Commit | Line | Data |
---|---|---|
be9b65ac DL |
1 | ;;; -*-Emacs-Lisp-*- General command interpreter in a window stuff |
2 | ;;; Copyright (C) 1989 Free Software Foundation, Inc. | |
3 | ;;; Original author: Olin Shivers <olin.shivers@cs.cmu.edu> Aug 1988 | |
4 | ||
5 | ;;; This file is part of GNU Emacs. | |
6 | ||
7 | ;;; GNU Emacs is free software; you can redistribute it and/or modify | |
8 | ;;; it under the terms of the GNU General Public License as published by | |
9 | ;;; the Free Software Foundation; either version 1, or (at your option) | |
10 | ;;; any later version. | |
11 | ||
12 | ;;; GNU Emacs is distributed in the hope that it will be useful, | |
13 | ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
14 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
15 | ;;; GNU General Public License for more details. | |
16 | ||
17 | ;;; You should have received a copy of the GNU General Public License | |
18 | ;;; along with GNU Emacs; see the file COPYING. If not, write to | |
19 | ;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. | |
20 | ||
21 | ;;; This file defines a general command-interpreter-in-a-buffer package | |
22 | ;;; (comint mode). The idea is that you can build specific process-in-a-buffer | |
23 | ;;; modes on top of comint mode -- e.g., lisp, shell, scheme, T, soar, .... | |
24 | ;;; This way, all these specific packages share a common base functionality, | |
25 | ;;; and a common set of bindings, which makes them easier to use (and | |
26 | ;;; saves code, implementation time, etc., etc.). | |
27 | ||
28 | ;;; For documentation on the functionality provided by comint mode, and | |
29 | ;;; the hooks available for customising it, see the comments below. | |
30 | ;;; For further information on the standard derived modes (shell, | |
31 | ;;; inferior-lisp, inferior-scheme, ...), see the relevant source files. | |
32 | ||
33 | ;;; For hints on converting existing process modes to use comint-mode | |
34 | ;;; instead of shell-mode, see the notes at the end of this file. | |
35 | ||
36 | (require 'history) | |
37 | (provide 'comint) | |
38 | (defconst comint-version "2.01") | |
39 | ||
40 | \f | |
41 | ;;; Not bound by default in comint-mode | |
42 | ;;; send-invisible Read a line w/o echo, and send to proc | |
43 | ;;; (These are bound in shell-mode) | |
44 | ;;; comint-dynamic-complete Complete filename at point. | |
45 | ;;; comint-dynamic-list-completions List completions in help buffer. | |
46 | ;;; comint-replace-by-expanded-filename Expand and complete filename at point; | |
47 | ;;; replace with expanded/completed name. | |
48 | (defvar comint-mode-map nil) | |
49 | ||
50 | (if comint-mode-map | |
51 | nil | |
52 | (setq comint-mode-map (make-sparse-keymap)) | |
53 | (define-key comint-mode-map "\C-a" 'comint-bol) | |
54 | (define-key comint-mode-map "\C-d" 'comint-delchar-or-maybe-eof) | |
55 | (define-key comint-mode-map "\C-m" 'comint-send-input) | |
56 | (define-key comint-mode-map "\M-p" 'comint-previous-input) | |
57 | (define-key comint-mode-map "\M-n" 'comint-next-input) | |
58 | (define-key comint-mode-map "\M-s" 'comint-previous-similar-input) | |
59 | (define-key comint-mode-map "\C-c\C-c" 'comint-interrupt-subjob) ; tty ^C | |
60 | (define-key comint-mode-map "\C-c\C-f" 'comint-continue-subjob) ; shell "fg" | |
61 | (define-key comint-mode-map "\C-c\C-l" 'comint-show-output) | |
62 | (define-key comint-mode-map "\C-c\C-o" 'comint-flush-output) ; tty ^O | |
63 | (define-key comint-mode-map "\C-c\C-r" 'comint-history-search-backward) | |
64 | (define-key comint-mode-map "\C-c\C-s" 'comint-history-search-forward) | |
65 | (define-key comint-mode-map "\C-c\C-u" 'comint-kill-input) ; tty ^U | |
66 | (define-key comint-mode-map "\C-c\C-w" 'backward-kill-word) ; tty ^W | |
67 | (define-key comint-mode-map "\C-c\C-z" 'comint-stop-subjob) ; tty ^Z | |
68 | (define-key comint-mode-map "\C-c\C-\\" 'comint-quit-subjob)) ; tty ^\ | |
69 | \f | |
70 | ;;; Buffer Local Variables: | |
71 | ;;;============================================================================ | |
72 | ;;; Comint mode buffer local variables: | |
73 | ;;; comint-prompt-regexp - string comint-bol uses to match prompt. | |
74 | ;;; comint-last-input-end - marker For comint-flush-output command | |
75 | ;;; input-ring-size - integer For the input history | |
76 | ;;; input-ring - ring mechanism | |
77 | ;;; input-ring-index - marker ... | |
78 | ;;; comint-last-input-match - string ... | |
79 | ;;; comint-get-old-input - function Hooks for specific | |
80 | ;;; comint-input-sentinel - function process-in-a-buffer | |
81 | ;;; comint-input-filter - function modes. | |
82 | ;;; comint-input-send - function | |
83 | ;;; comint-eol-on-send - boolean | |
84 | ||
85 | (make-variable-buffer-local | |
86 | (defvar comint-prompt-regexp "^" | |
87 | "*Regexp to recognise prompts in the inferior process. Defaults to \"^\". | |
88 | ||
89 | Good choices: | |
90 | Canonical Lisp: \"^[^> \n]*>+:? *\" (Lucid, Franz, KCL, T, cscheme, oaklisp) | |
91 | Lucid Common Lisp: \"^\\(>\\|\\(->\\)+\\) *\" | |
92 | Franz: \"^\\(->\\|<[0-9]*>:\\) *\" | |
93 | KCL and T: \"^>+ *\" | |
94 | shell: \"^[^#$%>\n]*[#$%>] *\" | |
95 | ||
96 | This is a good thing to set in mode hooks.")) | |
97 | ||
98 | (make-variable-buffer-local | |
99 | (defvar input-ring-size 30 "Size of input history ring.")) | |
100 | ||
101 | ;;; Here are the per-interpreter hooks. | |
102 | (make-variable-buffer-local | |
103 | (defvar comint-get-old-input (function comint-get-old-input-default) | |
104 | "Function that submits old text in comint mode. | |
105 | This function is called when return is typed while the point is in old text. | |
106 | It returns the text to be submitted as process input. The default is | |
107 | comint-get-old-input-default, which grabs the current line, and strips off | |
108 | leading text matching comint-prompt-regexp.")) | |
109 | ||
110 | (make-variable-buffer-local | |
111 | (defvar comint-input-sentinel (function ignore) | |
112 | "Called on each input submitted to comint mode process by comint-send-input. | |
113 | Thus it can, for instance, track cd/pushd/popd commands issued to the csh.")) | |
114 | ||
115 | (make-variable-buffer-local | |
116 | (defvar comint-input-filter | |
117 | (function (lambda (str) (not (string-match "\\`\\s *\\'" str)))) | |
118 | "Predicate for filtering additions to input history. | |
119 | Only inputs answering true to this function are saved on the input | |
120 | history list. Default is to save anything that isn't all whitespace")) | |
121 | ||
122 | (defvar comint-mode-hook '() | |
123 | "Called upon entry into comint-mode") | |
124 | ||
125 | (defun comint-mode () | |
126 | "Major mode for interacting with an inferior interpreter. | |
127 | Interpreter name is same as buffer name, sans the asterisks. | |
128 | Return at end of buffer sends line as input. | |
129 | Return not at end copies rest of line to end and sends it. | |
130 | ||
131 | This mode is typically customised to create inferior-lisp-mode, | |
132 | shell-mode, et cetera. This can be done by setting the hooks | |
133 | comint-input-sentinel, comint-input-filter, and comint-get-old-input | |
134 | to appropriate functions, and the variable comint-prompt-regexp | |
135 | to the appropriate regular expression. | |
136 | ||
137 | An input history is maintained of size input-ring-size, and | |
138 | can be accessed with the commands comint-next-input [\\[comint-next-input]] and | |
139 | comint-previous-input [\\[comint-previous-input]]. Commands not keybound by | |
140 | default are send-invisible, comint-dynamic-complete, and | |
141 | comint-list-dynamic-completions. | |
142 | ||
143 | If you accidentally suspend your process, use \\[comint-continue-subjob] | |
144 | to continue it. | |
145 | ||
146 | \\{comint-mode-map} | |
147 | ||
148 | Entry to this mode runs the hooks on comint-mode-hook." | |
149 | (interactive) | |
150 | (make-local-variable 'input-ring) | |
151 | (put 'input-ring 'preserved t) | |
152 | (kill-all-local-variables) | |
153 | (setq major-mode 'comint-mode | |
154 | mode-name "Comint" | |
155 | mode-line-process '(": %s")) | |
156 | (use-local-map comint-mode-map) | |
157 | (set (make-local-variable 'comint-last-input-match) "") | |
158 | (set (make-local-variable 'comint-last-similar--string) "") | |
159 | (set (make-local-variable 'input-ring-index) 0) | |
160 | (set (make-local-variable 'comint-last-input-end) (make-marker)) | |
161 | (set-marker comint-last-input-end (point-max)) | |
162 | (run-hooks 'comint-mode-hook)) | |
163 | ||
164 | (defun comint-check-proc (buffer-name) | |
165 | "True if there is a running or stopped process associated with BUFFER." | |
166 | (let ((proc (get-buffer-process buffer-name))) | |
167 | (and proc (memq (process-status proc) '(run stop))))) | |
168 | ||
169 | (defun comint-mark () | |
170 | ;; Returns the process-mark of the current-buffer | |
171 | (process-mark (get-buffer-process (current-buffer)))) | |
172 | ||
173 | ;;; Note that this guy, unlike shell.el's make-shell, barfs if you pass it () | |
174 | ;;; for the second argument (program). | |
175 | (defun make-comint (name program &optional startfile &rest switches) | |
176 | (let* ((buffer (get-buffer-create (concat "*" name "*"))) | |
177 | (proc (get-buffer-process buffer))) | |
178 | ;; If no process, or nuked process, crank up a new one and put buffer in | |
179 | ;; comint mode. Otherwise, leave buffer and existing process alone. | |
180 | (cond ((not (comint-check-proc)) | |
181 | (save-excursion | |
182 | (set-buffer buffer) | |
183 | (comint-mode)) ; Install local vars, mode, keymap, ... | |
184 | (comint-exec buffer name program startfile switches))) | |
185 | buffer)) | |
186 | ||
187 | (defun comint-exec (buffer name command startfile switches) | |
188 | "Fires up a process in buffer for comint modes. | |
189 | Blasts any old process running in the buffer. Doesn't set the buffer mode. | |
190 | You can use this to cheaply run a series of processes in the same buffer." | |
191 | (or command (error "No program for comint process")) | |
192 | (save-excursion | |
193 | (set-buffer buffer) | |
194 | (let ((proc (get-buffer-process buffer))) ; Blast any old process. | |
195 | (if proc (delete-process proc))) | |
196 | ;; Crank up a new process | |
197 | (let ((proc (comint-exec-1 name buffer command switches))) | |
198 | ;; Jump to the end, and set the process mark. | |
199 | (set-marker (comint-mark) (goto-char (point-max))) | |
200 | ;; Feed it the startfile. | |
201 | (cond (startfile | |
202 | ;;This is guaranteed to wait long enough | |
203 | ;;but has bad results if the comint does not prompt at all | |
204 | ;; (while (= size (buffer-size)) | |
205 | ;; (sleep-for 1)) | |
206 | ;;I hope 1 second is enough! | |
207 | (sleep-for 1) | |
208 | (goto-char (point-max)) | |
209 | (insert-file-contents startfile) | |
210 | (setq startfile (buffer-substring (point) (point-max))) | |
211 | (delete-region (point) (point-max)) | |
212 | (comint-send-string proc startfile))) | |
213 | buffer)) | |
214 | ||
215 | ;;; This auxiliary function cranks up the process for comint-exec in | |
216 | ;;; the appropriate environment. It is twice as long as it should be | |
217 | ;;; because emacs has two distinct mechanisms for manipulating the | |
218 | ;;; process environment, selected at compile time with the | |
219 | ;;; MAINTAIN-ENVIRONMENT #define. In one case, process-environment | |
220 | ;;; is bound; in the other it isn't. | |
221 | ||
222 | (defun comint-exec-1 (name buffer command switches) | |
223 | (if (boundp 'process-environment) ; Not a completely reliable test. | |
224 | (let ((process-environment | |
225 | (comint-update-env process-environment | |
226 | (list (format "TERMCAP=emacs:co#%d:tc=unknown" | |
227 | (screen-width)) | |
228 | "TERM=emacs" | |
229 | "EMACS=t")))) | |
230 | (apply 'start-process name buffer command switches)) | |
231 | (let ((tcapv (getenv "TERMCAP")) | |
232 | (termv (getenv "TERM")) | |
233 | (emv (getenv "EMACS"))) | |
234 | (unwind-protect | |
235 | (progn (setenv "TERMCAP" (format "emacs:co#%d:tc=unknown" | |
236 | (screen-width))) | |
237 | (setenv "TERM" "emacs") | |
238 | (setenv "EMACS" "t") | |
239 | (apply 'start-process name buffer command switches)) | |
240 | (setenv "TERMCAP" tcapv) | |
241 | (setenv "TERM" termv) | |
242 | (setenv "EMACS" emv))))) | |
243 | ||
244 | ;; This is just (append new old-env) that compresses out shadowed entries. | |
245 | ;; It's also pretty ugly, mostly due to elisp's horrible iteration structures. | |
246 | (defun comint-update-env (old-env new) | |
247 | (let ((ans (reverse new)) | |
248 | (vars (mapcar (function (lambda (vv) | |
249 | (and (string-match "^[^=]*=" vv) | |
250 | (substring vv 0 (match-end 0))))) | |
251 | new))) | |
252 | (while old-env | |
253 | (let* ((vv (car old-env)) ; vv is var=value | |
254 | (var (and (string-match "^[^=]*=" vv) | |
255 | (substring vv 0 (match-end 0))))) | |
256 | (setq old-env (cdr old-env)) | |
257 | (cond ((not (and var (member var vars))) | |
258 | (if var (setq var (cons var vars))) | |
259 | (setq ans (cons vv ans)))))) | |
260 | (nreverse ans))) | |
261 | \f | |
262 | ;;; Input history retrieval commands | |
263 | ;;; M-p -- previous input M-n -- next input | |
264 | ;;; C-c r -- previous input matching | |
265 | ;;; =========================================================================== | |
266 | ||
267 | (defun comint-previous-input (arg) | |
268 | "Cycle backwards through input history." | |
269 | (interactive "*p") | |
270 | (let ((len (ring-length input-ring))) | |
271 | (if (<= len 0) (error "Empty input ring")) | |
272 | (if (< (point) (comint-mark)) | |
273 | (delete-region (comint-mark) (goto-char (point-max)))) | |
274 | (cond ((eq last-command 'comint-previous-input) | |
275 | (delete-region (mark) (point))) | |
276 | ((eq last-command 'comint-previous-similar-input) | |
277 | (delete-region (comint-mark) (point))) | |
278 | (t | |
279 | (setq input-ring-index | |
280 | (if (> arg 0) -1 | |
281 | (if (< arg 0) 1 0))) | |
282 | (push-mark (point)))) | |
283 | (setq input-ring-index (comint-mod (+ input-ring-index arg) len)) | |
284 | (message "%d" (1+ input-ring-index)) | |
285 | (insert (ring-ref input-ring input-ring-index)) | |
286 | (setq this-command 'comint-previous-input))) | |
287 | ||
288 | (defun comint-next-input (arg) | |
289 | "Cycle forwards through input history." | |
290 | (interactive "*p") | |
291 | (comint-previous-input (- arg))) | |
292 | ||
293 | (defun comint-previous-input-matching (str) | |
294 | "Searches backwards through input history for substring match." | |
295 | (interactive (let* ((last-command last-command) ; preserve around r-f-m | |
296 | (s (read-from-minibuffer | |
297 | (format "Command substring (default %s): " | |
298 | comint-last-input-match)))) | |
299 | (list (if (string= s "") comint-last-input-match s)))) | |
300 | ; (interactive "sCommand substring: ") | |
301 | (setq comint-last-input-match str) ; update default | |
302 | (if (not (eq last-command 'comint-previous-input)) | |
303 | (setq input-ring-index -1)) | |
304 | (let ((str (regexp-quote str)) | |
305 | (len (ring-length input-ring)) | |
306 | (n (+ input-ring-index 1))) | |
307 | (while (and (< n len) (not (string-match str (ring-ref input-ring n)))) | |
308 | (setq n (+ n 1))) | |
309 | (cond ((< n len) | |
310 | (comint-previous-input (- n input-ring-index))) | |
311 | (t (if (eq last-command 'comint-previous-input) | |
312 | (setq this-command 'comint-previous-input)) | |
313 | (error "Not found"))))) | |
314 | ||
315 | ;;; | |
316 | ;;; Similar input -- contributed by ccm and highly winning. | |
317 | ;;; | |
318 | ;;; Reenter input, removing back to the last insert point if it exists. | |
319 | ;;; | |
320 | (defun comint-previous-similar-input (arg) | |
321 | "Reenters the last input that matches the string typed so far. If repeated | |
322 | successively older inputs are reentered. If arg is 1, it will go back | |
323 | in the history, if -1 it will go forward." | |
324 | (interactive "p") | |
325 | (if (< (point) (comint-mark)) | |
326 | (error "Not after process mark")) | |
327 | (if (not (eq last-command 'comint-previous-similar-input)) | |
328 | (setq input-ring-index -1 | |
329 | comint-last-similar-string | |
330 | (buffer-substring (comint-mark) (point)))) | |
331 | (let* ((size (length comint-last-similar-string)) | |
332 | (len (ring-length input-ring)) | |
333 | (n (+ input-ring-index arg)) | |
334 | entry) | |
335 | (while (and (< n len) | |
336 | (or (< (length (setq entry (ring-ref input-ring n))) size) | |
337 | (not (equal comint-last-similar-string | |
338 | (substring entry 0 size))))) | |
339 | (setq n (+ n arg))) | |
340 | (cond ((< n len) | |
341 | (setq input-ring-index n) | |
342 | (if (eq last-command 'comint-previous-similar-input) | |
343 | (delete-region (comint-mark) (point))) | |
344 | (insert (substring entry size))) | |
345 | (t (error "Not found"))))) | |
346 | \f | |
347 | (defun comint-send-input (&optional terminator delete) | |
348 | "Send input to process, followed by a linefeed or optional TERMINATOR. | |
349 | After the process output mark, sends all text from the process mark to | |
350 | end of buffer as input to the process. Before the process output mark, calls | |
351 | value of variable comint-get-old-input to retrieve old input, replaces it in | |
352 | the input region (from the end of process output to the end of the buffer) and | |
353 | then sends it. In either case, the value of variable comint-input-sentinel is | |
354 | called on the input before sending it. The input is entered into the input | |
355 | history ring, if value of variable comint-input-filter returns non-nil when | |
356 | called on the input. | |
357 | ||
358 | If optional second argument DELETE is non-nil, then the input is deleted from | |
359 | the end of the buffer. This is useful if the process unconditionally echoes | |
360 | input. Processes which use TERMINATOR or DELETE should have a command wrapper | |
361 | which provides them bound to RET; see telnet.el for an example. | |
362 | ||
363 | comint-get-old-input, comint-input-sentinel, and comint-input-filter are chosen | |
364 | according to the command interpreter running in the buffer. For example, | |
365 | ||
366 | If the interpreter is the csh, | |
367 | comint-get-old-input defaults: takes the current line, discard any | |
368 | initial string matching regexp comint-prompt-regexp. | |
369 | comint-input-sentinel: monitors input for \"cd\", \"pushd\", and \"popd\" | |
370 | commands. When it sees one, it changes the default directory of the buffer. | |
371 | comint-input-filter defaults: returns t if the input isn't all whitespace. | |
372 | ||
373 | If the comint is Lucid Common Lisp, | |
374 | comint-get-old-input: snarfs the sexp ending at point. | |
375 | comint-input-sentinel: does nothing. | |
376 | comint-input-filter: returns nil if the input matches input-filter-regexp, | |
377 | which matches (1) all whitespace (2) :a, :c, etc. | |
378 | ||
379 | Similar functions are used for other process modes." | |
380 | (interactive) | |
381 | ;; Note that the input string does not include its terminal newline. | |
382 | (if (not (get-buffer-process (current-buffer))) | |
383 | (error "Current buffer has no process") | |
384 | (let* ((pmark (comint-mark)) | |
385 | (input (if (>= (point) pmark) | |
386 | (buffer-substring pmark (goto-char (point-max))) | |
387 | (let ((copy (funcall comint-get-old-input))) | |
388 | (delete-region pmark (goto-char (point-max))) | |
389 | (insert copy) | |
390 | copy)))) | |
391 | (set-marker comint-last-input-end (point)) | |
392 | (setq input-ring-index 0) | |
393 | (if (funcall comint-input-filter input) (ring-insert input-ring input)) | |
394 | (funcall comint-input-sentinel input) | |
395 | (comint-send-string nil (concat input (or terminator "\n"))) | |
396 | (if delete (delete-region mark (point)) | |
397 | (insert "\n")) | |
398 | (set-marker (comint-mark) (point))))) | |
399 | ||
400 | (defun comint-get-old-input-default () | |
401 | "Default for comint-get-old-input: use the current line sans prompt." | |
402 | (save-excursion | |
403 | (comint-bol) | |
404 | (buffer-substring (point) (progn (end-of-line) (point))))) | |
405 | ||
406 | (defun comint-bol (arg) | |
407 | "Goes to the beginning of line, then skips past the prompt, if any. | |
408 | With a prefix argument, (\\[universal-argument]), then doesn't skip prompt. | |
409 | ||
410 | The prompt skip is done by passing over text matching the regular expression | |
411 | comint-prompt-regexp, a buffer local variable." | |
412 | (interactive "P") | |
413 | (beginning-of-line) | |
414 | (or arg (if (looking-at comint-prompt-regexp) (goto-char (match-end 0))))) | |
415 | ||
416 | ;;; These two functions are for entering text you don't want echoed or | |
417 | ;;; saved -- typically passwords to ftp, telnet, or somesuch. | |
418 | ;;; Just enter M-x send-invisible and type in your line. | |
419 | (defun comint-read-noecho (prompt) | |
420 | "Prompting with PROMPT, read a single line of text without echoing. | |
421 | The text can still be recovered (temporarily) with \\[view-lossage]. This | |
422 | may be a security bug for some applications." | |
423 | (let ((echo-keystrokes 0) | |
424 | (answ "") | |
425 | tem) | |
426 | (if (and (stringp prompt) (not (string= (message prompt) ""))) | |
427 | (message prompt)) | |
428 | (while (not (or (= (setq tem (read-char)) ?\^m) | |
429 | (= tem ?\n))) | |
430 | (setq answ (concat answ (char-to-string tem)))) | |
431 | (message "") | |
432 | answ)) | |
433 | ||
434 | (defun send-invisible (str) | |
435 | "Read a string without echoing, and send it to the current buffer's process. | |
436 | A newline is also sent. String is not saved on comint input history list. | |
437 | Security bug: your string can still be temporarily recovered with \\[view-lossage]." | |
438 | ; (interactive (list (comint-read-noecho "Enter non-echoed text"))) | |
439 | (interactive "P") ; Defeat snooping via C-x esc | |
440 | (let ((proc (get-buffer-process (current-buffer)))) | |
441 | (if (not proc) (error "Current buffer has no process") | |
442 | (comint-send-string proc | |
443 | (if (stringp str) str | |
444 | (comint-read-noecho "Enter non-echoed text"))) | |
445 | (comint-send-string proc "\n")))) | |
446 | ||
447 | \f | |
448 | ;;; Low-level process communication | |
449 | ||
450 | (defvar comint-input-chunk-size 512 | |
451 | "*Long inputs send to comint processes are broken up into chunks of this size. | |
452 | If your process is choking on big inputs, try lowering the value.") | |
453 | ||
454 | (defun comint-send-string (proc str) | |
455 | "Send PROCESS the contents of STRING as input. | |
456 | This is equivalent to process-send-string, except that long input strings | |
457 | are broken up into chunks of size comint-input-chunk-size. Processes | |
458 | are given a chance to output between chunks. This can help prevent processes | |
459 | from hanging when you send them long inputs on some OS's." | |
460 | (let* ((len (length str)) | |
461 | (i (min len comint-input-chunk-size))) | |
462 | (process-send-string proc (substring str 0 i)) | |
463 | (while (< i len) | |
464 | (let ((next-i (+ i comint-input-chunk-size))) | |
465 | (accept-process-output) | |
466 | (process-send-string proc (substring str i (min len next-i))) | |
467 | (setq i next-i))))) | |
468 | ||
469 | (defun comint-send-region (proc start end) | |
470 | "Sends to PROC the region delimited by START and END. | |
471 | This is a replacement for process-send-region that tries to keep | |
472 | your process from hanging on long inputs. See comint-send-string." | |
473 | (comint-send-string proc (buffer-substring start end))) | |
474 | ||
475 | \f | |
476 | ;;; Random input hackage | |
477 | ||
478 | (defun comint-flush-output () | |
479 | "Kill all output from interpreter since last input." | |
480 | (interactive) | |
481 | (save-excursion | |
482 | (goto-char (comint-mark)) | |
483 | (beginning-of-line) | |
484 | (delete-region (1+ comint-last-input-end) (point)) | |
485 | (insert "*** output flushed ***\n"))) | |
486 | ||
487 | (defun comint-show-output () | |
488 | "Start display of the current window at line preceding start of last output. | |
489 | \"Last output\" is considered to start at the line following the last command | |
490 | entered to the process." | |
491 | (interactive) | |
492 | (goto-char comint-last-input-end) | |
493 | (beginning-of-line) | |
494 | (set-window-start (selected-window) (point)) | |
495 | (comint-bol)) | |
496 | ||
497 | (defun comint-interrupt-subjob () | |
498 | "Sent an interrupt signal to the current subprocess. | |
499 | If the process-connection-type is via ptys, the signal is sent to the current | |
500 | process group of the pseudoterminal which Emacs is using to communicate with | |
501 | the subprocess. If the process is a job-control shell, this means the | |
502 | shell's current subjob. If the process connection is via pipes, the signal is | |
503 | sent to the immediate subprocess." | |
504 | (interactive) | |
505 | (interrupt-process nil t)) | |
506 | ||
507 | (defun comint-kill-subjob () | |
508 | "Send a kill signal to the current subprocess. | |
509 | See comint-interrupt-subjob for a description of \"current subprocess\"." | |
510 | (interactive) | |
511 | (kill-process nil t)) | |
512 | ||
513 | (defun comint-quit-subjob () | |
514 | "Send a quit signal to the current subprocess. | |
515 | See comint-interrupt-subjob for a description of \"current subprocess\"." | |
516 | (interactive) | |
517 | (quit-process nil t)) | |
518 | ||
519 | (defun comint-stop-subjob () | |
520 | "Stop the current subprocess. | |
521 | See comint-interrupt-subjob for a description of \"current subprocess\". | |
522 | ||
523 | WARNING: if there is no current subjob, you can end up suspending | |
524 | the top-level process running in the buffer. If you accidentally do | |
525 | this, use \\[comint-continue-subjob] to resume the process. (This is not a | |
526 | problem with most shells, since they ignore this signal.)" | |
527 | (interactive) | |
528 | (stop-process nil t)) | |
529 | ||
530 | (defun comint-continue-subjob () | |
531 | "Send a continue signal to current subprocess. | |
532 | See comint-interrupt-subjob for a description of \"current subprocess\". | |
533 | Useful if you accidentally suspend the top-level process." | |
534 | (interactive) | |
535 | (continue-process nil t)) | |
536 | ||
537 | (defun comint-kill-input () | |
538 | "Kill from current command through point." | |
539 | (interactive) | |
540 | (let ((pmark (comint-mark))) | |
541 | (if (> (point) pmark) | |
542 | (kill-region pmark (point)) | |
543 | (error "Nothing to kill")))) | |
544 | ||
545 | (defun comint-delchar-or-maybe-eof (arg) | |
546 | "Delete ARG characters forward, or send an EOF to process if at end of buffer." | |
547 | (interactive "p") | |
548 | (if (eobp) | |
549 | (process-send-eof) | |
550 | (delete-char arg))) | |
551 | \f | |
552 | ;;; Support for source-file processing commands. | |
553 | ;;;============================================================================ | |
554 | ;;; Many command-interpreters (e.g., Lisp, Scheme, Soar) have | |
555 | ;;; commands that process files of source text (e.g. loading or compiling | |
556 | ;;; files). So the corresponding process-in-a-buffer modes have commands | |
557 | ;;; for doing this (e.g., lisp-load-file). The functions below are useful | |
558 | ;;; for defining these commands. | |
559 | ;;; | |
560 | ;;; Alas, these guys don't do exactly the right thing for Lisp, Scheme | |
561 | ;;; and Soar, in that they don't know anything about file extensions. | |
562 | ;;; So the compile/load interface gets the wrong default occasionally. | |
563 | ;;; The load-file/compile-file default mechanism could be smarter -- it | |
564 | ;;; doesn't know about the relationship between filename extensions and | |
565 | ;;; whether the file is source or executable. If you compile foo.lisp | |
566 | ;;; with compile-file, then the next load-file should use foo.bin for | |
567 | ;;; the default, not foo.lisp. This is tricky to do right, particularly | |
568 | ;;; because the extension for executable files varies so much (.o, .bin, | |
569 | ;;; .lbin, .mo, .vo, .ao, ...). | |
570 | ||
571 | ||
572 | ;;; COMINT-SOURCE-DEFAULT -- determines defaults for source-file processing | |
573 | ;;; commands. | |
574 | ;;; | |
575 | ;;; COMINT-CHECK-SOURCE -- if FNAME is in a modified buffer, asks you if you | |
576 | ;;; want to save the buffer before issuing any process requests to the command | |
577 | ;;; interpreter. | |
578 | ;;; | |
579 | ;;; COMINT-GET-SOURCE -- used by the source-file processing commands to prompt | |
580 | ;;; for the file to process. | |
581 | ||
582 | ;;; (COMINT-SOURCE-DEFAULT previous-dir/file source-modes) | |
583 | ;;;============================================================================ | |
584 | ;;; This function computes the defaults for the load-file and compile-file | |
585 | ;;; commands for tea, soar, lisp, and scheme modes. | |
586 | ;;; | |
587 | ;;; - PREVIOUS-DIR/FILE is a pair (directory . filename) from the last | |
588 | ;;; source-file processing command. NIL if there hasn't been one yet. | |
589 | ;;; - SOURCE-MODES is a list used to determine what buffers contain source | |
590 | ;;; files: if the major mode of the buffer is in SOURCE-MODES, it's source. | |
591 | ;;; Typically, (lisp-mode) or (scheme-mode). | |
592 | ;;; | |
593 | ;;; If the command is given while the cursor is inside a string, *and* | |
594 | ;;; the string is an existing filename, *and* the filename is not a directory, | |
595 | ;;; then the string is taken as default. This allows you to just position | |
596 | ;;; your cursor over a string that's a filename and have it taken as default. | |
597 | ;;; | |
598 | ;;; If the command is given in a file buffer whose major mode is in | |
599 | ;;; SOURCE-MODES, then the the filename is the default file, and the | |
600 | ;;; file's directory is the default directory. | |
601 | ;;; | |
602 | ;;; If the buffer isn't a source file buffer (e.g., it's the process buffer), | |
603 | ;;; then the default directory & file are what was used in the last source-file | |
604 | ;;; processing command (i.e., PREVIOUS-DIR/FILE). If this is the first time | |
605 | ;;; the command has been run (PREVIOUS-DIR/FILE is nil), the default directory | |
606 | ;;; is the cwd, with no default file. (\"no default file\" = nil) | |
607 | ;;; | |
608 | ;;; SOURCE-REGEXP is typically going to be something like (tea-mode) | |
609 | ;;; for T programs, (lisp-mode) for Lisp programs, (soar-mode lisp-mode) | |
610 | ;;; for Soar programs, etc. | |
611 | ;;; | |
612 | ;;; The function returns a pair: (default-directory . default-file). | |
613 | ||
614 | (defun comint-source-default (previous-dir/file source-modes) | |
615 | (cond ((and buffer-file-name (memq major-mode source-modes)) | |
616 | (cons (file-name-directory buffer-file-name) | |
617 | (file-name-nondirectory buffer-file-name))) | |
618 | (previous-dir/file) | |
619 | (t | |
620 | (cons default-directory nil)))) | |
621 | ||
622 | ;;; (COMINT-CHECK-SOURCE fname) | |
623 | ;;;============================================================================ | |
624 | ;;; Prior to loading or compiling (or otherwise processing) a file (in the | |
625 | ;;; process-in-a-buffer modes), this function can be called on the filename. | |
626 | ;;; If the file is loaded into a buffer, and the buffer is modified, the user | |
627 | ;;; is queried to see if he wants to save the buffer before proceeding with | |
628 | ;;; the load or compile. | |
629 | ||
630 | (defun comint-check-source (fname) | |
631 | (let ((buff (get-file-buffer fname))) | |
632 | (if (and buff | |
633 | (buffer-modified-p buff) | |
634 | (y-or-n-p (format "Save buffer %s first? " | |
635 | (buffer-name buff)))) | |
636 | ;; save BUFF. | |
637 | (let ((old-buffer (current-buffer))) | |
638 | (set-buffer buff) | |
639 | (save-buffer) | |
640 | (set-buffer old-buffer))))) | |
641 | ||
642 | ;;; (COMINT-GET-SOURCE prompt prev-dir/file source-modes mustmatch-p) | |
643 | ;;;============================================================================ | |
644 | ;;; COMINT-GET-SOURCE is used to prompt for filenames in command-interpreter | |
645 | ;;; commands that process source files (like loading or compiling a file). | |
646 | ;;; It prompts for the filename, provides a default, if there is one, | |
647 | ;;; and returns the result filename. | |
648 | ;;; | |
649 | ;;; See COMINT-SOURCE-DEFAULT for more on determining defaults. | |
650 | ;;; | |
651 | ;;; PROMPT is the prompt string. PREV-DIR/FILE is the (directory . file) pair | |
652 | ;;; from the last source processing command. SOURCE-MODES is a list of major | |
653 | ;;; modes used to determine what file buffers contain source files. (These | |
654 | ;;; two arguments are used for determining defaults). If MUSTMATCH-P is true, | |
655 | ;;; then the filename reader will only accept a file that exists. | |
656 | ;;; | |
657 | ;;; A typical use: | |
658 | ;;; (interactive (comint-get-source "Compile file: " prev-lisp-dir/file | |
659 | ;;; '(lisp-mode) t)) | |
660 | ||
661 | ;;; This is pretty stupid about strings. It decides we're in a string | |
662 | ;;; if there's a quote on both sides of point on the current line. | |
663 | (defun comint-extract-string () | |
664 | "Returns string around point that starts the current line or nil." | |
665 | (save-excursion | |
666 | (let* ((point (point)) | |
667 | (bol (progn (beginning-of-line) (point))) | |
668 | (eol (progn (end-of-line) (point))) | |
669 | (start (progn (goto-char point) | |
670 | (and (search-backward "\"" bol t) | |
671 | (1+ (point))))) | |
672 | (end (progn (goto-char point) | |
673 | (and (search-forward "\"" eol t) | |
674 | (1- (point)))))) | |
675 | (and start end | |
676 | (buffer-substring start end))))) | |
677 | ||
678 | (defun comint-get-source (prompt prev-dir/file source-modes mustmatch-p) | |
679 | (let* ((def (comint-source-default prev-dir/file source-modes)) | |
680 | (stringfile (comint-extract-string)) | |
681 | (sfile-p (and stringfile | |
682 | (file-exists-p stringfile) | |
683 | (not (file-directory-p stringfile)))) | |
684 | (defdir (if sfile-p (file-name-directory stringfile) | |
685 | (car def))) | |
686 | (deffile (if sfile-p (file-name-nondirectory stringfile) | |
687 | (cdr def))) | |
688 | (ans (read-file-name (if deffile (format "%s(default %s) " | |
689 | prompt deffile) | |
690 | prompt) | |
691 | defdir | |
692 | (concat defdir deffile) | |
693 | mustmatch-p))) | |
694 | (list (expand-file-name (substitute-in-file-name ans))))) | |
695 | ||
696 | \f | |
697 | ;;; Simple process query facility. | |
698 | ;;; =========================================================================== | |
699 | ;;; This function is for commands that want to send a query to the process | |
700 | ;;; and show the response to the user. For example, a command to get the | |
701 | ;;; arglist for a Common Lisp function might send a "(arglist 'foo)" query | |
702 | ;;; to an inferior Common Lisp process. | |
703 | ;;; | |
704 | ;;; This simple facility just sends strings to the inferior process and pops | |
705 | ;;; up a window for the process buffer so you can see what the process | |
706 | ;;; responds with. We don't do anything fancy like try to intercept what the | |
707 | ;;; process responds with and put it in a pop-up window or on the message | |
708 | ;;; line. We just display the buffer. Low tech. Simple. Works good. | |
709 | ||
710 | ;;; Send to the inferior process PROC the string STR. Pop-up but do not select | |
711 | ;;; a window for the inferior process so that its response can be seen. | |
712 | (defun comint-proc-query (proc str) | |
713 | (let* ((proc-buf (process-buffer proc)) | |
714 | (proc-mark (process-mark proc))) | |
715 | (display-buffer proc-buf) | |
716 | (set-buffer proc-buf) ; but it's not the selected *window* | |
717 | (let ((proc-win (get-buffer-window proc-buf)) | |
718 | (proc-pt (marker-position proc-mark))) | |
719 | (comint-send-string proc str) ; send the query | |
720 | (accept-process-output proc) ; wait for some output | |
721 | ;; Try to position the proc window so you can see the answer. | |
722 | ;; This is bogus code. If you delete the (sit-for 0), it breaks. | |
723 | ;; I don't know why. Wizards invited to improve it. | |
724 | (if (not (pos-visible-in-window-p proc-pt proc-win)) | |
725 | (let ((opoint (window-point proc-win))) | |
726 | (set-window-point proc-win proc-mark) (sit-for 0) | |
727 | (if (not (pos-visible-in-window-p opoint proc-win)) | |
728 | (push-mark opoint) | |
729 | (set-window-point proc-win opoint))))))) | |
730 | ||
731 | \f | |
732 | ;;; Filename completion in a buffer | |
733 | ;;; =========================================================================== | |
734 | ;;; Useful completion functions, courtesy of the Ergo group. | |
735 | ;;; M-<Tab> will complete the filename at the cursor as much as possible | |
736 | ;;; M-? will display a list of completions in the help buffer. | |
737 | ||
738 | ;;; Three commands: | |
739 | ;;; comint-dynamic-complete Complete filename at point. | |
740 | ;;; comint-dynamic-list-completions List completions in help buffer. | |
741 | ;;; comint-replace-by-expanded-filename Expand and complete filename at point; | |
742 | ;;; replace with expanded/completed name. | |
743 | ||
744 | ;;; These are not installed in the comint-mode keymap. But they are | |
745 | ;;; available for people who want them. Shell-mode-map uses them, though. | |
746 | ||
747 | (defun comint-match-partial-pathname () | |
748 | "Returns the string of an existing filename or causes an error." | |
749 | (if (save-excursion (backward-char 1) (looking-at "\\s ")) "" | |
750 | (save-excursion | |
751 | (re-search-backward "[^~/A-Za-z0-9---_.$#,]+") | |
752 | (re-search-forward "[~/A-Za-z0-9---_.$#,]+") | |
753 | (substitute-in-file-name | |
754 | (buffer-substring (match-beginning 0) (match-end 0)))))) | |
755 | ||
756 | (defun comint-replace-by-expanded-filename () | |
757 | "Replace the filename at point with its expanded, canonicalised completion. | |
758 | \"Expanded\" means environment variables (e.g., $HOME) and ~'s are | |
759 | replaced with the corresponding directories. \"Canonicalised\" means .. | |
760 | and . are removed, and the filename is made absolute instead of relative. | |
761 | See functions expand-file-name and substitute-in-file-name. See also | |
762 | comint-dynamic-complete." | |
763 | (interactive) | |
764 | (let* ((pathname (comint-match-partial-pathname)) | |
765 | (pathdir (file-name-directory pathname)) | |
766 | (pathnondir (file-name-nondirectory pathname)) | |
767 | (completion (file-name-completion pathnondir | |
768 | (or pathdir default-directory)))) | |
769 | (cond ((null completion) | |
770 | (error "No completions")) | |
771 | ((eql completion t) | |
772 | (message "Sole completion")) | |
773 | (t ; this means a string was returned. | |
774 | (delete-region (match-beginning 0) (match-end 0)) | |
775 | (insert (expand-file-name (concat pathdir completion))))))) | |
776 | ||
777 | (defun comint-dynamic-complete () | |
778 | "Complete the filename at point. | |
779 | This function is similar to comint-replace-by-expanded-filename, except | |
780 | that it won't change parts of the filename already entered in the buffer; | |
781 | it just adds completion characters to the end of the filename." | |
782 | (interactive) | |
783 | (let* ((pathname (comint-match-partial-pathname)) | |
784 | (pathdir (file-name-directory pathname)) | |
785 | (pathnondir (file-name-nondirectory pathname)) | |
786 | (completion (file-name-completion pathnondir | |
787 | (or pathdir default-directory)))) | |
788 | (cond ((null completion) | |
789 | (error "No completions")) | |
790 | ((eql completion t) | |
791 | (error "Sole completion")) | |
792 | (t ; this means a string was returned. | |
793 | (goto-char (match-end 0)) | |
794 | (insert (substring completion (length pathnondir))))))) | |
795 | ||
796 | (defun comint-dynamic-list-completions () | |
797 | "List all possible completions of the filename at point." | |
798 | (interactive) | |
799 | (let* ((pathname (comint-match-partial-pathname)) | |
800 | (pathdir (file-name-directory pathname)) | |
801 | (pathnondir (file-name-nondirectory pathname)) | |
802 | (completions | |
803 | (file-name-all-completions pathnondir | |
804 | (or pathdir default-directory)))) | |
805 | (cond ((null completions) | |
806 | (error "No completions")) | |
807 | (t | |
808 | (let ((conf (current-window-configuration))) | |
809 | (with-output-to-temp-buffer " *Completions*" | |
810 | (display-completion-list completions)) | |
811 | (sit-for 0) | |
812 | (message "Hit space to flush.") | |
813 | (let ((ch (read-char))) | |
814 | (if (= ch ?\ ) | |
815 | (set-window-configuration conf) | |
816 | (setq unread-command-char ch)))))))) | |
817 | ||
818 | \f | |
819 | ;;; Converting process modes to use comint mode | |
820 | ;;; =========================================================================== | |
821 | ;;; Renaming variables | |
822 | ;;; Most of the work is renaming variables and functions. | |
823 | ;;; These are the common ones. | |
824 | ||
825 | ;;; Local variables -- | |
826 | ;;; last-input-end comint-last-input-end | |
827 | ;;; last-input-start <unnecessary> | |
828 | ;;; shell-prompt-pattern comint-prompt-regexp | |
829 | ;;; shell-set-directory-error-hook <no equivalent> | |
830 | ;;; Miscellaneous -- | |
831 | ;;; shell-set-directory <unnecessary> | |
832 | ;;; shell-mode-map comint-mode-map | |
833 | ;;; Commands -- | |
834 | ;;; shell-send-input comint-send-input | |
835 | ;;; shell-send-eof comint-delchar-or-maybe-eof | |
836 | ;;; kill-shell-input comint-kill-input | |
837 | ;;; interrupt-shell-subjob comint-interrupt-subjob | |
838 | ;;; stop-shell-subjob comint-stop-subjob | |
839 | ;;; quit-shell-subjob comint-quit-subjob | |
840 | ;;; kill-shell-subjob comint-kill-subjob | |
841 | ;;; kill-output-from-shell comint-kill-output | |
842 | ;;; show-output-from-shell comint-show-output | |
843 | ;;; copy-last-shell-input Use comint-previous-input/comint-next-input | |
844 | ;;; | |
845 | ;;; LAST-INPUT-START is no longer necessary because inputs are stored on the | |
846 | ;;; input history ring. SHELL-SET-DIRECTORY is gone, its functionality taken | |
847 | ;;; over by SHELL-DIRECTORY-TRACKER, the shell mode's comint-input-sentinel. | |
848 | ;;; Comint mode does not provide functionality equivalent to | |
849 | ;;; shell-set-directory-error-hook; it is gone. | |
850 | ;;; | |
851 | ;;; If you are implementing some process-in-a-buffer mode, called foo-mode, do | |
852 | ;;; *not* create the comint-mode local variables in your foo-mode function. | |
853 | ;;; This is not modular. Instead, call comint-mode, and let *it* create the | |
854 | ;;; necessary comint-specific local variables. Then create the | |
855 | ;;; foo-mode-specific local variables in foo-mode. Set the buffer's keymap to | |
856 | ;;; be foo-mode-map, and its mode to be foo-mode. Set the comint-mode hooks | |
857 | ;;; (comint-prompt-regexp, comint-input-filter, comint-input-sentinel, | |
858 | ;;; comint-get-old-input) that need to be different from the defaults. Call | |
859 | ;;; foo-mode-hook, and you're done. Don't run the comint-mode hook yourself; | |
860 | ;;; comint-mode will take care of it. | |
861 | ;;; | |
862 | ;;; Note that make-comint is different from make-shell in that it | |
863 | ;;; doesn't have a default program argument. If you give make-shell | |
864 | ;;; a program name of NIL, it cleverly chooses one of explicit-shell-name, | |
865 | ;;; $ESHELL, $SHELL, or /bin/sh. If you give make-comint a program argument | |
866 | ;;; of NIL, it barfs. Adjust your code accordingly... |