NetNews Usenet Archive 1992 #27/NN_1992_27.iso/spool/gnu/epoch/misc/1136

Text File | 1992-11-19 | 26.2 KB | 836 lines

Newsgroups: gnu.epoch.misc
Path: sparky!uunet!zaphod.mps.ohio-state.edu!news.acns.nwu.edu!gauss!richter
From: [e-mail] (Bill Richter)
Subject: Re:isearch & mouse
Message-ID: <[e-mail]>
Sender: [e-mail] (Usenet on news.acns)
Fcc: stuff
Organization: Northwestern University, Evanston, Illinois, USA
Date: Thu, 19 Nov 1992 16:07:16 GMT
Lines: 824

Here's a fix for the isearch bug; now a mouse action will exit an
isearch.  The fix is quite simple and consists of
1) changing the position of the line (abort-isearch) in the motion.el
routines
2) removing the save-window-excursion loop from isearch.el.  I'm
including the mouse part of my .emacs file (which fixes the isearch
bug), followed by my doctored version of isearch.el.

If you use my version of isearch.el, make sure it is at the top of
your load-path variable (check with C-h v load-path).  I do this by
putting the new isearch.el in my directory epoch-4.2/epoch-lisp and
byte-compile-ing it to make a new isearch.elc.

I also recommend my other included mouse mods, which include
Textedit-like secondary selections (cut/copy/paste a grey region away
from the mouse) and emacstool-like modeline mouse scrolling.  To me
the advantage of epoch is the extra (programmable) mouse capability.


Bill Richter



;;; MOUSE CUSTOMIZATIONS.
;;;
;;;      Everything here works with a split window, but not
;;; with separate screens. I use an emacs window that fills up
;;; the whole screen anyway.  We exit gracefully
;;; from isearches by: putting the line (abort-isearch) at the end of
;;; our mouse routines; and recompiling search by removing the one
;;; instance of save-window-excursion in isearch.el.

;;; Primary selections hacked from motion.el to resemble Paul
;;; Burchard's mods of x-mouse.el
;;;
;;; left mouse       = insert cursor and begin hiliting (underlining).
;;; middle mouse     = end hiliting & set-mark & copy hilited
;;;              region to kill ring and x cut-buffer.
;;;                 with double click fills-region-as-paragraph.
;;; right mouse      = paste x cut-buffer at mouse.
;;; cut (L10) button    = cut hilited region.
;;; shift middle mouse     = cut region between point and mouse.
;;;
;;; more precisely, sh-mid-mouse-down hilites and sh-mid-mouse-up cuts.
;;; cut does not take place if you pick up the shift key before
;;; picking up middle-mouse.


;;; Textedit-like secondary selections:
;;;
;;; left meta mouse           = begin secondary hiliting (grey stipple).
;;; middle meta mouse-down     = hilite and copy to x cut-buffer.
;;; middle meta mouse-up     = paste here and un-hilite.
;;;                    (pick up shift to cancel.)
;;; shift middle meta mouse-down= hilite and copy to x cut-buffer.
;;; shift middle meta mouse-up    = paste here and cut there.
;;;                    (pick up shift-meta to cancel.)
;;; right meta mouse          = paste there.
;;; shift middle meta mouse     = cut there.


;;; Emacstool-like modeline mouse scrolling:
;;;
;;;  (left middle right)-modeline mouse = (page-down recenter page-up)
;;;  shift-(left middle right)-modeline = (beg-file top-recenter end-file)
;;;  dbl clicks-(left right)-mod. mouse = (beg-file end-file)

(load "isearch")

;;; first the modeline mouse scrolling:

(defun mouse-scroll-up (arg)
  (setq curwin (selected-window))
  (select-window (nth 2 arg))
  (if (> mouse::clicks 1) ; multi-click
    (end-of-buffer)
    (scroll-up)
  )
  (select-window curwin)
)

(defun mouse-scroll-down (arg)
  (setq curwin (selected-window))
  (select-window (nth 2 arg))
  (if (> mouse::clicks 1) ; multi-click
    (beginning-of-buffer)
    (scroll-down)
  )
  (select-window curwin)
)


(defun mouse-recenter (arg)
  (setq curwin (selected-window))
  (select-window (nth 2 arg))
  (if (= mouse::clicks 2) ; multi-click
    (top-recenter)
    (recenter)
  )
  (if (> mouse::clicks 2) ; multi-click
    (bottom-recenter)
  )
  (select-window curwin)
)

(defun mouse-ebuff-list (arg)
   (electric-buffer-list () ) )

(defun mouse-beg-of-buffer (arg)
  (setq curwin (selected-window))
  (select-window (nth 2 arg))
  (beginning-of-buffer)
  (select-window curwin)
)

(defun mouse-end-of-buffer (arg)
  (setq curwin (selected-window))
  (select-window (nth 2 arg))
  (end-of-buffer)
  (select-window curwin)
)

(defun mouse-top-recenter (arg)
  (setq curwin (selected-window))
  (select-window (nth 2 arg))
  (top-recenter)
  (select-window curwin)
)

(defun top-recenter ()
  (interactive)
  (recenter 0))

(defun bottom-recenter ()
  (interactive)
  (recenter -1))

(global-set-mouse mouse-mode-left mouse-shift 'mouse-end-of-buffer)
(global-set-mouse mouse-mode-left mouse-down 'mouse-scroll-up)

(global-set-mouse mouse-mode-right mouse-down 'mouse-scroll-down)
(global-set-mouse mouse-mode-right mouse-shift 'mouse-beg-of-buffer)

(global-set-mouse mouse-mode-middle mouse-down 'mouse-recenter)

(global-set-mouse mouse-mode-middle mouse-meta 'mouse-ebuff-list)
(global-set-mouse mouse-mode-middle mouse-shift 'mouse-top-recenter)


;;;
;;; Now the Primary selection mouse customizations.
;;;


(defun start-mouse-drag (arg)
; (when arg
    (setq mouse::downp 'start)
    (mouse::set-point arg)
    (set-mouse-marker)
    (setq mouse::last-point (point))
    (if drag-zone
      (progn
    (delete-zone drag-zone)
    (setq drag-zone nil)
    (redisplay-screen)
      )
    )
    (abort-isearch)
; )
)


(defun end-mouse-region (arg)
   "ends the highlited drag-zone, the region between mouse cursor
mouse-left-marker.  With a double click, fills-region-as-paragraph "
  (if drag-zone
     (move-zone drag-zone mouse-down-marker (car arg)
     )
     (setq drag-zone
    (add-zone mouse-down-marker (car arg) motion::style)
     )
  )
; (set-zone-transient drag-zone t)
  (epoch::redisplay-screen)
  (mouse::copy-zone drag-zone)
  (push-mark (car arg) t)
  (if (> mouse::clicks 1) ; multi-click
    (fill-region-as-paragraph (point) (zone-end drag-zone))
  )
)



(defun mouse-cut-and-wipe-text (arg)
  "Kill text between point and mouse, like x-cut-and-wipe-text"
  (mouse::copy-zone drag-zone t)
  (undo-boundary)
  (abort-isearch)
)

(defun mouse-show-x-text (arg)
  "Underlines text between point and mouse; like x-cut-and-wipe-text"
  (if drag-zone
     (move-zone drag-zone (point) (car arg) (nth 1 arg)
     )
     (setq drag-zone
    (add-zone (point) (car arg) motion::style)
     )
  )
  (set-zone-transient drag-zone t)
  (epoch::redisplay-screen)
)

(defun bill-mouse::paste-cut-buffer (arg)
   (progn
    (mouse::paste-cut-buffer arg)
       (undo-boundary)
       (mouse::set-point arg)
        (abort-isearch)
   )
)

(defun kill-underlined-region ()
"kills (and X-cuts) the underlined region of text; point is not
moved."
    (interactive)
    (mouse::copy-zone drag-zone t)
    (undo-boundary)
)

(global-set-mouse mouse-left mouse-down 'start-mouse-drag)
(global-set-mouse mouse-left mouse-shift 'start-mouse-drag)
(global-set-mouse mouse-left mouse-up 'end-mouse-drag)

;(global-set-mouse mouse-middle mouse-down 'extend-mouse-drag)
;(global-set-mouse mouse-middle mouse-up 'end-mouse-drag)

(global-set-mouse mouse-middle mouse-shift 'mouse-show-x-text)
(global-set-mouse mouse-middle mouse-shift-up 'mouse-cut-and-wipe-text)

(global-set-mouse mouse-right mouse-down 'bill-mouse::paste-cut-buffer)
(global-set-mouse mouse-right mouse-shift 'bill-mouse::paste-cut-buffer)

;(global-set-mouse mouse-left mouse-down 'start-mouse-region)
;(global-set-mouse mouse-left mouse-shift 'start-mouse-region)

(global-set-mouse mouse-middle mouse-down 'end-mouse-region)


;rebinds L10 on sparc keyboard as explained in Epoch-FAQ
(rebind-key "L10" 0 "\C-^Xcut")
(define-key global-map "\C-^Xcut" 'kill-underlined-region)    ;L10=CUT


;;;
;;; We define secondary selections for mouse actions, hacked from
;;; motion.el
;;;

;; makes secondary selection appear as gray stipple pattern.
(defvar sec:motion::style nil "style used by secondary drag zone")
(setq-default sec:motion::style (make-style))

;; this pattern is from the EPOCH-FAQ
(set-style-background sec:motion::style (foreground))
(set-style-background-stipple sec:motion::style
      (make-bitmap 4 4 "\167\273\335\356"))


(defvar sec:drag-zone nil
  "Epoch zone to be used for hilighting the secondary selection."
)
(setq-default sec:drag-zone nil)

;; sec:mouse-down-marker is the marker which marks the left boundary of
;; our secondary selection, made by clicking the left-meta mouse
  (setq-default sec:mouse-down-marker (make-marker))

(defun sec:start-mouse-region (arg)
;;; arg is a list of ( POINT BUFFER WINDOW SCREEN )
  "starts the epoch region sec:drag-zone, which is one character in
width, starting at location arg_0, in the buffer of arg_1"
    (set-marker sec:mouse-down-marker (car arg) (nth 1 arg))
    (if sec:drag-zone
      (progn
    (delete-zone sec:drag-zone)
    (setq sec:drag-zone nil)
    (redisplay-screen)
      )
    )
    (setq sec:drag-zone
        (add-zone (car arg) (+ 1 (car arg)) sec:motion::style
            (nth 2 arg) (nth 1 arg)
          )
    )
)

(defun sec:end-mouse-region (arg)
   "ends the epoch zone sec:drag-zone, which will be hilited in a grey
stipple pattern."
  (if sec:drag-zone
     (move-zone sec:drag-zone sec:mouse-down-marker (car arg) (nth 1 arg)
     )
     (setq sec:drag-zone
    (add-zone sec:mouse-down-marker (car arg) sec:motion::style
            (nth 2 arg) (nth 1 arg)
    )
     )
  )
  (set-zone-transient sec:drag-zone t)
  (epoch::redisplay-screen)
  (mouse::sec:copy-zone sec:drag-zone)
  (undo-boundary)
)


(defun sec:mouse-paste-here (arg)
   (yank)
   (delete-zone sec:drag-zone)
   (setq sec:drag-zone nil)
   (undo-boundary)
)

(defun sec:hilite-region (arg)
 "kills (and X-cuts) the highlit region of text; point is not moved."
    (mouse::copy-zone sec:drag-zone t)
    (undo-boundary)
)


(defun sec:mouse-paste-here-kill-there (arg)
   (yank)
   (mouse::copy-zone sec:drag-zone t)
   (delete-zone sec:drag-zone)
   (setq sec:drag-zone nil)
   (undo-boundary)
)

(defun sec:kill-there (arg)
   (mouse::copy-zone sec:drag-zone t)
   (delete-zone sec:drag-zone)
   (setq sec:drag-zone nil)
   (undo-boundary)
)



(defun paste-there (arg)
   (progn
    (mouse::paste-cut-buffer arg)
       (undo-boundary)
   )
)

(defun mouse::sec:copy-zone (zone)
  "A modification of mouse::copy-zone---``Copy the text in the ZONE to
the appropriate selection atom and to X cut-buffer'':
*** we don't test that (point-max) > (epoch::zone-start&end zone).  This
allows us to copy from the Rmail buffer, in which narrowing occurs;
*** for safety we do not allow optional kills.
*** We make sure to restore the old buffer when we're done."
  (if (zonep zone)
    (let
      (
        (beg (epoch::zone-start zone) )
    (end (epoch::zone-end zone) )
    (buf (epoch::zone-buffer zone))
    text
      )
      (if (null beg) (setq beg 1))
      (if (null end) (setq end 1))
      (if (bufferp buf)
    (save-excursion
      (set-buffer buf)
      (setq text (buffer-substring beg end))
    )
    (setq text "")
      )
      (epoch::store-cut-buffer text)
      ; assert ownership of PRIMARY selection
      (epoch::acquire-selection mouse::selection-atom)
      ; store data so we people can paste from Epoch to other clients.
      (setq epoch::selection-alist
    (alist-delete mouse::selection-atom epoch::selection-alist))
      (setq epoch::selection-alist
    (cons
      (cons
        mouse::selection-atom text
      )
      epoch::selection-alist
    )
      )
      (if (/= beg end)
    (if (bufferp buf)
      (save-excursion
        (set-buffer buf)
        (copy-region-as-kill beg end)
            ;; Eliminate replication on kill.
            (setq this-command nil)
      )
    )
      )
    )
    (setq epoch::selection-alist
          (cons
           (cons
            mouse::selection-atom ""
            )
           (alist-delete mouse::selection-atom epoch::selection-alist)
           ))
    )
)

(global-set-mouse mouse-left mouse-meta 'sec:start-mouse-region)
(global-set-mouse mouse-middle mouse-meta 'sec:end-mouse-region)
(global-set-mouse mouse-middle mouse-meta-up 'sec:mouse-paste-here)

(global-set-mouse mouse-left mouse-meta-shift 'sec:start-mouse-region)
(global-set-mouse mouse-middle mouse-meta-shift 'sec:end-mouse-region)
(global-set-mouse mouse-middle mouse-meta-shift-up
    'sec:mouse-paste-here-kill-there)

(global-set-mouse mouse-right mouse-meta-shift 'sec:end-mouse-region)
(global-set-mouse mouse-right mouse-meta-shift-up 'sec:kill-there)
(global-set-mouse mouse-right mouse-meta 'paste-there)


;;;;
;;;;
;;;; End of mouse customizations!
;;;;
;;;;


;; Incremental search
;; Copyright (C) 1985, 1986 Free Software Foundation, Inc.

;; This file is part of GNU Emacs.
;; isearch.el with 2 lines changed by Bill Richter; the
;; (save-window-excursion ... ) is commented out


;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 1, or (at your option)
;; any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.

; in loaddefs.el
;(defvar search-last-string ""
;  "Last string search for by a search command.
;This does not include direct calls to the primitive search functions,
;and does not include searches that are aborted.")
;(defvar search-last-regexp ""
;  "Last string searched for by a regexp search command.
;This does not include direct calls to the primitive search functions,
;and does not include searches that are aborted.")
;
;(defconst search-repeat-char ?\C-s
;  "Character to repeat incremental search forwards.")
;(defconst search-reverse-char ?\C-r
;  "Character to repeat incremental search backwards.")
;(defconst search-exit-char ?\e
;  "Character to exit incremental search.")
;(defconst search-delete-char ?\177
;  "Character to delete from incremental search string.")
;(defconst search-quote-char ?\C-q
;  "Character to quote special characters for incremental search.")
;(defconst search-yank-word-char ?\C-w
;  "Character to pull next word from buffer into search string.")
;(defconst search-yank-line-char ?\C-y
;  "Character to pull rest of line from buffer into search string.")
;(defconst search-exit-option t
;  "Non-nil means random control characters terminate incremental search.")
;
;(defvar search-slow-window-lines 1
;  "*Number of lines in slow search display windows.")
;(defconst search-slow-speed 1200
;  "*Highest terminal speed at which to use \"slow\" style incremental search.
;This is the style where a one-line window is created to show the line
;that the search has reached.")

;; This function does all the work of incremental search.
;; The functions attached to ^R and ^S are trivial,
;; merely calling this one, but they are always loaded by default
;; whereas this file can optionally be autoloadable.
;; This is the only entry point in this file.

(defun isearch (forward &optional regexp)
  (let ((search-string "")
    (search-message "")
    (cmds nil)
    (success t)
    (wrapped nil)
    (barrier (point))
    adjusted
    (invalid-regexp nil)
    (slow-terminal-mode (and (<= (baud-rate) search-slow-speed)
                 (> (window-height)
                    (* 4 search-slow-window-lines))))
    (other-end nil)    ;Start of last match if fwd, end if backwd.
    (small-window nil)        ;if t, using a small window
    (found-point nil)        ;to restore point from a small window
    ;; This is the window-start value found by the search.
    (found-start nil)
    (opoint (point))
    (inhibit-quit t))  ;Prevent ^G from quitting immediately.
    (isearch-push-state)
;   (save-window-excursion
     (catch 'search-done
       (while t
     (or (>= unread-command-char 0)
         (progn
           (or (input-pending-p)
           (isearch-message))
           (if (and slow-terminal-mode
            (not (or small-window (pos-visible-in-window-p))))
           (progn
             (setq small-window t)
             (setq found-point (point))
             (move-to-window-line 0)
             (let ((window-min-height 1))
               (split-window nil (if (< search-slow-window-lines 0)
                         (1+ (- search-slow-window-lines))
                       (- (window-height)
                          (1+ search-slow-window-lines)))))
             (if (< search-slow-window-lines 0)
             (progn (vertical-motion (- 1 search-slow-window-lines))
                (set-window-start (next-window) (point))
                (set-window-hscroll (next-window)
                            (window-hscroll))
                (set-window-hscroll (selected-window) 0))
               (other-window 1))
             (goto-char found-point)))))
     (let ((char (if quit-flag
             ?\C-g
               (read-char))))
       (setq quit-flag nil adjusted nil)
       ;; Meta character means exit search.
       (cond ((and (>= char 128)
               search-exit-option)
          (setq unread-command-char char)
          (throw 'search-done t))
         ((eq char search-exit-char)
          ;; Esc means exit search normally.
          ;; Except, if first thing typed, it means do nonincremental
          (if (= 0 (length search-string))
              (nonincremental-search forward regexp))
          (throw 'search-done t))
         ((= char ?\C-g)
          ;; ^G means the user tried to quit.
          (ding)
          (discard-input)
          (if success
              ;; If search is successful, move back to starting point
              ;; and really do quit.
              (progn (goto-char opoint)
                 (signal 'quit nil))
            ;; If search is failing, rub out until it is once more
            ;;  successful.
            (while (not success) (isearch-pop))))
         ((or (eq char search-repeat-char)
              (eq char search-reverse-char))
          (if (eq forward (eq char search-repeat-char))
              ;; C-s in forward or C-r in reverse.
              (if (equal search-string "")
              ;; If search string is empty, use last one.
              (setq search-string
                (if regexp
                    search-last-regexp search-last-string)
                search-message
                (mapconcat 'text-char-description
                       search-string ""))
            ;; If already have what to search for, repeat it.
            (or success
                (progn (goto-char (if forward (point-min) (point-max)))
                   (setq wrapped t))))
            ;; C-s in reverse or C-r in forward, change direction.
            (setq forward (not forward)))
          (setq barrier (point)) ; For subsequent \| if regexp.
          (setq success t)
          (or (equal search-string "")
              (isearch-search))
          (isearch-push-state))
         ((= char search-delete-char)
          ;; Rubout means discard last input item and move point
          ;; back.  If buffer is empty, just beep.
          (if (null (cdr cmds))
              (ding)
            (isearch-pop)))
         (t
          (cond ((or (eq char search-yank-word-char)
                 (eq char search-yank-line-char))
             ;; ^W means gobble next word from buffer.
             ;; ^Y means gobble rest of line from buffer.
             (let ((word (save-excursion
                       (and (not forward) other-end
                        (goto-char other-end))
                       (buffer-substring
                    (point)
                    (save-excursion
                      (if (eq char search-yank-line-char)
                          (end-of-line)
                        (forward-word 1))
                      (point))))))
               (if regexp
                   (setq word (regexp-quote word)))
               (setq search-string (concat search-string word)
                 search-message
                   (concat search-message
                       (mapconcat 'text-char-description
                              word "")))))
             ;; Any other control char =>
             ;;  unread it and exit the search normally.
             ((and search-exit-option
                   (/= char search-quote-char)
                   (or (= char ?\177)
                   (and (< char ? ) (/= char ?\t) (/= char ?\r))))
              (setq unread-command-char char)
              (throw 'search-done t))
             (t
              ;; Any other character => add it to the
              ;;  search string and search.
              (cond ((= char search-quote-char)
                 (setq char (read-quoted-char
                         (isearch-message t))))
                ((= char ?\r)
                 ;; unix braindeath
                 (setq char ?\n)))
              (setq search-string (concat search-string
                              (char-to-string char))
                search-message (concat search-message
                               (text-char-description char)))))
          (if (and (not success)
               ;; unsuccessful regexp search may become
               ;;  successful by addition of characters which
               ;;  make search-string valid
               (not regexp))
              nil
            ;; If a regexp search may have been made more
            ;; liberal, retreat the search start.
            ;; Go back to place last successful search started
            ;; or to the last ^S/^R (barrier), whichever is nearer.
            (and regexp success cmds
             (cond ((and (memq char '(?* ??))
                     ;; Don't treat *, ? as special
                     ;; within [] or after \.
                     (not (nth 6 (car cmds))))
                (setq adjusted t)
                ;; This used to use element 2
                ;; in a reverse search, but it seems that 5
                ;; (which is the end of the old match)
                ;; is better in that case too.
                (let ((cs (nth 5 ; old other-end.
                           (car (cdr cmds)))))
                  ;; (car cmds) is after last search;
                  ;; (car (cdr cmds)) is from before it.
                  (setq cs (or cs barrier))
                  (goto-char
                   (if forward
                       (max cs barrier)
                     (min cs barrier)))))
                   ((eq char ?\|)
                (setq adjusted t)
                (goto-char barrier))))
            ;; In reverse regexp search, adding a character at
            ;; the end may cause zero or many more chars to be
            ;; matched, in the string following point.
            ;; Allow all those possibiities without moving point as
            ;; long as the match does not extend past search origin.
            (if (and regexp (not forward) (not adjusted)
                 (condition-case ()
                 (looking-at search-string)
                   (error nil))
                 (<= (match-end 0) (min opoint barrier)))
            (setq success t invalid-regexp nil
                  other-end (match-end 0))
              ;; Not regexp, not reverse, or no match at point.
              (if (and other-end (not adjusted))
              (goto-char (if forward other-end
                       (min opoint barrier (1+ other-end)))))
              (isearch-search)))
          (isearch-push-state))))))
     (setq found-start (window-start (selected-window)))
     (setq found-point (point))
;                   )
    (if (> (length search-string) 0)
    (if regexp
        (setq search-last-regexp search-string)
        (setq search-last-string search-string)))
    ;; If we displayed a single-line window, set point in this window.
    (if small-window
    (goto-char found-point))
    ;; If there was movement, mark the starting position.
    ;; Maybe should test difference between and set mark iff > threshold.
    (if (/= (point) opoint)
    (push-mark opoint)
      (message ""))
    (or small-window
    ;; Exiting the save-window-excursion clobbers this; restore it.
    (set-window-start (selected-window) found-start t))))

(defun isearch-message (&optional c-q-hack ellipsis)
  ;; If about to search, and previous search regexp was invalid,
  ;; check that it still is.  If it is valid now,
  ;; let the message we display while searching say that it is valid.
  (and invalid-regexp ellipsis
       (condition-case ()
       (progn (re-search-forward search-string (point) t)
          (setq invalid-regexp nil))
     (error nil)))
  ;; If currently failing, display no ellipsis.
  (or success (setq ellipsis nil))
  (let ((m (concat (if success "" "failing ")
           (if wrapped "wrapped ")
           (if regexp "regexp " "")
           "I-search"
           (if forward ": " " backward: ")
           search-message
           (if c-q-hack "^Q" "")
           (if invalid-regexp
               (concat " [" invalid-regexp "]")
             ""))))
    (aset m 0 (upcase (aref m 0)))
    (let ((cursor-in-echo-area ellipsis))
      (if c-q-hack m (message "%s" m)))))

(defun isearch-pop ()
  (setq cmds (cdr cmds))
  (let ((cmd (car cmds)))
    (setq search-string (car cmd)
      search-message (car (cdr cmd))
      success (nth 3 cmd)
      forward (nth 4 cmd)
      other-end (nth 5 cmd)
      invalid-regexp (nth 6 cmd)
      wrapped (nth 7 cmd)
      barrier (nth 8 cmd))
    (goto-char (car (cdr (cdr cmd))))))

(defun isearch-push-state ()
  (setq cmds (cons (list search-string search-message (point)
             success forward other-end invalid-regexp
             wrapped barrier)
           cmds)))

(defun isearch-search ()
  (isearch-message nil t)
  (condition-case lossage
      (let ((inhibit-quit nil))
    (if regexp (setq invalid-regexp nil))
    (setq success
          (funcall
           (if regexp
           (if forward 're-search-forward 're-search-backward)
         (if forward 'search-forward 'search-backward))
           search-string nil t))
    (if success
        (setq other-end
          (if forward (match-beginning 0) (match-end 0)))))
    (quit (setq unread-command-char ?\C-g)
      (setq success nil))
    (invalid-regexp (setq invalid-regexp (car (cdr lossage)))
            (if (string-match "\\`Premature \\|\\`Unmatched \\|\\`Invalid "
                      invalid-regexp)
            (setq invalid-regexp "incomplete input"))))
  (if success
      nil
    ;; Ding if failed this time after succeeding last time.
    (and (nth 3 (car cmds))
     (ding))
    (goto-char (nth 2 (car cmds)))))

;; This is called from incremental-search
;; if the first input character is the exit character.
;; The interactive-arg-reader uses free variables `forward' and `regexp'
;; which are bound by `incremental-search'.

;; We store the search string in `search-string'
;; which has been bound already by `incremental-search'
;; so that, when we exit, it is copied into `search-last-string'.

(defun nonincremental-search (forward regexp)
  (let (message char function string inhibit-quit)
    (let ((cursor-in-echo-area t))
      ;; Prompt assuming not word search,
      (setq message (if regexp
            (if forward "Regexp search: "
              "Regexp search backward: ")
              (if forward "Search: " "Search backward: ")))
      (message "%s" message)
      ;; Read 1 char and switch to word search if it is ^W.
      (setq char (read-char)))
    (if (eq char search-yank-word-char)
    (setq message (if forward "Word search: " "Word search backward: "))
      ;; Otherwise let that 1 char be part of the search string.
      (setq unread-command-char char))
    (setq function
      (if (eq char search-yank-word-char)
          (if forward 'word-search-forward 'word-search-backward)
        (if regexp
        (if forward 're-search-forward 're-search-backward)
          (if forward 'search-forward 'search-backward))))
    ;; Read the search string with corrected prompt.
    (setq string (read-string message))
    (let ((var (if regexp 'search-last-regexp 'search-last-string)))
      ;; Empty means use default.
      (if (= 0 (length string))
      (setq string (symbol-value var))
    ;; Set last search string now so it is set even if we fail.
    (set var string)))
    ;; Since we used the minibuffer, we should be available for redo.
    (setq command-history (cons (list function string) command-history))
    ;; Go ahead and search.
    (funcall function string)))