;;; config-org-exports.el --- Generated package (no.80) from my config -*- lexical-binding: t; -*- ;; ;; Copyright (C) 2024 TEC ;; ;; Author: TEC <https://code.tecosaur.net/tec> ;; Maintainer: TEC <contact@tecosaur.net> ;; 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.80) 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) (setq org-export-headline-levels 5) ; I like nesting (require 'ox-extra) (ox-extras-activate '(ignore-headlines)) (setq org-export-creator-string (format "Emacs %s (Org mode %s–%s)" emacs-version (org-release) (org-git-version))) (defun org-export-filter-text-acronym (text backend _info) "Wrap suspected acronyms in acronyms-specific formatting. Treat sequences of 2+ capital letters (optionally succeeded by \"s\") as an acronym. Ignore if preceeded by \";\" (for manual prevention) or \"\\\" (for LaTeX commands). TODO abstract backend implementations." (let ((base-backend (cond ((org-export-derived-backend-p backend 'latex) 'latex) ;; Markdown is derived from HTML, but we don't want to format it ((org-export-derived-backend-p backend 'md) nil) ((org-export-derived-backend-p backend 'html) 'html))) (case-fold-search nil)) (when base-backend (replace-regexp-in-string "[;\\\\]?\\b[A-Z][A-Z]+s?\\(?:[^A-Za-z]\\|\\b\\)" (lambda (all-caps-str) (cond ((equal (aref all-caps-str 0) ?\\) all-caps-str) ; don't format LaTeX commands ((equal (aref all-caps-str 0) ?\;) (substring all-caps-str 1)) ; just remove not-acronym indicator char ";" (t (let* ((final-char (if (string-match-p "[^A-Za-z]" (substring all-caps-str -1 (length all-caps-str))) (substring all-caps-str -1 (length all-caps-str)) nil)) ; needed to re-insert the [^A-Za-z] at the end (trailing-s (equal (aref all-caps-str (- (length all-caps-str) (if final-char 2 1))) ?s)) (acr (if final-char (substring all-caps-str 0 (if trailing-s -2 -1)) (substring all-caps-str 0 (+ (if trailing-s -1 (length all-caps-str))))))) (pcase base-backend ('latex (concat "\\acr{" (s-downcase acr) "}" (when trailing-s "\\acrs{}") final-char)) ('html (concat "<span class='acr'>" acr "</span>" (when trailing-s "<small>s</small>") final-char))))))) text t t)))) (add-to-list 'org-export-filter-plain-text-functions #'org-export-filter-text-acronym) ;; We won't use `org-export-filter-headline-functions' because it ;; passes (and formats) the entire section contents. That's no good. (defun org-html-format-headline-acronymised (todo todo-type priority text tags info) "Like `org-html-format-headline-default-function', but with acronym formatting." (org-html-format-headline-default-function todo todo-type priority (org-export-filter-text-acronym text 'html info) tags info)) (setq org-html-format-headline-function #'org-html-format-headline-acronymised) (defun org-latex-format-headline-acronymised (todo todo-type priority text tags info) "Like `org-latex-format-headline-default-function', but with acronym formatting." (org-latex-format-headline-default-function todo todo-type priority (org-export-filter-text-acronym text 'latex info) tags info)) (setq org-latex-format-headline-function #'org-latex-format-headline-acronymised) (defvar org-reference-contraction-max-words 3 "Maximum number of words in a reference reference.") (defvar org-reference-contraction-max-length 35 "Maximum length of resulting reference reference, including joining characters.") (defvar org-reference-contraction-stripped-words '("the" "on" "in" "off" "a" "for" "by" "of" "and" "is" "to" "as") "Superfluous words to be removed from a reference.") (defvar org-reference-contraction-joining-char "-" "Character used to join words in the reference reference.") (defun org-reference-contraction-truncate-words (words) "Using `org-reference-contraction-max-length' as the total character 'budget' for the WORDS and truncate individual words to conform to this budget. To arrive at a budget that accounts for words undershooting their requisite average length, the number of characters in the budget freed by short words is distributed among the words exceeding the average length. This adjusts the per-word budget to be the maximum feasable for this particular situation, rather than the universal maximum average. This budget-adjusted per-word maximum length is given by the mathematical expression below: max length = \\floor{ \\frac{total length - chars for seperators - \\sum_{word \\leq average length} length(word) }{num(words) > average length} }" ;; trucate each word to a max word length determined by ;; (let* ((total-length-budget (- org-reference-contraction-max-length ; how many non-separator chars we can use (1- (length words)))) (word-length-budget (/ total-length-budget ; max length of each word to keep within budget org-reference-contraction-max-words)) (num-overlong (-count (lambda (word) ; how many words exceed that budget (> (length word) word-length-budget)) words)) (total-short-length (-sum (mapcar (lambda (word) ; total length of words under that budget (if (<= (length word) word-length-budget) (length word) 0)) words))) (max-length (/ (- total-length-budget total-short-length) ; max(max-length) that we can have to fit within the budget num-overlong))) (mapcar (lambda (word) (if (<= (length word) max-length) word (substring word 0 max-length))) words))) (defun org-reference-contraction (reference-string) "Give a contracted form of REFERENCE-STRING that is only contains alphanumeric characters. Strips 'joining' words present in `org-reference-contraction-stripped-words', and then limits the result to the first `org-reference-contraction-max-words' words. If the total length is > `org-reference-contraction-max-length' then individual words are truncated to fit within the limit using `org-reference-contraction-truncate-words'." (let ((reference-words (cl-remove-if-not (lambda (word) (not (member word org-reference-contraction-stripped-words))) (let ((str reference-string)) (setq str (downcase str)) (setq str (replace-regexp-in-string "\\[\\[[^]]+\\]\\[\\([^]]+\\)\\]\\]" "\\1" str)) ; get description from org-link (setq str (replace-regexp-in-string "[-/ ]+" " " str)) ; replace seperator-type chars with space (setq str (puny-encode-string str)) (setq str (replace-regexp-in-string "^xn--\\(.*?\\) ?-?\\([a-z0-9]+\\)$" "\\2 \\1" str)) ; rearrange punycode (setq str (replace-regexp-in-string "[^A-Za-z0-9 ]" "" str)) ; strip chars which need %-encoding in a uri (split-string str " +"))))) (when (> (length reference-words) org-reference-contraction-max-words) (setq reference-words (cl-subseq reference-words 0 org-reference-contraction-max-words))) (when (> (apply #'+ (1- (length reference-words)) (mapcar #'length reference-words)) org-reference-contraction-max-length) (setq reference-words (org-reference-contraction-truncate-words reference-words))) (string-join reference-words org-reference-contraction-joining-char))) (define-minor-mode unpackaged/org-export-html-with-useful-ids-mode "Attempt to export Org as HTML with useful link IDs. Instead of random IDs like \"#orga1b2c3\", use heading titles, made unique when necessary." :global t (if unpackaged/org-export-html-with-useful-ids-mode (advice-add #'org-export-get-reference :override #'unpackaged/org-export-get-reference) (advice-remove #'org-export-get-reference #'unpackaged/org-export-get-reference))) (unpackaged/org-export-html-with-useful-ids-mode 1) ; ensure enabled, and advice run (defun unpackaged/org-export-get-reference (datum info) "Like `org-export-get-reference', except uses heading titles instead of random numbers." (let ((cache (plist-get info :internal-references))) (or (car (rassq datum cache)) (let* ((crossrefs (plist-get info :crossrefs)) (cells (org-export-search-cells datum)) ;; Preserve any pre-existing association between ;; a search cell and a reference, i.e., when some ;; previously published document referenced a location ;; within current file (see ;; `org-publish-resolve-external-link'). ;; ;; However, there is no guarantee that search cells are ;; unique, e.g., there might be duplicate custom ID or ;; two headings with the same title in the file. ;; ;; As a consequence, before re-using any reference to ;; an element or object, we check that it doesn't refer ;; to a previous element or object. (new (or (cl-some (lambda (cell) (let ((stored (cdr (assoc cell crossrefs)))) (when stored (let ((old (org-export-format-reference stored))) (and (not (assoc old cache)) stored))))) cells) (when (org-element-property :raw-value datum) ;; Heading with a title (unpackaged/org-export-new-named-reference datum cache)) (when (member (car datum) '(src-block table example fixed-width property-drawer)) ;; Nameable elements (unpackaged/org-export-new-named-reference datum cache)) ;; NOTE: This probably breaks some Org Export ;; feature, but if it does what I need, fine. (org-export-format-reference (org-export-new-reference cache)))) (reference-string new)) ;; Cache contains both data already associated to ;; a reference and in-use internal references, so as to make ;; unique references. (dolist (cell cells) (push (cons cell new) cache)) ;; Retain a direct association between reference string and ;; DATUM since (1) not every object or element can be given ;; a search cell (2) it permits quick lookup. (push (cons reference-string datum) cache) (plist-put info :internal-references cache) reference-string)))) (defun unpackaged/org-export-new-named-reference (datum cache) "Return new reference for DATUM that is unique in CACHE." (cl-macrolet ((inc-suffixf (place) `(progn (string-match (rx bos (minimal-match (group (1+ anything))) (optional "--" (group (1+ digit))) eos) ,place) ;; HACK: `s1' instead of a gensym. (let* ((s1 (match-string 1 ,place)) (suffix-1 (match-string 2 ,place)) (suffix (if suffix-1 (string-to-number suffix-1) 0))) (setf ,place (format "%s--%s" s1 (1+ suffix))))))) (let* ((headline-p (eq (car datum) 'headline)) (title (if headline-p (org-element-property :raw-value datum) (or (org-element-property :name datum) (concat (org-element-property :raw-value (org-element-property :parent (org-element-property :parent datum))))))) ;; get ascii-only form of title without needing percent-encoding (ref (concat (org-reference-contraction (substring-no-properties title)) (unless (or headline-p (org-element-property :name datum)) (concat "," (pcase (car datum) ('src-block "code") ('example "example") ('fixed-width "mono") ('property-drawer "properties") (_ (symbol-name (car datum)))) "--1")))) (parent (when headline-p (org-element-property :parent datum)))) (while (member ref (mapcar #'car cache)) ;; Title not unique: make it so. (if parent ;; Append ancestor title. (setf title (concat (org-element-property :raw-value parent) "--" title) ;; get ascii-only form of title without needing percent-encoding ref (org-reference-contraction (substring-no-properties title)) parent (when headline-p (org-element-property :parent parent))) ;; No more ancestors: add and increment a number. (inc-suffixf ref))) ref))) (add-hook 'org-load-hook #'unpackaged/org-export-html-with-useful-ids-mode) (defadvice! org-export-format-reference-a (reference) "Format REFERENCE into a string. REFERENCE is a either a number or a string representing a reference, as returned by `org-export-new-reference'." :override #'org-export-format-reference (if (stringp reference) reference (format "org%07x" reference))) (defun +org-export-remove-zero-width-space (text _backend _info) "Remove zero width spaces from TEXT." (unless (org-export-derived-backend-p 'org) (replace-regexp-in-string "\u200B" "" text))) (add-to-list 'org-export-filter-final-output-functions #'+org-export-remove-zero-width-space t) (defun +org-mode--fontlock-only-mode () "Just apply org-mode's font-lock once." (let (org-mode-hook org-hide-leading-stars org-hide-emphasis-markers) (org-set-font-lock-defaults) (font-lock-ensure)) (setq-local major-mode #'fundamental-mode)) (defun +org-export-babel-mask-org-config (_backend) "Use `+org-mode--fontlock-only-mode' instead of `org-mode'." (setq-local org-src-lang-modes (append org-src-lang-modes (list (cons "org" #'+org-mode--fontlock-only))))) (add-hook 'org-export-before-processing-hook #'+org-export-babel-mask-org-config) (provide 'config-org-exports) ;;; config-org-exports.el ends here