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

[Dmitry Gutov <dmitry@gutov.dev>]

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

On 28/04/2024 19:51, Juri Linkov wrote:
>> 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.
> 
> Thanks.
> 
>> +(defun other-project-prefix ()
> 
> Something is wrong here.  I bound 'other-project-prefix' to 'C-x p P'.
> Then typing 'C-x p P C-x d' asked a directory name, then later
> after selecting a project asked for the directory name again.

Looks like that has to do with the interactive spec. See the attached 
next revision, it seems to behave better.

> Then some advice remains unremoved.  Ok, will test more.

I haven't noticed this particular problem, so please write down a repro 
if you find one.

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

diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el
index 000a05804a8..feb31caba4d 100644
--- a/lisp/progmodes/project.el
+++ b/lisp/progmodes/project.el
@@ -952,6 +952,47 @@ 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)
+              (interactive #'ignore)
+              (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"))))
+
+;; (define-key project-prefix-map (kbd "P") #'other-project-prefix)
+
 (declare-function grep-read-files "grep")
 (declare-function xref--find-ignores-arguments "xref")