Browse Source

Match `org-complex-heading-regexp' with a nil `case-fold-search'

* lisp/org-agenda.el (org-agenda-goto):
* lisp/org-clock.el (org-clock-in):
(org-clock-out):
(org-clock-put-overlay):
(org-clock-load):
* lisp/org-element.el (org-element-context):
* lisp/org-footnote.el (org-footnote--allow-reference-p):
* lisp/org-mobile.el:
* lisp/ox.el (org-export--get-subtree-options):
* lisp/org.el (org-insert-heading):
(org-edit-headline):
(org-open-at-point):
(org-refile-get-targets):
(org--get-outline-path-1):
(org-toggle-comment):
(org-set-tags-to):
(org-set-tags):
(org-entry-properties):
(org-delete-indentation):
(org-beginning-of-line):
(org-end-of-line):
(org-mode-flyspell-verify): Bind `case-fold-search' to nil when matching
`org-complex-heading-regexp'.

(org-complex-heading-regexp): Add a note about the necessity to have
`case-fold-search' bound to nil.
Nicolas Goaziou 3 years ago
parent
commit
7bbe9202c2
7 changed files with 117 additions and 89 deletions
  1. 3 2
      lisp/org-agenda.el
  2. 13 9
      lisp/org-clock.el
  3. 10 9
      lisp/org-element.el
  4. 6 4
      lisp/org-footnote.el
  5. 27 25
      lisp/org-mobile.el
  6. 55 38
      lisp/org.el
  7. 3 2
      lisp/ox.el

+ 3 - 2
lisp/org-agenda.el

@@ -8400,8 +8400,9 @@ When called with a prefix argument, include all archive files as well."
       (org-show-context 'agenda)
       (recenter (/ (window-height) 2))
       (org-back-to-heading t)
-      (if (re-search-forward org-complex-heading-regexp nil t)
-	  (goto-char (match-beginning 4))))
+      (let ((case-fold-search nil))
+	(when (re-search-forward org-complex-heading-regexp nil t)
+	  (goto-char (match-beginning 4)))))
     (run-hooks 'org-agenda-after-show-hook)
     (and highlight (org-highlight (point-at-bol) (point-at-eol)))))
 

+ 13 - 9
lisp/org-clock.el

@@ -1266,10 +1266,11 @@ the default behavior."
 	 (org-clock-history-push)
 	 (setq org-clock-current-task (nth 4 (org-heading-components)))
 	 (cond ((functionp org-clock-in-switch-to-state)
-		(looking-at org-complex-heading-regexp)
+		(let ((case-fold-search nil))
+		  (looking-at org-complex-heading-regexp))
 		(let ((newstate (funcall org-clock-in-switch-to-state
 					 (match-string 2))))
-		  (if newstate (org-todo newstate))))
+		  (when newstate (org-todo newstate))))
 	       ((and org-clock-in-switch-to-state
 		     (not (looking-at (concat org-outline-regexp "[ \t]*"
 					      org-clock-in-switch-to-state
@@ -1617,10 +1618,11 @@ to, overriding the existing value of `org-clock-out-switch-to-state'."
 		    (org-clock-out-when-done nil))
 		(cond
 		 ((functionp org-clock-out-switch-to-state)
-		  (looking-at org-complex-heading-regexp)
+		  (let ((case-fold-search nil))
+		    (looking-at org-complex-heading-regexp))
 		  (let ((newstate (funcall org-clock-out-switch-to-state
 					   (match-string 2))))
-		    (if newstate (org-todo newstate))))
+		    (when newstate (org-todo newstate))))
 		 ((and org-clock-out-switch-to-state
 		       (not (looking-at (concat org-outline-regexp "[ \t]*"
 						org-clock-out-switch-to-state
@@ -1945,10 +1947,11 @@ This creates a new overlay and stores it in `org-clock-overlays', so that it
 will be easy to remove."
   (let (ov tx)
     (beginning-of-line)
-    (when (looking-at org-complex-heading-regexp)
-      (goto-char (match-beginning 4)))
+    (let ((case-fold-search nil))
+      (when (looking-at org-complex-heading-regexp)
+	(goto-char (match-beginning 4))))
     (setq ov (make-overlay (point) (point-at-eol))
-    	  tx (concat (buffer-substring-no-properties (point) (match-end 4))
+	  tx (concat (buffer-substring-no-properties (point) (match-end 4))
 		     (org-add-props
 			 (make-string
 			  (max 0 (- (- 60 (current-column))
@@ -2988,8 +2991,9 @@ The details of what will be saved are regulated by the variable
 			   (save-excursion
 			     (goto-char (cdr resume-clock))
 			     (org-back-to-heading t)
-			     (and (looking-at org-complex-heading-regexp)
-				  (match-string 4))))
+			     (let ((case-fold-search nil))
+			       (and (looking-at org-complex-heading-regexp)
+				    (match-string 4)))))
 			 ") "))))
 	  (when (file-exists-p (car resume-clock))
 	    (with-current-buffer (find-file (car resume-clock))

+ 10 - 9
lisp/org-element.el

@@ -5872,15 +5872,16 @@ Providing it allows for quicker computation."
 	       (throw 'objects-forbidden element)))))
 	;; At an headline or inlinetask, objects are in title.
 	((memq type '(headline inlinetask))
-	 (goto-char (org-element-property :begin element))
-	 (looking-at org-complex-heading-regexp)
-	 (let ((end (match-end 4)))
-	   (if (not end) (throw 'objects-forbidden element)
-	     (goto-char (match-beginning 4))
-	     (when (let (case-fold-search) (looking-at org-comment-string))
-	       (goto-char (match-end 0)))
-	     (if (>= (point) end) (throw 'objects-forbidden element)
-	       (narrow-to-region (point) end)))))
+	 (let ((case-fold-search nil))
+	   (goto-char (org-element-property :begin element))
+	   (looking-at org-complex-heading-regexp)
+	   (let ((end (match-end 4)))
+	     (if (not end) (throw 'objects-forbidden element)
+	       (goto-char (match-beginning 4))
+	       (when (looking-at org-comment-string)
+		 (goto-char (match-end 0)))
+	       (if (>= (point) end) (throw 'objects-forbidden element)
+		 (narrow-to-region (point) end))))))
 	;; At a paragraph, a table-row or a verse block, objects are
 	;; located within their contents.
 	((memq type '(paragraph table-row verse-block))

+ 6 - 4
lisp/org-footnote.el

@@ -284,10 +284,12 @@ otherwise."
        ;; heading itself or on the blank lines below.
        ((memq type '(headline inlinetask))
 	(or (not (org-at-heading-p))
-	    (and (save-excursion (beginning-of-line)
-				 (and (let ((case-fold-search t))
-					(not (looking-at "\\*+ END[ \t]*$")))
-				      (looking-at org-complex-heading-regexp)))
+	    (and (save-excursion
+		   (beginning-of-line)
+		   (and (let ((case-fold-search t))
+			  (not (looking-at-p "\\*+ END[ \t]*$")))
+			(let ((case-fold-search nil))
+			  (looking-at org-complex-heading-regexp))))
 		 (match-beginning 4)
 		 (>= (point) (match-beginning 4))
 		 (or (not (match-beginning 5))

+ 27 - 25
lisp/org-mobile.el

@@ -996,7 +996,7 @@ be returned that indicates what went wrong."
        ((equal new "DONEARCHIVE")
 	(org-todo 'done)
 	(org-archive-subtree-default))
-       ((equal new current) t) ; nothing needs to be done
+       ((equal new current) t)		; nothing needs to be done
        ((or (equal current old)
 	    (eq org-mobile-force-mobile-change t)
 	    (memq 'todo org-mobile-force-mobile-change))
@@ -1018,33 +1018,35 @@ be returned that indicates what went wrong."
 		 (or old "") (or current "")))))
 
      ((eq what 'priority)
-      (when (looking-at org-complex-heading-regexp)
-	(setq current (and (match-end 3) (substring (match-string 3) 2 3)))
-	(cond
-	 ((equal current new) t) ; no action required
-	 ((or (equal current old)
-	      (eq org-mobile-force-mobile-change t)
-	      (memq 'tags org-mobile-force-mobile-change))
-	  (org-priority (and new (string-to-char new))))
-	 (t (error "Priority was expected to be %s, but is %s"
-		   old current)))))
+      (let ((case-fold-search nil))
+	(when (looking-at org-complex-heading-regexp)
+	  (let ((current (and (match-end 3) (substring (match-string 3) 2 3))))
+	    (cond
+	     ((equal current new) t)	;no action required
+	     ((or (equal current old)
+		  (eq org-mobile-force-mobile-change t)
+		  (memq 'tags org-mobile-force-mobile-change))
+	      (org-priority (and new (string-to-char new))))
+	     (t (error "Priority was expected to be %s, but is %s"
+		       old current)))))))
 
      ((eq what 'heading)
-      (when (looking-at org-complex-heading-regexp)
-	(setq current (match-string 4))
-	(cond
-	 ((equal current new) t) ; no action required
-	 ((or (equal current old)
-	      (eq org-mobile-force-mobile-change t)
-	      (memq 'heading org-mobile-force-mobile-change))
-	  (goto-char (match-beginning 4))
-	  (insert new)
-	  (delete-region (point) (+ (point) (length current)))
-	  (org-set-tags nil 'align))
-	 (t (error "Heading changed in MobileOrg and on the computer")))))
+      (let ((case-fold-search nil))
+	(when (looking-at org-complex-heading-regexp)
+	  (let ((current (match-string 4)))
+	    (cond
+	     ((equal current new) t)	;no action required
+	     ((or (equal current old)
+		  (eq org-mobile-force-mobile-change t)
+		  (memq 'heading org-mobile-force-mobile-change))
+	      (goto-char (match-beginning 4))
+	      (insert new)
+	      (delete-region (point) (+ (point) (length current)))
+	      (org-set-tags nil 'align))
+	     (t (error "Heading changed in MobileOrg and on the computer")))))))
 
      ((eq what 'addheading)
-      (if (org-at-heading-p) ; if false we are in top-level of file
+      (if (org-at-heading-p)	; if false we are in top-level of file
 	  (progn
 	    ;; Workaround a `org-insert-heading-respect-content' bug
 	    ;; which prevents correct insertion when point is invisible
@@ -1059,7 +1061,7 @@ be returned that indicates what went wrong."
      ((eq what 'refile)
       (org-copy-subtree)
       (org-with-point-at (org-mobile-locate-entry new)
-	(if (org-at-heading-p) ; if false we are in top-level of file
+	(if (org-at-heading-p)	; if false we are in top-level of file
 	    (progn
 	      (setq level (org-get-valid-level (funcall outline-level) 1))
 	      (org-end-of-subtree t t)

+ 55 - 38
lisp/org.el

@@ -4912,11 +4912,15 @@ Otherwise, these types are allowed:
   "Matches a headline and puts TODO state into group 2 if present.")
 (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 3: Priority cookie
 group 4: True headline
-group 5: Tags")
+group 5: Tags
+
+Since TODO keywords are case-sensitive, `case-fold-search' is
+expected to be bound to nil when matching 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
@@ -8021,8 +8025,9 @@ unconditionally."
 		;; tags).
 		(let ((pos (point)))
 		  (beginning-of-line)
-		  (unless (looking-at org-complex-heading-regexp)
-		    (error "This should not happen"))
+		  (let ((case-fold-search nil))
+		    (unless (looking-at org-complex-heading-regexp)
+		      (error "This should not happen")))
 		  (when (and (match-beginning 4)
 			     (> pos (match-beginning 4))
 			     (< pos (match-end 4)))
@@ -8141,16 +8146,17 @@ Set it to HEADING when provided."
   (interactive)
   (org-with-wide-buffer
    (org-back-to-heading t)
-   (when (looking-at org-complex-heading-regexp)
-     (let* ((old (match-string-no-properties 4))
-	    (new (save-match-data
-		   (org-trim (or heading (read-string "Edit: " old))))))
-       (unless (equal old new)
-	 (if old (replace-match new t t nil 4)
-	   (goto-char (or (match-end 3) (match-end 2) (match-end 1)))
-	   (insert " " new))
-	 (org-set-tags nil t)
-	 (when (looking-at "[ \t]*$") (replace-match "")))))))
+   (let ((case-fold-search nil))
+     (when (looking-at org-complex-heading-regexp)
+       (let* ((old (match-string-no-properties 4))
+	      (new (save-match-data
+		     (org-trim (or heading (read-string "Edit: " old))))))
+	 (unless (equal old new)
+	   (if old (replace-match new t t nil 4)
+	     (goto-char (or (match-end 3) (match-end 2) (match-end 1)))
+	     (insert " " new))
+	   (org-set-tags nil t)
+	   (when (looking-at "[ \t]*$") (replace-match ""))))))))
 
 (defun org-insert-heading-after-current ()
   "Insert a new heading with same level as current, after current subtree."
@@ -10842,10 +10848,12 @@ link in a property drawer line."
 	 ;; a link, a footnote reference or on tags.
 	 ((and (memq type '(headline inlinetask))
 	       ;; Not on tags.
-	       (progn (save-excursion (beginning-of-line)
-				      (looking-at org-complex-heading-regexp))
-		      (or (not (match-beginning 5))
-			  (< (point) (match-beginning 5)))))
+	       (let ((case-fold-search nil))
+		 (save-excursion
+		   (beginning-of-line)
+		   (looking-at org-complex-heading-regexp))
+		 (or (not (match-beginning 5))
+		     (< (point) (match-beginning 5)))))
 	  (let* ((data (org-offer-links-in-entry (current-buffer) (point) arg))
 		 (links (car data))
 		 (links-end (cdr data)))
@@ -10873,10 +10881,11 @@ link in a property drawer line."
 	 ((eq type 'timestamp) (org-follow-timestamp-link))
 	 ;; On tags within a headline or an inlinetask.
 	 ((and (memq type '(headline inlinetask))
-	       (progn (save-excursion (beginning-of-line)
-				      (looking-at org-complex-heading-regexp))
-		      (and (match-beginning 5)
-			   (>= (point) (match-beginning 5)))))
+	       (let ((case-fold-search nil))
+		 (save-excursion (beginning-of-line)
+				 (looking-at org-complex-heading-regexp))
+		 (and (match-beginning 5)
+		      (>= (point) (match-beginning 5)))))
 	  (org-tags-view arg (substring (match-string 5) 0 -1)))
 	 ((eq type 'link)
 	  ;; When link is located within the description of another
@@ -11737,7 +11746,8 @@ order.")
 		(setq org-outline-path-cache nil)
 		(while (re-search-forward descre nil t)
 		  (beginning-of-line)
-		  (looking-at org-complex-heading-regexp)
+		  (let ((case-fold-search nil))
+		    (looking-at org-complex-heading-regexp))
 		  (let ((begin (point))
 			(heading (match-string-no-properties 4)))
 		    (unless (or (and
@@ -11786,7 +11796,7 @@ optional argument USE-CACHE is non-nil, make use of a cache.  See
 Assume buffer is widened and point is on a headline."
   (or (and use-cache (cdr (assq (point) org-outline-path-cache)))
       (let ((p (point))
-	    (heading (progn
+	    (heading (let ((case-fold-search nil))
 		       (looking-at org-complex-heading-regexp)
 		       (if (not (match-end 4)) ""
 			 ;; Remove statistics cookies.
@@ -12469,7 +12479,8 @@ expands them."
   (interactive)
   (save-excursion
     (org-back-to-heading)
-    (looking-at org-complex-heading-regexp)
+    (let ((case-fold-search nil))
+      (looking-at org-complex-heading-regexp))
     (goto-char (or (match-end 3) (match-end 2) (match-end 1)))
     (skip-chars-forward " \t")
     (unless (memq (char-before) '(?\s ?\t)) (insert " "))
@@ -15029,7 +15040,8 @@ If DATA is nil or the empty string, any tags will be removed."
   (when data
     (save-excursion
       (org-back-to-heading t)
-      (when (looking-at org-complex-heading-regexp)
+      (when (let ((case-fold-search nil))
+	      (looking-at org-complex-heading-regexp))
 	(if (match-end 5)
 	    (progn
 	      (goto-char (match-beginning 5))
@@ -15143,7 +15155,8 @@ When JUST-ALIGN is non-nil, only align tags."
 	  (unless (equal current tags)
 	    (save-excursion
 	      (beginning-of-line)
-	      (looking-at org-complex-heading-regexp)
+	      (let ((case-fold-search nil))
+		(looking-at org-complex-heading-regexp))
 	      ;; Remove current tags, if any.
 	      (when (match-end 5) (replace-match "" nil nil nil 5))
 	      ;; Insert new tags, if any.  Otherwise, remove trailing
@@ -15815,13 +15828,14 @@ strings."
 			props)))
 	      (when specific (throw 'exit props)))
 	    (when (or (not specific) (string= specific "ITEM"))
-	      (when (looking-at org-complex-heading-regexp)
-		(push (cons "ITEM"
-			    (let ((title (match-string-no-properties 4)))
-			      (if (org-string-nw-p title)
-				  (org-remove-tabs title)
-				"")))
-		      props))
+	      (let ((case-fold-search nil))
+		(when (looking-at org-complex-heading-regexp)
+		  (push (cons "ITEM"
+			      (let ((title (match-string-no-properties 4)))
+				(if (org-string-nw-p title)
+				    (org-remove-tabs title)
+				  "")))
+			props)))
 	      (when specific (throw 'exit props)))
 	    (when (or (not specific) (string= specific "TODO"))
 	      (let ((case-fold-search nil))
@@ -21302,7 +21316,8 @@ With a non-nil optional argument, join it to the following one."
   (interactive "*P")
   (if (save-excursion
 	(beginning-of-line (if arg 1 0))
-	(looking-at org-complex-heading-regexp))
+	(let ((case-fold-search nil))
+	  (looking-at org-complex-heading-regexp)))
       ;; At headline.
       (let ((tags-column (when (match-beginning 5)
 			   (save-excursion (goto-char (match-beginning 5))
@@ -23786,7 +23801,7 @@ With argument N not nil or 1, move forward N - 1 lines first."
      ;; of line: point is at the beginning of a visual line.  Bail
      ;; out.
      ((and (bound-and-true-p visual-line-mode) (not (bolp))))
-     ((looking-at org-complex-heading-regexp)
+     ((let ((case-fold-search nil)) (looking-at org-complex-heading-regexp))
       ;; At a headline, special position is before the title, but
       ;; after any TODO keyword or priority cookie.
       (let ((refpos (min (1+ (or (match-end 3) (match-end 2) (match-end 1)))
@@ -23837,7 +23852,8 @@ With argument N not nil or 1, move forward N - 1 lines first."
      ((and special
 	   (save-excursion
 	     (beginning-of-line)
-	     (looking-at org-complex-heading-regexp))
+	     (let ((case-fold-search nil))
+	       (looking-at org-complex-heading-regexp)))
 	   (match-end 5))
       (let ((tags (save-excursion
 		    (goto-char (match-beginning 5))
@@ -25020,8 +25036,9 @@ ELEMENT is the element at point."
       ;; faster than relying on `org-element-at-point'.
       (and (save-excursion (beginning-of-line)
 			   (and (let ((case-fold-search t))
-				  (not (looking-at "\\*+ END[ \t]*$")))
-				(looking-at org-complex-heading-regexp)))
+				  (not (looking-at-p "\\*+ END[ \t]*$")))
+				(let ((case-fold-search nil))
+				  (looking-at org-complex-heading-regexp))))
 	   (match-beginning 4)
 	   (>= (point) (match-beginning 4))
 	   (or (not (match-beginning 5))

+ 3 - 2
lisp/ox.el

@@ -1405,8 +1405,9 @@ for export.  Return options as a plist."
 	 (cache (list
 		 (cons "TITLE"
 		       (or (org-entry-get (point) "EXPORT_TITLE" 'selective)
-			   (progn (looking-at org-complex-heading-regexp)
-				  (match-string-no-properties 4))))))
+			   (let ((case-fold-search nil))
+			     (looking-at org-complex-heading-regexp)
+			     (match-string-no-properties 4))))))
 	 ;; Look for both general keywords and back-end specific
 	 ;; options, with priority given to the latter.
 	 (options (append (and backend (org-export-get-all-options backend))