summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorNicolas Goaziou <mail@nicolasgoaziou.fr>2016-03-06 22:42:26 +0100
committerNicolas Goaziou <mail@nicolasgoaziou.fr>2016-03-12 23:18:55 +0100
commit6ec06dcff98e2db9811d1d1e9da01399e9cc1fe3 (patch)
tree7e5ee78e363f3325956fe0f506bc18f134649a0c
parent015d971f483bf480b381b4282597bed7f5f2ccf3 (diff)
downloadorg-mode-6ec06dcff98e2db9811d1d1e9da01399e9cc1fe3.tar.gz
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.
-rw-r--r--lisp/ox.el123
-rw-r--r--testing/lisp/test-ox.el48
2 files changed, 106 insertions, 65 deletions
diff --git a/lisp/ox.el b/lisp/ox.el
index a932943..bb94559 100644
--- a/lisp/ox.el
+++ b/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)
diff --git a/testing/lisp/test-ox.el b/testing/lisp/test-ox.el
index 43fa092..0b89d42 100644
--- a/testing/lisp/test-ox.el
+++ b/testing/lisp/test-ox.el
@@ -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)))))