vc-do-command: Support discarding standard error

* lisp/vc/vc-dispatcher.el (vc-do-command): Support discarding
standard error.
* lisp/vc/vc-hg.el (vc-hg-dir-status-files): Discard standard
error of 'hg status' to avoid parsing mistakes.
(vc-hg-command): Update docstring given new meaning of first
argument to vc-do-command.
* test/lisp/vc/vc-tests/vc-test-misc.el (vc-test-do-command-1)
(vc-test-do-command-2, vc-test-do-command-3)
(vc-test-do-command-4, vc-test-do-command-5)
(vc-test-do-command-6, vc-test-do-command-7): New tests.

lisp/vc/vc-dispatcher.el

@@ -378,22 +378,44 @@ Intended to be used as the value of `vc-filter-command-function'."
           (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.
-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).
+(defun vc-do-command (destination okstatus command file-or-list &rest flags)
+  "Execute an inferior command, notifying user and checking for errors.
+DESTINATION specifies what to do with COMMAND's output.  It can be a
+buffer or the name of a buffer to insert output there, t to mean the
+current buffer, or nil to discard output.
+DESTINATION can also have the form (REAL-BUFFER STDERR-FILE); in that
+case, REAL-BUFFER says what to do with standard output, as above, while
+STDERR-FILE says what to do with standard error in the child.
+STDERR-FILE may only be nil which means to discard standard error
+output or t which means to mix it with standard output.
+If the destination for standard output is a buffer that is not the
+current buffer, set up the buffer 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 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."
+Return the return value of the inferior command in the synchronous case,
+and the process object in the asynchronous case."
+  ;; STDERR-FILE is limited to nil or t, instead of also supporting
+  ;; putting stderr output into a buffer or file, because of how we
+  ;; support both synchronous and asynchronous execution.
+  ;; `call-process' supports STDERR-FILE being a file name but not a
+  ;; buffer, while `make-process' with `:file-handler' non-nil supports
+  ;; putting stderr output in a buffer but not in a file (see Info node
+  ;; `(elisp) Asynchronous Processes' for this detail).  I.e. the only
+  ;; options supported by both `call-process' and `make-process' are
+  ;; discarding stderr output or mixing it with stdout.
+  (cl-assert (or (atom destination)
+                 (and (length= destination 2)
+                      (memq (cadr destination) '(t nil))))
+             nil
+             "Invalid DESTINATION argument to `vc-do-command': %s"
+             destination)
   (pcase-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,
@@ -402,13 +424,17 @@ case, and the process object in the asynchronous case."
               (vc-inhibit-message
                (or (eq vc-command-messages 'log)
                    (eq (selected-window) (active-minibuffer-window))))
+
               (`(,command ,file-or-list ,flags)
                (funcall vc-filter-command-function
-                        command file-or-list flags)))
+                        command file-or-list flags))
+              ((or `(,stdout ,stderr) (and stdout (let stderr t)))
+               destination))
     (save-current-buffer
-      (unless (or (eq buffer t)
-                  (eq (current-buffer) (get-buffer buffer)))
-        (vc-setup-buffer buffer))
+      (unless (or (memq stdout '(t nil))
+                  (eq (current-buffer) (get-buffer stdout)))
+        (vc-setup-buffer stdout)
+        (setq stdout t))
       (when vc-tor
         (push command flags)
         (setq command "torsocks"))
@@ -439,18 +465,24 @@ case, and the process object in the asynchronous case."
               (w32-quote-process-args t))
           (if (eq okstatus 'async)
               ;; Run asynchronously.
-              (let ((proc
-                     (let (process-connection-type)
-                       (apply #'start-file-process command
-                              (current-buffer) command squeezed))))
+              (let* ((stderr-buf
+                      (and (not stderr)
+                           (generate-new-buffer " *temp*" t)))
+                     (proc
+                      (make-process :name command
+                                    :buffer (and stdout (current-buffer))
+                                    :command (cons command squeezed)
+                                    :connection-type nil
+                                    :filter #'vc-process-filter
+                                    :sentinel #'ignore
+                                    :stderr stderr-buf
+                                    :file-handler t)))
+                (when stderr-buf
+                  (vc-run-delayed (kill-buffer stderr-buf)))
                 (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
@@ -463,8 +495,8 @@ case, and the process object in the asynchronous case."
               (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)))
+              (setq status (apply #'process-file command nil
+                                  (list stdout stderr) nil squeezed)))
             (when (and (not (eq t okstatus))
                        (or (not (integerp status))
                            (and okstatus (< okstatus status))))

lisp/vc/vc-hg.el

@@ -1518,7 +1518,7 @@ REV is the revision to check out into WORKFILE."
   ;; XXX: We can't pass DIR directly to 'hg status' because that
   ;; returns all ignored files if FILES is non-nil (bug#22481).
   (let ((default-directory dir))
-    (apply #'vc-hg-command (current-buffer) 'async files
+    (apply #'vc-hg-command '(t nil) 'async files
            "status" (concat "-mardu" (if files "i")) "-C"
            (if (version<= "4.2" (vc-hg--program-version))
                '("--config" "commands.status.relative=1")
@@ -1700,7 +1700,7 @@ This runs the command \"hg merge\"."
 (defun vc-hg-command (buffer okstatus file-or-list &rest flags)
   "A wrapper around `vc-do-command' for use in vc-hg.el.
 This function differs from `vc-do-command' in that
-- BUFFER may be nil
+- BUFFER nil means use a buffer called \"*vc*\"
 - it invokes `vc-hg-program' and passes `vc-hg-global-switches' to it
   before FLAGS."
   ;; Commands which pass command line arguments which might

test/lisp/vc/vc-tests/vc-test-misc.el

@@ -163,5 +163,65 @@
       (vc-test--exec-after-wait)
       (should (eq (point) (point-min))))))
 
+(ert-deftest vc-test-do-command-1 ()
+  "Test `vc-run-command' synchronous, discarding stderr."
+  (with-temp-buffer
+    (vc-do-command '(t nil) 0 "sh" nil "-c" "echo foo; echo >&2 bar")
+    (should (equal (buffer-string) "foo\n"))))
+
+(ert-deftest vc-test-do-command-2 ()
+  "Test `vc-run-command' synchronous, keeping stderr."
+  (with-temp-buffer
+    (vc-do-command t 0 "sh" nil "-c" "echo foo; echo >&2 bar")
+    (goto-char (point-min))
+    (should (save-excursion (re-search-forward "foo" nil t)))
+    (should (save-excursion (re-search-forward "bar" nil t)))))
+
+(ert-deftest vc-test-do-command-3 ()
+  "Test `vc-run-command' synchronous, discarding both."
+  (with-temp-buffer
+    (vc-do-command '(nil t) 0 "sh" nil "-c" "echo foo; echo >&2 bar")
+    (should (bobp))))
+
+(ert-deftest vc-test-do-command-4 ()
+  "Test `vc-run-command' asynchronous, discarding stderr."
+  (with-temp-buffer
+    (let ((proc (vc-do-command '(t nil) 'async "sh" nil
+                               "-c" "echo foo; echo >&2 bar"))
+          success)
+      (vc-test--exec-after-wait)
+      (should (equal (buffer-string) "foo\n")))))
+
+(ert-deftest vc-test-do-command-5 ()
+  "Test `vc-run-command' asynchronous, keeping stderr."
+  (with-temp-buffer
+    (let ((proc (vc-do-command t 'async "sh" nil
+                               "-c" "echo foo; echo >&2 bar"))
+          success)
+      (vc-test--exec-after-wait)
+      (goto-char (point-min))
+      (should (save-excursion (re-search-forward "foo" nil t)))
+      (should (save-excursion (re-search-forward "bar" nil t))))))
+
+(ert-deftest vc-test-do-command-6 ()
+  "Test `vc-run-command' asynchronous, discarding both."
+  (with-temp-buffer
+    (let ((proc (vc-do-command '(nil t) 'async "sh" nil
+                               "-c" "echo foo; echo >&2 bar"))
+          success)
+      (vc-test--exec-after-wait)
+      (should (bobp)))))
+
+(ert-deftest vc-test-do-command-7 ()
+  "Test `vc-run-command' setting up the buffer."
+  (let ((buf (generate-new-buffer " *temp*" t)))
+    (unwind-protect
+        (progn
+          (vc-do-command (list buf nil) 0 "sh" nil
+                         "-c" "echo foo; echo >&2 bar")
+          (with-current-buffer buf
+            (should (equal (buffer-string) "foo\n"))))
+      (kill-buffer buf))))
+
 (provide 'vc-test-misc)
 ;;; vc-test-misc.el ends here