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 'subr-x)
  33
  34 (defun pelican-timestamp (&optional time)
  35   "Generate a Pelican-compatible timestamp for TIME."
  36   (format-time-string "%Y-%m-%d %H:%M" time))
  37
  38 (defun pelican-is-markdown ()
  39   "Check if the buffer is likely using Markdown."
  40   (derived-mode-p 'markdown-mode))
  41
  42 (defun pelican-field (name value)
  43   "Format a line for a field NAME with a VALUE."
  44   (if value
  45       (cond ((derived-mode-p 'markdown-mode)
  46              (format "%s: %s\n" (capitalize name) value))
  47             ((derived-mode-p 'rst-mode)
  48              (format ":%s: %s\n" (downcase name) value))
  49             (t (error "Unsupported major mode %S" major-mode)))
  50     ""))
  51
  52 (defun pelican-title (title)
  53   "Format a TITLE for the current document, according to major mode."
  54   (cond ((derived-mode-p 'markdown-mode)
  55          (pelican-field "title" title))
  56         ((derived-mode-p 'rst-mode)
  57          (concat title "\n" (make-string (string-width title) ?#) "\n"))
  58         (t (error "Unsupported major mode %S" major-mode))))
  59
  60 (defun pelican-header (title date status category tags slug)
  61   "Create a Pelican header."
  62   ;; TODO: Use a property list (-> alist via seq-partition) instead.
  63   (when (eq date t)
  64     (setq date (pelican-timestamp)))
  65
  66   (concat (pelican-title title)
  67           (pelican-field "date" date)
  68           (pelican-field "status" status)
  69           (pelican-field "tags" tags)
  70           (pelican-field "category" category)
  71           (pelican-field "slug" slug)
  72           "\n"))
  73
  74 (defun pelican-insert-draft-post-header (title tags)
  75   "Insert a Pelican header for a draft post."
  76   (interactive "sPost title: \nsTags: ")
  77   (let ((slug (pelican-default-slug)))
  78     (save-excursion
  79       (goto-char 0)
  80       (insert (pelican-header title 't "draft" nil tags slug)))))
  81
  82 (defun pelican-insert-page-header (title hidden)
  83   "Insert a Pelican header for a page."
  84   (interactive
  85    (list (read-string "Page title: ")
  86          (y-or-n-p "Hidden? ")))
  87   (let ((slug (pelican-default-slug))
  88         (hidden (if hidden "hidden" nil)))
  89     (save-excursion
  90       (goto-char 0)
  91       (insert (pelican-header title nil hidden nil nil slug)))))
  92
  93 (defun pelican-insert-header ()
  94   "Insert a Pelican header for a page or post."
  95   (interactive)
  96   (call-interactively (if (pelican-is-page)
  97                           'pelican-insert-page-header
  98                         'pelican-insert-draft-post-header)))
  99
 100 (defun pelican-set-field (field value)
 101   "Set FIELD to VALUE."
 102   (save-excursion
 103     (goto-char 0)
 104     (if (re-search-forward (concat "^" (pelican-field field ".+*")) nil t)
 105         (replace-match (pelican-field field value))
 106       (re-search-forward "^$")
 107       (replace-match (pelican-field field value)))))
 108
 109 (defun pelican-update-date ()
 110   "Update a Pelican date header."
 111   (interactive)
 112   (pelican-set-field "date" (pelican-timestamp)))
 113
 114 (defun pelican-publish-draft ()
 115   "Remove draft status from a Pelican post."
 116   (interactive)
 117   (pelican-set-field "status" nil)
 118   (pelican-update-date))
 119
 120 (defun pelican-is-page ()
 121   "Guess the current buffer is a Pelican page (vs. a post or neither)."
 122   (when-let (pelican-base (pelican-find-root))
 123     (let* ((relative (file-relative-name buffer-file-name pelican-base))
 124            (components (split-string relative "/")))
 125       (equal "pages" (cadr components)))))
 126
 127 (defun pelican-default-slug ()
 128   "Generate a Pelican post/page slug for the current buffer."
 129   (if-let ((pelican-base (pelican-find-root))
 130            (file-name (file-name-sans-extension buffer-file-name)))
 131       (let* ((relative (file-relative-name file-name pelican-base))
 132              (components (cdr (split-string relative "/")))
 133              (components (if (string= "pages" (car components))
 134                              (cdr components) components)))
 135         (mapconcat 'identity components "/"))
 136     (format "%s/%s"
 137             (file-name-nondirectory
 138              (directory-file-name
 139               (file-name-directory file-name)))
 140             (file-name-base file-name))))
 141
 142 (defun pelican-find-in-parents (file-name)
 143   "Find FILE-NAME in the default directory or one of its parents, or nil."
 144   (let* ((parent (expand-file-name default-directory)))
 145     (while (and (not (file-readable-p (concat parent file-name)))
 146                 (not (string= parent (directory-file-name parent))))
 147       (setq parent (file-name-directory (directory-file-name parent))))
 148     (let ((found (concat parent file-name)))
 149       (if (file-readable-p found) found nil))))
 150
 151 (defun pelican-find-root ()
 152   "Return the root of the buffer's Pelican site, or nil."
 153   (when-let (conf (pelican-find-in-parents "pelicanconf.py"))
 154     (file-name-directory conf)))
 155
 156 (defun pelican-is-in-site ()
 157   "Check if this buffer is under a Pelican site."
 158   (not (null (pelican-find-root))))
 159
 160 (defun pelican-enable-if-site ()
 161   "Enable `pelican-mode' if this buffer is under a Pelican site."
 162   (when (pelican-is-in-site)
 163     (pelican-mode 1)))
 164
 165 (defun pelican-make (target)
 166   "Execute TARGET in a Makefile at the root of the site."
 167   (interactive "sMake Pelican target: ")
 168   (if-let ((default-directory (pelican-find-root)))
 169       (let ((output (get-buffer-create "*Pelican Output*")))
 170         (display-buffer output)
 171         (pop-to-buffer output)
 172         (compilation-mode)
 173         (start-process "Pelican Makefile" output "make" target))
 174     (message "This doesn't look like a Pelican site.")))
 175
 176 (defun pelican-make-html ()
 177   "Generate HTML via a Makefile at the root of the site."
 178   (interactive)
 179   (pelican-make "html"))
 180
 181 (defun pelican-make-rsync-upload ()
 182   "Upload with rsync via a Makefile at the root of the site."
 183   (interactive)
 184   (pelican-make "rsync_upload"))
 185
 186 (defconst pelican-keymap (make-sparse-keymap)
 187   "The default keymap used in Pelican mode.")
 188 (define-key pelican-keymap (kbd "C-c P n")
 189   'pelican-insert-header)
 190 (define-key pelican-keymap (kbd "C-c P p")
 191   'pelican-publish-draft)
 192 (define-key pelican-keymap (kbd "C-c P t")
 193   'pelican-update-date)
 194 (define-key pelican-keymap (kbd "C-c P h")
 195   'pelican-make-html)
 196 (define-key pelican-keymap (kbd "C-c P u")
 197   'pelican-make-rsync-upload)
 198
 199
 200 ;;;###autoload
 201 (define-minor-mode pelican-mode
 202   "Toggle Pelican mode.
 203
 204 Interactively with no argument, this command toggles the mode.
 205 to show buffer size and position in mode-line."
 206   :init-value nil
 207   :lighter " Pelican"
 208   :keymap pelican-keymap
 209   :group 'pelican)
 210
 211
 212 ;;;###autoload
 213 (add-hook 'markdown-mode-hook 'pelican-enable-if-site)
 214
 215 ;;;###autoload
 216 (add-hook 'rst-mode-hook 'pelican-enable-if-site)
 217
 218 (provide 'pelican-mode)
 219 ;;; pelican-mode.el ends here