pelican-mode.el

   1 ;;; pelican-mode.el --- Minor mode for editing pages and posts in Pelican sites
   2 ;;
   3 ;; Author: Joe Wreschnig
   4 ;; This code is released into the public domain.
   5
   6 ;;; Commentary:
   7 ;;
   8 ;; Probably, this doesn't handle a lot of error cases.  I also never
   9 ;; tested it on networked drives and the lookup for pelicanconf.py
  10 ;; might slow it down considerably.
  11
  12 ;;; Code:
  13
  14 (defun pelican-timestamp-now ()
  15   "Generate a Pelican-compatible timestamp."
  16   (format-time-string "%Y-%m-%d %H:%M"))
  17
  18 (defun pelican-is-markdown ()
  19   "Check if the buffer is likely using Markdown."
  20   (eq major-mode 'markdown-mode))
  21
  22 (defun pelican-field (name value)
  23   "Helper to format a field NAME and VALUE."
  24   (if value (format "%s: %s\n" name value) ""))
  25
  26 (defun pelican-markdown-header (title date status category tags slug)
  27   "Generate a Pelican Markdown header.
  28
  29 All parameters but TITLE may be nil to omit them. DATE may be a
  30 string or 't to use the current date and time."
  31   (let ((title (format "Title: %s\n" title))
  32         (status (pelican-field "Status" status))
  33         (category (pelican-field "Category" category))
  34         (tags (pelican-field "Tags" tags))
  35         (slug (pelican-field "Slug" slug))
  36         (date (if date (format "Date: %s\n"
  37                                (if (stringp date) date
  38                                  (pelican-timestamp-now)))
  39                 "")))
  40     (concat title date status tags category slug "\n")))
  41
  42 (defun pelican-rst-header (title date status category tags slug)
  43   "Generate a Pelican reStructuredText header.
  44
  45 All parameters but TITLE may be nil to omit them. DATE may be a
  46 string or 't to use the current date and time."
  47   (let ((title (format "%s\n%s\n\n" title
  48                        (make-string (string-width title) ?#)))
  49         (status (pelican-field ":status" status))
  50         (category (pelican-field ":category" category))
  51         (tags (pelican-field ":tags" tags))
  52         (slug (pelican-field ":slug" slug))
  53         (date (if date (format ":date: %s\n"
  54                                (if (stringp date) date
  55                                  (pelican-timestamp-now)))
  56                 "")))
  57     (concat title date status tags category slug "\n")))
  58
  59 (defun pelican-insert-draft-post-header (title tags)
  60   "Insert a Pelican header for a draft post."
  61   (interactive "sPost title: \nsTags: ")
  62   (let ((slug (pelican-default-slug))
  63         (header (if (pelican-is-markdown)
  64                     'pelican-markdown-header 'pelican-rst-header)))
  65     (save-excursion
  66       (goto-char 0)
  67       (insert (funcall header title 't "draft" nil tags slug)))))
  68
  69 (defun pelican-insert-page-header (title hidden)
  70   "Insert a Pelican header for a page."
  71   (interactive
  72    (list (read-string "Page title: ")
  73          (y-or-n-p "Hidden? ")))
  74   (let ((slug (pelican-default-slug))
  75         (hidden (if hidden "hidden" nil))
  76         (header (if (pelican-is-markdown)
  77                     'pelican-markdown-header 'pelican-rst-header)))
  78     (save-excursion
  79       (goto-char 0)
  80       (insert (funcall header title nil hidden nil nil slug)))))
  81
  82 (defun pelican-insert-header ()
  83   "Insert a Pelican header for a page or post."
  84   (interactive)
  85   (call-interactively (if (pelican-is-page)
  86                           'pelican-insert-page-header
  87                         'pelican-insert-draft-post-header)))
  88
  89 (defun pelican-update-date ()
  90   "Update a Pelican date header."
  91   (interactive)
  92   (save-excursion
  93     (goto-char 0)
  94     (let* ((field (if (pelican-is-markdown) "Date" ":date"))
  95            (re (format "^%s: [-0-9 :]+\n" field))
  96            (date (pelican-timestamp-now)))
  97       (if (re-search-forward re nil t)
  98           (replace-match (format "%s: %s\n" field date))
  99         (message "This doesn't look like a Pelican page.")))))
 100
 101 (defun pelican-publish-draft ()
 102   "Remove draft status from a Pelican post."
 103   (interactive)
 104   (save-excursion
 105     (goto-char 0)
 106     (let* ((field (if (pelican-is-markdown) "Status" ":status"))
 107            (re (format "^%s: draft\n" field)))
 108       (if (re-search-forward re nil t)
 109           (progn
 110             (replace-match (format ""))
 111             (pelican-update-date))
 112         (message "This doesn't look like a Pelican draft.")))))
 113
 114 (defun pelican-is-page ()
 115   "Guess the current buffer is a Pelican page (vs. a post or neither)."
 116   (let ((pelican-base (pelican-find-root)))
 117     (if pelican-base
 118         (let* ((relative (file-relative-name buffer-file-name pelican-base))
 119                (components (split-string relative "/")))
 120           (string= "pages" (car (cdr components)))))))
 121
 122 (defun pelican-default-slug ()
 123   "Generate a Pelican post/page slug for the current buffer."
 124   (let ((pelican-base (pelican-find-root))
 125         (file-name (file-name-sans-extension buffer-file-name)))
 126     (if pelican-base
 127         (let* ((relative (file-relative-name file-name pelican-base))
 128                (components (cdr (split-string relative "/")))
 129                (components (if (string= "pages" (car components))
 130                                (cdr components) components)))
 131           (mapconcat 'identity components "/"))
 132       (format "%s/%s"
 133               (file-name-nondirectory
 134                (directory-file-name
 135                 (file-name-directory file-name)))
 136               (file-name-base file-name)))))
 137
 138 (defun pelican-find-in-parents (file-name)
 139   "Find FILE-NAME in the default directory or one of its parents, or nil."
 140   (let* ((parent (expand-file-name default-directory)))
 141     (while (and (not (file-readable-p (concat parent file-name)))
 142                 (not (string= parent (directory-file-name parent))))
 143       (setq parent (file-name-directory (directory-file-name parent))))
 144     (let ((found (concat parent file-name)))
 145       (if (file-readable-p found) found nil))))
 146
 147 (defun pelican-find-root ()
 148   "Return the root of the buffer's Pelican site, or nil."
 149   (let ((conf (pelican-find-in-parents "pelicanconf.py")))
 150     (if conf (file-name-directory conf))))
 151
 152 (defun pelican-is-in-site ()
 153   "Check if this buffer is under a Pelican site."
 154   (not (not (pelican-find-root))))
 155
 156 (defun pelican-enable-if-site ()
 157   "Enable `pelican-mode' if this buffer is under a Pelican site."
 158   (if (pelican-is-in-site)
 159       (pelican-mode 1)))
 160
 161 (defun pelican-make (target)
 162   "Execute TARGET in a Makefile at the root of the site."
 163   (interactive "sMake Pelican target: ")
 164   (let ((default-directory (pelican-find-root)))
 165     (if default-directory
 166         (let ((output (get-buffer-create "*Pelican Output*")))
 167           (display-buffer output)
 168           (pop-to-buffer output)
 169           (compilation-mode)
 170           (start-process "Pelican Makefile" output "make" target))
 171       (message "This doesn't look like a Pelican site."))))
 172
 173 (defun pelican-make-html ()
 174   "Generate HTML via a Makefile at the root of the site."
 175   (interactive)
 176   (pelican-make "html"))
 177
 178 (defun pelican-make-rsync-upload ()
 179   "Upload with rsync via a Makefile at the root of the site."
 180   (interactive)
 181   (pelican-make "rsync_upload"))
 182
 183 (defconst pelican-keymap (make-sparse-keymap)
 184   "The default keymap used in Pelican mode.")
 185 (define-key pelican-keymap (kbd "C-c P n")
 186   'pelican-insert-header)
 187 (define-key pelican-keymap (kbd "C-c P p")
 188   'pelican-publish-draft)
 189 (define-key pelican-keymap (kbd "C-c P t")
 190   'pelican-update-date)
 191 (define-key pelican-keymap (kbd "C-c P h")
 192   'pelican-make-html)
 193 (define-key pelican-keymap (kbd "C-c P u")
 194   'pelican-make-rsync-upload)
 195
 196 (define-minor-mode pelican-mode
 197   "Toggle Pelican mode.
 198
 199 Interactively with no argument, this command toggles the mode.
 200 to show buffer size and position in mode-line.
 201 "
 202   :init-value nil
 203   :lighter " Pelican"
 204   :keymap pelican-keymap
 205   :group 'pelican
 206   )
 207
 208 (add-hook 'markdown-mode-hook 'pelican-enable-if-site)
 209 (add-hook 'rst-mode-hook 'pelican-enable-if-site)
 210
 211 (provide 'pelican-mode)
 212
 213 ;;; pelican-mode.el ends here