bug#70577: [PATCH] New command other-project-prefix

[Dmitry Gutov <dmitry@gutov.dev>]

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

On 15/05/2024 09:46, Juri Linkov wrote:
>>>> +(defvar other-project-prefix-transient-commands '(project-other-window-command
>>>> +                                                  project-other-frame-command
>>>> +                                                  project-other-tab-command
>>>> +                                                  other-window-prefix
>>>> +                                                  other-frame-prefix
>>>> +                                                  other-tab-prefix)
>>>> +  "List of commands that `other-project-prefix' does not apply to.
>>> This doesn't yet support such things as 'C-x 5 p p'?
>>
>> I'm not sure that other-project-prefix can do that.
>>
>> How does other-frame-prefix work? display-buffer-override-next-command sets
>> up hooks in the very familiar fashion, so that the next command (and only
>> the next command) is affected by a number of changed variables, which get
>> restored after.
>>
>> I suppose other-project-prefix could learn all the new variables it needs
>> to "carry on", look up their values, and set them additionally for the next
>> command. But that seems very ad-hoc.
>>
>> It seems the "proper" way to fix that would be a cross-codebase change
>> where all similar "prefix" commands themselves check whether the next
>> command is a "prefix" command as well, and if so, keep the variables and
>> hooks in place for the command after it. This would also mean moving the
>> information from other-project-prefix-transient-commands to symbol
>> properties (the alternative I've mentioned previously).
> 
> In https://debbugs.gnu.org/cgi/bugreport.cgi?bug=63648#95
> I made an unfinished attempt to handle this by:
> 
> ```
> diff --git a/lisp/window.el b/lisp/window.el
> index ab7dd5ced12..52ba407d9c8 100644
> --- a/lisp/window.el
> +++ b/lisp/window.el
> @@ -9099,7 +9091,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)
> +		     (memq this-command '(other-project-prefix)))
>                 (funcall exitfun))))
>       ;; Call post-function after the next command finishes (bug#49057).
>       (add-hook 'post-command-hook postfun)
> ```
> 
> I'm not sure if this is a proper way, this needs more trial-and-error.

Looks like you were thinking along similar lines.

Here's a patch using symbol properties that makes the prefix commands 
work combined in arbitrary order. At least according to my limited 
testing - and only the commands that have this property set, of course.

Something to discuss:
- A better name for the property? Maybe something longer would be more 
obvious for an accidental reader.
- Applying it through 'declare' forms could be a more self-contained 
approach.

[-- Attachment #2: other-project-prefix-v6.diff --]
[-- Type: text/x-patch, Size: 5013 bytes --]

diff --git a/lisp/frame.el b/lisp/frame.el
index d2376f1e339..1e18d41ac31 100644
--- a/lisp/frame.el
+++ b/lisp/frame.el
@@ -1108,6 +1108,8 @@ other-frame-prefix
    nil "[other-frame]")
   (message "Display next command buffer in a new frame..."))
 
+(put 'other-frame-prefix 'prefix-command t)
+
 (defun iconify-or-deiconify-frame ()
   "Iconify the selected frame, or deiconify if it's currently an icon."
   (interactive)
diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el
index a95d1267dd2..7298ffe19c8 100644
--- a/lisp/progmodes/project.el
+++ b/lisp/progmodes/project.el
@@ -934,6 +934,8 @@ project-other-window-command
                                     project-other-window-map)
     (project--other-place-prefix 'window project-other-window-map)))
 
+(put 'project-other-window-command 'prefix-command t)
+
 ;;;###autoload (define-key ctl-x-4-map "p" #'project-other-window-command)
 
 ;;;###autoload
@@ -950,6 +952,8 @@ project-other-frame-command
                                     project-other-frame-map)
     (project--other-place-prefix 'frame project-other-frame-map)))
 
+(put 'project-other-frame-command 'prefix-command t)
+
 ;;;###autoload (define-key ctl-x-5-map "p" #'project-other-frame-command)
 
 ;;;###autoload
@@ -964,10 +968,54 @@ project-other-tab-command
       (project--other-place-command '((display-buffer-in-new-tab)))
     (project--other-place-prefix 'tab)))
 
+(put 'project-other-tab-command 'prefix-command t)
+
 ;;;###autoload
 (when (bound-and-true-p tab-prefix-map)
   (define-key tab-prefix-map "p" #'project-other-tab-command))
 
+;;;###autoload
+(defun other-project-prefix ()
+  "\"Switch\" to another project before running an Emacs command.
+The next command you invoke will prompt for the project in which to run
+the command."
+  (interactive)
+  (prefix-command-preserve-state)
+  (letrec ((depth (minibuffer-depth))
+           (echofun (lambda () "[switch-project]"))
+           (around-fun
+            (lambda (command &rest _args)
+              (interactive)
+              (advice-remove this-command around-fun)
+              (if (or (eq this-command 'other-project-prefix)
+                      (eq last-command-event help-char))
+                  (call-interactively command)
+                (let* ((this-command-saved this-command)
+                       (root (funcall project-prompter)))
+                  (if (or (string-prefix-p "project-"
+                                           (symbol-name this-command-saved))
+                          (get this-command-saved 'project-aware))
+                      (let ((project-current-directory-override root))
+                        (call-interactively command))
+                    (let ((default-directory root))
+                      (call-interactively command)))))))
+           (prefun
+            (lambda ()
+              (unless (or (> (minibuffer-depth) depth)
+                          (get this-command 'prefix-command))
+                (remove-hook 'pre-command-hook prefun)
+                (remove-hook 'prefix-command-echo-keystrokes-functions echofun)
+                (when (and this-command (symbolp this-command))
+                  (advice-add this-command :around around-fun))))))
+    (add-hook 'pre-command-hook prefun)
+    (add-hook 'prefix-command-echo-keystrokes-functions echofun)
+    (set-transient-map project-prefix-map)
+    (message (concat "Type " (project--keymap-prompt) " or any global key"))))
+
+(put 'other-project-prefix 'prefix-command t)
+
+;; (define-key project-prefix-map (kbd "P") #'other-project-prefix)
+
 (declare-function grep-read-files "grep")
 (declare-function xref--find-ignores-arguments "xref")
 
diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el
index dac57ce2070..9a16d20be73 100644
--- a/lisp/tab-bar.el
+++ b/lisp/tab-bar.el
@@ -2855,6 +2855,8 @@ other-tab-prefix
    nil "[other-tab]")
   (message "Display next command buffer in a new tab..."))
 
+(put 'other-tab-prefix 'prefix-command t)
+
 \f
 ;;; Short aliases and keybindings
 
diff --git a/lisp/window.el b/lisp/window.el
index 8feeba0d83e..7d2c7f9977d 100644
--- a/lisp/window.el
+++ b/lisp/window.el
@@ -4044,6 +4044,8 @@ other-window-prefix
    nil "[other-window]")
   (message "Display next command buffer in a new window..."))
 
+(put 'other-window-prefix 'prefix-command t)
+
 (defun same-window-prefix ()
   "Display the buffer of the next command in the same window.
 The next buffer is the buffer displayed by the next command invoked
@@ -9269,7 +9271,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)
+                     (get this-command 'prefix-command))
               (funcall exitfun))))
     ;; Call post-function after the next command finishes (bug#49057).
     (add-hook 'post-command-hook postfun)