[PATCH] emacs: Echo the output of notmuch new as it runs
Austin Clements
amdragon at MIT.EDU
Mon Jun 24 15:32:25 PDT 2013
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
More information about the notmuch
mailing list