diff options
| author | Juri Linkov | 2022-07-08 20:58:33 +0300 |
|---|---|---|
| committer | Juri Linkov | 2022-07-08 20:58:33 +0300 |
| commit | df157953612910e26cab7d1aa31b7ac5cd58d945 (patch) | |
| tree | 8f64756254abf183e584a9e84e5591980769994b | |
| parent | 3cfac1fe073815bdbba96e3a35a1c15626022c07 (diff) | |
| download | emacs-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.el | 182 | ||||
| -rw-r--r-- | test/lisp/isearch-tests.el | 80 |
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. | ||
| 4494 | A noncontiguous region is defined by the argument BOUNDS that | ||
| 4495 | is 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. |
| 4494 | The function will limit the search for matches only inside text which has | 4517 | The function will limit the search for matches only inside text which has |
| 4495 | this property in the current buffer. | 4518 | this property in the current buffer. |
| 4496 | The argument SEARCH-FUN provides the function to search text, and | 4519 | The argument SEARCH-FUN provides the function to search text, and |
| 4497 | defaults to the value of `isearch-search-fun-default' when nil." | 4520 | defaults 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 |