Re: Passing flags using vc-do-command

[Lute Kamstra <Lute.Kamstra.lists@xs4all.nl>]

[-- Attachment #1: Type: text/plain, Size: 869 bytes --]

Stefan Monnier <monnier@IRO.UMontreal.CA> writes:

>>>> If not, what would be the best way to remedy the situation?
>>> Don't use vc-do-command and use process-file or
>>> start-file-process directly.
>> That way, I would have to duplicate a considerable amount of the
>> functionality of vc-do-command.
>
> Another option is to pass nil for the file-or-list argument.
>
>> What about adding a more versatile version of vc-do-command that
>> accepts after-flags as well as before-flags and implement the current
>> vc-do-command using that?  I could implement it and send in a patch.
>
> That could work as well.

Here is a patch that implements the more versatile function.  I could
not think of a more meaningful name.  Feel free to rename it.  If people
agree with the patch, could someone please install it for me?  I haven't
got a proper bzr setup (yet).

  Lute


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: vc-dispatcher.el.diff --]
[-- Type: text/x-diff, Size: 11683 bytes --]

=== modified file 'lisp/ChangeLog'
*** lisp/ChangeLog	2011-03-12 04:29:22 +0000
--- lisp/ChangeLog	2011-03-12 08:14:22 +0000
***************
*** 1,3 ****
--- 1,12 ----
+ 2011-03-11  Lute Kamstra  <lute@gnu.org>
+
+ 	* vc/vc-dispatcher.el (vc-post-command-1-functions): New variable.
+ 	(vc-post-command-functions): Improve docstring.
+ 	(vc-do-command-1): New function that generalizes vc-do-command by
+ 	accepting after flags as well as before flags.
+ 	(vc-do-command): Improve docstring and implement using
+ 	vc-do-command-1.
+
  2011-03-12  Stefan Monnier  <monnier@iro.umontreal.ca>

  	* progmodes/compile.el (compilation--previous-directory): Fix up
***************
*** 15,21 ****
  	mode-line redisplay warnings.
  	Also, clarify the module description and fix a comment typo.

-
  2011-03-11  Juanma Barranquero  <lekktu@gmail.com>

  	* help-fns.el (describe-variable): Don't complete keywords.
--- 24,29 ----

=== modified file 'lisp/vc/vc-dispatcher.el'
*** lisp/vc/vc-dispatcher.el	2011-02-19 21:23:51 +0000
--- lisp/vc/vc-dispatcher.el	2011-03-11 06:17:33 +0000
***************
*** 254,263 ****
       (t (error "Unexpected process state"))))
    nil)

  (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
! and is passed 3 arguments: the COMMAND, the FILES and the FLAGS.")

  (defvar w32-quote-process-args)

--- 254,270 ----
       (t (error "Unexpected process state"))))
    nil)

+ (defvar vc-post-command-1-functions nil
+   "Hook run at the end of `vc-do-command-1'.
+ Each function is called inside the buffer in which the command
+ was run and is passed 4 arguments: the COMMAND, the FILE-OR-LIST,
+ the BEFORE-FLAGS and the AFTER-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 and is passed 3 arguments: the COMMAND, the FILE-OR-LIST
! and the BEFORE-FLAGS.")

  (defvar w32-quote-process-args)

***************
*** 267,273 ****
    (if (not filelist) "."  (mapconcat 'identity filelist " ")))

  ;;;###autoload
! (defun vc-do-command (buffer okstatus command file-or-list &rest flags)
    "Execute a slave command, notifying user and checking for errors.
  Output from COMMAND goes to BUFFER, or the current buffer if
  BUFFER is t.  If the destination buffer is not already current,
--- 274,281 ----
    (if (not filelist) "."  (mapconcat 'identity filelist " ")))

  ;;;###autoload
! (defun vc-do-command-1 (buffer okstatus command file-or-list
! 			&optional before-flag-or-list &rest after-flags)
    "Execute a slave command, notifying user and checking for errors.
  Output from COMMAND goes to BUFFER, or the current buffer if
  BUFFER is t.  If the destination buffer is not already current,
***************
*** 278,304 ****
  subprocess; if it is t it means to ignore all execution errors).
  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.
! Return the return value of the slave command in the synchronous
! case, and the process object in the asynchronous case."
    ;; 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))))
  	 (full-command
! 	  ;; What we're doing here is preparing a version of the command
! 	  ;; for display in a debug-progress message.  If it's fewer than
! 	  ;; 20 characters display the entire command (without trailing
! 	  ;; newline).  Otherwise display the first 20 followed by an ellipsis.
  	  (concat (if (string= (substring command -1) "\n")
  		      (substring command 0 -1)
  		    command)
! 		  " "
! 		  (vc-delistify (mapcar (lambda (s) (if (> (length s) 20) (concat (substring s 0 2) "...")  s)) flags))
! 		  " " (vc-delistify files))))
      (save-current-buffer
        (unless (or (eq buffer t)
  		  (and (stringp buffer)
--- 286,322 ----
  subprocess; if it is t it means to ignore all execution errors).
  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).	The optional BEFORE-FLAG-OR-LIST is a
! single flag or a list of flags that is inserted into the command
! line before the file names.  The optional list of AFTER-FLAGS is
! inserted after the file names.	After executing the slave
! command, run `vc-post-command-1-functions'.  Return the return
! value of the slave command in the synchronous case, and the
! process object in the asynchronous case."
    ;; 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* ((before-flags
! 	  (if (listp before-flag-or-list)
! 	      before-flag-or-list
! 	    (list before-flag-or-list)))
! 	 (files
  	  (mapcar (lambda (f) (file-relative-name (expand-file-name f)))
  		  (if (listp file-or-list) file-or-list (list file-or-list))))
+ 	 (shorten-flags
+ 	  (lambda (flag)
+ 	    (if (> (length flag) 20)
+ 		(concat (substring flag 0 2) "...")
+ 	      flag)))
  	 (full-command
! 	  ;; Prepare a version of the command for display in a
! 	  ;; debug-progress message.
  	  (concat (if (string= (substring command -1) "\n")
  		      (substring command 0 -1)
  		    command)
! 		  " " (vc-delistify (mapcar shorten-flags before-flags))
! 		  " " (vc-delistify files)
! 		  " " (vc-delistify (mapcar shorten-flags after-flags)))))
      (save-current-buffer
        (unless (or (eq buffer t)
  		  (and (stringp buffer)
***************
*** 307,322 ****
  	(vc-setup-buffer buffer))
        ;; If there's some previous async process still running, just kill it.
        (let ((oldproc (get-buffer-process (current-buffer))))
!         ;; If we wanted to wait for oldproc to finish before doing
!         ;; something, we'd have used vc-eval-after.
!         ;; Use `delete-process' rather than `kill-process' because we don't
!         ;; want any of its output to appear from now on.
!         (when oldproc (delete-process oldproc)))
!       (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))
--- 325,342 ----
  	(vc-setup-buffer buffer))
        ;; If there's some previous async process still running, just kill it.
        (let ((oldproc (get-buffer-process (current-buffer))))
! 	;; If we wanted to wait for oldproc to finish before doing
! 	;; something, we'd have used vc-eval-after.
! 	;; Use `delete-process' rather than `kill-process' because we don't
! 	;; want any of its output to appear from now on.
! 	(when oldproc (delete-process oldproc)))
!       (let ((squeezed (remq nil before-flags))
  	    (inhibit-read-only t)
  	    (status 0))
  	(when files
  	  (setq squeezed (nconc squeezed files)))
+ 	(when after-flags
+ 	  (setq squeezed (nconc squeezed (remq nil after-flags))))
  	(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))
***************
*** 326,332 ****
  	      (let ((proc
  		     (let ((process-connection-type nil))
  		       (apply 'start-file-process command (current-buffer)
!                               command squeezed))))
  		(when vc-command-messages
  		  (message "Running %s in background..." full-command))
  		;;(set-process-sentinel proc (lambda (p msg) (delete-process p)))
--- 346,352 ----
  	      (let ((proc
  		     (let ((process-connection-type nil))
  		       (apply 'start-file-process command (current-buffer)
! 			      command squeezed))))
  		(when vc-command-messages
  		  (message "Running %s in background..." full-command))
  		;;(set-process-sentinel proc (lambda (p msg) (delete-process p)))
***************
*** 343,361 ****
  	    (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 "Running %s...FAILED (%s)" full-command
  		     (if (integerp status) (format "status %d" status) status)))
  	    (when vc-command-messages
  	      (message "Running %s...OK = %d" full-command status))))
! 	(vc-exec-after
! 	 `(run-hook-with-args 'vc-post-command-functions
! 			      ',command ',file-or-list ',flags))
  	status))))

  (defun vc-do-async-command (buffer root command &rest args)
    "Run COMMAND asynchronously with ARGS, displaying the result.
  Send the output to BUFFER, which should be a buffer or the name
--- 363,409 ----
  	    (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 "Running %s...FAILED (%s)" full-command
  		     (if (integerp status) (format "status %d" status) status)))
  	    (when vc-command-messages
  	      (message "Running %s...OK = %d" full-command status))))
! 	(when vc-post-command-1-functions ; so vc-do-command can suppress this
! 	  (vc-exec-after
! 	   `(run-hook-with-args 'vc-post-command-1-functions
! 				',command ',file-or-list
! 				',before-flags ',after-flags)))
  	status))))

+ ;;;###autoload
+ (defun vc-do-command (buffer okstatus command file-or-list &rest before-flags)
+   "Execute a slave command, notifying user and checking for errors.
+ Output from COMMAND goes to BUFFER, or the current buffer if
+ BUFFER is t.  If the destination buffer is not already current,
+ set it up properly and erase it.  The command is considered
+ successful if its exit status does not exceed OKSTATUS (if
+ OKSTATUS is nil, that means to ignore error status, if it is
+ `async', that means not to wait for termination of the
+ subprocess; if it is t it means to ignore all execution errors).
+ 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 BEFORE-FLAGS is
+ present, that is inserted into the command line before the file
+ names.	After executing the slave command, run
+ `vc-post-command-functions'.  Return the return value of the
+ slave command in the synchronous case, and the process object in
+ the asynchronous case."
+   (let* (vc-post-command-1-functions	; bind to suppress running it
+ 	 (status
+ 	  (vc-do-command-1 buffer okstatus command file-or-list before-flags)))
+     (vc-exec-after
+      `(run-hook-with-args 'vc-post-command-functions
+ 			  ',command ',file-or-list ',before-flags))
+     status))
+
  (defun vc-do-async-command (buffer root command &rest args)
    "Run COMMAND asynchronously with ARGS, displaying the result.
  Send the output to BUFFER, which should be a buffer or the name