[Emacs-diffs] /srv/bzr/emacs/trunk r107389: * lisp/minibuffer.el (completion-table-with-context): Fix inf-loop.

[Stefan Monnier]

------------------------------------------------------------
revno: 107389
committer: Stefan Monnier <address@hidden>
branch nick: trunk
timestamp: Wed 2012-02-22 23:38:29 -0500
message:
  * lisp/minibuffer.el (completion-table-with-context): Fix inf-loop.
  Reported by Aaron S. Hawley <address@hidden>.
modified:
  lisp/ChangeLog
  lisp/minibuffer.el

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2012-02-23 01:52:35 +0000
+++ b/lisp/ChangeLog    2012-02-23 04:38:29 +0000
@@ -1,3 +1,8 @@
+2012-02-23  Stefan Monnier  <address@hidden>
+
+       * minibuffer.el (completion-table-with-context): Fix inf-loop.
+       Reported by Aaron S. Hawley <address@hidden>.
+
 2012-02-23  Glenn Morris  <address@hidden>
 
        * emacs-lisp/authors.el (authors-aliases, authors-fixed-case)

=== modified file 'lisp/minibuffer.el'
--- a/lisp/minibuffer.el        2012-02-15 13:45:02 +0000
+++ b/lisp/minibuffer.el        2012-02-23 04:38:29 +0000
@@ -226,30 +226,31 @@
 
 (defun completion-table-with-context (prefix table string pred action)
   ;; TODO: add `suffix' maybe?
-  ;; Notice that `pred' may not be a function in some abusive cases.
-  (when (functionp pred)
-    (setq pred
-          ;; Predicates are called differently depending on the nature of
-          ;; the completion table :-(
-          (cond
-           ((vectorp table)             ;Obarray.
-            (lambda (sym) (funcall pred (concat prefix (symbol-name sym)))))
-           ((hash-table-p table)
-            (lambda (s _v) (funcall pred (concat prefix s))))
-           ((functionp table)
-            (lambda (s) (funcall pred (concat prefix s))))
-           (t                           ;Lists and alists.
-            (lambda (s)
-              (funcall pred (concat prefix (if (consp s) (car s) s))))))))
-  (if (eq (car-safe action) 'boundaries)
-      (let* ((len (length prefix))
-             (bound (completion-boundaries string table pred (cdr action))))
-        (list* 'boundaries (+ (car bound) len) (cdr bound)))
-    (let ((comp (complete-with-action action table string pred)))
-      (cond
-       ;; In case of try-completion, add the prefix.
-       ((stringp comp) (concat prefix comp))
-       (t comp)))))
+  (let ((pred
+         (if (not (functionp pred))
+             ;; Notice that `pred' may not be a function in some abusive cases.
+             pred
+           ;; Predicates are called differently depending on the nature of
+           ;; the completion table :-(
+           (cond
+            ((vectorp table)            ;Obarray.
+             (lambda (sym) (funcall pred (concat prefix (symbol-name sym)))))
+            ((hash-table-p table)
+             (lambda (s _v) (funcall pred (concat prefix s))))
+            ((functionp table)
+             (lambda (s) (funcall pred (concat prefix s))))
+            (t                          ;Lists and alists.
+             (lambda (s)
+               (funcall pred (concat prefix (if (consp s) (car s) s)))))))))
+    (if (eq (car-safe action) 'boundaries)
+        (let* ((len (length prefix))
+               (bound (completion-boundaries string table pred (cdr action))))
+          (list* 'boundaries (+ (car bound) len) (cdr bound)))
+      (let ((comp (complete-with-action action table string pred)))
+        (cond
+         ;; In case of try-completion, add the prefix.
+         ((stringp comp) (concat prefix comp))
+         (t comp))))))
 
 (defun completion-table-with-terminator (terminator table string pred action)
   "Construct a completion table like TABLE but with an extra TERMINATOR.