;;; 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.
;; 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
(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)
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)))))
(while (/= n 0)
(unless (re-search-backward regexp nil t dir)
(error "Not found"))
- (when (eq (get-char-property (point) 'field) 'input)
+ (unless (get-char-property (point) 'field)
(setq n (- n dir))))
(field-beginning))))
(goto-char pos))))
(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))
(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)))
+ (replace-regexp-in-string "\\\\\\(.\\)" "\\1" filename t))))
(defun comint-completion-at-point ()
(run-hook-with-args-until-success 'comint-dynamic-complete-functions))
(comint--complete-file-name-data)))
;; FIXME: comint--common-suffix, comint--common-quoted-suffix, and
-;; comint--table-subvert copied from pcomplete. And they don't fully solve
-;; the problem, since selecting a file from *Completions* won't quote it.
+;; comint--table-subvert don't fully solve the problem, since
+;; selecting a file from *Completions* won't quote it, among several
+;; other problems.
(defun comint--common-suffix (s1 s2)
(assert (not (or (string-match "\n" s1) (string-match "\n" s2))))
(- (match-end 1) (match-beginning 1))))
(defun comint--common-quoted-suffix (s1 s2)
+ ;; FIXME: Copied in pcomplete.el.
"Find the common suffix between S1 and S2 where S1 is the expanded S2.
S1 is expected to be the unquoted and expanded version of S1.
Returns (PS1 . PS2), i.e. the shortest prefixes of S1 and S2, such that
(cons (substring s1 0 (- (length s1) cs))
(substring s2 0 (- (length s2) cs))))))
-(defun comint--table-subvert (table s1 s2 string pred action)
+(defun comint--table-subvert (table s1 s2 &optional quote-fun unquote-fun)
"Completion table that replaces the prefix S1 with S2 in STRING.
-When TABLE, S1 and S2 are provided by `apply-partially', the result
-is a completion table which completes strings of the form (concat S1 S)
-in the same way as TABLE completes strings of the form (concat S2 S)."
- (let* ((str (if (eq t (compare-strings string 0 (length s1) s1 nil nil
- completion-ignore-case))
- (concat s2 (comint-unquote-filename
- (substring string (length s1))))))
- (res (if str (complete-with-action action table str pred))))
- (when res
- (cond
- ((and (eq (car-safe action) 'boundaries))
- (let ((beg (or (and (eq (car-safe res) 'boundaries) (cadr res)) 0)))
- (list* 'boundaries
- (max (length s1)
- ;; FIXME: Adjust because of quoting/unquoting.
- (+ beg (- (length s1) (length s2))))
- (and (eq (car-safe res) 'boundaries) (cddr res)))))
- ((stringp res)
- (if (eq t (compare-strings res 0 (length s2) s2 nil nil
- completion-ignore-case))
- (concat s1 (comint-quote-filename
- (substring res (length s2))))))
- ((eq action t)
- (let ((bounds (completion-boundaries str table pred "")))
- (if (>= (car bounds) (length s2))
- res
- (let ((re (concat "\\`"
- (regexp-quote (substring s2 (car bounds))))))
- (delq nil
- (mapcar (lambda (c)
- (if (string-match re c)
- (substring c (match-end 0))))
- res))))))
- ;; E.g. action=nil and it's the only completion.
- (res)))))
+The result is a completion table which completes strings of the
+form (concat S1 S) in the same way as TABLE completes strings of
+the form (concat S2 S)."
+ (lambda (string pred action)
+ (let* ((str (if (eq t (compare-strings string 0 (length s1) s1 nil nil
+ completion-ignore-case))
+ (let ((rest (substring string (length s1))))
+ (concat s2 (if unquote-fun
+ (funcall unquote-fun rest) rest)))))
+ (res (if str (complete-with-action action table str pred))))
+ (when res
+ (cond
+ ((and (eq (car-safe action) 'boundaries))
+ (let ((beg (or (and (eq (car-safe res) 'boundaries) (cadr res)) 0)))
+ (list* 'boundaries
+ (max (length s1)
+ ;; FIXME: Adjust because of quoting/unquoting.
+ (+ beg (- (length s1) (length s2))))
+ (and (eq (car-safe res) 'boundaries) (cddr res)))))
+ ((stringp res)
+ (if (eq t (compare-strings res 0 (length s2) s2 nil nil
+ completion-ignore-case))
+ (let ((rest (substring res (length s2))))
+ (concat s1 (if quote-fun (funcall quote-fun rest) rest)))))
+ ((eq action t)
+ (let ((bounds (completion-boundaries str table pred "")))
+ (if (>= (car bounds) (length s2))
+ (if quote-fun (mapcar quote-fun res) res)
+ (let ((re (concat "\\`"
+ (regexp-quote (substring s2 (car bounds))))))
+ (delq nil
+ (mapcar (lambda (c)
+ (if (string-match re c)
+ (let ((str (substring c (match-end 0))))
+ (if quote-fun
+ (funcall quote-fun str) str))))
+ res))))))
+ ;; E.g. action=nil and it's the only completion.
+ (res))))))
+
+(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)))))
(defun comint--complete-file-name-data ()
"Return the completion data for file name at point."
(table
(let ((prefixes (comint--common-quoted-suffix
unquoted filename)))
- (apply-partially
- #'comint--table-subvert
- #'completion-file-name-table
- (cdr prefixes) (car prefixes)))))
+ (comint--table-subvert
+ #'comint-completion-file-name-table
+ (cdr prefixes) (car prefixes)
+ #'comint-quote-filename #'comint-unquote-filename))))
(nconc
(list
filename-beg filename-end
: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
HCoop / bpt / emacs.git / blobdiff