Re: Passing flags using vc-do-command

[Lute Kamstra]

Stefan Monnier <address@hidden> 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

=== 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  <address@hidden>
+
+       * 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  <address@hidden>

        * 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  <address@hidden>

        * 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