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