diff options
Diffstat (limited to 'lisp/ox.el')
| -rw-r--r-- | lisp/ox.el | 2135 |
1 files changed, 1140 insertions, 995 deletions
@@ -1,4 +1,4 @@ -;;; ox.el --- Generic Export Engine for Org Mode +;;; ox.el --- Export Framework for Org Mode -*- lexical-binding: t; -*- ;; Copyright (C) 2012-2016 Free Software Foundation, Inc. @@ -71,17 +71,18 @@ ;;; Code: -(eval-when-compile (require 'cl)) +(require 'cl-lib) +(require 'ob-exp) (require 'org-element) (require 'org-macro) -(require 'ob-exp) +(require 'tabulated-list) (declare-function org-publish "ox-publish" (project &optional force async)) (declare-function org-publish-all "ox-publish" (&optional force async)) -(declare-function - org-publish-current-file "ox-publish" (&optional force async)) -(declare-function org-publish-current-project "ox-publish" - (&optional force async)) +(declare-function org-publish-current-file "ox-publish" (&optional force async)) +(declare-function org-publish-current-project "ox-publish" (&optional force async)) +(declare-function org-src-coderef-format "org-src" (&optional element)) +(declare-function org-src-coderef-regexp "org-src" (fmt &optional label)) (defvar org-publish-project-alist) (defvar org-table-number-fraction) @@ -112,6 +113,7 @@ (:time-stamp-file nil "timestamp" org-export-time-stamp-file) (:with-archived-trees nil "arch" org-export-with-archived-trees) (:with-author nil "author" org-export-with-author) + (:with-broken-links nil "broken-links" org-export-with-broken-links) (:with-clocks nil "c" org-export-with-clocks) (:with-creator nil "creator" org-export-with-creator) (:with-date nil "date" org-export-with-date) @@ -345,21 +347,24 @@ e.g. \"arch:nil\"." :type '(choice (const :tag "Not at all" nil) (const :tag "Headline only" headline) - (const :tag "Entirely" t))) + (const :tag "Entirely" t)) + :safe (lambda (x) (memq x '(t nil headline)))) (defcustom org-export-with-author t "Non-nil means insert author name into the exported file. This option can also be set with the OPTIONS keyword, e.g. \"author:nil\"." :group 'org-export-general - :type 'boolean) + :type 'boolean + :safe #'booleanp) (defcustom org-export-with-clocks nil "Non-nil means export CLOCK keywords. This option can also be set with the OPTIONS keyword, e.g. \"c:t\"." :group 'org-export-general - :type 'boolean) + :type 'boolean + :safe #'booleanp) (defcustom org-export-with-creator nil "Non-nil means the postamble should contain a creator sentence. @@ -370,16 +375,18 @@ see. This option can also be set with the OPTIONS keyword, e.g., \"creator:t\"." :group 'org-export-general - :version "25.1" + :version "25.2" :package-version '(Org . "8.3") - :type 'boolean) + :type 'boolean + :safe #'booleanp) (defcustom org-export-with-date t "Non-nil means insert date in the exported document. This option can also be set with the OPTIONS keyword, e.g. \"date:nil\"." :group 'org-export-general - :type 'boolean) + :type 'boolean + :safe #'booleanp) (defcustom org-export-date-timestamp-format nil "Time-stamp format string to use for DATE keyword. @@ -392,7 +399,8 @@ string." :group 'org-export-general :type '(choice (string :tag "Time-stamp format string") - (const :tag "No format string" nil))) + (const :tag "No format string" nil)) + :safe (lambda (x) (or (null x) (stringp x)))) (defcustom org-export-creator-string (format "Emacs %s (Org mode %s)" @@ -401,7 +409,8 @@ string." "Information about the creator of the document. This option can also be set on with the CREATOR keyword." :group 'org-export-general - :type '(string :tag "Creator string")) + :type '(string :tag "Creator string") + :safe #'stringp) (defcustom org-export-with-drawers '(not "LOGBOOK") "Non-nil means export contents of standard drawers. @@ -427,14 +436,20 @@ e.g. \"d:nil\"." (const :format "" not) (repeat :tag "Specify names of drawers to ignore during export" :inline t - (string :tag "Drawer name"))))) + (string :tag "Drawer name")))) + :safe (lambda (x) (or (booleanp x) + (and (listp x) + (or (cl-every #'stringp x) + (and (eq (nth 0 x) 'not) + (cl-every #'stringp (cdr x)))))))) (defcustom org-export-with-email nil "Non-nil means insert author email into the exported file. This option can also be set with the OPTIONS keyword, e.g. \"email:t\"." :group 'org-export-general - :type 'boolean) + :type 'boolean + :safe #'booleanp) (defcustom org-export-with-emphasize t "Non-nil means interpret *word*, /word/, _word_ and +word+. @@ -446,7 +461,8 @@ respectively. This option can also be set with the OPTIONS keyword, e.g. \"*:nil\"." :group 'org-export-general - :type 'boolean) + :type 'boolean + :safe #'booleanp) (defcustom org-export-exclude-tags '("noexport") "Tags that exclude a tree from export. @@ -457,7 +473,8 @@ carry one of the `org-export-select-tags' will be removed. This option can also be set with the EXCLUDE_TAGS keyword." :group 'org-export-general - :type '(repeat (string :tag "Tag"))) + :type '(repeat (string :tag "Tag")) + :safe (lambda (x) (and (listp x) (cl-every #'stringp x)))) (defcustom org-export-with-fixed-width t "Non-nil means export lines starting with \":\". @@ -466,14 +483,16 @@ e.g. \"::nil\"." :group 'org-export-general :version "24.4" :package-version '(Org . "8.0") - :type 'boolean) + :type 'boolean + :safe #'booleanp) (defcustom org-export-with-footnotes t "Non-nil means Org footnotes should be exported. This option can also be set with the OPTIONS keyword, e.g. \"f:nil\"." :group 'org-export-general - :type 'boolean) + :type 'boolean + :safe #'booleanp) (defcustom org-export-with-latex t "Non-nil means process LaTeX environments and fragments. @@ -490,7 +509,8 @@ t Allow export of math snippets." :type '(choice (const :tag "Do not process math in any way" nil) (const :tag "Interpret math snippets" t) - (const :tag "Leave math verbatim" verbatim))) + (const :tag "Leave math verbatim" verbatim)) + :safe (lambda (x) (memq x '(t nil verbatim)))) (defcustom org-export-headline-levels 3 "The last level which is still exported as a headline. @@ -501,7 +521,8 @@ when exported, but back-end behavior may differ. This option can also be set with the OPTIONS keyword, e.g. \"H:2\"." :group 'org-export-general - :type 'integer) + :type 'integer + :safe #'integerp) (defcustom org-export-default-language "en" "The default language for export and clocktable translations, as a string. @@ -510,14 +531,16 @@ This may have an association in `org-export-smart-quotes-alist' and `org-export-dictionary'. This option can also be set with the LANGUAGE keyword." :group 'org-export-general - :type '(string :tag "Language")) + :type '(string :tag "Language") + :safe #'stringp) (defcustom org-export-preserve-breaks nil "Non-nil means preserve all line breaks when exporting. This option can also be set with the OPTIONS keyword, e.g. \"\\n:t\"." :group 'org-export-general - :type 'boolean) + :type 'boolean + :safe #'booleanp) (defcustom org-export-with-entities t "Non-nil means interpret entities when exporting. @@ -531,7 +554,8 @@ and the user option `org-entities-user'. This option can also be set with the OPTIONS keyword, e.g. \"e:nil\"." :group 'org-export-general - :type 'boolean) + :type 'boolean + :safe #'booleanp) (defcustom org-export-with-inlinetasks t "Non-nil means inlinetasks should be exported. @@ -540,7 +564,8 @@ e.g. \"inline:nil\"." :group 'org-export-general :version "24.4" :package-version '(Org . "8.0") - :type 'boolean) + :type 'boolean + :safe #'booleanp) (defcustom org-export-with-planning nil "Non-nil means include planning info in export. @@ -553,14 +578,16 @@ e.g. \"p:t\"." :group 'org-export-general :version "24.4" :package-version '(Org . "8.0") - :type 'boolean) + :type 'boolean + :safe #'booleanp) (defcustom org-export-with-priority nil "Non-nil means include priority cookies in export. This option can also be set with the OPTIONS keyword, e.g. \"pri:t\"." :group 'org-export-general - :type 'boolean) + :type 'boolean + :safe #'booleanp) (defcustom org-export-with-properties nil "Non-nil means export contents of properties drawers. @@ -577,7 +604,9 @@ e.g. \"prop:t\"." (const :tag "All properties" t) (const :tag "None" nil) (repeat :tag "Selected properties" - (string :tag "Property name")))) + (string :tag "Property name"))) + :safe (lambda (x) (or (booleanp x) + (and (listp x) (cl-every #'stringp x))))) (defcustom org-export-with-section-numbers t "Non-nil means add section numbers to headlines when exporting. @@ -588,7 +617,8 @@ headlines whose relative level is higher or equal to n. This option can also be set with the OPTIONS keyword, e.g. \"num:t\"." :group 'org-export-general - :type 'boolean) + :type 'boolean + :safe #'booleanp) (defcustom org-export-select-tags '("export") "Tags that select a tree for export. @@ -600,7 +630,8 @@ tagging it with one of the `org-export-exclude-tags'. This option can also be set with the SELECT_TAGS keyword." :group 'org-export-general - :type '(repeat (string :tag "Tag"))) + :type '(repeat (string :tag "Tag")) + :safe (lambda (x) (and (listp x) (cl-every #'stringp x)))) (defcustom org-export-with-smart-quotes nil "Non-nil means activate smart quotes during export. @@ -615,7 +646,8 @@ E.g., you can load Babel for french like this: :group 'org-export-general :version "24.4" :package-version '(Org . "8.0") - :type 'boolean) + :type 'boolean + :safe #'booleanp) (defcustom org-export-with-special-strings t "Non-nil means interpret \"\\-\", \"--\" and \"---\" for export. @@ -632,7 +664,8 @@ When this option is turned on, these strings will be exported as: This option can also be set with the OPTIONS keyword, e.g. \"-:nil\"." :group 'org-export-general - :type 'boolean) + :type 'boolean + :safe #'booleanp) (defcustom org-export-with-statistics-cookies t "Non-nil means include statistics cookies in export. @@ -641,7 +674,8 @@ e.g. \"stat:nil\"" :group 'org-export-general :version "24.4" :package-version '(Org . "8.0") - :type 'boolean) + :type 'boolean + :safe #'booleanp) (defcustom org-export-with-sub-superscripts t "Non-nil means interpret \"_\" and \"^\" for export. @@ -678,7 +712,8 @@ frequently in plain text." :type '(choice (const :tag "Interpret them" t) (const :tag "Curly brackets only" {}) - (const :tag "Do not interpret them" nil))) + (const :tag "Do not interpret them" nil)) + :safe (lambda (x) (memq x '(t nil {})))) (defcustom org-export-with-toc t "Non-nil means create a table of contents in exported files. @@ -696,7 +731,9 @@ e.g. \"toc:nil\" or \"toc:3\"." :type '(choice (const :tag "No Table of Contents" nil) (const :tag "Full Table of Contents" t) - (integer :tag "TOC to level"))) + (integer :tag "TOC to level")) + :safe (lambda (x) (or (booleanp x) + (integerp x)))) (defcustom org-export-with-tables t "Non-nil means export tables. @@ -705,7 +742,8 @@ e.g. \"|:nil\"." :group 'org-export-general :version "24.4" :package-version '(Org . "8.0") - :type 'boolean) + :type 'boolean + :safe #'booleanp) (defcustom org-export-with-tags t "If nil, do not export tags, just remove them from headlines. @@ -720,7 +758,8 @@ e.g. \"tags:nil\"." :type '(choice (const :tag "Off" nil) (const :tag "Not in TOC" not-in-toc) - (const :tag "On" t))) + (const :tag "On" t)) + :safe (lambda (x) (memq x '(t nil not-in-toc)))) (defcustom org-export-with-tasks t "Non-nil means include TODO items for export. @@ -741,23 +780,28 @@ e.g. \"tasks:nil\"." (const :tag "Not-done tasks" todo) (const :tag "Only done tasks" done) (repeat :tag "Specific TODO keywords" - (string :tag "Keyword")))) + (string :tag "Keyword"))) + :safe (lambda (x) (or (memq x '(nil t todo done)) + (and (listp x) + (cl-every #'stringp x))))) (defcustom org-export-with-title t "Non-nil means print title into the exported file. This option can also be set with the OPTIONS keyword, e.g. \"title:nil\"." :group 'org-export-general - :version "25.1" + :version "25.2" :package-version '(Org . "8.3") - :type 'boolean) + :type 'boolean + :safe #'booleanp) (defcustom org-export-time-stamp-file t "Non-nil means insert a time stamp into the exported file. The time stamp shows when the file was created. This option can also be set with the OPTIONS keyword, e.g. \"timestamp:nil\"." :group 'org-export-general - :type 'boolean) + :type 'boolean + :safe #'booleanp) (defcustom org-export-with-timestamps t "Non nil means allow timestamps in export. @@ -779,7 +823,8 @@ This option can also be set with the OPTIONS keyword, e.g. (const :tag "All timestamps" t) (const :tag "Only active timestamps" active) (const :tag "Only inactive timestamps" inactive) - (const :tag "No timestamp" nil))) + (const :tag "No timestamp" nil)) + :safe (lambda (x) (memq x '(t nil active inactive)))) (defcustom org-export-with-todo-keywords t "Non-nil means include TODO keywords in export. @@ -797,6 +842,27 @@ is nil. You can also allow them through local buffer variables." :package-version '(Org . "8.0") :type 'boolean) +(defcustom org-export-with-broken-links nil + "Non-nil means do not raise an error on broken links. + +When this variable is non-nil, broken links are ignored, without +stopping the export process. If it is set to `mark', broken +links are marked as such in the output, with a string like + + [BROKEN LINK: path] + +where PATH is the un-resolvable reference. + +This option can also be set with the OPTIONS keyword, e.g., +\"broken-links:mark\"." + :group 'org-export-general + :version "25.2" + :package-version '(Org . "9.0") + :type '(choice + (const :tag "Ignore broken links" t) + (const :tag "Mark broken links in output" mark) + (const :tag "Raise an error" nil))) + (defcustom org-export-snippet-translation-alist nil "Alist between export snippets back-ends and exporter back-ends. @@ -810,7 +876,12 @@ HTML code while every other back-end will ignore it." :package-version '(Org . "8.0") :type '(repeat (cons (string :tag "Shortcut") - (string :tag "Back-end")))) + (string :tag "Back-end"))) + :safe (lambda (x) + (and (listp x) + (cl-every #'consp x) + (cl-every #'stringp (mapcar #'car x)) + (cl-every #'stringp (mapcar #'cdr x))))) (defcustom org-export-coding-system nil "Coding system for the exported file." @@ -823,7 +894,7 @@ HTML code while every other back-end will ignore it." "Non-nil means pushing export output to the kill ring. This variable is ignored during asynchronous export." :group 'org-export-general - :version "25.1" + :version "25.2" :package-version '(Org . "8.3") :type '(choice (const :tag "Always" t) @@ -851,7 +922,7 @@ these cases." (defcustom org-export-in-background nil "Non-nil means export and publishing commands will run in background. Results from an asynchronous export are never displayed -automatically. But you can retrieve them with \\[org-export-stack]." +automatically. But you can retrieve them with `\\[org-export-stack]'." :group 'org-export-general :version "24.4" :package-version '(Org . "8.0") @@ -921,8 +992,8 @@ mode." ;; Eventually `org-export-barf-if-invalid-backend' returns an error ;; when a given back-end hasn't been registered yet. -(defstruct (org-export-backend (:constructor org-export-create-backend) - (:copier nil)) +(cl-defstruct (org-export-backend (:constructor org-export-create-backend) + (:copier nil)) name parent transcoders options filters blocks menu) (defun org-export-get-backend (name) @@ -943,10 +1014,6 @@ BACKEND is a structure with `org-export-backend' type." (let ((parent (org-export-backend-parent backend))) (when (and parent (not (org-export-get-backend parent))) (error "Cannot use unknown \"%s\" back-end as a parent" parent))) - ;; Register dedicated export blocks in the parser. - (dolist (name (org-export-backend-blocks backend)) - (add-to-list 'org-element-block-name-alist - (cons name 'org-element-export-block-parser))) ;; If a back-end with the same name as BACKEND is already ;; registered, replace it with BACKEND. Otherwise, simply add ;; BACKEND to the list of registered back-ends. @@ -1073,14 +1140,6 @@ back-end. BODY can start with pre-defined keyword arguments. The following keywords are understood: - :export-block - - String, or list of strings, representing block names that - will not be parsed. This is used to specify blocks that will - contain raw code specific to the back-end. These blocks - still have to be handled by the relative `export-block' type - translator. - :filters-alist Alist between filters and function, or list of functions, @@ -1150,23 +1209,19 @@ keywords are understood: `org-export-options-alist' for more information about structure of the values." (declare (indent 1)) - (let (blocks filters menu-entry options contents) + (let (filters menu-entry options) (while (keywordp (car body)) (let ((keyword (pop body))) - (case keyword - (:export-block (let ((names (pop body))) - (setq blocks (if (consp names) (mapcar 'upcase names) - (list (upcase names)))))) + (pcase keyword (:filters-alist (setq filters (pop body))) (:menu-entry (setq menu-entry (pop body))) (:options-alist (setq options (pop body))) - (t (error "Unknown keyword: %s" keyword))))) + (_ (error "Unknown keyword: %s" keyword))))) (org-export-register-backend (org-export-create-backend :name backend :transcoders transcoders :options options :filters filters - :blocks blocks :menu menu-entry)))) (defun org-export-define-derived-backend (child parent &rest body) @@ -1178,14 +1233,6 @@ the parent back-end. BODY can start with pre-defined keyword arguments. The following keywords are understood: - :export-block - - String, or list of strings, representing block names that - will not be parsed. This is used to specify blocks that will - contain raw code specific to the back-end. These blocks - still have to be handled by the relative `export-block' type - translator. - :filters-alist Alist of filters that will overwrite or complete filters @@ -1222,25 +1269,21 @@ The back-end could then be called with, for example: (org-export-to-buffer \\='my-latex \"*Test my-latex*\")" (declare (indent 2)) - (let (blocks filters menu-entry options transcoders contents) + (let (filters menu-entry options transcoders) (while (keywordp (car body)) (let ((keyword (pop body))) - (case keyword - (:export-block (let ((names (pop body))) - (setq blocks (if (consp names) (mapcar 'upcase names) - (list (upcase names)))))) + (pcase keyword (:filters-alist (setq filters (pop body))) (:menu-entry (setq menu-entry (pop body))) (:options-alist (setq options (pop body))) (:translate-alist (setq transcoders (pop body))) - (t (error "Unknown keyword: %s" keyword))))) + (_ (error "Unknown keyword: %s" keyword))))) (org-export-register-backend (org-export-create-backend :name child :parent parent :transcoders transcoders :options options :filters filters - :blocks blocks :menu menu-entry)))) @@ -1259,7 +1302,7 @@ The back-end could then be called with, for example: ;; `org-export-options-alist' variable. ;; ;; 2. Tree properties are extracted directly from the parsed tree, -;; just before export, by `org-export-collect-tree-properties'. +;; just before export, by `org-export--collect-tree-properties'. ;;;; Environment Options ;; @@ -1304,7 +1347,7 @@ inferior to file-local settings." ;; First install #+BIND variables since these must be set before ;; global options are read. (dolist (pair (org-export--list-bound-variables)) - (org-set-local (car pair) (nth 1 pair))) + (set (make-local-variable (car pair)) (nth 1 pair))) ;; Get and prioritize export options... (org-combine-plists ;; ... from global variables... @@ -1314,25 +1357,7 @@ inferior to file-local settings." ;; ... from in-buffer settings... (org-export--get-inbuffer-options backend) ;; ... and from subtree, when appropriate. - (and subtreep (org-export--get-subtree-options backend)) - ;; Eventually add misc. properties. - (list - :back-end - backend - :translate-alist (org-export-get-all-transcoders backend) - :id-alist - ;; Collect id references. - (let (alist) - (org-with-wide-buffer - (goto-char (point-min)) - (while (re-search-forward "\\[\\[id:\\S-+?\\]" nil t) - (let ((link (org-element-context))) - (when (eq (org-element-type link) 'link) - (let* ((id (org-element-property :path link)) - (file (car (org-id-find id)))) - (when file - (push (cons id (file-relative-name file)) alist))))))) - alist)))) + (and subtreep (org-export--get-subtree-options backend)))) (defun org-export--parse-option-keyword (options &optional backend) "Parse an OPTIONS line and return values as a plist. @@ -1380,8 +1405,9 @@ for export. Return options as a plist." (cache (list (cons "TITLE" (or (org-entry-get (point) "EXPORT_TITLE" 'selective) - (progn (looking-at org-complex-heading-regexp) - (org-match-string-no-properties 4)))))) + (let ((case-fold-search nil)) + (looking-at org-complex-heading-regexp) + (match-string-no-properties 4)))))) ;; Look for both general keywords and back-end specific ;; options, with priority given to the latter. (options (append (and backend (org-export-get-all-options backend)) @@ -1401,7 +1427,7 @@ for export. Return options as a plist." (setq plist (plist-put plist property - (case (nth 4 option) + (cl-case (nth 4 option) (parse (org-element-parse-secondary-string value (org-element-restriction 'keyword))) @@ -1417,9 +1443,7 @@ which back-end specific options should also be read in the process. Assume buffer is in Org mode. Narrowing, if any, is ignored." - (let* (plist - get-options ; For byte-compiler. - (case-fold-search t) + (let* ((case-fold-search t) (options (append ;; Priority is given to back-end specific options. (and backend (org-export-get-all-options backend)) @@ -1427,110 +1451,124 @@ Assume buffer is in Org mode. Narrowing, if any, is ignored." (regexp (format "^[ \t]*#\\+%s:" (regexp-opt (nconc (delq nil (mapcar #'cadr options)) org-export-special-keywords)))) - (find-properties - (lambda (keyword) - ;; Return all properties associated to KEYWORD. - (let (properties) - (dolist (option options properties) - (when (equal (nth 1 option) keyword) - (pushnew (car option) properties)))))) - to-parse - (get-options - (lambda (&optional files plist) - ;; Recursively read keywords in buffer. FILES is a list - ;; of files read so far. PLIST is the current property - ;; list obtained. - (org-with-wide-buffer - (goto-char (point-min)) - (while (re-search-forward regexp nil t) - (let ((element (org-element-at-point))) - (when (eq (org-element-type element) 'keyword) - (let ((key (org-element-property :key element)) - (val (org-element-property :value element))) - (cond - ;; Options in `org-export-special-keywords'. - ((equal key "SETUPFILE") - (let ((file (expand-file-name - (org-remove-double-quotes (org-trim val))))) - ;; Avoid circular dependencies. - (unless (member file files) - (with-temp-buffer - (setq default-directory + plist to-parse) + (letrec ((find-properties + (lambda (keyword) + ;; Return all properties associated to KEYWORD. + (let (properties) + (dolist (option options properties) + (when (equal (nth 1 option) keyword) + (cl-pushnew (car option) properties)))))) + (get-options + (lambda (&optional files) + ;; Recursively read keywords in buffer. FILES is + ;; a list of files read so far. PLIST is the current + ;; property list obtained. + (org-with-wide-buffer + (goto-char (point-min)) + (while (re-search-forward regexp nil t) + (let ((element (org-element-at-point))) + (when (eq (org-element-type element) 'keyword) + (let ((key (org-element-property :key element)) + (val (org-element-property :value element))) + (cond + ;; Options in `org-export-special-keywords'. + ((equal key "SETUPFILE") + (let ((file + (expand-file-name + (org-unbracket-string "\"" "\"" (org-trim val))))) + ;; Avoid circular dependencies. + (unless (member file files) + (with-temp-buffer + (setq default-directory (file-name-directory file)) - (insert (org-file-contents file 'noerror)) - (let ((org-inhibit-startup t)) (org-mode)) - (setq plist (funcall get-options - (cons file files) plist)))))) - ((equal key "OPTIONS") - (setq plist - (org-combine-plists - plist - (org-export--parse-option-keyword val backend)))) - ((equal key "FILETAGS") - (setq plist - (org-combine-plists + (insert (org-file-contents file 'noerror)) + (let ((org-inhibit-startup t)) (org-mode)) + (funcall get-options (cons file files)))))) + ((equal key "OPTIONS") + (setq plist + (org-combine-plists + plist + (org-export--parse-option-keyword + val backend)))) + ((equal key "FILETAGS") + (setq plist + (org-combine-plists + plist + (list :filetags + (org-uniquify + (append + (org-split-string val ":") + (plist-get plist :filetags))))))) + (t + ;; Options in `org-export-options-alist'. + (dolist (property (funcall find-properties key)) + (setq plist - (list :filetags - (org-uniquify - (append (org-split-string val ":") - (plist-get plist :filetags))))))) - (t - ;; Options in `org-export-options-alist'. - (dolist (property (funcall find-properties key)) - (setq - plist - (plist-put - plist property - ;; Handle value depending on specified - ;; BEHAVIOR. - (case (nth 4 (assq property options)) - (parse - (unless (memq property to-parse) - (push property to-parse)) - ;; Even if `parse' implies `space' - ;; behavior, we separate line with "\n" - ;; so as to preserve line-breaks. - ;; However, empty lines are forbidden - ;; since `parse' doesn't allow more than - ;; one paragraph. - (let ((old (plist-get plist property))) - (cond ((not (org-string-nw-p val)) old) - (old (concat old "\n" val)) - (t val)))) - (space - (if (not (plist-get plist property)) - (org-trim val) - (concat (plist-get plist property) - " " - (org-trim val)))) - (newline - (org-trim - (concat (plist-get plist property) - "\n" - (org-trim val)))) - (split `(,@(plist-get plist property) - ,@(org-split-string val))) - ((t) val) - (otherwise - (if (not (plist-member plist property)) val - (plist-get plist property))))))))))))) - plist)))) - ;; Read options in the current buffer and return value. - (let ((options (funcall get-options - (and buffer-file-name (list buffer-file-name)) - nil))) + (plist-put + plist property + ;; Handle value depending on specified + ;; BEHAVIOR. + (cl-case (nth 4 (assq property options)) + (parse + (unless (memq property to-parse) + (push property to-parse)) + ;; Even if `parse' implies `space' + ;; behavior, we separate line with + ;; "\n" so as to preserve + ;; line-breaks. However, empty + ;; lines are forbidden since `parse' + ;; doesn't allow more than one + ;; paragraph. + (let ((old (plist-get plist property))) + (cond ((not (org-string-nw-p val)) old) + (old (concat old "\n" val)) + (t val)))) + (space + (if (not (plist-get plist property)) + (org-trim val) + (concat (plist-get plist property) + " " + (org-trim val)))) + (newline + (org-trim + (concat (plist-get plist property) + "\n" + (org-trim val)))) + (split `(,@(plist-get plist property) + ,@(org-split-string val))) + ((t) val) + (otherwise + (if (not (plist-member plist property)) val + (plist-get plist property))))))))))))))))) + ;; Read options in the current buffer and return value. + (funcall get-options (and buffer-file-name (list buffer-file-name))) ;; Parse properties in TO-PARSE. Remove newline characters not ;; involved in line breaks to simulate `space' behavior. ;; Finally return options. - (dolist (p to-parse options) + (dolist (p to-parse plist) (let ((value (org-element-parse-secondary-string - (plist-get options p) + (plist-get plist p) (org-element-restriction 'keyword)))) (org-element-map value 'plain-text (lambda (s) (org-element-set-element s (replace-regexp-in-string "\n" " " s)))) - (setq options (plist-put options p value))))))) + (setq plist (plist-put plist p value))))))) + +(defun org-export--get-export-attributes + (&optional backend subtreep visible-only body-only) + "Return properties related to export process, as a plist. +Optional arguments BACKEND, SUBTREEP, VISIBLE-ONLY and BODY-ONLY +are like the arguments with the same names of function +`org-export-as'." + (list :export-options (delq nil + (list (and subtreep 'subtree) + (and visible-only 'visible-only) + (and body-only 'body-only))) + :back-end backend + :translate-alist (org-export-get-all-transcoders backend) + :exported-data (make-hash-table :test #'eq :size 4001))) (defun org-export--get-buffer-attributes () "Return properties related to buffer attributes, as a plist." @@ -1566,37 +1604,37 @@ process." Also look for BIND keywords in setup files. The return value is an alist where associations are (VARIABLE-NAME VALUE)." (when org-export-allow-bind-keywords - (let* (collect-bind ; For byte-compiler. - (collect-bind - (lambda (files alist) - ;; Return an alist between variable names and their - ;; value. FILES is a list of setup files names read so - ;; far, used to avoid circular dependencies. ALIST is - ;; the alist collected so far. - (let ((case-fold-search t)) - (org-with-wide-buffer - (goto-char (point-min)) - (while (re-search-forward - "^[ \t]*#\\+\\(BIND\\|SETUPFILE\\):" nil t) - (let ((element (org-element-at-point))) - (when (eq (org-element-type element) 'keyword) - (let ((val (org-element-property :value element))) - (if (equal (org-element-property :key element) "BIND") - (push (read (format "(%s)" val)) alist) - ;; Enter setup file. - (let ((file (expand-file-name - (org-remove-double-quotes val)))) - (unless (member file files) - (with-temp-buffer - (setq default-directory - (file-name-directory file)) - (let ((org-inhibit-startup t)) (org-mode)) - (insert (org-file-contents file 'noerror)) - (setq alist - (funcall collect-bind - (cons file files) - alist)))))))))) - alist))))) + (letrec ((collect-bind + (lambda (files alist) + ;; Return an alist between variable names and their + ;; value. FILES is a list of setup files names read + ;; so far, used to avoid circular dependencies. ALIST + ;; is the alist collected so far. + (let ((case-fold-search t)) + (org-with-wide-buffer + (goto-char (point-min)) + (while (re-search-forward + "^[ \t]*#\\+\\(BIND\\|SETUPFILE\\):" nil t) + (let ((element (org-element-at-point))) + (when (eq (org-element-type element) 'keyword) + (let ((val (org-element-property :value element))) + (if (equal (org-element-property :key element) + "BIND") + (push (read (format "(%s)" val)) alist) + ;; Enter setup file. + (let ((file (expand-file-name + (org-unbracket-string "\"" "\"" val)))) + (unless (member file files) + (with-temp-buffer + (setq default-directory + (file-name-directory file)) + (let ((org-inhibit-startup t)) (org-mode)) + (insert (org-file-contents file 'noerror)) + (setq alist + (funcall collect-bind + (cons file files) + alist)))))))))) + alist))))) ;; Return value in appropriate order of appearance. (nreverse (funcall collect-bind nil nil))))) @@ -1612,7 +1650,7 @@ BLOB is the element or object considered." ;; ;; Tree properties are information extracted from parse tree. They ;; are initialized at the beginning of the transcoding process by -;; `org-export-collect-tree-properties'. +;; `org-export--collect-tree-properties'. ;; ;; Dedicated functions focus on computing the value of specific tree ;; properties during initialization. Thus, @@ -1623,7 +1661,7 @@ BLOB is the element or object considered." ;; `org-export--collect-headline-numbering' builds an alist between ;; headlines and their numbering. -(defun org-export-collect-tree-properties (data info) +(defun org-export--collect-tree-properties (data info) "Extract tree properties from parse tree. DATA is the parse tree from which information is retrieved. INFO @@ -1631,17 +1669,17 @@ is a list holding export options. Following tree properties are set or updated: -`:exported-data' Hash table used to memoize results from - `org-export-data'. - `:headline-offset' Offset between true level of headlines and local level. An offset of -1 means a headline of level 2 should be considered as a level 1 headline in the context. -`:headline-numbering' Alist of all headlines as key an the +`:headline-numbering' Alist of all headlines as key and the associated numbering as value. +`:id-alist' Alist of all ID references as key and associated file + as value. + Return updated plist." ;; Install the parse tree in the communication channel. (setq info (plist-put info :parse-tree data)) @@ -1651,12 +1689,18 @@ Return updated plist." (plist-put info :headline-offset (- 1 (org-export--get-min-level data info)))) - ;; Properties order doesn't matter: get the rest of the tree - ;; properties. - (nconc - `(:headline-numbering ,(org-export--collect-headline-numbering data info) - :exported-data ,(make-hash-table :test 'eq :size 4001)) - info)) + ;; From now on, properties order doesn't matter: get the rest of the + ;; tree properties. + (org-combine-plists + info + (list :headline-numbering (org-export--collect-headline-numbering data info) + :id-alist + (org-element-map data 'link + (lambda (l) + (and (string= (org-element-property :type l) "id") + (let* ((id (org-element-property :path l)) + (file (car (org-id-find id)))) + (and file (cons id (file-relative-name file)))))))))) (defun org-export--get-min-level (data options) "Return minimum exportable headline's level in DATA. @@ -1664,14 +1708,12 @@ DATA is parsed tree as returned by `org-element-parse-buffer'. OPTIONS is a plist holding export options." (catch 'exit (let ((min-level 10000)) - (mapc - (lambda (blob) - (when (and (eq (org-element-type blob) 'headline) - (not (org-element-property :footnote-section-p blob)) - (not (memq blob (plist-get options :ignore-list)))) - (setq min-level (min (org-element-property :level blob) min-level))) - (when (= min-level 1) (throw 'exit 1))) - (org-element-contents data)) + (dolist (datum (org-element-contents data)) + (when (and (eq (org-element-type datum) 'headline) + (not (org-element-property :footnote-section-p datum)) + (not (memq datum (plist-get options :ignore-list)))) + (setq min-level (min (org-element-property :level datum) min-level)) + (when (= min-level 1) (throw 'exit 1)))) ;; If no headline was found, for the sake of consistency, set ;; minimum level to 1 nonetheless. (if (= min-level 10000) 1 min-level)))) @@ -1694,55 +1736,58 @@ for a footnotes section." (1- (org-export-get-relative-level headline options)))) (cons headline - (loop for n across numbering - for idx from 0 to org-export-max-depth - when (< idx relative-level) collect n - when (= idx relative-level) collect (aset numbering idx (1+ n)) - when (> idx relative-level) do (aset numbering idx 0)))))) + (cl-loop + for n across numbering + for idx from 0 to org-export-max-depth + when (< idx relative-level) collect n + when (= idx relative-level) collect (aset numbering idx (1+ n)) + when (> idx relative-level) do (aset numbering idx 0)))))) options))) (defun org-export--selected-trees (data info) "List headlines and inlinetasks with a select tag in their tree. DATA is parsed data as returned by `org-element-parse-buffer'. INFO is a plist holding export options." - (let* (selected-trees - walk-data ; For byte-compiler. - (walk-data - (function - (lambda (data genealogy) - (let ((type (org-element-type data))) - (cond - ((memq type '(headline inlinetask)) - (let ((tags (org-element-property :tags data))) - (if (loop for tag in (plist-get info :select-tags) - thereis (member tag tags)) - ;; When a select tag is found, mark full - ;; genealogy and every headline within the tree - ;; as acceptable. - (setq selected-trees - (append - genealogy - (org-element-map data '(headline inlinetask) - #'identity) - selected-trees)) - ;; If at a headline, continue searching in tree, - ;; recursively. - (when (eq type 'headline) - (dolist (el (org-element-contents data)) - (funcall walk-data el (cons data genealogy))))))) - ((or (eq type 'org-data) - (memq type org-element-greater-elements)) - (dolist (el (org-element-contents data)) - (funcall walk-data el genealogy))))))))) - (funcall walk-data data nil) - selected-trees)) + (let ((select (plist-get info :select-tags))) + (if (cl-some (lambda (tag) (member tag select)) (plist-get info :filetags)) + ;; If FILETAGS contains a select tag, every headline or + ;; inlinetask is returned. + (org-element-map data '(headline inlinetask) #'identity) + (letrec ((selected-trees nil) + (walk-data + (lambda (data genealogy) + (let ((type (org-element-type data))) + (cond + ((memq type '(headline inlinetask)) + (let ((tags (org-element-property :tags data))) + (if (cl-some (lambda (tag) (member tag select)) tags) + ;; When a select tag is found, mark full + ;; genealogy and every headline within the + ;; tree as acceptable. + (setq selected-trees + (append + genealogy + (org-element-map data '(headline inlinetask) + #'identity) + selected-trees)) + ;; If at a headline, continue searching in + ;; tree, recursively. + (when (eq type 'headline) + (dolist (el (org-element-contents data)) + (funcall walk-data el (cons data genealogy))))))) + ((or (eq type 'org-data) + (memq type org-element-greater-elements)) + (dolist (el (org-element-contents data)) + (funcall walk-data el genealogy)))))))) + (funcall walk-data data nil) + selected-trees)))) (defun org-export--skip-p (blob options selected) "Non-nil when element or object BLOB should be skipped during export. OPTIONS is the plist holding export options. SELECTED, when non-nil, is a list of headlines or inlinetasks belonging to a tree with a select tag." - (case (org-element-type blob) + (cl-case (org-element-type blob) (clock (not (plist-get options :with-clocks))) (drawer (let ((with-drawers-p (plist-get options :with-drawers))) @@ -1764,13 +1809,13 @@ a tree with a select tag." (todo (org-element-property :todo-keyword blob)) (todo-type (org-element-property :todo-type blob)) (archived (plist-get options :with-archived-trees)) - (tags (org-element-property :tags blob))) + (tags (org-export-get-tags blob options nil t))) (or (and (eq (org-element-type blob) 'inlinetask) (not (plist-get options :with-inlinetasks))) ;; Ignore subtrees with an exclude tag. - (loop for k in (plist-get options :exclude-tags) - thereis (member k tags)) + (cl-loop for k in (plist-get options :exclude-tags) + thereis (member k tags)) ;; When a select tag is present in the buffer, ignore any tree ;; without it. (and selected (not (memq blob selected))) @@ -1812,7 +1857,7 @@ a tree with a select tag." (lambda (obj) (or (not (stringp obj)) (org-string-nw-p obj))) options t)))) - (case (plist-get options :with-timestamps) + (cl-case (plist-get options :with-timestamps) ((nil) t) (active (not (memq (org-element-property :type blob) '(active active-range)))) @@ -1842,7 +1887,7 @@ a tree with a select tag." INFO is a plist containing export directives." (let ((type (org-element-type blob))) ;; Return contents only for complete parse trees. - (if (eq type 'org-data) (lambda (blob contents info) contents) + (if (eq type 'org-data) (lambda (_datum contents _info) contents) (let ((transcoder (cdr (assq type (plist-get info :translate-alist))))) (and (functionp transcoder) transcoder))))) @@ -1854,91 +1899,103 @@ string. INFO is a plist holding export options. Return a string." (or (gethash data (plist-get info :exported-data)) - (let* ((type (org-element-type data)) - (results - (cond - ;; Ignored element/object. - ((memq data (plist-get info :ignore-list)) nil) - ;; Plain text. - ((eq type 'plain-text) - (org-export-filter-apply-functions - (plist-get info :filter-plain-text) - (let ((transcoder (org-export-transcoder data info))) - (if transcoder (funcall transcoder data info) data)) - info)) - ;; Secondary string. - ((not type) - (mapconcat (lambda (obj) (org-export-data obj info)) data "")) - ;; Element/Object without contents or, as a special - ;; case, headline with archive tag and archived trees - ;; restricted to title only. - ((or (not (org-element-contents data)) - (and (eq type 'headline) - (eq (plist-get info :with-archived-trees) 'headline) - (org-element-property :archivedp data))) - (let ((transcoder (org-export-transcoder data info))) - (or (and (functionp transcoder) - (funcall transcoder data nil info)) - ;; Export snippets never return a nil value so - ;; that white spaces following them are never - ;; ignored. - (and (eq type 'export-snippet) "")))) - ;; Element/Object with contents. - (t - (let ((transcoder (org-export-transcoder data info))) - (when transcoder - (let* ((greaterp (memq type org-element-greater-elements)) - (objectp - (and (not greaterp) - (memq type org-element-recursive-objects))) - (contents - (mapconcat - (lambda (element) (org-export-data element info)) - (org-element-contents - (if (or greaterp objectp) data - ;; Elements directly containing - ;; objects must have their indentation - ;; normalized first. - (org-element-normalize-contents - data - ;; When normalizing contents of the - ;; first paragraph in an item or - ;; a footnote definition, ignore - ;; first line's indentation: there is - ;; none and it might be misleading. - (when (eq type 'paragraph) - (let ((parent (org-export-get-parent data))) + ;; Handle broken links according to + ;; `org-export-with-broken-links'. + (cl-macrolet + ((broken-link-handler + (&rest body) + `(condition-case err + (progn ,@body) + (org-link-broken + (pcase (plist-get info :with-broken-links) + (`nil (user-error "Unable to resolve link: %S" (nth 1 err))) + (`mark (org-export-data + (format "[BROKEN LINK: %s]" (nth 1 err)) info)) + (_ nil)))))) + (let* ((type (org-element-type data)) + (parent (org-export-get-parent data)) + (results + (cond + ;; Ignored element/object. + ((memq data (plist-get info :ignore-list)) nil) + ;; Plain text. + ((eq type 'plain-text) + (org-export-filter-apply-functions + (plist-get info :filter-plain-text) + (let ((transcoder (org-export-transcoder data info))) + (if transcoder (funcall transcoder data info) data)) + info)) + ;; Secondary string. + ((not type) + (mapconcat (lambda (obj) (org-export-data obj info)) data "")) + ;; Element/Object without contents or, as a special + ;; case, headline with archive tag and archived trees + ;; restricted to title only. + ((or (not (org-element-contents data)) + (and (eq type 'headline) + (eq (plist-get info :with-archived-trees) 'headline) + (org-element-property :archivedp data))) + (let ((transcoder (org-export-transcoder data info))) + (or (and (functionp transcoder) + (broken-link-handler + (funcall transcoder data nil info))) + ;; Export snippets never return a nil value so + ;; that white spaces following them are never + ;; ignored. + (and (eq type 'export-snippet) "")))) + ;; Element/Object with contents. + (t + (let ((transcoder (org-export-transcoder data info))) + (when transcoder + (let* ((greaterp (memq type org-element-greater-elements)) + (objectp + (and (not greaterp) + (memq type org-element-recursive-objects))) + (contents + (mapconcat + (lambda (element) (org-export-data element info)) + (org-element-contents + (if (or greaterp objectp) data + ;; Elements directly containing + ;; objects must have their indentation + ;; normalized first. + (org-element-normalize-contents + data + ;; When normalizing contents of the + ;; first paragraph in an item or + ;; a footnote definition, ignore + ;; first line's indentation: there is + ;; none and it might be misleading. + (when (eq type 'paragraph) (and (eq (car (org-element-contents parent)) data) (memq (org-element-type parent) - '(footnote-definition item)))))))) - ""))) - (funcall transcoder data - (if (not greaterp) contents - (org-element-normalize-string contents)) - info)))))))) - ;; Final result will be memoized before being returned. - (puthash - data - (cond - ((not results) "") - ((memq type '(org-data plain-text nil)) results) - ;; Append the same white space between elements or objects - ;; as in the original buffer, and call appropriate filters. - (t - (let ((results - (org-export-filter-apply-functions - (plist-get info (intern (format ":filter-%s" type))) - (let ((post-blank (or (org-element-property :post-blank data) - 0))) - (if (memq type org-element-all-elements) - (concat (org-element-normalize-string results) - (make-string post-blank ?\n)) - (concat results (make-string post-blank ?\s)))) - info))) - results))) - (plist-get info :exported-data))))) + '(footnote-definition item))))))) + ""))) + (broken-link-handler + (funcall transcoder data + (if (not greaterp) contents + (org-element-normalize-string contents)) + info))))))))) + ;; Final result will be memoized before being returned. + (puthash + data + (cond + ((not results) "") + ((memq type '(org-data plain-text nil)) results) + ;; Append the same white space between elements or objects + ;; as in the original buffer, and call appropriate filters. + (t + (org-export-filter-apply-functions + (plist-get info (intern (format ":filter-%s" type))) + (let ((blank (or (org-element-property :post-blank data) 0))) + (if (eq (org-element-class data parent) 'object) + (concat results (make-string blank ?\s)) + (concat (org-element-normalize-string results) + (make-string blank ?\n)))) + info))) + (plist-get info :exported-data)))))) (defun org-export-data-with-backend (data backend info) "Convert DATA into BACKEND format. @@ -1972,7 +2029,8 @@ contents, as a string or nil. When optional argument WITH-AFFILIATED is non-nil, add affiliated keywords before output." (let ((type (org-element-type blob))) - (concat (and with-affiliated (memq type org-element-all-elements) + (concat (and with-affiliated + (eq (org-element-class blob) 'element) (org-element--interpret-affiliated-keywords blob)) (funcall (intern (format "org-element-%s-interpreter" type)) blob contents)))) @@ -2437,29 +2495,27 @@ Return the updated communication channel." (let (plist) ;; Install user-defined filters with `org-export-filters-alist' ;; and filters already in INFO (through ext-plist mechanism). - (mapc (lambda (p) - (let* ((prop (car p)) - (info-value (plist-get info prop)) - (default-value (symbol-value (cdr p)))) - (setq plist - (plist-put plist prop - ;; Filters in INFO will be called - ;; before those user provided. - (append (if (listp info-value) info-value - (list info-value)) - default-value))))) - org-export-filters-alist) + (dolist (p org-export-filters-alist) + (let* ((prop (car p)) + (info-value (plist-get info prop)) + (default-value (symbol-value (cdr p)))) + (setq plist + (plist-put plist prop + ;; Filters in INFO will be called + ;; before those user provided. + (append (if (listp info-value) info-value + (list info-value)) + default-value))))) ;; Prepend back-end specific filters to that list. - (mapc (lambda (p) - ;; Single values get consed, lists are appended. - (let ((key (car p)) (value (cdr p))) - (when value - (setq plist - (plist-put - plist key - (if (atom value) (cons value (plist-get plist key)) - (append value (plist-get plist key)))))))) - (org-export-get-all-filters (plist-get info :back-end))) + (dolist (p (org-export-get-all-filters (plist-get info :back-end))) + ;; Single values get consed, lists are appended. + (let ((key (car p)) (value (cdr p))) + (when value + (setq plist + (plist-put + plist key + (if (atom value) (cons value (plist-get plist key)) + (append value (plist-get plist key)))))))) ;; Return new communication channel. (org-combine-plists info plist))) @@ -2572,17 +2628,14 @@ The function assumes BUFFER's major mode is `org-mode'." (goto-char ,(point)) ;; Overlays with invisible property. ,@(let (ov-set) - (mapc - (lambda (ov) - (let ((invis-prop (overlay-get ov 'invisible))) - (when invis-prop - (push `(overlay-put - (make-overlay ,(overlay-start ov) - ,(overlay-end ov)) - 'invisible (quote ,invis-prop)) - ov-set)))) - (overlays-in (point-min) (point-max))) - ov-set))))) + (dolist (ov (overlays-in (point-min) (point-max)) ov-set) + (let ((invis-prop (overlay-get ov 'invisible))) + (when invis-prop + (push `(overlay-put + (make-overlay ,(overlay-start ov) + ,(overlay-end ov)) + 'invisible (quote ,invis-prop)) + ov-set))))))))) (defun org-export--delete-comments () "Delete commented areas in the buffer. @@ -2598,12 +2651,12 @@ the document. Narrowing, if any, is ignored." comment-re))) (while (re-search-forward regexp nil t) (let ((element (org-element-at-point))) - (case (org-element-type element) - ((headline inlinetask) + (pcase (org-element-type element) + ((or `headline `inlinetask) (when (org-element-property :commentedp element) (delete-region (org-element-property :begin element) (org-element-property :end element)))) - ((comment comment-block) + ((or `comment `comment-block) (let* ((parent (org-element-property :parent element)) (start (org-element-property :begin element)) (end (org-element-property :end element)) @@ -2622,7 +2675,7 @@ the document. Narrowing, if any, is ignored." end) (progn (forward-line -1) - (or (org-looking-at-p "^[ \t]*$") + (or (looking-at-p "^[ \t]*$") (org-with-limited-levels (org-at-heading-p))))))))) (delete-region start end) @@ -2634,33 +2687,47 @@ DATA is the parse tree to traverse. INFO is the plist holding export info. Also set `:ignore-list' in INFO to a list of objects which should be ignored during export, but not removed from tree." - (let* (walk-data - ignore - ;; First find trees containing a select tag, if any. - (selected (org-export--selected-trees data info)) - (walk-data - (lambda (data) - ;; Prune non-exportable elements and objects from tree. - ;; As a special case, special rows and cells from tables - ;; are stored in IGNORE, as they still need to be accessed - ;; during export. - (when data - (let ((type (org-element-type data))) - (if (org-export--skip-p data info selected) - (if (memq type '(table-cell table-row)) (push data ignore) - (org-element-extract-element data)) - (if (and (eq type 'headline) - (eq (plist-get info :with-archived-trees) 'headline) - (org-element-property :archivedp data)) - ;; If headline is archived but tree below has to - ;; be skipped, remove contents. - (org-element-set-contents data) - ;; Move into recursive objects/elements. - (mapc walk-data (org-element-contents data))) - ;; Move into secondary string, if any. - (dolist (p (cdr (assq type - org-element-secondary-value-alist))) - (mapc walk-data (org-element-property p data))))))))) + (letrec ((ignore nil) + ;; First find trees containing a select tag, if any. + (selected (org-export--selected-trees data info)) + (walk-data + (lambda (data) + ;; Prune non-exportable elements and objects from tree. + ;; As a special case, special rows and cells from tables + ;; are stored in IGNORE, as they still need to be + ;; accessed during export. + (when data + (let ((type (org-element-type data))) + (if (org-export--skip-p data info selected) + (if (memq type '(table-cell table-row)) (push data ignore) + (org-element-extract-element data)) + (if (and (eq type 'headline) + (eq (plist-get info :with-archived-trees) + 'headline) + (org-element-property :archivedp data)) + ;; If headline is archived but tree below has + ;; to be skipped, remove contents. + (org-element-set-contents data) + ;; Move into recursive objects/elements. + (mapc walk-data (org-element-contents data))) + ;; Move into secondary string, if any. + (dolist (p (cdr (assq type + org-element-secondary-value-alist))) + (mapc walk-data (org-element-property p data)))))))) + (definitions + ;; Collect definitions before possibly pruning them so as + ;; to avoid parsing them again if they are required. + (org-element-map data '(footnote-definition footnote-reference) + (lambda (f) + (cond + ((eq (org-element-type f) 'footnote-definition) f) + ((eq (org-element-property :type f) 'standard) nil) + (t (let ((label (org-element-property :label f))) + (when label ;Skip anonymous references. + (apply + #'org-element-create + 'footnote-definition `(:label ,label :post-blank 1) + (org-element-contents f)))))))))) ;; If a select tag is active, also ignore the section before the ;; first headline, if any. (when selected @@ -2669,16 +2736,156 @@ from tree." (org-element-extract-element first-element)))) ;; Prune tree and communication channel. (funcall walk-data data) - (dolist (entry - (append - ;; Priority is given to back-end specific options. - (org-export-get-all-options (plist-get info :back-end)) - org-export-options-alist)) + (dolist (entry (append + ;; Priority is given to back-end specific options. + (org-export-get-all-options (plist-get info :back-end)) + org-export-options-alist)) (when (eq (nth 4 entry) 'parse) (funcall walk-data (plist-get info (car entry))))) + (let ((missing (org-export--missing-definitions data definitions))) + (funcall walk-data missing) + (org-export--install-footnote-definitions missing data)) ;; Eventually set `:ignore-list'. (plist-put info :ignore-list ignore))) +(defun org-export--missing-definitions (tree definitions) + "List footnote definitions missing from TREE. +Missing definitions are searched within DEFINITIONS, which is +a list of footnote definitions or in the widened buffer." + (let* ((list-labels + (lambda (data) + ;; List all footnote labels encountered in DATA. Inline + ;; footnote references are ignored. + (org-element-map data 'footnote-reference + (lambda (reference) + (and (eq (org-element-property :type reference) 'standard) + (org-element-property :label reference)))))) + defined undefined missing-definitions) + ;; Partition DIRECT-REFERENCES between DEFINED and UNDEFINED + ;; references. + (let ((known-definitions + (org-element-map tree '(footnote-reference footnote-definition) + (lambda (f) + (and (or (eq (org-element-type f) 'footnote-definition) + (eq (org-element-property :type f) 'inline)) + (org-element-property :label f))))) + seen) + (dolist (l (funcall list-labels tree)) + (cond ((member l seen)) + ((member l known-definitions) (push l defined)) + (t (push l undefined))))) + ;; Complete MISSING-DEFINITIONS by finding the definition of every + ;; undefined label, first by looking into DEFINITIONS, then by + ;; searching the widened buffer. This is a recursive process + ;; since definitions found can themselves contain an undefined + ;; reference. + (while undefined + (let* ((label (pop undefined)) + (definition + (cond + ((cl-some + (lambda (d) (and (equal (org-element-property :label d) label) + d)) + definitions)) + ((pcase (org-footnote-get-definition label) + (`(,_ ,beg . ,_) + (org-with-wide-buffer + (goto-char beg) + (let ((datum (org-element-context))) + (if (eq (org-element-type datum) 'footnote-reference) + datum + ;; Parse definition with contents. + (save-restriction + (narrow-to-region + (org-element-property :begin datum) + (org-element-property :end datum)) + (org-element-map (org-element-parse-buffer) + 'footnote-definition #'identity nil t)))))) + (_ nil))) + (t (user-error "Definition not found for footnote %s" label))))) + (push label defined) + (push definition missing-definitions) + ;; Look for footnote references within DEFINITION, since + ;; we may need to also find their definition. + (dolist (l (funcall list-labels definition)) + (unless (or (member l defined) ;Known label + (member l undefined)) ;Processed later + (push l undefined))))) + ;; MISSING-DEFINITIONS may contain footnote references with inline + ;; definitions. Make sure those are changed into real footnote + ;; definitions. + (mapcar (lambda (d) + (if (eq (org-element-type d) 'footnote-definition) d + (let ((label (org-element-property :label d))) + (apply #'org-element-create + 'footnote-definition `(:label ,label :post-blank 1) + (org-element-contents d))))) + missing-definitions))) + +(defun org-export--install-footnote-definitions (definitions tree) + "Install footnote definitions in tree. + +DEFINITIONS is the list of footnote definitions to install. TREE +is the parse tree. + +If there is a footnote section in TREE, definitions found are +appended to it. If `org-footnote-section' is non-nil, a new +footnote section containing all definitions is inserted in TREE. +Otherwise, definitions are appended at the end of the section +containing their first reference." + (cond + ((null definitions)) + ;; If there is a footnote section, insert definitions there. + ((let ((footnote-section + (org-element-map tree 'headline + (lambda (h) (and (org-element-property :footnote-section-p h) h)) + nil t))) + (and footnote-section + (apply #'org-element-adopt-elements + footnote-section + (nreverse definitions))))) + ;; If there should be a footnote section, create one containing all + ;; the definitions at the end of the tree. + (org-footnote-section + (org-element-adopt-elements + tree + (org-element-create 'headline + (list :footnote-section-p t + :level 1 + :title org-footnote-section) + (apply #'org-element-create + 'section + nil + (nreverse definitions))))) + ;; Otherwise add each definition at the end of the section where it + ;; is first referenced. + (t + (letrec ((seen nil) + (insert-definitions + (lambda (data) + ;; Insert footnote definitions in the same section as + ;; their first reference in DATA. + (org-element-map data 'footnote-reference + (lambda (reference) + (when (eq (org-element-property :type reference) 'standard) + (let ((label (org-element-property :label reference))) + (unless (member label seen) + (push label seen) + (let ((definition + (cl-some + (lambda (d) + (and (equal (org-element-property :label d) + label) + d)) + definitions))) + (org-element-adopt-elements + (org-element-lineage reference '(section)) + definition) + ;; Also insert definitions for nested + ;; references, if any. + (funcall insert-definitions definition)))))))))) + (funcall insert-definitions tree))))) + (defun org-export--remove-uninterpreted-data (data info) "Change uninterpreted elements back into Org syntax. DATA is the parse tree. INFO is a plist containing export @@ -2705,7 +2912,7 @@ returned by the function." subscript superscript underline) (lambda (blob) (let ((new - (case (org-element-type blob) + (cl-case (org-element-type blob) ;; ... entities... (entity (and (not (plist-get info :with-entities)) @@ -2717,7 +2924,7 @@ returned by the function." ;; ... emphasis... ((bold italic strike-through underline) (and (not (plist-get info :with-emphasize)) - (let ((marker (case (org-element-type blob) + (let ((marker (cl-case (org-element-type blob) (bold "*") (italic "/") (strike-through "+") @@ -2762,131 +2969,6 @@ returned by the function." ;; Return modified parse tree. data) -(defun org-export--merge-external-footnote-definitions (tree) - "Insert footnote definitions outside parsing scope in TREE. - -If there is a footnote section in TREE, definitions found are -appended to it. If `org-footnote-section' is non-nil, a new -footnote section containing all definitions is inserted in TREE. -Otherwise, definitions are appended at the end of the section -containing their first reference. - -Only definitions actually referred to within TREE, directly or -not, are considered." - (let* ((collect-labels - (lambda (data) - (org-element-map data 'footnote-reference - (lambda (f) - (and (eq (org-element-property :type f) 'standard) - (org-element-property :label f)))))) - (referenced-labels (funcall collect-labels tree))) - (when referenced-labels - (let* ((definitions) - (push-definition - (lambda (datum) - (case (org-element-type datum) - (footnote-definition - (push (save-restriction - (narrow-to-region (org-element-property :begin datum) - (org-element-property :end datum)) - (org-element-map (org-element-parse-buffer) - 'footnote-definition #'identity nil t)) - definitions)) - (footnote-reference - (let ((label (org-element-property :label datum)) - (cbeg (org-element-property :contents-begin datum))) - (when (and label cbeg - (eq (org-element-property :type datum) 'inline)) - (push - (apply #'org-element-create - 'footnote-definition - (list :label label :post-blank 1) - (org-element-parse-secondary-string - (buffer-substring - cbeg (org-element-property :contents-end datum)) - (org-element-restriction 'footnote-reference))) - definitions)))))))) - ;; Collect all out of scope definitions. - (save-excursion - (goto-char (point-min)) - (org-with-wide-buffer - (while (re-search-backward org-footnote-re nil t) - (funcall push-definition (org-element-context)))) - (goto-char (point-max)) - (org-with-wide-buffer - (while (re-search-forward org-footnote-re nil t) - (funcall push-definition (org-element-context))))) - ;; Filter out definitions referenced neither in the original - ;; tree nor in the external definitions. - (let* ((directly-referenced - (org-remove-if-not - (lambda (d) - (member (org-element-property :label d) referenced-labels)) - definitions)) - (all-labels - (append (funcall collect-labels directly-referenced) - referenced-labels))) - (setq definitions - (org-remove-if-not - (lambda (d) - (member (org-element-property :label d) all-labels)) - definitions))) - ;; Install definitions in subtree. - (cond - ((null definitions)) - ;; If there is a footnote section, insert them here. - ((let ((footnote-section - (org-element-map tree 'headline - (lambda (h) - (and (org-element-property :footnote-section-p h) h)) - nil t))) - (and footnote-section - (apply #'org-element-adopt-elements (nreverse definitions))))) - ;; If there should be a footnote section, create one containing - ;; all the definitions at the end of the tree. - (org-footnote-section - (org-element-adopt-elements - tree - (org-element-create 'headline - (list :footnote-section-p t - :level 1 - :title org-footnote-section) - (apply #'org-element-create - 'section - nil - (nreverse definitions))))) - ;; Otherwise add each definition at the end of the section where - ;; it is first referenced. - (t - (let* ((seen) - (insert-definitions) ; For byte-compiler. - (insert-definitions - (lambda (data) - ;; Insert definitions in the same section as their - ;; first reference in DATA. - (org-element-map tree 'footnote-reference - (lambda (f) - (when (eq (org-element-property :type f) 'standard) - (let ((label (org-element-property :label f))) - (unless (member label seen) - (push label seen) - (let ((definition - (catch 'found - (dolist (d definitions) - (when (equal - (org-element-property :label d) - label) - (setq definitions - (delete d definitions)) - (throw 'found d)))))) - (when definition - (org-element-adopt-elements - (org-element-lineage f '(section)) - definition) - (funcall insert-definitions - definition))))))))))) - (funcall insert-definitions tree)))))))) - ;;;###autoload (defun org-export-as (backend &optional subtreep visible-only body-only ext-plist) @@ -2934,11 +3016,8 @@ Return code as a string." ;; attributes, unavailable in its copy. (let* ((org-export-current-backend (org-export-backend-name backend)) (info (org-combine-plists - (list :export-options - (delq nil - (list (and subtreep 'subtree) - (and visible-only 'visible-only) - (and body-only 'body-only)))) + (org-export--get-export-attributes + backend subtreep visible-only body-only) (org-export--get-buffer-attributes))) (parsed-keywords (delq nil @@ -2963,9 +3042,10 @@ Return code as a string." ;; again after executing Babel code. (org-set-regexps-and-options) (org-update-radio-target-regexp) - (org-export-execute-babel-code) - (org-set-regexps-and-options) - (org-update-radio-target-regexp) + (when org-export-babel-evaluate + (org-babel-exp-process-buffer) + (org-set-regexps-and-options) + (org-update-radio-target-regexp)) ;; Run last hook with current back-end's name as argument. ;; Update buffer properties and radio targets one last time ;; before parsing. @@ -3013,8 +3093,6 @@ Return code as a string." parsed-keywords) ;; Parse buffer. (setq tree (org-element-parse-buffer nil visible-only)) - ;; Merge footnote definitions outside scope into parse tree. - (org-export--merge-external-footnote-definitions tree) ;; Prune tree from non-exported elements and transform ;; uninterpreted elements or objects in both parse tree and ;; communication channel. @@ -3026,9 +3104,7 @@ Return code as a string." (plist-get info :filter-parse-tree) tree info)) ;; Now tree is complete, compute its properties and add them ;; to communication channel. - (setq info - (org-combine-plists - info (org-export-collect-tree-properties tree info))) + (setq info (org-export--collect-tree-properties tree info)) ;; Eventually transcode TREE. Wrap the resulting string into ;; a template. (let* ((body (org-element-normalize-string @@ -3146,7 +3222,7 @@ locally for the subtree through node properties." (< (+ width (length (car items)) 1) fill-column)) (let ((item (pop items))) (insert " " item) - (incf width (1+ (length item)))))) + (cl-incf width (1+ (length item)))))) (insert "\n"))))) ;; Then the rest of keywords, in the order specified in either ;; `org-export-options-alist' or respective export back-ends. @@ -3213,8 +3289,7 @@ storing and resolving footnotes. It is created automatically." (setq matched (replace-match "" nil nil matched 1))) (expand-file-name - (org-remove-double-quotes - matched) + (org-unbracket-string "\"" "\"" matched) dir))) (setq value (replace-match "" nil nil value))))) (only-contents @@ -3228,10 +3303,12 @@ storing and resolving footnotes. It is created automatically." value) (prog1 (match-string 1 value) (setq value (replace-match "" nil nil value))))) - (env (cond ((string-match "\\<example\\>" value) - 'literal) - ((string-match "\\<src\\(?: +\\(.*\\)\\)?" value) - 'literal))) + (env (cond + ((string-match "\\<example\\>" value) 'literal) + ((string-match "\\<export\\(?: +\\(.*\\)\\)?" value) + 'literal) + ((string-match "\\<src\\(?: +\\(.*\\)\\)?" value) + 'literal))) ;; Minimal level of included file defaults to the child ;; level of the current headline, if any, or one. It ;; only applies is the file is meant to be included as @@ -3243,12 +3320,11 @@ storing and resolving footnotes. It is created automatically." (setq value (replace-match "" nil nil value))) (get-text-property (point) :org-include-induced-level)))) - (src-args (and (eq env 'literal) - (match-string 1 value))) + (args (and (eq env 'literal) (match-string 1 value))) (block (and (string-match "\\<\\(\\S-+\\)\\>" value) (match-string 1 value)))) ;; Remove keyword. - (delete-region (point) (progn (forward-line) (point))) + (delete-region (point) (line-beginning-position 2)) (cond ((not file) nil) ((not (file-readable-p file)) @@ -3262,10 +3338,8 @@ storing and resolving footnotes. It is created automatically." (cond ((eq env 'literal) (insert - (let ((ind-str (make-string ind ? )) - (arg-str (if (stringp src-args) - (format " %s" src-args) - "")) + (let ((ind-str (make-string ind ?\s)) + (arg-str (if (stringp args) (format " %s" args) "")) (contents (org-escape-code-in-string (org-export--prepare-file-contents file lines)))) @@ -3273,7 +3347,7 @@ storing and resolving footnotes. It is created automatically." ind-str block arg-str contents ind-str block)))) ((stringp block) (insert - (let ((ind-str (make-string ind ? )) + (let ((ind-str (make-string ind ?\s)) (contents (org-export--prepare-file-contents file lines))) (format "%s#+BEGIN_%s\n%s%s#+END_%s\n" @@ -3292,7 +3366,7 @@ storing and resolving footnotes. It is created automatically." (org-export--prepare-file-contents file lines ind minlevel (or (gethash file file-prefix) - (puthash file (incf current-prefix) file-prefix)) + (puthash file (cl-incf current-prefix) file-prefix)) footnotes))) (org-export-expand-include-keyword (cons (list file lines) included) @@ -3304,7 +3378,7 @@ storing and resolving footnotes. It is created automatically." (unless included (org-with-wide-buffer (goto-char (point-max)) - (maphash (lambda (k v) (insert (format "\n[%s] %s\n" k v))) + (maphash (lambda (k v) (insert (format "\n[fn:%s] %s\n" k v))) footnotes))))))))))) (defun org-export--inclusion-absolute-lines (file location only-contents lines) @@ -3338,7 +3412,7 @@ Return a string of lines to be included in the format expected by (memq (org-element-type element) '(headline inlinetask))) ;; Skip planning line and property-drawer. (goto-char (point-min)) - (when (org-looking-at-p org-planning-line-re) (forward-line)) + (when (looking-at-p org-planning-line-re) (forward-line)) (when (looking-at org-property-drawer-re) (goto-char (match-end 0))) (unless (bolp) (forward-line)) (narrow-to-region (point) (point-max)))) @@ -3366,7 +3440,7 @@ Return a string of lines to be included in the format expected by (save-excursion (+ start-line (let ((counter 0)) - (while (< (point) end) (incf counter) (forward-line)) + (while (< (point) end) (cl-incf counter) (forward-line)) counter)))))))) (defun org-export--prepare-file-contents @@ -3425,7 +3499,7 @@ the included document." (unless (eq major-mode 'org-mode) (let ((org-inhibit-startup t)) (org-mode))) (goto-char (point-min)) - (let ((ind-str (make-string ind ? ))) + (let ((ind-str (make-string ind ?\s))) (while (not (or (eobp) (looking-at org-outline-regexp-bol))) ;; Do not move footnote definitions out of column 0. (unless (and (looking-at org-footnote-definition-re) @@ -3461,17 +3535,14 @@ the included document." (marker-max (point-max-marker)) (get-new-label (lambda (label) - ;; Generate new label from LABEL. If LABEL is akin to - ;; [1] convert it to [fn:--ID-1]. Otherwise add "-ID-" - ;; after "fn:". - (if (org-string-match-p "\\`[0-9]+\\'" label) - (format "fn:--%d-%s" id label) - (format "fn:-%d-%s" id (substring label 3))))) + ;; Generate new label from LABEL by prefixing it with + ;; "-ID-". + (format "-%d-%s" id label))) (set-new-label (lambda (f old new) ;; Replace OLD label with NEW in footnote F. (save-excursion - (goto-char (1+ (org-element-property :begin f))) + (goto-char (+ (org-element-property :begin f) 4)) (looking-at (regexp-quote old)) (replace-match new)))) (seen-alist)) @@ -3507,14 +3578,6 @@ the included document." (set-marker marker-max nil))) (org-element-normalize-string (buffer-string)))) -(defun org-export-execute-babel-code () - "Execute every Babel code in the visible part of current buffer." - ;; Get a pristine copy of current buffer so Babel references can be - ;; properly resolved. - (let ((reference (org-export-copy-buffer))) - (unwind-protect (org-babel-exp-process-buffer reference) - (kill-buffer reference)))) - (defun org-export--copy-to-kill-ring-p () "Return a non-nil value when output should be added to the kill ring. See also `org-export-copy-to-kill-ring'." @@ -3666,16 +3729,28 @@ definition can be found, raise an error." (let ((hash (make-hash-table :test #'equal))) (plist-put info :footnote-definition-cache hash) hash)))) - (or (gethash label cache) - (puthash label - (org-element-map (plist-get info :parse-tree) - '(footnote-definition footnote-reference) - (lambda (f) - (and (equal (org-element-property :label f) label) - (org-element-contents f))) - info t) - cache) - (error "Definition not found for footnote %s" label)))))) + (or + (gethash label cache) + (puthash label + (org-element-map (plist-get info :parse-tree) + '(footnote-definition footnote-reference) + (lambda (f) + (cond + ;; Skip any footnote with a different label. + ;; Also skip any standard footnote reference + ;; with the same label since those cannot + ;; contain a definition. + ((not (equal (org-element-property :label f) label)) nil) + ((eq (org-element-property :type f) 'standard) nil) + ((org-element-contents f)) + ;; Even if the contents are empty, we can not + ;; return nil since that would eventually raise + ;; the error. Instead, return the equivalent + ;; empty string. + (t ""))) + info t) + cache) + (error "Definition not found for footnote %s" label)))))) (defun org-export--footnote-reference-map (function data info &optional body-first) @@ -3684,41 +3759,41 @@ INFO is a plist containing export state. By default, as soon as a new footnote reference is encountered, FUNCTION is called onto its definition. However, if BODY-FIRST is non-nil, this step is delayed until the end of the process." - (let* ((definitions) - (seen-refs) - (search-ref) ; For byte-compiler. - (search-ref - (lambda (data delayp) - ;; Search footnote references through DATA, filling - ;; SEEN-REFS along the way. When DELAYP is non-nil, store - ;; footnote definitions so they can be entered later. - (org-element-map data 'footnote-reference - (lambda (f) - (funcall function f) - (let ((--label (org-element-property :label f))) - (unless (and --label (member --label seen-refs)) - (when --label (push --label seen-refs)) - ;; Search for subsequent references in footnote - ;; definition so numbering follows reading logic, - ;; unless DELAYP in non-nil. - (cond - (delayp - (push (org-export-get-footnote-definition f info) - definitions)) - ;; Do not force entering inline definitions, - ;; since `org-element-map' already traverses them - ;; at the right time. - ((eq (org-element-property :type f) 'inline)) - (t (funcall search-ref - (org-export-get-footnote-definition f info) - nil)))))) - info nil - ;; Don't enter footnote definitions since it will happen - ;; when their first reference is found. Moreover, if - ;; DELAYP is non-nil, make sure we postpone entering - ;; definitions of inline references. - (if delayp '(footnote-definition footnote-reference) - 'footnote-definition))))) + (letrec ((definitions nil) + (seen-refs nil) + (search-ref + (lambda (data delayp) + ;; Search footnote references through DATA, filling + ;; SEEN-REFS along the way. When DELAYP is non-nil, + ;; store footnote definitions so they can be entered + ;; later. + (org-element-map data 'footnote-reference + (lambda (f) + (funcall function f) + (let ((--label (org-element-property :label f))) + (unless (and --label (member --label seen-refs)) + (when --label (push --label seen-refs)) + ;; Search for subsequent references in footnote + ;; definition so numbering follows reading + ;; logic, unless DELAYP in non-nil. + (cond + (delayp + (push (org-export-get-footnote-definition f info) + definitions)) + ;; Do not force entering inline definitions, + ;; since `org-element-map' already traverses + ;; them at the right time. + ((eq (org-element-property :type f) 'inline)) + (t (funcall search-ref + (org-export-get-footnote-definition f info) + nil)))))) + info nil + ;; Don't enter footnote definitions since it will + ;; happen when their first reference is found. + ;; Moreover, if DELAYP is non-nil, make sure we + ;; postpone entering definitions of inline references. + (if delayp '(footnote-definition footnote-reference) + 'footnote-definition))))) (funcall search-ref data body-first) (funcall search-ref (nreverse definitions) nil))) @@ -3744,7 +3819,7 @@ for inlined footnotes. Unreferenced definitions are ignored." ;; Collect footnote number, label and definition. (let ((l (org-element-property :label f))) (unless (and l (member l labels)) - (incf n) + (cl-incf n) (push (list n l (org-export-get-footnote-definition f info)) alist)) (when l (push l labels)))) (or data (plist-get info :parse-tree)) info body-first) @@ -3803,8 +3878,8 @@ process, leading to a different order when footnotes are nested." ((and label l (string= label l)) (throw 'exit (1+ count))) ;; Otherwise store label and increase counter if label ;; wasn't encountered yet. - ((not l) (incf count)) - ((not (member l seen)) (push l seen) (incf count))))) + ((not l) (cl-incf count)) + ((not (member l seen)) (push l seen) (cl-incf count))))) (or data (plist-get info :parse-tree)) info body-first)))) @@ -3861,7 +3936,7 @@ INFO is a plist holding contextual information." (defun org-export-numbered-headline-p (headline info) "Return a non-nil value if HEADLINE element should be numbered. INFO is a plist used as a communication channel." - (unless (org-some + (unless (cl-some (lambda (head) (org-not-nil (org-element-property :UNNUMBERED head))) (org-element-lineage headline nil t)) (let ((sec-num (plist-get info :section-numbers)) @@ -3890,18 +3965,13 @@ INFO is a plist used as a communication channel." ELEMENT has either an `headline' or an `inlinetask' type. INFO is a plist used as a communication channel. -Select tags (see `org-export-select-tags') and exclude tags (see -`org-export-exclude-tags') are removed from the list. - When non-nil, optional argument TAGS should be a list of strings. Any tag belonging to this list will also be removed. When optional argument INHERITED is non-nil, tags can also be inherited from parent headlines and FILETAGS keywords." - (org-remove-if - (lambda (tag) (or (member tag (plist-get info :select-tags)) - (member tag (plist-get info :exclude-tags)) - (member tag tags))) + (cl-remove-if + (lambda (tag) (member tag tags)) (if (not inherited) (org-element-property :tags element) ;; Build complete list of inherited tags. (let ((current-tag-list (org-element-property :tags element))) @@ -3926,7 +3996,7 @@ Return value is a string or nil." (let ((headline (if (eq (org-element-type blob) 'headline) blob (org-export-get-parent-headline blob)))) (if (not inherited) (org-element-property property blob) - (let ((parent headline) value) + (let ((parent headline)) (catch 'found (while parent (when (plist-member (nth 1 parent) property) @@ -3951,10 +4021,9 @@ fail, the fall-back value is \"???\"." (and file (file-name-sans-extension (file-name-nondirectory file)))) "???")) -(defun org-export-get-alt-title (headline info) +(defun org-export-get-alt-title (headline _) "Return alternative title for HEADLINE, as a secondary string. -INFO is a plist used as a communication channel. If no optional -title is defined, fall-back to the regular title." +If no optional title is defined, fall-back to the regular title." (let ((alt (org-element-property :ALT_TITLE headline))) (if alt (org-element-parse-secondary-string alt (org-element-restriction 'headline) headline) @@ -4004,7 +4073,7 @@ meant to be translated with `org-export-data' or alike." ;;;; For Links ;; ;; `org-export-custom-protocol-maybe' handles custom protocol defined -;; with `org-add-link-type', which see. +;; in `org-link-parameters'. ;; ;; `org-export-get-coderef-format' returns an appropriate format ;; string for coderefs. @@ -4014,11 +4083,11 @@ meant to be translated with `org-export-data' or alike." ;; ;; `org-export-resolve-fuzzy-link' searches destination of fuzzy links ;; (i.e. links with "fuzzy" as type) within the parsed tree, and -;; returns an appropriate unique identifier when found, or nil. +;; returns an appropriate unique identifier. ;; ;; `org-export-resolve-id-link' returns the first headline with ;; specified id or custom-id in parse tree, the path to the external -;; file with the id or nil when neither was found. +;; file with the id. ;; ;; `org-export-resolve-coderef' associates a reference to a line ;; number in the element it belongs, or returns the reference itself @@ -4026,6 +4095,12 @@ meant to be translated with `org-export-data' or alike." ;; ;; `org-export-file-uri' expands a filename as stored in :path value ;; of a "file" link into a file URI. +;; +;; Broken links raise a `org-link-broken' error, which is caught by +;; `org-export-data' for further processing, depending on +;; `org-export-with-broken-links' value. + +(org-define-error 'org-link-broken "Unable to resolve link; aborting") (defun org-export-custom-protocol-maybe (link desc backend) "Try exporting LINK with a dedicated function. @@ -4041,7 +4116,7 @@ The function ignores links with an implicit type (e.g., (let ((type (org-element-property :type link))) (unless (or (member type '("coderef" "custom-id" "fuzzy" "radio")) (not backend)) - (let ((protocol (nth 2 (assoc type org-link-protocols)))) + (let ((protocol (org-link-get-parameter type :export))) (and (functionp protocol) (funcall protocol (org-link-unescape (org-element-property :path link)) @@ -4076,8 +4151,8 @@ This only applies to links without a description." (catch 'exit (dolist (rule (or rules org-export-default-inline-image-rule)) (and (string= (org-element-property :type link) (car rule)) - (org-string-match-p (cdr rule) - (org-element-property :path link)) + (string-match-p (cdr rule) + (org-element-property :path link)) (throw 'exit t))))))) (defun org-export-resolve-coderef (ref info) @@ -4103,11 +4178,69 @@ error if no block contains REF." (when (re-search-backward ref-re nil t) (cond ((org-element-property :use-labels el) ref) - ((eq (org-element-property :number-lines el) 'continued) - (+ (org-export-get-loc el info) (line-number-at-pos))) - (t (line-number-at-pos))))))) + (t (+ (or (org-export-get-loc el info) 0) (line-number-at-pos)))))))) info 'first-match) - (user-error "Unable to resolve code reference: %s" ref))) + (signal 'org-link-broken (list ref)))) + +(defun org-export-search-cells (datum) + "List search cells for element or object DATUM. + +A search cell follows the pattern (TYPE . SEARCH) where + + TYPE is a symbol among `headline', `custom-id', `target' and + `other'. + + SEARCH is the string a link is expected to match. More + accurately, it is + + - headline's title, as a list of strings, if TYPE is + `headline'. + + - CUSTOM_ID value, as a string, if TYPE is `custom-id'. + + - target's or radio-target's name as a list of strings if + TYPE is `target'. + + - NAME affiliated keyword is TYPE is `other'. + +A search cell is the internal representation of a fuzzy link. It +ignores white spaces and statistics cookies, if applicable." + (pcase (org-element-type datum) + (`headline + (let ((title (split-string + (replace-regexp-in-string + "\\[[0-9]*\\(?:%\\|/[0-9]*\\)\\]" "" + (org-element-property :raw-value datum))))) + (delq nil + (list + (cons 'headline title) + (cons 'other title) + (let ((custom-id (org-element-property :custom-id datum))) + (and custom-id (cons 'custom-id custom-id))))))) + (`target + (list (cons 'target (split-string (org-element-property :value datum))))) + ((and (let name (org-element-property :name datum)) + (guard name)) + (list (cons 'other (split-string name)))) + (_ nil))) + +(defun org-export-string-to-search-cell (s) + "Return search cells associated to string S. +S is either the path of a fuzzy link or a search option, i.e., it +tries to match either a headline (through custom ID or title), +a target or a named element." + (pcase (string-to-char s) + (?* (list (cons 'headline (split-string (substring s 1))))) + (?# (list (cons 'custom-id (substring s 1)))) + ((let search (split-string s)) + (list (cons 'target search) (cons 'other search))))) + +(defun org-export-match-search-cell-p (datum cells) + "Non-nil when DATUM matches search cells CELLS. +DATUM is an element or object. CELLS is a list of search cells, +as returned by `org-export-search-cells'." + (let ((targets (org-export-search-cells datum))) + (and targets (cl-some (lambda (cell) (member cell targets)) cells)))) (defun org-export-resolve-fuzzy-link (link info) "Return LINK destination. @@ -4128,54 +4261,37 @@ Return value can be an object or an element: Assume LINK type is \"fuzzy\". White spaces are not significant." - (let* ((raw-path (org-link-unescape (org-element-property :path link))) - (headline-only (eq (string-to-char raw-path) ?*)) - ;; Split PATH at white spaces so matches are space - ;; insensitive. - (path (org-split-string - (if headline-only (substring raw-path 1) raw-path))) + (let* ((search-cells (org-export-string-to-search-cell + (org-link-unescape (org-element-property :path link)))) (link-cache (or (plist-get info :resolve-fuzzy-link-cache) (plist-get (plist-put info :resolve-fuzzy-link-cache (make-hash-table :test #'equal)) :resolve-fuzzy-link-cache))) - (cached (gethash path link-cache 'not-found))) + (cached (gethash search-cells link-cache 'not-found))) (if (not (eq cached 'not-found)) cached - (let ((ast (plist-get info :parse-tree))) + (let ((matches + (org-element-map (plist-get info :parse-tree) + (cons 'target org-element-all-elements) + (lambda (datum) + (and (org-export-match-search-cell-p datum search-cells) + datum))))) + (unless matches + (signal 'org-link-broken + (list (org-element-property :raw-path link)))) (puthash - path - (cond - ;; First try to find a matching "<<path>>" unless user - ;; specified he was looking for a headline (path starts with - ;; a "*" character). - ((and (not headline-only) - (org-element-map ast 'target - (lambda (datum) - (and (equal (org-split-string - (org-element-property :value datum)) - path) - datum)) - info 'first-match))) - ;; Then try to find an element with a matching "#+NAME: path" - ;; affiliated keyword. - ((and (not headline-only) - (org-element-map ast org-element-all-elements - (lambda (datum) - (let ((name (org-element-property :name datum))) - (and name (equal (org-split-string name) path) datum))) - info 'first-match))) - ;; Try to find a matching headline. - ((org-element-map ast 'headline - (lambda (h) - (and (equal (org-split-string - (replace-regexp-in-string - "\\[[0-9]+%\\]\\|\\[[0-9]+/[0-9]+\\]" "" - (org-element-property :raw-value h))) - path) - h)) - info 'first-match)) - (t (user-error "Unable to resolve link \"%s\"" raw-path))) + search-cells + ;; There can be multiple matches for un-typed searches, i.e., + ;; for searches not starting with # or *. In this case, + ;; prioritize targets and names over headline titles. + ;; Matching both a name and a target is not valid, and + ;; therefore undefined. + (or (cl-some (lambda (datum) + (and (not (eq (org-element-type datum) 'headline)) + datum)) + matches) + (car matches)) link-cache))))) (defun org-export-resolve-id-link (link info) @@ -4196,7 +4312,7 @@ tree or a file name. Assume LINK type is either \"id\" or info 'first-match) ;; Otherwise, look for external files. (cdr (assoc id (plist-get info :id-alist))) - (user-error "Unable to resolve ID \"%s\"" id)))) + (signal 'org-link-broken (list id))))) (defun org-export-resolve-radio-link (link info) "Return radio-target object referenced as LINK destination. @@ -4219,7 +4335,7 @@ has type \"radio\"." (defun org-export-file-uri (filename) "Return file URI associated to FILENAME." - (cond ((org-string-match-p "\\`//" filename) (concat "file:" filename)) + (cond ((string-match-p "\\`//" filename) (concat "file:" filename)) ((not (file-name-absolute-p filename)) filename) ((org-file-remote-p filename) (concat "file:/" filename)) (t (concat "file://" (expand-file-name filename))))) @@ -4228,29 +4344,63 @@ has type \"radio\"." ;;;; For References ;; ;; `org-export-get-reference' associate a unique reference for any -;; object or element. +;; object or element. It uses `org-export-new-reference' and +;; `org-export-format-reference' to, respectively, generate new +;; internal references and turn them into a string suitable for +;; output. ;; ;; `org-export-get-ordinal' associates a sequence number to any object ;; or element. +(defun org-export-new-reference (references) + "Return a unique reference, among REFERENCES. +REFERENCES is an alist whose values are in-use references, as +numbers. Returns a number, which is the internal representation +of a reference. See also `org-export-format-reference'." + ;; Generate random 7 digits hexadecimal numbers. Collisions + ;; increase exponentially with the numbers of references. However, + ;; the odds for encountering at least one collision with 1000 active + ;; references in the same document are roughly 0.2%, so this + ;; shouldn't be the bottleneck. + (let ((new (random #x10000000))) + (while (rassq new references) (setq new (random #x10000000))) + new)) + +(defun org-export-format-reference (reference) + "Format REFERENCE into a string. +REFERENCE is a number representing a reference, as returned by +`org-export-new-reference', which see." + (format "org%07x" reference)) + (defun org-export-get-reference (datum info) "Return a unique reference for DATUM, as a string. + DATUM is either an element or an object. INFO is the current -export state, as a plist. Returned reference consists of -alphanumeric characters only." - (let ((type (org-element-type datum)) - (cache (or (plist-get info :internal-references) - (let ((h (make-hash-table :test #'eq))) - (plist-put info :internal-references h) - h)))) - (or (gethash datum cache) - (puthash datum - (format "org%s%d" - (if type - (replace-regexp-in-string "-" "" (symbol-name type)) - "secondarystring") - (incf (gethash type cache 0))) - cache)))) +export state, as a plist. + +This function checks `:crossrefs' property in INFO for search +cells matching DATUM before creating a new reference. Returned +reference consists of alphanumeric characters only." + (let ((cache (plist-get info :internal-references))) + (or (car (rassq datum cache)) + (let* ((crossrefs (plist-get info :crossrefs)) + (cells (org-export-search-cells datum)) + ;; If any other published document relies on an + ;; association between a search cell and a reference, + ;; make sure to preserve it. See + ;; `org-publish-resolve-external-link' for details. + (new (or (cdr (cl-some (lambda (c) (assoc c crossrefs)) cells)) + (org-export-new-reference cache))) + (reference-string (org-export-format-reference new))) + ;; Cache contains both data already associated to + ;; a reference and in-use internal references, so as to make + ;; unique references. + (dolist (cell cells) (push (cons cell new) cache)) + ;; Keep an associated related to DATUM as not every object + ;; and element can be associated to a search cell. + (push (cons reference-string datum) cache) + (plist-put info :internal-references cache) + reference-string)))) (defun org-export-get-ordinal (element info &optional types predicate) "Return ordinal number of an element or object. @@ -4282,7 +4432,7 @@ objects of the same type." (org-element-lineage element '(footnote-definition footnote-reference headline item table)))) - (case (org-element-type element) + (cl-case (org-element-type element) ;; Special case 1: A headline returns its number as a list. (headline (org-export-get-headline-number element info)) ;; Special case 2: An item returns its number as a list. @@ -4302,8 +4452,8 @@ objects of the same type." (lambda (el) (cond ((eq element el) (1+ counter)) - ((not predicate) (incf counter) nil) - ((funcall predicate el info) (incf counter) nil))) + ((not predicate) (cl-incf counter) nil) + ((funcall predicate el info) (cl-incf counter) nil))) info 'first-match))))) @@ -4330,32 +4480,34 @@ objects of the same type." ;; code in a format suitable for plain text or verbatim output. (defun org-export-get-loc (element info) - "Return accumulated lines of code up to ELEMENT. - -INFO is the plist used as a communication channel. - -ELEMENT is excluded from count." - (let ((loc 0)) - (org-element-map (plist-get info :parse-tree) - `(src-block example-block ,(org-element-type element)) - (lambda (el) - (cond - ;; ELEMENT is reached: Quit the loop. - ((eq el element)) - ;; Only count lines from src-block and example-block elements - ;; with a "+n" or "-n" switch. A "-n" switch resets counter. - ((not (memq (org-element-type el) '(src-block example-block))) nil) - ((let ((linums (org-element-property :number-lines el))) - (when linums - ;; Accumulate locs or reset them. - (let ((lines (org-count-lines - (org-trim (org-element-property :value el))))) - (setq loc (if (eq linums 'new) lines (+ loc lines)))))) - ;; Return nil to stay in the loop. - nil))) - info 'first-match) - ;; Return value. - loc)) + "Return count of lines of code before ELEMENT. + +ELEMENT is an example-block or src-block element. INFO is the +plist used as a communication channel. + +Count includes every line of code in example-block or src-block +with a \"+n\" or \"-n\" switch before block. Return nil if +ELEMENT doesn't allow line numbering." + (pcase (org-element-property :number-lines element) + (`(new . ,n) n) + (`(continued . ,n) + (let ((loc 0)) + (org-element-map (plist-get info :parse-tree) '(src-block example-block) + (lambda (el) + ;; ELEMENT is reached: Quit loop and return locs. + (if (eq el element) (+ loc n) + ;; Only count lines from src-block and example-block + ;; elements with a "+n" or "-n" switch. + (let ((linum (org-element-property :number-lines el))) + (when linum + (let ((lines (org-count-lines + (org-trim (org-element-property :value el))))) + ;; Accumulate locs or reset them. + (pcase linum + (`(new . ,n) (setq loc (+ n lines))) + (`(continued . ,n) (cl-incf loc (+ n lines))))))) + nil)) ;Return nil to stay in the loop. + info 'first-match))))) (defun org-export-unravel-code (element) "Clean source code and extract references out of it. @@ -4377,24 +4529,17 @@ reference on that line (string)." (if (or org-src-preserve-indentation (org-element-property :preserve-indent element)) value - (org-element-remove-indentation value))))) - ;; Get format used for references. - (label-fmt (regexp-quote - (or (org-element-property :label-fmt element) - org-coderef-label-format))) + (org-remove-indentation value))))) ;; Build a regexp matching a loc with a reference. - (with-ref-re - (format "^.*?\\S-.*?\\([ \t]*\\(%s\\)[ \t]*\\)$" - (replace-regexp-in-string - "%s" "\\([-a-zA-Z0-9_ ]+\\)" label-fmt nil t)))) + (ref-re (org-src-coderef-regexp (org-src-coderef-format element)))) ;; Return value. (cons ;; Code with references removed. (org-element-normalize-string (mapconcat (lambda (loc) - (incf line) - (if (not (string-match with-ref-re loc)) loc + (cl-incf line) + (if (not (string-match ref-re loc)) loc ;; Ref line: remove ref, and signal its position in REFS. (push (cons line (match-string 3 loc)) refs) (replace-match "" nil nil loc 1))) @@ -4426,7 +4571,7 @@ be nil. It can be obtained through the use of (org-element-normalize-string (mapconcat (lambda (--loc) - (incf --line) + (cl-incf --line) (let ((--ref (cdr (assq --line ref-alist)))) (funcall fun --loc (and num-lines (+ num-lines --line)) --ref))) --locs "\n")))) @@ -4451,9 +4596,7 @@ code." (let* ((refs (and (org-element-property :retain-labels element) (cdr code-info))) ;; Handle line numbering. - (num-start (case (org-element-property :number-lines element) - (continued (org-export-get-loc element info)) - (new 0))) + (num-start (org-export-get-loc element info)) (num-fmt (and num-start (format "%%%ds " @@ -4517,16 +4660,14 @@ All special columns will be ignored during export." ;; only empty cells as special. (let ((special-column-p 'empty)) (catch 'exit - (mapc - (lambda (row) - (when (eq (org-element-property :type row) 'standard) - (let ((value (org-element-contents - (car (org-element-contents row))))) - (cond ((member value '(("/") ("#") ("!") ("$") ("*") ("_") ("^"))) - (setq special-column-p 'special)) - ((not value)) - (t (throw 'exit nil)))))) - (org-element-contents table)) + (dolist (row (org-element-contents table)) + (when (eq (org-element-property :type row) 'standard) + (let ((value (org-element-contents + (car (org-element-contents row))))) + (cond ((member value '(("/") ("#") ("!") ("$") ("*") ("_") ("^"))) + (setq special-column-p 'special)) + ((not value)) + (t (throw 'exit nil)))))) (eq special-column-p 'special)))) (defun org-export-table-has-header-p (table info) @@ -4549,18 +4690,15 @@ A table has a header when it contains at least two row groups." (cond ((> rowgroup 1) t) ((and row-flag (eq (org-element-property :type row) 'rule)) - (incf rowgroup) (setq row-flag nil)) + (cl-incf rowgroup) (setq row-flag nil)) ((and (not row-flag) (eq (org-element-property :type row) 'standard)) (setq row-flag t) nil))) info 'first-match) cache))))) -(defun org-export-table-row-is-special-p (table-row info) +(defun org-export-table-row-is-special-p (table-row _) "Non-nil if TABLE-ROW is considered special. - -INFO is a plist used as the communication channel. - All special rows will be ignored during export." (when (eq (org-element-property :type table-row) 'standard) (let ((first-cell (org-element-contents @@ -4577,19 +4715,17 @@ All special rows will be ignored during export." ;; ... it contains only alignment cookies and empty cells. (let ((special-row-p 'empty)) (catch 'exit - (mapc - (lambda (cell) - (let ((value (org-element-contents cell))) - ;; Since VALUE is a secondary string, the following - ;; checks avoid expanding it with `org-export-data'. - (cond ((not value)) - ((and (not (cdr value)) - (stringp (car value)) - (string-match "\\`<[lrc]?\\([0-9]+\\)?>\\'" - (car value))) - (setq special-row-p 'cookie)) - (t (throw 'exit nil))))) - (org-element-contents table-row)) + (dolist (cell (org-element-contents table-row)) + (let ((value (org-element-contents cell))) + ;; Since VALUE is a secondary string, the following + ;; checks avoid expanding it with `org-export-data'. + (cond ((not value)) + ((and (not (cdr value)) + (stringp (car value)) + (string-match "\\`<[lrc]?\\([0-9]+\\)?>\\'" + (car value))) + (setq special-row-p 'cookie)) + (t (throw 'exit nil))))) (eq special-row-p 'cookie))))))) (defun org-export-table-row-group (table-row info) @@ -4612,7 +4748,7 @@ header." (lambda (row) (if (eq (org-element-property :type row) 'rule) (setq row-flag nil) - (unless row-flag (incf group) (setq row-flag t))) + (unless row-flag (cl-incf group) (setq row-flag t))) (when (eq table-row row) (puthash table-row group cache))) info 'first-match)))))) @@ -4712,14 +4848,14 @@ Possible values are `left', `right' and `center'." (org-element-contents (elt (org-element-contents row) column)) info))) - (incf total-cells) + (cl-incf total-cells) ;; Treat an empty cell as a number if it follows ;; a number. (if (not (or (string-match org-table-number-regexp value) (and (string= value "") previous-cell-number-p))) (setq previous-cell-number-p nil) (setq previous-cell-number-p t) - (incf number-cells)))))) + (cl-incf number-cells)))))) ;; Return value. Alignment specified by cookies has ;; precedence over alignment deduced from cell's contents. (aset align-vector @@ -4752,14 +4888,13 @@ Returned borders ignore special rows." ;; another regular row has to be found above that rule. (let (rule-flag) (catch 'exit - (mapc (lambda (row) - (cond ((eq (org-element-property :type row) 'rule) - (setq rule-flag t)) - ((not (org-export-table-row-is-special-p row info)) - (if rule-flag (throw 'exit (push 'above borders)) - (throw 'exit nil))))) - ;; Look at every row before the current one. - (cdr (memq row (reverse (org-element-contents table))))) + ;; Look at every row before the current one. + (dolist (row (cdr (memq row (reverse (org-element-contents table))))) + (cond ((eq (org-element-property :type row) 'rule) + (setq rule-flag t)) + ((not (org-export-table-row-is-special-p row info)) + (if rule-flag (throw 'exit (push 'above borders)) + (throw 'exit nil))))) ;; No rule above, or rule found starts the table (ignoring any ;; special row): TABLE-CELL is at the top of the table. (when rule-flag (push 'above borders)) @@ -4768,14 +4903,13 @@ Returned borders ignore special rows." ;; non-regular row below is a rule. (let (rule-flag) (catch 'exit - (mapc (lambda (row) - (cond ((eq (org-element-property :type row) 'rule) - (setq rule-flag t)) - ((not (org-export-table-row-is-special-p row info)) - (if rule-flag (throw 'exit (push 'below borders)) - (throw 'exit nil))))) - ;; Look at every row after the current one. - (cdr (memq row (org-element-contents table)))) + ;; Look at every row after the current one. + (dolist (row (cdr (memq row (org-element-contents table)))) + (cond ((eq (org-element-property :type row) 'rule) + (setq rule-flag t)) + ((not (org-export-table-row-is-special-p row info)) + (if rule-flag (throw 'exit (push 'below borders)) + (throw 'exit nil))))) ;; No rule below, or rule found ends the table (modulo some ;; special row): TABLE-CELL is at the bottom of the table. (when rule-flag (push 'below borders)) @@ -4787,37 +4921,35 @@ Returned borders ignore special rows." (catch 'exit (let ((column (let ((cells (org-element-contents row))) (- (length cells) (length (memq table-cell cells)))))) - (mapc - (lambda (row) - (unless (eq (org-element-property :type row) 'rule) - (when (equal (org-element-contents - (car (org-element-contents row))) - '("/")) - (let ((column-groups - (mapcar - (lambda (cell) - (let ((value (org-element-contents cell))) - (when (member value '(("<") ("<>") (">") nil)) - (car value)))) - (org-element-contents row)))) - ;; There's a left border when previous cell, if - ;; any, ends a group, or current one starts one. - (when (or (and (not (zerop column)) - (member (elt column-groups (1- column)) - '(">" "<>"))) - (member (elt column-groups column) '("<" "<>"))) - (push 'left borders)) - ;; There's a right border when next cell, if any, - ;; starts a group, or current one ends one. - (when (or (and (/= (1+ column) (length column-groups)) - (member (elt column-groups (1+ column)) - '("<" "<>"))) - (member (elt column-groups column) '(">" "<>"))) - (push 'right borders)) - (throw 'exit nil))))) - ;; Table rows are read in reverse order so last column groups - ;; row has precedence over any previous one. - (reverse (org-element-contents table))))) + ;; Table rows are read in reverse order so last column groups + ;; row has precedence over any previous one. + (dolist (row (reverse (org-element-contents table))) + (unless (eq (org-element-property :type row) 'rule) + (when (equal (org-element-contents + (car (org-element-contents row))) + '("/")) + (let ((column-groups + (mapcar + (lambda (cell) + (let ((value (org-element-contents cell))) + (when (member value '(("<") ("<>") (">") nil)) + (car value)))) + (org-element-contents row)))) + ;; There's a left border when previous cell, if + ;; any, ends a group, or current one starts one. + (when (or (and (not (zerop column)) + (member (elt column-groups (1- column)) + '(">" "<>"))) + (member (elt column-groups column) '("<" "<>"))) + (push 'left borders)) + ;; There's a right border when next cell, if any, + ;; starts a group, or current one ends one. + (when (or (and (/= (1+ column) (length column-groups)) + (member (elt column-groups (1+ column)) + '("<" "<>"))) + (member (elt column-groups column) '(">" "<>"))) + (push 'right borders)) + (throw 'exit nil))))))) ;; Return value. borders)) @@ -4892,7 +5024,7 @@ special columns and separators." (lambda (row) (cond ((eq row table-row) number) ((eq (org-element-property :type row) 'standard) - (incf number) nil))) + (cl-incf number) nil))) info 'first-match)))) (defun org-export-table-dimensions (table info) @@ -4908,10 +5040,10 @@ rows (resp. columns)." (org-element-map table 'table-row (lambda (row) (when (eq (org-element-property :type row) 'standard) - (incf rows) + (cl-incf rows) (unless first-row (setq first-row row)))) info) ;; Set number of columns. - (org-element-map first-row 'table-cell (lambda (cell) (incf columns)) info) + (org-element-map first-row 'table-cell (lambda (_) (cl-incf columns)) info) ;; Return value. (cons rows columns))) @@ -4931,7 +5063,7 @@ function returns nil for other cells." (let ((col-count 0)) (org-element-map table-row 'table-cell (lambda (cell) - (if (eq cell table-cell) col-count (incf col-count) nil)) + (if (eq cell table-cell) col-count (cl-incf col-count) nil)) info 'first-match)))))) (defun org-export-get-table-cell-at (address table info) @@ -4951,12 +5083,12 @@ return nil." (lambda (row) (cond ((eq (org-element-property :type row) 'rule) nil) ((= row-count row-pos) row) - (t (incf row-count) nil))) + (t (cl-incf row-count) nil))) info 'first-match)) 'table-cell (lambda (cell) (if (= column-count column-pos) cell - (incf column-count) nil)) + (cl-incf column-count) nil)) info 'first-match))) @@ -5064,10 +5196,6 @@ Return a list of src-block elements with a caption." ;; ;; Dictionary for smart quotes is stored in ;; `org-export-smart-quotes-alist'. -;; -;; Internally, regexps matching potential smart quotes (checks at -;; string boundaries are also necessary) are defined in -;; `org-export-smart-quotes-regexps'. (defconst org-export-smart-quotes-alist '(("da" @@ -5122,6 +5250,16 @@ Return a list of src-block elements with a caption." (secondary-closing :utf-8 " »" :html " »" :latex "\\fg{}" :texinfo "@tie{}@guillemetright{}") (apostrophe :utf-8 "’" :html "’")) + ("is" + (primary-opening + :utf-8 "„" :html "„" :latex "\"`" :texinfo "@quotedblbase{}") + (primary-closing + :utf-8 "“" :html "“" :latex "\"'" :texinfo "@quotedblleft{}") + (secondary-opening + :utf-8 "‚" :html "‚" :latex "\\glq{}" :texinfo "@quotesinglbase{}") + (secondary-closing + :utf-8 "‘" :html "‘" :latex "\\grq{}" :texinfo "@quoteleft{}") + (apostrophe :utf-8 "’" :html "’")) ("no" ;; https://nn.wikipedia.org/wiki/Sitatteikn (primary-opening @@ -5200,7 +5338,11 @@ INFO is the current export state, as a plist." (value (gethash parent cache 'missing-data))) (if (not (eq value 'missing-data)) (cdr (assq s value)) (let (level1-open full-status) - (org-element-map parent 'plain-text + (org-element-map + (let ((secondary (org-element-secondary-p s))) + (if secondary (org-element-property secondary parent) + (org-element-contents parent))) + 'plain-text (lambda (text) (let ((start 0) current-status) (while (setq start (string-match "['\"]" text start)) @@ -5223,7 +5365,7 @@ INFO is the current export state, as a plist." (let ((p (org-export-get-previous-element text info))) (cond ((not p) nil) - ((stringp p) (substring p (1- (length p)))) + ((stringp p) (substring p -1)) ((memq (org-element-property :post-blank p) '(0 nil)) 'no-blank) @@ -5257,7 +5399,7 @@ INFO is the current export state, as a plist." (allow-close 'secondary-closing) (t 'apostrophe))))) current-status) - (setq start (1+ start))) + (cl-incf start)) (when current-status (push (cons text (nreverse current-status)) full-status)))) info nil org-element-recursive-objects) @@ -5303,9 +5445,6 @@ Return the new string." ;; defsubst org-export-get-parent must be defined before first use -(define-obsolete-function-alias - 'org-export-get-genealogy 'org-element-lineage "25.1") - (defun org-export-get-parent-headline (blob) "Return BLOB parent headline or nil. BLOB is the element or object being considered." @@ -5344,7 +5483,7 @@ all of them." ((null n) (throw 'exit obj)) ((not (wholenump n)) (push obj prev)) ((zerop n) (throw 'exit prev)) - (t (decf n) (push obj prev))))))) + (t (cl-decf n) (push obj prev))))))) (defun org-export-get-next-element (blob info &optional n) "Return next element or object. @@ -5370,7 +5509,7 @@ them." ((null n) (throw 'exit obj)) ((not (wholenump n)) (push obj next)) ((zerop n) (throw 'exit (nreverse next))) - (t (decf n) (push obj next))))))) + (t (cl-decf n) (push obj next))))))) ;;;; Translation @@ -5457,6 +5596,7 @@ them." ("es" :ascii "Ecuacion" :html "Ecuación" :default "Ecuación") ("et" :html "Võrrand" :utf-8 "Võrrand") ("fr" :ascii "Equation" :default "Équation") + ("is" :default "Jafna") ("ja" :default "方程式") ("no" :default "Ligning") ("nb" :default "Ligning") @@ -5471,6 +5611,7 @@ them." ("de" :default "Abbildung") ("es" :default "Figura") ("et" :default "Joonis") + ("is" :default "Mynd") ("ja" :default "図" :html "図") ("no" :default "Illustrasjon") ("nb" :default "Illustrasjon") @@ -5485,6 +5626,7 @@ them." ("es" :default "Figura %d:") ("et" :default "Joonis %d:") ("fr" :default "Figure %d :" :html "Figure %d :") + ("is" :default "Mynd %d") ("ja" :default "図%d: " :html "図%d: ") ("no" :default "Illustrasjon %d") ("nb" :default "Illustrasjon %d") @@ -5537,6 +5679,7 @@ them." ("es" :ascii "Indice de tablas" :html "Índice de tablas" :default "Índice de tablas") ("et" :default "Tabelite nimekiri") ("fr" :default "Liste des tableaux") + ("is" :default "Töfluskrá" :html "Töfluskrá") ("ja" :default "表目次") ("no" :default "Tabeller") ("nb" :default "Tabeller") @@ -5593,6 +5736,7 @@ them." ("es" :default "Tabla") ("et" :default "Tabel") ("fr" :default "Tableau") + ("is" :default "Tafla") ("ja" :default "表" :html "表") ("pt_BR" :default "Tabela") ("ru" :html "Таблица" @@ -5604,6 +5748,7 @@ them." ("es" :default "Tabla %d") ("et" :default "Tabel %d") ("fr" :default "Tableau %d :") + ("is" :default "Tafla %d") ("ja" :default "表%d:" :html "表%d:") ("no" :default "Tabell %d") ("nb" :default "Tabell %d") @@ -5938,24 +6083,17 @@ Return file name as a string." (let* ((visited-file (buffer-file-name (buffer-base-buffer))) (base-name ;; File name may come from EXPORT_FILE_NAME subtree - ;; property, assuming point is at beginning of said - ;; sub-tree. + ;; property. (file-name-sans-extension - (or (and subtreep - (org-entry-get - (save-excursion - (ignore-errors (org-back-to-heading) (point))) - "EXPORT_FILE_NAME" 'selective)) + (or (and subtreep (org-entry-get nil "EXPORT_FILE_NAME" 'selective)) ;; File name may be extracted from buffer's associated ;; file, if any. (and visited-file (file-name-nondirectory visited-file)) ;; Can't determine file name on our own: Ask user. - (let ((read-file-name-function - (and org-completion-use-ido 'ido-read-file-name))) - (read-file-name - "Output file: " pub-dir nil nil nil - (lambda (name) - (string= (file-name-extension name t) extension))))))) + (read-file-name + "Output file: " pub-dir nil nil nil + (lambda (name) + (string= (file-name-extension name t) extension)))))) (output-file ;; Build file name. Enforce EXTENSION over whatever user ;; may have come up with. PUB-DIR, if defined, always has @@ -5969,7 +6107,7 @@ Return file name as a string." (t (concat (file-name-as-directory ".") base-name extension))))) ;; If writing to OUTPUT-FILE would overwrite original file, append ;; EXTENSION another time to final name. - (if (and visited-file (org-file-equal-p visited-file output-file)) + (if (and visited-file (file-equal-p visited-file output-file)) (concat output-file extension) output-file))) @@ -5990,68 +6128,21 @@ removed beforehand. Return the new stack." "Menu for asynchronous export results and running processes." (interactive) (let ((buffer (get-buffer-create "*Org Export Stack*"))) - (set-buffer buffer) - (when (zerop (buffer-size)) (org-export-stack-mode)) - (org-export-stack-refresh) + (with-current-buffer buffer + (org-export-stack-mode) + (tabulated-list-print t)) (pop-to-buffer buffer)) (message "Type \"q\" to quit, \"?\" for help")) -(defun org-export--stack-source-at-point () - "Return source from export results at point in stack." - (let ((source (car (nth (1- (org-current-line)) org-export-stack-contents)))) - (if (not source) (error "Source unavailable, please refresh buffer") - (let ((source-name (if (stringp source) source (buffer-name source)))) - (if (save-excursion - (beginning-of-line) - (looking-at (concat ".* +" (regexp-quote source-name) "$"))) - source - ;; SOURCE is not consistent with current line. The stack - ;; view is outdated. - (error "Source unavailable; type `g' to update buffer")))))) - (defun org-export-stack-clear () "Remove all entries from export stack." (interactive) (setq org-export-stack-contents nil)) -(defun org-export-stack-refresh (&rest dummy) - "Refresh the asynchronous export stack. -DUMMY is ignored. Unavailable sources are removed from the list. -Return the new stack." - (let ((inhibit-read-only t)) - (org-preserve-lc - (erase-buffer) - (insert (concat - (let ((counter 0)) - (mapconcat - (lambda (entry) - (let ((proc-p (processp (nth 2 entry)))) - (concat - ;; Back-end. - (format " %-12s " (or (nth 1 entry) "")) - ;; Age. - (let ((data (nth 2 entry))) - (if proc-p (format " %6s " (process-status data)) - ;; Compute age of the results. - (org-format-seconds - "%4h:%.2m " - (float-time (time-since data))))) - ;; Source. - (format " %s" - (let ((source (car entry))) - (if (stringp source) source - (buffer-name source))))))) - ;; Clear stack from exited processes, dead buffers or - ;; non-existent files. - (setq org-export-stack-contents - (org-remove-if-not - (lambda (el) - (if (processp (nth 2 el)) - (buffer-live-p (process-buffer (nth 2 el))) - (let ((source (car el))) - (if (bufferp source) (buffer-live-p source) - (file-exists-p source))))) - org-export-stack-contents)) "\n"))))))) +(defun org-export-stack-refresh () + "Refresh the export stack." + (interactive) + (tabulated-list-print t)) (defun org-export-stack-remove (&optional source) "Remove export results at point from stack. @@ -6059,7 +6150,7 @@ If optional argument SOURCE is non-nil, remove it instead." (interactive) (let ((source (or source (org-export--stack-source-at-point)))) (setq org-export-stack-contents - (org-remove-if (lambda (el) (equal (car el) source)) + (cl-remove-if (lambda (el) (equal (car el) source)) org-export-stack-contents)))) (defun org-export-stack-view (&optional in-emacs) @@ -6075,11 +6166,10 @@ within Emacs." (defvar org-export-stack-mode-map (let ((km (make-sparse-keymap))) + (set-keymap-parent km tabulated-list-mode-map) (define-key km " " 'next-line) - (define-key km "n" 'next-line) (define-key km "\C-n" 'next-line) (define-key km [down] 'next-line) - (define-key km "p" 'previous-line) (define-key km "\C-p" 'previous-line) (define-key km "\C-?" 'previous-line) (define-key km [up] 'previous-line) @@ -6090,31 +6180,85 @@ within Emacs." km) "Keymap for Org Export Stack.") -(define-derived-mode org-export-stack-mode special-mode "Org-Stack" +(define-derived-mode org-export-stack-mode tabulated-list-mode "Org-Stack" "Mode for displaying asynchronous export stack. -Type \\[org-export-stack] to visualize the asynchronous export +Type `\\[org-export-stack]' to visualize the asynchronous export stack. -In an Org Export Stack buffer, use \\<org-export-stack-mode-map>\\[org-export-stack-view] to view export output -on current line, \\[org-export-stack-remove] to remove it from the stack and \\[org-export-stack-clear] to clear +In an Org Export Stack buffer, use \ +\\<org-export-stack-mode-map>`\\[org-export-stack-view]' to view export output +on current line, `\\[org-export-stack-remove]' to remove it from the stack and \ +`\\[org-export-stack-clear]' to clear stack completely. -Removing entries in an Org Export Stack buffer doesn't affect -files or buffers, only the display. +Removing entries in a stack buffer does not affect files +or buffers, only display. \\{org-export-stack-mode-map}" - (abbrev-mode 0) - (auto-fill-mode 0) - (setq buffer-read-only t - buffer-undo-list t - truncate-lines t - header-line-format - '(:eval - (format " %-12s | %6s | %s" "Back-End" "Age" "Source"))) - (org-add-hook 'post-command-hook 'org-export-stack-refresh nil t) - (set (make-local-variable 'revert-buffer-function) - 'org-export-stack-refresh)) + (setq tabulated-list-format + (vector (list "#" 4 #'org-export--stack-num-predicate) + (list "Back-End" 12 t) + (list "Age" 6 nil) + (list "Source" 0 nil))) + (setq tabulated-list-sort-key (cons "#" nil)) + (setq tabulated-list-entries #'org-export--stack-generate) + (add-hook 'tabulated-list-revert-hook #'org-export--stack-generate nil t) + (add-hook 'post-command-hook #'org-export-stack-refresh nil t) + (tabulated-list-init-header)) + +(defun org-export--stack-generate () + "Generate the asynchronous export stack for display. +Unavailable sources are removed from the list. Return a list +appropriate for `tabulated-list-print'." + ;; Clear stack from exited processes, dead buffers or non-existent + ;; files. + (setq org-export-stack-contents + (cl-remove-if-not + (lambda (el) + (if (processp (nth 2 el)) + (buffer-live-p (process-buffer (nth 2 el))) + (let ((source (car el))) + (if (bufferp source) (buffer-live-p source) + (file-exists-p source))))) + org-export-stack-contents)) + ;; Update `tabulated-list-entries'. + (let ((counter 0)) + (mapcar + (lambda (entry) + (let ((source (car entry))) + (list source + (vector + ;; Counter. + (number-to-string (cl-incf counter)) + ;; Back-End. + (if (nth 1 entry) (symbol-name (nth 1 entry)) "") + ;; Age. + (let ((info (nth 2 entry))) + (if (processp info) (symbol-name (process-status info)) + (format-seconds "%h:%.2m" (float-time (time-since info))))) + ;; Source. + (if (stringp source) source (buffer-name source)))))) + org-export-stack-contents))) + +(defun org-export--stack-num-predicate (a b) + (< (string-to-number (aref (nth 1 a) 0)) + (string-to-number (aref (nth 1 b) 0)))) + +(defun org-export--stack-source-at-point () + "Return source from export results at point in stack." + (let ((source (car (nth (1- (org-current-line)) org-export-stack-contents)))) + (if (not source) (error "Source unavailable, please refresh buffer") + (let ((source-name (if (stringp source) source (buffer-name source)))) + (if (save-excursion + (beginning-of-line) + (looking-at-p (concat ".* +" (regexp-quote source-name) "$"))) + source + ;; SOURCE is not consistent with current line. The stack + ;; view is outdated. + (error (substitute-command-keys + "Source unavailable; type `\\[org-export-stack-refresh]' \ +to refresh buffer"))))))) @@ -6140,10 +6284,12 @@ SPC and DEL (resp. C-n and C-p) keys. Set variable `org-export-dispatch-use-expert-ui' to switch to one flavor or the other. -When ARG is \\[universal-argument], repeat the last export action, with the same set -of options used back then, on the current buffer. +When ARG is `\\[universal-argument]', repeat the last export action, with the\ + same +set of options used back then, on the current buffer. -When ARG is \\[universal-argument] \\[universal-argument], display the asynchronous export stack." +When ARG is `\\[universal-argument] \\[universal-argument]', display the \ +asynchronous export stack." (interactive "P") (let* ((input (cond ((equal arg '(16)) '(stack)) @@ -6168,7 +6314,7 @@ When ARG is \\[universal-argument] \\[universal-argument], display the asynchron (optns (cdr input))) (unless (memq 'subtree optns) (move-marker org-export-dispatch-last-position nil)) - (case action + (cl-case action ;; First handle special hard-coded actions. (template (org-export-insert-default-template nil optns)) (stack (org-export-stack)) @@ -6177,7 +6323,7 @@ When ARG is \\[universal-argument] \\[universal-argument], display the asynchron (publish-current-project (org-publish-current-project (memq 'force optns) (memq 'async optns))) (publish-choose-project - (org-publish (assoc (org-icompleting-read + (org-publish (assoc (completing-read "Publish project: " org-publish-project-alist nil t) org-publish-project-alist) @@ -6228,12 +6374,12 @@ back to standard interface." ;; on the first key, if any. A nil value means KEY will ;; only be activated at first level. (if (or (eq access-key t) (eq access-key first-key)) - (org-propertize key 'face 'org-warning) + (propertize key 'face 'org-warning) key))) (fontify-value (lambda (value) ;; Fontify VALUE string. - (org-propertize value 'face 'font-lock-variable-name-face))) + (propertize value 'face 'font-lock-variable-name-face))) ;; Prepare menu entries by extracting them from registered ;; back-ends and sorting them by access key and by ordinal, ;; if any. @@ -6307,7 +6453,7 @@ back to standard interface." (concat (mapconcat (lambda (sub-entry) - (incf index) + (cl-incf index) (format (if (zerop (mod index 2)) " [%s] %-26s" "[%s] %s\n") @@ -6378,7 +6524,7 @@ back to standard interface." standard-prompt allowed-keys entries options first-key expertp)))) (defun org-export--dispatch-action - (prompt allowed-keys entries options first-key expertp) + (prompt allowed-keys entries options first-key expertp) "Read a character from command input and act accordingly. PROMPT is the displayed prompt, as a string. ALLOWED-KEYS is @@ -6396,7 +6542,7 @@ options as CDR." (while (and (setq key (read-char-exclusive prompt)) (not expertp) (memq key '(14 16 ?\s ?\d))) - (case key + (cl-case key (14 (if (not (pos-visible-in-window-p (point-max))) (ignore-errors (scroll-up 1)) (message "End of buffer") @@ -6433,8 +6579,8 @@ options as CDR." ;; Toggle options: C-b (2) C-v (22) C-s (19) C-f (6) C-a (1). ((memq key '(2 22 19 6 1)) (org-export--dispatch-ui - (let ((option (case key (2 'body) (22 'visible) (19 'subtree) - (6 'force) (1 'async)))) + (let ((option (cl-case key (2 'body) (22 'visible) (19 'subtree) + (6 'force) (1 'async)))) (if (memq option options) (remq option options) (cons option options))) first-key expertp)) @@ -6446,7 +6592,7 @@ options as CDR." ;; Publishing actions are hard-coded. Send a special ;; signal to `org-export-dispatch'. ((eq first-key ?P) - (case key + (cl-case key (?f 'publish-current-file) (?p 'publish-current-project) (?x 'publish-choose-project) @@ -6455,10 +6601,9 @@ options as CDR." ;; path. Indeed, derived backends can share the same ;; FIRST-KEY. (t (catch 'found - (mapc (lambda (entry) - (let ((match (assq key (nth 2 entry)))) - (when match (throw 'found (nth 2 match))))) - (member (assq first-key entries) entries))))) + (dolist (entry (member (assq first-key entries) entries)) + (let ((match (assq key (nth 2 entry)))) + (when match (throw 'found (nth 2 match)))))))) options)) ;; Otherwise, enter sub-menu. (t (org-export--dispatch-ui options key expertp))))) |