bug#57807: 29.0.50; Make vc-print-branch-log able to log multiple branches

[Sean Whitton <spwhitton@spwhitton.name>]

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

Hello,

On Mon 19 Sep 2022 at 09:42AM +03, Juri Linkov wrote:

> Thanks, this would be one of the most useful vc features.
> I tried it out, and it works nicely.  Only minor details:
>
> Previously 'git-pull' asked for a full command including command name "git".
> I know there is no need to edit the command name "git", but splitting
> the command between the prompt and the minibuffer looks a little odd.
>
> Also the previous version of 'vc-git--pushpull' sets 'compile-command'
> to the edited command.  It seems this is implemented to be able to
> repeat the pull command with 'g' that is bound to 'recompile'.
> I don't have a good idea how to fix this.  Maybe by setting
> another global variable, e.g. 'vc-last-command' after editing
> the command in 'vc-do-command'.
>
> And also 'vc-do-async-command' reports the initial unedited command
> with its "Running" message string.

I've done something about all these in the attached.  What do you think?

-- 
Sean Whitton

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: v2-0001-Add-support-for-user-edits-to-VC-command-argument.patch --]
[-- Type: text/x-patch, Size: 9525 bytes --]

From 181241f981dce0610807f42e50a89713fafb9af0 Mon Sep 17 00:00:00 2001
From: Sean Whitton <spwhitton@spwhitton.name>
Date: Sun, 18 Sep 2022 14:47:23 -0700
Subject: [PATCH v2] Add support for user edits to VC command arguments

* lisp/vc/vc-dispatcher.el (vc-pre-command-functions): New hook.
(vc-want-edit-command-p): New variable.
(vc-do-command): If vc-want-edit-command-p is non-nil, prompt the user
to edit the VC command and arguments command before execution.  Run
the new hook.
(vc-do-async-command): Use the new hook to insert into BUFFER the
command that's next to be run.
* lisp/vc/vc-git.el (vc-git--pushpull): Drop prompting code.  Bind
vc-want-edit-command-p so that vc-do-command handles the prompting.
Use the new hook to update compile-command with the edited command.
* lisp/vc/vc.el (vc-print-branch-log): A non-nil prefix argument now
means vc-want-edit-command-p is bound to a non-nil value (bug#57807).
---
 lisp/vc/vc-dispatcher.el | 55 ++++++++++++++++++++++++++++++++--------
 lisp/vc/vc-git.el        | 31 ++++++++++------------
 lisp/vc/vc.el            | 18 ++++++++++---
 3 files changed, 71 insertions(+), 33 deletions(-)

diff --git a/lisp/vc/vc-dispatcher.el b/lisp/vc/vc-dispatcher.el
index 88bf6627ae..459c2ae103 100644
--- a/lisp/vc/vc-dispatcher.el
+++ b/lisp/vc/vc-dispatcher.el
@@ -156,6 +156,9 @@ vc-parent-buffer
 (defvar vc-parent-buffer-name nil)
 (put 'vc-parent-buffer-name 'permanent-local t)
 
+(defvar vc-want-edit-command-p nil
+  "If non-nil, let user edit the VC shell command before running it.")
+
 ;; Common command execution logic
 
 (defun vc-process-filter (p s)
@@ -262,6 +265,12 @@ vc-run-delayed
   (declare (indent 0) (debug (def-body)))
   `(vc-exec-after (lambda () ,@body)))
 
+(defvar vc-pre-command-functions nil
+  "Hook run at the beginning of `vc-do-command'.
+Each function is called inside the buffer in which the command
+will be run and is passed 3 arguments: the COMMAND, the FILES and
+the FLAGS.")
+
 (defvar vc-post-command-functions nil
   "Hook run at the end of `vc-do-command'.
 Each function is called inside the buffer in which the command was run
@@ -296,8 +305,27 @@ vc-do-command
 files or be nil (to execute commands that don't expect a file
 name or set of files).  If an optional list of FLAGS is present,
 that is inserted into the command line before the filename.
+
+If `vc-want-edit-command-p' is non-nil, prompt the user to edit
+COMMAND and FLAGS before execution.
+
 Return the return value of the slave command in the synchronous
 case, and the process object in the asynchronous case."
+  (when vc-want-edit-command-p
+    (let* ((files-separator-p (string= "--" (car (last flags))))
+           (edited (split-string-and-unquote
+                    (read-shell-command
+                     (format "Edit VC command & arguments%s: "
+                             (if file-or-list
+                                 " (files list to be appended)"
+                               ""))
+                     (combine-and-quote-strings
+                      (cons command (remq nil (if files-separator-p
+                                                  (butlast flags)
+                                                flags))))))))
+      (setq command (car edited)
+            flags (nconc (cdr edited)
+                         (and files-separator-p '("--"))))))
   (when vc-tor
     (push command flags)
     (setq command "torsocks"))
@@ -327,6 +355,8 @@ vc-do-command
 		       (string= (buffer-name) buffer))
 		  (eq buffer (current-buffer)))
 	(vc-setup-buffer buffer))
+      (run-hook-with-args 'vc-pre-command-functions
+		          command file-or-list flags)
       ;; If there's some previous async process still running, just kill it.
       (let ((squeezed (remq nil flags))
 	    (inhibit-read-only t)
@@ -386,22 +416,25 @@ vc-do-async-command
 of a buffer, which is created.
 ROOT should be the directory in which the command should be run.
 Display the buffer in some window, but don't select it."
-  (let* ((dir default-directory)
-	 (inhibit-read-only t)
-	 window new-window-start)
+  (letrec ((dir default-directory)
+	   (inhibit-read-only t)
+           (fun (lambda (command _ args)
+                  (remove-hook 'vc-pre-command-functions fun)
+                  (goto-char (point-max))
+                  (unless (eq (point) (point-min))
+	            (insert "\f\n"))
+                  (setq new-window-start (point))
+                  (insert "Running \"" command)
+                  (dolist (arg args)
+	            (insert " " arg))
+                  (insert "\"...\n")))
+	   (window nil) (new-window-start nil))
     (setq buffer (get-buffer-create buffer))
     (if (get-buffer-process buffer)
 	(error "Another VC action on %s is running" root))
     (with-current-buffer buffer
       (setq default-directory root)
-      (goto-char (point-max))
-      (unless (eq (point) (point-min))
-	(insert "\f\n"))
-      (setq new-window-start (point))
-      (insert "Running \"" command)
-      (dolist (arg args)
-	(insert " " arg))
-      (insert "\"...\n")
+      (add-hook 'vc-pre-command-functions fun)
       ;; Run in the original working directory.
       (let ((default-directory dir))
 	(apply #'vc-do-command t 'async command nil args)))
diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el
index a5d12f03bc..2228cf8665 100644
--- a/lisp/vc/vc-git.el
+++ b/lisp/vc/vc-git.el
@@ -1089,35 +1089,30 @@ vc-git-error-regexp-alist
 (declare-function vc-compilation-mode "vc-dispatcher" (backend))
 (defvar compilation-directory)
 (defvar compilation-arguments)
+(defvar vc-want-edit-command-p)
 
 (defun vc-git--pushpull (command prompt extra-args)
   "Run COMMAND (a string; either push or pull) on the current Git branch.
 If PROMPT is non-nil, prompt for the Git command to run."
   (let* ((root (vc-git-root default-directory))
 	 (buffer (format "*vc-git : %s*" (expand-file-name root)))
-	 (git-program vc-git-program)
-	 args)
-    ;; If necessary, prompt for the exact command.
-    ;; TODO if pushing, prompt if no default push location - cf bzr.
-    (when prompt
-      (setq args (split-string
-		  (read-shell-command
-                   (format "Git %s command: " command)
-                   (format "%s %s" git-program command)
-                   'vc-git-history)
-		  " " t))
-      (setq git-program (car  args)
-	    command     (cadr args)
-	    args        (cddr args)))
-    (setq args (nconc args extra-args))
+         ;; TODO if pushing, prompt if no default push location - cf bzr.
+         (vc-want-edit-command-p prompt))
     (require 'vc-dispatcher)
-    (apply #'vc-do-async-command buffer root git-program command args)
+    (when vc-want-edit-command-p
+      (with-current-buffer (get-buffer-create buffer)
+        (add-hook 'vc-pre-command-functions
+                  (pcase-lambda (_ _ `(,new-command . ,new-args))
+                    (setq command new-command extra-args new-args))
+                  nil t)))
+    (apply #'vc-do-async-command
+           buffer root vc-git-program command extra-args)
     (with-current-buffer buffer
       (vc-run-delayed
         (vc-compilation-mode 'git)
         (setq-local compile-command
-                    (concat git-program " " command " "
-                            (mapconcat #'identity args " ")))
+                    (concat vc-git-program " " command " "
+                            (mapconcat #'identity extra-args " ")))
         (setq-local compilation-directory root)
         ;; Either set `compilation-buffer-name-function' locally to nil
         ;; or use `compilation-arguments' to set `name-function'.
diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el
index c67dad69fc..76e577d682 100644
--- a/lisp/vc/vc.el
+++ b/lisp/vc/vc.el
@@ -1046,6 +1046,7 @@ log-view-vc-backend
 (defvar log-edit-vc-backend)
 (defvar diff-vc-backend)
 (defvar diff-vc-revisions)
+(defvar vc-want-edit-command-p)
 
 (defun vc-deduce-backend ()
   (cond ((derived-mode-p 'vc-dir-mode)   vc-dir-backend)
@@ -2744,17 +2745,26 @@ vc-print-root-log
     (setq vc-parent-buffer-name nil)))
 
 ;;;###autoload
-(defun vc-print-branch-log (branch)
-  "Show the change log for BRANCH root in a window."
+(defun vc-print-branch-log (branch &optional arg)
+  "Show the change log for BRANCH root in a window.
+Optional prefix ARG non-nil requests an opportunity for the user
+to edit the VC shell command that will be run to generate the
+log."
+  ;; The original motivation for ARG was to make it possible to
+  ;; produce a log of more than one Git branch without modifying the
+  ;; print-log VC API.  The user can append the other branches to the
+  ;; command line arguments to 'git log'.  See bug#57807.
   (interactive
    (let* ((backend (vc-responsible-backend default-directory))
           (rootdir (vc-call-backend backend 'root default-directory)))
      (list
-      (vc-read-revision "Branch to log: " (list rootdir) backend))))
+      (vc-read-revision "Branch to log: " (list rootdir) backend)
+      current-prefix-arg)))
   (when (equal branch "")
     (error "No branch specified"))
   (let* ((backend (vc-responsible-backend default-directory))
-         (rootdir (vc-call-backend backend 'root default-directory)))
+         (rootdir (vc-call-backend backend 'root default-directory))
+         (vc-want-edit-command-p arg))
     (vc-print-log-internal backend
                            (list rootdir) branch t
                            (when (> vc-log-show-limit 0) vc-log-show-limit))))
-- 
2.30.2