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 (URL http://getpelican.com/) sites.
  28 ;;
  29 ;; It's intended to be used alongside `markdown-mode' or `rst-mode'.
  30 ;; It also assumes you've set up Pelican with ``pelican-quickstart''
  31 ;; or something like it.  In particular it assumes:
  32 ;;
  33 ;;  * The existence of ``pelicanconf.py'' and ``Makefile'' in some
  34 ;;    ancestor directory.
  35 ;;  * The first component of the path (e.g. ``content'') after that
  36 ;;    ancestor is irrelevant.
  37 ;;  * If the next component is ``pages'', that indicates a page
  38 ;;    rather than an article.
  39
  40
  41 ;;; Code:
  42
  43 (require 'seq)
  44 (require 'subr-x)
  45
  46 (defgroup pelican-mode nil
  47   "Support for Pelican articles and pages."
  48   :group 'convenience)
  49
  50 (defcustom pelican-mode-default-page-fields
  51   '(:slug slug)
  52   "Fields to include when creating a new page.
  53
  54 See the documentation for `pelican-mode-set-field' for more information
  55 about metadata fields and special values."
  56   :group 'pelican
  57   :type '(plist))
  58
  59 (defcustom pelican-mode-default-article-fields
  60   '(:date now :status "draft" :slug slug)
  61   "Fields to include when creating a new article.
  62
  63 See the documentation for `pelican-mode-set-field' for more information
  64 about metadata fields and special values."
  65   :group 'pelican
  66   :type '(plist))
  67
  68 (defcustom pelican-mode-set-field-alist
  69   '((markdown-mode . pelican-mode-set-field-markdown-mode)
  70     (rst-mode . pelican-mode-set-field-rst-mode))
  71   "Functions to handle setting metadata, based on major mode.
  72
  73 This association list maps modes to functions that take two
  74 arguments, field and value strings."
  75   :group 'pelican
  76   :type '(alist :key-type function :value-type function))
  77
  78 (defun pelican-mode-timestamp (&optional time)
  79   "Generate a pelican-mode-compatible timestamp for TIME."
  80   (format-time-string "%Y-%m-%d %H:%M" time))
  81
  82 (defun pelican-mode-insert-header (&rest fields)
  83   "Insert a Pelican header for an article with metadata FIELDS."
  84   (mapc (apply-partially #'apply #'pelican-mode-set-field)
  85         (seq-partition fields 2)))
  86
  87 (defun pelican-mode-insert-draft-article-header (title tags)
  88   "Insert a Pelican header for a draft with a TITLE and TAGS."
  89   (interactive "sArticle title: \nsTags: ")
  90   (apply #'pelican-mode-insert-header
  91          `(:title ,title ,@pelican-mode-default-article-fields :tags ,tags)))
  92
  93 (defun pelican-mode-insert-page-header (title &optional hidden)
  94   "Insert a Pelican header for a page with a TITLE, potentially HIDDEN."
  95   (interactive
  96    (list (read-string "Page title: ")
  97          (y-or-n-p "Hidden? ")))
  98   (apply #'pelican-mode-insert-header
  99          `(:title ,title ,@pelican-mode-default-page-fields
 100                   :hidden ,(when hidden "hidden"))))
 101
 102 (defun pelican-mode-insert-auto-header ()
 103   "Insert a Pelican header for a page or article."
 104   (interactive)
 105   (call-interactively
 106    (if (pelican-mode-page-p)
 107        #'pelican-mode-insert-page-header
 108      #'pelican-mode-insert-draft-article-header)))
 109
 110 (defun pelican-mode-set-field-rst-mode (field value)
 111   "Set reStructuredText metadata FIELD to VALUE."
 112   (setq field (downcase field))
 113   (if (equal field "title")
 114       (let ((header (format "%s\n%s\n\n"
 115                             value (make-string (string-width value) ?#))))
 116         (if (looking-at ".*\n#+\n+")
 117             (replace-match header)
 118           (insert header)))
 119     (let ((text (when value (format ":%s: %s\n" field value))))
 120       (when (re-search-forward "^#" nil t)
 121         (forward-line 2))
 122       (if (re-search-forward (format "^:%s:.*\n" (regexp-quote field)) nil t)
 123           (replace-match (or text ""))
 124         (when text
 125           (if (re-search-forward "^$" nil t)
 126               (replace-match text)
 127             (insert text)))))))
 128
 129 (defun pelican-mode-set-field-markdown-mode (field value)
 130   "Set Markdown metadata FIELD to VALUE."
 131   (setq field (capitalize field))
 132   (let ((text (when value (format "%s: %s\n" field value))))
 133     (if (re-search-forward (format "^%s:.*\n" (regexp-quote field)) nil t)
 134         (replace-match text)
 135       (when value
 136         (if (re-search-forward "^$" nil t)
 137             (replace-match text)
 138           (insert text))))))
 139
 140 (defun pelican-mode-set-field (field value)
 141   "Set FIELD to VALUE.
 142
 143 FIELD may be a string or a symbol; if it is a symbol, the
 144 symbol name is used (removing a leading ':' if present).
 145
 146 VALUE may be any value; except for the following special values,
 147 the unquoted printed representation of it is used:
 148
 149 - `now' means the current time; see `pelican-mode-timestamp'.
 150
 151 - `slug' means the file's path relative to the document root sans
 152   extension; see `pelican-mode-default-slug'.
 153
 154 - nil or an empty string removes the field."
 155   (interactive "sField: \nsValue: ")
 156   (setq value (pcase value
 157                 ('now (pelican-mode-timestamp))
 158                 ('slug (pelican-mode-default-slug))
 159                 ('"" nil)
 160                 (_ value)))
 161   (when (symbolp field)
 162     (setq field (string-remove-prefix ":" (symbol-name field))))
 163   (let ((set-field
 164          (assoc-default nil pelican-mode-set-field-alist #'derived-mode-p)))
 165     (unless set-field
 166       (error "Unsupported major mode %S" major-mode))
 167     (save-excursion
 168       (goto-char 0)
 169       (funcall set-field field value))))
 170
 171 (defun pelican-mode-remove-field (field)
 172   "Remove FIELD."
 173   (pelican-mode-set-field field nil))
 174
 175 (defun pelican-mode-set-title (title)
 176   "Set the title to TITLE."
 177   (interactive "sTitle: ")
 178   (pelican-mode-set-field :title title))
 179
 180 (defun pelican-mode-update-date ()
 181   "Update a Pelican date header."
 182   (interactive)
 183   (pelican-mode-set-field :date 'now))
 184
 185 (defun pelican-mode-publish-draft ()
 186   "Remove draft status from a Pelican article."
 187   (interactive)
 188   (pelican-mode-remove-field :status)
 189   (pelican-mode-update-date))
 190
 191 (defun pelican-mode-page-p ()
 192   "Return non-nil the current buffer is a Pelican page."
 193   (when-let (pelican-mode-base (pelican-mode-find-root))
 194     (let* ((relative (file-relative-name buffer-file-name pelican-mode-base))
 195            (components (split-string relative "/")))
 196       (equal "pages" (cadr components)))))
 197
 198 (defun pelican-mode-default-slug ()
 199   "Generate a Pelican article/page slug for the current buffer."
 200   (if-let ((pelican-mode-base (pelican-mode-find-root))
 201            (file-name (file-name-sans-extension buffer-file-name)))
 202       (let* ((relative (file-relative-name file-name pelican-mode-base))
 203              (components (cdr (split-string relative "/")))
 204              (components (if (string= "pages" (car components))
 205                              (cdr components) components)))
 206         (mapconcat 'identity components "/"))
 207     (when-let (file-name (file-name-sans-extension buffer-file-name))
 208       (file-name-base file-name))))
 209
 210 (defun pelican-mode-find-in-parents (file-name)
 211   "Find FILE-NAME in the default directory or one of its parents, or nil."
 212   (let* ((parent (expand-file-name default-directory)))
 213     (while (and (not (file-readable-p (concat parent file-name)))
 214                 (not (string= parent (directory-file-name parent))))
 215       (setq parent (file-name-directory (directory-file-name parent))))
 216     (let ((found (concat parent file-name)))
 217       (if (file-readable-p found) found nil))))
 218
 219 (defun pelican-mode-find-root ()
 220   "Return the root of the buffer's Pelican site, or nil."
 221   (when-let (conf (pelican-mode-find-in-parents "pelicanconf.py"))
 222     (file-name-directory conf)))
 223
 224 (defun pelican-make (target)
 225   "Execute TARGET in a Makefile at the root of the site."
 226   (interactive "sMake Pelican target: ")
 227   (if-let (default-directory (pelican-mode-find-root))
 228       (compilation-start (format "make %s" target)
 229                          nil (lambda (_) "*pelican*"))
 230     (user-error "No Pelican site root could be found")))
 231
 232 (defun pelican-make-html ()
 233   "Generate HTML via a Makefile at the root of the site."
 234   (interactive)
 235   (pelican-make "html"))
 236
 237 (defun pelican-make-rsync-upload ()
 238   "Upload with rsync via a Makefile at the root of the site."
 239   (interactive)
 240   (pelican-make "rsync_upload"))
 241
 242 ;;;###autoload
 243 (define-minor-mode pelican-mode
 244   "Toggle Pelican mode.
 245 With a prefix argument ARG, enable Pelican mode if ARG is
 246 positive, and disable it otherwise.  If called from Lisp, enable
 247 the mode if ARG is omitted or nil.
 248
 249 When Pelican mode is enabled, additional commands are available
 250 for editing articles or pages:
 251
 252 \\{pelican-mode-map}"
 253   :lighter " Pelican"
 254   :keymap `((,(kbd "C-c P n") . pelican-mode-insert-auto-header)
 255             (,(kbd "C-c P p") . pelican-mode-publish-draft)
 256             (,(kbd "C-c P t") . pelican-mode-update-date)
 257             (,(kbd "C-c P h") . pelican-make-html)
 258             (,(kbd "C-c P u") . pelican-make-rsync-upload)))
 259
 260 ;;;###autoload
 261 (define-minor-mode pelican-global-mode
 262   "Toggle Pelican global mode.
 263 With a prefix argument ARG, enable Pelican global mode if ARG is
 264 positive, and disable it otherwise.  If called from Lisp, enable
 265 the mode if ARG is omitted or nil.
 266
 267 When Pelican global mode is enabled, text files which seem to
 268 be part of a Pelican site will have `pelican-mode' automatically
 269 enabled.
 270
 271 If you disable this, you may still enable `pelican-mode' manually
 272 or add `pelican-mode-enable-if-site' to more specific mode
 273 hooks."
 274   :global t
 275   :group 'pelican
 276   (if pelican-global-mode
 277       (add-hook 'text-mode-hook #'pelican-mode-enable-if-site)
 278     (remove-hook 'text-mode-hook #'pelican-mode-enable-if-site)))
 279
 280 ;;;###autoload
 281 (defun pelican-mode-enable-if-site ()
 282   "Enable `pelican-mode' if this buffer is part of a Pelican site."
 283   (when (pelican-mode-find-root)
 284     (pelican-mode 1)))
 285
 286 (provide 'pelican-mode)
 287 ;;; pelican-mode.el ends here
 288
 289 ;; Local Variables:
 290 ;; sentence-end-double-space: t
 291 ;; End: