gav451/emacs.d
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity
90f2d88ea2
emacs.d/site-lisp/ox-svg4css/ox-svg4css.el

452 lines
18 KiB
EmacsLisp
Raw Normal View History

Add ox-svg4css to address limitations of SVG and CSS in HTML
2023-06-10 20:42:11 +02:00
;;; ox-svg4css.el --- HTML Derived Backend -*- lexical-binding: t; -*-
;; Copyright (C) 2023 Free Software Foundation, Inc.
;; Author: Gerard Vermeulen <gerard.vermeulen AT posteo DOT net>
;; Maintainer: Gerard Vermeulen <gerard.vermeulen AT posteo DOT net>
;; 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 <https://www.gnu.org/licenses/>.
;;; 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
"\"" "&quot;" (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 "<object %s>
ARIA placeholder: see https://vecta.io/blog/best-way-to-embed-svg for ideas!
</object>" (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 <svg inside
;; or a preceding XML element with an SVG element inside.
(let ((case-fold-search t))
(unless (search-forward "<svg" nil 'noerror)
(user-error "Can't find a root SVG start tag in file `%s'." path)))
(delete-region (point-min) (match-beginning 0))
(buffer-string)))
;;; Transcode Functions
;;;; Link
(defun org-svg4css-link (link desc info)
"Transcode a LINK object from Org to HTML.
DESC is the description part of the link, or the empty string.
INFO is a plist holding contextual information. See
`org-export-data'."
(let* ((html-ext (plist-get info :html-extension))
(dot (when (> (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 "<a href=\"#%s\"%s>%s</a>"
(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 "<a href=\"%s#%s\"%s>%s</a>"
path fragment attributes (or desc destination))))
;; Fuzzy link points nowhere.
(`nil
(format "<i>%s</i>"
(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 "<a href=\"#%s\"%s>%s</a>" 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 "<a href=\"#%s\"%s>%s</a>" 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 "<a href=\"#%s\" %s%s>%s</a>"
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 "<a href=\"%s\"%s>%s</a>"
(org-html-encode-plain-text path)
attributes
desc))
;; External link without a description part.
(path
(let ((path (org-html-encode-plain-text path)))
(format "<a href=\"%s\"%s>%s</a>" path attributes path)))
;; No path, only description. Try to do something useful.
(t
(format "<i>%s</i>" 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 \"<body>\" and \"</body>\" 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 \"<body>\" and \"</body>\" 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
Reference in New Issue Copy Permalink