tec/org-mode
tec
/
org-mode
forked from mirrors/org-mode
1
0
Fork 0
Code Pull Requests Releases Activity

ox: Fix caching for fuzzy link resolution 

* lisp/ox.el (org-export-resolve-fuzzy-link): Fix caching process.
* testing/lisp/test-ox.el: Add test.
This commit is contained in:
Nicolas Goaziou 2013-05-04 08:56:30 +02:00
parent 76349b98a2
commit 3e1d83bf6b
2 changed files with 27 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
lisp/ox.el
View File

@ -3977,42 +3977,40 @@ significant."
;; insensitive. ;; insensitive.
(path (org-split-string (path (org-split-string
(if match-title-p (substring raw-path 1) raw-path))) (if match-title-p (substring raw-path 1) raw-path)))
;; Cache for locations of fuzzy links that are not position dependent ;; Cache for destinations that are not position dependent.
(link-cache (link-cache
(or (plist-get info :fuzzy-link-cache) (or (plist-get info :fuzzy-link-cache)
(plist-get (setq info (plist-put info :fuzzy-link-cache (plist-get (setq info (plist-put info :fuzzy-link-cache
(make-hash-table :test 'equal))) (make-hash-table :test 'equal)))
:fuzzy-link-cache))) :fuzzy-link-cache)))
(found-in-cache (gethash path link-cache 'fuzzy-link-not-found))) (cached (gethash path link-cache 'not-found)))
(cond (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 ;; First try to find a matching "<<path>>" unless user specified
;; he was looking for a headline (path starts with a "*" ;; he was looking for a headline (path starts with a "*"
;; character). ;; character).
((and (not match-title-p) ((and (not match-title-p)
(or (not (eq found-in-cache 'fuzzy-link-not-found)) (let ((match (org-element-map (plist-get info :parse-tree) 'target
(puthash path
(org-element-map (plist-get info :parse-tree) 'target
(lambda (blob) (lambda (blob)
(and (equal (org-split-string (and (equal (org-split-string
(org-element-property :value blob)) (org-element-property :value blob))
path) path)
blob)) blob))
info t) info 'first-match)))
link-cache)))) (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 match-title-p)
(or (not (eq found-in-cache 'fuzzy-link-not-found)) (let ((match (org-element-map (plist-get info :parse-tree)
(puthash path
(org-element-map (plist-get info :parse-tree)
org-element-all-elements org-element-all-elements
(lambda (el) (lambda (el)
(let ((name (org-element-property :name el))) (let ((name (org-element-property :name el)))
(when (and name (when (and name
(equal (org-split-string name) path)) (equal (org-split-string name) path))
el))) el)))
info 'first-match) info 'first-match)))
link-cache)))) (and match (puthash path match link-cache)))))
;; Last case: link either points to a headline or to nothingness. ;; Last case: link either points to a headline or to nothingness.
;; Try to find the source, with priority given to headlines with ;; Try to find the source, with priority given to headlines with
;; the closest common ancestor. If such candidate is found, ;; the closest common ancestor. If such candidate is found,
@ -4035,15 +4033,15 @@ significant."
info 'first-match))))) info 'first-match)))))
;; Search among headlines sharing an ancestor with link, from ;; Search among headlines sharing an ancestor with link, from
;; closest to farthest. ;; closest to farthest.
(or (catch 'exit (catch 'exit
(mapc (mapc
(lambda (parent) (lambda (parent)
(when (eq (org-element-type parent) 'headline)
(let ((foundp (funcall find-headline path parent))) (let ((foundp (funcall find-headline path parent)))
(when foundp (throw 'exit foundp))))) (when foundp (throw 'exit foundp))))
(org-export-get-genealogy link)) nil) (let ((parent-hl (org-export-get-parent-headline link)))
;; No match with a common ancestor: try full parse-tree. (cons parent-hl (org-export-get-genealogy parent-hl))))
(funcall find-headline path (plist-get info :parse-tree)))))))) ;; No destination found: return nil.
(and (not match-title-p) (puthash path nil link-cache))))))))
(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.

9
testing/lisp/test-ox.el
View File

@ -1467,7 +1467,14 @@ 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."