Line data Source code
1 : ;;; comint.el --- general command interpreter in a window stuff -*- lexical-binding: t -*-
2 :
3 : ;; Copyright (C) 1988, 1990, 1992-2017 Free Software Foundation, Inc.
4 :
5 : ;; Author: Olin Shivers <shivers@cs.cmu.edu>
6 : ;; Simon Marshall <simon@gnu.org>
7 : ;; Maintainer: emacs-devel@gnu.org
8 : ;; Keywords: processes
9 : ;; Package: emacs
10 :
11 : ;; This file is part of GNU Emacs.
12 :
13 : ;; GNU Emacs is free software: you can redistribute it and/or modify
14 : ;; it under the terms of the GNU General Public License as published by
15 : ;; the Free Software Foundation, either version 3 of the License, or
16 : ;; (at your option) any later version.
17 :
18 : ;; GNU Emacs is distributed in the hope that it will be useful,
19 : ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
20 : ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21 : ;; GNU General Public License for more details.
22 :
23 : ;; You should have received a copy of the GNU General Public License
24 : ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
25 :
26 : ;;; Commentary:
27 :
28 : ;; This file defines a general command-interpreter-in-a-buffer package
29 : ;; (comint mode). The idea is that you can build specific process-in-a-buffer
30 : ;; modes on top of comint mode -- e.g., Lisp, shell, scheme, T, soar, ....
31 : ;; This way, all these specific packages share a common base functionality,
32 : ;; and a common set of bindings, which makes them easier to use (and
33 : ;; saves code, implementation time, etc., etc.).
34 :
35 : ;; Several packages are already defined using comint mode:
36 : ;; - shell.el defines a shell-in-a-buffer mode.
37 : ;; - cmulisp.el defines a simple lisp-in-a-buffer mode.
38 : ;;
39 : ;; - The file cmuscheme.el defines a scheme-in-a-buffer mode.
40 : ;; - The file tea.el tunes scheme and inferior-scheme modes for T.
41 : ;; - The file soar.el tunes Lisp and inferior-lisp modes for Soar.
42 : ;; - cmutex.el defines TeX and LaTeX modes that invoke TeX, LaTeX, BibTeX,
43 : ;; previewers, and printers from within Emacs.
44 : ;; - background.el allows csh-like job control inside Emacs.
45 : ;; It is pretty easy to make new derived modes for other processes.
46 :
47 : ;; For documentation on the functionality provided by Comint mode, and
48 : ;; the hooks available for customizing it, see the comments below.
49 : ;; For further information on the standard derived modes (shell,
50 : ;; inferior-lisp, inferior-scheme, ...), see the relevant source files.
51 :
52 : ;; For hints on converting existing process modes (e.g., tex-mode,
53 : ;; background, dbx, gdb, kermit, prolog, telnet) to use comint-mode
54 : ;; instead of shell-mode, see the notes at the end of this file.
55 :
56 :
57 : ;; Brief Command Documentation:
58 : ;;============================================================================
59 : ;; Comint Mode Commands: (common to all derived modes, like shell & cmulisp
60 : ;; mode)
61 : ;;
62 : ;; M-p comint-previous-input Cycle backwards in input history
63 : ;; M-n comint-next-input Cycle forwards
64 : ;; M-r comint-history-isearch-backward-regexp Isearch input regexp backward
65 : ;; M-C-l comint-show-output Show last batch of process output
66 : ;; RET comint-send-input
67 : ;; C-d comint-delchar-or-maybe-eof Delete char unless at end of buff
68 : ;; C-c C-a comint-bol-or-process-mark First time, move point to bol;
69 : ;; second time, move to process-mark.
70 : ;; C-c C-u comint-kill-input ^u
71 : ;; C-c C-w backward-kill-word ^w
72 : ;; C-c C-c comint-interrupt-subjob ^c
73 : ;; C-c C-z comint-stop-subjob ^z
74 : ;; C-c C-\ comint-quit-subjob ^\
75 : ;; C-c C-o comint-delete-output Delete last batch of process output
76 : ;; C-c C-r comint-show-output Show last batch of process output
77 : ;; C-c C-l comint-dynamic-list-input-ring List input history
78 : ;;
79 : ;; Not bound by default in comint-mode (some are in shell mode)
80 : ;; comint-run Run a program under comint-mode
81 : ;; send-invisible Read a line w/o echo, and send to proc
82 : ;; comint-dynamic-complete-filename Complete filename at point.
83 : ;; comint-dynamic-list-filename-completions List completions in help buffer.
84 : ;; comint-replace-by-expanded-filename Expand and complete filename at point;
85 : ;; replace with expanded/completed name.
86 : ;; comint-replace-by-expanded-history Expand history at point;
87 : ;; replace with expanded name.
88 : ;; comint-magic-space Expand history and add (a) space(s).
89 : ;; comint-kill-subjob No mercy.
90 : ;; comint-show-maximum-output Show as much output as possible.
91 : ;; comint-continue-subjob Send CONT signal to buffer's process
92 : ;; group. Useful if you accidentally
93 : ;; suspend your process (with C-c C-z).
94 : ;; comint-get-next-from-history Fetch successive input history lines
95 : ;; comint-accumulate Combine lines to send them together
96 : ;; as input.
97 : ;; comint-goto-process-mark Move point to where process-mark is.
98 : ;; comint-set-process-mark Set process-mark to point.
99 :
100 : ;; comint-mode-hook is the Comint mode hook. Basically for your keybindings.
101 :
102 : ;;; Code:
103 :
104 : (require 'ring)
105 : (require 'ansi-color)
106 : (require 'regexp-opt) ;For regexp-opt-charset.
107 :
108 : ;; Buffer Local Variables:
109 : ;;============================================================================
110 : ;; Comint mode buffer local variables:
111 : ;; comint-prompt-regexp string comint-bol uses to match prompt
112 : ;; comint-delimiter-argument-list list For delimiters and arguments
113 : ;; comint-last-input-start marker Handy if inferior always echoes
114 : ;; comint-last-input-end marker For comint-delete-output command
115 : ;; comint-input-ring-size integer For the input history
116 : ;; comint-input-ring ring mechanism
117 : ;; comint-input-ring-index number ...
118 : ;; comint-save-input-ring-index number ...
119 : ;; comint-input-autoexpand symbol ...
120 : ;; comint-input-ignoredups boolean ...
121 : ;; comint-dynamic-complete-functions hook For the completion mechanism
122 : ;; comint-completion-fignore list ...
123 : ;; comint-file-name-chars string ...
124 : ;; comint-file-name-quote-list list ...
125 : ;; comint-get-old-input function Hooks for specific
126 : ;; comint-input-filter-functions hook process-in-a-buffer
127 : ;; comint-output-filter-functions hook function modes.
128 : ;; comint-preoutput-filter-functions hook
129 : ;; comint-input-filter function ...
130 : ;; comint-input-sender function ...
131 : ;; comint-eol-on-send boolean ...
132 : ;; comint-process-echoes boolean ...
133 : ;; comint-scroll-to-bottom-on-input symbol For scroll behavior
134 : ;; comint-move-point-for-output symbol ...
135 : ;; comint-scroll-show-maximum-output boolean ...
136 : ;; comint-accum-marker maker For comint-accumulate
137 : ;;
138 : ;; Comint mode non-buffer local variables:
139 : ;; comint-completion-addsuffix boolean/cons For file name
140 : ;; comint-completion-autolist boolean completion behavior
141 : ;; comint-completion-recexact boolean ...
142 :
143 : (defgroup comint nil
144 : "General command interpreter in a window stuff."
145 : :group 'processes)
146 :
147 : (defgroup comint-completion nil
148 : "Completion facilities in comint."
149 : :group 'comint)
150 :
151 : ;; Unused.
152 : ;;; (defgroup comint-source nil
153 : ;;; "Source finding facilities in comint."
154 : ;;; :prefix "comint-"
155 : ;;; :group 'comint)
156 :
157 : (defvar comint-prompt-regexp "^"
158 : "Regexp to recognize prompts in the inferior process.
159 : Defaults to \"^\", the null string at BOL.
160 :
161 : This variable is only used if the variable
162 : `comint-use-prompt-regexp' is non-nil.
163 :
164 : Good choices:
165 : Canonical Lisp: \"^[^> \\n]*>+:? *\" (Lucid, franz, kcl, T, cscheme, oaklisp)
166 : Lucid Common Lisp: \"^\\\\(>\\\\|\\\\(->\\\\)+\\\\) *\"
167 : franz: \"^\\\\(->\\\\|<[0-9]*>:\\\\) *\"
168 : kcl: \"^>+ *\"
169 : shell: \"^[^#$%>\\n]*[#$%>] *\"
170 : T: \"^>+ *\"
171 :
172 : This is a good thing to set in mode hooks.")
173 :
174 : (defcustom comint-prompt-read-only nil
175 : "If non-nil, the comint prompt is read only.
176 : The read only region includes the newline before the prompt.
177 : This does not affect existing prompts.
178 : Certain derived modes may override this option.
179 :
180 : If you set this option to t, then the safe way to temporarily
181 : override the read-only-ness of comint prompts is to call
182 : `comint-kill-whole-line' or `comint-kill-region' with no
183 : narrowing in effect. This way you will be certain that none of
184 : the remaining prompts will be accidentally messed up. You may
185 : wish to put something like the following in your init file:
186 :
187 : \(add-hook \\='comint-mode-hook
188 : (lambda ()
189 : (define-key comint-mode-map [remap kill-region] \\='comint-kill-region)
190 : (define-key comint-mode-map [remap kill-whole-line]
191 : \\='comint-kill-whole-line)))
192 :
193 : If you sometimes use comint-mode on text-only terminals or with `emacs -nw',
194 : you might wish to use another binding for `comint-kill-whole-line'."
195 : :type 'boolean
196 : :group 'comint
197 : :version "22.1")
198 :
199 : (defvar comint-delimiter-argument-list ()
200 : "List of characters to recognize as separate arguments in input.
201 : Strings comprising a character in this list will separate the arguments
202 : surrounding them, and also be regarded as arguments in their own right (unlike
203 : whitespace). See `comint-arguments'.
204 : Defaults to the empty list.
205 :
206 : For shells, a good value is (?\\| ?& ?< ?> ?\\( ?\\) ?;).
207 :
208 : This is a good thing to set in mode hooks.")
209 :
210 : (defcustom comint-input-autoexpand nil
211 : "If non-nil, expand input command history references on completion.
212 : This mirrors the optional behavior of tcsh (its autoexpand and histlist).
213 :
214 : If the value is `input', then the expansion is seen on input.
215 : If the value is `history', then the expansion is only when inserting
216 : into the buffer's input ring. See also `comint-magic-space' and
217 : `completion-at-point'.
218 :
219 : This variable is buffer-local."
220 : :type '(choice (const :tag "off" nil)
221 : (const input)
222 : (const history)
223 : (other :tag "on" t))
224 : :group 'comint)
225 :
226 : (defface comint-highlight-input '((t (:weight bold)))
227 : "Face to use to highlight user input."
228 : :group 'comint)
229 :
230 : (defface comint-highlight-prompt
231 : '((t :inherit minibuffer-prompt))
232 : "Face to use to highlight prompts."
233 : :group 'comint)
234 :
235 : (defcustom comint-input-ignoredups nil
236 : "If non-nil, don't add input matching the last on the input ring.
237 : This mirrors the optional behavior of bash.
238 :
239 : This variable is buffer-local."
240 : :type 'boolean
241 : :group 'comint)
242 :
243 : (defcustom comint-input-ring-file-name nil
244 : "If non-nil, name of the file to read/write input history.
245 : See also `comint-read-input-ring' and `comint-write-input-ring'.
246 : `comint-mode' makes this a buffer-local variable. You probably want
247 : to set this in a mode hook, rather than customize the default value."
248 : :type '(choice (const :tag "nil" nil)
249 : file)
250 : :group 'comint)
251 :
252 : (defcustom comint-scroll-to-bottom-on-input nil
253 : "Controls whether input to interpreter causes window to scroll.
254 : If nil, then do not scroll. If t or `all', scroll all windows showing buffer.
255 : If `this', scroll only the selected window.
256 :
257 : The default is nil.
258 :
259 : See `comint-preinput-scroll-to-bottom'. This variable is buffer-local."
260 : :type '(choice (const :tag "off" nil)
261 : (const t)
262 : (const all)
263 : (const this))
264 : :group 'comint)
265 :
266 : (defcustom comint-move-point-for-output nil
267 : "Controls whether interpreter output moves point to the end of the output.
268 : If nil, then output never moves point to the output.
269 : (If the output occurs at point, it is inserted before point.)
270 : If t or `all', move point in all windows showing the buffer.
271 : If `this', move point only the selected window.
272 : If `others', move point only in other windows, not in the selected window.
273 :
274 : The default is nil.
275 :
276 : See the variable `comint-scroll-show-maximum-output' and the function
277 : `comint-postoutput-scroll-to-bottom'.
278 : This variable is buffer-local in all Comint buffers."
279 : :type '(choice (const :tag "off" nil)
280 : (const t)
281 : (const all)
282 : (const this)
283 : (const others))
284 : :group 'comint)
285 :
286 : (defcustom comint-move-point-for-matching-input 'after-input
287 : "Controls where to place point after matching input.
288 : \\<comint-mode-map>This influences the commands \\[comint-previous-matching-input-from-input] and \\[comint-next-matching-input-from-input].
289 : If `after-input', point will be positioned after the input typed
290 : by the user, but before the rest of the history entry that has
291 : been inserted. If `end-of-line', point will be positioned at the
292 : end of the current logical (not visual) line after insertion."
293 : :type '(radio (const :tag "Stay after input" after-input)
294 : (const :tag "Move to end of line" end-of-line))
295 : :group 'comint)
296 :
297 : (defvaralias 'comint-scroll-to-bottom-on-output 'comint-move-point-for-output)
298 :
299 : (defcustom comint-scroll-show-maximum-output t
300 : "Controls how to scroll due to interpreter output.
301 : This variable applies when point is at the end of the buffer
302 : \(either because it was originally there, or because
303 : `comint-move-point-for-output' said to move it there)
304 : and output from the subprocess is inserted.
305 :
306 : Non-nil means scroll so that the window is full of text
307 : and point is on the last line. A value of nil
308 : means don't do anything special--scroll normally.
309 :
310 : See also the variable `comint-move-point-for-output' and the function
311 : `comint-postoutput-scroll-to-bottom'.
312 : This variable is buffer-local in all Comint buffers."
313 : :type 'boolean
314 : :group 'comint)
315 :
316 : (defcustom comint-buffer-maximum-size 1024
317 : "The maximum size in lines for Comint buffers.
318 : Comint buffers are truncated from the top to be no greater than this number, if
319 : the function `comint-truncate-buffer' is on `comint-output-filter-functions'."
320 : :type 'integer
321 : :group 'comint)
322 :
323 : (defcustom comint-input-ring-size 500
324 : "Size of the input history ring in `comint-mode'."
325 : :type 'integer
326 : :group 'comint
327 : :version "23.2")
328 :
329 : (defvar comint-input-ring-separator "\n"
330 : "Separator between commands in the history file.")
331 :
332 : (defvar comint-input-history-ignore "^#"
333 : "Regexp for history entries that should be ignored when Comint initializes.")
334 :
335 : (defcustom comint-process-echoes nil
336 : "If non-nil, assume that the subprocess echoes any input.
337 : If so, delete one copy of the input so that only one copy eventually
338 : appears in the buffer.
339 :
340 : This variable is buffer-local."
341 : :type 'boolean
342 : :group 'comint)
343 :
344 : ;; AIX puts the name of the person being su'd to in front of the prompt.
345 : ;; kinit prints a prompt like `Password for devnull@GNU.ORG: '.
346 : ;; ksu prints a prompt like `Kerberos password for devnull/root@GNU.ORG: '.
347 : ;; ssh-add prints a prompt like `Enter passphrase: '.
348 : ;; plink prints a prompt like `Passphrase for key "root@GNU.ORG": '.
349 : ;; Ubuntu's sudo prompts like `[sudo] password for user:'
350 : ;; Some implementations of passwd use "Password (again)" as the 2nd prompt.
351 : ;; Something called "perforce" uses "Enter password:".
352 : ;; See M-x comint-testsuite--test-comint-password-prompt-regexp.
353 : (defcustom comint-password-prompt-regexp
354 : (concat
355 : "\\(^ *\\|"
356 : (regexp-opt
357 : '("Enter" "enter" "Enter same" "enter same" "Enter the" "enter the"
358 : "Old" "old" "New" "new" "'s" "login"
359 : "Kerberos" "CVS" "UNIX" " SMB" "LDAP" "PEM" "SUDO"
360 : "[sudo]" "Repeat" "Bad" "Retype")
361 : t)
362 : " +\\)"
363 : "\\(?:" (regexp-opt password-word-equivalents) "\\|Response\\)"
364 : "\\(?:\\(?:, try\\)? *again\\| (empty for no passphrase)\\| (again)\\)?"
365 : ;; "[[:alpha:]]" used to be "for", which fails to match non-English.
366 : "\\(?: [[:alpha:]]+ .+\\)?[::៖]\\s *\\'")
367 : "Regexp matching prompts for passwords in the inferior process.
368 : This is used by `comint-watch-for-password-prompt'."
369 : :version "26.1"
370 : :type 'regexp
371 : :group 'comint)
372 :
373 : ;; Here are the per-interpreter hooks.
374 : (defvar comint-get-old-input (function comint-get-old-input-default)
375 : "Function that returns old text in Comint mode.
376 : This function is called when return is typed while the point is in old
377 : text. It returns the text to be submitted as process input. The
378 : default is `comint-get-old-input-default', which either grabs the
379 : current input field or grabs the current line and strips off leading
380 : text matching `comint-prompt-regexp', depending on the value of
381 : `comint-use-prompt-regexp'.")
382 :
383 : (defvar comint-dynamic-complete-functions
384 : '(comint-c-a-p-replace-by-expanded-history comint-filename-completion)
385 : "List of functions called to perform completion.
386 : Works like `completion-at-point-functions'.
387 : See also `completion-at-point'.
388 :
389 : This is a good thing to set in mode hooks.")
390 :
391 : (defvar comint-input-filter #'comint-nonblank-p
392 : "Predicate for filtering additions to input history.
393 : Takes one argument, the input. If non-nil, the input may be saved on the input
394 : history list. Default is to save anything that isn't all whitespace.")
395 :
396 : (defvar comint-input-filter-functions '()
397 : "Abnormal hook run before input is sent to the process.
398 : These functions get one argument, a string containing the text to send.")
399 :
400 : ;;;###autoload
401 : (defvar comint-output-filter-functions '(ansi-color-process-output comint-postoutput-scroll-to-bottom comint-watch-for-password-prompt)
402 : "Functions to call after output is inserted into the buffer.
403 : One possible function is `comint-postoutput-scroll-to-bottom'.
404 : These functions get one argument, a string containing the text as originally
405 : inserted. Note that this might not be the same as the buffer contents between
406 : `comint-last-output-start' and the buffer's `process-mark', if other filter
407 : functions have already modified the buffer.
408 :
409 : See also `comint-preoutput-filter-functions'.
410 :
411 : You can use `add-hook' to add functions to this list
412 : either globally or locally.")
413 :
414 : (defvar comint-input-sender-no-newline nil
415 : "Non-nil directs the `comint-input-sender' function not to send a newline.")
416 :
417 : (defvar comint-input-sender (function comint-simple-send)
418 : "Function to actually send to PROCESS the STRING submitted by user.
419 : Usually this is just `comint-simple-send', but if your mode needs to
420 : massage the input string, put a different function here.
421 : `comint-simple-send' just sends the string plus a newline.
422 : \(If `comint-input-sender-no-newline' is non-nil, it omits the newline.)
423 : This is called from the user command `comint-send-input'.")
424 :
425 : (defcustom comint-eol-on-send t
426 : "Non-nil means go to the end of the line before sending input.
427 : See `comint-send-input'."
428 : :type 'boolean
429 : :group 'comint)
430 :
431 : (define-obsolete-variable-alias 'comint-use-prompt-regexp-instead-of-fields
432 : 'comint-use-prompt-regexp "22.1")
433 :
434 : ;; Note: If it is decided to purge comint-prompt-regexp from the source
435 : ;; entirely, searching for uses of this variable will help to identify
436 : ;; places that need attention.
437 : (defcustom comint-use-prompt-regexp nil
438 : "If non-nil, use `comint-prompt-regexp' to recognize prompts.
439 : If nil, then program output and user-input are given different `field'
440 : properties, which Emacs commands can use to distinguish them (in
441 : particular, common movement commands such as `beginning-of-line'
442 : respect field boundaries in a natural way)."
443 : :type 'boolean
444 : :group 'comint)
445 :
446 : (defcustom comint-mode-hook nil
447 : "Hook run upon entry to `comint-mode'.
448 : This is run before the process is cranked up."
449 : :type 'hook
450 : :group 'comint)
451 :
452 : (defcustom comint-exec-hook '()
453 : "Hook run each time a process is exec'd by `comint-exec'.
454 : This is called after the process is cranked up. It is useful for things that
455 : must be done each time a process is executed in a Comint mode buffer (e.g.,
456 : `(process-kill-without-query)'). In contrast, the `comint-mode-hook' is only
457 : executed once when the buffer is created."
458 : :type 'hook
459 : :group 'comint)
460 :
461 : (defvar comint-mode-map
462 : (let ((map (make-sparse-keymap)))
463 : ;; Keys:
464 : (define-key map "\ep" 'comint-previous-input)
465 : (define-key map "\en" 'comint-next-input)
466 : (define-key map [C-up] 'comint-previous-input)
467 : (define-key map [C-down] 'comint-next-input)
468 : (define-key map "\er" 'comint-history-isearch-backward-regexp)
469 : (define-key map [?\C-c ?\M-r] 'comint-previous-matching-input-from-input)
470 : (define-key map [?\C-c ?\M-s] 'comint-next-matching-input-from-input)
471 : (define-key map "\e\C-l" 'comint-show-output)
472 : (define-key map "\C-m" 'comint-send-input)
473 : (define-key map "\C-d" 'comint-delchar-or-maybe-eof)
474 : ;; The following two are standardly bound to delete-forward-char,
475 : ;; but they should never do EOF, just delete.
476 : (define-key map [delete] 'delete-forward-char)
477 : (define-key map [kp-delete] 'delete-forward-char)
478 : (define-key map "\C-c " 'comint-accumulate)
479 : (define-key map "\C-c\C-x" 'comint-get-next-from-history)
480 : (define-key map "\C-c\C-a" 'comint-bol-or-process-mark)
481 : (define-key map "\C-c\C-u" 'comint-kill-input)
482 : (define-key map "\C-c\C-w" 'backward-kill-word)
483 : (define-key map "\C-c\C-c" 'comint-interrupt-subjob)
484 : (define-key map "\C-c\C-z" 'comint-stop-subjob)
485 : (define-key map "\C-c\C-\\" 'comint-quit-subjob)
486 : (define-key map "\C-c\C-m" 'comint-copy-old-input)
487 : (define-key map "\C-c\C-o" 'comint-delete-output)
488 : (define-key map "\C-c\M-o" 'comint-clear-buffer)
489 : (define-key map "\C-c\C-r" 'comint-show-output)
490 : (define-key map "\C-c\C-e" 'comint-show-maximum-output)
491 : (define-key map "\C-c\C-l" 'comint-dynamic-list-input-ring)
492 : (define-key map "\C-c\C-n" 'comint-next-prompt)
493 : (define-key map "\C-c\C-p" 'comint-previous-prompt)
494 : (define-key map "\C-c\C-d" 'comint-send-eof)
495 : (define-key map "\C-c\C-s" 'comint-write-output)
496 : (define-key map "\C-c." 'comint-insert-previous-argument)
497 : ;; Mouse Buttons:
498 : (define-key map [mouse-2] 'comint-insert-input)
499 : ;; Menu bars:
500 : ;; completion:
501 : (define-key map [menu-bar completion]
502 : (cons "Complete" (make-sparse-keymap "Complete")))
503 : (define-key map [menu-bar completion complete-expand]
504 : '("Expand File Name" . comint-replace-by-expanded-filename))
505 : (define-key map [menu-bar completion complete-listing]
506 : '("File Completion Listing" . comint-dynamic-list-filename-completions))
507 : (define-key map [menu-bar completion complete-file]
508 : '("Complete File Name" . comint-dynamic-complete-filename))
509 : (define-key map [menu-bar completion complete]
510 : '("Complete at Point" . completion-at-point))
511 : ;; Input history:
512 : (define-key map [menu-bar inout]
513 : (cons "In/Out" (make-sparse-keymap "In/Out")))
514 : (define-key map [menu-bar inout delete-output]
515 : '("Delete Current Output Group" . comint-delete-output))
516 : (define-key map [menu-bar inout append-output-to-file]
517 : '("Append Current Output Group to File" . comint-append-output-to-file))
518 : (define-key map [menu-bar inout write-output]
519 : '("Write Current Output Group to File" . comint-write-output))
520 : (define-key map [menu-bar inout next-prompt]
521 : '("Forward Output Group" . comint-next-prompt))
522 : (define-key map [menu-bar inout previous-prompt]
523 : '("Backward Output Group" . comint-previous-prompt))
524 : (define-key map [menu-bar inout show-maximum-output]
525 : '("Show Maximum Output" . comint-show-maximum-output))
526 : (define-key map [menu-bar inout show-output]
527 : '("Show Current Output Group" . comint-show-output))
528 : (define-key map [menu-bar inout kill-input]
529 : '("Kill Current Input" . comint-kill-input))
530 : (define-key map [menu-bar inout copy-input]
531 : '("Copy Old Input" . comint-copy-old-input))
532 : (define-key map [menu-bar inout history-isearch-backward-regexp]
533 : '("Isearch Input Regexp Backward..." . comint-history-isearch-backward-regexp))
534 : (define-key map [menu-bar inout history-isearch-backward]
535 : '("Isearch Input String Backward..." . comint-history-isearch-backward))
536 : (define-key map [menu-bar inout forward-matching-history]
537 : '("Forward Matching Input..." . comint-forward-matching-input))
538 : (define-key map [menu-bar inout backward-matching-history]
539 : '("Backward Matching Input..." . comint-backward-matching-input))
540 : (define-key map [menu-bar inout next-matching-history]
541 : '("Next Matching Input..." . comint-next-matching-input))
542 : (define-key map [menu-bar inout previous-matching-history]
543 : '("Previous Matching Input..." . comint-previous-matching-input))
544 : (define-key map [menu-bar inout next-matching-history-from-input]
545 : '("Next Matching Current Input" . comint-next-matching-input-from-input))
546 : (define-key map [menu-bar inout previous-matching-history-from-input]
547 : '("Previous Matching Current Input" . comint-previous-matching-input-from-input))
548 : (define-key map [menu-bar inout next-history]
549 : '("Next Input" . comint-next-input))
550 : (define-key map [menu-bar inout previous-history]
551 : '("Previous Input" . comint-previous-input))
552 : (define-key map [menu-bar inout list-history]
553 : '("List Input History" . comint-dynamic-list-input-ring))
554 : (define-key map [menu-bar inout expand-history]
555 : '("Expand History Before Point" . comint-replace-by-expanded-history))
556 : ;; Signals
557 : (let ((signals-map (make-sparse-keymap "Signals")))
558 : (define-key map [menu-bar signals] (cons "Signals" signals-map))
559 : (define-key signals-map [eof] '("EOF" . comint-send-eof))
560 : (define-key signals-map [kill] '("KILL" . comint-kill-subjob))
561 : (define-key signals-map [quit] '("QUIT" . comint-quit-subjob))
562 : (define-key signals-map [cont] '("CONT" . comint-continue-subjob))
563 : (define-key signals-map [stop] '("STOP" . comint-stop-subjob))
564 : (define-key signals-map [break] '("BREAK" . comint-interrupt-subjob)))
565 : ;; Put them in the menu bar:
566 : (setq menu-bar-final-items (append '(completion inout signals)
567 : menu-bar-final-items))
568 : map))
569 :
570 : ;; Fixme: Is this still relevant?
571 : (defvar comint-ptyp t
572 : "Non-nil if communications via pty; false if by pipe. Buffer local.
573 : This is to work around a bug in Emacs process signaling.")
574 :
575 : (defvar comint-input-ring nil)
576 : (defvar comint-last-input-start nil)
577 : (defvar comint-last-input-end nil)
578 : (defvar comint-last-output-start nil)
579 : (defvar comint-input-ring-index nil
580 : "Index of last matched history element.")
581 : (defvar comint-matching-input-from-input-string ""
582 : "Input previously used to match input history.")
583 : (defvar comint-save-input-ring-index nil
584 : "Last input ring index which you copied.
585 : This is to support the command \\[comint-get-next-from-history].")
586 :
587 : (defvar comint-accum-marker nil
588 : "Non-nil if you are accumulating input lines to send as input together.
589 : The command \\[comint-accumulate] sets this.")
590 :
591 : (defvar comint-stored-incomplete-input nil
592 : "Stored input for history cycling.")
593 :
594 : (put 'comint-replace-by-expanded-history 'menu-enable 'comint-input-autoexpand)
595 : (put 'comint-input-ring 'permanent-local t)
596 : (put 'comint-input-ring-index 'permanent-local t)
597 : (put 'comint-save-input-ring-index 'permanent-local t)
598 : (put 'comint-input-autoexpand 'permanent-local t)
599 : (put 'comint-input-filter-functions 'permanent-local t)
600 : (put 'comint-output-filter-functions 'permanent-local t)
601 : (put 'comint-preoutput-filter-functions 'permanent-local t)
602 : (put 'comint-scroll-to-bottom-on-input 'permanent-local t)
603 : (put 'comint-move-point-for-output 'permanent-local t)
604 : (put 'comint-scroll-show-maximum-output 'permanent-local t)
605 : (put 'comint-ptyp 'permanent-local t)
606 :
607 : (put 'comint-mode 'mode-class 'special)
608 :
609 : (define-derived-mode comint-mode fundamental-mode "Comint"
610 : "Major mode for interacting with an inferior interpreter.
611 : Interpreter name is same as buffer name, sans the asterisks.
612 : Return at end of buffer sends line as input.
613 : Return not at end copies rest of line to end and sends it.
614 : Setting variable `comint-eol-on-send' means jump to the end of the line
615 : before submitting new input.
616 :
617 : This mode is customized to create major modes such as Inferior Lisp
618 : mode, Shell mode, etc. This can be done by setting the hooks
619 : `comint-input-filter-functions', `comint-input-filter', `comint-input-sender'
620 : and `comint-get-old-input' to appropriate functions, and the variable
621 : `comint-prompt-regexp' to the appropriate regular expression.
622 :
623 : The mode maintains an input history of size `comint-input-ring-size'.
624 : You can access this with the commands \\[comint-next-input],
625 : \\[comint-previous-input], and \\[comint-dynamic-list-input-ring].
626 : Input ring history expansion can be achieved with the commands
627 : \\[comint-replace-by-expanded-history] or \\[comint-magic-space].
628 : Input ring expansion is controlled by the variable `comint-input-autoexpand',
629 : and addition is controlled by the variable `comint-input-ignoredups'.
630 :
631 : Commands with no default key bindings include `send-invisible',
632 : `completion-at-point', `comint-dynamic-list-filename-completions', and
633 : `comint-magic-space'.
634 :
635 : Input to, and output from, the subprocess can cause the window to scroll to
636 : the end of the buffer. See variables `comint-output-filter-functions',
637 : `comint-preoutput-filter-functions', `comint-scroll-to-bottom-on-input',
638 : and `comint-move-point-for-output'.
639 :
640 : If you accidentally suspend your process, use \\[comint-continue-subjob]
641 : to continue it.
642 :
643 : \\{comint-mode-map}
644 :
645 : Entry to this mode runs the hooks on `comint-mode-hook'."
646 12 : (setq mode-line-process '(":%s"))
647 12 : (setq-local window-point-insertion-type t)
648 12 : (setq-local comint-last-input-start (point-min-marker))
649 12 : (setq-local comint-last-input-end (point-min-marker))
650 12 : (setq-local comint-last-output-start (make-marker))
651 12 : (make-local-variable 'comint-last-prompt)
652 12 : (make-local-variable 'comint-prompt-regexp) ; Don't set; default
653 12 : (make-local-variable 'comint-input-ring-size) ; ...to global val.
654 12 : (make-local-variable 'comint-input-ring)
655 12 : (make-local-variable 'comint-input-ring-file-name)
656 12 : (or (and (boundp 'comint-input-ring) comint-input-ring)
657 12 : (setq comint-input-ring (make-ring comint-input-ring-size)))
658 12 : (make-local-variable 'comint-input-ring-index)
659 12 : (make-local-variable 'comint-save-input-ring-index)
660 12 : (or (and (boundp 'comint-input-ring-index) comint-input-ring-index)
661 12 : (setq comint-input-ring-index nil))
662 12 : (or (and (boundp 'comint-save-input-ring-index) comint-save-input-ring-index)
663 12 : (setq comint-save-input-ring-index nil))
664 12 : (make-local-variable 'comint-matching-input-from-input-string)
665 12 : (make-local-variable 'comint-input-autoexpand)
666 12 : (make-local-variable 'comint-input-ignoredups)
667 12 : (make-local-variable 'comint-delimiter-argument-list)
668 12 : (make-local-variable 'comint-completion-fignore)
669 12 : (make-local-variable 'comint-get-old-input)
670 12 : (make-local-variable 'comint-input-filter)
671 12 : (make-local-variable 'comint-input-sender)
672 12 : (make-local-variable 'comint-eol-on-send)
673 12 : (make-local-variable 'comint-scroll-to-bottom-on-input)
674 12 : (make-local-variable 'comint-move-point-for-output)
675 12 : (make-local-variable 'comint-scroll-show-maximum-output)
676 12 : (make-local-variable 'comint-stored-incomplete-input)
677 : ;; Following disabled because it seems to break the case when
678 : ;; comint-scroll-show-maximum-output is nil, and no-one can remember
679 : ;; what the original problem was. If there are problems with point
680 : ;; not going to the end, consider re-enabling this.
681 : ;; http://lists.gnu.org/archive/html/emacs-devel/2007-08/msg00827.html
682 : ;;
683 : ;; This makes it really work to keep point at the bottom.
684 : ;; (make-local-variable 'scroll-conservatively)
685 : ;; (setq scroll-conservatively 10000)
686 12 : (add-hook 'pre-command-hook 'comint-preinput-scroll-to-bottom t t)
687 12 : (make-local-variable 'comint-ptyp)
688 12 : (make-local-variable 'comint-process-echoes)
689 12 : (make-local-variable 'comint-file-name-chars)
690 12 : (make-local-variable 'comint-file-name-quote-list)
691 : ;; dir tracking on remote files
692 12 : (setq-local comint-file-name-prefix
693 12 : (or (file-remote-p default-directory) ""))
694 12 : (setq-local comint-accum-marker (make-marker))
695 12 : (setq-local font-lock-defaults '(nil t))
696 12 : (add-hook 'change-major-mode-hook 'font-lock-defontify nil t)
697 12 : (add-hook 'isearch-mode-hook 'comint-history-isearch-setup nil t)
698 12 : (add-hook 'completion-at-point-functions 'comint-completion-at-point nil t)
699 : ;; This behavior is not useful in comint buffers, and is annoying
700 12 : (setq-local next-line-add-newlines nil))
701 :
702 : (defun comint-check-proc (buffer)
703 : "Return non-nil if there is a living process associated w/buffer BUFFER.
704 : Living means the status is `open', `run', or `stop'.
705 : BUFFER can be either a buffer or the name of one."
706 2 : (let ((proc (get-buffer-process buffer)))
707 2 : (and proc (memq (process-status proc) '(open run stop)))))
708 :
709 : ;;;###autoload
710 : (defun make-comint-in-buffer (name buffer program &optional startfile &rest switches)
711 : "Make a Comint process NAME in BUFFER, running PROGRAM.
712 : If BUFFER is nil, it defaults to NAME surrounded by `*'s.
713 : If there is a running process in BUFFER, it is not restarted.
714 :
715 : PROGRAM should be one of the following:
716 : - a string, denoting an executable program to create via
717 : `start-file-process'
718 : - a cons pair of the form (HOST . SERVICE), denoting a TCP
719 : connection to be opened via `open-network-stream'
720 : - nil, denoting a newly-allocated pty.
721 :
722 : Optional fourth arg STARTFILE is the name of a file, whose
723 : contents are sent to the process as its initial input.
724 :
725 : If PROGRAM is a string, any more args are arguments to PROGRAM.
726 :
727 : Return the (possibly newly created) process buffer."
728 1 : (or (fboundp 'start-file-process)
729 1 : (error "Multi-processing is not supported for this system"))
730 1 : (setq buffer (get-buffer-create (or buffer (concat "*" name "*"))))
731 : ;; If no process, or nuked process, crank up a new one and put buffer in
732 : ;; comint mode. Otherwise, leave buffer and existing process alone.
733 1 : (unless (comint-check-proc buffer)
734 1 : (with-current-buffer buffer
735 1 : (unless (derived-mode-p 'comint-mode)
736 1 : (comint-mode))) ; Install local vars, mode, keymap, ...
737 1 : (comint-exec buffer name program startfile switches))
738 1 : buffer)
739 :
740 : ;;;###autoload
741 : (defun make-comint (name program &optional startfile &rest switches)
742 : "Make a Comint process NAME in a buffer, running PROGRAM.
743 : The name of the buffer is made by surrounding NAME with `*'s.
744 : PROGRAM should be either a string denoting an executable program to create
745 : via `start-file-process', or a cons pair of the form (HOST . SERVICE) denoting
746 : a TCP connection to be opened via `open-network-stream'. If there is already
747 : a running process in that buffer, it is not restarted. Optional third arg
748 : STARTFILE is the name of a file, whose contents are sent to the
749 : process as its initial input.
750 :
751 : If PROGRAM is a string, any more args are arguments to PROGRAM.
752 :
753 : Returns the (possibly newly created) process buffer."
754 0 : (apply #'make-comint-in-buffer name nil program startfile switches))
755 :
756 : ;;;###autoload
757 : (defun comint-run (program)
758 : "Run PROGRAM in a Comint buffer and switch to it.
759 : The buffer name is made by surrounding the file name of PROGRAM with `*'s.
760 : The file name is used to make a symbol name, such as `comint-sh-hook', and any
761 : hooks on this symbol are run in the buffer.
762 : See `make-comint' and `comint-exec'."
763 : (declare (interactive-only make-comint))
764 : (interactive "sRun program: ")
765 0 : (let ((name (file-name-nondirectory program)))
766 0 : (switch-to-buffer (make-comint name program))
767 0 : (run-hooks (intern-soft (concat "comint-" name "-hook")))))
768 :
769 : (defun comint-exec (buffer name command startfile switches)
770 : "Start up a process named NAME in buffer BUFFER for Comint modes.
771 : Runs the given COMMAND with SWITCHES, and initial input from STARTFILE.
772 :
773 : COMMAND should be one of the following:
774 : - a string, denoting an executable program to create via
775 : `start-file-process'
776 : - a cons pair of the form (HOST . SERVICE), denoting a TCP
777 : connection to be opened via `open-network-stream'
778 : - nil, denoting a newly-allocated pty.
779 :
780 : This function blasts any old process running in the buffer, and
781 : does not set the buffer mode. You can use this to cheaply run a
782 : series of processes in the same Comint buffer. The hook
783 : `comint-exec-hook' is run after each exec."
784 1 : (with-current-buffer buffer
785 1 : (let ((proc (get-buffer-process buffer))) ; Blast any old process.
786 1 : (if proc (delete-process proc)))
787 : ;; Crank up a new process
788 1 : (let ((proc
789 1 : (if (consp command)
790 0 : (open-network-stream name buffer (car command) (cdr command))
791 1 : (comint-exec-1 name buffer command switches))))
792 1 : (set-process-filter proc 'comint-output-filter)
793 1 : (setq-local comint-ptyp process-connection-type) ; t if pty, nil if pipe.
794 : ;; Jump to the end, and set the process mark.
795 1 : (goto-char (point-max))
796 1 : (set-marker (process-mark proc) (point))
797 : ;; Feed it the startfile.
798 1 : (cond (startfile
799 : ;;This is guaranteed to wait long enough
800 : ;;but has bad results if the comint does not prompt at all
801 : ;; (while (= size (buffer-size))
802 : ;; (sleep-for 1))
803 : ;;I hope 1 second is enough!
804 0 : (sleep-for 1)
805 0 : (goto-char (point-max))
806 0 : (insert-file-contents startfile)
807 0 : (setq startfile (buffer-substring (point) (point-max)))
808 0 : (delete-region (point) (point-max))
809 1 : (comint-send-string proc startfile)))
810 1 : (run-hooks 'comint-exec-hook)
811 1 : buffer)))
812 :
813 : ;; This auxiliary function cranks up the process for comint-exec in
814 : ;; the appropriate environment.
815 :
816 : (defun comint-exec-1 (name buffer command switches)
817 1 : (let ((process-environment
818 1 : (nconc
819 : ;; If using termcap, we specify `emacs' as the terminal type
820 : ;; because that lets us specify a width.
821 : ;; If using terminfo, we specify `dumb' because that is
822 : ;; a defined terminal type. `emacs' is not a defined terminal type
823 : ;; and there is no way for us to define it here.
824 : ;; Some programs that use terminfo get very confused
825 : ;; if TERM is not a valid terminal type.
826 : ;; ;; There is similar code in compile.el.
827 1 : (if (and (boundp 'system-uses-terminfo) system-uses-terminfo)
828 1 : (list "TERM=dumb" "TERMCAP="
829 1 : (format "COLUMNS=%d" (window-width)))
830 0 : (list "TERM=emacs"
831 1 : (format "TERMCAP=emacs:co#%d:tc=unknown:" (window-width))))
832 1 : (list (format "INSIDE_EMACS=%s,comint" emacs-version))
833 1 : process-environment))
834 : (default-directory
835 1 : (if (file-accessible-directory-p default-directory)
836 1 : default-directory
837 1 : "/"))
838 : proc decoding encoding changed)
839 1 : (let ((exec-path (if (and command (file-name-directory command))
840 : ;; If the command has slashes, make sure we
841 : ;; first look relative to the current directory.
842 1 : (cons default-directory exec-path) exec-path)))
843 1 : (setq proc (apply 'start-file-process name buffer command switches)))
844 : ;; Some file name handler cannot start a process, fe ange-ftp.
845 1 : (unless (processp proc) (error "No process started"))
846 1 : (let ((coding-systems (process-coding-system proc)))
847 1 : (setq decoding (car coding-systems)
848 1 : encoding (cdr coding-systems)))
849 : ;; Even if start-file-process left the coding system for encoding data
850 : ;; sent from the process undecided, we had better use the same one
851 : ;; as what we use for decoding. But, we should suppress EOL
852 : ;; conversion.
853 1 : (if (and decoding (not encoding))
854 0 : (setq encoding (coding-system-change-eol-conversion decoding 'unix)
855 1 : changed t))
856 1 : (if changed
857 1 : (set-process-coding-system proc decoding encoding))
858 1 : proc))
859 :
860 : (defun comint-nonblank-p (str)
861 : "Return non-nil if STR contains non-whitespace syntax."
862 0 : (not (string-match "\\`\\s *\\'" str)))
863 :
864 : (defun comint-insert-input (event)
865 : "In a Comint buffer, set the current input to the previous input at point.
866 : If there is no previous input at point, run the command specified
867 : by the global keymap (usually `mouse-yank-at-click')."
868 : (interactive "e")
869 : ;; Don't set the mouse here, since it may otherwise change the behavior
870 : ;; of the command on which we fallback if there's no field at point.
871 : ;; (mouse-set-point event)
872 0 : (let ((pos (posn-point (event-end event)))
873 : field input)
874 0 : (with-selected-window (posn-window (event-end event))
875 : ;; If pos is at the very end of a field, the mouse-click was
876 : ;; probably outside (to the right) of the field.
877 0 : (and (< pos (field-end pos))
878 0 : (< (field-end pos) (point-max))
879 0 : (progn (setq field (field-at-pos pos))
880 0 : (setq input (field-string-no-properties pos)))))
881 0 : (if (or (null input) (null comint-accum-marker) field)
882 : ;; Fall back to the global definition if (i) the selected
883 : ;; buffer is not a comint buffer (which can happen if a
884 : ;; non-comint window was selected and we clicked in a comint
885 : ;; window), or (ii) there is no input at POS.
886 0 : (let* ((keys (this-command-keys))
887 0 : (last-key (and (vectorp keys) (aref keys (1- (length keys)))))
888 0 : (fun (and last-key (lookup-key global-map (vector last-key)))))
889 0 : (and fun (not (eq fun 'comint-insert-input))
890 0 : (call-interactively fun)))
891 0 : (with-selected-window (posn-window (event-end event))
892 : ;; Otherwise, insert the previous input.
893 0 : (goto-char (point-max))
894 : ;; First delete any old unsent input at the end
895 0 : (delete-region
896 0 : (or (marker-position comint-accum-marker)
897 0 : (process-mark (get-buffer-process (current-buffer))))
898 0 : (point))
899 : ;; Insert the input at point
900 0 : (insert input)))))
901 :
902 : ;; Input history processing in a buffer
903 : ;; ===========================================================================
904 : ;; Useful input history functions, courtesy of the Ergo group.
905 :
906 : ;; Eleven commands:
907 : ;; comint-dynamic-list-input-ring List history in help buffer.
908 : ;; comint-previous-input Previous input...
909 : ;; comint-previous-matching-input ...matching a string.
910 : ;; comint-previous-matching-input-from-input ... matching the current input.
911 : ;; comint-next-input Next input...
912 : ;; comint-next-matching-input ...matching a string.
913 : ;; comint-next-matching-input-from-input ... matching the current input.
914 : ;; comint-backward-matching-input Backwards input...
915 : ;; comint-forward-matching-input ...matching a string.
916 : ;; comint-replace-by-expanded-history Expand history at point;
917 : ;; replace with expanded history.
918 : ;; comint-magic-space Expand history and insert space.
919 : ;;
920 : ;; Three functions:
921 : ;; comint-read-input-ring Read into comint-input-ring...
922 : ;; comint-write-input-ring Write to comint-input-ring-file-name.
923 : ;; comint-replace-by-expanded-history-before-point Workhorse function.
924 :
925 : (defun comint-read-input-ring (&optional silent)
926 : "Set the buffer's `comint-input-ring' from a history file.
927 : The name of the file is given by the variable `comint-input-ring-file-name'.
928 : The history ring is of size `comint-input-ring-size', regardless of file size.
929 : If `comint-input-ring-file-name' is nil this function does nothing.
930 :
931 : If the optional argument SILENT is non-nil, we say nothing about a
932 : failure to read the history file.
933 :
934 : This function is useful for major mode commands and mode hooks.
935 :
936 : The commands stored in the history file are separated by the
937 : `comint-input-ring-separator', and entries that match
938 : `comint-input-history-ignore' are ignored. The most recent command
939 : comes last.
940 :
941 : See also `comint-input-ignoredups' and `comint-write-input-ring'."
942 11 : (cond ((or (null comint-input-ring-file-name)
943 11 : (equal comint-input-ring-file-name ""))
944 : nil)
945 11 : ((not (file-readable-p comint-input-ring-file-name))
946 11 : (or silent
947 0 : (message "Cannot read history file %s"
948 11 : comint-input-ring-file-name)))
949 : (t
950 0 : (let* ((file comint-input-ring-file-name)
951 : (count 0)
952 : ;; Some users set HISTSIZE or `comint-input-ring-size'
953 : ;; to huge numbers. Don't allocate a huge ring right
954 : ;; away; there might not be that much history.
955 0 : (ring-size (min 1500 comint-input-ring-size))
956 0 : (ring (make-ring ring-size)))
957 0 : (with-temp-buffer
958 0 : (insert-file-contents file)
959 : ;; Save restriction in case file is already visited...
960 : ;; Watch for those date stamps in history files!
961 0 : (goto-char (point-max))
962 0 : (let (start end history)
963 0 : (while (and (< count comint-input-ring-size)
964 0 : (re-search-backward comint-input-ring-separator
965 0 : nil t)
966 0 : (setq end (match-beginning 0)))
967 0 : (setq start
968 0 : (if (re-search-backward comint-input-ring-separator
969 0 : nil t)
970 0 : (match-end 0)
971 0 : (point-min)))
972 0 : (setq history (buffer-substring start end))
973 0 : (goto-char start)
974 0 : (when (and (not (string-match comint-input-history-ignore
975 0 : history))
976 0 : (or (null comint-input-ignoredups)
977 0 : (ring-empty-p ring)
978 0 : (not (string-equal (ring-ref ring 0)
979 0 : history))))
980 0 : (when (= count ring-size)
981 0 : (ring-extend ring (min (- comint-input-ring-size ring-size)
982 0 : ring-size))
983 0 : (setq ring-size (ring-size ring)))
984 0 : (ring-insert-at-beginning ring history)
985 0 : (setq count (1+ count))))))
986 0 : (setq comint-input-ring ring
987 11 : comint-input-ring-index nil)))))
988 :
989 : (defun comint-write-input-ring ()
990 : "Writes the buffer's `comint-input-ring' to a history file.
991 : The name of the file is given by the variable `comint-input-ring-file-name'.
992 : The original contents of the file are lost if `comint-input-ring' is not empty.
993 : If `comint-input-ring-file-name' is nil this function does nothing.
994 :
995 : Useful within process sentinels.
996 :
997 : See also `comint-read-input-ring'."
998 0 : (cond ((or (null comint-input-ring-file-name)
999 0 : (equal comint-input-ring-file-name "")
1000 0 : (null comint-input-ring) (ring-empty-p comint-input-ring))
1001 : nil)
1002 0 : ((not (file-writable-p comint-input-ring-file-name))
1003 0 : (message "Cannot write history file %s" comint-input-ring-file-name))
1004 : (t
1005 0 : (let* ((history-buf (get-buffer-create " *Temp Input History*"))
1006 0 : (ring comint-input-ring)
1007 0 : (file comint-input-ring-file-name)
1008 0 : (index (ring-length ring)))
1009 : ;; Write it all out into a buffer first. Much faster, but messier,
1010 : ;; than writing it one line at a time.
1011 0 : (with-current-buffer history-buf
1012 0 : (erase-buffer)
1013 0 : (while (> index 0)
1014 0 : (setq index (1- index))
1015 0 : (insert (ring-ref ring index) comint-input-ring-separator))
1016 0 : (write-region (buffer-string) nil file nil 'no-message)
1017 0 : (kill-buffer nil))))))
1018 :
1019 :
1020 : (defvar comint-dynamic-list-input-ring-window-conf)
1021 :
1022 : (defun comint-dynamic-list-input-ring-select ()
1023 : "Choose the input history entry that point is in or next to."
1024 : (interactive)
1025 0 : (let ((buffer completion-reference-buffer)
1026 : beg end completion)
1027 0 : (if (and (not (eobp)) (get-text-property (point) 'mouse-face))
1028 0 : (setq end (point) beg (1+ (point))))
1029 0 : (if (and (not (bobp)) (get-text-property (1- (point)) 'mouse-face))
1030 0 : (setq end (1- (point)) beg (point)))
1031 0 : (if (null beg)
1032 0 : (error "No history entry here"))
1033 0 : (setq beg (previous-single-property-change beg 'mouse-face))
1034 0 : (setq end (or (next-single-property-change end 'mouse-face) (point-max)))
1035 0 : (setq completion (buffer-substring beg end))
1036 0 : (set-window-configuration comint-dynamic-list-input-ring-window-conf)
1037 0 : (choose-completion-string completion buffer)))
1038 :
1039 : (defun comint-dynamic-list-input-ring ()
1040 : "Display a list of recent inputs entered into the current buffer."
1041 : (interactive)
1042 0 : (if (or (not (ring-p comint-input-ring))
1043 0 : (ring-empty-p comint-input-ring))
1044 0 : (message "No history")
1045 0 : (let ((history nil)
1046 : (history-buffer " *Input History*")
1047 0 : (conf (current-window-configuration)))
1048 : ;; We have to build up a list ourselves from the ring vector.
1049 0 : (dotimes (index (ring-length comint-input-ring))
1050 0 : (push (ring-ref comint-input-ring index) history))
1051 : ;; Show them most-recent-first.
1052 0 : (setq history (nreverse history))
1053 : ;; Change "completion" to "history reference"
1054 : ;; to make the display accurate.
1055 0 : (with-output-to-temp-buffer history-buffer
1056 0 : (display-completion-list history)
1057 0 : (set-buffer history-buffer)
1058 0 : (let ((keymap (make-sparse-keymap)))
1059 0 : (set-keymap-parent keymap (current-local-map))
1060 0 : (define-key keymap "\C-m" 'comint-dynamic-list-input-ring-select)
1061 0 : (use-local-map keymap))
1062 0 : (forward-line 3)
1063 0 : (while (search-backward "completion" nil 'move)
1064 0 : (replace-match "history reference")))
1065 0 : (sit-for 0)
1066 0 : (message "Hit space to flush")
1067 0 : (setq comint-dynamic-list-input-ring-window-conf conf)
1068 0 : (let ((ch (read-event)))
1069 0 : (if (eq ch ?\s)
1070 0 : (set-window-configuration conf)
1071 0 : (push ch unread-command-events))))))
1072 :
1073 :
1074 : (defun comint-regexp-arg (prompt)
1075 : "Return list of regexp and prefix arg using PROMPT."
1076 0 : (let* (;; Don't clobber this.
1077 0 : (last-command last-command)
1078 0 : (regexp (read-from-minibuffer prompt nil nil nil
1079 0 : 'minibuffer-history-search-history)))
1080 : ;; If the user didn't enter anything, nothing is added to m-h-s-h.
1081 : ;; Use the previous search regexp, if there is one.
1082 0 : (list (if (string-equal regexp "")
1083 0 : (or (car minibuffer-history-search-history)
1084 0 : regexp)
1085 0 : regexp)
1086 0 : (prefix-numeric-value current-prefix-arg))))
1087 :
1088 : (defun comint-search-arg (arg)
1089 : ;; First make sure there is a ring and that we are after the process mark
1090 0 : (cond ((not (comint-after-pmark-p))
1091 0 : (user-error "Not at command line"))
1092 0 : ((or (null comint-input-ring)
1093 0 : (ring-empty-p comint-input-ring))
1094 0 : (user-error "Empty input ring"))
1095 0 : ((zerop arg)
1096 : ;; arg of zero resets search from beginning, and uses arg of 1
1097 0 : (setq comint-input-ring-index nil)
1098 : 1)
1099 : (t
1100 0 : arg)))
1101 :
1102 : (defun comint-restore-input ()
1103 : "Restore unfinished input."
1104 : (interactive)
1105 0 : (when comint-input-ring-index
1106 0 : (comint-delete-input)
1107 0 : (when (> (length comint-stored-incomplete-input) 0)
1108 0 : (insert comint-stored-incomplete-input)
1109 0 : (message "Input restored"))
1110 0 : (setq comint-input-ring-index nil)))
1111 :
1112 : (defun comint-search-start (arg)
1113 : "Index to start a directional search, starting at `comint-input-ring-index'."
1114 0 : (if comint-input-ring-index
1115 : ;; If a search is running, offset by 1 in direction of arg
1116 0 : (mod (+ comint-input-ring-index (if (> arg 0) 1 -1))
1117 0 : (ring-length comint-input-ring))
1118 : ;; For a new search, start from beginning or end, as appropriate
1119 0 : (if (>= arg 0)
1120 : 0 ; First elt for forward search
1121 0 : (1- (ring-length comint-input-ring))))) ; Last elt for backward search
1122 :
1123 : (defun comint-previous-input-string (arg)
1124 : "Return the string ARG places along the input ring.
1125 : Moves relative to `comint-input-ring-index'."
1126 0 : (ring-ref comint-input-ring (if comint-input-ring-index
1127 0 : (mod (+ arg comint-input-ring-index)
1128 0 : (ring-length comint-input-ring))
1129 0 : arg)))
1130 :
1131 : (defun comint-previous-input (arg)
1132 : "Cycle backwards through input history, saving input."
1133 : (interactive "*p")
1134 0 : (if (and comint-input-ring-index
1135 0 : (or ;; leaving the "end" of the ring
1136 0 : (and (< arg 0) ; going down
1137 0 : (eq comint-input-ring-index 0))
1138 0 : (and (> arg 0) ; going up
1139 0 : (eq comint-input-ring-index
1140 0 : (1- (ring-length comint-input-ring)))))
1141 0 : comint-stored-incomplete-input)
1142 0 : (comint-restore-input)
1143 0 : (comint-previous-matching-input "." arg)))
1144 :
1145 : (defun comint-next-input (arg)
1146 : "Cycle forwards through input history."
1147 : (interactive "*p")
1148 0 : (comint-previous-input (- arg)))
1149 :
1150 : (defun comint-previous-matching-input-string (regexp arg)
1151 : "Return the string matching REGEXP ARG places along the input ring.
1152 : Moves relative to `comint-input-ring-index'."
1153 0 : (let* ((pos (comint-previous-matching-input-string-position regexp arg)))
1154 0 : (if pos (ring-ref comint-input-ring pos))))
1155 :
1156 : (defun comint-previous-matching-input-string-position (regexp arg &optional start)
1157 : "Return the index matching REGEXP ARG places along the input ring.
1158 : Moves relative to START, or `comint-input-ring-index'."
1159 0 : (if (or (not (ring-p comint-input-ring))
1160 0 : (ring-empty-p comint-input-ring))
1161 0 : (user-error "No history"))
1162 0 : (let* ((len (ring-length comint-input-ring))
1163 0 : (motion (if (> arg 0) 1 -1))
1164 0 : (n (mod (- (or start (comint-search-start arg)) motion) len))
1165 : (tried-each-ring-item nil)
1166 : (prev nil))
1167 : ;; Do the whole search as many times as the argument says.
1168 0 : (while (and (/= arg 0) (not tried-each-ring-item))
1169 : ;; Step once.
1170 0 : (setq prev n
1171 0 : n (mod (+ n motion) len))
1172 : ;; If we haven't reached a match, step some more.
1173 0 : (while (and (< n len) (not tried-each-ring-item)
1174 0 : (not (string-match regexp (ring-ref comint-input-ring n))))
1175 0 : (setq n (mod (+ n motion) len)
1176 : ;; If we have gone all the way around in this search.
1177 0 : tried-each-ring-item (= n prev)))
1178 0 : (setq arg (if (> arg 0) (1- arg) (1+ arg))))
1179 : ;; Now that we know which ring element to use, if we found it, return that.
1180 0 : (if (string-match regexp (ring-ref comint-input-ring n))
1181 0 : n)))
1182 :
1183 : (defun comint-delete-input ()
1184 : "Delete all input between accumulation or process mark and point."
1185 0 : (delete-region
1186 : ;; Can't use kill-region as it sets this-command
1187 0 : (or (marker-position comint-accum-marker)
1188 0 : (process-mark (get-buffer-process (current-buffer))))
1189 0 : (point-max)))
1190 :
1191 : (defun comint-previous-matching-input (regexp n)
1192 : "Search backwards through input history for match for REGEXP.
1193 : \(Previous history elements are earlier commands.)
1194 : With prefix argument N, search for Nth previous match.
1195 : If N is negative, find the next or Nth next match."
1196 0 : (interactive (comint-regexp-arg "Previous input matching (regexp): "))
1197 0 : (setq n (comint-search-arg n))
1198 0 : (let ((pos (comint-previous-matching-input-string-position regexp n)))
1199 : ;; Has a match been found?
1200 0 : (if (null pos)
1201 0 : (user-error "Not found")
1202 : ;; If leaving the edit line, save partial input
1203 0 : (if (null comint-input-ring-index) ;not yet on ring
1204 0 : (setq comint-stored-incomplete-input
1205 0 : (funcall comint-get-old-input)))
1206 0 : (setq comint-input-ring-index pos)
1207 0 : (unless isearch-mode
1208 0 : (let ((message-log-max nil)) ; Do not write to *Messages*.
1209 0 : (message "History item: %d" (1+ pos))))
1210 0 : (comint-delete-input)
1211 0 : (insert (ring-ref comint-input-ring pos)))))
1212 :
1213 : (defun comint-next-matching-input (regexp n)
1214 : "Search forwards through input history for match for REGEXP.
1215 : \(Later history elements are more recent commands.)
1216 : With prefix argument N, search for Nth following match.
1217 : If N is negative, find the previous or Nth previous match."
1218 0 : (interactive (comint-regexp-arg "Next input matching (regexp): "))
1219 0 : (comint-previous-matching-input regexp (- n)))
1220 :
1221 : (defun comint-previous-matching-input-from-input (n)
1222 : "Search backwards through input history for match for current input.
1223 : \(Previous history elements are earlier commands.)
1224 : With prefix argument N, search for Nth previous match.
1225 : If N is negative, search forwards for the -Nth following match."
1226 : (interactive "p")
1227 0 : (let ((opoint (point)))
1228 0 : (unless (memq last-command '(comint-previous-matching-input-from-input
1229 0 : comint-next-matching-input-from-input))
1230 : ;; Starting a new search
1231 0 : (setq comint-matching-input-from-input-string
1232 0 : (buffer-substring
1233 0 : (or (marker-position comint-accum-marker)
1234 0 : (process-mark (get-buffer-process (current-buffer))))
1235 0 : (point))
1236 0 : comint-input-ring-index nil))
1237 0 : (comint-previous-matching-input
1238 0 : (concat "^" (regexp-quote comint-matching-input-from-input-string))
1239 0 : n)
1240 0 : (when (eq comint-move-point-for-matching-input 'after-input)
1241 0 : (goto-char opoint))))
1242 :
1243 : (defun comint-next-matching-input-from-input (n)
1244 : "Search forwards through input history for match for current input.
1245 : \(Following history elements are more recent commands.)
1246 : With prefix argument N, search for Nth following match.
1247 : If N is negative, search backwards for the -Nth previous match."
1248 : (interactive "p")
1249 0 : (comint-previous-matching-input-from-input (- n)))
1250 :
1251 :
1252 : (defun comint-replace-by-expanded-history (&optional silent start)
1253 : "Expand input command history references before point.
1254 : Expansion is dependent on the value of `comint-input-autoexpand'.
1255 :
1256 : This function depends on the buffer's idea of the input history, which may not
1257 : match the command interpreter's idea, assuming it has one.
1258 :
1259 : Assumes history syntax is like typical Un*x shells'. However, since Emacs
1260 : cannot know the interpreter's idea of input line numbers, assuming it has one,
1261 : it cannot expand absolute input line number references.
1262 :
1263 : If the optional argument SILENT is non-nil, never complain
1264 : even if history reference seems erroneous.
1265 :
1266 : If the optional argument START is non-nil, that specifies the
1267 : start of the text to scan for history references, rather
1268 : than the logical beginning of line.
1269 :
1270 : See `comint-magic-space' and `comint-replace-by-expanded-history-before-point'.
1271 :
1272 : Returns t if successful."
1273 : (interactive)
1274 0 : (let ((f (comint-c-a-p-replace-by-expanded-history silent start)))
1275 0 : (if f (funcall f))))
1276 :
1277 : (defun comint-c-a-p-replace-by-expanded-history (&optional silent start)
1278 : "Expand input command history at point.
1279 : For use on `completion-at-point-functions'."
1280 0 : (if (and comint-input-autoexpand
1281 0 : (if comint-use-prompt-regexp
1282 : ;; Use comint-prompt-regexp
1283 0 : (save-excursion
1284 0 : (beginning-of-line)
1285 0 : (looking-at (concat comint-prompt-regexp "!\\|\\^")))
1286 : ;; Use input fields. User input that hasn't been entered
1287 : ;; yet, at the end of the buffer, has a nil `field' property.
1288 0 : (and (null (get-char-property (point) 'field))
1289 0 : (string-match "!\\|^\\^" (field-string))))
1290 0 : (catch 'dry-run
1291 0 : (comint-replace-by-expanded-history-before-point
1292 0 : silent start 'dry-run)))
1293 : (lambda ()
1294 : ;; Looks like there might be history references in the command.
1295 0 : (let ((previous-modified-tick (buffer-modified-tick)))
1296 0 : (comint-replace-by-expanded-history-before-point silent start)
1297 0 : (/= previous-modified-tick (buffer-modified-tick))))))
1298 :
1299 :
1300 : (defun comint-replace-by-expanded-history-before-point
1301 : (silent &optional start dry-run)
1302 : "Expand directory stack reference before point.
1303 : See `comint-replace-by-expanded-history'. Returns t if successful.
1304 :
1305 : If the optional argument START is non-nil, that specifies the
1306 : start of the text to scan for history references, rather
1307 : than the logical beginning of line.
1308 :
1309 : If DRY-RUN is non-nil, throw to DRY-RUN before performing any
1310 : actual side-effect."
1311 0 : (save-excursion
1312 0 : (let ((toend (- (line-end-position) (point)))
1313 0 : (start (or start (comint-line-beginning-position))))
1314 0 : (goto-char start)
1315 0 : (while (progn
1316 0 : (skip-chars-forward "^!^" (- (line-end-position) toend))
1317 0 : (< (point) (- (line-end-position) toend)))
1318 : ;; This seems a bit complex. We look for references such as !!, !-num,
1319 : ;; !foo, !?foo, !{bar}, !?{bar}, ^oh, ^my^, ^god^it, ^never^ends^.
1320 : ;; If that wasn't enough, the plings can be suffixed with argument
1321 : ;; range specifiers.
1322 : ;; Argument ranges are complex too, so we hive off the input line,
1323 : ;; referenced with plings, with the range string to `comint-args'.
1324 0 : (setq comint-input-ring-index nil)
1325 0 : (cond ((or (= (preceding-char) ?\\)
1326 0 : (comint-within-quotes start (point)))
1327 : ;; The history is quoted, or we're in quotes.
1328 0 : (goto-char (1+ (point))))
1329 0 : ((looking-at "![0-9]+\\($\\|[^-]\\)")
1330 : ;; We cannot know the interpreter's idea of input line numbers.
1331 0 : (if dry-run (throw dry-run 'message))
1332 0 : (goto-char (match-end 0))
1333 0 : (message "Absolute reference cannot be expanded"))
1334 0 : ((looking-at "!-\\([0-9]+\\)\\(:?[0-9^$*-]+\\)?")
1335 : ;; Just a number of args from `number' lines backward.
1336 0 : (if dry-run (throw dry-run 'history))
1337 0 : (let ((number (1- (string-to-number
1338 0 : (buffer-substring (match-beginning 1)
1339 0 : (match-end 1))))))
1340 0 : (if (<= number (ring-length comint-input-ring))
1341 0 : (progn
1342 0 : (replace-match
1343 0 : (comint-args (comint-previous-input-string number)
1344 0 : (match-beginning 2) (match-end 2))
1345 0 : t t)
1346 0 : (setq comint-input-ring-index number)
1347 0 : (message "History item: %d" (1+ number)))
1348 0 : (goto-char (match-end 0))
1349 0 : (message "Relative reference exceeds input history size"))))
1350 0 : ((or (looking-at "!!?:?\\([0-9^$*-]+\\)") (looking-at "!!"))
1351 : ;; Just a number of args from the previous input line.
1352 0 : (if dry-run (throw dry-run 'expand))
1353 0 : (replace-match (comint-args (comint-previous-input-string 0)
1354 0 : (match-beginning 1) (match-end 1))
1355 0 : t t)
1356 0 : (message "History item: previous"))
1357 0 : ((looking-at
1358 0 : "!\\??\\({\\(.+\\)}\\|\\(\\sw+\\)\\)\\(:?[0-9^$*-]+\\)?")
1359 : ;; Most recent input starting with or containing (possibly
1360 : ;; protected) string, maybe just a number of args. Phew.
1361 0 : (if dry-run (throw dry-run 'expand))
1362 0 : (let* ((mb1 (match-beginning 1)) (me1 (match-end 1))
1363 0 : (mb2 (match-beginning 2)) (me2 (match-end 2))
1364 0 : (exp (buffer-substring (or mb2 mb1) (or me2 me1)))
1365 0 : (pref (if (save-match-data (looking-at "!\\?")) "" "^"))
1366 0 : (pos (save-match-data
1367 0 : (comint-previous-matching-input-string-position
1368 0 : (concat pref (regexp-quote exp)) 1))))
1369 0 : (if (null pos)
1370 0 : (progn
1371 0 : (goto-char (match-end 0))
1372 0 : (or silent
1373 0 : (progn (message "Not found")
1374 0 : (ding))))
1375 0 : (setq comint-input-ring-index pos)
1376 0 : (replace-match
1377 0 : (comint-args (ring-ref comint-input-ring pos)
1378 0 : (match-beginning 4) (match-end 4))
1379 0 : t t)
1380 0 : (message "History item: %d" (1+ pos)))))
1381 0 : ((looking-at "\\^\\([^^]+\\)\\^?\\([^^]*\\)\\^?")
1382 : ;; Quick substitution on the previous input line.
1383 0 : (if dry-run (throw dry-run 'expand))
1384 0 : (let ((old (buffer-substring (match-beginning 1) (match-end 1)))
1385 0 : (new (buffer-substring (match-beginning 2) (match-end 2)))
1386 : (pos nil))
1387 0 : (replace-match (comint-previous-input-string 0) t t)
1388 0 : (setq pos (point))
1389 0 : (goto-char (match-beginning 0))
1390 0 : (if (not (search-forward old pos t))
1391 0 : (or silent
1392 0 : (user-error "Not found"))
1393 0 : (replace-match new t t)
1394 0 : (message "History item: substituted"))))
1395 : (t
1396 0 : (forward-char 1)))))
1397 0 : nil))
1398 :
1399 :
1400 : (defun comint-magic-space (arg)
1401 : "Expand input history references before point and insert ARG spaces.
1402 : A useful command to bind to SPC. See `comint-replace-by-expanded-history'."
1403 : (interactive "p")
1404 0 : (comint-replace-by-expanded-history)
1405 0 : (self-insert-command arg))
1406 :
1407 : ;; Isearch in comint input history
1408 :
1409 : (defcustom comint-history-isearch nil
1410 : "Non-nil to Isearch in input history only, not in comint buffer output.
1411 : If t, usual Isearch keys like `C-r' and `C-M-r' in comint mode search
1412 : in the input history.
1413 : If `dwim', Isearch keys search in the input history only when initial
1414 : point position is at the comint command line. When starting Isearch
1415 : from other parts of the comint buffer, they search in the comint buffer.
1416 : If nil, Isearch operates on the whole comint buffer."
1417 : :type '(choice (const :tag "Don't search in input history" nil)
1418 : (const :tag "When point is on command line initially, search history" dwim)
1419 : (const :tag "Always search in input history" t))
1420 : :group 'comint
1421 : :version "23.2")
1422 :
1423 : (defun comint-history-isearch-backward ()
1424 : "Search for a string backward in input history using Isearch."
1425 : (interactive)
1426 0 : (let ((comint-history-isearch t))
1427 0 : (isearch-backward nil t)))
1428 :
1429 : (defun comint-history-isearch-backward-regexp ()
1430 : "Search for a regular expression backward in input history using Isearch."
1431 : (interactive)
1432 0 : (let ((comint-history-isearch t))
1433 0 : (isearch-backward-regexp nil t)))
1434 :
1435 : (defvar-local comint-history-isearch-message-overlay nil)
1436 :
1437 : (defun comint-history-isearch-setup ()
1438 : "Set up a comint for using Isearch to search the input history.
1439 : Intended to be added to `isearch-mode-hook' in `comint-mode'."
1440 0 : (when (or (eq comint-history-isearch t)
1441 0 : (and (eq comint-history-isearch 'dwim)
1442 : ;; Point is at command line.
1443 0 : (comint-after-pmark-p)))
1444 0 : (setq isearch-message-prefix-add "history ")
1445 0 : (setq-local isearch-search-fun-function
1446 0 : #'comint-history-isearch-search)
1447 0 : (setq-local isearch-message-function
1448 0 : #'comint-history-isearch-message)
1449 0 : (setq-local isearch-wrap-function
1450 0 : #'comint-history-isearch-wrap)
1451 0 : (setq-local isearch-push-state-function
1452 0 : #'comint-history-isearch-push-state)
1453 0 : (add-hook 'isearch-mode-end-hook 'comint-history-isearch-end nil t)))
1454 :
1455 : (defun comint-history-isearch-end ()
1456 : "Clean up the comint after terminating Isearch in comint."
1457 0 : (if comint-history-isearch-message-overlay
1458 0 : (delete-overlay comint-history-isearch-message-overlay))
1459 0 : (setq isearch-message-prefix-add nil)
1460 0 : (setq isearch-search-fun-function 'isearch-search-fun-default)
1461 0 : (setq isearch-message-function nil)
1462 0 : (setq isearch-wrap-function nil)
1463 0 : (setq isearch-push-state-function nil)
1464 0 : (remove-hook 'isearch-mode-end-hook 'comint-history-isearch-end t))
1465 :
1466 : (defun comint-goto-input (pos)
1467 : "Put input history item of the absolute history position POS."
1468 : ;; If leaving the edit line, save partial unfinished input.
1469 0 : (if (null comint-input-ring-index)
1470 0 : (setq comint-stored-incomplete-input
1471 0 : (funcall comint-get-old-input)))
1472 0 : (setq comint-input-ring-index pos)
1473 0 : (comint-delete-input)
1474 0 : (if (and pos (not (ring-empty-p comint-input-ring)))
1475 0 : (insert (ring-ref comint-input-ring pos))
1476 : ;; Restore partial unfinished input.
1477 0 : (when (> (length comint-stored-incomplete-input) 0)
1478 0 : (insert comint-stored-incomplete-input))))
1479 :
1480 : (defun comint-history-isearch-search ()
1481 : "Return the proper search function, for Isearch in input history."
1482 : (lambda (string bound noerror)
1483 0 : (let ((search-fun
1484 : ;; Use standard functions to search within comint text
1485 0 : (isearch-search-fun-default))
1486 : found)
1487 : ;; Avoid lazy-highlighting matches in the comint prompt and in the
1488 : ;; output when searching forward. Lazy-highlight calls this lambda
1489 : ;; with the bound arg, so skip the prompt and the output.
1490 0 : (if (and bound isearch-forward (not (comint-after-pmark-p)))
1491 0 : (goto-char (process-mark (get-buffer-process (current-buffer)))))
1492 0 : (or
1493 : ;; 1. First try searching in the initial comint text
1494 0 : (funcall search-fun string
1495 0 : (if isearch-forward bound (comint-line-beginning-position))
1496 0 : noerror)
1497 : ;; 2. If the above search fails, start putting next/prev history
1498 : ;; elements in the comint successively, and search the string
1499 : ;; in them. Do this only when bound is nil (i.e. not while
1500 : ;; lazy-highlighting search strings in the current comint text).
1501 0 : (unless bound
1502 0 : (condition-case nil
1503 0 : (progn
1504 0 : (while (not found)
1505 0 : (cond (isearch-forward
1506 : ;; Signal an error here explicitly, because
1507 : ;; `comint-next-input' doesn't signal an error.
1508 0 : (when (null comint-input-ring-index)
1509 0 : (error "End of history; no next item"))
1510 0 : (comint-next-input 1)
1511 0 : (goto-char (comint-line-beginning-position)))
1512 : (t
1513 : ;; Signal an error here explicitly, because
1514 : ;; `comint-previous-input' doesn't signal an error.
1515 0 : (when (eq comint-input-ring-index
1516 0 : (1- (ring-length comint-input-ring)))
1517 0 : (error "Beginning of history; no preceding item"))
1518 0 : (comint-previous-input 1)
1519 0 : (goto-char (point-max))))
1520 0 : (setq isearch-barrier (point) isearch-opoint (point))
1521 : ;; After putting the next/prev history element, search
1522 : ;; the string in them again, until comint-next-input
1523 : ;; or comint-previous-input raises an error at the
1524 : ;; beginning/end of history.
1525 0 : (setq found (funcall search-fun string
1526 0 : (unless isearch-forward
1527 : ;; For backward search, don't search
1528 : ;; in the comint prompt
1529 0 : (comint-line-beginning-position))
1530 0 : noerror)))
1531 : ;; Return point of the new search result
1532 0 : (point))
1533 : ;; Return nil on the error "no next/preceding item"
1534 0 : (error nil)))))))
1535 :
1536 : (defun comint-history-isearch-message (&optional c-q-hack ellipsis)
1537 : "Display the input history search prompt.
1538 : If there are no search errors, this function displays an overlay with
1539 : the Isearch prompt which replaces the original comint prompt.
1540 : Otherwise, it displays the standard Isearch message returned from
1541 : the function `isearch-message'."
1542 0 : (if (not (and isearch-success (not isearch-error)))
1543 : ;; Use standard function `isearch-message' when not in comint prompt,
1544 : ;; or search fails, or has an error (like incomplete regexp).
1545 : ;; This function displays isearch message in the echo area,
1546 : ;; so it's possible to see what is wrong in the search string.
1547 0 : (isearch-message c-q-hack ellipsis)
1548 : ;; Otherwise, put the overlay with the standard isearch prompt over
1549 : ;; the initial comint prompt.
1550 0 : (if (overlayp comint-history-isearch-message-overlay)
1551 0 : (move-overlay comint-history-isearch-message-overlay
1552 0 : (save-excursion
1553 0 : (goto-char (comint-line-beginning-position))
1554 0 : (forward-line 0)
1555 0 : (point))
1556 0 : (comint-line-beginning-position))
1557 0 : (setq comint-history-isearch-message-overlay
1558 0 : (make-overlay (save-excursion
1559 0 : (goto-char (comint-line-beginning-position))
1560 0 : (forward-line 0)
1561 0 : (point))
1562 0 : (comint-line-beginning-position)))
1563 0 : (overlay-put comint-history-isearch-message-overlay 'evaporate t))
1564 0 : (overlay-put comint-history-isearch-message-overlay
1565 0 : 'display (isearch-message-prefix ellipsis isearch-nonincremental))
1566 0 : (if (and comint-input-ring-index (not ellipsis))
1567 : ;; Display the current history index.
1568 0 : (message "History item: %d" (1+ comint-input-ring-index))
1569 : ;; Or clear a previous isearch message.
1570 0 : (message ""))))
1571 :
1572 : (defun comint-history-isearch-wrap ()
1573 : "Wrap the input history search when search fails.
1574 : Move point to the first history element for a forward search,
1575 : or to the last history element for a backward search."
1576 : ;; When `comint-history-isearch-search' fails on reaching the
1577 : ;; beginning/end of the history, wrap the search to the first/last
1578 : ;; input history element.
1579 0 : (if isearch-forward
1580 0 : (comint-goto-input (1- (ring-length comint-input-ring)))
1581 0 : (comint-goto-input nil))
1582 0 : (setq isearch-success t)
1583 0 : (goto-char (if isearch-forward (comint-line-beginning-position) (point-max))))
1584 :
1585 : (defun comint-history-isearch-push-state ()
1586 : "Save a function restoring the state of input history search.
1587 : Save `comint-input-ring-index' to the additional state parameter
1588 : in the search status stack."
1589 0 : (let ((index comint-input-ring-index))
1590 : (lambda (cmd)
1591 0 : (comint-history-isearch-pop-state cmd index))))
1592 :
1593 : (defun comint-history-isearch-pop-state (_cmd hist-pos)
1594 : "Restore the input history search state.
1595 : Go to the history element by the absolute history position HIST-POS."
1596 0 : (comint-goto-input hist-pos))
1597 :
1598 :
1599 : (defun comint-within-quotes (beg end)
1600 : "Return t if the number of quotes between BEG and END is odd.
1601 : Quotes are single and double."
1602 0 : (let ((countsq (comint-how-many-region "\\(^\\|[^\\\\]\\)'" beg end))
1603 0 : (countdq (comint-how-many-region "\\(^\\|[^\\\\]\\)\"" beg end)))
1604 0 : (or (= (mod countsq 2) 1) (= (mod countdq 2) 1))))
1605 :
1606 : (defun comint-how-many-region (regexp beg end)
1607 : "Return number of matches for REGEXP from BEG to END."
1608 0 : (let ((count 0))
1609 0 : (save-excursion
1610 0 : (save-match-data
1611 0 : (goto-char beg)
1612 0 : (while (re-search-forward regexp end t)
1613 0 : (setq count (1+ count)))))
1614 0 : count))
1615 :
1616 : (defun comint-args (string begin end)
1617 : ;; From STRING, return the args depending on the range specified in the text
1618 : ;; from BEGIN to END. If BEGIN is nil, assume all args. Ignore leading `:'.
1619 : ;; Range can be x-y, x-, -y, where x/y can be [0-9], *, ^, $.
1620 0 : (save-match-data
1621 0 : (if (null begin)
1622 0 : (comint-arguments string 0 nil)
1623 0 : (let* ((range (buffer-substring
1624 0 : (if (eq (char-after begin) ?:) (1+ begin) begin) end))
1625 0 : (nth (cond ((string-match "^[*^]" range) 1)
1626 0 : ((string-match "^-" range) 0)
1627 0 : ((string-equal range "$") nil)
1628 0 : (t (string-to-number range))))
1629 0 : (mth (cond ((string-match "[-*$]$" range) nil)
1630 0 : ((string-match "-" range)
1631 0 : (string-to-number (substring range (match-end 0))))
1632 0 : (t nth))))
1633 0 : (comint-arguments string nth mth)))))
1634 :
1635 : (defun comint-delim-arg (arg)
1636 : "Return a list of arguments from ARG.
1637 : Break it up at the delimiters in `comint-delimiter-argument-list'.
1638 : Returned list is backwards.
1639 :
1640 : Characters with non-nil values of the text property `literal' are
1641 : assumed to have literal values (e.g., backslash-escaped
1642 : characters), and are not considered to be delimiters."
1643 0 : (if (null comint-delimiter-argument-list)
1644 0 : (list arg)
1645 0 : (let ((args nil)
1646 : (pos 0)
1647 0 : (len (length arg)))
1648 0 : (while (< pos len)
1649 0 : (let ((char (aref arg pos))
1650 0 : (start pos))
1651 0 : (if (and (memq char comint-delimiter-argument-list)
1652 : ;; Ignore backslash-escaped characters.
1653 0 : (not (get-text-property pos 'literal arg)))
1654 0 : (while (and (< pos len) (eq (aref arg pos) char))
1655 0 : (setq pos (1+ pos)))
1656 0 : (while (and (< pos len)
1657 0 : (not (and (memq (aref arg pos)
1658 0 : comint-delimiter-argument-list)
1659 0 : (not (get-text-property
1660 0 : pos 'literal arg)))))
1661 0 : (setq pos (1+ pos))))
1662 0 : (setq args (cons (substring arg start pos) args))))
1663 0 : args)))
1664 :
1665 : (defun comint-arguments (string nth mth)
1666 : "Return from STRING the NTH to MTH arguments.
1667 : NTH and/or MTH can be nil, which means the last argument.
1668 : Returned arguments are separated by single spaces.
1669 : We assume whitespace separates arguments, except within quotes
1670 : and except for a space or tab that immediately follows a backslash.
1671 : Also, a run of one or more of a single character
1672 : in `comint-delimiter-argument-list' is a separate argument.
1673 : Argument 0 is the command name."
1674 : ;; The first line handles ordinary characters and backslash-sequences
1675 : ;; (except with w32 msdos-like shells, where backslashes are valid).
1676 : ;; The second matches "-quoted strings.
1677 : ;; The third matches '-quoted strings.
1678 : ;; The fourth matches `-quoted strings.
1679 : ;; This seems to fit the syntax of BASH 2.0.
1680 0 : (let* ((backslash-escape (not (and (fboundp 'w32-shell-dos-semantics)
1681 0 : (w32-shell-dos-semantics))))
1682 0 : (first (if backslash-escape
1683 : "[^ \n\t\"'`\\]\\|\\(\\\\.\\)\\|"
1684 0 : "[^ \n\t\"'`]+\\|"))
1685 0 : (argpart (concat first
1686 : "\\(\"\\([^\"\\]\\|\\\\.\\)*\"\\|\
1687 : '[^']*'\\|\
1688 0 : `[^`]*`\\)"))
1689 0 : (quote-subexpr (if backslash-escape 2 1))
1690 : (args ()) (pos 0)
1691 : (count 0)
1692 : beg str quotes)
1693 : ;; Build a list of all the args until we have as many as we want.
1694 0 : (while (and (or (null mth) (<= count mth))
1695 0 : (string-match argpart string pos))
1696 : ;; Apply the `literal' text property to backslash-escaped
1697 : ;; characters, so that `comint-delim-arg' won't break them up.
1698 0 : (and backslash-escape
1699 0 : (match-beginning 1)
1700 0 : (put-text-property (match-beginning 1) (match-end 1)
1701 0 : 'literal t string))
1702 0 : (if (and beg (= pos (match-beginning 0)))
1703 : ;; It's contiguous, part of the same arg.
1704 0 : (setq pos (match-end 0)
1705 0 : quotes (or quotes (match-beginning quote-subexpr)))
1706 : ;; It's a new separate arg.
1707 0 : (if beg
1708 : ;; Put the previous arg, if there was one, onto ARGS.
1709 0 : (setq str (substring string beg pos)
1710 0 : args (if quotes (cons str args)
1711 0 : (nconc (comint-delim-arg str) args))))
1712 0 : (setq count (length args))
1713 0 : (setq quotes (match-beginning quote-subexpr))
1714 0 : (setq beg (match-beginning 0))
1715 0 : (setq pos (match-end 0))))
1716 0 : (if beg
1717 0 : (setq str (substring string beg pos)
1718 0 : args (if quotes (cons str args)
1719 0 : (nconc (comint-delim-arg str) args))))
1720 0 : (setq count (length args))
1721 0 : (let ((n (or nth (1- count)))
1722 0 : (m (if mth (1- (- count mth)) 0)))
1723 0 : (mapconcat
1724 0 : (function (lambda (a) a)) (nthcdr n (nreverse (nthcdr m args))) " "))))
1725 :
1726 : ;;
1727 : ;; Input processing stuff
1728 : ;;
1729 : (defun comint-add-to-input-history (cmd)
1730 : "Add CMD to the input history.
1731 : Ignore duplicates if `comint-input-ignoredups' is non-nil."
1732 0 : (when (and (funcall comint-input-filter cmd)
1733 0 : (or (null comint-input-ignoredups)
1734 0 : (not (ring-p comint-input-ring))
1735 0 : (ring-empty-p comint-input-ring)
1736 0 : (not (string-equal (ring-ref comint-input-ring 0) cmd))))
1737 : ;; If `comint-input-ring' is full, maybe grow it.
1738 0 : (let ((size (ring-size comint-input-ring)))
1739 0 : (and (= size (ring-length comint-input-ring))
1740 0 : (< size comint-input-ring-size)
1741 0 : (ring-extend comint-input-ring
1742 0 : (min size (- comint-input-ring-size size)))))
1743 0 : (ring-insert comint-input-ring cmd)))
1744 :
1745 : (defun comint-send-input (&optional no-newline artificial)
1746 : "Send input to process.
1747 : After the process output mark, sends all text from the process mark to
1748 : point as input to the process. Before the process output mark, calls
1749 : value of variable `comint-get-old-input' to retrieve old input, copies
1750 : it to the process mark, and sends it.
1751 :
1752 : This command also sends and inserts a final newline, unless
1753 : NO-NEWLINE is non-nil.
1754 :
1755 : Any history reference may be expanded depending on the value of the variable
1756 : `comint-input-autoexpand'. The list of function names contained in the value
1757 : of `comint-input-filter-functions' is called on the input before sending it.
1758 : The input is entered into the input history ring, if the value of variable
1759 : `comint-input-filter' returns non-nil when called on the input.
1760 :
1761 : If variable `comint-eol-on-send' is non-nil, then point is moved to the
1762 : end of line before sending the input.
1763 :
1764 : After the input has been sent, if `comint-process-echoes' is non-nil,
1765 : then `comint-send-input' waits to see if the process outputs a string
1766 : matching the input, and if so, deletes that part of the output.
1767 : If ARTIFICIAL is non-nil, it inhibits such deletion.
1768 : Callers sending input not from the user should use ARTIFICIAL = t.
1769 :
1770 : The values of `comint-get-old-input', `comint-input-filter-functions', and
1771 : `comint-input-filter' are chosen according to the command interpreter running
1772 : in the buffer. E.g.,
1773 :
1774 : If the interpreter is the csh,
1775 : `comint-get-old-input' is the default:
1776 : If `comint-use-prompt-regexp' is nil, then
1777 : either return the current input field, if point is on an input
1778 : field, or the current line, if point is on an output field.
1779 : If `comint-use-prompt-regexp' is non-nil, then
1780 : return the current line with any initial string matching the
1781 : regexp `comint-prompt-regexp' removed.
1782 : `comint-input-filter-functions' monitors input for \"cd\", \"pushd\", and
1783 : \"popd\" commands. When it sees one, it cd's the buffer.
1784 : `comint-input-filter' is the default: returns t if the input isn't all white
1785 : space.
1786 :
1787 : If the Comint is Lucid Common Lisp,
1788 : `comint-get-old-input' snarfs the sexp ending at point.
1789 : `comint-input-filter-functions' does nothing.
1790 : `comint-input-filter' returns nil if the input matches input-filter-regexp,
1791 : which matches (1) all whitespace (2) :a, :c, etc.
1792 :
1793 : Similarly for Soar, Scheme, etc."
1794 : (interactive)
1795 : ;; If we're currently completing, stop. We're definitely done
1796 : ;; completing, and by sending the input, we might cause side effects
1797 : ;; that will confuse the code running in the completion
1798 : ;; post-command-hook.
1799 0 : (when completion-in-region-mode
1800 0 : (completion-in-region-mode -1))
1801 : ;; Note that the input string does not include its terminal newline.
1802 0 : (let ((proc (get-buffer-process (current-buffer))))
1803 0 : (if (not proc) (user-error "Current buffer has no process")
1804 0 : (widen)
1805 0 : (let* ((pmark (process-mark proc))
1806 0 : (intxt (if (>= (point) (marker-position pmark))
1807 0 : (progn (if comint-eol-on-send
1808 0 : (if comint-use-prompt-regexp
1809 0 : (end-of-line)
1810 0 : (goto-char (field-end))))
1811 0 : (buffer-substring pmark (point)))
1812 0 : (let ((copy (funcall comint-get-old-input)))
1813 0 : (goto-char pmark)
1814 0 : (insert copy)
1815 0 : copy)))
1816 0 : (input (if (not (eq comint-input-autoexpand 'input))
1817 : ;; Just whatever's already there.
1818 0 : intxt
1819 : ;; Expand and leave it visible in buffer.
1820 0 : (comint-replace-by-expanded-history t pmark)
1821 0 : (buffer-substring pmark (point))))
1822 0 : (history (if (not (eq comint-input-autoexpand 'history))
1823 0 : input
1824 : ;; This is messy 'cos ultimately the original
1825 : ;; functions used do insertion, rather than return
1826 : ;; strings. We have to expand, then insert back.
1827 0 : (comint-replace-by-expanded-history t pmark)
1828 0 : (let ((copy (buffer-substring pmark (point)))
1829 0 : (start (point)))
1830 0 : (insert input)
1831 0 : (delete-region pmark start)
1832 0 : copy))))
1833 :
1834 0 : (unless no-newline
1835 0 : (insert ?\n))
1836 :
1837 0 : (comint-add-to-input-history history)
1838 :
1839 0 : (run-hook-with-args 'comint-input-filter-functions
1840 0 : (if no-newline input
1841 0 : (concat input "\n")))
1842 :
1843 0 : (let ((beg (marker-position pmark))
1844 0 : (end (if no-newline (point) (1- (point)))))
1845 0 : (with-silent-modifications
1846 0 : (when (> end beg)
1847 0 : (add-text-properties beg end
1848 : '(front-sticky t
1849 0 : font-lock-face comint-highlight-input))
1850 0 : (unless comint-use-prompt-regexp
1851 : ;; Give old user input a field property of `input', to
1852 : ;; distinguish it from both process output and unsent
1853 : ;; input. The terminating newline is put into a special
1854 : ;; `boundary' field to make cursor movement between input
1855 : ;; and output fields smoother.
1856 0 : (add-text-properties
1857 0 : beg end
1858 : '(mouse-face highlight
1859 0 : help-echo "mouse-2: insert after prompt as new input"))))
1860 0 : (unless (or no-newline comint-use-prompt-regexp)
1861 : ;; Cover the terminating newline
1862 0 : (add-text-properties end (1+ end)
1863 : '(rear-nonsticky t
1864 : field boundary
1865 0 : inhibit-line-move-field-capture t)))))
1866 :
1867 0 : (comint-snapshot-last-prompt)
1868 :
1869 0 : (setq comint-save-input-ring-index comint-input-ring-index)
1870 0 : (setq comint-input-ring-index nil)
1871 : ;; Update the markers before we send the input
1872 : ;; in case we get output amidst sending the input.
1873 0 : (set-marker comint-last-input-start pmark)
1874 0 : (set-marker comint-last-input-end (point))
1875 0 : (set-marker (process-mark proc) (point))
1876 : ;; clear the "accumulation" marker
1877 0 : (set-marker comint-accum-marker nil)
1878 0 : (let ((comint-input-sender-no-newline no-newline))
1879 0 : (funcall comint-input-sender proc input))
1880 :
1881 : ;; Optionally delete echoed input (after checking it).
1882 0 : (when (and comint-process-echoes (not artificial))
1883 0 : (let ((echo-len (- comint-last-input-end
1884 0 : comint-last-input-start)))
1885 : ;; Wait for all input to be echoed:
1886 0 : (while (and (> (+ comint-last-input-end echo-len)
1887 0 : (point-max))
1888 0 : (accept-process-output proc)
1889 0 : (zerop
1890 0 : (compare-buffer-substrings
1891 0 : nil comint-last-input-start
1892 0 : (- (point-max) echo-len)
1893 : ;; Above difference is equivalent to
1894 : ;; (+ comint-last-input-start
1895 : ;; (- (point-max) comint-last-input-end))
1896 0 : nil comint-last-input-end (point-max)))))
1897 0 : (if (and
1898 0 : (<= (+ comint-last-input-end echo-len)
1899 0 : (point-max))
1900 0 : (zerop
1901 0 : (compare-buffer-substrings
1902 0 : nil comint-last-input-start comint-last-input-end
1903 0 : nil comint-last-input-end
1904 0 : (+ comint-last-input-end echo-len))))
1905 : ;; Certain parts of the text to be deleted may have
1906 : ;; been mistaken for prompts. We have to prevent
1907 : ;; problems when `comint-prompt-read-only' is non-nil.
1908 0 : (let ((inhibit-read-only t))
1909 0 : (delete-region comint-last-input-end
1910 0 : (+ comint-last-input-end echo-len))
1911 0 : (when comint-prompt-read-only
1912 0 : (save-excursion
1913 0 : (goto-char comint-last-input-end)
1914 0 : (comint-update-fence)))))))
1915 :
1916 : ;; This used to call comint-output-filter-functions,
1917 : ;; but that scrolled the buffer in undesirable ways.
1918 0 : (run-hook-with-args 'comint-output-filter-functions "")))))
1919 :
1920 : (defvar comint-preoutput-filter-functions nil
1921 : "List of functions to call before inserting Comint output into the buffer.
1922 : Each function gets one argument, a string containing the text received
1923 : from the subprocess. It should return the string to insert, perhaps
1924 : the same string that was received, or perhaps a modified or transformed
1925 : string.
1926 :
1927 : The functions on the list are called sequentially, and each one is
1928 : given the string returned by the previous one. The string returned by
1929 : the last function is the text that is actually inserted in the
1930 : redirection buffer.
1931 :
1932 : You can use `add-hook' to add functions to this list
1933 : either globally or locally.")
1934 :
1935 : (defvar comint-inhibit-carriage-motion nil
1936 : "If nil, Comint will interpret `carriage control' characters in output.
1937 : See `comint-carriage-motion' for details.")
1938 :
1939 : (defvar comint-last-prompt nil
1940 : "Markers pointing to the last prompt.
1941 : If non-nil, a cons cell containing markers. The car points to
1942 : the start, the cdr to the end of the last prompt recognized.")
1943 :
1944 : (defun comint-snapshot-last-prompt ()
1945 : "Snapshot the current `comint-last-prompt'.
1946 : Freezes the `font-lock-face' text property in place."
1947 0 : (when comint-last-prompt
1948 0 : (with-silent-modifications
1949 0 : (font-lock-prepend-text-property
1950 0 : (car comint-last-prompt)
1951 0 : (cdr comint-last-prompt)
1952 0 : 'font-lock-face 'comint-highlight-prompt))
1953 : ;; Reset comint-last-prompt so later on comint-output-filter does
1954 : ;; not remove the font-lock-face text property of the previous
1955 : ;; (this) prompt.
1956 0 : (setq comint-last-prompt nil)))
1957 :
1958 : (defun comint-carriage-motion (start end)
1959 : "Interpret carriage control characters in the region from START to END.
1960 : Translate carriage return/linefeed sequences to linefeeds.
1961 : Make single carriage returns delete to the beginning of the line.
1962 : Make backspaces delete the previous character."
1963 28 : (save-excursion
1964 : ;; We used to check the existence of \b and \r at first to avoid
1965 : ;; calling save-match-data and save-restriction. But, such a
1966 : ;; check is not necessary now because we don't use regexp search
1967 : ;; nor save-restriction. Note that the buffer is already widen,
1968 : ;; and calling narrow-to-region and widen are not that heavy.
1969 28 : (goto-char start)
1970 28 : (let* ((inhibit-field-text-motion t)
1971 : (inhibit-read-only t)
1972 28 : (lbeg (line-beginning-position))
1973 : delete-end ch)
1974 : ;; If the preceding text is marked as "must-overwrite", record
1975 : ;; it in delete-end.
1976 28 : (when (and (> start (point-min))
1977 28 : (get-text-property (1- start) 'comint-must-overwrite))
1978 0 : (setq delete-end (point-marker))
1979 28 : (remove-text-properties lbeg start '(comint-must-overwrite nil)))
1980 28 : (narrow-to-region lbeg end)
1981 : ;; Handle BS, LF, and CR specially.
1982 351 : (while (and (skip-chars-forward "^\b\n\r") (not (eobp)))
1983 323 : (setq ch (following-char))
1984 323 : (cond ((= ch ?\b) ; CH = BS
1985 0 : (delete-char 1)
1986 0 : (if (> (point) lbeg)
1987 0 : (delete-char -1)))
1988 323 : ((= ch ?\n)
1989 323 : (when delete-end ; CH = LF
1990 0 : (if (< delete-end (point))
1991 0 : (delete-region lbeg delete-end))
1992 0 : (set-marker delete-end nil)
1993 323 : (setq delete-end nil))
1994 323 : (forward-char 1)
1995 323 : (setq lbeg (point)))
1996 : (t ; CH = CR
1997 0 : (delete-char 1)
1998 0 : (if delete-end
1999 0 : (when (< delete-end (point))
2000 0 : (delete-region lbeg delete-end)
2001 0 : (move-marker delete-end (point)))
2002 323 : (setq delete-end (point-marker))))))
2003 28 : (when delete-end
2004 0 : (if (< delete-end (point))
2005 : ;; As there's a text after the last CR, make the current
2006 : ;; line contain only that text.
2007 0 : (delete-region lbeg delete-end)
2008 : ;; Remember that the process output ends by CR, and thus we
2009 : ;; must overwrite the contents of the current line next
2010 : ;; time.
2011 0 : (put-text-property lbeg delete-end 'comint-must-overwrite t))
2012 28 : (set-marker delete-end nil))
2013 28 : (widen))))
2014 :
2015 : ;; The purpose of using this filter for comint processes
2016 : ;; is to keep comint-last-input-end from moving forward
2017 : ;; when output is inserted.
2018 : (defun comint-output-filter (process string)
2019 29 : (let ((oprocbuf (process-buffer process)))
2020 : ;; First check for killed buffer or no input.
2021 29 : (when (and string oprocbuf (buffer-name oprocbuf))
2022 28 : (with-current-buffer oprocbuf
2023 : ;; Run preoutput filters
2024 28 : (let ((functions comint-preoutput-filter-functions))
2025 28 : (while (and functions string)
2026 0 : (if (eq (car functions) t)
2027 0 : (let ((functions
2028 0 : (default-value 'comint-preoutput-filter-functions)))
2029 0 : (while (and functions string)
2030 0 : (setq string (funcall (car functions) string))
2031 0 : (setq functions (cdr functions))))
2032 0 : (setq string (funcall (car functions) string)))
2033 28 : (setq functions (cdr functions))))
2034 :
2035 : ;; Insert STRING
2036 28 : (let ((inhibit-read-only t)
2037 : ;; The point should float after any insertion we do.
2038 28 : (saved-point (copy-marker (point) t)))
2039 :
2040 : ;; We temporarily remove any buffer narrowing, in case the
2041 : ;; process mark is outside of the restriction
2042 28 : (save-restriction
2043 28 : (widen)
2044 :
2045 28 : (goto-char (process-mark process))
2046 28 : (set-marker comint-last-output-start (point))
2047 :
2048 : ;; Try to skip repeated prompts, which can occur as a result of
2049 : ;; commands sent without inserting them in the buffer.
2050 28 : (let ((bol (save-excursion (forward-line 0) (point)))) ;No fields.
2051 28 : (when (and (not (bolp))
2052 28 : (looking-back comint-prompt-regexp bol))
2053 0 : (let* ((prompt (buffer-substring bol (point)))
2054 0 : (prompt-re (concat "\\`" (regexp-quote prompt))))
2055 0 : (while (string-match prompt-re string)
2056 28 : (setq string (substring string (match-end 0)))))))
2057 28 : (while (string-match (concat "\\(^" comint-prompt-regexp
2058 28 : "\\)\\1+")
2059 28 : string)
2060 28 : (setq string (replace-match "\\1" nil nil string)))
2061 :
2062 : ;; insert-before-markers is a bad thing. XXX
2063 : ;; Luckily we don't have to use it any more, we use
2064 : ;; window-point-insertion-type instead.
2065 28 : (insert string)
2066 :
2067 : ;; Advance process-mark
2068 28 : (set-marker (process-mark process) (point))
2069 :
2070 28 : (unless comint-inhibit-carriage-motion
2071 : ;; Interpret any carriage motion characters (newline, backspace)
2072 28 : (comint-carriage-motion comint-last-output-start (point)))
2073 :
2074 : ;; Run these hooks with point where the user had it.
2075 28 : (goto-char saved-point)
2076 28 : (run-hook-with-args 'comint-output-filter-functions string)
2077 28 : (set-marker saved-point (point))
2078 :
2079 28 : (goto-char (process-mark process)) ; In case a filter moved it.
2080 :
2081 28 : (unless comint-use-prompt-regexp
2082 28 : (with-silent-modifications
2083 28 : (add-text-properties comint-last-output-start (point)
2084 : '(front-sticky
2085 : (field inhibit-line-move-field-capture)
2086 : rear-nonsticky t
2087 : field output
2088 28 : inhibit-line-move-field-capture t))))
2089 :
2090 : ;; Highlight the prompt, where we define `prompt' to mean
2091 : ;; the most recent output that doesn't end with a newline.
2092 28 : (let ((prompt-start (save-excursion (forward-line 0) (point)))
2093 : (inhibit-read-only t))
2094 28 : (when comint-prompt-read-only
2095 0 : (with-silent-modifications
2096 0 : (or (= (point-min) prompt-start)
2097 0 : (get-text-property (1- prompt-start) 'read-only)
2098 0 : (put-text-property (1- prompt-start)
2099 0 : prompt-start 'read-only 'fence))
2100 0 : (add-text-properties prompt-start (point)
2101 28 : '(read-only t front-sticky (read-only)))))
2102 28 : (when comint-last-prompt
2103 : ;; There might be some keywords here waiting for
2104 : ;; fontification, so no `with-silent-modifications'.
2105 18 : (font-lock--remove-face-from-text-property
2106 18 : (car comint-last-prompt)
2107 18 : (cdr comint-last-prompt)
2108 : 'font-lock-face
2109 28 : 'comint-highlight-prompt))
2110 28 : (setq comint-last-prompt
2111 28 : (cons (copy-marker prompt-start) (point-marker)))
2112 28 : (font-lock-prepend-text-property prompt-start (point)
2113 : 'font-lock-face
2114 28 : 'comint-highlight-prompt)
2115 28 : (add-text-properties prompt-start (point) '(rear-nonsticky t)))
2116 29 : (goto-char saved-point)))))))
2117 :
2118 : (defun comint-preinput-scroll-to-bottom ()
2119 : "Go to the end of buffer in all windows showing it.
2120 : Movement occurs if point in the selected window is not after the process mark,
2121 : and `this-command' is an insertion command. Insertion commands recognized
2122 : are `self-insert-command', `comint-magic-space', `yank', and `hilit-yank'.
2123 : Depends on the value of `comint-scroll-to-bottom-on-input'.
2124 :
2125 : This function should be a pre-command hook."
2126 0 : (if (and comint-scroll-to-bottom-on-input
2127 0 : (memq this-command '(self-insert-command comint-magic-space yank
2128 0 : hilit-yank)))
2129 0 : (let* ((current (current-buffer))
2130 0 : (process (get-buffer-process current))
2131 0 : (scroll comint-scroll-to-bottom-on-input))
2132 0 : (if (and process (< (point) (process-mark process)))
2133 0 : (if (eq scroll 'this)
2134 0 : (goto-char (point-max))
2135 0 : (walk-windows
2136 : (lambda (window)
2137 0 : (if (and (eq (window-buffer window) current)
2138 0 : (or (eq scroll t) (eq scroll 'all)))
2139 0 : (with-selected-window window
2140 0 : (goto-char (point-max)))))
2141 0 : nil t))))))
2142 :
2143 : (defvar follow-mode)
2144 : (declare-function follow-comint-scroll-to-bottom "follow" (&optional window))
2145 :
2146 : (defun comint-postoutput-scroll-to-bottom (_string)
2147 : "Go to the end of buffer in some or all windows showing it.
2148 : Do not scroll if the current line is the last line in the buffer.
2149 : Depends on the value of `comint-move-point-for-output' and
2150 : `comint-scroll-show-maximum-output'.
2151 :
2152 : This function should be in the list `comint-output-filter-functions'."
2153 28 : (let* ((current (current-buffer))
2154 28 : (process (get-buffer-process current)))
2155 28 : (unwind-protect
2156 28 : (cond
2157 28 : ((null process))
2158 28 : ((bound-and-true-p follow-mode)
2159 0 : (follow-comint-scroll-to-bottom))
2160 : (t
2161 28 : (dolist (w (get-buffer-window-list current nil t))
2162 28 : (comint-adjust-window-point w process)
2163 : ;; Optionally scroll to the bottom of the window.
2164 28 : (and comint-scroll-show-maximum-output
2165 28 : (eq (window-point w) (point-max))
2166 28 : (with-selected-window w
2167 28 : (recenter (- -1 scroll-margin)))))))
2168 28 : (set-buffer current))))
2169 :
2170 :
2171 : (defun comint-adjust-window-point (window process)
2172 : "Move point in WINDOW based on Comint settings.
2173 : For point adjustment use the process-mark of PROCESS."
2174 28 : (and (< (window-point window) (process-mark process))
2175 28 : (or (memq comint-move-point-for-output '(t all))
2176 : ;; Maybe user wants point to jump to end.
2177 28 : (eq comint-move-point-for-output
2178 28 : (if (eq (selected-window) window) 'this 'others))
2179 : ;; If point was at the end, keep it at end.
2180 28 : (and (marker-position comint-last-output-start)
2181 28 : (>= (window-point window) comint-last-output-start)))
2182 28 : (set-window-point window (process-mark process))))
2183 :
2184 :
2185 : ;; this function is nowhere used
2186 : (defun comint-adjust-point (selected)
2187 : "Move point in the selected window based on Comint settings.
2188 : SELECTED is the window that was originally selected."
2189 0 : (let ((process (get-buffer-process (current-buffer))))
2190 0 : (and (< (point) (process-mark process))
2191 0 : (or (memq comint-move-point-for-output '(t all))
2192 : ;; Maybe user wants point to jump to end.
2193 0 : (eq comint-move-point-for-output
2194 0 : (if (eq (selected-window) selected) 'this 'others))
2195 : ;; If point was at the end, keep it at end.
2196 0 : (and (marker-position comint-last-output-start)
2197 0 : (>= (point) comint-last-output-start)))
2198 0 : (goto-char (process-mark process)))))
2199 :
2200 : (defun comint-truncate-buffer (&optional _string)
2201 : "Truncate the buffer to `comint-buffer-maximum-size'.
2202 : This function could be on `comint-output-filter-functions' or bound to a key."
2203 : (interactive)
2204 0 : (save-excursion
2205 0 : (goto-char (process-mark (get-buffer-process (current-buffer))))
2206 0 : (forward-line (- comint-buffer-maximum-size))
2207 0 : (beginning-of-line)
2208 0 : (let ((inhibit-read-only t))
2209 0 : (delete-region (point-min) (point)))))
2210 :
2211 : (defun comint-strip-ctrl-m (&optional _string)
2212 : "Strip trailing `^M' characters from the current output group.
2213 : This function could be on `comint-output-filter-functions' or bound to a key."
2214 : (interactive)
2215 0 : (let ((pmark (process-mark (get-buffer-process (current-buffer)))))
2216 0 : (save-excursion
2217 0 : (condition-case nil
2218 0 : (goto-char
2219 0 : (if (called-interactively-p 'interactive)
2220 0 : comint-last-input-end comint-last-output-start))
2221 0 : (error nil))
2222 0 : (while (re-search-forward "\r+$" pmark t)
2223 0 : (replace-match "" t t)))))
2224 : (defalias 'shell-strip-ctrl-m 'comint-strip-ctrl-m)
2225 :
2226 : (defun comint-show-maximum-output ()
2227 : "Put the end of the buffer at the bottom of the window."
2228 : (interactive)
2229 0 : (goto-char (point-max))
2230 0 : (recenter (- -1 scroll-margin)))
2231 :
2232 : (defun comint-get-old-input-default ()
2233 : "Default for `comint-get-old-input'.
2234 : If `comint-use-prompt-regexp' is nil, then either
2235 : return the current input field, if point is on an input field, or the
2236 : current line, if point is on an output field.
2237 : If `comint-use-prompt-regexp' is non-nil, then return
2238 : the current line with any initial string matching the regexp
2239 : `comint-prompt-regexp' removed."
2240 0 : (let (bof)
2241 0 : (if (and (not comint-use-prompt-regexp)
2242 : ;; Make sure we're in an input rather than output field.
2243 0 : (null (get-char-property (setq bof (field-beginning)) 'field)))
2244 0 : (field-string-no-properties bof)
2245 0 : (comint-bol)
2246 0 : (buffer-substring-no-properties (point)
2247 0 : (if comint-use-prompt-regexp
2248 0 : (line-end-position)
2249 0 : (field-end))))))
2250 :
2251 : (defun comint-copy-old-input ()
2252 : "Insert after prompt old input at point as new input to be edited.
2253 : Calls `comint-get-old-input' to get old input."
2254 : (interactive)
2255 0 : (let ((input (funcall comint-get-old-input))
2256 0 : (process (get-buffer-process (current-buffer))))
2257 0 : (if (not process)
2258 0 : (user-error "Current buffer has no process")
2259 0 : (goto-char (process-mark process))
2260 0 : (insert input))))
2261 :
2262 : (defun comint-skip-prompt ()
2263 : "Skip past the text matching regexp `comint-prompt-regexp'.
2264 : If this takes us past the end of the current line, don't skip at all."
2265 0 : (if (and (looking-at comint-prompt-regexp)
2266 0 : (<= (match-end 0) (line-end-position)))
2267 0 : (goto-char (match-end 0))))
2268 :
2269 : (defun comint-after-pmark-p ()
2270 : "Return t if point is after the process output marker."
2271 0 : (let ((pmark (process-mark (get-buffer-process (current-buffer)))))
2272 0 : (<= (marker-position pmark) (point))))
2273 :
2274 : (defun comint-simple-send (proc string)
2275 : "Default function for sending to PROC input STRING.
2276 : This just sends STRING plus a newline. To override this,
2277 : set the hook `comint-input-sender'."
2278 0 : (let ((send-string
2279 0 : (if comint-input-sender-no-newline
2280 0 : string
2281 : ;; Sending as two separate strings does not work
2282 : ;; on Windows, so concat the \n before sending.
2283 0 : (concat string "\n"))))
2284 0 : (comint-send-string proc send-string))
2285 0 : (if (and comint-input-sender-no-newline
2286 0 : (not (string-equal string "")))
2287 0 : (process-send-eof)))
2288 :
2289 : (defun comint-line-beginning-position ()
2290 : "Return the buffer position of the beginning of the line, after any prompt.
2291 : If `comint-use-prompt-regexp' is non-nil, then the prompt skip is done by
2292 : skipping text matching the regular expression `comint-prompt-regexp',
2293 : a buffer local variable."
2294 0 : (if comint-use-prompt-regexp
2295 : ;; Use comint-prompt-regexp
2296 0 : (save-excursion
2297 0 : (beginning-of-line)
2298 0 : (comint-skip-prompt)
2299 0 : (point))
2300 : ;; Use input fields. Note that, unlike the behavior of
2301 : ;; `line-beginning-position' inside a field, this function will
2302 : ;; return the position of the end of a prompt, even if the point is
2303 : ;; already inside the prompt. In order to do this, it assumes that
2304 : ;; if there are two fields on a line, then the first one is the
2305 : ;; prompt, and the second one is an input field, and is front-sticky
2306 : ;; (as input fields should be).
2307 0 : (constrain-to-field (if (eq (field-at-pos (point)) 'output)
2308 0 : (line-beginning-position)
2309 0 : (field-beginning))
2310 0 : (line-end-position))))
2311 :
2312 : (defun comint-bol (&optional arg)
2313 : "Go to the beginning of line, then skip past the prompt, if any.
2314 : If prefix argument is given (\\[universal-argument]) the prompt is not skipped.
2315 : If `comint-use-prompt-regexp' is non-nil, then the prompt skip is done
2316 : by skipping text matching the regular expression `comint-prompt-regexp',
2317 : a buffer local variable."
2318 : (interactive "P")
2319 0 : (if arg
2320 : ;; Unlike `beginning-of-line', forward-line ignores field boundaries
2321 0 : (forward-line 0)
2322 0 : (goto-char (comint-line-beginning-position))))
2323 :
2324 : ;; For compatibility.
2325 : (defun comint-read-noecho (prompt &optional _ignore)
2326 0 : (read-passwd prompt))
2327 :
2328 : ;; These three functions are for entering text you don't want echoed or
2329 : ;; saved -- typically passwords to ftp, telnet, or somesuch.
2330 : ;; Just enter m-x send-invisible and type in your line.
2331 :
2332 : (defun send-invisible (&optional prompt)
2333 : "Read a string without echoing.
2334 : Then send it to the process running in the current buffer.
2335 : The string is sent using `comint-input-sender'.
2336 : Security bug: your string can still be temporarily recovered with
2337 : \\[view-lossage]; `clear-this-command-keys' can fix that."
2338 : (interactive "P") ; Defeat snooping via C-x ESC ESC
2339 0 : (let ((proc (get-buffer-process (current-buffer)))
2340 : (prefix
2341 0 : (if (eq (window-buffer) (current-buffer))
2342 : ""
2343 0 : (format "(In buffer %s) "
2344 0 : (current-buffer)))))
2345 0 : (if proc
2346 0 : (let ((str (read-passwd (concat prefix
2347 0 : (or prompt "Non-echoed text: ")))))
2348 0 : (if (stringp str)
2349 0 : (progn
2350 0 : (comint-snapshot-last-prompt)
2351 0 : (funcall comint-input-sender proc str))
2352 0 : (message "Warning: text will be echoed")))
2353 0 : (error "Buffer %s has no process" (current-buffer)))))
2354 :
2355 : (defun comint-watch-for-password-prompt (string)
2356 : "Prompt in the minibuffer for password and send without echoing.
2357 : This function uses `send-invisible' to read and send a password to the buffer's
2358 : process if STRING contains a password prompt defined by
2359 : `comint-password-prompt-regexp'.
2360 :
2361 : This function could be in the list `comint-output-filter-functions'."
2362 28 : (when (let ((case-fold-search t))
2363 28 : (string-match comint-password-prompt-regexp string))
2364 0 : (when (string-match "^[ \n\r\t\v\f\b\a]+" string)
2365 0 : (setq string (replace-match "" t t string)))
2366 28 : (send-invisible string)))
2367 :
2368 : ;; Low-level process communication
2369 :
2370 : (defun comint-send-string (process string)
2371 : "Like `process-send-string', but also does extra bookkeeping for Comint mode."
2372 0 : (if process
2373 0 : (with-current-buffer (if (processp process)
2374 0 : (process-buffer process)
2375 0 : (get-buffer process))
2376 0 : (comint-snapshot-last-prompt))
2377 0 : (comint-snapshot-last-prompt))
2378 0 : (process-send-string process string))
2379 :
2380 : (defun comint-send-region (process start end)
2381 : "Like `process-send-region', but also does extra bookkeeping for Comint mode."
2382 0 : (if process
2383 0 : (with-current-buffer (if (processp process)
2384 0 : (process-buffer process)
2385 0 : (get-buffer process))
2386 0 : (comint-snapshot-last-prompt))
2387 0 : (comint-snapshot-last-prompt))
2388 0 : (process-send-region process start end))
2389 :
2390 :
2391 : ;; Random input hackage
2392 :
2393 : (defun comint-delete-output ()
2394 : "Delete all output from interpreter since last input.
2395 : Does not delete the prompt."
2396 : (interactive)
2397 0 : (let ((proc (get-buffer-process (current-buffer)))
2398 : (replacement nil)
2399 : (inhibit-read-only t))
2400 0 : (save-excursion
2401 0 : (let ((pmark (progn (goto-char (process-mark proc))
2402 0 : (forward-line 0)
2403 0 : (point-marker))))
2404 0 : (delete-region comint-last-input-end pmark)
2405 0 : (goto-char (process-mark proc))
2406 0 : (setq replacement (concat "*** output flushed ***\n"
2407 0 : (buffer-substring pmark (point))))
2408 0 : (delete-region pmark (point))))
2409 : ;; Output message and put back prompt
2410 0 : (comint-output-filter proc replacement)))
2411 :
2412 : (defun comint-write-output (filename &optional append mustbenew)
2413 : "Write output from interpreter since last input to FILENAME.
2414 : Any prompt at the end of the output is not written.
2415 :
2416 : If the optional argument APPEND (the prefix argument when interactive)
2417 : is non-nil, the output is appended to the file instead.
2418 :
2419 : If the optional argument MUSTBENEW is non-nil, check for an existing
2420 : file with the same name. If MUSTBENEW is `excl', that means to get an
2421 : error if the file already exists; never overwrite. If MUSTBENEW is
2422 : neither nil nor `excl', that means ask for confirmation before
2423 : overwriting, but do go ahead and overwrite the file if the user
2424 : confirms. When interactive, MUSTBENEW is nil when appending, and t
2425 : otherwise."
2426 : (interactive
2427 0 : (list (read-file-name
2428 0 : (if current-prefix-arg
2429 : "Append output to file: "
2430 0 : "Write output to file: "))
2431 0 : current-prefix-arg
2432 0 : (not current-prefix-arg)))
2433 0 : (save-excursion
2434 0 : (goto-char (process-mark (get-buffer-process (current-buffer))))
2435 0 : (forward-line 0)
2436 0 : (write-region comint-last-input-end (point) filename
2437 0 : append nil nil mustbenew)))
2438 :
2439 : ;; This function exists for the benefit of the menu; from the keyboard,
2440 : ;; users can just use `comint-write-output' with a prefix arg.
2441 : (defun comint-append-output-to-file (filename)
2442 : "Append output from interpreter since last input to FILENAME.
2443 : Any prompt at the end of the output is not written."
2444 : (interactive "fAppend output to file: ")
2445 0 : (comint-write-output filename t))
2446 :
2447 : (defun comint-show-output ()
2448 : "Display start of this batch of interpreter output at top of window.
2449 : Sets mark to the value of point when this command is run."
2450 : (interactive)
2451 0 : (push-mark)
2452 0 : (let ((pos (or (marker-position comint-last-input-end) (point-max))))
2453 0 : (cond (comint-use-prompt-regexp
2454 0 : (goto-char pos)
2455 0 : (beginning-of-line 0)
2456 0 : (set-window-start (selected-window) (point))
2457 0 : (comint-skip-prompt))
2458 : (t
2459 0 : (goto-char (field-beginning pos))
2460 0 : (set-window-start (selected-window) (point))))))
2461 :
2462 : (defun comint-clear-buffer ()
2463 : "Clear the comint buffer."
2464 : (interactive)
2465 0 : (let ((comint-buffer-maximum-size 0))
2466 0 : (comint-truncate-buffer)))
2467 :
2468 : (defun comint-interrupt-subjob ()
2469 : "Interrupt the current subjob.
2470 : This command also kills the pending input
2471 : between the process mark and point."
2472 : (interactive)
2473 0 : (comint-skip-input)
2474 0 : (interrupt-process nil comint-ptyp)
2475 : ;; (process-send-string nil "\n")
2476 : )
2477 :
2478 : (defun comint-kill-subjob ()
2479 : "Send kill signal to the current subjob.
2480 : This command also kills the pending input
2481 : between the process mark and point."
2482 : (interactive)
2483 0 : (comint-skip-input)
2484 0 : (kill-process nil comint-ptyp))
2485 :
2486 : (defun comint-quit-subjob ()
2487 : "Send quit signal to the current subjob.
2488 : This command also kills the pending input
2489 : between the process mark and point."
2490 : (interactive)
2491 0 : (comint-skip-input)
2492 0 : (quit-process nil comint-ptyp))
2493 :
2494 : (defun comint-stop-subjob ()
2495 : "Stop the current subjob.
2496 : This command also kills the pending input
2497 : between the process mark and point.
2498 :
2499 : WARNING: if there is no current subjob, you can end up suspending
2500 : the top-level process running in the buffer. If you accidentally do
2501 : this, use \\[comint-continue-subjob] to resume the process. (This
2502 : is not a problem with most shells, since they ignore this signal.)"
2503 : (interactive)
2504 0 : (comint-skip-input)
2505 0 : (stop-process nil comint-ptyp))
2506 :
2507 : (defun comint-continue-subjob ()
2508 : "Send CONT signal to process buffer's process group.
2509 : Useful if you accidentally suspend the top-level process."
2510 : (interactive)
2511 0 : (continue-process nil comint-ptyp))
2512 :
2513 : (defun comint-skip-input ()
2514 : "Skip all pending input, from last stuff output by interpreter to point.
2515 : This means mark it as if it had been sent as input, without sending it."
2516 0 : (let ((comint-input-sender 'ignore)
2517 : (comint-input-filter-functions nil))
2518 0 : (comint-send-input t t))
2519 0 : (end-of-line)
2520 0 : (let ((pos (point))
2521 0 : (marker (process-mark (get-buffer-process (current-buffer)))))
2522 0 : (insert " " (key-description (this-command-keys)))
2523 0 : (if (= marker pos)
2524 0 : (set-marker marker (point)))))
2525 :
2526 : (defun comint-kill-input ()
2527 : "Kill all text from last stuff output by interpreter to point."
2528 : (interactive)
2529 0 : (let ((pmark (process-mark (get-buffer-process (current-buffer)))))
2530 0 : (if (> (point) (marker-position pmark))
2531 0 : (kill-region pmark (point)))))
2532 :
2533 : (defun comint-delchar-or-maybe-eof (arg)
2534 : "Delete ARG characters forward or send an EOF to subprocess.
2535 : Sends an EOF only if point is at the end of the buffer and there is no input."
2536 : (interactive "p")
2537 0 : (let ((proc (get-buffer-process (current-buffer))))
2538 0 : (if (and (eobp) proc (= (point) (marker-position (process-mark proc))))
2539 0 : (comint-send-eof)
2540 0 : (delete-char arg))))
2541 :
2542 : (defun comint-send-eof ()
2543 : "Send an EOF to the current buffer's process."
2544 : (interactive)
2545 0 : (comint-send-input t t)
2546 0 : (process-send-eof))
2547 :
2548 :
2549 : (defun comint-backward-matching-input (regexp n)
2550 : "Search backward through buffer for input fields that match REGEXP.
2551 : If `comint-use-prompt-regexp' is non-nil, then input fields are identified
2552 : by lines that match `comint-prompt-regexp'.
2553 :
2554 : With prefix argument N, search for Nth previous match.
2555 : If N is negative, find the next or Nth next match."
2556 0 : (interactive (comint-regexp-arg "Backward input matching (regexp): "))
2557 0 : (if comint-use-prompt-regexp
2558 : ;; Use comint-prompt-regexp
2559 0 : (let* ((re (concat comint-prompt-regexp ".*" regexp))
2560 0 : (pos (save-excursion (end-of-line (if (> n 0) 0 1))
2561 0 : (if (re-search-backward re nil t n)
2562 0 : (point)))))
2563 0 : (if (null pos)
2564 0 : (progn (message "Not found")
2565 0 : (ding))
2566 0 : (goto-char pos)
2567 0 : (comint-bol nil)))
2568 : ;; Use input fields
2569 0 : (let* ((dir (if (< n 0) -1 1))
2570 : (pos
2571 0 : (save-excursion
2572 0 : (while (/= n 0)
2573 0 : (unless (re-search-backward regexp nil t dir)
2574 0 : (user-error "Not found"))
2575 0 : (unless (get-char-property (point) 'field)
2576 0 : (setq n (- n dir))))
2577 0 : (field-beginning))))
2578 0 : (goto-char pos))))
2579 :
2580 :
2581 : (defun comint-forward-matching-input (regexp n)
2582 : "Search forward through buffer for input fields that match REGEXP.
2583 : If `comint-use-prompt-regexp' is non-nil, then input fields are identified
2584 : by lines that match `comint-prompt-regexp'.
2585 :
2586 : With prefix argument N, search for Nth following match.
2587 : If N is negative, find the previous or Nth previous match."
2588 0 : (interactive (comint-regexp-arg "Forward input matching (regexp): "))
2589 0 : (comint-backward-matching-input regexp (- n)))
2590 :
2591 :
2592 : (defun comint-next-prompt (n)
2593 : "Move to end of Nth next prompt in the buffer.
2594 : If `comint-use-prompt-regexp' is nil, then this means the beginning of
2595 : the Nth next `input' field, otherwise, it means the Nth occurrence of
2596 : text matching `comint-prompt-regexp'."
2597 : (interactive "p")
2598 0 : (if comint-use-prompt-regexp
2599 : ;; Use comint-prompt-regexp
2600 0 : (let ((paragraph-start comint-prompt-regexp))
2601 0 : (end-of-line (if (> n 0) 1 0))
2602 0 : (forward-paragraph n)
2603 0 : (comint-skip-prompt))
2604 : ;; Use input fields
2605 0 : (let ((pos (point))
2606 : (input-pos nil)
2607 : prev-pos)
2608 0 : (while (/= n 0)
2609 0 : (setq prev-pos pos)
2610 0 : (setq pos
2611 0 : (if (> n 0)
2612 0 : (next-single-char-property-change pos 'field)
2613 0 : (previous-single-char-property-change pos 'field)))
2614 0 : (cond ((= pos prev-pos)
2615 : ;; Ran off the end of the buffer.
2616 0 : (when (> n 0)
2617 : ;; There's always an input field at the end of the
2618 : ;; buffer, but it has a `field' property of nil.
2619 0 : (setq input-pos (point-max)))
2620 : ;; stop iterating
2621 0 : (setq n 0))
2622 0 : ((null (get-char-property pos 'field))
2623 0 : (setq n (if (< n 0) (1+ n) (1- n)))
2624 0 : (setq input-pos pos))))
2625 0 : (when input-pos
2626 0 : (goto-char input-pos)))))
2627 :
2628 :
2629 : (defun comint-previous-prompt (n)
2630 : "Move to end of Nth previous prompt in the buffer.
2631 : If `comint-use-prompt-regexp' is nil, then this means the beginning of
2632 : the Nth previous `input' field, otherwise, it means the Nth occurrence of
2633 : text matching `comint-prompt-regexp'."
2634 : (interactive "p")
2635 0 : (comint-next-prompt (- n)))
2636 :
2637 : ;; State used by `comint-insert-previous-argument' when cycling.
2638 : (defvar-local comint-insert-previous-argument-last-start-pos nil)
2639 : (defvar-local comint-insert-previous-argument-last-index nil)
2640 :
2641 : ;; Needs fixing:
2642 : ;; make comint-arguments understand negative indices as bash does
2643 : (defun comint-insert-previous-argument (index)
2644 : "Insert the INDEXth argument from the previous Comint command-line at point.
2645 : Spaces are added at beginning and/or end of the inserted string if
2646 : necessary to ensure that it's separated from adjacent arguments.
2647 : Interactively, if no prefix argument is given, the last argument is inserted.
2648 : Repeated interactive invocations will cycle through the same argument
2649 : from progressively earlier commands (using the value of INDEX specified
2650 : with the first command).
2651 : This command is like `M-.' in bash."
2652 : (interactive "P")
2653 0 : (unless (null index)
2654 0 : (setq index (prefix-numeric-value index)))
2655 0 : (cond ((eq last-command this-command)
2656 : ;; Delete last input inserted by this command.
2657 0 : (delete-region comint-insert-previous-argument-last-start-pos (point))
2658 0 : (setq index comint-insert-previous-argument-last-index))
2659 : (t
2660 : ;; This is a non-repeat invocation, so initialize state.
2661 0 : (setq comint-input-ring-index nil)
2662 0 : (setq comint-insert-previous-argument-last-index index)
2663 0 : (when (null comint-insert-previous-argument-last-start-pos)
2664 : ;; First usage; initialize to a marker
2665 0 : (setq comint-insert-previous-argument-last-start-pos
2666 0 : (make-marker)))))
2667 : ;; Make sure we're not in the prompt, and add a beginning space if necessary.
2668 0 : (if (<= (point) (comint-line-beginning-position))
2669 0 : (comint-bol)
2670 0 : (just-one-space))
2671 : ;; Remember the beginning of what we insert, so we can delete it if
2672 : ;; the command is repeated.
2673 0 : (set-marker comint-insert-previous-argument-last-start-pos (point))
2674 : ;; Insert the argument.
2675 0 : (let ((input-string (comint-previous-input-string 0)))
2676 0 : (when (string-match "[ \t\n]*&" input-string)
2677 : ;; strip terminating '&'
2678 0 : (setq input-string (substring input-string 0 (match-beginning 0))))
2679 0 : (insert (comint-arguments input-string index index)))
2680 : ;; Make next invocation return arg from previous input
2681 0 : (setq comint-input-ring-index (1+ (or comint-input-ring-index 0)))
2682 : ;; Add a terminating space if necessary.
2683 0 : (unless (eolp)
2684 0 : (just-one-space)))
2685 :
2686 :
2687 : ;; Support editing with `comint-prompt-read-only' set to t.
2688 :
2689 : (defun comint-update-fence ()
2690 : "Update read-only status of newline before point.
2691 : The `fence' read-only property is used to indicate that a newline
2692 : is read-only for no other reason than to \"fence off\" a
2693 : following front-sticky read-only region. This is used to
2694 : implement comint read-only prompts. If the text after a newline
2695 : changes, the read-only status of that newline may need updating.
2696 : That is what this function does.
2697 :
2698 : This function does nothing if point is not at the beginning of a
2699 : line, or is at the beginning of the accessible portion of the buffer.
2700 : Otherwise, if the character after point has a front-sticky
2701 : read-only property, then the preceding newline is given a
2702 : read-only property of `fence', unless it already is read-only.
2703 : If the character after point does not have a front-sticky
2704 : read-only property, any read-only property of `fence' on the
2705 : preceding newline is removed."
2706 0 : (let* ((pt (point)) (lst (get-text-property pt 'front-sticky)))
2707 0 : (and (bolp)
2708 0 : (not (bobp))
2709 0 : (with-silent-modifications
2710 0 : (if (and (get-text-property pt 'read-only)
2711 0 : (if (listp lst) (memq 'read-only lst) t))
2712 0 : (unless (get-text-property (1- pt) 'read-only)
2713 0 : (put-text-property (1- pt) pt 'read-only 'fence))
2714 0 : (when (eq (get-text-property (1- pt) 'read-only) 'fence)
2715 0 : (remove-list-of-text-properties (1- pt) pt '(read-only))))))))
2716 :
2717 : (defun comint-kill-whole-line (&optional count)
2718 : "Kill current line, ignoring read-only and field properties.
2719 : With prefix arg COUNT, kill that many lines starting from the current line.
2720 : If COUNT is negative, kill backward. Also kill the preceding newline,
2721 : instead of the trailing one. \(This is meant to make \\[repeat] work well
2722 : with negative arguments.)
2723 : If COUNT is zero, kill current line but exclude the trailing newline.
2724 : The read-only status of newlines is updated with `comint-update-fence',
2725 : if necessary."
2726 : (interactive "p")
2727 0 : (let ((inhibit-read-only t) (inhibit-field-text-motion t))
2728 0 : (kill-whole-line count)
2729 0 : (when (>= count 0) (comint-update-fence))))
2730 :
2731 : (defun comint-kill-region (beg end)
2732 : "Like `kill-region', but ignores read-only properties, if safe.
2733 : This command assumes that the buffer contains read-only
2734 : \"prompts\" which are regions with front-sticky read-only
2735 : properties at the beginning of a line, with the preceding newline
2736 : being read-only to protect the prompt. This is true of the
2737 : comint prompts if `comint-prompt-read-only' is non-nil. This
2738 : command will not delete the region if this would create mutilated
2739 : or out of place prompts. That is, if any part of a prompt is
2740 : deleted, the entire prompt must be deleted and all remaining
2741 : prompts should stay at the beginning of a line. If this is not
2742 : the case, this command just calls `kill-region' with all
2743 : read-only properties intact. The read-only status of newlines is
2744 : updated using `comint-update-fence', if necessary."
2745 : (interactive "r")
2746 0 : (save-excursion
2747 0 : (let* ((true-beg (min beg end))
2748 0 : (true-end (max beg end))
2749 0 : (beg-bolp (progn (goto-char true-beg) (bolp)))
2750 0 : (beg-lst (get-text-property true-beg 'front-sticky))
2751 0 : (beg-bad (and (get-text-property true-beg 'read-only)
2752 0 : (if (listp beg-lst) (memq 'read-only beg-lst) t)))
2753 0 : (end-bolp (progn (goto-char true-end) (bolp)))
2754 0 : (end-lst (get-text-property true-end 'front-sticky))
2755 0 : (end-bad (and (get-text-property true-end 'read-only)
2756 0 : (if (listp end-lst) (memq 'read-only end-lst) t))))
2757 0 : (if (or (and (not beg-bolp) (or beg-bad end-bad))
2758 0 : (and (not end-bolp) end-bad))
2759 0 : (kill-region beg end)
2760 0 : (let ((inhibit-read-only t))
2761 0 : (kill-region beg end)
2762 0 : (comint-update-fence))))))
2763 :
2764 : ;; Support for source-file processing commands.
2765 : ;;============================================================================
2766 : ;; Many command-interpreters (e.g., Lisp, Scheme, Soar) have
2767 : ;; commands that process files of source text (e.g. loading or compiling
2768 : ;; files). So the corresponding process-in-a-buffer modes have commands
2769 : ;; for doing this (e.g., lisp-load-file). The functions below are useful
2770 : ;; for defining these commands.
2771 : ;;
2772 : ;; Alas, these guys don't do exactly the right thing for Lisp, Scheme
2773 : ;; and Soar, in that they don't know anything about file extensions.
2774 : ;; So the compile/load interface gets the wrong default occasionally.
2775 : ;; The load-file/compile-file default mechanism could be smarter -- it
2776 : ;; doesn't know about the relationship between filename extensions and
2777 : ;; whether the file is source or executable. If you compile foo.lisp
2778 : ;; with compile-file, then the next load-file should use foo.bin for
2779 : ;; the default, not foo.lisp. This is tricky to do right, particularly
2780 : ;; because the extension for executable files varies so much (.o, .bin,
2781 : ;; .lbin, .mo, .vo, .ao, ...).
2782 :
2783 :
2784 : ;; COMINT-SOURCE-DEFAULT -- determines defaults for source-file processing
2785 : ;; commands.
2786 : ;;
2787 : ;; COMINT-CHECK-SOURCE -- if FNAME is in a modified buffer, asks you if you
2788 : ;; want to save the buffer before issuing any process requests to the command
2789 : ;; interpreter.
2790 : ;;
2791 : ;; COMINT-GET-SOURCE -- used by the source-file processing commands to prompt
2792 : ;; for the file to process.
2793 :
2794 : (defun comint-source-default (previous-dir/file source-modes)
2795 : "Compute the defaults for `load-file' and `compile-file' commands.
2796 :
2797 : PREVIOUS-DIR/FILE is a pair (DIRECTORY . FILENAME) from the last
2798 : source-file processing command, or nil if there hasn't been one yet.
2799 : SOURCE-MODES is a list used to determine what buffers contain source
2800 : files: if the major mode of the buffer is in SOURCE-MODES, it's source.
2801 : Typically, (lisp-mode) or (scheme-mode).
2802 :
2803 : If the command is given while the cursor is inside a string, *and*
2804 : the string is an existing filename, *and* the filename is not a directory,
2805 : then the string is taken as default. This allows you to just position
2806 : your cursor over a string that's a filename and have it taken as default.
2807 :
2808 : If the command is given in a file buffer whose major mode is in
2809 : SOURCE-MODES, then the filename is the default file, and the
2810 : file's directory is the default directory.
2811 :
2812 : If the buffer isn't a source file buffer (e.g., it's the process buffer),
2813 : then the default directory & file are what was used in the last source-file
2814 : processing command (i.e., PREVIOUS-DIR/FILE). If this is the first time
2815 : the command has been run (PREVIOUS-DIR/FILE is nil), the default directory
2816 : is the cwd, with no default file. (\"no default file\" = nil)
2817 :
2818 : SOURCE-MODES is typically going to be something like (tea-mode)
2819 : for T programs, (lisp-mode) for Lisp programs, (soar-mode lisp-mode)
2820 : for Soar programs, etc.
2821 :
2822 : The function returns a pair: (default-directory . default-file)."
2823 0 : (cond ((and buffer-file-name (memq major-mode source-modes))
2824 0 : (cons (file-name-directory buffer-file-name)
2825 0 : (file-name-nondirectory buffer-file-name)))
2826 0 : (previous-dir/file)
2827 : (t
2828 0 : (cons default-directory nil))))
2829 :
2830 :
2831 : (defun comint-check-source (fname)
2832 : "Check whether to save buffers visiting file FNAME.
2833 : Prior to loading or compiling (or otherwise processing) a file (in the CMU
2834 : process-in-a-buffer modes), this function can be called on the filename.
2835 : If the file is loaded into a buffer, and the buffer is modified, the user
2836 : is queried to see if he wants to save the buffer before proceeding with
2837 : the load or compile."
2838 0 : (let ((buff (get-file-buffer fname)))
2839 0 : (if (and buff
2840 0 : (buffer-modified-p buff)
2841 0 : (y-or-n-p (format "Save buffer %s first? " (buffer-name buff))))
2842 0 : (with-current-buffer buff
2843 0 : (save-buffer)))))
2844 :
2845 : (defun comint-extract-string ()
2846 : "Return string around point, or nil."
2847 0 : (let ((syntax (syntax-ppss)))
2848 0 : (when (nth 3 syntax)
2849 0 : (condition-case ()
2850 0 : (buffer-substring-no-properties (1+ (nth 8 syntax))
2851 0 : (progn (goto-char (nth 8 syntax))
2852 0 : (forward-sexp)
2853 0 : (1- (point))))
2854 0 : (error nil)))))
2855 :
2856 : (defun comint-get-source (prompt prev-dir/file source-modes mustmatch-p)
2857 : "Prompt for filenames in commands that process source files,
2858 : e.g. loading or compiling a file.
2859 : Provides a default, if there is one, and returns the result filename.
2860 :
2861 : See `comint-source-default' for more on determining defaults.
2862 :
2863 : PROMPT is the prompt string. PREV-DIR/FILE is the (DIRECTORY . FILE) pair
2864 : from the last source processing command. SOURCE-MODES is a list of major
2865 : modes used to determine what file buffers contain source files. (These
2866 : two arguments are used for determining defaults.) If MUSTMATCH-P is true,
2867 : then the filename reader will only accept a file that exists.
2868 :
2869 : A typical use:
2870 : (interactive (comint-get-source \"Compile file: \" prev-lisp-dir/file
2871 : \\='(lisp-mode) t))"
2872 0 : (let* ((def (comint-source-default prev-dir/file source-modes))
2873 0 : (stringfile (comint-extract-string))
2874 0 : (sfile-p (and stringfile
2875 0 : (condition-case ()
2876 0 : (file-exists-p stringfile)
2877 0 : (error nil))
2878 0 : (not (file-directory-p stringfile))))
2879 0 : (defdir (if sfile-p (file-name-directory stringfile)
2880 0 : (car def)))
2881 0 : (deffile (if sfile-p (file-name-nondirectory stringfile)
2882 0 : (cdr def)))
2883 0 : (ans (read-file-name (if deffile (format "%s(default %s) "
2884 0 : prompt deffile)
2885 0 : prompt)
2886 0 : defdir
2887 0 : (concat defdir deffile)
2888 0 : mustmatch-p)))
2889 0 : (list (expand-file-name (substitute-in-file-name ans)))))
2890 :
2891 : ;; I am somewhat divided on this string-default feature. It seems
2892 : ;; to violate the principle-of-least-astonishment, in that it makes
2893 : ;; the default harder to predict, so you actually have to look and see
2894 : ;; what the default really is before choosing it. This can trip you up.
2895 : ;; On the other hand, it can be useful, I guess. I would appreciate feedback
2896 : ;; on this.
2897 : ;; -Olin
2898 :
2899 :
2900 : ;; Simple process query facility.
2901 : ;; ===========================================================================
2902 : ;; This function is for commands that want to send a query to the process
2903 : ;; and show the response to the user. For example, a command to get the
2904 : ;; arglist for a Common Lisp function might send a "(arglist 'foo)" query
2905 : ;; to an inferior Common Lisp process.
2906 : ;;
2907 : ;; This simple facility just sends strings to the inferior process and pops
2908 : ;; up a window for the process buffer so you can see what the process
2909 : ;; responds with. We don't do anything fancy like try to intercept what the
2910 : ;; process responds with and put it in a pop-up window or on the message
2911 : ;; line. We just display the buffer. Low tech. Simple. Works good.
2912 :
2913 : (defun comint-proc-query (proc str)
2914 : "Send to the inferior process PROC the string STR.
2915 : Pop-up but do not select a window for the inferior process so that
2916 : its response can be seen."
2917 0 : (let* ((proc-buf (process-buffer proc))
2918 0 : (proc-mark (process-mark proc)))
2919 0 : (display-buffer proc-buf)
2920 0 : (set-buffer proc-buf) ; but it's not the selected *window*
2921 0 : (let ((proc-win (get-buffer-window proc-buf 0))
2922 0 : (proc-pt (marker-position proc-mark)))
2923 0 : (comint-send-string proc str) ; send the query
2924 0 : (accept-process-output proc) ; wait for some output
2925 : ;; Try to position the proc window so you can see the answer.
2926 : ;; This is bogus code. If you delete the (sit-for 0), it breaks.
2927 : ;; I don't know why. Wizards invited to improve it.
2928 0 : (unless (pos-visible-in-window-p proc-pt proc-win)
2929 0 : (let ((opoint (window-point proc-win)))
2930 0 : (set-window-point proc-win proc-mark)
2931 0 : (sit-for 0)
2932 0 : (if (not (pos-visible-in-window-p opoint proc-win))
2933 0 : (push-mark opoint)
2934 0 : (set-window-point proc-win opoint)))))))
2935 :
2936 :
2937 : ;; Filename/command/history completion in a buffer
2938 : ;; ===========================================================================
2939 : ;; Useful completion functions, courtesy of the Ergo group.
2940 :
2941 : ;; Six commands:
2942 : ;; completion-at-point Complete or expand command, filename,
2943 : ;; history at point.
2944 : ;; comint-dynamic-complete-filename Complete filename at point.
2945 : ;; comint-dynamic-list-filename-completions List completions in help buffer.
2946 : ;; comint-replace-by-expanded-filename Expand and complete filename at point;
2947 : ;; replace with expanded/completed name.
2948 :
2949 : ;; These are not installed in the comint-mode keymap. But they are
2950 : ;; available for people who want them. Shell-mode installs them:
2951 : ;; (define-key shell-mode-map "\t" 'completion-at-point)
2952 : ;; (define-key shell-mode-map "\M-?"
2953 : ;; 'comint-dynamic-list-filename-completions)))
2954 : ;;
2955 : ;; Commands like this are fine things to put in load hooks if you
2956 : ;; want them present in specific modes.
2957 :
2958 : (defcustom comint-completion-autolist nil
2959 : "If non-nil, automatically list possibilities on partial completion.
2960 : This mirrors the optional behavior of tcsh."
2961 : :type 'boolean
2962 : :group 'comint-completion)
2963 :
2964 : (defcustom comint-completion-addsuffix t
2965 : "If non-nil, add ` ' to file names.
2966 : It can either be a string FILESUFFIX or a cons (DIRSUFFIX . FILESUFFIX)
2967 : where DIRSUFFIX is ignored and FILESUFFIX is a string added on unambiguous
2968 : or exact completion.
2969 : This mirrors the optional behavior of tcsh."
2970 : :type '(choice (const :tag "None" nil)
2971 : (const :tag "Add SPC" t)
2972 : (string :tag "File suffix")
2973 : (cons :tag "Obsolete suffix pair"
2974 : (string :tag "Ignored")
2975 : (string :tag "File suffix")))
2976 : :group 'comint-completion)
2977 :
2978 : (defcustom comint-completion-recexact nil
2979 : "If non-nil, use shortest completion if characters cannot be added.
2980 : This mirrors the optional behavior of tcsh.
2981 :
2982 : A non-nil value is useful if `comint-completion-autolist' is non-nil too."
2983 : :type 'boolean
2984 : :group 'comint-completion)
2985 :
2986 : (defcustom comint-completion-fignore nil
2987 : "List of suffixes to be disregarded during file completion.
2988 : This mirrors the optional behavior of bash and tcsh.
2989 :
2990 : Note that this applies to `comint-dynamic-complete-filename' only."
2991 : :type '(repeat (string :tag "Suffix"))
2992 : :group 'comint-completion)
2993 :
2994 : ;;;###autoload
2995 : (defvar comint-file-name-prefix (purecopy "")
2996 : "Prefix prepended to absolute file names taken from process input.
2997 : This is used by Comint's and shell's completion functions, and by shell's
2998 : directory tracking functions.")
2999 :
3000 : (defvar comint-file-name-chars
3001 : (if (memq system-type '(ms-dos windows-nt cygwin))
3002 : "~/A-Za-z0-9_^$!#%&{}@`'.,:()-"
3003 : "[]~/A-Za-z0-9+@:_.$#%,={}-")
3004 : "String of characters valid in a file name.
3005 : Note that all non-ASCII characters are considered valid in a file name
3006 : regardless of what this variable says.
3007 :
3008 : This is a good thing to set in mode hooks.")
3009 :
3010 : (defvar comint-file-name-quote-list nil
3011 : "List of characters to quote with `\\' when in a file name.
3012 :
3013 : This is a good thing to set in mode hooks.")
3014 :
3015 :
3016 : (defun comint-directory (directory)
3017 : "Return expanded DIRECTORY, with `comint-file-name-prefix' if absolute."
3018 0 : (expand-file-name (if (file-name-absolute-p directory)
3019 0 : (concat comint-file-name-prefix directory)
3020 0 : directory)))
3021 :
3022 :
3023 : (defun comint-word (word-chars)
3024 : "Return the word of WORD-CHARS at point, or nil if none is found.
3025 : Word constituents are considered to be those in WORD-CHARS, which is like the
3026 : inside of a \"[...]\" (see `skip-chars-forward'), plus all non-ASCII characters."
3027 : ;; FIXME: Need to handle "..." and '...' quoting in shell.el!
3028 : ;; This should be combined with completion parsing somehow.
3029 0 : (save-excursion
3030 0 : (let ((here (point))
3031 : giveup)
3032 0 : (while (not giveup)
3033 0 : (let ((startpoint (point)))
3034 0 : (skip-chars-backward (concat "\\\\" word-chars))
3035 0 : (if (and comint-file-name-quote-list
3036 0 : (eq (char-before (1- (point))) ?\\))
3037 0 : (forward-char -2))
3038 : ;; FIXME: This isn't consistent with Bash, at least -- not
3039 : ;; all non-ASCII chars should be word constituents.
3040 0 : (if (and (not (bobp)) (>= (char-before) 128))
3041 0 : (forward-char -1))
3042 0 : (if (= (point) startpoint)
3043 0 : (setq giveup t))))
3044 : ;; Set match-data to match the entire string.
3045 0 : (when (< (point) here)
3046 0 : (set-match-data (list (point) here))
3047 0 : (match-string 0)))))
3048 :
3049 : (defun comint-substitute-in-file-name (filename)
3050 : "Return FILENAME with environment variables substituted.
3051 : Supports additional environment variable syntax of the command
3052 : interpreter (e.g., the percent notation of cmd.exe on Windows)."
3053 0 : (let ((name (substitute-in-file-name filename)))
3054 0 : (if (memq system-type '(ms-dos windows-nt))
3055 0 : (let (env-var-name
3056 : env-var-val)
3057 0 : (save-match-data
3058 0 : (while (string-match "%\\([^\\\\/]*\\)%" name)
3059 0 : (setq env-var-name (match-string 1 name))
3060 0 : (setq env-var-val (or (getenv env-var-name) ""))
3061 0 : (setq name (replace-match env-var-val t t name))))))
3062 0 : name))
3063 :
3064 : (defun comint--match-partial-filename ()
3065 : "Return the filename at point as-is, or nil if none is found.
3066 : See `comint-word'."
3067 0 : (comint-word comint-file-name-chars))
3068 :
3069 : (defun comint--unquote&requote-argument (qstr &optional upos)
3070 0 : (unless upos (setq upos 0))
3071 0 : (let* ((qpos 0)
3072 : (ustrs '())
3073 0 : (re (concat
3074 : "\\$\\(?:\\([[:alpha:]][[:alnum:]]*\\)"
3075 : "\\|{\\(?1:[^{}]+\\)}\\)"
3076 0 : (when (memq system-type '(ms-dos windows-nt))
3077 0 : "\\|%\\(?1:[^\\\\/]*\\)%")
3078 0 : (when comint-file-name-quote-list
3079 0 : "\\|\\\\\\(.\\)")))
3080 : (qupos nil)
3081 : (push (lambda (str end)
3082 0 : (push str ustrs)
3083 0 : (setq upos (- upos (length str)))
3084 0 : (unless (or qupos (> upos 0))
3085 0 : (setq qupos (if (< end 0) (- end) (+ upos end))))))
3086 : match)
3087 0 : (while (setq match (string-match re qstr qpos))
3088 0 : (funcall push (substring qstr qpos match) match)
3089 0 : (cond
3090 0 : ((match-beginning 2) (funcall push (match-string 2 qstr) (match-end 0)))
3091 0 : ((match-beginning 1) (funcall push (getenv (match-string 1 qstr))
3092 0 : (- (match-end 0))))
3093 0 : (t (error "Unexpected case in comint--unquote&requote-argument!")))
3094 0 : (setq qpos (match-end 0)))
3095 0 : (funcall push (substring qstr qpos) (length qstr))
3096 0 : (list (mapconcat #'identity (nreverse ustrs) "")
3097 0 : qupos #'comint-quote-filename)))
3098 :
3099 : (defun comint--unquote-argument (str)
3100 0 : (car (comint--unquote&requote-argument str)))
3101 : (define-obsolete-function-alias 'comint--unquote&expand-filename
3102 : #'comint--unquote-argument "24.3")
3103 :
3104 : (defun comint-match-partial-filename ()
3105 : "Return the unquoted&expanded filename at point, or nil if none is found.
3106 : Environment variables are substituted. See `comint-word'."
3107 0 : (let ((filename (comint--match-partial-filename)))
3108 0 : (and filename (comint--unquote-argument filename))))
3109 :
3110 : (defun comint-quote-filename (filename)
3111 : "Return FILENAME with magic characters quoted.
3112 : Magic characters are those in `comint-file-name-quote-list'."
3113 0 : (if (null comint-file-name-quote-list)
3114 0 : filename
3115 0 : (let ((regexp (regexp-opt-charset comint-file-name-quote-list)))
3116 0 : (save-match-data
3117 0 : (let ((i 0))
3118 0 : (while (string-match regexp filename i)
3119 0 : (setq filename (replace-match "\\\\\\&" nil nil filename))
3120 0 : (setq i (1+ (match-end 0)))))
3121 0 : filename))))
3122 :
3123 : (defun comint-unquote-filename (filename)
3124 : "Return FILENAME with quoted characters unquoted."
3125 : (declare (obsolete nil "24.3"))
3126 0 : (if (null comint-file-name-quote-list)
3127 0 : filename
3128 0 : (save-match-data
3129 0 : (replace-regexp-in-string "\\\\\\(.\\)" "\\1" filename t))))
3130 :
3131 : (defun comint--requote-argument (upos qstr)
3132 : ;; See `completion-table-with-quoting'.
3133 0 : (let ((res (comint--unquote&requote-argument qstr upos)))
3134 0 : (cons (nth 1 res) (nth 2 res))))
3135 :
3136 : (defun comint-completion-at-point ()
3137 0 : (run-hook-with-args-until-success 'comint-dynamic-complete-functions))
3138 :
3139 : (define-obsolete-function-alias
3140 : 'comint-dynamic-complete
3141 : 'completion-at-point "24.1")
3142 :
3143 : (defun comint-dynamic-complete-filename ()
3144 : "Dynamically complete the filename at point.
3145 : Completes if after a filename.
3146 : This function is similar to `comint-replace-by-expanded-filename', except that
3147 : it won't change parts of the filename already entered in the buffer; it just
3148 : adds completion characters to the end of the filename. A completions listing
3149 : may be shown in a separate buffer if completion is ambiguous.
3150 :
3151 : Completion is dependent on the value of `comint-completion-addsuffix',
3152 : `comint-completion-recexact' and `comint-completion-fignore', and the timing of
3153 : completions listing is dependent on the value of `comint-completion-autolist'.
3154 :
3155 : Returns t if successful."
3156 : (interactive)
3157 0 : (when (comint--match-partial-filename)
3158 0 : (unless (window-minibuffer-p)
3159 0 : (message "Completing file name..."))
3160 0 : (let ((data (comint--complete-file-name-data)))
3161 0 : (completion-in-region (nth 0 data) (nth 1 data) (nth 2 data)))))
3162 :
3163 : (defun comint-filename-completion ()
3164 : "Return completion data for filename at point, if any."
3165 0 : (when (comint--match-partial-filename)
3166 0 : (comint--complete-file-name-data)))
3167 :
3168 : (defun comint-completion-file-name-table (string pred action)
3169 0 : (if (not (file-name-absolute-p string))
3170 0 : (completion-file-name-table string pred action)
3171 0 : (cond
3172 0 : ((memq action '(t lambda))
3173 0 : (completion-file-name-table
3174 0 : (concat comint-file-name-prefix string) pred action))
3175 0 : ((null action)
3176 0 : (let ((res (completion-file-name-table
3177 0 : (concat comint-file-name-prefix string) pred action)))
3178 0 : (if (and (stringp res)
3179 0 : (string-match
3180 0 : (concat "\\`" (regexp-quote comint-file-name-prefix))
3181 0 : res))
3182 0 : (substring res (match-end 0))
3183 0 : res)))
3184 0 : (t (completion-file-name-table string pred action)))))
3185 :
3186 : (defvar comint-unquote-function #'comint--unquote-argument
3187 : "Function to use for completion of quoted data.
3188 : See `completion-table-with-quoting' and `comint-requote-function'.")
3189 : (defvar comint-requote-function #'comint--requote-argument
3190 : "Function to use for completion of quoted data.
3191 : See `completion-table-with-quoting' and `comint-unquote-function'.")
3192 :
3193 : (defun comint--complete-file-name-data ()
3194 : "Return the completion data for file name at point."
3195 0 : (let* ((filesuffix (cond ((not comint-completion-addsuffix) "")
3196 0 : ((stringp comint-completion-addsuffix)
3197 0 : comint-completion-addsuffix)
3198 0 : ((not (consp comint-completion-addsuffix)) " ")
3199 0 : (t (cdr comint-completion-addsuffix))))
3200 0 : (filename (comint--match-partial-filename))
3201 0 : (filename-beg (if filename (match-beginning 0) (point)))
3202 0 : (filename-end (if filename (match-end 0) (point)))
3203 : (table
3204 0 : (completion-table-with-quoting
3205 0 : #'comint-completion-file-name-table
3206 0 : comint-unquote-function
3207 0 : comint-requote-function)))
3208 0 : (nconc
3209 0 : (list
3210 0 : filename-beg filename-end
3211 : (lambda (string pred action)
3212 0 : (let ((completion-ignore-case read-file-name-completion-ignore-case)
3213 0 : (completion-ignored-extensions comint-completion-fignore))
3214 0 : (complete-with-action action table string pred))))
3215 0 : (unless (zerop (length filesuffix))
3216 0 : (list :exit-function
3217 : (lambda (_s status)
3218 0 : (when (eq status 'finished)
3219 0 : (if (looking-at (regexp-quote filesuffix))
3220 0 : (goto-char (match-end 0))
3221 0 : (insert filesuffix)))))))))
3222 :
3223 : (defun comint-dynamic-complete-as-filename ()
3224 : "Dynamically complete at point as a filename.
3225 : See `comint-dynamic-complete-filename'. Returns t if successful."
3226 : (declare (obsolete comint-filename-completion "24.1"))
3227 0 : (let ((data (comint--complete-file-name-data)))
3228 0 : (completion-in-region (nth 0 data) (nth 1 data) (nth 2 data))))
3229 :
3230 : (defun comint-replace-by-expanded-filename ()
3231 : "Dynamically expand and complete the filename at point.
3232 : Replace the filename with an expanded, canonicalized and
3233 : completed replacement, i.e. substituting environment
3234 : variables (e.g. $HOME), `~'s, `..', and `.', and making the
3235 : filename absolute. For expansion see `expand-file-name' and
3236 : `substitute-in-file-name'. For completion see
3237 : `comint-dynamic-complete-filename'."
3238 : (interactive)
3239 0 : (let ((filename (comint-match-partial-filename)))
3240 0 : (when filename
3241 0 : (replace-match (expand-file-name filename) t t)
3242 0 : (comint-dynamic-complete-filename))))
3243 :
3244 :
3245 : (defun comint-dynamic-simple-complete (stub candidates)
3246 : "Dynamically complete STUB from CANDIDATES list.
3247 : This function inserts completion characters at point by
3248 : completing STUB from the strings in CANDIDATES. If completion is
3249 : ambiguous, possibly show a completions listing in a separate
3250 : buffer.
3251 :
3252 : Return nil if no completion was inserted.
3253 : Return `sole' if completed with the only completion match.
3254 : Return `shortest' if completed with the shortest match.
3255 : Return `partial' if completed as far as possible.
3256 : Return `listed' if a completion listing was shown.
3257 :
3258 : See also `comint-dynamic-complete-filename'."
3259 : (declare (obsolete completion-in-region "24.1"))
3260 0 : (let* ((completion-ignore-case (memq system-type '(ms-dos windows-nt cygwin)))
3261 0 : (minibuffer-p (window-minibuffer-p))
3262 0 : (suffix (cond ((not comint-completion-addsuffix) "")
3263 0 : ((not (consp comint-completion-addsuffix)) " ")
3264 0 : (t (cdr comint-completion-addsuffix))))
3265 0 : (completions (all-completions stub candidates)))
3266 0 : (cond ((null completions)
3267 0 : (if minibuffer-p
3268 0 : (minibuffer-message "No completions of %s" stub)
3269 0 : (message "No completions of %s" stub))
3270 : nil)
3271 0 : ((= 1 (length completions)) ; Gotcha!
3272 0 : (let ((completion (car completions)))
3273 0 : (if (string-equal completion stub)
3274 0 : (unless minibuffer-p
3275 0 : (message "Sole completion"))
3276 0 : (insert (substring completion (length stub)))
3277 0 : (unless minibuffer-p
3278 0 : (message "Completed")))
3279 0 : (insert suffix)
3280 0 : 'sole))
3281 : (t ; There's no unique completion.
3282 0 : (let ((completion (try-completion stub candidates)))
3283 : ;; Insert the longest substring.
3284 0 : (insert (substring completion (length stub)))
3285 0 : (cond ((and comint-completion-recexact comint-completion-addsuffix
3286 0 : (string-equal stub completion)
3287 0 : (member completion completions))
3288 : ;; It's not unique, but user wants shortest match.
3289 0 : (insert suffix)
3290 0 : (unless minibuffer-p
3291 0 : (message "Completed shortest"))
3292 : 'shortest)
3293 0 : ((or comint-completion-autolist
3294 0 : (string-equal stub completion))
3295 : ;; It's not unique, list possible completions.
3296 0 : (comint-dynamic-list-completions completions stub)
3297 : 'listed)
3298 : (t
3299 0 : (unless minibuffer-p
3300 0 : (message "Partially completed"))
3301 0 : 'partial)))))))
3302 :
3303 : (defun comint-dynamic-list-filename-completions ()
3304 : "Display a list of possible completions for the filename at point."
3305 : (interactive)
3306 0 : (let* ((data (comint--complete-file-name-data))
3307 0 : (minibuffer-completion-table (nth 2 data))
3308 : (minibuffer-completion-predicate nil)
3309 0 : (ol (make-overlay (nth 0 data) (nth 1 data) nil nil t)))
3310 0 : (overlay-put ol 'field 'completion)
3311 0 : (unwind-protect
3312 0 : (call-interactively 'minibuffer-completion-help)
3313 0 : (delete-overlay ol))))
3314 :
3315 :
3316 : ;; This is bound locally in a *Completions* buffer to the list of
3317 : ;; completions displayed, and is used to detect the case where the same
3318 : ;; command is repeatedly used without the set of completions changing.
3319 : (defvar comint-displayed-dynamic-completions nil)
3320 :
3321 : (defvar comint-dynamic-list-completions-config nil)
3322 :
3323 : (defun comint-dynamic-list-completions (completions &optional common-substring)
3324 : "Display a list of sorted COMPLETIONS.
3325 : Typing SPC flushes the completions buffer.
3326 :
3327 : The optional argument COMMON-SUBSTRING, if non-nil, should be a string
3328 : specifying a common substring for adding the faces
3329 : `completions-first-difference' and `completions-common-part' to
3330 : the completions."
3331 0 : (let ((window (get-buffer-window "*Completions*" 0)))
3332 0 : (setq completions (sort completions 'string-lessp))
3333 0 : (if (and (eq last-command this-command)
3334 0 : window (window-live-p window) (window-buffer window)
3335 0 : (buffer-name (window-buffer window))
3336 : ;; The above tests are not sufficient to detect the case where we
3337 : ;; should scroll, because the top-level interactive command may
3338 : ;; not have displayed a completions window the last time it was
3339 : ;; invoked, and there may be such a window left over from a
3340 : ;; previous completion command with a different set of
3341 : ;; completions. To detect that case, we also test that the set
3342 : ;; of displayed completions is in fact the same as the previously
3343 : ;; displayed set.
3344 0 : (equal completions
3345 0 : (buffer-local-value 'comint-displayed-dynamic-completions
3346 0 : (window-buffer window))))
3347 : ;; If this command was repeated, and
3348 : ;; there's a fresh completion window with a live buffer,
3349 : ;; and this command is repeated, scroll that window.
3350 0 : (with-current-buffer (window-buffer window)
3351 0 : (if (pos-visible-in-window-p (point-max) window)
3352 0 : (set-window-start window (point-min))
3353 0 : (save-selected-window
3354 0 : (select-window window)
3355 0 : (scroll-up))))
3356 :
3357 : ;; Display a completion list for the first time.
3358 0 : (setq comint-dynamic-list-completions-config
3359 0 : (current-window-configuration))
3360 0 : (with-output-to-temp-buffer "*Completions*"
3361 0 : (display-completion-list
3362 0 : (completion-hilit-commonality completions (length common-substring))))
3363 0 : (if (window-minibuffer-p)
3364 0 : (minibuffer-message "Type space to flush; repeat completion command to scroll")
3365 0 : (message "Type space to flush; repeat completion command to scroll")))
3366 :
3367 : ;; Read the next key, to process SPC.
3368 0 : (let (key first)
3369 0 : (if (with-current-buffer (get-buffer "*Completions*")
3370 0 : (setq-local comint-displayed-dynamic-completions
3371 0 : completions)
3372 0 : (setq key (read-key-sequence nil)
3373 0 : first (aref key 0))
3374 0 : (and (consp first) (consp (event-start first))
3375 0 : (eq (window-buffer (posn-window (event-start first)))
3376 0 : (get-buffer "*Completions*"))
3377 0 : (memq (key-binding key)
3378 0 : '(mouse-choose-completion choose-completion))))
3379 : ;; If the user does choose-completion with the mouse,
3380 : ;; execute the command, then delete the completion window.
3381 0 : (progn
3382 0 : (choose-completion first)
3383 0 : (set-window-configuration comint-dynamic-list-completions-config))
3384 0 : (if (eq first ?\s)
3385 0 : (set-window-configuration comint-dynamic-list-completions-config)
3386 0 : (setq unread-command-events
3387 0 : (nconc (listify-key-sequence key) unread-command-events)))))))
3388 :
3389 : (defun comint-get-next-from-history ()
3390 : "After fetching a line from input history, this fetches the following line.
3391 : In other words, this recalls the input line after the line you recalled last.
3392 : You can use this to repeat a sequence of input lines."
3393 : (interactive)
3394 0 : (if comint-save-input-ring-index
3395 0 : (progn
3396 0 : (setq comint-input-ring-index (1+ comint-save-input-ring-index))
3397 0 : (comint-next-input 1))
3398 0 : (message "No previous history command")))
3399 :
3400 : (defun comint-accumulate ()
3401 : "Accumulate a line to send as input along with more lines.
3402 : This inserts a newline so that you can enter more text
3403 : to be sent along with this line. Use \\[comint-send-input]
3404 : to send all the accumulated input, at once.
3405 : The entire accumulated text becomes one item in the input history
3406 : when you send it."
3407 : (interactive)
3408 0 : (insert "\n")
3409 0 : (set-marker comint-accum-marker (point))
3410 0 : (if comint-input-ring-index
3411 0 : (setq comint-save-input-ring-index
3412 0 : (- comint-input-ring-index 1))))
3413 :
3414 : (defun comint-goto-process-mark ()
3415 : "Move point to the process mark.
3416 : The process mark separates output, and input already sent,
3417 : from input that has not yet been sent."
3418 : (interactive)
3419 0 : (let ((proc (or (get-buffer-process (current-buffer))
3420 0 : (user-error "Current buffer has no process"))))
3421 0 : (goto-char (process-mark proc))
3422 0 : (when (called-interactively-p 'interactive)
3423 0 : (message "Point is now at the process mark"))))
3424 :
3425 : (defun comint-bol-or-process-mark ()
3426 : "Move point to beginning of line (after prompt) or to the process mark.
3427 : The first time you use this command, it moves to the beginning of the line
3428 : \(but after the prompt, if any). If you repeat it again immediately,
3429 : it moves point to the process mark.
3430 :
3431 : The process mark separates the process output, along with input already sent,
3432 : from input that has not yet been sent. Ordinarily, the process mark
3433 : is at the beginning of the current input line; but if you have
3434 : used \\[comint-accumulate] to send multiple lines at once,
3435 : the process mark is at the beginning of the accumulated input."
3436 : (interactive)
3437 0 : (if (not (eq last-command 'comint-bol-or-process-mark))
3438 0 : (comint-bol nil)
3439 0 : (comint-goto-process-mark)))
3440 :
3441 : (defun comint-set-process-mark ()
3442 : "Set the process mark at point."
3443 : (interactive)
3444 0 : (let ((proc (or (get-buffer-process (current-buffer))
3445 0 : (user-error "Current buffer has no process"))))
3446 0 : (set-marker (process-mark proc) (point))
3447 0 : (message "Process mark set")))
3448 :
3449 :
3450 : ;; Author: Peter Breton <pbreton@cs.umb.edu>
3451 :
3452 : ;; This little add-on for comint is intended to make it easy to get
3453 : ;; output from currently active comint buffers into another buffer,
3454 : ;; or buffers, and then go back to using the comint shell.
3455 : ;;
3456 : ;; My particular use is SQL interpreters; I want to be able to execute a
3457 : ;; query using the process associated with a comint-buffer, and save that
3458 : ;; somewhere else. Because the process might have state (for example, it
3459 : ;; could be in an uncommitted transaction), just running starting a new
3460 : ;; process and having it execute the query and then finish, would not
3461 : ;; work. I'm sure there are other uses as well, although in many cases
3462 : ;; starting a new process is the simpler, and thus preferable, approach.
3463 : ;;
3464 : ;; The basic implementation is as follows: comint-redirect changes the
3465 : ;; preoutput filter functions (`comint-preoutput-filter-functions') to use
3466 : ;; its own filter. The filter puts the output into the designated buffer,
3467 : ;; or buffers, until it sees a regexp that tells it to stop (by default,
3468 : ;; this is the prompt for the interpreter, `comint-prompt-regexp'). When it
3469 : ;; sees the stop regexp, it restores the old filter functions, and runs
3470 : ;; `comint-redirect-hook'.
3471 : ;;
3472 : ;; Each comint buffer may only use one redirection at a time, but any number
3473 : ;; of different comint buffers may be simultaneously redirected.
3474 : ;;
3475 : ;; NOTE: It is EXTREMELY important that `comint-prompt-regexp' be set to the
3476 : ;; correct prompt for your interpreter, or that you supply a regexp that says
3477 : ;; when the redirection is finished. Otherwise, redirection will continue
3478 : ;; indefinitely. The code now does a sanity check to ensure that it can find
3479 : ;; a prompt in the comint buffer; however, it is still important to ensure that
3480 : ;; this prompt is set correctly.
3481 : ;;
3482 : ;; XXX: This doesn't work so well unless `comint-prompt-regexp' is set;
3483 : ;; perhaps it should prompt for a terminating string (with an
3484 : ;; appropriate magic default by examining what we think is the prompt)?
3485 : ;;
3486 : ;; Fixme: look for appropriate fields, rather than regexp, if
3487 : ;; `comint-use-prompt-regexp' is true.
3488 :
3489 : ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3490 : ;; Variables
3491 : ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3492 :
3493 : (defcustom comint-redirect-verbose nil
3494 : "If non-nil, print messages each time the redirection filter is invoked.
3495 : Also print a message when redirection is completed."
3496 : :group 'comint
3497 : :type 'boolean)
3498 :
3499 : ;; Directly analogous to comint-preoutput-filter-functions
3500 : (defvar comint-redirect-filter-functions nil
3501 : "List of functions to call before inserting redirected process output.
3502 : Each function gets one argument, a string containing the text received
3503 : from the subprocess. It should return the string to insert, perhaps
3504 : the same string that was received, or perhaps a modified or transformed
3505 : string.
3506 :
3507 : The functions on the list are called sequentially, and each one is given
3508 : the string returned by the previous one. The string returned by the
3509 : last function is the text that is actually inserted in the redirection buffer.
3510 :
3511 : You can use `add-hook' to add functions to this list
3512 : either globally or locally.")
3513 :
3514 : ;; Internal variables
3515 :
3516 : (defvar comint-redirect-output-buffer nil
3517 : "The buffer or list of buffers to put output into.")
3518 :
3519 : (defvar comint-redirect-finished-regexp nil
3520 : "Regular expression that determines when to stop redirection in Comint.
3521 : When the redirection filter function is given output that matches this regexp,
3522 : the output is inserted as usual, and redirection is completed.")
3523 :
3524 : (defvar comint-redirect-insert-matching-regexp nil
3525 : "If non-nil, the text that ends a redirection is included in it.
3526 : More precisely, the text that matches `comint-redirect-finished-regexp'
3527 : and therefore terminates an output redirection is inserted in the
3528 : redirection target buffer, along with the preceding output.")
3529 :
3530 : (defvar comint-redirect-echo-input nil
3531 : "Non-nil means echo input in the process buffer even during redirection.")
3532 :
3533 : (defvar comint-redirect-completed nil
3534 : "Non-nil if redirection has completed in the current buffer.")
3535 :
3536 : (defvar comint-redirect-original-mode-line-process nil
3537 : "Original mode line for redirected process.")
3538 :
3539 : (defvar comint-redirect-perform-sanity-check t
3540 : "If non-nil, check that redirection is likely to complete successfully.
3541 : More precisely, before starting a redirection, verify that the
3542 : regular expression `comint-redirect-finished-regexp' that controls
3543 : when to terminate it actually matches some text already in the process
3544 : buffer. The idea is that this regular expression should match a prompt
3545 : string, and that there ought to be at least one copy of your prompt string
3546 : in the process buffer already.")
3547 :
3548 : (defvar comint-redirect-subvert-readonly nil
3549 : "Non-nil means `comint-redirect' can insert into read-only buffers.
3550 : This works by binding `inhibit-read-only' around the insertion.
3551 : This is useful, for instance, for insertion into Help mode buffers.
3552 : You probably want to set it locally to the output buffer.")
3553 :
3554 : (defvar comint-redirect-previous-input-string nil
3555 : "Last redirected line of text.
3556 : Allows detection of the end of the redirection in case the
3557 : completion string is split between two output segments.")
3558 :
3559 : ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3560 : ;; Functions
3561 : ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3562 :
3563 : (defun comint-redirect-setup (output-buffer
3564 : comint-buffer
3565 : finished-regexp
3566 : &optional echo-input)
3567 : "Set up for output redirection.
3568 : This function sets local variables that are used by `comint-redirect-filter'
3569 : to perform redirection.
3570 :
3571 : Output from COMINT-BUFFER is redirected to OUTPUT-BUFFER, until something
3572 : in the output matches FINISHED-REGEXP.
3573 :
3574 : If optional argument ECHO-INPUT is non-nil, output is echoed to the
3575 : original Comint buffer.
3576 :
3577 : This function is called by `comint-redirect-send-command-to-process',
3578 : and does not normally need to be invoked by the end user or programmer."
3579 0 : (with-current-buffer comint-buffer
3580 :
3581 0 : (setq-local comint-redirect-original-mode-line-process mode-line-process)
3582 :
3583 0 : (setq-local comint-redirect-output-buffer output-buffer)
3584 :
3585 0 : (setq-local comint-redirect-finished-regexp finished-regexp)
3586 :
3587 0 : (setq-local comint-redirect-echo-input echo-input)
3588 :
3589 0 : (setq-local comint-redirect-completed nil)
3590 :
3591 0 : (setq-local comint-redirect-previous-input-string "")
3592 :
3593 0 : (setq mode-line-process
3594 0 : (if mode-line-process
3595 0 : (list (concat (elt mode-line-process 0) " Redirection"))
3596 0 : (list ":%s Redirection")))))
3597 :
3598 : (defun comint-redirect-cleanup ()
3599 : "End a Comint redirection. See `comint-redirect-send-command'."
3600 : (interactive)
3601 : ;; Release the last redirected string
3602 0 : (setq comint-redirect-previous-input-string nil)
3603 : ;; Restore the process filter
3604 0 : (remove-function (process-filter (get-buffer-process (current-buffer)))
3605 0 : #'comint-redirect-filter)
3606 : ;; Restore the mode line
3607 0 : (setq mode-line-process comint-redirect-original-mode-line-process)
3608 : ;; Set the completed flag
3609 0 : (setq comint-redirect-completed t))
3610 :
3611 : ;; Because the cleanup happens as a callback, it's not easy to guarantee
3612 : ;; that it really occurs.
3613 : (defalias 'comint-redirect-remove-redirection 'comint-redirect-cleanup)
3614 :
3615 : (defun comint-redirect-filter (orig-filter process input-string)
3616 : "Filter function which redirects output from PROCESS to a buffer or buffers.
3617 : The variable `comint-redirect-output-buffer' says which buffer(s) to
3618 : place output in.
3619 :
3620 : INPUT-STRING is the input from the Comint process.
3621 :
3622 : This function runs as a process filter, and does not need to be invoked by the
3623 : end user."
3624 0 : (and process
3625 0 : (with-current-buffer (process-buffer process)
3626 0 : (comint-redirect-preoutput-filter input-string)
3627 : ;; If we have to echo output, give it to the original filter function
3628 0 : (and comint-redirect-echo-input
3629 0 : orig-filter
3630 0 : (funcall orig-filter process input-string)))))
3631 :
3632 :
3633 : (defun comint-redirect-preoutput-filter (input-string)
3634 : "Comint filter function which redirects Comint output to a buffer or buffers.
3635 : The variable `comint-redirect-output-buffer' says which buffer(s) to
3636 : place output in.
3637 :
3638 : INPUT-STRING is the input from the Comint process.
3639 :
3640 : This function does not need to be invoked by the end user."
3641 0 : (let ((output-buffer-list
3642 0 : (if (listp comint-redirect-output-buffer)
3643 0 : comint-redirect-output-buffer
3644 0 : (list comint-redirect-output-buffer)))
3645 0 : (filtered-input-string input-string))
3646 :
3647 : ;; If there are any filter functions, give them a chance to modify
3648 : ;; the string.
3649 0 : (let ((functions comint-redirect-filter-functions))
3650 0 : (while (and functions filtered-input-string)
3651 0 : (if (eq (car functions) t)
3652 : ;; If a local value says "use the default value too",
3653 : ;; do that.
3654 0 : (let ((functions
3655 0 : (default-value 'comint-redirect-filter-functions)))
3656 0 : (while (and functions filtered-input-string)
3657 0 : (setq filtered-input-string
3658 0 : (funcall (car functions) filtered-input-string))
3659 0 : (setq functions (cdr functions))))
3660 0 : (setq filtered-input-string
3661 0 : (funcall (car functions) filtered-input-string)))
3662 0 : (setq functions (cdr functions))))
3663 :
3664 : ;; Clobber `comint-redirect-finished-regexp'
3665 0 : (or comint-redirect-insert-matching-regexp
3666 0 : (and (string-match comint-redirect-finished-regexp filtered-input-string)
3667 0 : (setq filtered-input-string
3668 0 : (replace-match "" nil nil filtered-input-string))))
3669 :
3670 : ;; Send output to all registered buffers
3671 0 : (save-excursion
3672 0 : (dolist (buf output-buffer-list)
3673 : ;; Set this buffer to the output buffer
3674 0 : (set-buffer (get-buffer-create buf))
3675 : ;; Go to the end of the buffer
3676 0 : (goto-char (point-max))
3677 : ;; Insert the output
3678 0 : (let ((inhibit-read-only comint-redirect-subvert-readonly))
3679 0 : (insert filtered-input-string))))
3680 :
3681 : ;; Message
3682 0 : (and comint-redirect-verbose
3683 0 : (message "Redirected output to buffer(s) %s" output-buffer-list))
3684 :
3685 : ;; If we see the prompt, tidy up
3686 : ;; We'll look for the prompt in the original string, so nobody can
3687 : ;; clobber it
3688 0 : (and (string-match comint-redirect-finished-regexp
3689 0 : (concat comint-redirect-previous-input-string
3690 0 : input-string))
3691 0 : (progn
3692 0 : (and comint-redirect-verbose
3693 0 : (message "Redirection completed"))
3694 0 : (comint-redirect-cleanup)
3695 0 : (run-hooks 'comint-redirect-hook)))
3696 0 : (setq comint-redirect-previous-input-string input-string)
3697 :
3698 : ;; Echo input?
3699 0 : (if comint-redirect-echo-input
3700 0 : filtered-input-string
3701 0 : "")))
3702 :
3703 : ;;;###autoload
3704 : (defun comint-redirect-send-command (command output-buffer echo &optional no-display)
3705 : "Send COMMAND to process in current buffer, with output to OUTPUT-BUFFER.
3706 : With prefix arg ECHO, echo output in process buffer.
3707 :
3708 : If NO-DISPLAY is non-nil, do not show the output buffer."
3709 : (interactive "sCommand: \nBOutput Buffer: \nP")
3710 0 : (let ((process (get-buffer-process (current-buffer))))
3711 0 : (if process
3712 0 : (comint-redirect-send-command-to-process
3713 0 : command output-buffer (current-buffer) echo no-display)
3714 0 : (error "No process for current buffer"))))
3715 :
3716 : ;;;###autoload
3717 : (defun comint-redirect-send-command-to-process
3718 : (command output-buffer process echo &optional no-display)
3719 : "Send COMMAND to PROCESS, with output to OUTPUT-BUFFER.
3720 : With prefix arg, echo output in process buffer.
3721 :
3722 : If NO-DISPLAY is non-nil, do not show the output buffer."
3723 : (interactive "sCommand: \nBOutput Buffer: \nbProcess Buffer: \nP")
3724 0 : (let* (;; The process buffer
3725 0 : (process-buffer (if (processp process)
3726 0 : (process-buffer process)
3727 0 : process))
3728 0 : (proc (get-buffer-process process-buffer)))
3729 : ;; Change to the process buffer
3730 0 : (with-current-buffer process-buffer
3731 :
3732 : ;; Make sure there's a prompt in the current process buffer
3733 0 : (and comint-redirect-perform-sanity-check
3734 0 : (save-excursion
3735 0 : (goto-char (point-max))
3736 0 : (or (re-search-backward comint-prompt-regexp nil t)
3737 0 : (error "No prompt found or `comint-prompt-regexp' not set properly"))))
3738 :
3739 : ;; Set up for redirection
3740 0 : (comint-redirect-setup
3741 0 : output-buffer
3742 0 : (current-buffer) ; Comint Buffer
3743 0 : comint-prompt-regexp ; Finished Regexp
3744 0 : echo) ; Echo input
3745 :
3746 : ;; Set the filter.
3747 0 : (add-function :around (process-filter proc) #'comint-redirect-filter)
3748 :
3749 : ;; Send the command
3750 0 : (process-send-string (current-buffer) (concat command "\n"))
3751 :
3752 : ;; Show the output
3753 0 : (or no-display
3754 0 : (display-buffer
3755 0 : (get-buffer-create
3756 0 : (if (listp output-buffer)
3757 0 : (car output-buffer)
3758 0 : output-buffer)))))))
3759 :
3760 : ;;;###autoload
3761 : (defun comint-redirect-results-list (command regexp regexp-group)
3762 : "Send COMMAND to current process.
3763 : Return a list of expressions in the output which match REGEXP.
3764 : REGEXP-GROUP is the regular expression group in REGEXP to use."
3765 0 : (comint-redirect-results-list-from-process
3766 0 : (get-buffer-process (current-buffer))
3767 0 : command regexp regexp-group))
3768 :
3769 : ;;;###autoload
3770 : (defun comint-redirect-results-list-from-process (process command regexp regexp-group)
3771 : "Send COMMAND to PROCESS.
3772 : Return a list of expressions in the output which match REGEXP.
3773 : REGEXP-GROUP is the regular expression group in REGEXP to use."
3774 0 : (let ((output-buffer " *Comint Redirect Work Buffer*")
3775 : results)
3776 0 : (with-current-buffer (get-buffer-create output-buffer)
3777 0 : (erase-buffer)
3778 0 : (comint-redirect-send-command-to-process command
3779 0 : output-buffer process nil t)
3780 : ;; Wait for the process to complete
3781 0 : (set-buffer (process-buffer process))
3782 0 : (while (and (null comint-redirect-completed)
3783 0 : (accept-process-output process)))
3784 : ;; Collect the output
3785 0 : (set-buffer output-buffer)
3786 0 : (goto-char (point-min))
3787 : ;; Skip past the command, if it was echoed
3788 0 : (and (looking-at command)
3789 0 : (forward-line))
3790 0 : (while (and (not (eobp))
3791 0 : (re-search-forward regexp nil t))
3792 0 : (push (buffer-substring-no-properties
3793 0 : (match-beginning regexp-group)
3794 0 : (match-end regexp-group))
3795 0 : results))
3796 0 : (nreverse results))))
3797 :
3798 : ;; Converting process modes to use comint mode
3799 : ;; ===========================================================================
3800 : ;; The code in the Emacs 19 distribution has all been modified to use comint
3801 : ;; where needed. However, there are `third-party' packages out there that
3802 : ;; still use the old shell mode. Here's a guide to conversion.
3803 : ;;
3804 : ;; Renaming variables
3805 : ;; Most of the work is renaming variables and functions. These are the common
3806 : ;; ones:
3807 : ;; Local variables:
3808 : ;; last-input-start comint-last-input-start
3809 : ;; last-input-end comint-last-input-end
3810 : ;; shell-prompt-pattern comint-prompt-regexp
3811 : ;; shell-set-directory-error-hook <no equivalent>
3812 : ;; Miscellaneous:
3813 : ;; shell-set-directory <unnecessary>
3814 : ;; shell-mode-map comint-mode-map
3815 : ;; Commands:
3816 : ;; shell-send-input comint-send-input
3817 : ;; shell-send-eof comint-delchar-or-maybe-eof
3818 : ;; kill-shell-input comint-kill-input
3819 : ;; interrupt-shell-subjob comint-interrupt-subjob
3820 : ;; stop-shell-subjob comint-stop-subjob
3821 : ;; quit-shell-subjob comint-quit-subjob
3822 : ;; kill-shell-subjob comint-kill-subjob
3823 : ;; kill-output-from-shell comint-delete-output
3824 : ;; show-output-from-shell comint-show-output
3825 : ;; copy-last-shell-input Use comint-previous-input/comint-next-input
3826 : ;;
3827 : ;; SHELL-SET-DIRECTORY is gone, its functionality taken over by
3828 : ;; SHELL-DIRECTORY-TRACKER, the shell mode's comint-input-filter-functions.
3829 : ;; Comint mode does not provide functionality equivalent to
3830 : ;; shell-set-directory-error-hook; it is gone.
3831 : ;;
3832 : ;; comint-last-input-start is provided for modes which want to munge
3833 : ;; the buffer after input is sent, perhaps because the inferior
3834 : ;; insists on echoing the input. The LAST-INPUT-START variable in
3835 : ;; the old shell package was used to implement a history mechanism,
3836 : ;; but you should think twice before using comint-last-input-start
3837 : ;; for this; the input history ring often does the job better.
3838 : ;;
3839 : ;; If you are implementing some process-in-a-buffer mode, called foo-mode, do
3840 : ;; *not* create the comint-mode local variables in your foo-mode function.
3841 : ;; This is not modular. Instead, call comint-mode, and let *it* create the
3842 : ;; necessary comint-specific local variables. Then create the
3843 : ;; foo-mode-specific local variables in foo-mode. Set the buffer's keymap to
3844 : ;; be foo-mode-map, and its mode to be foo-mode. Set the comint-mode hooks
3845 : ;; (comint-{prompt-regexp, input-filter, input-filter-functions,
3846 : ;; get-old-input) that need to be different from the defaults. Call
3847 : ;; foo-mode-hook, and you're done. Don't run the comint-mode hook yourself;
3848 : ;; comint-mode will take care of it. The following example, from shell.el,
3849 : ;; is typical:
3850 : ;;
3851 : ;; (defvar shell-mode-map
3852 : ;; (let ((map (make-sparse-keymap)))
3853 : ;; (set-keymap-parent map comint-mode-map)
3854 : ;; (define-key map "\C-c\C-f" 'shell-forward-command)
3855 : ;; (define-key map "\C-c\C-b" 'shell-backward-command)
3856 : ;; (define-key map "\t" 'completion-at-point)
3857 : ;; (define-key map "\M-?"
3858 : ;; 'comint-dynamic-list-filename-completions)
3859 : ;; map))
3860 : ;;
3861 : ;; (define-derived-mode shell-mode comint-mode "Shell"
3862 : ;; "Doc."
3863 : ;; (setq comint-prompt-regexp shell-prompt-pattern)
3864 : ;; (setq-local shell-directory-stack nil)
3865 : ;; (add-hook 'comint-input-filter-functions 'shell-directory-tracker))
3866 : ;;
3867 : ;;
3868 : ;; Completion for comint-mode users
3869 : ;;
3870 : ;; For modes that use comint-mode, comint-dynamic-complete-functions is the
3871 : ;; hook to add completion functions to. Functions on this list should return
3872 : ;; the completion data according to the documentation of
3873 : ;; `completion-at-point-functions'
3874 :
3875 :
3876 : (provide 'comint)
3877 :
3878 : ;;; comint.el ends here
|