Add key binding display to execute-command completion

src/commands/other.lisp

@@ -56,18 +56,10 @@
 
 (define-command execute-command (arg) (:universal-nil)
   "Read a command name, then read the ARG and call the command."
-  (let* ((name (prompt-for-string
+  (let* ((name (prompt-for-command
                 (if arg
                     (format nil "~D M-x " arg)
-                    "M-x ")
-                :completion-function (lambda (str)
-                                       (sort
-                                        (if (find #\- str)
-                                            (completion-hyphen str (all-command-names))
-                                            (completion str (all-command-names)))
-                                        #'string-lessp))
-                :test-function 'exist-command-p
-                :history-symbol 'mh-execute-command))
+                    "M-x ")))
          (command (find-command name)))
     (if command
         (call-command command arg)

src/ext/prompt-window.lisp

@@ -430,5 +430,39 @@
                     :start s
                     :end (line-end e)))))
 
+(defun collect-command-all-keybindings (buffer command)
+  (let ((command-name (command-name command)))
+    (flet ((find-keybindings (keymap)
+             (alexandria:when-let (keybindings (collect-command-keybindings command-name keymap))
+               (mapcar (lambda (keybinding)
+                         (format nil "~{~A~^ ~}" keybinding))
+                       keybindings))))
+      (format nil "~{~A~^, ~}"
+              (append (find-keybindings (mode-keymap (buffer-major-mode buffer)))
+                      (loop :for mode :in (buffer-minor-modes buffer)
+                            :for keymap := (mode-keymap mode)
+                            :when keymap
+                            :append (find-keybindings keymap))
+                      (find-keybindings *global-keymap*))))))
+
+(defun prompt-command-completion (string)
+  (let ((items (loop :for name :in (all-command-names)
+                     :collect (lem/completion-mode:make-completion-item
+                               :label name
+                               :detail (collect-command-all-keybindings
+                                        (current-buffer)
+                                        (find-command name))))))
+    (sort
+     (if (find #\- string)
+         (completion-hyphen string
+                            items
+                            :key #'lem/completion-mode:completion-item-label)
+         (completion string
+                     items
+                     :key #'lem/completion-mode:completion-item-label))
+     #'string-lessp
+     :key #'lem/completion-mode:completion-item-label)))
+
 (setf *prompt-file-completion-function* 'prompt-file-completion)
 (setf *prompt-buffer-completion-function* 'prompt-buffer-completion)
+(setf *prompt-command-completion-function* 'prompt-command-completion)

src/internal-packages.lisp

@@ -247,6 +247,7 @@
    :*prompt-deactivate-hook*
    :*prompt-buffer-completion-function*
    :*prompt-file-completion-function*
+   :*prompt-command-completion-function*
    :caller-of-prompt-window
    :prompt-active-p
    :active-prompt-window
@@ -258,6 +259,7 @@
    :prompt-for-buffer
    :prompt-for-file
    :prompt-for-directory
+   :prompt-for-command
    :prompt-for-encodings
    :prompt-for-library)
   ;; buffer.lisp

src/prompt.lisp

@@ -8,6 +8,7 @@
 
 (defvar *prompt-buffer-completion-function* nil)
 (defvar *prompt-file-completion-function* nil)
+(defvar *prompt-command-completion-function* 'completion-command)
 
 (defgeneric caller-of-prompt-window (prompt))
 (defgeneric prompt-active-p (prompt))
@@ -126,6 +127,20 @@
         default
         result)))
 
+(defun completion-command (str)
+  (sort
+   (if (find #\- str)
+       (completion-hyphen str (all-command-names))
+       (completion str (all-command-names)))
+   #'string-lessp))
+
+(defun prompt-for-command (prompt)
+  (prompt-for-string
+   prompt
+   :completion-function *prompt-command-completion-function*
+   :test-function 'exist-command-p
+   :history-symbol 'mh-execute-command))
+
 (defun prompt-for-library (prompt &key history-symbol)
   (macrolet ((ql-symbol-value (symbol)
                `(symbol-value (uiop:find-symbol* ,symbol :quicklisp))))