forked from mirrors/org-mode
Fix TODO keywords case sensitivity
* lisp/org.el (org-todo-regexp): (org-not-done-regexp): (org-not-done-heading-regexp): (org-todo-line-regexp): (org-complex-heading-regexp): Improve docstrings. (org-insert-todo-heading): (org-fix-position-after-promote): (org-link-search): (org-block-todo-from-children-or-siblings-or-parent): (org-get-todo-state): (org-priority): (org-point-at-end-of-empty-headline): * lisp/org-agenda.el (org-fix-agenda-info): (org-agenda-get-todos): (org-cmp-alpha): * lisp/org-archive.el (org-archive-subtree): (org-archive-all-done): * lisp/org-list.el (org-toggle-item): * lisp/org-pcomplete.el (pcomplete/org-mode/searchhead): Bind `case-fold-search' to nil when matching aginst one of the regexp above. * testing/lisp/test-org.el (test-org/fuzzy-links): Add tests.
This commit is contained in:
Nicolas Goaziou
parent
ff0748beac
commit
ebbc675bd9
|
|
@ -3249,7 +3249,7 @@ This ensures the export commands can easily use it."
|
|||
(setq tmp (replace-match "" t t tmp)))
|
||||
(when (and (setq re (plist-get props 'org-todo-regexp))
|
||||
(setq re (concat "\\`\\.*" re " ?"))
|
||||
(string-match re tmp))
|
||||
(let ((case-fold-search nil)) (string-match re tmp)))
|
||||
(plist-put props 'todo (match-string 1 tmp))
|
||||
(setq tmp (replace-match "" t t tmp)))
|
||||
(plist-put props 'txt tmp)))
|
||||
|
|
@ -5441,6 +5441,7 @@ and the timestamp type relevant for the sorting strategy in
|
|||
'help-echo
|
||||
(format "mouse-2 or RET jump to org file %s"
|
||||
(abbreviate-file-name buffer-file-name))))
|
||||
(case-fold-search nil)
|
||||
(regexp (format org-heading-keyword-regexp-format
|
||||
(cond
|
||||
((and org-select-this-todo-keyword
|
||||
|
|
@ -6998,7 +6999,8 @@ The optional argument TYPE tells the agenda type."
|
|||
(let* ((pla (text-property-any 0 (length a) 'org-heading t a))
|
||||
(plb (text-property-any 0 (length b) 'org-heading t b))
|
||||
(ta (and pla (substring a pla)))
|
||||
(tb (and plb (substring b plb))))
|
||||
(tb (and plb (substring b plb)))
|
||||
(case-fold-search nil))
|
||||
(when pla
|
||||
(if (string-match (concat "\\`[ \t]*" (or (get-text-property 0 'org-todo-regexp a) "")
|
||||
"\\([ \t]*\\[[a-zA-Z0-9]\\]\\)? *") ta)
|
||||
|
|
|
|||
|
|
@ -356,7 +356,8 @@ this heading."
|
|||
(org-set-tags-to all-tags))
|
||||
;; Mark the entry as done
|
||||
(when (and org-archive-mark-done
|
||||
(looking-at org-todo-line-regexp)
|
||||
(let ((case-fold-search nil))
|
||||
(looking-at org-todo-line-regexp))
|
||||
(or (not (match-end 2))
|
||||
(not (member (match-string 2) org-done-keywords))))
|
||||
(let (org-log-done org-todo-log-states)
|
||||
|
|
@ -472,8 +473,9 @@ it is on a headline, try all direct children.
|
|||
When TAG is non-nil, don't move trees, but mark them with the ARCHIVE tag."
|
||||
(org-archive-all-matches
|
||||
(lambda (_beg end)
|
||||
(unless (re-search-forward org-not-done-heading-regexp end t)
|
||||
"no open TODO items"))
|
||||
(let ((case-fold-search nil))
|
||||
(unless (re-search-forward org-not-done-heading-regexp end t)
|
||||
"no open TODO items")))
|
||||
tag))
|
||||
|
||||
(defun org-archive-all-old (&optional tag)
|
||||
|
|
|
|||
|
|
@ -3036,7 +3036,7 @@ With a prefix argument ARG, change the region in a single item."
|
|||
;; subtrees.
|
||||
(when (< level ref-level) (setq ref-level level))
|
||||
;; Remove stars and TODO keyword.
|
||||
(looking-at org-todo-line-regexp)
|
||||
(let ((case-fold-search nil)) (looking-at org-todo-line-regexp))
|
||||
(delete-region (point) (or (match-beginning 3)
|
||||
(line-end-position)))
|
||||
(insert bul)
|
||||
|
|
|
|||
|
|
@ -315,10 +315,11 @@ This needs more work, to handle headings with lots of spaces in them."
|
|||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(let (tbl)
|
||||
(while (re-search-forward org-todo-line-regexp nil t)
|
||||
(push (org-make-org-heading-search-string
|
||||
(match-string-no-properties 3))
|
||||
tbl))
|
||||
(let ((case-fold-search nil))
|
||||
(while (re-search-forward org-todo-line-regexp nil t)
|
||||
(push (org-make-org-heading-search-string
|
||||
(match-string-no-properties 3))
|
||||
tbl)))
|
||||
(pcomplete-uniqify-list tbl)))
|
||||
(substring pcomplete-stub 1))))
|
||||
|
||||
|
|
|
|||
88
lisp/org.el
88
lisp/org.el
|
|
@ -4903,29 +4903,43 @@ Otherwise, these types are allowed:
|
|||
;;; Variables for pre-computed regular expressions, all buffer local
|
||||
|
||||
(defvar-local org-todo-regexp nil
|
||||
"Matches any of the TODO state keywords.")
|
||||
"Matches any of the TODO state keywords.
|
||||
Since TODO keywords are case-sensitive, `case-fold-search' is
|
||||
expected to be bound to nil when matching against this regexp.")
|
||||
|
||||
(defvar-local org-not-done-regexp nil
|
||||
"Matches any of the TODO state keywords except the last one.")
|
||||
"Matches any of the TODO state keywords except the last one.
|
||||
Since TODO keywords are case-sensitive, `case-fold-search' is
|
||||
expected to be bound to nil when matching against this regexp.")
|
||||
|
||||
(defvar-local org-not-done-heading-regexp nil
|
||||
"Matches a TODO headline that is not done.")
|
||||
"Matches a TODO headline that is not done.
|
||||
Since TODO keywords are case-sensitive, `case-fold-search' is
|
||||
expected to be bound to nil when matching against this regexp.")
|
||||
|
||||
(defvar-local org-todo-line-regexp nil
|
||||
"Matches a headline and puts TODO state into group 2 if present.")
|
||||
"Matches a headline and puts TODO state into group 2 if present.
|
||||
Since TODO keywords are case-sensitive, `case-fold-search' is
|
||||
expected to be bound to nil when matching against this regexp.")
|
||||
|
||||
(defvar-local org-complex-heading-regexp nil
|
||||
"Matches a headline and puts everything into groups:
|
||||
|
||||
group 1: the stars
|
||||
group 2: The todo keyword, maybe
|
||||
group 1: Stars
|
||||
group 2: The TODO keyword, maybe
|
||||
group 3: Priority cookie
|
||||
group 4: True headline
|
||||
group 5: Tags
|
||||
|
||||
Since TODO keywords are case-sensitive, `case-fold-search' is
|
||||
expected to be bound to nil when matching this regexp.")
|
||||
expected to be bound to nil when matching against this regexp.")
|
||||
|
||||
(defvar-local org-complex-heading-regexp-format nil
|
||||
"Printf format to make regexp to match an exact headline.
|
||||
This regexp will match the headline of any node which has the
|
||||
exact headline text that is put into the format, but may have any
|
||||
TODO state, priority and tags.")
|
||||
|
||||
(defvar-local org-todo-line-tags-regexp nil
|
||||
"Matches a headline and puts TODO state into group 2 if present.
|
||||
Also put tags into group 4 if tags are present.")
|
||||
|
|
@ -8197,7 +8211,7 @@ unchecked check box."
|
|||
(save-excursion
|
||||
(org-back-to-heading)
|
||||
(outline-previous-heading)
|
||||
(looking-at org-todo-line-regexp))
|
||||
(let ((case-fold-search nil)) (looking-at org-todo-line-regexp)))
|
||||
(let* ((new-mark-x
|
||||
(if (or (equal arg '(4))
|
||||
(not (match-beginning 2))
|
||||
|
|
@ -8289,12 +8303,12 @@ headings in the region."
|
|||
"Fix cursor position and indentation after demoting/promoting."
|
||||
(let ((pos (point)))
|
||||
(when (save-excursion
|
||||
(beginning-of-line 1)
|
||||
(looking-at org-todo-line-regexp)
|
||||
(or (equal pos (match-end 1)) (equal pos (match-end 2))))
|
||||
(beginning-of-line)
|
||||
(let ((case-fold-search nil)) (looking-at org-todo-line-regexp))
|
||||
(or (eq pos (match-end 1)) (eq pos (match-end 2))))
|
||||
(cond ((eobp) (insert " "))
|
||||
((eolp) (insert " "))
|
||||
((equal (char-after) ?\ ) (forward-char 1))))))
|
||||
((equal (char-after) ?\s) (forward-char 1))))))
|
||||
|
||||
(defun org-current-level ()
|
||||
"Return the level of the current entry, or nil if before the first headline.
|
||||
|
|
@ -11221,22 +11235,22 @@ of matched result, which is either `dedicated' or `fuzzy'."
|
|||
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
|
||||
sep)))
|
||||
(if starred (substring title 1) title))
|
||||
sep "?"
|
||||
"\\(?:[ \t]+:[[:alnum:]_@#%%:]+:\\)?"
|
||||
"[ \t]*$")))
|
||||
(title
|
||||
(format "\\(?:%s[ \t]+\\)?%s?%s%s?"
|
||||
org-comment-string
|
||||
sep
|
||||
(let ((re (mapconcat #'regexp-quote words sep)))
|
||||
(if starred (substring re 1) re))
|
||||
sep))
|
||||
(exact-title (format "\\`%s\\'" title))
|
||||
(re (concat org-outline-regexp-bol "+.*" title)))
|
||||
(goto-char (point-min))
|
||||
(re-search-forward re nil t)))
|
||||
(goto-char (match-beginning 0))
|
||||
(catch :found
|
||||
(while (re-search-forward re nil t)
|
||||
(when (string-match-p exact-title (org-get-heading t t))
|
||||
(throw :found t)))
|
||||
nil)))
|
||||
(beginning-of-line)
|
||||
(setq type 'dedicated))
|
||||
;; Offer to create non-existent headline depending on
|
||||
;; `org-link-search-must-match-exact-headline'.
|
||||
|
|
@ -12844,7 +12858,8 @@ changes. Such blocking occurs when:
|
|||
(save-excursion
|
||||
(org-back-to-heading t)
|
||||
(let* ((pos (point))
|
||||
(parent-pos (and (org-up-heading-safe) (point))))
|
||||
(parent-pos (and (org-up-heading-safe) (point)))
|
||||
(case-fold-search nil))
|
||||
(unless parent-pos (throw 'dont-block t)) ; no parent
|
||||
(when (and (org-not-nil (org-entry-get (point) "ORDERED"))
|
||||
(forward-line 1)
|
||||
|
|
@ -13225,7 +13240,7 @@ Returns the new TODO keyword, or nil if no state change should occur."
|
|||
"Return the TODO keyword of the current subtree."
|
||||
(save-excursion
|
||||
(org-back-to-heading t)
|
||||
(and (looking-at org-todo-line-regexp)
|
||||
(and (let ((case-fold-search nil)) (looking-at org-todo-line-regexp))
|
||||
(match-end 2)
|
||||
(match-string 2))))
|
||||
|
||||
|
|
@ -14256,8 +14271,7 @@ ACTION can be `set', `up', `down', or a character."
|
|||
(replace-match news t t nil 2))
|
||||
(if remove
|
||||
(user-error "No priority cookie found in line")
|
||||
(let ((case-fold-search nil))
|
||||
(looking-at org-todo-line-regexp))
|
||||
(let ((case-fold-search nil)) (looking-at org-todo-line-regexp))
|
||||
(if (match-end 2)
|
||||
(progn
|
||||
(goto-char (match-end 2))
|
||||
|
|
@ -24140,13 +24154,13 @@ unless optional argument NO-INHERITANCE is non-nil."
|
|||
"If point is at the end of an empty headline, return t, else nil.
|
||||
If the heading only contains a TODO keyword, it is still still considered
|
||||
empty."
|
||||
(and (looking-at "[ \t]*$")
|
||||
(when org-todo-line-regexp
|
||||
(let ((case-fold-search nil))
|
||||
(and (looking-at "[ \t]*$")
|
||||
org-todo-line-regexp
|
||||
(save-excursion
|
||||
(beginning-of-line 1)
|
||||
(let ((case-fold-search nil))
|
||||
(looking-at org-todo-line-regexp)
|
||||
(string= (match-string 3) ""))))))
|
||||
(beginning-of-line)
|
||||
(looking-at org-todo-line-regexp)
|
||||
(string= (match-string 3) "")))))
|
||||
|
||||
(defun org-at-heading-or-item-p ()
|
||||
(or (org-at-heading-p) (org-at-item-p)))
|
||||
|
|
|
|||
|
|
@ -2098,7 +2098,8 @@ SCHEDULED: <2014-03-04 tue.>"
|
|||
(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.
|
||||
;; keywords, priorities, and tags. However, TODO keywords are
|
||||
;; case-sensitive.
|
||||
(should
|
||||
(let ((first-line
|
||||
"** TODO [#A] [/] Test [1/2] [33%] 1 \t 2 [%] :work:urgent: "))
|
||||
|
|
@ -2108,15 +2109,26 @@ SCHEDULED: <2014-03-04 tue.>"
|
|||
(org-todo-regexp "TODO"))
|
||||
(org-open-at-point))
|
||||
(looking-at (regexp-quote first-line)))))
|
||||
(should-error
|
||||
(org-test-with-temp-text "** todo Test 1 2\nFoo Bar\n<point>[[*Test 1 2]]"
|
||||
(let ((org-link-search-must-match-exact-headline nil)
|
||||
(org-todo-regexp "TODO"))
|
||||
(org-open-at-point))))
|
||||
;; Heading match should still be exact.
|
||||
(should-error
|
||||
(let ((first-line
|
||||
"** TODO [#A] [/] Test [1/2] [33%] 1 \t 2 [%] :work:urgent: "))
|
||||
(org-test-with-temp-text
|
||||
(concat first-line "\nFoo Bar\n<point>[[*Test 1]]")
|
||||
(let ((org-link-search-must-match-exact-headline nil)
|
||||
(org-todo-regexp "TODO"))
|
||||
(org-open-at-point)))))
|
||||
(org-test-with-temp-text "
|
||||
** TODO [#A] [/] Test [1/2] [33%] 1 \t 2 [%] :work:urgent:
|
||||
Foo Bar
|
||||
<point>[[*Test 1]]"
|
||||
(let ((org-link-search-must-match-exact-headline nil)
|
||||
(org-todo-regexp "TODO"))
|
||||
(org-open-at-point))))
|
||||
(should
|
||||
(org-test-with-temp-text "* Test 1 2 3\n** Test 1 2\n<point>[[*Test 1 2]]"
|
||||
(let ((org-link-search-must-match-exact-headline nil)
|
||||
(org-todo-regexp "TODO"))
|
||||
(org-open-at-point))
|
||||
(looking-at-p (regexp-quote "** Test 1 2"))))
|
||||
;; Heading match ignores COMMENT keyword.
|
||||
(should
|
||||
(org-test-with-temp-text "[[*Test]]\n* COMMENT Test"
|
||||
|
|
|
|||
Loading…
Reference in New Issue