e690005aa8e86e7d28d32b8de3d15150c3826eee
[ghc-hetmet.git] / ghc / CONTRIB / haskell-modes / yale / original / comint.el
1 ;;; -*-Emacs-Lisp-*- General command interpreter in a window stuff
2 ;;; Copyright Olin Shivers (1988).
3 ;;; Please imagine a long, tedious, legalistic 5-page gnu-style copyright
4 ;;; notice appearing here to the effect that you may use this code any
5 ;;; way you like, as long as you don't charge money for it, remove this
6 ;;; notice, or hold me liable for its results.
7
8 ;;; The changelog is at the end of this file.
9
10 ;;; Please send me bug reports, bug fixes, and extensions, so that I can
11 ;;; merge them into the master source.
12 ;;;     - Olin Shivers (shivers@cs.cmu.edu)
13
14 ;;; This hopefully generalises shell mode, lisp mode, tea mode, soar mode,...
15 ;;; This file defines a general command-interpreter-in-a-buffer package
16 ;;; (comint mode). The idea is that you can build specific process-in-a-buffer
17 ;;; modes on top of comint mode -- e.g., lisp, shell, scheme, T, soar, ....
18 ;;; This way, all these specific packages share a common base functionality, 
19 ;;; and a common set of bindings, which makes them easier to use (and
20 ;;; saves code, implementation time, etc., etc.).
21
22 ;;; Several packages are already defined using comint mode:
23 ;;; - cmushell.el defines a shell-in-a-buffer mode.
24 ;;; - cmulisp.el defines a simple lisp-in-a-buffer mode.
25 ;;; Cmushell and cmulisp mode are similar to, and intended to replace,
26 ;;; their counterparts in the standard gnu emacs release (in shell.el). 
27 ;;; These replacements are more featureful, robust, and uniform than the 
28 ;;; released versions. The key bindings in lisp mode are also more compatible
29 ;;; with the bindings of Hemlock and Zwei (the Lisp Machine emacs).
30 ;;;
31 ;;; - The file cmuscheme.el defines a scheme-in-a-buffer mode.
32 ;;; - The file tea.el tunes scheme and inferior-scheme modes for T.
33 ;;; - The file soar.el tunes lisp and inferior-lisp modes for Soar.
34 ;;; - cmutex.el defines tex and latex modes that invoke tex, latex, bibtex,
35 ;;;   previewers, and printers from within emacs.
36 ;;; - background.el allows csh-like job control inside emacs.
37 ;;; It is pretty easy to make new derived modes for other processes.
38
39 ;;; For documentation on the functionality provided by comint mode, and
40 ;;; the hooks available for customising it, see the comments below.
41 ;;; For further information on the standard derived modes (shell, 
42 ;;; inferior-lisp, inferior-scheme, ...), see the relevant source files.
43
44 ;;; For hints on converting existing process modes (e.g., tex-mode,
45 ;;; background, dbx, gdb, kermit, prolog, telnet) to use comint-mode
46 ;;; instead of shell-mode, see the notes at the end of this file.
47
48 (provide 'comint)
49 (defconst comint-version "2.01")
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71 ;;; Brief Command Documentation:
72 ;;;============================================================================
73 ;;; Comint Mode Commands: (common to all derived modes, like cmushell & cmulisp
74 ;;; mode)
75 ;;;
76 ;;; m-p     comint-previous-input           Cycle backwards in input history
77 ;;; m-n     comint-next-input               Cycle forwards
78 ;;; m-s     comint-previous-similar-input   Previous similar input
79 ;;; c-c r   comint-previous-input-matching  Search backwards in input history
80 ;;; return  comint-send-input
81 ;;; c-a     comint-bol                      Beginning of line; skip prompt.
82 ;;; c-d     comint-delchar-or-maybe-eof     Delete char unless at end of buff.
83 ;;; c-c c-u comint-kill-input               ^u
84 ;;; c-c c-w backward-kill-word              ^w
85 ;;; c-c c-c comint-interrupt-subjob         ^c
86 ;;; c-c c-z comint-stop-subjob              ^z
87 ;;; c-c c-\ comint-quit-subjob              ^\
88 ;;; c-c c-o comint-kill-output              Delete last batch of process output
89 ;;; c-c c-r comint-show-output              Show last batch of process output
90 ;;;
91 ;;; Not bound by default in comint-mode
92 ;;; send-invisible                      Read a line w/o echo, and send to proc
93 ;;; (These are bound in shell-mode)
94 ;;; comint-dynamic-complete             Complete filename at point.
95 ;;; comint-dynamic-list-completions     List completions in help buffer.
96 ;;; comint-replace-by-expanded-filename Expand and complete filename at point;
97 ;;;                                     replace with expanded/completed name.
98 ;;; comint-kill-subjob                  No mercy.
99 ;;; comint-continue-subjob              Send CONT signal to buffer's process
100 ;;;                                     group. Useful if you accidentally
101 ;;;                                     suspend your process (with C-c C-z).
102 ;;;
103 ;;; Bound for RMS -- I prefer the input history stuff, but you might like 'em.
104 ;;; m-P    comint-msearch-input         Search backwards for prompt
105 ;;; m-N    comint-psearch-input         Search forwards for prompt
106 ;;; C-cR   comint-msearch-input-matching Search backwards for prompt & string
107
108 ;;; comint-mode-hook is the comint mode hook. Basically for your keybindings.
109 ;;; comint-load-hook is run after loading in this package.
110
111
112
113
114
115 ;;; Buffer Local Variables:
116 ;;;============================================================================
117 ;;; Comint mode buffer local variables:
118 ;;;     comint-prompt-regexp    - string       comint-bol uses to match prompt.
119 ;;;     comint-last-input-end   - marker       For comint-kill-output command
120 ;;;     input-ring-size         - integer      For the input history
121 ;;;     input-ring              - ring             mechanism
122 ;;;     input-ring-index        - marker           ...
123 ;;;     comint-last-input-match - string           ...
124 ;;;     comint-get-old-input    - function     Hooks for specific 
125 ;;;     comint-input-sentinel   - function         process-in-a-buffer
126 ;;;     comint-input-filter     - function         modes.
127 ;;;     comint-input-send       - function
128 ;;;     comint-eol-on-send      - boolean
129
130 (defvar comint-prompt-regexp "^"
131   "Regexp to recognise prompts in the inferior process.
132 Defaults to \"^\", the null string at BOL.
133
134 Good choices:
135   Canonical Lisp: \"^[^> ]*>+:? *\" (Lucid, franz, kcl, T, cscheme, oaklisp)
136   Lucid Common Lisp: \"^\\(>\\|\\(->\\)+\\) *\"
137   franz: \"^\\(->\\|<[0-9]*>:\\) *\"
138   kcl: \"^>+ *\"
139   shell: \"^[^#$%>]*[#$%>] *\"
140   T: \"^>+ *\"
141
142 This is a good thing to set in mode hooks.")
143
144 (defvar input-ring-size 30
145   "Size of input history ring.")
146
147 ;;; Here are the per-interpreter hooks.
148 (defvar comint-get-old-input (function comint-get-old-input-default)
149   "Function that submits old text in comint mode.
150 This function is called when return is typed while the point is in old text.
151 It returns the text to be submitted as process input.  The default is
152 comint-get-old-input-default, which grabs the current line, and strips off
153 leading text matching comint-prompt-regexp")
154
155 (defvar comint-input-sentinel (function ignore)
156   "Called on each input submitted to comint mode process by comint-send-input.
157 Thus it can, for instance, track cd/pushd/popd commands issued to the csh.")
158
159 (defvar comint-input-filter
160   (function (lambda (str) (not (string-match "\\`\\s *\\'" str))))
161   "Predicate for filtering additions to input history.
162 Only inputs answering true to this function are saved on the input
163 history list. Default is to save anything that isn't all whitespace")
164
165 (defvar comint-input-sender (function comint-simple-send)
166   "Function to actually send to PROCESS the STRING submitted by user.
167 Usually this is just 'comint-simple-send, but if your mode needs to 
168 massage the input string, this is your hook. This is called from
169 the user command comint-send-input. comint-simple-send just sends
170 the string plus a newline.")
171
172 (defvar comint-eol-on-send 'T
173   "If non-nil, then jump to the end of the line before sending input to process.
174 See COMINT-SEND-INPUT")
175
176 (defvar comint-mode-hook '()
177   "Called upon entry into comint-mode")
178
179 (defvar comint-mode-map nil)
180
181 (defun comint-mode ()
182   "Major mode for interacting with an inferior interpreter.
183 Interpreter name is same as buffer name, sans the asterisks.
184 Return at end of buffer sends line as input.
185 Return not at end copies rest of line to end and sends it.
186 Setting mode variable comint-eol-on-send means jump to the end of the line
187 before submitting new input.
188
189 This mode is typically customised to create inferior-lisp-mode,
190 shell-mode, etc.. This can be done by setting the hooks
191 comint-input-sentinel, comint-input-filter, comint-input-sender and
192 comint-get-old-input to appropriate functions, and the variable
193 comint-prompt-regexp to the appropriate regular expression.
194
195 An input history is maintained of size input-ring-size, and
196 can be accessed with the commands comint-next-input [\\[comint-next-input]] and 
197 comint-previous-input [\\[comint-previous-input]]. Commands not keybound by
198 default are send-invisible, comint-dynamic-complete, and 
199 comint-list-dynamic-completions.
200
201 If you accidentally suspend your process, use \\[comint-continue-subjob]
202 to continue it.
203
204 \\{comint-mode-map}
205
206 Entry to this mode runs the hooks on comint-mode-hook"
207   (interactive)
208   (let ((old-ring (and (assq 'input-ring (buffer-local-variables))
209                        (boundp 'input-ring)
210                        input-ring))
211         (old-ptyp comint-ptyp)) ; preserve across local var kill. gross.
212     (kill-all-local-variables)
213     (setq major-mode 'comint-mode)
214     (setq mode-name "Comint")
215     (setq mode-line-process '(": %s"))
216     (use-local-map comint-mode-map)
217     (make-local-variable 'comint-last-input-end)
218     (setq comint-last-input-end (make-marker))
219     (make-local-variable 'comint-last-input-match)
220     (setq comint-last-input-match "")
221     (make-local-variable 'comint-prompt-regexp) ; Don't set; default
222     (make-local-variable 'input-ring-size)      ; ...to global val.
223     (make-local-variable 'input-ring)
224     (make-local-variable 'input-ring-index)
225     (setq input-ring-index 0)
226     (make-local-variable 'comint-get-old-input)
227     (make-local-variable 'comint-input-sentinel)
228     (make-local-variable 'comint-input-filter)  
229     (make-local-variable 'comint-input-sender)
230     (make-local-variable 'comint-eol-on-send)
231     (make-local-variable 'comint-ptyp)
232     (setq comint-ptyp old-ptyp)
233     (run-hooks 'comint-mode-hook)
234     ;Do this after the hook so the user can mung INPUT-RING-SIZE w/his hook.
235     ;The test is so we don't lose history if we run comint-mode twice in
236     ;a buffer.
237     (setq input-ring (if (ring-p old-ring) old-ring
238                          (make-ring input-ring-size)))))
239
240 ;;; The old-ptyp stuff above is because we have to preserve the value of
241 ;;; comint-ptyp across calls to comint-mode, in spite of the
242 ;;; kill-all-local-variables that it does. Blech. Hopefully, this will all
243 ;;; go away when a later release fixes the signalling bug.
244
245 (if comint-mode-map
246     nil
247   (setq comint-mode-map (make-sparse-keymap))
248   (define-key comint-mode-map "\ep" 'comint-previous-input)
249   (define-key comint-mode-map "\en" 'comint-next-input)
250   (define-key comint-mode-map "\es" 'comint-previous-similar-input)
251   (define-key comint-mode-map "\C-m" 'comint-send-input)
252   (define-key comint-mode-map "\C-d" 'comint-delchar-or-maybe-eof)
253   (define-key comint-mode-map "\C-a" 'comint-bol)
254   (define-key comint-mode-map "\C-c\C-u" 'comint-kill-input)
255   (define-key comint-mode-map "\C-c\C-w" 'backward-kill-word)
256   (define-key comint-mode-map "\C-c\C-c" 'comint-interrupt-subjob)
257   (define-key comint-mode-map "\C-c\C-z" 'comint-stop-subjob)
258   (define-key comint-mode-map "\C-c\C-\\" 'comint-quit-subjob)
259   (define-key comint-mode-map "\C-c\C-o" 'comint-kill-output)
260   (define-key comint-mode-map "\C-cr"    'comint-previous-input-matching)
261   (define-key comint-mode-map "\C-c\C-r" 'comint-show-output)
262   ;;; Here's the prompt-search stuff I installed for RMS to try...
263   (define-key comint-mode-map "\eP" 'comint-msearch-input)
264   (define-key comint-mode-map "\eN" 'comint-psearch-input)
265   (define-key comint-mode-map "\C-cR" 'comint-msearch-input-matching))
266
267
268 ;;; This function is used to make a full copy of the comint mode map,
269 ;;; so that client modes won't interfere with each other. This function
270 ;;; isn't necessary in emacs 18.5x, but we keep it around for 18.4x versions.
271 (defun full-copy-sparse-keymap (km)
272   "Recursively copy the sparse keymap KM"
273   (cond ((consp km)
274          (cons (full-copy-sparse-keymap (car km))
275                (full-copy-sparse-keymap (cdr km))))
276         (t km)))
277
278 (defun comint-check-proc (buffer-name)
279   "True if there is a process associated w/buffer BUFFER-NAME, and
280 it is alive (status RUN or STOP)."
281   (let ((proc (get-buffer-process buffer-name)))
282     (and proc (memq (process-status proc) '(run stop)))))
283
284 ;;; Note that this guy, unlike shell.el's make-shell, barfs if you pass it ()
285 ;;; for the second argument (program).
286 (defun make-comint (name program &optional startfile &rest switches)
287   (let* ((buffer (get-buffer-create (concat "*" name "*")))
288          (proc (get-buffer-process buffer)))
289     ;; If no process, or nuked process, crank up a new one and put buffer in
290     ;; comint mode. Otherwise, leave buffer and existing process alone.
291     (cond ((or (not proc) (not (memq (process-status proc) '(run stop))))
292            (save-excursion
293              (set-buffer buffer)
294              (comint-mode)) ; Install local vars, mode, keymap, ...
295            (comint-exec buffer name program startfile switches)))
296     buffer))
297
298 (defvar comint-ptyp t
299   "True if communications via pty; false if by pipe. Buffer local.
300 This is to work around a bug in emacs process signalling.")
301
302 (defun comint-exec (buffer name command startfile switches)
303   "Fires up a process in buffer for comint modes.
304 Blasts any old process running in the buffer. Doesn't set the buffer mode.
305 You can use this to cheaply run a series of processes in the same comint
306 buffer."
307   (save-excursion
308     (set-buffer buffer)
309     (let ((proc (get-buffer-process buffer)))   ; Blast any old process.
310       (if proc (delete-process proc)))
311     ;; Crank up a new process
312     (let ((proc (comint-exec-1 name buffer command switches)))
313       (make-local-variable 'comint-ptyp)
314       (setq comint-ptyp process-connection-type) ; T if pty, NIL if pipe.
315       ;; Jump to the end, and set the process mark.
316       (goto-char (point-max))
317       (set-marker (process-mark proc) (point)))
318       ;; Feed it the startfile.
319       (cond (startfile
320              ;;This is guaranteed to wait long enough
321              ;;but has bad results if the comint does not prompt at all
322              ;;      (while (= size (buffer-size))
323              ;;        (sleep-for 1))
324              ;;I hope 1 second is enough!
325              (sleep-for 1)
326              (goto-char (point-max))
327              (insert-file-contents startfile)
328              (setq startfile (buffer-substring (point) (point-max)))
329              (delete-region (point) (point-max))
330              (comint-send-string proc startfile)))
331     buffer))
332
333 ;;; This auxiliary function cranks up the process for comint-exec in
334 ;;; the appropriate environment. It is twice as long as it should be
335 ;;; because emacs has two distinct mechanisms for manipulating the
336 ;;; process environment, selected at compile time with the
337 ;;; MAINTAIN-ENVIRONMENT #define. In one case, process-environment
338 ;;; is bound; in the other it isn't.
339
340 (defun comint-exec-1 (name buffer command switches)
341   (if (boundp 'process-environment) ; Not a completely reliable test.
342       (let ((process-environment
343              (comint-update-env process-environment
344                                 (list (format "TERMCAP=emacs:co#%d:tc=unknown"
345                                               (screen-width))
346                                       "TERM=emacs"
347                                       "EMACS=t"))))
348         (apply 'start-process name buffer command switches))
349
350       (let ((tcapv (getenv "TERMCAP"))
351             (termv (getenv "TERM"))
352             (emv   (getenv "EMACS")))
353         (unwind-protect
354              (progn (setenv "TERMCAP" (format "emacs:co#%d:tc=unknown"
355                                               (screen-width)))
356                     (setenv "TERM" "emacs")
357                     (setenv "EMACS" "t")
358                     (apply 'start-process name buffer command switches))
359           (setenv "TERMCAP" tcapv)
360           (setenv "TERM"    termv)
361           (setenv "EMACS"   emv)))))
362              
363
364
365 ;; This is just (append new old-env) that compresses out shadowed entries.
366 ;; It's also pretty ugly, mostly due to elisp's horrible iteration structures.
367 (defun comint-update-env (old-env new)
368   (let ((ans (reverse new))
369         (vars (mapcar (function (lambda (vv)
370                         (and (string-match "^[^=]*=" vv)
371                              (substring vv 0 (match-end 0)))))
372                       new)))
373     (while old-env
374       (let* ((vv (car old-env)) ; vv is var=value
375              (var (and (string-match "^[^=]*=" vv)
376                        (substring vv 0 (match-end 0)))))
377         (setq old-env (cdr old-env))
378         (cond ((not (and var (comint-mem var vars)))
379                (if var (setq var (cons var vars)))
380                (setq ans (cons vv ans))))))
381     (nreverse ans)))
382
383 ;;; This should be in emacs, but it isn't.
384 (defun comint-mem (item list &optional elt=)
385   "Test to see if ITEM is equal to an item in LIST.
386 Option comparison function ELT= defaults to equal."
387   (let ((elt= (or elt= (function equal)))
388         (done nil))
389     (while (and list (not done))
390       (if (funcall elt= item (car list))
391           (setq done list)
392           (setq list (cdr list))))
393     done))
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423 ;;; Ring Code
424 ;;;============================================================================
425 ;;; This code defines a ring data structure. A ring is a 
426 ;;;     (hd-index tl-index . vector) 
427 ;;; list. You can insert to, remove from, and rotate a ring. When the ring
428 ;;; fills up, insertions cause the oldest elts to be quietly dropped.
429 ;;;
430 ;;; HEAD = index of the newest item on the ring.
431 ;;; TAIL = index of the oldest item on the ring.
432 ;;;
433 ;;; These functions are used by the input history mechanism, but they can
434 ;;; be used for other purposes as well.
435
436 (defun ring-p (x) 
437   "T if X is a ring; NIL otherwise."
438   (and (consp x) (integerp (car x))
439        (consp (cdr x)) (integerp (car (cdr x)))
440        (vectorp (cdr (cdr x)))))
441
442 (defun make-ring (size)
443   "Make a ring that can contain SIZE elts"
444   (cons 1 (cons 0 (make-vector (+ size 1) nil))))
445
446 (defun ring-plus1 (index veclen)
447   "INDEX+1, with wraparound"
448   (let ((new-index (+ index 1)))
449     (if (= new-index veclen) 0 new-index)))
450
451 (defun ring-minus1 (index veclen)
452   "INDEX-1, with wraparound"
453   (- (if (= 0 index) veclen index) 1))
454
455 (defun ring-length (ring)
456   "Number of elts in the ring."
457   (let ((hd (car ring)) (tl (car (cdr ring)))  (siz (length (cdr (cdr ring)))))
458     (let ((len (if (<= hd tl) (+ 1 (- tl hd)) (+ 1 tl (- siz hd)))))
459       (if (= len siz) 0 len))))
460
461 (defun ring-empty-p (ring)
462   (= 0 (ring-length ring)))
463
464 (defun ring-insert (ring item)
465   "Insert a new item onto the ring. If the ring is full, dump the oldest
466 item to make room."       
467   (let* ((vec (cdr (cdr ring)))  (len (length vec))
468          (new-hd (ring-minus1 (car ring) len)))
469       (setcar ring new-hd)
470       (aset vec new-hd item)
471       (if (ring-empty-p ring) ;overflow -- dump one off the tail.
472           (setcar (cdr ring) (ring-minus1 (car (cdr ring)) len)))))
473
474 (defun ring-remove (ring)
475   "Remove the oldest item retained on the ring."
476   (if (ring-empty-p ring) (error "Ring empty")
477       (let ((tl (car (cdr ring)))  (vec (cdr (cdr ring))))
478         (set-car (cdr ring) (ring-minus1 tl (length vec)))
479         (aref vec tl))))
480
481 ;;; This isn't actually used in this package. I just threw it in in case
482 ;;; someone else wanted it. If you want rotating-ring behavior on your history
483 ;;; retrieval (analagous to kill ring behavior), this function is what you
484 ;;; need. I should write the yank-input and yank-pop-input-or-kill to go with
485 ;;; this, and not bind it to a key by default, so it would be available to
486 ;;; people who want to bind it to a key. But who would want it? Blech.
487 (defun ring-rotate (ring n)
488   (if (not (= n 0))
489       (if (ring-empty-p ring) ;Is this the right error check?
490           (error "ring empty")
491           (let ((hd (car ring))  (tl (car (cdr ring)))  (vec (cdr (cdr ring))))
492             (let ((len (length vec)))
493               (while (> n 0)
494                 (setq tl (ring-plus1 tl len))
495                 (aset ring tl (aref ring hd))
496                 (setq hd (ring-plus1 hd len))
497                 (setq n (- n 1)))
498               (while (< n 0)
499                 (setq hd (ring-minus1 hd len))
500                 (aset vec hd (aref vec tl))
501                 (setq tl (ring-minus1 tl len))
502                 (setq n (- n 1))))
503             (set-car ring hd)
504             (set-car (cdr ring) tl)))))
505
506 (defun comint-mod (n m)
507   "Returns N mod M. M is positive. Answer is guaranteed to be non-negative, 
508 and less than m."
509   (let ((n (% n m)))
510     (if (>= n 0) n
511         (+ n
512            (if (>= m 0) m (- m)))))) ; (abs m)
513
514 (defun ring-ref (ring index)
515   (let ((numelts (ring-length ring)))
516     (if (= numelts 0) (error "indexed empty ring")
517         (let* ((hd (car ring))  (tl (car (cdr ring)))  (vec (cdr (cdr ring)))
518                (index (comint-mod index numelts))
519                (vec-index (comint-mod (+ index hd) 
520                                       (length vec))))
521           (aref vec vec-index)))))
522
523
524 ;;; Input history retrieval commands
525 ;;; M-p -- previous input    M-n -- next input
526 ;;; C-c r -- previous input matching
527 ;;; ===========================================================================
528
529 (defun comint-previous-input (arg)
530   "Cycle backwards through input history."
531   (interactive "*p")
532   (let ((len (ring-length input-ring)))
533     (cond ((<= len 0)
534            (message "Empty input ring")
535            (ding))
536           ((not (comint-after-pmark-p))
537            (message "Not after process mark")
538            (ding))
539           (t
540            (cond ((eq last-command 'comint-previous-input)
541                   (delete-region (mark) (point)))
542                  ((eq last-command 'comint-previous-similar-input)
543                   (delete-region 
544                    (process-mark (get-buffer-process (current-buffer)))
545                    (point)))
546                  (t                          
547                   (setq input-ring-index
548                         (if (> arg 0) -1
549                             (if (< arg 0) 1 0)))
550                   (push-mark (point))))
551            (setq input-ring-index (comint-mod (+ input-ring-index arg) len))
552            (message "%d" (1+ input-ring-index))
553            (insert (ring-ref input-ring input-ring-index))
554            (setq this-command 'comint-previous-input)))))
555          
556 (defun comint-next-input (arg)
557   "Cycle forwards through input history."
558   (interactive "*p")
559   (comint-previous-input (- arg)))
560
561 (defvar comint-last-input-match ""
562   "Last string searched for by comint input history search, for defaulting.
563 Buffer local variable.") 
564
565 (defun comint-previous-input-matching (str)
566   "Searches backwards through input history for substring match."
567   (interactive (let* ((last-command last-command) ; preserve around r-f-m
568                       (s (read-from-minibuffer 
569                          (format "Command substring (default %s): "
570                                  comint-last-input-match))))
571                  (list (if (string= s "") comint-last-input-match s))))
572 ; (interactive "sCommand substring: ")
573   (setq comint-last-input-match str) ; update default
574   (if (not (eq last-command 'comint-previous-input))
575       (setq input-ring-index -1))
576   (let ((str (regexp-quote str))
577         (len (ring-length input-ring))
578         (n (+ input-ring-index 1)))
579     (while (and (< n len) (not (string-match str (ring-ref input-ring n))))
580       (setq n (+ n 1)))
581     (cond ((< n len)
582            (comint-previous-input (- n input-ring-index)))
583           (t (if (eq last-command 'comint-previous-input) 
584                  (setq this-command 'comint-previous-input))
585              (message "Not found.")
586              (ding)))))
587
588
589 ;;; These next three commands are alternatives to the input history commands --
590 ;;; comint-next-input, comint-previous-input and 
591 ;;; comint-previous-input-matching. They search through the process buffer
592 ;;; text looking for occurrences of the prompt. RMS likes them better;
593 ;;; I don't. Bound to M-P, M-N, and C-c R (uppercase P, N, and R) for
594 ;;; now. Try'em out. Go with what you like...
595
596 ;;; comint-msearch-input-matching prompts for a string, not a regexp.
597 ;;; This could be considered to be the wrong thing. I decided to keep it
598 ;;; simple, and not make the user worry about regexps. This, of course,
599 ;;; limits functionality.
600
601 (defun comint-psearch-input ()
602   "Search forwards for next occurrence of prompt and skip to end of line.
603 \(prompt is anything matching regexp comint-prompt-regexp)"
604   (interactive)
605   (if (re-search-forward comint-prompt-regexp (point-max) t)
606       (end-of-line)
607       (error "No occurrence of prompt found")))
608
609 (defun comint-msearch-input ()
610   "Search backwards for previous occurrence of prompt and skip to end of line.
611 Search starts from beginning of current line."
612   (interactive)
613   (let ((p (save-excursion
614              (beginning-of-line)
615              (cond ((re-search-backward comint-prompt-regexp (point-min) t)
616                     (end-of-line)
617                     (point))
618                    (t nil)))))
619     (if p (goto-char p)
620         (error "No occurrence of prompt found"))))
621
622 (defun comint-msearch-input-matching (str)
623   "Search backwards for occurrence of prompt followed by STRING.
624 STRING is prompted for, and is NOT a regular expression."
625   (interactive (let ((s (read-from-minibuffer 
626                          (format "Command (default %s): "
627                                  comint-last-input-match))))
628                  (list (if (string= s "") comint-last-input-match s))))
629 ; (interactive "sCommand: ")
630   (setq comint-last-input-match str) ; update default
631   (let* ((r (concat comint-prompt-regexp (regexp-quote str)))
632          (p (save-excursion
633               (beginning-of-line)
634               (cond ((re-search-backward r (point-min) t)
635                      (end-of-line)
636                      (point))
637                     (t nil)))))
638     (if p (goto-char p)
639         (error "No match"))))
640
641 ;;;
642 ;;; Similar input -- contributed by ccm and highly winning.
643 ;;;
644 ;;; Reenter input, removing back to the last insert point if it exists. 
645 ;;;
646 (defvar comint-last-similar-string "" 
647   "The string last used in a similar string search.")
648 (defun comint-previous-similar-input (arg)
649   "Reenters the last input that matches the string typed so far.  If repeated 
650 successively older inputs are reentered.  If arg is 1, it will go back
651 in the history, if -1 it will go forward."
652   (interactive "p")
653   (if (not (comint-after-pmark-p))
654       (error "Not after process mark"))
655   (if (not (eq last-command 'comint-previous-similar-input))
656       (setq input-ring-index -1
657             comint-last-similar-string 
658             (buffer-substring 
659              (process-mark (get-buffer-process (current-buffer)))
660              (point))))
661   (let* ((size (length comint-last-similar-string))
662          (len (ring-length input-ring))
663          (n (+ input-ring-index arg))
664          entry)
665     (while (and (< n len) 
666                 (or (< (length (setq entry (ring-ref input-ring n))) size)
667                     (not (equal comint-last-similar-string 
668                                 (substring entry 0 size)))))
669       (setq n (+ n arg)))
670     (cond ((< n len)
671            (setq input-ring-index n)
672            (if (eq last-command 'comint-previous-similar-input)
673                (delete-region (mark) (point)) ; repeat
674                (push-mark (point)))           ; 1st time
675            (insert (substring entry size)))
676           (t (message "Not found.") (ding) (sit-for 1)))
677     (message "%d" (1+ input-ring-index))))
678
679
680
681
682
683
684
685
686
687 (defun comint-send-input () 
688   "Send input to process.  After the process output mark, sends all text
689 from the process mark to point as input to the process.  Before the
690 process output mark, calls value of variable comint-get-old-input to retrieve
691 old input, copies it to the end of the buffer, and sends it.  A terminal
692 newline is also inserted into the buffer and sent to the process.  In either
693 case, value of variable comint-input-sentinel is called on the input before
694 sending it.  The input is entered into the input history ring, if value of
695 variable comint-input-filter returns non-nil when called on the input.
696
697 If variable comint-eol-on-send is non-nil, then point is moved to the end of
698 line before sending the input.
699
700 comint-get-old-input, comint-input-sentinel, and comint-input-filter are chosen
701 according to the command interpreter running in the buffer. E.g.,
702 If the interpreter is the csh,
703     comint-get-old-input is the default: take the current line, discard any
704         initial string matching regexp comint-prompt-regexp.
705     comint-input-sentinel monitors input for \"cd\", \"pushd\", and \"popd\" 
706         commands. When it sees one, it cd's the buffer.
707     comint-input-filter is the default: returns T if the input isn't all white
708         space.
709
710 If the comint is Lucid Common Lisp, 
711     comint-get-old-input snarfs the sexp ending at point.
712     comint-input-sentinel does nothing.
713     comint-input-filter returns NIL if the input matches input-filter-regexp,
714         which matches (1) all whitespace (2) :a, :c, etc.
715
716 Similarly for Soar, Scheme, etc.."
717   (interactive)
718   ;; Note that the input string does not include its terminal newline.
719   (let ((proc (get-buffer-process (current-buffer))))
720     (if (not proc) (error "Current buffer has no process")
721         (let* ((pmark (process-mark proc))
722                (pmark-val (marker-position pmark))
723                (input (if (>= (point) pmark-val)
724                           (progn (if comint-eol-on-send (end-of-line))
725                                  (buffer-substring pmark (point)))
726                           (let ((copy (funcall comint-get-old-input)))
727                             (goto-char pmark)
728                             (insert copy)
729                             copy))))
730           (insert ?\n)
731           (if (funcall comint-input-filter input) (ring-insert input-ring input))
732           (funcall comint-input-sentinel input)
733           (funcall comint-input-sender proc input)
734           (set-marker (process-mark proc) (point))
735           (set-marker comint-last-input-end (point))))))
736
737 (defun comint-get-old-input-default ()
738   "Default for comint-get-old-input: take the current line, and discard
739 any initial text matching comint-prompt-regexp."
740   (save-excursion
741     (beginning-of-line)
742     (comint-skip-prompt)
743     (let ((beg (point)))
744       (end-of-line)
745       (buffer-substring beg (point)))))
746
747 (defun comint-skip-prompt ()
748   "Skip past the text matching regexp comint-prompt-regexp. 
749 If this takes us past the end of the current line, don't skip at all."
750   (let ((eol (save-excursion (end-of-line) (point))))
751     (if (and (looking-at comint-prompt-regexp)
752              (<= (match-end 0) eol))
753         (goto-char (match-end 0)))))
754
755
756 (defun comint-after-pmark-p ()
757   "Is point after the process output marker?"
758   ;; Since output could come into the buffer after we looked at the point
759   ;; but before we looked at the process marker's value, we explicitly 
760   ;; serialise. This is just because I don't know whether or not emacs
761   ;; services input during execution of lisp commands.
762   (let ((proc-pos (marker-position
763                    (process-mark (get-buffer-process (current-buffer))))))
764     (<= proc-pos (point))))
765
766 (defun comint-simple-send (proc string)
767   "Default function for sending to PROC input STRING.
768 This just sends STRING plus a newline. To override this,
769 set the hook COMINT-INPUT-SENDER."
770   (comint-send-string proc string)
771   (comint-send-string proc "\n"))
772
773 (defun comint-bol (arg)
774   "Goes to the beginning of line, then skips past the prompt, if any.
775 If a prefix argument is given (\\[universal-argument]), then no prompt skip 
776 -- go straight to column 0.
777
778 The prompt skip is done by skipping text matching the regular expression
779 comint-prompt-regexp, a buffer local variable.
780
781 If you don't like this command, reset c-a to beginning-of-line 
782 in your hook, comint-mode-hook."
783   (interactive "P")
784   (beginning-of-line)
785   (if (null arg) (comint-skip-prompt)))
786
787 ;;; These two functions are for entering text you don't want echoed or
788 ;;; saved -- typically passwords to ftp, telnet, or somesuch.
789 ;;; Just enter m-x send-invisible and type in your line.
790
791 (defun comint-read-noecho (prompt)
792   "Prompt the user with argument PROMPT. Read a single line of text
793 without echoing, and return it. Note that the keystrokes comprising
794 the text can still be recovered (temporarily) with \\[view-lossage]. This
795 may be a security bug for some applications."
796   (let ((echo-keystrokes 0)
797         (answ "")
798         tem)
799     (if (and (stringp prompt) (not (string= (message prompt) "")))
800         (message prompt))
801     (while (not(or  (= (setq tem (read-char)) ?\^m)
802                     (= tem ?\n)))
803       (setq answ (concat answ (char-to-string tem))))
804     (message "")
805     answ))
806
807 (defun send-invisible (str)
808   "Read a string without echoing, and send it to the process running
809 in the current buffer. A new-line is additionally sent. String is not 
810 saved on comint input history list.
811 Security bug: your string can still be temporarily recovered with
812 \\[view-lossage]."
813 ; (interactive (list (comint-read-noecho "Enter non-echoed text")))
814   (interactive "P") ; Defeat snooping via C-x esc
815   (let ((proc (get-buffer-process (current-buffer))))
816     (if (not proc) (error "Current buffer has no process")
817         (comint-send-string proc
818                             (if (stringp str) str
819                                 (comint-read-noecho "Enter non-echoed text")))
820         (comint-send-string proc "\n"))))
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863 ;;; Low-level process communication
864
865 (defvar comint-input-chunk-size 512
866   "*Long inputs send to comint processes are broken up into chunks of this size.
867 If your process is choking on big inputs, try lowering the value.")
868
869 (defun comint-send-string (proc str)
870   "Send PROCESS the contents of STRING as input.
871 This is equivalent to process-send-string, except that long input strings
872 are broken up into chunks of size comint-input-chunk-size. Processes
873 are given a chance to output between chunks. This can help prevent processes
874 from hanging when you send them long inputs on some OS's."
875   (let* ((len (length str))
876          (i (min len comint-input-chunk-size)))
877     (process-send-string proc (substring str 0 i))
878     (while (< i len)
879       (let ((next-i (+ i comint-input-chunk-size)))
880         (accept-process-output)
881         (process-send-string proc (substring str i (min len next-i)))
882         (setq i next-i)))))
883
884 (defun comint-send-region (proc start end)
885   "Sends to PROC the region delimited by START and END.
886 This is a replacement for process-send-region that tries to keep
887 your process from hanging on long inputs. See comint-send-string."
888   (comint-send-string proc (buffer-substring start end)))
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907 ;;; Random input hackage
908
909 (defun comint-kill-output ()
910   "Kill all output from interpreter since last input."
911   (interactive)
912   (let ((pmark (process-mark (get-buffer-process (current-buffer)))))
913     (kill-region comint-last-input-end pmark)
914     (goto-char pmark)    
915     (insert "*** output flushed ***\n")
916     (set-marker pmark (point))))
917
918 (defun comint-show-output ()
919   "Display start of this batch of interpreter output at top of window.
920 Also put cursor there."
921   (interactive)
922   (goto-char comint-last-input-end)
923   (backward-char)
924   (beginning-of-line)
925   (set-window-start (selected-window) (point))
926   (end-of-line))
927
928 (defun comint-interrupt-subjob ()
929   "Interrupt the current subjob."
930   (interactive)
931   (interrupt-process nil comint-ptyp))
932
933 (defun comint-kill-subjob ()
934   "Send kill signal to the current subjob."
935   (interactive)
936   (kill-process nil comint-ptyp))
937
938 (defun comint-quit-subjob ()
939   "Send quit signal to the current subjob."
940   (interactive)
941   (quit-process nil comint-ptyp))
942
943 (defun comint-stop-subjob ()
944   "Stop the current subjob.
945 WARNING: if there is no current subjob, you can end up suspending
946 the top-level process running in the buffer. If you accidentally do
947 this, use \\[comint-continue-subjob] to resume the process. (This
948 is not a problem with most shells, since they ignore this signal.)"
949   (interactive)
950   (stop-process nil comint-ptyp))
951
952 (defun comint-continue-subjob ()
953   "Send CONT signal to process buffer's process group.
954 Useful if you accidentally suspend the top-level process."
955   (interactive)
956   (continue-process nil comint-ptyp))
957
958 (defun comint-kill-input ()
959   "Kill all text from last stuff output by interpreter to point."
960   (interactive)
961   (let* ((pmark (process-mark (get-buffer-process (current-buffer))))
962          (p-pos (marker-position pmark)))
963     (if (> (point) p-pos)
964         (kill-region pmark (point)))))
965
966 (defun comint-delchar-or-maybe-eof (arg)
967   "Delete ARG characters forward, or send an EOF to process if at end of buffer."
968   (interactive "p")
969   (if (eobp)
970       (process-send-eof)
971       (delete-char arg)))
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995 ;;; Support for source-file processing commands.
996 ;;;============================================================================
997 ;;; Many command-interpreters (e.g., Lisp, Scheme, Soar) have
998 ;;; commands that process files of source text (e.g. loading or compiling
999 ;;; files). So the corresponding process-in-a-buffer modes have commands
1000 ;;; for doing this (e.g., lisp-load-file). The functions below are useful
1001 ;;; for defining these commands.
1002 ;;;
1003 ;;; Alas, these guys don't do exactly the right thing for Lisp, Scheme
1004 ;;; and Soar, in that they don't know anything about file extensions.
1005 ;;; So the compile/load interface gets the wrong default occasionally.
1006 ;;; The load-file/compile-file default mechanism could be smarter -- it
1007 ;;; doesn't know about the relationship between filename extensions and
1008 ;;; whether the file is source or executable. If you compile foo.lisp
1009 ;;; with compile-file, then the next load-file should use foo.bin for
1010 ;;; the default, not foo.lisp. This is tricky to do right, particularly
1011 ;;; because the extension for executable files varies so much (.o, .bin,
1012 ;;; .lbin, .mo, .vo, .ao, ...).
1013
1014
1015 ;;; COMINT-SOURCE-DEFAULT -- determines defaults for source-file processing
1016 ;;; commands.
1017 ;;;
1018 ;;; COMINT-CHECK-SOURCE -- if FNAME is in a modified buffer, asks you if you
1019 ;;; want to save the buffer before issuing any process requests to the command
1020 ;;; interpreter.
1021 ;;;
1022 ;;; COMINT-GET-SOURCE -- used by the source-file processing commands to prompt
1023 ;;; for the file to process.
1024
1025 ;;; (COMINT-SOURCE-DEFAULT previous-dir/file source-modes)
1026 ;;;============================================================================
1027 ;;; This function computes the defaults for the load-file and compile-file
1028 ;;; commands for tea, soar, cmulisp, and cmuscheme modes. 
1029 ;;; 
1030 ;;; - PREVIOUS-DIR/FILE is a pair (directory . filename) from the last 
1031 ;;; source-file processing command. NIL if there hasn't been one yet.
1032 ;;; - SOURCE-MODES is a list used to determine what buffers contain source
1033 ;;; files: if the major mode of the buffer is in SOURCE-MODES, it's source.
1034 ;;; Typically, (lisp-mode) or (scheme-mode).
1035 ;;; 
1036 ;;; If the command is given while the cursor is inside a string, *and*
1037 ;;; the string is an existing filename, *and* the filename is not a directory,
1038 ;;; then the string is taken as default. This allows you to just position
1039 ;;; your cursor over a string that's a filename and have it taken as default.
1040 ;;;
1041 ;;; If the command is given in a file buffer whose major mode is in
1042 ;;; SOURCE-MODES, then the the filename is the default file, and the
1043 ;;; file's directory is the default directory.
1044 ;;; 
1045 ;;; If the buffer isn't a source file buffer (e.g., it's the process buffer),
1046 ;;; then the default directory & file are what was used in the last source-file
1047 ;;; processing command (i.e., PREVIOUS-DIR/FILE).  If this is the first time
1048 ;;; the command has been run (PREVIOUS-DIR/FILE is nil), the default directory
1049 ;;; is the cwd, with no default file. (\"no default file\" = nil)
1050 ;;; 
1051 ;;; SOURCE-REGEXP is typically going to be something like (tea-mode)
1052 ;;; for T programs, (lisp-mode) for Lisp programs, (soar-mode lisp-mode)
1053 ;;; for Soar programs, etc.
1054 ;;; 
1055 ;;; The function returns a pair: (default-directory . default-file).
1056
1057 (defun comint-source-default (previous-dir/file source-modes)
1058   (cond ((and buffer-file-name (memq major-mode source-modes))
1059          (cons (file-name-directory    buffer-file-name)
1060                (file-name-nondirectory buffer-file-name)))
1061         (previous-dir/file)
1062         (t
1063          (cons default-directory nil))))
1064
1065
1066 ;;; (COMINT-CHECK-SOURCE fname)
1067 ;;;============================================================================
1068 ;;; Prior to loading or compiling (or otherwise processing) a file (in the CMU
1069 ;;; process-in-a-buffer modes), this function can be called on the filename.
1070 ;;; If the file is loaded into a buffer, and the buffer is modified, the user
1071 ;;; is queried to see if he wants to save the buffer before proceeding with
1072 ;;; the load or compile.
1073
1074 (defun comint-check-source (fname)
1075   (let ((buff (get-file-buffer fname)))
1076     (if (and buff
1077              (buffer-modified-p buff)
1078              (y-or-n-p (format "Save buffer %s first? "
1079                                (buffer-name buff))))
1080         ;; save BUFF.
1081         (let ((old-buffer (current-buffer)))
1082           (set-buffer buff)
1083           (save-buffer)
1084           (set-buffer old-buffer)))))
1085
1086
1087 ;;; (COMINT-GET-SOURCE prompt prev-dir/file source-modes mustmatch-p)
1088 ;;;============================================================================
1089 ;;; COMINT-GET-SOURCE is used to prompt for filenames in command-interpreter
1090 ;;; commands that process source files (like loading or compiling a file).
1091 ;;; It prompts for the filename, provides a default, if there is one,
1092 ;;; and returns the result filename.
1093 ;;; 
1094 ;;; See COMINT-SOURCE-DEFAULT for more on determining defaults.
1095 ;;; 
1096 ;;; PROMPT is the prompt string. PREV-DIR/FILE is the (directory . file) pair
1097 ;;; from the last source processing command.  SOURCE-MODES is a list of major
1098 ;;; modes used to determine what file buffers contain source files.  (These
1099 ;;; two arguments are used for determining defaults). If MUSTMATCH-P is true,
1100 ;;; then the filename reader will only accept a file that exists.
1101 ;;; 
1102 ;;; A typical use:
1103 ;;; (interactive (comint-get-source "Compile file: " prev-lisp-dir/file
1104 ;;;                                 '(lisp-mode) t))
1105
1106 ;;; This is pretty stupid about strings. It decides we're in a string
1107 ;;; if there's a quote on both sides of point on the current line.
1108 (defun comint-extract-string ()
1109   "Returns string around point that starts the current line or nil." 
1110   (save-excursion
1111     (let* ((point (point))
1112            (bol (progn (beginning-of-line) (point)))
1113            (eol (progn (end-of-line) (point)))
1114            (start (progn (goto-char point) 
1115                          (and (search-backward "\"" bol t) 
1116                               (1+ (point)))))
1117            (end (progn (goto-char point)
1118                        (and (search-forward "\"" eol t)
1119                             (1- (point))))))
1120       (and start end
1121            (buffer-substring start end)))))
1122
1123 (defun comint-get-source (prompt prev-dir/file source-modes mustmatch-p)
1124   (let* ((def (comint-source-default prev-dir/file source-modes))
1125          (stringfile (comint-extract-string))
1126          (sfile-p (and stringfile
1127                        (file-exists-p stringfile)
1128                        (not (file-directory-p stringfile))))
1129          (defdir  (if sfile-p (file-name-directory stringfile)
1130                       (car def)))
1131          (deffile (if sfile-p (file-name-nondirectory stringfile)
1132                       (cdr def)))
1133          (ans (read-file-name (if deffile (format "%s(default %s) "
1134                                                   prompt    deffile)
1135                                   prompt)
1136                               defdir
1137                               (concat defdir deffile)
1138                               mustmatch-p)))
1139     (list (expand-file-name (substitute-in-file-name ans)))))
1140
1141 ;;; I am somewhat divided on this string-default feature. It seems
1142 ;;; to violate the principle-of-least-astonishment, in that it makes
1143 ;;; the default harder to predict, so you actually have to look and see
1144 ;;; what the default really is before choosing it. This can trip you up.
1145 ;;; On the other hand, it can be useful, I guess. I would appreciate feedback
1146 ;;; on this.
1147 ;;;     -Olin
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171 ;;; Simple process query facility.
1172 ;;; ===========================================================================
1173 ;;; This function is for commands that want to send a query to the process
1174 ;;; and show the response to the user. For example, a command to get the
1175 ;;; arglist for a Common Lisp function might send a "(arglist 'foo)" query
1176 ;;; to an inferior Common Lisp process.
1177 ;;; 
1178 ;;; This simple facility just sends strings to the inferior process and pops
1179 ;;; up a window for the process buffer so you can see what the process
1180 ;;; responds with.  We don't do anything fancy like try to intercept what the
1181 ;;; process responds with and put it in a pop-up window or on the message
1182 ;;; line. We just display the buffer. Low tech. Simple. Works good.
1183
1184 ;;; Send to the inferior process PROC the string STR. Pop-up but do not select
1185 ;;; a window for the inferior process so that its response can be seen.
1186 (defun comint-proc-query (proc str)
1187   (let* ((proc-buf (process-buffer proc))
1188          (proc-mark (process-mark proc)))
1189     (display-buffer proc-buf)
1190     (set-buffer proc-buf) ; but it's not the selected *window*
1191     (let ((proc-win (get-buffer-window proc-buf))
1192           (proc-pt (marker-position proc-mark)))
1193       (comint-send-string proc str) ; send the query
1194       (accept-process-output proc)  ; wait for some output
1195       ;; Try to position the proc window so you can see the answer.
1196       ;; This is bogus code. If you delete the (sit-for 0), it breaks.
1197       ;; I don't know why. Wizards invited to improve it.
1198       (if (not (pos-visible-in-window-p proc-pt proc-win))
1199           (let ((opoint (window-point proc-win)))
1200             (set-window-point proc-win proc-mark) (sit-for 0)
1201             (if (not (pos-visible-in-window-p opoint proc-win))
1202                 (push-mark opoint)
1203                 (set-window-point proc-win opoint)))))))
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215 ;;; Filename completion in a buffer
1216 ;;; ===========================================================================
1217 ;;; Useful completion functions, courtesy of the Ergo group.
1218 ;;; M-<Tab> will complete the filename at the cursor as much as possible
1219 ;;; M-? will display a list of completions in the help buffer.
1220
1221 ;;; Three commands:
1222 ;;; comint-dynamic-complete             Complete filename at point.
1223 ;;; comint-dynamic-list-completions     List completions in help buffer.
1224 ;;; comint-replace-by-expanded-filename Expand and complete filename at point;
1225 ;;;                                     replace with expanded/completed name.
1226
1227 ;;; These are not installed in the comint-mode keymap. But they are
1228 ;;; available for people who want them. Shell-mode installs them:
1229 ;;; (define-key cmushell-mode-map "\M-\t" 'comint-dynamic-complete)
1230 ;;; (define-key cmushell-mode-map "\M-?"  'comint-dynamic-list-completions)))
1231 ;;;
1232 ;;; Commands like this are fine things to put in load hooks if you
1233 ;;; want them present in specific modes. Example:
1234 ;;; (setq cmushell-load-hook
1235 ;;;       '((lambda () (define-key lisp-mode-map "\M-\t"
1236 ;;;                                'comint-replace-by-expanded-filename))))
1237 ;;;          
1238
1239
1240 (defun comint-match-partial-pathname ()
1241   "Returns the string of an existing filename or causes an error."
1242   (if (save-excursion (backward-char 1) (looking-at "\\s ")) ""
1243       (save-excursion
1244         (re-search-backward "[^~/A-Za-z0-9---_.$#,]+")
1245         (re-search-forward "[~/A-Za-z0-9---_.$#,]+")
1246         (substitute-in-file-name 
1247           (buffer-substring (match-beginning 0) (match-end 0))))))
1248
1249
1250 (defun comint-replace-by-expanded-filename ()
1251 "Replace the filename at point with an expanded, canonicalised, and
1252 completed replacement.
1253 \"Expanded\" means environment variables (e.g., $HOME) and ~'s are
1254 replaced with the corresponding directories.  \"Canonicalised\" means ..
1255 and \. are removed, and the filename is made absolute instead of relative.
1256 See functions expand-file-name and substitute-in-file-name. See also
1257 comint-dynamic-complete."
1258   (interactive)
1259   (let* ((pathname (comint-match-partial-pathname))
1260          (pathdir (file-name-directory pathname))
1261          (pathnondir (file-name-nondirectory pathname))
1262          (completion (file-name-completion pathnondir
1263                                            (or pathdir default-directory))))
1264     (cond ((null completion)
1265            (message "No completions of %s." pathname)
1266            (ding))
1267           ((eql completion t)
1268            (message "Unique completion."))
1269           (t                            ; this means a string was returned.
1270            (delete-region (match-beginning 0) (match-end 0))
1271            (insert (expand-file-name (concat pathdir completion)))))))
1272
1273
1274 (defun comint-dynamic-complete ()
1275   "Dynamically complete the filename at point.
1276 This function is similar to comint-replace-by-expanded-filename, except
1277 that it won't change parts of the filename already entered in the buffer; 
1278 it just adds completion characters to the end of the filename."
1279   (interactive)
1280   (let* ((pathname (comint-match-partial-pathname))
1281          (pathdir (file-name-directory pathname))
1282          (pathnondir (file-name-nondirectory pathname))
1283          (completion (file-name-completion  pathnondir
1284                                            (or pathdir default-directory))))
1285     (cond ((null completion)
1286            (message "No completions of %s." pathname)
1287            (ding))
1288           ((eql completion t)
1289            (message "Unique completion."))
1290           (t                            ; this means a string was returned.
1291            (goto-char (match-end 0))
1292            (insert (substring completion (length pathnondir)))))))
1293
1294 (defun comint-dynamic-list-completions ()
1295   "List in help buffer all possible completions of the filename at point."
1296   (interactive)
1297   (let* ((pathname (comint-match-partial-pathname))
1298          (pathdir (file-name-directory pathname))
1299          (pathnondir (file-name-nondirectory pathname))
1300          (completions
1301           (file-name-all-completions pathnondir
1302                                      (or pathdir default-directory))))
1303     (cond ((null completions)
1304            (message "No completions of %s." pathname)
1305            (ding))
1306           (t
1307            (let ((conf (current-window-configuration)))
1308              (with-output-to-temp-buffer "*Help*"
1309                (display-completion-list completions))
1310              (sit-for 0)
1311              (message "Hit space to flush.")
1312              (let ((ch (read-char)))
1313                (if (= ch ?\ )
1314                    (set-window-configuration conf)
1315                    (setq unread-command-char ch))))))))
1316
1317 ; Ergo bindings
1318 ; (global-set-key "\M-\t" 'comint-replace-by-expanded-filename)
1319 ; (global-set-key "\M-?" 'comint-dynamic-list-completions)
1320 ; (define-key shell-mode-map "\M-\t" 'comint-dynamic-complete)
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347 ;;; Converting process modes to use comint mode
1348 ;;; ===========================================================================
1349 ;;; Several gnu packages (tex-mode, background, dbx, gdb, kermit, prolog, 
1350 ;;; telnet are some) use the shell package as clients. Most of them would
1351 ;;; be better off using the comint package, but they predate it. 
1352 ;;;
1353 ;;; Altering these packages to use comint mode should greatly
1354 ;;; improve their functionality, and is fairly easy.
1355 ;;; 
1356 ;;; Renaming variables
1357 ;;; Most of the work is renaming variables and functions. These are the common
1358 ;;; ones:
1359 ;;; Local variables:
1360 ;;;     last-input-end          comint-last-input-end
1361 ;;;     last-input-start        <unnecessary>
1362 ;;;     shell-prompt-pattern    comint-prompt-regexp
1363 ;;;     shell-set-directory-error-hook <no equivalent>
1364 ;;; Miscellaneous:
1365 ;;;     shell-set-directory     <unnecessary>
1366 ;;;     shell-mode-map          comint-mode-map
1367 ;;; Commands:
1368 ;;;     shell-send-input        comint-send-input
1369 ;;;     shell-send-eof          comint-delchar-or-maybe-eof
1370 ;;;     kill-shell-input        comint-kill-input
1371 ;;;     interrupt-shell-subjob  comint-interrupt-subjob
1372 ;;;     stop-shell-subjob       comint-stop-subjob
1373 ;;;     quit-shell-subjob       comint-quit-subjob
1374 ;;;     kill-shell-subjob       comint-kill-subjob
1375 ;;;     kill-output-from-shell  comint-kill-output
1376 ;;;     show-output-from-shell  comint-show-output
1377 ;;;     copy-last-shell-input   Use comint-previous-input/comint-next-input
1378 ;;;
1379 ;;; LAST-INPUT-START is no longer necessary because inputs are stored on the
1380 ;;; input history ring. SHELL-SET-DIRECTORY is gone, its functionality taken
1381 ;;; over by SHELL-DIRECTORY-TRACKER, the shell mode's comint-input-sentinel.
1382 ;;; Comint mode does not provide functionality equivalent to 
1383 ;;; shell-set-directory-error-hook; it is gone.
1384 ;;; 
1385 ;;; If you are implementing some process-in-a-buffer mode, called foo-mode, do
1386 ;;; *not* create the comint-mode local variables in your foo-mode function.
1387 ;;; This is not modular.  Instead, call comint-mode, and let *it* create the
1388 ;;; necessary comint-specific local variables. Then create the
1389 ;;; foo-mode-specific local variables in foo-mode.  Set the buffer's keymap to
1390 ;;; be foo-mode-map, and its mode to be foo-mode.  Set the comint-mode hooks
1391 ;;; (comint-prompt-regexp, comint-input-filter, comint-input-sentinel,
1392 ;;; comint-get-old-input) that need to be different from the defaults.  Call
1393 ;;; foo-mode-hook, and you're done. Don't run the comint-mode hook yourself;
1394 ;;; comint-mode will take care of it. The following example, from cmushell.el,
1395 ;;; is typical:
1396 ;;; 
1397 ;;; (defun shell-mode ()
1398 ;;;   (interactive)
1399 ;;;   (comint-mode)
1400 ;;;   (setq comint-prompt-regexp shell-prompt-pattern)
1401 ;;;   (setq major-mode 'shell-mode)
1402 ;;;   (setq mode-name "Shell")
1403 ;;;   (cond ((not shell-mode-map)
1404 ;;;          (setq shell-mode-map (full-copy-sparse-keymap comint-mode-map))
1405 ;;;          (define-key shell-mode-map "\M-\t" 'comint-dynamic-complete)
1406 ;;;          (define-key shell-mode-map "\M-?"
1407 ;;;                      'comint-dynamic-list-completions)))
1408 ;;;   (use-local-map shell-mode-map)
1409 ;;;   (make-local-variable 'shell-directory-stack)
1410 ;;;   (setq shell-directory-stack nil)
1411 ;;;   (setq comint-input-sentinel 'shell-directory-tracker)
1412 ;;;   (run-hooks 'shell-mode-hook))
1413 ;;;
1414 ;;;
1415 ;;; Note that make-comint is different from make-shell in that it
1416 ;;; doesn't have a default program argument. If you give make-shell
1417 ;;; a program name of NIL, it cleverly chooses one of explicit-shell-name,
1418 ;;; $ESHELL, $SHELL, or /bin/sh. If you give make-comint a program argument
1419 ;;; of NIL, it barfs. Adjust your code accordingly...
1420 ;;;
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435 ;;; Do the user's customisation...
1436
1437 (defvar comint-load-hook nil
1438   "This hook is run when comint is loaded in.
1439 This is a good place to put keybindings.")
1440         
1441 (run-hooks 'comint-load-hook)
1442
1443 ;;; Change log:
1444 ;;; 9/12/89 
1445 ;;;  - Souped up the filename expansion procedures.
1446 ;;;    Doc strings are much clearer and more detailed.
1447 ;;;    Fixed a bug where doing a filename completion when the point
1448 ;;;    was in the middle of the filename instead of at the end would lose.
1449 ;;;
1450 ;;; 2/17/90 
1451 ;;;  - Souped up the command history stuff so that text inserted
1452 ;;;    by comint-previous-input-matching is removed by following
1453 ;;;    command history recalls. comint-next/previous-input-matching
1454 ;;;    is now much more smoothly integrated w/the command history stuff.
1455 ;;;  - Added comint-eol-on-send flag and comint-input-sender hook.
1456 ;;;    Comint-input-sender based on code contributed by Jeff Peck
1457 ;;;    (peck@sun.com).
1458 ;;;
1459 ;;; 3/13/90 ccm@cmu.cs.edu
1460 ;;;  - Added comint-previous-similar-input for looking up similar inputs.
1461 ;;;  - Added comint-send-and-get-output to allow snarfing input from
1462 ;;;    buffer. 
1463 ;;;  - Added the ability to pick up a source file by positioning over
1464 ;;;    a string in comint-get-source.
1465 ;;;  - Added add-hook to make it a little easier for the user to use
1466 ;;;    multiple hooks.
1467 ;;;  
1468 ;;; 5/22/90 shivers
1469 ;;; - Moved Chris' multiplexed ipc stuff to comint-ipc.el.
1470 ;;; - Altered Chris' comint-get-source string feature. The string
1471 ;;;   is only offered as a default if it names an existing file.
1472 ;;; - Changed comint-exec to directly crank up the process, instead
1473 ;;;   of calling the env program. This made background.el happy.
1474 ;;; - Added new buffer-local var comint-ptyp. The problem is that
1475 ;;;   the signalling functions don't work as advertised. If you are
1476 ;;;   communicating via pipes, the CURRENT-GROUP arg is supposed to
1477 ;;;   be ignored, but, unfortunately it seems to be the case that you
1478 ;;;   must pass a NIL for this arg in the pipe case. COMINT-PTYP
1479 ;;;   is a flag that tells whether the process is communicating
1480 ;;;   via pipes or a pty. The comint signalling functions use it
1481 ;;;   to determine the necessary CURRENT-GROUP arg value. The bug
1482 ;;;   has been reported to the Gnu folks.
1483 ;;; - comint-dynamic-complete flushes the help window if you hit space
1484 ;;;   after you execute it.
1485 ;;; - Added functions comint-send-string, comint-send-region and var 
1486 ;;;   comint-input-chunk-size.  comint-send-string tries to prevent processes
1487 ;;;   from hanging when you send them long strings by breaking them into
1488 ;;;   chunks and allowing process output between chunks. I got the idea from
1489 ;;;   Eero Simoncelli's Common Lisp package. Note that using
1490 ;;;   comint-send-string means that the process buffer's contents can change
1491 ;;;   during a call!  If you depend on process output only happening between
1492 ;;;   toplevel commands, this could be a problem. In such a case, use
1493 ;;;   process-send-string instead. If this is a problem for people, I'd like
1494 ;;;   to hear about it.
1495 ;;; - Added comint-proc-query as a simple mechanism for commands that
1496 ;;;   want to query an inferior process and display its response. For a
1497 ;;;   typical use, see lisp-show-arglist in cmulisp.el.
1498 ;;; - Added constant comint-version, which is now "2.01".
1499 ;;;
1500 ;;; 6/14/90 shivers
1501 ;;; - Had comint-update-env defined twice. Removed extra copy. Also
1502 ;;;   renamed mem to be comint-mem, for modularity. The duplication
1503 ;;;   was reported by Michael Meissner.
1504 ;;; 6/16/90 shivers
1505 ;;; - Emacs has two different mechanisms for maintaining the process
1506 ;;;   environment, determined at compile time by the MAINTAIN-ENVIRONMENT
1507 ;;;   #define. One uses the process-environment global variable, and
1508 ;;;   one uses a getenv/setenv interface. comint-exec assumed the
1509 ;;;   process-environment interface; it has been generalised (with
1510 ;;;   comint-exec-1) to handle both cases. Pretty bogus. We could,
1511 ;;;   of course, skip all this and just use the etc/env program to
1512 ;;;   handle the environment tweaking, but that obscures process
1513 ;;;   queries that other modules (like background.el) depend on. etc/env
1514 ;;;   is also fairly bogus. This bug, and some of the fix code was
1515 ;;;   reported by Dan Pierson.
1516 ;;;
1517 ;;; 9/5/90 shivers
1518 ;;; - Changed make-variable-buffer-local's to make-local-variable's.
1519 ;;;   This leaves non-comint-mode buffers alone. Stephane Payrard
1520 ;;;   reported the sloppy useage.
1521 ;;; - You can now go from comint-previous-similar-input to
1522 ;;;   comint-previous-input with no problem.
1523
1524