![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to isearch.el CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSD / contrib / emacs / lisp|
Return to isearch.el CVS log | Up to [CSRG BSD Unix] / 43BSD / contrib / emacs / lisp |
1.1 root 1: ;; Incremental search
2: ;; Copyright (C) 1985 Richard M. Stallman.
3:
4: ;; This file is part of GNU Emacs.
5:
6: ;; GNU Emacs is distributed in the hope that it will be useful,
7: ;; but WITHOUT ANY WARRANTY. No author or distributor
8: ;; accepts responsibility to anyone for the consequences of using it
9: ;; or for whether it serves any particular purpose or works at all,
10: ;; unless he says so in writing. Refer to the GNU Emacs General Public
11: ;; License for full details.
12:
13: ;; Everyone is granted permission to copy, modify and redistribute
14: ;; GNU Emacs, but only under the conditions described in the
15: ;; GNU Emacs General Public License. A copy of this license is
16: ;; supposed to have been given to you along with GNU Emacs so you
17: ;; can know your rights and responsibilities. It should be in a
18: ;; file named COPYING. Among other things, the copyright notice
19: ;; and this notice must be preserved on all copies.
20:
21: ; in loaddefs.el
22: ;(defvar search-last-string ""
23: ; "Last string search for by a search command.
24: ;This does not include direct calls to the primitive search functions,
25: ;and does not include searches that are aborted.")
26: ;
27: ;(defconst search-repeat-char ?\C-s
28: ; "Character to repeat incremental search forwards.")
29: ;(defconst search-reverse-char ?\C-r
30: ; "Character to repeat incremental search backwards.")
31: ;(defconst search-exit-char ?\e
32: ; "Character to exit incremental search.")
33: ;(defconst search-delete-char ?\177
34: ; "Character to delete from incremental search string.")
35: ;(defconst search-quote-char ?\C-q
36: ; "Character to quote special characters for incremental search.")
37: ;(defconst search-yank-word-char ?\C-w
38: ; "Character to pull next word from buffer into search string.")
39: ;(defconst search-yank-line-char ?\C-y
40: ; "Character to pull rest of line from buffer into search string.")
41: ;(defconst search-exit-option t
42: ; "Non-nil means random control characters terminate incremental search.")
43: ;
44: ;(defvar isearch-slow-window-lines 1
45: ; "*Number of lines in slow search display windows.")
46: ;(defconst isearch-slow-speed 1200
47: ; "*Highest terminal speed at which to use \"slow\" style incremental search.
48: ;This is the style where a one-line window is created to show the line
49: ;that the search has reached.")
50:
51: ;; This function does all the work of incremental search.
52: ;; The functions attached to ^R and ^S are trivial,
53: ;; merely calling this one, but they are always loaded by default
54: ;; whereas this file can optionally be autoloadable.
55: ;; This is the only entry point in this file.
56:
57: (defun isearch (forward &optional regexp)
58: (let ((search-string "")
59: (search-message "")
60: (cmds nil)
61: (success t)
62: (invalid-regexp nil)
63: (slow-terminal-mode (<= (baud-rate) isearch-slow-speed))
64: (other-end nil) ;Start of last match if fwd, end if backwd.
65: (small-window nil) ;if t, using a small window
66: (window-min-height (min window-min-height (1+ isearch-slow-window-lines)))
67: ;so we can make small windows
68: (found-point nil) ;to restore point from a small window
69: ;; This is the window-start value found by the search.
70: (found-start nil)
71: (opoint (point))
72: (inhibit-quit t)) ;Prevent ^G from quitting immediately.
73: (isearch-push-state)
74: (save-window-excursion
75: (catch 'search-done
76: (while t
77: (or (>= unread-command-char 0)
78: (progn
79: (or (input-pending-p)
80: (isearch-message))
81: (if (and slow-terminal-mode
82: (not (or small-window (pos-visible-in-window-p))))
83: (progn
84: (setq small-window t)
85: (setq found-point (point))
86: (move-to-window-line 0)
87: (split-window nil (- (window-height)
88: (1+ isearch-slow-window-lines)))
89: (other-window 1)
90: (goto-char found-point)))))
91: (let ((char (if quit-flag
92: ?\C-g
93: (read-char))))
94: (setq quit-flag nil
95: invalid-regexp nil)
96: ;; Meta character means exit search.
97: (cond ((and (>= char 128)
98: search-exit-option)
99: (setq unread-command-char char)
100: (throw 'search-done t))
101: ((eq char search-exit-char)
102: ;; Esc means exit search normally.
103: ;; Except, if first thing typed, it means do nonincremental
104: (if (= 0 (length search-string))
105: (nonincremental-search forward regexp))
106: (throw 'search-done t))
107: ((= char ?\C-g)
108: ;; ^G means the user tried to quit.
109: (ding)
110: (discard-input)
111: (if success
112: ;; If search is successful, move back to starting point
113: ;; and really do quit.
114: (progn (goto-char opoint)
115: (signal 'quit nil))
116: ;; If search is failing, rub out until it is once more
117: ;; successful.
118: (while (not success) (isearch-pop))))
119: ((eq char search-repeat-char)
120: ;; ^S means search again, forward, for the same string.
121: (setq forward t)
122: (if (null (cdr cmds))
123: ;; If the first char typed,
124: ;; it means search for the string of the previous search
125: (progn
126: (setq search-string search-last-string
127: search-message
128: (mapconcat 'text-char-description
129: search-string ""))))
130: (isearch-search)
131: (isearch-push-state))
132: ((eq char search-reverse-char)
133: ;; ^R is similar but it searches backward.
134: (setq forward nil)
135: (if (null (cdr cmds))
136: (progn
137: (setq search-string search-last-string
138: search-message
139: (mapconcat 'text-char-description
140: search-string ""))))
141: (isearch-search)
142: (isearch-push-state))
143: ((= char search-delete-char)
144: ;; Rubout means discard last input item and move point
145: ;; back. If buffer is empty, just beep.
146: (if (null (cdr cmds))
147: (ding)
148: (isearch-pop)))
149: (t
150: (cond ((or (eq char search-yank-word-char)
151: (eq char search-yank-line-char))
152: ;; ^W means gobble next word from buffer.
153: ;; ^Y means gobble rest of line from buffer.
154: (let ((word (save-excursion
155: (and (not forward) other-end
156: (goto-char other-end))
157: (buffer-substring
158: (point)
159: (save-excursion
160: (if (eq char search-yank-line-char)
161: (end-of-line)
162: (forward-word 1))
163: (point))))))
164: (setq search-string (concat search-string word)
165: search-message
166: (concat search-message
167: (mapconcat 'text-char-description
168: word "")))))
169: ;; Any other control char =>
170: ;; unread it and exit the search normally.
171: ((and search-exit-option
172: (/= char search-quote-char)
173: (< char ? ) (/= char ?\t) (/= char ?\r))
174: (setq unread-command-char char)
175: (throw 'search-done t))
176: (t
177: ;; Any other character => add it to the
178: ;; search string and search.
179: (cond ((= char search-quote-char)
180: (setq char (read-quoted-char
181: (isearch-message t))))
182: ((= char ?\r)
183: ;; unix braindeath
184: (setq char ?\n)))
185: (setq search-string (concat search-string
186: (char-to-string char))
187: search-message (concat search-message
188: (text-char-description char)))))
189: (if (and (not success)
190: ;; unsuccessful regexp search may become
191: ;; successful by addition of characters which
192: ;; make search-string valid
193: (not regexp))
194: nil
195: (if other-end
196: (goto-char (if forward other-end
197: (min opoint (1+ other-end)))))
198: (isearch-search))
199: (isearch-push-state))))))
200: (setq found-start (window-start (selected-window)))
201: (setq found-point (point)))
202: (setq search-last-string search-string)
203: ;; If there was movement, mark the starting position.
204: ;; Maybe should test difference between and set mark iff > threshold.
205: (if (/= (point) opoint) (push-mark opoint))
206: (if small-window
207: (goto-char found-point)
208: ;; Exiting the save-window-excursion clobbers this; restore it.
209: (set-window-start (selected-window) found-start t))
210: (message "")))
211:
212: (defun isearch-message (&optional c-q-hack ing)
213: (or success (setq ing nil))
214: (let ((m (concat (if success "" "Failing ")
215: (if regexp (if success "Regexp " "regexp ") "")
216: "I-search"
217: (if forward ": " " backward: ")
218: search-message
219: (if c-q-hack "^Q" "")
220: (if invalid-regexp
221: (concat " [" invalid-regexp "]")
222: (if (and ing (not slow-terminal-mode)) " ..." "")))))
223: (if c-q-hack m (message "%s" m))))
224:
225: (defun isearch-pop ()
226: (setq cmds (cdr cmds))
227: (let ((cmd (car cmds)))
228: (setq search-string (car cmd)
229: search-message (car (cdr cmd))
230: success (car (cdr (cdr (cdr cmd))))
231: forward (car (cdr (cdr (cdr (cdr cmd)))))
232: other-end (car (cdr (cdr (cdr (cdr (cdr cmd))))))
233: invalid-regexp (car (cdr (cdr (cdr (cdr (cdr (cdr cmd))))))))
234: (goto-char (car (cdr (cdr cmd))))))
235:
236: (defun isearch-push-state ()
237: (setq cmds (cons (list search-string search-message (point)
238: success forward other-end invalid-regexp)
239: cmds)))
240:
241: (defun isearch-search ()
242: (isearch-message nil t)
243: (if (setq success
244: (condition-case lossage
245: (let ((inhibit-quit nil))
246: (if regexp (setq invalid-regexp nil))
247: (funcall
248: (if regexp
249: (if forward 're-search-forward 're-search-backward)
250: (if forward 'search-forward 'search-backward))
251: search-string nil t))
252: (quit (setq unread-command-char ?\C-g)
253: nil)
254: (invalid-regexp (setq invalid-regexp (car (cdr lossage)))
255: nil)))
256: (setq other-end
257: (if forward (match-beginning 0) (match-end 0)))
258: (or invalid-regexp
259: (not (car (cdr (cdr (cdr (car cmds)))))) ;unsuccusful last time
260: (ding))
261: (goto-char (car (cdr (cdr (car cmds)))))))
262:
263: ;; This is called from incremental-search
264: ;; if the first input character is the exit character.
265: ;; We store the search string in search-string
266: ;; which has been bound already by incremental-search
267: ;; so that, when we exit, it is copied into search-last-string.
268: (defun nonincremental-search (forward regexp)
269: (let (message char (inhibit-quit nil))
270: ;; Prompt assuming not word search,
271: (setq message (if regexp
272: (if forward "Regexp search: "
273: "Regexp search backward: ")
274: (if forward "Search: " "Search backward: ")))
275: (message "%s" message)
276: ;; Read 1 char and switch to word search if it is ^W.
277: (setq char (read-char))
278: (if (eq char search-yank-word-char)
279: (setq message (if forward "Word search: " "Word search backward: "))
280: ;; Otherwise let that 1 char be part of the search string.
281: (setq unread-command-char char))
282: ;; Read the search string with corrected prompt.
283: (setq search-string (read-string message))
284: ;; Empty means use default.
285: (if (= 0 (length search-string))
286: (setq search-string search-last-string)
287: ;; Set last search string now so it is set even if we fail.
288: (setq search-last-string search-string))
289: ;; Go ahead and search.
290: (funcall (if (eq char search-yank-word-char)
291: (if forward 'word-search-forward 'word-search-backward)
292: (if regexp
293: (if forward 're-search-forward 're-search-backward)
294: (if forward 'search-forward 'search-backward)))
295: search-string)))
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.