Browse Source

ox: Simplify fuzzy link matching

* lisp/ox.el (org-export-resolve-fuzzy-link): When a fuzzy link
  matches more than one headline, prefer the first one in the parse
  tree.

* testing/lisp/test-ox.el (test-org-export/fuzzy-link): Remove a test.

This behaviour is consistent with `org-open-at-point'.  Also, it
allows to cache destinations.
Nicolas Goaziou 9 years ago
parent
commit
d1f9aa3a02
2 changed files with 43 additions and 74 deletions
  1. 42 66
      lisp/ox.el
  2. 1 8
      testing/lisp/test-ox.el

+ 42 - 66
lisp/ox.el

@@ -4023,85 +4023,61 @@ Return value can be an object, an element, or nil:
   \(i.e. #+NAME: path) of an element, return that element.
 
 - If LINK path exactly matches any headline name, return that
-  element.  If more than one headline share that name, priority
-  will be given to the one with the closest common ancestor, if
-  any, or the first one in the parse tree otherwise.
+  element.
 
 - Otherwise, throw an error.
 
 Assume LINK type is \"fuzzy\".  White spaces are not
 significant."
   (let* ((raw-path (org-link-unescape (org-element-property :path link)))
-	 (match-title-p (eq (string-to-char raw-path) ?*))
+	 (headline-only (eq (string-to-char raw-path) ?*))
 	 ;; Split PATH at white spaces so matches are space
 	 ;; insensitive.
 	 (path (org-split-string
-		(if match-title-p (substring raw-path 1) raw-path)))
-	 ;; Cache for destinations that are not position dependent.
+		(if headline-only (substring raw-path 1) raw-path)))
 	 (link-cache
 	  (or (plist-get info :resolve-fuzzy-link-cache)
-	      (plist-get (setq info (plist-put info :resolve-fuzzy-link-cache
-					       (make-hash-table :test 'equal)))
+	      (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)))
-    (cond
-     ;; Destination is not position dependent: use cached value.
-     ((and (not match-title-p) (not (eq cached 'not-found))) cached)
-     ;; First try to find a matching "<<path>>" unless user specified
-     ;; he was looking for a headline (path starts with a "*"
-     ;; character).
-     ((and (not match-title-p)
-	   (let ((match (org-element-map (plist-get info :parse-tree) 'target
-			  (lambda (blob)
-			    (and (equal (org-split-string
-					 (org-element-property :value blob))
-					path)
-				 blob))
-			  info 'first-match)))
-	     (and match (puthash path match link-cache)))))
-     ;; Then try to find an element with a matching "#+NAME: path"
-     ;; affiliated keyword.
-     ((and (not match-title-p)
-	   (let ((match (org-element-map (plist-get info :parse-tree)
-			    org-element-all-elements
-			  (lambda (el)
-			    (let ((name (org-element-property :name el)))
-			      (when (and name
-					 (equal (org-split-string name) path))
-				el)))
-			  info 'first-match)))
-	     (and match (puthash path match link-cache)))))
-     ;; Last case: link either points to a headline or to nothingness.
-     ;; Try to find the source, with priority given to headlines with
-     ;; the closest common ancestor.  If such candidate is found,
-     ;; return it, otherwise signal an error.
-     (t
-      (let ((find-headline
-	     (function
-	      ;; Return first headline whose `:raw-value' property is
-	      ;; NAME in parse tree DATA, or nil.  Statistics cookies
-	      ;; are ignored.
-	      (lambda (name data)
-		(org-element-map data 'headline
-		  (lambda (headline)
-		    (when (equal (org-split-string
-				  (replace-regexp-in-string
-				   "\\[[0-9]+%\\]\\|\\[[0-9]+/[0-9]+\\]" ""
-				   (org-element-property :raw-value headline)))
-				 name)
-		      headline))
-		  info 'first-match)))))
-	;; Search among headlines sharing an ancestor with link, from
-	;; closest to farthest.
-	(catch 'exit
-	  (dolist (parent
-		   (let ((parent-hl (org-export-get-parent-headline link)))
-		     (if (not parent-hl) (list (plist-get info :parse-tree))
-		       (org-element-lineage parent-hl nil t))))
-	    (let ((foundp (funcall find-headline path parent)))
-	      (when foundp (throw 'exit foundp))))
-	  ;; No destination found: error.
-	  (user-error "Unable to resolve link \"%s\"" raw-path)))))))
+    (if (not (eq cached 'not-found)) cached
+      (let ((ast (plist-get info :parse-tree)))
+	(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)))
+	 link-cache)))))
 
 (defun org-export-resolve-id-link (link info)
   "Return headline referenced as LINK destination.

+ 1 - 8
testing/lisp/test-ox.el

@@ -2391,14 +2391,7 @@ Paragraph[1][2][fn:lbl3:C<<target>>][[test]][[target]]\n[1] A\n\n[2] <<test>>B"
    (org-test-with-parsed-data "* Head [100%]\n[[Head]]"
      (org-element-map tree 'link
        (lambda (link) (org-export-resolve-fuzzy-link link info))
-       info t)))
-  ;; Headline match is position dependent.
-  (should-not
-   (apply
-    'eq
-    (org-test-with-parsed-data "* H1\n[[*H1]]\n* H1\n[[*H1]]"
-      (org-element-map tree 'link
-	(lambda (link) (org-export-resolve-fuzzy-link link info)) info)))))
+       info t))))
 
 (ert-deftest test-org-export/resolve-coderef ()
   "Test `org-export-resolve-coderef' specifications."