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

[Dmitry Gutov <dmitry@gutov.dev>]

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

On 09/05/2024 05:22, Dmitry Gutov wrote:
> On 07/05/2024 22:16, Dmitry Gutov wrote:
>> Speaking of the implementation strategy, though, I think the current 
>> other-project-prefix implementation still doesn't work well together 
>> with project-other-*-command.
> 
> I suppose we could just blacklist some known prefix commands (*) in the 
> same form where we now compare (eq this-command 'other-project-prefix), 
> but it would be nice to distinguish prefix commands from "real" ones 
> somehow.
> 
> (*) project-other-window-command, project-other-frame-command, 
> project-other-tab-command, some others?

This can look like the attached.

Though I suppose we would use some global registry, or symbol 
properties, or etc.

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

diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el
index a95d1267dd2..13e9d2c8a96 100644
--- a/lisp/progmodes/project.el
+++ b/lisp/progmodes/project.el
@@ -968,6 +968,58 @@ project-other-tab-command
 (when (bound-and-true-p tab-prefix-map)
   (define-key tab-prefix-map "p" #'project-other-tab-command))
 
+(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.
+
+Meaning, its effect will apply to the first next command that is not in
+this list.  You would typically specify \"prefix\" commands here, ones
+that also apply some modification to the following command's behavior.")
+
+;;;###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)
+                          (memq this-command other-project-prefix-transient-commands))
+                (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"))))
+
+;; (define-key project-prefix-map (kbd "P") #'other-project-prefix)
+
 (declare-function grep-read-files "grep")
 (declare-function xref--find-ignores-arguments "xref")