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: 20170618
   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
  36 (defun pelican-timestamp (&optional time)
  37   "Generate a Pelican-compatible timestamp for TIME."
  38   (format-time-string "%Y-%m-%d %H:%M" time))
  39
  40 (defun pelican-field (name value)
  41   "Format a line for a field NAME with a VALUE.
  42
  43 NAME may be a string or a symbol; if it is a symbol, the
  44 symbol name is used (removing a leading ':' if present).
  45
  46 VALUE may be any value; except for the following special values,
  47 the unquoted printed representation of it is used:
  48
  49 - `now' means the current time; see `pelican-timestamp'.
  50
  51 - `slug' means the file's path relative to the document root sans
  52   extension; see `pelican-default-slug'.
  53
  54 - nil or an empty strings means return an empty string, without
  55   any name or value."
  56   (setq value (pcase value
  57                 ('now (pelican-timestamp))
  58                 ('slug (pelican-default-slug))
  59                 ('"" nil)
  60                 (_ value)))
  61   (when (symbolp name)
  62     (setq name (string-remove-prefix ":" (symbol-name name))))
  63   (if value
  64       (cond ((derived-mode-p 'markdown-mode)
  65              (format "%s: %s\n" (capitalize name) value))
  66             ((derived-mode-p 'rst-mode)
  67              (format ":%s: %s\n" (downcase name) value))
  68             (t (error "Unsupported major mode %S" major-mode)))
  69     ""))
  70
  71 (defun pelican-rst-title (title)
  72   "Create a ReSt version of TITLE."
  73   (concat title "\n" (make-string (string-width title) ?#) "\n\n"))
  74
  75 (defun pelican-title (title)
  76   "Format a TITLE for the current document, according to major mode."
  77   (cond ((derived-mode-p 'markdown-mode)
  78          (pelican-field "title" title))
  79         ((derived-mode-p 'rst-mode)
  80          (pelican-rst-title title))
  81         (t (error "Unsupported major mode %S" major-mode))))
  82
  83 (defun pelican-header (title &rest fields)
  84   "Generate a Pelican header for a post with a TITLE and metadata FIELDS."
  85   (concat (pelican-title title)
  86           (mapconcat (apply-partially #'apply #'pelican-field)
  87                      (seq-partition fields 2) "")
  88           "\n"))
  89
  90 (defun pelican-insert-header (title &rest fields)
  91   "Insert a Pelican header for a post with a TITLE and metadata FIELDS."
  92   (save-excursion
  93     (goto-char 0)
  94     (insert (apply #'pelican-header (cons title fields)))))
  95
  96 (defun pelican-insert-draft-post-header (title tags)
  97   "Insert a Pelican header for a draft with a TITLE and TAGS."
  98   (interactive "sPost title: \nsTags: ")
  99   (save-excursion
 100     (goto-char 0)
 101     (insert (pelican-header title
 102                             :date 'now
 103                             :status "draft"
 104                             :tags tags
 105                             :slug 'slug))))
 106
 107 (defun pelican-insert-page-header (title &optional hidden)
 108   "Insert a Pelican header for a page with a TITLE, potentially HIDDEN."
 109   (interactive
 110    (list (read-string "Page title: ")
 111          (y-or-n-p "Hidden? ")))
 112   (save-excursion
 113     (goto-char 0)
 114     (insert (pelican-header title
 115                             :status (when hidden "hidden")
 116                             :slug 'slug))))
 117
 118 (defun pelican-insert-auto-header ()
 119   "Insert a Pelican header for a page or post."
 120   (interactive)
 121   (call-interactively (if (pelican-page-p)
 122                           'pelican-insert-page-header
 123                         'pelican-insert-draft-post-header)))
 124
 125 (defun pelican-set-field (field value)
 126   "Set FIELD to VALUE."
 127   (interactive "sField: \nsValue: ")
 128   (save-excursion
 129     (goto-char 0)
 130     (when (and (derived-mode-p 'rst-mode)
 131                (re-search-forward "^#" nil t))
 132       (forward-line 2))
 133     (if (re-search-forward (concat "^" (pelican-field field ".+*")) nil t)
 134         (replace-match (pelican-field field value))
 135       (when value
 136         (re-search-forward "^$")
 137         (replace-match (pelican-field field value))))))
 138
 139 (defun pelican-remove-field (field)
 140   "Remove FIELD."
 141   (pelican-set-field field nil))
 142
 143 (defun pelican-set-title (title)
 144   "Set the title to TITLE."
 145   (interactive "sTitle: ")
 146   (if (derived-mode-p 'markdown-mode)
 147       (pelican-set-field "title" title)
 148     (save-excursion
 149       (goto-char 0)
 150       (let ((header (pelican-rst-title title)))
 151         (if (looking-at ".*\n#+\n+")
 152             (replace-match header)
 153           (insert header))))))
 154
 155 (defun pelican-update-date ()
 156   "Update a Pelican date header."
 157   (interactive)
 158   (pelican-set-field :date 'now))
 159
 160 (defun pelican-publish-draft ()
 161   "Remove draft status from a Pelican post."
 162   (interactive)
 163   (pelican-remove-field :status)
 164   (pelican-update-date))
 165
 166 (defun pelican-page-p ()
 167   "Guess the current buffer is a Pelican page (vs. a post or neither)."
 168   (when-let (pelican-base (pelican-find-root))
 169     (let* ((relative (file-relative-name buffer-file-name pelican-base))
 170            (components (split-string relative "/")))
 171       (equal "pages" (cadr components)))))
 172
 173 (defun pelican-default-slug ()
 174   "Generate a Pelican post/page slug for the current buffer."
 175   (if-let ((pelican-base (pelican-find-root))
 176            (file-name (file-name-sans-extension buffer-file-name)))
 177       (let* ((relative (file-relative-name file-name pelican-base))
 178              (components (cdr (split-string relative "/")))
 179              (components (if (string= "pages" (car components))
 180                              (cdr components) components)))
 181         (mapconcat 'identity components "/"))
 182     (format "%s/%s"
 183             (file-name-nondirectory
 184              (directory-file-name
 185               (file-name-directory file-name)))
 186             (file-name-base file-name))))
 187
 188 (defun pelican-find-in-parents (file-name)
 189   "Find FILE-NAME in the default directory or one of its parents, or nil."
 190   (let* ((parent (expand-file-name default-directory)))
 191     (while (and (not (file-readable-p (concat parent file-name)))
 192                 (not (string= parent (directory-file-name parent))))
 193       (setq parent (file-name-directory (directory-file-name parent))))
 194     (let ((found (concat parent file-name)))
 195       (if (file-readable-p found) found nil))))
 196
 197 (defun pelican-find-root ()
 198   "Return the root of the buffer's Pelican site, or nil."
 199   (when-let (conf (pelican-find-in-parents "pelicanconf.py"))
 200     (file-name-directory conf)))
 201
 202 (defun pelican-site-p ()
 203   "Check if this buffer is under a Pelican site."
 204   (not (null (pelican-find-root))))
 205
 206 (defun pelican-make (target)
 207   "Execute TARGET in a Makefile at the root of the site."
 208   (interactive "sMake Pelican target: ")
 209   (if-let (default-directory (pelican-find-root))
 210       (compilation-start (format "make %s" target)
 211                          nil (lambda (_) "*pelican*"))
 212     (message "This doesn't look like a Pelican site.")))
 213
 214 (defun pelican-make-html ()
 215   "Generate HTML via a Makefile at the root of the site."
 216   (interactive)
 217   (pelican-make "html"))
 218
 219 (defun pelican-make-rsync-upload ()
 220   "Upload with rsync via a Makefile at the root of the site."
 221   (interactive)
 222   (pelican-make "rsync_upload"))
 223
 224 ;;;###autoload
 225 (define-minor-mode pelican-mode
 226   "Toggle Pelican mode.
 227
 228 Interactively with no argument, this command toggles the mode.
 229 for editing Pelican site files."
 230   :lighter " Pelican"
 231   :group 'pelican
 232   :keymap `((,(kbd "C-c P n") . pelican-insert-auto-header)
 233             (,(kbd "C-c P p") . pelican-publish-draft)
 234             (,(kbd "C-c P t") . pelican-update-date)
 235             (,(kbd "C-c P h") . pelican-make-html)
 236             (,(kbd "C-c P u") . pelican-make-rsync-upload)))
 237
 238 ;;;###autoload
 239 (defun pelican-enable-if-site ()
 240   "Enable `pelican-mode' if this buffer is under a Pelican site."
 241   (when (pelican-site-p)
 242     (pelican-mode 1)))
 243
 244 ;;;###autoload
 245 (add-hook 'markdown-mode-hook 'pelican-enable-if-site)
 246
 247 ;;;###autoload
 248 (add-hook 'rst-mode-hook 'pelican-enable-if-site)
 249
 250 (provide 'pelican-mode)
 251 ;;; pelican-mode.el ends here