home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Professional / OS2PRO194.ISO / os2 / prgramer / unix / emacs / lisp / isearch.el < prev    next >
Lisp/Scheme  |  1992-04-19  |  14KB  |  387 lines
  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 no longer means exit search.
  111.        (cond
  112.           ;;((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.                (if regexp
  179.                    (setq word (regexp-quote word)))
  180.                (setq search-string (concat search-string word)
  181.                  search-message
  182.                    (concat search-message
  183.                        (mapconcat 'text-char-description
  184.                               word "")))))
  185.              ;; Any other control char =>
  186.              ;;  unread it and exit the search normally.
  187.              ((and search-exit-option
  188.                    (/= char search-quote-char)
  189.                    (or (= char ?\177)
  190.                    (and (< char ? ) (/= char ?\t) (/= char ?\r))))
  191.               (setq unread-command-char char)
  192.               (throw 'search-done t))
  193.              (t
  194.               ;; Any other character => add it to the
  195.               ;;  search string and search.
  196.               (cond ((= char search-quote-char)
  197.                  (setq char (read-quoted-char
  198.                          (isearch-message t))))
  199.                 ((= char ?\r)
  200.                  ;; unix braindeath
  201.                  (setq char ?\n)))
  202.               (setq search-string (concat search-string
  203.                               (char-to-string char))
  204.                 search-message (concat search-message
  205.                                (text-char-description char)))))
  206.           (if (and (not success)
  207.                ;; unsuccessful regexp search may become
  208.                ;;  successful by addition of characters which
  209.                ;;  make search-string valid
  210.                (not regexp))
  211.               nil
  212.             ;; If a regexp search may have been made more
  213.             ;; liberal, retreat the search start.
  214.             ;; Go back to place last successful search started
  215.             ;; or to the last ^S/^R (barrier), whichever is nearer.
  216.             (and regexp success cmds
  217.              (cond ((and (memq char '(?* ??))
  218.                      ;; Don't treat *, ? as special
  219.                      ;; within [] or after \.
  220.                      (not (nth 6 (car cmds))))
  221.                 (setq adjusted t)
  222.                 ;; This used to use element 2
  223.                 ;; in a reverse search, but it seems that 5
  224.                 ;; (which is the end of the old match)
  225.                 ;; is better in that case too.
  226.                 (let ((cs (nth 5 ; old other-end.
  227.                            (car (cdr cmds)))))
  228.                   ;; (car cmds) is after last search;
  229.                   ;; (car (cdr cmds)) is from before it.
  230.                   (setq cs (or cs barrier))
  231.                   (goto-char
  232.                    (if forward
  233.                        (max cs barrier)
  234.                      (min cs barrier)))))
  235.                    ((eq char ?\|)
  236.                 (setq adjusted t)
  237.                 (goto-char barrier))))
  238.             ;; In reverse regexp search, adding a character at
  239.             ;; the end may cause zero or many more chars to be
  240.             ;; matched, in the string following point.
  241.             ;; Allow all those possibiities without moving point as
  242.             ;; long as the match does not extend past search origin.
  243.             (if (and regexp (not forward) (not adjusted)
  244.                  (condition-case ()
  245.                  (looking-at search-string)
  246.                    (error nil))
  247.                  (<= (match-end 0) (min opoint barrier)))
  248.             (setq success t invalid-regexp nil
  249.                   other-end (match-end 0))
  250.               ;; Not regexp, not reverse, or no match at point.
  251.               (if (and other-end (not adjusted))
  252.               (goto-char (if forward other-end
  253.                        (min opoint barrier (1+ other-end)))))
  254.               (isearch-search)))
  255.           (isearch-push-state))))))
  256.      (setq found-start (window-start (selected-window)))
  257.      (setq found-point (point)))
  258.     (if (> (length search-string) 0)
  259.     (if regexp
  260.         (setq search-last-regexp search-string)
  261.         (setq search-last-string search-string)))
  262.     ;; If we displayed a single-line window, set point in this window. 
  263.     (if small-window
  264.     (goto-char found-point))
  265.     ;; If there was movement, mark the starting position.
  266.     ;; Maybe should test difference between and set mark iff > threshold.
  267.     (if (/= (point) opoint)
  268.     (push-mark opoint)
  269.       (message ""))
  270.     (or small-window
  271.     ;; Exiting the save-window-excursion clobbers this; restore it.
  272.     (set-window-start (selected-window) found-start t))))
  273.  
  274. (defun isearch-message (&optional c-q-hack ellipsis)
  275.   ;; If about to search, and previous search regexp was invalid,
  276.   ;; check that it still is.  If it is valid now,
  277.   ;; let the message we display while searching say that it is valid.
  278.   (and invalid-regexp ellipsis
  279.        (condition-case ()
  280.        (progn (re-search-forward search-string (point) t)
  281.           (setq invalid-regexp nil))
  282.      (error nil)))
  283.   ;; If currently failing, display no ellipsis.
  284.   (or success (setq ellipsis nil))
  285.   (let ((m (concat (if success "" "failing ")
  286.            (if wrapped "wrapped ")
  287.            (if regexp "regexp " "")
  288.            "I-search"
  289.            (if forward ": " " backward: ")
  290.            search-message
  291.            (if c-q-hack "^Q" "")
  292.            (if invalid-regexp
  293.                (concat " [" invalid-regexp "]")
  294.              ""))))
  295.     (aset m 0 (upcase (aref m 0)))
  296.     (let ((cursor-in-echo-area ellipsis))
  297.       (if c-q-hack m (message "%s" m)))))
  298.  
  299. (defun isearch-pop ()
  300.   (setq cmds (cdr cmds))
  301.   (let ((cmd (car cmds)))
  302.     (setq search-string (car cmd)
  303.       search-message (car (cdr cmd))
  304.       success (nth 3 cmd)
  305.       forward (nth 4 cmd)
  306.       other-end (nth 5 cmd)
  307.       invalid-regexp (nth 6 cmd)
  308.       wrapped (nth 7 cmd)
  309.       barrier (nth 8 cmd))
  310.     (goto-char (car (cdr (cdr cmd))))))
  311.  
  312. (defun isearch-push-state ()
  313.   (setq cmds (cons (list search-string search-message (point)
  314.              success forward other-end invalid-regexp
  315.              wrapped barrier)
  316.            cmds)))
  317.  
  318. (defun isearch-search ()
  319.   (isearch-message nil t)
  320.   (condition-case lossage
  321.       (let ((inhibit-quit nil))
  322.     (if regexp (setq invalid-regexp nil))
  323.     (setq success
  324.           (funcall
  325.            (if regexp
  326.            (if forward 're-search-forward 're-search-backward)
  327.          (if forward 'search-forward 'search-backward))
  328.            search-string nil t))
  329.     (if success
  330.         (setq other-end
  331.           (if forward (match-beginning 0) (match-end 0)))))
  332.     (quit (setq unread-command-char ?\C-g)
  333.       (setq success nil))
  334.     (invalid-regexp (setq invalid-regexp (car (cdr lossage)))
  335.             (if (string-match "\\`Premature \\|\\`Unmatched \\|\\`Invalid "
  336.                       invalid-regexp)
  337.             (setq invalid-regexp "incomplete input"))))
  338.   (if success
  339.       nil
  340.     ;; Ding if failed this time after succeeding last time.
  341.     (and (nth 3 (car cmds))
  342.      (ding))
  343.     (goto-char (nth 2 (car cmds)))))
  344.  
  345. ;; This is called from incremental-search
  346. ;; if the first input character is the exit character.
  347. ;; The interactive-arg-reader uses free variables `forward' and `regexp'
  348. ;; which are bound by `incremental-search'.
  349.  
  350. ;; We store the search string in `search-string'
  351. ;; which has been bound already by `incremental-search'
  352. ;; so that, when we exit, it is copied into `search-last-string'.
  353.  
  354. (defun nonincremental-search (forward regexp)
  355.   (let (message char function string inhibit-quit)
  356.     (let ((cursor-in-echo-area t))
  357.       ;; Prompt assuming not word search,
  358.       (setq message (if regexp 
  359.             (if forward "Regexp search: "
  360.               "Regexp search backward: ")
  361.               (if forward "Search: " "Search backward: ")))
  362.       (message "%s" message)
  363.       ;; Read 1 char and switch to word search if it is ^W.
  364.       (setq char (read-char)))
  365.     (if (eq char search-yank-word-char)
  366.     (setq message (if forward "Word search: " "Word search backward: "))
  367.       ;; Otherwise let that 1 char be part of the search string.
  368.       (setq unread-command-char char))
  369.     (setq function
  370.       (if (eq char search-yank-word-char)
  371.           (if forward 'word-search-forward 'word-search-backward)
  372.         (if regexp
  373.         (if forward 're-search-forward 're-search-backward)
  374.           (if forward 'search-forward 'search-backward))))
  375.     ;; Read the search string with corrected prompt.
  376.     (setq string (read-string message))
  377.     (let ((var (if regexp 'search-last-regexp 'search-last-string)))
  378.       ;; Empty means use default.
  379.       (if (= 0 (length string))
  380.       (setq string (symbol-value var))
  381.     ;; Set last search string now so it is set even if we fail.
  382.     (set var string)))
  383.     ;; Since we used the minibuffer, we should be available for redo.
  384.     (setq command-history (cons (list function string) command-history))
  385.     ;; Go ahead and search.
  386.     (funcall function string)))
  387.