changeset 110842:e4f63401c6eb

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)
author Chong Yidong <cyd@stupidchicken.com>
date Sun, 03 Oct 2010 15:50:14 -0400
parents c93b5b77a985
children 96d70b5ac881 9f6864a5076e
files lisp/ChangeLog lisp/minibuffer.el
diffstat 2 files changed, 68 insertions(+), 53 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/ChangeLog	Sun Oct 03 12:43:54 2010 -0700
+++ b/lisp/ChangeLog	Sun Oct 03 15:50:14 2010 -0400
@@ -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)
--- a/lisp/minibuffer.el	Sun Oct 03 12:43:54 2010 -0700
+++ b/lisp/minibuffer.el	Sun Oct 03 15:50:14 2010 -0400
@@ -129,8 +129,8 @@
   "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 @@
  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 @@
       ;; `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 @@
  `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 @@
   "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 @@
     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 @@
              (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 @@
 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))