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-insert-header (&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-insert-header
 105          `(:title ,title ,@pelican-mode-default-article-fields :tags ,tags)))
 106
 107 (defun pelican-mode-insert-page-header (title &optional hidden)
 108   "Insert a Pelican header for a page with a TITLE, potentially HIDDEN."
 109   (interactive
 110    (list (read-string "Page title: ")
 111          (y-or-n-p "Hidden? ")))
 112   (apply #'pelican-mode-insert-header
 113          `(:title ,title ,@pelican-mode-default-page-fields
 114                   :hidden ,(when hidden "hidden"))))
 115
 116 (defun pelican-mode-insert-auto-header ()
 117   "Insert a Pelican header for a page or article."
 118   (interactive)
 119   (call-interactively
 120    (if (pelican-mode-page-p)
 121        #'pelican-mode-insert-page-header
 122      #'pelican-mode-insert-draft-article-header)))
 123
 124 (defun pelican-mode-set-field-rst-mode (field value)
 125   "Set reStructuredText metadata FIELD to VALUE."
 126   (setq field (downcase field))
 127   (if (equal field "title")
 128       (let ((header (format "%s\n%s\n\n"
 129                             value (make-string (string-width value) ?#))))
 130         (if (looking-at ".*\n#+\n+")
 131             (replace-match header)
 132           (insert header)))
 133     (let ((text (when value (format ":%s: %s\n" field value))))
 134       (when (looking-at "^.*\n#")
 135         (forward-line 3))
 136       (if (re-search-forward (format "^:%s:.*\n" (regexp-quote field)) nil t)
 137           (replace-match (or text ""))
 138         (when text
 139           (if (re-search-forward "^$" nil t)
 140               (replace-match text)
 141             (insert text)))))))
 142
 143 (defun pelican-mode-set-field-markdown-mode (field value)
 144   "Set Markdown metadata FIELD to VALUE."
 145   (setq field (capitalize field))
 146   (let ((text (when value (format "%s: %s\n" field value))))
 147     (if (re-search-forward (format "^%s:.*\n" (regexp-quote field)) nil t)
 148         (replace-match text)
 149       (when value
 150         (if (re-search-forward "^$" nil t)
 151             (replace-match text)
 152           (insert text))))))
 153
 154 (defun pelican-mode-set-field-adoc-mode (field value)
 155   "Set AsciiDoc metadata FIELD to VALUE."
 156   (setq field (downcase field))
 157   (if (equal field "title")
 158       (let ((header (format "= %s\n\n" value)))
 159         (if (looking-at "= .*\n\n+")
 160             (replace-match header)
 161           (insert header)))
 162     (let ((text (when value (format ":%s: %s\n" field value))))
 163       (when (looking-at "^=")
 164         (forward-line 2))
 165       (if (re-search-forward (format "^:%s:.*\n" (regexp-quote field)) nil t)
 166           (replace-match (or text ""))
 167         (when text
 168           (if (re-search-forward "^$" nil t)
 169               (replace-match text)
 170             (insert text)))))))
 171
 172 (defun pelican-mode-set-field-org-mode (field value)
 173   "Set Org global metadata FIELD to VALUE."
 174   ;; None of org-mode's functions I can find for setting properties
 175   ;; operate on the global list, only a single property drawer.
 176   (setq field (upcase field))
 177   (setq field
 178         (format (if (member field '("TITLE" "DATE" "CATEGORY" "AUTHOR"))
 179                     "#+%s:"
 180                   "#+PROPERTY: %s")
 181                 field))
 182   (let ((text (when value (format "%s %s\n" field value))))
 183     (if (re-search-forward (format "^%s .*\n" (regexp-quote field)) nil t)
 184         (replace-match (or text ""))
 185       (when text
 186         (if (re-search-forward "^$" nil t)
 187             (replace-match text)
 188           (insert text))))))
 189
 190 (defun pelican-mode-set-field (field value)
 191   "Set FIELD to VALUE.
 192
 193 FIELD may be a string or a symbol; if it is a symbol, the
 194 symbol name is used (removing a leading ':' if present).
 195
 196 When called from Lisp, VALUE may be any value; except for the
 197 following special values, the unquoted printed representation of
 198 it is used:
 199
 200 - `now' means the current time; see `pelican-mode-timestamp'.
 201
 202 - `slug' means the file's path relative to the document root sans
 203   extension; see `pelican-mode-default-slug'.
 204
 205 - nil or an empty string removes the field.
 206
 207 The buffer must be in a format listed in `pelican-mode-formats'
 208 for this function to work correctly."
 209   (interactive "sField: \nsValue: ")
 210   (setq value (pcase value
 211                 ('now (pelican-mode-timestamp))
 212                 ('slug (pelican-mode-default-slug))
 213                 ('"" nil)
 214                 (_ value)))
 215   (when (symbolp field)
 216     (setq field (string-remove-prefix ":" (symbol-name field))))
 217   (let ((set-field
 218          (assoc-default nil pelican-mode-formats #'derived-mode-p)))
 219     (unless set-field
 220       (error "Unsupported major mode %S" major-mode))
 221     (save-excursion
 222       (goto-char 0)
 223       (funcall set-field field value))))
 224
 225 (defun pelican-mode-remove-field (field)
 226   "Remove FIELD."
 227   (pelican-mode-set-field field nil))
 228
 229 (defun pelican-mode-set-title (title)
 230   "Set the title to TITLE."
 231   (interactive "sTitle: ")
 232   (pelican-mode-set-field :title title))
 233
 234 (defun pelican-mode-update-date ()
 235   "Update a Pelican date header."
 236   (interactive)
 237   (pelican-mode-set-field :date 'now))
 238
 239 (defun pelican-mode-publish-draft ()
 240   "Remove draft status from a Pelican article."
 241   (interactive)
 242   (pelican-mode-remove-field :status)
 243   (pelican-mode-update-date))
 244
 245 (defun pelican-mode-page-p ()
 246   "Return non-nil the current buffer is a Pelican page."
 247   (when-let (pelican-mode-base (pelican-mode-find-root))
 248     (let* ((relative (file-relative-name buffer-file-name pelican-mode-base))
 249            (components (split-string relative "/")))
 250       (equal "pages" (cadr components)))))
 251
 252 (defun pelican-mode-default-slug ()
 253   "Generate a Pelican article/page slug for the current buffer."
 254   (if-let ((pelican-mode-base (pelican-mode-find-root))
 255            (file-name (file-name-sans-extension buffer-file-name)))
 256       (let* ((relative (file-relative-name file-name pelican-mode-base))
 257              (components (cdr (split-string relative "/")))
 258              (components (if (string= "pages" (car components))
 259                              (cdr components) components)))
 260         (mapconcat 'identity components "/"))
 261     (when-let (file-name (file-name-sans-extension buffer-file-name))
 262       (file-name-base file-name))))
 263
 264 (defun pelican-mode-find-root ()
 265   "Return the root of the buffer's Pelican site, or nil."
 266   (locate-dominating-file default-directory "pelicanconf.py"))
 267
 268 (defun pelican-make (target)
 269   "Execute TARGET in a Makefile at the root of the site."
 270   (interactive "sMake Pelican target: ")
 271   (if-let (default-directory (pelican-mode-find-root))
 272       (compilation-start (format "make %s" target)
 273                          nil (lambda (_) "*pelican*"))
 274     (user-error "No Pelican site root could be found")))
 275
 276 (defun pelican-make-html ()
 277   "Generate HTML via a Makefile at the root of the site."
 278   (interactive)
 279   (pelican-make "html"))
 280
 281 (defun pelican-make-rsync-upload ()
 282   "Upload with rsync via a Makefile at the root of the site."
 283   (interactive)
 284   (pelican-make "rsync_upload"))
 285
 286 ;;;###autoload
 287 (define-minor-mode pelican-mode
 288   "Toggle Pelican mode.
 289 With a prefix argument ARG, enable Pelican mode if ARG is
 290 positive, and disable it otherwise.  If called from Lisp, enable
 291 the mode if ARG is omitted or nil.
 292
 293 Pelican is a static site generator which can process a variety of
 294 text file formats.  For more information, see URL
 295 https://blog.getpelican.com/.
 296
 297 When Pelican mode is enabled, additional commands are available
 298 for editing articles or pages:
 299
 300 \\{pelican-mode-map}"
 301   :lighter " Pelican"
 302   :keymap `((,(kbd "C-c P n") . pelican-mode-insert-auto-header)
 303             (,(kbd "C-c P p") . pelican-mode-publish-draft)
 304             (,(kbd "C-c P t") . pelican-mode-update-date)
 305             (,(kbd "C-c P h") . pelican-make-html)
 306             (,(kbd "C-c P f") . pelican-set-field)
 307             (,(kbd "C-c P u") . pelican-make-rsync-upload)))
 308
 309 ;;;###autoload
 310 (define-minor-mode pelican-global-mode
 311   "Toggle Pelican global mode.
 312 With a prefix argument ARG, enable Pelican global mode if ARG is
 313 positive, and disable it otherwise.  If called from Lisp, enable
 314 the mode if ARG is omitted or nil.
 315
 316 Pelican is a static site generator which can process a variety of
 317 text file formats.  For more information, see URL
 318 https://blog.getpelican.com/.
 319
 320 When Pelican global mode is enabled, text files which seem to
 321 be part of a Pelican site will have `pelican-mode' automatically
 322 enabled.
 323
 324 If you disable this, you may still enable `pelican-mode' manually
 325 or add `pelican-mode-enable-if-site' to more specific mode
 326 hooks."
 327   :global t
 328   :group 'pelican-mode
 329   (if pelican-global-mode
 330       (add-hook 'text-mode-hook #'pelican-mode-enable-if-site)
 331     (remove-hook 'text-mode-hook #'pelican-mode-enable-if-site)))
 332
 333 ;;;###autoload
 334 (defun pelican-mode-enable-if-site ()
 335   "Enable `pelican-mode' if this buffer is part of a Pelican site."
 336   (when (pelican-mode-find-root)
 337     (pelican-mode 1)))
 338
 339 (provide 'pelican-mode)
 340 ;;; pelican-mode.el ends here
 341
 342 ;; Local Variables:
 343 ;; sentence-end-double-space: t
 344 ;; End: