[Emacs-diffs] /srv/bzr/emacs/trunk r105992: * lisp/pcmpl-unix.el (pcomplete/scp): Don't assume pcomplete-all-entries

[Stefan Monnier]

------------------------------------------------------------
revno: 105992
fixes bug(s): http://debbugs.gnu.org/cgi/bugreport.cgi?bug=9554
committer: Stefan Monnier <address@hidden>
branch nick: trunk
timestamp: Mon 2011-10-03 12:49:56 -0400
message:
  * 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.
modified:
  lisp/ChangeLog
  lisp/comint.el
  lisp/pcmpl-unix.el
  lisp/pcomplete.el

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2011-10-03 15:03:00 +0000
+++ b/lisp/ChangeLog    2011-10-03 16:49:56 +0000
@@ -1,5 +1,13 @@
 2011-10-03  Stefan Monnier  <address@hidden>
 
+       * 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.

=== modified file 'lisp/comint.el'
--- a/lisp/comint.el    2011-10-02 04:08:50 +0000
+++ b/lisp/comint.el    2011-10-03 16:49:56 +0000
@@ -3040,8 +3040,9 @@
     (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 @@
       (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 @@
          (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

=== modified file 'lisp/pcmpl-unix.el'
--- a/lisp/pcmpl-unix.el        2011-01-25 04:08:28 +0000
+++ b/lisp/pcmpl-unix.el        2011-10-03 16:49:56 +0000
@@ -193,10 +193,25 @@
   "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)
 

=== modified file 'lisp/pcomplete.el'
--- a/lisp/pcomplete.el 2011-10-03 15:03:00 +0000
+++ b/lisp/pcomplete.el 2011-10-03 16:49:56 +0000
@@ -370,7 +370,7 @@
 ;; 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 @@
       (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 @@
            ;; 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 @@
                  ;; 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