From 7bbe9202c2d641dfaabab45b1bfd4b7f1f0bf71a Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Sat, 29 Oct 2016 00:38:15 +0200 Subject: [PATCH] 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. --- lisp/org-agenda.el | 5 ++- lisp/org-clock.el | 22 ++++++----- lisp/org-element.el | 19 ++++----- lisp/org-footnote.el | 10 +++-- lisp/org-mobile.el | 52 +++++++++++++------------ lisp/org.el | 93 ++++++++++++++++++++++++++------------------ lisp/ox.el | 5 ++- 7 files changed, 117 insertions(+), 89 deletions(-) diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el index 4559f9013..7ee721ab8 100644 --- a/lisp/org-agenda.el +++ b/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))))) diff --git a/lisp/org-clock.el b/lisp/org-clock.el index 3bc577815..c14d097f3 100644 --- a/lisp/org-clock.el +++ b/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)) diff --git a/lisp/org-element.el b/lisp/org-element.el index 0793f75da..008dddc2a 100644 --- a/lisp/org-element.el +++ b/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)) diff --git a/lisp/org-footnote.el b/lisp/org-footnote.el index c86ab84c9..9e6bd9c40 100644 --- a/lisp/org-footnote.el +++ b/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)) diff --git a/lisp/org-mobile.el b/lisp/org-mobile.el index 3b2bbf12d..3ef3f4e04 100644 --- a/lisp/org-mobile.el +++ b/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) diff --git a/lisp/org.el b/lisp/org.el index 2feb16392..138c03f8b 100644 --- a/lisp/org.el +++ b/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)) diff --git a/lisp/ox.el b/lisp/ox.el index a41b7d71e..d3d1a0ed8 100644 --- a/lisp/ox.el +++ b/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))