-;;; comint.el --- general command interpreter in a window stuff
+;;; comint.el --- general command interpreter in a window stuff -*- lexical-binding: t -*-
-;; Copyright (C) 1988, 1990, 1992-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1988, 1990, 1992-2012 Free Software Foundation, Inc.
;; Author: Olin Shivers <shivers@cs.cmu.edu>
;; Simon Marshall <simon@gnu.org>
;; It is pretty easy to make new derived modes for other processes.
;; For documentation on the functionality provided by Comint mode, and
-;; the hooks available for customising it, see the comments below.
+;; the hooks available for customizing it, see the comments below.
;; For further information on the standard derived modes (shell,
;; inferior-lisp, inferior-scheme, ...), see the relevant source files.
;;; Code:
+(eval-when-compile (require 'cl))
(require 'ring)
+(require 'ansi-color)
+(require 'regexp-opt) ;For regexp-opt-charset.
\f
;; Buffer Local Variables:
;;============================================================================
" +\\)"
(regexp-opt
'("password" "Password" "passphrase" "Passphrase"
- "pass phrase" "Pass phrase"))
+ "pass phrase" "Pass phrase" "Response"))
"\\(?:\\(?:, try\\)? *again\\| (empty for no passphrase)\\| (again)\\)?\
\\(?: for [^:]+\\)?:\\s *\\'")
"Regexp matching prompts for passwords in the inferior process.
`comint-use-prompt-regexp'.")
(defvar comint-dynamic-complete-functions
- '(comint-replace-by-expanded-history comint-dynamic-complete-filename)
+ '(comint-c-a-p-replace-by-expanded-history comint-filename-completion)
"List of functions called to perform completion.
-Functions should return non-nil if completion was performed.
+Works like `completion-at-point-functions'.
See also `comint-dynamic-complete'.
This is a good thing to set in mode hooks.")
These functions get one argument, a string containing the text to send.")
;;;###autoload
-(defvar comint-output-filter-functions '(comint-postoutput-scroll-to-bottom comint-watch-for-password-prompt)
+(defvar comint-output-filter-functions '(ansi-color-process-output comint-postoutput-scroll-to-bottom comint-watch-for-password-prompt)
"Functions to call after output is inserted into the buffer.
One possible function is `comint-postoutput-scroll-to-bottom'.
These functions get one argument, a string containing the text as originally
(define-key map [menu-bar completion complete-file]
'("Complete File Name" . comint-dynamic-complete-filename))
(define-key map [menu-bar completion complete]
- '("Complete Before Point" . comint-dynamic-complete))
+ '("Complete at Point" . completion-at-point))
;; Input history:
(define-key map [menu-bar inout]
(cons "In/Out" (make-sparse-keymap "In/Out")))
(setq font-lock-defaults '(nil t))
(add-hook 'change-major-mode-hook 'font-lock-defontify nil t)
(add-hook 'isearch-mode-hook 'comint-history-isearch-setup nil t)
+ (add-hook 'completion-at-point-functions 'comint-completion-at-point nil t)
;; This behavior is not useful in comint buffers, and is annoying
(set (make-local-variable 'next-line-add-newlines) nil))
(defun make-comint-in-buffer (name buffer program &optional startfile &rest switches)
"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-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, whose contents are sent to the
-process as its initial input.
+If there is a running process in BUFFER, it is not restarted.
+
+PROGRAM should be one of the following:
+- a string, denoting an executable program to create via
+ `start-file-process'
+- a cons pair of the form (HOST . SERVICE), denoting a TCP
+ connection to be opened via `open-network-stream'
+- nil, denoting a newly-allocated pty.
+
+Optional fourth arg STARTFILE is the name of a file, whose
+contents are sent to the process as its initial input.
If PROGRAM is a string, any more args are arguments to PROGRAM.
-Returns the (possibly newly created) process buffer."
+Return the (possibly newly created) process buffer."
(or (fboundp 'start-file-process)
(error "Multi-processing is not supported for this system"))
(setq buffer (get-buffer-create (or buffer (concat "*" name "*"))))
(defun comint-exec (buffer name command startfile switches)
"Start up a process named NAME in buffer BUFFER for Comint modes.
Runs the given COMMAND with SWITCHES, and initial input from STARTFILE.
-Blasts any old process running in the buffer. Doesn't set the buffer mode.
-You can use this to cheaply run a series of processes in the same Comint
-buffer. The hook `comint-exec-hook' is run after each exec."
+
+COMMAND should be one of the following:
+- a string, denoting an executable program to create via
+ `start-file-process'
+- a cons pair of the form (HOST . SERVICE), denoting a TCP
+ connection to be opened via `open-network-stream'
+- nil, denoting a newly-allocated pty.
+
+This function blasts any old process running in the buffer, and
+does not set the buffer mode. You can use this to cheaply run a
+series of processes in the same Comint buffer. The hook
+`comint-exec-hook' is run after each exec."
(with-current-buffer buffer
(let ((proc (get-buffer-process buffer))) ; Blast any old process.
(if proc (delete-process proc)))
;; If pos is at the very end of a field, the mouse-click was
;; probably outside (to the right) of the field.
(and (< pos (field-end pos))
- (setq field (field-at-pos pos))
- (setq input (field-string-no-properties pos))))
- (if (or (null comint-accum-marker)
- (not (eq field 'input)))
+ (< (field-end pos) (point-max))
+ (progn (setq field (field-at-pos pos))
+ (setq input (field-string-no-properties pos)))))
+ (if (or (null input) (null comint-accum-marker) field)
;; 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
(t
(let* ((file comint-input-ring-file-name)
(count 0)
- (size comint-input-ring-size)
- (ring (make-ring size)))
+ ;; Some users set HISTSIZE or `comint-input-ring-size'
+ ;; to huge numbers. Don't allocate a huge ring right
+ ;; away; there might not be that much history.
+ (ring-size (min 1500 comint-input-ring-size))
+ (ring (make-ring ring-size)))
(with-temp-buffer
(insert-file-contents file)
;; Save restriction in case file is already visited...
;; Watch for those date stamps in history files!
(goto-char (point-max))
(let (start end history)
- (while (and (< count size)
+ (while (and (< count comint-input-ring-size)
(re-search-backward comint-input-ring-separator
nil t)
(setq end (match-beginning 0)))
(point-min)))
(setq history (buffer-substring start end))
(goto-char start)
- (if (and (not (string-match comint-input-history-ignore
- history))
- (or (null comint-input-ignoredups)
- (ring-empty-p ring)
- (not (string-equal (ring-ref ring 0)
- history))))
- (progn
- (ring-insert-at-beginning ring history)
- (setq count (1+ count)))))))
+ (when (and (not (string-match comint-input-history-ignore
+ history))
+ (or (null comint-input-ignoredups)
+ (ring-empty-p ring)
+ (not (string-equal (ring-ref ring 0)
+ history))))
+ (when (= count ring-size)
+ (ring-extend ring (min (- comint-input-ring-size ring-size)
+ ring-size))
+ (setq ring-size (ring-size ring)))
+ (ring-insert-at-beginning ring history)
+ (setq count (1+ count))))))
(setq comint-input-ring ring
comint-input-ring-index nil)))))
(message "No history")
(let ((history nil)
(history-buffer " *Input History*")
- (index (1- (ring-length comint-input-ring)))
(conf (current-window-configuration)))
;; We have to build up a list ourselves from the ring vector.
(dotimes (index (ring-length comint-input-ring))
(defun comint-search-arg (arg)
;; First make sure there is a ring and that we are after the process mark
(cond ((not (comint-after-pmark-p))
- (error "Not at command line"))
+ (user-error "Not at command line"))
((or (null comint-input-ring)
(ring-empty-p comint-input-ring))
- (error "Empty input ring"))
+ (user-error "Empty input ring"))
((zerop arg)
;; arg of zero resets search from beginning, and uses arg of 1
(setq comint-input-ring-index nil)
Moves relative to START, or `comint-input-ring-index'."
(if (or (not (ring-p comint-input-ring))
(ring-empty-p comint-input-ring))
- (error "No history"))
+ (user-error "No history"))
(let* ((len (ring-length comint-input-ring))
(motion (if (> arg 0) 1 -1))
(n (mod (- (or start (comint-search-start arg)) motion) len))
(let ((pos (comint-previous-matching-input-string-position regexp n)))
;; Has a match been found?
(if (null pos)
- (error "Not found")
+ (user-error "Not found")
;; If leaving the edit line, save partial input
(if (null comint-input-ring-index) ;not yet on ring
(setq comint-stored-incomplete-input
Returns t if successful."
(interactive)
+ (let ((f (comint-c-a-p-replace-by-expanded-history silent start)))
+ (if f (funcall f))))
+
+(defun comint-c-a-p-replace-by-expanded-history (&optional silent start)
+ "Expand input command history at point.
+For use on `completion-at-point-functions'."
(if (and comint-input-autoexpand
(if comint-use-prompt-regexp
;; Use comint-prompt-regexp
;; Use input fields. User input that hasn't been entered
;; yet, at the end of the buffer, has a nil `field' property.
(and (null (get-char-property (point) 'field))
- (string-match "!\\|^\\^" (field-string)))))
- ;; Looks like there might be history references in the command.
- (let ((previous-modified-tick (buffer-modified-tick)))
- (comint-replace-by-expanded-history-before-point silent start)
- (/= previous-modified-tick (buffer-modified-tick)))))
-
-
-(defun comint-replace-by-expanded-history-before-point (silent &optional start)
+ (string-match "!\\|^\\^" (field-string))))
+ (catch 'dry-run
+ (comint-replace-by-expanded-history-before-point
+ silent start 'dry-run)))
+ (lambda ()
+ ;; Looks like there might be history references in the command.
+ (let ((previous-modified-tick (buffer-modified-tick)))
+ (comint-replace-by-expanded-history-before-point silent start)
+ (/= previous-modified-tick (buffer-modified-tick))))))
+
+
+(defun comint-replace-by-expanded-history-before-point
+ (silent &optional start dry-run)
"Expand directory stack reference before point.
See `comint-replace-by-expanded-history'. Returns t if successful.
If the optional argument START is non-nil, that specifies the
start of the text to scan for history references, rather
-than the logical beginning of line."
+than the logical beginning of line.
+
+If DRY-RUN is non-nil, throw to DRY-RUN before performing any
+actual side-effect."
(save-excursion
(let ((toend (- (line-end-position) (point)))
(start (or start (comint-line-beginning-position))))
(goto-char (1+ (point))))
((looking-at "![0-9]+\\($\\|[^-]\\)")
;; We cannot know the interpreter's idea of input line numbers.
+ (if dry-run (throw dry-run 'message))
(goto-char (match-end 0))
(message "Absolute reference cannot be expanded"))
((looking-at "!-\\([0-9]+\\)\\(:?[0-9^$*-]+\\)?")
;; Just a number of args from `number' lines backward.
+ (if dry-run (throw dry-run 'history))
(let ((number (1- (string-to-number
(buffer-substring (match-beginning 1)
(match-end 1))))))
(message "Relative reference exceeds input history size"))))
((or (looking-at "!!?:?\\([0-9^$*-]+\\)") (looking-at "!!"))
;; Just a number of args from the previous input line.
+ (if dry-run (throw dry-run 'expand))
(replace-match (comint-args (comint-previous-input-string 0)
(match-beginning 1) (match-end 1))
t t)
"!\\??\\({\\(.+\\)}\\|\\(\\sw+\\)\\)\\(:?[0-9^$*-]+\\)?")
;; Most recent input starting with or containing (possibly
;; protected) string, maybe just a number of args. Phew.
+ (if dry-run (throw dry-run 'expand))
(let* ((mb1 (match-beginning 1)) (me1 (match-end 1))
(mb2 (match-beginning 2)) (me2 (match-end 2))
(exp (buffer-substring (or mb2 mb1) (or me2 me1)))
(message "History item: %d" (1+ pos)))))
((looking-at "\\^\\([^^]+\\)\\^?\\([^^]*\\)\\^?")
;; Quick substitution on the previous input line.
+ (if dry-run (throw dry-run 'expand))
(let ((old (buffer-substring (match-beginning 1) (match-end 1)))
(new (buffer-substring (match-beginning 2) (match-end 2)))
(pos nil))
(goto-char (match-beginning 0))
(if (not (search-forward old pos t))
(or silent
- (error "Not found"))
+ (user-error "Not found"))
(replace-match new t t)
(message "History item: substituted"))))
(t
- (forward-char 1)))))))
+ (forward-char 1)))))
+ nil))
(defun comint-magic-space (arg)
`(lambda (cmd)
(comint-history-isearch-pop-state cmd ,comint-input-ring-index)))
-(defun comint-history-isearch-pop-state (cmd hist-pos)
+(defun comint-history-isearch-pop-state (_cmd hist-pos)
"Restore the input history search state.
Go to the history element by the absolute history position HIST-POS."
(comint-goto-input hist-pos))
(defun comint-add-to-input-history (cmd)
"Add CMD to the input history.
Ignore duplicates if `comint-input-ignoredups' is non-nil."
- (if (and (funcall comint-input-filter cmd)
- (or (null comint-input-ignoredups)
- (not (ring-p comint-input-ring))
- (ring-empty-p comint-input-ring)
- (not (string-equal (ring-ref comint-input-ring 0)
- cmd))))
- (ring-insert comint-input-ring cmd)))
+ (when (and (funcall comint-input-filter cmd)
+ (or (null comint-input-ignoredups)
+ (not (ring-p comint-input-ring))
+ (ring-empty-p comint-input-ring)
+ (not (string-equal (ring-ref comint-input-ring 0) cmd))))
+ ;; If `comint-input-ring' is full, maybe grow it.
+ (let ((size (ring-size comint-input-ring)))
+ (and (= size (ring-length comint-input-ring))
+ (< size comint-input-ring-size)
+ (ring-extend comint-input-ring
+ (min size (- comint-input-ring-size size)))))
+ (ring-insert comint-input-ring cmd)))
(defun comint-send-input (&optional no-newline artificial)
"Send input to process.
(interactive)
;; 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")
+ (if (not proc) (user-error "Current buffer has no process")
(widen)
(let* ((pmark (process-mark proc))
(intxt (if (>= (point) (marker-position pmark))
(insert copy)
copy)))
(input (if (not (eq comint-input-autoexpand 'input))
- ;; Just whatever's already there
+ ;; Just whatever's already there.
intxt
- ;; Expand and leave it visible in buffer
+ ;; Expand and leave it visible in buffer.
(comint-replace-by-expanded-history t pmark)
(buffer-substring pmark (point))))
(history (if (not (eq comint-input-autoexpand 'history))
(add-text-properties
beg end
'(mouse-face highlight
- help-echo "mouse-2: insert after prompt as new input"
- field input))))
+ help-echo "mouse-2: insert after prompt as new input"))))
(unless (or no-newline comint-use-prompt-regexp)
;; Cover the terminating newline
(add-text-properties end (1+ end)
;; The point should float after any insertion we do.
(saved-point (copy-marker (point) t)))
- ;; We temporarly remove any buffer narrowing, in case the
+ ;; We temporarily remove any buffer narrowing, in case the
;; process mark is outside of the restriction
(save-restriction
(widen)
(select-window selected))))
nil t))))))
-(defun comint-postoutput-scroll-to-bottom (string)
+(defvar follow-mode)
+(declare-function follow-comint-scroll-to-bottom "follow" ())
+
+(defun comint-postoutput-scroll-to-bottom (_string)
"Go to the end of buffer in some or all windows showing it.
-Does not scroll if the current line is the last line in the buffer.
+Do not scroll if the current line is the last line in the buffer.
Depends on the value of `comint-move-point-for-output' and
`comint-scroll-show-maximum-output'.
This function should be in the list `comint-output-filter-functions'."
- (let* ((selected (selected-window))
- (current (current-buffer))
- (process (get-buffer-process current))
- (scroll comint-move-point-for-output))
+ (let* ((current (current-buffer))
+ (process (get-buffer-process current)))
(unwind-protect
- (if process
- (walk-windows
- (lambda (window)
- (when (eq (window-buffer window) current)
- (select-window window)
- (if (and (< (point) (process-mark process))
- (or (eq scroll t) (eq scroll 'all)
- ;; Maybe user wants point to jump to end.
- (and (eq scroll 'this) (eq selected window))
- (and (eq scroll 'others) (not (eq selected window)))
- ;; If point was at the end, keep it at end.
- (and (marker-position comint-last-output-start)
- (>= (point) comint-last-output-start))))
- (goto-char (process-mark process)))
- ;; Optionally scroll so that the text
- ;; ends at the bottom of the window.
- (if (and comint-scroll-show-maximum-output
- (= (point) (point-max)))
- (save-excursion
- (goto-char (point-max))
- (recenter (- -1 scroll-margin))))
- (select-window selected)))
- nil t))
+ (cond
+ ((null process))
+ ((bound-and-true-p follow-mode)
+ (follow-comint-scroll-to-bottom))
+ (t
+ (let ((selected (selected-window)))
+ (dolist (w (get-buffer-window-list current nil t))
+ (select-window w)
+ (unwind-protect
+ (progn
+ (comint-adjust-point selected)
+ ;; Optionally scroll to the bottom of the window.
+ (and comint-scroll-show-maximum-output
+ (eobp)
+ (recenter (- -1 scroll-margin))))
+ (select-window selected))))))
(set-buffer current))))
-(defun comint-truncate-buffer (&optional string)
+(defun comint-adjust-point (selected)
+ "Move point in the selected window based on Comint settings.
+SELECTED is the window that was originally selected."
+ (let ((process (get-buffer-process (current-buffer))))
+ (and (< (point) (process-mark process))
+ (or (memq comint-move-point-for-output '(t all))
+ ;; Maybe user wants point to jump to end.
+ (eq comint-move-point-for-output
+ (if (eq (selected-window) selected) 'this 'others))
+ ;; If point was at the end, keep it at end.
+ (and (marker-position comint-last-output-start)
+ (>= (point) comint-last-output-start)))
+ (goto-char (process-mark process)))))
+
+(defun comint-truncate-buffer (&optional _string)
"Truncate the buffer to `comint-buffer-maximum-size'.
This function could be on `comint-output-filter-functions' or bound to a key."
(interactive)
(let ((inhibit-read-only t))
(delete-region (point-min) (point)))))
-(defun comint-strip-ctrl-m (&optional string)
+(defun comint-strip-ctrl-m (&optional _string)
"Strip trailing `^M' characters from the current output group.
This function could be on `comint-output-filter-functions' or bound to a key."
(interactive)
If `comint-use-prompt-regexp' is non-nil, then return
the current line with any initial string matching the regexp
`comint-prompt-regexp' removed."
- (let ((bof (field-beginning)))
- (if (eq (get-char-property bof 'field) 'input)
+ (let (bof)
+ (if (and (not comint-use-prompt-regexp)
+ ;; Make sure we're in an input rather than output field.
+ (null (get-char-property (setq bof (field-beginning)) 'field)))
(field-string-no-properties bof)
(comint-bol)
(buffer-substring-no-properties (point) (line-end-position)))))
(let ((input (funcall comint-get-old-input))
(process (get-buffer-process (current-buffer))))
(if (not process)
- (error "Current buffer has no process")
+ (user-error "Current buffer has no process")
(goto-char (process-mark process))
(insert input))))
(goto-char (comint-line-beginning-position))))
;; For compatibility.
-(defun comint-read-noecho (prompt &optional ignore)
+(defun comint-read-noecho (prompt &optional _ignore)
(read-passwd prompt))
;; These three functions are for entering text you don't want echoed or
(save-excursion
(while (/= n 0)
(unless (re-search-backward regexp nil t dir)
- (error "Not found"))
- (when (eq (get-char-property (point) 'field) 'input)
+ (user-error "Not found"))
+ (unless (get-char-property (point) 'field)
(setq n (- n dir))))
(field-beginning))))
(goto-char pos))))
(if (> n 0)
(next-single-char-property-change pos 'field)
(previous-single-char-property-change pos 'field)))
- (cond ((or (null pos) (= pos prev-pos))
+ (cond ((= pos prev-pos)
;; Ran off the end of the buffer.
(when (> n 0)
;; There's always an input field at the end of the
(setq input-pos (point-max)))
;; stop iterating
(setq n 0))
- ((eq (get-char-property pos 'field) 'input)
+ ((null (get-char-property pos 'field))
(setq n (if (< n 0) (1+ n) (1- n)))
(setq input-pos pos))))
(when input-pos
;; First usage; initialize to a marker
(setq comint-insert-previous-argument-last-start-pos
(make-marker)))))
- ;; Make sure we're not in the prompt, and add a beginning space if necess.
+ ;; Make sure we're not in the prompt, and add a beginning space if necessary.
(if (<= (point) (comint-line-beginning-position))
(comint-bol)
(just-one-space))
;; comint-dynamic-list-filename-completions List completions in help buffer.
;; comint-replace-by-expanded-filename Expand and complete filename at point;
;; replace with expanded/completed name.
-;; comint-dynamic-simple-complete Complete stub given candidates.
-;; These are not installed in the comint-mode keymap. But they are
-;; available for people who want them. Shell-mode installs them:
+;; These are not installed in the comint-mode keymap. But they are
+;; available for people who want them. Shell-mode installs them:
;; (define-key shell-mode-map "\t" 'comint-dynamic-complete)
;; (define-key shell-mode-map "\M-?"
;; 'comint-dynamic-list-filename-completions)))
:group 'comint-completion)
(defcustom comint-completion-addsuffix t
- "If non-nil, add a `/' to completed directories, ` ' to file names.
-If a cons pair, it should be of the form (DIRSUFFIX . FILESUFFIX) where
-DIRSUFFIX and FILESUFFIX are strings added on unambiguous or exact completion.
+ "If non-nil, add ` ' to file names.
+It can either be a string FILESUFFIX or a cons (DIRSUFFIX . FILESUFFIX)
+where DIRSUFFIX is ignored and FILESUFFIX is a string added on unambiguous
+or exact completion.
This mirrors the optional behavior of tcsh."
:type '(choice (const :tag "None" nil)
- (const :tag "Add /" t)
- (cons :tag "Suffix pair"
- (string :tag "Directory suffix")
+ (const :tag "Add SPC" t)
+ (string :tag "File suffix")
+ (cons :tag "Obsolete suffix pair"
+ (string :tag "Ignored")
(string :tag "File suffix")))
:group 'comint-completion)
"Return the word of WORD-CHARS at point, or nil if none is found.
Word constituents are considered to be those in WORD-CHARS, which is like the
inside of a \"[...]\" (see `skip-chars-forward'), plus all non-ASCII characters."
+ ;; FIXME: Need to handle "..." and '...' quoting in shell.el!
+ ;; This should be combined with completion parsing somehow.
(save-excursion
(let ((here (point))
giveup)
(while (not giveup)
(let ((startpoint (point)))
(skip-chars-backward (concat "\\\\" word-chars))
- ;; Fixme: This isn't consistent with Bash, at least -- not
- ;; all non-ASCII chars should be word constituents.
- (if (and (> (- (point) 2) (point-min))
- (= (char-after (- (point) 2)) ?\\))
+ (if (and comint-file-name-quote-list
+ (eq (char-before (1- (point))) ?\\))
(forward-char -2))
- (if (and (> (- (point) 1) (point-min))
- (>= (char-after (- (point) 1)) 128))
+ ;; FIXME: This isn't consistent with Bash, at least -- not
+ ;; all non-ASCII chars should be word constituents.
+ (if (and (not (bobp)) (>= (char-before) 128))
(forward-char -1))
(if (= (point) startpoint)
(setq giveup t))))
(defun comint-substitute-in-file-name (filename)
"Return FILENAME with environment variables substituted.
Supports additional environment variable syntax of the command
-interpreter (e.g., the percent notation of cmd.exe on NT)."
+interpreter (e.g., the percent notation of cmd.exe on Windows)."
(let ((name (substitute-in-file-name filename)))
(if (memq system-type '(ms-dos windows-nt))
(let (env-var-name
(setq name (replace-match env-var-val t t name))))))
name))
+(defun comint--match-partial-filename ()
+ "Return the filename at point as-is, or nil if none is found.
+See `comint-word'."
+ (comint-word comint-file-name-chars))
+
+(defun comint--unquote&requote-argument (qstr &optional upos)
+ (unless upos (setq upos 0))
+ (let* ((qpos 0)
+ (ustrs '())
+ (re (concat
+ "\\$\\(?:\\([[:alpha:]][[:alnum:]]*\\)"
+ "\\|{\\(?1:[^{}]+\\)}\\)"
+ (when (memq system-type '(ms-dos windows-nt))
+ "\\|%\\(?1:[^\\\\/]*\\)%")
+ (when comint-file-name-quote-list
+ "\\|\\\\\\(.\\)")))
+ (qupos nil)
+ (push (lambda (str end)
+ (push str ustrs)
+ (setq upos (- upos (length str)))
+ (unless (or qupos (> upos 0))
+ (setq qupos (if (< end 0) (- end) (+ upos end))))))
+ match)
+ (while (setq match (string-match re qstr qpos))
+ (funcall push (substring qstr qpos match) match)
+ (cond
+ ((match-beginning 2) (funcall push (match-string 2 qstr) (match-end 0)))
+ ((match-beginning 1) (funcall push (getenv (match-string 1 qstr))
+ (- (match-end 0))))
+ (t (error "Unexpected case in comint--unquote&requote-argument!")))
+ (setq qpos (match-end 0)))
+ (funcall push (substring qstr qpos) (length qstr))
+ (list (mapconcat #'identity (nreverse ustrs) "")
+ qupos #'comint-quote-filename)))
+
+(defun comint--unquote-argument (str)
+ (car (comint--unquote&requote-argument str)))
+(define-obsolete-function-alias 'comint--unquote&expand-filename
+ #'comint--unquote-argument "24.2")
+
(defun comint-match-partial-filename ()
- "Return the filename at point, or nil if none is found.
+ "Return the unquoted&expanded 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
- (comint-unquote-filename filename)))))
-
+ (let ((filename (comint--match-partial-filename)))
+ (and filename (comint--unquote-argument filename))))
(defun comint-quote-filename (filename)
"Return FILENAME with magic characters quoted.
Magic characters are those in `comint-file-name-quote-list'."
(if (null comint-file-name-quote-list)
filename
- (let ((regexp
- (format "[%s]"
- (mapconcat 'char-to-string comint-file-name-quote-list ""))))
+ (let ((regexp (regexp-opt-charset comint-file-name-quote-list)))
(save-match-data
(let ((i 0))
(while (string-match regexp filename i)
(if (null comint-file-name-quote-list)
filename
(save-match-data
- (let ((i 0))
- (while (string-match "\\\\\\(.\\)" filename i)
- (setq filename (replace-match "\\1" nil nil filename))
- (setq i (+ 1 (match-beginning 0)))))
- filename)))
-
-
-(defun comint-dynamic-complete ()
- "Dynamically perform completion at point.
-Calls the functions in `comint-dynamic-complete-functions' to perform
-completion until a function returns non-nil, at which point completion is
-assumed to have occurred."
- (interactive)
+ (replace-regexp-in-string "\\\\\\(.\\)" "\\1" filename t))))
+(make-obsolete 'comint-unquote-filename nil "24.2")
+
+(defun comint--requote-argument (upos qstr)
+ ;; See `completion-table-with-quoting'.
+ (let ((res (comint--unquote&requote-argument qstr upos)))
+ (cons (nth 1 res) (nth 2 res))))
+
+(defun comint-completion-at-point ()
(run-hook-with-args-until-success 'comint-dynamic-complete-functions))
+(define-obsolete-function-alias
+ 'comint-dynamic-complete
+ 'completion-at-point "24.1")
(defun comint-dynamic-complete-filename ()
"Dynamically complete the filename at point.
-Completes if after a filename. See `comint-match-partial-filename' and
-`comint-dynamic-complete-as-filename'.
+Completes if after a filename.
This function is similar to `comint-replace-by-expanded-filename', except that
it won't change parts of the filename already entered in the buffer; it just
adds completion characters to the end of the filename. A completions listing
Returns t if successful."
(interactive)
- (when (comint-match-partial-filename)
+ (when (comint--match-partial-filename)
(unless (window-minibuffer-p (selected-window))
(message "Completing file name..."))
- (comint-dynamic-complete-as-filename)))
+ (let ((data (comint--complete-file-name-data)))
+ (completion-in-region (nth 0 data) (nth 1 data) (nth 2 data)))))
+
+(defun comint-filename-completion ()
+ "Return completion data for filename at point, if any."
+ (when (comint--match-partial-filename)
+ (comint--complete-file-name-data)))
+
+(defun comint-completion-file-name-table (string pred action)
+ (if (not (file-name-absolute-p string))
+ (completion-file-name-table string pred action)
+ (cond
+ ((memq action '(t lambda))
+ (completion-file-name-table
+ (concat comint-file-name-prefix string) pred action))
+ ((null action)
+ (let ((res (completion-file-name-table
+ (concat comint-file-name-prefix string) pred action)))
+ (if (and (stringp res)
+ (string-match
+ (concat "\\`" (regexp-quote comint-file-name-prefix))
+ res))
+ (substring res (match-end 0))
+ res)))
+ (t (completion-file-name-table string pred action)))))
+
+(defvar comint-unquote-function #'comint--unquote-argument
+ "Function to use for completion of quoted data.
+See `completion-table-with-quoting' and `comint-requote-function'.")
+(defvar comint-requote-function #'comint--requote-argument
+ "Function to use for completion of quoted data.
+See `completion-table-with-quoting' and `comint-unquote-function'.")
+
+(defun comint--complete-file-name-data ()
+ "Return the completion data for file name at point."
+ (let* ((filesuffix (cond ((not comint-completion-addsuffix) "")
+ ((stringp comint-completion-addsuffix)
+ comint-completion-addsuffix)
+ ((not (consp comint-completion-addsuffix)) " ")
+ (t (cdr comint-completion-addsuffix))))
+ (filename (comint--match-partial-filename))
+ (filename-beg (if filename (match-beginning 0) (point)))
+ (filename-end (if filename (match-end 0) (point)))
+ (table
+ (completion-table-with-quoting
+ #'comint-completion-file-name-table
+ comint-unquote-function
+ comint-requote-function)))
+ (nconc
+ (list
+ filename-beg filename-end
+ (lambda (string pred action)
+ (let ((completion-ignore-case read-file-name-completion-ignore-case)
+ (completion-ignored-extensions comint-completion-fignore))
+ (complete-with-action action table string pred))))
+ (unless (zerop (length filesuffix))
+ (list :exit-function
+ (lambda (_s finished)
+ (when (memq finished '(sole finished))
+ (if (looking-at (regexp-quote filesuffix))
+ (goto-char (match-end 0))
+ (insert filesuffix)))))))))
(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 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,
- ;; but subsequent changes may have made this unnecessary. sm.
- ;;(file-name-handler-alist nil)
- (minibuffer-p (window-minibuffer-p (selected-window)))
- (success t)
- (dirsuffix (cond ((not comint-completion-addsuffix)
- "")
- ((not (consp comint-completion-addsuffix))
- "/")
- (t
- (car comint-completion-addsuffix))))
- (filesuffix (cond ((not comint-completion-addsuffix)
- "")
- ((not (consp comint-completion-addsuffix))
- " ")
- (t
- (cdr comint-completion-addsuffix))))
- (filename (comint-match-partial-filename))
- (filename-beg (if filename (match-beginning 0) (point)))
- (filename-end (if filename (match-end 0) (point)))
- (filename (or filename ""))
- (filedir (file-name-directory filename))
- (filenondir (file-name-nondirectory filename))
- (directory (if filedir (comint-directory filedir) default-directory))
- (completion (file-name-completion filenondir directory)))
- (cond ((null completion)
- (if minibuffer-p
- (minibuffer-message "No completions of %s" filename)
- (message "No completions of %s" filename))
- (setq success nil))
- ((eq completion t) ; Means already completed "file".
- (insert filesuffix)
- (unless minibuffer-p
- (message "Sole completion")))
- ((string-equal completion "") ; Means completion on "directory/".
- (comint-dynamic-list-filename-completions))
- (t ; Completion string returned.
- (let ((file (concat (file-name-as-directory directory) completion)))
- ;; Insert completion. Note that the completion string
- ;; may have a different case than what's in the prompt,
- ;; if read-file-name-completion-ignore-case is non-nil,
- (delete-region filename-beg filename-end)
- (if filedir (insert (comint-quote-filename filedir)))
- (insert (comint-quote-filename (directory-file-name completion)))
- (cond ((symbolp (file-name-completion completion directory))
- ;; We inserted a unique completion.
- (insert (if (file-directory-p file) dirsuffix filesuffix))
- (unless minibuffer-p
- (message "Completed")))
- ((and comint-completion-recexact comint-completion-addsuffix
- (string-equal filenondir completion)
- (file-exists-p file))
- ;; It's not unique, but user wants shortest match.
- (insert (if (file-directory-p file) dirsuffix filesuffix))
- (unless minibuffer-p
- (message "Completed shortest")))
- ((or comint-completion-autolist
- (string-equal filenondir completion))
- ;; It's not unique, list possible completions.
- (comint-dynamic-list-filename-completions))
- (t
- (unless minibuffer-p
- (message "Partially completed")))))))
- success))
-
+ (let ((data (comint--complete-file-name-data)))
+ (completion-in-region (nth 0 data) (nth 1 data) (nth 2 data))))
+(make-obsolete 'comint-dynamic-complete-as-filename
+ 'comint-filename-completion "24.1")
(defun comint-replace-by-expanded-filename ()
"Dynamically expand and complete the filename at point.
(unless minibuffer-p
(message "Partially completed"))
'partial)))))))
+(make-obsolete 'comint-dynamic-simple-complete 'completion-in-region "24.1")
(defun comint-dynamic-list-filename-completions ()
"Display a list of possible completions for the filename at point."
(interactive)
- (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.
- ;;(file-name-handler-alist nil)
- (filename (or (comint-match-partial-filename) ""))
- (filedir (file-name-directory filename))
- (filenondir (file-name-nondirectory filename))
- (directory (if filedir (comint-directory filedir) default-directory))
- (completions (file-name-all-completions filenondir directory)))
- (if (not completions)
- (if (window-minibuffer-p (selected-window))
- (minibuffer-message "No completions of %s" filename)
- (message "No completions of %s" filename))
- (comint-dynamic-list-completions
- (mapcar 'comint-quote-filename completions)
- (comint-quote-filename filenondir)))))
+ (let* ((data (comint--complete-file-name-data))
+ (minibuffer-completion-table (nth 2 data))
+ (minibuffer-completion-predicate nil)
+ (ol (make-overlay (nth 0 data) (nth 1 data) nil nil t)))
+ (overlay-put ol 'field 'completion)
+ (unwind-protect
+ (call-interactively 'minibuffer-completion-help)
+ (delete-overlay ol))))
;; This is bound locally in a *Completions* buffer to the list of
(if (eq first ?\s)
(set-window-configuration comint-dynamic-list-completions-config)
(setq unread-command-events (listify-key-sequence key)))))))
-
\f
(defun comint-get-next-from-history ()
"After fetching a line from input history, this fetches the following line.
from input that has not yet been sent."
(interactive)
(let ((proc (or (get-buffer-process (current-buffer))
- (error "Current buffer has no process"))))
+ (user-error "Current buffer has no process"))))
(goto-char (process-mark proc))
(when (called-interactively-p 'interactive)
(message "Point is now at the process mark"))))
"Set the process mark at point."
(interactive)
(let ((proc (or (get-buffer-process (current-buffer))
- (error "Current buffer has no process"))))
+ (user-error "Current buffer has no process"))))
(set-marker (process-mark proc) (point))
(message "Process mark set")))
:group 'comint
:type 'boolean)
-;; Directly analagous to comint-preoutput-filter-functions
+;; Directly analogous to comint-preoutput-filter-functions
(defvar comint-redirect-filter-functions nil
"List of functions to call before inserting redirected process output.
Each function gets one argument, a string containing the text received
(match-end regexp-group))
results))
results)))
-
-(dolist (x '("^Not at command line$"
- "^Empty input ring$"
- "^No history$"
- "^Not found$" ; Too common?
- "^Current buffer has no process$"))
- (add-to-list 'debug-ignored-errors x))
-
\f
;; Converting process modes to use comint mode
;; ===========================================================================
;;
;; For modes that use comint-mode, comint-dynamic-complete-functions is the
;; hook to add completion functions to. Functions on this list should return
-;; non-nil if completion occurs (i.e., further completion should not occur).
-;; You could use comint-dynamic-simple-complete to do the bulk of the
-;; completion job.
+;; the completion data according to the documentation of
+;; `completion-at-point-functions'
\f
(provide 'comint)
HCoop / bpt / emacs.git / blobdiff