X-Git-Url: https://git.korewanetadesu.com/?p=pelican-mode.git;a=blobdiff_plain;f=pelican-mode.el;h=e0f522338c998099ddabbf37814a26d849a34629;hp=f6cc52555e624323d4e982db0597df126ae913b4;hb=51d1a9224c25a4b579e63c57ef2d272c0b538a67;hpb=f1fb8573ced9aaa3fe6b5ffb798435edf47a0b34 diff --git a/pelican-mode.el b/pelican-mode.el index f6cc525..e0f5223 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: 20170618 +;; 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,156 @@ ;; 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) -(defun pelican-is-markdown () - "Check if the buffer is likely using Markdown." - (eq major-mode 'markdown-mode)) + +(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 means return an empty string, without any name or value." + (setq value (pcase value + ('now (pelican-timestamp)) + ('slug (pelican-default-slug)) + (_ 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) + "Create a ReSt 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))))) - -(defun pelican-insert-page-header (title hidden) - "Insert a Pelican header for a page." + (save-excursion + (goto-char 0) + (insert (pelican-header title + :date 'now + :status "draft" + :tags tags + :slug 'slug)))) + +(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))))) + (save-excursion + (goto-char 0) + (insert (pelican-header title + :status (when hidden "hidden") + :slug 'slug)))) -(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))) +(defun pelican-set-field (field value) + "Set FIELD to VALUE." + (interactive "sField: \nsValue: ") + (save-excursion + (goto-char 0) + (if (re-search-forward (concat "^" (pelican-field field ".+*")) nil t) + (replace-match (pelican-field field value)) + (re-search-forward "#") + (forward-line 2) + (re-search-forward "^$") + (replace-match (pelican-field field value))))) + +(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" (pelican-timestamp))) (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."))))) + (pelican-set-field "status" nil) + (pelican-update-date)) (defun pelican-is-page () "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 +188,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 () "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*")) + (message "This doesn't look like a Pelican site."))) (defun pelican-make-html () "Generate HTML via a Makefile at the root of the site." @@ -183,7 +216,7 @@ string or 't to use the current date and time." (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) + 'pelican-insert-auto-header) (define-key pelican-keymap (kbd "C-c P p") 'pelican-publish-draft) (define-key pelican-keymap (kbd "C-c P t") @@ -193,21 +226,29 @@ string or 't to use the current date and time." (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. -" +for editing Pelican site files." :init-value nil :lighter " Pelican" :keymap pelican-keymap - :group 'pelican - ) + :group 'pelican) + +;;;###autoload +(defun pelican-enable-if-site () + "Enable `pelican-mode' if this buffer is under a Pelican site." + (when (pelican-is-in-site) + (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