Annotation of 43BSD/contrib/emacs/lisp/isearch.el, revision 1.1

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

unix.superglobalmegacorp.com

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