Sfoglia il codice sorgente

ox: Add external footnotes definitions in parse tree

* lisp/ox.el (org-export-get-environment):
(org-export-collect-tree-properties):
Remove :footnote-definition-alist property.
(org-export-get-footnote-definition): Apply removal of property.

(org-export--merge-external-footnote-definitions): New function.
(org-export-as): Use new function.

* testing/lisp/test-ox.el (test-org-export/footnotes): Update tests.

This change allows to have all footnote definitions within the parse
tree, so they can be reached with, e.g., a parse tree filter.
Nicolas Goaziou 9 anni fa
parent
commit
47265b31ca
2 ha cambiato i file con 167 aggiunte e 77 eliminazioni
  1. 143 58
      lisp/ox.el
  2. 24 19
      testing/lisp/test-ox.el

+ 143 - 58
lisp/ox.el

@@ -1320,39 +1320,6 @@ inferior to file-local settings."
     :back-end
     backend
     :translate-alist (org-export-get-all-transcoders backend)
-    :footnote-definition-alist
-    ;; Footnotes definitions must be collected in the original
-    ;; buffer, as there's no insurance that they will still be in
-    ;; the parse tree, due to possible narrowing.
-    (let (alist)
-      (org-with-wide-buffer
-       (goto-char (point-min))
-       (while (re-search-forward org-footnote-re nil t)
-	 (backward-char)
-	 (let ((fn (save-match-data (org-element-context))))
-	   (case (org-element-type fn)
-	     (footnote-definition
-	      (push
-	       (cons (org-element-property :label fn)
-		     (let ((cbeg (org-element-property :contents-begin fn)))
-		       (when cbeg
-			 (org-element--parse-elements
-			  cbeg (org-element-property :contents-end fn)
-			  nil nil nil nil (list 'org-data nil)))))
-	       alist))
-	     (footnote-reference
-	      (let ((label (org-element-property :label fn))
-		    (cbeg (org-element-property :contents-begin fn)))
-		(when (and label cbeg
-			   (eq (org-element-property :type fn) 'inline))
-		  (push
-		   (cons label
-			 (org-element-parse-secondary-string
-			  (buffer-substring
-			   cbeg (org-element-property :contents-end fn))
-			  (org-element-restriction 'footnote-reference)))
-		   alist)))))))
-       alist))
     :id-alist
     ;; Collect id references.
     (let (alist)
@@ -1666,9 +1633,6 @@ Following tree properties are set or updated:
 `:exported-data' Hash table used to memoize results from
                  `org-export-data'.
 
-`:footnote-definition-alist' List of footnotes definitions in
-                   original buffer and current parse tree.
-
 `: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
@@ -1686,22 +1650,6 @@ Return updated plist."
 	(plist-put info
 		   :headline-offset
 		   (- 1 (org-export--get-min-level data info))))
-  ;; Footnote definitions in parse tree override those stored in
-  ;; `:footnote-definition-alist'.  This way, any change to
-  ;; a definition in the parse tree (e.g., through a parse tree
-  ;; filter) propagates into the alist.
-  (let ((defs (plist-get info :footnote-definition-alist)))
-    (org-element-map data '(footnote-definition footnote-reference)
-      (lambda (fn)
-	(cond ((eq (org-element-type fn) 'footnote-definition)
-	       (push (cons (org-element-property :label fn)
-			   (append '(org-data nil) (org-element-contents fn)))
-		     defs))
-	      ((eq (org-element-property :type fn) 'inline)
-	       (push (cons (org-element-property :label fn)
-			   (org-element-contents fn))
-		     defs)))))
-    (setq info (plist-put info :footnote-definition-alist defs)))
   ;; Properties order doesn't matter: get the rest of the tree
   ;; properties.
   (nconc
@@ -2794,6 +2742,131 @@ 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)
@@ -2913,13 +2986,14 @@ 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.
 	 (org-export--prune-tree tree info)
 	 (org-export--remove-uninterpreted-data tree info)
-	 ;; Parse buffer, handle uninterpreted elements or objects,
-	 ;; then call parse-tree filters.
+	 ;; Call parse tree filters.
 	 (setq tree
 	       (org-export-filter-apply-functions
 		(plist-get info :filter-parse-tree) tree info))
@@ -3569,10 +3643,21 @@ applied."
 INFO is the plist used as a communication channel.  If no such
 definition can be found, raise an error."
   (let ((label (org-element-property :label footnote-reference)))
-    (or (if label
-	    (cdr (assoc label (plist-get info :footnote-definition-alist)))
-	  (org-element-contents footnote-reference))
-	(error "Definition not found for footnote %s" label))))
+    (if (not label) (org-element-contents footnote-reference)
+      (let ((cache (or (plist-get info :footnote-definition-cache)
+		       (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))))))
 
 (defun org-export--footnote-reference-map
     (function data info &optional body-first)

+ 24 - 19
testing/lisp/test-ox.el

@@ -1826,38 +1826,43 @@ Footnotes[fn:2], foot[fn:test], digit only[3], and [fn:inline:anonymous footnote
 			    (car (org-element-contents def))))))))
 	  info))))
     ;; Test nested footnote in invisible definitions.
-    (org-test-with-temp-text "Text[1]\n\n[1] B [2]\n\n[2] C."
-      ;; Hide definitions.
-      (narrow-to-region (point) (point-at-eol))
-      (let* ((tree (org-element-parse-buffer))
-	     (info (org-combine-plists
-		    `(:parse-tree ,tree)
-		    (org-export-collect-tree-properties
-		     tree (org-export-get-environment)))))
-	;; Both footnotes should be seen.
-	(should
-	 (= (length (org-export-collect-footnote-definitions info)) 2))))
+    (should
+     (= 2
+	(org-test-with-temp-text "Text[1]\n\n[1] B [2]\n\n[2] C."
+	  (narrow-to-region (point) (line-end-position))
+	  (catch 'exit
+	    (org-export-as
+	     (org-export-create-backend
+	      :transcoders
+	      '((section
+		 .
+		 (lambda (s c i)
+		   (throw 'exit (length
+				 (org-export-collect-footnote-definitions
+				  i))))))))))))
     ;; Test export of footnotes defined outside parsing scope.
     (should
      (equal
       "ParagraphOut of scope\n"
       (org-test-with-temp-text "[fn:1] Out of scope
 * Title
-Paragraph[fn:1]"
+<point>Paragraph[fn:1]"
 	(let ((backend (org-test-default-backend)))
 	  (setf (org-export-backend-transcoders backend)
-		(cons (cons 'footnote-reference
-			    (lambda (fn contents info)
-			      (org-element-interpret-data
-			       (org-export-get-footnote-definition fn info))))
-		      (org-export-backend-transcoders backend)))
-	  (forward-line)
+		(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)))))
     ;; Footnotes without a definition should throw an error.
     (should-error
      (org-test-with-parsed-data "Text[fn:1]"
        (org-export-get-footnote-definition
-	(org-element-map tree 'footnote-reference 'identity info t) info)))
+	(org-element-map tree 'footnote-reference #'identity info t) info)))
     ;; Footnote section should be ignored in TOC and in headlines
     ;; numbering.
     (should