From: Austin Clements <amdragon@MIT.EDU>
To: notmuch@notmuchmail.org
Subject: [PATCH] emacs: Echo the output of notmuch new as it runs
Date: Mon, 24 Jun 2013 18:32:25 -0400
Message-Id: <1372113145-1944-1-git-send-email-amdragon@mit.edu>
Precedence: list

Previously, when the user pressed "G" to invoke notmuch new, Emacs
would go out to lunch until it finished, giving the user no sense that
the (potentially long-running) notmuch new process was making
progress.  This patch fixes this by continuously updating the echo
area to display the last output line of notmuch new as it runs.
---

This turned out to be a little more complex than I was expecting, but
the effect is really nice, especially if you have a slow computer.

 emacs/notmuch-lib.el |   87 ++++++++++++++++++++++++++++++++++++++++++++++++++
 emacs/notmuch.el     |    5 +--
 2 files changed, 90 insertions(+), 2 deletions(-)

diff --git a/emacs/notmuch-lib.el b/emacs/notmuch-lib.el
index 534f217..5329146 100644
--- a/emacs/notmuch-lib.el
+++ b/emacs/notmuch-lib.el
@@ -372,6 +372,9 @@ returned by FUNC."
       (put-text-property start next prop (funcall func value) object)
       (setq start next))))
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Process helpers
+
 (defun notmuch-logged-error (msg &optional extra)
   "Log MSG and EXTRA to *Notmuch errors* and signal MSG.
 
@@ -554,6 +557,90 @@ status."
        (message "%s" (error-message-string err))))
     (ignore-errors (delete-file err-file))))
 
+(defun notmuch-call-process-with-progress (msg-prefix program &rest args)
+  "Call PROGRAM with ARGS, tailing its last line in the echo area.
+
+This is useful for potentially long-running commands that print
+their progress, since it will continuously display the last line
+of the command's output in the echo area as it runs.  In other
+respects, this is very similar to `call-process': it's
+synchronous, handles quits the same way, and its return value is
+the same.
+
+MSG-PREFIX is the string to prefix echo area messages with.  If
+nil, the message will be constructed from PROGRAM."
+
+  (unless msg-prefix
+    (setq msg-prefix (format "Running %s" program)))
+
+  (with-temp-buffer
+    (let* (;; Inhibit quit until we're ready to handle it properly
+	   (inhibit-quit t)
+	   (proc
+	    (let ((process-environment
+		   ;; We emulate a (very lame) VT100
+		   (cons "TERM=vt100" process-environment)))
+	      (apply #'start-process program (current-buffer) program args)))
+	   (filter
+	    (lambda (proc string)
+	      (when (buffer-live-p (process-buffer proc))
+		(with-current-buffer (process-buffer proc)
+		  (goto-char (point-max))
+		  ;; Treat both \r and \n as newline
+		  (insert (replace-regexp-in-string "\r" "\n" string))
+		  ;; Find the beginning of the last line with content
+		  ;; (which might be the line we're on)
+		  (while (and (bolp) (not (bobp)))
+		    (backward-char))
+		  (beginning-of-line)
+		  (delete-region (point-min) (point))
+		  ;; Strip VT100 control sequences.  This isn't
+		  ;; perfect, but it's simple and it'll handle anything
+		  ;; we're likely to see.
+		  (save-excursion
+		    (while (re-search-forward "\e\\[[0-9;?$]*[@a-zA-Z]" nil t)
+		      (replace-match "")))
+		  ;; Update the minibuffer.  The text is after the
+		  ;; "..." so that Emacs will update the line in
+		  ;; *Messages* rather than flooding the log.
+		  (message "%s... %s" (process-get proc 'msg-prefix)
+			   (buffer-substring (point) (line-end-position)))))))
+	   (sentinel
+	    (lambda (proc event)
+	      ;; This is the only way to get signal names
+	      (process-put proc 'sentinel-event (substring event 0 -1)))))
+      (process-put proc 'msg-prefix msg-prefix)
+      (set-process-filter proc filter)
+      (set-process-sentinel proc sentinel)
+      (process-send-eof proc)
+      (message "%s..." msg-prefix)
+
+      ;; Wait for termination, emulating `call-process'
+      (unwind-protect
+	  (while (eq (process-status proc) 'run)
+	    (let ((inhibit-quit nil))
+	      (accept-process-output proc nil nil t)))
+	(when (eq (process-status proc) 'run)
+	  (interrupt-process proc t)
+	  (message "Waiting for process to die...(type C-g again to kill it instantly)")
+	  (unwind-protect
+	      (while (eq (process-status proc) 'run)
+		(let ((inhibit-quit nil))
+		  (accept-process-output proc nil nil t)))
+	    (delete-process proc))
+	  (message "Waiting for process to die...done")))
+
+      ;; Print the final status message and return like `call-process'
+      (let ((event (process-get proc 'sentinel-event))
+	    (status (process-status proc))
+	    (exit-status (process-exit-status proc)))
+	(if (eq status 'exit)
+	    (progn
+	      (message "%s...%s" msg-prefix (if (= exit-status 0) "done" event))
+	      exit-status)
+	  (message "%s...%s" msg-prefix event)
+	  event)))))
+
 ;; This variable is used only buffer local, but it needs to be
 ;; declared globally first to avoid compiler warnings.
 (defvar notmuch-show-process-crypto nil)
diff --git a/emacs/notmuch.el b/emacs/notmuch.el
index a9949a1..9949b6c 100644
--- a/emacs/notmuch.el
+++ b/emacs/notmuch.el
@@ -996,8 +996,9 @@ depending on the value of `notmuch-poll-script'."
   (interactive)
   (if (stringp notmuch-poll-script)
       (unless (string= notmuch-poll-script "")
-	(call-process notmuch-poll-script nil nil))
-    (call-process notmuch-command nil nil nil "new")))
+	(notmuch-call-process-with-progress nil notmuch-poll-script))
+    (notmuch-call-process-with-progress
+     "Checking for mail" notmuch-command "new")))
 
 (defun notmuch-search-poll-and-refresh-view ()
   "Invoke `notmuch-poll' to import mail, then refresh the current view."
-- 
1.7.10.4