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