comint.el 58.1 KB
Newer Older
Eric S. Raymond's avatar
Eric S. Raymond committed
1
;;; comint.el --- general command interpreter in a window stuff
2

3
;; Copyright (C) 1988, 1990, 1992, 1993 Free Software Foundation, Inc.
Eric S. Raymond's avatar
Eric S. Raymond committed
4

5
;; Author: Olin Shivers <shivers@cs.cmu.edu>
Eric S. Raymond's avatar
Eric S. Raymond committed
6
;; Keywords: processes
Eric S. Raymond's avatar
Eric S. Raymond committed
7

8
;; This file is part of GNU Emacs.
David Lawrence's avatar
David Lawrence committed
9

10 11 12 13
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
David Lawrence's avatar
David Lawrence committed
14

15 16 17 18
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.
David Lawrence's avatar
David Lawrence committed
19

20 21 22
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
David Lawrence's avatar
David Lawrence committed
23

Eric S. Raymond's avatar
Eric S. Raymond committed
24 25
;;; Commentary:

Jim Blandy's avatar
Jim Blandy committed
26 27 28 29 30 31
;;; The changelog is at the end of this file.

;;; Please send me bug reports, bug fixes, and extensions, so that I can
;;; merge them into the master source.
;;;     - Olin Shivers (shivers@cs.cmu.edu)

David Lawrence's avatar
David Lawrence committed
32 33 34 35 36 37 38
;;; This file defines a general command-interpreter-in-a-buffer package
;;; (comint mode). The idea is that you can build specific process-in-a-buffer
;;; modes on top of comint mode -- e.g., lisp, shell, scheme, T, soar, ....
;;; This way, all these specific packages share a common base functionality, 
;;; and a common set of bindings, which makes them easier to use (and
;;; saves code, implementation time, etc., etc.).

Jim Blandy's avatar
Jim Blandy committed
39
;;; Several packages are already defined using comint mode:
40
;;; - shell.el defines a shell-in-a-buffer mode.
Jim Blandy's avatar
Jim Blandy committed
41 42 43 44 45 46 47 48 49 50
;;; - cmulisp.el defines a simple lisp-in-a-buffer mode.
;;;
;;; - The file cmuscheme.el defines a scheme-in-a-buffer mode.
;;; - The file tea.el tunes scheme and inferior-scheme modes for T.
;;; - The file soar.el tunes lisp and inferior-lisp modes for Soar.
;;; - cmutex.el defines tex and latex modes that invoke tex, latex, bibtex,
;;;   previewers, and printers from within emacs.
;;; - background.el allows csh-like job control inside emacs.
;;; It is pretty easy to make new derived modes for other processes.

David Lawrence's avatar
David Lawrence committed
51 52 53 54 55
;;; For documentation on the functionality provided by comint mode, and
;;; the hooks available for customising it, see the comments below.
;;; For further information on the standard derived modes (shell, 
;;; inferior-lisp, inferior-scheme, ...), see the relevant source files.

Jim Blandy's avatar
Jim Blandy committed
56 57
;;; For hints on converting existing process modes (e.g., tex-mode,
;;; background, dbx, gdb, kermit, prolog, telnet) to use comint-mode
David Lawrence's avatar
David Lawrence committed
58 59 60
;;; instead of shell-mode, see the notes at the end of this file.


Jim Blandy's avatar
Jim Blandy committed
61 62
;;; Brief Command Documentation:
;;;============================================================================
63
;;; Comint Mode Commands: (common to all derived modes, like shell & cmulisp
Jim Blandy's avatar
Jim Blandy committed
64 65 66 67
;;; mode)
;;;
;;; m-p	    comint-previous-input    	    Cycle backwards in input history
;;; m-n	    comint-next-input  	    	    Cycle forwards
68 69
;;; m-r     comint-previous-matching-input   Previous input matching a regexp
;;; m-s     comint-next-matching-input       Next input that matches
Jim Blandy's avatar
Jim Blandy committed
70 71 72 73 74 75 76 77 78 79 80
;;; return  comint-send-input
;;; c-a     comint-bol                      Beginning of line; skip prompt.
;;; c-d	    comint-delchar-or-maybe-eof     Delete char unless at end of buff.
;;; c-c c-u comint-kill-input	    	    ^u
;;; c-c c-w backward-kill-word    	    ^w
;;; c-c c-c comint-interrupt-subjob 	    ^c
;;; c-c c-z comint-stop-subjob	    	    ^z
;;; c-c c-\ comint-quit-subjob	    	    ^\
;;; c-c c-o comint-kill-output		    Delete last batch of process output
;;; c-c c-r comint-show-output		    Show last batch of process output
;;;
David Lawrence's avatar
David Lawrence committed
81 82 83 84 85 86 87
;;; Not bound by default in comint-mode
;;; send-invisible			Read a line w/o echo, and send to proc
;;; (These are bound in shell-mode)
;;; comint-dynamic-complete		Complete filename at point.
;;; comint-dynamic-list-completions	List completions in help buffer.
;;; comint-replace-by-expanded-filename	Expand and complete filename at point;
;;;					replace with expanded/completed name.
Jim Blandy's avatar
Jim Blandy committed
88 89 90 91 92 93 94 95 96 97 98 99 100
;;; comint-kill-subjob			No mercy.
;;; comint-continue-subjob		Send CONT signal to buffer's process
;;;					group. Useful if you accidentally
;;;					suspend your process (with C-c C-z).
;;;
;;; These used to be bound for RMS -- I prefer the input history stuff,
;;; but you might like 'em.
;;; m-P	   comint-msearch-input		Search backwards for prompt
;;; m-N    comint-psearch-input		Search forwards for prompt
;;; C-cR   comint-msearch-input-matching Search backwards for prompt & string

;;; comint-mode-hook is the comint mode hook. Basically for your keybindings.
;;; comint-load-hook is run after loading in this package.
David Lawrence's avatar
David Lawrence committed
101

Eric S. Raymond's avatar
Eric S. Raymond committed
102 103 104 105
;;; Code:

(defconst comint-version "2.03")

Richard M. Stallman's avatar
Richard M. Stallman committed
106
(require 'ring)
David Lawrence's avatar
David Lawrence committed
107 108 109 110 111

;;; Buffer Local Variables:
;;;============================================================================
;;; Comint mode buffer local variables:
;;;     comint-prompt-regexp    - string       comint-bol uses to match prompt.
Jim Blandy's avatar
Jim Blandy committed
112
;;;     comint-last-input-start - marker       Handy if inferior always echos
Jim Blandy's avatar
Jim Blandy committed
113
;;;     comint-last-input-end   - marker       For comint-kill-output command
114 115
;;;     comint-input-ring-size  - integer      For the input history
;;;     comint-input-ring       - ring             mechanism
116
;;;     comint-input-ring-index - number           ...
David Lawrence's avatar
David Lawrence committed
117 118 119 120 121 122
;;;     comint-last-input-match - string           ...
;;;     comint-get-old-input    - function     Hooks for specific 
;;;     comint-input-sentinel   - function         process-in-a-buffer
;;;     comint-input-filter     - function         modes.
;;;     comint-input-send	- function
;;;     comint-eol-on-send	- boolean
Noah Friedman's avatar
Noah Friedman committed
123
;;;     comint-process-echoes   - boolean
David Lawrence's avatar
David Lawrence committed
124

Jim Blandy's avatar
Jim Blandy committed
125 126 127
(defvar comint-prompt-regexp "^"
  "Regexp to recognise prompts in the inferior process.
Defaults to \"^\", the null string at BOL.
David Lawrence's avatar
David Lawrence committed
128 129

Good choices:
Jim Blandy's avatar
Jim Blandy committed
130
  Canonical Lisp: \"^[^> ]*>+:? *\" (Lucid, franz, kcl, T, cscheme, oaklisp)
David Lawrence's avatar
David Lawrence committed
131
  Lucid Common Lisp: \"^\\(>\\|\\(->\\)+\\) *\"
Jim Blandy's avatar
Jim Blandy committed
132 133 134 135
  franz: \"^\\(->\\|<[0-9]*>:\\) *\"
  kcl: \"^>+ *\"
  shell: \"^[^#$%>]*[#$%>] *\"
  T: \"^>+ *\"
David Lawrence's avatar
David Lawrence committed
136

Jim Blandy's avatar
Jim Blandy committed
137
This is a good thing to set in mode hooks.")
David Lawrence's avatar
David Lawrence committed
138

139
(defvar comint-input-ring-size 30
Jim Blandy's avatar
Jim Blandy committed
140
  "Size of input history ring.")
David Lawrence's avatar
David Lawrence committed
141

Noah Friedman's avatar
Noah Friedman committed
142
(defvar comint-process-echoes nil
143
  "*If non-nil, assume that the subprocess echoes any input.
Noah Friedman's avatar
Noah Friedman committed
144 145 146 147 148
If so, delete one copy of the input so that only one copy eventually
appears in the buffer. 

This variable is buffer-local.")

David Lawrence's avatar
David Lawrence committed
149
;;; Here are the per-interpreter hooks.
Jim Blandy's avatar
Jim Blandy committed
150 151
(defvar comint-get-old-input (function comint-get-old-input-default)
  "Function that submits old text in comint mode.
David Lawrence's avatar
David Lawrence committed
152 153
This function is called when return is typed while the point is in old text.
It returns the text to be submitted as process input.  The default is
154 155
`comint-get-old-input-default', which grabs the current line, and strips off
leading text matching `comint-prompt-regexp'.")
David Lawrence's avatar
David Lawrence committed
156

Jim Blandy's avatar
Jim Blandy committed
157
(defvar comint-input-sentinel (function ignore)
158
  "Called on each input submitted to comint mode process by `comint-send-input'.
Jim Blandy's avatar
Jim Blandy committed
159
Thus it can, for instance, track cd/pushd/popd commands issued to the csh.")
David Lawrence's avatar
David Lawrence committed
160

Jim Blandy's avatar
Jim Blandy committed
161 162 163
(defvar comint-input-filter
  (function (lambda (str) (not (string-match "\\`\\s *\\'" str))))
  "Predicate for filtering additions to input history.
David Lawrence's avatar
David Lawrence committed
164
Only inputs answering true to this function are saved on the input
165
history list.  Default is to save anything that isn't all whitespace")
Jim Blandy's avatar
Jim Blandy committed
166 167 168

(defvar comint-input-sender (function comint-simple-send)
  "Function to actually send to PROCESS the STRING submitted by user.
169 170 171 172
Usually this is just `comint-simple-send', but if your mode needs to 
massage the input string, put a different function here.
`comint-simple-send' just sends the string plus a newline.
This is called from the user command `comint-send-input'.")
Jim Blandy's avatar
Jim Blandy committed
173

174 175 176
(defvar comint-eol-on-send t
  "*Non-nil means go to the end of the line before sending input to process.
See `comint-send-input'.")
David Lawrence's avatar
David Lawrence committed
177 178

(defvar comint-mode-hook '()
Jim Blandy's avatar
Jim Blandy committed
179 180 181 182
  "Called upon entry into comint-mode
This is run before the process is cranked up.")

(defvar comint-exec-hook '()
183
  "Called each time a process is exec'd by `comint-exec'.
Jim Blandy's avatar
Jim Blandy committed
184
This is called after the process is cranked up.  It is useful for things that
185 186
must be done each time a process is executed in a comint mode buffer (e.g.,
`(process-kill-without-query)').  In contrast, the `comint-mode-hook' is only
Jim Blandy's avatar
Jim Blandy committed
187 188 189
executed once when the buffer is created.")

(defvar comint-mode-map nil)
David Lawrence's avatar
David Lawrence committed
190

Richard M. Stallman's avatar
Richard M. Stallman committed
191 192
(defvar comint-ptyp t
  "True if communications via pty; false if by pipe.  Buffer local.
193
This is to work around a bug in Emacs process signalling.")
Richard M. Stallman's avatar
Richard M. Stallman committed
194

195 196 197
;;(defvar comint-last-input-match ""
;;  "Last string searched for by comint input history search, for defaulting.
;;Buffer local variable.") 
198

199
(defvar comint-input-ring nil)
200 201
(defvar comint-last-input-start)
(defvar comint-last-input-end)
Richard M. Stallman's avatar
Richard M. Stallman committed
202 203 204
(defvar comint-input-ring-index)
(put 'comint-input-ring 'permanent-local t)
(put 'comint-ptyp 'permanent-local t)
205

David Lawrence's avatar
David Lawrence committed
206 207 208 209 210
(defun comint-mode ()
  "Major mode for interacting with an inferior interpreter.
Interpreter name is same as buffer name, sans the asterisks.
Return at end of buffer sends line as input.
Return not at end copies rest of line to end and sends it.
211
Setting variable `comint-eol-on-send' means jump to the end of the line
Jim Blandy's avatar
Jim Blandy committed
212
before submitting new input.
David Lawrence's avatar
David Lawrence committed
213

214 215 216 217 218
This mode is typically customised to create Inferior Lisp mode,
Shell mode, etc.  This can be done by setting the hooks
`comint-input-sentinel', `comint-input-filter', `comint-input-sender' and
`comint-get-old-input' to appropriate functions, and the variable
`comint-prompt-regexp' to the appropriate regular expression.
David Lawrence's avatar
David Lawrence committed
219

220 221 222 223
An input history is maintained of size `comint-input-ring-size', and
can be accessed with the commands \\[comint-next-input] and \\[comint-previous-input].
Commands with no default key bindings include `send-invisible',
`comint-dynamic-complete', and `comint-list-dynamic-completions'.
David Lawrence's avatar
David Lawrence committed
224 225 226 227 228 229

If you accidentally suspend your process, use \\[comint-continue-subjob]
to continue it.

\\{comint-mode-map}

Jim Blandy's avatar
Jim Blandy committed
230
Entry to this mode runs the hooks on comint-mode-hook"
David Lawrence's avatar
David Lawrence committed
231
  (interactive)
Richard M. Stallman's avatar
Richard M. Stallman committed
232 233
    ;; Do not remove this.  All major modes must do this.
    (kill-all-local-variables)
Jim Blandy's avatar
Jim Blandy committed
234 235 236 237
    (setq major-mode 'comint-mode)
    (setq mode-name "Comint")
    (setq mode-line-process '(": %s"))
    (use-local-map comint-mode-map)
Jim Blandy's avatar
Jim Blandy committed
238 239
    (make-local-variable 'comint-last-input-start)
    (setq comint-last-input-start (make-marker))
Jim Blandy's avatar
Jim Blandy committed
240 241
    (make-local-variable 'comint-last-input-end)
    (setq comint-last-input-end (make-marker))
242 243
;;;    (make-local-variable 'comint-last-input-match)
;;;    (setq comint-last-input-match "")
Jim Blandy's avatar
Jim Blandy committed
244
    (make-local-variable 'comint-prompt-regexp) ; Don't set; default
245 246 247 248
    (make-local-variable 'comint-input-ring-size)      ; ...to global val.
    (make-local-variable 'comint-input-ring)
    (make-local-variable 'comint-input-ring-index)
    (setq comint-input-ring-index 0)
Jim Blandy's avatar
Jim Blandy committed
249 250 251 252 253 254
    (make-local-variable 'comint-get-old-input)
    (make-local-variable 'comint-input-sentinel)
    (make-local-variable 'comint-input-filter)  
    (make-local-variable 'comint-input-sender)
    (make-local-variable 'comint-eol-on-send)
    (make-local-variable 'comint-ptyp)
Jim Blandy's avatar
Jim Blandy committed
255
    (make-local-variable 'comint-exec-hook)
Noah Friedman's avatar
Noah Friedman committed
256
    (make-local-variable 'comint-process-echoes)
Jim Blandy's avatar
Jim Blandy committed
257
    (run-hooks 'comint-mode-hook)
Richard M. Stallman's avatar
Richard M. Stallman committed
258 259
    (or comint-input-ring
	(setq comint-input-ring (make-ring comint-input-ring-size))))
David Lawrence's avatar
David Lawrence committed
260

Jim Blandy's avatar
Jim Blandy committed
261 262 263 264 265
(if comint-mode-map
    nil
  (setq comint-mode-map (make-sparse-keymap))
  (define-key comint-mode-map "\ep" 'comint-previous-input)
  (define-key comint-mode-map "\en" 'comint-next-input)
266 267
  (define-key comint-mode-map "\er" 'comint-previous-matching-input)
  (define-key comint-mode-map "\es" 'comint-next-matching-input)
Jim Blandy's avatar
Jim Blandy committed
268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288
  (define-key comint-mode-map "\C-m" 'comint-send-input)
  (define-key comint-mode-map "\C-d" 'comint-delchar-or-maybe-eof)
  (define-key comint-mode-map "\C-a" 'comint-bol)
  (define-key comint-mode-map "\C-c\C-u" 'comint-kill-input)
  (define-key comint-mode-map "\C-c\C-w" 'backward-kill-word)
  (define-key comint-mode-map "\C-c\C-c" 'comint-interrupt-subjob)
  (define-key comint-mode-map "\C-c\C-z" 'comint-stop-subjob)
  (define-key comint-mode-map "\C-c\C-\\" 'comint-quit-subjob)
  (define-key comint-mode-map "\C-c\C-o" 'comint-kill-output)
  (define-key comint-mode-map "\C-c\C-r" 'comint-show-output)
  ;;; prompt-search commands commented out 3/90 -Olin
; (define-key comint-mode-map "\eP" 'comint-msearch-input)
; (define-key comint-mode-map "\eN" 'comint-psearch-input)
; (define-key comint-mode-map "\C-cR" 'comint-msearch-input-matching)
  )


;;; This function is used to make a full copy of the comint mode map,
;;; so that client modes won't interfere with each other. This function
;;; isn't necessary in emacs 18.5x, but we keep it around for 18.4x versions.
(defun full-copy-sparse-keymap (km)
289
  "Recursively copy the sparse keymap KM."
Jim Blandy's avatar
Jim Blandy committed
290 291 292 293 294 295
  (cond ((consp km)
	 (cons (full-copy-sparse-keymap (car km))
	       (full-copy-sparse-keymap (cdr km))))
	(t km)))

(defun comint-check-proc (buffer)
296 297 298
  "True if there is a living process associated w/buffer BUFFER.
Living means the status is `run' or `stop'.
BUFFER can be either a buffer or the name of one."
Jim Blandy's avatar
Jim Blandy committed
299 300
  (let ((proc (get-buffer-process buffer)))
    (and proc (memq (process-status proc) '(run stop)))))
David Lawrence's avatar
David Lawrence committed
301 302 303

;;; Note that this guy, unlike shell.el's make-shell, barfs if you pass it ()
;;; for the second argument (program).
304
;;;###autoload
David Lawrence's avatar
David Lawrence committed
305
(defun make-comint (name program &optional startfile &rest switches)
306 307 308 309 310
  "Make a comint process NAME in a buffer, running PROGRAM.
The name of the buffer is made by surrounding NAME with `*'s.
If there is already a running process in that buffer, it is not restarted.
Optional third arg STARTFILE is the name of a file to send the contents of to 
the process.  Any more args are arguments to PROGRAM."
Jim Blandy's avatar
Jim Blandy committed
311
  (let ((buffer (get-buffer-create (concat "*" name "*"))))
David Lawrence's avatar
David Lawrence committed
312
    ;; If no process, or nuked process, crank up a new one and put buffer in
313
    ;; comint mode.  Otherwise, leave buffer and existing process alone.
Jim Blandy's avatar
Jim Blandy committed
314
    (cond ((not (comint-check-proc buffer))
Jim Blandy's avatar
Jim Blandy committed
315
	   (save-excursion
David Lawrence's avatar
David Lawrence committed
316 317 318 319 320 321
	     (set-buffer buffer)
	     (comint-mode)) ; Install local vars, mode, keymap, ...
	   (comint-exec buffer name program startfile switches)))
    buffer))

(defun comint-exec (buffer name command startfile switches)
322
  "Start up a process in buffer BUFFER for comint modes.
323
Blasts any old process running in the buffer.  Doesn't set the buffer mode.
Jim Blandy's avatar
Jim Blandy committed
324
You can use this to cheaply run a series of processes in the same comint
325
buffer.  The hook `comint-exec-hook' is run after each exec."
David Lawrence's avatar
David Lawrence committed
326 327 328 329 330 331
  (save-excursion
    (set-buffer buffer)
    (let ((proc (get-buffer-process buffer)))	; Blast any old process.
      (if proc (delete-process proc)))
    ;; Crank up a new process
    (let ((proc (comint-exec-1 name buffer command switches)))
332
      (set-process-filter proc 'comint-filter)
Jim Blandy's avatar
Jim Blandy committed
333 334
      (make-local-variable 'comint-ptyp)
      (setq comint-ptyp process-connection-type) ; T if pty, NIL if pipe.
David Lawrence's avatar
David Lawrence committed
335
      ;; Jump to the end, and set the process mark.
Jim Blandy's avatar
Jim Blandy committed
336
      (goto-char (point-max))
Jim Blandy's avatar
Jim Blandy committed
337
      (set-marker (process-mark proc) (point))
David Lawrence's avatar
David Lawrence committed
338 339 340 341 342 343 344 345 346 347 348 349
      ;; Feed it the startfile.
      (cond (startfile
	     ;;This is guaranteed to wait long enough
	     ;;but has bad results if the comint does not prompt at all
	     ;;	     (while (= size (buffer-size))
	     ;;	       (sleep-for 1))
	     ;;I hope 1 second is enough!
	     (sleep-for 1)
	     (goto-char (point-max))
	     (insert-file-contents startfile)
	     (setq startfile (buffer-substring (point) (point-max)))
	     (delete-region (point) (point-max))
Jim Blandy's avatar
Jim Blandy committed
350 351
	     (comint-send-string proc startfile)))
    (run-hooks 'comint-exec-hook)
Jim Blandy's avatar
Jim Blandy committed
352
    buffer)))
David Lawrence's avatar
David Lawrence committed
353 354

;;; This auxiliary function cranks up the process for comint-exec in
Jim Blandy's avatar
Jim Blandy committed
355
;;; the appropriate environment.
David Lawrence's avatar
David Lawrence committed
356 357

(defun comint-exec-1 (name buffer command switches)
Jim Blandy's avatar
Jim Blandy committed
358 359 360
  (let ((process-environment
	 (comint-update-env process-environment
			    (list (format "TERMCAP=emacs:co#%d:tc=unknown"
Jim Blandy's avatar
Jim Blandy committed
361
					  (frame-width))
Jim Blandy's avatar
Jim Blandy committed
362 363 364
				  "TERM=emacs"
				  "EMACS=t"))))
    (apply 'start-process name buffer command switches)))
Jim Blandy's avatar
Jim Blandy committed
365 366
	     

David Lawrence's avatar
David Lawrence committed
367 368

;; This is just (append new old-env) that compresses out shadowed entries.
Eric S. Raymond's avatar
Eric S. Raymond committed
369
;; It's also pretty ugly, mostly due to lisp's horrible iteration structures.
David Lawrence's avatar
David Lawrence committed
370 371 372 373 374 375 376 377 378 379 380
(defun comint-update-env (old-env new)
  (let ((ans (reverse new))
	(vars (mapcar (function (lambda (vv)
			(and (string-match "^[^=]*=" vv)
			     (substring vv 0 (match-end 0)))))
		      new)))
    (while old-env
      (let* ((vv (car old-env)) ; vv is var=value
	     (var (and (string-match "^[^=]*=" vv)
		       (substring vv 0 (match-end 0)))))
	(setq old-env (cdr old-env))
381
	(cond ((not (and var (member var vars)))
David Lawrence's avatar
David Lawrence committed
382 383 384
	       (if var (setq var (cons var vars)))
	       (setq ans (cons vv ans))))))
    (nreverse ans)))
Jim Blandy's avatar
Jim Blandy committed
385

David Lawrence's avatar
David Lawrence committed
386 387 388

;;; Input history retrieval commands
;;; M-p -- previous input    M-n -- next input
Jim Blandy's avatar
Jim Blandy committed
389
;;; M-C-r -- previous input matching
David Lawrence's avatar
David Lawrence committed
390 391 392 393 394
;;; ===========================================================================

(defun comint-previous-input (arg)
  "Cycle backwards through input history."
  (interactive "*p")
395
  (let ((len (ring-length comint-input-ring)))
Jim Blandy's avatar
Jim Blandy committed
396 397 398 399 400 401 402
    (cond ((<= len 0)
	   (message "Empty input ring")
	   (ding))
	  ((not (comint-after-pmark-p))
	   (message "Not after process mark")
	   (ding))
	  (t
403 404 405 406 407 408 409 410 411 412
	   (delete-region (point)
			  (process-mark (get-buffer-process (current-buffer))))
	   ;; Initialize the index on the first use of this command
	   ;; so that the first M-p gets index 0, and the first M-n gets
	   ;; index -1.
	   (if (null comint-input-ring-index)
	       (setq comint-input-ring-index
		     (if (> arg 0) -1
			 (if (< arg 0) 1 0))))
	   (setq comint-input-ring-index
413
		 (ring-mod (+ comint-input-ring-index arg) len))
414
	   (message "%d" (1+ comint-input-ring-index))
415 416
	   (insert (ring-ref comint-input-ring comint-input-ring-index))))))

David Lawrence's avatar
David Lawrence committed
417 418 419 420 421
(defun comint-next-input (arg)
  "Cycle forwards through input history."
  (interactive "*p")
  (comint-previous-input (- arg)))

422 423 424 425 426 427
(defun comint-previous-matching-input (regexp arg)
  "Search backwards through input history for match for REGEXP.
\(Previous history elements are earlier commands.)
With prefix argument N, search for Nth previous match.
If N is negative, find the next or Nth next match."
  (interactive
428 429 430 431 432 433 434 435
   (let* ((minibuffer-history-sexp-flag nil)
	  ;; Don't clobber this.
	  (last-command last-command)
	  (regexp (read-from-minibuffer "Previous input matching (regexp): "
					nil
					minibuffer-local-map
					nil
					'minibuffer-history-search-history)))
436 437 438 439 440
     (list (if (string= regexp "")
	       (setcar minibuffer-history-search-history
		       (nth 1 minibuffer-history-search-history))
	     regexp)
	   (prefix-numeric-value current-prefix-arg))))
441
  (if (null comint-input-ring-index)
442
      (setq comint-input-ring-index -1))
443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483
  (let* ((len (ring-length comint-input-ring))
	 (motion (if (> arg 0) 1 -1))
	 (n comint-input-ring-index))
    ;; Do the whole search as many times as the argument says.
    (while (/= arg 0)
      (let ((prev n))
	;; Step once.
	(setq n (ring-mod (+ n motion) len))
	;; If we haven't reached a match, step some more.
	(while (and (< n len)
		    (not (string-match regexp (ring-ref comint-input-ring n))))
	  (setq n (ring-mod (+ n motion) len))
	  ;; If we have gone all the way around in this search, error.
	  (if (= n prev)
	      (error "Not found"))))
      (setq arg (if (> arg 0) (1- arg) (1+ arg))))
    ;; Now that we know which ring element to use,
    ;; substitute that for the current input.
    (comint-previous-input (- n comint-input-ring-index))))

(defun comint-next-matching-input (regexp arg)
  "Search forwards through input history for match for REGEXP.
\(Later history elements are more recent commands.)
With prefix argument N, search for Nth following match.
If N is negative, find the previous or Nth previous match."
  (interactive
   (let ((minibuffer-history-sexp-flag nil)
	 ;; Don't clobber this.
	 (last-command last-command)
	 (regexp (read-from-minibuffer "Previous input matching (regexp): "
				       nil
				       minibuffer-local-map
				       nil
				       'minibuffer-history-search-history)))
     (list (if (string= regexp "")
	       (setcar minibuffer-history-search-history
		       (nth 1 minibuffer-history-search-history))
	     regexp)
	   (prefix-numeric-value current-prefix-arg))))
  (comint-previous-matching-input regexp (- arg)))

Jim Blandy's avatar
Jim Blandy committed
484
;;; These next three commands are alternatives to the input history commands
485
;;; They search through the process buffer
Jim Blandy's avatar
Jim Blandy committed
486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535
;;; text looking for occurrences of the prompt.  Bound to M-P, M-N, and C-c R
;;; (uppercase P, N, and R) for now. Try'em out. Go with what you like...

;;; comint-msearch-input-matching prompts for a string, not a regexp.
;;; This could be considered to be the wrong thing. I decided to keep it
;;; simple, and not make the user worry about regexps. This, of course,
;;; limits functionality.

;;; These commands were deemed non-winning and have been commented out.
;;; Feel free to re-enable them if you like. -Olin 3/91

;(defun comint-psearch-input ()
;  "Search forwards for next occurrence of prompt and skip to end of line.
;\(prompt is anything matching regexp comint-prompt-regexp)"
;  (interactive)
;  (if (re-search-forward comint-prompt-regexp (point-max) t)
;      (end-of-line)
;      (error "No occurrence of prompt found")))
;
;(defun comint-msearch-input ()
;  "Search backwards for previous occurrence of prompt and skip to end of line.
;Search starts from beginning of current line."
;  (interactive)
;  (let ((p (save-excursion
;	     (beginning-of-line)
;	     (cond ((re-search-backward comint-prompt-regexp (point-min) t)
;		    (end-of-line)
;		    (point))
;		   (t nil)))))
;    (if p (goto-char p)
;	(error "No occurrence of prompt found"))))
;
;(defun comint-msearch-input-matching (str)
;  "Search backwards for occurrence of prompt followed by STRING.
;STRING is prompted for, and is NOT a regular expression."
;  (interactive (let ((s (read-from-minibuffer 
;			 (format "Command (default %s): "
;				 comint-last-input-match))))
;		 (list (if (string= s "") comint-last-input-match s))))
;; (interactive "sCommand: ")
;  (setq comint-last-input-match str) ; update default
;  (let* ((r (concat comint-prompt-regexp (regexp-quote str)))
;	 (p (save-excursion
;	      (beginning-of-line)
;	      (cond ((re-search-backward r (point-min) t)
;		     (end-of-line)
;		     (point))
;		    (t nil)))))
;    (if p (goto-char p)
;	(error "No match"))))
David Lawrence's avatar
David Lawrence committed
536 537 538 539 540 541

;;;
;;; Similar input -- contributed by ccm and highly winning.
;;;
;;; Reenter input, removing back to the last insert point if it exists. 
;;;
542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588
;;(defvar comint-last-similar-string "" 
;;  "The string last used in a similar string search.")

;;(defun comint-previous-similar-input (arg)
;;  "Fetch the previous (older) input that matches the string typed so far.
;;Successive repetitions find successively older matching inputs.
;;A prefix argument serves as a repeat count; a negative argument
;;fetches following (more recent) inputs."
;;  (interactive "p")
;;  (if (not (comint-after-pmark-p))
;;      (error "Not after process mark"))
;;  (if (null comint-input-ring-index)
;;      (setq comint-input-ring-index
;;	    (if (> arg 0) -1
;;	      (if (< arg 0) 1 0))))
;;  (if (not (or (eq last-command 'comint-previous-similar-input)
;;	       (eq last-command 'comint-next-similar-input)))
;;      (setq comint-last-similar-string 
;;	    (buffer-substring 
;;	     (process-mark (get-buffer-process (current-buffer)))
;;	     (point))))
;;  (let* ((size (length comint-last-similar-string))
;;	 (len (ring-length comint-input-ring))
;;	 (n (+ comint-input-ring-index arg))
;;	 entry)
;;    (while (and (< n len) 
;;		(or (< (length (setq entry (ring-ref comint-input-ring n))) size)
;;		    (not (equal comint-last-similar-string 
;;				(substring entry 0 size)))))
;;      (setq n (+ n arg)))
;;    (cond ((< n len)
;;	   (setq comint-input-ring-index n)
;;	   (if (or (eq last-command 'comint-previous-similar-input)
;;		   (eq last-command 'comint-next-similar-input))
;;	       (delete-region (mark) (point)) ; repeat
;;	       (push-mark (point)))	      ; 1st time
;;	   (insert (substring entry size)))
;;	  (t (error "Not found")))
;;    (message "%d" (1+ comint-input-ring-index))))

;;(defun comint-next-similar-input (arg)
;;  "Fetch the next (newer) input that matches the string typed so far.
;;Successive repetitions find successively newer matching inputs.
;;A prefix argument serves as a repeat count; a negative argument
;;fetches previous (older) inputs."
;;  (interactive "p")
;;  (comint-previous-similar-input (- arg)))
David Lawrence's avatar
David Lawrence committed
589

Jim Blandy's avatar
Jim Blandy committed
590
(defun comint-send-input () 
Christopher Zaborsky's avatar
Christopher Zaborsky committed
591 592 593
  "Send input to process.
After the process output mark, sends all text from the process mark to
point as input to the process.  Before the process output mark, calls value
Noah Friedman's avatar
Noah Friedman committed
594
of variable `comint-get-old-input' to retrieve old input, copies it to the
595
process mark, and sends it.  If variable `comint-process-echoes' is nil,
Noah Friedman's avatar
Noah Friedman committed
596
a terminal newline is also inserted into the buffer and sent to the process
597 598
\(if it is non-nil, all text from the process mark to point is deleted,
since it is assumed the remote process will re-echo it).
Noah Friedman's avatar
Noah Friedman committed
599

600 601 602 603 604 605
The value of variable `comint-input-sentinel' is called on the input
before sending it.  The input is entered into the input history ring,
if the value of variable `comint-input-filter' returns non-nil when
called on the input.

If variable `comint-eol-on-send' is non-nil, then point is moved to the
Noah Friedman's avatar
Noah Friedman committed
606 607 608 609
end of line before sending the input.

`comint-get-old-input', `comint-input-sentinel', and `comint-input-filter'
are chosen according to the command interpreter running in the buffer.  E.g.,
David Lawrence's avatar
David Lawrence committed
610
If the interpreter is the csh,
Jim Blandy's avatar
Jim Blandy committed
611 612 613 614 615 616
    comint-get-old-input is the default: take the current line, discard any
        initial string matching regexp comint-prompt-regexp.
    comint-input-sentinel monitors input for \"cd\", \"pushd\", and \"popd\" 
        commands. When it sees one, it cd's the buffer.
    comint-input-filter is the default: returns T if the input isn't all white
	space.
David Lawrence's avatar
David Lawrence committed
617 618

If the comint is Lucid Common Lisp, 
Jim Blandy's avatar
Jim Blandy committed
619 620 621
    comint-get-old-input snarfs the sexp ending at point.
    comint-input-sentinel does nothing.
    comint-input-filter returns NIL if the input matches input-filter-regexp,
David Lawrence's avatar
David Lawrence committed
622 623
        which matches (1) all whitespace (2) :a, :c, etc.

624
Similarly for Soar, Scheme, etc."
David Lawrence's avatar
David Lawrence committed
625 626
  (interactive)
  ;; Note that the input string does not include its terminal newline.
Jim Blandy's avatar
Jim Blandy committed
627 628 629 630 631 632 633
  (let ((proc (get-buffer-process (current-buffer))))
    (if (not proc) (error "Current buffer has no process")
	(let* ((pmark (process-mark proc))
	       (pmark-val (marker-position pmark))
	       (input (if (>= (point) pmark-val)
			  (progn (if comint-eol-on-send (end-of-line))
				 (buffer-substring pmark (point)))
Jim Blandy's avatar
Jim Blandy committed
634 635 636 637
			(let ((copy (funcall comint-get-old-input)))
			  (goto-char pmark)
			  (insert copy)
			  copy))))
Noah Friedman's avatar
Noah Friedman committed
638 639 640
          (if comint-process-echoes
              (delete-region pmark (point))
            (insert ?\n))
641 642
	  (if (funcall comint-input-filter input)
	      (ring-insert comint-input-ring input))
Jim Blandy's avatar
Jim Blandy committed
643 644
	  (funcall comint-input-sentinel input)
	  (funcall comint-input-sender proc input)
645
	  (setq comint-input-ring-index nil)
Jim Blandy's avatar
Jim Blandy committed
646 647 648
	  (set-marker comint-last-input-start pmark)
	  (set-marker comint-last-input-end (point))
	  (set-marker (process-mark proc) (point))))))
David Lawrence's avatar
David Lawrence committed
649

650 651 652 653 654 655 656 657 658 659 660 661 662 663
;; The sole purpose of using this filter for comint processes
;; is to keep comint-last-input-end from moving forward
;; when output is inserted.
(defun comint-filter (process string)
  (let ((obuf (current-buffer))
	opoint obeg oend)
    (set-buffer (process-buffer process))
    (setq opoint (point))
    (setq obeg (point-min))
    (setq oend (point-max))
    (let ((buffer-read-only nil)
	  (nchars (length string)))
      (widen)
      (goto-char (process-mark process))
664 665
      (if (<= (point) opoint)
	  (setq opoint (+ opoint nchars)))
666 667 668 669 670 671 672
      ;; Insert after old_begv, but before old_zv.
      (if (< (point) obeg)
	  (setq obeg (+ obeg nchars)))
      (if (<= (point) oend)
	  (setq oend (+ oend nchars)))

      (insert-before-markers string)
673 674 675 676
      ;; Don't insert initial prompt outside the top of the window.
      (if (= (window-start (selected-window)) (point))
	  (set-window-start (selected-window) (- (point) (length string))))

677 678 679 680 681 682
      (and comint-last-input-end
	   (marker-buffer comint-last-input-end)
	   (= (point) comint-last-input-end)
	   (set-marker comint-last-input-end
		       (- comint-last-input-end nchars)))
      (set-marker (process-mark process) (point) nil)
683
      (force-mode-line-update))
684

685 686 687
    (narrow-to-region obeg oend)
    (goto-char opoint)
    (set-buffer obuf)))
688

David Lawrence's avatar
David Lawrence committed
689
(defun comint-get-old-input-default ()
690
  "Default for `comint-get-old-input'.
Christopher Zaborsky's avatar
Christopher Zaborsky committed
691
Take the current line, and discard any initial text matching
692
`comint-prompt-regexp'."
David Lawrence's avatar
David Lawrence committed
693
  (save-excursion
Jim Blandy's avatar
Jim Blandy committed
694 695 696 697 698 699 700
    (beginning-of-line)
    (comint-skip-prompt)
    (let ((beg (point)))
      (end-of-line)
      (buffer-substring beg (point)))))

(defun comint-skip-prompt ()
701
  "Skip past the text matching regexp `comint-prompt-regexp'.
Jim Blandy's avatar
Jim Blandy committed
702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721
If this takes us past the end of the current line, don't skip at all."
  (let ((eol (save-excursion (end-of-line) (point))))
    (if (and (looking-at comint-prompt-regexp)
	     (<= (match-end 0) eol))
	(goto-char (match-end 0)))))


(defun comint-after-pmark-p ()
  "Is point after the process output marker?"
  ;; Since output could come into the buffer after we looked at the point
  ;; but before we looked at the process marker's value, we explicitly 
  ;; serialise. This is just because I don't know whether or not emacs
  ;; services input during execution of lisp commands.
  (let ((proc-pos (marker-position
		   (process-mark (get-buffer-process (current-buffer))))))
    (<= proc-pos (point))))

(defun comint-simple-send (proc string)
  "Default function for sending to PROC input STRING.
This just sends STRING plus a newline. To override this,
722
set the hook `comint-input-sender'."
Jim Blandy's avatar
Jim Blandy committed
723 724
  (comint-send-string proc string)
  (comint-send-string proc "\n"))
David Lawrence's avatar
David Lawrence committed
725 726 727

(defun comint-bol (arg)
  "Goes to the beginning of line, then skips past the prompt, if any.
Jim Blandy's avatar
Jim Blandy committed
728 729
If a prefix argument is given (\\[universal-argument]), then no prompt skip 
-- go straight to column 0.
David Lawrence's avatar
David Lawrence committed
730

Jim Blandy's avatar
Jim Blandy committed
731
The prompt skip is done by skipping text matching the regular expression
732
`comint-prompt-regexp', a buffer local variable.
Jim Blandy's avatar
Jim Blandy committed
733

734 735
If you don't like this command, bind C-a to `beginning-of-line' 
in your hook, `comint-mode-hook'."
David Lawrence's avatar
David Lawrence committed
736 737
  (interactive "P")
  (beginning-of-line)
Jim Blandy's avatar
Jim Blandy committed
738
  (if (null arg) (comint-skip-prompt)))
David Lawrence's avatar
David Lawrence committed
739 740 741

;;; These two functions are for entering text you don't want echoed or
;;; saved -- typically passwords to ftp, telnet, or somesuch.
Jim Blandy's avatar
Jim Blandy committed
742 743
;;; Just enter m-x send-invisible and type in your line.

Jim Blandy's avatar
Jim Blandy committed
744
(defun comint-read-noecho (prompt &optional stars)
Noah Friedman's avatar
Noah Friedman committed
745 746 747 748
  "Read a single line of text from user without echoing, and return it. 
Prompt with argument PROMPT, a string.  Optional argument STARS causes
input to be echoed with '*' characters on the prompt line.  Input ends with
RET, LFD, or ESC.  DEL or C-h rubs out.  C-u kills line.  C-g aborts (if
749 750
`inhibit-quit' is set because e.g. this function was called from a process
filter and C-g is pressed, this function returns nil rather than a string).
Noah Friedman's avatar
Noah Friedman committed
751 752

Note that the keystrokes comprising the text can still be recovered
753
\(temporarily) with \\[view-lossage].  This may be a security bug for some
Noah Friedman's avatar
Noah Friedman committed
754 755 756 757
applications."
  (let ((ans "")
	(c 0)
	(echo-keystrokes 0)
Jim Blandy's avatar
Jim Blandy committed
758
	(cursor-in-echo-area t)
Noah Friedman's avatar
Noah Friedman committed
759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790
        (done nil))
    (while (not done)
      (if stars
          (message "%s%s" prompt (make-string (length ans) ?*))
        (message prompt))
      (setq c (read-char))
      (cond ((= c ?\C-g)
             ;; This function may get called from a process filter, where
             ;; inhibit-quit is set.  In later versions of emacs read-char
             ;; may clear quit-flag itself and return C-g.  That would make
             ;; it impossible to quit this loop in a simple way, so
             ;; re-enable it here (for backward-compatibility the check for
             ;; quit-flag below would still be necessary, so this is seems
             ;; like the simplest way to do things).
             (setq quit-flag t
                   done t))
            ((or (= c ?\r) (= c ?\n) (= c ?\e))
             (setq done t))
            ((= c ?\C-u)
             (setq ans ""))
            ((and (/= c ?\b) (/= c ?\177))
             (setq ans (concat ans (char-to-string c))))
            ((> (length ans) 0)
             (setq ans (substring ans 0 -1)))))
    (if quit-flag
        ;; Emulate a true quit, except that we have to return a value.
        (prog1
            (setq quit-flag nil)
          (message "Quit")
          (beep t))
      (message "")
      ans)))
Jim Blandy's avatar
Jim Blandy committed
791

David Lawrence's avatar
David Lawrence committed
792
(defun send-invisible (str)
Christopher Zaborsky's avatar
Christopher Zaborsky committed
793
  "Read a string without echoing.
794 795
Then send it to the process running in the current buffer.  A new-line
is additionally sent.  String is not saved on comint input history list.
Jim Blandy's avatar
Jim Blandy committed
796 797
Security bug: your string can still be temporarily recovered with
\\[view-lossage]."
David Lawrence's avatar
David Lawrence committed
798 799 800 801 802 803
; (interactive (list (comint-read-noecho "Enter non-echoed text")))
  (interactive "P") ; Defeat snooping via C-x esc
  (let ((proc (get-buffer-process (current-buffer))))
    (if (not proc) (error "Current buffer has no process")
	(comint-send-string proc
			    (if (stringp str) str
Jim Blandy's avatar
Jim Blandy committed
804
				(comint-read-noecho "Non-echoed text: " t)))
David Lawrence's avatar
David Lawrence committed
805 806 807 808 809 810
	(comint-send-string proc "\n"))))


;;; Low-level process communication

(defvar comint-input-chunk-size 512
811
  "*Long inputs are sent to comint processes in chunks of this size.
David Lawrence's avatar
David Lawrence committed
812 813 814 815
If your process is choking on big inputs, try lowering the value.")

(defun comint-send-string (proc str)
  "Send PROCESS the contents of STRING as input.
816 817 818
This is equivalent to `process-send-string', except that long input strings
are broken up into chunks of size `comint-input-chunk-size'.  Processes
are given a chance to output between chunks.  This can help prevent processes
David Lawrence's avatar
David Lawrence committed
819 820 821 822 823 824 825 826 827 828 829 830
from hanging when you send them long inputs on some OS's."
  (let* ((len (length str))
	 (i (min len comint-input-chunk-size)))
    (process-send-string proc (substring str 0 i))
    (while (< i len)
      (let ((next-i (+ i comint-input-chunk-size)))
	(accept-process-output)
	(process-send-string proc (substring str i (min len next-i)))
	(setq i next-i)))))

(defun comint-send-region (proc start end)
  "Sends to PROC the region delimited by START and END.
831 832
This is a replacement for `process-send-region' that tries to keep
your process from hanging on long inputs.  See `comint-send-string'."
David Lawrence's avatar
David Lawrence committed
833 834 835 836 837
  (comint-send-string proc (buffer-substring start end)))


;;; Random input hackage

Jim Blandy's avatar
Jim Blandy committed
838
(defun comint-kill-output ()
David Lawrence's avatar
David Lawrence committed
839 840
  "Kill all output from interpreter since last input."
  (interactive)
Jim Blandy's avatar
Jim Blandy committed
841 842 843 844 845
  (let ((pmark (process-mark (get-buffer-process (current-buffer)))))
    (kill-region comint-last-input-end pmark)
    (goto-char pmark)    
    (insert "*** output flushed ***\n")
    (set-marker pmark (point))))
David Lawrence's avatar
David Lawrence committed
846 847

(defun comint-show-output ()
Jim Blandy's avatar
Jim Blandy committed
848 849
  "Display start of this batch of interpreter output at top of window.
Also put cursor there."
David Lawrence's avatar
David Lawrence committed
850 851
  (interactive)
  (goto-char comint-last-input-end)
Jim Blandy's avatar
Jim Blandy committed
852
  (backward-char)
David Lawrence's avatar
David Lawrence committed
853 854
  (beginning-of-line)
  (set-window-start (selected-window) (point))
Jim Blandy's avatar
Jim Blandy committed
855
  (end-of-line))
David Lawrence's avatar
David Lawrence committed
856 857

(defun comint-interrupt-subjob ()
Jim Blandy's avatar
Jim Blandy committed
858
  "Interrupt the current subjob."
David Lawrence's avatar
David Lawrence committed
859
  (interactive)
Jim Blandy's avatar
Jim Blandy committed
860
  (interrupt-process nil comint-ptyp))
David Lawrence's avatar
David Lawrence committed
861 862

(defun comint-kill-subjob ()
Jim Blandy's avatar
Jim Blandy committed
863
  "Send kill signal to the current subjob."
David Lawrence's avatar
David Lawrence committed
864
  (interactive)
Jim Blandy's avatar
Jim Blandy committed
865
  (kill-process nil comint-ptyp))
David Lawrence's avatar
David Lawrence committed
866 867

(defun comint-quit-subjob ()
Jim Blandy's avatar
Jim Blandy committed
868
  "Send quit signal to the current subjob."
David Lawrence's avatar
David Lawrence committed
869
  (interactive)
Jim Blandy's avatar
Jim Blandy committed
870
  (quit-process nil comint-ptyp))
David Lawrence's avatar
David Lawrence committed
871 872

(defun comint-stop-subjob ()
Jim Blandy's avatar
Jim Blandy committed
873
  "Stop the current subjob.
David Lawrence's avatar
David Lawrence committed
874
WARNING: if there is no current subjob, you can end up suspending
Jim Blandy's avatar
Jim Blandy committed
875 876 877
the top-level process running in the buffer. If you accidentally do
this, use \\[comint-continue-subjob] to resume the process. (This
is not a problem with most shells, since they ignore this signal.)"
David Lawrence's avatar
David Lawrence committed
878
  (interactive)
Jim Blandy's avatar
Jim Blandy committed
879
  (stop-process nil comint-ptyp))
David Lawrence's avatar
David Lawrence committed
880 881

(defun comint-continue-subjob ()
Jim Blandy's avatar
Jim Blandy committed
882
  "Send CONT signal to process buffer's process group.
David Lawrence's avatar
David Lawrence committed
883 884
Useful if you accidentally suspend the top-level process."
  (interactive)
Jim Blandy's avatar
Jim Blandy committed
885
  (continue-process nil comint-ptyp))
David Lawrence's avatar
David Lawrence committed
886 887

(defun comint-kill-input ()
Jim Blandy's avatar
Jim Blandy committed
888
  "Kill all text from last stuff output by interpreter to point."
David Lawrence's avatar
David Lawrence committed
889
  (interactive)
Jim Blandy's avatar
Jim Blandy committed
890 891 892 893
  (let* ((pmark (process-mark (get-buffer-process (current-buffer))))
	 (p-pos (marker-position pmark)))
    (if (> (point) p-pos)
	(kill-region pmark (point)))))
David Lawrence's avatar
David Lawrence committed
894 895 896 897 898 899

(defun comint-delchar-or-maybe-eof (arg)
  "Delete ARG characters forward, or send an EOF to process if at end of buffer."
  (interactive "p")
  (if (eobp)
      (process-send-eof)
Jim Blandy's avatar
Jim Blandy committed
900 901 902 903
      (delete-char arg)))



David Lawrence's avatar
David Lawrence committed
904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937

;;; Support for source-file processing commands.
;;;============================================================================
;;; Many command-interpreters (e.g., Lisp, Scheme, Soar) have
;;; commands that process files of source text (e.g. loading or compiling
;;; files). So the corresponding process-in-a-buffer modes have commands
;;; for doing this (e.g., lisp-load-file). The functions below are useful
;;; for defining these commands.
;;;
;;; Alas, these guys don't do exactly the right thing for Lisp, Scheme
;;; and Soar, in that they don't know anything about file extensions.
;;; So the compile/load interface gets the wrong default occasionally.
;;; The load-file/compile-file default mechanism could be smarter -- it
;;; doesn't know about the relationship between filename extensions and
;;; whether the file is source or executable. If you compile foo.lisp
;;; with compile-file, then the next load-file should use foo.bin for
;;; the default, not foo.lisp. This is tricky to do right, particularly
;;; because the extension for executable files varies so much (.o, .bin,
;;; .lbin, .mo, .vo, .ao, ...).


;;; COMINT-SOURCE-DEFAULT -- determines defaults for source-file processing
;;; commands.
;;;
;;; COMINT-CHECK-SOURCE -- if FNAME is in a modified buffer, asks you if you
;;; want to save the buffer before issuing any process requests to the command
;;; interpreter.
;;;
;;; COMINT-GET-SOURCE -- used by the source-file processing commands to prompt
;;; for the file to process.

;;; (COMINT-SOURCE-DEFAULT previous-dir/file source-modes)
;;;============================================================================
;;; This function computes the defaults for the load-file and compile-file
Jim Blandy's avatar
Jim Blandy committed
938
;;; commands for tea, soar, cmulisp, and cmuscheme modes. 
David Lawrence's avatar
David Lawrence committed
939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974
;;; 
;;; - PREVIOUS-DIR/FILE is a pair (directory . filename) from the last 
;;; source-file processing command. NIL if there hasn't been one yet.
;;; - SOURCE-MODES is a list used to determine what buffers contain source
;;; files: if the major mode of the buffer is in SOURCE-MODES, it's source.
;;; Typically, (lisp-mode) or (scheme-mode).
;;; 
;;; If the command is given while the cursor is inside a string, *and*
;;; the string is an existing filename, *and* the filename is not a directory,
;;; then the string is taken as default. This allows you to just position
;;; your cursor over a string that's a filename and have it taken as default.
;;;
;;; If the command is given in a file buffer whose major mode is in
;;; SOURCE-MODES, then the the filename is the default file, and the
;;; file's directory is the default directory.
;;; 
;;; If the buffer isn't a source file buffer (e.g., it's the process buffer),
;;; then the default directory & file are what was used in the last source-file
;;; processing command (i.e., PREVIOUS-DIR/FILE).  If this is the first time
;;; the command has been run (PREVIOUS-DIR/FILE is nil), the default directory
;;; is the cwd, with no default file. (\"no default file\" = nil)
;;; 
;;; SOURCE-REGEXP is typically going to be something like (tea-mode)
;;; for T programs, (lisp-mode) for Lisp programs, (soar-mode lisp-mode)
;;; for Soar programs, etc.
;;; 
;;; The function returns a pair: (default-directory . default-file).

(defun comint-source-default (previous-dir/file source-modes)
  (cond ((and buffer-file-name (memq major-mode source-modes))
	 (cons (file-name-directory    buffer-file-name)
	       (file-name-nondirectory buffer-file-name)))
	(previous-dir/file)
	(t
	 (cons default-directory nil))))

Jim Blandy's avatar
Jim Blandy committed
975

David Lawrence's avatar
David Lawrence committed
976 977
;;; (COMINT-CHECK-SOURCE fname)
;;;============================================================================
Jim Blandy's avatar
Jim Blandy committed
978
;;; Prior to loading or compiling (or otherwise processing) a file (in the CMU
David Lawrence's avatar
David Lawrence committed
979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995
;;; process-in-a-buffer modes), this function can be called on the filename.
;;; If the file is loaded into a buffer, and the buffer is modified, the user
;;; is queried to see if he wants to save the buffer before proceeding with
;;; the load or compile.

(defun comint-check-source (fname)
  (let ((buff (get-file-buffer fname)))
    (if (and buff
	     (buffer-modified-p buff)
	     (y-or-n-p (format "Save buffer %s first? "
			       (buffer-name buff))))
	;; save BUFF.
	(let ((old-buffer (current-buffer)))
	  (set-buffer buff)
	  (save-buffer)
	  (set-buffer old-buffer)))))

Jim Blandy's avatar
Jim Blandy committed
996

David Lawrence's avatar
David Lawrence committed
997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018
;;; (COMINT-GET-SOURCE prompt prev-dir/file source-modes mustmatch-p)
;;;============================================================================
;;; COMINT-GET-SOURCE is used to prompt for filenames in command-interpreter
;;; commands that process source files (like loading or compiling a file).
;;; It prompts for the filename, provides a default, if there is one,
;;; and returns the result filename.
;;; 
;;; See COMINT-SOURCE-DEFAULT for more on determining defaults.
;;; 
;;; PROMPT is the prompt string. PREV-DIR/FILE is the (directory . file) pair
;;; from the last source processing command.  SOURCE-MODES is a list of major
;;; modes used to determine what file buffers contain source files.  (These
;;; two arguments are used for determining defaults). If MUSTMATCH-P is true,
;;; then the filename reader will only accept a file that exists.
;;; 
;;; A typical use:
;;; (interactive (comint-get-source "Compile file: " prev-lisp-dir/file
;;;                                 '(lisp-mode) t))

;;; This is pretty stupid about strings. It decides we're in a string
;;; if there's a quote on both sides of point on the current line.
(defun comint-extract-string ()
1019
  "Return string around POINT that starts the current line, or nil." 
David Lawrence's avatar
David Lawrence committed
1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036
  (save-excursion
    (let* ((point (point))
	   (bol (progn (beginning-of-line) (point)))
	   (eol (progn (end-of-line) (point)))
	   (start (progn (goto-char point) 
			 (and (search-backward "\"" bol t) 
			      (1+ (point)))))
	   (end (progn (goto-char point)
		       (and (search-forward "\"" eol t)
			    (1- (point))))))
      (and start end
	   (buffer-substring start end)))))

(defun comint-get-source (prompt prev-dir/file source-modes mustmatch-p)
  (let* ((def (comint-source-default prev-dir/file source-modes))
         (stringfile (comint-extract-string))
	 (sfile-p (and stringfile
Jim Blandy's avatar
Jim Blandy committed
1037 1038 1039
		       (condition-case ()
			   (file-exists-p stringfile)
			 (error nil))
David Lawrence's avatar
David Lawrence committed
1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052
		       (not (file-directory-p stringfile))))
	 (defdir  (if sfile-p (file-name-directory stringfile)
                      (car def)))
	 (deffile (if sfile-p (file-name-nondirectory stringfile)
                      (cdr def)))
	 (ans (read-file-name (if deffile (format "%s(default %s) "
						  prompt    deffile)
				  prompt)
			      defdir
			      (concat defdir deffile)
			      mustmatch-p)))
    (list (expand-file-name (substitute-in-file-name ans)))))

Jim Blandy's avatar
Jim Blandy committed
1053 1054 1055 1056 1057 1058 1059 1060
;;; I am somewhat divided on this string-default feature. It seems
;;; to violate the principle-of-least-astonishment, in that it makes
;;; the default harder to predict, so you actually have to look and see
;;; what the default really is before choosing it. This can trip you up.
;;; On the other hand, it can be useful, I guess. I would appreciate feedback
;;; on this.
;;;     -Olin

David Lawrence's avatar
David Lawrence committed
1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107

;;; Simple process query facility.
;;; ===========================================================================
;;; This function is for commands that want to send a query to the process
;;; and show the response to the user. For example, a command to get the
;;; arglist for a Common Lisp function might send a "(arglist 'foo)" query
;;; to an inferior Common Lisp process.
;;; 
;;; This simple facility just sends strings to the inferior process and pops
;;; up a window for the process buffer so you can see what the process
;;; responds with.  We don't do anything fancy like try to intercept what the
;;; process responds with and put it in a pop-up window or on the message
;;; line. We just display the buffer. Low tech. Simple. Works good.

;;; Send to the inferior process PROC the string STR. Pop-up but do not select
;;; a window for the inferior process so that its response can be seen.
(defun comint-proc-query (proc str)
  (let* ((proc-buf (process-buffer proc))
	 (proc-mark (process-mark proc)))
    (display-buffer proc-buf)
    (set-buffer proc-buf) ; but it's not the selected *window*
    (let ((proc-win (get-buffer-window proc-buf))
	  (proc-pt (marker-position proc-mark)))
      (comint-send-string proc str) ; send the query
      (accept-process-output proc)  ; wait for some output
      ;; Try to position the proc window so you can see the answer.
      ;; This is bogus code. If you delete the (sit-for 0), it breaks.
      ;; I don't know why. Wizards invited to improve it.
      (if (not (pos-visible-in-window-p proc-pt proc-win))
	  (let ((opoint (window-point proc-win)))
	    (set-window-point proc-win proc-mark) (sit-for 0)
	    (if (not (pos-visible-in-window-p opoint proc-win))
		(push-mark opoint)
		(set-window-point proc-win opoint)))))))


;;; Filename completion in a buffer
;;; ===========================================================================
;;; Useful completion functions, courtesy of the Ergo group.

;;; Three commands:
;;; comint-dynamic-complete		Complete filename at point.
;;; comint-dynamic-list-completions	List completions in help buffer.
;;; comint-replace-by-expanded-filename	Expand and complete filename at point;
;;;					replace with expanded/completed name.

;;; These are not installed in the comint-mode keymap. But they are
Jim Blandy's avatar
Jim Blandy committed
1108
;;; available for people who want them. Shell-mode installs them:
1109 1110
;;; (define-key shell-mode-map "\t" 'comint-dynamic-complete)
;;; (define-key shell-mode-map "\M-?"  'comint-dynamic-list-completions)))
Jim Blandy's avatar
Jim Blandy committed
1111 1112
;;;
;;; Commands like this are fine things to put in load hooks if you
1113
;;; want them present in specific modes.
Jim Blandy's avatar
Jim Blandy committed
1114

David Lawrence's avatar
David Lawrence committed
1115 1116

(defun comint-match-partial-pathname ()
1117
  "Return the filename at point, or signal an error."
Jim Blandy's avatar
Jim Blandy committed
1118
  (save-excursion
1119
    (if (re-search-backward "[^~/A-Za-z0-9_.$#,=-]" nil 'move)
Jim Blandy's avatar
Jim Blandy committed
1120 1121
	(forward-char 1))
    ;; Anchor the search forwards.
1122 1123
    (if (not (looking-at "[~/A-Za-z0-9_.$#,=-]")) (error ""))
    (re-search-forward "[~/A-Za-z0-9_.$#,=-]+")
Jim Blandy's avatar
Jim Blandy committed
1124 1125 1126
    (substitute-in-file-name
     (buffer-substring (match-beginning 0) (match-end 0)))))

David Lawrence's avatar
David Lawrence committed
1127 1128

(defun comint-replace-by-expanded-filename ()
1129
  "Expand the filename at point.
Christopher Zaborsky's avatar
Christopher Zaborsky committed
1130 1131
Replace the filename with an expanded, canonicalised, and completed
 replacement.
David Lawrence's avatar
David Lawrence committed
1132 1133
\"Expanded\" means environment variables (e.g., $HOME) and ~'s are
replaced with the corresponding directories.  \"Canonicalised\" means ..
Jim Blandy's avatar
Jim Blandy committed
1134
and \. are removed, and the filename is made absolute instead of relative.
1135 1136
See functions `expand-file-name' and `substitute-in-file-name'.  See also
`comint-dynamic-complete'."
David Lawrence's avatar
David Lawrence committed
1137 1138 1139 1140 1141 1142 1143
  (interactive)
  (let* ((pathname (comint-match-partial-pathname))
	 (pathdir (file-name-directory pathname))
	 (pathnondir (file-name-nondirectory pathname))
	 (completion (file-name-completion pathnondir
					   (or pathdir default-directory))))
    (cond ((null completion)
1144
	   (message "No completions of %s" pathname)
Jim Blandy's avatar
Jim Blandy committed
1145
	   (ding))
David Lawrence's avatar
David Lawrence committed
1146
	  ((eql completion t)
1147
	   (message "Unique completion"))