Remove the duplication from project-switch-commands's config

Based on an older patch by Philip K (https://debbugs.gnu.org/41890#127).

* lisp/progmodes/project.el: (project-switch-commands): Change to
'defcustom', alter the value format, add :type.
(project-switch-use-entire-map): New option.
(project--keymap-prompt, project-switch-project):
Update accordingly, while keeping compatibility with user-defined
values in the previous format (for some transition period).

Co-authored-by: Philip K. <philipk@posteo.net>

diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el
index 0ed5f1f907c1dfa44bec9ae5a8992d20a6fb0888..d4c0e46c8517dbf1342b1bb7afbabc2f2d62f1e8 100644 (file)
--- a/lisp/progmodes/project.el
+++ b/lisp/progmodes/project.el
@@ -1250,27 +1250,55 @@ It's also possible to enter an arbitrary directory not in the list."
 ;;; Project switching
 
 ;;;###autoload
-(defvar project-switch-commands
-  '((?f "Find file" project-find-file)
-    (?g "Find regexp" project-find-regexp)
-    (?d "Dired" project-dired)
-    (?v "VC-Dir" project-vc-dir)
-    (?e "Eshell" project-eshell))
-  "Alist mapping keys to project switching menu entries.
+(defcustom project-switch-commands
+  '((project-find-file "Find file")
+    (project-find-regexp "Find regexp")
+    (project-dired "Dired")
+    (project-vc-dir "VC-Dir")
+    (project-eshell "Eshell"))
+  "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 (KEY LABEL COMMAND), where COMMAND is the
-command to run when KEY is pressed.  LABEL is used to distinguish
-the menu entries in the dispatch menu.")
+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."
+  :version "28.1"
+  :package-version '(project . "0.6.0")
+  :type '(repeat
+          (list
+           (symbol :tag "Command")
+           (string :tag "Label")
+           (choice :tag "Key to press"
+            (const :tag "Infer from the keymap" nil)
+            (character :tag "Explicit key")))))
+
+(defcustom project-switch-use-entire-map nil
+  "Make `project-switch-project' use entire `project-prefix-map'.
+If nil, `project-switch-project' will only recognize commands
+listed in `project-switch-commands' and signal an error when
+others are invoked.  Otherwise, all keys in `project-prefix-map'
+are legal even if they aren't listed in the dispatch menu."
+  :type 'bool
+  :version "28.1")
 
 (defun project--keymap-prompt ()
   "Return a prompt for the project switching dispatch menu."
   (mapconcat
-   (pcase-lambda (`(,key ,label))
-     (format "[%s] %s"
-             (propertize (key-description `(,key)) 'face 'bold)
-             label))
+   (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 project-prefix-map t))))
+       (format "[%s] %s"
+               (propertize (key-description key) 'face 'bold)
+               label)))
    project-switch-commands
    "  "))
 
@@ -1283,13 +1311,31 @@ made from `project-switch-commands'.
 When called in a program, it will use the project corresponding
 to directory DIR."
   (interactive (list (project-prompt-project-dir)))
-  (let ((choice nil))
-    (while (not choice)
-      (setq choice (assq (read-event (project--keymap-prompt))
-                         project-switch-commands)))
+  (let ((commands-menu
+         (mapcar
+          (lambda (row)
+            (if (characterp (car row))
+                ;; Deprecated format.
+                ;; XXX: Add a warning about it?
+                (reverse row)
+              row))
+          project-switch-commands))
+        command)
+    (while (not command)
+      (let ((choice (read-event (project--keymap-prompt))))
+        (when (setq command
+                    (or (car
+                         (seq-find (lambda (row) (equal choice (nth 2 row)))
+                                   commands-menu))
+                        (lookup-key project-prefix-map (vector choice))))
+          (unless (or project-switch-use-entire-map
+                      (assq command commands-menu))
+            ;; TODO: Add some hint to the prompt, like "key not
+            ;; recognized" or something.
+            (setq command nil)))))
     (let ((default-directory dir)
           (project-current-inhibit-prompt t))
-      (call-interactively (nth 2 choice)))))
+      (call-interactively command))))
 
 (provide 'project)
 ;;; project.el ends here