Improve code blocks

Table of Contents

What is the problem with default highlighting?

Prism.js

Change code block template

(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* (
	 (language (format "language-%s" (org-element-property :language src-block)))
	 (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 Prism.js

(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 . "prism-theme") (rel . "stylesheet") (type . "text/css")))
     (link ((rel . "stylesheet") (type . "text/css") (href . "/resources/css/quirks.css")))
     (script ((src . "https://cdnjs.cloudflare.com/ajax/libs/prism/1.29.0/prism.min.js")) ())
     (script ((src . "https://cdnjs.cloudflare.com/ajax/libs/prism/1.29.0/plugins/autoloader/prism-autoloader.min.js")) ())
     (script ((src . "/resources/js/theme-selector.js")) ())
))
(title () ,title-str)

Respect prefers-color-scheme

function setPrismTheme() {
  const prismThemeLink = document.getElementById("prism-theme");
  const darkTheme =
    "https://cdnjs.cloudflare.com/ajax/libs/prism/1.29.0/themes/prism-tomorrow.min.css";
  const lightTheme =
    "https://cdnjs.cloudflare.com/ajax/libs/prism/1.29.0/themes/prism-solarizedlight.min.css";
  if (
    window.matchMedia &&
    window.matchMedia("(prefers-color-scheme: dark)").matches
  ) {
    prismThemeLink.href = darkTheme;
  } else {
    prismThemeLink.href = lightTheme;
  }
}

// Initial theme set
setPrismTheme();

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

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* (
	 (language (format "language-%s" (org-element-property :language src-block)))
	 (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
     "<!DOCTYPE html>"
     (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 . "prism-theme") (rel . "stylesheet") (type . "text/css")))
		   (link ((rel . "stylesheet") (type . "text/css") (href . "/resources/css/quirks.css")))
		   (script ((src . "https://cdnjs.cloudflare.com/ajax/libs/prism/1.29.0/prism.min.js")) ())
		   (script ((src . "https://cdnjs.cloudflare.com/ajax/libs/prism/1.29.0/plugins/autoloader/prism-autoloader.min.js")) ())
		   (script ((src . "/resources/js/theme-selector.js")) ())
		   )
		 )
	      (title () ,title-str)
	      )
	(body ((class . "line-numbers"))
	      (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!")