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

Simplify matching headlines in `org-link-search' 

* lisp/org.el (org-link-search): Simplify matching headlines.
This commit is contained in:
Nicolas Goaziou 2016-12-08 22:40:18 +01:00
parent b7cb9b54d5
commit e32aca36a4
1 changed files with 100 additions and 104 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

204
lisp/org.el
View File

@ -11156,7 +11156,8 @@ of matched result, which is either `dedicated' or `fuzzy'."
(let* ((case-fold-search t) (let* ((case-fold-search t)
(origin (point)) (origin (point))
(normalized (replace-regexp-in-string "\n[ \t]*" " " s)) (normalized (replace-regexp-in-string "\n[ \t]*" " " s))
(words (org-split-string s "[ \t\n]+")) (starred (eq (string-to-char normalized) ?*))
(words (split-string (if starred (substring s 1) s)))
(s-multi-re (mapconcat #'regexp-quote words "[ \t]+\\(?:\n[ \t]*\\)?")) (s-multi-re (mapconcat #'regexp-quote words "[ \t]+\\(?:\n[ \t]*\\)?"))
(s-single-re (mapconcat #'regexp-quote words "[ \t]+")) (s-single-re (mapconcat #'regexp-quote words "[ \t]+"))
type) type)
@ -11198,109 +11199,104 @@ of matched result, which is either `dedicated' or `fuzzy'."
;; Look for a regular expression. ;; Look for a regular expression.
(funcall (if (derived-mode-p 'org-mode) #'org-occur #'org-do-occur) (funcall (if (derived-mode-p 'org-mode) #'org-occur #'org-do-occur)
(match-string 1 s))) (match-string 1 s)))
;; Fuzzy links. ;; From here, we handle fuzzy links.
(t ;;
(let ((starred (eq (string-to-char normalized) ?*))) ;; Look for targets, only if not in a headline search.
(cond ((and (not starred)
;; Look for targets, only if not in a headline search. (let ((target (format "<<%s>>" s-multi-re)))
((and (not starred) (catch :target-match
(let ((target (format "<<%s>>" s-multi-re))) (goto-char (point-min))
(catch :target-match (while (re-search-forward target nil t)
(goto-char (point-min)) (backward-char)
(while (re-search-forward target nil t) (let ((context (org-element-context)))
(backward-char) (when (eq (org-element-type context) 'target)
(let ((context (org-element-context))) (setq type 'dedicated)
(when (eq (org-element-type context) 'target) (goto-char (org-element-property :begin context))
(setq type 'dedicated) (throw :target-match t))))
(goto-char (org-element-property :begin context)) nil))))
(throw :target-match t)))) ;; Look for elements named after S, only if not in a headline
nil)))) ;; search.
;; Look for elements named after S, only if not in a headline ((and (not starred)
;; search. (let ((name (format "^[ \t]*#\\+NAME: +%s[ \t]*$" s-single-re)))
((and (not starred) (catch :name-match
(let ((name (format "^[ \t]*#\\+NAME: +%s[ \t]*$" s-single-re))) (goto-char (point-min))
(catch :name-match (while (re-search-forward name nil t)
(goto-char (point-min)) (let ((element (org-element-at-point)))
(while (re-search-forward name nil t) (when (equal words
(let ((element (org-element-at-point))) (split-string
(when (equal (org-split-string (org-element-property :name element)))
(org-element-property :name element) (setq type 'dedicated)
"[ \t]+") (beginning-of-line)
words) (throw :name-match t))))
(setq type 'dedicated) nil))))
(beginning-of-line) ;; Regular text search. Prefer headlines in Org mode buffers.
(throw :name-match t)))) ;; Ignore COMMENT keyword, TODO keywords, priority cookies,
nil)))) ;; statistics cookies and tags.
;; Regular text search. Prefer headlines in Org mode ((and (derived-mode-p 'org-mode)
;; buffers. (let ((title-re
((and (derived-mode-p 'org-mode) (format "%s[ \t]*\\(?:%s[ \t]+\\)?.*%s"
(let* ((wspace "[ \t]") org-outline-regexp-bol
(wspaceopt (concat wspace "*")) org-comment-string
(cookie (concat "\\(?:" (mapconcat
wspaceopt (lambda (w) (format "\\<%s\\>" (regexp-quote w)))
"\\[[0-9]*\\(?:%\\|/[0-9]*\\)\\]" words
wspaceopt ".+")))
"\\)")) (cookie-re "\\[[0-9]*\\(?:%\\|/[0-9]*\\)\\]")
(sep (concat "\\(?:\\(?:" wspace "\\|" cookie "\\)+\\)")) (comment-re (format "\\`%s[ \t]+" org-comment-string)))
(title (goto-char (point-min))
(format "\\(?:%s[ \t]+\\)?%s?%s%s?" (catch :found
org-comment-string (while (re-search-forward title-re nil t)
sep (when (equal words
(let ((re (mapconcat #'regexp-quote words sep))) (split-string
(if starred (substring re 1) re)) (replace-regexp-in-string
sep)) cookie-re ""
(exact-title (format "\\`%s\\'" title)) (replace-regexp-in-string
(re (concat org-outline-regexp-bol "+.*" title))) comment-re "" (org-get-heading t t)))))
(goto-char (point-min)) (throw :found t)))
(catch :found nil)))
(while (re-search-forward re nil t) (beginning-of-line)
(when (string-match-p exact-title (org-get-heading t t)) (setq type 'dedicated))
(throw :found t))) ;; Offer to create non-existent headline depending on
nil))) ;; `org-link-search-must-match-exact-headline'.
(beginning-of-line) ((and (derived-mode-p 'org-mode)
(setq type 'dedicated)) (not org-link-search-inhibit-query)
;; Offer to create non-existent headline depending on (eq org-link-search-must-match-exact-headline 'query-to-create)
;; `org-link-search-must-match-exact-headline'. (yes-or-no-p "No match - create this as a new heading? "))
((and (derived-mode-p 'org-mode) (goto-char (point-max))
(not org-link-search-inhibit-query) (unless (bolp) (newline))
(eq org-link-search-must-match-exact-headline 'query-to-create) (org-insert-heading nil t t)
(yes-or-no-p "No match - create this as a new heading? ")) (insert s "\n")
(goto-char (point-max)) (beginning-of-line 0))
(unless (bolp) (newline)) ;; Only headlines are looked after. No need to process
(org-insert-heading nil t t) ;; further: throw an error.
(insert s "\n") ((and (derived-mode-p 'org-mode)
(beginning-of-line 0)) (or starred org-link-search-must-match-exact-headline))
;; Only headlines are looked after. No need to process (goto-char origin)
;; further: throw an error. (error "No match for fuzzy expression: %s" normalized))
((and (derived-mode-p 'org-mode) ;; Regular text search.
(or starred org-link-search-must-match-exact-headline)) ((catch :fuzzy-match
(goto-char origin) (goto-char (point-min))
(error "No match for fuzzy expression: %s" normalized)) (while (re-search-forward s-multi-re nil t)
;; Regular text search. ;; Skip match if it contains AVOID-POS or it is included in
((catch :fuzzy-match ;; a link with a description but outside the description.
(goto-char (point-min)) (unless (or (and avoid-pos
(while (re-search-forward s-multi-re nil t) (<= (match-beginning 0) avoid-pos)
;; Skip match if it contains AVOID-POS or it is included (> (match-end 0) avoid-pos))
;; in a link with a description but outside the (and (save-match-data
;; description. (org-in-regexp org-bracket-link-regexp))
(unless (or (and avoid-pos (match-beginning 3)
(<= (match-beginning 0) avoid-pos) (or (> (match-beginning 3) (point))
(> (match-end 0) avoid-pos)) (<= (match-end 3) (point)))
(and (save-match-data (org-element-lineage
(org-in-regexp org-bracket-link-regexp)) (save-match-data (org-element-context))
(match-beginning 3) '(link) t)))
(or (> (match-beginning 3) (point)) (goto-char (match-beginning 0))
(<= (match-end 3) (point))) (setq type 'fuzzy)
(org-element-lineage (throw :fuzzy-match t)))
(save-match-data (org-element-context)) nil))
'(link) t))) ;; All failed. Throw an error.
(goto-char (match-beginning 0)) (t (goto-char origin)
(setq type 'fuzzy) (error "No match for fuzzy expression: %s" normalized)))
(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. ;; Disclose surroundings of match, if appropriate.
(when (and (derived-mode-p 'org-mode) (not stealth)) (when (and (derived-mode-p 'org-mode) (not stealth))
(org-show-context 'link-search)) (org-show-context 'link-search))