From d1f9aa3a02c022baa9ded80ccca6589ba9d75669 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Tue, 16 Jun 2015 23:05:29 +0200 Subject: [PATCH] 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. --- lisp/ox.el | 108 +++++++++++++++++++----------------------------- testing/lisp/test-ox.el | 9 +--- 2 files changed, 43 insertions(+), 74 deletions(-) diff --git a/lisp/ox.el b/lisp/ox.el index 955169af0..9a24a5d36 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 "<>" 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 "<>" 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 aa366f238..1b59d3ad7 100644 --- a/testing/lisp/test-ox.el +++ b/testing/lisp/test-ox.el @@ -2391,14 +2391,7 @@ Paragraph[1][2][fn:lbl3:C<>][[test]][[target]]\n[1] A\n\n[2] <>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." -- 2.11.4.GIT