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: 20170618
   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 ;;; Commentary:
  24 ;;
  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.
  28
  29
  30 ;;; Code:
  31
  32 (require 'subr-x)
  33
  34 (defun pelican-timestamp (&optional time)
  35   "Generate a Pelican-compatible timestamp for TIME."
  36   (format-time-string "%Y-%m-%d %H:%M" time))
  37
  38 (defun pelican-is-markdown ()
  39   "Check if the buffer is likely using Markdown."
  40   (derived-mode-p 'markdown-mode))
  41
  42 (defun pelican-field (name value)
  43   "Format a line for a field NAME with a VALUE."
  44   (if 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)))
  50     ""))
  51
  52 (defun pelican-rst-title (title)
  53   "Create a ReSt version of TITLE."
  54   (concat title "\n" (make-string (string-width title) ?#) "\n\n"))
  55
  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))))
  63
  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.
  67   (when (eq date t)
  68     (setq date (pelican-timestamp)))
  69
  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)
  76           "\n"))
  77
  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)))
  82     (save-excursion
  83       (goto-char 0)
  84       (insert (pelican-header title 't "draft" nil tags slug)))))
  85
  86 (defun pelican-insert-page-header (title hidden)
  87   "Insert a Pelican header for a page."
  88   (interactive
  89    (list (read-string "Page title: ")
  90          (y-or-n-p "Hidden? ")))
  91   (let ((slug (pelican-default-slug))
  92         (hidden (if hidden "hidden" nil)))
  93     (save-excursion
  94       (goto-char 0)
  95       (insert (pelican-header title nil hidden nil nil slug)))))
  96
  97 (defun pelican-insert-header ()
  98   "Insert a Pelican header for a page or post."
  99   (interactive)
 100   (call-interactively (if (pelican-is-page)
 101                           'pelican-insert-page-header
 102                         'pelican-insert-draft-post-header)))
 103
 104 (defun pelican-set-field (field value)
 105   "Set FIELD to VALUE."
 106   (interactive "sField: \nsValue: ")
 107   (save-excursion
 108     (goto-char 0)
 109     (if (re-search-forward (concat "^" (pelican-field field ".+*")) nil t)
 110         (replace-match (pelican-field field value))
 111       (re-search-forward "#")
 112       (forward-line 2)
 113       (re-search-forward "^$")
 114       (replace-match (pelican-field field value)))))
 115
 116 (defun pelican-set-title (title)
 117   "Set the title to TITLE."
 118   (interactive "sTitle: ")
 119   (if (pelican-is-markdown)
 120       (pelican-set-field "title" title)
 121     (save-excursion
 122       (goto-char 0)
 123       (let ((header (pelican-rst-title title)))
 124         (if (looking-at ".*\n#+\n+")
 125             (replace-match header)
 126           (insert header))))))
 127
 128 (defun pelican-update-date ()
 129   "Update a Pelican date header."
 130   (interactive)
 131   (pelican-set-field "date" (pelican-timestamp)))
 132
 133 (defun pelican-publish-draft ()
 134   "Remove draft status from a Pelican post."
 135   (interactive)
 136   (pelican-set-field "status" nil)
 137   (pelican-update-date))
 138
 139 (defun pelican-is-page ()
 140   "Guess the current buffer is a Pelican page (vs. a post or neither)."
 141   (when-let (pelican-base (pelican-find-root))
 142     (let* ((relative (file-relative-name buffer-file-name pelican-base))
 143            (components (split-string relative "/")))
 144       (equal "pages" (cadr components)))))
 145
 146 (defun pelican-default-slug ()
 147   "Generate a Pelican post/page slug for the current buffer."
 148   (if-let ((pelican-base (pelican-find-root))
 149            (file-name (file-name-sans-extension buffer-file-name)))
 150       (let* ((relative (file-relative-name file-name pelican-base))
 151              (components (cdr (split-string relative "/")))
 152              (components (if (string= "pages" (car components))
 153                              (cdr components) components)))
 154         (mapconcat 'identity components "/"))
 155     (format "%s/%s"
 156             (file-name-nondirectory
 157              (directory-file-name
 158               (file-name-directory file-name)))
 159             (file-name-base file-name))))
 160
 161 (defun pelican-find-in-parents (file-name)
 162   "Find FILE-NAME in the default directory or one of its parents, or nil."
 163   (let* ((parent (expand-file-name default-directory)))
 164     (while (and (not (file-readable-p (concat parent file-name)))
 165                 (not (string= parent (directory-file-name parent))))
 166       (setq parent (file-name-directory (directory-file-name parent))))
 167     (let ((found (concat parent file-name)))
 168       (if (file-readable-p found) found nil))))
 169
 170 (defun pelican-find-root ()
 171   "Return the root of the buffer's Pelican site, or nil."
 172   (when-let (conf (pelican-find-in-parents "pelicanconf.py"))
 173     (file-name-directory conf)))
 174
 175 (defun pelican-is-in-site ()
 176   "Check if this buffer is under a Pelican site."
 177   (not (null (pelican-find-root))))
 178
 179 (defun pelican-make (target)
 180   "Execute TARGET in a Makefile at the root of the site."
 181   (interactive "sMake Pelican target: ")
 182   (if-let (default-directory (pelican-find-root))
 183       (compilation-start (format "make %s" target)
 184                          nil (lambda (_) "*pelican*"))
 185     (message "This doesn't look like a Pelican site.")))
 186
 187 (defun pelican-make-html ()
 188   "Generate HTML via a Makefile at the root of the site."
 189   (interactive)
 190   (pelican-make "html"))
 191
 192 (defun pelican-make-rsync-upload ()
 193   "Upload with rsync via a Makefile at the root of the site."
 194   (interactive)
 195   (pelican-make "rsync_upload"))
 196
 197 (defconst pelican-keymap (make-sparse-keymap)
 198   "The default keymap used in Pelican mode.")
 199 (define-key pelican-keymap (kbd "C-c P n")
 200   'pelican-insert-header)
 201 (define-key pelican-keymap (kbd "C-c P p")
 202   'pelican-publish-draft)
 203 (define-key pelican-keymap (kbd "C-c P t")
 204   'pelican-update-date)
 205 (define-key pelican-keymap (kbd "C-c P h")
 206   'pelican-make-html)
 207 (define-key pelican-keymap (kbd "C-c P u")
 208   'pelican-make-rsync-upload)
 209
 210
 211 ;;;###autoload
 212 (define-minor-mode pelican-mode
 213   "Toggle Pelican mode.
 214
 215 Interactively with no argument, this command toggles the mode.
 216 for editing Pelican site files."
 217   :init-value nil
 218   :lighter " Pelican"
 219   :keymap pelican-keymap
 220   :group 'pelican)
 221
 222 ;;;###autoload
 223 (defun pelican-enable-if-site ()
 224   "Enable `pelican-mode' if this buffer is under a Pelican site."
 225   (when (pelican-is-in-site)
 226     (pelican-mode 1)))
 227
 228 ;;;###autoload
 229 (add-hook 'markdown-mode-hook 'pelican-enable-if-site)
 230
 231 ;;;###autoload
 232 (add-hook 'rst-mode-hook 'pelican-enable-if-site)
 233
 234 (provide 'pelican-mode)
 235 ;;; pelican-mode.el ends here