From db5cbe0a693d4f231141576b07ba68e3287ca645 Mon Sep 17 00:00:00 2001 From: Sean Whitton 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