(completion-pcm--merge-completions): Make sure the

string we return is all made up of text from the completions rather
than part from the completions and part from the input (bug#4219).

2 files changed, 32 insertions, 11 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index fef454a6fa..5c1112793e 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,9 @@
 2009-10-14  Stefan Monnier  <[email protected]>
 
+	* minibuffer.el (completion-pcm--merge-completions): Make sure the
+	string we return is all made up of text from the completions rather
+	than part from the completions and part from the input (bug#4219).
+
 	* ido.el (ido-everywhere): Use define-minor-mode.
 
 	* buff-menu.el (list-buffers, ctl-x-map):
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 48a3ac0113..e332b5df20 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -1661,6 +1661,15 @@ filter out additional entries (because TABLE migth not obey PRED)."
 
 (defun completion-pcm--merge-completions (strs pattern)
   "Extract the commonality in STRS, with the help of PATTERN."
+  ;; When completing while ignoring case, we want to try and avoid
+  ;; completing "fo" to "foO" when completing against "FOO" (bug#4219).
+  ;; So we try and make sure that the string we return is all made up
+  ;; of text from the completions rather than part from the
+  ;; completions and part from the input.
+  ;; FIXME: This reduces the problems of inconsistent capitalization
+  ;; but it doesn't fully fix it: we may still end up completing
+  ;; "fo-ba" to "foo-BAR" or "FOO-bar" when completing against
+  ;; '("foo-barr" "FOO-BARD").
   (cond
    ((null (cdr strs)) (list (car strs)))
    (t
@@ -1674,28 +1683,35 @@ filter out additional entries (because TABLE migth not obey PRED)."
           (unless (string-match re str)
             (error "Internal error: %s doesn't match %s" str re))
           (let ((chopped ())
-                (i 1))
-            (while (match-beginning i)
-              (push (match-string i str) chopped)
+                (last 0)
+                (i 1)
+                next)
+            (while (setq next (match-end i))
+              (push (substring str last next) chopped)
+              (setq last next)
               (setq i (1+ i)))
             ;; Add the text corresponding to the implicit trailing `any'.
-            (push (substring str (match-end 0)) chopped)
+            (push (substring str last) chopped)
             (push (nreverse chopped) ccs))))
 
       ;; Then for each of those non-constant elements, extract the
       ;; commonality between them.
-      (let ((res ()))
-        ;; Make the implicit `any' explicit.  We could make it explicit
-        ;; everywhere, but it would slow down regexp-matching a little bit.
+      (let ((res ())
+            (fixed ""))
+        ;; Make the implicit trailing `any' explicit.
         (dolist (elem (append pattern '(any)))
           (if (stringp elem)
-              (push elem res)
+              (setq fixed (concat fixed elem))
             (let ((comps ()))
               (dolist (cc (prog1 ccs (setq ccs nil)))
                 (push (car cc) comps)
                 (push (cdr cc) ccs))
-              (let* ((prefix (try-completion "" comps))
-                     (unique (or (and (eq prefix t) (setq prefix ""))
+              ;; Might improve the likelihood to avoid choosing
+              ;; different capitalizations in different parts.
+              ;; In practice, it doesn't seem to make any difference.
+              (setq ccs (nreverse ccs))
+              (let* ((prefix (try-completion fixed comps))
+                     (unique (or (and (eq prefix t) (setq prefix fixed))
                                  (eq t (try-completion prefix comps)))))
                 (unless (equal prefix "") (push prefix res))
                 ;; If there's only one completion, `elem' is not useful
@@ -1704,7 +1720,8 @@ filter out additional entries (because TABLE migth not obey PRED)."
                 ;; `any' into a `star' because the surrounding context has
                 ;; changed such that string->pattern wouldn't add an `any'
                 ;; here any more.
-                (unless unique (push elem res))))))
+                (unless unique (push elem res))
+                (setq fixed "")))))
         ;; We return it in reverse order.
         res)))))