Parcourir la source

ox: Abstract fuzzy link searches with search cells

* lisp/ox.el (org-export-search-cells):
(org-export-string-to-search-cell):
(org-export-match-search-cell-p): New functions.

(org-export-resolve-fuzzy-link): Use new functions.

* testing/lisp/test-ox.el (test-org-export/fuzzy-link): Tiny
  refactoring.
(test-org-export/resolve-fuzzy-link): Fix failing test.
Nicolas Goaziou il y a 9 ans
Parent
commit
6ec06dcff9
2 fichiers modifiés avec 106 ajouts et 65 suppressions
  1. 83 40
      lisp/ox.el
  2. 23 25
      testing/lisp/test-ox.el

+ 83 - 40
lisp/ox.el

@@ -4153,6 +4153,66 @@ error if no block contains REF."
 	info 'first-match)
       (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.
 
@@ -4172,54 +4232,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 (signal 'org-link-broken (list 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)

+ 23 - 25
testing/lisp/test-ox.el

@@ -2517,53 +2517,53 @@ Para2"
 (ert-deftest test-org-export/fuzzy-link ()
   "Test fuzzy links specifications."
   ;; Link to an headline should return headline's number.
-  (org-test-with-parsed-data
-      "Paragraph.\n* Head1\n* Head2\n* Head3\n[[Head2]]"
-    (should
-     ;; Note: Headline's number is in fact a list of numbers.
-     (equal '(2)
+  (should
+   ;; Note: Headline's number is in fact a list of numbers.
+   (equal '(2)
+	  (org-test-with-parsed-data
+	      "Paragraph.\n* Head1\n* Head2\n* Head3\n[[Head2]]"
 	    (org-element-map tree 'link
 	      (lambda (link)
 		(org-export-get-ordinal
 		 (org-export-resolve-fuzzy-link link info) info)) info t))))
   ;; Link to a target in an item should return item's number.
-  (org-test-with-parsed-data
-      "- Item1\n  - Item11\n  - <<test>>Item12\n- Item2\n\n\n[[test]]"
-    (should
-     ;; Note: Item's number is in fact a list of numbers.
-     (equal '(1 2)
+  (should
+   ;; Note: Item's number is in fact a list of numbers.
+   (equal '(1 2)
+	  (org-test-with-parsed-data
+	      "- Item1\n  - Item11\n  - <<test>>Item12\n- Item2\n\n\n[[test]]"
 	    (org-element-map tree 'link
 	      (lambda (link)
 		(org-export-get-ordinal
 		 (org-export-resolve-fuzzy-link link info) info)) info t))))
   ;; Link to a target in a footnote should return footnote's number.
-  (org-test-with-parsed-data "
+  (should
+   (equal '(2 3)
+	  (org-test-with-parsed-data "
 Paragraph[fn:1][fn:2][fn:lbl3:C<<target>>][[test]][[target]]
 \[fn:1] A
 
 \[fn:2] <<test>>B"
-    (should
-     (equal '(2 3)
 	    (org-element-map tree 'link
 	      (lambda (link)
 		(org-export-get-ordinal
 		 (org-export-resolve-fuzzy-link link info) info)) info))))
   ;; Link to a named element should return sequence number of that
   ;; element.
-  (org-test-with-parsed-data
-      "#+NAME: tbl1\n|1|2|\n#+NAME: tbl2\n|3|4|\n#+NAME: tbl3\n|5|6|\n[[tbl2]]"
-    (should
-     (= 2
+  (should
+   (= 2
+      (org-test-with-parsed-data
+	  "#+NAME: tbl1\n|1|2|\n#+NAME: tbl2\n|3|4|\n#+NAME: tbl3\n|5|6|\n[[tbl2]]"
 	(org-element-map tree 'link
 	  (lambda (link)
 	    (org-export-get-ordinal
 	     (org-export-resolve-fuzzy-link link info) info)) info t))))
   ;; Link to a target not within an item, a table, a footnote
   ;; reference or definition should return section number.
-  (org-test-with-parsed-data
-      "* Head1\n* Head2\nParagraph<<target>>\n* Head3\n[[target]]"
-    (should
-     (equal '(2)
+  (should
+   (equal '(2)
+	  (org-test-with-parsed-data
+	      "* Head1\n* Head2\nParagraph<<target>>\n* Head3\n[[target]]"
 	    (org-element-map tree 'link
 	      (lambda (link)
 		(org-export-get-ordinal
@@ -2697,12 +2697,10 @@ Another text. (ref:text)
    (org-test-with-parsed-data "* My headline\n[[My headline]]"
      (org-export-resolve-fuzzy-link
       (org-element-map tree 'link 'identity info t) info)))
-  ;; Targets objects have priority over named elements and headline
-  ;; titles.
+  ;; Targets objects have priority over headline titles.
   (should
    (eq 'target
-       (org-test-with-parsed-data
-	   "* target\n#+NAME: target\n<<target>>\n\n[[target]]"
+       (org-test-with-parsed-data "* target\n<<target>>[[target]]"
 	 (org-element-type
 	  (org-export-resolve-fuzzy-link
 	   (org-element-map tree 'link 'identity info t) info)))))