From 5e37a5c116b0e9361fa7d83ff106e0a36bfd4bee Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Mon, 27 Jun 2016 23:50:58 +0200 Subject: [PATCH 1/4] ox: Fix export of footnote definitions in pruned parts of tree * lisp/ox.el (org-export--missing-definitions): (org-export--install-footnote-definitions): New functions (org-export--merge-external-footnote-definitions): Remove function (org-export-as): (org-export--prune-tree): Use new functions. * testing/lisp/test-ox.el (test-org-export/footnotes): Add tests. Reported-by: Mark Edgington --- lisp/ox.el | 295 ++++++++++++++++++++++------------------ testing/lisp/test-ox.el | 88 ++++++++++-- 2 files changed, 236 insertions(+), 147 deletions(-) diff --git a/lisp/ox.el b/lisp/ox.el index bf19b4b98..2b1f57c6e 100644 --- a/lisp/ox.el +++ b/lisp/ox.el @@ -2660,7 +2660,23 @@ from tree." ;; Move into secondary string, if any. (dolist (p (cdr (assq type org-element-secondary-value-alist))) - (mapc walk-data (org-element-property p data))))))))) + (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 + ;; Since we're only interested in footnote definitions + (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 +2685,157 @@ 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) + ;; 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. + (let (missing-definitions) + (while undefined + (let* ((label (pop undefined)) + (definition + (cond + ((catch :found + (dolist (d definitions) + (when (equal (org-element-property :label d) label) + (throw :found d))))) + ((let ((def (org-footnote-get-definition label))) + (when def + (org-with-wide-buffer + (goto-char (nth 1 def)) + (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)))))))) + (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 (label (funcall list-labels definition)) + (unless (or (member label defined) ;Known label + (member label undefined)) ;Processed later + (push label 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 d :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 + (let* ((seen) + (insert-definitions) ; For byte-compiler. + (insert-definitions + (lambda (data) + ;; Insert footnote definitions in the same section as + ;; their first reference in DATA. + (org-element-map tree '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 + (catch :found + (dolist (d definitions) + (when (equal (org-element-property :label d) + label) + (throw :found d)))))) + (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 @@ -2762,130 +2919,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 @@ -3013,8 +3046,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. diff --git a/testing/lisp/test-ox.el b/testing/lisp/test-ox.el index a85f1046d..8177ea410 100644 --- a/testing/lisp/test-ox.el +++ b/testing/lisp/test-ox.el @@ -2006,7 +2006,7 @@ Para2" (car (org-element-contents (car (org-element-contents def)))))))) info)))) - ;; Test nested footnote in invisible definitions. + ;; Export nested footnote in invisible definitions. (should (= 2 (org-test-with-temp-text "Text[1]\n\n[1] B [2]\n\n[2] C." @@ -2021,24 +2021,82 @@ Para2" (throw 'exit (length (org-export-collect-footnote-definitions i)))))))))))) - ;; Test export of footnotes defined outside parsing scope. + ;; Export footnotes defined outside parsing scope. (should - (equal - "ParagraphOut of scope\n" + (string-match + "Out of scope" (org-test-with-temp-text "[fn:1] Out of scope * Title Paragraph[fn:1]" - (let ((backend (org-test-default-backend))) - (setf (org-export-backend-transcoders backend) - (append - (list (cons 'footnote-reference - (lambda (fn contents info) - (org-element-interpret-data - (org-export-get-footnote-definition fn info)))) - (cons 'footnote-definition #'ignore) - (cons 'headline #'ignore)) - (org-export-backend-transcoders backend))) - (org-export-as backend 'subtree))))) + (org-export-as (org-test-default-backend) 'subtree)))) + (should + (string-match + "Out of scope" + (org-test-with-temp-text "[fn:1] Out of scope +* Title +Paragraph[fn:1]" + (narrow-to-region (point) (point-max)) + (org-export-as (org-test-default-backend))))) + ;; Export nested footnotes defined outside parsing scope. + (should + (string-match + "Very out of scope" + (org-test-with-temp-text " +\[fn:1] Out of scope[fn:2] + +\[fn:2] Very out of scope +* Title +Paragraph[fn:1]" + (org-export-as (org-test-default-backend) 'subtree)))) + (should + (string-match + "Very out of scope" + (org-test-with-temp-text " +\[fn:1] Out of scope[fn:2] + +\[fn:2] Very out of scope +* Title +Paragraph[fn:1]" + (narrow-to-region (point) (point-max)) + (org-export-as (org-test-default-backend))))) + ;; Export footnotes in pruned parts of tree. + (should + (string-match + "Definition" + (let ((org-export-exclude-tags '("noexport"))) + (org-test-with-temp-text + "* H\nText[fn:1]\n* H2 :noexport:\n[fn:1] Definition" + (org-export-as (org-test-default-backend)))))) + (should + (string-match + "Definition" + (let ((org-export-select-tags '("export"))) + (org-test-with-temp-text + "* H :export:\nText[fn:1]\n* H2\n[fn:1] Definition" + (org-export-as (org-test-default-backend)))))) + ;; Export nested footnotes in pruned parts of tree. + (should + (string-match + "D2" + (let ((org-export-exclude-tags '("noexport"))) + (org-test-with-temp-text + "* H\nText[fn:1]\n* H2 :noexport:\n[fn:1] D1[fn:2]\n\n[fn:2] D2" + (org-export-as (org-test-default-backend)))))) + (should + (string-match + "D2" + (let ((org-export-select-tags '("export"))) + (org-test-with-temp-text + "* H :export:\nText[fn:1]\n* H2\n[fn:1] D1[fn:2]\n\n[fn:2] D2" + (org-export-as (org-test-default-backend)))))) + ;; Handle uninterpreted data in pruned footnote definitions. + (should-not + (string-match + "|" + (let ((org-export-with-tables nil)) + (org-test-with-temp-text + "* H\nText[fn:1]\n* H2 :noexport:\n[fn:1]\n| a |" + (org-export-as (org-test-default-backend)))))) ;; Footnotes without a definition should throw an error. (should-error (org-test-with-parsed-data "Text[fn:1]" From a131fd1a1d1124c03952b0d41d4fd98da0a6fb55 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Mon, 27 Jun 2016 23:58:08 +0200 Subject: [PATCH 2/4] ox: Fix typo in comment * lisp/ox.el (org-export-get-footnote-definition): Fix typo. --- lisp/ox.el | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/lisp/ox.el b/lisp/ox.el index 2b1f57c6e..e7b528c03 100644 --- a/lisp/ox.el +++ b/lisp/ox.el @@ -3704,10 +3704,10 @@ definition can be found, raise an error." '(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. + ;; 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)) From 96a9542ae1153a0c8003d9e80a48d1558b89b50a Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Mon, 27 Jun 2016 23:59:44 +0200 Subject: [PATCH 3/4] org-element: Remove spurious blank when interpreting a row * lisp/org-element.el (org-element-table-row-interpreter): Remove spurious white space. --- lisp/org-element.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/org-element.el b/lisp/org-element.el index 2576c3fac..bf76bd40e 100644 --- a/lisp/org-element.el +++ b/lisp/org-element.el @@ -2591,7 +2591,7 @@ containing `:begin', `:end', `:contents-begin', `:contents-end', "Interpret TABLE-ROW element as Org syntax. CONTENTS is the contents of the table row." (if (eq (org-element-property :type table-row) 'rule) "|-" - (concat "| " contents))) + (concat "|" contents))) ;;;; Verse Block From f196fb3bed2cf9156d485315d46d193cc877b6aa Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Tue, 28 Jun 2016 00:01:48 +0200 Subject: [PATCH 4/4] ob-exp: Silence byte compiler --- lisp/ob-exp.el | 3 +++ 1 file changed, 3 insertions(+) diff --git a/lisp/ob-exp.el b/lisp/ob-exp.el index 6774bd160..e82499231 100644 --- a/lisp/ob-exp.el +++ b/lisp/ob-exp.el @@ -34,9 +34,12 @@ (declare-function org-babel-lob-get-info "ob-lob" ()) (declare-function org-babel-eval-wipe-error-buffer "ob-eval" ()) +(declare-function org-between-regexps-p "ob-eval" (start-re end-re &optional lim-up lim-down)) (declare-function org-get-indentation "org" (&optional line)) (declare-function org-heading-components "org" ()) +(declare-function org-in-block-p "org" (names)) (declare-function org-in-commented-heading-p "org" (&optional no-inheritance)) +(declare-function org-in-verbatim-emphasis "org" ()) (declare-function org-link-search "org" (s &optional avoid-pos stealth)) (declare-function org-fill-template "org" (template alist)) (declare-function org-split-string "org" (string &optional separators))