From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Lute Kamstra Newsgroups: gmane.emacs.devel Subject: Re: Passing flags using vc-do-command Date: Sat, 12 Mar 2011 09:29:56 +0100 Message-ID: <87mxl0pwqj.fsf@speer.lan> References: <87lj0qstpw.fsf@speer.lan> <87lj0oyfar.fsf@speer.lan> NNTP-Posting-Host: lo.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: dough.gmane.org 1299918622 9883 80.91.229.12 (12 Mar 2011 08:30:22 GMT) X-Complaints-To: usenet@dough.gmane.org NNTP-Posting-Date: Sat, 12 Mar 2011 08:30:22 +0000 (UTC) Cc: emacs-devel@gnu.org To: Stefan Monnier Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Sat Mar 12 09:30:17 2011 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([199.232.76.165]) by lo.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1PyKDI-0006JC-RX for ged-emacs-devel@m.gmane.org; Sat, 12 Mar 2011 09:30:17 +0100 Original-Received: from localhost ([127.0.0.1]:40056 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1PyKDH-0002Z6-DK for ged-emacs-devel@m.gmane.org; Sat, 12 Mar 2011 03:30:15 -0500 Original-Received: from [140.186.70.92] (port=47267 helo=eggs.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1PyKD8-0002XY-Np for emacs-devel@gnu.org; Sat, 12 Mar 2011 03:30:09 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1PyKD4-0001Yv-6v for emacs-devel@gnu.org; Sat, 12 Mar 2011 03:30:04 -0500 Original-Received: from smtp-vbr10.xs4all.nl ([194.109.24.30]:1402) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1PyKD3-0001We-Po for emacs-devel@gnu.org; Sat, 12 Mar 2011 03:30:02 -0500 Original-Received: from speer.lan (a80-101-193-22.adsl.xs4all.nl [80.101.193.22]) by smtp-vbr10.xs4all.nl (8.13.8/8.13.8) with ESMTP id p2C8TvL5021788 (version=TLSv1/SSLv3 cipher=AES256-SHA bits=256 verify=NO); Sat, 12 Mar 2011 09:29:58 +0100 (CET) (envelope-from Lute.Kamstra.lists@xs4all.nl) Original-Received: from lute by speer.lan with local (Exim 4.74) (envelope-from ) id 1PyKCy-0006kA-LQ; Sat, 12 Mar 2011 09:29:57 +0100 In-Reply-To: (Stefan Monnier's message of "Wed, 09 Mar 2011 13:21:14 -0500") User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/24.0.50 (gnu/linux) Original-Lines: 26 X-Virus-Scanned: by XS4ALL Virus Scanner X-detected-operating-system: by eggs.gnu.org: FreeBSD 4.6-4.9 X-Received-From: 194.109.24.30 X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.5 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Original-Sender: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.devel:137138 Archived-At: --=-=-= Content-Type: text/plain Stefan Monnier 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 --=-=-= Content-Type: text/x-diff Content-Disposition: inline; filename=vc-dispatcher.el.diff === 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 + + * 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 * 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 * 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 --=-=-=--