452 lines
18 KiB
EmacsLisp
452 lines
18 KiB
EmacsLisp
;;; 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
|
||
"\"" """ (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
|