aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorJuri Linkov2022-07-08 20:58:33 +0300
committerJuri Linkov2022-07-08 20:58:33 +0300
commitdf157953612910e26cab7d1aa31b7ac5cd58d945 (patch)
tree8f64756254abf183e584a9e84e5591980769994b
parent3cfac1fe073815bdbba96e3a35a1c15626022c07 (diff)
downloademacs-df157953612910e26cab7d1aa31b7ac5cd58d945.tar.gz
emacs-df157953612910e26cab7d1aa31b7ac5cd58d945.zip
* lisp/isearch.el (isearch-search-fun-in-noncontiguous-region): New function.
(isearch-search-fun-in-text-property): Refactor body to 'search-within-boundaries', then call it (bug#14013). (search-within-boundaries): New function refactored from isearch-search-fun-in-text-property. * test/lisp/isearch-tests.el: Add tests for new search functions. (isearch--test-search-within-boundaries): New function. (isearch--test-search-fun-in-text-property) (isearch--test-search-fun-in-noncontiguous-region): New tests.
-rw-r--r--lisp/isearch.el182
-rw-r--r--test/lisp/isearch-tests.el80
2 files changed, 185 insertions, 77 deletions
diff --git a/lisp/isearch.el b/lisp/isearch.el
index ad8897dda2c..8f480a87d94 100644
--- a/lisp/isearch.el
+++ b/lisp/isearch.el
@@ -4489,89 +4489,117 @@ LAX-WHITESPACE: The value of `isearch-lax-whitespace' and
4489 (funcall after-change nil nil nil))))) 4489 (funcall after-change nil nil nil)))))
4490 4490
4491 4491
4492(defun isearch-search-fun-in-noncontiguous-region (search-fun bounds)
4493 "Return the function that searches inside noncontiguous regions.
4494A noncontiguous region is defined by the argument BOUNDS that
4495is a list of cons cells of the form (START . END)."
4496 (apply-partially
4497 #'search-within-boundaries
4498 search-fun
4499 (lambda (pos)
4500 (seq-some (lambda (b) (if isearch-forward
4501 (and (>= pos (car b)) (< pos (cdr b)))
4502 (and (> pos (car b)) (<= pos (cdr b)))))
4503 bounds))
4504 (lambda (pos)
4505 (let ((bounds (flatten-list bounds))
4506 found)
4507 (unless isearch-forward
4508 (setq bounds (nreverse bounds)))
4509 (while (and bounds (not found))
4510 (if (if isearch-forward (< pos (car bounds)) (> pos (car bounds)))
4511 (setq found (car bounds))
4512 (setq bounds (cdr bounds))))
4513 found))))
4514
4492(defun isearch-search-fun-in-text-property (search-fun property) 4515(defun isearch-search-fun-in-text-property (search-fun property)
4493 "Return the function to search inside text that has the specified PROPERTY. 4516 "Return the function to search inside text that has the specified PROPERTY.
4494The function will limit the search for matches only inside text which has 4517The function will limit the search for matches only inside text which has
4495this property in the current buffer. 4518this property in the current buffer.
4496The argument SEARCH-FUN provides the function to search text, and 4519The argument SEARCH-FUN provides the function to search text, and
4497defaults to the value of `isearch-search-fun-default' when nil." 4520defaults to the value of `isearch-search-fun-default' when nil."
4498 (lambda (string &optional bound noerror count) 4521 (apply-partially
4499 (let* ((old (point)) 4522 #'search-within-boundaries
4500 ;; Check if point is already on the property. 4523 search-fun
4501 (beg (when (get-text-property 4524 (lambda (pos) (get-text-property (if isearch-forward pos
4502 (if isearch-forward old (max (1- old) (point-min))) 4525 (max (1- pos) (point-min)))
4503 property) 4526 property))
4504 old)) 4527 (lambda (pos) (if isearch-forward
4505 end found (i 0) 4528 (next-single-property-change pos property)
4506 (subregexp 4529 (previous-single-property-change pos property)))))
4507 (and isearch-regexp 4530
4508 (save-match-data 4531(defun search-within-boundaries ( search-fun get-fun next-fun
4509 (catch 'subregexp 4532 string &optional bound noerror count)
4510 (while (string-match "\\^\\|\\$" string i) 4533 (let* ((old (point))
4511 (setq i (match-end 0)) 4534 ;; Check if point is already on the property.
4512 (when (subregexp-context-p string (match-beginning 0)) 4535 (beg (when (funcall get-fun old) old))
4513 ;; The ^/$ is not inside a char-range or escaped. 4536 end found (i 0)
4514 (throw 'subregexp t)))))))) 4537 (subregexp
4515 ;; Otherwise, try to search for the next property. 4538 (and isearch-regexp
4516 (unless beg 4539 (save-match-data
4517 (setq beg (if isearch-forward 4540 (catch 'subregexp
4518 (next-single-property-change old property) 4541 (while (string-match "\\^\\|\\$" string i)
4519 (previous-single-property-change old property))) 4542 (setq i (match-end 0))
4520 (when beg (goto-char beg))) 4543 (when (subregexp-context-p string (match-beginning 0))
4521 ;; Non-nil `beg' means there are more properties. 4544 ;; The ^/$ is not inside a char-range or escaped.
4522 (while (and beg (not found)) 4545 (throw 'subregexp t))))))))
4523 ;; Search for the end of the current property. 4546 ;; Otherwise, try to search for the next property.
4524 (setq end (if isearch-forward 4547 (unless beg
4525 (next-single-property-change beg property) 4548 (setq beg (funcall next-fun old))
4526 (previous-single-property-change beg property))) 4549 (when beg (goto-char beg)))
4527 ;; Handle ^/$ specially by matching in a temporary buffer. 4550 ;; Non-nil `beg' means there are more properties.
4528 (if subregexp 4551 (while (and beg (not found))
4529 (let* ((prop-beg 4552 ;; Search for the end of the current property.
4530 (if (or (if isearch-forward (bobp) (eobp)) 4553 (setq end (funcall next-fun beg))
4531 (null (get-text-property 4554 ;; Handle ^/$ specially by matching in a temporary buffer.
4532 (+ (point) (if isearch-forward -1 0)) 4555 (if subregexp
4533 property))) 4556 (let* ((prop-beg
4534 ;; Already at the beginning of the field. 4557 (if (or (if isearch-forward (bobp) (eobp))
4535 beg 4558 (null (funcall get-fun
4536 ;; Get the real beginning of the field when 4559 (+ (point)
4537 ;; the search was started in the middle. 4560 (if isearch-forward -1 1)))))
4538 (if isearch-forward 4561 ;; Already at the beginning of the field.
4539 (previous-single-property-change beg property) 4562 beg
4540 (next-single-property-change beg property)))) 4563 ;; Get the real beginning of the field when
4541 (substring (buffer-substring prop-beg end)) 4564 ;; the search was started in the middle.
4542 (offset (if isearch-forward prop-beg end)) 4565 (let ((isearch-forward (not isearch-forward)))
4543 match-data) 4566 ;; Search in the reverse direction.
4544 (with-temp-buffer 4567 (funcall next-fun beg))))
4545 (insert substring) 4568 (substring (buffer-substring prop-beg end))
4546 (goto-char (- beg offset -1)) 4569 (offset (if isearch-forward prop-beg end))
4547 ;; Apply ^/$ regexp on the whole extracted substring. 4570 match-data)
4548 (setq found (funcall 4571 (with-temp-buffer
4549 (or search-fun (isearch-search-fun-default)) 4572 (insert substring)
4550 string (and bound (max (point-min) 4573 (goto-char (- beg offset -1))
4551 (min (point-max) 4574 ;; Apply ^/$ regexp on the whole extracted substring.
4552 (- bound offset -1)))) 4575 (setq found (funcall
4553 noerror count)) 4576 (or search-fun (isearch-search-fun-default))
4554 ;; Adjust match data as if it's matched in original buffer. 4577 string (and bound (max (point-min)
4555 (when found 4578 (min (point-max)
4556 (setq found (+ found offset -1) 4579 (- bound offset -1))))
4557 match-data (mapcar (lambda (m) (+ m offset -1)) 4580 noerror count))
4558 (match-data))))) 4581 ;; Adjust match data as if it's matched in original buffer.
4559 (when match-data (set-match-data match-data))) 4582 (when found
4560 (setq found (funcall 4583 (setq found (+ found offset -1)
4561 (or search-fun (isearch-search-fun-default)) 4584 match-data (mapcar (lambda (m) (+ m offset -1))
4562 string (if bound (if isearch-forward 4585 (match-data)))))
4563 (min bound end) 4586 (when found (goto-char found))
4564 (max bound end)) 4587 (when match-data (set-match-data
4565 end) 4588 (mapcar (lambda (m) (copy-marker m))
4566 noerror count))) 4589 match-data))))
4567 ;; Get the next text property. 4590 (setq found (funcall
4568 (unless found 4591 (or search-fun (isearch-search-fun-default))
4569 (setq beg (if isearch-forward 4592 string (if bound (if isearch-forward
4570 (next-single-property-change end property) 4593 (min bound end)
4571 (previous-single-property-change end property))) 4594 (max bound end))
4572 (when beg (goto-char beg)))) 4595 end)
4573 (unless found (goto-char old)) 4596 noerror count)))
4574 found))) 4597 ;; Get the next text property.
4598 (unless found
4599 (setq beg (funcall next-fun end))
4600 (when beg (goto-char beg))))
4601 (unless found (goto-char old))
4602 found))
4575 4603
4576 4604
4577(defun isearch-resume (string regexp word forward message case-fold) 4605(defun isearch-resume (string regexp word forward message case-fold)
diff --git a/test/lisp/isearch-tests.el b/test/lisp/isearch-tests.el
index 4600757d940..8cb5e5e4542 100644
--- a/test/lisp/isearch-tests.el
+++ b/test/lisp/isearch-tests.el
@@ -38,5 +38,85 @@
38 ;; Bug #21091: let `isearch-done' work without `isearch-update'. 38 ;; Bug #21091: let `isearch-done' work without `isearch-update'.
39 (isearch-done)) 39 (isearch-done))
40 40
41
42;; Search functions.
43
44(defun isearch--test-search-within-boundaries (pairs)
45 (goto-char (point-min))
46 (let ((isearch-forward t)
47 (isearch-regexp nil))
48 (dolist (pos (append pairs nil))
49 (should (eq (cdr pos) (isearch-search-string "foo" nil t)))
50 (should (equal (match-string 0) "foo"))
51 (when (car pos) (should (eq (car pos) (match-beginning 0))))))
52
53 (goto-char (point-max))
54 (let ((isearch-forward nil)
55 (isearch-regexp nil))
56 (dolist (pos (append (reverse pairs) nil))
57 (should (eq (car pos) (isearch-search-string "foo" nil t)))
58 (should (equal (match-string 0) "foo"))
59 (when (cdr pos) (should (eq (cdr pos) (match-end 0))))))
60
61 (goto-char (point-min))
62 (let ((isearch-forward t)
63 (isearch-regexp t))
64 (dolist (pos (append pairs nil))
65 (should (eq (cdr pos) (isearch-search-string ".*" nil t)))
66 (should (equal (match-string 0) "foo"))
67 (when (car pos) (should (eq (car pos) (match-beginning 0))))))
68
69 (goto-char (point-min))
70 (let ((isearch-forward t)
71 (isearch-regexp t))
72 (dolist (pos (append pairs nil))
73 (should (eq (cdr pos) (isearch-search-string "^.*" nil t)))
74 (should (equal (match-string 0) "foo"))
75 (when (car pos) (should (eq (car pos) (match-beginning 0))))))
76
77 (goto-char (point-min))
78 (let ((isearch-forward t)
79 (isearch-regexp t))
80 (dolist (pos (append pairs nil))
81 (should (eq (cdr pos) (isearch-search-string ".*$" nil t)))
82 (should (equal (match-string 0) "foo"))
83 (when (car pos) (should (eq (car pos) (match-beginning 0))))))
84
85 (goto-char (point-max))
86 (let ((isearch-forward nil)
87 (isearch-regexp t))
88 (dolist (pos (append (reverse pairs) nil))
89 (should (eq (car pos) (isearch-search-string "^.*" nil t)))
90 (should (equal (match-string 0) "foo"))
91 (when (cdr pos) (should (eq (cdr pos) (match-end 0))))))
92
93 (goto-char (point-max))
94 (let ((isearch-forward nil)
95 (isearch-regexp t))
96 (dolist (pos (append (reverse pairs) nil))
97 (should (eq (car pos) (isearch-search-string "foo$" nil t)))
98 (should (equal (match-string 0) "foo"))
99 (when (cdr pos) (should (eq (cdr pos) (match-end 0)))))))
100
101(ert-deftest isearch--test-search-fun-in-text-property ()
102 (let* ((pairs '((4 . 7) (11 . 14) (21 . 24)))
103 (isearch-search-fun-function
104 (lambda () (isearch-search-fun-in-text-property nil 'dired-filename))))
105 (with-temp-buffer
106 (insert "foo" (propertize "foo" 'dired-filename t) "foo\n")
107 (insert (propertize "foo" 'dired-filename t) "foo\n")
108 (insert "foo" (propertize "foo" 'dired-filename t) "\n")
109 (isearch--test-search-within-boundaries pairs))))
110
111(ert-deftest isearch--test-search-fun-in-noncontiguous-region ()
112 (let* ((pairs '((4 . 7) (11 . 14) (21 . 24)))
113 (isearch-search-fun-function
114 (lambda () (isearch-search-fun-in-noncontiguous-region nil pairs))))
115 (with-temp-buffer
116 (insert "foofoofoo\n")
117 (insert "foofoo\n")
118 (insert "foofoo\n")
119 (isearch--test-search-within-boundaries pairs))))
120
41(provide 'isearch-tests) 121(provide 'isearch-tests)
42;;; isearch-tests.el ends here 122;;; isearch-tests.el ends here