home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / elisp / interfaces / Emacs-cl-shell / shell-history.el < prev    next >
Encoding:
Text File  |  1991-03-19  |  9.7 KB  |  215 lines
  1. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  2. ;;; FILE:          shell-history.el
  3. ;;; DESCRIPTION:   Extensions to the code in shell.el for recording and 
  4. ;;;                yanking command history in a ring (vector).
  5. ;;; AUTHOR:        Eero Simoncelli, 
  6. ;;;                Vision Science Group, 
  7. ;;;                MIT Media Laboratory.
  8. ;;; CREATED:       March, 1989
  9. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  10.  
  11. ;; GNU Emacs is distributed in the hope that it will be useful, but
  12. ;; WITHOUT ANY WARRANTY.  No author or distributor accepts
  13. ;; responsibility to anyone for the consequences of using it or for
  14. ;; whether it serves any particular purpose or works at all, unless he
  15. ;; says so in writing.  Refer to the GNU Emacs General Public License
  16. ;; for full details.
  17.  
  18. ;; Everyone is granted permission to copy, modify and redistribute GNU
  19. ;; Emacs, but only under the conditions described in the GNU Emacs
  20. ;; General Public License.  A copy of this license is supposed to have
  21. ;; been given to you along with GNU Emacs so you can know your rights
  22. ;; and responsibilities.  It should be in a file named COPYING.  Among
  23. ;; other things, the copyright notice and this notice must be
  24. ;; preserved on all copies.
  25.  
  26. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  27.  
  28. ;;; To use this code, you have to insert this line in the function which sends
  29. ;;; strings to the shell process:
  30. ;;;      (shell-add-history <string>)
  31. ;;; For standard shells (as in shell.el), the function of interest is
  32. ;;; shell-send-input.
  33.  
  34. ;;; The top-level commands are shell-yank-history,
  35. ;;; shell-yank-history-forward, shell-yank-matching-history, and
  36. ;;; shell-yank-matching-history-forward.  These cycle through the
  37. ;;; history ring, pulling out previous commands the user has typed
  38. ;;; (like using C-y, M-y to look at the Emacs kill-ring).  FOr the
  39. ;;; first two commands, the matches are inserted at the point.  The
  40. ;;; "matching" commands differ in that 1) If the user has already
  41. ;;; started typing a command, then the ring is searched for commands
  42. ;;; which match what has been typed (with leading whitespace trimmed)
  43. ;;; and 2) the yanks are inserted at the process-mark (beginning of
  44. ;;; new input).
  45.  
  46. ;;; Recommended key bindings:
  47. ;;;  (define-key shell-mode-map "\M-\C-y" 'shell-yank-history)
  48. ;;;  (define-key shell-mode-map "\M-\C-z" 'shell-yank-history-forward)
  49. ;;; and (to match bindings of tcsh)
  50. ;;;  (define-key shell-mode-map "\M-p" 'shell-yank-matching-history)
  51. ;;;  (define-key shell-mode-map "\M-n" 'shell-yank-matching-history-forward)
  52.  
  53. ;;; Relies only on a buffer variable called history-ring, which is
  54. ;;; created automatically by shell-add-history.  The ring is a vector.
  55. ;;; The first element of the ring is an index number (current
  56. ;;; insertion position).  The rest of the elements are the history
  57. ;;; strings.
  58.  
  59. (defconst *shell-history-default-length* 100)
  60. (defvar *shell-history-min-string-length* 4)
  61.  
  62. ;;; First element is index of current ring position.  This is where the
  63. ;;; next history string will be added.
  64. (defun shell-make-history-ring (&optional length)
  65.   (if (null length) (setq length *shell-history-default-length*))
  66.   (let ((vect (make-vector (1+ length) nil))) ;make vector of nils
  67.     (aset vect 0 1)        ;initial index is 1
  68.     vect))
  69.  
  70. (setq-default history-ring nil)   ;could set this to be a global history ring.
  71.  
  72. ;;; Top level function for adding a string to the history ring.  If
  73. ;;; buffer has no history-ring, a new one is created.  Initial whitespace
  74. ;;; is trimmed.
  75. (defun shell-add-history (string &optional buffer)
  76.   (let ((original-buffer (current-buffer))
  77.     length index)
  78.     (set-buffer (or buffer original-buffer))
  79.     (if history-ring nil
  80.     (make-local-variable 'history-ring) ;make a new one if necessary
  81.     (setq history-ring (shell-make-history-ring)))
  82.     (setq index (aref history-ring 0))  ;read current ring position
  83.     (setq length (length history-ring))
  84.     (if (eq (string-match "[ \t\n]" string) 0)
  85.     (setq string (substring string (match-end 0))))
  86.     ;; check if string is empty or previous input was identical
  87.     (if (or (< (length string) *shell-history-min-string-length*)
  88.         (equal string (aref history-ring (mod+1 (1- index) length))))
  89.     nil                ;don't bother if empty, keyword or repeat
  90.     (aset history-ring index string)
  91.     (aset history-ring 0 (mod+1 (1+ index) (length history-ring))))
  92.     (set-buffer original-buffer)
  93.     string))
  94.     
  95. ;;; This should only be called from within the shell buffer.  It yanks
  96. ;;; from the history ring, inserting at the current point position.
  97. (defun shell-yank-history (&optional forward-p)
  98.   "Cycle backward through the history ring of commands typed to the shell. The history
  99. ring has length determined by the global variable *shell-history-default-length*."
  100.   (interactive)
  101.   (let (history-string)
  102.     (if (null history-ring) (error "No history ring for current buffer."))
  103.     (setq history-string
  104.       (catch 'no-history
  105.         (cond ((or (eq last-command 'shell-yank-history)
  106.                (eq last-command 'shell-yank-history-forward))
  107.            (delete-region shell-history-insertion-position (point))
  108.            (shell-next-history-string history-ring "" forward-p))
  109.           (t (setq shell-history-insertion-position (point))
  110.              (shell-next-history-string history-ring "" forward-p t)))))
  111.     (if (stringp history-string)
  112.     (insert history-string)
  113.     (beep)
  114.     (message (concat (if history-string "Beginning"  "End") " of history ring.")))))
  115.  
  116. (defun shell-yank-history-forward ()
  117.   "Cycle forward through the history ring of commands typed to the shell.  The history
  118. ring has length determined by the global variable *shell-history-default-length*."
  119.   (interactive)
  120.   (shell-yank-history t))
  121.  
  122. ;;; This should only be called from within the shell buffer.  Yanks from
  123. ;;; history ring the next command matching the shell-history-substring.
  124. (defun shell-yank-matching-history (&optional forward-p)
  125.   "Cycle backward through the history ring of commands typed to the shell.  If the 
  126. user has begun typing a new command, then looks for a command matching the typed
  127. substring.  The history strings are inserted at the process-mark (where the next
  128. user input will begin). The history ring has length determined by the global variable 
  129. *shell-history-default-length*."
  130.   (interactive)
  131.   (let (history-string proc-mark)
  132.     (if (null history-ring) (error "No history ring for current buffer."))
  133.     (if (or (null (get-buffer-process (current-buffer)))
  134.         (null (setq proc-mark
  135.             (process-mark (get-buffer-process (current-buffer))))))
  136.     (error "No process-mark for current buffer."))
  137.     (setq history-string
  138.       (catch 'no-history
  139.         (if (or (eq last-command 'shell-yank-matching-history)
  140.             (eq last-command 'shell-yank-matching-history-forward))
  141.         (shell-next-history-string
  142.          history-ring shell-history-substring forward-p)
  143.         ;; Find first non-whitespace char after process-mark:
  144.         (setq shell-history-insertion-position
  145.               (save-excursion
  146.             (goto-char proc-mark)
  147.             (skip-chars-forward " \t\n")
  148.             (point)))
  149.         ;; Goto beginning of trailing whitespace:
  150.         (goto-char (point-max))
  151.         (skip-chars-backward " \t\n" shell-history-insertion-position)
  152.         (setq shell-history-substring 
  153.               (buffer-substring shell-history-insertion-position (point)))
  154.         (shell-next-history-string
  155.          history-ring shell-history-substring forward-p t))))
  156.     ;; Assumes the point is at the end of the inserted string!
  157.     (delete-region shell-history-insertion-position (point))
  158.     (if (stringp history-string)
  159.     (insert history-string)
  160.     (beep)
  161.     (message (concat (if history-string "Beginning"  "End")
  162.              " of history ring"
  163.              (if (> (length shell-history-substring) 0)
  164.                  ": No more matches."  ".")))
  165.     (insert shell-history-substring)
  166.     (goto-char (point-max)))))
  167.  
  168. (defun shell-yank-matching-history-forward ()
  169. "Cycle forward through the history ring of commands typed to the shell.  If the 
  170. user has begun typing a new command, then looks for a command matching the typed
  171. substring.  The history strings are inserted at the process-mark (where the next
  172. user input will begin). The history ring has length determined by the global variable 
  173. *shell-history-default-length*."
  174.   (interactive)
  175.   (shell-yank-matching-history t))
  176.  
  177. ;;; These can be global since they only apply to the current buffer.
  178. (defvar shell-history-insertion-position 0
  179.   "Starting buffer position of history insertions.")
  180.  
  181. (defvar shell-history-substring ""
  182.   "Substring user had started typing before they requested a history yank.")
  183.  
  184. (defvar shell-history-ring-position 0
  185.   "Index of the last yank -- for use when doing sequential yanks.")
  186.  
  187. (defun mod+1 (value ring-size)
  188.   (1+ (% (+ ring-size value -2) (1- ring-size))))
  189.  
  190. ;;; Get next string from the-ring which matches substring.  Throws the
  191. ;;; value of forward-p to 'no-history tag if it reaches the end
  192. ;;; (beginning) of the ring.
  193. (defun shell-next-history-string
  194.     (the-ring substring forward-p &optional first-yank-p)
  195.   (let ((incr (if forward-p 1 -1))
  196.     (length (length the-ring))
  197.     history-entry)
  198.     (if first-yank-p (setq shell-history-ring-position (aref the-ring 0)))
  199.     (if (and forward-p (= shell-history-ring-position (aref the-ring 0)))
  200.     (throw 'no-history forward-p))
  201.     (setq shell-history-ring-position
  202.       (mod+1 (+ shell-history-ring-position incr) length))
  203.     (if (= shell-history-ring-position (aref the-ring 0))
  204.     (throw 'no-history forward-p))
  205.     (setq history-entry (aref the-ring shell-history-ring-position))
  206.     (while (or (null history-entry)
  207.            (not (eq 0 (string-match (regexp-quote substring) history-entry))))
  208.       (setq shell-history-ring-position
  209.         (mod+1 (+ shell-history-ring-position incr) length))
  210.       (if (= shell-history-ring-position (aref the-ring 0))
  211.       (throw 'no-history forward-p))
  212.       (setq history-entry (aref the-ring shell-history-ring-position)))
  213.     history-entry))
  214.  
  215.