From: Eshel Yaron <me@eshelyaron.com>
Date: Tue, 18 Feb 2025 08:39:59 +0000 (+0100)
Subject: Simplify project-switch-project/commands
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=3263ec9373aa3c13d62e733ae01321c97efd20f0;p=emacs.git

Simplify project-switch-project/commands
---

diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el
index da6785d92b0..c2a2cab94ca 100644
--- a/lisp/progmodes/project.el
+++ b/lisp/progmodes/project.el
@@ -2073,142 +2073,34 @@ Return the number of forgotten projects."
 ;;; Project switching
 
 (defcustom project-switch-commands
-  '((project-find-file "Find file")
-    (project-find-regexp "Find regexp")
-    (project-find-dir "Find directory")
-    (project-vc-dir "VC-Dir")
-    (project-eshell "Eshell")
-    (project-any-command "Other"))
-  "Alist mapping commands to descriptions.
-Used by `project-switch-project' to construct a dispatch menu of
-commands available upon \"switching\" to another project.
-
-Each element is of the form (COMMAND LABEL &optional KEY) where
-COMMAND is the command to run when KEY is pressed.  LABEL is used
-to distinguish the menu entries in the dispatch menu.  If KEY is
-absent, COMMAND must be bound in `project-prefix-map', and the
-key is looked up in that map.
-
-The value can also be a symbol, the name of the command to be
-invoked immediately without any dispatch menu."
-  :version "28.1"
-  :group 'project
-  :package-version '(project . "0.6.0")
-  :type '(choice
-          (repeat :tag "Commands menu"
-           (list
-            (symbol :tag "Command")
-            (string :tag "Label")
-            (choice :tag "Key to press"
-                    (const :tag "Infer from the keymap" nil)
-                    (character :tag "Explicit key"))))
-          (const :tag "Use both short keys and global bindings"
-                 project-prefix-or-any-command)
-          (symbol :tag "Custom command")))
-
-(defcustom project-switch-use-entire-map nil
-  "Whether `project-switch-project' will use the entire `project-prefix-map'.
-If nil, `project-switch-project' will only recognize commands
-listed in `project-switch-commands', and will signal an error
-when other commands are invoked.  If this is non-nil, all the
-keys in `project-prefix-map' are valid even if they aren't
-listed in the dispatch menu produced from `project-switch-commands'."
-  :type 'boolean
-  :group 'project
-  :version "28.1")
-
-(defcustom project-key-prompt-style (if (facep 'help-key-binding)
-                                        t
-                                      'brackets)
-  "Which presentation to use when asking to choose a command by key.
-
-When `brackets', use text brackets and `bold' for the character.
-Otherwise, use the face `help-key-binding' in the prompt."
-  :type '(choice (const :tag "Using help-key-binding face" t)
-                 (const :tag "Using bold face and brackets" brackets))
-  :group 'project
-  :version "30.1")
-
-(defun project--keymap-prompt ()
-  "Return a prompt for the project switching using the prefix map."
-  (let (keys)
-    (map-keymap
-     (lambda (evt _)
-       (when (characterp evt) (push evt keys)))
-     project-prefix-map)
-    (mapconcat (lambda (key) (help-key-description (string key) nil)) keys " ")))
-
-(defun project--menu-prompt ()
-  "Return a prompt for the project switching dispatch menu."
-  (mapconcat
-   (pcase-lambda (`(,cmd ,label ,key))
-     (when (characterp cmd) ; Old format, apparently user-customized.
-       (let ((tmp cmd))
-         ;; TODO: Add a deprecation warning, probably.
-         (setq cmd key
-               key tmp)))
-     (let ((key (if key
-                    (vector key)
-                  (where-is-internal cmd (list project-prefix-map) t))))
-       (if (not (eq project-key-prompt-style 'brackets))
-           (format "%s %s"
-                   (propertize (key-description key) 'face 'help-key-binding)
-                   label)
-         (format "[%s] %s"
-                 (propertize (key-description key) 'face 'bold)
-                 label))))
-   project-switch-commands
-   "  "))
+  '((?D "Dired" nil project-dired)
+    (?f "file" nil project-find-file)
+    (?g "Regexp" nil project-find-regexp)
+    (?o "other" nil project-any-command)
+    (?s "shell" nil project-shell)
+    (?v "vc-dir" nil project-vc-dir)
+    (?x "M-x" nil project-execute-extended-command))
+  "Selection of commands for `project-switch-project'.
+
+This is a list of elements (KEY DESC LONG CMD), which says to make CMD
+available for selection by pressing KEY.  DESC is a short description of
+CMD, and LONG is an optional longer description to display when the user
+asks for help."
+  :type '(repeat (list (character :tag "key")
+                       (string :tag "description")
+                       (choice :tag "long description" string (const nil))
+                       (function :tag "command"))))
 
 (defun project--switch-project-command (&optional dir)
-  (let* ((commands-menu
-          (mapcar
-           (lambda (row)
-             (if (characterp (car row))
-                 ;; Deprecated format.
-                 ;; XXX: Add a warning about it?
-                 (reverse row)
-               row))
-           project-switch-commands))
-         (commands-map
-          (let ((temp-map (make-sparse-keymap)))
-            (set-keymap-parent temp-map project-prefix-map)
-            (dolist (row commands-menu temp-map)
-              (when-let ((cmd (nth 0 row))
-                         (keychar (nth 2 row)))
-                (define-key temp-map (vector keychar) cmd)))))
-         command
-         choice)
-    (while (not command)
-      (let* ((overriding-local-map commands-map)
-             (prompt (if project-switch-use-entire-map
-                         (project--keymap-prompt)
-                       (project--menu-prompt))))
-        (when choice
-          (setq prompt (concat prompt
-                               (format " %s: %s"
-                                       (propertize "Unrecognized input"
-                                                   'face 'warning)
-                                       (help-key-description choice nil)))))
-        (setq choice (read-key-sequence (concat
-                                         (if dir
-                                             (format-message "Command in `%s': "
-                                                             (propertize
-                                                              dir 'face
-                                                              'font-lock-string-face))
-                                           "Command: ")
-                                         prompt)))
-        (when (setq command (lookup-key commands-map choice))
-          (when (numberp command) (setq command nil))
-          (unless (or project-switch-use-entire-map
-                      (assq command commands-menu))
-            (setq command nil)))
-        (let ((global-command (lookup-key (current-global-map) choice)))
-          (when (memq global-command
-                      '(keyboard-quit keyboard-escape-quit))
-            (call-interactively global-command)))))
-    (message nil)
-    command))
+  (cadddr
+   (read-multiple-choice
+    (if dir
+        (format-message "Command in `%s': "
+                        (propertize
+                         dir 'face
+                         'font-lock-string-face))
+      "Command: ")
+    project-switch-commands)))
 
 ;;;###autoload
 (defun project-switch-project (dir)
@@ -2220,9 +2112,7 @@ When called in a program, it will use the project corresponding
 to directory DIR."
   (interactive (list (funcall project-prompter)))
   (project--remember-dir dir)
-  (let ((command (if (symbolp project-switch-commands)
-                     project-switch-commands
-                   (project--switch-project-command dir)))
+  (let ((command (project--switch-project-command dir))
         (buffer (current-buffer)))
     (unwind-protect
         (progn