;;; ox-slimhtml.el --- an HTML org export backend for the USWDS -*- lexical-binding: t; -*- ;; Copyright (C) 2021 Marius Peter ;; Author: Marius Peter (rot13 "?znevhf.crgre@ghgnabgn.pbz") ;; Created: March 2021 ;; Package-Version: 0.1 ;; Keywords: org export publish html ;; Homepage: http://www.smart-documents.org ;; This file is not part of GNU Emacs. ;;; License: ;; This program 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. ;; ;; This program 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 this file. If not, see . ;;; Commentary: ;; html-uswds is an Org mode export backend derived from the ;; `ox-slimhtml' backend. It is intended to produce HTML compatible ;; with the USWDS (https://designsystem.digital.gov/). A key feature ;; of resulting web pages is their accessibility---the USWDS initially ;; caters to American federal agencies wishing to adopt a common ;; design language intelligible for all cultures and levels of ;; computer literacy. ;;; Code: (require 'ox-html) (require 'cl-lib) ;; formatting ;; #+BEGIN_EXAMPLE ;; ,*bold* # bold ;; /italic/ # italic ;; =verbatim= # verbatim ;; #+END_EXAMPLE (defun ox-html-uswds-bold (bold contents info) "Transcode BOLD from Org to HTML. CONTENTS is the text with bold markup. INFO is a plist holding contextual information." (when contents (format "%s" contents))) (defun ox-html-uswds-italic (italic contents info) "Transcode ITALIC from Org to HTML. CONTENTS is the text with italic markup. INFO is a plist holding contextual information." (when contents (format "%s" contents))) (defun ox-html-uswds-verbatim (verbatim contents info) "Transcode VERBATIM string from Org to HTML. CONTENTS is nil. INFO is a plist holding contextual information." (let ((contents (org-html-encode-plain-text (org-element-property :value verbatim)))) (when contents (format "%s" contents)))) ;; headlines ;; #+BEGIN_EXAMPLE ;; ,* headline text #
;; :PROPERTIES: #

headline text

;; :attr_html: :class headline #
;; :html_container: section ;; :html_container_class: container ;; :END: ;; ,#+OPTIONS: H:[headline level] ;; ,#+HTML_CONTAINER: [default container] ;; #+END_EXAMPLE (defun ox-html-uswds-headline (headline contents info) "Transcode HEADLINE from Org to HTML. CONTENTS is the section as defined under the HEADLINE. INFO is a plist holding contextual information." (let* ((text (org-export-data (org-element-property :title headline) info)) (level (org-export-get-relative-level headline info)) (attributes (org-element-property :ATTR_HTML headline)) (container (org-element-property :HTML_CONTAINER headline)) (container-class (and container (org-element-property :HTML_CONTAINER_CLASS headline)))) (when attributes (setq attributes (format " %s" (org-html--make-attribute-string (org-export-read-attribute 'attr_html `(nil (attr_html ,(split-string attributes)))))))) (concat (when (and container (not (string= "" container))) (format "<%s%s>" container (if container-class (format " class=\"%s\"" container-class) ""))) (if (not (org-export-low-level-p headline info)) (format "%s%s" level (or attributes "") text level (or contents "")) (concat (when (org-export-first-sibling-p headline info) ""))) (when (and container (not (string= "" container))) (format "" (cl-subseq container 0 (cl-search " " container))))))) ;; sections (defun ox-html-uswds-section (section contents info) "Transcode a SECTION element from Org to HTML. CONTENTS is the contents of the section. INFO is a plist holding contextual information. Sections are child elements of org headlines; 'container' settings are found in slim-headlines." contents) ;; links ;; #+BEGIN_EXAMPLE ;; ,#+attr_html: :class link # content ;; [[link][content]] ;; ,#+OPTIONS: html-link-org-files-as-html:[t/nil] || org-html-link-org-files-as-html ;; ,#+HTML_EXTENSION: [html] || org-html-extension ;; ,#+OPTIONS: html-link-use-abs-url:[t/nil] || org-html-link-use-abs-url ;; #+END_EXAMPLE (defun ox-html-uswds-link (link contents info) "Transcode LINK from Org to HTML. CONTENTS is the text of the link. INFO is a plist holding contextual information." (if (ox-html-uswds--immediate-child-of-p link 'link) (org-element-property :raw-link link) (if (not contents) (format "%s" (org-element-property :path link)) (let ((link-type (org-element-property :type link)) (href (org-element-property :raw-link link)) (attributes (if (ox-html-uswds--immediate-child-of-p link 'paragraph) (ox-html-uswds--attr (org-export-get-parent link)) "")) (element "%s")) (cond ((string= "file" link-type) (let ((html-extension (or (plist-get info :html-extension) "")) (use-abs-url (plist-get info :html-link-use-abs-url)) (link-org-files-as-html (plist-get info :html-link-org-as-html)) (path (or (org-element-property :path link) ""))) (format element (concat (if (and use-abs-url (file-name-absolute-p path)) "file:" "") (if (and link-org-files-as-html (string= "org" (downcase (or (file-name-extension path) "")))) (if (and html-extension (not (string= "" html-extension))) (concat (file-name-sans-extension path) "." html-extension) (file-name-sans-extension path)) path)) attributes contents))) (t (format element href attributes contents))))))) ;; plain lists ;; #+BEGIN_EXAMPLE ;; ,#+attr_html: :class this # ;; + item 1 #
  1. item 1
;; - definition :: list #
definition
list
;; #+END_EXAMPLE (defun ox-html-uswds-plain-list (plain-list contents info) "Transcode a PLAIN-LIST string from Org to HTML. CONTENTS is the contents of the list element. INFO is a plist holding contextual information." (when contents (let ((type (cl-case (org-element-property :type plain-list) (ordered "ol") (unordered "ul") (descriptive "dl")))) (format "<%s%s>%s" type (ox-html-uswds--attr plain-list) contents type)))) ;; paragraphs ;; #+BEGIN_EXAMPLE ;; ,#+attr_html: :class this #

content

;; content ;; #+END_EXAMPLE (defun ox-html-uswds-paragraph (paragraph contents info) "Transcode a PARAGRAPH element from Org to HTML. CONTENTS is the contents of the paragraph. INFO is a plist holding contextual information." (when contents (if (or (ox-html-uswds--immediate-child-of-p paragraph 'item) (ox-html-uswds--immediate-child-of-p paragraph 'special-block)) contents (if (ox-html-uswds--has-immediate-child-of-p paragraph 'link) (format "

%s

" contents) (format "%s

" (ox-html-uswds--attr paragraph) contents))))) ;; examples ;; #+BEGIN_EXAMPLE ;; ,#+BEGIN_EXAMPLE # content ;; content ;; ,#+END_EXAMPLE ;; #+END_EXAMPLE (defun ox-html-uswds-example-block (example-block contents info) "Transcode an EXAMPLE-BLOCK element from Org to HTML. CONTENTS is nil. INFO is a plist holding contextual information." (let ((code (org-html-format-code example-block info))) (when code (format "
%s
" (or (org-element-property :language example-block) "example") code)))) ;; raw html ;; #+BEGIN_EXAMPLE ;; ,#+BEGIN_EXPORT html # export block ;; export block ;; ,#+END_EXPORT ;; ,#+BEGIN_EXPORT javascript # ;; console.log() ;; ,#+END_EXPORT ;; ,#+BEGIN_EXPORT css # ;; span {} ;; ,#+END_EXPORT ;; #+END_EXAMPLE (defun ox-html-uswds-export-block (export-block contents info) "Transcode an EXPORT-BLOCK element from Org to HTML. CONTENTS is nil. INFO is a plist holding contextual information." (let ((contents (org-element-property :value export-block)) (language (org-element-property :type export-block))) (when contents (cond ((string= "JAVASCRIPT" language) (format "" contents)) ((string= "CSS" language) (format "" contents)) (t (org-remove-indentation contents)))))) ;; snippet ;; #+BEGIN_EXAMPLE ;; @@html:snippet@@ # snippet ;; #+END_EXAMPLE (defun ox-html-uswds-export-snippet (export-snippet contents info) "Transcode a EXPORT-SNIPPET object from Org to HTML. CONTENTS is nil. INFO is a plist holding contextual information." (let ((contents (org-element-property :value export-snippet))) (when contents contents))) ;; special block ;; #+BEGIN_EXAMPLE ;; ,#+attr_html: :type text/css # ;; ,#+END_STYLE ;; #+END_EXAMPLE (load-file "./ox-html-uswds-components.el") (defun ox-html-uswds-special-block (special-block contents info) "Transcode SPECIAL-BLOCK from Org to HTML. CONTENTS is the text within the #+BEGIN_ and #+END_ markers. INFO is a plist holding contextual information." (when contents (let ((block-type (downcase (org-element-property :type special-block)))) (cond ((string= "accordion" block-type)(uswds-component-accordion contents)) ((string= "alert-info" block-type) (uswds-component-alert-info contents)) ((string= "alert-warning" block-type) (uswds-component-alert-warning contents)) ((string= "alert-error" block-type) (uswds-component-alert-error contents)) ((string= "alert-success" block-type) (uswds-component-alert-success contents)) ((string= "alert-slim" block-type) (uswds-component-alert-slim contents)) ((string= "alert-no-icon" block-type) (uswds-component-alert-no-icon contents)) ((string= "banner" block-type) (uswds-component-banner contents)) ((string= "breadcrumb" block-type) (uswds-component-breadcrumb contents)) ((string= "button" block-type) (uswds-component-button contents)) ((string= "button-group" block-type) (uswds-component-button-group contents)) ((string= "card" block-type) (uswds-component-card contents)) ((string= "collection" block-type) (uswds-component-collection contents)) ((string= "footer" block-type) (uswds-component-footer contents)) ;; TODO form controls and templates ((string= "grid" block-type) (uswds-component-grid contents)) ((string= "header" block-type) (uswds-component-header contents)) ;; TODO icons ((string= "identifier" block-type) (uswds-component-identifier contents)) ((string= "process-list" block-type) (uswds-component-process contents)) ((string= "search" block-type) (uswds-component-search contents)) ((string= "side-navigation" block-type) (uswds-component-side contents)) ((string= "site-alert" block-type) (uswds-component-site-alert contents)) ((string= "step-indicator" block-type) (uswds-component-step-indicator contents)) ((string= "summary-box" block-type) (uswds-component-summary-box contents)) ;; TODO table? ((string= "tag" block-type) (uswds-component-tag contents)) ((string= "tooltip" block-type) (uswds-component-tooltip contents)) (t (format "
\n%s No suitable special block found. \n
" contents)))))) ;; source code ;; #+BEGIN_EXAMPLE ;; ,#+BEGIN_SRC javascript #
;;     code                                     # code
;;   ,#+END_SRC                                  # 
;; #+END_EXAMPLE (defun ox-html-uswds-src-block (src-block contents info) "Transcode SRC-BLOCK from Org to HTML. CONTENTS is the text of a #+BEGIN_SRC...#+END_SRC block. INFO is a plist holding contextual information." (let ((code (org-html-format-code src-block info)) (language (org-element-property :language src-block))) (when code (format "
%s
" language (ox-html-uswds--attr src-block) code)))) ;; body ;; #+BEGIN_EXAMPLE ;; ,#+HTML_PREAMBLE: preamble {{{macro}}} # preamble ;; content # content ;; ,#+HTML_POSTAMBLE: postamble {{{macro}}} # postamble ;; #+END_EXAMPLE (defun ox-html-uswds-inner-template (contents info) "Return body of document string after HTML conversion. CONTENTS is the transcoded contents string. INFO is a plist holding export options." (when (and contents (not (string= "" contents))) (let ((container (plist-get info :html-container))) (concat (when (and container (not (string= "" container))) (format "<%s>" container)) (or (ox-html-uswds--expand-macros (plist-get info :html-preamble) info) "") contents (or (ox-html-uswds--expand-macros (plist-get info :html-postamble) info) "") (when (and container (not (string= "" container))) (format "" (cl-subseq container 0 (cl-search " " container)))))))) ;; html page ;; #+BEGIN_EXAMPLE ;; ,#+HTML_DOCTYPE: || org-html-doctype # ; html5 ;; ,#+HTML_HEAD: || org-html-head # ; when language is set ;; ,#+HTML_TITLE: %t # ;; ,#+HTML_HEAD_EXTRA: || org-html-head-extra # head ;; ,#+HTML_BODY_ATTR: id="test" # document title ;; ,#+HTML_HEADER: {{{macro}}} # head-extra ;; ,#+HTML_FOOTER: {{{macro}}} # ;; # ;; # header ;; # content ;; # footer ;; # ;; # ;; {{{macro}}} tokens can also be set in INFO; ;; :html-head, :html-head-extra and :html-header. ;; :html-title is a string with optional tokens; ;; %t is the document's #+TITLE: property. ;; #+END_EXAMPLE (defun ox-html-uswds-template (contents info) "Return full document string after HTML conversion. CONTENTS is the transcoded contents string. INFO is a plist holding export options." (let ((doctype (assoc (plist-get info :html-doctype) org-html-doctype-alist)) (language (plist-get info :language)) (head (ox-html-uswds--expand-macros (plist-get info :html-head) info)) (head-extra (ox-html-uswds--expand-macros (plist-get info :html-head-extra) info)) (title (plist-get info :title)) (title-format (plist-get info :html-title)) (body-attr (plist-get info :html-body-attr)) (header (plist-get info :html-header)) (newline "\n")) (when (listp title) (setq title (car title))) (concat (when doctype (concat (cdr doctype) newline)) "" newline ;; Start if the document head. "" newline (when (not (string= "" head)) (concat head newline)) (when (and title (not (string= "" title))) (if title-format (format-spec (concat "" title-format "\n") (format-spec-make ?t title)) (concat "" title "" newline))) (when (not (string= "" head-extra)) (concat head-extra newline)) "" "" ;; USWDS init "" "" newline ;; Start of the document body. "" "Skip to main content" "" (when (and header (not (string= "" header))) (or (ox-html-uswds--expand-macros header info) "")) ;; When not the index page, add side navigation links. ;; (when (not (string= (substring (buffer-name) 0 5) "index")) ;; "Skip to main content" ;; "
;;
;;
;;
;; ;;
) contents (or (ox-html-uswds--expand-macros (plist-get info :html-footer) info) "") "" newline "" newline ""))) ;; plain text (defun ox-html-uswds-plain-text (plain-text info) "Transcode a PLAIN-TEXT string from Org to HTML. PLAIN-TEXT is the string to transcode. INFO is a plist holding contextual information." (org-html-encode-plain-text plain-text)) ;; attributes (defun ox-html-uswds--attr (element &optional property) "Return ELEMENT's html attribute properties as a string. When optional argument PROPERTY is non-nil, return the value of that property within attributes." (let ((attributes (org-export-read-attribute :attr_html element property))) (if attributes (concat " " (org-html--make-attribute-string attributes)) ""))) ;; is an immediate child of [element]? (defun ox-html-uswds--immediate-child-of-p (element container-type) "Is ELEMENT an immediate child of an org CONTAINER-TYPE element?" (let ((container (org-export-get-parent element))) (and (eq (org-element-type container) container-type) (= (org-element-property :begin element) (org-element-property :contents-begin container))))) ;; has an immediate child of [element-type]? (defun ox-html-uswds--has-immediate-child-of-p (element element-type) "Does ELEMENT have an immediate ELEMENT-TYPE child?" (org-element-map element element-type (lambda (link) (= (org-element-property :begin link) (org-element-property :contents-begin element))) nil t)) ;; expand macros ;; Macro expansion takes place in a separate buffer - as such buffer local variables ;; are not directly available, which might be important when using self-evaluating ;; macros such as =,#+MACRO: x (eval (fn $1))=. To help with this, the original ;; =buffer-file-name= is shadowed. (defun ox-html-uswds--expand-macros (contents info) "Return CONTENTS string, with macros expanded. CONTENTS is a string, optionally with {{{macro}}} tokens. INFO is a plist holding export options." (if (cl-search "{{{" contents) (let* ((author (org-element-interpret-data (plist-get info :author))) (date (org-element-interpret-data (plist-get info :date))) (email (or (plist-get info :email) "")) (title (org-element-interpret-data (plist-get info :title))) (export-specific-templates (list (cons "author" author) (cons "date" (format "(eval (format-time-string \"$1\" '%s))" (org-read-date nil t date nil))) (cons "email" email) (cons "title" title))) (templates (org-combine-plists export-specific-templates org-macro-templates)) (buffer-name buffer-file-name)) (with-temp-buffer (insert contents) (let ((buffer-file-name buffer-name)) (org-macro-replace-all templates)) (buffer-string))) contents)) ;; org-mode publishing function ;; #+BEGIN_EXAMPLE ;; (setq org-publish-project-alist ;; '(("project-name" ;; :base-directory "~/src" ;; :publishing-directory "~/public" ;; :publishing-function ox-html-uswds-publish-to-html))) ;; #+END_EXAMPLE ;;;###autoload (defun ox-html-uswds-publish-to-html (plist filename pub-dir) "Publish an org file to HTML adapted for the USWDS. PLIST is the property list for the given project. FILENAME is the filename of the Org file to be published. PUB-DIR is the publishing directory. Return output file name." (let ((html-extension (or (plist-get plist :html-extension) org-html-extension))) (org-publish-org-to 'html-uswds filename (when (and html-extension (not (string= "" html-extension))) (concat "." html-extension)) plist pub-dir))) ;; org-export backend definition (org-export-define-backend 'html-uswds '((bold . ox-html-uswds-bold) (example-block . ox-html-uswds-example-block) (export-block . ox-html-uswds-export-block) (export-snippet . ox-html-uswds-export-snippet) (headline . ox-html-uswds-headline) (inner-template . ox-html-uswds-inner-template) (italic . ox-html-uswds-italic) (item . org-html-item) (link . ox-html-uswds-link) (paragraph . ox-html-uswds-paragraph) (plain-list . ox-html-uswds-plain-list) (plain-text . ox-html-uswds-plain-text) (section . ox-html-uswds-section) (special-block . ox-html-uswds-special-block) (src-block . ox-html-uswds-src-block) (template . ox-html-uswds-template) (verbatim . ox-html-uswds-verbatim)) :menu-entry '(?u "Export to html-uswds" ((?U "As html-uswds buffer" ox-html-uswds-export-as-html) (?u "As html-uswds file" ox-html-uswds-export-to-html))) :options-alist '((:html-extension "HTML_EXTENSION" nil org-html-extension) (:html-link-org-as-html nil "html-link-org-files-as-html" org-html-link-org-files-as-html) (:html-doctype "HTML_DOCTYPE" nil org-html-doctype) (:html-container "HTML_CONTAINER" nil org-html-container-element t) (:html-link-use-abs-url nil "html-link-use-abs-url" org-html-link-use-abs-url) (:html-link-home "HTML_LINK_HOME" nil org-html-link-home) (:html-preamble "HTML_PREAMBLE" nil "" newline) (:html-postamble "HTML_POSTAMBLE" nil "" newline) (:html-head "HTML_HEAD" nil org-html-head newline) (:html-head-extra "HTML_HEAD_EXTRA" nil org-html-head-extra newline) (:html-header "HTML_HEADER" nil "" newline) (:html-footer "HTML_FOOTER" nil "" newline) (:html-title "HTML_TITLE" nil "%t" t) (:html-body-attr "HTML_BODY_ATTR" nil "" t))) ;;;###autoload (defun ox-html-uswds-export-as-html (&optional async subtreep visible-only body-only ext-plist) "Export current buffer to a HTML-USWDS buffer. Export as `org-html-export-as-html' does, with html-uswds org-export-backend. 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-USWDS export*\", which will be displayed when `org-export-show-temporary-export-buffer' is non-nil." (interactive) (org-export-to-buffer 'html-uswds "*Org HTML-USWDS Export*" async subtreep visible-only body-only ext-plist (lambda () (set-auto-mode t)))) ;;;###autoload (defun ox-html-uswds-export-to-html (&optional async subtreep visible-only body-only ext-plist) "Export current buffer to an HTML file. Export as `org-html-export-as-html' does, with html-uswds org-export-backend. 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 "." (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 'html-uswds file async subtreep visible-only body-only ext-plist))) (provide 'ox-html.uswds) ;;; ox-html-uswds.el ends here