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: 20170618
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.
34 (defun pelican-timestamp (&optional time)
35 "Generate a Pelican-compatible timestamp for TIME."
36 (format-time-string "%Y-%m-%d %H:%M" time))
38 (defun pelican-is-markdown ()
39 "Check if the buffer is likely using Markdown."
40 (derived-mode-p 'markdown-mode))
42 (defun pelican-field (name value)
43 "Format a line for a field NAME with a VALUE."
45 (cond ((derived-mode-p 'markdown-mode)
46 (format "%s: %s\n" (capitalize name) value))
47 ((derived-mode-p 'rst-mode)
48 (format ":%s: %s\n" (downcase name) value))
49 (t (error "Unsupported major mode %S" major-mode)))
52 (defun pelican-rst-title (title)
53 "Create a ReSt version of TITLE."
54 (concat title "\n" (make-string (string-width title) ?#) "\n\n"))
56 (defun pelican-title (title)
57 "Format a TITLE for the current document, according to major mode."
58 (cond ((derived-mode-p 'markdown-mode)
59 (pelican-field "title" title))
60 ((derived-mode-p 'rst-mode)
61 (pelican-rst-title title))
62 (t (error "Unsupported major mode %S" major-mode))))
64 (defun pelican-header (title date status category tags slug)
65 "Create a Pelican header."
66 ;; TODO: Use a property list (-> alist via seq-partition) instead.
68 (setq date (pelican-timestamp)))
70 (concat (pelican-title title)
71 (pelican-field "date" date)
72 (pelican-field "status" status)
73 (pelican-field "tags" tags)
74 (pelican-field "category" category)
75 (pelican-field "slug" slug)
78 (defun pelican-insert-draft-post-header (title tags)
79 "Insert a Pelican header for a draft post."
80 (interactive "sPost title: \nsTags: ")
81 (let ((slug (pelican-default-slug)))
84 (insert (pelican-header title 't "draft" nil tags slug)))))
86 (defun pelican-insert-page-header (title hidden)
87 "Insert a Pelican header for a page."
89 (list (read-string "Page title: ")
90 (y-or-n-p "Hidden? ")))
91 (let ((slug (pelican-default-slug))
92 (hidden (if hidden "hidden" nil)))
95 (insert (pelican-header title nil hidden nil nil slug)))))
97 (defun pelican-insert-header ()
98 "Insert a Pelican header for a page or post."
100 (call-interactively (if (pelican-is-page)
101 'pelican-insert-page-header
102 'pelican-insert-draft-post-header)))
104 (defun pelican-set-field (field value)
105 "Set FIELD to VALUE."
108 (if (re-search-forward (concat "^" (pelican-field field ".+*")) nil t)
109 (replace-match (pelican-field field value))
110 (re-search-forward "^$")
111 (replace-match (pelican-field field value)))))
113 (defun pelican-set-title (title)
114 "Set the title to TITLE."
115 (if (pelican-is-markdown)
116 (pelican-set-field "title" title)
119 (let ((header (pelican-rst-title title)))
120 (if (looking-at ".*\n#+\n+")
121 (replace-match header)
124 (defun pelican-update-date ()
125 "Update a Pelican date header."
127 (pelican-set-field "date" (pelican-timestamp)))
129 (defun pelican-publish-draft ()
130 "Remove draft status from a Pelican post."
132 (pelican-set-field "status" nil)
133 (pelican-update-date))
135 (defun pelican-is-page ()
136 "Guess the current buffer is a Pelican page (vs. a post or neither)."
137 (when-let (pelican-base (pelican-find-root))
138 (let* ((relative (file-relative-name buffer-file-name pelican-base))
139 (components (split-string relative "/")))
140 (equal "pages" (cadr components)))))
142 (defun pelican-default-slug ()
143 "Generate a Pelican post/page slug for the current buffer."
144 (if-let ((pelican-base (pelican-find-root))
145 (file-name (file-name-sans-extension buffer-file-name)))
146 (let* ((relative (file-relative-name file-name pelican-base))
147 (components (cdr (split-string relative "/")))
148 (components (if (string= "pages" (car components))
149 (cdr components) components)))
150 (mapconcat 'identity components "/"))
152 (file-name-nondirectory
154 (file-name-directory file-name)))
155 (file-name-base file-name))))
157 (defun pelican-find-in-parents (file-name)
158 "Find FILE-NAME in the default directory or one of its parents, or nil."
159 (let* ((parent (expand-file-name default-directory)))
160 (while (and (not (file-readable-p (concat parent file-name)))
161 (not (string= parent (directory-file-name parent))))
162 (setq parent (file-name-directory (directory-file-name parent))))
163 (let ((found (concat parent file-name)))
164 (if (file-readable-p found) found nil))))
166 (defun pelican-find-root ()
167 "Return the root of the buffer's Pelican site, or nil."
168 (when-let (conf (pelican-find-in-parents "pelicanconf.py"))
169 (file-name-directory conf)))
171 (defun pelican-is-in-site ()
172 "Check if this buffer is under a Pelican site."
173 (not (null (pelican-find-root))))
175 (defun pelican-enable-if-site ()
176 "Enable `pelican-mode' if this buffer is under a Pelican site."
177 (when (pelican-is-in-site)
180 (defun pelican-make (target)
181 "Execute TARGET in a Makefile at the root of the site."
182 (interactive "sMake Pelican target: ")
183 (if-let ((default-directory (pelican-find-root)))
184 (let ((output (get-buffer-create "*Pelican Output*")))
185 (display-buffer output)
186 (pop-to-buffer output)
188 (start-process "Pelican Makefile" output "make" target))
189 (message "This doesn't look like a Pelican site.")))
191 (defun pelican-make-html ()
192 "Generate HTML via a Makefile at the root of the site."
194 (pelican-make "html"))
196 (defun pelican-make-rsync-upload ()
197 "Upload with rsync via a Makefile at the root of the site."
199 (pelican-make "rsync_upload"))
201 (defconst pelican-keymap (make-sparse-keymap)
202 "The default keymap used in Pelican mode.")
203 (define-key pelican-keymap (kbd "C-c P n")
204 'pelican-insert-header)
205 (define-key pelican-keymap (kbd "C-c P p")
206 'pelican-publish-draft)
207 (define-key pelican-keymap (kbd "C-c P t")
208 'pelican-update-date)
209 (define-key pelican-keymap (kbd "C-c P h")
211 (define-key pelican-keymap (kbd "C-c P u")
212 'pelican-make-rsync-upload)
216 (define-minor-mode pelican-mode
217 "Toggle Pelican mode.
219 Interactively with no argument, this command toggles the mode.
220 to show buffer size and position in mode-line."
223 :keymap pelican-keymap
227 (add-hook 'markdown-mode-hook 'pelican-enable-if-site)
230 (add-hook 'rst-mode-hook 'pelican-enable-if-site)
232 (provide 'pelican-mode)
233 ;;; pelican-mode.el ends here