forked from mirrors/org-mode
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:
parent
2c27e85f11
commit
d1f9aa3a02
108
lisp/ox.el
108
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.
|
\(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.
|
||||||
|
|
|
@ -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."
|
||||||
|
|
Loading…
Reference in a new issue