Add AsciiDoc support.
[pelican-mode.git] / pelican-mode.el
index d8f71a7..8a53c27 100644 (file)
 ;; You should have received a copy of the GNU General Public License
 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
 
 ;; You should have received a copy of the GNU General Public License
 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
 
+
 ;;; Commentary:
 ;;
 ;;; Commentary:
 ;;
-;; Probably, this doesn't handle a lot of error cases.  I also never
-;; tested it on networked drives and the lookup for pelicanconf.py
-;; might slow it down considerably.
+;; pelican-mode is an Emacs minor mode for editing pages and posts in
+;; Pelican sites.  Pelican is a static site generator which can
+;; process a variety of text file formats.  For more information, see
+;; URL https://blog.getpelican.com/.
+;;
+;; It's intended to be used alongside `markdown-mode' or `rst-mode'.
+;; It also assumes you've set up Pelican with ``pelican-quickstart''
+;; or something like it.  In particular it assumes:
+;;
+;;  * The existence of ``pelicanconf.py'' and ``Makefile'' in some
+;;    ancestor directory.
+;;  * The first component of the path (e.g. ``content'') after that
+;;    ancestor is irrelevant.
+;;  * If the next component is ``pages'', that indicates a page
+;;    rather than an article.
 
 
 ;;; Code:
 
 
 ;;; Code:
 (require 'subr-x)
 
 (defgroup pelican-mode nil
 (require 'subr-x)
 
 (defgroup pelican-mode nil
-  "Support for Pelican articles and pages."
+  "Support for Pelican articles and pages.
+
+For more information about Pelican see URL https://blog.getpelican.com/."
   :group 'convenience)
 
 (defcustom pelican-mode-default-page-fields
   '(:slug slug)
   "Fields to include when creating a new page.
 
   :group 'convenience)
 
 (defcustom pelican-mode-default-page-fields
   '(:slug slug)
   "Fields to include when creating a new page.
 
-See the documentation for `pelican-mode-field' for more information
+See the documentation for `pelican-mode-set-field' for more information
 about metadata fields and special values."
 about metadata fields and special values."
-  :group 'pelican
+  :group 'pelican-mode
   :type '(plist))
 
 (defcustom pelican-mode-default-article-fields
   '(:date now :status "draft" :slug slug)
   "Fields to include when creating a new article.
 
   :type '(plist))
 
 (defcustom pelican-mode-default-article-fields
   '(:date now :status "draft" :slug slug)
   "Fields to include when creating a new article.
 
-See the documentation for `pelican-mode-field' for more information
+See the documentation for `pelican-mode-set-field' for more information
 about metadata fields and special values."
 about metadata fields and special values."
-  :group 'pelican
+  :group 'pelican-mode
   :type '(plist))
 
   :type '(plist))
 
+(defcustom pelican-mode-formats
+  '((markdown-mode . pelican-mode-set-field-markdown-mode)
+    (adoc-mode . pelican-mode-set-field-adoc-mode)
+    (rst-mode . pelican-mode-set-field-rst-mode))
+  "Functions to handle setting metadata, based on major mode.
+
+This association list maps modes to functions that take two
+arguments, field and value strings."
+  :group 'pelican-mode
+  :type '(alist :key-type function :value-type function))
+
 (defun pelican-mode-timestamp (&optional time)
   "Generate a pelican-mode-compatible timestamp for TIME."
   (format-time-string "%Y-%m-%d %H:%M" time))
 
 (defun pelican-mode-timestamp (&optional time)
   "Generate a pelican-mode-compatible timestamp for TIME."
   (format-time-string "%Y-%m-%d %H:%M" time))
 
-(defun pelican-mode-field (name value)
-  "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-mode-timestamp'.
-
-- `slug' means the file's path relative to the document root sans
-  extension; see `pelican-mode-default-slug'.
-
-- nil or an empty strings means return an empty string, without
-  any name or value."
-  (setq value (pcase value
-                ('now (pelican-mode-timestamp))
-                ('slug (pelican-mode-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-mode-rst-title (title)
-  "Format a reStructureText version of TITLE."
-  (concat title "\n" (make-string (string-width title) ?#) "\n\n"))
-
-(defun pelican-mode-title (title)
-  "Format a TITLE for the current document, according to major mode."
-  (cond ((derived-mode-p 'markdown-mode)
-         (pelican-mode-field "title" title))
-        ((derived-mode-p 'rst-mode)
-         (pelican-mode-rst-title title))
-        (t (error "Unsupported major mode %S" major-mode))))
-
-(defun pelican-mode-header (title &rest fields)
-  "Generate a Pelican header for an article with a TITLE and metadata FIELDS."
-  (concat (pelican-mode-title title)
-          (mapconcat (apply-partially #'apply #'pelican-mode-field)
-                     (seq-partition fields 2) "")
-          "\n"))
-
-(defun pelican-mode-insert-header (title &rest fields)
-  "Insert a Pelican header for an article with a TITLE and metadata FIELDS."
-  (save-excursion
-    (goto-char 0)
-    (insert (apply #'pelican-mode-header (cons title fields)))))
+(defun pelican-mode-insert-header (&rest fields)
+  "Insert a Pelican header for an article with metadata FIELDS."
+  (mapc (apply-partially #'apply #'pelican-mode-set-field)
+        (seq-partition fields 2)))
 
 (defun pelican-mode-insert-draft-article-header (title tags)
   "Insert a Pelican header for a draft with a TITLE and TAGS."
   (interactive "sArticle title: \nsTags: ")
   (apply #'pelican-mode-insert-header
 
 (defun pelican-mode-insert-draft-article-header (title tags)
   "Insert a Pelican header for a draft with a TITLE and TAGS."
   (interactive "sArticle title: \nsTags: ")
   (apply #'pelican-mode-insert-header
-         `(,title ,@pelican-mode-default-article-fields :tags ,tags)))
+         `(:title ,title ,@pelican-mode-default-article-fields :tags ,tags)))
 
 (defun pelican-mode-insert-page-header (title &optional hidden)
   "Insert a Pelican header for a page with a TITLE, potentially HIDDEN."
 
 (defun pelican-mode-insert-page-header (title &optional hidden)
   "Insert a Pelican header for a page with a TITLE, potentially HIDDEN."
@@ -126,7 +101,7 @@ the unquoted printed representation of it is used:
    (list (read-string "Page title: ")
          (y-or-n-p "Hidden? ")))
   (apply #'pelican-mode-insert-header
    (list (read-string "Page title: ")
          (y-or-n-p "Hidden? ")))
   (apply #'pelican-mode-insert-header
-         `(,title ,@pelican-mode-default-page-fields
+         `(:title ,title ,@pelican-mode-default-page-fields
                   :hidden ,(when hidden "hidden"))))
 
 (defun pelican-mode-insert-auto-header ()
                   :hidden ,(when hidden "hidden"))))
 
 (defun pelican-mode-insert-auto-header ()
@@ -137,19 +112,84 @@ the unquoted printed representation of it is used:
        #'pelican-mode-insert-page-header
      #'pelican-mode-insert-draft-article-header)))
 
        #'pelican-mode-insert-page-header
      #'pelican-mode-insert-draft-article-header)))
 
+(defun pelican-mode-set-field-rst-mode (field value)
+  "Set reStructuredText metadata FIELD to VALUE."
+  (setq field (downcase field))
+  (if (equal field "title")
+      (let ((header (format "%s\n%s\n\n"
+                            value (make-string (string-width value) ?#))))
+        (if (looking-at ".*\n#+\n+")
+            (replace-match header)
+          (insert header)))
+    (let ((text (when value (format ":%s: %s\n" field value))))
+      (when (looking-at "^.*\n#")
+        (forward-line 3))
+      (if (re-search-forward (format "^:%s:.*\n" (regexp-quote field)) nil t)
+          (replace-match (or text ""))
+        (when text
+          (if (re-search-forward "^$" nil t)
+              (replace-match text)
+            (insert text)))))))
+
+(defun pelican-mode-set-field-markdown-mode (field value)
+  "Set Markdown metadata FIELD to VALUE."
+  (setq field (capitalize field))
+  (let ((text (when value (format "%s: %s\n" field value))))
+    (if (re-search-forward (format "^%s:.*\n" (regexp-quote field)) nil t)
+        (replace-match text)
+      (when value
+        (if (re-search-forward "^$" nil t)
+            (replace-match text)
+          (insert text))))))
+
+(defun pelican-mode-set-field-adoc-mode (field value)
+  "Set AsciiDoc metadata FIELD to VALUE."
+  (setq field (downcase field))
+  (if (equal field "title")
+      (let ((header (format "= %s\n\n" value)))
+        (if (looking-at "= .*\n\n+")
+            (replace-match header)
+          (insert header)))
+    (let ((text (when value (format ":%s: %s\n" field value))))
+      (when (looking-at "^=")
+        (forward-line 2))
+      (if (re-search-forward (format "^:%s:.*\n" (regexp-quote field)) nil t)
+          (replace-match (or text ""))
+        (when text
+          (if (re-search-forward "^$" nil t)
+              (replace-match text)
+            (insert text)))))))
+
 (defun pelican-mode-set-field (field value)
 (defun pelican-mode-set-field (field value)
-  "Set FIELD to VALUE."
+  "Set FIELD to VALUE.
+
+FIELD 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-mode-timestamp'.
+
+- `slug' means the file's path relative to the document root sans
+  extension; see `pelican-mode-default-slug'.
+
+- nil or an empty string removes the field."
   (interactive "sField: \nsValue: ")
   (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-mode-field field ".+*")) nil t)
-        (replace-match (pelican-mode-field field value))
-      (when value
-        (re-search-forward "^$")
-        (replace-match (pelican-mode-field field value))))))
+  (setq value (pcase value
+                ('now (pelican-mode-timestamp))
+                ('slug (pelican-mode-default-slug))
+                ('"" nil)
+                (_ value)))
+  (when (symbolp field)
+    (setq field (string-remove-prefix ":" (symbol-name field))))
+  (let ((set-field
+         (assoc-default nil pelican-mode-formats #'derived-mode-p)))
+    (unless set-field
+      (error "Unsupported major mode %S" major-mode))
+    (save-excursion
+      (goto-char 0)
+      (funcall set-field field value))))
 
 (defun pelican-mode-remove-field (field)
   "Remove FIELD."
 
 (defun pelican-mode-remove-field (field)
   "Remove FIELD."
@@ -158,14 +198,7 @@ the unquoted printed representation of it is used:
 (defun pelican-mode-set-title (title)
   "Set the title to TITLE."
   (interactive "sTitle: ")
 (defun pelican-mode-set-title (title)
   "Set the title to TITLE."
   (interactive "sTitle: ")
-  (if (derived-mode-p 'markdown-mode)
-      (pelican-mode-set-field "title" title)
-    (save-excursion
-      (goto-char 0)
-      (let ((header (pelican-mode-rst-title title)))
-        (if (looking-at ".*\n#+\n+")
-            (replace-match header)
-          (insert header))))))
+  (pelican-mode-set-field :title title))
 
 (defun pelican-mode-update-date ()
   "Update a Pelican date header."
 
 (defun pelican-mode-update-date ()
   "Update a Pelican date header."
@@ -194,25 +227,12 @@ the unquoted printed representation of it is used:
              (components (if (string= "pages" (car components))
                              (cdr components) components)))
         (mapconcat 'identity components "/"))
              (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-mode-find-in-parents (file-name)
-  "Find FILE-NAME in the default directory or one of its parents, or nil."
-  (let* ((parent (expand-file-name default-directory)))
-    (while (and (not (file-readable-p (concat parent file-name)))
-                (not (string= parent (directory-file-name parent))))
-      (setq parent (file-name-directory (directory-file-name parent))))
-    (let ((found (concat parent file-name)))
-      (if (file-readable-p found) found nil))))
+    (when-let (file-name (file-name-sans-extension buffer-file-name))
+      (file-name-base file-name))))
 
 (defun pelican-mode-find-root ()
   "Return the root of the buffer's Pelican site, or nil."
 
 (defun pelican-mode-find-root ()
   "Return the root of the buffer's Pelican site, or nil."
-  (when-let (conf (pelican-mode-find-in-parents "pelicanconf.py"))
-    (file-name-directory conf)))
+  (locate-dominating-file default-directory "pelicanconf.py"))
 
 (defun pelican-make (target)
   "Execute TARGET in a Makefile at the root of the site."
 
 (defun pelican-make (target)
   "Execute TARGET in a Makefile at the root of the site."
@@ -220,7 +240,7 @@ the unquoted printed representation of it is used:
   (if-let (default-directory (pelican-mode-find-root))
       (compilation-start (format "make %s" target)
                          nil (lambda (_) "*pelican*"))
   (if-let (default-directory (pelican-mode-find-root))
       (compilation-start (format "make %s" target)
                          nil (lambda (_) "*pelican*"))
-    (user-error "This doesn't look like a Pelican site")))
+    (user-error "No Pelican site root could be found")))
 
 (defun pelican-make-html ()
   "Generate HTML via a Makefile at the root of the site."
 
 (defun pelican-make-html ()
   "Generate HTML via a Makefile at the root of the site."
@@ -239,6 +259,10 @@ With a prefix argument ARG, enable Pelican mode if ARG is
 positive, and disable it otherwise.  If called from Lisp, enable
 the mode if ARG is omitted or nil.
 
 positive, and disable it otherwise.  If called from Lisp, enable
 the mode if ARG is omitted or nil.
 
+Pelican is a static site generator which can process a variety of
+text file formats.  For more information, see URL
+https://blog.getpelican.com/.
+
 When Pelican mode is enabled, additional commands are available
 for editing articles or pages:
 
 When Pelican mode is enabled, additional commands are available
 for editing articles or pages:
 
@@ -257,6 +281,10 @@ With a prefix argument ARG, enable Pelican global mode if ARG is
 positive, and disable it otherwise.  If called from Lisp, enable
 the mode if ARG is omitted or nil.
 
 positive, and disable it otherwise.  If called from Lisp, enable
 the mode if ARG is omitted or nil.
 
+Pelican is a static site generator which can process a variety of
+text file formats.  For more information, see URL
+https://blog.getpelican.com/.
+
 When Pelican global mode is enabled, text files which seem to
 be part of a Pelican site will have `pelican-mode' automatically
 enabled.
 When Pelican global mode is enabled, text files which seem to
 be part of a Pelican site will have `pelican-mode' automatically
 enabled.
@@ -265,7 +293,7 @@ If you disable this, you may still enable `pelican-mode' manually
 or add `pelican-mode-enable-if-site' to more specific mode
 hooks."
   :global t
 or add `pelican-mode-enable-if-site' to more specific mode
 hooks."
   :global t
-  :group 'pelican
+  :group 'pelican-mode
   (if pelican-global-mode
       (add-hook 'text-mode-hook #'pelican-mode-enable-if-site)
     (remove-hook 'text-mode-hook #'pelican-mode-enable-if-site)))
   (if pelican-global-mode
       (add-hook 'text-mode-hook #'pelican-mode-enable-if-site)
     (remove-hook 'text-mode-hook #'pelican-mode-enable-if-site)))