returns a list. Add remote file name completion.
* lisp/comint.el (comint--table-subvert): Curry and get quote&unquote
functions as arguments.
(comint--complete-file-name-data): Adjust call accordingly.
* lisp/pcomplete.el (pcomplete--table-subvert): Remove.
(pcomplete-completions-at-point): Use comint--table-subvert instead.
Fixes: debbugs:9554
2011-10-03 Stefan Monnier <monnier@iro.umontreal.ca>
+ * pcmpl-unix.el (pcomplete/scp): Don't assume pcomplete-all-entries
+ returns a list (bug#9554). Add remote file name completion.
+ * comint.el (comint--table-subvert): Curry and get quote&unquote
+ functions as arguments.
+ (comint--complete-file-name-data): Adjust call accordingly.
+ * pcomplete.el (pcomplete--table-subvert): Remove.
+ (pcomplete-completions-at-point): Use comint--table-subvert instead.
+
* minibuffer.el (completion-table-case-fold): Use currying.
(completion--styles-type, completion--cycling-threshold-type):
New constants.
(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))))
(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)))))
+ (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))
+ 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))))))
(defun comint-completion-file-name-table (string pred action)
(if (not (file-name-absolute-p string))
(table
(let ((prefixes (comint--common-quoted-suffix
unquoted filename)))
- (apply-partially
- #'comint--table-subvert
+ (comint--table-subvert
#'comint-completion-file-name-table
- (cdr prefixes) (car prefixes)))))
+ (cdr prefixes) (car prefixes)
+ #'comint-quote-filename #'comint-unquote-filename))))
(nconc
(list
filename-beg filename-end
"Completion rules for the `scp' command.
Includes files as well as host names followed by a colon."
(pcomplete-opt "1246BCpqrvcFiloPS")
- (while t (pcomplete-here (append (pcomplete-all-entries)
- (mapcar (lambda (host)
- (concat host ":"))
- (pcmpl-ssh-hosts))))))
+ (while t (pcomplete-here
+ (lambda (string pred action)
+ (let ((table
+ (cond
+ ((string-match "\\`[^:/]+:" string) ; Remote file name.
+ (if (and (eq action 'lambda)
+ (eq (match-end 0) (length string)))
+ ;; Avoid connecting to the remote host when we're
+ ;; only completing the host name.
+ (list string)
+ (comint--table-subvert (pcomplete-all-entries)
+ "" "/ssh:")))
+ ((string-match "/" string) ; Local file name.
+ (pcomplete-all-entries))
+ (t ;Host name or local file name.
+ (append (all-completions string (pcomplete-all-entries))
+ (mapcar (lambda (host) (concat host ":"))
+ (pcmpl-ssh-hosts)))))))
+ (complete-with-action action table string pred))))))
(provide 'pcmpl-unix)
;; it pretty much impossible to have completion other than
;; prefix-completion.
;;
-;; pcomplete--common-quoted-suffix and pcomplete--table-subvert try to
+;; pcomplete--common-quoted-suffix and comint--table-subvert try to
;; work around this difficulty with heuristics, but it's
;; really a hack.
(cons (substring s1 0 (- (length s1) cs))
(substring s2 0 (- (length s2) cs))))))
-(defun pcomplete--table-subvert (table s1 s2 string pred action)
- ;; FIXME: Copied in comint.el.
- "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 (pcomplete-unquote-argument
- (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 (pcomplete-quote-argument
- (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)))))
-
;; I don't think such commands are usable before first setting up buffer-local
;; variables to parse args, so there's no point autoloading it.
;; ;;;###autoload
;; pcomplete-stub and works from the buffer's text instead,
;; we need to trick minibuffer-complete, into using
;; pcomplete-stub without its knowledge. To that end, we
- ;; use pcomplete--table-subvert to construct a completion
+ ;; use comint--table-subvert to construct a completion
;; table which expects strings using a prefix from the
;; buffer's text but internally uses the corresponding
;; prefix from pcomplete-stub.
;; practice it should work just fine (fingers crossed).
(let ((prefixes (pcomplete--common-quoted-suffix
pcomplete-stub buftext)))
- (apply-partially #'pcomplete--table-subvert
- completions
- (cdr prefixes) (car prefixes))))
+ (comint--table-subvert
+ completions (cdr prefixes) (car prefixes)
+ #'pcomplete-quote-argument #'pcomplete-unquote-argument)))
(t
(lambda (string pred action)
(let ((res (complete-with-action
projects / emacs.git / commitdiff