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