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

(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))))))))

 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)
41:     (blog-preview)))

(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")
    ;; Enable preview for this container if not already active.
    (unless (member #'blog-preview-subtree after-save-hook)
      (blog-preview))))

;; 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 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 @history (json)
  "Get an HTML badge that points to the Github history of a given file name, in my blog."
  (concat
   "<a class=\"tooltip\" title=\"See the various edits to this article over time\" href=\""
   (map-elt json "history")
   "\"><img src=\"https://img.shields.io/badge/-History-informational?logo=github\"></a>"))

(defun blog--tag-slug (tag)
  "Convert an internal TAG name (underscores, Org-compatible) to a kebab-case slug.

Org forbids dashes in tag names ---we use underscores internally and replace them
with dashes for display and URLs so the reader sees kebab-case everywhere:
  programming_language  →  programming-language
  tag-programming_language.html  →  tag-programming-language.html"
  (s-replace "_" "-" (downcase tag)))

(defun @tag-list (json)
  "JSON ↦ its space-separated \"tags\" as a list, sans empty strings."
  (s-split " " (map-elt json "tags") t))

(defun @tags (json)
  "Get an HTML listing of tags, as shields.io badges, associated with the given file.

Tag names are stored with underscores (Org syntax requirement) but rendered with
dashes everywhere ---display label, URL slug--- so readers see kebab-case.

Example use:  (@tags (seq-elt blog-posts 0))
"
  (concat
  ;; Badges implementation
   (concat
    (format "<a href=\"https://alhassy.github.io/tags.html\"> %s </a>"
            (org-link/octoicon "tag" nil 'html))
    (s-join " "
            (--map  (let ((slug (blog--tag-slug it)))
                      (org-link/badge
                       (format "|%s|grey|%stag-%s.html"
                               slug (blog--url) slug)
                       nil 'html))
                    (@tag-list json))))))

(cl-defun @image (json &optional explicit-image-path-prefix)
  "Assemble the value of '#+fileimage: image width height border?' as an HTML form.

By default, the image should be located in the top-level resources/ directory.
If the image is located elsewhere, or is a URL, is dictated by the presence of a `/'
in the image path.

Example use:  (@image (seq-elt blog-posts 0))

Here are 4 example uses:

#+fileimage: emacs-birthday-present.png
#+fileimage: ../resources/emacs-birthday-present.png
#+fileimage: https://upload.wikimedia.org/wikipedia/en/6/64/Dora_and_Boots.jpg 350 300
#+fileimage: https://unsplash.com/photos/Vc2dD4l57og

+ Notice that the second indicates explicit width and height.
+ (To make the first approach work in previews regardless of where the
   buffer's file lives, we need the variable EXPLICIT-IMAGE-PATH-PREFIX,
   which `blog--inner-template' sets to the deployed
   https://alhassy.com/resources/ URL rather than a local relative path.
   This requires a slash at the end.)
+ The unsplash approach is specific: It shows the *main* image in the provided URL, and links to the provided URL.
"
  (-let [(image width height no-border?) (s-split " " (map-elt json "image"))]
    (setq width (or width 350))
    (setq height (or height 350))
    (setq no-border? (if no-border? "" "style=\"border: 2px solid black;\""))
    (cond
     ((s-contains? "/" image) t) ;; It's a URL, or explicit path, do nothing to it.
     (explicit-image-path-prefix (setq image (format "%s%s"  explicit-image-path-prefix image)))
     ((not (s-contains? "/" image)) (setq image (format "resources/%s" image))))
    (-let [unsplash (cl-second (s-match ".*unsplash.com/photos/\\(.*\\)" image))]
      (setq href (if unsplash (concat "https://unsplash.com/photos/" unsplash) image))
      (setq title (format "Image credit %s" (if unsplash (concat "https://unsplash.com/photos/" unsplash) image)))
      (setq src (if unsplash (format "https://source.unsplash.com/%s/%sx%s" unsplash width height) image))
      (s-collapse-whitespace
       (format "<center class=\"post-image\"><a href=\"%s\" class=\"tooltip\" title=\"%s\"><img src=\"%s\" alt=\"Article image\"
             %s width=\"%s\" height=\"%s\" align=\"top\"/></a></center>"
              href title src no-border? width height)))))

(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)))
         ;; 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)))))))))

(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: tag or the COMMENT keyword.
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)
                (org-element-property :commentedp headline-node))
      (let* (;; draft?
             (draft? (or (member "draft" heading-tags)
                         (equal "t" (org-element-property :DRAFT headline-node))))
             ;; 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; otherwise derive from tags
             (image (or (org-element-property :IMAGE headline-node)
                        (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))
             (history (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"    (org-element-property :REDIRECT 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)
      (delq nil
            (cl-mapcar (lambda (h slug) (blog--info-subtree h container-file slug))
                       top-headings slugs)))))

* 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:

* Remote README :docs:
:PROPERTIES:
:DATE:        <2024-02-01>
:REDIRECT:    https://raw.githubusercontent.com/alhassy/example/master/README.org
:END:

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

(org-defblock abstract (main) nil
  "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))

  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:    (or (@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--toc-block (posts)
 39:   "Return a #+begin_export html block listing every post as a linked TOC entry."
 40:   (concat
 41:    "#+begin_export html\n"
 42:    "<details id=\"articles-toc\" style=\"text-align:center;margin:1em 0\">\n"
 43:    "<summary style=\"cursor:pointer;font-size:1.1em;font-weight:bold\">Articles on this page</summary>\n"
 44:    "<ol style=\"display:inline-block;text-align:left;margin-top:0.5em\">\n"
 45:    (mapconcat (lambda (post)
 46:                 (format "<li><a href=\"%s\">%s</a></li>\n"
 47:                         (@url post) (blog--title-html (@title post))))
 48:               posts "")
 49:    "</ol>\n</details>\n"
 50:    "#+end_export\n"))
 51: 
 52: (defun blog--make-page-buffer (posts greeting export-file-name &optional rss-file)
 53:   "Return a fresh Org buffer for POSTS with GREETING, targeting EXPORT-FILE-NAME.
 54: RSS-FILE is the filename of the associated feed (\"rss.xml\" for the index,
 55: \"<tag>-rss.xml\" for a tag page).  It is surfaced as a prominent link right
 56: under the greeting so readers see it without scrolling.
 57: Caller is responsible for killing the buffer when done."
 58:   (let ((buf (generate-new-buffer " *blog-page*"))
 59:         (rss (or rss-file "rss.xml")))
 60:     (with-current-buffer buf
 61:       (insert
 62:        (format "#+EXPORT_FILE_NAME: %s\n" export-file-name)
 63:        "#+options: toc:nil title:nil html-postamble:nil broken-links:t\n"
 64:        "#+begin_export html\n"
 65:        blog-page-preamble "\n"
 66:        blog-page-header "\n"
 67:        "#+end_export\n"
 68:        "#+html: <br>\n"
 69:        greeting "\n"
 70:        (format "#+html: <p style=\"text-align:center;\"><a href=\"%s\">📡 Subscribe via RSS</a></p>\n" rss)
 71:        "#+html: <br>\n"
 72:        (blog--toc-block posts)
 73:        "#+html: <br>\n"
 74:        (mapconcat #'blog--card posts "\n")
 75:        "\n#+begin_export html\n"
 76:        "<hr> <center> <em> Thanks for reading everything! 😁 Bye! 👋 </em>"
 77:        " </center> <br/>\n"
 78:        (blog--license)
 79:        "\n#+end_export\n")
 80:       (org-mode)
 81:       ;; ospe provides the `badge:`, `doc:`, `tweet:` etc. link handlers
 82:       ;; used throughout `blog--card', and appends tooltipster CSS/JS
 83:       ;; to `org-html-head-extra' on first activation (idempotent:
 84:       ;; ospe's setup-guard wraps the injection).
 85:       (org-special-block-extras-mode 1))
 86:     buf))
 87: 
 88: (defun blog-make-index-page ()
 89:   "Assemble index.html and every tag page.
 90: 
 91: Builds one Org buffer per output file, each populated directly from
 92: the relevant subset of blog-posts ---no copy-then-delete."
 93:   (cl-flet ((export-page (posts greeting dest rss)
 94:                (let ((buf (blog--make-page-buffer posts greeting dest rss)))
 95:                  (unwind-protect
 96:                      (with-current-buffer buf (org-export-to-file 'blog-page (org-export-output-file-name ".html")))
 97:                    (with-current-buffer buf (set-buffer-modified-p nil))
 98:                    (kill-buffer buf)))))
 99:     (export-page blog-posts
100:                  (blog--greeting)
101:                  (concat blog-publish-directory "index.html")
102:                  "rss.xml")
103:     (let ((by-tag (blog--posts-by-tag)))
104:       (dolist (tag blog-tags)
105:         (message "=> Generating tag page: %s..." tag)
106:         (let ((slug (blog--tag-slug tag)))
107:           (export-page (gethash tag by-tag)
108:                        (blog--greeting tag)
109:                        (concat blog-publish-directory (concat "tag-" slug ".html"))
110:                        (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-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-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: 

 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:          "</div>")))
66: 
67: (defun blog--refresh-posts ()
68:   "Recompute blog-posts, blog-pages, and blog-tags from source org files."
69:   (let ((result (blog--compute-posts-and-pages)))
70:     (setq blog-posts (car result))
71:     (setq blog-pages (cdr result))
72:     (setq blog-tags
73:           (sort (seq-uniq (mapcan #'@tag-list blog-posts)) #'string<))
74:     (blog--rebuild-preamble)))
75: 
76: (defvar blog-page-preamble ""
77:   "HTML injected at the top of every exported page: the site nav bar.
78: Set by blog--rebuild-preamble whenever blog-pages changes.")
79: 
80: (defvar blog-page-header ""
81:   "HTML injected into the <head> of every exported page: CSS, JS, MathJax, etc.
82: Set once at load time by the setq block near the blog-banner section.")
83: 
84: (defvar blog-posts nil
85:   "All post metadata, sorted newest-first. Initialized at end of file; refresh with (blog--refresh-posts).")
86: 
87: (defvar blog-pages nil
88:   "Site navigation page metadata (subtrees with :SITE_NAV: t).
89: These appear as header links on every page but not as blog post cards.
90: Initialized at end of file; refresh with (blog--refresh-posts).")
91: 
92: (defvar blog-tags nil
93:   "Tags for my blog articles. Initialized at end of file; refresh with (blog--refresh-posts).")

(setq blog-page-header
 (concat
  ;; NOPE: org-html-head-extra  ;; Altered by 'org-special-block-extras'
  (concat
  "<meta name=\"author\" content=\"Musa Al-hassy\">
   <meta name=\"referrer\" content=\"no-referrer\">"
  "<link href=\"https://alhassy.com/resources/usual-org-front-matter.css\" rel=\"stylesheet\" type=\"text/css\" />"
  "<link href=\"https://alhassy.com/resources/org-notes-style.css\" rel=\"stylesheet\" type=\"text/css\" />"
  "<link href=\"https://alhassy.com/resources/floating-toc.css\" rel=\"stylesheet\" type=\"text/css\" />"
  "<link href=\"https://alhassy.com/resources/blog-banner.css\" rel=\"stylesheet\" type=\"text/css\" />"
  "<link href=\"https://fonts.googleapis.com/css2?family=Philosopher:ital,wght@0,400;0,700;1,400;1,700&display=swap\" rel=\"stylesheet\" />"
  "<link rel=\"icon\" href=\"https://alhassy.com/resources/favicon.png\">")
  "<script type=\"text/javascript\">
  /*
  @licstart  The following is the entire license notice for the
  JavaScript code in this tag.

  Copyright (C) 2012-2020 Free Software Foundation, Inc.

  The JavaScript code in this tag is free software: you can
  redistribute it and/or modify it under the terms of the GNU
  General Public License (GNU GPL) as published by the Free Software
  Foundation, either version 3 of the License, or (at your option)
  any later version.  The code is distributed WITHOUT ANY WARRANTY;
  without even the implied warranty of MERCHANTABILITY or FITNESS
  FOR A PARTICULAR PURPOSE.  See the GNU GPL for more details.

  As additional permission under GNU GPL version 3 section 7, you
  may distribute non-source (e.g., minimized or compacted) forms of
  that code without the copy of the GNU GPL normally required by
  section 4, provided you include this license notice and a URL
  through which recipients can access the Corresponding Source.


  @licend  The above is the entire license notice
  for the JavaScript code in this tag.
  */
  <!--/*--><![CDATA[/*><!--*/
   function CodeHighlightOn(elem, id)
   {
     var target = document.getElementById(id);
     if(null != target) {
       elem.cacheClassElem = elem.className;
       elem.cacheClassTarget = target.className;
       target.className = \"code-highlighted\";
       elem.className   = \"code-highlighted\";
     }
   }
   function CodeHighlightOff(elem, id)
   {
     var target = document.getElementById(id);
     if(elem.cacheClassElem)
       elem.className = elem.cacheClassElem;
     if(elem.cacheClassTarget)
       target.className = elem.cacheClassTarget;
   }
  /*]]>*///-->
  </script>"
  ))

 1: .header {
 2:   /* fantasy first (Papyrus on Chrome/Safari); Philosopher as cross-browser fallback. */
 3:   font-family: fantasy, 'Philosopher', 'Book Antiqua', Palatino, serif;
 4:   text-align: center;
 5:   overflow: hidden;
 6:   /* background-color: #f1f1f1 !important; */
 7:   /* background: #4183c4 !important; */
 8:   padding-top: 10px;
 9:   padding-bottom: 10px;
10:   box-shadow: 0 2px 10px 2px rgba(0, 0, 0, 0.2);
11: }
12: 
13: .header a.logo {
14:   font-size: 50px;
15:   font-weight: bold;
16: }
17: 
18: .header a {
19:   color: black;
20:   padding: 12px;
21:   text-decoration: none;
22:   font-size: 18px;
23: }
24: 
25: .header a:hover {
26:   background-color: #ddd;
27:   background-color: #fff;
28:   color: #4183c4;
29: }

 1: "<script type=\"text/javascript\">
 2: /*
 3: @licstart  The following is the entire license notice for the
 4: JavaScript code in this tag.
 5: 
 6: Copyright (C) 2012-2020 Free Software Foundation, Inc.
 7: 
 8: The JavaScript code in this tag is free software: you can
 9: redistribute it and/or modify it under the terms of the GNU
10: General Public License (GNU GPL) as published by the Free Software
11: Foundation, either version 3 of the License, or (at your option)
12: any later version.  The code is distributed WITHOUT ANY WARRANTY;
13: without even the implied warranty of MERCHANTABILITY or FITNESS
14: FOR A PARTICULAR PURPOSE.  See the GNU GPL for more details.
15: 
16: As additional permission under GNU GPL version 3 section 7, you
17: may distribute non-source (e.g., minimized or compacted) forms of
18: that code without the copy of the GNU GPL normally required by
19: section 4, provided you include this license notice and a URL
20: through which recipients can access the Corresponding Source.
21: 
22: 
23: @licend  The above is the entire license notice
24: for the JavaScript code in this tag.
25: */
26: <!--/*--><![CDATA[/*><!--*/
27:  function CodeHighlightOn(elem, id)
28:  {
29:    var target = document.getElementById(id);
30:    if(null != target) {
31:      elem.cacheClassElem = elem.className;
32:      elem.cacheClassTarget = target.className;
33:      target.className = \"code-highlighted\";
34:      elem.className   = \"code-highlighted\";
35:    }
36:  }
37:  function CodeHighlightOff(elem, id)
38:  {
39:    var target = document.getElementById(id);
40:    if(elem.cacheClassElem)
41:      elem.className = elem.cacheClassElem;
42:    if(elem.cacheClassTarget)
43:      target.className = elem.cacheClassTarget;
44:  }
45: /*]]>*///-->
46: </script>"

 1: .src {
 2:   border: 0px !important;
 3:   /* 50px for top-left and bottom-right corners;
 4:      20px for top-right and bottom-left cornerns. */
 5:   border-radius: 50px 20px !important;
 6: }
 7: 
 8: pre.src:before {
 9:     /* border: 0px !important; */
10:     /* background-color: inherit !important; */
11:     padding: 3px !important;
12:     border-radius: 20px 50px !important;
13:     font-weight:700
14: }
15: 
16:  /* wrap lengthy lines for code blocks */
17:  pre{white-space:pre-wrap}
18: 
19:  /* Also curvy inline code with ~ ⋯ ~ and = ⋯ = */
20:  code {
21:      /* background: Cyan !important; */
22:      background: pink !important;
23:      border-radius: 7px;
24:      /* border: 1px solid lightgrey; background: #FFFFE9; padding: 2px */
25:  }

table {
     background: pink;
     border-radius: 10px;
     /* width:90% */

     border-bottom: hidden;
     border-top: hidden;

     display: table !important;

     /* Put table in the center of the page, horizontally. */
     margin-left:auto !important;margin-right:auto !important;

     font-family:"Courier New";
     font-size:90%;
 }

 /* Styling for 't'able 'd'ata and 'h'eader elements */
 th, td {
     border: 0px solid red;
 }

details {
  padding: 1em;
  background-color: #e5f5e5;
  /* background-color: pink; */
  border-radius: 15px;
  color: hsl(157 75% 20%);
  font-size: 0.9em;
  box-shadow: 0.05em 0.1em 5px 0.01em  #00000057;
}

(defun blog--ensure-useful-section-anchors (&rest _)
  "Org sections without a CUSTOM_ID are given one derived from the heading title.

Uses `blog--make-slug' so the result is lowercase kebab-case, consistent with
URL slugs.  If a collision is detected, pops a message-box and undoes.

E.g., ↯ We'll go on a ∀∃⇅ adventure
   ↦  well-go-on-a-adventure
"
  (interactive)
  (let ((ids))
    (org-map-entries
     (lambda ()
       (org-with-point-at (point)
         (let ((id (org-entry-get nil "CUSTOM_ID")))
           (unless id
             (setq id (blog--make-slug (nth 4 (org-heading-components))))
             (if (not (member id ids))
                 (push id ids)
               (message-box "Oh no, a repeated id!\n\n\t%s" id)
               (undo)
               (setq quit-flag t))
             (org-entry-put nil "CUSTOM_ID" id))))))))

;; Anchor assignment is an interactive-authoring concern ---it should only
;; happen while you can still edit the generated id, i.e. during C-x C-s
;; preview.  CI must not mutate source files, and (undo)/(message-box) don't
;; work headlessly anyway.

;; Src: https://writepermission.com/org-blogging-clickable-headlines.html
;; Installed as the `blog' backend's :html-format-headline-function default.
(defun blog--format-headline (todo todo-type priority text tags info)
  "Format a headline with a link to itself ---its :CUSTOM_ID:, which `blog--stable-headline-ids' guarantees."
  (let* ((id (and blog--current-headline (org-element-property :CUSTOM_ID blog--current-headline)))
         (link (if (and id (not (s-contains? "<a " text))) ;; Links cannot nest.
                   (format "<a href=\"#%s\">%s</a>" id text)
                 text)))
    (org-html-format-headline-default-function todo todo-type priority link tags info)))

(provide 'AlBasmala)

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

(defun blog--sync-assets ()
  "Copy static assets into blog-publish-directory so relative HTML paths resolve.

Called at the end of `blog-publish-all' so that public/ is self-contained and
can be deployed as-is to gh-pages without the master-branch source tree."
  (let ((dist (file-name-as-directory (expand-file-name blog-publish-directory))))
    (make-directory dist t)
    ;; Required: resources/ must exist ---missing it means a broken site.
    (dolist (asset '("resources"))
      (let ((src (expand-file-name asset blog-posts-directory)))
        (unless (file-exists-p src)
          (user-error "blog--sync-assets: required asset %s missing at %s" asset src))
        (copy-directory src (expand-file-name asset dist) t t t)))
    ;; Optional: nice-to-haves ---silent skip if absent.
    (dolist (asset '("readremaining.js-readremainingjs" "floating-toc.css"))
      (let ((src (expand-file-name asset blog-posts-directory)))
        (when (file-exists-p src)
          (if (file-directory-p src)
              (copy-directory src (expand-file-name asset dist) t t t)
            (copy-file src (expand-file-name asset dist) t)))))))

(defun blog--publishable-p (file)
  "Return non-nil if FILE is an article that should be published.
A file is publishable when it has any of:
  - #+date:                     ---standalone post
  - #+article_style: multiple   ---container of subtree articles
  - #+site_nav:                 ---top-level nav page (e.g. about.org)

Fragments that are #+include'd into articles but never published on
their own (e.g. MathJaxPreamble.org) must opt out explicitly with

  #+exclude_from_publish: t

Any other .org file missing /both/ a publish marker and the opt-out
signals a (user-error) ---we do not silently skip files that just
forgot their #+date:."
  (with-temp-buffer
    (insert-file-contents file)
    (cl-flet ((kw (k) (blog--file-keyword nil k)))
      (cond
       ((kw "exclude_from_publish") nil)
       ((kw "modified") t)
       ((equal (kw "article_style") "multiple") t)
       ((kw "site_nav") t)
       (t (user-error
           "%s has no #+modified:, #+article_style: multiple, or #+site_nav: ---add one, or #+exclude_from_publish: t if this is an include-only fragment"
           (f-filename file)))))))

(defun blog-publish-all ()
  "Batch-publish every article and regenerate the index.  The sole CI entry point.

Exports all posts → public/, rebuilds index + tag pages + RSS, copies static
assets.  public/ is then deployed by CI to gh-pages so URLs stay flat:
alhassy.com/foo not alhassy.com/public/foo.

Dispatches on #+article_style: per file:
  standalone (default) → one .org → one HTML file,
  multiple            → one subtree → one HTML file (via `blog--publish-multiple-articles')."
  ;; CI passes relative directories, e.g., "./public/"; pin them now, else a nested article's
  ;; buffer would resolve them against its own subdirectory.
  (let ((blog-posts-directory   (expand-file-name blog-posts-directory))
        (blog-publish-directory (file-name-as-directory (expand-file-name blog-publish-directory))))
    (make-directory blog-publish-directory t)
    (blog--refresh-posts)
    (blog--validate-slugs)
    (dolist (f (seq-filter #'blog--publishable-p (blog--org-files)))
      (with-current-buffer (find-file-noselect f)
        ;; badge:/doc:/tweet: links in articles are registered as Org link types
        ;; by org-special-block-extras-mode.  It's a buffer-local minor mode, so
        ;; turn it on per buffer ---without it those links leak verbatim to HTML.
        (org-special-block-extras-mode 1)
        (if (blog--multiple-style-p)
            (progn
              (message "=> Exporting all articles from %s..." (f-base f))
              (blog--vendor-redirects)
              (blog--publish-multiple-articles f))
          (let ((target (expand-file-name (concat (f-base f) ".html") blog-publish-directory)))
            ;; Export directly to public/<base>.html so that #+export_file_name:
            ;; entries pointing at ~/blog/ (valid locally, absent on CI) never
            ;; become the output destination.
            (org-export-to-file 'blog target)))))
    (blog-make-index-page)
    (blog--make-rss-feed)
    (blog--sync-assets)))

(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))))))

(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)))))

name: blog CI

on:
  push:
    branches: [ master ]
  pull_request:
    branches: [ master ]
  workflow_dispatch:

# Serialise deploys so two quick master pushes don't race on the
# gh-pages force-push.  Queue rather than cancel ---every deploy lands.
concurrency:
  group: pages
  cancel-in-progress: false

# Build .org → public/, force-push to gh-pages on master.  See README.
jobs:
  build:
    runs-on: ubuntu-latest
    timeout-minutes: 15
    permissions:
      contents: write

    steps:
      - uses: actions/checkout@v4
        with:
          fetch-depth: 1

      - name: Set up Emacs
        uses: purcell/setup-emacs@v8.0
        with:
          version: 30.1

      - name: Cache Emacs packages
        uses: actions/cache@v4
        with:
          path: ~/.emacs.d/elpa
          key: elpa-${{ runner.os }}-emacs30.1-${{ hashFiles('.github/workflows/ci.yml') }}

      - name: Install Emacs package dependencies
        run: |
          emacs --batch \
            --eval "(require 'package)" \
            --eval "(setq package-archives '((\"melpa\" . \"https://melpa.org/packages/\")))" \
            --eval "(package-initialize)" \
            --eval "(unless (file-exists-p (expand-file-name \"archives/melpa\" package-user-dir)) (package-refresh-contents))" \
            --eval "(dolist (p '(dash f s htmlize org-special-block-extras)) (unless (package-installed-p p) (package-install p)))" \
            --eval "(unless (locate-library \"org-deftag\") (package-refresh-contents) (package-upgrade 'org-special-block-extras))"

      - name: Build all articles
        run: |
          mkdir -p ~/.emacs.d
          printf '* Mini-tutorial-on-Org-mode\n:PROPERTIES:\n:CUSTOM_ID: Mini-tutorial-on-Org-mode\n:END:\n' > ~/.emacs.d/init.org
          emacs --batch \
            --eval "(require 'package)" \
            --eval "(setq package-archives '((\"melpa\" . \"https://melpa.org/packages/\")))" \
            --eval "(package-initialize)" \
            --load ox-extra.el \
            --eval "(defun not-currently-working-with (&optional _) \"\")" \
            --eval "(defun currently-working-with (&optional _) \"\")" \
            --eval "(setq org-confirm-babel-evaluate nil)" \
            --eval "(setq org-export-with-broken-links t)" \
            --eval "(setq blog-publish-directory \"./public/\")" \
            --eval "(setq blog-posts-directory \"./\")" \
            --eval "(require 'ob-tangle)" \
            --eval "(org-babel-tangle-file \"AlBasmala.org\")" \
            --eval "(load-file \"AlBasmala.el\")" \
            --eval "(blog-publish-all)"

      - name: Deploy public/ to gh-pages
        if: github.ref == 'refs/heads/master' && github.event_name == 'push'
        uses: peaceiris/actions-gh-pages@v4
        with:
          github_token: ${{ secrets.GITHUB_TOKEN }}
          publish_dir: ./public
          publish_branch: gh-pages
          cname: alhassy.com

(use-package org-special-block-extras :ensure t :demand t
  :config (org-special-block-extras-mode t))


(org-deflink image
             "Provide a quick way to insert images along with credits via tooltips.

Example usage:

image:https://upload.wikimedia.org/wikipedia/commons/3/33/Heisokudachi.svg|100|100

image:URL|WIDTH|HEIGHT|CENTER?|CREDIT?
"
;;             (upcase (or o-description o-label))
  (-let [(image width height center? credit?) (s-split "|" o-label)]
    (-let [unsplash (cl-second (s-match ".*unsplash.com/photos/\\(.*\\)" image))]
      (let* ((href (if unsplash (concat "https://unsplash.com/photos/" unsplash) image))
            (title (format "Image credit %s" (or credit? (if unsplash (concat "https://unsplash.com/photos/" unsplash) image))))
            (src (if unsplash (format "https://source.unsplash.com/%s/%sx%s" unsplash width height) image))
            (it (format "<a href=\"%s\" class=\"tooltip\" title=\"%s\"><img src=\"%s\" alt=\"Article image\"
             width=\"%s\" height=\"%s\" align=\"top\"/></a>"
                        href title src width height)))
        (if center?
            (format "<center> %s </center>" it)
          it)))))