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