;;; comint.el --- general command interpreter in a window stuff
;; Copyright (C) 1988, 1990, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
-;; 2000, 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
+;; 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
;; Author: Olin Shivers <shivers@cs.cmu.edu>
;; Simon Marshall <simon@gnu.org>
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
+;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; comint-eol-on-send boolean ...
;; comint-process-echoes boolean ...
;; comint-scroll-to-bottom-on-input symbol For scroll behavior
-;; comint-scroll-to-bottom-on-output symbol ...
+;; comint-move-point-for-output symbol ...
;; comint-scroll-show-maximum-output boolean ...
;; comint-accum-marker maker For comint-accumulate
;;
;; kinit prints a prompt like `Password for devnull@GNU.ORG: '.
;; ksu prints a prompt like `Kerberos password for devnull/root@GNU.ORG: '.
;; ssh-add prints a prompt like `Enter passphrase: '.
+;; plink prints a prompt like `Passphrase for key "root@GNU.ORG": '.
;; Some implementations of passwd use "Password (again)" as the 2nd prompt.
(defcustom comint-password-prompt-regexp
"\\(\\([Oo]ld \\|[Nn]ew \\|'s \\|login \\|\
-Kerberos \\|CVS \\|UNIX \\| SMB \\|^\\)\
+Kerberos \\|CVS \\|UNIX \\| SMB \\|LDAP \\|^\\)\
\[Pp]assword\\( (again)\\)?\\|\
-pass phrase\\|\\(Enter\\|Repeat\\|Bad\\) passphrase\\)\
+pass phrase\\|\\(Enter \\|Repeat \\|Bad \\)?[Pp]assphrase\\)\
\\(?:, try again\\)?\\(?: for [^:]+\\)?:\\s *\\'"
"*Regexp matching prompts for passwords in the inferior process.
This is used by `comint-watch-for-password-prompt'."
(define-key map "\C-c\C-c" 'comint-interrupt-subjob)
(define-key map "\C-c\C-z" 'comint-stop-subjob)
(define-key map "\C-c\C-\\" 'comint-quit-subjob)
- (define-key map "\C-c\C-m" 'comint-insert-input)
+ (define-key map "\C-c\C-m" 'comint-copy-old-input)
(define-key map "\C-c\C-o" 'comint-delete-output)
(define-key map "\C-c\C-r" 'comint-show-output)
(define-key map "\C-c\C-e" 'comint-show-maximum-output)
(define-key map "\C-c\C-l" 'comint-dynamic-list-input-ring)
(define-key map "\C-c\C-n" 'comint-next-prompt)
(define-key map "\C-c\C-p" 'comint-previous-prompt)
- (define-key map "\C-c\C-j" 'comint-restore-input)
(define-key map "\C-c\C-d" 'comint-send-eof)
(define-key map "\C-c\C-s" 'comint-write-output)
(define-key map "\C-c." 'comint-insert-previous-argument)
(define-key map [menu-bar inout kill-input]
'("Kill Current Input" . comint-kill-input))
(define-key map [menu-bar inout copy-input]
- '("Copy Old Input" . comint-insert-input))
+ '("Copy Old Input" . comint-copy-old-input))
(define-key map [menu-bar inout forward-matching-history]
'("Forward Matching Input..." . comint-forward-matching-input))
(define-key map [menu-bar inout backward-matching-history]
(make-local-variable 'comint-move-point-for-output)
(make-local-variable 'comint-scroll-show-maximum-output)
(make-local-variable 'comint-stored-incomplete-input)
+ ;; Following disabled because it seems to break the case when
+ ;; comint-scroll-show-maximum-output is nil, and no-one can remember
+ ;; what the original problem was. If there are problems with point
+ ;; not going to the end, consider re-enabling this.
+ ;; http://lists.gnu.org/archive/html/emacs-devel/2007-08/msg00827.html
+ ;;
;; This makes it really work to keep point at the bottom.
- (make-local-variable 'scroll-conservatively)
- (setq scroll-conservatively 10000)
+;;; (make-local-variable 'scroll-conservatively)
+;;; (setq scroll-conservatively 10000)
(add-hook 'pre-command-hook 'comint-preinput-scroll-to-bottom t t)
(make-local-variable 'comint-ptyp)
(make-local-variable 'comint-process-echoes)
(make-local-variable 'comint-file-name-chars)
(make-local-variable 'comint-file-name-quote-list)
- (set (make-local-variable 'comint-accum-marker) (make-marker))
+ (make-local-variable 'comint-accum-marker)
+ (setq comint-accum-marker (make-marker))
+ (make-local-variable 'font-lock-defaults)
+ (setq font-lock-defaults '(nil t))
(add-hook 'change-major-mode-hook 'font-lock-defontify nil t)
;; This behavior is not useful in comint buffers, and is annoying
(set (make-local-variable 'next-line-add-newlines) nil))
"Make a Comint process NAME in BUFFER, running PROGRAM.
If BUFFER is nil, it defaults to NAME surrounded by `*'s.
PROGRAM should be either a string denoting an executable program to create
-via `start-process', or a cons pair of the form (HOST . SERVICE) denoting a TCP
-connection to be opened via `open-network-stream'. If there is already a
-running process in that buffer, it is not restarted. Optional fourth arg
+via `start-file-process', or a cons pair of the form (HOST . SERVICE) denoting
+a TCP connection to be opened via `open-network-stream'. If there is already
+a running process in that buffer, it is not restarted. Optional fourth arg
STARTFILE is the name of a file to send the contents of to the process.
If PROGRAM is a string, any more args are arguments to PROGRAM."
- (or (fboundp 'start-process)
+ (or (fboundp 'start-file-process)
(error "Multi-processing is not supported for this system"))
(setq buffer (get-buffer-create (or buffer (concat "*" name "*"))))
;; If no process, or nuked process, crank up a new one and put buffer in
"Make a Comint process NAME in a buffer, running PROGRAM.
The name of the buffer is made by surrounding NAME with `*'s.
PROGRAM should be either a string denoting an executable program to create
-via `start-process', or a cons pair of the form (HOST . SERVICE) denoting a TCP
-connection to be opened via `open-network-stream'. If there is already a
-running process in that buffer, it is not restarted. Optional third arg
+via `start-file-process', or a cons pair of the form (HOST . SERVICE) denoting
+a TCP connection to be opened via `open-network-stream'. If there is already
+a running process in that buffer, it is not restarted. Optional third arg
STARTFILE is the name of a file to send the contents of the process to.
If PROGRAM is a string, any more args are arguments to PROGRAM."
(format "COLUMNS=%d" (window-width)))
(list "TERM=emacs"
(format "TERMCAP=emacs:co#%d:tc=unknown:" (window-width))))
- (if (getenv "EMACS") nil (list "EMACS=t"))
+ (unless (getenv "EMACS")
+ (list "EMACS=t"))
+ (list (format "INSIDE_EMACS=%s,comint" emacs-version))
process-environment))
(default-directory
(if (file-accessible-directory-p default-directory)
;; If the command has slashes, make sure we
;; first look relative to the current directory.
(cons default-directory exec-path) exec-path)))
- (setq proc (apply 'start-process name buffer command switches)))
+ (setq proc (apply 'start-file-process name buffer command switches)))
+ ;; Some file name handler cannot start a process, fe ange-ftp.
+ (unless (processp proc) (error "No process started"))
(let ((coding-systems (process-coding-system proc)))
(setq decoding (car coding-systems)
encoding (cdr coding-systems)))
- ;; If start-process decided to use some coding system for decoding
+ ;; If start-file-process decided to use some coding system for decoding
;; data sent from the process and the coding system doesn't
;; specify EOL conversion, we had better convert CRLF to LF.
(if (vectorp (coding-system-eol-type decoding))
(setq decoding (coding-system-change-eol-conversion decoding 'dos)
changed t))
- ;; Even if start-process left the coding system for encoding data
+ ;; Even if start-file-process left the coding system for encoding data
;; sent from the process undecided, we had better use the same one
;; as what we use for decoding. But, we should suppress EOL
;; conversion.
(set-process-coding-system proc decoding encoding))
proc))
-(defun comint-insert-input (&optional event)
- "In a Comint buffer, set the current input to the previous input at point."
- ;; This doesn't use "e" because it is supposed to work
- ;; for events without parameters.
- (interactive (list last-input-event))
- (let ((pos (point)))
- (if event (posn-set-point (event-end event)))
- (if (not (eq (get-char-property (point) 'field) 'input))
- ;; No input at POS, fall back to the global definition.
+(defun comint-insert-input (event)
+ "In a Comint buffer, set the current input to the previous input at point.
+If there is no previous input at point, run the command specified
+by the global keymap (usually `mouse-yank-at-point')."
+ (interactive "e")
+ (let ((pos (posn-point (event-end event)))
+ field input)
+ (with-selected-window (posn-window (event-end event))
+ (and (setq field (field-at-pos pos))
+ (setq input (field-string-no-properties pos))))
+ (if (or (null comint-accum-marker)
+ (not (eq field 'input)))
+ ;; Fall back to the global definition if (i) the selected
+ ;; buffer is not a comint buffer (which can happen if a
+ ;; non-comint window was selected and we clicked in a comint
+ ;; window), or (ii) there is no input at POS.
(let* ((keys (this-command-keys))
(last-key (and (vectorp keys) (aref keys (1- (length keys)))))
(fun (and last-key (lookup-key global-map (vector last-key)))))
- (goto-char pos)
- (and fun (call-interactively fun)))
- (setq pos (point))
- ;; There's previous input at POS, insert it at the end of the buffer.
+ (and fun (not (eq fun 'comint-insert-input))
+ (call-interactively fun)))
+ ;; Otherwise, insert the previous input.
(goto-char (point-max))
;; First delete any old unsent input at the end
(delete-region
(process-mark (get-buffer-process (current-buffer))))
(point))
;; Insert the input at point
- (insert (buffer-substring-no-properties
- (previous-single-char-property-change (1+ pos) 'field)
- (next-single-char-property-change pos 'field))))))
-
+ (insert input))))
\f
;; Input history processing in a buffer
;; ===========================================================================
;; Watch for those date stamps in history files!
(goto-char (point-max))
(let (start end history)
- (while (and (< count comint-input-ring-size)
+ (while (and (< count size)
(re-search-backward comint-input-ring-separator nil t)
(setq end (match-beginning 0)))
(if (re-search-backward comint-input-ring-separator nil t)
(defun comint-previous-input (arg)
"Cycle backwards through input history, saving input."
(interactive "*p")
- (if (and comint-input-ring-index
+ (if (and comint-input-ring-index
(or ;; leaving the "end" of the ring
(and (< arg 0) ; going down
(eq comint-input-ring-index 0))
(and (> arg 0) ; going up
- (eq comint-input-ring-index
+ (eq comint-input-ring-index
(1- (ring-length comint-input-ring)))))
comint-stored-incomplete-input)
(comint-restore-input)
(defun comint-delim-arg (arg)
"Return a list of arguments from ARG.
Break it up at the delimiters in `comint-delimiter-argument-list'.
-Returned list is backwards."
+Returned list is backwards.
+
+Characters with non-nil values of the text property `literal' are
+assumed to have literal values (e.g., backslash-escaped
+characters), and are not considered to be delimiters."
(if (null comint-delimiter-argument-list)
(list arg)
(let ((args nil)
(while (< pos len)
(let ((char (aref arg pos))
(start pos))
- (if (memq char comint-delimiter-argument-list)
+ (if (and (memq char comint-delimiter-argument-list)
+ ;; Ignore backslash-escaped characters.
+ (not (get-text-property pos 'literal arg)))
(while (and (< pos len) (eq (aref arg pos) char))
(setq pos (1+ pos)))
(while (and (< pos len)
- (not (memq (aref arg pos)
- comint-delimiter-argument-list)))
+ (not (and (memq (aref arg pos)
+ comint-delimiter-argument-list)
+ (not (get-text-property
+ pos 'literal arg)))))
(setq pos (1+ pos))))
(setq args (cons (substring arg start pos) args))))
args)))
;; The third matches '-quoted strings.
;; The fourth matches `-quoted strings.
;; This seems to fit the syntax of BASH 2.0.
- (let* ((first (if (if (fboundp 'w32-shell-dos-semantics)
- (w32-shell-dos-semantics))
- "[^ \n\t\"'`]+\\|"
- "[^ \n\t\"'`\\]+\\|\\\\[\"'`\\ \t]+\\|"))
+ (let* ((backslash-escape (not (and (fboundp 'w32-shell-dos-semantics)
+ (w32-shell-dos-semantics))))
+ (first (if backslash-escape
+ "[^ \n\t\"'`\\]\\|\\(\\\\.\\)\\|"
+ "[^ \n\t\"'`]+\\|"))
(argpart (concat first
"\\(\"\\([^\"\\]\\|\\\\.\\)*\"\\|\
'[^']*'\\|\
`[^`]*`\\)"))
+ (quote-subexpr (if backslash-escape 2 1))
(args ()) (pos 0)
(count 0)
beg str quotes)
;; Build a list of all the args until we have as many as we want.
(while (and (or (null mth) (<= count mth))
(string-match argpart string pos))
+ ;; Apply the `literal' text property to backslash-escaped
+ ;; characters, so that `comint-delim-arg' won't break them up.
+ (and backslash-escape
+ (match-beginning 1)
+ (put-text-property (match-beginning 1) (match-end 1)
+ 'literal t string))
(if (and beg (= pos (match-beginning 0)))
;; It's contiguous, part of the same arg.
(setq pos (match-end 0)
- quotes (or quotes (match-beginning 1)))
+ quotes (or quotes (match-beginning quote-subexpr)))
;; It's a new separate arg.
(if beg
;; Put the previous arg, if there was one, onto ARGS.
args (if quotes (cons str args)
(nconc (comint-delim-arg str) args))))
(setq count (length args))
- (setq quotes (match-beginning 1))
+ (setq quotes (match-beginning quote-subexpr))
(setq beg (match-beginning 0))
(setq pos (match-end 0))))
(if beg
;; Note that the input string does not include its terminal newline.
(let ((proc (get-buffer-process (current-buffer))))
(if (not proc) (error "Current buffer has no process")
+ (widen)
(let* ((pmark (process-mark proc))
(intxt (if (>= (point) (marker-position pmark))
(progn (if comint-eol-on-send (end-of-line))
(concat input "\n")))
(let ((beg (marker-position pmark))
- (end (if no-newline (point) (1- (point))))
- (inhibit-modification-hooks t))
+ (end (if no-newline (point) (1- (point))))
+ (inhibit-modification-hooks t))
(when (> end beg)
- ;; Set text-properties for the input field
- (add-text-properties
- beg end
- '(front-sticky t
- font-lock-face comint-highlight-input
- mouse-face highlight
- help-echo "mouse-2: insert after prompt as new input"))
+ (add-text-properties beg end
+ '(front-sticky t
+ font-lock-face comint-highlight-input))
(unless comint-use-prompt-regexp
;; Give old user input a field property of `input', to
;; distinguish it from both process output and unsent
;; input. The terminating newline is put into a special
;; `boundary' field to make cursor movement between input
;; and output fields smoother.
- (put-text-property beg end 'field 'input)))
+ (add-text-properties
+ beg end
+ '(mouse-face highlight
+ help-echo "mouse-2: insert after prompt as new input"
+ field input))))
(unless (or no-newline comint-use-prompt-regexp)
;; Cover the terminating newline
(add-text-properties end (1+ end)
(let ((inhibit-read-only t)
(inhibit-modification-hooks t))
(add-text-properties (overlay-start comint-last-prompt-overlay)
- (overlay-end comint-last-prompt-overlay)
- (overlay-properties comint-last-prompt-overlay)))))
+ (overlay-end comint-last-prompt-overlay)
+ (overlay-properties comint-last-prompt-overlay)))))
(defun comint-carriage-motion (start end)
"Interpret carriage control characters in the region from START to END.
(comint-bol)
(buffer-substring-no-properties (point) (line-end-position)))))
+(defun comint-copy-old-input ()
+ "Insert after prompt old input at point as new input to be edited.
+Calls `comint-get-old-input' to get old input."
+ (interactive)
+ (let ((input (funcall comint-get-old-input))
+ (process (get-buffer-process (current-buffer))))
+ (if (not process)
+ (error "Current buffer has no process")
+ (goto-char (process-mark process))
+ (insert input))))
+
(defun comint-skip-prompt ()
"Skip past the text matching regexp `comint-prompt-regexp'.
If this takes us past the end of the current line, don't skip at all."
"Default function for sending to PROC input STRING.
This just sends STRING plus a newline. To override this,
set the hook `comint-input-sender'."
- (comint-send-string proc string)
- (if comint-input-sender-no-newline
- (if (not (string-equal string ""))
- (process-send-eof))
- (comint-send-string proc "\n")))
+ (let ((send-string
+ (if comint-input-sender-no-newline
+ string
+ ;; Sending as two separate strings does not work
+ ;; on Windows, so concat the \n before sending.
+ (concat string "\n"))))
+ (comint-send-string proc send-string))
+ (if (and comint-input-sender-no-newline
+ (not (string-equal string "")))
+ (process-send-eof)))
(defun comint-line-beginning-position ()
"Return the buffer position of the beginning of the line, after any prompt.
(when (eq (get-text-property (1- pt) 'read-only) 'fence)
(remove-list-of-text-properties (1- pt) pt '(read-only)))))))
-(defun comint-kill-whole-line (&optional arg)
+(defun comint-kill-whole-line (&optional count)
"Kill current line, ignoring read-only and field properties.
-With prefix arg, kill that many lines starting from the current line.
-If arg is negative, kill backward. Also kill the preceding newline,
+With prefix arg COUNT, kill that many lines starting from the current line.
+If COUNT is negative, kill backward. Also kill the preceding newline,
instead of the trailing one. \(This is meant to make \\[repeat] work well
with negative arguments.)
-If arg is zero, kill current line but exclude the trailing newline.
+If COUNT is zero, kill current line but exclude the trailing newline.
The read-only status of newlines is updated with `comint-update-fence',
if necessary."
(interactive "p")
(let ((inhibit-read-only t) (inhibit-field-text-motion t))
- (kill-whole-line arg)
- (when (>= arg 0) (comint-update-fence))))
+ (kill-whole-line count)
+ (when (>= count 0) (comint-update-fence))))
(defun comint-kill-region (beg end &optional yank-handler)
"Like `kill-region', but ignores read-only properties, if safe.
(proc-mark (process-mark proc)))
(display-buffer proc-buf)
(set-buffer proc-buf) ; but it's not the selected *window*
- (let ((proc-win (get-buffer-window proc-buf))
+ (let ((proc-win (get-buffer-window proc-buf 0))
(proc-pt (marker-position proc-mark)))
(comint-send-string proc str) ; send the query
(accept-process-output proc) ; wait for some output
name))
(defun comint-match-partial-filename ()
- "Return the filename at point, or nil if non is found.
+ "Return the filename at point, or nil if none is found.
Environment variables are substituted. See `comint-word'."
(let ((filename (comint-word comint-file-name-chars)))
(and filename (comint-substitute-in-file-name
(defun comint-dynamic-complete-as-filename ()
"Dynamically complete at point as a filename.
See `comint-dynamic-complete-filename'. Returns t if successful."
- (let* ((completion-ignore-case (memq system-type '(ms-dos windows-nt cygwin)))
+ (let* ((completion-ignore-case read-file-name-completion-ignore-case)
(completion-ignored-extensions comint-completion-fignore)
;; If we bind this, it breaks remote directory tracking in rlogin.el.
;; I think it was originally bound to solve file completion problems,
(defun comint-dynamic-list-filename-completions ()
"List in help buffer possible completions of the filename at point."
(interactive)
- (let* ((completion-ignore-case (memq system-type '(ms-dos windows-nt cygwin)))
+ (let* ((completion-ignore-case read-file-name-completion-ignore-case)
;; If we bind this, it breaks remote directory tracking in rlogin.el.
;; I think it was originally bound to solve file completion problems,
;; but subsequent changes may have made this unnecessary. sm.
(defun comint-dynamic-list-completions (completions)
"List in help buffer sorted COMPLETIONS.
Typing SPC flushes the help buffer."
- (let ((window (get-buffer-window "*Completions*")))
+ (let ((window (get-buffer-window "*Completions*" 0)))
(setq completions (sort completions 'string-lessp))
(if (and (eq last-command this-command)
window (window-live-p window) (window-buffer window)