ox: Abstract fuzzy link searches with search cells
* lisp/ox.el (org-export-search-cells): (org-export-string-to-search-cell): (org-export-match-search-cell-p): New functions. (org-export-resolve-fuzzy-link): Use new functions. * testing/lisp/test-ox.el (test-org-export/fuzzy-link): Tiny refactoring. (test-org-export/resolve-fuzzy-link): Fix failing test.
This commit is contained in:
Nicolas Goaziou
parent
015d971f48
commit
6ec06dcff9
123
lisp/ox.el
123
lisp/ox.el
|
|
@ -4153,6 +4153,66 @@ error if no block contains REF."
|
|||
info 'first-match)
|
||||
(signal 'org-link-broken (list ref))))
|
||||
|
||||
(defun org-export-search-cells (datum)
|
||||
"List search cells for element or object DATUM.
|
||||
|
||||
A search cell follows the pattern (TYPE . SEARCH) where
|
||||
|
||||
TYPE is a symbol among `headline', `custom-id', `target' and
|
||||
`other'.
|
||||
|
||||
SEARCH is the string a link is expected to match. More
|
||||
accurately, it is
|
||||
|
||||
- headline's title, as a list of strings, if TYPE is
|
||||
`headline'.
|
||||
|
||||
- CUSTOM_ID value, as a string, if TYPE is `custom-id'.
|
||||
|
||||
- target's or radio-target's name as a list of strings if
|
||||
TYPE is `target'.
|
||||
|
||||
- NAME affiliated keyword is TYPE is `other'.
|
||||
|
||||
A search cell is the internal representation of a fuzzy link. It
|
||||
ignores white spaces and statistics cookies, if applicable."
|
||||
(pcase (org-element-type datum)
|
||||
(`headline
|
||||
(let ((title (split-string
|
||||
(replace-regexp-in-string
|
||||
"\\[[0-9]*\\(?:%\\|/[0-9]*\\)\\]" ""
|
||||
(org-element-property :raw-value datum)))))
|
||||
(delq nil
|
||||
(list
|
||||
(cons 'headline title)
|
||||
(cons 'other title)
|
||||
(let ((custom-id (org-element-property :custom-id datum)))
|
||||
(and custom-id (cons 'custom-id custom-id)))))))
|
||||
(`target
|
||||
(list (cons 'target (split-string (org-element-property :value datum)))))
|
||||
((and (let name (org-element-property :name datum))
|
||||
(guard name))
|
||||
(list (cons 'other (split-string name))))
|
||||
(_ nil)))
|
||||
|
||||
(defun org-export-string-to-search-cell (s)
|
||||
"Return search cells associated to string S.
|
||||
S is either the path of a fuzzy link or a search option, i.e., it
|
||||
tries to match either a headline (through custom ID or title),
|
||||
a target or a named element."
|
||||
(pcase (string-to-char s)
|
||||
(?* (list (cons 'headline (split-string (substring s 1)))))
|
||||
(?# (list (cons 'custom-id (substring s 1))))
|
||||
((let search (split-string s))
|
||||
(list (cons 'target search) (cons 'other search)))))
|
||||
|
||||
(defun org-export-match-search-cell-p (datum cells)
|
||||
"Non-nil when DATUM matches search cells CELLS.
|
||||
DATUM is an element or object. CELLS is a list of search cells,
|
||||
as returned by `org-export-search-cells'."
|
||||
(let ((targets (org-export-search-cells datum)))
|
||||
(and targets (cl-some (lambda (cell) (member cell targets)) cells))))
|
||||
|
||||
(defun org-export-resolve-fuzzy-link (link info)
|
||||
"Return LINK destination.
|
||||
|
||||
|
|
@ -4172,54 +4232,37 @@ Return value can be an object or an element:
|
|||
|
||||
Assume LINK type is \"fuzzy\". White spaces are not
|
||||
significant."
|
||||
(let* ((raw-path (org-link-unescape (org-element-property :path link)))
|
||||
(headline-only (eq (string-to-char raw-path) ?*))
|
||||
;; Split PATH at white spaces so matches are space
|
||||
;; insensitive.
|
||||
(path (org-split-string
|
||||
(if headline-only (substring raw-path 1) raw-path)))
|
||||
(let* ((search-cells (org-export-string-to-search-cell
|
||||
(org-link-unescape (org-element-property :path link))))
|
||||
(link-cache
|
||||
(or (plist-get info :resolve-fuzzy-link-cache)
|
||||
(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)))
|
||||
(cached (gethash search-cells link-cache 'not-found)))
|
||||
(if (not (eq cached 'not-found)) cached
|
||||
(let ((ast (plist-get info :parse-tree)))
|
||||
(let ((matches
|
||||
(org-element-map (plist-get info :parse-tree)
|
||||
(cons 'target org-element-all-elements)
|
||||
(lambda (datum)
|
||||
(and (org-export-match-search-cell-p datum search-cells)
|
||||
datum)))))
|
||||
(unless matches
|
||||
(signal 'org-link-broken
|
||||
(list (org-element-property :raw-path link))))
|
||||
(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 (signal 'org-link-broken (list raw-path))))
|
||||
search-cells
|
||||
;; There can be multiple matches for un-typed searches, i.e.,
|
||||
;; for searches not starting with # or *. In this case,
|
||||
;; prioritize targets and names over headline titles.
|
||||
;; Matching both a name and a target is not valid, and
|
||||
;; therefore undefined.
|
||||
(or (cl-some (lambda (datum)
|
||||
(and (not (eq (org-element-type datum) 'headline))
|
||||
datum))
|
||||
matches)
|
||||
(car matches))
|
||||
link-cache)))))
|
||||
|
||||
(defun org-export-resolve-id-link (link info)
|
||||
|
|
|
|||
|
|
@ -2517,53 +2517,53 @@ Para2"
|
|||
(ert-deftest test-org-export/fuzzy-link ()
|
||||
"Test fuzzy links specifications."
|
||||
;; Link to an headline should return headline's number.
|
||||
(org-test-with-parsed-data
|
||||
"Paragraph.\n* Head1\n* Head2\n* Head3\n[[Head2]]"
|
||||
(should
|
||||
;; Note: Headline's number is in fact a list of numbers.
|
||||
(equal '(2)
|
||||
(should
|
||||
;; Note: Headline's number is in fact a list of numbers.
|
||||
(equal '(2)
|
||||
(org-test-with-parsed-data
|
||||
"Paragraph.\n* Head1\n* Head2\n* Head3\n[[Head2]]"
|
||||
(org-element-map tree 'link
|
||||
(lambda (link)
|
||||
(org-export-get-ordinal
|
||||
(org-export-resolve-fuzzy-link link info) info)) info t))))
|
||||
;; Link to a target in an item should return item's number.
|
||||
(org-test-with-parsed-data
|
||||
"- Item1\n - Item11\n - <<test>>Item12\n- Item2\n\n\n[[test]]"
|
||||
(should
|
||||
;; Note: Item's number is in fact a list of numbers.
|
||||
(equal '(1 2)
|
||||
(should
|
||||
;; Note: Item's number is in fact a list of numbers.
|
||||
(equal '(1 2)
|
||||
(org-test-with-parsed-data
|
||||
"- Item1\n - Item11\n - <<test>>Item12\n- Item2\n\n\n[[test]]"
|
||||
(org-element-map tree 'link
|
||||
(lambda (link)
|
||||
(org-export-get-ordinal
|
||||
(org-export-resolve-fuzzy-link link info) info)) info t))))
|
||||
;; Link to a target in a footnote should return footnote's number.
|
||||
(org-test-with-parsed-data "
|
||||
(should
|
||||
(equal '(2 3)
|
||||
(org-test-with-parsed-data "
|
||||
Paragraph[fn:1][fn:2][fn:lbl3:C<<target>>][[test]][[target]]
|
||||
\[fn:1] A
|
||||
|
||||
\[fn:2] <<test>>B"
|
||||
(should
|
||||
(equal '(2 3)
|
||||
(org-element-map tree 'link
|
||||
(lambda (link)
|
||||
(org-export-get-ordinal
|
||||
(org-export-resolve-fuzzy-link link info) info)) info))))
|
||||
;; Link to a named element should return sequence number of that
|
||||
;; element.
|
||||
(org-test-with-parsed-data
|
||||
"#+NAME: tbl1\n|1|2|\n#+NAME: tbl2\n|3|4|\n#+NAME: tbl3\n|5|6|\n[[tbl2]]"
|
||||
(should
|
||||
(= 2
|
||||
(should
|
||||
(= 2
|
||||
(org-test-with-parsed-data
|
||||
"#+NAME: tbl1\n|1|2|\n#+NAME: tbl2\n|3|4|\n#+NAME: tbl3\n|5|6|\n[[tbl2]]"
|
||||
(org-element-map tree 'link
|
||||
(lambda (link)
|
||||
(org-export-get-ordinal
|
||||
(org-export-resolve-fuzzy-link link info) info)) info t))))
|
||||
;; Link to a target not within an item, a table, a footnote
|
||||
;; reference or definition should return section number.
|
||||
(org-test-with-parsed-data
|
||||
"* Head1\n* Head2\nParagraph<<target>>\n* Head3\n[[target]]"
|
||||
(should
|
||||
(equal '(2)
|
||||
(should
|
||||
(equal '(2)
|
||||
(org-test-with-parsed-data
|
||||
"* Head1\n* Head2\nParagraph<<target>>\n* Head3\n[[target]]"
|
||||
(org-element-map tree 'link
|
||||
(lambda (link)
|
||||
(org-export-get-ordinal
|
||||
|
|
@ -2697,12 +2697,10 @@ Another text. (ref:text)
|
|||
(org-test-with-parsed-data "* My headline\n[[My headline]]"
|
||||
(org-export-resolve-fuzzy-link
|
||||
(org-element-map tree 'link 'identity info t) info)))
|
||||
;; Targets objects have priority over named elements and headline
|
||||
;; titles.
|
||||
;; Targets objects have priority over headline titles.
|
||||
(should
|
||||
(eq 'target
|
||||
(org-test-with-parsed-data
|
||||
"* target\n#+NAME: target\n<<target>>\n\n[[target]]"
|
||||
(org-test-with-parsed-data "* target\n<<target>>[[target]]"
|
||||
(org-element-type
|
||||
(org-export-resolve-fuzzy-link
|
||||
(org-element-map tree 'link 'identity info t) info)))))
|
||||
|
|
|
|||
Loading…
Reference in New Issue