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: 325 bytes --]

Hello,

On Fri 16 Sep 2022 at 09:59AM +03, Juri Linkov wrote:

> Yes, please try to prepare a patch, preferably without changing the
> established backend API, maybe by using a global variable that later
> could be reused to confirm and edit other commands.

Here's my attempt.  Let me know what you think.

-- 
Sean Whitton

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

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

* lisp/vc/vc-dispatcher.el (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 arguments to the VC command before execution.
* 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.
* 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 | 35 +++++++++++++++++++++++++++++------
 lisp/vc/vc-git.el        | 25 +++++++------------------
 lisp/vc/vc.el            | 14 ++++++++++----
 3 files changed, 46 insertions(+), 28 deletions(-)

diff --git a/lisp/vc/vc-dispatcher.el b/lisp/vc/vc-dispatcher.el
index 88bf6627ae..d83db53dc8 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)
@@ -296,15 +299,16 @@ 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
+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-tor
-    (push command flags)
-    (setq command "torsocks"))
-  ;; FIXME: file-relative-name can return a bogus result because
-  ;; it doesn't look at the actual file-system to see if symlinks
-  ;; come into play.
   (let* ((files
+          ;; FIXME: file-relative-name can return a bogus result
+          ;; because it doesn't look at the actual file-system to see
+          ;; if symlinks come into play.
 	  (mapcar (lambda (f) (file-relative-name (expand-file-name f)))
 		  (if (listp file-or-list) file-or-list (list file-or-list))))
 	 ;; Keep entire commands in *Messages* but avoid resizing the
@@ -312,6 +316,22 @@ vc-do-command
 	 ;; a such way that the important parts are at the beginning,
 	 ;; due to potential truncation of long messages.
 	 (message-truncate-lines t)
+         (files-separator-p (string= "--" (car (last flags))))
+         (flags (if vc-want-edit-command-p
+                    (append
+                     (split-string-and-unquote
+                      (read-shell-command
+                       (format "Edit VC command arguments%s: %s "
+                               (if files
+                                   " (files list to be appended)"
+                                 "")
+                               command)
+                       (combine-and-quote-strings
+                        (remq nil (if files-separator-p
+                                      (butlast flags)
+                                    flags)))))
+                     (and files-separator-p (list "--")))
+                  flags))
 	 (full-command
 	  (concat (if (string= (substring command -1) "\n")
 		      (substring command 0 -1)
@@ -321,6 +341,9 @@ vc-do-command
 	 (vc-inhibit-message
 	  (or (eq vc-command-messages 'log)
 	      (eq (selected-window) (active-minibuffer-window)))))
+    (when vc-tor
+      (push command flags)
+      (setq command "torsocks"))
     (save-current-buffer
       (unless (or (eq buffer t)
 		  (and (stringp buffer)
diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el
index a5d12f03bc..91951d3277 100644
--- a/lisp/vc/vc-git.el
+++ b/lisp/vc/vc-git.el
@@ -1089,35 +1089,24 @@ 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)
+    (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..027dfc72ea 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,22 @@ 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."
   (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