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)))
(cond (if (not (eq cached 'not-found)) cached
;; Destination is not position dependent: use cached value. (let ((ast (plist-get info :parse-tree)))
((and (not match-title-p) (not (eq cached 'not-found))) cached) (puthash
;; First try to find a matching "<<path>>" unless user specified path
;; he was looking for a headline (path starts with a "*" (cond
;; character). ;; First try to find a matching "<<path>>" unless user
((and (not match-title-p) ;; specified he was looking for a headline (path starts with
(let ((match (org-element-map (plist-get info :parse-tree) 'target ;; a "*" character).
(lambda (blob) ((and (not headline-only)
(and (equal (org-split-string (org-element-map ast 'target
(org-element-property :value blob)) (lambda (datum)
path) (and (equal (org-split-string
blob)) (org-element-property :value datum))
info 'first-match))) path)
(and match (puthash path match link-cache))))) datum))
;; Then try to find an element with a matching "#+NAME: path" info 'first-match)))
;; affiliated keyword. ;; Then try to find an element with a matching "#+NAME: path"
((and (not match-title-p) ;; affiliated keyword.
(let ((match (org-element-map (plist-get info :parse-tree) ((and (not headline-only)
org-element-all-elements (org-element-map ast org-element-all-elements
(lambda (el) (lambda (datum)
(let ((name (org-element-property :name el))) (let ((name (org-element-property :name datum)))
(when (and name (and name (equal (org-split-string name) path) datum)))
(equal (org-split-string name) path)) info 'first-match)))
el))) ;; Try to find a matching headline.
info 'first-match))) ((org-element-map ast 'headline
(and match (puthash path match link-cache))))) (lambda (h)
;; Last case: link either points to a headline or to nothingness. (and (equal (org-split-string
;; Try to find the source, with priority given to headlines with (replace-regexp-in-string
;; the closest common ancestor. If such candidate is found, "\\[[0-9]+%\\]\\|\\[[0-9]+/[0-9]+\\]" ""
;; return it, otherwise signal an error. (org-element-property :raw-value h)))
(t path)
(let ((find-headline h))
(function info 'first-match))
;; Return first headline whose `:raw-value' property is (t (user-error "Unable to resolve link \"%s\"" raw-path)))
;; NAME in parse tree DATA, or nil. Statistics cookies link-cache)))))
;; 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)))))))
(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."