]> git.eshelyaron.com Git - emacs.git/commitdiff
zap-to-char: case sensitive for upper-case characters
authorTino Calancha <tino.calancha@gmail.com>
Sat, 21 May 2022 09:23:17 +0000 (11:23 +0200)
committerTino Calancha <tino.calancha@gmail.com>
Sat, 21 May 2022 09:23:55 +0000 (11:23 +0200)
In interactive calls, behave case-sensitively if the given char
is an upper-case character.  Same for zap-up-to-char (Bug#54804).

This is analog to what the user-level incremental search feature does.

* lisp/misc.el (zap-up-to-char): Add an optional arg INTERACTIVE.
Perform a case-sensitive search when INTERACTIVE is non-nil and
CHAR is an upper-case character.
* lisp/simple.el (zap-to-char): Same.

* etc/NEWS (Editing Changes in Emacs 29.1): Announce this change.
* test/lisp/misc-tests.el (misc-test-zap-up-to-char): Add test cases.
* test/lisp/simple-tests.el (with-zap-to-char-test): Add helper macro.
(simple-tests-zap-to-char): Add a test.

etc/NEWS
lisp/misc.el
lisp/simple.el
test/lisp/misc-tests.el
test/lisp/simple-tests.el

index 5eab8e23bb24567bdbe3b1ea796313c3092a1de9..d238fd74fece974924b007518773a9e5fda984ff 100644 (file)
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -698,6 +698,12 @@ Formerly it invoked 'just-one-space'.  The actions performed by
 'cycle-spacing' and their order can now be customized via the user
 option 'cycle-spacing-actions'.
 
+---
+** 'zap-to-char' and 'zap-up-to-char' are case-sensitive for upper-case chars.
+These commands now behave as case-sensitive for interactive calls when
+are invoked with an uppercase argument, regardless of the
+`case-fold-search' value.
+
 ---
 ** 'scroll-other-window' and 'scroll-other-window-down' now respect remapping.
 These commands (bound to 'C-M-v' and 'C-M-V') used to scroll the other
index d85f889ffd3ddacb64b4195fa1c418a62f311e4d..0bb8ee6c7bcf0640fc008b8b979996be4a9f8b46 100644 (file)
@@ -64,15 +64,22 @@ The characters copied are inserted in the buffer before point."
 ;; Variation of `zap-to-char'.
 
 ;;;###autoload
-(defun zap-up-to-char (arg char)
+(defun zap-up-to-char (arg char &optional interactive)
   "Kill up to, but not including ARGth occurrence of CHAR.
+When run interactively, the argument INTERACTIVE is non-nil.
 Case is ignored if `case-fold-search' is non-nil in the current buffer.
 Goes backward if ARG is negative; error if CHAR not found.
-Ignores CHAR at point."
+Ignores CHAR at point.
+If called interactively, do a case sensitive search if CHAR
+is an upper-case character."
   (interactive (list (prefix-numeric-value current-prefix-arg)
                     (read-char-from-minibuffer "Zap up to char: "
-                                               nil 'read-char-history)))
-  (let ((direction (if (>= arg 0) 1 -1)))
+                                               nil 'read-char-history)
+                     t))
+  (let ((direction (if (>= arg 0) 1 -1))
+        (case-fold-search (if (and interactive (char-uppercase-p char))
+                              nil
+                            case-fold-search)))
     (kill-region (point)
                 (progn
                   (forward-char direction)
index 6aa079464a5768eb38b40ec96799b962360bacde..6906675f68ad6f8c7157be2644af6be2e78c091b 100644 (file)
@@ -6342,21 +6342,26 @@ then gives correct answers only for ASCII characters."
          (characterp (get-char-code-property char 'lowercase)))
         ((and (>= char ?A) (<= char ?Z)))))
 
-(defun zap-to-char (arg char)
+(defun zap-to-char (arg char &optional interactive)
   "Kill up to and including ARGth occurrence of CHAR.
+When run interactively, the argument INTERACTIVE is non-nil.
 Case is ignored if `case-fold-search' is non-nil in the current buffer.
 Goes backward if ARG is negative; error if CHAR not found.
-See also `zap-up-to-char'."
+See also `zap-up-to-char'.
+If called interactively, do a case sensitive search if CHAR
+is an upper-case character."
   (interactive (list (prefix-numeric-value current-prefix-arg)
                     (read-char-from-minibuffer "Zap to char: "
-                                               nil 'read-char-history)))
+                                               nil 'read-char-history))
+               t)
   ;; Avoid "obsolete" warnings for translation-table-for-input.
   (with-no-warnings
     (if (char-table-p translation-table-for-input)
        (setq char (or (aref translation-table-for-input char) char))))
-  (kill-region (point) (progn
-                        (search-forward (char-to-string char) nil nil arg)
-                        (point))))
+  (let ((case-fold-search (if (and interactive (char-uppercase-p char))
+                              nil
+                            case-fold-search)))
+    (kill-region (point) (search-forward (char-to-string char) nil nil arg))))
 
 ;; kill-line and its subroutines.
 
index 36a8726b88592e1fbe91d316ceb250324a69de47..236223ef493b5a7f8e917a7f9ef926e9db60fd86 100644 (file)
     (zap-up-to-char 1 ?c))
   (with-misc-test "abcde abc123" "c123"
     (goto-char (point-min))
-    (zap-up-to-char 2 ?c)))
+    (zap-up-to-char 2 ?c))
+  (let ((case-fold-search t))
+    (with-misc-test "abcdeCXYZ" "cdeCXYZ"
+      (goto-char (point-min))
+      (zap-up-to-char 1 ?C))
+    (with-misc-test "abcdeCXYZ" "CXYZ"
+      (goto-char (point-min))
+      (zap-up-to-char 1 ?C 'interactive))))
 
 (ert-deftest misc-test-upcase-char ()
   (with-misc-test "abcde" "aBCDe"
index 437c62f61d8575127ed494b720a0fbc2102e7277..b4576889dcda9d576214f0d21e29c96d6064b543 100644 (file)
@@ -1004,6 +1004,27 @@ See Bug#21722."
       (yank-in-context)
       (buffer-string))
     "echo 'f'\\''bar'\\''oo'")))
+\f
+;;; Tests for `zap-to-char'
+
+(defmacro with-zap-to-char-test (original result &rest body)
+  (declare (indent 2) (debug (stringp stringp body)))
+  `(with-temp-buffer
+     (insert ,original)
+     (goto-char (point-min))
+     ,@body
+     (should (equal (buffer-string) ,result))))
+
+(ert-deftest simple-tests-zap-to-char ()
+  (with-zap-to-char-test "abcde" "de"
+    (zap-to-char 1 ?c))
+  (with-zap-to-char-test "abcde abc123" "123"
+    (zap-to-char 2 ?c))
+  (let ((case-fold-search t))
+    (with-zap-to-char-test "abcdeCXYZ" "deCXYZ"
+      (zap-to-char 1 ?C))
+    (with-zap-to-char-test "abcdeCXYZ" "XYZ"
+      (zap-to-char 1 ?C 'interactive))))
 
 (provide 'simple-test)
 ;;; simple-tests.el ends here