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