procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Add support for user edits to VC command arguments

Browse source 
* 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).
This commit is contained in:
Sean Whitton 2022-09-18 14:47:23 -07:00
parent 447ff572be
commit 101f3cf5b9
3 changed files with 71 additions and 33 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

55
lisp/vc/vc-dispatcher.el
View file

@ -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)))

31
lisp/vc/vc-git.el
View file

@ -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'.

18
lisp/vc/vc.el
View file

@ -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))))