bug#63648: 29.0.90; project.el: with switch-use-entire-map, switch-project errors on non-project commands

[Juri Linkov]

>> There is no code where to bind a dynamic variable, because its value
>> should be available for the next command in the command loop.
>> If you agree there is no other way to implement this than 
>> next-default-directory,
>> then I could bring up the discussion on emacs-devel.
>
> Before we dive into all that, why not try advice on 'command-execute'? For
> the PoC code at least. It's in Lisp since 2013.

Thanks for bringing up 'command-execute'.  I forgot it was moved from C to Lisp,
so the change is simpler and not needed to discuss on emacs-devel.  Then advice
on 'command-execute' will be required to support older Emacs versions in 
project.el.
But for Emacs 30 I modified my previous patch, and the next version is below:

> The comment in its body does say "Called directly from the C code", but I'm
> not sure if that has any direct implications for us.

Also interesting how 'command-execute' handles 'debug-on-next-call'
similar to 'next-default-directory'.

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))