master 101f3cf5b9: Add support for user edits to VC command arguments

[Sean Whitton]

branch: master
commit 101f3cf5b9b5600147d4406c3be8daf174e1a543
Author: Sean Whitton <spwhitton@spwhitton.name>
Commit: Sean Whitton <spwhitton@spwhitton.name>

    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 & arguments 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 @@ BEWARE: Despite its name, this variable is not itself a 
hook!")
 (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 @@ CODE should be a function of no arguments."
   (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 @@ FILE-OR-LIST is the name of a working file; it may be a 
list of
 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 @@ case, and the process object in the asynchronous case."
                       (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 @@ Send the output to BUFFER, which should be a buffer or 
the name
 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 "\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 "\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 @@ It is based on `log-edit-mode', and has Git-specific 
extensions."
 (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 6ee6e36a04..a45e0e0c52 100644
--- a/lisp/vc/vc.el
+++ b/lisp/vc/vc.el
@@ -1046,6 +1046,7 @@ Within directories, only files already under version 
control are noticed."
 (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 @@ with its diffs (if the underlying VCS supports that)."
     (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))))