Add basic mode for displaying {call,start}-process output

2 files changed, 86 insertions, 34 deletions

diff --git a/piem-b4.el b/piem-b4.el
index baa26a4..b00b9f8 100644
--- a/piem-b4.el
+++ b/piem-b4.el
@@ -74,28 +74,8 @@ the following information about the patch series:
 
 ;;;; Internals
 
-(define-error 'piem-b4-error "piem-b4 error")
-
 (defconst piem-b4-output-buffer "*piem-b4-output*")
 
-;; TODO: Use an asynchronous process.
-(defun piem-b4--call (program infile &rest args)
-  (let ((temp-buffer-show-function (lambda (_))))
-    (with-output-to-temp-buffer piem-b4-output-buffer
-      (unless (= 0 (apply #'call-process program
-                          infile standard-output nil
-                          (remq nil args)))
-        (display-buffer piem-b4-output-buffer)
-        (signal 'piem-b4-error
-                (list (format "%s call in %s failed"
-                              program default-directory)))))))
-
-(defun piem-b4--call-b4 (infile &rest args)
-  (apply #'piem-b4--call piem-b4-b4-executable infile args))
-
-(defun piem-b4--call-git (infile &rest args)
-  (apply #'piem-b4--call piem-b4-git-executable infile args))
-
 (defun piem-b4--series-info (cover patches)
   "Collect information for a patch series.
 COVER is an mbox with the cover letter, and PATCHES is an
@@ -195,13 +175,13 @@ in `piem-b4-default-branch-function'."
           (setq custom-p t))))
     ;; Move to the coderepo so that we pick up any b4 configuration
     ;; from there.
-    (let ((default-directory coderepo))
-      (apply #'piem-b4--call-b4 nil "am"
-             (and custom-p
-                  (concat "--use-local-mbox=" mbox-thread))
-             (concat "--outdir=" outdir)
-             (concat "--mbox-name=m")
-             (append args (list mid))))
+    (apply #'piem-process-call piem-b4-output-buffer coderepo
+           piem-b4-b4-executable "am"
+           (and custom-p
+                (concat "--use-local-mbox=" mbox-thread))
+           (concat "--outdir=" outdir)
+           (concat "--mbox-name=m")
+           (append args (list mid)))
     (let ((mbox-cover (concat root ".cover"))
           (mbox-am (concat root ".mbx")))
       (list (and (file-exists-p mbox-cover)
@@ -217,16 +197,16 @@ in `piem-b4-default-branch-function'."
 (defun piem-b4-am-ready-from-mbox (mbox &optional args)
   (interactive (list (read-file-name "mbox: ")
                      (transient-args 'piem-b4-am)))
-  (apply #'piem-b4--call-b4 nil "am"
-         (cons (concat "--use-local-mbox=" mbox) args))
-  (display-buffer piem-b4-output-buffer))
+  (apply #'piem-process-start piem-b4-output-buffer nil
+         piem-b4-b4-executable "am"
+         (cons (concat "--use-local-mbox=" mbox) args)))
 
 ;;;###autoload
 (defun piem-b4-am-ready-from-mid (mid &optional args)
   (interactive (list (read-string "Message ID: " nil nil (piem-mid))
                      (transient-args 'piem-b4-am)))
-  (apply #'piem-b4--call-b4 nil "am" (append args (list mid)))
-  (display-buffer piem-b4-output-buffer))
+  (apply #'piem-process-start piem-b4-output-buffer nil
+         piem-b4-b4-executable "am" (append args (list mid))))
 
 ;;;###autoload
 (defun piem-b4-am-from-mid (mid &optional args)
@@ -266,12 +246,15 @@ in `piem-b4-default-branch-function'."
                                    (magit-list-local-branch-names)))
                        (base (plist-get info :base-commit)))
                    (if base (cons base cands) cands)))))
-      (apply #'piem-b4--call-git nil "checkout"
+      (apply #'piem-process-call piem-b4-output-buffer nil
+             piem-b4-git-executable "checkout"
              (append (if (string-empty-p new-branch)
                          (list "--detach")
                        (list "-b" new-branch))
                      (list base))))
-    (piem-b4--call-git mbox-file "am" "--scissors")
+    (piem-process-call piem-b4-output-buffer nil
+                       piem-b4-git-executable "am" "--scissors"
+                       mbox-file)
     (if (and piem-b4-use-magit
              (fboundp 'magit-status-setup-buffer))
         (magit-status-setup-buffer)
diff --git a/piem.el b/piem.el
index 9695511..a6b3819 100644
--- a/piem.el
+++ b/piem.el
@@ -130,6 +130,75 @@ intended to be used by libraries implementing a function for
               (throw 'hit (car inbox)))))))))
 
 
+;;;; Subprocess handling
+
+(defvar piem-process-mode-font-lock-keywords
+  `((,(rx line-start
+          ";;; " (or "process" "directory") ":" (one-or-more not-newline)
+          line-end)
+      (0 font-lock-comment-face t))
+    (,(rx line-start
+          "Process " (one-or-more not-newline) " finished"
+          line-end)
+     (0 font-lock-comment-face))))
+
+(define-derived-mode piem-process-mode nil "piem-process"
+  "Major mode for displaying processes created by piem."
+  :group 'piem
+  (setq buffer-read-only t)
+  (setq-local window-point-insertion-type t)
+  (setq-local font-lock-defaults
+              '(piem-process-mode-font-lock-keywords)))
+
+(define-error 'piem-process-error "piem process error")
+
+(defvar-local piem--buffer-process nil)
+
+(defun piem--process-go (buffer dir program program-args fn)
+  (setq dir (or dir default-directory))
+  (setq buffer (get-buffer-create buffer))
+  (with-current-buffer buffer
+    (when (and piem--buffer-process
+               (process-live-p piem--buffer-process))
+      (user-error "Buffer %s already has an active process: %s"
+                  (current-buffer) piem--buffer-process))
+    (unless (derived-mode-p 'piem-process-mode)
+      (piem-process-mode))
+    (setq default-directory (file-name-as-directory dir))
+    (display-buffer buffer)
+    (let ((inhibit-read-only t))
+      (insert (format "
+%s
+;;; process: %S
+;;; directory:  %s
+"
+                      (char-to-string 12) ; form feed
+                      (cons program program-args)
+                      default-directory))
+      (funcall fn))))
+
+(defun piem-process-start (buffer dir program &rest program-args)
+  (setq program-args (remq nil program-args))
+  (piem--process-go
+   buffer dir program program-args
+   (lambda ()
+     (setq piem--buffer-process
+          (apply #'start-process
+                 (file-name-nondirectory program)
+                 (current-buffer)
+                 program program-args)))))
+
+(defun piem-process-call (buffer dir program &rest program-args)
+  (setq program-args (remq nil program-args))
+  (piem--process-go
+   buffer dir program program-args
+   (lambda ()
+     (unless (= 0 (apply #'call-process program nil t nil program-args))
+       (signal 'piem-error
+               (list (format "%s call in %s failed"
+                             program default-directory)))))))
+
+
 ;;;; Extractors
 
 (defun piem-inbox ()