* 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

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  <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.
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