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