(require 'ox-html)
;; https://gileschamberlin.com/2020/02/25/writing-a-new-org-mode-exporter-back-end
;; https://github.com/grc/jujutsu-website/blob/master/elisp/org-jujutsu-site.el
;; https://orgmode.org/worg/dev/org-export-reference.html
(defvar shittyweb-html-background-color "#dcd1ba")
(defvar shittyweb-html-table-background-color "#bebebe")
(defvar shittyweb-html-table-border 1)
(defvar shittyweb-html-table-width "65%")
(defvar shittyweb-html-code-background-color "white")
(defvar shittyweb-html-code-border 1)
(org-export-define-derived-backend 'shittyweb-html 'html
:translate-alist '((template . shittyweb-html-template)
(src-block . shittyweb-html-src-block))
:options-alist '((:background-image "BACKGROUND_IMAGE" nil nil)
(:shittyweb-header "SHITTYWEB_HEADER" nil nil)
(:shittyweb-back "SHITTYWEB_BACK" nil "")))
(defun shittyweb-html-template (contents info)
"Return complete document string after HTML conversion.
CONTENTS is the transcoded contents string. INFO is a plist
holding export options."
(concat
(when (and (not (org-html-html5-p info)) (org-html-xhtml-p info))
(let* ((xml-declaration (plist-get info :html-xml-declaration))
(decl (or (and (stringp xml-declaration) xml-declaration)
(cdr (assoc (plist-get info :html-extension)
xml-declaration))
(cdr (assoc "html" xml-declaration))
"")))
(when (not (or (not decl) (string= "" decl)))
(format "%s\n"
(format decl
(or (and org-html-coding-system
(coding-system-get org-html-coding-system :mime-charset))
"iso-8859-1"))))))
(org-html-doctype info)
"\n"
(concat "<html"
(cond ((org-html-xhtml-p info)
(format
" xmlns=\"http://www.w3.org/1999/xhtml\" lang=\"%s\" xml:lang=\"%s\""
(plist-get info :language) (plist-get info :language)))
((org-html-html5-p info)
(format " lang=\"%s\"" (plist-get info :language))))
">\n")
"<head>\n"
(org-html--build-meta-info info)
(org-html--build-head info)
(org-html--build-mathjax-config info)
"</head>\n"
;; Body with background
(let ((background (plist-get info :background-image)))
(if background
(format "<body bgcolor=\"%s\" background=\"%s\">\n"
shittyweb-html-background-color
background)
(format "<body bgcolor=\"%s\">"
shittyweb-html-background-color)))
;; I dont use link-up so byebye it goes.
;; Also I give it a directory instead of file.
(let ((link-home (org-trim (plist-get info :html-link-home))))
(unless (string= link-home "")
(format (plist-get info :html-home/up-format) link-home link-home)))
;; The back button thingy
(let ((back-page (org-trim (plist-get info :shittyweb-back))))
(unless (string= back-page "")
back-page))
;; Preamble.
(org-html--build-pre/postamble 'preamble info)
"\n<center>\n"
;; Shittyweb header. Its outside the weird table thing.
(let ((shittyweb-header (plist-get info :shittyweb-header)))
(if shittyweb-header
shittyweb-header))
;; Document contents.
(let ((div (assq 'content (plist-get info :html-divs))))
(format "<table border=\"%d\" width=\"%s\" bgcolor=\"%s\" id=\
\"%s\" class=\"%s\"><tr><td>\n"
shittyweb-html-table-border
shittyweb-html-table-width
shittyweb-html-table-background-color
(nth 2 div)
(plist-get info :html-content-class)))
;; Document title.
(when (plist-get info :with-title)
(let ((title (and (plist-get info :with-title)
(plist-get info :title)))
(subtitle (plist-get info :subtitle))
(html5-fancy (org-html--html5-fancy-p info)))
(when title
(format
(if html5-fancy
"<header>\n<h1 class=\"title\">%s</h1>\n%s</header>"
"<h1 class=\"title\">%s%s</h1>\n")
(org-export-data title info)
(if subtitle
(format
(if html5-fancy
"<p class=\"subtitle\" role=\"doc-subtitle\">%s</p>\n"
(concat "\n" (org-html-close-tag "br" nil info) "\n"
"<span class=\"subtitle\">%s</span>\n"))
(org-export-data subtitle info))
"")))))
contents
"</td></tr></table>\n"
;; Postamble.
(org-html--build-pre/postamble 'postamble info)
;; Possibly use the Klipse library live code blocks.
(when (plist-get info :html-klipsify-src)
(concat "<script>" (plist-get info :html-klipse-selection-script)
"</script><script src=\""
org-html-klipse-js
"\"></script><link rel=\"stylesheet\" type=\"text/css\" href=\""
org-html-klipse-css "\"/>"))
;; Closing document.
"</center>\n</body>\n</html>"))
;; I don't like the way it handles src blocks. I just want <code>.
(defun shittyweb-html-src-block (src-block _contents info)
(let* ((code (org-html-format-code src-block info))
(code-lines (string-split (string-trim code) "\n")))
(defun join-code-lines (lines) ;; Change \n to <br />
(concat (car lines)
(if (cdr lines)
(concat "<br />\n" (join-code-lines (cdr lines)))
"")))
(format "<table bgcolor=\"%s\" border=\"%d\"><tr><td>\n\
<code>\n%s\n</code>\n</td></tr></table>"
shittyweb-html-code-background-color
shittyweb-html-code-border
(join-code-lines code-lines))))
(defun shittyweb-publish-to-html (plist filename pub-dir)
"Publish an org file to HTML.
FILENAME is the filename of the Org file to be published. PLIST
is the property list for the given project. PUB-DIR is the
publishing directory.
Return output file name."
(org-publish-org-to 'shittyweb-html filename
(concat (when (> (length org-html-extension) 0) ".")
(or (plist-get plist :html-extension)
org-html-extension
"html"))
plist pub-dir))
(provide 'shittyweb-html)