AlBasmala:
Blogging with Emacs & Org-mode (•̀ᴗ•́)و

;; A section tagged :abstract: is boxed too; its subsections stay outside the box, as a block cannot hold a heading.
(org-defblock abstract (:tag [:subsections ignore] &context contents)
  "Render a block in a slightly narrowed blueish box, titled \"Abstract\".

   Supported backends: HTML. "
   (format (concat
            "<div class=\"abstract\" style=\"border: 1px solid black;"
            "padding: 1%%; margin-top: 1%%; margin-bottom: 1%%;"
            "margin-right: 10%%; margin-left: 10%%; background-color: lightblue;\">"
            "<center> <strong class=\"tooltip\""
            "title=\"What's the goal of this article?\"> Abstract </strong> </center>"
            "%s </div>")
           contents))

* My Literate Emacs Config :emacs:lisp:
:PROPERTIES:
:DATE:        <2024-01-15>
:DESCRIPTION: A literate Emacs configuration, tangled from Org and readable as prose.
:REDIRECT:    ~/.emacs.d/init.org
:END:

* Holy Books: Quran & Bible look-ups in Org-mode :emacs:
:PROPERTIES:
:DATE:        <2021-10-25>
:CUSTOM_ID:   holy-books-in-org-mode
:REDIRECT:    https://raw.githubusercontent.com/alhassy/holy-books/main/holy-books.org
:END:

* AlBasmala :emacs:lisp:
:PROPERTIES:
:DATE:        <2020-01-01>
:DESCRIPTION: How this blog works.
:CUSTOM_ID:   albasmala
:SITE_NAV:    AlBasmala
:END:

(provide 'AlBasmala)

((org-mode . ((eval . (progn
                        (require 'AlBasmala (expand-file-name "AlBasmala"
                                              (locate-dominating-file default-directory ".dir-locals.el")))
                        (my/blogging-mode 1))))))

 1: (defun blog-new-article ()
 2: "Make a new article for my blog; prompting for the necessary ingredients.
 3: 
 4: If the filename entered already exists, we simply write to it.
 5: The user notices this and picks a new name.
 6: 
 7: This sets up a new article based on existing tags and posts.
 8: + Use C-SPC to select multiple tag items
 9: 
10: Under `my/blogging-mode', every save, C-x C-s, live-previews the article."
11:   (interactive)
12:   (let (file desc)
13: 
14:     ;; Subdirectories are welcome, e.g., "emacs/new-trick.org"; the blog stays flat regardless.
15:     (setq file (expand-file-name
16:                 (completing-read "Filename (Above are existing): "
17:                                  (mapcar (lambda (f) (file-relative-name f (expand-file-name blog-posts-directory)))
18:                                          (blog--org-files)))
19:                 blog-posts-directory))
20:     (make-directory (file-name-directory file) t)
21: 
22:     ;; For some reason, 'find-file' in the thread above
23:     ;; wont let the completing-read display the possible completions.
24:     (find-file file)
25: 
26:     (insert "#+title: " (read-string "Title: ")
27:             "\n#+author: " user-full-name
28:             "\n#+email: "  user-mail-address
29:             "\n#+modified: " (format-time-string "%Y-%m-%d")
30:             "\n#+filetags: " (s-join " " (completing-read-multiple "Tags: " blog-tags))
31:             "\n#+fileimage: emacs-birthday-present.png"
32:             ;; "\n#+fileimage: " (completing-read
33:             ;;                    "Image: "
34:             ;;                    (mapcar #'f-filename (f-entries "~/blog/resources/")))
35:             ;; "\n#+include: ../MathJaxPreamble.org" ;; TODO. Is this someting I actually want here? If so, then consider tangling it from AlBasmala! (and add the whitespace-MathJax setup from above!)
36:             "\n#+description: "
37:                (setq desc (read-string "Article Purpose: "))
38:             "\n\n* Abstract :ignore: \n" desc
39:             "\n\n* ???")
40:     (save-buffer)))

(defun blog-new-post ()
  "Insert a new article skeleton at point in a multiple-style container file.

Prompts for title, description, and (optionally) tags.  The image is
selected automatically from blog-tag-image-alist based on the tags entered
-- no image prompt required.  It can be overridden afterwards by editing the
:IMAGE: property in the drawer.

The :draft: heading tag is added automatically so the article is treated as
a draft until you remove it before publishing."
  (interactive)
  (unless (blog--multiple-style-p)
    (user-error "Not a multiple-style file; use blog-new-article for standalone posts"))
  (let* ((title       (read-string "Article title: "))
         (description (read-string "One-line description: "))
         (tags-input  (read-string "Tags (space-separated, optional): "))
         (tags        (s-split " " tags-input t))
         (image       (blog--image-for-tags tags))
         (tag-suffix  (if tags (concat ":" (s-join ":" tags) ":") ""))
         (today       (format-time-string "%Y-%m-%d")))
    (unless (bolp) (newline))
    (insert
     "* " title " :draft:" tag-suffix "\n"
     ":PROPERTIES:\n"
     ":MODIFIED:    " today "\n"
     ":DESCRIPTION: " description "\n"
     ":IMAGE:       " image "\n"
     ":END:\n"
     "\n"
     "** Abstract :ignore:\n"
     description "\n"
     "\n"
     "** ???\n")))

(cl-defun blog--git (cmd &rest args)
  "Execute git command CMD, which may have %s placeholders whose values are positional in ARGS."
  (let ((default-directory (expand-file-name blog-posts-directory)))
    (shell-command (apply #'format (concat "git " cmd) args))))

(defun blog-insert-image (file)
  "Copy FILE into ~/blog/resources/, git-add it, and insert an Org link, relative to this file, at point.

With a \\[universal-argument] prefix, prompts for a new filename after the
default name is pre-filled so you can rename the resource before committing."
  (interactive "fImage file: ")
  (let* ((default-name (f-filename file))
         (dest-name (if current-prefix-arg
                        (read-string "Name for image (with extension): " default-name)
                      default-name))
         (dest (expand-file-name dest-name (expand-file-name "resources/" blog-posts-directory))))
    (copy-file file dest t)
    (blog--git "add resources/%s" dest-name)
    (insert (format "[[file:%s]]" (file-relative-name dest)))  ; Relative to this file; `blog--link' re-roots it.
    (org-display-inline-images nil t (line-beginning-position) (line-end-position))))

(defun blog-insert-screenshot ()
  "Take an interactive screenshot, move it to ~/blog/resources/, git-add, insert link.

Uses macOS screencapture -i (crosshair selector).  After the screenshot is taken
you are prompted for a meaningful name; the timestamp default is just a fallback."
  (interactive)
  (let* ((tmp (make-temp-file "blog-screenshot-" nil ".png")))
    (shell-command (format "screencapture -i %s" (shell-quote-argument tmp)))
    (if (not (file-exists-p tmp))
        (message "Screenshot cancelled.")
      (let* ((default-name (format "screenshot-%s.png" (format-time-string "%Y%m%d-%H%M%S")))
             (dest-name (read-string "Name for screenshot (with extension): " default-name))
             (dest (expand-file-name dest-name (expand-file-name "resources/" blog-posts-directory))))
        (rename-file tmp dest t)
        (blog--git "add resources/%s" dest-name)
        (insert (format "[[file:%s]]" (file-relative-name dest)))  ; Relative to this file; `blog--link' re-roots it.
        (org-display-inline-images nil t (line-beginning-position) (line-end-position))))))

(defvar blog-title "Life & Computing Science"
  "Title of the blog.")

(defvar blog-url "https://alhassy.com"
  "URL of the blog.")

(defun blog--url (&rest path)
  "PATH… ↦ its absolute URL on the blog; e.g., (blog--url \"tag-\" \"emacs\" \".html\")."
  (apply #'concat blog-url "/" path))

(defun blog--history-url (file)
  "FILE ↦ the GitHub commit history of FILE, by its path relative to `blog-posts-directory'."
  (format "https://github.com/alhassy/alhassy.github.io/commits/master/%s"
          (file-relative-name (expand-file-name file) (expand-file-name blog-posts-directory))))

(defvar blog-publish-directory "~/blog/public/"
  "Directory containing published HTML files.

HTML is a build artefact; the .org sources in ~/blog/ are first-class.
On master we keep only sources; CI exports everything to public/ and deploys
public/'s contents to the gh-pages branch that GitHub Pages serves.
That gives flat URLs (alhassy.com/foo) while the master working tree stays clean.")

(defvar blog-posts-directory "~/blog"
  "Directory containing source Org files.

All article .org files ---including AlBasmala.org itself--- live here, in any
subdirectories we like; see `blog--org-files'.  blog--compute-posts-and-pages collects every .org file with #+date:
as a post and every file with #+site_nav: as a nav page; files with neither
(e.g. MathJaxPreamble.org) are silently skipped.
See blog-make-index-page and blog-publish-directory.")

(defun blog--org-files ()
  "Every .org file under `blog-posts-directory', recursively; subdirectories are for us, not the blog.

Skips hidden directories, `blog-publish-directory', and resources/ (vendored :REDIRECT: sources)."
  (let ((root (expand-file-name blog-posts-directory))
        (skip (list (directory-file-name (expand-file-name blog-publish-directory))
                    (expand-file-name "resources" blog-posts-directory))))
    (directory-files-recursively
     root "\\`[^.#].*\\.org\\'" nil
     (lambda (dir) (not (or (member dir skip) (string-prefix-p "." (f-filename dir))))))))

(defun blog--draft-file-p (file)
  "FILE ↦ non-nil when it lives under ~/blog/draft/, whose every article is a draft."
  (file-in-directory-p file (expand-file-name "draft" blog-posts-directory)))

(defun blog--info (post-filename)
  "Extract the `#+BLOG_KEYWORD: VALUE` pairs from POST-FILENAME.

Example use: (blog--info \"~/blog/HeytingAlgebra.org\")

For container sub-articles, the temp file may carry synthetic keywords:
  #+history_url:         ---overrides the auto-computed GitHub history URL
  #+htmlized_source_url: ---URL for the per-article colourised source badge
These are ignored for ordinary standalone files (regex yields nil, fallback applies)."
  (let ((case-fold-search t))
    (with-temp-buffer
      (insert-file-contents post-filename)
      (let* ((keyword-pairs
              (cl-loop for (prop.name prop.regex prop.default) on
                    `("title"                "^\\#\\+title:[ ]*\\(.+\\)$"                ,post-filename
                      "date"                 "^\\#\\+modified:[ ]*\\(.+\\)$"             ,(format-time-string "%Y-%m-%d")
                      "image"                "^\\#\\+fileimage: \\(.*\\)"                "emacs-birthday-present.png 350 350"
                      "description"          "^\\#\\+description:[ ]*\\(.+\\)$"          "I learned something neat, and wanted to share!"
                      "tags"                 "^\\#\\+filetags:[ ]*\\(.+\\)$"             "" ;; String; Space-separated
                      "history_url"          "^\\#\\+history_url:[ ]*\\(.+\\)$"          nil
                      "htmlized_source_url"  "^\\#\\+htmlized_source_url:[ ]*\\(.+\\)$"  nil
                      "site_nav"             "^\\#\\+site_nav:[ ]*\\(.+\\)$"             nil
                      "modified"             "^\\#\\+modified:[ ]*\\(.+\\)$"             nil
                      )
                  by 'cdddr
                  ;; See: https://stackoverflow.com/questions/19774603/convert-alist-to-from-regular-list-in-elisp
                  do (goto-char (point-min))
                  collect (cons prop.name
                                (if (search-forward-regexp prop.regex nil t)
                                    (match-string 1)
                                  prop.default)))))
        (-snoc
         (cons
          (cons "file" (f-base post-filename))
          keyword-pairs)
         (cons "url" (blog--url (f-base post-filename)))
         ;; A draft says #+draft: t, or lives under draft/; the temp file of a container draft says the former.
         (cons "draft" (when (or (blog--draft-file-p post-filename)
                                 (progn (goto-char (point-min))
                                        (re-search-forward "^#\\+draft:[ ]*t[ ]*$" nil t)))
                         "t"))
         ;; Prefer an explicit #+history_url: (injected for container sub-articles)
         ;; over the auto-derived URL based on the file basename.
         (cons "history"
               (or (cdr (assoc "history_url" keyword-pairs))
                   (blog--history-url post-filename)))
         (cons "abstract" (when-let ((bounds (blog--abstract-bounds)))
                            (buffer-substring-no-properties (car bounds) (cdr bounds)))))))))

;; Convenient accessor methods: Given a JSON hashmap, get the specified key values.
;; Later, we redefine these, for example `@image' will actually produces the HTML for the image.
;; Example usage: (@title (seq-elt posts 0))  ⇒  "Java CheatSheet"

;; Extract the '#+title:' from POST-FILENAME.
(defun @title       (json) (map-elt json "title"))

(defun @draft? (json)
  "JSON ↦ non-nil when it's a draft: published at its URL, yet unlisted; see §“Drafts”."
  (equal "t" (map-elt json "draft")))

(defun blog--title-html (title)
  "Strip Org export-snippet markers from TITLE so embedded HTML renders.

Titles like 'AlBasmala: @@html: <br>@@ …' carry Org export snippets that
`#+begin_export html' blocks and raw format strings ship verbatim ---so the
`@@html:' / `@@' markers leak into the output.  Axe them, keeping the payload
(here, the literal `<br>') so HTML contexts render it as intended.  RSS feeds
should keep calling (esc (@title post)) and avoid this helper: `<br>' would
then escape to '&lt;br&gt;' and be shown as text."
  (thread-last title
               (string-replace "@@html:" "")
               (string-replace "@@" "")))

;; TODO: Consider using: (format-time-string "%d %b %Y" ⋯) to have the same format across all articles.
(defun @date (json)
  "Extract the #+modified: field from JSON."
  (map-elt json "date"))

(defun @file        (json) (map-elt json "file"))
(defun @slug        (json) (map-elt json "slug"))
(defun @description (json) (map-elt json "description"))
(defun @abstract    (json) (map-elt json "abstract"))

;; Returns absolute URL to the published POST-FILENAME.
;;
;; This function concatenates publish URL and generated custom filepath to the
;; published HTML version of the post.
;;
(defun @url                  (json) (map-elt json "url"))

;; For container sub-articles, the synthetic #+htmlized_source_url: keyword
;; carries the URL of the per-article colourised source view.
;; Returns nil for ordinary standalone articles (blog--footer falls back to blog--htmlize-file).
(defun @htmlized_source_url  (json) (map-elt json "htmlized_source_url"))

(defun blog--file-keyword (file-or-nil key &optional default)
  "Return the value of `#+KEY:' as a trimmed string.

If FILE-OR-NIL is nil, scan the current buffer; otherwise read FILE-OR-NIL
into a temp buffer first.  Returns DEFAULT when the keyword is absent.
Case-insensitive on the key.  KEY omits the leading `#+' and trailing `:'."
  (let ((case-fold-search t)
        (rx (concat "^#\\+" (regexp-quote key) ":[ ]*\\(.*\\)$")))
    (cl-flet ((scan ()
                (save-excursion
                  (goto-char (point-min))
                  (if (re-search-forward rx nil t) (s-trim (match-string 1)) default))))
      (if (null file-or-nil)
          (scan)
        (with-temp-buffer
          (insert-file-contents file-or-nil)
          (scan))))))

(defun blog--article-style (&optional filename)
  "Return the #+article_style keyword for FILENAME (default: current buffer file).
Returns \"multiple\" or \"standalone\" (the default when the keyword is absent)."
  (let ((file (or filename (buffer-file-name))))
    (if (not file)
        "standalone"
      (blog--file-keyword file "article_style" "standalone"))))

(defun blog--make-slug (title)
  "Convert TITLE to a URL-safe kebab-case slug.

Lowercases, strips non-alphanumeric characters (keeping spaces and existing
dashes), then collapses runs of spaces/dashes into a single dash."
  (thread-last title
    downcase
    (replace-regexp-in-string "[^[:alnum:][:space:]-]" "")
    (replace-regexp-in-string "[[:space:]]+" "-")
    (replace-regexp-in-string "-+" "-")
    (replace-regexp-in-string "^-\\|-$" "")))

(defun blog--multiple-style-p (&optional file)
  "Return non-nil when FILE (or the current buffer) is a multiple-style container."
  (equal "multiple" (if file
                        (blog--article-style file)
                      (blog--file-keyword nil "article_style" "standalone"))))

(defun blog--find-info-by-slug (slug infos)
  "Return the first entry in INFOS whose slug matches SLUG, or nil."
  (seq-find (lambda (a) (equal (@slug a) slug)) infos))

(defun blog--info-subtree-abstract (headline-node)
  "Return the abstract text for HEADLINE-NODE, or nil.

Priority:
1. :ABSTRACT: property on the headline.
2. A child heading whose title matches /abstract/i (e.g. ** Abstract :ignore:).
3. The first paragraph element in the heading body."
  (or
   ;; 1. Explicit property
   (org-element-property :ABSTRACT headline-node)
   ;; 2. Child heading named Abstract
   (org-element-map headline-node 'headline
     (lambda (child)
       (when (and (= (org-element-property :level child)
                    (1+ (org-element-property :level headline-node)))
                  (string-match-p "abstract"
                                  (downcase (or (org-element-property :raw-value child) ""))))
         (org-element-interpret-data (org-element-contents child))))
     nil t)
   ;; 3. First paragraph fallback
   (org-element-map headline-node 'paragraph
     (lambda (para) (org-element-interpret-data para))
     nil t)))

(defun blog--info-subtree (headline-node container-file slug)
  "Extract post metadata for HEADLINE-NODE from CONTAINER-FILE with SLUG.

Returns nil when the headline carries a :noexport: or :ignore: tag, the COMMENT keyword,
or is the footnote section: none of these is an article.
Returns an alist with the same keys as blog--info plus \"slug\" and \"container\"."
  (let* ((heading-tags (mapcar #'downcase
                               (org-element-property :tags headline-node))))
    (unless (or (member "noexport" heading-tags)
                (member "ignore" heading-tags)
                (org-element-property :commentedp headline-node)
                (org-element-property :footnote-section-p headline-node))
      (let* (;; draft?
             (draft? (or (member "draft" heading-tags)
                         (equal "t" (org-element-property :DRAFT headline-node))
                         (blog--draft-file-p container-file)))
             ;; title: :TITLE: property overrides heading text
             (title (or (org-element-property :TITLE headline-node)
                        (org-element-property :raw-value headline-node)))
             ;; date ---prefer :MODIFIED:, fall back to :DATE: for old articles
             (date-raw (or (org-element-property :MODIFIED headline-node)
                           (org-element-property :DATE headline-node)))
             (date (if date-raw
                       (replace-regexp-in-string "[<>]" "" date-raw)
                     (format-time-string "%Y-%m-%d")))
             ;; description
             (description (or (org-element-property :DESCRIPTION headline-node)
                              "I learned something neat, and wanted to share!"))
             ;; image: explicit :IMAGE: property wins; then a :REDIRECT: source's own #+fileimage:; then tags
             (image (or (org-element-property :IMAGE headline-node)
                        (and (org-element-property :REDIRECT headline-node)
                             (blog--redirect-keyword slug "fileimage"))
                        (blog--image-for-tags heading-tags)))
             ;; tags: merge :TAGS: property with heading tags; strip structural tags
             (structural-tags '("noexport" "draft" "ignore" "details" "details_orange"
                                "details_green" "header" "reexport" "noreexport"))
             (prop-tags  (s-split " " (or (org-element-property :TAGS headline-node) "") t))
             (org-tags   (seq-remove (lambda (tag) (member tag structural-tags)) heading-tags))
             (all-tags   (seq-uniq (append prop-tags org-tags)))
             (tags-str   (s-join " " all-tags))
             ;; abstract
             (abstract (blog--info-subtree-abstract headline-node))
             ;; urls
             (container-base (f-base container-file))
             (url      (blog--url slug))
             (redirect (org-element-property :REDIRECT headline-node))
             ;; A redirected article's history is its source's, when that's on GitHub.
             (history  (or (and redirect (blog--redirect-history-url redirect))
                           (blog--history-url container-file))))
        (list (cons "file"        container-base)
              (cons "slug"        slug)
              (cons "container"   container-base)
              (cons "title"       title)
              (cons "date"        date)
              (cons "image"       image)
              (cons "description" description)
              (cons "tags"        tags-str)
              (cons "url"         url)
              (cons "history"     history)
              (cons "abstract"    abstract)
              (cons "draft"       (if draft? "t" nil))
              (cons "redirect"    redirect)
              (cons "load"        (org-element-property :LOAD headline-node))
              (cons "modified"    (org-element-property :MODIFIED headline-node))
              (cons "site_nav"    (org-element-property :SITE_NAV headline-node)))))))

(defun blog--info-multiple (container-file)
  "Return a list of post-alists for all publishable top-level headings in CONTAINER-FILE.

CONTAINER-FILE must carry #+article_style: multiple.
Headings tagged :noexport: or carrying the COMMENT keyword are excluded.
Headings tagged :draft: are included but marked."
  (with-temp-buffer
    (insert-file-contents container-file)
    (org-mode)
    (let* ((tree (org-element-parse-buffer))
           ;; Collect all level-1 headings
           (top-headings
            (org-element-map tree 'headline
              (lambda (h)
                (when (= (org-element-property :level h) 1) h))))
           ;; A slug is the heading's :CUSTOM_ID:.  Until C-x C-s stamps one, fall back to
           ;; what it will stamp; `blog--validate-slugs' catches any collision.
           (slugs
            (mapcar (lambda (h)
                      (or (org-element-property :CUSTOM_ID h)
                          (blog--make-slug (or (org-element-property :TITLE h)
                                               (org-element-property :raw-value h)))))
                    top-headings)))
      ;; Build alists, skipping noexport/COMMENT headings (blog--info-subtree returns nil for them);
      ;; a :REDIRECT: to a container becomes that container's articles.
      (mapcan #'blog--redirected-container-infos
              (delq nil
                    (cl-mapcar (lambda (h slug) (blog--info-subtree h container-file slug))
                               top-headings slugs))))))

(defun blog--redirected-container-infos (info)
  "INFO ↦ (INFO), or the infos of its vendored :REDIRECT: source's articles when that's a container.

Each inherits INFO's redirect, load, history, draft, and tags, and remembers INFO's slug as
\"redirect-slug\", which names the vendored file; see §“A REDIRECT to a container”."
  (let ((vendored (and (map-elt info "redirect")
                       (expand-file-name (concat blog-redirects-subdir (@slug info) ".org") blog-posts-directory))))
    (if (not (and vendored (file-exists-p vendored) (blog--multiple-style-p vendored)))
        (list info)
      (mapcar (lambda (article)
                (append (list (cons "redirect-slug" (@slug info))
                              (cons "tags" (s-join " " (seq-uniq (s-split " " (concat (map-elt info "tags") " " (map-elt article "tags")) t)))))
                        (map-filter (lambda (key _) (member key '("redirect" "load" "history" "draft"))) info)
                        article))
              (blog--info-multiple vendored)))))

  1: (defun blog--date-p (str)
  2:   "STR ↦ non-nil iff it names a real calendar day; e.g., “2026-05-04 Mon” ↦ t, “Fri” ↦ nil, “2023-02-30” ↦ nil."
  3:   (pcase-let ((`(,_ ,_ ,_ ,day ,month ,year) (parse-time-string (or str ""))))
  4:     (and day month year (<= 1 month 12) (<= 1 day (date-days-in-month year month)))))
  5: 
  6: (defvar blog--file-infos-cache (make-hash-table :test #'equal)
  7:   "FILE ↦ (MTIME . INFOS): what `blog--file-infos' last computed for FILE.")
  8: 
  9: (defun blog--file-infos (file)
 10:   "FILE ↦ its post infos (nil when unpublishable), recomputed only when FILE's mtime moves.
 11: 
 12: C-x C-s refreshes the registry on every save; with the cache that costs one
 13: `file-attributes' per file, re-reading only the files that actually changed."
 14:   (let ((mtime (file-attribute-modification-time (file-attributes file)))
 15:         (hit (gethash file blog--file-infos-cache)))
 16:     (if (and hit (equal mtime (car hit)))
 17:         (cdr hit)
 18:       (let ((infos (when (blog--publishable-p file)
 19:                      ;; Each info remembers its source's path, e.g., "emacs/foo.org", for error messages.
 20:                      (let ((source (file-relative-name file (expand-file-name blog-posts-directory))))
 21:                        (mapcar (lambda (info) (cons (cons "source" source) info))
 22:                                (if (blog--multiple-style-p file)
 23:                                    (blog--info-multiple file)
 24:                                  (list (blog--info file))))))))
 25:         (dolist (info infos)
 26:           (lf-assert (map-elt info "source") t
 27:                      (@title info)           t
 28:                      (@date info)            (blog--date-p it)))
 29:         (puthash file (cons mtime infos) blog--file-infos-cache)
 30:         infos))))
 31: 
 32: (defun blog--compute-posts-and-pages ()
 33:   "Scan every .org file under `blog-posts-directory' and return (posts . pages).
 34: 
 35: Every .org file is processed uniformly ---there is no special-cased directory.
 36: Container files (#+article_style: multiple) yield many post entries; standalone
 37: files yield one.  A file with #+site_nav: contributes a nav-page entry instead
 38: of (or in addition to) a post entry.
 39: 
 40: posts ---all entries, sorted newest-first.
 41: pages ---site_nav entries, unsorted (used for the nav bar)."
 42:   (let ((posts '())
 43:         (pages '()))
 44:     (dolist (file (blog--org-files))
 45:       (dolist (info (blog--file-infos file))
 46:         (when (map-elt info "site_nav") (push info pages))
 47:         (push info posts)))
 48:     (cons (sort posts (lambda (a b)
 49:                         (time-less-p (date-to-time (@date b))
 50:                                      (date-to-time (@date a)))))
 51:           pages)))
 52: 
 53: (defun blog--rebuild-preamble ()
 54:   "Regenerate blog-page-preamble from blog-pages.
 55: Called automatically by blog--refresh-posts; also useful to call
 56: interactively after editing :SITE_NAV: headings."
 57:   (setq blog-page-preamble
 58:         (concat
 59:          "<div class=\"header\">\n"
 60:          "  <a href=\"https://alhassy.github.io/\" class=\"logo\">Life & Computing Science</a>\n"
 61:          "  <br/>\n"
 62:          (mapconcat (lambda (p)
 63:                       (format "  <a href=\"%s\">%s</a>\n" (@url p) (map-elt p "site_nav")))
 64:                     blog-pages "")
 65:          ;; A red badge on any live page means CI failed, so the site lags master.
 66:          "  <br/><a href=\"https://github.com/alhassy/alhassy.github.io/actions/workflows/ci.yml\">"
 67:          "<img style=\"vertical-align:middle\" alt=\"build status\""
 68:          " src=\"https://github.com/alhassy/alhassy.github.io/actions/workflows/ci.yml/badge.svg?branch=master\"></a>\n"
 69:          "</div>")))
 70: 
 71: (defun blog--refresh-posts ()
 72:   "Recompute blog-posts, blog-pages, and blog-tags from source org files."
 73:   (let ((result (blog--compute-posts-and-pages)))
 74:     (setq blog-posts (car result))
 75:     (setq blog-pages (cdr result))
 76:     (setq blog-tags
 77:           (sort (seq-uniq (mapcan #'@tag-list (blog--listed-posts))) #'string<))
 78:     (blog--rebuild-preamble)))
 79: 
 80: (defun blog--listed-posts ()
 81:   "`blog-posts' sans drafts: what the index, tag pages, and RSS feeds list."
 82:   (seq-remove #'@draft? blog-posts))
 83: 
 84: (defvar blog-page-preamble ""
 85:   "HTML injected at the top of every exported page: the site nav bar.
 86: Set by blog--rebuild-preamble whenever blog-pages changes.")
 87: 
 88: (defvar blog-page-header ""
 89:   "HTML injected into the <head> of every exported page: CSS, JS, MathJax, etc.
 90: Set once at load time by the setq block near the blog-banner section.")
 91: 
 92: (defvar blog-posts nil
 93:   "All post metadata, sorted newest-first. Initialized by `my/blogging-mode' and `blog-publish-all'; refresh with (blog--refresh-posts).")
 94: 
 95: (defvar blog-pages nil
 96:   "Site navigation page metadata (subtrees with :SITE_NAV: t).
 97: These appear as header links on every page but not as blog post cards.
 98: Initialized by `my/blogging-mode' and `blog-publish-all'; refresh with (blog--refresh-posts).")
 99: 
100: (defvar blog-tags nil
101:   "Tags for my blog articles. Initialized by `my/blogging-mode' and `blog-publish-all'; refresh with (blog--refresh-posts).")

(defun blog--validate-slugs ()
  "Signal a `user-error' when a container slug isn't lower-case kebab-case, or two articles share a slug.

Scans blog-posts, which covers both standalone and container articles.  The
effective slug is the :CUSTOM_ID: (container subtrees) or the file basename
(standalone articles); both land at the same URL, so both must be globally
unique.  Only :CUSTOM_ID: slugs must be kebab-case: a standalone basename
like =PathCat= is a long-published URL."
  (let ((seen (make-hash-table :test #'equal)))
    (dolist (p blog-posts)
      (let* ((slug   (or (@slug p) (@file p)))  ; effective URL slug
             (source (format "\"%s\" (%s)"
                             (or (map-elt p "title") slug)
                             (or (map-elt p "source") slug)))
             (prior  (gethash slug seen)))
        (when (and (@slug p) (not (equal slug (blog--make-slug slug))))
          (user-error "Slug \"%s\" of %s isn't lower-case kebab-case; use :CUSTOM_ID: %s"
                      slug source (blog--make-slug slug)))
        (when prior
          ;; Subdirectories don't reach the flat site: emacs/foo.org and life/foo.org both claim foo.html.
          (user-error "Duplicate slug \"%s\":\n  already claimed by %s\n  also claimed by %s\n  %s"
                      slug prior source
                      (if (@slug p) "Change one of the :CUSTOM_ID: properties."
                        "Rename one of the files; subdirectories don't count, the site is flat.")))
        (puthash slug source seen)))))

(defconst blog--sanitise-title-js
  "<script> window.parent.document.title =  window.parent.document.title.replace(/@@.*@@/, \"\") </script>"
  "Strip any `@@backend:...@@' from the browser frame's title.")

(defun blog--header-html (post)
  "POST ↦ the site nav, CSS/JS stack, and fancy title that open every article."
  (concat
   blog-page-preamble
   blog-page-header
   "<link href=\"https://alhassy.github.io/org-notes-style.css\" rel=\"stylesheet\" type=\"text/css\" />"
   "<link href=\"https://alhassy.github.io/floating-toc.css\" rel=\"stylesheet\" type=\"text/css\" />"
   "<link href=\"https://alhassy.github.io/blog-banner.css\" rel=\"stylesheet\" type=\"text/css\" />"
   (format "<br><center><h1 class=\"post-title\">%s</h1></center>" (blog--title-html (@title post)))))

;; Every page on the site ---index and tag pages included--- gets stable, human-named anchors.
(org-export-define-derived-backend 'blog-page 'html
  :options-alist '((:html-prefer-user-labels nil nil t))
  :filters-alist '((:filter-parse-tree . blog--stable-headline-ids)
                   (:filter-final-output . blog--no-random-ids)))

;; Never export a broken link; e.g., a `doc:' link to nothing errors rather than shipping an empty tooltip.
(setq org-export-with-broken-links nil)

;; Articles additionally get the blog look.
(org-export-define-derived-backend 'blog 'blog-page
  :options-alist '((:with-toc nil "toc" 2)
                   (:with-drawers nil "d" nil)
                   (:with-title nil "title" nil)
                   (:html-postamble nil "html-postamble" nil)
                   (:html-table-caption-above nil nil nil)
                   (:html-format-headline-function nil nil #'blog--format-headline))
  :filters-alist '((:filter-options . blog--draft-noindex))
  :translate-alist '((headline . blog--headline)
                     (link . blog--link)
                     (inner-template . blog--inner-template)))

(defun blog--draft-noindex (info _backend)
  "INFO ↦ INFO, with a noindex robots tag in a draft's <head>, so search engines skip it."
  (when (@draft? (blog--info (plist-get info :input-file)))
    (plist-put info :html-head-extra
               (concat (plist-get info :html-head-extra) "\n<meta name=\"robots\" content=\"noindex\">")))
  info)

(defvar blog--link-base-directory nil
  "Directory that relative file links resolve against; nil means the exported file's own directory.

`blog--publish-single-subtree' binds it to the container's directory, since it exports a temp copy.")

(defun blog--link (link desc info)
  "Org's HTML for LINK, a relative file path re-rooted at `blog-posts-directory'; the site is flat.

By way of example, in =emacs/foo.org=, =[[file:../resources/x.png]]= ↦ =resources/x.png= and
=[[file:../life/bar.org]]= ↦ =bar.html=, since every page is served from the root.  Files outside
the blog keep their links as written.  Radio links point at their =<<<target>>>='s label, not a random id."
  (let ((root (file-name-as-directory (expand-file-name blog-posts-directory)))
        (base (or blog--link-base-directory
                  (file-name-directory (or (plist-get info :input-file) default-directory))))
        (path (org-element-property :path link)))
    (when (and (equal (org-element-property :type link) "file")
               (not (file-name-absolute-p path))
               (file-in-directory-p base root))
      (let ((target (expand-file-name path base)))
        ;; Another article is a sibling on the flat site, wherever its source lives.
        (org-element-put-property link :path (if (equal (file-name-extension target) "org")
                                                 (file-name-nondirectory target)
                                               (file-relative-name target root)))))
    ;; Org's own radio links use a random id, while their <<<target>>> uses its label; agree on the label.
    (if-let ((radio (and (equal (org-element-property :type link) "radio")
                         (org-export-resolve-radio-link link info))))
        (format "<a href=\"#%s\">%s</a>" (org-html--reference radio info) desc)
      (org-html-link link desc info))))

(defun blog--inner-template (contents info)
  "(CONTENTS, INFO) ↦ header ⊕ tags ⊕ image ⊕ badges ⊕ Org's own body (TOC titled Ξ) ⊕ footer."
  (let* ((file (plist-get info :input-file))
         (post (blog--info file)))
    (concat
     (blog--header-html post)
     (when (@draft? post)
       (concat "<center><p style=\"background:#fff3cd;border:1px dashed #b58900;padding:0.5em;"
               "max-width:40em;\">🚧 <b>Draft</b> &mdash;unlisted while I think it over; "
               "please don't share it just yet.</p></center>"))
     blog--sanitise-title-js
     "<center>" (@tags post) "</center>"
     (@image post (blog--url "resources/"))
     (blog--badges-bar post file)
     (replace-regexp-in-string "<h\\([0-9]\\)>Table of Contents</h\\1>"
                               (lambda (h) (s-replace "Table of Contents" (blog--toc-title) h))
                               (org-html-inner-template contents info) t t)
     (blog--footer file))))

(defun blog--stable-headline-ids (tree _backend info)
  "Give each headline lacking a :CUSTOM_ID: the slug `blog--ensure-useful-section-anchors' would stamp.

That function only runs on C-x C-s; here we cover files not re-saved since, so
CI never falls back to Org's random `orgXXXXXXX' anchors.  Collisions get -2, -3, …"
  (let* ((headlines (org-element-map tree 'headline #'identity info))
         (taken (delq nil (mapcar (lambda (h) (org-element-property :CUSTOM_ID h)) headlines))))
    (dolist (h headlines tree)
      (unless (org-element-property :CUSTOM_ID h)
        (let* ((base (blog--make-slug (org-element-property :raw-value h)))
               (base (if (string-empty-p base) "section" base))
               (slug base)
               (n 1))
          (while (member slug taken) (setq slug (format "%s-%d" base (cl-incf n))))
          (push slug taken)
          (org-element-put-property h :CUSTOM_ID slug))))))

(defun blog--no-random-ids (html _backend _info)
  "HTML ↦ HTML sans Org's random `orgXXXXXXX' ids; signal, with a suggested name, when a link targets one.

Headlines, `<<targets>>' and `#+name:'d elements all get stable ids, so a random
id is only ever on something nobody can link to ---unless a link does, which we
refuse to publish: its URL would change on every export."
  (let ((case-fold-search nil))
    (when (string-match "<a href=\"#org[0-9a-f]\\{7\\}\"[^>]*>\\(.*?\\)</a>" html)
      (let ((text (replace-regexp-in-string "<[^>]*>" "" (match-string 1 html))))
        (user-error "Link “%s” targets an element Org can only give a random id; name it, e.g. #+name: %s"
                    text (blog--make-slug text))))
    (replace-regexp-in-string " id=\"org[0-9a-f]\\{7\\}\"" "" html t t)))

(defvar blog--current-headline nil
  "The headline `blog--headline' is transcoding; read by `blog--format-headline'.")

(defun blog--headline (headline contents info)
  "Transcode HEADLINE as `org-html-headline' does, exposing it to `blog--format-headline'."
  (let ((blog--current-headline headline))
    (org-html-headline headline contents info)))

(defun blog--style-setup (backend)
  "Tag the “* Abstract” heading :abstract:, for =blog= exports only; e.g., =* Abstract :ignore:= ↦ =* Abstract :ignore:abstract:=.

The =abstract= block's tag then boxes the section's text, and =:ignore:= axes the heading.
(The abstract is an ordinary section in the source, so this is the one thing that
must happen before parsing; everything else lives in the =blog= backend.)"
  (when (org-export-derived-backend-p backend 'blog)
    (goto-char (point-min))
    ;; Previewing a narrowed subtree: links to the rest of the file are expected to dangle.
    (when (buffer-narrowed-p) (setq-local org-export-with-broken-links t))
    (when (re-search-forward "^\\* Abstract\\b.*?[ \t]*$" nil t)
      (skip-chars-backward " \t")
      ;; Join an existing tag cluster, such as :ignore:, else start one.
      (insert (if (looking-back "[ \t]:\\(?:[^ \t\n]+:\\)+" (line-beginning-position)) "abstract:" " :abstract:")))))

(defun blog--abstract-bounds ()
  "Current buffer ↦ (BEG . END) of the “* Abstract” section's body, past any :PROPERTIES: drawer; nil if absent.

A top-level section ends at the next top-level heading, so plain regex suffices ---no `org-mode' needed."
  (save-excursion
    (goto-char (point-min))
    (when (re-search-forward "^\\* Abstract" nil t)
      (forward-line)
      (when (looking-at-p "^[ \t]*:PROPERTIES:")
        (re-search-forward "^[ \t]*:END:" nil t)
        (forward-line))
      (cons (point)
            (if (re-search-forward "^\\* " nil t) (match-beginning 0) (point-max))))))

(add-hook 'org-export-before-processing-hook #'blog--style-setup)

 1: (defun blog--badges-bar (post post-file-name)
 2:   "Return the Source/History/BuyMeACoffee badge cluster for POST.
 3: 
 4: POST is the metadata alist from `blog--info'; POST-FILE-NAME is the article's
 5: filesystem path (used only when we need to htmlize a standalone article's
 6: source for the Source badge).
 7: 
 8: Surfaced directly under the article image in `blog--inner-template' so readers
 9: see the source/history/support links up top ---nobody scrolls to the bottom."
10:   (let ((source-badge
11:          (if-let (url (@htmlized_source_url post))
12:              ;; Container sub-article: source htmlized separately to <slug>.org.html.
13:              (blog--source-badge url)
14:            ;; Standalone: htmlize and return badge.
15:            (blog--htmlize-file post-file-name))))
16:     (concat
17:      "<center>"
18:      source-badge
19:      "&ensp;"
20:      (@history post)
21:      "&ensp;"
22:      "<a href=\"https://www.buymeacoffee.com/alhassy\"><img src="
23:      "\"https://alhassy.com/resources/badge-buy-me-a-coffee.svg\">"
24:      "</a>"
25:      "</center>")))
26: 
27: (defun blog--footer (post-file-name)
28:   "Return the closing HTML appended to every post.
29: 
30: Just the emacs/org credit, license, Arabic-font CSS shim, and RR.js hook:
31: the Source/History/BuyMeACoffee badges have been hoisted up to sit
32: directly under the article image (see `blog--badges-bar').  For container
33: sub-articles, #+htmlized_source_url: and #+history_url: are carried on
34: the temp buffer by `blog--info'."
35:   (concat
36:    "<hr>"
37:    "<center>"
38:    (blog--css-arabic-font-setup)
39:    "<strong> Generated by Emacs and Org-mode (•̀ᴗ•́)و </strong>"
40:    (blog--license)
41:    "</center>"
42:    "<div hidden> <div id=\"postamble\" class=\"status\"> </div> </div>"
43:    (blog--read-remaining-js)))

;; htmlize is chatty; hush it.
(advice-add 'htmlize-buffer-1 :around
            (lambda (orig &rest args) (let ((inhibit-message t)) (apply orig args))))

;; Faces like (:background white) name colours by symbol, which htmlize's string-match chokes on.
(advice-add 'htmlize-color-to-rgb :filter-args
            (lambda (args) (cons (if (and (car args) (symbolp (car args))) (symbol-name (car args)) (car args)) (cdr args))))

(defun blog--source-badge (url)
  "URL ↦ the “Source” badge linking to an article's colourised Org source."
  (concat "<a class=\"tooltip\" title=\"See the colourised Org source of this article; i.e., what I typed to get this nice webpage\" href=\""
          url "\"><img src=\"https://alhassy.com/resources/badge-source.svg\"></a>"))

(defun blog--htmlize-to (name)
  "Write the current Org buffer, fully unfolded and htmlized with inline CSS, to `blog-publish-directory'/NAME.org.html.

The <title> is the buffer's file name, so callers let-bind `buffer-file-name'."
  (let ((htmlize-output-type 'inline-css)
        (inhibit-message t))
    (outline-show-all)
    (with-current-buffer (htmlize-buffer)
      (write-file (expand-file-name (concat name ".org.html") blog-publish-directory))
      (kill-buffer))))

(defun blog--htmlize-file (file-name)
  "FILE-NAME ↦ the Source badge for it, having written its colourised source to public/BASE.org.html."
  (let ((org-hide-block-startup nil))
    (with-temp-buffer
      ;; Not `find-file': that hands back the live editing buffer, and re-running
      ;; `org-mode' there resets its local state and re-fires .dir-locals.el.
      (insert-file-contents file-name)
      (org-mode)
      (let ((buffer-file-name file-name))
        (blog--htmlize-to (f-base file-name)))))
  (blog--source-badge (concat (f-base file-name) ".org.html")))

(defun blog--license ()
  "Get HTML for Creative Commons Attribution-ShareAlike 3.0 Unported License."
(s-collapse-whitespace (s-replace "\n" ""
"
<center style=\"font-size: 12px\">
  <a rel=\"license\" href=\"https://creativecommons.org/licenses/by-sa/3.0/\">
     <img alt=\"Creative Commons License\" style=\"border-width:0\"
          src=\"https://alhassy.com/resources/cc-by-sa-3.0-88x31.png\"/>
  </a>

  <br/>
  <span xmlns:dct=\"https://purl.org/dc/terms/\"
        href=\"https://purl.org/dc/dcmitype/Text\"
        property=\"dct:title\" rel=\"dct:type\">
     <em>Life & Computing Science</em>
  </span>

  by
  <a xmlns:cc=\"https://creativecommons.org/ns#\"
  href=\"https://alhassy.github.io/\"
  property=\"cc:attributionName\" rel=\"cc:attributionURL\">
    Musa Al-hassy
  </a>

  is licensed under a
  <a rel=\"license\" href=\"https://creativecommons.org/licenses/by-sa/3.0/\">
    Creative Commons Attribution-ShareAlike 3.0 Unported License
  </a>
</center>")))

(defun blog--read-remaining-js ()
  "Get the HTML required to make use of ReadRemaining.js"

  ;; [Maybe Not True] ReadReamining.js does not work well with xWidget browser within Emacs,
  ;; so in-Emacs previews ---every interactive export--- go without it; CI's builds have it.
  (if (not noninteractive)
      ""

   ;; ReadRemaining.js ∷ How much time is left to finish reading this article?
   ;;
  ;; jQuery already loaded by org-special-block-extras.
  ;; "<script
  ;; src=\
  ;; "https://ajax.googleapis.com/ajax/libs/jquery/3.4.1/jquery.min.js\"></script>"
 "<link rel=\"stylesheet\" href=\"readremaining.js-readremainingjs/css/rr_light.css\"
     type='text/css'/>
  <script
     src=\"readremaining.js-readremainingjs/src/readremaining.jquery.js\"></script>
  <script src='readremaining.js/src/readremaining.jquery.js'
     type='text/javascript'></script>
  <script type=\"text/javascript\"> $('body').readRemaining({showGaugeDelay : 10,
     showGaugeOnStart : true}); </script>"))

 1: /*TOC inspired by https://orgmode.org/worg/ */
 2: #table-of-contents {
 3:     /* Place the toc in the top right corner */
 4:     position: fixed; right: 0em; top: 0em;
 5:     margin-top: 120px; /* offset from the top of the screen */
 6: 
 7:     /* It shrinks and grows as necessary */
 8:     padding: 0em !important;
 9:     width: auto !important;
10:     min-width: auto !important;
11: 
12:     font-size: 10pt;
13:     background: white;
14:     line-height: 12pt;
15:     text-align: right;
16: 
17:     box-shadow: 0 0 1em #777777;
18:     -webkit-box-shadow: 0 0 1em #777777;
19:     -moz-box-shadow: 0 0 1em #777777;
20:     -webkit-border-bottom-left-radius: 5px;
21:     -moz-border-radius-bottomleft: 5px;
22: 
23:     /* Ensure doesn't flow off the screen when expanded */
24:     max-height: 80%;
25:     overflow: auto;}
26: 
27: /* How big is the text "Table of Contents" and space around it */
28: #table-of-contents h2 {
29:     font-size: 13pt;
30:     max-width: 9em;
31:     border: 0;
32:     font-weight: normal;
33:     padding-left: 0.5em;
34:     padding-right: 0.5em;
35:     padding-top: 0.05em;
36:     padding-bottom: 0.05em; }
37: 
38: /* Intially have the TOC folded up; show it if the mouse hovers it */
39: #table-of-contents #text-table-of-contents {
40:     display: none;
41:     text-align: left; }
42: 
43: #table-of-contents:hover #text-table-of-contents {
44:     display: block;
45:     padding: 0.5em;
46:     margin-top: -1.5em; }

(defun blog--css-arabic-font-setup ()
  "Return CSS/HTML for Arabic font rendering.
For a one-off use in an article, prepend #+html: to the result."
  "
  <link rel='stylesheet' href='https://fonts.googleapis.com/css?family=Amiri'>
  <style>
     body {font-family: 'Amiri', sans-serif;}
     table {font-family:  'Scheherazade'; font-size: 105%; }
   </style>")

  1: (defun blog--greeting (&optional tag)
  2:   "Return the index/tag-page greeting string, optionally specialised to TAG.
  3: 
  4: The `thread-first` / `doc:cl-loop' name-drop makes sense on the landing page
  5: (Elisp is the site's /lingua franca/) but reads as a non-sequitur on a
  6: tag-scoped page like `life' ---so tag pages get a trimmed variant."
  7:   (if tag
  8:       (format "Here are some of my latest thoughts on %s... badge:Made_with|Lisp|success|https://alhassy.github.io/ElispCheatSheet/CheatSheet.pdf|Gnu-Emacs tweet:https://alhassy.com @@html:<br><br>@@"
  9:               (blog--tag-slug tag))
 10:     "Here are some of my latest thoughts... badge:Made_with|Lisp|success|https://alhassy.github.io/ElispCheatSheet/CheatSheet.pdf|Gnu-Emacs such as doc:thread-first and doc:cl-loop (•̀ᴗ•́)و tweet:https://alhassy.com @@html:<br><br>@@"))
 11: 
 12: (defun blog--card (post)
 13:   "Return the Org source for one article card.
 14: 
 15: No Org heading is emitted ---Org would render it as an <h2> *in addition*
 16: to our own <h2 class=\"title\"> inside the export block, giving every
 17: card a duplicated title.  Per-tag filtering is done in Elisp before
 18: cards are built (see `blog-make-index-page'), so the Org tag machinery
 19: earns us nothing here."
 20:   (concat
 21:    "#+begin_export html\n"
 22:    (format "<h2 class=\"title\"><a href=\"%s\">%s</a></h2>\n"
 23:            (@url post) (blog--title-html (@title post)))
 24:    (format "<center>%s</center>\n" (@tags post))
 25:    (@image post (blog--url "resources/"))
 26:    "\n#+end_export\n"
 27:    "\n"
 28:    (blog--card-abstract post)
 29:    "\n"
 30:    ;; badge:… is an org-special-block-extras link type, so it must sit in
 31:    ;; Org territory ---not inside #+begin_export html, which would ship it
 32:    ;; verbatim to the HTML output.  The @@html:…@@ wrappers give us the
 33:    ;; surrounding <p> while keeping the badge: link itself as Org syntax.
 34:    (format "@@html:<p style=\"text-align:right\">@@ badge:Read|more|green|%s|read-the-docs @@html:</p>@@\n"
 35:            (@url post))
 36:    "\n@@html:<hr>@@\n"))
 37: 
 38: (defun blog--card-abstract (post)
 39:   "POST ↦ its abstract, its links into the article made absolute, since the card lives on another page.
 40: 
 41:   [[#rss-feeds][RSS]] ↦ [[https://alhassy.com/AlBasmala#rss-feeds][RSS]], and [[blog-banner]] ↦ [[https://alhassy.com/AlBasmala#blog-banner]]
 42: Typed links, such as [[file:x.png]] or doc:thread-first, and paths such as [[./x.png]], are left alone."
 43:   (replace-regexp-in-string "\\[\\[#?\\([^]:[/.~][^]:[]*\\)\\]"
 44:                             (lambda (link) (format "[[%s#%s]" (@url post) (match-string 1 link)))
 45:                             (or (@abstract post) "") t t))
 46: 
 47: (defun blog--toc-block (posts)
 48:   "Return a #+begin_export html block listing every post as a linked TOC entry."
 49:   (concat
 50:    "#+begin_export html\n"
 51:    "<details id=\"articles-toc\" style=\"text-align:center;margin:1em 0\">\n"
 52:    "<summary style=\"cursor:pointer;font-size:1.1em;font-weight:bold\">Articles on this page</summary>\n"
 53:    "<ol style=\"display:inline-block;text-align:left;margin-top:0.5em\">\n"
 54:    (mapconcat (lambda (post)
 55:                 (format "<li><a href=\"%s\">%s</a></li>\n"
 56:                         (@url post) (blog--title-html (@title post))))
 57:               posts "")
 58:    "</ol>\n</details>\n"
 59:    "#+end_export\n"))
 60: 
 61: (defun blog--make-page-buffer (posts greeting export-file-name &optional rss-file)
 62:   "Return a fresh Org buffer for POSTS with GREETING, targeting EXPORT-FILE-NAME.
 63: RSS-FILE is the filename of the associated feed (\"rss.xml\" for the index,
 64: \"<tag>-rss.xml\" for a tag page).  It is surfaced as a prominent link right
 65: under the greeting so readers see it without scrolling; nil omits it, as
 66: drafts have no feed.
 67: Caller is responsible for killing the buffer when done."
 68:   (let ((buf (generate-new-buffer " *blog-page*"))
 69:         (rss rss-file))
 70:     (with-current-buffer buf
 71:       (insert
 72:        (format "#+EXPORT_FILE_NAME: %s\n" export-file-name)
 73:        "#+options: toc:nil title:nil html-postamble:nil\n"
 74:        "#+begin_export html\n"
 75:        blog-page-preamble "\n"
 76:        blog-page-header "\n"
 77:        "#+end_export\n"
 78:        "#+html: <br>\n"
 79:        greeting "\n"
 80:        (if rss (format "#+html: <p style=\"text-align:center;\"><a href=\"%s\">📡 Subscribe via RSS</a></p>\n" rss) "")
 81:        "#+html: <br>\n"
 82:        (blog--toc-block posts)
 83:        "#+html: <br>\n"
 84:        (mapconcat #'blog--card posts "\n")
 85:        "\n#+begin_export html\n"
 86:        "<hr> <center> <em> Thanks for reading everything! 😁 Bye! 👋 </em>"
 87:        " </center> <br/>\n"
 88:        (blog--license)
 89:        "\n#+end_export\n")
 90:       (org-mode)
 91:       ;; ospe provides the `badge:`, `doc:`, `tweet:` etc. link handlers
 92:       ;; used throughout `blog--card', and appends tooltipster CSS/JS
 93:       ;; to `org-html-head-extra' on first activation (idempotent:
 94:       ;; ospe's setup-guard wraps the injection).
 95:       (org-special-block-extras-mode 1))
 96:     buf))
 97: 
 98: (defun blog-make-index-page ()
 99:   "Assemble index.html, the unlisted drafts.html, and every tag page.
100: 
101: Builds one Org buffer per output file, each populated directly from
102: the relevant subset of blog-posts ---no copy-then-delete."
103:   (cl-flet ((export-page (posts greeting dest rss)
104:                (let ((buf (blog--make-page-buffer posts greeting dest rss)))
105:                  (unwind-protect
106:                      (with-current-buffer buf (org-export-to-file 'blog-page (org-export-output-file-name ".html")))
107:                    (with-current-buffer buf (set-buffer-modified-p nil))
108:                    (kill-buffer buf)))))
109:     (export-page (blog--listed-posts)
110:                  (blog--greeting)
111:                  (concat blog-publish-directory "index.html")
112:                  "rss.xml")
113:     ;; Unlisted like the drafts it lists: linked from nowhere, noindex, and no feed.
114:     (export-page (seq-filter #'@draft? blog-posts)
115:                  (concat "#+html_head_extra: <meta name=\"robots\" content=\"noindex\">\n"
116:                          "Here are my drafts: published, yet unlisted ---still mulling them over. @@html:<br><br>@@")
117:                  (concat blog-publish-directory "drafts.html")
118:                  nil)
119:     (let ((by-tag (blog--posts-by-tag)))
120:       (dolist (tag blog-tags)
121:         (message "=> Generating tag page: %s..." tag)
122:         (let ((slug (blog--tag-slug tag)))
123:           (export-page (gethash tag by-tag)
124:                        (blog--greeting tag)
125:                        (concat blog-publish-directory (concat "tag-" slug ".html"))
126:                        (concat slug "-rss.xml")))))))

 1: (defun blog--rss-date (date-str)
 2:   "Format DATE-STR (an Org date string) as an RFC-822 pubDate for RSS."
 3:   (format-time-string "%a, %d %b %Y %H:%M:%S %z"
 4:                       (condition-case _
 5:                           (date-to-time date-str)
 6:                         (error (current-time)))))
 7: 
 8: (defun blog--rss-guid (post)
 9:   "Return POST's RSS <guid>.
10: 
11: If POST carries a :MODIFIED: property, the guid is the article URL with
12: a ?last-updated=<MODIFIED> query string; bumping :MODIFIED: therefore
13: re-announces the post to every subscriber's feed reader (see the
14: identity discussion in the prose above).  Without :MODIFIED:, the guid
15: is just the URL ---edits stay quiet until you stamp one."
16:   (let ((modified (map-elt post "modified")))
17:     (if modified
18:         (format "%s?last-updated=%s" (@url post) modified)
19:       (@url post))))
20: 
21: (defun blog--make-one-rss-feed (posts filename &optional channel-title)
22:   "Emit `blog-publish-directory'/FILENAME from POSTS.
23: 
24: A minimal RSS 2.0 feed ---title, link, pubDate, description per item.
25: Body is intentionally a short #+description rather than the full article
26: HTML, so readers click through to alhassy.com.  CHANNEL-TITLE defaults
27: to `blog-title'.
28: 
29: Text fields are run through `xml-escape-string' so <, >, & in titles
30: and descriptions do not break feed readers."
31:   (cl-flet ((esc (s) (xml-escape-string (or s ""))))
32:     (let ((dest  (concat blog-publish-directory filename))
33:           (title (or channel-title blog-title)))
34:       (with-temp-file dest
35:         (insert "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n"
36:                 "<rss version=\"2.0\">\n"
37:                 "<channel>\n"
38:                 "<title>"       (esc title) "</title>\n"
39:                 "<link>"        (esc blog-url) "</link>\n"
40:                 "<description>" (esc title) "</description>\n"
41:                 "<language>en-us</language>\n")
42:         (dolist (post posts)
43:           (insert "<item>\n"
44:                   "<title>"       (esc (@title post))       "</title>\n"
45:                   "<link>"        (esc (@url post))         "</link>\n"
46:                   "<guid>"        (esc (blog--rss-guid post)) "</guid>\n"
47:                   "<pubDate>"     (blog--rss-date (@date post)) "</pubDate>\n"
48:                   "<description>" (esc (@description post)) "</description>\n"
49:                   "</item>\n"))
50:         (insert "</channel>\n</rss>\n")))))
51: 
52: (defun blog--posts-by-tag ()
53:   "Return a hash-table mapping tag-string → list of posts carrying that tag.
54: 
55: Each post appears under every tag it declares in #+filetags.  Lookup is
56: O(1); the table mirrors `blog-posts' and should be rebuilt after every
57: `blog--refresh-posts' call ---cheapest to just call this fresh at each
58: consumer (index/RSS loops)."
59:   (let ((by-tag (make-hash-table :test #'equal)))
60:     (dolist (p (blog--listed-posts))
61:       (dolist (tag (@tag-list p))
62:         (push p (gethash tag by-tag))))
63:     (maphash (lambda (k v) (puthash k (nreverse v) by-tag)) by-tag)
64:     by-tag))
65: 
66: (defun blog--make-rss-feed ()
67:   "Emit rss.xml (all posts) plus one <tag>-rss.xml per tag."
68:   (blog--make-one-rss-feed (blog--listed-posts) "rss.xml")
69:   (let ((by-tag (blog--posts-by-tag)))
70:     (dolist (tag blog-tags)
71:       (blog--make-one-rss-feed
72:        (gethash tag by-tag)
73:        (concat (blog--tag-slug tag) "-rss.xml")
74:        (format "%s — %s" blog-title tag)))))
75: