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: 20170730
   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
  24 ;;; Commentary:
  25 ;;
  26 ;; pelican-mode is an Emacs minor mode for editing pages and posts in
  27 ;; Pelican sites.  Pelican is a static site generator which can
  28 ;; process a variety of text file formats.  For more information, see
  29 ;; URL https://blog.getpelican.com/.
  30 ;;
  31 ;; It's intended to be used alongside `markdown-mode' or `rst-mode'.
  32 ;; It also assumes you've set up Pelican with ``pelican-quickstart''
  33 ;; or something like it.  In particular it assumes:
  34 ;;
  35 ;;  * The existence of ``pelicanconf.py'' and ``Makefile'' in some
  36 ;;    ancestor directory.
  37 ;;  * The first component of the path (e.g. ``content'') after that
  38 ;;    ancestor is irrelevant.
  39 ;;  * If the next component is ``pages'', that indicates a page
  40 ;;    rather than an article.
  41
  42
  43 ;;; Code:
  44
  45 (require 'seq)
  46 (require 'subr-x)
  47
  48 (defgroup pelican-mode nil
  49   "Support for Pelican articles and pages.
  50
  51 For more information about Pelican see URL https://blog.getpelican.com/."
  52   :group 'convenience)
  53
  54 (defcustom pelican-mode-default-page-fields
  55   '(:slug slug)
  56   "Fields to include when creating a new page.
  57
  58 See the documentation for `pelican-mode-set-field' for more information
  59 about metadata fields and special values."
  60   :group 'pelican
  61   :type '(plist))
  62
  63 (defcustom pelican-mode-default-article-fields
  64   '(:date now :status "draft" :slug slug)
  65   "Fields to include when creating a new article.
  66
  67 See the documentation for `pelican-mode-set-field' for more information
  68 about metadata fields and special values."
  69   :group 'pelican
  70   :type '(plist))
  71
  72 (defcustom pelican-mode-set-field-alist
  73   '((markdown-mode . pelican-mode-set-field-markdown-mode)
  74     (rst-mode . pelican-mode-set-field-rst-mode))
  75   "Functions to handle setting metadata, based on major mode.
  76
  77 This association list maps modes to functions that take two
  78 arguments, field and value strings."
  79   :group 'pelican
  80   :type '(alist :key-type function :value-type function))
  81
  82 (defun pelican-mode-timestamp (&optional time)
  83   "Generate a pelican-mode-compatible timestamp for TIME."
  84   (format-time-string "%Y-%m-%d %H:%M" time))
  85
  86 (defun pelican-mode-insert-header (&rest fields)
  87   "Insert a Pelican header for an article with metadata FIELDS."
  88   (mapc (apply-partially #'apply #'pelican-mode-set-field)
  89         (seq-partition fields 2)))
  90
  91 (defun pelican-mode-insert-draft-article-header (title tags)
  92   "Insert a Pelican header for a draft with a TITLE and TAGS."
  93   (interactive "sArticle title: \nsTags: ")
  94   (apply #'pelican-mode-insert-header
  95          `(:title ,title ,@pelican-mode-default-article-fields :tags ,tags)))
  96
  97 (defun pelican-mode-insert-page-header (title &optional hidden)
  98   "Insert a Pelican header for a page with a TITLE, potentially HIDDEN."
  99   (interactive
 100    (list (read-string "Page title: ")
 101          (y-or-n-p "Hidden? ")))
 102   (apply #'pelican-mode-insert-header
 103          `(:title ,title ,@pelican-mode-default-page-fields
 104                   :hidden ,(when hidden "hidden"))))
 105
 106 (defun pelican-mode-insert-auto-header ()
 107   "Insert a Pelican header for a page or article."
 108   (interactive)
 109   (call-interactively
 110    (if (pelican-mode-page-p)
 111        #'pelican-mode-insert-page-header
 112      #'pelican-mode-insert-draft-article-header)))
 113
 114 (defun pelican-mode-set-field-rst-mode (field value)
 115   "Set reStructuredText metadata FIELD to VALUE."
 116   (setq field (downcase field))
 117   (if (equal field "title")
 118       (let ((header (format "%s\n%s\n\n"
 119                             value (make-string (string-width value) ?#))))
 120         (if (looking-at ".*\n#+\n+")
 121             (replace-match header)
 122           (insert header)))
 123     (let ((text (when value (format ":%s: %s\n" field value))))
 124       (when (re-search-forward "^#" nil t)
 125         (forward-line 2))
 126       (if (re-search-forward (format "^:%s:.*\n" (regexp-quote field)) nil t)
 127           (replace-match (or text ""))
 128         (when text
 129           (if (re-search-forward "^$" nil t)
 130               (replace-match text)
 131             (insert text)))))))
 132
 133 (defun pelican-mode-set-field-markdown-mode (field value)
 134   "Set Markdown metadata FIELD to VALUE."
 135   (setq field (capitalize field))
 136   (let ((text (when value (format "%s: %s\n" field value))))
 137     (if (re-search-forward (format "^%s:.*\n" (regexp-quote field)) nil t)
 138         (replace-match text)
 139       (when value
 140         (if (re-search-forward "^$" nil t)
 141             (replace-match text)
 142           (insert text))))))
 143
 144 (defun pelican-mode-set-field (field value)
 145   "Set FIELD to VALUE.
 146
 147 FIELD may be a string or a symbol; if it is a symbol, the
 148 symbol name is used (removing a leading ':' if present).
 149
 150 VALUE may be any value; except for the following special values,
 151 the unquoted printed representation of it is used:
 152
 153 - `now' means the current time; see `pelican-mode-timestamp'.
 154
 155 - `slug' means the file's path relative to the document root sans
 156   extension; see `pelican-mode-default-slug'.
 157
 158 - nil or an empty string removes the field."
 159   (interactive "sField: \nsValue: ")
 160   (setq value (pcase value
 161                 ('now (pelican-mode-timestamp))
 162                 ('slug (pelican-mode-default-slug))
 163                 ('"" nil)
 164                 (_ value)))
 165   (when (symbolp field)
 166     (setq field (string-remove-prefix ":" (symbol-name field))))
 167   (let ((set-field
 168          (assoc-default nil pelican-mode-set-field-alist #'derived-mode-p)))
 169     (unless set-field
 170       (error "Unsupported major mode %S" major-mode))
 171     (save-excursion
 172       (goto-char 0)
 173       (funcall set-field field value))))
 174
 175 (defun pelican-mode-remove-field (field)
 176   "Remove FIELD."
 177   (pelican-mode-set-field field nil))
 178
 179 (defun pelican-mode-set-title (title)
 180   "Set the title to TITLE."
 181   (interactive "sTitle: ")
 182   (pelican-mode-set-field :title title))
 183
 184 (defun pelican-mode-update-date ()
 185   "Update a Pelican date header."
 186   (interactive)
 187   (pelican-mode-set-field :date 'now))
 188
 189 (defun pelican-mode-publish-draft ()
 190   "Remove draft status from a Pelican article."
 191   (interactive)
 192   (pelican-mode-remove-field :status)
 193   (pelican-mode-update-date))
 194
 195 (defun pelican-mode-page-p ()
 196   "Return non-nil the current buffer is a Pelican page."
 197   (when-let (pelican-mode-base (pelican-mode-find-root))
 198     (let* ((relative (file-relative-name buffer-file-name pelican-mode-base))
 199            (components (split-string relative "/")))
 200       (equal "pages" (cadr components)))))
 201
 202 (defun pelican-mode-default-slug ()
 203   "Generate a Pelican article/page slug for the current buffer."
 204   (if-let ((pelican-mode-base (pelican-mode-find-root))
 205            (file-name (file-name-sans-extension buffer-file-name)))
 206       (let* ((relative (file-relative-name file-name pelican-mode-base))
 207              (components (cdr (split-string relative "/")))
 208              (components (if (string= "pages" (car components))
 209                              (cdr components) components)))
 210         (mapconcat 'identity components "/"))
 211     (when-let (file-name (file-name-sans-extension buffer-file-name))
 212       (file-name-base file-name))))
 213
 214 (defun pelican-mode-find-root ()
 215   "Return the root of the buffer's Pelican site, or nil."
 216   (locate-dominating-file default-directory "pelicanconf.py"))
 217
 218 (defun pelican-make (target)
 219   "Execute TARGET in a Makefile at the root of the site."
 220   (interactive "sMake Pelican target: ")
 221   (if-let (default-directory (pelican-mode-find-root))
 222       (compilation-start (format "make %s" target)
 223                          nil (lambda (_) "*pelican*"))
 224     (user-error "No Pelican site root could be found")))
 225
 226 (defun pelican-make-html ()
 227   "Generate HTML via a Makefile at the root of the site."
 228   (interactive)
 229   (pelican-make "html"))
 230
 231 (defun pelican-make-rsync-upload ()
 232   "Upload with rsync via a Makefile at the root of the site."
 233   (interactive)
 234   (pelican-make "rsync_upload"))
 235
 236 ;;;###autoload
 237 (define-minor-mode pelican-mode
 238   "Toggle Pelican mode.
 239 With a prefix argument ARG, enable Pelican mode if ARG is
 240 positive, and disable it otherwise.  If called from Lisp, enable
 241 the mode if ARG is omitted or nil.
 242
 243 Pelican is a static site generator which can process a variety of
 244 text file formats.  For more information, see URL
 245 https://blog.getpelican.com/.
 246
 247 When Pelican mode is enabled, additional commands are available
 248 for editing articles or pages:
 249
 250 \\{pelican-mode-map}"
 251   :lighter " Pelican"
 252   :keymap `((,(kbd "C-c P n") . pelican-mode-insert-auto-header)
 253             (,(kbd "C-c P p") . pelican-mode-publish-draft)
 254             (,(kbd "C-c P t") . pelican-mode-update-date)
 255             (,(kbd "C-c P h") . pelican-make-html)
 256             (,(kbd "C-c P u") . pelican-make-rsync-upload)))
 257
 258 ;;;###autoload
 259 (define-minor-mode pelican-global-mode
 260   "Toggle Pelican global mode.
 261 With a prefix argument ARG, enable Pelican global mode if ARG is
 262 positive, and disable it otherwise.  If called from Lisp, enable
 263 the mode if ARG is omitted or nil.
 264
 265 Pelican is a static site generator which can process a variety of
 266 text file formats.  For more information, see URL
 267 https://blog.getpelican.com/.
 268
 269 When Pelican global mode is enabled, text files which seem to
 270 be part of a Pelican site will have `pelican-mode' automatically
 271 enabled.
 272
 273 If you disable this, you may still enable `pelican-mode' manually
 274 or add `pelican-mode-enable-if-site' to more specific mode
 275 hooks."
 276   :global t
 277   :group 'pelican
 278   (if pelican-global-mode
 279       (add-hook 'text-mode-hook #'pelican-mode-enable-if-site)
 280     (remove-hook 'text-mode-hook #'pelican-mode-enable-if-site)))
 281
 282 ;;;###autoload
 283 (defun pelican-mode-enable-if-site ()
 284   "Enable `pelican-mode' if this buffer is part of a Pelican site."
 285   (when (pelican-mode-find-root)
 286     (pelican-mode 1)))
 287
 288 (provide 'pelican-mode)
 289 ;;; pelican-mode.el ends here
 290
 291 ;; Local Variables:
 292 ;; sentence-end-double-space: t
 293 ;; End: