summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorNicolas Goaziou <mail@nicolasgoaziou.fr>2015-06-16 23:05:29 +0200
committerNicolas Goaziou <mail@nicolasgoaziou.fr>2015-06-16 23:24:42 +0200
commitd1f9aa3a02c022baa9ded80ccca6589ba9d75669 (patch)
tree3964b1d0eca836ae37054cef848f76466fb8053a
parent2c27e85f11aeb4bbf2b3cfea91e6d0a2f8fa4ab6 (diff)
downloadorg-mode-d1f9aa3a02c022baa9ded80ccca6589ba9d75669.tar.gz
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.
-rw-r--r--lisp/ox.el108
-rw-r--r--testing/lisp/test-ox.el9
2 files changed, 43 insertions, 74 deletions
diff --git a/lisp/ox.el b/lisp/ox.el
index 955169a..9a24a5d 100644
--- a/lisp/ox.el
+++ b/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.
diff --git a/testing/lisp/test-ox.el b/testing/lisp/test-ox.el
index aa366f2..1b59d3a 100644
--- a/testing/lisp/test-ox.el
+++ b/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."