"Function to save a function restoring the mode-specific isearch state
to the search status stack.")
-(defvar isearch-success-function 'isearch-success-function-default
- "Function to report whether the new search match is considered successful.
-The function has two arguments: the positions of start and end of text
-matched by the search. If this function returns nil, continue
-searching without stopping at this match.")
+(defvar isearch-filter-predicate 'isearch-filter-invisible
+ "Predicate that filters the search hits that would normally be available.
+Search hits that dissatisfy the predicate are skipped. The function
+has two arguments: the positions of start and end of text matched by
+the search. If this function returns nil, continue searching without
+stopping at this match.")
;; Search ring.
(defvar isearch-string "") ; The current search string.
(defvar isearch-message "") ; text-char-description version of isearch-string
+(defvar isearch-message-prefix-add nil) ; Additonal text for the message prefix
+(defvar isearch-message-suffix-add nil) ; Additonal text for the message suffix
+
(defvar isearch-success t) ; Searching is currently successful.
(defvar isearch-error nil) ; Error message for failed search.
(defvar isearch-other-end nil) ; Start (end) of match if forward (backward).
(sit-for 1)
(isearch-update))
-(defun isearch-query-replace (&optional regexp-flag)
- "Start `query-replace' with string to replace from last search string."
- (interactive)
+(defun isearch-query-replace (&optional delimited regexp-flag)
+ "Start `query-replace' with string to replace from last search string.
+The arg DELIMITED (prefix arg if interactive), if non-nil, means replace
+only matches surrounded by word boundaries. Note that using the prefix arg
+is possible only when `isearch-allow-scroll' is non-nil, and it don't
+always provides the correct matches for `query-replace', so the preferred
+way to run word replacements from Isearch is `M-s w ... M-%'."
+ (interactive
+ (list current-prefix-arg))
(barf-if-buffer-read-only)
(if regexp-flag (setq isearch-regexp t))
(let ((case-fold-search isearch-case-fold-search)
;; set `search-upper-case' to nil to not call
;; `isearch-no-upper-case-p' in `perform-replace'
- (search-upper-case nil))
- (isearch-done)
+ (search-upper-case nil)
+ ;; Set `isearch-recursive-edit' to nil to prevent calling
+ ;; `exit-recursive-edit' in `isearch-done' that terminates
+ ;; the execution of this command when it is non-nil.
+ ;; We call `exit-recursive-edit' explicitly at the end below.
+ (isearch-recursive-edit nil))
+ (isearch-done nil t)
(isearch-clean-overlays)
(if (and isearch-other-end
(< isearch-other-end (point))
isearch-string
(query-replace-read-to
isearch-string
- (if isearch-regexp "Query replace regexp" "Query replace")
+ (concat "Query replace"
+ (if (or delimited isearch-word) " word" "")
+ (if isearch-regexp " regexp" "")
+ (if (and transient-mark-mode mark-active) " in region" ""))
isearch-regexp)
- t isearch-regexp isearch-word nil nil
+ t isearch-regexp (or delimited isearch-word) nil nil
(if (and transient-mark-mode mark-active) (region-beginning))
- (if (and transient-mark-mode mark-active) (region-end)))))
+ (if (and transient-mark-mode mark-active) (region-end))))
+ (and isearch-recursive-edit (exit-recursive-edit)))
-(defun isearch-query-replace-regexp ()
- "Start `query-replace-regexp' with string to replace from last search string."
- (interactive)
- (isearch-query-replace t))
+(defun isearch-query-replace-regexp (&optional delimited)
+ "Start `query-replace-regexp' with string to replace from last search string.
+See `isearch-query-replace' for more information."
+ (interactive
+ (list current-prefix-arg))
+ (isearch-query-replace delimited t))
(defun isearch-occur (regexp &optional nlines)
"Run `occur' with regexp to search from the current search string.
string. NLINES has the same meaning as in `occur'."
(interactive
(list
- (if isearch-regexp isearch-string (regexp-quote isearch-string))
+ (cond
+ (isearch-word (concat "\\b" (regexp-quote isearch-string) "\\b"))
+ (isearch-regexp isearch-string)
+ (t (regexp-quote isearch-string)))
(if current-prefix-arg (prefix-numeric-value current-prefix-arg))))
(let ((case-fold-search isearch-case-fold-search)
;; set `search-upper-case' to nil to not call
argument from the last search regexp or a quoted search string,
and reads its face argument using `hi-lock-read-face-name'."
(interactive)
- (isearch-done)
- (isearch-clean-overlays)
+ (let (
+ ;; Set `isearch-recursive-edit' to nil to prevent calling
+ ;; `exit-recursive-edit' in `isearch-done' that terminates
+ ;; the execution of this command when it is non-nil.
+ ;; We call `exit-recursive-edit' explicitly at the end below.
+ (isearch-recursive-edit nil))
+ (isearch-done nil t)
+ (isearch-clean-overlays))
(require 'hi-lock nil t)
- ;; (add-to-history 'hi-lock-regexp-history regexp)
- (let ((case-fold-search isearch-case-fold-search)
- ;; TODO: add `search-upper-case' as in `isearch-occur'
- )
- (hi-lock-face-buffer
- (hi-lock-regexp-okay
- (if isearch-regexp isearch-string (regexp-quote isearch-string)))
- (hi-lock-read-face-name))))
+ (let ((string (cond (isearch-regexp isearch-string)
+ ((if (and (eq isearch-case-fold-search t)
+ search-upper-case)
+ (isearch-no-upper-case-p
+ isearch-string isearch-regexp)
+ isearch-case-fold-search)
+ ;; Turn isearch-string into a case-insensitive
+ ;; regexp.
+ (mapconcat
+ (lambda (c)
+ (let ((s (string c)))
+ (if (string-match "[[:alpha:]]" s)
+ (format "[%s%s]" (upcase s) (downcase s))
+ (regexp-quote s))))
+ isearch-string ""))
+ (t (regexp-quote isearch-string)))))
+ (hi-lock-face-buffer string (hi-lock-read-face-name)))
+ (and isearch-recursive-edit (exit-recursive-edit)))
\f
(defun isearch-delete-char ()
(if isearch-word "word " "")
(if isearch-regexp "regexp " "")
(if multi-isearch-next-buffer-current-function "multi " "")
+ (or isearch-message-prefix-add "")
(if nonincremental "search" "I-search")
(if isearch-forward "" " backward")
(if current-input-method
(concat (if c-q-hack "^Q" "")
(if isearch-error
(concat " [" isearch-error "]")
- "")))
+ "")
+ (or isearch-message-suffix-add "")))
\f
;; Searching
(funcall isearch-search-fun-function)
(cond
(isearch-word
- (if isearch-forward 'word-search-forward 'word-search-backward))
+ ;; Use lax versions to not fail at the end of the word while the user
+ ;; adds and removes characters in the search string
+ (if (not (eq (length isearch-string)
+ (length (isearch-string-state (car isearch-cmds)))))
+ (if isearch-forward 'word-search-forward-lax 'word-search-backward-lax)
+ (if isearch-forward 'word-search-forward 'word-search-backward)))
(isearch-regexp
(if isearch-forward 're-search-forward 're-search-backward))
(t
(if isearch-forward 'search-forward 'search-backward)))))
(defun isearch-search-string (string bound noerror)
- ;; Search for the first occurance of STRING or its translation. If
- ;; found, move point to the end of the occurance, update
- ;; isearch-match-beg and isearch-match-end, and return point.
- (let ((func (isearch-search-fun))
- (len (length string))
- pos1 pos2)
- (setq pos1 (save-excursion (funcall func string bound noerror)))
- (if (and (char-table-p translation-table-for-input)
- (multibyte-string-p string)
- ;; Minor optimization.
- (string-match-p "[^[:ascii:]]" string))
- (let ((translated
- (apply 'string
- (mapcar (lambda (c)
- (or (aref translation-table-for-input c) c))
- string)))
- match-data)
- (when translated
- (save-match-data
- (save-excursion
- (if (setq pos2 (funcall func translated bound noerror))
- (setq match-data (match-data t)))))
- (when (and pos2
- (or (not pos1)
- (if isearch-forward (< pos2 pos1) (> pos2 pos1))))
- (setq pos1 pos2)
- (set-match-data match-data)))))
+ "Search for the first occurance of STRING or its translation. If
+found, move point to the end of the occurance, update
+isearch-match-beg and isearch-match-end, and return point."
+ (let* ((func (isearch-search-fun))
+ (pos1 (save-excursion (funcall func string bound noerror)))
+ pos2)
+ (when (and (char-table-p translation-table-for-input)
+ (multibyte-string-p string)
+ ;; Minor optimization.
+ (string-match-p "[^[:ascii:]]" string))
+ (let ((translated
+ (apply 'string
+ (mapcar (lambda (c)
+ (or (aref translation-table-for-input c) c))
+ string)))
+ match-data)
+ (when translated
+ (save-match-data
+ (save-excursion
+ (if (setq pos2 (funcall func translated bound noerror))
+ (setq match-data (match-data t)))))
+ (when (and pos2
+ (or (not pos1)
+ (if isearch-forward (< pos2 pos1) (> pos2 pos1))))
+ (setq pos1 pos2)
+ (set-match-data match-data)))))
(when pos1
;; When using multiple buffers isearch, switch to the new buffer here,
;; because `save-excursion' above doesn't allow doing it inside funcall.
(if (and multi-isearch-next-buffer-current-function
(buffer-live-p multi-isearch-current-buffer))
(switch-to-buffer multi-isearch-current-buffer))
- (goto-char pos1))
- pos1))
+ (goto-char pos1)
+ pos1)))
(defun isearch-search ()
;; Do the search with the current search string.
(isearch-no-upper-case-p isearch-string isearch-regexp)))
(condition-case lossage
(let ((inhibit-point-motion-hooks
- (and (eq isearch-success-function 'isearch-success-function-default)
+ (and (eq isearch-filter-predicate 'isearch-filter-invisible)
search-invisible))
(inhibit-quit nil)
(case-fold-search isearch-case-fold-search)
(while retry
(setq isearch-success
(isearch-search-string isearch-string nil t))
- ;; Clear RETRY unless we matched some invisible text
- ;; and we aren't supposed to do that.
+ ;; Clear RETRY unless the search predicate says
+ ;; to skip this search hit.
(if (or (not isearch-success)
(bobp) (eobp)
(= (match-beginning 0) (match-end 0))
- (funcall isearch-success-function
+ (funcall isearch-filter-predicate
(match-beginning 0) (match-end 0)))
(setq retry nil)))
(setq isearch-just-started nil)
nil)
(setq isearch-hidden t)))))))
-(defun isearch-success-function-default (beg end)
- "Default function to report if the new search match is successful.
-Returns t if search can match hidden text, or otherwise checks if some
-text from BEG to END is visible."
+(defun isearch-filter-invisible (beg end)
+ "Default predicate to filter out invisible text.
+It filters search hits to those that are visible (at least partially),
+unless invisible text too can be searched."
(or (eq search-invisible t)
(not (isearch-range-invisible beg end))))
(defun isearch-lazy-highlight-search ()
"Search ahead for the next or previous match, for lazy highlighting.
Attempt to do the search exactly the way the pending isearch would."
- (let ((case-fold-search isearch-lazy-highlight-case-fold-search)
- (isearch-regexp isearch-lazy-highlight-regexp)
- (search-spaces-regexp isearch-lazy-highlight-space-regexp))
- (condition-case nil
- (isearch-search-string
- isearch-lazy-highlight-last-string
- (if isearch-forward
- (min (or isearch-lazy-highlight-end-limit (point-max))
+ (condition-case nil
+ (let ((case-fold-search isearch-lazy-highlight-case-fold-search)
+ (isearch-regexp isearch-lazy-highlight-regexp)
+ (search-spaces-regexp isearch-lazy-highlight-space-regexp)
+ (search-invisible nil) ; don't match invisible text
+ (retry t)
+ (success nil)
+ (bound (if isearch-forward
+ (min (or isearch-lazy-highlight-end-limit (point-max))
+ (if isearch-lazy-highlight-wrapped
+ isearch-lazy-highlight-start
+ (window-end)))
+ (max (or isearch-lazy-highlight-start-limit (point-min))
(if isearch-lazy-highlight-wrapped
- isearch-lazy-highlight-start
- (window-end)))
- (max (or isearch-lazy-highlight-start-limit (point-min))
- (if isearch-lazy-highlight-wrapped
- isearch-lazy-highlight-end
- (window-start))))
- t)
- (error nil))))
+ isearch-lazy-highlight-end
+ (window-start))))))
+ ;; Use a loop like in `isearch-search'.
+ (while retry
+ (setq success (isearch-search-string
+ isearch-lazy-highlight-last-string bound t))
+ ;; Clear RETRY unless the search predicate says
+ ;; to skip this search hit.
+ (if (or (not success)
+ (funcall isearch-filter-predicate
+ (match-beginning 0) (match-end 0)))
+ (setq retry nil)))
+ success)
+ (error nil)))
(defun isearch-lazy-highlight-update ()
"Update highlighting of other matches for current search."
HCoop / bpt / emacs.git / blobdiff