From 181241f981dce0610807f42e50a89713fafb9af0 Mon Sep 17 00:00:00 2001 From: Sean Whitton 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 " \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 @@ 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