summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorNicolas Goaziou <mail@nicolasgoaziou.fr>2016-11-13 10:58:23 +0100
committerNicolas Goaziou <mail@nicolasgoaziou.fr>2016-11-13 11:26:17 +0100
commitebbc675bd9890c451ad01910fa2625fa78baac9b (patch)
tree4954cb882adb54d69242fc7de71a7a0b14f8efa6
parentff0748beacf3cf6369732ef10d56691ac9545d38 (diff)
downloadorg-mode-ebbc675bd9890c451ad01910fa2625fa78baac9b.tar.gz
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.
-rw-r--r--lisp/org-agenda.el6
-rw-r--r--lisp/org-archive.el8
-rw-r--r--lisp/org-list.el2
-rw-r--r--lisp/org-pcomplete.el9
-rw-r--r--lisp/org.el88
-rw-r--r--testing/lisp/test-org.el28
6 files changed, 86 insertions, 55 deletions
diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el
index bf95aa4..0a10bba 100644
--- a/lisp/org-agenda.el
+++ b/lisp/org-agenda.el
@@ -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)
diff --git a/lisp/org-archive.el b/lisp/org-archive.el
index e0c2435..3ba8bf1 100644
--- a/lisp/org-archive.el
+++ b/lisp/org-archive.el
@@ -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)
diff --git a/lisp/org-list.el b/lisp/org-list.el
index e8d9aef..bb39b6e 100644
--- a/lisp/org-list.el
+++ b/lisp/org-list.el
@@ -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)
diff --git a/lisp/org-pcomplete.el b/lisp/org-pcomplete.el
index f3b498e..5a52491 100644
--- a/lisp/org-pcomplete.el
+++ b/lisp/org-pcomplete.el
@@ -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))))
diff --git a/lisp/org.el b/lisp/org.el
index 9d526ae..dc204a5 100644
--- a/lisp/org.el
+++ b/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)))
diff --git a/testing/lisp/test-org.el b/testing/lisp/test-org.el
index 081a6c4..03dd429 100644
--- a/testing/lisp/test-org.el
+++ b/testing/lisp/test-org.el
@@ -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"