From 90f2d88ea24442b2a698ca8e857096c7c52e140b Mon Sep 17 00:00:00 2001 From: Gerard Vermeulen Date: Sat, 10 Jun 2023 20:42:11 +0200 Subject: [PATCH] Add ox-svg4css to address limitations of SVG and CSS in HTML --- README.org | 2 +- site-lisp/ox-svg4css/ox-svg4css.el | 451 +++++++++++++++++++++++++++++ 2 files changed, 452 insertions(+), 1 deletion(-) create mode 100644 site-lisp/ox-svg4css/ox-svg4css.el diff --git a/README.org b/README.org index 0268216..715195e 100644 --- a/README.org +++ b/README.org @@ -2156,7 +2156,7 @@ list detailing and motivating each listing: ;; MIT/GNU Scheme breaks Babel contrary to Guile, Chez and Chicken Scheme. (scheme . ,(fboundp 'geiser-mode)) (shell . t)) - org-export-backends '(ascii beamer html icalendar latex my-html odt texinfo) + org-export-backends '(ascii beamer html icalendar latex odt svg4css texinfo) org-file-apps '((auto-mode . emacs) (directory . emacs) ("\\.mm\\'" . default) diff --git a/site-lisp/ox-svg4css/ox-svg4css.el b/site-lisp/ox-svg4css/ox-svg4css.el new file mode 100644 index 0000000..f104e7a --- /dev/null +++ b/site-lisp/ox-svg4css/ox-svg4css.el @@ -0,0 +1,451 @@ +;;; ox-svg4css.el --- HTML Derived Backend -*- lexical-binding: t; -*- + +;; Copyright (C) 2023 Free Software Foundation, Inc. + +;; Author: Gerard Vermeulen +;; Maintainer: Gerard Vermeulen +;; Keywords: org, hypermedia + +;; Since this library contains a lot of code from the Emacs ox-html +;; library, see the ox-html library for its authors, maintainer and +;; FSF copyright. + +;; This file is NOT part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;; This library implements a HTML derived backend for Org export. +;; It tries to address limitations of SVG images and CSS in HTML pages: +;; 1. Firstly, it probes whether to export the SVG image as an "object" tag. +;; 2. Secondly, it probes whether to include the SVG contents in the HTML. +;; 3. Thirdly, it probes wheter to embed the SVG image in an "img" tag. +;; 4. The option precedence order is "svg-as-object", "svg-inclusion", +;; "org-html-inline-images", but disabling the latter disables the other +;; options. +;; +;; I prefer the "svg-as-object" option over the "svg-inclusion" option. +;; +;; See: https://list.orgmode.org/c1eef10be815748d2103cb81bce08708@posteo.net/ +;; where Cristian Moe has proposed to export SVG as "object" tag. +;; Ihor Radchenko and Max Nikulin have proposed the idea of using special +;; "#+ATTR_HTML:" attributes to control the export options. + +;;; Code: + +(require 'org-macs) +(org-assert-version) + +(require 'cl-lib) +(require 'ox-html) + + +;;; Define Backend + +(org-export-define-derived-backend 'svg4css 'html + :menu-entry + '(?h 1 + ((?M "As SVG4CSS buffer" org-svg4css-export-as-html) + (?m "As SVG4CSS file" org-svg4css-export-to-html) + (?O "As SVG4CSS file and open" + (lambda (a s v b) + (if a (org-svg4css-export-to-html t s v b) + (org-open-file (org-svg4css-export-to-html nil s v b))))))) + :options-alist + '((:html-svg-as-object nil "svg-as-object" org-html-svg-as-object) + (:html-svg-inclusion nil "svg-inclusion" org-html-svg-inclusion)) + :translate-alist + '((link . org-svg4css-link))) + + +;;; User Configuration Variables + +(defcustom org-html-svg-as-object nil + "Non-nil means export SVG images in object tags when in-lining +applies, otherwise try SVG image inclusion or try to apply the +normal export rules. + +SVG images in object tags and CSS links in such images simply work. +Note: https://www.w3schools.com/tags/tag_object.asp prefers \"img\" +tag usage." + :group 'org-export-html + :type 'boolean) + +(defcustom org-html-svg-inclusion nil + "Non-nil means include SVG image contents in when in-lining +applies, otherwise try to apply the normal export rules. + +The HTML file including the SVG image contents has to link to the +CSS to let the SVG image and the CSS work together. +Note: SVG inclusion breaks \"13.9.9 Images in HTML export\"." + :group 'org-export-html + :type 'boolean) + +(defcustom org-html-no-attribute-names '("svg-as-object" "svg-inclusion") + "List of HTML tag attribute names to exclude from the tags. +Those attributes control image scope export options." + :group 'org-export-html + :type '(repeat string)) + +;;; Internal Functions + +(defun org-svg4css--make-attribute-string (attributes no-attribute-names) + "Return a list of attributes, as a string. +ATTRIBUTES is a plist where values are either strings or nil. An +attribute with a nil value will be omitted from the result. +NO-ATTRIBUTE-NAMES lists attribute names to omit from the result." + (let (output) + (dolist (item attributes (mapconcat 'identity (nreverse output) " ")) + (cond ((null item) (pop output)) + ((symbolp item) (push (substring (symbol-name item) 1) output)) + (t (let ((key (car output)) + (value (replace-regexp-in-string + "\"" """ (org-html-encode-plain-text item)))) + (if (member key no-attribute-names) + (pop output) + (setcar output (format "%s=\"%s\"" key value))))))))) + +(defun org-svg4css--svg-as-object-p (link info attributes-plist) + (and (plist-get info :html-inline-images) + (or (and (plist-get attributes-plist :svg-as-object)) + (and (plist-get info :html-svg-as-object) + (or (not (plist-member attributes-plist :svg-as-object)) + (plist-get attributes-plist :svg-as-object)))) + (org-export-inline-image-p + link (plist-get info :html-inline-image-rules)) + (not (org-element-contents link)) + (let ((case-fold-search t)) + (string-match-p ".svg\\'" (org-element-property :path link))))) + +(defun org-svg4css--svg-inclusion-p (link info attributes-plist) + (and (plist-get info :html-inline-images) + (or (and (plist-get attributes-plist :svg-inclusion)) + (and (plist-get info :html-svg-inclusion) + (or (not (plist-member attributes-plist :svg-inclusion)) + (plist-get attributes-plist :svg-inclusion)))) + (org-export-inline-image-p + link (plist-get info :html-inline-image-rules)) + (not (org-element-contents link)) + (let ((case-fold-search t)) + (string-match-p ".svg\\'" (org-element-property :path link))))) + +(defun org-svg4css--format-svg-as-object (path attributes-plist) + (format " +ARIA placeholder: see https://vecta.io/blog/best-way-to-embed-svg for ideas! +" (org-svg4css--make-attribute-string + (org-combine-plists + (list :data path + :type "image/svg+xml") + attributes-plist) + org-html-no-attribute-names))) + +(defun org-svg4css--format-svg-inclusion (path) + "Return the SVG contents of the file named PATH for inclusion." + (with-temp-buffer + (insert-file-contents path) + ;; Delete text preceding something starting as an SVG root element. + ;; The intent is to remove XML declarations (and XML comments). + ;; This breaks in case of a preceding XML comment with (length html-ext) 0) ".")) + (link-org-files-as-html-maybe + (lambda (raw-path info) + ;; Treat links to `file.org' as links to `file.html', if + ;; needed. See `org-html-link-org-files-as-html'. + (save-match-data + (cond + ((and (plist-get info :html-link-org-files-as-html) + (let ((case-fold-search t)) + (string-match "\\(.+\\)\\.org\\(?:\\.gpg\\)?$" raw-path))) + (concat (match-string 1 raw-path) dot html-ext)) + (t raw-path))))) + (type (org-element-property :type link)) + (raw-path (org-element-property :path link)) + ;; Ensure DESC really exists, or set it to nil. + (desc (org-string-nw-p desc)) + (path + (cond + ((member type '("http" "https" "ftp" "mailto" "news")) + (url-encode-url (concat type ":" raw-path))) + ((string= "file" type) + ;; During publishing, turn absolute file names belonging + ;; to base directory into relative file names. Otherwise, + ;; append "file" protocol to absolute file name. + (setq raw-path + (org-export-file-uri + (org-publish-file-relative-name raw-path info))) + ;; Possibly append `:html-link-home' to relative file + ;; name. + (let ((home (and (plist-get info :html-link-home) + (org-trim (plist-get info :html-link-home))))) + (when (and home + (plist-get info :html-link-use-abs-url) + (file-name-absolute-p raw-path)) + (setq raw-path (concat (file-name-as-directory home) raw-path)))) + ;; Maybe turn ".org" into ".html". + (setq raw-path (funcall link-org-files-as-html-maybe raw-path info)) + ;; Add search option, if any. A search option can be + ;; relative to a custom-id, a headline title, a name or + ;; a target. + (let ((option (org-element-property :search-option link))) + (if (not option) raw-path + (let ((path (org-element-property :path link))) + (concat raw-path + "#" + (org-publish-resolve-external-link option path t)))))) + (t raw-path))) + (attributes-plist + (org-combine-plists + ;; Extract attributes from parent's paragraph. HACK: Only + ;; do this for the first link in parent (inner image link + ;; for inline images). This is needed as long as + ;; attributes cannot be set on a per link basis. + (let* ((parent (org-export-get-parent-element link)) + (link (let ((container (org-export-get-parent link))) + (if (and (eq 'link (org-element-type container)) + (org-html-inline-image-p link info)) + container + link)))) + (and (eq link (org-element-map parent 'link #'identity info t)) + (org-export-read-attribute :attr_html parent))) + ;; Also add attributes from link itself. Currently, those + ;; need to be added programmatically before `org-html-link' + ;; is invoked, for example, by backends building upon HTML + ;; export. + (org-export-read-attribute :attr_html link))) + (attributes + (let ((attr (org-html--make-attribute-string attributes-plist))) + (if (org-string-nw-p attr) (concat " " attr) "")))) + (cond + ;; Link type is handled by a special function. + ((org-export-custom-protocol-maybe link desc 'html info)) + ;; SVG as object. + ((org-svg4css--svg-as-object-p link info attributes-plist) + (org-svg4css--format-svg-as-object path attributes-plist)) + ;; SVG inclusion. + ((org-svg4css--svg-inclusion-p link info attributes-plist) + (org-svg4css--format-svg-inclusion path)) + ;; Image file. + ((and (plist-get info :html-inline-images) + (org-export-inline-image-p + link (plist-get info :html-inline-image-rules))) + (org-html--format-image path attributes-plist info)) + ;; Radio target: Transcode target's contents and use them as + ;; link's description. + ((string= type "radio") + (let ((destination (org-export-resolve-radio-link link info))) + (if (not destination) desc + (format "%s" + (org-export-get-reference destination info) + attributes + desc)))) + ;; Links pointing to a headline: Find destination and build + ;; appropriate referencing command. + ((member type '("custom-id" "fuzzy" "id")) + (let ((destination (if (string= type "fuzzy") + (org-export-resolve-fuzzy-link link info) + (org-export-resolve-id-link link info)))) + (pcase (org-element-type destination) + ;; ID link points to an external file. + (`plain-text + (let ((fragment (concat org-html--id-attr-prefix path)) + ;; Treat links to ".org" files as ".html", if needed. + (path (funcall link-org-files-as-html-maybe + destination info))) + (format "%s" + path fragment attributes (or desc destination)))) + ;; Fuzzy link points nowhere. + (`nil + (format "%s" + (or desc + (org-export-data + (org-element-property :raw-link link) info)))) + ;; Link points to a headline. + (`headline + (let ((href (org-html--reference destination info)) + ;; What description to use? + (desc + ;; Case 1: Headline is numbered and LINK has no + ;; description. Display section number. + (if (and (org-export-numbered-headline-p destination info) + (not desc)) + (mapconcat #'number-to-string + (org-export-get-headline-number + destination info) ".") + ;; Case 2: Either the headline is un-numbered or + ;; LINK has a custom description. Display LINK's + ;; description or headline's title. + (or desc + (org-export-data + (org-element-property :title destination) info))))) + (format "%s" href attributes desc))) + ;; Fuzzy link points to a target or an element. + (_ + (if (and destination + (memq (plist-get info :with-latex) '(mathjax t)) + (eq 'latex-environment (org-element-type destination)) + (eq 'math (org-latex--environment-type destination))) + ;; Caption and labels are introduced within LaTeX + ;; environment. Use "ref" or "eqref" macro, depending on user + ;; preference to refer to those in the document. + (format (plist-get info :html-equation-reference-format) + (org-html--reference destination info)) + (let* ((ref (org-html--reference destination info)) + (org-html-standalone-image-predicate + #'org-html--has-caption-p) + (counter-predicate + (if (eq 'latex-environment (org-element-type destination)) + #'org-html--math-environment-p + #'org-html--has-caption-p)) + (number + (cond + (desc nil) + ((org-html-standalone-image-p destination info) + (org-export-get-ordinal + (org-element-map destination 'link #'identity info t) + info '(link) 'org-html-standalone-image-p)) + (t (org-export-get-ordinal + destination info nil counter-predicate)))) + (desc + (cond (desc) + ((not number) "No description for this link") + ((numberp number) (number-to-string number)) + (t (mapconcat #'number-to-string number "."))))) + (format "%s" ref attributes desc))))))) + ;; Coderef: replace link with the reference name or the + ;; equivalent line number. + ((string= type "coderef") + (let ((fragment (concat "coderef-" (org-html-encode-plain-text path)))) + (format "%s" + fragment + (format "class=\"coderef\" onmouseover=\"CodeHighlightOn(this, \ +'%s');\" onmouseout=\"CodeHighlightOff(this, '%s');\"" + fragment fragment) + attributes + (format (org-export-get-coderef-format path desc) + (org-export-resolve-coderef path info))))) + ;; External link with a description part. + ((and path desc) + (format "%s" + (org-html-encode-plain-text path) + attributes + desc)) + ;; External link without a description part. + (path + (let ((path (org-html-encode-plain-text path))) + (format "%s" path attributes path))) + ;; No path, only description. Try to do something useful. + (t + (format "%s" desc))))) + + +;;; End-user functions + +;;;###autoload +(defun org-svg4css-export-as-html + (&optional async subtreep visible-only body-only ext-plist) + "Export current buffer to an HTML buffer. + +If narrowing is active in the current buffer, only export its +narrowed part. + +If a region is active, export that region. + +A non-nil optional argument ASYNC means the process should happen +asynchronously. The resulting buffer should be accessible +through the `org-export-stack' interface. + +When optional argument SUBTREEP is non-nil, export the sub-tree +at point, extracting information from the headline properties +first. + +When optional argument VISIBLE-ONLY is non-nil, don't export +contents of hidden elements. + +When optional argument BODY-ONLY is non-nil, only write code +between \"\" and \"\" tags. + +EXT-PLIST, when provided, is a property list with external +parameters overriding Org default settings, but still inferior to +file-local settings. + +Export is done in a buffer named \"*Org SVG4CSS Export*\", which +will be displayed when `org-export-show-temporary-export-buffer' +is non-nil." + (interactive) + (org-export-to-buffer 'svg4css "*Org SVG4CSS Export*" + async subtreep visible-only body-only ext-plist + (lambda () (set-auto-mode t)))) + +;;;###autoload +(defun org-svg4css-export-to-html + (&optional async subtreep visible-only body-only ext-plist) + "Export current buffer to an HTML file. + +If narrowing is active in the current buffer, only export its +narrowed part. + +If a region is active, export that region. + +A non-nil optional argument ASYNC means the process should happen +asynchronously. The resulting file should be accessible through +the `org-export-stack' interface. + +When optional argument SUBTREEP is non-nil, export the sub-tree +at point, extracting information from the headline properties +first. + +When optional argument VISIBLE-ONLY is non-nil, don't export +contents of hidden elements. + +When optional argument BODY-ONLY is non-nil, only write code +between \"\" and \"\" tags. + +EXT-PLIST, when provided, is a property list with external +parameters overriding Org default settings, but still inferior to +file-local settings. + +Return output file's name." + (interactive) + (let* ((extension (concat + (when (> (length org-html-extension) 0) ".") + (or (plist-get ext-plist :html-extension) + org-html-extension + "html"))) + (file (org-export-output-file-name extension subtreep)) + (org-export-coding-system org-html-coding-system)) + (org-export-to-file 'svg4css file + async subtreep visible-only body-only ext-plist))) + +(provide 'ox-svg4css) + +;;; ox-svg4css.el ends here