;;; config-ox-html.el --- Generated package (no.81) from my config -*- lexical-binding: t; -*- ;; ;; Copyright (C) 2024 TEC ;; ;; Author: TEC ;; Maintainer: TEC ;; Created: April 20, 2024 ;; Modified: April 20, 2024 ;; Version: 2024.04.20 ;; Homepage: https://code.tecosaur.net/tec/emacs-config ;; Package-Requires: ((emacs "29.1")) ;; ;; This file is not part of GNU Emacs. ;; ;;; Commentary: ;; ;; Generated package (no.81) from my config. ;; ;; During generation, dependency on other aspects of my configuration and ;; packages is inferred via (regexp-based) static analysis. While this seems ;; to do a good job, this method is imperfect. This code likely depends on ;; utilities provided by Doom, and if you try to run it in isolation you may ;; discover the code makes more assumptions. ;; ;; That said, I've found pretty good results so far. ;; ;;; Code: (require 'ox-html) (require 'config-org-exports) (define-minor-mode org-fancy-html-export-mode "Toggle my fabulous org export tweaks. While this mode itself does a little bit, the vast majority of the change in behaviour comes from switch statements in: - `org-html-template-fancier' - `org-html--build-meta-info-extended' - `org-html-src-block-collapsable' - `org-html-block-collapsable' - `org-html-table-wrapped' - `org-html--format-toc-headline-colapseable' - `org-html--toc-text-stripped-leaves' - `org-export-html-headline-anchor'" :global t :init-value t (if org-fancy-html-export-mode (setq org-html-style-default org-html-style-fancy org-html-meta-tags #'org-html-meta-tags-fancy org-html-checkbox-type 'html-span) (setq org-html-style-default org-html-style-plain org-html-meta-tags #'org-html-meta-tags-default org-html-checkbox-type 'html))) (defadvice! org-html-template-fancier (orig-fn contents info) "Return complete document string after HTML conversion. CONTENTS is the transcoded contents string. INFO is a plist holding export options. Adds a few extra things to the body compared to the default implementation." :around #'org-html-template (if (or (not org-fancy-html-export-mode) (bound-and-true-p org-msg-export-in-progress)) (funcall orig-fn contents info) (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 (fboundp 'coding-system-get) (coding-system-get org-html-coding-system 'mime-charset)) "iso-8859-1")))))) (org-html-doctype info) "\n" (concat "\n") "\n" (org-html--build-meta-info info) (org-html--build-head info) (org-html--build-mathjax-config info) "\n" "\n
" (let ((link-up (org-trim (plist-get info :html-link-up))) (link-home (org-trim (plist-get info :html-link-home)))) (unless (and (string= link-up "") (string= link-home "")) (format (plist-get info :html-home/up-format) (or link-up link-home) (or link-home link-up)))) ;; Preamble. (org-html--build-pre/postamble 'preamble info) ;; Document contents. (let ((div (assq 'content (plist-get info :html-divs)))) (format "<%s id=\"%s\">\n" (nth 1 div) (nth 2 div))) ;; 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 "
%s\n

%s

\n%s
" "

%s%s

\n") (if (or (plist-get info :with-date) (plist-get info :with-author)) (concat "
" (when (plist-get info :with-date) (org-export-data (plist-get info :date) info)) (when (and (plist-get info :with-date) (plist-get info :with-author)) ", ") (when (plist-get info :with-author) (org-export-data (plist-get info :author) info)) "
\n") "") (org-export-data title info) (if subtitle (format (if html5-fancy "

%s

\n" (concat "\n" (org-html-close-tag "br" nil info) "\n" "%s\n")) (org-export-data subtitle info)) ""))))) contents (format "\n" (nth 1 (assq 'content (plist-get info :html-divs)))) ;; Postamble. (org-html--build-pre/postamble 'postamble info) ;; Possibly use the Klipse library live code blocks. (when (plist-get info :html-klipsify-src) (concat "")) ;; Closing document. "
\n\n"))) (defadvice! org-html-toc-linked (depth info &optional scope) "Build a table of contents. Just like `org-html-toc', except the header is a link to \"#\". DEPTH is an integer specifying the depth of the table. INFO is a plist used as a communication channel. Optional argument SCOPE is an element defining the scope of the table. Return the table of contents as a string, or nil if it is empty." :override #'org-html-toc (let ((toc-entries (mapcar (lambda (headline) (cons (org-html--format-toc-headline headline info) (org-export-get-relative-level headline info))) (org-export-collect-headlines info depth scope)))) (when toc-entries (let ((toc (concat "
" (org-html--toc-text toc-entries) "
\n"))) (if scope toc (let ((outer-tag (if (org-html--html5-fancy-p info) "nav" "div"))) (concat (format "<%s id=\"table-of-contents\">\n" outer-tag) (let ((top-level (plist-get info :html-toplevel-hlevel))) (format "%s\n" top-level (org-html--translate "Table of Contents" info) top-level)) toc (format "\n" outer-tag)))))))) (defvar org-html-meta-tags-opengraph-image '(:image "https://tecosaur.com/resources/org/nib.png" :type "image/png" :width "200" :height "200" :alt "Green fountain pen nib") "Plist of og:image:PROP properties and their value, for use in `org-html-meta-tags-fancy'.") (defun org-html-meta-tags-fancy (info) "Use the INFO plist to construct the meta tags, as described in `org-html-meta-tags'." (let ((title (org-html-plain-text (org-element-interpret-data (plist-get info :title)) info)) (author (and (plist-get info :with-author) (let ((auth (plist-get info :author))) ;; Return raw Org syntax. (and auth (org-html-plain-text (org-element-interpret-data auth) info)))))) (append (list (when (org-string-nw-p author) (list "name" "author" author)) (when (org-string-nw-p (plist-get info :description)) (list "name" "description" (plist-get info :description))) '("name" "generator" "org mode") '("name" "theme-color" "#77aa99") '("property" "og:type" "article") (list "property" "og:title" title) (let ((subtitle (org-export-data (plist-get info :subtitle) info))) (when (org-string-nw-p subtitle) (list "property" "og:description" subtitle)))) (when org-html-meta-tags-opengraph-image (list (list "property" "og:image" (plist-get org-html-meta-tags-opengraph-image :image)) (list "property" "og:image:type" (plist-get org-html-meta-tags-opengraph-image :type)) (list "property" "og:image:width" (plist-get org-html-meta-tags-opengraph-image :width)) (list "property" "og:image:height" (plist-get org-html-meta-tags-opengraph-image :height)) (list "property" "og:image:alt" (plist-get org-html-meta-tags-opengraph-image :alt)))) (list (when (org-string-nw-p author) (list "property" "og:article:author:first_name" (car (s-split-up-to " " author 2)))) (when (and (org-string-nw-p author) (s-contains-p " " author)) (list "property" "og:article:author:last_name" (cadr (s-split-up-to " " author 2)))) (list "property" "og:article:published_time" (format-time-string "%FT%T%z" (or (when-let ((date-str (cadar (org-collect-keywords '("DATE"))))) (unless (string= date-str (format-time-string "%F")) (ignore-errors (encode-time (org-parse-time-string date-str))))) (if buffer-file-name (file-attribute-modification-time (file-attributes buffer-file-name)) (current-time))))) (when buffer-file-name (list "property" "og:article:modified_time" (format-time-string "%FT%T%z" (file-attribute-modification-time (file-attributes buffer-file-name))))))))) (unless (functionp #'org-html-meta-tags-default) (defalias 'org-html-meta-tags-default #'ignore)) (setq org-html-meta-tags #'org-html-meta-tags-fancy) (setq org-html-style-plain org-html-style-default org-html-htmlize-output-type 'css org-html-doctype "html5" org-html-html5-fancy t) (defun org-html-reload-fancy-style () (interactive) (setq org-html-style-fancy (with-temp-buffer (insert-file-contents (expand-file-name "misc/org-export-header.html" doom-user-dir)) (goto-char (point-max)) (insert "\n") (buffer-string))) (when org-fancy-html-export-mode (setq org-html-style-default org-html-style-fancy))) (org-html-reload-fancy-style) (defvar org-html-export-collapsed nil) (eval '(cl-pushnew '(:collapsed "COLLAPSED" "collapsed" org-html-export-collapsed t) (org-export-backend-options (org-export-get-backend 'html)))) (add-to-list 'org-default-properties "EXPORT_COLLAPSED") (defadvice! org-html-src-block-collapsable (orig-fn src-block contents info) "Wrap the usual 
 block in a 
"
  :around #'org-html-src-block
  (if (or (not org-fancy-html-export-mode) (bound-and-true-p org-msg-export-in-progress))
      (funcall orig-fn src-block contents info)
    (let* ((properties (cadr src-block))
           (lang (mode-name-to-lang-name
                  (plist-get properties :language)))
           (name (plist-get properties :name))
           (ref (org-export-get-reference src-block info))
           (collapsed-p (member (or (org-export-read-attribute :attr_html src-block :collapsed)
                                    (plist-get info :collapsed))
                                '("y" "yes" "t" t "true" "all"))))
      (format
       "
%s


#
\


%s

"
       ref
       (if collapsed-p "" " open")
       (if name " class='named'" "")
       (concat
        (when name (concat "" name ""))
        "" lang "")
       ref
       (if name
           (replace-regexp-in-string (format "" ref) ""
                                     (funcall orig-fn src-block contents info))
         (funcall orig-fn src-block contents info))))))

(defun mode-name-to-lang-name (mode)
  (or (cadr (assoc mode
                   '(("asymptote" "Asymptote")
                     ("awk" "Awk")
                     ("C" "C")
                     ("clojure" "Clojure")
                     ("css" "CSS")
                     ("D" "D")
                     ("ditaa" "ditaa")
                     ("dot" "Graphviz")
                     ("calc" "Emacs Calc")
                     ("emacs-lisp" "Emacs Lisp")
                     ("fortran" "Fortran")
                     ("gnuplot" "gnuplot")
                     ("haskell" "Haskell")
                     ("hledger" "hledger")
                     ("java" "Java")
                     ("js" "Javascript")
                     ("latex" "LaTeX")
                     ("ledger" "Ledger")
                     ("lisp" "Lisp")
                     ("lilypond" "Lilypond")
                     ("lua" "Lua")
                     ("matlab" "MATLAB")
                     ("mscgen" "Mscgen")
                     ("ocaml" "Objective Caml")
                     ("octave" "Octave")
                     ("org" "Org mode")
                     ("oz" "OZ")
                     ("plantuml" "Plantuml")
                     ("processing" "Processing.js")
                     ("python" "Python")
                     ("R" "R")
                     ("ruby" "Ruby")
                     ("sass" "Sass")
                     ("scheme" "Scheme")
                     ("screen" "Gnu Screen")
                     ("sed" "Sed")
                     ("sh" "shell")
                     ("sql" "SQL")
                     ("sqlite" "SQLite")
                     ("forth" "Forth")
                     ("io" "IO")
                     ("J" "J")
                     ("makefile" "Makefile")
                     ("maxima" "Maxima")
                     ("perl" "Perl")
                     ("picolisp" "Pico Lisp")
                     ("scala" "Scala")
                     ("shell" "Shell Script")
                     ("ebnf2ps" "ebfn2ps")
                     ("cpp" "C++")
                     ("abc" "ABC")
                     ("coq" "Coq")
                     ("groovy" "Groovy")
                     ("bash" "bash")
                     ("csh" "csh")
                     ("ash" "ash")
                     ("dash" "dash")
                     ("ksh" "ksh")
                     ("mksh" "mksh")
                     ("posh" "posh")
                     ("ada" "Ada")
                     ("asm" "Assembler")
                     ("caml" "Caml")
                     ("delphi" "Delphi")
                     ("html" "HTML")
                     ("idl" "IDL")
                     ("mercury" "Mercury")
                     ("metapost" "MetaPost")
                     ("modula-2" "Modula-2")
                     ("pascal" "Pascal")
                     ("ps" "PostScript")
                     ("prolog" "Prolog")
                     ("simula" "Simula")
                     ("tcl" "tcl")
                     ("tex" "LaTeX")
                     ("plain-tex" "TeX")
                     ("verilog" "Verilog")
                     ("vhdl" "VHDL")
                     ("xml" "XML")
                     ("nxml" "XML")
                     ("conf" "Configuration File"))))
      mode))

(defun org-html-block-collapsable (orig-fn block contents info)
  "Wrap the usual block in a 
"
  (if (or (not org-fancy-html-export-mode) (bound-and-true-p org-msg-export-in-progress))
      (funcall orig-fn block contents info)
    (let ((ref (org-export-get-reference block info))
          (type (pcase (car block)
                  ('property-drawer "Properties")))
          (collapsed-default (pcase (car block)
                               ('property-drawer t)
                               (_ nil)))
          (collapsed-value (org-export-read-attribute :attr_html block :collapsed))
          (collapsed-p (or (member (org-export-read-attribute :attr_html block :collapsed)
                                   '("y" "yes" "t" t "true"))
                           (member (plist-get info :collapsed) '("all")))))
      (format
       "

%s

\
#
\


%s\n

"
       ref
       (if (or collapsed-p collapsed-default) "" " open")
       (if type " class='named'" "")
       (if type (format "%s" type) "")
       ref
       (funcall orig-fn block contents info)))))

(advice-add 'org-html-example-block   :around #'org-html-block-collapsable)
(advice-add 'org-html-fixed-width     :around #'org-html-block-collapsable)
(advice-add 'org-html-property-drawer :around #'org-html-block-collapsable)

(autoload #'highlight-numbers--turn-on "highlight-numbers")
(add-hook 'htmlize-before-hook #'highlight-numbers--turn-on)

(defadvice! org-html-table-wrapped (orig-fn table contents info)
  "Wrap the usual  in a 
"
  :around #'org-html-table
  (if (or (not org-fancy-html-export-mode) (bound-and-true-p org-msg-export-in-progress))
      (funcall orig-fn table contents info)
    (let* ((name (plist-get (cadr table) :name))
           (ref (org-export-get-reference table info)))
      (format "


#



%s

\

"
              ref ref
              (if name
                  (replace-regexp-in-string (format "
"
              id id (funcall orig-fn headline info)))))

(defadvice! org-html--toc-text-stripped-leaves (orig-fn toc-entries)
  "Remove label"
  :around #'org-html--toc-text
  (if (or (not org-fancy-html-export-mode) (bound-and-true-p org-msg-export-in-progress))
      (funcall orig-fn toc-entries)
    (replace-regexp-in-string "]+>" "\\1"
                              (funcall orig-fn toc-entries))))

(setq org-html-text-markup-alist
      '((bold . "%s")
        (code . "%s")
        (italic . "%s")
        (strike-through . "%s")
        (underline . "%s")
        (verbatim . "%s")))

(appendq! org-html-checkbox-types
          '((html-span
             (on . "")
             (off . "")
             (trans . ""))))
(setq org-html-checkbox-type 'html-span)

(pushnew! org-html-special-string-regexps
          '("->" . "→")
          '("<-" . "←"))

(defun org-export-html-headline-anchor (text backend info)
  (when (and (org-export-derived-backend-p backend 'html)
             (not (org-export-derived-backend-p backend 're-reveal))
             org-fancy-html-export-mode)
    (unless (bound-and-true-p org-msg-export-in-progress)
      (replace-regexp-in-string
       "\\(.*[^ ]\\)<\\/h[0-9]>" ; this is quite restrictive, but due to `org-reference-contraction' I can do this
       "\\3# "
       text))))

(add-to-list 'org-export-filter-headline-functions
             'org-export-html-headline-anchor)

(org-link-set-parameters "Https"
                         :follow (lambda (url arg) (browse-url (concat "https:" url) arg))
                         :export #'org-url-fancy-export)

(defun org-url-fancy-export (url _desc backend)
  (let ((metadata (org-url-unfurl-metadata (concat "https:" url))))
    (cond
     ((org-export-derived-backend-p backend 'html)
      (concat
       "
"
       (format "" (concat "https:" url))
       (when (plist-get metadata :image)
         (format "" (plist-get metadata :image)))
       ""
       (replace-regexp-in-string "//\\(?:www\\.\\)?\\([^/]+\\)/?.*" "\\1" url)
       "
"
       (when (plist-get metadata :title)
         (concat "" (org-html-encode-plain-text (plist-get metadata :title)) "
"))
       (when (plist-get metadata :description)
         (org-html-encode-plain-text (plist-get metadata :description)))
       "
"))
     (t url))))

(setq org-url-unfurl-metadata--cache nil)
(defun org-url-unfurl-metadata (url)
  (cdr (or (assoc url org-url-unfurl-metadata--cache)
           (car (push
                 (cons
                  url
                  (let* ((head-data
                          (cl-remove-if-not
                           #'listp
                           (cdaddr
                            (with-current-buffer
                                (progn (message "Fetching metadata from %s" url)
                                       (if (executable-find "curl")
                                           (with-current-buffer (generate-new-buffer " *curl*")
                                             (call-process "curl" nil t nil "--max-time" "5" "-sSL" url)
                                             (current-buffer))
                                         (url-retrieve-synchronously url t t 5)))
                              (goto-char (point-min))
                              (delete-region (point-min) (- (search-forward "") (point-max))
                              (goto-char (point-min))
                              (while (re-search-forward "" nil t)
                                (replace-match ""))
                              (goto-char (point-min))
                              (while (re-search-forward "" nil t)
                                (replace-match ""))
                              (libxml-parse-html-region (point-min) (point-max))))))
                         (meta (delq nil
                                     (mapcar
                                      (lambda (tag)
                                        (when (eq 'meta (car tag))
                                          (cons (or (cdr (assoc 'name (cadr tag)))
                                                    (cdr (assoc 'property (cadr tag))))
                                                (cdr (assoc 'content (cadr tag))))))
                                      head-data))))
                    (let ((title (or (cdr (assoc "og:title" meta))
                                     (cdr (assoc "twitter:title" meta))
                                     (nth 2 (assq 'title head-data))))
                          (description (or (cdr (assoc "og:description" meta))
                                           (cdr (assoc "twitter:description" meta))
                                           (cdr (assoc "description" meta))))
                          (image (or (cdr (assoc "og:image" meta))
                                     (cdr (assoc "twitter:image" meta)))))
                      (when image
                        (setq image (replace-regexp-in-string
                                     "^/" (concat "https://" (replace-regexp-in-string "//\\([^/]+\\)/?.*" "\\1" url) "/")
                                     (replace-regexp-in-string
                                      "^//" "https://"
                                      image))))
                      (list :title title :description description :image image))))
                 org-url-unfurl-metadata--cache)))))

;; (setq-default org-html-with-latex `dvisvgm)

(setcdr (assoc 'path org-html-mathjax-options)
        (list "https://cdn.jsdelivr.net/npm/mathjax@3/es5/tex-svg.js"))

(setq org-html-mathjax-template
  "

")

(provide 'config-ox-html)
;;; config-ox-html.el ends here