Improve code blocks

Use highlight.js for code syntax highlighting

Table of Contents

What is the problem with default highlighting?

Htmlize works poorly with headless publishing. It lacks extensibility, including features like line numbers, a copy button, and the ability to highlight predefined parts of the code.

Highlight.js

Change code block template

We need to make small changes in how code blocks are rendered. By default, Org Export exports code blocks as <pre></pre>. For Highlight.js, we need <pre><code></code></pre>. Additionally, we need to set the correct language name in the class attribute. Since Highlight.js does not support elisp, I rewrite it to regular lisp using the my/replace-substring function. 

(setq
  my/lang-substitution-map '(("elisp" . "lisp")))

(defun my/replace-substrings (input-string)
  "Replace substrings in INPUT-STRING according to SUBSTITUTION-MAP."
  (let ((output-string input-string))
    (dolist (pair my/lang-substitution-map)
      (let ((old (regexp-quote (car pair)))
            (new (cdr pair)))
        (setq output-string (replace-regexp-in-string old new output-string))))
    output-string))

(defun my/src-block (src-block contents info)
  "Translate SRC-BLOCK element into HTML.
CONTENTS is nil. INFO is a plist holding contextual information."
  (let* (
         (org-language (format "language-%s" (org-element-property :language src-block)))
         (language (my/replace-substrings org-language))
         (code (org-element-property :value src-block)))
    (esxml-to-xml
     `(pre ()
       (code ((class . ,language))
             ,(org-html-encode-plain-text code)
             ))
     )
    )
  )

(org-export-define-derived-backend 'my-html 'html
  :translate-alist '(
                     (template . my/template)
                     (src-block . my/src-block)
                     ))

Plug Highlight.js

I do not want to load Highlight.js on every page, so I need to check if the initial Org file contains code blocks. Depending on this, we will render the part of the tree with JavaScript or not. 

(defun my/org-has-src-blocks-p (info)
  "Return t if the Org document represented by INFO has source code blocks."
  (org-element-map (plist-get info :parse-tree) 'src-block
    (lambda (src-block) t)
    nil t))

(defun my/template (contents info)

  (let* ((title-str (org-export-data (plist-get info :title) info))
         ...
         (has-src-blocks (my/org-has-src-blocks-p info)))
...

(script ((defer . "true") (src . "https://umami.dokutsu.xyz/script.js") (data-website-id . "d52d9af1-0c7d-4531-84c6-0b9c2850011f")) ())

,(when has-src-blocks
`(nil ()
        (link ((id . "highlight-theme") (rel . "stylesheet") (type . "text/css")))
        (script ((src . "https://cdnjs.cloudflare.com/ajax/libs/highlight.js/11.9.0/highlight.min.js")) ())
        (script ((src . "https://cdn.jsdelivr.net/gh/highlightjs/cdn-release@11.9.0/build/languages/bash.min.js")) ())
        (script ((src . "https://cdn.jsdelivr.net/gh/highlightjs/cdn-release@11.9.0/build/languages/lisp.min.js")) ())
        (script ((src . "/resources/js/theme-selector.js")) ())
        )
)

(title () ,title-str)

Respect prefers-color-scheme

Additionally, I think it's a good idea to respect the prefers-color-scheme property of the user's browser. We can switch CSS files based on this property. We should also subscribe to changes in this property to handle the edge case when it switches while reading the page. 

hljs.highlightAll(); // Initialize highlight.js

// Function to set the theme based on the preferred color scheme
function setHighlightTheme() {
  const highlightThemeLink = document.getElementById("highlight-theme");
  const darkTheme =
    "https://cdnjs.cloudflare.com/ajax/libs/highlight.js/11.9.0/styles/base16/solarized-dark.min.css";
  const lightTheme =
    "https://cdnjs.cloudflare.com/ajax/libs/highlight.js/11.9.0/styles/base16/solarized-light.min.css";
  if (
    window.matchMedia &amp;&amp;
    window.matchMedia("(prefers-color-scheme: dark)").matches
  ) {
    highlightThemeLink.href = darkTheme;
  } else {
    highlightThemeLink.href = lightTheme;
  }
}

// Initial theme set
setHighlightTheme();

// Listen for changes in the preferred color scheme
window
  .matchMedia("(prefers-color-scheme: dark)")
  .addEventListener("change", setHighlightTheme);

Whole config

In between posts I've switched from sxml to esxml so here is the current config. 

;; Load the publishing system
;; Configure environment
;;
(setq debug-on-error t)

(let ((default-directory  (concat "~/.config/emacs/.local/straight/build-" emacs-version "/")))
  (normal-top-level-add-subdirs-to-load-path))

(add-to-list 'custom-theme-load-path
             (concat "~/.config/emacs/.local/straight/build-" emacs-version "/doom-themes"))
(add-to-list 'custom-theme-load-path (concat "~/.config/emacs/.local/straight/build-" emacs-version "/base16-theme"))
(add-to-list 'custom-theme-load-path (concat "~/.config/emacs/.local/straight/build-" emacs-version "/moe-theme"))


(require 'xml)
(require 'dom)
(require 'ox-publish)
(require 'ox-rss)
(require 'org)
(require 'esxml)
;; (require 'esxml-html)

;;
;;Variables
;;
(setq
 my/url "https://fidonode.me"
 my/web-export-path "./public"
 my/blog-src-path "./home/05 Blog"
 my/lang-substitution-map '(("elisp" . "lisp"))
 org-html-validation-link nil            ;; Don't show validation link
 org-html-htmlize-output-type nil
 org-src-fontify-natively t)

;;
;;Templates
;;
(defun my/footer (info)
  `(footer ((class .  "footer"))
    (hr () )
    (small ()
           (p () "Alex Mikhailov")
           (p () "Built with: "
              (a ((href . "https://www.gnu.org/software/emacs/")) "GNU Emacs") " "
              (a ((href . "https://orgmode.org/")) "Org Mode") " "
              (a ((href . "https://picocss.com/")) "picocss")
              )
           )
    ))

(defun my/header (info)
  (let ((title-str (org-export-data (plist-get info :title) info)))
    `(header ((class . "header"))
      (nav ()
           (ul ()
               (li ()
                   (strong () ,title-str)))
           (ul ()
               (li () (a ((href . "/index.html")) "About"))
               (li () (a ((href . "/posts.html")) "Blog"))
               (li () (a ((href . "/rss.xml")) "RSS"))
               )
           ))
    )
  )

(defun my/src-block (src-block contents info)
  "Translate SRC-BLOCK element into HTML.
CONTENTS is nil. INFO is a plist holding contextual information."
  (let* (
         (org-language (format "language-%s" (org-element-property :language src-block)))
         (language (my/replace-substrings org-language))
         (code (org-element-property :value src-block)))
    (esxml-to-xml
     `(pre ()
       (code ((class . ,language))
             ,(org-html-encode-plain-text code)
             ))
     )
    )
  )


(defun my/template (contents info)

  (let* ((title-str (org-export-data (plist-get info :title) info))
         (description-str (org-export-data (plist-get info :description) info))
         (file-path-str (org-export-data (plist-get info :input-file) info))
         (base-directory-str (org-export-data (plist-get info :base-directory) info))
         (file-name-str (file-relative-name file-path-str (format "%s/%s" script-directory base-directory-str)))
         (img-link-str (format "%s/resources/images/%s.png" my/url file-name-str))
         (has-src-blocks (my/org-has-src-blocks-p info)))

    (set-text-properties 0 (length title-str) nil title-str)
    (set-text-properties 0 (length description-str) nil description-str)
    (set-text-properties 0 (length img-link-str) nil img-link-str)

    (concat
     "&lt;!DOCTYPE html&gt;"
     (esxml-to-xml
      `(html ((lang . "en"))
        (head ()
              (meta ((charset . "utf-8")))
              (meta ((author . "Alex Mikhailov")))
              (meta ((name . "viewport")
                     (content . "width=device-width, initial-scale=1, shrink-to-fit=no")))
              (meta ((name . "color-scheme") (content . "light dark")))
              (meta ((http-equiv . "content-language") (content . "en-us")))
              ;; OG block
              ;; "Personal page with a blog about my technical adventures"
              (meta ((name . "description") (content .  ,description-str)))
              (meta ((name . "og:description") (content . ,description-str)))
              (meta ((name . "twitter:description") (content . ,description-str)))

              (meta ((name . "og:image") (content . ,img-link-str)))
              (meta ((name . "twitter:image") (content . ,img-link-str)))

              (meta ((name . "og:title") (content . ,title-str)))
              (meta ((name . "twitter:title") (content . ,title-str)))

              (meta ((name . "twitter:card") (content . "summary_large_image")))

              (link ((rel . "icon") (type . "image/x-icon") (href . "/resources/favicon.ico")))
              (link ((rel . "stylesheet") (type . "text/css") (href . "/resources/css/pico.sand.min.css")))
              (script ((defer . "true") (src . "https://umami.dokutsu.xyz/script.js") (data-website-id . "d52d9af1-0c7d-4531-84c6-0b9c2850011f")) ())
              ,(when has-src-blocks
                 `(nil ()
                   (link ((id . "highlight-theme") (rel . "stylesheet") (type . "text/css")))
                   (script ((src . "https://cdnjs.cloudflare.com/ajax/libs/highlight.js/11.9.0/highlight.min.js")) ())
                   (script ((src . "https://cdn.jsdelivr.net/gh/highlightjs/cdn-release@11.9.0/build/languages/bash.min.js")) ())
                   (script ((src . "https://cdn.jsdelivr.net/gh/highlightjs/cdn-release@11.9.0/build/languages/lisp.min.js")) ())
                   (script ((src . "/resources/js/theme-selector.js")) ())
                   )
                 )
              (title () ,title-str)
              )
        (body ()
              (main ((class . "container"))
                    ,(my/header info)
                    (raw-string ,contents)
                    ,(my/footer info)
                    )
              ))
      ))
    ))


(org-export-define-derived-backend 'my-html 'html
  :translate-alist '(
                     (template . my/template)
                     (src-block . my/src-block)
                     ))

(defun my/publish-to-html (plist filename pub-dir)
  "Publish an Org file to HTML using the custom backend."
  (org-publish-org-to 'my-html filename ".html" plist pub-dir))
;;
;;Sitemap/RSS
;;
(defun my/format-rss-feed-entry (entry style project)
  "Format ENTRY for the RSS feed.
ENTRY is a file name.  STYLE is either 'list' or 'tree'.
PROJECT is the current project."
  (cond ((not (directory-name-p entry))
         (let* ((file (org-publish--expand-file-name entry project))
                (title (org-publish-find-title entry project))
                (date (format-time-string "%Y-%m-%d" (org-publish-find-date entry project)))
                (link (concat (file-name-sans-extension entry) ".html")))
           (with-temp-buffer
             (org-mode)
             (insert (format "* [[file:%s][%s]]\n" file title))
             (org-set-property "RSS_PERMALINK" link)
             (org-set-property "RSS_TITLE" title)
             (org-set-property "PUBDATE" date)
             (let ((first-two-lines (with-temp-buffer
                                      (insert-file-contents file)
                                      (buffer-substring-no-properties
                                       (point-min)
                                       (progn (forward-line 2) (point))))))
               (if (string-suffix-p "\n" first-two-lines)
                   (setq first-two-lines (substring first-two-lines 0 -1)))
               (insert first-two-lines))
             (goto-char (point-max))
             (insert "...")
             (buffer-string))))
        ((eq style 'tree)
         ;; Return only last subdir.
         (file-name-nondirectory (directory-file-name entry)))
        (t entry)))

(defun my/format-rss-feed (title list)
  "Generate RSS feed, as a string.
TITLE is the title of the RSS feed.  LIST is an internal
representation for the files to include, as returned by
`org-list-to-lisp'.  PROJECT is the current project."
  (concat "#+TITLE: " title "\n"
          "#+STARTUP: showall \n\n"
          (org-list-to-subtree list 1 '(:icount "" :istart ""))))

(defun my/publish-to-rss (plist filename pub-dir)
  "Publish RSS with PLIST, only when FILENAME is 'rss.org'.
PUB-DIR is when the output will be placed."
  (if (equal "rss.org" (file-name-nondirectory filename))
      (org-rss-publish-to-rss plist filename pub-dir)))

;;
;;Helpers
;;
(defun my/format-date-subtitle (file project)
  "Format the date found in FILE of PROJECT."
  (format-time-string "posted on %Y-%m-%d" (org-publish-find-date file project)))

(defun my/pt (var)
  "Print the value and type of VAR."
  (message "Value: %S, Type: %s" var (type-of var)))

(defun plist-keys (plist)
  "Return a list of keys in the property list PLIST."
  (let (keys)
    (while plist
      (setq keys (cons (car plist) keys))
      (setq plist (cddr plist)))
    (nreverse keys)))

(defvar script-directory
  (file-name-directory (or load-file-name buffer-file-name))
  "The directory where the current script is located.")

(defun my/org-has-src-blocks-p (info)
  "Return t if the Org document represented by INFO has source code blocks."
  (org-element-map (plist-get info :parse-tree) 'src-block
    (lambda (src-block) t)
    nil t))

(defun my/replace-substrings (input-string)
  "Replace substrings in INPUT-STRING according to SUBSTITUTION-MAP."
  (let ((output-string input-string))
    (dolist (pair my/lang-substitution-map)
      (let ((old (regexp-quote (car pair)))
            (new (cdr pair)))
        (setq output-string (replace-regexp-in-string old new output-string))))
    output-string))

;;
;;Clear folder with results
;;
(when (file-directory-p my/web-export-path)
  (delete-directory my/web-export-path t))
(mkdir my/web-export-path)


;;
;;Main blog configuration
;;
(setq org-publish-project-alist
      (list
       (list "static"
             :base-directory my/blog-src-path
             :base-extension "css\\|js\\|png\\|jpg\\|jpeg\\|gif\\|pdf\\|ico\\|txt"
             :publishing-directory my/web-export-path
             :recursive t
             :publishing-function 'org-publish-attachment
             )
       (list "blog"
             :recursive t
             :base-directory my/blog-src-path
             :publishing-directory my/web-export-path
             :publishing-function 'my/publish-to-html
             :html-html5-fancy t
             :htmlized-source t
             :with-author nil
             :with-creator t
             :with-toc t
             :section-numbers nil
             :time-stamp-file nil
             )
       (list "blog-rss"
             :author "Alex M"
             :email "iam@fidonode.me"
             :base-directory my/blog-src-path
             :base-extension "org"
             :recursive t
             :exclude (regexp-opt '("rss.org" "index.org" "404.org" "posts.org"))
             :publishing-function 'my/publish-to-rss
             :publishing-directory my/web-export-path
             :rss-extension "xml"
             :html-link-home my/url
             :html-link-use-abs-url t
             :html-link-org-files-as-html t
             :auto-sitemap t
             :sitemap-filename "rss.org"
             :sitemap-title "rss"
             :sitemap-style 'list
             :sitemap-sort-files 'anti-chronologically
             :sitemap-function 'my/format-rss-feed
             :sitemap-format-entry 'my/format-rss-feed-entry)
       ))


;; Generate the site output
(org-publish-all t)

(message "Build complete!")