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