X-Git-Url: https://git.korewanetadesu.com/?p=pelican-mode.git;a=blobdiff_plain;f=pelican-mode.el;h=3691c2fe4095a95dc6468c5001e2cd69235fd834;hp=f6cc52555e624323d4e982db0597df126ae913b4;hb=4cf099e3b9e3e10f1f2f32df7f4b890b6d103657;hpb=f1fb8573ced9aaa3fe6b5ffb798435edf47a0b34 diff --git a/pelican-mode.el b/pelican-mode.el index f6cc525..3691c2f 100644 --- a/pelican-mode.el +++ b/pelican-mode.el @@ -1,7 +1,24 @@ -;;; pelican-mode.el --- Minor mode for editing pages and posts in Pelican sites +;;; pelican-mode.el --- Minor mode for editing Pelican sites -*- lexical-binding: t -*- ;; -;; Author: Joe Wreschnig -;; This code is released into the public domain. +;; Copyright 2013-2017 Joe Wreschnig +;; +;; Author: Joe Wreschnig +;; Package-Version: 20170730 +;; Package-Requires: ((emacs "25")) +;; Keywords: convenience, editing +;; +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . ;;; Commentary: ;; @@ -9,131 +26,179 @@ ;; tested it on networked drives and the lookup for pelicanconf.py ;; might slow it down considerably. + ;;; Code: -(defun pelican-timestamp-now () - "Generate a Pelican-compatible timestamp." - (format-time-string "%Y-%m-%d %H:%M")) +(require 'seq) +(require 'subr-x) + +(defgroup pelican-mode nil + "Support for Pelican posts and pages." + :group 'convenience) -(defun pelican-is-markdown () - "Check if the buffer is likely using Markdown." - (eq major-mode 'markdown-mode)) +(defcustom pelican-mode-default-page-fields + '(:slug slug) + "Fields to include when creating a new page. + +See the documentation for `pelican-field' for more information +about metadata fields and special values." + :group 'pelican-mode + :type '(plist)) + +(defcustom pelican-mode-default-post-fields + '(:date now :status "draft" :slug slug) + "Fields to include when creating a new post. + +See the documentation for `pelican-field' for more information +about metadata fields and special values." + :group 'pelican-mode + :type '(plist)) + +(defun pelican-timestamp (&optional time) + "Generate a Pelican-compatible timestamp for TIME." + (format-time-string "%Y-%m-%d %H:%M" time)) (defun pelican-field (name value) - "Helper to format a field NAME and VALUE." - (if value (format "%s: %s\n" name value) "")) - -(defun pelican-markdown-header (title date status category tags slug) - "Generate a Pelican Markdown header. - -All parameters but TITLE may be nil to omit them. DATE may be a -string or 't to use the current date and time." - (let ((title (format "Title: %s\n" title)) - (status (pelican-field "Status" status)) - (category (pelican-field "Category" category)) - (tags (pelican-field "Tags" tags)) - (slug (pelican-field "Slug" slug)) - (date (if date (format "Date: %s\n" - (if (stringp date) date - (pelican-timestamp-now))) - ""))) - (concat title date status tags category slug "\n"))) - -(defun pelican-rst-header (title date status category tags slug) - "Generate a Pelican reStructuredText header. - -All parameters but TITLE may be nil to omit them. DATE may be a -string or 't to use the current date and time." - (let ((title (format "%s\n%s\n\n" title - (make-string (string-width title) ?#))) - (status (pelican-field ":status" status)) - (category (pelican-field ":category" category)) - (tags (pelican-field ":tags" tags)) - (slug (pelican-field ":slug" slug)) - (date (if date (format ":date: %s\n" - (if (stringp date) date - (pelican-timestamp-now))) - ""))) - (concat title date status tags category slug "\n"))) + "Format a line for a field NAME with a VALUE. + +NAME may be a string or a symbol; if it is a symbol, the +symbol name is used (removing a leading ':' if present). + +VALUE may be any value; except for the following special values, +the unquoted printed representation of it is used: + +- `now' means the current time; see `pelican-timestamp'. + +- `slug' means the file's path relative to the document root sans + extension; see `pelican-default-slug'. + +- nil or an empty strings means return an empty string, without + any name or value." + (setq value (pcase value + ('now (pelican-timestamp)) + ('slug (pelican-default-slug)) + ('"" nil) + (_ value))) + (when (symbolp name) + (setq name (string-remove-prefix ":" (symbol-name name)))) + (if value + (cond ((derived-mode-p 'markdown-mode) + (format "%s: %s\n" (capitalize name) value)) + ((derived-mode-p 'rst-mode) + (format ":%s: %s\n" (downcase name) value)) + (t (error "Unsupported major mode %S" major-mode))) + "")) + +(defun pelican-rst-title (title) + "Format a reStructureText version of TITLE." + (concat title "\n" (make-string (string-width title) ?#) "\n\n")) + +(defun pelican-title (title) + "Format a TITLE for the current document, according to major mode." + (cond ((derived-mode-p 'markdown-mode) + (pelican-field "title" title)) + ((derived-mode-p 'rst-mode) + (pelican-rst-title title)) + (t (error "Unsupported major mode %S" major-mode)))) + +(defun pelican-header (title &rest fields) + "Generate a Pelican header for a post with a TITLE and metadata FIELDS." + (concat (pelican-title title) + (mapconcat (apply-partially #'apply #'pelican-field) + (seq-partition fields 2) "") + "\n")) + +(defun pelican-insert-header (title &rest fields) + "Insert a Pelican header for a post with a TITLE and metadata FIELDS." + (save-excursion + (goto-char 0) + (insert (apply #'pelican-header (cons title fields))))) (defun pelican-insert-draft-post-header (title tags) - "Insert a Pelican header for a draft post." + "Insert a Pelican header for a draft with a TITLE and TAGS." (interactive "sPost title: \nsTags: ") - (let ((slug (pelican-default-slug)) - (header (if (pelican-is-markdown) - 'pelican-markdown-header 'pelican-rst-header))) - (save-excursion - (goto-char 0) - (insert (funcall header title 't "draft" nil tags slug))))) + (apply #'pelican-insert-header + `(,title ,@pelican-mode-default-post-fields :tags ,tags))) -(defun pelican-insert-page-header (title hidden) - "Insert a Pelican header for a page." +(defun pelican-insert-page-header (title &optional hidden) + "Insert a Pelican header for a page with a TITLE, potentially HIDDEN." (interactive (list (read-string "Page title: ") (y-or-n-p "Hidden? "))) - (let ((slug (pelican-default-slug)) - (hidden (if hidden "hidden" nil)) - (header (if (pelican-is-markdown) - 'pelican-markdown-header 'pelican-rst-header))) - (save-excursion - (goto-char 0) - (insert (funcall header title nil hidden nil nil slug))))) + (apply #'pelican-insert-header + `(,title ,@pelican-mode-default-page-fields + :hidden ,(when hidden "hidden")))) -(defun pelican-insert-header () +(defun pelican-insert-auto-header () "Insert a Pelican header for a page or post." (interactive) - (call-interactively (if (pelican-is-page) - 'pelican-insert-page-header - 'pelican-insert-draft-post-header))) + (call-interactively + (if (pelican-page-p) + #'pelican-insert-page-header + #'pelican-insert-draft-post-header))) + +(defun pelican-set-field (field value) + "Set FIELD to VALUE." + (interactive "sField: \nsValue: ") + (save-excursion + (goto-char 0) + (when (and (derived-mode-p 'rst-mode) + (re-search-forward "^#" nil t)) + (forward-line 2)) + (if (re-search-forward (concat "^" (pelican-field field ".+*")) nil t) + (replace-match (pelican-field field value)) + (when value + (re-search-forward "^$") + (replace-match (pelican-field field value)))))) + +(defun pelican-remove-field (field) + "Remove FIELD." + (pelican-set-field field nil)) + +(defun pelican-set-title (title) + "Set the title to TITLE." + (interactive "sTitle: ") + (if (derived-mode-p 'markdown-mode) + (pelican-set-field "title" title) + (save-excursion + (goto-char 0) + (let ((header (pelican-rst-title title))) + (if (looking-at ".*\n#+\n+") + (replace-match header) + (insert header)))))) (defun pelican-update-date () "Update a Pelican date header." (interactive) - (save-excursion - (goto-char 0) - (let* ((field (if (pelican-is-markdown) "Date" ":date")) - (re (format "^%s: [-0-9 :]+\n" field)) - (date (pelican-timestamp-now))) - (if (re-search-forward re nil t) - (replace-match (format "%s: %s\n" field date)) - (message "This doesn't look like a Pelican page."))))) + (pelican-set-field :date 'now)) (defun pelican-publish-draft () "Remove draft status from a Pelican post." (interactive) - (save-excursion - (goto-char 0) - (let* ((field (if (pelican-is-markdown) "Status" ":status")) - (re (format "^%s: draft\n" field))) - (if (re-search-forward re nil t) - (progn - (replace-match (format "")) - (pelican-update-date)) - (message "This doesn't look like a Pelican draft."))))) - -(defun pelican-is-page () + (pelican-remove-field :status) + (pelican-update-date)) + +(defun pelican-page-p () "Guess the current buffer is a Pelican page (vs. a post or neither)." - (let ((pelican-base (pelican-find-root))) - (if pelican-base - (let* ((relative (file-relative-name buffer-file-name pelican-base)) - (components (split-string relative "/"))) - (string= "pages" (car (cdr components))))))) + (when-let (pelican-base (pelican-find-root)) + (let* ((relative (file-relative-name buffer-file-name pelican-base)) + (components (split-string relative "/"))) + (equal "pages" (cadr components))))) (defun pelican-default-slug () "Generate a Pelican post/page slug for the current buffer." - (let ((pelican-base (pelican-find-root)) - (file-name (file-name-sans-extension buffer-file-name))) - (if pelican-base - (let* ((relative (file-relative-name file-name pelican-base)) - (components (cdr (split-string relative "/"))) - (components (if (string= "pages" (car components)) - (cdr components) components))) - (mapconcat 'identity components "/")) - (format "%s/%s" - (file-name-nondirectory - (directory-file-name - (file-name-directory file-name))) - (file-name-base file-name))))) + (if-let ((pelican-base (pelican-find-root)) + (file-name (file-name-sans-extension buffer-file-name))) + (let* ((relative (file-relative-name file-name pelican-base)) + (components (cdr (split-string relative "/"))) + (components (if (string= "pages" (car components)) + (cdr components) components))) + (mapconcat 'identity components "/")) + (format "%s/%s" + (file-name-nondirectory + (directory-file-name + (file-name-directory file-name))) + (file-name-base file-name)))) (defun pelican-find-in-parents (file-name) "Find FILE-NAME in the default directory or one of its parents, or nil." @@ -146,29 +211,20 @@ string or 't to use the current date and time." (defun pelican-find-root () "Return the root of the buffer's Pelican site, or nil." - (let ((conf (pelican-find-in-parents "pelicanconf.py"))) - (if conf (file-name-directory conf)))) + (when-let (conf (pelican-find-in-parents "pelicanconf.py")) + (file-name-directory conf))) -(defun pelican-is-in-site () +(defun pelican-site-p () "Check if this buffer is under a Pelican site." - (not (not (pelican-find-root)))) - -(defun pelican-enable-if-site () - "Enable `pelican-mode' if this buffer is under a Pelican site." - (if (pelican-is-in-site) - (pelican-mode 1))) + (not (null (pelican-find-root)))) (defun pelican-make (target) "Execute TARGET in a Makefile at the root of the site." (interactive "sMake Pelican target: ") - (let ((default-directory (pelican-find-root))) - (if default-directory - (let ((output (get-buffer-create "*Pelican Output*"))) - (display-buffer output) - (pop-to-buffer output) - (compilation-mode) - (start-process "Pelican Makefile" output "make" target)) - (message "This doesn't look like a Pelican site.")))) + (if-let (default-directory (pelican-find-root)) + (compilation-start (format "make %s" target) + nil (lambda (_) "*pelican*")) + (user-error "This doesn't look like a Pelican site"))) (defun pelican-make-html () "Generate HTML via a Makefile at the root of the site." @@ -180,34 +236,31 @@ string or 't to use the current date and time." (interactive) (pelican-make "rsync_upload")) -(defconst pelican-keymap (make-sparse-keymap) - "The default keymap used in Pelican mode.") -(define-key pelican-keymap (kbd "C-c P n") - 'pelican-insert-header) -(define-key pelican-keymap (kbd "C-c P p") - 'pelican-publish-draft) -(define-key pelican-keymap (kbd "C-c P t") - 'pelican-update-date) -(define-key pelican-keymap (kbd "C-c P h") - 'pelican-make-html) -(define-key pelican-keymap (kbd "C-c P u") - 'pelican-make-rsync-upload) - +;;;###autoload (define-minor-mode pelican-mode "Toggle Pelican mode. Interactively with no argument, this command toggles the mode. -to show buffer size and position in mode-line. -" - :init-value nil +for editing Pelican site files." :lighter " Pelican" - :keymap pelican-keymap :group 'pelican - ) + :keymap `((,(kbd "C-c P n") . pelican-insert-auto-header) + (,(kbd "C-c P p") . pelican-publish-draft) + (,(kbd "C-c P t") . pelican-update-date) + (,(kbd "C-c P h") . pelican-make-html) + (,(kbd "C-c P u") . pelican-make-rsync-upload))) +;;;###autoload +(defun pelican-enable-if-site () + "Enable `pelican-mode' if this buffer is under a Pelican site." + (when (pelican-site-p) + (pelican-mode 1))) + +;;;###autoload (add-hook 'markdown-mode-hook 'pelican-enable-if-site) + +;;;###autoload (add-hook 'rst-mode-hook 'pelican-enable-if-site) (provide 'pelican-mode) - ;;; pelican-mode.el ends here