[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
bug#14013: 24.3.50; dired-isearch-filenames-regexp is matching text outs
|
From: |
Juri Linkov |
|
Subject: |
bug#14013: 24.3.50; dired-isearch-filenames-regexp is matching text outside filenames |
|
Date: |
Thu, 30 Jun 2022 20:45:17 +0300 |
|
User-agent: |
Gnus/5.13 (Gnus v5.13) Emacs/29.0.50 (x86_64-pc-linux-gnu) |
> BTW, do you think that such regexps as ".*" and "^.*$"
> should be supported not only in Dired buffers, but also
> when making replacements in rectangular regions?
> E.g. C-x SPC ... C-M-% .* RET RET should effectively
> clear the region, etc.
Here is a complete patch with tests:
diff --git a/lisp/isearch.el b/lisp/isearch.el
index 34c3665bd8..14e5bfb93f 100644
--- a/lisp/isearch.el
+++ b/lisp/isearch.el
@@ -2805,12 +2806,10 @@ isearch-search-and-update
(if (and (eq case-fold-search t) search-upper-case)
(setq case-fold-search
(isearch-no-upper-case-p isearch-string
isearch-regexp)))
- (looking-at (cond
- ((functionp isearch-regexp-function)
- (funcall isearch-regexp-function
isearch-string t))
- (isearch-regexp-function (word-search-regexp
isearch-string t))
- (isearch-regexp isearch-string)
- (t (regexp-quote isearch-string)))))
+ ;; Like `looking-at' but uses search functions:
+ (let ((isearch-forward t))
+ (isearch-search-string
+ (concat "\\=\\(?:" isearch-string "\\)") nil t)))
(error nil))
(or isearch-yank-flag
(<= (match-end 0)
@@ -4381,6 +4401,7 @@ minibuffer-lazy-highlight-setup
(cleanup lazy-highlight-cleanup)
(transform #'identity)
(filter nil)
+ (search-fun nil)
(regexp isearch-regexp)
(regexp-function isearch-regexp-function)
(case-fold isearch-case-fold-search)
@@ -4400,6 +4421,7 @@ minibuffer-lazy-highlight-setup
TRANSFORM: A function taking one argument, the minibuffer contents,
and returning the `isearch-string' to use for lazy highlighting.
FILTER: A function to add to `isearch-filter-predicate'.
+SEARCH-FUN: A function to add to `isearch-search-fun-function'.
REGEXP: The value of `isearch-regexp' to use for lazy highlighting.
REGEXP-FUNCTION: The value of `isearch-regexp-function' to use for
lazy highlighting.
@@ -4419,6 +4441,9 @@ minibuffer-lazy-highlight-setup
(when filter
(with-current-buffer buffer
(remove-function (local 'isearch-filter-predicate) filter)))
+ (when search-fun
+ (with-current-buffer buffer
+ (remove-function (local 'isearch-search-fun-function)
search-fun)))
(remove-hook 'lazy-count-update-hook display-count)
(when overlay (delete-overlay overlay))
(remove-hook 'after-change-functions after-change t)
@@ -4454,92 +4479,123 @@ minibuffer-lazy-highlight-setup
(when filter
(with-current-buffer buffer
(add-function :after-while (local 'isearch-filter-predicate)
filter)))
+ (when search-fun
+ (with-current-buffer buffer
+ (add-function :around (local 'isearch-search-fun-function)
search-fun)))
(funcall after-change nil nil nil)))))
+(defun isearch-search-fun-in-noncontiguous-region (search-fun bounds)
+ "Return the function that searches inside noncontiguous regions.
+A noncontiguous regions is defined by the argument BOUNDS that
+is a list of cons cells of the form (START . END)."
+ (apply-partially
+ #'search-within-boundaries
+ search-fun
+ (lambda (pos)
+ (seq-some (lambda (b) (if isearch-forward
+ (and (>= pos (car b)) (< pos (cdr b)))
+ (and (> pos (car b)) (<= pos (cdr b)))))
+ bounds))
+ (lambda (pos)
+ (let ((bounds (flatten-list bounds))
+ found)
+ (unless isearch-forward
+ (setq bounds (nreverse bounds)))
+ (while (and bounds (not found))
+ (if (if isearch-forward (< pos (car bounds)) (> pos (car bounds)))
+ (setq found (car bounds))
+ (setq bounds (cdr bounds))))
+ found))))
+
(defun isearch-search-fun-in-text-property (search-fun property)
"Return the function to search inside text that has the specified PROPERTY.
The function will limit the search for matches only inside text which has
this property in the current buffer.
The argument SEARCH-FUN provides the function to search text, and
defaults to the value of `isearch-search-fun-default' when nil."
- (lambda (string &optional bound noerror count)
- (let* ((old (point))
- ;; Check if point is already on the property.
- (beg (when (get-text-property
- (if isearch-forward old (max (1- old) (point-min)))
- property)
- old))
- end found (i 0)
- (subregexp
- (and isearch-regexp
- (save-match-data
- (catch 'subregexp
- (while (string-match "\\^\\|\\$" string i)
- (setq i (match-end 0))
- (when (subregexp-context-p string (match-beginning 0))
- ;; The ^/$ is not inside a char-range or escaped.
- (throw 'subregexp t))))))))
- ;; Otherwise, try to search for the next property.
- (unless beg
- (setq beg (if isearch-forward
- (next-single-property-change old property)
- (previous-single-property-change old property)))
- (when beg (goto-char beg)))
- ;; Non-nil `beg' means there are more properties.
- (while (and beg (not found))
- ;; Search for the end of the current property.
- (setq end (if isearch-forward
- (next-single-property-change beg property)
- (previous-single-property-change beg property)))
- ;; Handle ^/$ specially by matching in a temporary buffer.
- (if subregexp
- (let* ((prop-beg
- (if (or (if isearch-forward (bobp) (eobp))
- (null (get-text-property
- (+ (point) (if isearch-forward -1 0))
- property)))
- ;; Already at the beginning of the field.
- beg
- ;; Get the real beginning of the field when
- ;; the search was started in the middle.
- (if isearch-forward
- (previous-single-property-change beg property)
- (next-single-property-change beg property))))
- (substring (buffer-substring prop-beg end))
- (offset (if isearch-forward prop-beg end))
- match-data)
- (with-temp-buffer
- (insert substring)
- (goto-char (- beg offset -1))
- ;; Apply ^/$ regexp on the whole extracted substring.
- (setq found (funcall
- (or search-fun (isearch-search-fun-default))
- string (and bound (max (point-min)
- (min (point-max)
- (- bound offset -1))))
- noerror count))
- ;; Adjust match data as if it's matched in original buffer.
- (when found
- (setq found (+ found offset -1)
- match-data (mapcar (lambda (m) (+ m offset -1))
- (match-data)))))
- (when match-data (set-match-data match-data)))
- (setq found (funcall
- (or search-fun (isearch-search-fun-default))
- string (if bound (if isearch-forward
- (min bound end)
- (max bound end))
- end)
- noerror count)))
- ;; Get the next text property.
- (unless found
- (setq beg (if isearch-forward
- (next-single-property-change end property)
- (previous-single-property-change end property)))
- (when beg (goto-char beg))))
- (unless found (goto-char old))
- found)))
+ (apply-partially
+ #'search-within-boundaries
+ search-fun
+ (lambda (pos) (get-text-property (if isearch-forward pos
+ (max (1- pos) (point-min)))
+ property))
+ (lambda (pos) (if isearch-forward
+ (next-single-property-change pos property)
+ (previous-single-property-change pos property)))))
+
+(defun search-within-boundaries ( search-fun get-fun next-fun
+ string &optional bound noerror count)
+ (let* ((old (point))
+ ;; Check if point is already on the property.
+ (beg (when (funcall get-fun old) old))
+ end found (i 0)
+ (subregexp
+ (and isearch-regexp
+ (save-match-data
+ (catch 'subregexp
+ (while (string-match "\\^\\|\\$" string i)
+ (setq i (match-end 0))
+ (when (subregexp-context-p string (match-beginning 0))
+ ;; The ^/$ is not inside a char-range or escaped.
+ (throw 'subregexp t))))))))
+ ;; Otherwise, try to search for the next property.
+ (unless beg
+ (setq beg (funcall next-fun old))
+ (when beg (goto-char beg)))
+ ;; Non-nil `beg' means there are more properties.
+ (while (and beg (not found))
+ ;; Search for the end of the current property.
+ (setq end (funcall next-fun beg))
+ ;; Handle ^/$ specially by matching in a temporary buffer.
+ (if subregexp
+ (let* ((prop-beg
+ (if (or (if isearch-forward (bobp) (eobp))
+ (null (funcall get-fun
+ (+ (point)
+ (if isearch-forward -1 1)))))
+ ;; Already at the beginning of the field.
+ beg
+ ;; Get the real beginning of the field when
+ ;; the search was started in the middle.
+ (let ((isearch-forward (not isearch-forward)))
+ ;; Search in the reverse direction.
+ (funcall next-fun beg))))
+ (substring (buffer-substring prop-beg end))
+ (offset (if isearch-forward prop-beg end))
+ match-data)
+ (with-temp-buffer
+ (insert substring)
+ (goto-char (- beg offset -1))
+ ;; Apply ^/$ regexp on the whole extracted substring.
+ (setq found (funcall
+ (or search-fun (isearch-search-fun-default))
+ string (and bound (max (point-min)
+ (min (point-max)
+ (- bound offset -1))))
+ noerror count))
+ ;; Adjust match data as if it's matched in original buffer.
+ (when found
+ (setq found (+ found offset -1)
+ match-data (mapcar (lambda (m) (+ m offset -1))
+ (match-data)))))
+ (when found (goto-char found))
+ (when match-data (set-match-data
+ (mapcar (lambda (m) (copy-marker m))
+ match-data))))
+ (setq found (funcall
+ (or search-fun (isearch-search-fun-default))
+ string (if bound (if isearch-forward
+ (min bound end)
+ (max bound end))
+ end)
+ noerror count)))
+ ;; Get the next text property.
+ (unless found
+ (setq beg (funcall next-fun end))
+ (when beg (goto-char beg))))
+ (unless found (goto-char old))
+ found))
(defun isearch-resume (string regexp word forward message case-fold)
diff --git a/lisp/replace.el b/lisp/replace.el
index 34c3d5299e..ca2edbf8ea 100644
--- a/lisp/replace.el
+++ b/lisp/replace.el
@@ -371,9 +371,6 @@ query-replace-read-args
(from (minibuffer-with-setup-hook
(minibuffer-lazy-highlight-setup
:case-fold case-fold-search
- :filter (when (use-region-p)
- (replace--region-filter
- (funcall region-extract-function 'bounds)))
:highlight query-replace-lazy-highlight
:regexp regexp-flag
:regexp-function (or replace-regexp-function
@@ -381,6 +378,15 @@ query-replace-read-args
(and replace-char-fold
(not regexp-flag)
#'char-fold-to-regexp))
+ :search-fun (when (use-region-p)
+ (let ((bounds
+ (mapcar (lambda (p)
+ (cons (copy-marker (car
p))
+ (copy-marker (cdr
p))))
+ (funcall
region-extract-function 'bounds))))
+ (lambda (orig-fun)
+
(isearch-search-fun-in-noncontiguous-region
+ (funcall orig-fun) bounds))))
:transform (lambda (string)
(let* ((split (query-replace--split-string
string))
(from-string (if (consp split) (car
split) split)))
@@ -2850,26 +2856,6 @@ replace--push-stack
,search-str ,next-replace)
,stack))
-(defun replace--region-filter (bounds)
- "Return a function that decides if a region is inside BOUNDS.
-BOUNDS is a list of cons cells of the form (START . END). The
-returned function takes as argument two buffer positions, START
-and END."
- (let ((region-bounds
- (mapcar (lambda (position)
- (cons (copy-marker (car position))
- (copy-marker (cdr position))))
- bounds)))
- (lambda (start end)
- (delq nil (mapcar
- (lambda (bounds)
- (and
- (>= start (car bounds))
- (<= start (cdr bounds))
- (>= end (car bounds))
- (<= end (cdr bounds))))
- region-bounds)))))
-
(defun perform-replace (from-string replacements
query-flag regexp-flag delimited-flag
&optional repeat-count map start end backward
region-noncontiguous-p)
@@ -2930,7 +2916,28 @@ perform-replace
;; If non-nil, it is marker saying where in the buffer to stop.
(limit nil)
- (region-filter nil)
+
+ ;; Unless a single contiguous chunk is selected, operate on multiple
chunks.
+ (noncontiguous-region-bounds
+ (when region-noncontiguous-p
+ (mapcar (lambda (p)
+ (cons (copy-marker (car p))
+ (copy-marker (cdr p))))
+ (funcall region-extract-function 'bounds))))
+ (noncontiguous-search-fun
+ (when noncontiguous-region-bounds
+ (isearch-search-fun-in-noncontiguous-region
+ nil noncontiguous-region-bounds)))
+ (replace-search-function
+ (or replace-search-function noncontiguous-search-fun))
+ (replace-re-search-function
+ ;; To be able to use "^.*$" on rectangles
+ (or replace-re-search-function noncontiguous-search-fun))
+ (replace-search-fun-function
+ (when noncontiguous-region-bounds
+ (lambda (orig-fun)
+ (isearch-search-fun-in-noncontiguous-region
+ (funcall orig-fun) noncontiguous-region-bounds))))
;; Data for the next match. If a cons, it has the same format as
;; (match-data); otherwise it is t if a match is possible at point.
@@ -2952,11 +2959,10 @@ perform-replace
"(\\<query-replace-map>\\[help] for help) "))
minibuffer-prompt-properties))))
- ;; Unless a single contiguous chunk is selected, operate on multiple
chunks.
- (when region-noncontiguous-p
- (setq region-filter (replace--region-filter
- (funcall region-extract-function 'bounds)))
- (add-function :after-while isearch-filter-predicate region-filter))
+ ;; For lazy-highlight during replacement
+ (when replace-search-fun-function
+ (add-function :around isearch-search-fun-function
+ replace-search-fun-function))
;; If region is active, in Transient Mark mode, operate on region.
(if backward
@@ -3052,9 +3058,11 @@ perform-replace
(setq match-again
(and nonempty-match
(or (not regexp-flag)
- (and (if backward
- (looking-back search-string nil)
- (looking-at search-string))
+ ;; Like `looking-at' but uses search functions:
+ (and (replace-search
+ (concat "\\=\\(?:" search-string "\\)")
+ limit regexp-flag delimited-flag
+ case-fold-search backward)
(let ((match (match-data)))
(and (/= (nth 0 match) (nth 1 match))
match))))))
@@ -3323,7 +3331,8 @@ perform-replace
;; when perform-replace was started from
;; `xref--query-replace-1' that let-binds
;; `isearch-filter-predicate' (bug#53758).
- (isearch-filter-predicate
#'isearch-filter-visible))
+ (isearch-filter-predicate
#'isearch-filter-visible)
+ (isearch-search-fun-function
#'isearch-search-fun-default))
(setq real-match-data (replace-match-data
nil real-match-data
real-match-data))
@@ -3337,8 +3346,13 @@ perform-replace
;; decide whether the search string
;; can match again just after this match.
(if (and regexp-flag nonempty-match)
- (setq match-again (and (looking-at search-string)
- (match-data)))))
+ (setq match-again
+ (and (save-window-excursion
+ (replace-search
+ (concat "\\=\\(?:" search-string
"\\)")
+ limit regexp-flag delimited-flag
+ case-fold-search backward))
+ (match-data)))))
;; Edit replacement.
((or (eq def 'edit-replacement)
(eq def 'edit-replacement-exact-case))
@@ -3406,8 +3420,9 @@ perform-replace
search-string-replaced nil
last-was-act-and-show nil))))))
(replace-dehighlight)
- (when region-filter
- (remove-function isearch-filter-predicate region-filter)))
+ (when replace-search-fun-function
+ (remove-function isearch-search-fun-function
+ replace-search-fun-function)))
(or unread-command-events
(message (ngettext "Replaced %d occurrence%s"
"Replaced %d occurrences%s"
diff --git a/test/lisp/isearch-tests.el b/test/lisp/isearch-tests.el
index 4600757d94..82f9fb0fe9 100644
--- a/test/lisp/isearch-tests.el
+++ b/test/lisp/isearch-tests.el
@@ -38,5 +38,85 @@ isearch--test-done
;; Bug #21091: let `isearch-done' work without `isearch-update'.
(isearch-done))
+
+;; Search functions.
+
+(defun isearch--test-search-within-boundaries (pairs)
+ (goto-char (point-min))
+ (let ((isearch-forward t)
+ (isearch-regexp nil))
+ (dolist (pos (append pairs nil))
+ (should (eq (cdr pos) (isearch-search-string "foo" nil t)))
+ (should (equal (match-string 0) "foo"))
+ (when (car pos) (should (eq (car pos) (match-beginning 0))))))
+
+ (goto-char (point-max))
+ (let ((isearch-forward nil)
+ (isearch-regexp nil))
+ (dolist (pos (append (reverse pairs) nil))
+ (should (eq (car pos) (isearch-search-string "foo" nil t)))
+ (should (equal (match-string 0) "foo"))
+ (when (cdr pos) (should (eq (cdr pos) (match-end 0))))))
+
+ (goto-char (point-min))
+ (let ((isearch-forward t)
+ (isearch-regexp t))
+ (dolist (pos (append pairs nil))
+ (should (eq (cdr pos) (isearch-search-string ".*" nil t)))
+ (should (equal (match-string 0) "foo"))
+ (when (car pos) (should (eq (car pos) (match-beginning 0))))))
+
+ (goto-char (point-min))
+ (let ((isearch-forward t)
+ (isearch-regexp t))
+ (dolist (pos (append pairs nil))
+ (should (eq (cdr pos) (isearch-search-string "^.*" nil t)))
+ (should (equal (match-string 0) "foo"))
+ (when (car pos) (should (eq (car pos) (match-beginning 0))))))
+
+ (goto-char (point-min))
+ (let ((isearch-forward t)
+ (isearch-regexp t))
+ (dolist (pos (append pairs nil))
+ (should (eq (cdr pos) (isearch-search-string ".*$" nil t)))
+ (should (equal (match-string 0) "foo"))
+ (when (car pos) (should (eq (car pos) (match-beginning 0))))))
+
+ (goto-char (point-max))
+ (let ((isearch-forward nil)
+ (isearch-regexp t))
+ (dolist (pos (append (reverse pairs) nil))
+ (should (eq (car pos) (isearch-search-string "^.*" nil t)))
+ (should (equal (match-string 0) "foo"))
+ (when (cdr pos) (should (eq (cdr pos) (match-end 0))))))
+
+ (goto-char (point-max))
+ (let ((isearch-forward nil)
+ (isearch-regexp t))
+ (dolist (pos (append (reverse pairs) nil))
+ (should (eq (car pos) (isearch-search-string "foo$" nil t)))
+ (should (equal (match-string 0) "foo"))
+ (when (cdr pos) (should (eq (cdr pos) (match-end 0)))))))
+
+(ert-deftest isearch--test-search-fun-in-text-property ()
+ (let* ((pairs '((4 . 7) (11 . 14) (21 . 24)))
+ (isearch-search-fun-function
+ (lambda () (isearch-search-fun-in-text-property nil
'dired-filename))))
+ (with-temp-buffer
+ (insert "foo" (propertize "foo" 'dired-filename t) "foo\n")
+ (insert (propertize "foo" 'dired-filename t) "foo\n")
+ (insert "foo" (propertize "foo" 'dired-filename t) "\n")
+ (isearch--test-search-within-boundaries pairs))))
+
+(ert-deftest isearch--test-search-fun-in-noncontiguous-region ()
+ (let* ((pairs '((4 . 7) (11 . 14) (21 . 24)))
+ (isearch-search-fun-function
+ (lambda () (isearch-search-fun-in-noncontiguous-region nil pairs))))
+ (with-temp-buffer
+ (insert "foofoofoo\n")
+ (insert "foofoo\n")
+ (insert "foofoo\n")
+ (isearch--test-search-within-boundaries pairs))))
+
(provide 'isearch-tests)
;;; isearch-tests.el ends here
diff --git a/test/lisp/replace-tests.el b/test/lisp/replace-tests.el
index ef1e5c3eaf..e59883b5b6 100644
--- a/test/lisp/replace-tests.el
+++ b/test/lisp/replace-tests.el
@@ -460,20 +460,12 @@ query-replace-search-function-tests
(let* ((replace-re-search-function #'re-search-forward))
(query-replace--run-tests query-replace-tests))
- (let* ((pairs '((1 . 2) (3 . 4)))
+ (let* ((bounds '((1 . 2) (3 . 4)))
(replace-re-search-function
- (lambda (string &optional _bound noerror count)
- (let (found)
- (while (and (not found) pairs)
- (goto-char (caar pairs))
- (when (re-search-forward string (cdar pairs) noerror count)
- (setq found t))
- (pop pairs))
- found)))
+ (isearch-search-fun-in-noncontiguous-region nil bounds))
(tests
'(
- ;; FIXME: this test should pass after fixing bug#54733:
- ;; ("aaaa" "C-M-% .* RET 1 RET !" "1a1a")
+ ("aaaa" "C-M-% .* RET 1 RET !" "1a1a")
)))
(query-replace--run-tests tests)))
@@ -485,8 +477,9 @@ perform-replace-tests
;; Test case from commit 5632eb272c7
("a a a " "\\ba " "c" nil t nil nil nil nil nil nil nil "ccc") ; not "ca c"
;; The same with region inside the second match
- ;; FIXME: this test should pass after fixing bug#54733:
- ;; ("a a a " "\\ba " "c" nil t nil nil nil 1 4 nil nil "ca a ")
+ ("a a a " "\\ba " "c" nil t nil nil nil 1 3 nil nil "ca a ")
+ ("a a a " "\\ba " "c" nil t nil nil nil 1 4 nil nil "ca a ")
+ ("a a a " "\\ba " "c" nil t nil nil nil 1 5 nil nil "cca ")
))
(defun perform-replace--run-tests (tests)