Use lexical-let to avoid false matches in var completion (Bug#7056).

* lisp/minibuffer.el (completion--some, completion--do-completion)
(minibuffer-complete-and-exit, minibuffer-completion-help)
(completion-basic-try-completion)
(completion-basic-all-completions)
(completion-pcm--find-all-completions): Use lexical-let to
avoid some false matches in variable completion (Bug#7056)

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 84162ef502df89b7c48b5c5e86372dcaba6a39e7..85d108356cc2e416b6069de332ad0174957b5eb5 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,12 @@
+2010-10-03  Chong Yidong  <cyd@stupidchicken.com>
+
+       * minibuffer.el (completion--some, completion--do-completion)
+       (minibuffer-complete-and-exit, minibuffer-completion-help)
+       (completion-basic-try-completion)
+       (completion-basic-all-completions)
+       (completion-pcm--find-all-completions): Use lexical-let to
+       avoid some false matches in variable completion (Bug#7056)
+
 2010-10-03  Olof Ohlsson Sax  <olof.ohlsson.sax@gmail.com>  (tiny change)
 
        * vc-svn.el (vc-svn-merge-news): Use --non-interactive.  (Bug#7152)

diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 9a47702042124624444a756a8bc192b505980ae3..a4ab5261f7cdd30e84ae5f9ae2f028c293ae10c3 100644 (file)
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -129,8 +129,8 @@ the closest directory separators."
   "Apply FUN to each element of XS in turn.
 Return the first non-nil returned value.
 Like CL's `some'."
-  (let ((firsterror nil)
-        res)
+  (lexical-let ((firsterror nil)
+               res)
     (while (and (not res) xs)
       (condition-case err
           (setq res (funcall fun (pop xs)))
@@ -518,15 +518,16 @@ E = after completion we now have an Exact match.
  101  5 ??? impossible
  110  6 some completion happened
  111  7 completed to an exact completion"
-  (let* ((beg (field-beginning))
-         (end (field-end))
-         (string (buffer-substring beg end))
-         (comp (funcall (or try-completion-function
-                           'completion-try-completion)
-                       string
-                       minibuffer-completion-table
-                       minibuffer-completion-predicate
-                       (- (point) beg))))
+  (lexical-let*
+      ((beg (field-beginning))
+       (end (field-end))
+       (string (buffer-substring beg end))
+       (comp (funcall (or try-completion-function
+                         'completion-try-completion)
+                     string
+                     minibuffer-completion-table
+                     minibuffer-completion-predicate
+                     (- (point) beg))))
     (cond
      ((null comp)
       (minibuffer-hide-completions)
@@ -539,14 +540,15 @@ E = after completion we now have an Exact match.
       ;; `completed' should be t if some completion was done, which doesn't
       ;; include simply changing the case of the entered string.  However,
       ;; for appearance, the string is rewritten if the case changes.
-      (let* ((comp-pos (cdr comp))
-            (completion (car comp))
-            (completed (not (eq t (compare-strings completion nil nil
-                                                   string nil nil t))))
-            (unchanged (eq t (compare-strings completion nil nil
-                                              string nil nil nil))))
+      (lexical-let*
+         ((comp-pos (cdr comp))
+          (completion (car comp))
+          (completed (not (eq t (compare-strings completion nil nil
+                                                 string nil nil t))))
+          (unchanged (eq t (compare-strings completion nil nil
+                                            string nil nil nil))))
         (if unchanged
-          (goto-char end)
+           (goto-char end)
           ;; Insert in minibuffer the chars we got.
           (completion--replace beg end completion))
        ;; Move point to its completion-mandated destination.
@@ -693,8 +695,8 @@ If `minibuffer-completion-confirm' is `confirm-after-completion',
  `minibuffer-confirm-exit-commands', and accept the input
  otherwise."
   (interactive)
-  (let ((beg (field-beginning))
-        (end (field-end)))
+  (lexical-let ((beg (field-beginning))
+               (end (field-end)))
     (cond
      ;; Allow user to specify null string
      ((= beg end) (exit-minibuffer))
@@ -1071,13 +1073,13 @@ variables.")
   "Display a list of possible completions of the current minibuffer contents."
   (interactive)
   (message "Making completion list...")
-  (let* ((start (field-beginning))
-         (string (field-string))
-         (completions (completion-all-completions
-                       string
-                       minibuffer-completion-table
-                       minibuffer-completion-predicate
-                       (- (point) (field-beginning)))))
+  (lexical-let* ((start (field-beginning))
+                (string (field-string))
+                (completions (completion-all-completions
+                              string
+                              minibuffer-completion-table
+                              minibuffer-completion-predicate
+                              (- (point) (field-beginning)))))
     (message nil)
     (if (and completions
              (or (consp (cdr completions))
@@ -1707,9 +1709,10 @@ Return the new suffix."
     suffix))
 
 (defun completion-basic-try-completion (string table pred point)
-  (let* ((beforepoint (substring string 0 point))
-         (afterpoint (substring string point))
-         (bounds (completion-boundaries beforepoint table pred afterpoint)))
+  (lexical-let*
+      ((beforepoint (substring string 0 point))
+       (afterpoint (substring string point))
+       (bounds (completion-boundaries beforepoint table pred afterpoint)))
     (if (zerop (cdr bounds))
         ;; `try-completion' may return a subtly different result
         ;; than `all+merge', so try to use it whenever possible.
@@ -1720,28 +1723,30 @@ Return the new suffix."
              (concat completion
                      (completion--merge-suffix completion point afterpoint))
              (length completion))))
-      (let* ((suffix (substring afterpoint (cdr bounds)))
-             (prefix (substring beforepoint 0 (car bounds)))
-             (pattern (delete
-                       "" (list (substring beforepoint (car bounds))
-                                'point
-                                (substring afterpoint 0 (cdr bounds)))))
-             (all (completion-pcm--all-completions prefix pattern table pred)))
+      (lexical-let*
+         ((suffix (substring afterpoint (cdr bounds)))
+          (prefix (substring beforepoint 0 (car bounds)))
+          (pattern (delete
+                    "" (list (substring beforepoint (car bounds))
+                             'point
+                             (substring afterpoint 0 (cdr bounds)))))
+          (all (completion-pcm--all-completions prefix pattern table pred)))
         (if minibuffer-completing-file-name
             (setq all (completion-pcm--filename-try-filter all)))
         (completion-pcm--merge-try pattern all prefix suffix)))))
 
 (defun completion-basic-all-completions (string table pred point)
-  (let* ((beforepoint (substring string 0 point))
-         (afterpoint (substring string point))
-         (bounds (completion-boundaries beforepoint table pred afterpoint))
-         (suffix (substring afterpoint (cdr bounds)))
-         (prefix (substring beforepoint 0 (car bounds)))
-         (pattern (delete
-                   "" (list (substring beforepoint (car bounds))
-                            'point
-                            (substring afterpoint 0 (cdr bounds)))))
-         (all (completion-pcm--all-completions prefix pattern table pred)))
+  (lexical-let*
+      ((beforepoint (substring string 0 point))
+       (afterpoint (substring string point))
+       (bounds (completion-boundaries beforepoint table pred afterpoint))
+       (suffix (substring afterpoint (cdr bounds)))
+       (prefix (substring beforepoint 0 (car bounds)))
+       (pattern (delete
+                "" (list (substring beforepoint (car bounds))
+                         'point
+                         (substring afterpoint 0 (cdr bounds)))))
+       (all (completion-pcm--all-completions prefix pattern table pred)))
     (completion-hilit-commonality all point (car bounds))))
 
 ;;; Partial-completion-mode style completion.
@@ -1896,12 +1901,13 @@ POINT is a position inside STRING.
 FILTER is a function applied to the return value, that can be used, e.g. to
 filter out additional entries (because TABLE migth not obey PRED)."
   (unless filter (setq filter 'identity))
-  (let* ((beforepoint (substring string 0 point))
-         (afterpoint (substring string point))
-         (bounds (completion-boundaries beforepoint table pred afterpoint))
-         (prefix (substring beforepoint 0 (car bounds)))
-         (suffix (substring afterpoint (cdr bounds)))
-         firsterror)
+  (lexical-let*
+      ((beforepoint (substring string 0 point))
+       (afterpoint (substring string point))
+       (bounds (completion-boundaries beforepoint table pred afterpoint))
+       (prefix (substring beforepoint 0 (car bounds)))
+       (suffix (substring afterpoint (cdr bounds)))
+       firsterror)
     (setq string (substring string (car bounds) (+ point (cdr bounds))))
     (let* ((relpoint (- point (car bounds)))
            (pattern (completion-pcm--string->pattern string relpoint))