545 lines
23 KiB

;;; publish.el --- Build
;; Copyright (C) 2021, 2023 David Wilson <>
;; Author: David Wilson <>
;; Maintainer: David Wilson <>
;; URL:
;; Version: 0.0.1
;; Package-Requires: ((emacs "28.2"))
;; Keywords: hypermedia, blog, feed, rss
;; This file is not part of GNU Emacs.
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Docs License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; GNU General Docs License for more details.
;; You should have received a copy of the GNU General Docs License
;; along with this program. If not, see <>.
;;; Usage:
;; emacs -Q --batch -l ./publish.el --funcall dw/publish
;;; Code:
;; Initialize package sources
(require 'package)
;; Set the package installation directory so that packages aren't stored in the
;; ~/.emacs.d/elpa path.
(setq package-user-dir (expand-file-name "./.packages"))
(add-to-list 'package-archives '("melpa" . ""))
(add-to-list 'package-archives '("melpa-stable" . ""))
;; Initialize the package system
(unless package-archive-contents
;; Install use-package
(unless (package-installed-p 'use-package)
(package-install 'use-package))
(require 'use-package)
;; Require built-in dependencies
(require 'vc-git)
(require 'ox-publish)
(require 'subr-x)
(require 'cl-lib)
;; Install other dependencies
(use-package esxml
:pin "melpa-stable"
:ensure t)
(use-package htmlize
:ensure t)
(use-package webfeeder
:ensure t)
(defvar yt-iframe-format
(concat "<div class=\"video\">"
" <iframe src=\"\" allowfullscreen></iframe>"
(defun dw/embed-video (video-id)
(format yt-iframe-format video-id))
(setq user-full-name "David Wilson")
(setq user-mail-address "")
(defvar dw/site-url (if (string-equal (getenv "CI") "true")
"The URL for the site being generated.")
(defun dw/embed-list-form ()
`(div (@ (class "list-form center"))
(div (@ (class "list-form-title")) "Subscribe to the System Crafters Newsletter!")
(form (@ (method "POST")
(action ""))
(input (@ (type "hidden") (name "format") (value "text")))
(input (@ (type "hidden") (name "action") (value "subscribe")))
(input (@ (type "hidden") (name "list") (value "")))
(div (@ (class "list-form-message"))
"Stay up to date with the latest System Crafters news and updates! Read the "
(a (@ (href "/newsletter/")) "Newsletter")
" page for more information.")
(div (@ (class "row"))
(div (@ (class "column"))
(div (@ (class "row center list-form-label")) "Name (optional)")
(div (@ (class "row")) (input (@ (type "text") (name "name")))))
(div (@ (class "column"))
(div (@ (class "row center list-form-label")) "Email Address")
(div (@ (class "row")) (input (@ (type "text") (name "email"))))))
(div nil
(input (@ (type "submit") (value "Subscribe!")))))))
(lambda (handle)
(concat ""
(lambda (path desc backend channel)
(when (eq backend 'html)
(dw/embed-video path))))
(defun dw/site-header ()
(list `(header (@ (class "site-header"))
(div (@ (class "container"))
(div (@ (class "site-title"))
(img (@ (class "logo")
(src ,(concat dw/site-url "/img/sc_logo.png"))
(alt "System Crafters")))))
(div (@ (class "site-masthead"))
(div (@ (class "container"))
(nav (@ (class "nav"))
(a (@ (class "nav-link") (href "/")) "Home") " "
(a (@ (class "nav-link") (href "/guides/")) "Guides") " "
(a (@ (class "nav-link") (href "/news/")) "News") " "
(a (@ (class "nav-link") (href "/community/")) "Community") " "
(a (@ (class "nav-link") (href "")) "Store") " "
(a (@ (class "nav-link") (href "/how-to-help/")) "How to Help")))))))
(defun dw/site-footer ()
(list `(footer (@ (class "site-footer"))
(div (@ (class "container"))
(div (@ (class "row"))
(div (@ (class "column"))
(p (a (@ (href ,(concat dw/site-url "/privacy-policy/"))) "Privacy Policy")
" · "
(a (@ (href ,(concat dw/site-url "/credits/"))) "Credits")
" · "
(a (@ (href ,(concat dw/site-url "/rss/"))) "RSS Feeds")
" · "
(a (@ (rel "me") (href "")) "Fediverse"))
(p "© 2021-2023 System Crafters LLC"))
(div (@ (class "column align-right"))
(p (a (@ (href ""))
(img (@ (src ,(concat dw/site-url "/img/codeberg.png"))
(style "width: 120px")
(alt "Contribute on Codeberg")))))))))))
(defun get-article-output-path (org-file pub-dir)
(let ((article-dir (concat pub-dir
(file-name-nondirectory org-file)))))))
(if (string-match "\\/\\|\\/$" org-file)
(unless (file-directory-p article-dir)
(make-directory article-dir t))
(defun dw/get-commit-hash ()
"Get the short hash of the latest commit in the current repository."
(with-current-buffer standard-output
(vc-git-command t nil nil "rev-parse" "--short" "HEAD")))))
(cl-defun dw/generate-page (title
"<!-- Generated from " (dw/get-commit-hash) " on " (format-time-string "%Y-%m-%d @ %H:%M") " with " org-export-creator-string " -->\n"
"<!DOCTYPE html>"
`(html (@ (lang "en"))
(meta (@ (charset "utf-8")))
(meta (@ (author "System Crafters - David Wilson")))
(meta (@ (name "viewport")
(content "width=device-width, initial-scale=1, shrink-to-fit=no")))
(link (@ (rel "icon") (type "image/png") (href "/img/favicon.png")))
(link (@ (rel "alternative")
(type "application/rss+xml")
(title "System Crafters News")
(href ,(concat dw/site-url "/rss/news.xml"))))
(link (@ (rel "stylesheet") (href ,(concat dw/site-url "/fonts/iosevka-aile/iosevka-aile.css"))))
(link (@ (rel "stylesheet") (href ,(concat dw/site-url "/fonts/jetbrains-mono/jetbrains-mono.css"))))
(link (@ (rel "stylesheet") (href ,(concat dw/site-url "/css/code.css"))))
(link (@ (rel "stylesheet") (href ,(concat dw/site-url "/css/site.css"))))
(script (@ (defer "defer")
(data-domain "")
(src ""))
;; Empty string to cause a closing </script> tag
,(when head-extra head-extra)
(title ,(concat title " - System Crafters")))
(body ,@(unless exclude-header
(div (@ (class "container"))
(div (@ (class "site-post"))
(h1 (@ (class "site-post-title"))
,(when publish-date
`(p (@ (class "site-post-meta")) ,publish-date))
,(if-let ((video-id (plist-get info :video)))
(dw/embed-video video-id))
,(when pre-content pre-content)
(div (@ (id "content"))
,@(unless exclude-footer
(defun dw/org-html-template (contents info)
(dw/generate-page (org-export-data (plist-get info :title) info)
:publish-date (org-export-data (org-export-get-date info "%B %e, %Y") info)))
(defun dw/org-html-link (link contents info)
"Removes file extension and changes the path into lowercase file:// links."
(when (and (string= 'file (org-element-property :type link))
(string= "org" (file-name-extension (org-element-property :path link))))
(org-element-put-property link :path
(org-element-property :path link)))))
(let ((exported-link (org-export-custom-protocol-maybe link contents 'html info)))
(exported-link exported-link)
((equal contents nil)
(format "<a href=\"%s\">%s</a>"
(org-element-property :raw-link link)
(org-element-property :raw-link link)))
((string-prefix-p "/" (org-element-property :raw-link link))
(format "<a href=\"%s\">%s</a>"
(org-element-property :raw-link link)
(t (org-export-with-backend 'html link contents info)))))
(defun dw/make-heading-anchor-name (headline-text)
(thread-last headline-text
(replace-regexp-in-string " " "-")
(replace-regexp-in-string "[^[:alnum:]_-]" "")))
(defun dw/org-html-headline (headline contents info)
(let* ((text (org-export-data (org-element-property :title headline) info))
(level (org-export-get-relative-level headline info))
(level (min 7 (when level (1+ level))))
(anchor-name (dw/make-heading-anchor-name text))
(attributes (org-element-property :ATTR_HTML headline))
(container (org-element-property :HTML_CONTAINER headline))
(container-class (and container (org-element-property :HTML_CONTAINER_CLASS headline))))
(when attributes
(setq attributes
(format " %s" (org-html--make-attribute-string
(org-export-read-attribute 'attr_html `(nil
(attr_html ,(split-string attributes))))))))
(when (and container (not (string= "" container)))
(format "<%s%s>" container (if container-class (format " class=\"%s\"" container-class) "")))
(if (not (org-export-low-level-p headline info))
(format "<h%d%s><a id=\"%s\" class=\"anchor\" href=\"#%s\">¶</a>%s</h%d>%s"
(or attributes "")
(or contents ""))
(when (org-export-first-sibling-p headline info) "<ul>")
(format "<li>%s%s</li>" text (or contents ""))
(when (org-export-last-sibling-p headline info) "</ul>")))
(when (and container (not (string= "" container)))
(format "</%s>" (cl-subseq container 0 (cl-search " " container)))))))
(defun dw/org-html-src-block (src-block _contents info)
(let* ((lang (org-element-property :language src-block))
(code (org-html-format-code src-block info)))
(format "<pre>%s</pre>" (string-trim code))))
(defun dw/org-html-special-block (special-block contents info)
"Transcode a SPECIAL-BLOCK element from Org to HTML.
CONTENTS holds the contents of the block. INFO is a plist
holding contextual information."
(let* ((block-type (org-element-property :type special-block))
(attributes (org-export-read-attribute :attr_html special-block)))
(format "<div class=\"%s center\">\n%s\n</div>"
(or contents
(if (string= block-type "cta")
"If you find this guide helpful, please consider supporting System Crafters via the links on the <a href=\"/how-to-help/#support-my-work\">How to Help</a> page!"
(org-export-define-derived-backend 'site-html 'html
'((template . dw/org-html-template)
(link . dw/org-html-link)
(src-block . dw/org-html-src-block)
(special-block . dw/org-html-special-block)
(headline . dw/org-html-headline))
'((:video "VIDEO" nil nil)))
(defun org-html-publish-to-html (plist filename pub-dir)
"Publish an org file to HTML, using the FILENAME as the output directory."
(let ((article-path (get-article-output-path filename pub-dir)))
(cl-letf (((symbol-function 'org-export-output-file-name)
(lambda (extension &optional subtreep pub-dir)
;; The 404 page is a special case, it must be named "404.html"
(concat article-path
(if (string= (file-name-nondirectory filename) "") "404" "index")
(org-publish-org-to 'site-html
(concat "." (or (plist-get plist :html-extension)
(defun dw/publish-newsletter-page (plist filename pub-dir)
"Publish a newsletter .txt file to a simple HTML page."
(let* ((issue-name (file-name-sans-extension
(file-name-nondirectory filename)))
(output-file (expand-file-name
(concat issue-name ".html")
(contents (with-temp-buffer
(insert-file-contents filename)
(with-temp-file output-file
(concat "Issue "
(nth 2 (split-string issue-name "-")))
(format "<pre class=\"newsletter-text\">%s</pre>"
"\\(http\\|https\\)://[^ \t\n\r<>\"']*[^ \t\n\r<>\".,;!?']"
(lambda (match)
(format "<a href=\"%s\">%s</a>" match match))
:exclude-header t
:exclude-footer t)))))
(setq org-publish-use-timestamps-flag t
org-publish-timestamp-directory "./.org-cache/"
org-export-with-section-numbers nil
org-export-use-babel nil
org-export-with-smart-quotes t
org-export-with-sub-superscripts nil
org-export-with-tags 'not-in-toc
org-html-htmlize-output-type 'css
org-html-prefer-user-labels t
org-html-link-home dw/site-url
org-html-link-use-abs-url t
org-html-link-org-files-as-html t
org-html-html5-fancy t
org-html-self-link-headlines t
org-export-with-toc nil
make-backup-files nil)
(defun dw/format-live-stream-entry (entry style project)
"Format posts with author and published data in the index page."
(cond ((not (directory-name-p entry))
(format "[[file:%s][%s]] - %s"
(org-publish-find-title entry project)
(format-time-string "%B %d, %Y"
(org-publish-find-date entry project))))
((eq style 'tree) (file-name-nondirectory (directory-file-name entry)))
(t entry)))
(defun dw/format-news-entry (entry style project)
"Format posts with author and published data in the index page."
(cond ((not (directory-name-p entry))
(format "[[file:%s][%s]] - %s · %s"
(org-publish-find-title entry project)
(car (org-publish-find-property entry :author project))
(format-time-string "%B %d, %Y"
(org-publish-find-date entry project))))
((eq style 'tree) (file-name-nondirectory (directory-file-name entry)))
(t entry)))
(defun dw/news-sitemap (title files)
(format "#+title: %s\n\n%s"
(mapconcat (lambda (file)
(format "- %s\n" file))
(cadr files)
(defun dw/rss-extract-title (html-file)
"Extract the title from an HTML file."
(insert-file-contents html-file)
(let ((dom (libxml-parse-html-region (point-min) (point-max))))
(dom-text (car (dom-by-class dom "site-post-title"))))))
(defun dw/rss-extract-date (html-file)
"Extract the post date from an HTML file."
(insert-file-contents html-file)
(let* ((dom (libxml-parse-html-region (point-min) (point-max)))
(date-string (dom-text (car (dom-by-class dom "site-post-meta"))))
(parsed-date (parse-time-string date-string))
(day (nth 3 parsed-date))
(month (nth 4 parsed-date))
(year (nth 5 parsed-date)))
;; NOTE: Hardcoding this at 8am for now
(encode-time 0 0 8 day month year))))
;(defun dw/rss-extract-summary (html-file)
; )
(setq webfeeder-title-function #'dw/rss-extract-title
webfeeder-date-function #'dw/rss-extract-date)
(setq org-publish-project-alist
(list '("systemcrafters:main"
:base-directory "./content"
:base-extension "org"
:publishing-directory "./public"
:publishing-function org-html-publish-to-html
:with-title nil
:with-timestamps nil)
:base-directory "./content/faq"
:base-extension "org"
:publishing-directory "./public/faq"
:publishing-function org-html-publish-to-html
:with-title nil
:with-timestamps nil)
:base-directory "./assets"
:base-extension "css\\|js\\|png\\|jpg\\|gif\\|pdf\\|mp3\\|ogg\\|woff2\\|ttf"
:publishing-directory "./public"
:recursive t
:publishing-function org-publish-attachment)
:base-directory "./content/live-streams"
:base-extension "org"
:publishing-directory "./public/live-streams"
:publishing-function org-html-publish-to-html
:auto-sitemap t
:sitemap-filename "../"
:sitemap-title "Live Streams"
:sitemap-format-entry dw/format-live-stream-entry
:sitemap-style list
:sitemap-sort-files anti-chronologically
:with-title nil
:with-timestamps nil)
:base-directory "./content/news"
:base-extension "org"
:publishing-directory "./public/news"
:publishing-function org-html-publish-to-html
:auto-sitemap t
:sitemap-filename "../"
:sitemap-title "System Crafters News"
:sitemap-format-entry dw/format-news-entry
:sitemap-style list
;; :sitemap-function dw/news-sitemap
:sitemap-sort-files anti-chronologically
:with-title nil
:with-timestamps nil)
:base-directory "./content/newsletter"
:base-extension "txt"
:publishing-directory "./public/newsletter"
:publishing-function dw/publish-newsletter-page)
:base-directory "./content/videos"
:base-extension "org"
:recursive t
:publishing-directory "./public"
:publishing-function org-html-publish-to-html
:with-title nil
:with-timestamps nil)))
;; TODO: Generate a _redirects file instead once Codeberg Pages releases a new version
(defun dw/generate-redirects (redirects)
(dolist (redirect redirects)
(let ((output-path (concat "./public/" (car redirect) "/index.html"))
(redirect-url (concat dw/site-url "/" (cdr redirect) "/")))
(make-directory (file-name-directory output-path) t)
(with-temp-file output-path
(dw/generate-page "Redirecting..."
(concat "You are being redirected to "
"<a href=\"" redirect-url "\">" redirect-url "</a>")
(concat "<meta http-equiv=\"refresh\" content=\"0; url='" redirect-url "'\"/>")))))))
(defun dw/publish ()
"Publish the entire site."
(org-publish-all (string-equal (or (getenv "FORCE")
(getenv "CI"))
(webfeeder-build "rss/news.xml"
(let ((default-directory (expand-file-name "./public/")))
(remove "news/index.html"
(directory-files-recursively "news"
:builder 'webfeeder-make-rss
:title "System Crafters News"
:description "News and Insights from System Crafters!"
:author "David Wilson")
(dw/generate-redirects '(("support-the-channel" . "how-to-help")
("videos" . "guides")))
;; Copy the domains file to ensure the custom domain resolves
(copy-file ".domains" "public/.domains" t)
;; Copy the .well-known folder for Matrix
(unless (file-exists-p "public/.well-known")
(copy-directory ".well-known" "public/" t)))
(provide 'publish)
;;; publish.el ends here