From dd95f7e65cdec97438971f15ff62bcbb94946803 Mon Sep 17 00:00:00 2001 From: Gerard Vermeulen Date: Thu, 1 Jun 2023 16:22:00 +0200 Subject: [PATCH] Derive an HTML export backend to embed SVG images --- README.org | 31 ++- site-lisp/ox-my-html/ox-my-html.el | 368 +++++++++++++++++++++++++++++ 2 files changed, 397 insertions(+), 2 deletions(-) create mode 100644 site-lisp/ox-my-html/ox-my-html.el diff --git a/README.org b/README.org index 9724154..2ef3a34 100644 --- a/README.org +++ b/README.org @@ -299,7 +299,7 @@ recommendation of [[info:emacs#Saving Customizations][saving customizations (inf #+caption[Set the third set of Emacs options: upgrade Org and transient]: #+caption: Set the third set of Emacs options: upgrade Org and transient. #+name: lst:3rd-setopt-call -#+begin_src emacs-lisp +#+begin_src emacs-lisp -n :results silent ;; Enable `package-install-upgrade-build-in' to upgrade Org and transient. ;; Disable upgrading other packages by pinning them to "nongnu". (setopt package-install-upgrade-built-in t @@ -328,6 +328,33 @@ recommendation of [[info:emacs#Saving Customizations][saving customizations (inf package-pinned-packages :key #'car)) #+end_src +#+caption[Handle ~user-emacs-directory~ site-lisp directories as packages]: +#+caption: Handle ~user-emacs-directory~ site-lisp directories as packages. +#+name: lst:site-lisp-packages +#+begin_src emacs-lisp -n :results silent +(with-eval-after-load 'emacs + ;; Handle user-emacs-directory site-lisp directories as packages. + (mapc (apply-partially 'add-to-list 'load-path) + (cl-remove-duplicates + (mapcar 'directory-file-name + (mapcar 'file-name-directory + (directory-files-recursively + (expand-file-name "site-lisp" user-emacs-directory) + "\\.el$"))) + :test #'string=)) + + (defun make-loaddefs-in-buffer-directory () + "Make or update the autoloads in the directory of the visited file." + (interactive) + (let ((dir (directory-file-name (file-name-directory (buffer-file-name)))) + (name (file-name-base (directory-file-name + (file-name-directory (buffer-file-name)))))) + (loaddefs-generate dir + (expand-file-name (format "%s-autoloads.el" name) dir) + nil nil nil 'generate-full)))) + +#+end_src + * [[info:emacs#Package Installation][Install the selected packages (info)]] :PROPERTIES: :CUSTOM_ID: sec:install-selected-packages @@ -2124,7 +2151,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 odt texinfo) + org-export-backends '(ascii beamer html icalendar latex my-html odt texinfo) org-file-apps '((auto-mode . emacs) (directory . emacs) ("\\.mm\\'" . default) diff --git a/site-lisp/ox-my-html/ox-my-html.el b/site-lisp/ox-my-html/ox-my-html.el new file mode 100644 index 0000000..2763e22 --- /dev/null +++ b/site-lisp/ox-my-html/ox-my-html.el @@ -0,0 +1,368 @@ +;;; ox-my-html.el --- HTML Derived Backend -*- lexical-binding: t; -*- + +;; Copyright (C) 2011-2023 Free Software Foundation, Inc. + +;; Author: Carsten Dominik +;; Nicolas Goaziou +;; Maintainer: Gerard Vermeulen +;; Keywords: org, hypermedia + +;; This file is 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: +;; 1. The Org ox-beamer library shows how to code derived backends. +;; 2. The function org-my-html-link is an edited org-html-link copy. +;; 3. It borrows code from https://emacs.stackexchange.com/a/57433 to +;; embed SVG images in the HTML file. + +;;; Code: + +(require 'org-macs) +(org-assert-version) + +(require 'cl-lib) +(require 'ox-html) +(require 'nxml-mode) + + +;;; Define Backend + +(org-export-define-derived-backend 'my-html 'html + :menu-entry + '(?h 1 + ((?M "As MY-HTML buffer" org-my-html-export-as-html) + (?m "As MY-HTML file" org-my-html-export-to-html))) + :options-alist + '((:my-html-embed-svg "HTML_EMBED_SVG" nil nil t)) + :translate-alist + '((link . org-my-html-link))) + + +;;; User Configuration Variables + +;;;; Links :: Embed SVG + +(defcustom org-my-html-embed-svg t + "Non-nil means embed SVG embed into exported MY-HTML pages. +You can set this variable in Org files with +#+HTML_EMBED_SVG: t +orx +#+OPTIONS: html-embed-svg:t." + :group 'org-export-html + :version "30.0" + :type 'boolean) + + +;;; Transcode Functions + +;;;; Link + +(defun org--my-html-embed-svg-p (link) + (message "Check SVG Path: %s" (org-element-property :path link)) + (and (not (org-element-contents link)) + (let ((case-fold-search t)) + (string-match-p ".svg\\'" (org-element-property :path link))))) + +(defun org--my-html-format-svg (path) + ;; https://emacs.stackexchange.com/a/57433 + (with-temp-buffer + (insert-file-contents path) + (with-syntax-table nxml-mode-syntax-table + (while (and (search-forward " (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-my-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)) + ;; Embed SVG. + ((and (plist-get info :my-html-embed-svg) + (org--my-html-embed-svg-p link)) + (org--my-html-format-svg 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-my-html-export-as-html + (&optional async subtreep visible-only body-only ext-plist) + "Export current buffer to a MY-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 HTML PLUS Export*\", which +will be displayed when `org-export-show-temporary-export-buffer' +is non-nil." + (interactive) + (org-export-to-buffer 'my-html "*Org MY-HTML Export*" + async subtreep visible-only body-only ext-plist + (lambda () (set-auto-mode t)))) + +;;;###autoload +(defun org-my-html-export-to-html + (&optional async subtreep visible-only body-only ext-plist) + "Export current buffer to a MY-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 'my-html file + async subtreep visible-only body-only ext-plist))) + +(provide 'ox-my-html) + +;;; ox-my-html.el ends here