diff --git a/lisp/simple.el b/lisp/simple.el index 05a3c4b93d6..ff665111a5d 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -2752,6 +2752,9 @@ oclosure-interactive-form (let ((if (cconv--interactive-helper--if f))) `(interactive ,(if (functionp if) `(funcall ',if) if)))) +(defvar next-default-directory nil + "Default directory for the next command.") + (defun command-execute (cmd &optional record-flag keys special) ;; BEWARE: Called directly from the C code. "Execute CMD as an editor command. @@ -2803,7 +2806,11 @@ command-execute (execute-kbd-macro final prefixarg)) (t ;; Pass `cmd' rather than `final', for the backtrace's sake. - (prog1 (call-interactively cmd record-flag keys) + (prog1 (if next-default-directory + (let ((default-directory next-default-directory)) + (prog1 (call-interactively cmd record-flag keys) + (setq next-default-directory nil))) + (call-interactively cmd record-flag keys)) (when-let ((info (and (symbolp cmd) (not (get cmd 'command-execute-obsolete-warned)) diff --git a/lisp/window.el b/lisp/window.el index b9b032c33e9..006531ab017 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -9122,7 +9114,8 @@ display-buffer-override-next-command (> (minibuffer-depth) minibuffer-depth) ;; But don't remove immediately after ;; adding the hook by the same command below. - (eq this-command command)) + (eq this-command command) + (eq this-command 'project-switch-project)) (funcall exitfun)))) ;; Call post-function after the next command finishes (bug#49057). (add-hook 'post-command-hook postfun) diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index 7aaf7a9f9fb..f87bb750e23 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -193,9 +193,10 @@ project-find-functions 'project-current-directory-override "29.1") -(defvar project-current-directory-override nil - "Value to use instead of `default-directory' when detecting the project. -When it is non-nil, `project-current' will always skip prompting too.") +(define-obsolete-variable-alias + 'project-current-directory-override + 'next-default-directory + "30.1") (defcustom project-prompter #'project-prompt-project-dir "Function to call to prompt for a project. @@ -227,12 +228,11 @@ project-current See the doc string of `project-find-functions' for the general form of the project instance object." - (unless directory (setq directory (or project-current-directory-override - default-directory))) + (unless directory (setq directory default-directory)) (let ((pr (project--find-in-directory directory))) (cond (pr) - ((unless project-current-directory-override + ((unless next-default-directory maybe-prompt) (setq directory (funcall project-prompter) pr (project--find-in-directory directory)))) @@ -846,8 +846,8 @@ project-prefix-map ;;;###autoload (define-key ctl-x-map "p" project-prefix-map) -;; We can't have these place-specific maps inherit from -;; project-prefix-map because project--other-place-command needs to +;; Maybe we can have these place-specific maps inherit from +;; project-prefix-map because set-transient-map maybe needs to ;; know which map the key binding came from, as if it came from one of ;; these maps, we don't want to set display-buffer-overriding-action @@ -863,16 +863,6 @@ project-other-frame-map map) "Keymap for project commands that display buffers in other frames.") -(defun project--other-place-command (action &optional map) - (let* ((key (read-key-sequence-vector nil t)) - (place-cmd (lookup-key map key)) - (generic-cmd (lookup-key project-prefix-map key)) - (switch-to-buffer-obey-display-actions t) - (display-buffer-overriding-action (unless place-cmd action))) - (if-let ((cmd (or place-cmd generic-cmd))) - (call-interactively cmd) - (user-error "%s is undefined" (key-description key))))) - ;;;###autoload (defun project-other-window-command () "Run project command, displaying resultant buffer in another window. @@ -882,9 +872,10 @@ project-other-window-command \\{project-prefix-map} \\{project-other-window-map}" (interactive) - (project--other-place-command '((display-buffer-pop-up-window) - (inhibit-same-window . t)) - project-other-window-map)) + (let ((inhibit-message t)) (other-window-prefix)) + (message "Display next project command buffer in a new window...") + (set-transient-map (make-composed-keymap project-prefix-map + project-other-window-map))) ;;;###autoload (define-key ctl-x-4-map "p" #'project-other-window-command) @@ -897,8 +888,10 @@ project-other-frame-command \\{project-prefix-map} \\{project-other-frame-map}" (interactive) - (project--other-place-command '((display-buffer-pop-up-frame)) - project-other-frame-map)) + (let ((inhibit-message t)) (other-frame-prefix)) + (message "Display next project command buffer in a new frame...") + (set-transient-map (make-composed-keymap project-prefix-map + project-other-frame-map))) ;;;###autoload (define-key ctl-x-5-map "p" #'project-other-frame-command) @@ -910,7 +903,9 @@ project-other-tab-command \\{project-prefix-map}" (interactive) - (project--other-place-command '((display-buffer-in-new-tab)))) + (let ((inhibit-message t)) (other-tab-prefix)) + (message "Display next project command buffer in a new tab...") + (set-transient-map project-prefix-map)) ;;;###autoload (when (bound-and-true-p tab-prefix-map) @@ -993,13 +988,13 @@ project--find-default-from "Ensure FILENAME is in PROJECT. Usually, just return FILENAME. But if -`project-current-directory-override' is set, adjust it to be +`next-default-directory' is set, adjust it to be relative to PROJECT instead. This supports using a relative file name from the current buffer when switching projects with `project-switch-project' and then using a command like `project-find-file'." - (if-let (filename-proj (and project-current-directory-override + (if-let (filename-proj (and next-default-directory (project-current nil default-directory))) ;; file-name-concat requires Emacs 28+ (concat (file-name-as-directory (project-root project)) @@ -1893,16 +1888,17 @@ project-switch-commands (character :tag "Explicit key")))) (symbol :tag "Single 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") +;; OBSOLETE? +;; (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 @@ -1938,39 +1934,6 @@ project--keymap-prompt project-switch-commands " ")) -(defun project--switch-project-command () - (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) - (while (not command) - (let* ((overriding-local-map commands-map) - (choice (read-key-sequence (project--keymap-prompt)))) - (when (setq command (lookup-key commands-map 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 ((global-command (lookup-key (current-global-map) choice))) - (when (memq global-command - '(keyboard-quit keyboard-escape-quit)) - (call-interactively global-command))))) - command)) - ;;;###autoload (defun project-switch-project (dir) "\"Switch\" to another project by running an Emacs command. @@ -1980,11 +1943,18 @@ project-switch-project When called in a program, it will use the project corresponding to directory DIR." (interactive (list (funcall project-prompter))) - (let ((command (if (symbolp project-switch-commands) - project-switch-commands - (project--switch-project-command)))) - (let ((project-current-directory-override dir)) - (call-interactively command)))) + (if (symbolp project-switch-commands) + (let ((default-directory dir)) + (call-interactively project-switch-commands)) + (let* ((echofun (lambda () "[switch-project]")) + (postfun (lambda () (remove-hook + 'prefix-command-echo-keystrokes-functions + echofun)))) + (setq next-default-directory dir) + (message (project--keymap-prompt)) + (add-hook 'prefix-command-echo-keystrokes-functions echofun) + (prefix-command-preserve-state) + (set-transient-map project-prefix-map nil postfun)))) ;;;###autoload (defun project-uniquify-dirname-transform (dirname) diff --git a/test/lisp/progmodes/project-tests.el b/test/lisp/progmodes/project-tests.el index 5a206b67db1..bc8c0553f40 100644 --- a/test/lisp/progmodes/project-tests.el +++ b/test/lisp/progmodes/project-tests.el @@ -41,7 +41,7 @@ project/quoted-directory (skip-unless (executable-find "grep")) (ert-with-temp-directory directory (let ((default-directory directory) - (project-current-directory-override t) + (next-default-directory directory) (project-find-functions nil) (project-list-file (expand-file-name "projects" directory))