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-title (title)
53 "Format a TITLE for the current document, according to major mode."
54 (cond ((derived-mode-p 'markdown-mode)
55 (pelican-field "title" title))
56 ((derived-mode-p 'rst-mode)
57 (concat title "\n" (make-string (string-width title) ?#) "\n"))
58 (t (error "Unsupported major mode %S" major-mode))))
60 (defun pelican-header (title date status category tags slug)
61 "Create a Pelican header."
62 ;; TODO: Use a property list (-> alist via seq-partition) instead.
64 (setq date (pelican-timestamp)))
66 (concat (pelican-title title)
67 (pelican-field "date" date)
68 (pelican-field "status" status)
69 (pelican-field "tags" tags)
70 (pelican-field "category" category)
71 (pelican-field "slug" slug)
74 (defun pelican-insert-draft-post-header (title tags)
75 "Insert a Pelican header for a draft post."
76 (interactive "sPost title: \nsTags: ")
77 (let ((slug (pelican-default-slug)))
80 (insert (pelican-header title 't "draft" nil tags slug)))))
82 (defun pelican-insert-page-header (title hidden)
83 "Insert a Pelican header for a page."
85 (list (read-string "Page title: ")
86 (y-or-n-p "Hidden? ")))
87 (let ((slug (pelican-default-slug))
88 (hidden (if hidden "hidden" nil)))
91 (insert (pelican-header title nil hidden nil nil slug)))))
93 (defun pelican-insert-header ()
94 "Insert a Pelican header for a page or post."
96 (call-interactively (if (pelican-is-page)
97 'pelican-insert-page-header
98 'pelican-insert-draft-post-header)))
100 (defun pelican-set-field (field value)
101 "Set FIELD to VALUE."
104 (if (re-search-forward (concat "^" (pelican-field field ".+*")) nil t)
105 (replace-match (pelican-field field value))
106 (re-search-forward "^$")
107 (replace-match (pelican-field field value)))))
109 (defun pelican-update-date ()
110 "Update a Pelican date header."
112 (pelican-set-field "date" (pelican-timestamp)))
114 (defun pelican-publish-draft ()
115 "Remove draft status from a Pelican post."
117 (pelican-set-field "status" nil)
118 (pelican-update-date))
120 (defun pelican-is-page ()
121 "Guess the current buffer is a Pelican page (vs. a post or neither)."
122 (when-let (pelican-base (pelican-find-root))
123 (let* ((relative (file-relative-name buffer-file-name pelican-base))
124 (components (split-string relative "/")))
125 (equal "pages" (cadr components)))))
127 (defun pelican-default-slug ()
128 "Generate a Pelican post/page slug for the current buffer."
129 (if-let ((pelican-base (pelican-find-root))
130 (file-name (file-name-sans-extension buffer-file-name)))
131 (let* ((relative (file-relative-name file-name pelican-base))
132 (components (cdr (split-string relative "/")))
133 (components (if (string= "pages" (car components))
134 (cdr components) components)))
135 (mapconcat 'identity components "/"))
137 (file-name-nondirectory
139 (file-name-directory file-name)))
140 (file-name-base file-name))))
142 (defun pelican-find-in-parents (file-name)
143 "Find FILE-NAME in the default directory or one of its parents, or nil."
144 (let* ((parent (expand-file-name default-directory)))
145 (while (and (not (file-readable-p (concat parent file-name)))
146 (not (string= parent (directory-file-name parent))))
147 (setq parent (file-name-directory (directory-file-name parent))))
148 (let ((found (concat parent file-name)))
149 (if (file-readable-p found) found nil))))
151 (defun pelican-find-root ()
152 "Return the root of the buffer's Pelican site, or nil."
153 (when-let (conf (pelican-find-in-parents "pelicanconf.py"))
154 (file-name-directory conf)))
156 (defun pelican-is-in-site ()
157 "Check if this buffer is under a Pelican site."
158 (not (null (pelican-find-root))))
160 (defun pelican-enable-if-site ()
161 "Enable `pelican-mode' if this buffer is under a Pelican site."
162 (when (pelican-is-in-site)
165 (defun pelican-make (target)
166 "Execute TARGET in a Makefile at the root of the site."
167 (interactive "sMake Pelican target: ")
168 (if-let ((default-directory (pelican-find-root)))
169 (let ((output (get-buffer-create "*Pelican Output*")))
170 (display-buffer output)
171 (pop-to-buffer output)
173 (start-process "Pelican Makefile" output "make" target))
174 (message "This doesn't look like a Pelican site.")))
176 (defun pelican-make-html ()
177 "Generate HTML via a Makefile at the root of the site."
179 (pelican-make "html"))
181 (defun pelican-make-rsync-upload ()
182 "Upload with rsync via a Makefile at the root of the site."
184 (pelican-make "rsync_upload"))
186 (defconst pelican-keymap (make-sparse-keymap)
187 "The default keymap used in Pelican mode.")
188 (define-key pelican-keymap (kbd "C-c P n")
189 'pelican-insert-header)
190 (define-key pelican-keymap (kbd "C-c P p")
191 'pelican-publish-draft)
192 (define-key pelican-keymap (kbd "C-c P t")
193 'pelican-update-date)
194 (define-key pelican-keymap (kbd "C-c P h")
196 (define-key pelican-keymap (kbd "C-c P u")
197 'pelican-make-rsync-upload)
201 (define-minor-mode pelican-mode
202 "Toggle Pelican mode.
204 Interactively with no argument, this command toggles the mode.
205 to show buffer size and position in mode-line."
208 :keymap pelican-keymap
213 (add-hook 'markdown-mode-hook 'pelican-enable-if-site)
216 (add-hook 'rst-mode-hook 'pelican-enable-if-site)
218 (provide 'pelican-mode)
219 ;;; pelican-mode.el ends here