Passing flags using vc-do-command

Passing flags using vc-do-command

[Lute Kamstra]

Hello everyone,

I'm writing a VC backend for Surround SCM, a version control program that is
used at my work.  I try to use vc-do-command to call the CLI of Surround, but
that's giving me some problems.  For example, to check out version 3 of file
"some_file.txt", you need to issue:

  sscm checkout some_file.txt -v3

So you need to pass the switch "checkout" before the file name and "-v3" after
the file name.  vc-do-command does not seem to support that.  As far as I can
tell, it only allows me to pass flags before the file name.  Am I missing
something?  If not, what would be the best way to remedy the situation?

Regards,

  Lute Kamstra

Re: Passing flags using vc-do-command

[Stefan Monnier]

> something?  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.


        Stefan

Re: Passing flags using vc-do-command

[Lute Kamstra]

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

  Lute

Re: Passing flags using vc-do-command

[Stefan Monnier]

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


        Stefan

Re: Passing flags using vc-do-command

[Andy Moreton]

On Wed 09 Mar 2011, Stefan Monnier wrote:

>>>> 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.
>
>
>         Stefan

I think that vc-hg-command does something similar - perhaps it
could be generalised to enhance vc-do-command ?

    AndyM

Re: Passing flags using vc-do-command

[Stefan Monnier]

> I think that vc-hg-command does something similar - perhaps it
> could be generalised to enhance vc-do-command ?

Quite likely.  The vc-<backend>.el files could benefit from merging some
of the process handling with a replacement for vc-do-command which
could (for example) automatically obey `vc-<backend>-program'.


        Stefan

Re: Passing flags using vc-do-command

[Lute Kamstra]

[-- 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

Re: Passing flags using vc-do-command

[Lute Kamstra]

Andy Moreton <andrewjmoreton@gmail.com> writes:

>>> 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.
>>
>>
>>         Stefan
>
> I think that vc-hg-command does something similar - perhaps it
> could be generalised to enhance vc-do-command ?

I'm not sure what you mean.  vc-hg-command simply calls vc-do-command.
It does not duplicate any of its functionality.

  Lute

Re: Passing flags using vc-do-command

[Lute Kamstra]

Lute Kamstra <Lute.Kamstra.lists@xs4all.nl> writes:

> Stefan Monnier <monnier@IRO.UMontreal.CA> writes:
>
>>> 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).

With the help of http://www.emacswiki.org/emacs/BzrForEmacsDevs (clear
and concise explanation, by the way), I was able to set bazaar up
properly.  So now I should be able to commit the change myself.  If
nobody objects, I'll do that in a couple of days.

  Lute

Re: Passing flags using vc-do-command

[Stefan Monnier]

> + (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.")

Do we really need that?

> ! (defun vc-do-command-1 (buffer okstatus command file-or-list
> ! 			&optional before-flag-or-list &rest after-flags)

I'd rather a nicer name for the new command.
And I'd like it to address some of the other needs of backends,
e.g. paying attention to vc-<backend>-program.  So I think we should
look at the calls to vc-do-command (and to
call-process/start-process/...) in backends to try and design the
successor to vc-do-command.


        Stefan

Re: Passing flags using vc-do-command

[Lute Kamstra]

Stefan Monnier <monnier@iro.umontreal.ca> writes:

>> + (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.")
>
> Do we really need that?
>
>> ! (defun vc-do-command-1 (buffer okstatus command file-or-list
>> ! 			&optional before-flag-or-list &rest after-flags)
>
> I'd rather a nicer name for the new command.
> And I'd like it to address some of the other needs of backends,
> e.g. paying attention to vc-<backend>-program.  So I think we should
> look at the calls to vc-do-command (and to
> call-process/start-process/...) in backends to try and design the
> successor to vc-do-command.

I'm open to suggestions for a better name...  But maybe it's cleaner to
make an incompatible change and just replace vc-do-command.  I could
change all calls to vc-do-command in trunk, but I have no idea how many
backends exist outside the emacs repository.  Replacing vc-do-command
would also eliminate my need of a second hook variable.  What do people
say?

I could take a look at the current uses of vc-do-command / call-process
/ start-process in the various backends in trunk to see if I can
accommodate for possible other shortcomings of the current version.  But
I'd appreciate some help with that: If people could give me concrete
examples of useful additions, that would be great.

  Lute

Re: Passing flags using vc-do-command

[Stefan Monnier]

> I'm open to suggestions for a better name...

There's a lot of freedom here: vc-run, vc-run-process, vc-run-command,
vc-do-process, vc-call-process, ...

> But maybe it's cleaner to make an incompatible change and just replace
> vc-do-command.

You don't have throw away vc-do-command right away, but yes, make
a brand new command without paying attention to vc-do-command, adding
the features that would be handy, and maybe dropping some that aren't
needed any more.

It should pay particular attention to asynchronous execution, since more
commands should be changed (in the future) to use asynchronous
execution, and that feature was added to vc-do-command "with minimal
changes" which ends up not being always the most convenient.

> I could take a look at the current uses of vc-do-command / call-process
> / start-process in the various backends in trunk to see if I can
> accommodate for possible other shortcomings of the current version.  But
> I'd appreciate some help with that: If people could give me concrete
> examples of useful additions, that would be great.

As mentioned I think it should centralize/unify the handling of
vc-<backend>-program, and maybe also some of the handling of
vc-<foo>-switches.


        Stefan