![[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] / 43BSDReno / contrib / emacs-18.55 / lisp|
Return to isearch.el CVS log | Up to [CSRG BSD Unix] / 43BSDReno / contrib / emacs-18.55 / lisp |
1.1 root 1: ;; Incremental search
2: ;; Copyright (C) 1985, 1986 Free Software Foundation, Inc.
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: ;(defvar search-last-regexp ""
27: ; "Last string searched for by a regexp search command.
28: ;This does not include direct calls to the primitive search functions,
29: ;and does not include searches that are aborted.")
30: ;
31: ;(defconst search-repeat-char ?\C-s
32: ; "Character to repeat incremental search forwards.")
33: ;(defconst search-reverse-char ?\C-r
34: ; "Character to repeat incremental search backwards.")
35: ;(defconst search-exit-char ?\e
36: ; "Character to exit incremental search.")
37: ;(defconst search-delete-char ?\177
38: ; "Character to delete from incremental search string.")
39: ;(defconst search-quote-char ?\C-q
40: ; "Character to quote special characters for incremental search.")
41: ;(defconst search-yank-word-char ?\C-w
42: ; "Character to pull next word from buffer into search string.")
43: ;(defconst search-yank-line-char ?\C-y
44: ; "Character to pull rest of line from buffer into search string.")
45: ;(defconst search-exit-option t
46: ; "Non-nil means random control characters terminate incremental search.")
47: ;
48: ;(defvar search-slow-window-lines 1
49: ; "*Number of lines in slow search display windows.")
50: ;(defconst search-slow-speed 1200
51: ; "*Highest terminal speed at which to use \"slow\" style incremental search.
52: ;This is the style where a one-line window is created to show the line
53: ;that the search has reached.")
54:
55: ;; This function does all the work of incremental search.
56: ;; The functions attached to ^R and ^S are trivial,
57: ;; merely calling this one, but they are always loaded by default
58: ;; whereas this file can optionally be autoloadable.
59: ;; This is the only entry point in this file.
60:
61: (defun isearch (forward &optional regexp)
62: (let ((search-string "")
63: (search-message "")
64: (cmds nil)
65: (success t)
66: (wrapped nil)
67: (barrier (point))
68: adjusted
69: (invalid-regexp nil)
70: (slow-terminal-mode (and (<= (baud-rate) search-slow-speed)
71: (> (window-height)
72: (* 4 search-slow-window-lines))))
73: (other-end nil) ;Start of last match if fwd, end if backwd.
74: (small-window nil) ;if t, using a small window
75: (found-point nil) ;to restore point from a small window
76: ;; This is the window-start value found by the search.
77: (found-start nil)
78: (opoint (point))
79: (inhibit-quit t)) ;Prevent ^G from quitting immediately.
80: (isearch-push-state)
81: (save-window-excursion
82: (catch 'search-done
83: (while t
84: (or (>= unread-command-char 0)
85: (progn
86: (or (input-pending-p)
87: (isearch-message))
88: (if (and slow-terminal-mode
89: (not (or small-window (pos-visible-in-window-p))))
90: (progn
91: (setq small-window t)
92: (setq found-point (point))
93: (move-to-window-line 0)
94: (let ((window-min-height 1))
95: (split-window nil (if (< search-slow-window-lines 0)
96: (1+ (- search-slow-window-lines))
97: (- (window-height)
98: (1+ search-slow-window-lines)))))
99: (if (< search-slow-window-lines 0)
100: (progn (vertical-motion (- 1 search-slow-window-lines))
101: (set-window-start (next-window) (point))
102: (set-window-hscroll (next-window)
103: (window-hscroll))
104: (set-window-hscroll (selected-window) 0))
105: (other-window 1))
106: (goto-char found-point)))))
107: (let ((char (if quit-flag
108: ?\C-g
109: (read-char))))
110: (setq quit-flag nil adjusted nil)
111: ;; Meta character means exit search.
112: (cond ((and (>= char 128)
113: search-exit-option)
114: (setq unread-command-char char)
115: (throw 'search-done t))
116: ((eq char search-exit-char)
117: ;; Esc means exit search normally.
118: ;; Except, if first thing typed, it means do nonincremental
119: (if (= 0 (length search-string))
120: (nonincremental-search forward regexp))
121: (throw 'search-done t))
122: ((= char ?\C-g)
123: ;; ^G means the user tried to quit.
124: (ding)
125: (discard-input)
126: (if success
127: ;; If search is successful, move back to starting point
128: ;; and really do quit.
129: (progn (goto-char opoint)
130: (signal 'quit nil))
131: ;; If search is failing, rub out until it is once more
132: ;; successful.
133: (while (not success) (isearch-pop))))
134: ((or (eq char search-repeat-char)
135: (eq char search-reverse-char))
136: (if (eq forward (eq char search-repeat-char))
137: ;; C-s in forward or C-r in reverse.
138: (if (equal search-string "")
139: ;; If search string is empty, use last one.
140: (setq search-string
141: (if regexp
142: search-last-regexp search-last-string)
143: search-message
144: (mapconcat 'text-char-description
145: search-string ""))
146: ;; If already have what to search for, repeat it.
147: (or success
148: (progn (goto-char (if forward (point-min) (point-max)))
149: (setq wrapped t))))
150: ;; C-s in reverse or C-r in forward, change direction.
151: (setq forward (not forward)))
152: (setq barrier (point)) ; For subsequent \| if regexp.
153: (setq success t)
154: (or (equal search-string "")
155: (isearch-search))
156: (isearch-push-state))
157: ((= char search-delete-char)
158: ;; Rubout means discard last input item and move point
159: ;; back. If buffer is empty, just beep.
160: (if (null (cdr cmds))
161: (ding)
162: (isearch-pop)))
163: (t
164: (cond ((or (eq char search-yank-word-char)
165: (eq char search-yank-line-char))
166: ;; ^W means gobble next word from buffer.
167: ;; ^Y means gobble rest of line from buffer.
168: (let ((word (save-excursion
169: (and (not forward) other-end
170: (goto-char other-end))
171: (buffer-substring
172: (point)
173: (save-excursion
174: (if (eq char search-yank-line-char)
175: (end-of-line)
176: (forward-word 1))
177: (point))))))
178: (setq search-string (concat search-string word)
179: search-message
180: (concat search-message
181: (mapconcat 'text-char-description
182: word "")))))
183: ;; Any other control char =>
184: ;; unread it and exit the search normally.
185: ((and search-exit-option
186: (/= char search-quote-char)
187: (or (= char ?\177)
188: (and (< char ? ) (/= char ?\t) (/= char ?\r))))
189: (setq unread-command-char char)
190: (throw 'search-done t))
191: (t
192: ;; Any other character => add it to the
193: ;; search string and search.
194: (cond ((= char search-quote-char)
195: (setq char (read-quoted-char
196: (isearch-message t))))
197: ((= char ?\r)
198: ;; unix braindeath
199: (setq char ?\n)))
200: (setq search-string (concat search-string
201: (char-to-string char))
202: search-message (concat search-message
203: (text-char-description char)))))
204: (if (and (not success)
205: ;; unsuccessful regexp search may become
206: ;; successful by addition of characters which
207: ;; make search-string valid
208: (not regexp))
209: nil
210: ;; If a regexp search may have been made more
211: ;; liberal, retreat the search start.
212: ;; Go back to place last successful search started
213: ;; or to the last ^S/^R (barrier), whichever is nearer.
214: (and regexp success cmds
215: (cond ((memq char '(?* ??))
216: (setq adjusted t)
217: (let ((cs (nth (if forward
218: 5 ; other-end
219: 2) ; saved (point)
220: (car (cdr cmds)))))
221: ;; (car cmds) is after last search;
222: ;; (car (cdr cmds)) is from before it.
223: (setq cs (or cs barrier))
224: (goto-char
225: (if forward
226: (max cs barrier)
227: (min cs barrier)))))
228: ((eq char ?\|)
229: (setq adjusted t)
230: (goto-char barrier))))
231: ;; In reverse regexp search, adding a character at
232: ;; the end may cause zero or many more chars to be
233: ;; matched, in the string following point.
234: ;; Allow all those possibiities without moving point as
235: ;; long as the match does not extend past search origin.
236: (if (and regexp (not forward) (not adjusted)
237: (condition-case ()
238: (looking-at search-string)
239: (error nil))
240: (<= (match-end 0) (min opoint barrier)))
241: (setq success t invalid-regexp nil
242: other-end (match-end 0))
243: ;; Not regexp, not reverse, or no match at point.
244: (if (and other-end (not adjusted))
245: (goto-char (if forward other-end
246: (min opoint barrier (1+ other-end)))))
247: (isearch-search)))
248: (isearch-push-state))))))
249: (setq found-start (window-start (selected-window)))
250: (setq found-point (point)))
251: (if (> (length search-string) 0)
252: (if regexp
253: (setq search-last-regexp search-string)
254: (setq search-last-string search-string)))
255: ;; If there was movement, mark the starting position.
256: ;; Maybe should test difference between and set mark iff > threshold.
257: (if (/= (point) opoint)
258: (push-mark opoint)
259: (message ""))
260: (if small-window
261: (goto-char found-point)
262: ;; Exiting the save-window-excursion clobbers this; restore it.
263: (set-window-start (selected-window) found-start t))))
264:
265: (defun isearch-message (&optional c-q-hack ellipsis)
266: ;; If about to search, and previous search regexp was invalid,
267: ;; check that it still is. If it is valid now,
268: ;; let the message we display while searching say that it is valid.
269: (and invalid-regexp ellipsis
270: (condition-case ()
271: (progn (re-search-forward search-string (point) t)
272: (setq invalid-regexp nil))
273: (error nil)))
274: ;; If currently failing, display no ellipsis.
275: (or success (setq ellipsis nil))
276: (let ((m (concat (if success "" "failing ")
277: (if wrapped "wrapped ")
278: (if regexp "regexp " "")
279: "I-search"
280: (if forward ": " " backward: ")
281: search-message
282: (if c-q-hack "^Q" "")
283: (if invalid-regexp
284: (concat " [" invalid-regexp "]")
285: ""))))
286: (aset m 0 (upcase (aref m 0)))
287: (let ((cursor-in-echo-area ellipsis))
288: (if c-q-hack m (message "%s" m)))))
289:
290: (defun isearch-pop ()
291: (setq cmds (cdr cmds))
292: (let ((cmd (car cmds)))
293: (setq search-string (car cmd)
294: search-message (car (cdr cmd))
295: success (nth 3 cmd)
296: forward (nth 4 cmd)
297: other-end (nth 5 cmd)
298: invalid-regexp (nth 6 cmd)
299: wrapped (nth 7 cmd)
300: barrier (nth 8 cmd))
301: (goto-char (car (cdr (cdr cmd))))))
302:
303: (defun isearch-push-state ()
304: (setq cmds (cons (list search-string search-message (point)
305: success forward other-end invalid-regexp
306: wrapped barrier)
307: cmds)))
308:
309: (defun isearch-search ()
310: (isearch-message nil t)
311: (condition-case lossage
312: (let ((inhibit-quit nil))
313: (if regexp (setq invalid-regexp nil))
314: (setq success
315: (funcall
316: (if regexp
317: (if forward 're-search-forward 're-search-backward)
318: (if forward 'search-forward 'search-backward))
319: search-string nil t))
320: (if success
321: (setq other-end
322: (if forward (match-beginning 0) (match-end 0)))))
323: (quit (setq unread-command-char ?\C-g)
324: (setq success nil))
325: (invalid-regexp (setq invalid-regexp (car (cdr lossage)))
326: (if (string-match "\\`Premature \\|\\`Unmatched \\|\\`Invalid "
327: invalid-regexp)
328: (setq invalid-regexp "incomplete input"))))
329: (if success
330: nil
331: ;; Ding if failed this time after succeeding last time.
332: (and (nth 3 (car cmds))
333: (ding))
334: (goto-char (nth 2 (car cmds)))))
335:
336: ;; This is called from incremental-search
337: ;; if the first input character is the exit character.
338: ;; The interactive-arg-reader uses free variables `forward' and `regexp'
339: ;; which are bound by `incremental-search'.
340:
341: ;; We store the search string in `search-string'
342: ;; which has been bound already by `incremental-search'
343: ;; so that, when we exit, it is copied into `search-last-string'.
344:
345: (defun nonincremental-search (forward regexp)
346: (let (message char function string inhibit-quit
347: (cursor-in-echo-area t))
348: ;; Prompt assuming not word search,
349: (setq message (if regexp
350: (if forward "Regexp search: "
351: "Regexp search backward: ")
352: (if forward "Search: " "Search backward: ")))
353: (message "%s" message)
354: ;; Read 1 char and switch to word search if it is ^W.
355: (setq char (read-char))
356: (if (eq char search-yank-word-char)
357: (setq message (if forward "Word search: " "Word search backward: "))
358: ;; Otherwise let that 1 char be part of the search string.
359: (setq unread-command-char char))
360: (setq function
361: (if (eq char search-yank-word-char)
362: (if forward 'word-search-forward 'word-search-backward)
363: (if regexp
364: (if forward 're-search-forward 're-search-backward)
365: (if forward 'search-forward 'search-backward))))
366: ;; Read the search string with corrected prompt.
367: (setq string (read-string message))
368: ;; Empty means use default.
369: (if (= 0 (length string))
370: (setq string search-last-string)
371: ;; Set last search string now so it is set even if we fail.
372: (setq search-last-string string))
373: ;; Since we used the minibuffer, we should be available for redo.
374: (setq command-history (cons (list function string) command-history))
375: ;; Go ahead and search.
376: (funcall function string)))
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.