![[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.