;;; 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

;; See the Emacs ox-html library for its authors, maintainer and FSF
;; Copyright, since ox-svg4css contains a lot of code from ox-html.

;; 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 an HTML derived backend for Org export.
;; It tries to address limitations of SVG images and CSS in HTML pages.
;; For each SVG image during HTML export:
;; 1. It checks `svg-as-object' and "image in-lining" whether to
;;    embed the SVG image in an <object> tag.
;; 2. If not, it checks `svg-inclusion' and "image in-lining"
;;    whether to copy the SVG contents to the HTML output.
;; 3. If not, it falls back to checking "image in-lining" whether to
;;    embed the SVG image in an <img> tag (as any other image type).
;; 4. It is possible to set `svg-as-object' and/or `svg-inclusion':
;;    - For each SVG link by means of "#+ATTR_HTML: :svg-as-object t"
;;      or "#+ATTR_HTML: :svg-inclusion t".
;;    - Within file scope by means of "#+OPTIONS: svg-as-object:t" or
;;      "#+OPTIONS: svg-inclusion:t".
;;    - Within toplevel scope by means of the options
;;      `org-html-svg-as-object' or `org-html-svg-inclusion'.
;;
;; Caveats: the HTML output does not comply with W3C recommendations
;; after `svg-as-object' and/or `svg-inclusion' exports and it does not
;; comply with the Org Manual section "13.9.9 Images in HTML export"
;; after `svg-inclusion' exports.
;;
;; See: https://list.orgmode.org/c1eef10be815748d2103cb81bce08708@posteo.net/
;; where Cristian Moe has proposed to embed SVG images in <object> tags.
;; Ihor Radchenko and Max Nikulin have insisted on the use of special
;; "#+ATTR_HTML:" attributes to control the export options.
;;
;; I prefer enabling `:svg-as-object' over enabling `:svg-inclusion'.
;;
;; Relevant W3C documentation:
;;
;; Loading an SVG image by an HTML <embed>, <iframe> or <object> tag:
;; https://stackoverflow.com/a/12604286
;; https://svgwg.org/specs/integration/#referencing-modes
;; https://svgwg.org/specs/integration/#embedded-document-mode
;; https://svgwg.org/specs/integration/#dynamic-interactive-mode
;;
;; Four types of SVG document usage with their security implications:
;; https://www.w3.org/wiki/SVG_Security

;;; Code:

(require 'org-macs)
(org-assert-version)

(require 'cl-lib)
(require 'ox-html)


;;; Define Derived 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 apply SVG image inclusion or 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 copy SVG image contents to the HTML output when
in-lining applies, otherwise apply the normal export rules.

The HTML file including the SVG image contents has to include or
to link 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)
  "Check whether LINK links to an SVG image to embed in an <object> tag.
INFO is a communication channel and ATTRIBUTES-PLIST holds all attributes
relevant to LINK."
  (and (plist-get info :html-inline-images)
       (not (org-element-contents link))
       (let ((case-fold-search t))
         (string-match-p ".svg\\'" (org-element-property :path link)))
       (org-export-inline-image-p
        link (plist-get info :html-inline-image-rules))
       (or (and (plist-get attributes-plist :svg-as-object))
           (and (plist-get info :html-svg-as-object)
                ;; Next form returns `nil' when member has value `nil'.
                (or (not (plist-member attributes-plist :svg-as-object))
                    (plist-get attributes-plist :svg-as-object))))))

(defun org-svg4css--svg-inclusion-p (link info attributes-plist)
  "Check whether LINK links to an SVG image to include in the HTML output.
INFO is a communication channel and ATTRIBUTES-PLIST holds all attributes
relevant to LINK."
  (and (plist-get info :html-inline-images)
       (not (org-element-contents link))
       (let ((case-fold-search t))
         (string-match-p ".svg\\'" (org-element-property :path link)))
       (org-export-inline-image-p
	link (plist-get info :html-inline-image-rules))
       (or (and (plist-get attributes-plist :svg-inclusion))
           (and (plist-get info :html-svg-inclusion)
                ;; Next form returns `nil' when member has value `nil'.
                (or (not (plist-member attributes-plist :svg-inclusion))
                    (plist-get attributes-plist :svg-inclusion))))))

(defun org-svg4css--format-svg-as-object (path attributes-plist)
  "Return a string embedding the SVG image PATH in an <objec> tag."
  (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