From 5575a0f18277ef34f4003c1bccf650e4237e6048 Mon Sep 17 00:00:00 2001 From: TEC Date: Mon, 25 Jul 2022 23:37:13 +0800 Subject: [PATCH 1/6] ox: Introduce conditional/generated preamble * lisp/ox.el (org-export-detect-features, org-export-expand-features, org-export-generate-features-preamble): New functions for detecting features and generating content based on them. * lisp/ox.el (org-export-conditional-features): Customisation for feature detection. * lisp/ox.el (org-export-as): Add detected to features to info in the slot :features. --- lisp/ox.el | 217 +++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 217 insertions(+) diff --git a/lisp/ox.el b/lisp/ox.el index 0a48e850a..1a75ed28d 100644 --- a/lisp/ox.el +++ b/lisp/ox.el @@ -2030,6 +2030,221 @@ (defun org-export-expand (blob contents &optional with-affiliated) (funcall (intern (format "org-element-%s-interpreter" type)) blob contents)))) + +;;; Conditional/Generated Preamble +;; +;; Many formats have some version of a preamble, whether it be HTML's +;; ... or the content before LaTeX's \begin{document}. +;; Depending on the particular features in the Org document being +;; exported, different setup snippets will be needed. There's the +;; "everything and the kitchen sink" approach of adding absolutely +;; everything that might be needed, and the post-translation editing +;; with filters approach, but neither really solve this problem nicely. +;; +;; The conditional/generated preamble defines mechanisms of detecting +;; which "features" are used in a document, handles interactions +;; between features, and provides/generates preamble content to +;; support the features. + +(defcustom org-export-conditional-features + `(("^[ \t]*#\\+print_bibliography:" . bibliography) + (,(lambda (info) + (org-element-map (plist-get info :parse-tree) + 'link + (lambda (link) + (and (member (org-element-property :type link) + '("http" "https" "ftp" "file")) + (file-name-extension (org-element-property :path link)) + (string= (downcase (file-name-extension + (org-element-property :path link))) + "svg"))) + info t)) + . svg) + (,(lambda (info) + (org-element-map (plist-get info :parse-tree) + 'link + (lambda (link) + (and (member (org-element-property :type link) + '("http" "https" "ftp" "file")) + (file-name-extension (org-element-property :path link)) + (member (downcase (file-name-extension + (org-element-property :path link))) + image-file-name-extensions))) + info t)) + . image) + (,(lambda (info) + (org-element-map (plist-get info :parse-tree) + 'table #'identity info t)) + . table) + (,(lambda (info) + (org-element-map (plist-get info :parse-tree) + '(src-block inline-src-block) #'identity info t)) + . code)) + "Org feature tests and associated feature flags. + +Alist where the car is a test for the presense of the feature, +and the CDR is either a single feature symbol or a list of +feature symbols. + +Feature tests can take any of the following forms: +- Variable symbol, the value of which is fetched. +- Function symbol, which is called with the export info + as the argument. +- A string, which is used as a regexp search in the buffer. + The regexp matching is taken as confirmation of the existence + of the feature. + +When the test is a variable or function and produces a string +value, that value is itself used as a test. Any other non-nil +value will imply the existance of the feature." + :group 'org-export-general + :type '(alist :key-type + (choice (regexp :tag "Feature test regexp") + (variable :tag "Feature variable") + (function :tag "Feature test function")) + :value-type + (choice (symbol :tag "Feature symbol") + (repeat symbol :tag "Feature symbols")))) + +(defun org-export-detect-features (info) + "Detect features from `org-export-conditional-features' in INFO." + (let (case-fold-search) + (delete-dups + (mapcan + (lambda (construct-feature) + (and (let ((out (pcase (car construct-feature) + ((pred stringp) (car construct-feature)) + ((pred functionp) + (funcall (car construct-feature) info)) + ((pred symbolp) (symbol-value (car construct-feature))) + (_ (error "org-export-conditional-features key %s unable to be used" (car construct-feature)))))) + (if (stringp out) + (save-excursion + (goto-char (point-min)) + (re-search-forward out nil t)) + out)) + (if (listp (cdr construct-feature)) + (copy-sequence (cdr construct-feature)) + (list (cdr construct-feature))))) + (append org-export-conditional-features + (plist-get info :conditional-features)))))) + +(defun org-export-expand-features (info) + "Identify all implied implementations from features, in INFO. + +(plist-get info :feature-implementations) should be an alist of feature symbols +and specification plists with the following keys: +- :snippet, which is either, + - A string, which should be included in the preamble verbatim. + - A variable, the value of which should be included in the preamble. + - A function, which is called with two arguments — the export info, + and the list of feature flags. The returned value is included in + the preamble. +- :requires, a feature or list of features this feature will enable. +- :when, a feature or list of features which are required for this + feature to be active. +- :prevents, a feature or list of features that should be masked. +- :order, for when inclusion order matters. Feature implementations + with a lower order appear first. The default is 0. + +This function processes :requires, :when, and :prevents in turn +before finally sorting according to :order. + +After resolving the features, the :features key of INFO is +updated to reflect the expanded set of features being used." + (let ((initial-features (plist-get info :features)) + (implementations (plist-get info :feature-implementations)) + required-features current-implementations) + ;; Process :requires. + (while initial-features + (push (car initial-features) required-features) + (setq initial-features + (if-let (requirements + (plist-get (alist-get (car initial-features) implementations) + :requires)) + (if (consp requirements) + (append requirements (cdr initial-features)) + (cons requirements (cdr initial-features))) + (cdr initial-features)))) + ;; Get the implementations of required features. + (setq current-implementations + (mapcar (lambda (f) (assq f implementations)) + (delete-dups required-features))) + ;; Remove features with unfulfilled :when conditions. + (let ((processing t) + confirmed-features conditional-implementations + when) + ;; To correctly resolve all the various :when conditions, + ;; do not make any assumptions about which features are active. + ;; Initially only consider non-:when implementations to be + ;; active, then run through the list of unconfirmed :when + ;; implementations and check their conditions against the list + ;; of confirmed features. Continue doing this until no more + ;; features are confirmed. + (dolist (impl current-implementations) + (if (plist-get (cdr impl) :when) + (push impl conditional-implementations) + (push (car impl) confirmed-features))) + (while processing + (setq processing nil) + (dolist (impl conditional-implementations) + (setq when (plist-get (cdr impl) :when)) + (when (cond + ((symbolp when) + (memq when confirmed-features)) + ((consp when) + (not (cl-set-difference when confirmed-features)))) + (push (car impl) confirmed-features) + (setq conditional-implementations + (delq impl conditional-implementations) + processing t)))) + ;; Now all that remains is implementations with unsatisfiable + ;; :when conditions. + (dolist (impl conditional-implementations) + (setq current-implementations + (delq impl current-implementations)))) + ;; Get rid of prevented features. + (dolist (impl current-implementations) + (when-let ((prevented (pcase (plist-get (cdr impl) :prevents) + ((and (pred consp) p) p) + ((pred null) nil) + ((and (pred atom) p) (list p))))) + (setq current-implementations + (cl-remove-if + (lambda (i) (memq (car i) prevented)) + current-implementations)))) + ;; Sort by :order. + (setq current-implementations + (sort current-implementations + (lambda (impl1 impl2) + (< (or (plist-get (cdr impl1) :order) 0) + (or (plist-get (cdr impl2) :order) 0))))) + ;; Update :features to reflect the features actually used. + (plist-put info :features (mapcar #'car current-implementations)) + current-implementations)) + +(defun org-export-generate-features-preamble (info) + "Generate preamble string according to features an implementations in INFO. +More specifically, this function resolves feature implementations +with `org-export-expand-features' and concatenates the snippets." + (let* ((feat-impl (org-export-expand-features info)) + (feat-snippets + (mapcar + (lambda (impl) + (let ((snippet (plist-get (cdr impl) :snippet))) + (cond + ((null snippet) nil) + ((functionp snippet) + (funcall snippet info)) + ((symbolp snippet) (symbol-value snippet)) + ((stringp snippet) snippet) + (t (error "org-export feature snippet %S is invalid." snippet) + nil)))) + feat-impl))) + (mapconcat + #'identity + (append (delq nil feat-snippets) (list "")) + "\n"))) ;;; The Filter System @@ -3186,6 +3401,8 @@ (defun org-export--annotate-info (backend info &optional subtreep visible-only e ;; the output of the selected citation export processor. (org-cite-process-citations info) (org-cite-process-bibliography info) + ;; With the complete tree, detect features. + (plist-put info :features (org-export-detect-features info)) info)) ;;;###autoload -- 2.39.0