From 6ec06dcff98e2db9811d1d1e9da01399e9cc1fe3 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Sun, 6 Mar 2016 22:42:26 +0100 Subject: [PATCH] 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. --- lisp/ox.el | 123 +++++++++++++++++++++++++++------------- testing/lisp/test-ox.el | 48 ++++++++-------- 2 files changed, 106 insertions(+), 65 deletions(-) diff --git a/lisp/ox.el b/lisp/ox.el index a93294386..bb94559ac 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 "<>" 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 43fa092a0..0b89d4265 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 - <>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 - <>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<>][[test]][[target]] \[fn:1] A \[fn:2] <>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<>\n* Head3\n[[target]]" - (should - (equal '(2) + (should + (equal '(2) + (org-test-with-parsed-data + "* Head1\n* Head2\nParagraph<>\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<>\n\n[[target]]" + (org-test-with-parsed-data "* target\n<>[[target]]" (org-element-type (org-export-resolve-fuzzy-link (org-element-map tree 'link 'identity info t) info)))))