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.

1 files changed, 47 insertions, 98 deletions

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.