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