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