home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / elisp / packages / comint-isearch.el < prev    next >
Encoding:
Text File  |  1992-06-16  |  10.4 KB  |  326 lines
  1. ; Return-Path: <mathur@nas.nasa.gov>
  2. ; Received: from hal.com (hal-backbone) by halaus.hal.com (4.1/SMI-4.1)
  3. ;     id AA06798; Fri, 10 Apr 92 17:06:06 CDT
  4. ; Received: from mail.cis.ohio-state.edu by hal.com (4.1/SMI-4.1)
  5. ;     id AA08054; Fri, 10 Apr 92 15:05:47 PDT
  6. ; Received: from wk218.nas.nasa.gov by mail.cis.ohio-state.edu (5.61-kk/5.911008)
  7. ;     id AA29703; Fri, 10 Apr 92 18:05:32 -0400
  8. ; Received: by wk218.nas.nasa.gov (5.61/1.34)
  9. ;     id AA21659; Fri, 10 Apr 92 15:05:04 -0700
  10. ; Date: Fri, 10 Apr 92 15:05:04 -0700
  11. ; From: mathur@nas.nasa.gov (Sanjay R. Mathur)
  12. ; Reply-To: tg.southern@rxuk.xerox.com
  13. ; Subject: comint-isearch
  14. ; Status: OR
  15. ; 
  16. ; 
  17. ; [ I am forwarding this on behalf of Terry. Please address any responses
  18. ;   directly to him at the address below.  -- Sanjay ]
  19. ; 
  20. ; 
  21. ; This is an incremental command search mode for comint.  Previous
  22. ; commands that match are inserted on the command line as you type.
  23. ; Anyone familiar with the emacs isearch or bash should find this easy
  24. ; to adapt to.
  25. ; 
  26. ; Terry.
  27. ; 
  28. ; =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
  29. ;   Terry Glanfield, +44 483 753 057, tg.southern@rxuk.xerox.com 
  30. ; =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
  31. ; 
  32. ; 
  33. ;;; -*-Emacs-Lisp-*- Incremental command search for comint
  34. ;;; Terry Glanfield (tg.southern@rxuk.xerox.com)
  35. ;;; Version 1.0
  36. ;;; 
  37. ;;; This file is not part of GNU Emacs but the same permissions apply.
  38. ;;; 
  39. ;;; GNU Emacs is free software; you can redistribute it and/or modify
  40. ;;; it under the terms of the GNU General Public License as published by
  41. ;;; the Free Software Foundation; either version 1, or (at your option)
  42. ;;; any later version.
  43. ;;;
  44. ;;; GNU Emacs is distributed in the hope that it will be useful,
  45. ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  46. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  47. ;;; GNU General Public License for more details.
  48. ;;;
  49. ;;; You should have received a copy of the GNU General Public License
  50. ;;; along with GNU Emacs; see the file COPYING.  If not, write to
  51. ;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  52. ;;;
  53. ;;;
  54. ;;; This is an incremental command search mode for comint.  Previous
  55. ;;; commands that match are inserted on the command line as you type.
  56. ;;; Anyone familiar with the emacs isearch or bash should find this easy
  57. ;;; to adapt to.
  58. ;;; 
  59. ;;; It is based on ideas from bash and borrows heavily from isearch.el.
  60. ;;; 
  61. ;;; Differences from bash:
  62. ;;;   * C-s searches forwards
  63. ;;;   * DEL cancels characters or moves to previous search
  64. ;;;   * C-g also moves to previous successful search
  65. ;;;   * Inserts previous search string
  66. ;;; 
  67. ;;; Differences from isearch:
  68. ;;;   * No C-w or C-y
  69. ;;;   * No wrap around, yet
  70. ;;; 
  71. ;;; It uses the variables search-repeat-char, search-exit-char etc.
  72. ;;; 
  73. ;;;  recommended usage:
  74. ;;; (setq cmushell-load-hook
  75. ;;;       '((lambda ()
  76. ;;;       (require 'comint-isearch)
  77. ;;;       (define-key cmushell-mode-map "\C-r" 'comint-isearch))))
  78.  
  79. ;; LCD Archive Entry:
  80. ;; comint-isearch|Terry Glanfield|tg.southern@rxuk.xerox.com|
  81. ;; Command line incremental searching for comint.|
  82. ;; 92-04-10|Version 1.0|~/packages/comint-isearch.el.Z|
  83.  
  84. (require 'comint)
  85. (provide 'comint-isearch)
  86.  
  87. (defvar comint-last-isearch-string nil
  88.   "Last string searched for in comint-isearch.")
  89.  
  90. (defvar comint-isearch-buffer " *Ring Buffer*"
  91.   "Buffer used in comint-isearch")
  92.  
  93. (defun comint-isearch ()
  94.   "Do incremental searching for commands in comint shells.
  95. As you type characters, they add to the search string and the
  96. matching command line from the history ring is inserted.
  97. Type Delete to cancel characters from end of search string.
  98. Type ESC to exit, leaving point at location found.
  99. Type C-r to search again, C-s to search again forwards.
  100. Type C-q to quote control character to search for it.
  101. Type RET to send this command to the shell.
  102. Other control and meta characters terminate the search
  103.  and are then executed normally.
  104. The above special characters are mostly controlled by parameters;
  105.  do M-x apropos on search-.*-char to find them.
  106. C-g while searching or when search has failed
  107.  cancels input back to what has been found successfully.
  108. C-g when search is successful aborts and moves point to starting point."
  109.   (interactive)
  110.   (let ((ring-len (ring-length input-ring)))
  111.     (cond ((not (comint-after-pmark-p))
  112.        (isearch-backward))
  113.       ((<= ring-len 0)
  114.        (message "Empty input ring")
  115.        (ding))
  116.       (t
  117.        (comint-isearch-internal)))))
  118.  
  119. (defun comint-isearch-internal ()
  120.   (let* ((search-string "")
  121.      (search-message "")
  122.      (success t)
  123.      (cmds nil)
  124.      (forward nil)
  125.      (pmark (marker-position
  126.          (process-mark (get-buffer-process (current-buffer)))))
  127.      (saved-prompt (buffer-substring
  128.             (save-excursion (beginning-of-line) (point))
  129.             pmark))
  130.      (saved-command (buffer-substring
  131.              pmark
  132.              (save-excursion (end-of-line) (point))))
  133.      (saved-point (- (point-max) (point)))
  134.      (ring input-ring)
  135.      (ring-buf (get-buffer-create comint-isearch-buffer))
  136.      (ring-point nil)
  137.      (line-point 0)
  138.      (abort-flag nil)
  139.      (inhibit-quit t))  ;Prevent ^G from quitting.
  140.     (save-excursion
  141.       (set-buffer ring-buf)
  142.       ;; fill temporary buffer with history ring
  143.       (erase-buffer)
  144.       (let ((n ring-len))
  145.     (while (> n 0)
  146.       (setq n (1- n))
  147.       (insert (ring-ref ring n) 10)))
  148.       (insert saved-command)
  149.       (end-of-buffer)
  150.       (backward-char saved-point)
  151.       (setq ring-point (point))
  152.       (setq line-point (- (point-max) (point))))
  153.     (comint-isearch-push)
  154.     (catch 'search-done
  155.       (while t
  156.     (or (>= unread-command-char 0)
  157.         (progn
  158.           (or (input-pending-p)
  159.           (comint-isearch-prompt))))
  160.     (let ((char (if quit-flag
  161.             ?\C-g
  162.               (read-char))))
  163.       (setq quit-flag nil)
  164.       (cond ((and (>= char 128)
  165.               search-exit-option)
  166.          (setq unread-command-char char)
  167.          ;; Meta character means exit search.
  168.          (setq unread-command-char char)
  169.          (throw 'search-done t))
  170.         ((eq char search-exit-char)
  171.          ;; Esc means exit search normally.
  172.          (throw 'search-done t))
  173.         ((= char ?\C-g)
  174.          ;; ^G means the user tried to quit.
  175.          ;; needs to be more clever
  176.          (ding)
  177.          (discard-input)
  178.          (if success
  179.              ;; really do quit.
  180.              (progn (setq abort-flag t)
  181.                 (throw 'search-done t))
  182.            ;; If search is failing, rub out until it is once more
  183.            ;;  successful.
  184.            (while (not success) (comint-isearch-pop))
  185.            ;; If it is now at the start, exit anyway
  186.            (if (equal search-string "")
  187.                (progn (setq abort-flag t)
  188.                   (throw 'search-done t)))))
  189.         ((or (eq char search-repeat-char)
  190.              (eq char search-reverse-char))
  191.          (if (eq forward (eq char search-repeat-char))
  192.              ;; C-s in forward or C-r in reverse.
  193.              (if (equal search-string "")
  194.              ;; If search string is empty, use last one.
  195.              (setq search-string comint-last-isearch-string
  196.                    search-message (mapconcat 'text-char-description
  197.                              search-string ""))
  198.                ;; If already have what to search for, repeat it.
  199.                (or success (ding)))
  200.            ;; C-s in reverse or C-r in forward, change direction.
  201.            (setq forward (not forward)))
  202.          (setq success t)
  203.          (or (equal search-string "")
  204.              (comint-isearch-search t))
  205.          (comint-isearch-push))
  206.         ((= char search-delete-char)
  207.          ;; Rubout means discard last input item and move point
  208.          ;; back.  If buffer is empty, just beep.
  209.           (if (null (cdr cmds))
  210.               (ding)
  211.             (comint-isearch-pop)))
  212.         ((or (= char ?\r)
  213.              (= char ?\n))
  214.          ;; Accept this line
  215.          (setq unread-command-char char)
  216.          (throw 'search-done t))
  217.         (t
  218.          ;; could add search-yank-word-char
  219.          ;; and search-yank-line-char in here
  220.          (cond ((and
  221.              search-exit-option
  222.              (/= char search-quote-char)
  223.              (or (= char ?\177)
  224.                  (and (< char ? ) (/= char ?\t) (/= char ?\r))))
  225.             ;; Any other control char =>
  226.             ;;  unread it and exit the search normally.
  227.             (setq unread-command-char char)
  228.             (throw 'search-done t))
  229.                (t
  230.             ;; Any other character => add it to the
  231.             ;;  search string and search.
  232.             (and (= char search-quote-char)
  233.                  (setq char (read-quoted-char
  234.                      (comint-isearch-prompt t))))
  235.             (setq search-string (concat
  236.                          search-string
  237.                          (char-to-string char))
  238.                   search-message (concat
  239.                           search-message
  240.                           (text-char-description char)))))
  241.          (if success
  242.              (comint-isearch-search))
  243.          (comint-isearch-push))))))
  244.     (message "")
  245.     (delete-region
  246.      (progn (beginning-of-line) (point))
  247.      (progn (end-of-line) (point)))
  248.     (insert-string saved-prompt)
  249.     (if (or abort-flag
  250.         (equal search-string ""))
  251.     (progn (insert saved-command)
  252.            (backward-char saved-point))
  253.       (progn (insert (comint-isearch-selected-line))
  254.          (backward-char line-point)
  255.          (if (> (length search-string) 0)
  256.          (setq comint-last-isearch-string search-string))))
  257.     (set-marker (process-mark (get-buffer-process (current-buffer))) pmark)))
  258.  
  259. (defun comint-isearch-selected-line ()
  260.   (save-excursion
  261.     (set-buffer ring-buf)
  262.     (goto-char ring-point)
  263.     (beginning-of-line)
  264.     (buffer-substring
  265.      (point)
  266.      (progn (end-of-line) (point)))))
  267.  
  268. (defun comint-isearch-prompt (&optional c-q-hack)
  269.   (let ((m (concat "(I-search: '"
  270.            search-message
  271.            (if c-q-hack "^Q" "")
  272.            "'): "))
  273.     (c (if ring-point
  274.            (comint-isearch-selected-line)
  275.          "")))
  276.     (beginning-of-line)
  277.     (delete-region (point) (save-excursion (end-of-line) (point)))
  278.     (insert-string m c)
  279.     (backward-char line-point)
  280.     ;; ditch garbage from mini-buffer
  281.     (message " ")))
  282.  
  283. (defun comint-isearch-pop ()
  284.   (setq cmds (cdr cmds))
  285.   (let ((cmd (car cmds)))
  286.     (setq search-string (car cmd)
  287.       search-message (car (cdr cmd))
  288.       success (nth 2 cmd)
  289.       forward (nth 3 cmd)
  290.       ring-point (nth 4 cmd)
  291.       line-point (nth 5 cmd))
  292.     (save-excursion
  293.       (set-buffer ring-buf)
  294.       (goto-char ring-point))))
  295.  
  296. (defun comint-isearch-push ()
  297.   (setq cmds (cons (list search-string search-message success
  298.              forward ring-point line-point)
  299.            cmds)))
  300.  
  301. (defun comint-isearch-search (&optional repeat)
  302.   (save-excursion
  303.     (set-buffer ring-buf)
  304.     (if forward
  305.     (goto-char ring-point)
  306.       (goto-char (+ ring-point (if (null repeat) (length search-string) 0))))
  307.     (condition-case lossage
  308.     (let ((inhibit-quit nil))
  309.       (setq success
  310.         (funcall
  311.          (if forward 'search-forward 'search-backward)
  312.          search-string nil t))
  313.       (if success
  314.           (progn (setq ring-point (point))
  315.              (end-of-line)
  316.              (setq line-point (- (point) ring-point)))))
  317.       (quit (setq unread-command-char ?\C-g)
  318.         (setq success nil)))
  319.     (if success
  320.     nil
  321.       ;; Ding if failed this time after succeeding last time.
  322.       (and (nth 2 (car cmds))
  323.        (ding)))))
  324.  
  325.  
  326.