;;; 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)
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
projects / emacs.git / commitdiff