pelican-mode.el

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