master df15795361: * lisp/isearch.el (isearch-search-fun-in-noncontiguous-region): New function.

[Juri Linkov]

branch: master
commit df157953612910e26cab7d1aa31b7ac5cd58d945
Author: Juri Linkov <juri@linkov.net>
Commit: Juri Linkov <juri@linkov.net>

    * 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.
---
 lisp/isearch.el            | 182 ++++++++++++++++++++++++++-------------------
 test/lisp/isearch-tests.el |  80 ++++++++++++++++++++
 2 files changed, 185 insertions(+), 77 deletions(-)

diff --git a/lisp/isearch.el b/lisp/isearch.el
index ad8897dda2..8f480a87d9 100644
--- a/lisp/isearch.el
+++ b/lisp/isearch.el
@@ -4489,89 +4489,117 @@ LAX-WHITESPACE: The value of `isearch-lax-whitespace' 
and
         (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 region 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/test/lisp/isearch-tests.el b/test/lisp/isearch-tests.el
index 4600757d94..8cb5e5e454 100644
--- a/test/lisp/isearch-tests.el
+++ b/test/lisp/isearch-tests.el
@@ -38,5 +38,85 @@
   ;; 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