(PC-do-completion): Retain capitalization of user input, when possible, even

if completion-ignore-case is set.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 1508381ce4c7b64e716c3be698dbe14a9ee49a4a..27a6f573aaf17d36c82572998cc4b9fc4a6a88f8 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,8 @@
+2006-06-23  Michael Ernst  <mernst@alum.mit.edu>
+
+       * complete.el (PC-do-completion): Retain capitalization of user
+       input, when possible, even if completion-ignore-case is set.
+
 2006-06-23  Eli Zaretskii  <eliz@gnu.org>
 
        * generic-x.el (bat-generic-mode): Support .cmd files.

diff --git a/lisp/complete.el b/lisp/complete.el
index d0e3fbe8ddf1616a15349f7dcc60c95a87e0e0b0..df1bc2bfd8b735c2ac987614c4d4df4c7fb29b36 100644 (file)
--- a/lisp/complete.el
+++ b/lisp/complete.el
@@ -196,7 +196,7 @@ as much as possible and `*' characters are treated likewise in file names.
 For example, M-x p-c-m expands to M-x partial-completion-mode since no other
 command begins with that sequence of characters, and
 \\[find-file] f_b.c TAB might complete to foo_bar.c if that file existed and no
-other file in that directory begin with that sequence of characters.
+other file in that directory begins with that sequence of characters.
 
 Unless `PC-disable-includes' is non-nil, the `<...>' sequence is interpreted
 specially in \\[find-file].  For example,
@@ -358,13 +358,36 @@ See `PC-complete' for details."
 The function takes no arguments, and typically looks at the value
 of `minibuffer-completion-table' and the minibuffer contents.")
 
+;; Returns the sequence of non-delimiter characters that follow regexp in string.
+(defun PC-chunk-after (string regexp)
+  (if (not (string-match regexp string))
+      (let ((message (format "String %s didn't match regexp %s" string regexp)))
+       (message message)
+       (error message)))
+  (let ((result (substring string (match-end 0))))
+    ;; result may contain multiple chunks
+    (if (string-match PC-delim-regex result)
+       (setq result (substring result 0 (match-beginning 0))))
+    result))
+
+(defun test-completion-ignore-case (str table pred)
+  "Like `test-completion', but ignores case when possible."
+  ;; Binding completion-ignore-case to nil ensures, for compatibility with
+  ;; standard completion, that the return value is exactly one of the
+  ;; possibilities.  Do this binding only if pred is nil, out of paranoia;
+  ;; perhaps it is safe even if pred is non-nil.
+  (if pred
+      (test-completion str table pred)
+    (let ((completion-ignore-case nil))
+      (test-completion str table pred))))
+
 (defun PC-do-completion (&optional mode beg end)
   (or beg (setq beg (minibuffer-prompt-end)))
   (or end (setq end (point-max)))
   (let* ((table minibuffer-completion-table)
         (pred minibuffer-completion-predicate)
         (filename (funcall PC-completion-as-file-name-predicate))
-        (dirname nil)
+        (dirname nil)          ; non-nil only if a filename is being completed
         (dirlength 0)
         (str (buffer-substring beg end))
         (incname (and filename (string-match "<\\([^\"<>]*\\)>?$" str)))
@@ -379,7 +402,7 @@ of `minibuffer-completion-table' and the minibuffer contents.")
 
     ;; Check if buffer contents can already be considered complete
     (if (and (eq mode 'exit)
-            (test-completion str table pred))
+            (test-completion-ignore-case str table pred))
        'complete
 
       ;; Do substitutions in directory names
@@ -598,35 +621,38 @@ of `minibuffer-completion-table' and the minibuffer contents.")
 
            ;; Check if next few letters are the same in all cases
            (if (and (not (eq mode 'help))
-                    (setq prefix (try-completion "" (mapcar 'list poss))))
+                    (setq prefix (try-completion (PC-chunk-after basestr skip) (mapcar 'list poss))))
                (let ((first t) i)
+                 ;; Retain capitalization of user input even if
+                 ;; completion-ignore-case is set.
                  (if (eq mode 'word)
                      (setq prefix (PC-chop-word prefix basestr)))
                  (goto-char (+ beg (length dirname)))
                  (while (and (progn
-                               (setq i 0)
+                               (setq i 0) ; index into prefix string
                                (while (< i (length prefix))
                                  (if (and (< (point) end)
-                                          (eq (aref prefix i)
-                                              (following-char)))
+                                          (eq (downcase (aref prefix i))
+                                              (downcase (following-char))))
+                                     ;; same char (modulo case); no action
                                      (forward-char 1)
                                    (if (and (< (point) end)
-                                            (or (and (looking-at " ")
+                                            (and (looking-at " ")
                                                      (memq (aref prefix i)
-                                                           PC-delims-list))
-                                                (eq (downcase (aref prefix i))
-                                                    (downcase
-                                                     (following-char)))))
+                                                       PC-delims-list)))
+                                       ;; replace " " by the actual delimiter
                                        (progn
                                          (delete-char 1)
-                                         (setq end (1- end)))
+                                         (insert (substring prefix i (1+ i))))
+                                     ;; insert a new character
+                                     (progn
                                      (and filename (looking-at "\\*")
                                           (progn
                                             (delete-char 1)
                                             (setq end (1- end))))
-                                     (setq improved t))
+                                       (setq improved t)
                                    (insert (substring prefix i (1+ i)))
-                                   (setq end (1+ end)))
+                                       (setq end (1+ end)))))
                                  (setq i (1+ i)))
                                (or pt (setq pt (point)))
                                (looking-at PC-delim-regex))
@@ -634,7 +660,12 @@ of `minibuffer-completion-table' and the minibuffer contents.")
                                                 (regexp-quote prefix)
                                                 PC-ndelims-regex)
                                    prefix (try-completion
-                                           ""
+                                           (PC-chunk-after
+                                            ;; not basestr, because that does
+                                            ;; not reflect insertions
+                                            (buffer-substring
+                                             (+ beg (length dirname)) end)
+                                            skip)
                                            (mapcar
                                             (function
                                              (lambda (x)
@@ -666,7 +697,7 @@ of `minibuffer-completion-table' and the minibuffer contents.")
 
                  ;; We changed it... enough to be complete?
                  (and (eq mode 'exit)
-                      (test-completion (field-string) table pred))
+                      (test-completion-ignore-case (field-string) table pred))
 
                ;; If totally ambiguous, display a list of completions
                (if (or (eq completion-auto-help t)
@@ -950,11 +981,10 @@ absolute rather than relative to some directory on the SEARCH-PATH."
   (if (string-match "<\\([^\"<>]*\\)>?\\'" (ad-get-arg 0))
       (let* ((string (ad-get-arg 0))
              (action (ad-get-arg 2))
-             (name (match-string 1 string))
+             (name (substring string (match-beginning 1) (match-end 1)))
             (str2 (substring string (match-beginning 0)))
             (completion-table
-             (mapcar (lambda (x)
-                       (format (if (string-match "/\\'" x) "<%s" "<%s>") x))
+             (mapcar (lambda (x) (format "<%s>" x))
                      (PC-include-file-all-completions
                       name (PC-include-file-path)))))
         (setq ad-return-value