comparison lisp/isearch.el @ 89969:3219f94257bc

Revision: [e-mail]--gnu-2004/emacs--unicode--0--patch-34 Merge from emacs--cvs-trunk--0 Patches applied: * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-514 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-522 Update from CVS

89968:1e9fa4848335

;; Exiting immediately from isearch uses isearch-edit-string instead
;; of nonincremental-search, if search-nonincremental-instead is non-nil.
;; The name of this option should probably be changed if we decide to
;; keep the behavior.  No point in forcing nonincremental search until
;; the last possible moment.

;; TODO
;; - Integrate the emacs 19 generalized command history.
;; - Hooks and options for failed search.

;;; Change Log:

;; Changes before those recorded in ChangeLog:

;; Revision 1.4  92/09/14  16:26:02  liberte
;; Added prefix args to isearch-forward, etc. to switch between
;;    string and regular expression searching.
;; Added some support for lemacs.
;; Added general isearch-highlight option - but only for lemacs so far.
;; Added support for frame switching in emacs 19.
;; Added word search option to isearch-edit-string.
;; Renamed isearch-quit to isearch-abort.
;; Numerous changes to comments and doc strings.
;;
;; Revision 1.3  92/06/29  13:10:08  liberte
;; Moved modal isearch-mode handling into isearch-mode.
;; Got rid of buffer-local isearch variables.
;; isearch-edit-string used by ring adjustments, completion, and
;; nonincremental searching.  C-s and C-r are additional exit commands.
;; Renamed all regex to regexp.
;; Got rid of found-start and found-point globals.
;; Generalized handling of upper-case chars.

;; Revision 1.2  92/05/27  11:33:57  liberte
;; Emacs version 19 has a search ring, which is supported here.
;; Other fixes found in the version 19 isearch are included here.
;;
;; Also see variables search-caps-disable-folding,
;; search-nonincremental-instead, search-whitespace-regexp, and
;; commands isearch-toggle-regexp, isearch-edit-string.
;;
;; semi-modal isearching is supported.

;; Changes for 1.1
;; 3/18/92 Fixed invalid-regexp.
;; 3/18/92 Fixed yanking in regexps.

;;; Code:


;; Some additional options and constants.

(defvar isearch-mode-hook nil
  "Function(s) to call after starting up an incremental search.")

(defvar isearch-mode-end-hook nil
  "Function(s) to call after terminating an incremental search.")

;; Search ring.

(defvar search-ring nil
  "List of search string sequences.")

;;   (handle-switch-frame (car (cdr last-command-char))))


;; The search status structure and stack.

(defsubst isearch-string (frame)
  "Return the search string in FRAME."
  (aref frame 0))
(defsubst isearch-message-string (frame)
  "Return the search string to display to the user in FRAME."
  (aref frame 1))
(defsubst isearch-point (frame)
  "Return the point in FRAME."
  (aref frame 2))
(defsubst isearch-success (frame)
  "Return the success flag in FRAME."
  (aref frame 3))
(defsubst isearch-forward-flag (frame)
  "Return the searching-forward flag in FRAME."
  (aref frame 4))
(defsubst isearch-other-end (frame)
  "Return the other end of the match in FRAME."
  (aref frame 5))
(defsubst isearch-word (frame)
  "Return the search-by-word flag in FRAME."
  (aref frame 6))
(defsubst isearch-invalid-regexp (frame)
  "Return the regexp error message in FRAME, or nil if its regexp is valid."
  (aref frame 7))
(defsubst isearch-wrapped (frame)
  "Return the search-wrapped flag in FRAME."
  (aref frame 8))
(defsubst isearch-barrier (frame)
  "Return the barrier value in FRAME."
  (aref frame 9))
(defsubst isearch-within-brackets (frame)
  "Return the in-character-class flag in FRAME."
  (aref frame 10))
(defsubst isearch-case-fold-search (frame)
  "Return the case-folding flag in FRAME."
  (aref frame 11))

(defun isearch-top-state ()
  (let ((cmd (car isearch-cmds)))
    (setq isearch-string (isearch-string cmd)
	  isearch-message (isearch-message-string cmd)
	  isearch-success (isearch-success cmd)
	  isearch-forward (isearch-forward-flag cmd)
	  isearch-other-end (isearch-other-end cmd)
	  isearch-word (isearch-word cmd)
	  isearch-invalid-regexp (isearch-invalid-regexp cmd)
	  isearch-wrapped (isearch-wrapped cmd)
	  isearch-barrier (isearch-barrier cmd)
	  isearch-within-brackets (isearch-within-brackets cmd)
	  isearch-case-fold-search (isearch-case-fold-search cmd))
    (goto-char (isearch-point cmd))))

(defun isearch-pop-state ()
  (setq isearch-cmds (cdr isearch-cmds))
  (isearch-top-state))

  (setq isearch-cmds
	(cons (vector isearch-string isearch-message (point)
		      isearch-success isearch-forward isearch-other-end
		      isearch-word
		      isearch-invalid-regexp isearch-wrapped isearch-barrier
		      isearch-within-brackets isearch-case-fold-search)
	      isearch-cmds)))


;; Commands active while inside of the isearch minor mode.

  (exit-minibuffer))

(defun isearch-cancel ()
  "Terminate the search and go back to the starting point."
  (interactive)
  (goto-char isearch-opoint)
  (isearch-done t)
  (isearch-clean-overlays)
  (signal 'quit nil))  ; and pass on quit signal

(defun isearch-abort ()
  "Abort incremental search mode if searching is successful, signaling quit.
Otherwise, revert to previous successful search and continue searching.
Use `isearch-exit' to quit without signaling."

;;  (ding)  signal instead below, if quitting
  (discard-input)
  (if isearch-success
      ;; If search is successful, move back to starting point
      ;; and really do quit.
      (progn (goto-char isearch-opoint)
	     (setq isearch-success nil)
	     (isearch-done t)   ; exit isearch
	     (isearch-clean-overlays)
	     (signal 'quit nil))  ; and pass on quit signal
    ;; If search is failing, or has an incomplete regexp,
    ;; rub out until it is once more successful.
    (while (or (not isearch-success) isearch-invalid-regexp)
      (isearch-pop-state))
    (isearch-update)))

			   isearch-string "")
		isearch-case-fold-search isearch-last-case-fold-search)
	;; If already have what to search for, repeat it.
	(or isearch-success
	    (progn
	      (goto-char (if isearch-forward (point-min) (point-max)))
	      (setq isearch-wrapped t))))
    ;; C-s in reverse or C-r in forward, change direction.
    (setq isearch-forward (not isearch-forward)))

  (setq isearch-barrier (point)) ; For subsequent \| if regexp.

  "Toggle regexp searching on or off."
  ;; The status stack is left unchanged.
  (interactive)
  (setq isearch-regexp (not isearch-regexp))
  (if isearch-regexp (setq isearch-word nil))
  (isearch-update))

(defun isearch-toggle-case-fold ()
  "Toggle case folding in searching on or off."
  (interactive)

  (let ((message-log-max nil))
    (message "%s%s [case %ssensitive]"
	     (isearch-message-prefix nil nil isearch-nonincremental)
	     isearch-message
	     (if isearch-case-fold-search "in" "")))
  (setq isearch-adjusted t)
  (sit-for 1)
  (isearch-update))

(defun isearch-query-replace ()
  "Start query-replace with string to replace from last search string."
  (interactive)
  (barf-if-buffer-read-only)
  (let ((case-fold-search isearch-case-fold-search))
    (isearch-done)
    (isearch-clean-overlays)
    (and isearch-forward isearch-other-end (goto-char isearch-other-end))
    (perform-replace
     isearch-string
     (query-replace-read-to isearch-string "Query replace" isearch-regexp)
     t isearch-regexp isearch-word)))

(defun isearch-query-replace-regexp ()
  "Start query-replace-regexp with string to replace from last search string."
  (interactive)
  (let ((query-replace-interactive t)
        (case-fold-search isearch-case-fold-search))
    ;; Put search string into the right ring
    (setq isearch-regexp t)
    (isearch-done)
    (isearch-clean-overlays)
    (and isearch-forward isearch-other-end (goto-char isearch-other-end))
    (call-interactively 'query-replace-regexp)))


(defun isearch-delete-char ()
  "Discard last input item and move point back.
If no previous match was done, just beep."

  (when (and isearch-regexp (eq (not (isearch-backslash isearch-string))
				(not want-backslash))
	     ;; We have to check 2 stack frames because the last might be
	     ;; invalid just because of a backslash.
	     (or (not isearch-invalid-regexp)
		 (not (isearch-invalid-regexp (cadr isearch-cmds)))
		 allow-invalid))
    (if to-barrier
	(progn (goto-char isearch-barrier)
	       (setq isearch-adjusted t))
      (let* ((stack isearch-cmds)

	;; removes all bracket-sets and groups that might be in the way, as
	;; well as partial \{\} constructs that the code below leaves behind.
	;; Also skip over postfix operators -- though horrid,
	;; 'ab?\{5,6\}+\{1,2\}*' is perfectly legal.
	(while (and previous
		    (or (isearch-invalid-regexp frame)
			(let* ((string (isearch-string frame))
			       (lchar (aref string (1- (length string)))))
			  ;; The operators aren't always operators; check
			  ;; backslashes.  This doesn't handle the case of
			  ;; operators at the beginning of the regexp not
			  ;; being special, but then we should fall back to
			  ;; the barrier anyway because it's all optional.
			  (if (isearch-backslash
			       (isearch-string (car previous)))
			      (eq lchar ?\})
			    (memq lchar '(?* ?? ?+))))))
	  (setq stack previous previous (cdr previous) frame (car stack)))
	(when stack
	  ;; `stack' now refers the most recent valid regexp that is not at
	  ;; all optional in its last term.  Now dig one level deeper and find
	  ;; what matched before that.
	  (let ((last-other-end (or (isearch-other-end (car previous))
				    isearch-barrier)))
	    (goto-char (if isearch-forward
			   (max last-other-end isearch-barrier)
			 (min last-other-end isearch-barrier)))
	    (setq isearch-adjusted t))))))

           (setq prefix-arg arg)
           (command-execute scroll-command)
           (let ((ab-bel (isearch-string-out-of-window isearch-point)))
             (if ab-bel
                 (isearch-back-into-window (eq ab-bel 'above) isearch-point)
               (or (eq (point) isearch-point)
                   (goto-char isearch-point))))
           (isearch-update))
	  (search-exit-option
	   (let (window)
             (isearch-unread-key-sequence keylist)
             (setq main-event (car unread-command-events))

			isearch-within-brackets nil))
	 (error nil)))
  ;; If currently failing, display no ellipsis.
  (or isearch-success (setq ellipsis nil))
  (let ((m (concat (if isearch-success "" "failing ")
		   (if (and isearch-wrapped
			    (if isearch-forward
				(> (point) isearch-opoint)
			      (< (point) isearch-opoint)))
		       "over")
		   (if isearch-wrapped "wrapped ")

     (setq isearch-invalid-regexp (format "%s" lossage))))

  (if isearch-success
      nil
    ;; Ding if failed this time after succeeding last time.
    (and (isearch-success (car isearch-cmds))
	 (ding))
    (goto-char (isearch-point (car isearch-cmds)))))


;; Called when opening an overlay, and we are still in isearch.
(defun isearch-open-overlay-temporary (ov)
  (if (not (null (overlay-get ov 'isearch-open-invisible-temporary)))

89969:3219f94257bc

;; Exiting immediately from isearch uses isearch-edit-string instead
;; of nonincremental-search, if search-nonincremental-instead is non-nil.
;; The name of this option should probably be changed if we decide to
;; keep the behavior.  No point in forcing nonincremental search until
;; the last possible moment.

;;; Code:


;; Some additional options and constants.

(defvar isearch-mode-hook nil
  "Function(s) to call after starting up an incremental search.")

(defvar isearch-mode-end-hook nil
  "Function(s) to call after terminating an incremental search.")

(defvar isearch-wrap-function nil
  "Function to call to wrap the search when search is failed.
If nil, move point to the beginning of the buffer for a forward search,
or to the end of the buffer for a backward search.")

(defvar isearch-push-state-function nil
  "Function to save a function restoring the mode-specific isearch state
to the search status stack.")

;; Search ring.

(defvar search-ring nil
  "List of search string sequences.")

;;   (handle-switch-frame (car (cdr last-command-char))))


;; The search status structure and stack.

(defsubst isearch-string-state (frame)
  "Return the search string in FRAME."
  (aref frame 0))
(defsubst isearch-message-state (frame)
  "Return the search string to display to the user in FRAME."
  (aref frame 1))
(defsubst isearch-point-state (frame)
  "Return the point in FRAME."
  (aref frame 2))
(defsubst isearch-success-state (frame)
  "Return the success flag in FRAME."
  (aref frame 3))
(defsubst isearch-forward-state (frame)
  "Return the searching-forward flag in FRAME."
  (aref frame 4))
(defsubst isearch-other-end-state (frame)
  "Return the other end of the match in FRAME."
  (aref frame 5))
(defsubst isearch-word-state (frame)
  "Return the search-by-word flag in FRAME."
  (aref frame 6))
(defsubst isearch-invalid-regexp-state (frame)
  "Return the regexp error message in FRAME, or nil if its regexp is valid."
  (aref frame 7))
(defsubst isearch-wrapped-state (frame)
  "Return the search-wrapped flag in FRAME."
  (aref frame 8))
(defsubst isearch-barrier-state (frame)
  "Return the barrier value in FRAME."
  (aref frame 9))
(defsubst isearch-within-brackets-state (frame)
  "Return the in-character-class flag in FRAME."
  (aref frame 10))
(defsubst isearch-case-fold-search-state (frame)
  "Return the case-folding flag in FRAME."
  (aref frame 11))
(defsubst isearch-pop-fun-state (frame)
  "Return the function restoring the mode-specific isearch state in FRAME."
  (aref frame 12))

(defun isearch-top-state ()
  (let ((cmd (car isearch-cmds)))
    (setq isearch-string (isearch-string-state cmd)
	  isearch-message (isearch-message-state cmd)
	  isearch-success (isearch-success-state cmd)
	  isearch-forward (isearch-forward-state cmd)
	  isearch-other-end (isearch-other-end-state cmd)
	  isearch-word (isearch-word-state cmd)
	  isearch-invalid-regexp (isearch-invalid-regexp-state cmd)
	  isearch-wrapped (isearch-wrapped-state cmd)
	  isearch-barrier (isearch-barrier-state cmd)
	  isearch-within-brackets (isearch-within-brackets-state cmd)
	  isearch-case-fold-search (isearch-case-fold-search-state cmd))
    (if (functionp (isearch-pop-fun-state cmd))
	(funcall (isearch-pop-fun-state cmd) cmd))
    (goto-char (isearch-point-state cmd))))

(defun isearch-pop-state ()
  (setq isearch-cmds (cdr isearch-cmds))
  (isearch-top-state))

  (setq isearch-cmds
	(cons (vector isearch-string isearch-message (point)
		      isearch-success isearch-forward isearch-other-end
		      isearch-word
		      isearch-invalid-regexp isearch-wrapped isearch-barrier
		      isearch-within-brackets isearch-case-fold-search
		      (if isearch-push-state-function
			  (funcall isearch-push-state-function)))
	      isearch-cmds)))


;; Commands active while inside of the isearch minor mode.

  (exit-minibuffer))

(defun isearch-cancel ()
  "Terminate the search and go back to the starting point."
  (interactive)
  (if (functionp (isearch-pop-fun-state (car (last isearch-cmds))))
      (funcall (isearch-pop-fun-state (car (last isearch-cmds)))
               (car (last isearch-cmds))))
  (goto-char isearch-opoint)
  (isearch-done t)                      ; exit isearch
  (isearch-clean-overlays)
  (signal 'quit nil))                   ; and pass on quit signal

(defun isearch-abort ()
  "Abort incremental search mode if searching is successful, signaling quit.
Otherwise, revert to previous successful search and continue searching.
Use `isearch-exit' to quit without signaling."

;;  (ding)  signal instead below, if quitting
  (discard-input)
  (if isearch-success
      ;; If search is successful, move back to starting point
      ;; and really do quit.
      (progn
        (setq isearch-success nil)
        (isearch-cancel))
    ;; If search is failing, or has an incomplete regexp,
    ;; rub out until it is once more successful.
    (while (or (not isearch-success) isearch-invalid-regexp)
      (isearch-pop-state))
    (isearch-update)))

			   isearch-string "")
		isearch-case-fold-search isearch-last-case-fold-search)
	;; If already have what to search for, repeat it.
	(or isearch-success
	    (progn
	      (if isearch-wrap-function
		  (funcall isearch-wrap-function)
	        (goto-char (if isearch-forward (point-min) (point-max))))
	      (setq isearch-wrapped t))))
    ;; C-s in reverse or C-r in forward, change direction.
    (setq isearch-forward (not isearch-forward)))

  (setq isearch-barrier (point)) ; For subsequent \| if regexp.

  "Toggle regexp searching on or off."
  ;; The status stack is left unchanged.
  (interactive)
  (setq isearch-regexp (not isearch-regexp))
  (if isearch-regexp (setq isearch-word nil))
  (setq isearch-success t isearch-adjusted t)
  (isearch-update))

(defun isearch-toggle-case-fold ()
  "Toggle case folding in searching on or off."
  (interactive)

  (let ((message-log-max nil))
    (message "%s%s [case %ssensitive]"
	     (isearch-message-prefix nil nil isearch-nonincremental)
	     isearch-message
	     (if isearch-case-fold-search "in" "")))
  (setq isearch-success t isearch-adjusted t)
  (sit-for 1)
  (isearch-update))

(defun isearch-query-replace (&optional regexp-flag)
  "Start query-replace with string to replace from last search string."
  (interactive)
  (barf-if-buffer-read-only)
  (if regexp-flag (setq isearch-regexp t))
  (let ((case-fold-search isearch-case-fold-search))
    (isearch-done)
    (isearch-clean-overlays)
    (if (and (< isearch-other-end (point))
             (not (and transient-mark-mode mark-active
                       (< isearch-opoint (point)))))
        (goto-char isearch-other-end))
    (set query-replace-from-history-variable
         (cons isearch-string
               (symbol-value query-replace-from-history-variable)))
    (perform-replace
     isearch-string
     (query-replace-read-to
      isearch-string
      (if isearch-regexp "Query replace regexp" "Query replace")
      isearch-regexp)
     t isearch-regexp isearch-word nil nil
     (if (and transient-mark-mode mark-active) (region-beginning))
     (if (and transient-mark-mode mark-active) (region-end)))))

(defun isearch-query-replace-regexp ()
  "Start query-replace-regexp with string to replace from last search string."
  (interactive)
  (isearch-query-replace t))


(defun isearch-delete-char ()
  "Discard last input item and move point back.
If no previous match was done, just beep."

  (when (and isearch-regexp (eq (not (isearch-backslash isearch-string))
				(not want-backslash))
	     ;; We have to check 2 stack frames because the last might be
	     ;; invalid just because of a backslash.
	     (or (not isearch-invalid-regexp)
		 (not (isearch-invalid-regexp-state (cadr isearch-cmds)))
		 allow-invalid))
    (if to-barrier
	(progn (goto-char isearch-barrier)
	       (setq isearch-adjusted t))
      (let* ((stack isearch-cmds)

	;; removes all bracket-sets and groups that might be in the way, as
	;; well as partial \{\} constructs that the code below leaves behind.
	;; Also skip over postfix operators -- though horrid,
	;; 'ab?\{5,6\}+\{1,2\}*' is perfectly legal.
	(while (and previous
		    (or (isearch-invalid-regexp-state frame)
			(let* ((string (isearch-string-state frame))
			       (lchar (aref string (1- (length string)))))
			  ;; The operators aren't always operators; check
			  ;; backslashes.  This doesn't handle the case of
			  ;; operators at the beginning of the regexp not
			  ;; being special, but then we should fall back to
			  ;; the barrier anyway because it's all optional.
			  (if (isearch-backslash
			       (isearch-string-state (car previous)))
			      (eq lchar ?\})
			    (memq lchar '(?* ?? ?+))))))
	  (setq stack previous previous (cdr previous) frame (car stack)))
	(when stack
	  ;; `stack' now refers the most recent valid regexp that is not at
	  ;; all optional in its last term.  Now dig one level deeper and find
	  ;; what matched before that.
	  (let ((last-other-end (or (isearch-other-end-state (car previous))
				    isearch-barrier)))
	    (goto-char (if isearch-forward
			   (max last-other-end isearch-barrier)
			 (min last-other-end isearch-barrier)))
	    (setq isearch-adjusted t))))))

           (setq prefix-arg arg)
           (command-execute scroll-command)
           (let ((ab-bel (isearch-string-out-of-window isearch-point)))
             (if ab-bel
                 (isearch-back-into-window (eq ab-bel 'above) isearch-point)
               (goto-char isearch-point)))
           (isearch-update))
	  (search-exit-option
	   (let (window)
             (isearch-unread-key-sequence keylist)
             (setq main-event (car unread-command-events))

			isearch-within-brackets nil))
	 (error nil)))
  ;; If currently failing, display no ellipsis.
  (or isearch-success (setq ellipsis nil))
  (let ((m (concat (if isearch-success "" "failing ")
		   (if isearch-adjusted "pending " "")
		   (if (and isearch-wrapped
			    (not isearch-wrap-function)
			    (if isearch-forward
				(> (point) isearch-opoint)
			      (< (point) isearch-opoint)))
		       "over")
		   (if isearch-wrapped "wrapped ")

     (setq isearch-invalid-regexp (format "%s" lossage))))

  (if isearch-success
      nil
    ;; Ding if failed this time after succeeding last time.
    (and (isearch-success-state (car isearch-cmds))
	 (ding))
    (if (functionp (isearch-pop-fun-state (car isearch-cmds)))
        (funcall (isearch-pop-fun-state (car isearch-cmds)) (car isearch-cmds)))
    (goto-char (isearch-point-state (car isearch-cmds)))))


;; Called when opening an overlay, and we are still in isearch.
(defun isearch-open-overlay-temporary (ov)
  (if (not (null (overlay-get ov 'isearch-open-invisible-temporary)))