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

[Dmitry Gutov <dmitry@gutov.dev>]

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

On 26/04/2024 13:59, Dmitry Gutov wrote:
> On 26/04/2024 09:09, Juri Linkov wrote:
>>> This is based on Juri's patch in
>>> https://debbugs.gnu.org/cgi/bugreport.cgi?bug=63648#161, but the idea is
>>> more focused: to switch the order of events, and first read the full key
>>> sequence, and then prompt for the project and the command arguments. 
>>> Like
>>> we also discussed in the past.
>>
>> I'm not a fan of reading the full key sequence bypassing the event loop.
> 
> That's what the current code does. While the patch tries to change that.

Sorry, I forgot to attach the actual patch.

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

diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el
index 000a05804a8..f25403c982c 100644
--- a/lisp/progmodes/project.el
+++ b/lisp/progmodes/project.el
@@ -952,6 +952,44 @@ project-other-tab-command
 (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.
+Makes sure the next command invoked asks for the project to run it in."
+  (interactive)
+  (prefix-command-preserve-state)
+  (letrec ((depth (minibuffer-depth))
+           (echofun (lambda () "[switch-project]"))
+           (around-fun
+            (lambda (command &rest _args)
+              (advice-remove this-command around-fun)
+              (unless (or (eq this-command 'other-project-prefix)
+                          (eq last-command-event help-char))
+                (let ((root (funcall project-prompter)))
+                  (if (or (string-prefix-p "project-"
+                                           (symbol-name this-command))
+                          (get this-command 'project-aware))
+                      (let ((project-current-directory-override root))
+                        (call-interactively command))
+                    (let ((default-directory root))
+                      (call-interactively command)))))))
+           (prefun
+            (lambda ()
+              (unless (> (minibuffer-depth) depth)
+                (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)
+    (let ((map (make-sparse-keymap)))
+      (set-keymap-parent map project-prefix-map)
+      ;; Doesn't work ;-(
+      ;; (define-key map (vector help-char)
+      ;;             (lambda () (interactive) (help-form-show)))
+      (set-transient-map map))
+    (message (concat "Type " (project--keymap-prompt) " or any global key"))))
+
 (declare-function grep-read-files "grep")
 (declare-function xref--find-ignores-arguments "xref")