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

[Juri Linkov <juri@linkov.net>]

[-- Attachment #1: Type: text/plain, Size: 737 bytes --]

>> Probably. Would you like to propose one? So that I have something to
>> compare to, and have something specific to put to the vote as well.
>
> Ok, something like this:

Here is a more tested patch.  It supports these cases:

(setq project-switch-use-entire-map t)

C-x p p C-b - should not include current buffer in the list of another project (bug#58784)
C-x p p f M-n - should fetch the right default file name (bug#58784, bug#63829)
C-u C-x p p f emoji TAB - should include ignored emoji-labels.el (bug#63648)
C-x p p C-x d - should visit another project's root (bug#63648)

The same with frames:

C-x 5 p p C-b
C-x 5 p p f M-n
C-u C-x 5 p p f emoji TAB - should not show completions in another frame (bug#65558)
C-x 5 p p C-x d


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: project-default-directory.patch --]
[-- Type: text/x-diff, Size: 9407 bytes --]

diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el
index 2e6ae89a443..9faacbe3512 100644
--- a/lisp/progmodes/project.el
+++ b/lisp/progmodes/project.el
@@ -197,6 +197,14 @@ project-current-directory-override
   "Value to use instead of `default-directory' when detecting the project.
 When it is non-nil, `project-current' will always skip prompting too.")
 
+(defvar-local project-default-directory nil
+  "Value to use instead of `default-directory' when detecting the project.
+For the next command after switching the project, this buffer-local
+variable contains the original value of `default-directory'.
+Whereas the buffer-local `default-directory' is temporarily set
+to the root directory of the switched project.
+When it is non-nil, `project-current' will always skip prompting too.")
+
 (defcustom project-prompter #'project-prompt-project-dir
   "Function to call to prompt for a project.
 Called with no arguments and should return a project root dir."
@@ -232,7 +240,8 @@ project-current
   (let ((pr (project--find-in-directory directory)))
     (cond
      (pr)
-     ((unless project-current-directory-override
+     ((unless (or project-current-directory-override
+                  project-default-directory)
         maybe-prompt)
       (setq directory (funcall project-prompter)
             pr (project--find-in-directory directory))))
@@ -397,8 +406,10 @@ project-buffers
   (let ((root (expand-file-name (file-name-as-directory (project-root project))))
         bufs)
     (dolist (buf (buffer-list))
-      (when (string-prefix-p root (expand-file-name
-                                   (buffer-local-value 'default-directory buf)))
+      (when (string-prefix-p
+             root (expand-file-name
+                   (or (buffer-local-value 'project-default-directory buf)
+                       (buffer-local-value 'default-directory buf))))
         (push buf bufs)))
     (nreverse bufs)))
 
@@ -813,7 +824,9 @@ project-buffers
          dd
          bufs)
     (dolist (buf (buffer-list))
-      (setq dd (expand-file-name (buffer-local-value 'default-directory buf)))
+      (setq dd (expand-file-name
+                (or (buffer-local-value 'project-default-directory buf)
+                    (buffer-local-value 'default-directory buf))))
       (when (and (string-prefix-p root dd)
                  (not (cl-find-if (lambda (module) (string-prefix-p module dd))
                                   modules)))
@@ -842,7 +855,9 @@ project-prefix-map
     (define-key map "c" 'project-compile)
     (define-key map "e" 'project-eshell)
     (define-key map "k" 'project-kill-buffers)
-    (define-key map "p" 'project-switch-project)
+    (define-key map "p" (if (< emacs-major-version 30)
+                            'project-switch-project
+                          'other-project-prefix))
     (define-key map "g" 'project-find-regexp)
     (define-key map "G" 'project-or-external-find-regexp)
     (define-key map "r" 'project-query-replace-regexp)
@@ -889,10 +904,18 @@ 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))
+  (if (< emacs-major-version 30)
+      (project--other-place-command '((display-buffer-pop-up-window)
+                                      (inhibit-same-window . t))
+                                    project-other-window-map)
+    (prefix-command-preserve-state)
+    (let ((inhibit-message t)) (other-window-prefix))
+    (message "Display next project command buffer in a new window...")
+    ;; Should return exitfun from set-transient-map
+    (set-transient-map (make-composed-keymap project-prefix-map
+                                             project-other-window-map))))
 
+;; TODO: maybe rename to project-other-window-prefix
 ;;;###autoload (define-key ctl-x-4-map "p" #'project-other-window-command)
 
 ;;;###autoload
@@ -904,8 +927,15 @@ 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))
+  (if (< emacs-major-version 30)
+      (project--other-place-command '((display-buffer-pop-up-frame))
+                                    project-other-frame-map)
+    (prefix-command-preserve-state)
+    (let ((inhibit-message t)) (other-frame-prefix))
+    (message "Display next project command buffer in a new frame...")
+    ;; Should return exitfun from set-transient-map
+    (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)
 
@@ -917,7 +947,13 @@ project-other-tab-command
 
 \\{project-prefix-map}"
   (interactive)
-  (project--other-place-command '((display-buffer-in-new-tab))))
+  (if (< emacs-major-version 30)
+      (project--other-place-command '((display-buffer-in-new-tab)))
+    (prefix-command-preserve-state)
+    (let ((inhibit-message t)) (other-tab-prefix))
+    (message "Display next project command buffer in a new tab...")
+    ;; Should return exitfun from set-transient-map
+    (set-transient-map project-prefix-map)))
 
 ;;;###autoload
 (when (bound-and-true-p tab-prefix-map)
@@ -1000,14 +1036,16 @@ 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
+`project-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
-                            (project-current nil default-directory)))
+  (if-let (filename-proj (or (and project-current-directory-override
+                                  (project-current nil default-directory))
+                             (and project-default-directory
+                                  (project-current nil project-default-directory))))
       ;; file-name-concat requires Emacs 28+
       (concat (file-name-as-directory (project-root project))
               (file-relative-name filename (project-root filename-proj)))
@@ -1993,6 +2031,60 @@ project-switch-project
     (let ((project-current-directory-override dir))
       (call-interactively command))))
 
+;;;###autoload
+(defun other-project-prefix (dir)
+  "\"Switch\" to another project before running an Emacs command.
+The available commands are presented as a dispatch menu
+made from `project-switch-commands'.
+
+When called in a program, it will use the project corresponding
+to directory DIR."
+  (interactive (list (funcall project-prompter)))
+  (if (symbolp project-switch-commands)
+      (let* ((project-default-directory default-directory)
+             (default-directory dir))
+        (call-interactively project-switch-commands))
+    (prefix-command-preserve-state)
+    (letrec ((minibuffer-depth (minibuffer-depth))
+             (command this-command)
+             (old-buffer (current-buffer))
+             (echofun (lambda () "[switch-project]"))
+             (postfun
+              (lambda ()
+                (unless (or (eq this-command command)
+                            (> (minibuffer-depth) minibuffer-depth))
+                  (remove-hook 'post-command-hook postfun)
+                  (remove-hook 'prefix-command-echo-keystrokes-functions
+                               echofun)
+                  (when (buffer-live-p old-buffer)
+                    (with-current-buffer old-buffer
+                      (when project-default-directory
+                        (setq-local default-directory project-default-directory)
+                        (kill-local-variable 'project-default-directory))))))))
+      (add-hook 'post-command-hook postfun)
+      (add-hook 'prefix-command-echo-keystrokes-functions echofun)
+      (setq-local project-default-directory default-directory)
+      (setq-local default-directory dir)
+      (message (concat (project--keymap-prompt) " or any global key."))
+      (let ((map (make-sparse-keymap)))
+        (if project-switch-use-entire-map
+            (set-keymap-parent map project-prefix-map)
+          (dolist (row project-switch-commands map)
+            (when-let* ((cmd (nth 0 row))
+                        (key (if (nth 2 row)
+                                 (vector (nth 2 row))
+                               (where-is-internal
+                                cmd (list project-prefix-map) t))))
+              (define-key map key cmd))))
+        (define-key map (vector help-char)
+                    (lambda ()
+                      (interactive)
+                      (let ((help-form "\
+You can use any global keybinding."))
+                        (help-form-show))))
+        ;; Should return exitfun from set-transient-map
+        (set-transient-map map)))))
+
 ;;;###autoload
 (defun project-uniquify-dirname-transform (dirname)
   "Uniquify name of directory DIRNAME using `project-name', if in a project.