Re: [PATCH] (icomplete-vertical-mode): Add support for affixations and, annotations

[Stefan Monnier <monnier@iro.umontreal.ca>]

>> I also don't understand why :affixation-function is given a full list of
>> completions, when it is presumably meant to return a list of exactly the
>> same length.
>
> This has the advantage in functions like read-extended-command--affixation,
> where minibuffer-selected-window is selected only once with with-selected-window,
> then all completions are processed in the same buffer, without the need
> to switch buffers for every completion in a long list, as annotation-function
> would require to do.

Why does the function use `with-selected-window`?  I can't see why it
would need to mess with windows.  As for switching buffer, the only
reason I can see to switch buffer is for `where-is-internal`, which
could be fixed by pre-computing the set of keymaps (see patch below)
which also makes sure we use the right buffer whereas
`minibuffer-selected-window` could theoretically return another active
minibuffer than "ours".


        Stefan


diff --git a/lisp/simple.el b/lisp/simple.el
index 2a90a076315..f0eff99a358 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -2003,9 +2003,14 @@ read-extended-command
 	         "M-x "))
        (lambda (string pred action)
          (if (and suggest-key-bindings (eq action 'metadata))
-	     '(metadata
-	       (affixation-function . read-extended-command--affixation)
-	       (category . command))
+	     ;; FIXME: Actually, we know that `overriding-local-map' is nil at
+	     ;; this point.
+	     (let ((keymaps (current-active-maps overriding-local-map)))
+	       `(metadata
+	         (affixation-function
+	          . ,(lambda (arg)
+	               (read-extended-command--affixation keymaps arg)))
+	         (category . command)))
            (let ((pred
                   (if (memq action '(nil t))
                       ;; Exclude from completions obsolete commands
@@ -2093,25 +2098,24 @@ command-completion-button-p
     (and (get-text-property (point) 'button)
          (eq (get-text-property (point) 'category) category))))
 
-(defun read-extended-command--affixation (command-names)
-  (with-selected-window (or (minibuffer-selected-window) (selected-window))
-    (mapcar
-     (lambda (command-name)
-       (let* ((fun (and (stringp command-name) (intern-soft command-name)))
-              (binding (where-is-internal fun overriding-local-map t))
-              (obsolete (get fun 'byte-obsolete-info))
-              (alias (symbol-function fun))
-              (suffix (cond ((symbolp alias)
-                             (format " (%s)" alias))
-                            (obsolete
-                             (format " (%s)" (car obsolete)))
-                            ((and binding (not (stringp binding)))
-                             (format " (%s)" (key-description binding)))
-                            (t ""))))
-         (put-text-property 0 (length suffix)
-                            'face 'completions-annotations suffix)
-         (list command-name "" suffix)))
-     command-names)))
+(defun read-extended-command--affixation (keymaps command-names)
+  (mapcar
+   (lambda (command-name)
+     (let* ((fun (and (stringp command-name) (intern-soft command-name)))
+            (binding (where-is-internal fun keymaps t))
+            (obsolete (get fun 'byte-obsolete-info))
+            (alias (symbol-function fun))
+            (suffix (cond ((symbolp alias)
+                           (format " (%s)" alias))
+                          (obsolete
+                           (format " (%s)" (car obsolete)))
+                          ((and binding (not (stringp binding)))
+                           (format " (%s)" (key-description binding)))
+                          (t ""))))
+       (put-text-property 0 (length suffix)
+                          'face 'completions-annotations suffix)
+       (list command-name "" suffix)))
+   command-names))
 
 (defcustom suggest-key-bindings t
   "Non-nil means show the equivalent key-binding when M-x command has one.