* lisp/comint.el: Use lexical-binding. Use std completion UI. Require CL.

(comint-dynamic-complete-functions): Use comint-filename-completion.
(comint-completion-addsuffix): Tweak custom type.
(comint-filename-completion, comint--common-suffix)
(comint--common-quoted-suffix, comint--table-subvert)
(comint--complete-file-name-data): New functions.
(comint-dynamic-complete-as-filename, comint-dynamic-complete-filename)
(comint-dynamic-list-filename-completions): Use them.
(comint-dynamic-simple-complete): Make obsolete.
* lisp/minibuffer.el (completion-in-region-mode):
Keep completion-in-region-mode--predicate global.
(completion-in-region--postch):
Assume completion-in-region-mode--predicate is not null.

lisp/ChangeLog

@@ -1,5 +1,19 @@
 2011-04-20  Stefan Monnier  <monnier@iro.umontreal.ca>
 
+	* comint.el: Use lexical-binding.  Require CL.
+	(comint-dynamic-complete-functions): Use comint-filename-completion.
+	(comint-completion-addsuffix): Tweak custom type.
+	(comint-filename-completion, comint--common-suffix)
+	(comint--common-quoted-suffix, comint--table-subvert)
+	(comint--complete-file-name-data): New functions.
+	(comint-dynamic-complete-as-filename, comint-dynamic-complete-filename)
+	(comint-dynamic-list-filename-completions): Use them.
+	(comint-dynamic-simple-complete): Make obsolete.
+	* minibuffer.el (completion-in-region-mode):
+	Keep completion-in-region-mode--predicate global.
+	(completion-in-region--postch):
+	Assume completion-in-region-mode--predicate is not null.
+
 	* progmodes/flymake.el (flymake-start-syntax-check-process):
 	Obey `dir'.  Simplify.
 

lisp/comint.el

@@ -1,4 +1,4 @@
-;;; comint.el --- general command interpreter in a window stuff
+;;; comint.el --- general command interpreter in a window stuff -*- lexical-binding: t -*-
 
 ;; Copyright (C) 1988, 1990, 1992-2011  Free Software Foundation, Inc.
 
@@ -101,6 +101,7 @@
 
 ;;; Code:
 
+(eval-when-compile (require 'cl))
 (require 'ring)
 
 ;; Buffer Local Variables:
@@ -366,7 +367,7 @@ text matching `comint-prompt-regexp', depending on the value of
 `comint-use-prompt-regexp'.")
 
 (defvar comint-dynamic-complete-functions
-  '(comint-replace-by-expanded-history comint-dynamic-complete-filename)
+  '(comint-replace-by-expanded-history comint-filename-completion)
   "List of functions called to perform completion.
 Works like `completion-at-point-functions'.
 See also `comint-dynamic-complete'.
@@ -2831,10 +2832,9 @@ its response can be seen."
 ;; comint-dynamic-list-filename-completions List completions in help buffer.
 ;; comint-replace-by-expanded-filename	Expand and complete filename at point;
 ;;					replace with expanded/completed name.
-;; comint-dynamic-simple-complete	Complete stub given candidates.
 
-;; These are not installed in the comint-mode keymap. But they are
-;; available for people who want them. Shell-mode installs them:
+;; These are not installed in the comint-mode keymap.  But they are
+;; available for people who want them.  Shell-mode installs them:
 ;; (define-key shell-mode-map "\t" 'comint-dynamic-complete)
 ;; (define-key shell-mode-map "\M-?"
 ;;             'comint-dynamic-list-filename-completions)))
@@ -2849,14 +2849,16 @@ This mirrors the optional behavior of tcsh."
   :group 'comint-completion)
 
 (defcustom comint-completion-addsuffix t
-  "If non-nil, add a `/' to completed directories, ` ' to file names.
-If a cons pair, it should be of the form (DIRSUFFIX . FILESUFFIX) where
-DIRSUFFIX and FILESUFFIX are strings added on unambiguous or exact completion.
+  "If non-nil, add ` ' to file names.
+It can either be a string FILESUFFIX or a cons (DIRSUFFIX . FILESUFFIX)
+where DIRSUFFIX is ignored and FILESUFFIX is a string added on unambiguous
+or exact completion.
 This mirrors the optional behavior of tcsh."
   :type '(choice (const :tag "None" nil)
-		 (const :tag "Add /" t)
-		 (cons :tag "Suffix pair"
-		       (string :tag "Directory suffix")
+		 (const :tag "Add SPC" t)
+                 (string :tag "File suffix")
+		 (cons :tag "Obsolete suffix pair"
+		       (string :tag "Ignored")
 		       (string :tag "File suffix")))
   :group 'comint-completion)
 
@@ -3016,73 +3018,125 @@ Returns t if successful."
   (when (comint--match-partial-filename)
     (unless (window-minibuffer-p (selected-window))
       (message "Completing file name..."))
-    (comint-dynamic-complete-as-filename)))
+    (apply #'completion-in-region (comint--complete-file-name-data))))
+
+(defun comint-filename-completion ()
+  "Return completion data for filename at point, if any."
+  (when (comint--match-partial-filename)
+    (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.
+
+(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)
+  "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 S1.
+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)
+    (if (and (not (equal ss1 qss1))
+             (setq qc (comint-quote-filename (substring ss1 0 1)))
+             (eq t (compare-strings s2 (- (length s2) cs (length qc) -1)
+                                    (- (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 (- (length s2) cs (length qc) -1)))
+      (cons (substring s1 0 (- (length s1) cs))
+            (substring s2 0 (- (length s2) cs))))))
+
+(defun comint--table-subvert (table s1 s2 string pred action)
+  "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)))))
+
+(defun comint--complete-file-name-data ()
+  "Return the completion data for file name at point."
+  (let* ((filesuffix (cond ((not comint-completion-addsuffix) "")
+			   ((stringp comint-completion-addsuffix)
+                            comint-completion-addsuffix)
+			   ((not (consp comint-completion-addsuffix)) " ")
+			   (t (cdr comint-completion-addsuffix))))
+	 (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)))
+            (apply-partially
+             #'comint--table-subvert
+             #'completion-file-name-table
+             (cdr prefixes) (car prefixes)))))
+    (list
+     filename-beg filename-end
+     (lambda (string pred action)
+       (let ((completion-ignore-case read-file-name-completion-ignore-case)
+             (completion-ignored-extensions comint-completion-fignore))
+         (if (zerop (length filesuffix))
+             (complete-with-action action table string pred)
+           ;; Add a space at the end of completion.  Use a terminator-regexp
+           ;; that never matches since the terminator cannot appear
+           ;; within the completion field anyway.
+           (completion-table-with-terminator
+            (cons filesuffix "\\`a\\`")
+            table string pred action)))))))
 
 (defun comint-dynamic-complete-as-filename ()
   "Dynamically complete at point as a filename.
 See `comint-dynamic-complete-filename'.  Returns t if successful."
-  (let* ((completion-ignore-case read-file-name-completion-ignore-case)
-	 (completion-ignored-extensions comint-completion-fignore)
-	 ;; If we bind this, it breaks remote directory tracking in rlogin.el.
-	 ;; I think it was originally bound to solve file completion problems,
-	 ;; but subsequent changes may have made this unnecessary.  sm.
-	 ;;(file-name-handler-alist nil)
-	 (minibuffer-p (window-minibuffer-p (selected-window)))
-	 (success t)
-	 (dirsuffix (cond ((not comint-completion-addsuffix) "")
-			  ((not (consp comint-completion-addsuffix)) "/")
-			  (t (car comint-completion-addsuffix))))
-	 (filesuffix (cond ((not comint-completion-addsuffix) "")
-			   ((not (consp comint-completion-addsuffix)) " ")
-			   (t (cdr comint-completion-addsuffix))))
-	 (filename (comint-match-partial-filename))
-	 (filename-beg (if filename (match-beginning 0) (point)))
-	 (filename-end (if filename (match-end 0) (point)))
-	 (filename (or filename ""))
-	 (filedir (file-name-directory filename))
-	 (filenondir (file-name-nondirectory filename))
-	 (directory (if filedir (comint-directory filedir) default-directory))
-	 (completion (file-name-completion filenondir directory)))
-    (cond ((null completion)
-	   (if minibuffer-p
-	       (minibuffer-message "No completions of %s" filename)
-	     (message "No completions of %s" filename))
-	   (setq success nil))
-	  ((eq completion t)            ; Means already completed "file".
-	   (insert filesuffix)
-	   (unless minibuffer-p
-	     (message "Sole completion")))
-	  ((string-equal completion "") ; Means completion on "directory/".
-	   (comint-dynamic-list-filename-completions))
-	  (t                            ; Completion string returned.
-	   (let ((file (concat (file-name-as-directory directory) completion)))
-	     ;; Insert completion.  Note that the completion string
-	     ;; may have a different case than what's in the prompt,
-	     ;; if read-file-name-completion-ignore-case is non-nil,
-	     (delete-region filename-beg filename-end)
-	     (if filedir (insert (comint-quote-filename filedir)))
-	     (insert (comint-quote-filename (directory-file-name completion)))
-	     (cond ((symbolp (file-name-completion completion directory))
-		    ;; We inserted a unique completion.
-		    (insert (if (file-directory-p file) dirsuffix filesuffix))
-		    (unless minibuffer-p
-		      (message "Completed")))
-		   ((and comint-completion-recexact comint-completion-addsuffix
-			 (string-equal filenondir completion)
-			 (file-exists-p file))
-		    ;; It's not unique, but user wants shortest match.
-		    (insert (if (file-directory-p file) dirsuffix filesuffix))
-		    (unless minibuffer-p
-		      (message "Completed shortest")))
-		   ((or comint-completion-autolist
-			(string-equal filenondir completion))
-		    ;; It's not unique, list possible completions.
-		    (comint-dynamic-list-filename-completions))
-		   (t
-		    (unless minibuffer-p
-		      (message "Partially completed")))))))
-    success))
-
+  (apply #'completion-in-region (comint--complete-file-name-data)))
+(make-obsolete 'comint-dynamic-complete-as-filename
+               'comint-filename-completion "24.1")
 
 (defun comint-replace-by-expanded-filename ()
   "Dynamically expand and complete the filename at point.
@@ -3155,28 +3209,20 @@ See also `comint-dynamic-complete-filename'."
 		    (unless minibuffer-p
 		      (message "Partially completed"))
 		    'partial)))))))
+(make-obsolete 'comint-dynamic-simple-complete 'completion-in-region "24.1")
 
 
 (defun comint-dynamic-list-filename-completions ()
   "Display a list of possible completions for the filename at point."
   (interactive)
-  (let* ((completion-ignore-case read-file-name-completion-ignore-case)
-	 ;; If we bind this, it breaks remote directory tracking in rlogin.el.
-	 ;; I think it was originally bound to solve file completion problems,
-	 ;; but subsequent changes may have made this unnecessary.  sm.
-	 ;;(file-name-handler-alist nil)
-	 (filename (or (comint-match-partial-filename) ""))
-	 (filedir (file-name-directory filename))
-	 (filenondir (file-name-nondirectory filename))
-	 (directory (if filedir (comint-directory filedir) default-directory))
-	 (completions (file-name-all-completions filenondir directory)))
-    (if (not completions)
-	(if (window-minibuffer-p (selected-window))
-	    (minibuffer-message "No completions of %s" filename)
-	  (message "No completions of %s" filename))
-      (comint-dynamic-list-completions
-       (mapcar 'comint-quote-filename completions)
-       (comint-quote-filename filenondir)))))
+  (let* ((data (comint--complete-file-name-data))
+         (minibuffer-completion-table (nth 2 data))
+         (minibuffer-completion-predicate nil)
+         (ol (make-overlay (nth 0 data) (nth 1 data) nil nil t)))
+    (overlay-put ol 'field 'completion)
+    (unwind-protect
+        (call-interactively 'minibuffer-completion-help)
+      (delete-overlay ol))))
 
 
 ;; This is bound locally in a *Completions* buffer to the list of
@@ -3244,7 +3290,6 @@ Typing SPC flushes the completions buffer."
 	(if (eq first ?\s)
 	    (set-window-configuration comint-dynamic-list-completions-config)
 	  (setq unread-command-events (listify-key-sequence key)))))))
-
 
 (defun comint-get-next-from-history ()
   "After fetching a line from input history, this fetches the following line.
@@ -3742,9 +3787,8 @@ REGEXP-GROUP is the regular expression group in REGEXP to use."
 ;;
 ;; For modes that use comint-mode, comint-dynamic-complete-functions is the
 ;; hook to add completion functions to.  Functions on this list should return
-;; non-nil if completion occurs (i.e., further completion should not occur).
-;; You could use comint-dynamic-simple-complete to do the bulk of the
-;; completion job.
+;; the completion data according to the documentation of
+;; `completion-at-point-functions'
 
 
 (provide 'comint)

lisp/minibuffer.el

@@ -58,6 +58,8 @@
 
 ;;; Todo:
 
+;; - Make things like icomplete-mode or lightning-completion work with
+;;   completion-in-region-mode.
 ;; - completion-insert-complete-hook (called after inserting a complete
 ;;   completion), typically used for "complete-abbrev" where it would expand
 ;;   the abbrev.  Tho we'd probably want to provide it from the
@@ -1314,8 +1316,7 @@ Point needs to be somewhere between START and END."
                     (save-excursion
                       (goto-char (nth 2 completion-in-region--data))
                       (line-end-position)))
-                (when completion-in-region-mode--predicate
-                  (funcall completion-in-region-mode--predicate))))
+		(funcall completion-in-region-mode--predicate)))
       (completion-in-region-mode -1)))
 
 ;; (defalias 'completion-in-region--prech 'completion-in-region--postch)
@@ -1330,12 +1331,12 @@ Point needs to be somewhere between START and END."
         (delq (assq 'completion-in-region-mode minor-mode-overriding-map-alist)
               minor-mode-overriding-map-alist))
   (if (null completion-in-region-mode)
-      (unless (or (equal "*Completions*" (buffer-name (window-buffer)))
-                  (null completion-in-region-mode--predicate))
+      (unless (equal "*Completions*" (buffer-name (window-buffer)))
 	(minibuffer-hide-completions))
     ;; (add-hook 'pre-command-hook #'completion-in-region--prech)
-    (set (make-local-variable 'completion-in-region-mode--predicate)
-         completion-in-region-mode-predicate)
+    (assert completion-in-region-mode-predicate)
+    (setq completion-in-region-mode--predicate
+	  completion-in-region-mode-predicate)
     (add-hook 'post-command-hook #'completion-in-region--postch)
     (push `(completion-in-region-mode . ,completion-in-region-mode-map)
           minor-mode-overriding-map-alist)))