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