Use completion-table-with-quoting for comint and pcomplete.

* lisp/comint.el (comint--unquote&requote-argument)
(comint--unquote-argument, comint--requote-argument): New functions.
(comint--unquote&expand-filename, comint-unquote-filename): Obsolete.
(comint-quote-filename): Use regexp-opt-charset.
(comint--common-suffix, comint--common-quoted-suffix)
(comint--table-subvert): Remove.
(comint-unquote-function, comint-requote-function): New vars.
(comint--complete-file-name-data): Use them with
completion-table-with-quoting.
* lisp/pcmpl-unix.el (pcomplete/scp): Use completion-table-subvert.
* lisp/pcomplete.el (pcomplete-arg-quote-list)
(pcomplete-quote-arg-hook, pcomplete-quote-argument): Obsolete.
(pcomplete-unquote-argument-function): Default to non-nil.
(pcomplete-unquote-argument): Simplify.
(pcomplete--common-quoted-suffix): Remove.
(pcomplete-requote-argument-function): New var.
(pcomplete--common-suffix): New function.
(pcomplete-completions-at-point): Use completion-table-with-quoting
and completion-table-subvert.

4 files changed, 133 insertions, 197 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 8a21f5966c7..dc56bf3c1e2 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,26 @@
 2012-04-25  Stefan Monnier  <monnier@iro.umontreal.ca>
 
+        Use completion-table-with-quoting for comint and pcomplete.
+        * comint.el (comint--unquote&requote-argument)
+        (comint--unquote-argument, comint--requote-argument): New functions.
+        (comint--unquote&expand-filename, comint-unquote-filename): Obsolete.
+        (comint-quote-filename): Use regexp-opt-charset.
+        (comint--common-suffix, comint--common-quoted-suffix)
+        (comint--table-subvert): Remove.
+        (comint-unquote-function, comint-requote-function): New vars.
+        (comint--complete-file-name-data): Use them with
+        completion-table-with-quoting.
+        * pcmpl-unix.el (pcomplete/scp): Use completion-table-subvert.
+        * pcomplete.el (pcomplete-arg-quote-list)
+        (pcomplete-quote-arg-hook, pcomplete-quote-argument): Obsolete.
+        (pcomplete-unquote-argument-function): Default to non-nil.
+        (pcomplete-unquote-argument): Simplify.
+        (pcomplete--common-quoted-suffix): Remove.
+        (pcomplete-requote-argument-function): New var.
+        (pcomplete--common-suffix): New function.
+        (pcomplete-completions-at-point): Use completion-table-with-quoting
+        and completion-table-subvert.
+
         * minibuffer.el: Use completion-table-with-quoting for read-file-name.
         (minibuffer--double-dollars): Preserve properties.
         (completion--sifn-requote): New function.
diff --git a/lisp/comint.el b/lisp/comint.el
index 10981675971..2f8d7bd850c 100644
--- a/lisp/comint.el
+++ b/lisp/comint.el
@@ -104,6 +104,7 @@
 (eval-when-compile (require 'cl))
 (require 'ring)
 (require 'ansi-color)
+(require 'regexp-opt)                   ;For regexp-opt-charset.
 
 ;; Buffer Local Variables:
 ;;============================================================================
@@ -3000,26 +3001,62 @@ interpreter (e.g., the percent notation of cmd.exe on Windows)."
 See `comint-word'."
   (comint-word comint-file-name-chars))
 
-(defun comint--unquote&expand-filename (filename)
-  ;; FIXME: The code below does unquote-then-expand which means that "\\$HOME"
-  ;; gets expanded to the same as "$HOME"
-  (comint-substitute-in-file-name
-   (comint-unquote-filename filename)))
+(defun comint--unquote&requote-argument (qstr &optional upos)
+  (unless upos (setq upos 0))
+  (let* ((qpos 0)
+         (dquotes nil)
+         (ustrs '())
+         (re (concat
+              "[\"']\\|\\\\\\(.\\)"
+              "\\|\\$\\(?:\\([[:alpha:]][[:alnum:]]*\\)"
+              "\\|{\\(?2:[^{}]+\\)}\\)"
+              (when (memq system-type '(ms-dos windows-nt))
+                "\\|%\\(?2:[^\\\\/]*\\)%")))
+         (qupos nil)
+         (push (lambda (str end)
+                 (push str ustrs)
+                 (setq upos (- upos (length str)))
+                 (unless (or qupos (> upos 0))
+                   (setq qupos (if (< end 0) (- end) (+ upos end))))))
+         match)
+    (while (setq match (string-match re qstr qpos))
+      (funcall push (substring qstr qpos match) match)
+      (cond
+       ((match-beginning 1) (funcall push (match-string 1 qstr) (match-end 0)))
+       ((match-beginning 2) (funcall push (getenv (match-string 2 qstr))
+                                     (- (match-end 0))))
+       ((eq (aref qstr match) ?\") (setq dquotes (not dquotes)))
+       ((eq (aref qstr match) ?\')
+        (cond
+         (dquotes (funcall push "'" (match-end 0)))
+         ((< match (1+ (length qstr)))
+          (let ((end (string-match "'" qstr (1+ match))))
+            (funcall push (substring qstr (1+ match) end)
+                     (or end (length qstr)))))
+         (t nil)))
+       (t (error "Unexpected case in comint--unquote&requote-argument!")))
+      (setq qpos (match-end 0)))
+    (funcall push (substring qstr qpos) (length qstr))
+    (list (mapconcat #'identity (nreverse ustrs) "")
+          qupos #'comint-quote-filename)))
+
+(defun comint--unquote-argument (str)
+  (car (comint--unquote&requote-argument str)))
+(define-obsolete-function-alias 'comint--unquote&expand-filename
+  #'comint--unquote-argument "24.2")
 
 (defun comint-match-partial-filename ()
   "Return the unquoted&expanded filename at point, or nil if none is found.
 Environment variables are substituted.  See `comint-word'."
   (let ((filename (comint--match-partial-filename)))
-    (and filename (comint--unquote&expand-filename filename))))
+    (and filename (comint--unquote-argument filename))))
 
 (defun comint-quote-filename (filename)
   "Return FILENAME with magic characters quoted.
 Magic characters are those in `comint-file-name-quote-list'."
   (if (null comint-file-name-quote-list)
       filename
-    (let ((regexp
-           (format "[%s]"
-                   (mapconcat 'char-to-string comint-file-name-quote-list ""))))
+    (let ((regexp (regexp-opt-charset comint-file-name-quote-list)))
       (save-match-data
         (let ((i 0))
           (while (string-match regexp filename i)
@@ -3033,6 +3070,12 @@ Magic characters are those in `comint-file-name-quote-list'."
       filename
     (save-match-data
       (replace-regexp-in-string "\\\\\\(.\\)" "\\1" filename t))))
+(make-obsolete 'comint-unquote-filename nil "24.2")
+
+(defun comint--requote-argument (upos qstr)
+  ;; See `completion-table-with-quoting'.
+  (let ((res (comint--unquote&requote-argument qstr upos)))
+    (cons (nth 1 res) (nth 2 res))))
 
 (defun comint-completion-at-point ()
   (run-hook-with-args-until-success 'comint-dynamic-complete-functions))
@@ -3066,87 +3109,6 @@ Returns t if successful."
   (when (comint--match-partial-filename)
     (comint--complete-file-name-data)))
 
-;; FIXME: comint--common-suffix, comint--common-quoted-suffix, and
-;; 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))))
-  ;; Since S2 is expected to be the "unquoted/expanded" version of S1,
-  ;; there shouldn't be any case difference, even if the completion is
-  ;; case-insensitive.
-  (let ((case-fold-search nil))
-    (string-match ".*?\\(.*\\)\n.*\\1\\'" (concat s1 "\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 S2.
-Returns (PS1 . PS2), i.e. the shortest prefixes of S1 and S2, such that
-S1 = (concat PS1 SS1) and S2 = (concat PS2 SS2) and
-SS1 = (unquote SS2)."
-  (let* ((cs (comint--common-suffix s1 s2))
-         (ss1 (substring s1 (- (length s1) cs)))
-         (qss1 (comint-quote-filename ss1))
-         qc s2b)
-    (if (and (not (equal ss1 qss1))
-             (setq qc (comint-quote-filename (substring ss1 0 1)))
-             (setq s2b (- (length s2) cs (length qc) -1))
-             (>= s2b 0)                 ;bug#11158.
-             (eq t (compare-strings s2 s2b (- (length s2) cs -1)
-                                    qc nil nil)))
-        ;; The difference found is just that one char is quoted in S2
-        ;; but not in S1, keep looking before this difference.
-        (comint--common-quoted-suffix
-         (substring s1 0 (- (length s1) cs))
-         (substring s2 0 s2b))
-      (cons (substring s1 0 (- (length s1) cs))
-            (substring s2 0 (- (length s2) cs))))))
-
-(defun comint--table-subvert (table s1 s2 &optional quote-fun unquote-fun)
-  "Completion table that replaces the prefix S1 with S2 in STRING.
-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)
@@ -3165,6 +3127,13 @@ the form (concat S2 S)."
           res)))
      (t (completion-file-name-table string pred action)))))
 
+(defvar comint-unquote-function #'comint--unquote-argument
+  "Function to use for completion of quoted data.
+See `completion-table-with-quoting' and `comint-requote-function'.")
+(defvar comint-requote-function #'comint--requote-argument
+  "Function to use for completion of quoted data.
+See `completion-table-with-quoting' and `comint-requote-function'.")
+
 (defun comint--complete-file-name-data ()
   "Return the completion data for file name at point."
   (let* ((filesuffix (cond ((not comint-completion-addsuffix) "")
@@ -3175,14 +3144,11 @@ the form (concat S2 S)."
          (filename (comint--match-partial-filename))
          (filename-beg (if filename (match-beginning 0) (point)))
          (filename-end (if filename (match-end 0) (point)))
-         (unquoted (if filename (comint--unquote&expand-filename filename) ""))
          (table
-          (let ((prefixes (comint--common-quoted-suffix
-                           unquoted filename)))
-            (comint--table-subvert
-             #'comint-completion-file-name-table
-             (cdr prefixes) (car prefixes)
-             #'comint-quote-filename #'comint-unquote-filename))))
+          (completion-table-with-quoting
+           #'comint-completion-file-name-table
+           comint-unquote-function
+           comint-requote-function)))
     (nconc
      (list
       filename-beg filename-end
diff --git a/lisp/pcmpl-unix.el b/lisp/pcmpl-unix.el
index 3af22c82dfb..ae4bd270b09 100644
--- a/lisp/pcmpl-unix.el
+++ b/lisp/pcmpl-unix.el
@@ -205,8 +205,8 @@ Includes files as well as host names followed by a colon."
                            ;; Avoid connecting to the remote host when we're
                            ;; only completing the host name.
                            (list string)
-                         (comint--table-subvert (pcomplete-all-entries)
-                                                "" "/ssh:")))
+                         (completion-table-subvert (pcomplete-all-entries)
+                                                   "" "/ssh:")))
                       ((string-match "/" string) ; Local file name.
                        (pcomplete-all-entries))
                       (t                ;Host name or local file name.
diff --git a/lisp/pcomplete.el b/lisp/pcomplete.el
index cad2ffb2a2c..c9961a67f3d 100644
--- a/lisp/pcomplete.el
+++ b/lisp/pcomplete.el
@@ -165,22 +165,8 @@ A non-nil value is useful if `pcomplete-autolist' is non-nil too."
   :type 'boolean
   :group 'pcomplete)
 
-(defcustom pcomplete-arg-quote-list nil
-  "List of characters to quote when completing an argument."
-  :type '(choice (repeat character)
-                 (const :tag "Don't quote" nil))
-  :group 'pcomplete)
-
-(defcustom pcomplete-quote-arg-hook nil
-  "A hook which is run to quote a character within a filename.
-Each function is passed both the filename to be quoted, and the index
-to be considered.  If the function wishes to provide an alternate
-quoted form, it need only return the replacement string.  If no
-function provides a replacement, quoting shall proceed as normal,
-using a backslash to quote any character which is a member of
-`pcomplete-arg-quote-list'."
-  :type 'hook
-  :group 'pcomplete)
+(define-obsolete-variable-alias
+  'pcomplete-arg-quote-list 'comint-file-name-quote-list "24.2")
 
 (defcustom pcomplete-man-function 'man
   "A function to that will be called to display a manual page.
@@ -370,48 +356,28 @@ 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 comint--table-subvert try to
-;; work around this difficulty with heuristics, but it's
-;; really a hack.
-
-(defvar pcomplete-unquote-argument-function nil)
-
-(defun pcomplete-unquote-argument (s)
-  (cond
-   (pcomplete-unquote-argument-function
-    (funcall pcomplete-unquote-argument-function s))
-   ((null pcomplete-arg-quote-list) s)
-   (t
-    (replace-regexp-in-string "\\\\\\(.\\)" "\\1" s t))))
-
-(defun pcomplete--common-quoted-suffix (s1 s2)
-  ;; FIXME: Copied in comint.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 S2.
-Returns (PS1 . PS2), i.e. the shortest prefixes of S1 and S2, such that
-S1 = (concat PS1 SS1) and S2 = (concat PS2 SS2) and
-SS1 = (unquote SS2)."
-  (let* ((cs (comint--common-suffix s1 s2))
-         (ss1 (substring s1 (- (length s1) cs)))
-         (qss1 (pcomplete-quote-argument ss1))
-         qc s2b)
-    (if (and (not (equal ss1 qss1))
-             (setq qc (pcomplete-quote-argument (substring ss1 0 1)))
-             (setq s2b (- (length s2) cs (length qc) -1))
-             (>= s2b 0)                 ;bug#11158.
-             (eq t (compare-strings s2 s2b (- (length s2) cs -1)
-                                    qc nil nil)))
-        ;; The difference found is just that one char is quoted in S2
-        ;; but not in S1, keep looking before this difference.
-        (pcomplete--common-quoted-suffix
-         (substring s1 0 (- (length s1) cs))
-         (substring s2 0 s2b))
-      (cons (substring s1 0 (- (length s1) cs))
-            (substring s2 0 (- (length s2) cs))))))
-
-;; 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--common-suffix and completion-table-subvert try to work around
+;; this difficulty with heuristics, but it's really a hack.
+
+(defvar pcomplete-unquote-argument-function #'comint--unquote-argument)
+
+(defsubst pcomplete-unquote-argument (s)
+  (funcall pcomplete-unquote-argument-function s))
+
+(defvar pcomplete-requote-argument-function #'comint--requote-argument)
+
+(defun pcomplete--common-suffix (s1 s2)
+  ;; Since S2 is expected to be the "unquoted/expanded" version of S1,
+  ;; there shouldn't be any case difference, even if the completion is
+  ;; case-insensitive.
+  (let ((case-fold-search nil))
+    (string-match
+     ;; \x3FFF7F is just an arbitrary char among the ones Emacs accepts
+     ;; that hopefully will never appear in normal text.
+     "\\(?:.\\|\n\\)*?\\(\\(?:.\\|\n\\)*\\)\x3FFF7F\\(?:.\\|\n\\)*\\1\\'"
+     (concat s1 "\x3FFF7F" s2))
+    (- (match-end 1) (match-beginning 1))))
+
 (defun pcomplete-completions-at-point ()
   "Provide standard completion using pcomplete's completion tables.
 Same as `pcomplete' but using the standard completion UI."
@@ -442,34 +408,31 @@ 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 comint--table-subvert to construct a completion
+           ;; use completion-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.
            (beg (max (- (point) (length pcomplete-stub))
                      (pcomplete-begin)))
-           (buftext (buffer-substring beg (point))))
+           (buftext (pcomplete-unquote-argument
+                     (buffer-substring beg (point)))))
       (when completions
         (let ((table
-               (cond
-                ((not (equal pcomplete-stub buftext))
-                 ;; This isn't always strictly right (e.g. if
-                 ;; FOO="toto/$FOO", then completion of /$FOO/bar may
-                 ;; result in something incorrect), but given the lack of
-                 ;; any other info, it's about as good as it gets, and in
-                 ;; practice it should work just fine (fingers crossed).
-                 (let ((prefixes (pcomplete--common-quoted-suffix
+               (completion-table-with-quoting
+                (if (equal pcomplete-stub buftext)
+                    completions
+                  ;; This may not always be strictly right, but given the lack
+                  ;; of any other info, it's about as good as it gets, and in
+                  ;; practice it should work just fine (fingers crossed).
+                  (let ((suf-len (pcomplete--common-suffix
                                   pcomplete-stub buftext)))
-                   (comint--table-subvert
-                    completions (cdr prefixes) (car prefixes)
-                    #'pcomplete-quote-argument #'pcomplete-unquote-argument)))
-                (t
-                 (lambda (string pred action)
-                   (let ((res (complete-with-action
-                               action completions string pred)))
-                     (if (stringp res)
-                         (pcomplete-quote-argument res)
-                       res))))))
+                    (completion-table-subvert
+                     completions
+                     (substring buftext 0 (- (length buftext) suf-len))
+                     (substring pcomplete-stub 0
+                                (- (length pcomplete-stub) suf-len)))))
+                pcomplete-unquote-argument-function
+                pcomplete-requote-argument-function))
               (pred
                ;; Pare it down, if applicable.
                (when (and pcomplete-use-paring pcomplete-seen)
@@ -828,22 +791,8 @@ this is `comint-dynamic-complete-functions'."
               (throw 'pcompleted t)
             pcomplete-args))))))
 
-(defun pcomplete-quote-argument (filename)
-  "Return FILENAME with magic characters quoted.
-Magic characters are those in `pcomplete-arg-quote-list'."
-  (if (null pcomplete-arg-quote-list)
-      filename
-    (let ((index 0))
-      (mapconcat (lambda (c)
-                   (prog1
-                       (or (run-hook-with-args-until-success
-                            'pcomplete-quote-arg-hook filename index)
-                           (when (memq c pcomplete-arg-quote-list)
-                             (string ?\\ c))
-                           (char-to-string c))
-                     (setq index (1+ index))))
-                 filename
-                 ""))))
+(define-obsolete-function-alias
+  'pcomplete-quote-argument #'comint-quote-filename "24.2")
 
 ;; file-system completion lists
 
@@ -1179,14 +1128,14 @@ Returns non-nil if a space was appended at the end."
     (if (not pcomplete-ignore-case)
         (insert-and-inherit (if raw-p
                                 (substring entry (length stub))
-                              (pcomplete-quote-argument
+                              (comint-quote-filename
                                (substring entry (length stub)))))
       ;; the stub is not quoted at this time, so to determine the
       ;; length of what should be in the buffer, we must quote it
       ;; FIXME: Here we presume that quoting `stub' gives us the exact
       ;; text in the buffer before point, which is not guaranteed;
       ;; e.g. it is not the case in eshell when completing ${FOO}tm[TAB].
-      (delete-char (- (length (pcomplete-quote-argument stub))))
+      (delete-char (- (length (comint-quote-filename stub))))
       ;; if there is already a backslash present to handle the first
       ;; character, don't bother quoting it
       (when (eq (char-before) ?\\)
@@ -1194,7 +1143,7 @@ Returns non-nil if a space was appended at the end."
         (setq entry (substring entry 1)))
       (insert-and-inherit (if raw-p
                               entry
-                            (pcomplete-quote-argument entry))))
+                            (comint-quote-filename entry))))
     (let (space-added)
       (when (and (not (memq (char-before) pcomplete-suffix-list))
                  addsuffix)
@@ -1204,7 +1153,7 @@ Returns non-nil if a space was appended at the end."
             pcomplete-last-completion-stub stub)
       space-added)))
 
-;; selection of completions
+;; Selection of completions.
 
 (defun pcomplete-do-complete (stub completions)
   "Dynamically complete at point using STUB and COMPLETIONS.