Generalize & simplify implementation of user edits to VC commands
* lisp/vc/vc-dispatcher.el (vc-pre-command-functions) (vc-want-edit-command-p): Delete. (vc-filter-command-function): New variable. (vc-user-edit-command): Factor out of vc-do-command. (vc-do-command, vc-do-async-command) * lisp/vc/vc-git.el (vc-git--pushpull) * lisp/vc/vc.el (vc-print-branch-log): Use vc-filter-command-function in place of vc-pre-command-functions and vc-want-edit-command-p.
This commit is contained in:
Sean Whitton
parent
8574ae625e
commit
9a5176aec0
3 changed files with 149 additions and 136 deletions
|
|
@ -109,6 +109,8 @@
|
|||
;; TODO:
|
||||
;; - log buffers need font-locking.
|
||||
|
||||
(eval-when-compile (require 'cl-lib))
|
||||
|
||||
;; General customization
|
||||
|
||||
(defcustom vc-logentry-check-hook nil
|
||||
|
|
@ -156,9 +158,6 @@ 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)
|
||||
|
|
@ -270,11 +269,12 @@ SUCCESS process has a zero exit code."
|
|||
(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-filter-command-function (lambda (&rest args) args)
|
||||
"Function called to transform VC commands before execution.
|
||||
The function is called inside the buffer in which the command
|
||||
will be run and is passed the COMMAND, FILE-OR-LIST and FLAGS
|
||||
arguments to `vc-do-command'. It should return a list of three
|
||||
elements, the new values for these arguments.")
|
||||
|
||||
(defvar vc-post-command-functions nil
|
||||
"Hook run at the end of `vc-do-command'.
|
||||
|
|
@ -296,6 +296,23 @@ the man pages for \"torsocks\" for more details about Tor."
|
|||
:version "27.1"
|
||||
:group 'vc)
|
||||
|
||||
(defun vc-user-edit-command (command file-or-list flags)
|
||||
"Prompt the user to edit VC command COMMAND and FLAGS.
|
||||
Intended to be used as the value of `vc-filter-command-function'."
|
||||
(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))))))))
|
||||
(list (car edited) file-or-list
|
||||
(nconc (cdr edited) (and files-separator-p '("--"))))))
|
||||
|
||||
;;;###autoload
|
||||
(defun vc-do-command (buffer okstatus command file-or-list &rest flags)
|
||||
"Execute a slave command, notifying user and checking for errors.
|
||||
|
|
@ -311,109 +328,102 @@ 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"))
|
||||
;; 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
|
||||
(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
|
||||
;; echo area. Messages in this function are formatted in
|
||||
;; a such way that the important parts are at the beginning,
|
||||
;; due to potential truncation of long messages.
|
||||
(message-truncate-lines t)
|
||||
(full-command
|
||||
(concat (if (string= (substring command -1) "\n")
|
||||
(substring command 0 -1)
|
||||
command)
|
||||
" " (vc-delistify flags)
|
||||
" " (vc-delistify files)))
|
||||
(vc-inhibit-message
|
||||
(or (eq vc-command-messages 'log)
|
||||
(eq (selected-window) (active-minibuffer-window)))))
|
||||
(let (;; Keep entire commands in *Messages* but avoid resizing the
|
||||
;; echo area. Messages in this function are formatted in
|
||||
;; a such way that the important parts are at the beginning,
|
||||
;; due to potential truncation of long messages.
|
||||
(message-truncate-lines t)
|
||||
(vc-inhibit-message
|
||||
(or (eq vc-command-messages 'log)
|
||||
(eq (selected-window) (active-minibuffer-window)))))
|
||||
(save-current-buffer
|
||||
(unless (or (eq buffer t)
|
||||
(and (stringp buffer)
|
||||
(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)
|
||||
(status 0))
|
||||
(when files
|
||||
(setq squeezed (nconc squeezed files)))
|
||||
(let (;; Since some functions need to parse the output
|
||||
;; from external commands, set LC_MESSAGES to C.
|
||||
(process-environment (cons "LC_MESSAGES=C" process-environment))
|
||||
(w32-quote-process-args t))
|
||||
(if (eq okstatus 'async)
|
||||
;; Run asynchronously.
|
||||
(let ((proc
|
||||
(let ((process-connection-type nil))
|
||||
(apply #'start-file-process command (current-buffer)
|
||||
command squeezed))))
|
||||
(when vc-command-messages
|
||||
(let ((inhibit-message vc-inhibit-message))
|
||||
(message "Running in background: %s" full-command)))
|
||||
;; Get rid of the default message insertion, in case we don't
|
||||
;; set a sentinel explicitly.
|
||||
(set-process-sentinel proc #'ignore)
|
||||
(set-process-filter proc #'vc-process-filter)
|
||||
(setq status proc)
|
||||
(when vc-command-messages
|
||||
(vc-run-delayed
|
||||
(let ((message-truncate-lines t)
|
||||
(inhibit-message vc-inhibit-message))
|
||||
(message "Done in background: %s" full-command)))))
|
||||
;; Run synchronously
|
||||
(when vc-command-messages
|
||||
(let ((inhibit-message vc-inhibit-message))
|
||||
(message "Running in foreground: %s" full-command)))
|
||||
(let ((buffer-undo-list t))
|
||||
(setq status (apply #'process-file command nil t nil squeezed)))
|
||||
(when (and (not (eq t okstatus))
|
||||
(or (not (integerp status))
|
||||
(and okstatus (< okstatus status))))
|
||||
(unless (eq ?\s (aref (buffer-name (current-buffer)) 0))
|
||||
(pop-to-buffer (current-buffer))
|
||||
(goto-char (point-min))
|
||||
(shrink-window-if-larger-than-buffer))
|
||||
(error "Failed (%s): %s"
|
||||
(if (integerp status) (format "status %d" status) status)
|
||||
full-command))
|
||||
(when vc-command-messages
|
||||
(let ((inhibit-message vc-inhibit-message))
|
||||
(message "Done (status=%d): %s" status full-command)))))
|
||||
(vc-run-delayed
|
||||
(run-hook-with-args 'vc-post-command-functions
|
||||
command file-or-list flags))
|
||||
status))))
|
||||
(vc-setup-buffer buffer))
|
||||
(cl-destructuring-bind (command file-or-list flags)
|
||||
(funcall vc-filter-command-function command file-or-list flags)
|
||||
(when vc-tor
|
||||
(push command flags)
|
||||
(setq command "torsocks"))
|
||||
(let* (;; 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.
|
||||
(files
|
||||
(mapcar (lambda (f)
|
||||
(file-relative-name (expand-file-name f)))
|
||||
(if (listp file-or-list)
|
||||
file-or-list
|
||||
(list file-or-list))))
|
||||
(full-command
|
||||
(concat (if (string= (substring command -1) "\n")
|
||||
(substring command 0 -1)
|
||||
command)
|
||||
" " (vc-delistify flags)
|
||||
" " (vc-delistify files)))
|
||||
(squeezed (remq nil flags))
|
||||
(inhibit-read-only t)
|
||||
(status 0))
|
||||
;; If there's some previous async process still running,
|
||||
;; just kill it.
|
||||
(when files
|
||||
(setq squeezed (nconc squeezed files)))
|
||||
(let (;; Since some functions need to parse the output
|
||||
;; from external commands, set LC_MESSAGES to C.
|
||||
(process-environment
|
||||
(cons "LC_MESSAGES=C" process-environment))
|
||||
(w32-quote-process-args t))
|
||||
(if (eq okstatus 'async)
|
||||
;; Run asynchronously.
|
||||
(let ((proc
|
||||
(let ((process-connection-type nil))
|
||||
(apply #'start-file-process command
|
||||
(current-buffer) command squeezed))))
|
||||
(when vc-command-messages
|
||||
(let ((inhibit-message vc-inhibit-message))
|
||||
(message "Running in background: %s"
|
||||
full-command)))
|
||||
;; Get rid of the default message insertion, in case
|
||||
;; we don't set a sentinel explicitly.
|
||||
(set-process-sentinel proc #'ignore)
|
||||
(set-process-filter proc #'vc-process-filter)
|
||||
(setq status proc)
|
||||
(when vc-command-messages
|
||||
(vc-run-delayed
|
||||
(let ((message-truncate-lines t)
|
||||
(inhibit-message vc-inhibit-message))
|
||||
(message "Done in background: %s"
|
||||
full-command)))))
|
||||
;; Run synchronously
|
||||
(when vc-command-messages
|
||||
(let ((inhibit-message vc-inhibit-message))
|
||||
(message "Running in foreground: %s" full-command)))
|
||||
(let ((buffer-undo-list t))
|
||||
(setq status (apply #'process-file
|
||||
command nil t nil squeezed)))
|
||||
(when (and (not (eq t okstatus))
|
||||
(or (not (integerp status))
|
||||
(and okstatus (< okstatus status))))
|
||||
(unless (eq ?\s (aref (buffer-name (current-buffer)) 0))
|
||||
(pop-to-buffer (current-buffer))
|
||||
(goto-char (point-min))
|
||||
(shrink-window-if-larger-than-buffer))
|
||||
(error "Failed (%s): %s"
|
||||
(if (integerp status)
|
||||
(format "status %d" status)
|
||||
status)
|
||||
full-command))
|
||||
(when vc-command-messages
|
||||
(let ((inhibit-message vc-inhibit-message))
|
||||
(message "Done (status=%d): %s"
|
||||
status full-command)))))
|
||||
(vc-run-delayed
|
||||
(run-hook-with-args 'vc-post-command-functions
|
||||
command file-or-list flags))
|
||||
status)))))
|
||||
|
||||
(defvar vc--inhibit-change-window-start nil)
|
||||
|
||||
|
|
@ -424,29 +434,30 @@ of a buffer, which is created.
|
|||
ROOT should be the directory in which the command should be run.
|
||||
The process object is returned.
|
||||
Display the buffer in some window, but don't select it."
|
||||
(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)
|
||||
(proc nil))
|
||||
(let ((dir default-directory)
|
||||
(inhibit-read-only t)
|
||||
window new-window-start proc)
|
||||
(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)
|
||||
(add-hook 'vc-pre-command-functions fun)
|
||||
;; Run in the original working directory.
|
||||
(let ((default-directory dir))
|
||||
(let* (;; Run in the original working directory.
|
||||
(default-directory dir)
|
||||
(orig-fun vc-filter-command-function)
|
||||
(vc-filter-command-function
|
||||
(lambda (&rest args)
|
||||
(cl-destructuring-bind (&whole args cmd _ flags)
|
||||
(apply orig-fun args)
|
||||
(goto-char (point-max))
|
||||
(unless (eq (point) (point-min))
|
||||
(insert " \n"))
|
||||
(setq new-window-start (point))
|
||||
(insert "Running \"" cmd)
|
||||
(dolist (flag flags)
|
||||
(insert " " flag))
|
||||
(insert "\"...\n")
|
||||
args))))
|
||||
(setq proc (apply #'vc-do-command t 'async command nil args))))
|
||||
(setq window (display-buffer buffer))
|
||||
(when (and window
|
||||
|
|
|
|||
|
|
@ -1094,23 +1094,23 @@ It is based on `log-edit-mode', and has Git-specific extensions."
|
|||
(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."
|
||||
(require 'vc-dispatcher)
|
||||
(let* ((root (vc-git-root default-directory))
|
||||
(buffer (format "*vc-git : %s*" (expand-file-name root)))
|
||||
(git-program vc-git-program)
|
||||
;; TODO if pushing, prompt if no default push location - cf bzr.
|
||||
(vc-want-edit-command-p prompt)
|
||||
proc)
|
||||
(require 'vc-dispatcher)
|
||||
(when vc-want-edit-command-p
|
||||
(with-current-buffer (get-buffer-create buffer)
|
||||
(add-hook 'vc-pre-command-functions
|
||||
(lambda (&rest args)
|
||||
(setq git-program (car args)
|
||||
command (caaddr args)
|
||||
extra-args (cdaddr args)))
|
||||
nil t)))
|
||||
(setq proc (apply #'vc-do-async-command
|
||||
buffer root git-program command extra-args))
|
||||
(vc-filter-command-function
|
||||
(if prompt
|
||||
(lambda (&rest args)
|
||||
(cl-destructuring-bind (&whole args git _ flags)
|
||||
(apply #'vc-user-edit-command args)
|
||||
(setq git-program git
|
||||
command (car flags)
|
||||
extra-args (cdr flags))
|
||||
args))
|
||||
vc-filter-command-function))
|
||||
(proc (apply #'vc-do-async-command
|
||||
buffer root git-program command extra-args)))
|
||||
(with-current-buffer buffer
|
||||
(vc-run-delayed
|
||||
(vc-compilation-mode 'git)
|
||||
|
|
|
|||
|
|
@ -2764,7 +2764,9 @@ log."
|
|||
(error "No branch specified"))
|
||||
(let* ((backend (vc-responsible-backend default-directory))
|
||||
(rootdir (vc-call-backend backend 'root default-directory))
|
||||
(vc-want-edit-command-p arg))
|
||||
(vc-filter-command-function (if arg
|
||||
#'vc-user-edit-command
|
||||
vc-filter-command-function)))
|
||||
(vc-print-log-internal backend
|
||||
(list rootdir) branch t
|
||||
(when (> vc-log-show-limit 0) vc-log-show-limit))))
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue