seam-html.el (17381B)
1 ;;; seam-html.el --- Seam HTML exporter -*- lexical-binding: t -*- 2 3 ;; Copyright (C) 2025 Spencer Williams 4 ;; Copyright (C) 2011-2025 Free Software Foundation, Inc. 5 6 ;; Author: Spencer Williams <spnw@plexwave.org> 7 8 ;; SPDX-License-Identifier: GPL-3.0-or-later 9 10 ;; This file is not part of GNU Emacs. 11 12 ;; This program is free software: you can redistribute it and/or modify 13 ;; it under the terms of the GNU General Public License as published by 14 ;; the Free Software Foundation, either version 3 of the License, or 15 ;; (at your option) any later version. 16 17 ;; This program is distributed in the hope that it will be useful, 18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 20 ;; GNU General Public License for more details. 21 22 ;; You should have received a copy of the GNU General Public License 23 ;; along with this program. If not, see <http://www.gnu.org/licenses/>. 24 25 ;;; Commentary: 26 27 ;; Seam's HTML exporter. 28 ;; 29 ;; This was blithely hacked together using large chunks of code lifted 30 ;; straight from ox-html.el, and could do with much improvement. 31 ;; 32 ;; The original authors of ox-html are: 33 ;; Carsten Dominik <carsten.dominik@gmail.com> 34 ;; Jambunathan K <kjambunathan at gmail dot com> 35 36 ;;; Code: 37 38 (require 'ox-html) 39 40 ;;; Org <9.7 compatibility. 41 42 (fset 'seam-html--element-parent-element 43 (if (fboundp 'org-element-parent-element) 44 'org-element-parent-element 45 'org-export-get-parent-element)) 46 47 (fset 'seam-html--element-parent 48 (if (fboundp 'org-element-parent) 49 'org-element-parent 50 (lambda (node) 51 (org-element-property :parent node)))) 52 53 (fset 'seam-html--element-type-p 54 (if (fboundp 'org-element-type-p) 55 'org-element-type-p 56 (lambda (node types) 57 (memq (org-element-type node) 58 (ensure-list types))))) 59 60 ;;; NOTE: This function does not respect `:headline-levels' or 61 ;;; `:html-self-link-headlines'. 62 (defun seam-html-headline (headline contents info) 63 "Transcode a HEADLINE element from Org to HTML. 64 CONTENTS holds the contents of the headline. INFO is a plist 65 holding contextual information." 66 (cond 67 ((org-element-property :SEAM-TITLE-P headline) 68 contents) 69 ((org-element-property :footnote-section-p headline) 70 nil) 71 (t 72 (let* ((level (+ (org-export-get-relative-level headline info) 73 (1- (plist-get info :html-toplevel-hlevel)))) 74 (text (org-export-data (org-element-property :title headline) info)) 75 (contents (or contents "")) 76 (id (org-html--reference headline info)) 77 (todo (and (plist-get info :with-todo-keywords) 78 (let ((todo (org-element-property :todo-keyword headline))) 79 (and todo (org-export-data todo info))))) 80 (todo-type (and todo (org-element-property :todo-type headline))) 81 (priority (and (plist-get info :with-priority) 82 (org-element-property :priority headline))) 83 (tags (and (plist-get info :with-tags) 84 (org-export-get-tags headline info))) 85 (full-text (funcall (plist-get info :html-format-headline-function) 86 todo todo-type priority text tags info))) 87 (let ((headline-class 88 (org-element-property :HTML_HEADLINE_CLASS headline))) 89 (format "%s%s\n" 90 (format "<h%d id=\"%s\"%s>%s</h%d>\n" 91 level 92 id 93 (if (not headline-class) "" 94 (format " class=\"%s\"" headline-class)) 95 full-text 96 level) 97 contents)))))) 98 99 (defun seam-html-section (_section contents _info) 100 "Transcode a SECTION element from Org to HTML. 101 CONTENTS holds the contents of the section." 102 contents) 103 104 (defvar seam-html-standalone-image-predicate) 105 (defun seam-html-standalone-image-p (element info) 106 "Non-nil if ELEMENT is a standalone image. 107 108 INFO is a plist holding contextual information. 109 110 An element or object is a standalone image when 111 112 - its type is `paragraph' and its sole content, save for white 113 spaces, is a link that qualifies as an inline image; 114 115 - its type is `link' and its containing paragraph has no other 116 content save white spaces. 117 118 Bind `seam-html-standalone-image-predicate' to constrain paragraph 119 further. For example, to check for only captioned standalone 120 images, set it to: 121 122 (lambda (paragraph) (org-element-property :caption paragraph))" 123 (let ((paragraph (pcase (org-element-type element) 124 (`paragraph element) 125 (`link (seam-html--element-parent element))))) 126 (and (seam-html--element-type-p paragraph 'paragraph) 127 (or (not (and (boundp 'seam-html-standalone-image-predicate) 128 (fboundp seam-html-standalone-image-predicate))) 129 (funcall seam-html-standalone-image-predicate paragraph)) 130 (catch 'exit 131 (let ((link-count 0)) 132 (org-element-map (org-element-contents paragraph) 133 (cons 'plain-text org-element-all-objects) 134 (lambda (obj) 135 (when (pcase (org-element-type obj) 136 (`plain-text (org-string-nw-p obj)) 137 (`link (or (> (cl-incf link-count) 1) 138 (not (org-html-inline-image-p obj info)))) 139 (_ t)) 140 (throw 'exit nil))) 141 info nil 'link) 142 (= link-count 1)))))) 143 144 (defun seam-html-link (link desc info) 145 "Transcode a LINK object from Org to HTML. 146 DESC is the description part of the link, or the empty string. 147 INFO is a plist holding contextual information. See 148 `org-export-data'." 149 (let* ((html-ext (plist-get info :html-extension)) 150 (dot (when (> (length html-ext) 0) ".")) 151 (link-org-files-as-html-maybe 152 (lambda (raw-path info) 153 ;; Treat links to `file.org' as links to `file.html', if 154 ;; needed. See `org-html-link-org-files-as-html'. 155 (save-match-data 156 (cond 157 ((and (plist-get info :html-link-org-files-as-html) 158 (let ((case-fold-search t)) 159 (string-match "\\(.+\\)\\.org\\(?:\\.gpg\\)?$" raw-path))) 160 (concat (match-string 1 raw-path) dot html-ext)) 161 (t raw-path))))) 162 (link-type (org-element-property :type link)) 163 (raw-path (org-element-property :path link)) 164 ;; Ensure DESC really exists, or set it to nil. 165 (desc (org-string-nw-p desc)) 166 (path 167 (cond 168 ((string= "seam" link-type) 169 (let ((slug (string-remove-prefix "-" raw-path))) 170 (when-let ((file (seam-lookup-slug slug))) 171 (let ((type (seam-get-note-type file))) 172 (when (and (member type seam-export--types) 173 (or seam-export--include-drafts 174 (not (seam-draft-p file))) 175 (file-exists-p (seam-make-file-name raw-path type))) 176 (concat seam-export--root-path 177 slug 178 (if seam-export--no-extension "" ".html"))))))) 179 ((string= "file" link-type) 180 ;; During publishing, turn absolute file names belonging 181 ;; to base directory into relative file names. Otherwise, 182 ;; append "file" protocol to absolute file name. 183 (setq raw-path 184 (org-export-file-uri 185 (org-publish-file-relative-name raw-path info))) 186 ;; Possibly append `:html-link-home' to relative file 187 ;; name. 188 (let ((home (and (plist-get info :html-link-home) 189 (org-trim (plist-get info :html-link-home))))) 190 (when (and home 191 (plist-get info :html-link-use-abs-url) 192 (not (file-name-absolute-p raw-path))) 193 (setq raw-path (concat (file-name-as-directory home) raw-path)))) 194 ;; Maybe turn ".org" into ".html". 195 (setq raw-path (funcall link-org-files-as-html-maybe raw-path info)) 196 ;; Add search option, if any. A search option can be 197 ;; relative to a custom-id, a headline title, a name or 198 ;; a target. 199 (let ((option (org-element-property :search-option link))) 200 (if (not option) raw-path 201 (let ((path (org-element-property :path link))) 202 (concat raw-path 203 "#" 204 (org-publish-resolve-external-link option path t)))))) 205 (t (url-encode-url (concat link-type ":" raw-path))))) 206 (attributes-plist 207 (org-combine-plists 208 ;; Extract attributes from parent's paragraph. HACK: Only 209 ;; do this for the first link in parent (inner image link 210 ;; for inline images). This is needed as long as 211 ;; attributes cannot be set on a per link basis. 212 (let* ((parent (seam-html--element-parent-element link)) 213 (link (let ((container (seam-html--element-parent link))) 214 (if (and (seam-html--element-type-p container 'link) 215 (org-html-inline-image-p link info)) 216 container 217 link)))) 218 (and (eq link (org-element-map parent 'link #'identity info t)) 219 (org-export-read-attribute :attr_html parent))) 220 ;; Add Seam internal link class if appropriate. 221 (when (and seam-export--internal-link-class (string= "seam" link-type)) 222 (list :class seam-export--internal-link-class)) 223 ;; Also add attributes from link itself. Currently, those 224 ;; need to be added programmatically before `org-html-link' 225 ;; is invoked, for example, by backends building upon HTML 226 ;; export. 227 (org-export-read-attribute :attr_html link))) 228 (attributes 229 (let ((attr (org-html--make-attribute-string attributes-plist))) 230 (if (org-string-nw-p attr) (concat " " attr) "")))) 231 (cond 232 ;; Link type is handled by a special function. 233 ((org-export-custom-protocol-maybe link desc 'html info)) 234 ;; Image file. 235 ((and (plist-get info :html-inline-images) 236 (org-export-inline-image-p 237 link (plist-get info :html-inline-image-rules))) 238 (org-html--format-image path attributes-plist info)) 239 ;; Radio target: Transcode target's contents and use them as 240 ;; link's description. 241 ((string= link-type "radio") 242 (let ((destination (org-export-resolve-radio-link link info))) 243 (if (not destination) desc 244 (format "<a href=\"#%s\"%s>%s</a>" 245 (org-export-get-reference destination info) 246 attributes 247 desc)))) 248 ;; Links pointing to a headline: Find destination and build 249 ;; appropriate referencing command. 250 ((member link-type '("custom-id" "fuzzy" "id")) 251 (let ((destination (if (string= link-type "fuzzy") 252 (org-export-resolve-fuzzy-link link info) 253 (org-export-resolve-id-link link info)))) 254 (pcase (org-element-type destination) 255 ;; ID link points to an external file. 256 (`plain-text 257 (let ((fragment (concat org-html--id-attr-prefix raw-path)) 258 ;; Treat links to ".org" files as ".html", if needed. 259 (path (funcall link-org-files-as-html-maybe 260 destination info))) 261 (format "<a href=\"%s#%s\"%s>%s</a>" 262 path fragment attributes (or desc destination)))) 263 ;; Fuzzy link points nowhere. 264 (`nil 265 (;; format "<i>%s</i>" 266 identity 267 (or desc 268 (org-export-data 269 (org-element-property :raw-link link) info)))) 270 ;; Link points to a headline. 271 (`headline 272 (let ((href (org-html--reference destination info)) 273 ;; What description to use? 274 (desc 275 ;; Case 1: Headline is numbered and LINK has no 276 ;; description. Display section number. 277 (if (and (org-export-numbered-headline-p destination info) 278 (not desc)) 279 (mapconcat #'number-to-string 280 (org-export-get-headline-number 281 destination info) ".") 282 ;; Case 2: Either the headline is un-numbered or 283 ;; LINK has a custom description. Display LINK's 284 ;; description or headline's title. 285 (or desc 286 (org-export-data 287 (org-element-property :title destination) info))))) 288 (format "<a href=\"#%s\"%s>%s</a>" href attributes desc))) 289 ;; Fuzzy link points to a target or an element. 290 (_ 291 (if (and destination 292 (memq (plist-get info :with-latex) '(mathjax t)) 293 (seam-html--element-type-p destination 'latex-environment) 294 (eq 'math (org-latex--environment-type destination))) 295 ;; Caption and labels are introduced within LaTeX 296 ;; environment. Use "ref" or "eqref" macro, depending on user 297 ;; preference to refer to those in the document. 298 (format (plist-get info :html-equation-reference-format) 299 (org-html--reference destination info)) 300 (let* ((ref (org-html--reference destination info)) 301 (seam-html-standalone-image-predicate 302 #'org-html--has-caption-p) 303 (counter-predicate 304 (if (seam-html--element-type-p destination 'latex-environment) 305 #'org-html--math-environment-p 306 #'org-html--has-caption-p)) 307 (number 308 (cond 309 (desc nil) 310 ((seam-html-standalone-image-p destination info) 311 (org-export-get-ordinal 312 (org-element-map destination 'link #'identity info t) 313 info '(link) 'seam-html-standalone-image-p)) 314 (t (org-export-get-ordinal 315 destination info nil counter-predicate)))) 316 (desc 317 (cond (desc) 318 ((not number) "No description for this link") 319 ((numberp number) (number-to-string number)) 320 (t (mapconcat #'number-to-string number "."))))) 321 (format "<a href=\"#%s\"%s>%s</a>" ref attributes desc))))))) 322 ;; Coderef: replace link with the reference name or the 323 ;; equivalent line number. 324 ((string= link-type "coderef") 325 (let ((fragment (concat "coderef-" (org-html-encode-plain-text raw-path)))) 326 (format "<a href=\"#%s\" %s%s>%s</a>" 327 fragment 328 (format "class=\"coderef\" onmouseover=\"CodeHighlightOn(this, \ 329 '%s');\" onmouseout=\"CodeHighlightOff(this, '%s');\"" 330 fragment fragment) 331 attributes 332 (format (org-export-get-coderef-format raw-path desc) 333 (org-export-resolve-coderef raw-path info))))) 334 ;; External link with a description part. 335 ((and path desc) 336 (format "<a href=\"%s\"%s>%s</a>" 337 (org-html-encode-plain-text path) 338 attributes 339 desc)) 340 ;; External link without a description part. 341 (path 342 (let ((path (org-html-encode-plain-text path))) 343 (format "<a href=\"%s\"%s>%s</a>" path attributes path))) 344 ;; No path, only description. 345 (t desc)))) 346 347 (defun seam-html-src-block (src-block _contents info) 348 "Transcode a SRC-BLOCK element from Org to HTML. 349 CONTENTS holds the contents of the item. INFO is a plist holding 350 contextual information." 351 (if (org-export-read-attribute :attr_html src-block :textarea) 352 (org-html--textarea-block src-block) 353 (let* ((lang (org-element-property :language src-block)) 354 (code (org-html-format-code src-block info)) 355 (label (let ((lbl (org-html--reference src-block info t))) 356 (if lbl (format " id=\"%s\"" lbl) "")))) 357 (format "<pre>%s%s</pre>" 358 ;; Build caption. 359 (let ((caption (org-export-get-caption src-block))) 360 (if (not caption) "" 361 (let ((listing-number 362 (format 363 "<span class=\"listing-number\">%s </span>" 364 (format 365 (org-html--translate "Listing %d:" info) 366 (org-export-get-ordinal 367 src-block info nil #'org-html--has-caption-p))))) 368 (format "<label class=\"org-src-name\">%s%s</label>" 369 listing-number 370 (org-trim (org-export-data caption info)))))) 371 ;; Contents. 372 (format "<code class=\"src src-%s\"%s>%s</code>" 373 ;; Lang being nil is OK. 374 lang label code))))) 375 376 (org-export-define-derived-backend 377 'seam 378 'html 379 :translate-alist 380 `((headline . seam-html-headline) 381 (link . seam-html-link) 382 (section . seam-html-section) 383 (src-block . seam-html-src-block))) 384 385 (provide 'seam-html) 386 387 ;;; seam-html.el ends here