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