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: 20170808
   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   :group 'pelican-mode
 146   :require 'pelican-mode
 147   :keymap pelican-mode-map
 148   :lighter " Pelican")
 149
 150 ;;;###autoload
 151 (define-globalized-minor-mode pelican-global-mode pelican-mode
 152   (lambda ()
 153     (when (derived-mode-p #'text-mode)
 154       (pelican-mode-enable-if-site)))
 155   :group 'pelican-mode
 156   :require 'pelican-mode)
 157
 158 ;;;###autoload
 159 (defun pelican-mode-enable-if-site ()
 160   "Enable `pelican-mode' if this buffer is part of a Pelican site.
 161
 162 Pelican sites are detected by looking for a file named `pelicanconf.py'
 163 in an ancestor directory."
 164   (when (pelican-mode-find-root)
 165     (pelican-mode)))
 166
 167 \f
 168
 169 ;; User Commands
 170
 171 (defun pelican-mode-set-field (field value)
 172   "Set FIELD to VALUE.
 173
 174 FIELD may be a string or a symbol; if it is a symbol, the
 175 symbol name is used (removing a leading ':' if present).
 176
 177 When called from Lisp, VALUE may be any value; except for the
 178 following special values, the unquoted printed representation of
 179 it is used:
 180
 181 - `now' means the current time.
 182
 183 - `slug' means the file's path relative to the document root sans
 184   extension; see `pelican-mode-default-slug'.
 185
 186 - nil or an empty string removes the field.
 187
 188 The buffer must be in a format listed in `pelican-mode-formats'
 189 for this function to work correctly."
 190   (interactive "sField: \nsValue: ")
 191   (setq value (pcase value
 192                 ('now (format-time-string "%Y-%m-%d %H:%M"))
 193                 ('slug (pelican-mode-default-slug))
 194                 ('"" nil)
 195                 (_ value)))
 196   (when (symbolp field)
 197     (setq field (string-remove-prefix ":" (symbol-name field))))
 198   (let ((set-field
 199          (assoc-default nil pelican-mode-formats #'derived-mode-p)))
 200     (unless set-field
 201       (error "Unsupported major mode %S" major-mode))
 202     (save-excursion
 203       (goto-char 0)
 204       (funcall set-field field value))))
 205
 206 (defun pelican-mode-remove-field (field)
 207   "Remove FIELD."
 208   (interactive "sField: ")
 209   (pelican-mode-set-field field nil))
 210
 211 (defun pelican-mode-set-title (title)
 212   "Set the title to TITLE."
 213   (interactive "sTitle: ")
 214   (pelican-mode-set-field :title title))
 215
 216 (defun pelican-mode-update-date (&optional original)
 217   "Update the document's modification date.
 218
 219 If ORIGINAL is non-nil, the publication date is updated rather
 220 than the modification date."
 221   (interactive "P")
 222   (pelican-mode-set-field (if original :date :modified) 'now))
 223
 224 (defun pelican-mode-publish ()
 225   "Remove draft or hidden status from a Pelican article."
 226   (interactive)
 227   (pelican-mode-remove-field :status)
 228   (pelican-mode-update-date :date))
 229
 230 (defun pelican-mode-insert-article-header (title tags)
 231   "Insert a Pelican header for an article with a TITLE and TAGS."
 232   (interactive "sArticle title: \nsTags: ")
 233   (save-excursion
 234     (goto-char 0)
 235     (insert "\n")
 236     (apply #'pelican-mode-set-fields
 237            `(:title ,title
 238              ,@pelican-mode-default-article-fields
 239              :tags ,tags))))
 240
 241 (defun pelican-mode-insert-page-header (title &optional hidden)
 242   "Insert a Pelican header for a page with a TITLE.
 243
 244 If HIDDEN is non-nil, the page is marked hidden; otherwise it
 245 has no status."
 246   (interactive "sPage title: \nP")
 247   (save-excursion
 248     (goto-char 0)
 249     (insert "\n")
 250     (apply #'pelican-mode-set-fields
 251            (append
 252             (list :title title :status (when hidden "hidden"))
 253             pelican-mode-default-page-fields))))
 254
 255 (defun pelican-mode-insert-header ()
 256   "Insert a Pelican header for a page or article."
 257   (interactive)
 258   (call-interactively
 259    (if (pelican-mode-page-p)
 260        #'pelican-mode-insert-page-header
 261      #'pelican-mode-insert-article-header)))
 262
 263 (defun pelican-make (target)
 264   "Execute TARGET in a Makefile at the root of the site."
 265   (interactive "sMake Pelican target: ")
 266   (if-let (default-directory (pelican-mode-find-root))
 267       (compilation-start (format "make %s" target)
 268                          nil (lambda (_) "*pelican*"))
 269     (user-error "No Pelican site root could be found")))
 270
 271 (defun pelican-make-html ()
 272   "Generate HTML via a Makefile at the root of the site."
 273   (interactive)
 274   (pelican-make "html"))
 275
 276 (defun pelican-make-rsync-upload ()
 277   "Upload with rsync via a Makefile at the root of the site."
 278   (interactive)
 279   (pelican-make "rsync_upload"))
 280
 281 \f
 282
 283 (defun pelican-mode-set-fields (&rest fields)
 284   "Insert a Pelican header for an article with metadata FIELDS."
 285   (mapc (apply-partially #'apply #'pelican-mode-set-field)
 286         (seq-partition fields 2)))
 287
 288 (defun pelican-mode-set-field-rst-mode (field value)
 289   "Set reStructuredText metadata FIELD to VALUE."
 290   (setq field (downcase field))
 291   (if (equal field "title")
 292       (let ((header (format "%s\n%s\n\n"
 293                             value (make-string (string-width value) ?#))))
 294         (if (looking-at ".*\n#+\n+")
 295             (replace-match header)
 296           (insert header)))
 297     (let ((text (when value (format ":%s: %s\n" field value))))
 298       (when (looking-at "^.*\n#")
 299         (forward-line 3))
 300       (if (re-search-forward (format "^:%s:.*\n" (regexp-quote field)) nil t)
 301           (replace-match (or text ""))
 302         (when text
 303           (if (re-search-forward "^$" nil t)
 304               (replace-match text)
 305             (insert text)))))))
 306
 307 (defun pelican-mode-set-field-markdown-mode (field value)
 308   "Set Markdown metadata FIELD to VALUE."
 309   (setq field (capitalize field))
 310   (let ((text (when value (format "%s: %s\n" field value))))
 311     (if (re-search-forward (format "^%s:.*\n" (regexp-quote field)) nil t)
 312         (replace-match text)
 313       (when value
 314         (if (re-search-forward "^$" nil t)
 315             (replace-match text)
 316           (insert text))))))
 317
 318 (defun pelican-mode-set-field-adoc-mode (field value)
 319   "Set AsciiDoc metadata FIELD to VALUE."
 320   (setq field (downcase field))
 321   (if (equal field "title")
 322       (let ((header (format "= %s\n\n" value)))
 323         (if (looking-at "= .*\n\n+")
 324             (replace-match header)
 325           (insert header)))
 326     (let ((text (when value (format ":%s: %s\n" field value))))
 327       (when (looking-at "^=")
 328         (forward-line 2))
 329       (if (re-search-forward (format "^:%s:.*\n" (regexp-quote field)) nil t)
 330           (replace-match (or text ""))
 331         (when text
 332           (if (re-search-forward "^$" nil t)
 333               (replace-match text)
 334             (insert text)))))))
 335
 336 (defun pelican-mode-set-field-org-mode (field value)
 337   "Set Org global metadata FIELD to VALUE."
 338   ;; None of org-mode's functions I can find for setting properties
 339   ;; operate on the global list, only a single property drawer.
 340   (setq field (upcase field))
 341   (setq field
 342         (format (if (member field '("TITLE" "DATE" "CATEGORY" "AUTHOR"))
 343                     "#+%s:"
 344                   "#+PROPERTY: %s")
 345                 field))
 346   (let ((text (when value (format "%s %s\n" field value))))
 347     (if (re-search-forward (format "^%s .*\n" (regexp-quote field)) nil t)
 348         (replace-match (or text ""))
 349       (when text
 350         (if (re-search-forward "^$" nil t)
 351             (replace-match text)
 352           (insert text))))))
 353
 354 (defun pelican-mode-page-p ()
 355   "Return non-nil the current buffer is a Pelican page."
 356   (string-match-p
 357    "^[^/]+/pages/"
 358    (file-relative-name
 359     (abbreviate-file-name (or (buffer-file-name) (buffer-name)))
 360     (pelican-mode-find-root))))
 361
 362 (defun pelican-mode-default-slug ()
 363   "Generate a Pelican slug for the current buffer."
 364   (file-name-sans-extension
 365    (replace-regexp-in-string
 366     "^[^/]+/\\(?:pages/\\)?" ""
 367     (file-relative-name
 368      (abbreviate-file-name (or (buffer-file-name) (buffer-name)))
 369      (pelican-mode-find-root)))))
 370
 371 (defun pelican-mode-find-root ()
 372   "Return the root of the buffer's Pelican site, or nil."
 373   (locate-dominating-file default-directory "pelicanconf.py"))
 374
 375 (provide 'pelican-mode)
 376 ;;; pelican-mode.el ends here
 377
 378 \f
 379
 380 ;; Local Variables:
 381 ;; sentence-end-double-space: t
 382 ;; End: