summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSean Whitton <spwhitton@spwhitton.name>2022-09-18 14:47:23 -0700
committerSean Whitton <spwhitton@spwhitton.name>2022-09-21 12:31:05 -0700
commit101f3cf5b9b5600147d4406c3be8daf174e1a543 (patch)
tree2b1c2c04359ada4948958695236a129bddb0fcfb
parent447ff572be1019249afb2c67411d4a5bdb0a4407 (diff)
downloademacs-101f3cf5b9b5600147d4406c3be8daf174e1a543.tar.gz
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).
-rw-r--r--lisp/vc/vc-dispatcher.el55
-rw-r--r--lisp/vc/vc-git.el31
-rw-r--r--lisp/vc/vc.el18
3 files changed, 71 insertions, 33 deletions
diff --git a/lisp/vc/vc-dispatcher.el b/lisp/vc/vc-dispatcher.el
index 88bf6627ae6..459c2ae1039 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 a5d12f03bcf..2228cf86659 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 6ee6e36a040..a45e0e0c522 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))))