Annotation of 43BSDReno/contrib/emacs-18.55/lisp/isearch.el, revision 1.1

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

unix.superglobalmegacorp.com

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.