#!/usr/bin/env -S emacs -Q --batch --script
(require 'ox)
(require 'esxml)
(defun thomaslabs-navbar ()
(sxml-to-xml
`(nav
(ul
(li (a (@ (href "/"))
"Home"))
(li (a (@ (href "/z80/"))
"Z80"))
(li (a (@ (href "/programs/"))
"programs"))
(li (a (@ (href "/math/"))
"math"))
(li (a (@ (href "https://git.thomaslabs.org"))
"git"))
(li (a (@ (href "/privacy.html"))
"contact & privacy policy"))))))
(defun thomaslabs-footer ()
(sxml-to-xml
`(footer
(p
"Copyright © 2021 - 2023 Thomas Albers Raviola"
(br)
"This website and its contents are published under the
following licences, unless otherwise specified"
(ul
(li "Website and images:"
(a (@ (href "https://creativecommons.org/licenses/by-nc-sa/4.0/"))
"CC BY-NC-SA 4.0"))
(li "Schematics:"
(a (@ (href "https://creativecommons.org/licenses/by-nc-nd/4.0/"))
"CC BY-NC-ND 4.0"))
(li "Code:"
(a (@ (href "https://www.gnu.org/licenses/gpl-3.0.html"))
"GPL-3.0")))))))
(defun thomaslabs-template (contents info)
(concat
"\n"
(sxml-to-xml
`(html (@ (lang "en"))
(head
,(org-html--build-meta-info
`(:title ,(if (plist-get info :title)
(format "Thomas' Labs | %s" (car (plist-get info :title)))
"Thomas' Labs")
,@info))
,(org-html--build-head info))
(body
,(if-let ((title (plist-get info :title)))
(let ((subtitle (plist-get info :subtitle)))
`(header
(div "Thomas' Labs")
(h1 ,(org-export-data title info))
,@(if subtitle
`((div (@ (class "subtitle"))
,(car subtitle)))
'())))
`(header
(h1 "Thomas' Labs")))
,(thomaslabs-navbar)
(div (@ (class "content"))
(main
(article ,contents)))
(hr)
,(thomaslabs-footer))))))
(defun math-preamble (&rest args)
(sxml-to-xml
'(div
(h2 "Disclaimer")
(p "This site as of now just a technology demonstration and its claims
should not be taken as true (even though I myself am pretty confident
they are"))))
(defun math-sitemap (title entries)
(concat "#+title: " title "\n"
"#+setupfile: ../../math_options.org\n\n"
(org-list-to-org entries)))
(defun org-local-link-export (link description format info)
(format "%s"
link
description))
(defun org-img-link-export (link description format info)
(format "%s"
link
description))
(defun org-local-link-follow (&rest args)
t)
(org-link-set-parameters "local"
:follow #'org-local-link-follow
:export #'org-local-link-export)
(org-link-set-parameters "img"
:follow #'org-local-link-follow
:export #'org-img-link-export)
(defvar root-dir (expand-file-name ""))
(defun org-export-file-uri (filename)
"Return file URI associated to FILENAME."
(cond ((not (file-name-absolute-p filename))
(string-remove-prefix "site" filename))
((string-suffix-p ".jpg" filename)
(concat "/img-small" (string-remove-prefix "/img" filename)))
(t
(string-remove-prefix (concat root-dir "/site")
(expand-file-name filename)))))
(org-export-define-derived-backend 'thomaslabs-html 'html
:translate-alist
'((template . thomaslabs-template)))
(defun thomaslabs-publish-to-html (plist filename pub-dir)
"Publish an org file to HTML, using the FILENAME as the output directory."
(org-publish-org-to 'thomaslabs-html
filename
".html"
plist
pub-dir))
(defun image-dimensions (pathname)
(with-temp-buffer
(call-process "identify" nil (current-buffer) nil
"-ping" "-format" "%wx%h" pathname)
(mapcar #'cl-parse-integer (split-string (buffer-string) "x"))))
(defun resize-image (factor input output)
(let ((percentage (format "%.01f%%" (* 100.0 factor))))
(call-process "convert" nil nil nil input "-resize" percentage output)))
(defun thomaslabs-publish-image (_plist filename pub-dir)
(unless (file-directory-p pub-dir)
(make-directory pub-dir t))
(let ((output (expand-file-name (file-name-nondirectory filename) pub-dir)))
(unless (file-equal-p (expand-file-name (file-name-directory filename))
(file-name-as-directory (expand-file-name pub-dir)))
(let* ((dimensions (image-dimensions filename))
(width (cl-first dimensions))
(height (cl-second dimensions))
(factor (min (/ 800.0 width) (/ 800.0 height) 1.0)))
(resize-image factor filename output)))
;; Return file name.
output))
(defun org-html--wrap-latex-environment (contents _ &optional caption label)
"Wrap CONTENTS string within appropriate environment for equations.
When optional arguments CAPTION and LABEL are given, use them for
caption and \"id\" attribute."
(format "\n\n%s%s\n"
;; ID.
(if (org-string-nw-p label) (format " id=\"%s\"" label) "")
;; Contents.
(format "\n%s\n" contents)
;; Caption.
(if (not (org-string-nw-p caption)) ""
(format "\n(%s)"
caption))))
(defvar default-html-project-properties
'(:publishing-function thomaslabs-publish-to-html
:with-toc nil
:recursive nil
:language "en_US"
:html-head-include-default-style nil
:html-head-include-scripts nil
:html-preamble nil
:html-postamble nil
:html-use-infojs nil
:html-html5-fancy t
:html-doctype "html5"
:with-toc nil
:section-numbers nil
:with-latex dvisvgm))
(setq org-publish-project-alist
`(("root"
:base-directory "src"
:publishing-directory "site"
,@default-html-project-properties)
("arm"
:base-directory "src/arm"
:publishing-directory "site/arm"
,@default-html-project-properties
:recursive t)
("programs"
:base-directory "src/programs"
:publishing-directory "site/programs"
,@default-html-project-properties
:recursive t)
("z80"
:base-directory "src/z80"
:publishing-directory "site/z80"
,@default-html-project-properties
:recursive t)
("math"
:base-directory "src/math"
:publishing-directory "site/math"
:publishing-function thomaslabs-publish-to-html
,@(org-plist-delete default-html-project-properties :html-preamble)
:html-preamble math-preamble
:auto-sitemap t
:sitemap-filename "index.org"
:sitemap-title "Math and Physics articles"
:sitemap-function math-sitemap)
("img"
:base-directory "site/img"
:publishing-directory "site/img-small"
:base-extension "png\\|jpg\\|gif"
:recursive t
:publishing-function thomaslabs-publish-image)
("thomaslabs"
:components ("root" "arm" "programs" "z80" "math" "img"))))
;; (plist-put org-format-latex-options :html-foreground "#cccccc")
(plist-put org-format-latex-options :html-foreground "#000000")
(setq org-publish-timestamp-directory (concat (getenv "XDG_CACHE_HOME") "/org-timestamps/"))
(setq org-preview-latex-image-directory (expand-file-name "site/svg"))
(setq org-html-htmlize-output-type 'css)
(org-publish "thomaslabs" t)
;; fork ox-html?