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 ;; To enable by default on all text files in a Pelican site:
  43 ;;
  44 ;;     (require 'pelican-mode)
  45 ;;     (pelican-global-mode)
  46 ;;
  47 ;; Or, register `pelican-mode' or `pelican-mode-enable-if-site'
  48 ;; as hook functions for more direct control.
  49
  50
  51 ;;; Code:
  52
  53 (require 'seq)
  54 (require 'subr-x)
  55
  56 (defgroup pelican-mode nil
  57   "Support for Pelican articles and pages.
  58
  59 For more information about Pelican see URL https://blog.getpelican.com/."
  60   :group 'convenience)
  61
  62 (defcustom pelican-mode-default-page-fields
  63   '(:slug slug)
  64   "Fields to include when creating a new page.
  65
  66 See the documentation for `pelican-mode-set-field' for more information
  67 about metadata fields and special values."
  68   :group 'pelican-mode
  69   :type '(plist))
  70
  71 (defcustom pelican-mode-default-article-fields
  72   '(:date now :status "draft" :slug slug)
  73   "Fields to include when creating a new article.
  74
  75 See the documentation for `pelican-mode-set-field' for more information
  76 about metadata fields and special values."
  77   :group 'pelican-mode
  78   :type '(plist))
  79
  80 (defcustom pelican-mode-formats
  81   '((markdown-mode . pelican-mode-set-field-markdown-mode)
  82     (adoc-mode . pelican-mode-set-field-adoc-mode)
  83     (org-mode . pelican-mode-set-field-org-mode)
  84     (rst-mode . pelican-mode-set-field-rst-mode))
  85   "Functions to handle setting metadata, based on major mode.
  86
  87 This association list maps modes to functions that take two
  88 arguments, field and value strings."
  89   :group 'pelican-mode
  90   :type '(alist :key-type function :value-type function))
  91
  92 (defun pelican-mode-timestamp (&optional time)
  93   "Generate a pelican-mode-compatible timestamp for TIME."
  94   (format-time-string "%Y-%m-%d %H:%M" time))
  95
  96 (defun pelican-mode-set-fields (&rest fields)
  97   "Insert a Pelican header for an article with metadata FIELDS."
  98   (mapc (apply-partially #'apply #'pelican-mode-set-field)
  99         (seq-partition fields 2)))
 100
 101 (defun pelican-mode-insert-draft-article-header (title tags)
 102   "Insert a Pelican header for a draft with a TITLE and TAGS."
 103   (interactive "sArticle title: \nsTags: ")
 104   (apply #'pelican-mode-set-fields
 105          `(:title ,title
 106            ,@pelican-mode-default-article-fields
 107            :tags ,tags)))
 108
 109 (defun pelican-mode-insert-page-header (title &optional hidden)
 110   "Insert a Pelican header for a page with a TITLE.
 111
 112 If HIDDEN is non-nil, the page is marked hidden; otherwise it
 113 has no status."
 114   (interactive "sPage title: \nP")
 115   (apply #'pelican-mode-set-fields
 116          (append
 117           (list :title title :status (when hidden "hidden"))
 118           pelican-mode-default-page-fields)))
 119
 120 (defun pelican-mode-insert-header ()
 121   "Insert a Pelican header for a page or article."
 122   (interactive)
 123   (call-interactively
 124    (if (pelican-mode-page-p)
 125        #'pelican-mode-insert-page-header
 126      #'pelican-mode-insert-draft-article-header)))
 127
 128 (defun pelican-mode-set-field-rst-mode (field value)
 129   "Set reStructuredText metadata FIELD to VALUE."
 130   (setq field (downcase field))
 131   (if (equal field "title")
 132       (let ((header (format "%s\n%s\n\n"
 133                             value (make-string (string-width value) ?#))))
 134         (if (looking-at ".*\n#+\n+")
 135             (replace-match header)
 136           (insert header)))
 137     (let ((text (when value (format ":%s: %s\n" field value))))
 138       (when (looking-at "^.*\n#")
 139         (forward-line 3))
 140       (if (re-search-forward (format "^:%s:.*\n" (regexp-quote field)) nil t)
 141           (replace-match (or text ""))
 142         (when text
 143           (if (re-search-forward "^$" nil t)
 144               (replace-match text)
 145             (insert text)))))))
 146
 147 (defun pelican-mode-set-field-markdown-mode (field value)
 148   "Set Markdown metadata FIELD to VALUE."
 149   (setq field (capitalize field))
 150   (let ((text (when value (format "%s: %s\n" field value))))
 151     (if (re-search-forward (format "^%s:.*\n" (regexp-quote field)) nil t)
 152         (replace-match text)
 153       (when value
 154         (if (re-search-forward "^$" nil t)
 155             (replace-match text)
 156           (insert text))))))
 157
 158 (defun pelican-mode-set-field-adoc-mode (field value)
 159   "Set AsciiDoc metadata FIELD to VALUE."
 160   (setq field (downcase field))
 161   (if (equal field "title")
 162       (let ((header (format "= %s\n\n" value)))
 163         (if (looking-at "= .*\n\n+")
 164             (replace-match header)
 165           (insert header)))
 166     (let ((text (when value (format ":%s: %s\n" field value))))
 167       (when (looking-at "^=")
 168         (forward-line 2))
 169       (if (re-search-forward (format "^:%s:.*\n" (regexp-quote field)) nil t)
 170           (replace-match (or text ""))
 171         (when text
 172           (if (re-search-forward "^$" nil t)
 173               (replace-match text)
 174             (insert text)))))))
 175
 176 (defun pelican-mode-set-field-org-mode (field value)
 177   "Set Org global metadata FIELD to VALUE."
 178   ;; None of org-mode's functions I can find for setting properties
 179   ;; operate on the global list, only a single property drawer.
 180   (setq field (upcase field))
 181   (setq field
 182         (format (if (member field '("TITLE" "DATE" "CATEGORY" "AUTHOR"))
 183                     "#+%s:"
 184                   "#+PROPERTY: %s")
 185                 field))
 186   (let ((text (when value (format "%s %s\n" field value))))
 187     (if (re-search-forward (format "^%s .*\n" (regexp-quote field)) nil t)
 188         (replace-match (or text ""))
 189       (when text
 190         (if (re-search-forward "^$" nil t)
 191             (replace-match text)
 192           (insert text))))))
 193
 194 (defun pelican-mode-set-field (field value)
 195   "Set FIELD to VALUE.
 196
 197 FIELD may be a string or a symbol; if it is a symbol, the
 198 symbol name is used (removing a leading ':' if present).
 199
 200 When called from Lisp, VALUE may be any value; except for the
 201 following special values, the unquoted printed representation of
 202 it is used:
 203
 204 - `now' means the current time; see `pelican-mode-timestamp'.
 205
 206 - `slug' means the file's path relative to the document root sans
 207   extension; see `pelican-mode-default-slug'.
 208
 209 - nil or an empty string removes the field.
 210
 211 The buffer must be in a format listed in `pelican-mode-formats'
 212 for this function to work correctly."
 213   (interactive "sField: \nsValue: ")
 214   (setq value (pcase value
 215                 ('now (pelican-mode-timestamp))
 216                 ('slug (pelican-mode-default-slug))
 217                 ('"" nil)
 218                 (_ value)))
 219   (when (symbolp field)
 220     (setq field (string-remove-prefix ":" (symbol-name field))))
 221   (let ((set-field
 222          (assoc-default nil pelican-mode-formats #'derived-mode-p)))
 223     (unless set-field
 224       (error "Unsupported major mode %S" major-mode))
 225     (save-excursion
 226       (goto-char 0)
 227       (funcall set-field field value))))
 228
 229 (defun pelican-mode-remove-field (field)
 230   "Remove FIELD."
 231   (pelican-mode-set-field field nil))
 232
 233 (defun pelican-mode-set-title (title)
 234   "Set the title to TITLE."
 235   (interactive "sTitle: ")
 236   (pelican-mode-set-field :title title))
 237
 238 (defun pelican-mode-update-date ()
 239   "Update a Pelican date header."
 240   (interactive)
 241   (pelican-mode-set-field :date 'now))
 242
 243 (defun pelican-mode-publish-draft ()
 244   "Remove draft status from a Pelican article."
 245   (interactive)
 246   (pelican-mode-remove-field :status)
 247   (pelican-mode-update-date))
 248
 249 (defun pelican-mode-page-p ()
 250   "Return non-nil the current buffer is a Pelican page."
 251   (when-let (pelican-mode-base (pelican-mode-find-root))
 252     (let* ((relative (file-relative-name buffer-file-name pelican-mode-base))
 253            (components (split-string relative "/")))
 254       (equal "pages" (cadr components)))))
 255
 256 (defun pelican-mode-default-slug ()
 257   "Generate a Pelican article/page slug for the current buffer."
 258   (if-let ((pelican-mode-base (pelican-mode-find-root))
 259            (file-name (file-name-sans-extension buffer-file-name)))
 260       (let* ((relative (file-relative-name file-name pelican-mode-base))
 261              (components (cdr (split-string relative "/")))
 262              (components (if (string= "pages" (car components))
 263                              (cdr components) components)))
 264         (mapconcat 'identity components "/"))
 265     (when-let (file-name (file-name-sans-extension buffer-file-name))
 266       (file-name-base file-name))))
 267
 268 (defun pelican-mode-find-root ()
 269   "Return the root of the buffer's Pelican site, or nil."
 270   (locate-dominating-file default-directory "pelicanconf.py"))
 271
 272 (defun pelican-make (target)
 273   "Execute TARGET in a Makefile at the root of the site."
 274   (interactive "sMake Pelican target: ")
 275   (if-let (default-directory (pelican-mode-find-root))
 276       (compilation-start (format "make %s" target)
 277                          nil (lambda (_) "*pelican*"))
 278     (user-error "No Pelican site root could be found")))
 279
 280 (defun pelican-make-html ()
 281   "Generate HTML via a Makefile at the root of the site."
 282   (interactive)
 283   (pelican-make "html"))
 284
 285 (defun pelican-make-rsync-upload ()
 286   "Upload with rsync via a Makefile at the root of the site."
 287   (interactive)
 288   (pelican-make "rsync_upload"))
 289
 290 ;;;###autoload
 291 (define-minor-mode pelican-mode
 292   "Toggle Pelican mode.
 293 With a prefix argument ARG, enable Pelican mode if ARG is
 294 positive, and disable it otherwise.  If called from Lisp, enable
 295 the mode if ARG is omitted or nil.
 296
 297 Pelican is a static site generator which can process a variety of
 298 text file formats.  For more information, see URL
 299 https://blog.getpelican.com/.
 300
 301 Rather than manually enabling this mode, you may wish to use
 302 `pelican-global-mode' or `pelican-mode-enable-if-site'.
 303
 304 When Pelican mode is enabled, additional commands are available
 305 for editing articles or pages:
 306
 307 \\{pelican-mode-map}"
 308   :lighter " Pelican"
 309   :keymap `((,(kbd "C-c P f") . pelican-set-field)
 310             (,(kbd "C-c P h") . pelican-make-html)
 311             (,(kbd "C-c P n") . pelican-mode-insert-header)
 312             (,(kbd "C-c P p") . pelican-mode-publish-draft)
 313             (,(kbd "C-c P t") . pelican-mode-update-date)
 314             (,(kbd "C-c P u") . pelican-make-rsync-upload)))
 315
 316 ;;;###autoload
 317 (define-minor-mode pelican-global-mode
 318   "Toggle Pelican global mode.
 319 With a prefix argument ARG, enable Pelican global mode if ARG is
 320 positive, and disable it otherwise.  If called from Lisp, enable
 321 the mode if ARG is omitted or nil.
 322
 323 Pelican is a static site generator which can process a variety of
 324 text file formats.  For more information, see URL
 325 https://blog.getpelican.com/.
 326
 327 When Pelican global mode is enabled, text files which seem to
 328 be part of a Pelican site will have `pelican-mode' automatically
 329 enabled.
 330
 331 If you disable this, you may still enable `pelican-mode' manually
 332 or add `pelican-mode-enable-if-site' to more specific mode
 333 hooks."
 334   :global t
 335   :group 'pelican-mode
 336   (if pelican-global-mode
 337       (add-hook 'text-mode-hook #'pelican-mode-enable-if-site)
 338     (remove-hook 'text-mode-hook #'pelican-mode-enable-if-site)))
 339
 340 ;;;###autoload
 341 (defun pelican-mode-enable-if-site ()
 342   "Enable `pelican-mode' if this buffer is part of a Pelican site."
 343   (when (pelican-mode-find-root)
 344     (pelican-mode 1)))
 345
 346 (provide 'pelican-mode)
 347 ;;; pelican-mode.el ends here
 348
 349 ;; Local Variables:
 350 ;; sentence-end-double-space: t
 351 ;; End: