From 915a9b6440634287d48d184bb326a0c845c31863 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 3 Oct 2011 12:49:56 -0400 Subject: [PATCH] * lisp/pcmpl-unix.el (pcomplete/scp): Don't assume pcomplete-all-entries 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 --- lisp/ChangeLog | 8 +++++ lisp/comint.el | 79 ++++++++++++++++++++++++---------------------- lisp/pcmpl-unix.el | 23 +++++++++++--- lisp/pcomplete.el | 49 +++------------------------- 4 files changed, 73 insertions(+), 86 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 2a08568e74f..3706497a291 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,13 @@ 2011-10-03 Stefan Monnier + * 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. diff --git a/lisp/comint.el b/lisp/comint.el index 59feab82e44..52580db6186 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -3040,8 +3040,9 @@ Returns t if successful." (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)))) @@ -3076,43 +3077,45 @@ SS1 = (unquote SS2)." (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)) @@ -3146,10 +3149,10 @@ in the same way as TABLE completes strings of the form (concat S2 S)." (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 diff --git a/lisp/pcmpl-unix.el b/lisp/pcmpl-unix.el index e947bfe1da6..b466c2cd899 100644 --- a/lisp/pcmpl-unix.el +++ b/lisp/pcmpl-unix.el @@ -193,10 +193,25 @@ Uses both `pcmpl-ssh-config-file' and `pcmpl-ssh-known-hosts-file'." "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) diff --git a/lisp/pcomplete.el b/lisp/pcomplete.el index 4b25c1643af..8ae1e203849 100644 --- a/lisp/pcomplete.el +++ b/lisp/pcomplete.el @@ -370,7 +370,7 @@ modified to be an empty string, or the desired separation string." ;; 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. @@ -408,45 +408,6 @@ SS1 = (unquote SS2)." (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 @@ -480,7 +441,7 @@ Same as `pcomplete' but using the standard completion UI." ;; 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. @@ -498,9 +459,9 @@ Same as `pcomplete' but using the standard completion UI." ;; 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 -- 2.39.2