* 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.
This commit is contained in:
Juri Linkov
parent
3cfac1fe07
commit
df15795361
2 changed files with 185 additions and 77 deletions
182
lisp/isearch.el
182
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)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue