diff options
Diffstat (limited to 'lisp/garden-publish.el')
| -rw-r--r-- | lisp/garden-publish.el | 450 |
1 files changed, 450 insertions, 0 deletions
diff --git a/lisp/garden-publish.el b/lisp/garden-publish.el new file mode 100644 index 0000000..cafbcda --- /dev/null +++ b/lisp/garden-publish.el @@ -0,0 +1,450 @@ +;;; garden-publish.el --- publish the garden to the zola site -*- lexical-binding: t; -*- + +(require 'garden-core) +(require 'subr-x) + +(declare-function denote-publish-to-md "denote-publish") +(declare-function org-publish "ox-publish") + +(defvar denote-directory) +(defvar org-export-with-broken-links) +(defvar org-export-use-babel) +(defvar org-publish-project-alist) + +(defcustom garden-publish-site-directory (expand-file-name "~/cashmere.rs/") "Root directory of the Zola site checkout." :type 'directory :group 'garden) +(defcustom garden-publish-wiki-subdir "content/wiki" "Wiki output directory relative to the site root." :type 'string :group 'garden) + +(defun garden-publish--clean-generated (dir) + "Delete all generated Markdown files in DIR except _index.md." + (dolist (old (directory-files dir t "\\.md\\'")) + (unless (equal (file-name-nondirectory old) "_index.md") (delete-file old)))) + +(defun garden-publish--ensure-index (dir title) + "Create an _index.md with TITLE in DIR unless one already exists." + (let ((idx (expand-file-name "_index.md" dir))) + (unless (file-exists-p idx) + (with-temp-file idx (insert (format "+++\ntitle = %S\nsort_by = \"date\"\n+++\n" title)))))) + +(defun garden-publish--filename-slug (file) + "Return the slug part of the denote FILE name, or nil." + (let ((base (file-name-nondirectory file))) + (when (string-match "\\`[0-9]\\{8\\}T[0-9]\\{6\\}--\\([a-z0-9-]+\\)\\(?:__[a-z0-9_-]+\\)?\\.org\\'" base) + (match-string 1 base)))) + +(defun garden-publish--slug-map () + "Return a hash table mapping note ids to unique URL slugs." + (let ((map (make-hash-table :test 'equal)) + (seen (make-hash-table :test 'equal))) + (dolist (file (sort (garden--note-files) #'string<)) + (let* ((id (garden--file-id file)) + (base (garden-publish--filename-slug file)) + (kw (car (garden--file-keywords file)))) + (when (and id base) + (let ((slug base)) + (when (gethash slug seen) + (setq slug (if (and kw (not (gethash (concat base "-" kw) seen))) + (concat base "-" kw) + (let ((n 2)) + (while (gethash (format "%s-%d" base n) seen) (setq n (1+ n))) + (format "%s-%d" base n))))) + (puthash slug t seen) + (puthash id slug map))))) + map)) + +(defcustom garden-publish-exclude-keywords '("draft" "private" "noexport") "File keywords that exclude a note from publishing." :type '(repeat string) :group 'garden) + +(defun garden-publish--exclude-ids () + "Return a hash table of note ids that must not be published." + (let ((ex (make-hash-table :test 'equal))) + (dolist (file (garden--note-files)) + (when (seq-intersection garden-publish-exclude-keywords (garden--file-keywords file)) + (puthash (garden--file-id file) t ex))) + ex)) + +(defun garden-publish--rewrite-denote-links (map) + "Rewrite exported denote links in the current buffer using MAP. +MAP maps note ids to wiki slugs; links to unknown ids are reduced +to their description." + (goto-char (point-min)) + (while (re-search-forward + "<a href=\"denote:\\([0-9]\\{8\\}T[0-9]\\{6\\}\\)\\(?:::[^\"]*\\)?\\(?:\\.html\\)?\"[^>]*>\\(\\(?:.\\|\n\\)*?\\)</a>" + nil t) + (let* ((tid (match-string 1)) + (desc (match-string 2)) + (tslug (gethash tid map))) + (replace-match (if tslug (format "<a href=\"/wiki/%s/\">%s</a>" tslug desc) desc) t t))) + (goto-char (point-min)) + (while (re-search-forward + "\\[\\([^]]*\\)\\](denote:\\([0-9]\\{8\\}T[0-9]\\{6\\}\\)[^)]*)" + nil t) + (let* ((desc (match-string 1)) + (tslug (gethash (match-string 2) map))) + (replace-match (if tslug (format "[%s](/wiki/%s/)" desc tslug) desc) t t)))) + +(defun garden-publish--fix-wiki-frontmatter () + "Move top-level tags/category in YAML front matter into a Zola taxonomies block. +This is done in the current buffer." + (save-excursion + (goto-char (point-min)) + (when (looking-at "^---$") + (let ((start (point))) + (forward-line) + (when (re-search-forward "^---$" nil t) + (let ((end (point))) + (save-restriction + (narrow-to-region start end) + (goto-char (point-min)) + (when (re-search-forward "^\\(tags:\\|category:\\)" nil t) + (beginning-of-line) + (insert "taxonomies:\n") + (goto-char (point-min)) + (while (re-search-forward "^tags:" nil t) + (replace-match " tags:")) + (goto-char (point-min)) + (while (re-search-forward "^category:" nil t) + (replace-match " categories:")))))))))) + +(defun garden-publish--fix-wiki (dir map exclude) + "Post-process exported wiki files in DIR. +Rewrite denote links using the id-to-slug table MAP, delete files +whose id is in the EXCLUDE table, strip PGP blocks and TODO +keywords, fix front matter taxonomies, and rename each file to its slug." + (dolist (md (directory-files dir t "\\.md\\'")) + (let* ((base (file-name-nondirectory md)) + (id (and (string-match "\\`\\([0-9]\\{8\\}T[0-9]\\{6\\}\\)" base) (match-string 1 base))) + (slug (and id (gethash id map)))) + (cond + ((and id (gethash id exclude)) (delete-file md)) + ((null slug) nil) + (t + (with-temp-buffer + (insert-file-contents md) + (garden-publish--fix-wiki-frontmatter) + (goto-char (point-min)) + (while (re-search-forward "\\(?:-----\\|–—\\)?BEGIN PGP\\(?:.\\|\n\\)*?END PGP[^&\n-]*\\(?:-----\\|–—\\)?" nil t) + (replace-match "")) + (goto-char (point-min)) + (while (re-search-forward "^\\(#+\\)[ \t]+\\(?:TODO\\|DONE\\|NEXT\\|WAIT[A-Z]*\\|CANCELL?ED\\|HOLD\\|STRT\\)[ \t]+" nil t) + (replace-match "\\1 ")) + (garden-publish--rewrite-denote-links map) + (write-region (point-min) (point-max) md nil 'silent)) + (unless (equal base (concat slug ".md")) + (rename-file md (expand-file-name (concat slug ".md") dir) t))))))) + +;;;###autoload +(defun garden-publish-wiki () + "Export all garden notes to Markdown in the site wiki directory." + (interactive) + (require 'denote) + (require 'ox-gfm) + (require 'denote-publish) + (let* ((out (expand-file-name garden-publish-wiki-subdir garden-publish-site-directory)) + (denote-directory (expand-file-name garden-directory)) + (org-export-with-broken-links t) + (org-export-use-babel nil) + (make-backup-files nil) + (org-publish-project-alist + `(("garden-wiki" + :base-directory ,(expand-file-name garden-directory) + :publishing-directory ,out + :publishing-function denote-publish-to-md + :recursive nil + :exclude-tags ("noexport" "draft") + :with-toc nil)))) + (make-directory out t) + (garden-publish--clean-generated out) + (garden-publish--ensure-index out "Wiki") + (garden-build) + (org-publish "garden-wiki" t) + (garden-publish--fix-wiki out (garden-publish--slug-map) (garden-publish--exclude-ids)) + (message "garden: published wiki to %s" out))) + +(defcustom garden-publish-blog-source (expand-file-name "~/garden/posts/") + "Directory holding the Org source files for blog posts." + :type 'directory :group 'garden) + +(defcustom garden-publish-pages-source (expand-file-name "~/garden/pages/") + "Directory holding the Org source files for standalone pages." + :type 'directory :group 'garden) + +(defcustom garden-publish-images-source (expand-file-name "~/garden/posts/images/") + "Directory holding images referenced by blog posts." + :type 'directory :group 'garden) + +(defcustom garden-publish-blog-subdir "content/blog" "Blog output directory relative to the site root." :type 'string :group 'garden) + +(declare-function org-export-as "ox") + +(defun garden-publish--parse-post (file) + "Parse the Org post FILE into a (PROPERTIES . BODY) pair." + (let ((props nil) (body-start 0) (i 0) + (lines (with-temp-buffer (insert-file-contents file) (split-string (buffer-string) "\n")))) + (catch 'done + (dolist (line lines) + (cond + ((string-match "\\`#\\+\\([A-Za-z_]+\\):[ \t]*\\(.*\\)\\'" line) + (push (cons (downcase (match-string 1 line)) (string-trim (match-string 2 line))) props)) + ((string-empty-p (string-trim line)) nil) + (t (setq body-start i) (throw 'done nil))) + (setq i (1+ i)))) + (cons props (string-join (nthcdr body-start lines) "\n")))) + +(defun garden-publish--strip-toc (body) + "Return BODY with any Table of Contents section removed." + (let ((out '()) (skip nil)) + (dolist (line (split-string body "\n")) + (cond + ((string-match-p "\\`\\*+ +Table of Contents[ \t]*\\'" line) (setq skip t)) + ((and skip (string-match-p "\\`\\*+ " line)) (setq skip nil) (push line out)) + (skip nil) + (t (push line out)))) + (string-join (nreverse out) "\n"))) + +(defun garden-publish--clean-slug (s) + "Normalize string S into a lowercase URL slug." + (let ((x (replace-regexp-in-string "[^a-z0-9]+" "-" (downcase (string-trim s))))) + (replace-regexp-in-string "\\(?:\\`-+\\|-+\\'\\)" "" x))) + +(defun garden-publish--org-to-gfm (body) + "Export the Org string BODY to GitHub-flavored Markdown." + (require 'ox-gfm) + (with-temp-buffer + (insert body) + (org-mode) + (let ((org-export-with-broken-links t) + (org-export-use-babel nil)) + (org-export-as 'gfm nil nil t '(:with-toc nil :with-section-numbers nil))))) + +(defun garden-publish--blog-one (file out-dir) + "Convert the blog post FILE to Markdown in OUT-DIR unless drafted." + (let* ((parsed (garden-publish--parse-post file)) + (props (car parsed)) + (body (cdr parsed))) + (unless (equal (cdr (assoc "status" props)) "draft") + (let* ((title (or (cdr (assoc "title" props)) (file-name-base file))) + (slug (garden-publish--clean-slug (or (cdr (assoc "slug" props)) (file-name-base file)))) + (date (let ((d (cdr (assoc "date" props)))) (and d (substring d 0 (min 10 (length d)))))) + (tags (let ((tg (cdr (assoc "tags" props)))) (and tg (split-string tg "[ ,]+" t)))) + (desc (cdr (assoc "description" props))) + (md (garden-publish--org-to-gfm + (garden-publish--strip-toc + (replace-regexp-in-string "/content/images/" "/images/" body)))) + (fm (concat "+++\n" + (format "title = %S\n" title) + (or (when date (format "date = \"%s\"\n" date)) "") + (or (when (and desc (not (string-empty-p desc))) + (format "description = %S\n" desc)) + "") + (or (when tags + (concat "[taxonomies]\n" + (format "tags = [%s]\n" + (mapconcat (lambda (x) (format "%S" x)) tags ", ")))) + "") + "+++\n\n"))) + (with-temp-file (expand-file-name (concat slug ".md") out-dir) + (insert fm md)))))) + +;;;###autoload +(defun garden-publish-blog () + "Export all blog posts and images to the site blog directory." + (interactive) + (let ((out (expand-file-name garden-publish-blog-subdir garden-publish-site-directory)) + (postsrc garden-publish-blog-source) + (imgsrc garden-publish-images-source) + (imgdst (expand-file-name "static/images" garden-publish-site-directory))) + (make-directory out t) + (garden-publish--clean-generated out) + (garden-publish--ensure-index out "Blog") + (if (file-directory-p postsrc) + (dolist (f (directory-files postsrc t "\\.org\\'")) + (garden-publish--blog-one f out)) + (message "garden: blog source missing, skipping posts")) + (when (file-directory-p imgsrc) + (make-directory imgdst t) + (copy-directory imgsrc imgdst t t t)) + (message "garden: published blog to %s" out))) + +(defcustom garden-publish-pages-skip '("wiki-archive") "Page slugs that are never published." :type '(repeat string) :group 'garden) + +(defcustom garden-publish-pages-manifest (expand-file-name ".garden/pages.eld" garden-directory) "File recording the page files written by the last publish run." :type 'file :group 'garden) + +(defun garden-publish--load-pages-manifest () + "Read the pages manifest file and return its entries, or nil." + (when (file-exists-p garden-publish-pages-manifest) + (with-temp-buffer + (insert-file-contents garden-publish-pages-manifest) + (ignore-errors (read (current-buffer)))))) + +(defun garden-publish--save-pages-manifest (entries) + "Write ENTRIES to the pages manifest file." + (make-directory (file-name-directory garden-publish-pages-manifest) t) + (with-temp-file garden-publish-pages-manifest (prin1 entries (current-buffer)))) + +(defun garden-publish--page-one (file out-dir) + "Convert the page FILE to Markdown in OUT-DIR and return its name." + (let* ((parsed (garden-publish--parse-post file)) + (props (car parsed)) + (body (cdr parsed)) + (slug (garden-publish--clean-slug (or (cdr (assoc "slug" props)) (file-name-base file))))) + (unless (or (equal (cdr (assoc "status" props)) "draft") + (member slug garden-publish-pages-skip)) + (let* ((title (or (cdr (assoc "title" props)) (file-name-base file))) + (desc (cdr (assoc "description" props))) + (md (garden-publish--org-to-gfm + (garden-publish--strip-toc + (replace-regexp-in-string "/content/images/" "/images/" body)))) + (fm (concat "+++\n" + (format "title = %S\n" title) + (or (when (and desc (not (string-empty-p desc))) + (format "description = %S\n" desc)) + "") + "+++\n\n"))) + (with-temp-file (expand-file-name (concat slug ".md") out-dir) + (insert fm md)) + (concat slug ".md"))))) + +;;;###autoload +(defun garden-publish-pages () + "Export all standalone pages and remove stale ones from the site." + (interactive) + (let ((out (expand-file-name "content" garden-publish-site-directory)) + (src garden-publish-pages-source) + (written '())) + (make-directory out t) + (if (file-directory-p src) + (dolist (f (directory-files src t "\\.org\\'")) + (let ((name (garden-publish--page-one f out))) + (when name (push name written)))) + (message "garden: pages source missing, skipping pages")) + (let ((stale (seq-difference (garden-publish--load-pages-manifest) written))) + (dolist (name stale) + (let ((md (expand-file-name name out))) + (when (file-exists-p md) (delete-file md)))) + (garden-publish--save-pages-manifest written) + (if stale + (message "garden: published pages to %s (removed %d stale)" out (length stale)) + (message "garden: published pages to %s" out))))) + +(defcustom garden-publish-deploy-command "just publish" + "Shell command that deploys the generated site." + :type 'string :group 'garden) + +(defun garden-publish--post-files () + "Return the Org files of all blog posts, or nil if the source is missing." + (when (file-directory-p garden-publish-blog-source) + (directory-files garden-publish-blog-source t "\\.org\\'"))) + +(defun garden-publish--page-files () + "Return the Org files of all standalone pages, or nil if the source is missing." + (when (file-directory-p garden-publish-pages-source) + (directory-files garden-publish-pages-source t "\\.org\\'"))) + +(defun garden-publish--pick-file (prompt files) + "Pick one of FILES by base name with PROMPT." + (if (null files) + (user-error "No source files available") + (let ((table (mapcar (lambda (f) (cons (file-name-nondirectory f) f)) files))) + (cdr (assoc (completing-read prompt table nil t) table))))) + +;;;###autoload +(defun garden-publish-post (file) + "Export the single blog post FILE to the site blog directory." + (interactive (list (garden-publish--pick-file "Publish post: " (garden-publish--post-files)))) + (let ((out (expand-file-name garden-publish-blog-subdir garden-publish-site-directory)) + (props (car (garden-publish--parse-post file)))) + (if (equal (cdr (assoc "status" props)) "draft") + (message "garden: %s is a draft, not published" (file-name-base file)) + (make-directory out t) + (garden-publish--ensure-index out "Blog") + (garden-publish--blog-one file out) + (message "garden: published post %s → %s" (file-name-base file) out)))) + +;;;###autoload +(defun garden-publish-page (file) + "Export the single standalone page FILE to the site content directory." + (interactive (list (garden-publish--pick-file "Publish page: " (garden-publish--page-files)))) + (let* ((out (expand-file-name "content" garden-publish-site-directory)) + (name (progn (make-directory out t) (garden-publish--page-one file out)))) + (if (null name) + (message "garden: %s is a draft or skipped, not published" (file-name-base file)) + (let ((manifest (garden-publish--load-pages-manifest))) + (unless (member name manifest) + (garden-publish--save-pages-manifest (cons name manifest)))) + (message "garden: published page %s" name)))) + +;;;###autoload +(defun garden-publish-note-as-page (&optional file slug) + "Export the garden note FILE as the standalone page SLUG on the site. +Interactively, offers the current buffer's note when visiting one, +and prompts for the slug. The note file itself stays untouched; +tag it noexport if it should not also appear under /wiki/." + (interactive) + (let* ((current (buffer-file-name)) + (file (or file + (if (and current + (string-prefix-p (expand-file-name garden-directory) + (expand-file-name current)) + (y-or-n-p (format "Publish %s as a page? " + (file-name-nondirectory current)))) + current + (garden-publish--pick-file "Publish note as page: " (garden--note-files))))) + (parsed (garden-publish--parse-post file)) + (props (car parsed)) + (title (or (cdr (assoc "title" props)) (file-name-base file))) + (slug (garden-publish--clean-slug + (or slug + (read-string "Page slug: " (or (garden-publish--filename-slug file) + (garden-publish--clean-slug title)))))) + (md (garden-publish--org-to-gfm + (garden-publish--strip-toc + (replace-regexp-in-string "/content/images/" "/images/" (cdr parsed))))) + (out (expand-file-name "content" garden-publish-site-directory)) + (map (garden-publish--slug-map))) + (make-directory out t) + (with-temp-file (expand-file-name (concat slug ".md") out) + (insert (format "+++\ntitle = %S\n+++\n\n" title) md) + (garden-publish--rewrite-denote-links map)) + (message "garden: published note as page /%s" slug))) + +;;;###autoload +(defun garden-publish-one () + "Publish a single post, page or note, then offer to deploy." + (interactive) + (let* ((candidates + (append + (mapcar (lambda (f) (cons (concat "post: " (file-name-base f)) (cons #'garden-publish-post f))) + (garden-publish--post-files)) + (mapcar (lambda (f) (cons (concat "page: " (file-name-base f)) (cons #'garden-publish-page f))) + (garden-publish--page-files)) + (mapcar (lambda (f) (cons (concat "note: " (file-name-nondirectory f)) (cons #'garden-publish-note-as-page f))) + (garden--note-files)))) + (choice (cdr (assoc (completing-read "Publish one: " candidates nil t) candidates)))) + (funcall (car choice) (cdr choice)) + (when (y-or-n-p (format "Deploy now (%s)? " garden-publish-deploy-command)) + (garden-publish-deploy)))) + +;;;###autoload +(defun garden-publish () + "Publish the wiki, the blog and the pages to the site directory." + (interactive) + (garden-publish-wiki) + (garden-publish-blog) + (garden-publish-pages) + (message "garden: published wiki + blog + pages → %s" garden-publish-site-directory)) + +;;;###autoload +(defun garden-publish-deploy () + "Run the deploy command asynchronously in the site directory." + (interactive) + (let ((default-directory (expand-file-name garden-publish-site-directory))) + (async-shell-command garden-publish-deploy-command "*garden-deploy*"))) + +;;;###autoload +(defun garden-publish-all () + "Publish the whole site and then deploy it." + (interactive) + (garden-publish) + (garden-publish-deploy)) + +(provide 'garden-publish) +;;; garden-publish.el ends here |