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 posts 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-field' for more information
  44 about metadata fields and special values."
  45   :group 'pelican-mode
  46   :type '(plist))
  47
  48 (defcustom pelican-mode-default-post-fields
  49   '(:date now :status "draft" :slug slug)
  50   "Fields to include when creating a new post.
  51
  52 See the documentation for `pelican-field' for more information
  53 about metadata fields and special values."
  54   :group 'pelican-mode
  55   :type '(plist))
  56
  57 (defun pelican-timestamp (&optional time)
  58   "Generate a Pelican-compatible timestamp for TIME."
  59   (format-time-string "%Y-%m-%d %H:%M" time))
  60
  61 (defun pelican-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-timestamp'.
  71
  72 - `slug' means the file's path relative to the document root sans
  73   extension; see `pelican-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-timestamp))
  79                 ('slug (pelican-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-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-title (title)
  97   "Format a TITLE for the current document, according to major mode."
  98   (cond ((derived-mode-p 'markdown-mode)
  99          (pelican-field "title" title))
 100         ((derived-mode-p 'rst-mode)
 101          (pelican-rst-title title))
 102         (t (error "Unsupported major mode %S" major-mode))))
 103
 104 (defun pelican-header (title &rest fields)
 105   "Generate a Pelican header for a post with a TITLE and metadata FIELDS."
 106   (concat (pelican-title title)
 107           (mapconcat (apply-partially #'apply #'pelican-field)
 108                      (seq-partition fields 2) "")
 109           "\n"))
 110
 111 (defun pelican-insert-header (title &rest fields)
 112   "Insert a Pelican header for a post with a TITLE and metadata FIELDS."
 113   (save-excursion
 114     (goto-char 0)
 115     (insert (apply #'pelican-header (cons title fields)))))
 116
 117 (defun pelican-insert-draft-post-header (title tags)
 118   "Insert a Pelican header for a draft with a TITLE and TAGS."
 119   (interactive "sPost title: \nsTags: ")
 120   (apply #'pelican-insert-header
 121          `(,title ,@pelican-mode-default-post-fields :tags ,tags)))
 122
 123 (defun pelican-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-insert-header
 129          `(,title ,@pelican-mode-default-page-fields
 130                   :hidden ,(when hidden "hidden"))))
 131
 132 (defun pelican-insert-auto-header ()
 133   "Insert a Pelican header for a page or post."
 134   (interactive)
 135   (call-interactively
 136    (if (pelican-page-p)
 137        #'pelican-insert-page-header
 138      #'pelican-insert-draft-post-header)))
 139
 140 (defun pelican-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-field field ".+*")) nil t)
 149         (replace-match (pelican-field field value))
 150       (when value
 151         (re-search-forward "^$")
 152         (replace-match (pelican-field field value))))))
 153
 154 (defun pelican-remove-field (field)
 155   "Remove FIELD."
 156   (pelican-set-field field nil))
 157
 158 (defun pelican-set-title (title)
 159   "Set the title to TITLE."
 160   (interactive "sTitle: ")
 161   (if (derived-mode-p 'markdown-mode)
 162       (pelican-set-field "title" title)
 163     (save-excursion
 164       (goto-char 0)
 165       (let ((header (pelican-rst-title title)))
 166         (if (looking-at ".*\n#+\n+")
 167             (replace-match header)
 168           (insert header))))))
 169
 170 (defun pelican-update-date ()
 171   "Update a Pelican date header."
 172   (interactive)
 173   (pelican-set-field :date 'now))
 174
 175 (defun pelican-publish-draft ()
 176   "Remove draft status from a Pelican post."
 177   (interactive)
 178   (pelican-remove-field :status)
 179   (pelican-update-date))
 180
 181 (defun pelican-page-p ()
 182   "Guess the current buffer is a Pelican page (vs. a post or neither)."
 183   (when-let (pelican-base (pelican-find-root))
 184     (let* ((relative (file-relative-name buffer-file-name pelican-base))
 185            (components (split-string relative "/")))
 186       (equal "pages" (cadr components)))))
 187
 188 (defun pelican-default-slug ()
 189   "Generate a Pelican post/page slug for the current buffer."
 190   (if-let ((pelican-base (pelican-find-root))
 191            (file-name (file-name-sans-extension buffer-file-name)))
 192       (let* ((relative (file-relative-name file-name pelican-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-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-find-root ()
 213   "Return the root of the buffer's Pelican site, or nil."
 214   (when-let (conf (pelican-find-in-parents "pelicanconf.py"))
 215     (file-name-directory conf)))
 216
 217 (defun pelican-site-p ()
 218   "Check if this buffer is under a Pelican site."
 219   (not (null (pelican-find-root))))
 220
 221 (defun pelican-make (target)
 222   "Execute TARGET in a Makefile at the root of the site."
 223   (interactive "sMake Pelican target: ")
 224   (if-let (default-directory (pelican-find-root))
 225       (compilation-start (format "make %s" target)
 226                          nil (lambda (_) "*pelican*"))
 227     (user-error "This doesn't look like a Pelican site")))
 228
 229 (defun pelican-make-html ()
 230   "Generate HTML via a Makefile at the root of the site."
 231   (interactive)
 232   (pelican-make "html"))
 233
 234 (defun pelican-make-rsync-upload ()
 235   "Upload with rsync via a Makefile at the root of the site."
 236   (interactive)
 237   (pelican-make "rsync_upload"))
 238
 239 ;;;###autoload
 240 (define-minor-mode pelican-mode
 241   "Toggle Pelican mode.
 242
 243 Interactively with no argument, this command toggles the mode.
 244 for editing Pelican site files."
 245   :lighter " Pelican"
 246   :group 'pelican
 247   :keymap `((,(kbd "C-c P n") . pelican-insert-auto-header)
 248             (,(kbd "C-c P p") . pelican-publish-draft)
 249             (,(kbd "C-c P t") . pelican-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 (defun pelican-enable-if-site ()
 255   "Enable `pelican-mode' if this buffer is under a Pelican site."
 256   (when (pelican-site-p)
 257     (pelican-mode 1)))
 258
 259 ;;;###autoload
 260 (add-hook 'markdown-mode-hook 'pelican-enable-if-site)
 261
 262 ;;;###autoload
 263 (add-hook 'rst-mode-hook 'pelican-enable-if-site)
 264
 265 (provide 'pelican-mode)
 266 ;;; pelican-mode.el ends here