Browse Source

Implement conditional case-fold search in org-occur

* lisp/org.el (org-occur-case-fold-search): New variable.
(org-occur): Use new variable.

* testing/lisp/test-org.el (test-org/occur): Add tests.
Nicolas Goaziou 9 years ago
parent
commit
2d846210eb
3 changed files with 52 additions and 8 deletions
  1. 5 0
      etc/ORG-NEWS
  2. 21 7
      lisp/org.el
  3. 26 1
      testing/lisp/test-org.el

+ 5 - 0
etc/ORG-NEWS

@@ -277,6 +277,11 @@ types.
 *** New option ~org-attach-commit~
 When non-nil, commit attachments with git, assuming the document is in
 a git repository.
+*** Allow conditional case-fold searches in ~org-occur~
+When set to ~smart~, the new variable ~org-occur-case-fold-search~
+allows to mimic =isearch.el=: if the regexp searched contains any
+upper case character (or character class), the search is case
+sensitive.  Otherwise, it is case insensitive.
 ** New functions
 *** ~org-next-line-empty-p~
 It replaces the deprecated ~next~ argument to ~org-previous-line-empty-p~.

+ 21 - 7
lisp/org.el

@@ -111,6 +111,7 @@ Stars are put in group 1 and the trimmed body in group 2.")
 
 (declare-function calendar-check-holidays "holidays" (date))
 (declare-function cdlatex-environment "ext:cdlatex" (environment item))
+(declare-function isearch-no-upper-case-p "isearch" (string regexp-flag))
 (declare-function org-add-archive-files "org-archive" (files))
 (declare-function org-agenda-entry-get-agenda-timestamp "org-agenda" (pom))
 (declare-function org-agenda-list "org-agenda"
@@ -1677,6 +1678,16 @@ The highlights created by `org-toggle-latex-fragment' always need
   :group 'org-time
   :type 'boolean)
 
+(defcustom org-occur-case-fold-search t
+  "Non-nil means `org-occur' should be case-insensitive.
+If set to `smart' the search will be case-insensitive only if it
+doesn't specify any upper case character."
+  :group 'org-sparse-trees
+  :version "25.1"
+  :type '(choice
+	  (const :tag "Case-sensitive" nil)
+	  (const :tag "Case-insensitive" t)
+	  (const :tag "Case-insensitive for lower case searches only" 'smart)))
 
 (defcustom org-occur-hook '(org-first-headline-recenter)
   "Hook that is run after `org-occur' has constructed a sparse tree.
@@ -13894,13 +13905,16 @@ The function must neither move point nor alter narrowing."
 		(not org-occur-highlights)) ; no previous matches
 	;; hide everything
 	(org-overview))
-      (while (re-search-forward regexp nil t)
-	(when (or (not callback)
-		  (save-match-data (funcall callback)))
-	  (setq cnt (1+ cnt))
-	  (when org-highlight-sparse-tree-matches
-	    (org-highlight-new-match (match-beginning 0) (match-end 0)))
-	  (org-show-context 'occur-tree))))
+      (let ((case-fold-search (if (eq org-occur-case-fold-search 'smart)
+				  (isearch-no-upper-case-p regexp t)
+				org-occur-case-fold-search)))
+	(while (re-search-forward regexp nil t)
+	  (when (or (not callback)
+		    (save-match-data (funcall callback)))
+	    (setq cnt (1+ cnt))
+	    (when org-highlight-sparse-tree-matches
+	      (org-highlight-new-match (match-beginning 0) (match-end 0)))
+	    (org-show-context 'occur-tree)))))
     (when org-remove-highlights-with-change
       (org-add-hook 'before-change-functions 'org-remove-occur-highlights
 		    nil 'local))

+ 26 - 1
testing/lisp/test-org.el

@@ -4337,7 +4337,32 @@ Paragraph<point>"
   (should
    (= 1
       (org-test-with-temp-text "* H\nA\n* H2\nA"
-	(org-occur "A" nil (lambda () (equal (org-get-heading) "H2")))))))
+	(org-occur "A" nil (lambda () (equal (org-get-heading) "H2"))))))
+  ;; Case-fold searches according to `org-occur-case-fold-search'.
+  (should
+   (= 2
+      (org-test-with-temp-text "Aa"
+	(let ((org-occur-case-fold-search t)) (org-occur "A")))))
+  (should
+   (= 2
+      (org-test-with-temp-text "Aa"
+	(let ((org-occur-case-fold-search t)) (org-occur "a")))))
+  (should
+   (= 1
+      (org-test-with-temp-text "Aa"
+	(let ((org-occur-case-fold-search nil)) (org-occur "A")))))
+  (should
+   (= 1
+      (org-test-with-temp-text "Aa"
+	(let ((org-occur-case-fold-search nil)) (org-occur "a")))))
+  (should
+   (= 1
+      (org-test-with-temp-text "Aa"
+	(let ((org-occur-case-fold-search 'smart)) (org-occur "A")))))
+  (should
+   (= 2
+      (org-test-with-temp-text "Aa"
+	(let ((org-occur-case-fold-search 'smart)) (org-occur "a"))))))
 
 
 ;;; Tags