1 ;;; pelican-mode.el --- Minor mode for editing Pelican sites -*- lexical-binding: t -*-
3 ;; Copyright 2013-2017 Joe Wreschnig
5 ;; Author: Joe Wreschnig <joe.wreschnig@gmail.com>
6 ;; Package-Version: 20170730
7 ;; Package-Requires: ((emacs "25"))
8 ;; Keywords: convenience, editing
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.
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.
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/>.
25 ;; Probably, this doesn't handle a lot of error cases. I also never
26 ;; tested it on networked drives and the lookup for pelicanconf.py
27 ;; might slow it down considerably.
35 (defgroup pelican-mode nil
36 "Support for Pelican articles and pages."
39 (defcustom pelican-mode-default-page-fields
41 "Fields to include when creating a new page.
43 See the documentation for `pelican-mode-field' for more information
44 about metadata fields and special values."
48 (defcustom pelican-mode-default-article-fields
49 '(:date now :status "draft" :slug slug)
50 "Fields to include when creating a new article.
52 See the documentation for `pelican-mode-field' for more information
53 about metadata fields and special values."
57 (defun pelican-mode-timestamp (&optional time)
58 "Generate a pelican-mode-compatible timestamp for TIME."
59 (format-time-string "%Y-%m-%d %H:%M" time))
61 (defun pelican-mode-field (name value)
62 "Format a line for a field NAME with a VALUE.
64 NAME may be a string or a symbol; if it is a symbol, the
65 symbol name is used (removing a leading ':' if present).
67 VALUE may be any value; except for the following special values,
68 the unquoted printed representation of it is used:
70 - `now' means the current time; see `pelican-mode-timestamp'.
72 - `slug' means the file's path relative to the document root sans
73 extension; see `pelican-mode-default-slug'.
75 - nil or an empty strings means return an empty string, without
77 (setq value (pcase value
78 ('now (pelican-mode-timestamp))
79 ('slug (pelican-mode-default-slug))
83 (setq name (string-remove-prefix ":" (symbol-name name))))
85 (cond ((derived-mode-p 'markdown-mode)
86 (format "%s: %s\n" (capitalize name) value))
87 ((derived-mode-p 'rst-mode)
88 (format ":%s: %s\n" (downcase name) value))
89 (t (error "Unsupported major mode %S" major-mode)))
92 (defun pelican-mode-rst-title (title)
93 "Format a reStructureText version of TITLE."
94 (concat title "\n" (make-string (string-width title) ?#) "\n\n"))
96 (defun pelican-mode-title (title)
97 "Format a TITLE for the current document, according to major mode."
98 (cond ((derived-mode-p 'markdown-mode)
99 (pelican-mode-field "title" title))
100 ((derived-mode-p 'rst-mode)
101 (pelican-mode-rst-title title))
102 (t (error "Unsupported major mode %S" major-mode))))
104 (defun pelican-mode-header (title &rest fields)
105 "Generate a Pelican header for an article with a TITLE and metadata FIELDS."
106 (concat (pelican-mode-title title)
107 (mapconcat (apply-partially #'apply #'pelican-mode-field)
108 (seq-partition fields 2) "")
111 (defun pelican-mode-insert-header (title &rest fields)
112 "Insert a Pelican header for an article with a TITLE and metadata FIELDS."
115 (insert (apply #'pelican-mode-header (cons title fields)))))
117 (defun pelican-mode-insert-draft-article-header (title tags)
118 "Insert a Pelican header for a draft with a TITLE and TAGS."
119 (interactive "sArticle title: \nsTags: ")
120 (apply #'pelican-mode-insert-header
121 `(,title ,@pelican-mode-default-article-fields :tags ,tags)))
123 (defun pelican-mode-insert-page-header (title &optional hidden)
124 "Insert a Pelican header for a page with a TITLE, potentially HIDDEN."
126 (list (read-string "Page title: ")
127 (y-or-n-p "Hidden? ")))
128 (apply #'pelican-mode-insert-header
129 `(,title ,@pelican-mode-default-page-fields
130 :hidden ,(when hidden "hidden"))))
132 (defun pelican-mode-insert-auto-header ()
133 "Insert a Pelican header for a page or article."
136 (if (pelican-mode-page-p)
137 #'pelican-mode-insert-page-header
138 #'pelican-mode-insert-draft-article-header)))
140 (defun pelican-mode-set-field (field value)
141 "Set FIELD to VALUE."
142 (interactive "sField: \nsValue: ")
145 (when (and (derived-mode-p 'rst-mode)
146 (re-search-forward "^#" nil t))
148 (if (re-search-forward (concat "^" (pelican-mode-field field ".+*")) nil t)
149 (replace-match (pelican-mode-field field value))
151 (re-search-forward "^$")
152 (replace-match (pelican-mode-field field value))))))
154 (defun pelican-mode-remove-field (field)
156 (pelican-mode-set-field field nil))
158 (defun pelican-mode-set-title (title)
159 "Set the title to TITLE."
160 (interactive "sTitle: ")
161 (if (derived-mode-p 'markdown-mode)
162 (pelican-mode-set-field "title" title)
165 (let ((header (pelican-mode-rst-title title)))
166 (if (looking-at ".*\n#+\n+")
167 (replace-match header)
170 (defun pelican-mode-update-date ()
171 "Update a Pelican date header."
173 (pelican-mode-set-field :date 'now))
175 (defun pelican-mode-publish-draft ()
176 "Remove draft status from a Pelican article."
178 (pelican-mode-remove-field :status)
179 (pelican-mode-update-date))
181 (defun pelican-mode-page-p ()
182 "Return non-nil the current buffer is a Pelican page."
183 (when-let (pelican-mode-base (pelican-mode-find-root))
184 (let* ((relative (file-relative-name buffer-file-name pelican-mode-base))
185 (components (split-string relative "/")))
186 (equal "pages" (cadr components)))))
188 (defun pelican-mode-default-slug ()
189 "Generate a Pelican article/page slug for the current buffer."
190 (if-let ((pelican-mode-base (pelican-mode-find-root))
191 (file-name (file-name-sans-extension buffer-file-name)))
192 (let* ((relative (file-relative-name file-name pelican-mode-base))
193 (components (cdr (split-string relative "/")))
194 (components (if (string= "pages" (car components))
195 (cdr components) components)))
196 (mapconcat 'identity components "/"))
198 (file-name-nondirectory
200 (file-name-directory file-name)))
201 (file-name-base file-name))))
203 (defun pelican-mode-find-in-parents (file-name)
204 "Find FILE-NAME in the default directory or one of its parents, or nil."
205 (let* ((parent (expand-file-name default-directory)))
206 (while (and (not (file-readable-p (concat parent file-name)))
207 (not (string= parent (directory-file-name parent))))
208 (setq parent (file-name-directory (directory-file-name parent))))
209 (let ((found (concat parent file-name)))
210 (if (file-readable-p found) found nil))))
212 (defun pelican-mode-find-root ()
213 "Return the root of the buffer's Pelican site, or nil."
214 (when-let (conf (pelican-mode-find-in-parents "pelicanconf.py"))
215 (file-name-directory conf)))
217 (defun pelican-make (target)
218 "Execute TARGET in a Makefile at the root of the site."
219 (interactive "sMake Pelican target: ")
220 (if-let (default-directory (pelican-mode-find-root))
221 (compilation-start (format "make %s" target)
222 nil (lambda (_) "*pelican*"))
223 (user-error "This doesn't look like a Pelican site")))
225 (defun pelican-make-html ()
226 "Generate HTML via a Makefile at the root of the site."
228 (pelican-make "html"))
230 (defun pelican-make-rsync-upload ()
231 "Upload with rsync via a Makefile at the root of the site."
233 (pelican-make "rsync_upload"))
236 (define-minor-mode pelican-mode
237 "Toggle Pelican mode.
238 With a prefix argument ARG, enable Pelican mode if ARG is
239 positive, and disable it otherwise. If called from Lisp, enable
240 the mode if ARG is omitted or nil.
242 When Pelican mode is enabled, additional commands are available
243 for editing articles or pages:
245 \\{pelican-mode-map}"
247 :keymap `((,(kbd "C-c P n") . pelican-mode-insert-auto-header)
248 (,(kbd "C-c P p") . pelican-mode-publish-draft)
249 (,(kbd "C-c P t") . pelican-mode-update-date)
250 (,(kbd "C-c P h") . pelican-make-html)
251 (,(kbd "C-c P u") . pelican-make-rsync-upload)))
254 (define-minor-mode pelican-global-mode
255 "Toggle Pelican global mode.
256 With a prefix argument ARG, enable Pelican global mode if ARG is
257 positive, and disable it otherwise. If called from Lisp, enable
258 the mode if ARG is omitted or nil.
260 When Pelican global mode is enabled, text files which seem to
261 be part of a Pelican site will have `pelican-mode' automatically
264 If you disable this, you may still enable `pelican-mode' manually
265 or add `pelican-mode-enable-if-site' to more specific mode
269 (if pelican-global-mode
270 (add-hook 'text-mode-hook #'pelican-mode-enable-if-site)
271 (remove-hook 'text-mode-hook #'pelican-mode-enable-if-site)))
274 (defun pelican-mode-enable-if-site ()
275 "Enable `pelican-mode' if this buffer is part of a Pelican site."
276 (when (pelican-mode-find-root)
279 (provide 'pelican-mode)
280 ;;; pelican-mode.el ends here
283 ;; sentence-end-double-space: t