310 lines
16 KiB
EmacsLisp
Executable File
310 lines
16 KiB
EmacsLisp
Executable File
;;; sitemaps.el --- Sitemap generators for org-publish -*- lexical-binding: t; -*-
|
|
|
|
;;; Commentary:
|
|
;; Custom :sitemap-function implementations for each publishing project.
|
|
;;
|
|
;; NOTE: Do NOT define `site-root' here. build-site.el owns that definition.
|
|
|
|
;;; Code:
|
|
|
|
(require 'cl-lib)
|
|
(require 'org)
|
|
|
|
;; ─────────────────────────────────────────────────────────────────────────────
|
|
;; Internal helpers
|
|
;; ─────────────────────────────────────────────────────────────────────────────
|
|
|
|
(defun z/sitemap--tag-html (tags-raw)
|
|
"Convert a raw FILETAGS string into an Org-mode HTML inline tag list.
|
|
Returns an empty string when TAGS-RAW is nil or blank."
|
|
(if (and tags-raw (string-match-p "\\S-" tags-raw))
|
|
(mapconcat
|
|
(lambda (tag)
|
|
(format "@@html:<a href=\"/tags/%s.html\"><span class=\"post-tag\">%s</span></a>@@"
|
|
tag tag))
|
|
(split-string tags-raw ":" t)
|
|
" ")
|
|
""))
|
|
|
|
(defun z/sitemap--entry-data (link base-dir)
|
|
"Extract (FULL-PATH DATE-STR TAGS-STR) for a sitemap ENTRY under BASE-DIR.
|
|
LINK is the raw [[file:...][...]] string produced by org-publish."
|
|
(let* ((filename (if (string-match "\\[\\[file:\\([^]]+\\)\\]" link)
|
|
(match-string 1 link)
|
|
link))
|
|
(full-path (expand-file-name filename base-dir))
|
|
(date (and (file-exists-p full-path)
|
|
(org-publish-find-date full-path org-publish-project-alist)))
|
|
(date-str (if date (format-time-string "%d-%m-%Y %H:%M" date) "no date"))
|
|
(tags-raw (and (file-exists-p full-path)
|
|
(with-temp-buffer
|
|
(insert-file-contents full-path)
|
|
(org-mode)
|
|
(cadr (assoc "FILETAGS"
|
|
(org-collect-keywords '("FILETAGS"))))))))
|
|
(list full-path date-str (z/sitemap--tag-html tags-raw) date)))
|
|
|
|
(defun z/sitemap--flat-list (title list base-dir section-title categories-rel)
|
|
"Render a flat bullet-point sitemap.
|
|
TITLE — org-publish title string
|
|
LIST — the raw list from org-publish (car is root node)
|
|
BASE-DIR — absolute path to the project's :base-directory
|
|
SECTION-TITLE — heading text, e.g. \"Posts\"
|
|
CATEGORIES-REL — relative path to categories.html from this project root"
|
|
(concat
|
|
"#+TITLE: " title "\n"
|
|
"#+OPTIONS: toc:nil num:nil\n\n"
|
|
(format "See the categories: @@html:<a href=\"%s\">Categories</a>@@\n\n" categories-rel)
|
|
"* " section-title "\n"
|
|
(mapconcat
|
|
(lambda (entry)
|
|
(when (consp entry)
|
|
(let* ((link (car entry))
|
|
(data (z/sitemap--entry-data link base-dir))
|
|
(date-str (nth 1 data))
|
|
(tags-str (nth 2 data)))
|
|
(format "- %s @@html:<span class=\"post-date\">%s</span>@@ %s"
|
|
link date-str tags-str))))
|
|
(cdr list)
|
|
"\n")))
|
|
|
|
;; ─────────────────────────────────────────────────────────────────────────────
|
|
;; Posts
|
|
;; ─────────────────────────────────────────────────────────────────────────────
|
|
|
|
(defun z/posts-sitemap (title list)
|
|
"Flat sitemap for org-posts."
|
|
(z/sitemap--flat-list title list
|
|
(site-path "posts/")
|
|
"Posts:"
|
|
"../home/categories.html"))
|
|
|
|
;; ─────────────────────────────────────────────────────────────────────────────
|
|
;; Blogs — flat (kept for compatibility, not used as default)
|
|
;; ─────────────────────────────────────────────────────────────────────────────
|
|
|
|
(defun z/blogs-sitemap (title list)
|
|
"Flat sitemap for org-blogs (use z/blogs-grouped-sitemap for the default)."
|
|
(z/sitemap--flat-list title list
|
|
(site-path "blogs/")
|
|
"Blogs:"
|
|
"../home/categories.html"))
|
|
|
|
;; ─────────────────────────────────────────────────────────────────────────────
|
|
;; Blogs — grouped by year → month
|
|
;; ─────────────────────────────────────────────────────────────────────────────
|
|
|
|
(defun z/blogs-grouped-sitemap (title list)
|
|
"Sitemap for org-blogs grouped by year and month, newest first."
|
|
(let ((data (make-hash-table :test 'equal)))
|
|
|
|
;; Collect into year-key → month-key → list of (link date-str tags-str time)
|
|
(dolist (entry (cdr list))
|
|
(when (consp entry)
|
|
(let* ((link (car entry))
|
|
(ed (z/sitemap--entry-data link (site-path "blogs/")))
|
|
(full-path (nth 0 ed))
|
|
(date-str (nth 1 ed))
|
|
(tags-str (nth 2 ed))
|
|
(time (nth 3 ed)))
|
|
(when time
|
|
(let* ((year (format-time-string "%Y" time))
|
|
(month (format-time-string "%B %Y" time))
|
|
(year-table (or (gethash year data)
|
|
(puthash year (make-hash-table :test 'equal) data))))
|
|
(puthash month
|
|
(cons (list link date-str tags-str time)
|
|
(gethash month year-table))
|
|
year-table))))))
|
|
|
|
;; Render
|
|
(let ((output (concat "#+TITLE: " title "\n"
|
|
"#+OPTIONS: toc:nil num:nil\n\n"
|
|
"See the categories: @@html:<a href=\"../home/categories.html\">Categories</a>@@\n\n")))
|
|
(dolist (year (sort (hash-table-keys data) #'string>))
|
|
(setq output (concat output "* " year "\n"))
|
|
(let ((year-table (gethash year data)))
|
|
(dolist (month (sort (hash-table-keys year-table)
|
|
(lambda (a b)
|
|
(time-less-p
|
|
(date-to-time (concat "01 " b))
|
|
(date-to-time (concat "01 " a))))))
|
|
(setq output (concat output "\n** " month "\n"))
|
|
(dolist (entry (sort (gethash month year-table)
|
|
(lambda (a b)
|
|
(time-less-p (nth 3 b) (nth 3 a)))))
|
|
(setq output
|
|
(concat output
|
|
(format "- %s @@html:<span class=\"post-date\">%s</span>@@ %s\n"
|
|
(nth 0 entry)
|
|
(nth 1 entry)
|
|
(nth 2 entry))))))))
|
|
output)))
|
|
|
|
;; ─────────────────────────────────────────────────────────────────────────────
|
|
;; Books
|
|
;; ─────────────────────────────────────────────────────────────────────────────
|
|
|
|
(defun z/books-sitemap (title list)
|
|
"Flat sitemap for org-books."
|
|
(z/sitemap--flat-list title list
|
|
(site-path "books/")
|
|
"Book Notes:"
|
|
"../home/categories.html"))
|
|
|
|
;; ─────────────────────────────────────────────────────────────────────────────
|
|
;; Year-scoped sitemaps (generic helper)
|
|
;; ─────────────────────────────────────────────────────────────────────────────
|
|
|
|
(defun z/year-grouped-sitemap (title list year base-dir categories-rel)
|
|
"Generic year-scoped, month-grouped sitemap.
|
|
YEAR is a string like \"2025\". BASE-DIR is the project root.
|
|
CATEGORIES-REL is the relative href to categories.html."
|
|
(let ((output (concat "#+TITLE: " title "\n"
|
|
"#+OPTIONS: toc:nil num:nil\n\n"
|
|
(format "See the categories: @@html:<a href=\"%s\">Categories</a>@@\n\n"
|
|
categories-rel)
|
|
"* " year "\n"))
|
|
(current-month nil))
|
|
(dolist (entry (cdr list))
|
|
(when (consp entry)
|
|
(let* ((link (car entry))
|
|
(ed (z/sitemap--entry-data link base-dir))
|
|
(date-str (nth 1 ed))
|
|
(tags-str (nth 2 ed))
|
|
(time (nth 3 ed))
|
|
(month-str (if time (format-time-string "%B %Y" time) "No date")))
|
|
(unless (equal month-str current-month)
|
|
(setq current-month month-str)
|
|
(setq output (concat output "\n** " month-str "\n")))
|
|
(setq output
|
|
(concat output
|
|
(format "- %s @@html:<span class=\"post-date\">%s</span>@@ %s\n"
|
|
link date-str tags-str))))))
|
|
output))
|
|
|
|
(defun z/2025-sitemap (title list)
|
|
"Sitemap for blogs/2025/ grouped by month."
|
|
(z/year-grouped-sitemap title list "2025"
|
|
(site-path "blogs/2025/")
|
|
"../../home/categories.html"))
|
|
|
|
(defun z/2026-sitemap (title list)
|
|
"Sitemap for blogs/2026/ grouped by month."
|
|
(z/year-grouped-sitemap title list "2026"
|
|
(site-path "blogs/2026/")
|
|
"../../home/categories.html"))
|
|
|
|
;; ─────────────────────────────────────────────────────────────────────────────
|
|
;; Career
|
|
;; ─────────────────────────────────────────────────────────────────────────────
|
|
|
|
(defun z/career-sitemap (title list)
|
|
"Sitemap for posts/career/ grouped by month."
|
|
(concat
|
|
(z/year-grouped-sitemap title list ""
|
|
(site-path "posts/career/")
|
|
"../../home/categories.html")
|
|
"\nSee the following page for more details: @@html:<a href=\"./career-intro.html\">Career Intro</a>@@\n"))
|
|
|
|
;; ─────────────────────────────────────────────────────────────────────────────
|
|
;; Categories
|
|
;; ─────────────────────────────────────────────────────────────────────────────
|
|
|
|
(defun z/categories-sitemap (title _list)
|
|
"Generate a categories overview by scanning tags across posts and blogs."
|
|
(let* ((expanded (org-publish-expand-projects org-publish-project-alist))
|
|
(posts (assoc "org-posts" expanded))
|
|
(blogs (assoc "org-blogs" expanded))
|
|
(files (cl-remove-if
|
|
(lambda (f)
|
|
(member (file-name-nondirectory f)
|
|
'("posts-list.org" "blogs-list.org"
|
|
"sitemap.org" "categories.org")))
|
|
(cl-remove-duplicates
|
|
(append (and posts (org-publish-get-base-files posts))
|
|
(and blogs (org-publish-get-base-files blogs)))
|
|
:test #'file-equal-p)))
|
|
(counts (make-hash-table :test 'equal)))
|
|
(dolist (f files)
|
|
(when (file-readable-p f)
|
|
(with-temp-buffer
|
|
(insert-file-contents f)
|
|
(org-mode)
|
|
(let* ((kw (org-collect-keywords '("FILETAGS" "TAGS")))
|
|
(raw (cadr (or (assoc "FILETAGS" kw)
|
|
(assoc "TAGS" kw)))))
|
|
(when raw
|
|
(dolist (tag (split-string raw ":" t))
|
|
(puthash tag (1+ (gethash tag counts 0)) counts)))))))
|
|
(let (tags)
|
|
(maphash (lambda (k _) (push k tags)) counts)
|
|
(setq tags (sort tags #'string-lessp))
|
|
(concat
|
|
"#+TITLE: " title "\n#+OPTIONS: toc:nil num:nil title:nil\n\n"
|
|
"* Categories (Includes both blogs and posts)\n"
|
|
(if tags
|
|
(mapconcat
|
|
(lambda (tag)
|
|
(format "- [[file:../tags/%s.org][@@html:<span class=\"post-tag\">%s</span>@@]] (%d)"
|
|
(z/tag-slug tag) tag (gethash tag counts)))
|
|
tags
|
|
"\n")
|
|
"_No tags found yet._")))))
|
|
|
|
;; ─────────────────────────────────────────────────────────────────────────────
|
|
;; WIP sitemap
|
|
;; ─────────────────────────────────────────────────────────────────────────────
|
|
|
|
(defun z/wip-file-p (file)
|
|
"Return non-nil if FILE is marked as work-in-progress.
|
|
|
|
A file is WIP when any of the following is true:
|
|
- It has a #+WIP: keyword with a non-empty value.
|
|
- Its FILETAGS contain :WIP:.
|
|
- Any top-level heading contains \"WIP\" (case-insensitive)."
|
|
(when (file-exists-p file)
|
|
(with-temp-buffer
|
|
(insert-file-contents file)
|
|
(org-mode)
|
|
(let* ((case-fold-search t)
|
|
(keywords (org-collect-keywords '("WIP" "FILETAGS")))
|
|
(wip (cadr (assoc "WIP" keywords)))
|
|
(filetags (cadr (assoc "FILETAGS" keywords))))
|
|
(or
|
|
(and wip (string-match-p "\\S-" wip))
|
|
(and filetags (string-match-p ":WIP:" (concat ":" filetags ":")))
|
|
(save-excursion
|
|
(goto-char (point-min))
|
|
(re-search-forward "^\\*+ .*WIP.*" nil t)))))))
|
|
|
|
(defun z/wip-sitemap (title list)
|
|
"Sitemap listing only entries whose source files are marked WIP."
|
|
(let ((items
|
|
(delq nil
|
|
(mapcar
|
|
(lambda (entry)
|
|
(when (consp entry)
|
|
(let* ((link (car entry))
|
|
(filename (if (string-match "\\[\\[file:\\([^]]+\\)\\]" link)
|
|
(match-string 1 link)
|
|
link))
|
|
(full-path (expand-file-name filename z/site-root)))
|
|
(when (z/wip-file-p full-path)
|
|
(let* ((date (org-publish-find-date full-path org-publish-project-alist))
|
|
(date-str (if date
|
|
(format-time-string "%d-%m-%Y %H:%M" date)
|
|
"")))
|
|
(format "- %s @@html:<span class=\"post-date\">%s</span>@@"
|
|
link date-str))))))
|
|
(cdr list)))))
|
|
(concat "#+TITLE: " title "\n"
|
|
"#+OPTIONS: toc:nil num:nil\n\n"
|
|
"* Work in progress\n"
|
|
(if items
|
|
(mapconcat #'identity items "\n")
|
|
"No items currently marked as WIP.\n"))))
|
|
|
|
(provide 'sitemaps)
|
|
|
|
;;; sitemaps.el ends here |