diff --git a/src/commands/other.lisp b/src/commands/other.lisp index f3bbd0f69..d380b610d 100644 --- a/src/commands/other.lisp +++ b/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) diff --git a/src/ext/prompt-window.lisp b/src/ext/prompt-window.lisp index 59c08a45e..843644fc0 100644 --- a/src/ext/prompt-window.lisp +++ b/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) diff --git a/src/internal-packages.lisp b/src/internal-packages.lisp index b821b4e45..41c2416f7 100644 --- a/src/internal-packages.lisp +++ b/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 diff --git a/src/prompt.lisp b/src/prompt.lisp index 448733993..dd84b4068 100644 --- a/src/prompt.lisp +++ b/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))))