diff --git a/lisp/org.el b/lisp/org.el index 1f7d4568b..0ce4efe3d 100755 --- a/lisp/org.el +++ b/lisp/org.el @@ -10603,9 +10603,6 @@ See the docstring of `org-open-file' for details." "The window configuration before following a link. This is saved in case the need arises to restore it.") -(defvar org-open-link-marker (make-marker) - "Marker pointing to the location where `org-open-at-point' was called.") - ;;;###autoload (defun org-open-at-point-global () "Follow a link like Org-mode does. @@ -10670,7 +10667,6 @@ link in a property drawer line." ;; On a code block, open block's results. (unless (call-interactively 'org-babel-open-src-block-result) (org-load-modules-maybe) - (move-marker org-open-link-marker (point)) (setq org-window-config-before-follow-link (current-window-configuration)) (org-remove-occur-highlights nil nil t) (unless (run-hook-with-args-until-success 'org-open-at-point-functions) @@ -10858,7 +10854,6 @@ link in a property drawer line." (line-beginning-position))))))) (org-footnote-action)) (t (user-error "No link found"))))) - (move-marker org-open-link-marker nil) (run-hook-with-args 'org-follow-link-hook))) (defun org-offer-links-in-entry (buffer marker &optional nth zero) @@ -10977,170 +10972,178 @@ the window configuration before `org-open-at-point' was called using: (set-window-configuration org-window-config-before-follow-link)") (defun org-link-search (s &optional type avoid-pos stealth) - "Search for a link search option. -If S is surrounded by forward slashes, it is interpreted as a -regular expression. In org-mode files, this will create an `org-occur' -sparse tree. In ordinary files, `occur' will be used to list matches. -If the current buffer is in `dired-mode', grep will be used to search -in all files. If AVOID-POS is given, ignore matches near that position. + "Search for a search string S. + +If S starts with \"#\", it triggers a custom ID search. + +If S is enclosed within parenthesis, it initiates a coderef +search. + +If S is surrounded by forward slashes, it is interpreted as +a regular expression. In Org mode files, this will create an +`org-occur' sparse tree. In ordinary files, `occur' will be used +to list matches. If the current buffer is in `dired-mode', grep +will be used to search in all files. + +When optional argument TYPE is `org-occur', call this function on +a regexp matching S. If it is `occur', call Emacs' `occur' +function instead. + +When AVOID-POS is given, ignore matches near that position. When optional argument STEALTH is non-nil, do not modify visibility around point, thus ignoring `org-show-context-detail' -variable." - (let ((case-fold-search t) - (s0 (mapconcat 'identity (org-split-string s "[ \t\r\n]+") " ")) - (markers (concat "\\(?:" (mapconcat (lambda (x) (regexp-quote (car x))) - (append '(("") (" ") ("\t") ("\n")) - org-emphasis-alist) - "\\|") "\\)")) - (pos (point)) - words re0 re2 re4_ re4 re5 re2a re2a_ reall) +variable. + +Search is case-insensitive and ignores white spaces." + (unless (org-string-nw-p s) (error "Invalid search string \"%s\"" s)) + (let* ((case-fold-search t) + (origin (point)) + (normalized (replace-regexp-in-string "\n[ \t]*" " " s)) + (words (org-split-string s "[ \t\n]+")) + (s-multi-re (mapconcat #'regexp-quote words "[ \t]+\\(?:\n[ \t]*\\)?")) + (s-single-re (mapconcat #'regexp-quote words "[ \t]+"))) (cond - ;; First check if there are any special search functions + ;; Check if there are any special search functions. ((run-hook-with-args-until-success 'org-execute-file-search-functions s)) - ;; Now try the builtin stuff - ((and (eq (aref s0 0) ?#) - (> (length s0) 1) - (let ((match (org-find-property "CUSTOM_ID" (substring s0 1)))) - (and match (goto-char match) (setf type 'dedicated))))) - ((save-excursion + ((eq (string-to-char s) ?#) + ;; Look for a custom ID S if S starts with "#". + (let* ((id (substring normalized 1)) + (match (org-find-property "CUSTOM_ID" id))) + (if match (progn (goto-char match) (setf type 'dedicated)) + (error "No match for custom ID: %s" id)))) + ((string-match "\\`(\\(.*\\))\\'" normalized) + ;; Look for coderef targets if S is enclosed within parenthesis. + (let ((coderef (match-string-no-properties 1 normalized)) + (re (substring s-single-re 1 -1))) (goto-char (point-min)) - (and - (re-search-forward - (concat "<<" (regexp-quote s0) ">>") nil t) - (setq type 'dedicated - pos (match-beginning 0)))) - ;; There is an exact target for this - (goto-char pos)) - ((save-excursion - (goto-char (point-min)) - (and - (re-search-forward - (format "^[ \t]*#\\+NAME: %s" (regexp-quote s0)) nil t) - (setq type 'dedicated pos (match-beginning 0)))) - ;; Found an element with a matching #+name affiliated keyword. - (goto-char pos)) - ((and (string-match "^(\\(.*\\))$" s0) - (save-excursion - (goto-char (point-min)) - (and - (re-search-forward - (concat "[^[]" (regexp-quote - (format org-coderef-label-format - (match-string 1 s0)))) - nil t) - (setq type 'dedicated - pos (1+ (match-beginning 0)))))) - ;; There is a coderef target for this - (goto-char pos)) - ((string-match "^/\\(.*\\)/$" s) - ;; A regular expression + (catch :coderef-match + (while (re-search-forward re nil t) + (let ((element (org-element-at-point))) + (when (and (memq (org-element-type element) + '(example-block src-block)) + ;; Build proper regexp according to current + ;; block's label format. + (let ((label-fmt + (regexp-quote + (or (org-element-property :label-fmt element) + org-coderef-label-format)))) + (save-excursion + (beginning-of-line) + (looking-at (format ".*?\\(%s\\)[ \t]*$" + (format label-fmt coderef)))))) + (setq type 'dedicated) + (goto-char (match-beginning 1)) + (throw :coderef-match nil)))) + (goto-char origin) + (error "No match for coderef: %s" coderef)))) + ((string-match "\\`/\\(.*\\)/\\'" normalized) + ;; Look for a regular expression. (cond ((derived-mode-p 'org-mode) (org-occur (match-string 1 s))) (t (org-do-occur (match-string 1 s))))) - ((and (derived-mode-p 'org-mode) - (or (and (equal (string-to-char s) ?*) (setq s (substring s 1))) - org-link-search-must-match-exact-headline)) - ;; Headline search. - (goto-char (point-min)) - (cond - ((let (case-fold-search) - (re-search-forward - (let* ((wspace "[ \t]") - (wspaceopt (concat wspace "*")) - (cookie (concat "\\(?:" - wspaceopt - "\\[[0-9]*\\(?:%\\|/[0-9]*\\)\\]" - wspaceopt - "\\)")) - (sep (concat "\\(?:" wspace "+\\|" cookie "+\\)"))) - (concat - org-outline-regexp-bol - "\\(?:" org-todo-regexp "[ \t]+\\)?" - "\\(?:\\[#.\\][ \t]+\\)?" - "\\(?:" org-comment-string "[ \t]+\\)?" - sep "*" - (mapconcat #'identity - (org-split-string (regexp-quote s)) - (concat sep "+")) - sep "*" - (org-re "\\(?:[ \t]+:[[:alnum:]_@#%%:]+:\\)?") - "[ \t]*$")) - nil t)) - ;; OK, found a match - (setq type 'dedicated) - (goto-char (match-beginning 0))) - ((and (not org-link-search-inhibit-query) - (eq org-link-search-must-match-exact-headline 'query-to-create) - (y-or-n-p "No match - create this as a new heading? ")) - (goto-char (point-max)) - (unless (bolp) (newline)) - (org-insert-heading nil t t) - (insert s "\n") - (beginning-of-line 0)) - (t - (goto-char pos) - (error "No match")))) + ;; Fuzzy links. (t - ;; A normal search string - (remove-text-properties - 0 (length s) - '(face nil mouse-face nil keymap nil fontified nil) s) - ;; Make a series of regular expressions to find a match - (setq words (org-split-string s "[ \n\r\t]+") - - re0 (concat "\\(<<" (regexp-quote s0) ">>\\)") - re2 (concat markers "\\(" (mapconcat 'downcase words "[ \t]+") - "\\)" markers) - re2a_ (concat "\\(" (mapconcat 'downcase words - "[ \t\r\n]+") "\\)[ \t\r\n]") - re2a (concat "[ \t\r\n]" re2a_) - re4_ (concat "\\(" (mapconcat 'downcase words - "[^a-zA-Z_\r\n]+") "\\)[^a-zA-Z_]") - re4 (concat "[^a-zA-Z_]" re4_) - - re5 (concat ".*" re4) - reall (concat "\\(" re0 "\\)\\|\\(" re2 "\\)\\|\\(" re4 - "\\)\\|\\(" re5 "\\)")) - (cond - ((eq type 'org-occur) (org-occur reall)) - ((eq type 'occur) (org-do-occur (downcase reall) 'cleanup)) - (t (goto-char (point-min)) - (setq type 'fuzzy) - (if (or (and (org-search-not-self 1 re0 nil t) - (setq type 'dedicated)) - (org-search-not-self 1 re2 nil t) - (org-search-not-self 1 re2a nil t) - (org-search-not-self 1 re4 nil t) - (org-search-not-self 1 re5 nil t)) - (goto-char (match-beginning 1)) - (goto-char pos) - (error "No match")))))) - (and (derived-mode-p 'org-mode) - (not stealth) - (org-show-context 'link-search)) + (let* ((starred (eq (string-to-char normalized) ?*)) + (headline-search (and (derived-mode-p 'org-mode) + (or org-link-search-must-match-exact-headline + starred)))) + (cond + ;; Look for targets, only if not in a headline search. + ((and (not headline-search) + (let ((target (format "<<%s>>" s-multi-re))) + (catch :target-match + (goto-char (point-min)) + (while (re-search-forward target nil t) + (backward-char) + (let ((context (org-element-context))) + (when (eq (org-element-type context) 'target) + (setq type 'dedicated) + (goto-char (org-element-property :begin context)) + (throw :target-match t)))) + nil)))) + ;; Look for elements named after S, only if not in a headline + ;; search. + ((and (not headline-search) + (let ((name (format "^[ \t]*#\\+NAME: +%s[ \t]*$" s-single-re))) + (catch :name-match + (goto-char (point-min)) + (while (re-search-forward name nil t) + (let ((element (org-element-at-point))) + (when (equal (org-split-string + (org-element-property :name element) + "[ \t]+") + words) + (setq type 'dedicated) + (beginning-of-line) + (throw :name-match t)))) + nil)))) + ;; Regular text search. Prefer headlines in Org mode + ;; buffers. + ((and (derived-mode-p 'org-mode) + (let* ((wspace "[ \t]") + (wspaceopt (concat wspace "*")) + (cookie (concat "\\(?:" + wspaceopt + "\\[[0-9]*\\(?:%\\|/[0-9]*\\)\\]" + wspaceopt + "\\)")) + (sep (concat "\\(?:" wspace "+\\|" cookie "+\\)")) + (re (concat + org-outline-regexp-bol + "\\(?:" org-todo-regexp "[ \t]+\\)?" + "\\(?:\\[#.\\][ \t]+\\)?" + "\\(?:" org-comment-string "[ \t]+\\)?" + sep "*" + (let ((title (mapconcat #'regexp-quote + words + (concat sep "+")))) + (if starred (substring title 1) title)) + sep "*" + (org-re "\\(?:[ \t]+:[[:alnum:]_@#%%:]+:\\)?") + "[ \t]*$"))) + (goto-char (point-min)) + (re-search-forward re nil t))) + (goto-char (match-beginning 0)) + (setq type 'dedicated)) + ;; Offer to create non-existent headline depending on + ;; `org-link-search-must-match-exact-headline'. + ((and headline-search + (not org-link-search-inhibit-query) + (eq org-link-search-must-match-exact-headline 'query-to-create) + (yes-or-no-p "No match - create this as a new heading? ")) + (goto-char (point-max)) + (unless (bolp) (newline)) + (org-insert-heading nil t t) + (insert s "\n") + (beginning-of-line 0)) + ;; Only headlines are looked after. No need to process + ;; further: throw an error. + (headline-search + (goto-char origin) + (error "No match for fuzzy expression: %s" normalized)) + ;; Regular text search or occur, depending on TYPE. + ((eq type 'org-occur) (org-occur s-multi-re)) + ((eq type 'occur) (org-do-occur s-multi-re 'cleanup)) + ((catch :fuzzy-match + (goto-char (point-min)) + (while (re-search-forward s-multi-re nil t) + (unless (and avoid-pos + (>= (match-beginning 0) avoid-pos) + (< (match-end 0) avoid-pos)) + (goto-char (match-beginning 0)) + (setq type 'fuzzy) + (throw :fuzzy-match t))) + nil)) + ;; All failed. Throw an error. + (t (goto-char origin) + (error "No match for fuzzy expression: %s" normalized)))))) + ;; Disclose surroundings of match, if appropriate. + (when (and (derived-mode-p 'org-mode) (not stealth)) + (org-show-context 'link-search)) type)) -(defun org-search-not-self (group &rest args) - "Execute `re-search-forward', but only accept matches that do not -enclose the position of `org-open-link-marker'." - (let ((m org-open-link-marker)) - (catch 'exit - (while (apply 're-search-forward args) - (unless (get-text-property (match-end group) 'intangible) ; Emacs 21 - (goto-char (match-end group)) - (if (and (or (not (eq (marker-buffer m) (current-buffer))) - (> (match-beginning 0) (marker-position m)) - (< (match-end 0) (marker-position m))) - (save-match-data - (or (not (org-in-regexp - org-bracket-link-analytic-regexp 1)) - (not (match-end 4)) ; no description - (and (<= (match-beginning 4) (point)) - (>= (match-end 4) (point)))))) - (throw 'exit (point)))))))) - (defun org-get-buffer-for-internal-link (buffer) "Return a buffer to be used for displaying the link target of internal links." (cond diff --git a/lisp/ox.el b/lisp/ox.el index b06211b87..e7ecacbb2 100644 --- a/lisp/ox.el +++ b/lisp/ox.el @@ -3297,7 +3297,7 @@ Return a string of lines to be included in the format expected by (let ((org-inhibit-startup t)) (org-mode))) (condition-case err ;; Enforce consistent search. - (let ((org-link-search-must-match-exact-headline t)) + (let ((org-link-search-must-match-exact-headline nil)) (org-link-search location)) (error (error "%s for %s::%s" (error-message-string err) file location))) diff --git a/testing/lisp/test-org.el b/testing/lisp/test-org.el index 9243be491..c8052f760 100644 --- a/testing/lisp/test-org.el +++ b/testing/lisp/test-org.el @@ -886,7 +886,8 @@ ;; is non-nil. (should (org-test-with-temp-text "Link [[target]] <>" - (let ((org-return-follows-link t)) (org-return)) + (let ((org-return-follows-link t) + (org-link-search-must-match-exact-headline nil)) (org-return)) (org-looking-at-p "<>"))) (should-not (org-test-with-temp-text "Link [[target]] <>" @@ -1422,10 +1423,18 @@ #+BEGIN_SRC emacs-lisp \(+ 1 1) (ref:sc) #+END_SRC -\[[(sc)]]" - (goto-char (point-max)) +\[[(sc)]]" (org-open-at-point) - (looking-at "(ref:sc)")))) + (looking-at "(ref:sc)"))) + ;; Find coderef even with alternate label format. + (should + (org-test-with-temp-text " +#+BEGIN_SRC emacs-lisp -l \"{ref:%s}\" +\(+ 1 1) {ref:sc} +#+END_SRC +\[[(sc)]]" + (org-open-at-point) + (looking-at "{ref:sc}")))) ;;;; Custom ID @@ -1433,16 +1442,14 @@ "Test custom ID links specifications." (should (org-test-with-temp-text - "* H1\n:PROPERTIES:\n:CUSTOM_ID: custom\n:END:\n* H2\n[[#custom]]" - (goto-char (point-max)) + "* H1\n:PROPERTIES:\n:CUSTOM_ID: custom\n:END:\n* H2\n[[#custom]]" (org-open-at-point) (org-looking-at-p "\\* H1"))) - ;; Ignore false positives. - (should-not + ;; Throw an error on false positives. + (should-error (org-test-with-temp-text "* H1\n:DRAWER:\n:CUSTOM_ID: custom\n:END:\n* H2\n[[#custom]]" - (goto-char (point-max)) - (let (org-link-search-must-match-exact-headline) (org-open-at-point)) + (org-open-at-point) (org-looking-at-p "\\* H1")))) ;;;; Fuzzy Links @@ -1454,27 +1461,24 @@ "Test fuzzy links specifications." ;; Fuzzy link goes in priority to a matching target. (should - (org-test-with-temp-text "#+NAME: Test\n|a|b|\n<>\n* Test\n[[Test]]" - (goto-line 5) - (org-open-at-point) + (org-test-with-temp-text + "#+NAME: Test\n|a|b|\n<>\n* Test\n[[Test]]" + (let ((org-link-search-must-match-exact-headline nil)) (org-open-at-point)) (looking-at "<>"))) ;; Then fuzzy link points to an element with a given name. (should - (org-test-with-temp-text "Test\n#+NAME: Test\n|a|b|\n* Test\n[[Test]]" - (goto-line 5) - (org-open-at-point) + (org-test-with-temp-text "Test\n#+NAME: Test\n|a|b|\n* Test\n[[Test]]" + (let ((org-link-search-must-match-exact-headline nil)) (org-open-at-point)) (looking-at "#\\+NAME: Test"))) ;; A target still lead to a matching headline otherwise. (should - (org-test-with-temp-text "* Head1\n* Head2\n*Head3\n[[Head2]]" - (goto-line 4) - (org-open-at-point) + (org-test-with-temp-text "* Head1\n* Head2\n*Head3\n[[Head2]]" + (let ((org-link-search-must-match-exact-headline nil)) (org-open-at-point)) (looking-at "\\* Head2"))) ;; With a leading star in link, enforce heading match. (should - (org-test-with-temp-text "* Test\n<>\n[[*Test]]" - (goto-line 3) - (org-open-at-point) + (org-test-with-temp-text "* Test\n<>\n[[*Test]]" + (let ((org-link-search-must-match-exact-headline nil)) (org-open-at-point)) (looking-at "\\* Test"))) ;; With a leading star in link, enforce exact heading match, even ;; with `org-link-search-must-match-exact-headline' set to nil. @@ -1482,7 +1486,16 @@ (org-test-with-temp-text "* Test 1\nFoo Bar\n[[*Test]]" (let ((org-link-search-must-match-exact-headline nil)) (org-open-at-point)))) - ;; Heading match should not care about spaces, cookies, todo + ;; Handle non-nil `org-link-search-must-match-exact-headline'. + (should + (org-test-with-temp-text "* Test\nFoo Bar\n[[Test]]" + (let ((org-link-search-must-match-exact-headline t)) (org-open-at-point)) + (looking-at "\\* Test"))) + (should + (org-test-with-temp-text "* Test\nFoo Bar\n[[*Test]]" + (let ((org-link-search-must-match-exact-headline t)) (org-open-at-point)) + (looking-at "\\* Test"))) + ;; Heading match should not care about spaces, cookies, TODO ;; keywords, priorities, and tags. (should (let ((first-line diff --git a/testing/lisp/test-ox.el b/testing/lisp/test-ox.el index 9bf4b0cad..e795226de 100644 --- a/testing/lisp/test-ox.el +++ b/testing/lisp/test-ox.el @@ -911,40 +911,40 @@ text (equal "#+BEGIN_EXAMPLE\nSmall Org file with an include keyword.\n#+END_EXAMPLE\n" (org-test-with-temp-text - (format "#+INCLUDE: \"%s/examples/include.org\" :lines \"1-2\" EXAMPLE" - org-test-dir) - (org-export-expand-include-keyword) - (buffer-string)))) + (format "#+INCLUDE: \"%s/examples/include.org\" :lines \"1-2\" EXAMPLE" + org-test-dir) + (org-export-expand-include-keyword) + (buffer-string)))) ;; Inclusion within a src-block. (should (equal "#+BEGIN_SRC emacs-lisp\n(+ 2 1)\n#+END_SRC\n" (org-test-with-temp-text - (format - "#+INCLUDE: \"%s/examples/include.org\" :lines \"4-5\" SRC emacs-lisp" - org-test-dir) - (org-export-expand-include-keyword) - (buffer-string)))) + (format + "#+INCLUDE: \"%s/examples/include.org\" :lines \"4-5\" SRC emacs-lisp" + org-test-dir) + (org-export-expand-include-keyword) + (buffer-string)))) ;; Inclusion within an html export-block. (should (equal "#+BEGIN_HTML\n

HTML!

\n#+END_HTML\n" (org-test-with-temp-text - (format - "#+INCLUDE: \"%s/examples/include.html\" HTML" - org-test-dir) - (org-export-expand-include-keyword) - (buffer-string)))) + (format + "#+INCLUDE: \"%s/examples/include.html\" HTML" + org-test-dir) + (org-export-expand-include-keyword) + (buffer-string)))) ;; Inclusion within an center paragraph (should (equal "#+BEGIN_CENTER\nSuccess!\n#+END_CENTER\n" (org-test-with-temp-text - (format - "#+INCLUDE: \"%s/examples/include2.org\" CENTER" - org-test-dir) - (org-export-expand-include-keyword) - (buffer-string)))) + (format + "#+INCLUDE: \"%s/examples/include2.org\" CENTER" + org-test-dir) + (org-export-expand-include-keyword) + (buffer-string)))) ;; Footnotes labels are local to each included file. (should (= 6 @@ -1016,15 +1016,15 @@ Footnotes[fn:2], foot[fn:test], digit only[3], and [fn:inline:anonymous footnote (equal "body\n" (org-test-with-temp-text - (concat - (format "#+INCLUDE: \"%s/examples/include.org::*Heading\" " org-test-dir) - ":only-contents t") + (concat + (format "#+INCLUDE: \"%s/examples/include.org::*Heading\" " org-test-dir) + ":only-contents t") (org-export-expand-include-keyword) (buffer-string)))) ;; Headings can be included via CUSTOM_ID. (should (org-test-with-temp-text - (format "#+INCLUDE: \"%s/examples/include.org::#ah\"" org-test-dir) + (format "#+INCLUDE: \"%s/examples/include.org::#ah\"" org-test-dir) (org-export-expand-include-keyword) (goto-char (point-min)) (looking-at "* Another heading"))) @@ -1039,7 +1039,7 @@ Footnotes[fn:2], foot[fn:test], digit only[3], and [fn:inline:anonymous footnote ;; Including non-existing elements should result in an error. (should-error (org-test-with-temp-text - (format "#+INCLUDE: \"%s/examples/include.org::*non-existing heading\"" org-test-dir) + (format "#+INCLUDE: \"%s/examples/include.org::*non-existing heading\"" org-test-dir) (org-export-expand-include-keyword))) ;; Lines work relatively to an included element. (should