2c8315b8b47ef0b00d87a1d13c6b680d71bbb8a0
[pelican-mode.git] / pelican-mode.el
1 ;;; pelican-mode.el --- Minor mode for editing Pelican sites -*- lexical-binding: t -*-
2 ;;
3 ;; Copyright 2013-2017 Joe Wreschnig
4 ;;
5 ;; Author: Joe Wreschnig <joe.wreschnig@gmail.com>
6 ;; Package-Version: 20170807
7 ;; Package-Requires: ((emacs "25"))
8 ;; Keywords: convenience, editing
9 ;;
10 ;; This program is free software; you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation, either version 3 of the License, or
13 ;; (at your option) any later version.
14 ;;
15 ;; This program is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
19 ;;
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
22
23 \f
24
25 ;;; Commentary:
26 ;;
27 ;; pelican-mode is an Emacs minor mode for editing pages and posts in
28 ;; Pelican sites. Pelican is a static site generator which can
29 ;; process a variety of text file formats. For more information, see
30 ;; URL https://blog.getpelican.com/.
31 ;;
32 ;; It's intended to be used alongside a major mode for the Pelican
33 ;; document. Currently supported formats are Markdown,
34 ;; reStructuredText, AsciiDoc, and Org. It also assumes you've set up
35 ;; Pelican with ``pelican-quickstart'' or something like it. In
36 ;; particular it expects:
37 ;;
38 ;; * The existence of ``pelicanconf.py'' and ``Makefile'' in some
39 ;; ancestor directory.
40 ;; * The first component of the path (e.g. ``content'') after that
41 ;; ancestor is irrelevant.
42 ;; * If the next component is ``pages'', that indicates a page
43 ;; rather than an article.
44 ;;
45 ;; To enable by default on all text files in a Pelican site:
46 ;;
47 ;; (require 'pelican-mode)
48 ;; (pelican-global-mode)
49 ;;
50 ;; Or, register `pelican-mode' or `pelican-mode-enable-if-site'
51 ;; as hook functions for more direct control.
52
53 \f
54
55 ;;; Code:
56
57 (require 'seq)
58 (require 'subr-x)
59
60 ;; Mode Definition
61
62 ;;;###autoload
63 (define-minor-mode pelican-mode
64 "Toggle Pelican mode.
65 With a prefix argument ARG, enable Pelican mode if ARG is
66 positive, and disable it otherwise. If called from Lisp, enable
67 the mode if ARG is omitted or nil.
68
69 Pelican is a static site generator which can process a variety of
70 text file formats. For more information, see URL
71 https://blog.getpelican.com/.
72
73 Rather than manually enabling this mode, you may wish to use
74 `pelican-global-mode' or `pelican-mode-enable-if-site'.
75
76 When Pelican mode is enabled, additional commands are available
77 for editing articles or pages:
78
79 \\{pelican-mode-map}"
80 :lighter " Pelican"
81 :keymap `((,(kbd "C-c P d") . pelican-mode-update-date)
82 (,(kbd "C-c P f") . pelican-set-field)
83 (,(kbd "C-c P h") . pelican-make-html)
84 (,(kbd "C-c P n") . pelican-mode-insert-header)
85 (,(kbd "C-c P p") . pelican-mode-publish)
86 (,(kbd "C-c P u") . pelican-make-rsync-upload)))
87
88 ;;;###autoload
89 (define-minor-mode pelican-global-mode
90 "Toggle Pelican global mode.
91 With a prefix argument ARG, enable Pelican global mode if ARG is
92 positive, and disable it otherwise. If called from Lisp, enable
93 the mode if ARG is omitted or nil.
94
95 Pelican is a static site generator which can process a variety of
96 text file formats. For more information, see URL
97 https://blog.getpelican.com/.
98
99 When Pelican global mode is enabled, text files which seem to
100 be part of a Pelican site will have `pelican-mode' automatically
101 enabled.
102
103 If you disable this, you may still enable `pelican-mode' manually
104 or add `pelican-mode-enable-if-site' to more specific mode
105 hooks."
106 :global t
107 :group 'pelican-mode
108 (if pelican-global-mode
109 (add-hook 'text-mode-hook #'pelican-mode-enable-if-site)
110 (remove-hook 'text-mode-hook #'pelican-mode-enable-if-site)))
111
112 ;;;###autoload
113 (defun pelican-mode-enable-if-site ()
114 "Enable `pelican-mode' if this buffer is part of a Pelican site.
115
116 Pelican sites are detected by looking for a file named `pelicanconf.py'
117 in an ancestor directory."
118 (when (pelican-mode-find-root)
119 (pelican-mode)))
120
121 \f
122
123 ;; Customizations
124
125 (defgroup pelican-mode nil
126 "Support for Pelican articles and pages.
127
128 For more information about Pelican see URL https://blog.getpelican.com/."
129 :group 'convenience)
130
131 (defcustom pelican-mode-default-page-fields
132 '(:slug slug)
133 "Fields to include when creating a new page.
134
135 See the documentation for `pelican-mode-set-field' for more information
136 about metadata fields and special values."
137 :group 'pelican-mode
138 :type '(plist))
139
140 (defcustom pelican-mode-default-article-fields
141 '(:date now :status "draft" :slug slug)
142 "Fields to include when creating a new article.
143
144 See the documentation for `pelican-mode-set-field' for more information
145 about metadata fields and special values."
146 :group 'pelican-mode
147 :type '(plist))
148
149 (defcustom pelican-mode-formats
150 '((adoc-mode . pelican-mode-set-field-adoc-mode)
151 (markdown-mode . pelican-mode-set-field-markdown-mode)
152 (org-mode . pelican-mode-set-field-org-mode)
153 (rst-mode . pelican-mode-set-field-rst-mode))
154 "Functions to handle setting metadata, based on major mode.
155
156 This association list maps modes to functions that take two
157 arguments, field and value strings."
158 :group 'pelican-mode
159 :type '(alist :key-type function :value-type function))
160
161 \f
162
163 ;; User Commands
164
165 (defun pelican-mode-set-field (field value)
166 "Set FIELD to VALUE.
167
168 FIELD may be a string or a symbol; if it is a symbol, the
169 symbol name is used (removing a leading ':' if present).
170
171 When called from Lisp, VALUE may be any value; except for the
172 following special values, the unquoted printed representation of
173 it is used:
174
175 - `now' means the current time.
176
177 - `slug' means the file's path relative to the document root sans
178 extension; see `pelican-mode-default-slug'.
179
180 - nil or an empty string removes the field.
181
182 The buffer must be in a format listed in `pelican-mode-formats'
183 for this function to work correctly."
184 (interactive "sField: \nsValue: ")
185 (setq value (pcase value
186 ('now (format-time-string "%Y-%m-%d %H:%M"))
187 ('slug (pelican-mode-default-slug))
188 ('"" nil)
189 (_ value)))
190 (when (symbolp field)
191 (setq field (string-remove-prefix ":" (symbol-name field))))
192 (let ((set-field
193 (assoc-default nil pelican-mode-formats #'derived-mode-p)))
194 (unless set-field
195 (error "Unsupported major mode %S" major-mode))
196 (save-excursion
197 (goto-char 0)
198 (funcall set-field field value))))
199
200 (defun pelican-mode-remove-field (field)
201 "Remove FIELD."
202 (interactive "sField: ")
203 (pelican-mode-set-field field nil))
204
205 (defun pelican-mode-set-title (title)
206 "Set the title to TITLE."
207 (interactive "sTitle: ")
208 (pelican-mode-set-field :title title))
209
210 (defun pelican-mode-update-date (&optional original)
211 "Update the document's modification date.
212
213 If ORIGINAL is non-nil, the publication date is updated rather
214 than the modification date."
215 (interactive "P")
216 (pelican-mode-set-field (if original :date :modified) 'now))
217
218 (defun pelican-mode-publish ()
219 "Remove draft or hidden status from a Pelican article."
220 (interactive)
221 (pelican-mode-remove-field :status)
222 (pelican-mode-update-date :date))
223
224 (defun pelican-mode-insert-article-header (title tags)
225 "Insert a Pelican header for an article with a TITLE and TAGS."
226 (interactive "sArticle title: \nsTags: ")
227 (save-excursion
228 (goto-char 0)
229 (insert "\n")
230 (apply #'pelican-mode-set-fields
231 `(:title ,title
232 ,@pelican-mode-default-article-fields
233 :tags ,tags))))
234
235 (defun pelican-mode-insert-page-header (title &optional hidden)
236 "Insert a Pelican header for a page with a TITLE.
237
238 If HIDDEN is non-nil, the page is marked hidden; otherwise it
239 has no status."
240 (interactive "sPage title: \nP")
241 (save-excursion
242 (goto-char 0)
243 (insert "\n")
244 (apply #'pelican-mode-set-fields
245 (append
246 (list :title title :status (when hidden "hidden"))
247 pelican-mode-default-page-fields))))
248
249 (defun pelican-mode-insert-header ()
250 "Insert a Pelican header for a page or article."
251 (interactive)
252 (call-interactively
253 (if (pelican-mode-page-p)
254 #'pelican-mode-insert-page-header
255 #'pelican-mode-insert-article-header)))
256
257 (defun pelican-make (target)
258 "Execute TARGET in a Makefile at the root of the site."
259 (interactive "sMake Pelican target: ")
260 (if-let (default-directory (pelican-mode-find-root))
261 (compilation-start (format "make %s" target)
262 nil (lambda (_) "*pelican*"))
263 (user-error "No Pelican site root could be found")))
264
265 (defun pelican-make-html ()
266 "Generate HTML via a Makefile at the root of the site."
267 (interactive)
268 (pelican-make "html"))
269
270 (defun pelican-make-rsync-upload ()
271 "Upload with rsync via a Makefile at the root of the site."
272 (interactive)
273 (pelican-make "rsync_upload"))
274
275 \f
276
277 (defun pelican-mode-set-fields (&rest fields)
278 "Insert a Pelican header for an article with metadata FIELDS."
279 (mapc (apply-partially #'apply #'pelican-mode-set-field)
280 (seq-partition fields 2)))
281
282 (defun pelican-mode-set-field-rst-mode (field value)
283 "Set reStructuredText metadata FIELD to VALUE."
284 (setq field (downcase field))
285 (if (equal field "title")
286 (let ((header (format "%s\n%s\n\n"
287 value (make-string (string-width value) ?#))))
288 (if (looking-at ".*\n#+\n+")
289 (replace-match header)
290 (insert header)))
291 (let ((text (when value (format ":%s: %s\n" field value))))
292 (when (looking-at "^.*\n#")
293 (forward-line 3))
294 (if (re-search-forward (format "^:%s:.*\n" (regexp-quote field)) nil t)
295 (replace-match (or text ""))
296 (when text
297 (if (re-search-forward "^$" nil t)
298 (replace-match text)
299 (insert text)))))))
300
301 (defun pelican-mode-set-field-markdown-mode (field value)
302 "Set Markdown metadata FIELD to VALUE."
303 (setq field (capitalize field))
304 (let ((text (when value (format "%s: %s\n" field value))))
305 (if (re-search-forward (format "^%s:.*\n" (regexp-quote field)) nil t)
306 (replace-match text)
307 (when value
308 (if (re-search-forward "^$" nil t)
309 (replace-match text)
310 (insert text))))))
311
312 (defun pelican-mode-set-field-adoc-mode (field value)
313 "Set AsciiDoc metadata FIELD to VALUE."
314 (setq field (downcase field))
315 (if (equal field "title")
316 (let ((header (format "= %s\n\n" value)))
317 (if (looking-at "= .*\n\n+")
318 (replace-match header)
319 (insert header)))
320 (let ((text (when value (format ":%s: %s\n" field value))))
321 (when (looking-at "^=")
322 (forward-line 2))
323 (if (re-search-forward (format "^:%s:.*\n" (regexp-quote field)) nil t)
324 (replace-match (or text ""))
325 (when text
326 (if (re-search-forward "^$" nil t)
327 (replace-match text)
328 (insert text)))))))
329
330 (defun pelican-mode-set-field-org-mode (field value)
331 "Set Org global metadata FIELD to VALUE."
332 ;; None of org-mode's functions I can find for setting properties
333 ;; operate on the global list, only a single property drawer.
334 (setq field (upcase field))
335 (setq field
336 (format (if (member field '("TITLE" "DATE" "CATEGORY" "AUTHOR"))
337 "#+%s:"
338 "#+PROPERTY: %s")
339 field))
340 (let ((text (when value (format "%s %s\n" field value))))
341 (if (re-search-forward (format "^%s .*\n" (regexp-quote field)) nil t)
342 (replace-match (or text ""))
343 (when text
344 (if (re-search-forward "^$" nil t)
345 (replace-match text)
346 (insert text))))))
347
348 (defun pelican-mode-page-p ()
349 "Return non-nil the current buffer is a Pelican page."
350 (string-match-p
351 "^[^/]+/pages/"
352 (file-relative-name
353 (abbreviate-file-name (or (buffer-file-name) (buffer-name)))
354 (pelican-mode-find-root))))
355
356 (defun pelican-mode-default-slug ()
357 "Generate a Pelican slug for the current buffer."
358 (file-name-sans-extension
359 (replace-regexp-in-string
360 "^[^/]+/\\(?:pages/\\)?" ""
361 (file-relative-name
362 (abbreviate-file-name (or (buffer-file-name) (buffer-name)))
363 (pelican-mode-find-root)))))
364
365 (defun pelican-mode-find-root ()
366 "Return the root of the buffer's Pelican site, or nil."
367 (locate-dominating-file default-directory "pelicanconf.py"))
368
369 (provide 'pelican-mode)
370 ;;; pelican-mode.el ends here
371
372 \f
373
374 ;; Local Variables:
375 ;; sentence-end-double-space: t
376 ;; End: