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.
This commit is contained in:
Nicolas Goaziou 2015-06-16 23:05:29 +02:00
parent 2c27e85f11
commit d1f9aa3a02
2 changed files with 43 additions and 74 deletions

View File

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

View File

@ -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-test-with-parsed-data "* Head [100%]\n[[Head]]"
(org-element-map tree 'link (org-element-map tree 'link
(lambda (link) (org-export-resolve-fuzzy-link link info)) (lambda (link) (org-export-resolve-fuzzy-link link info))
info t))) 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)))))
(ert-deftest test-org-export/resolve-coderef () (ert-deftest test-org-export/resolve-coderef ()
"Test `org-export-resolve-coderef' specifications." "Test `org-export-resolve-coderef' specifications."