85/a2d8715e756af5a2a231a633ca06f8147bf72f

   1 Return-Path: <amdragon@mit.edu>\r
   2 X-Original-To: notmuch@notmuchmail.org\r
   3 Delivered-To: notmuch@notmuchmail.org\r
   4 Received: from localhost (localhost [127.0.0.1])\r
   5         by olra.theworths.org (Postfix) with ESMTP id 06167431FB6\r
   6         for <notmuch@notmuchmail.org>; Mon, 24 Jun 2013 15:32:40 -0700 (PDT)\r
   7 X-Virus-Scanned: Debian amavisd-new at olra.theworths.org\r
   8 X-Spam-Flag: NO\r
   9 X-Spam-Score: -0.7\r
  10 X-Spam-Level: \r
  11 X-Spam-Status: No, score=-0.7 tagged_above=-999 required=5\r
  12         tests=[RCVD_IN_DNSWL_LOW=-0.7] autolearn=disabled\r
  13 Received: from olra.theworths.org ([127.0.0.1])\r
  14         by localhost (olra.theworths.org [127.0.0.1]) (amavisd-new, port 10024)\r
  15         with ESMTP id ObtxBzZDDIL1 for <notmuch@notmuchmail.org>;\r
  16         Mon, 24 Jun 2013 15:32:33 -0700 (PDT)\r
  17 Received: from dmz-mailsec-scanner-1.mit.edu (dmz-mailsec-scanner-1.mit.edu\r
  18         [18.9.25.12])\r
  19         by olra.theworths.org (Postfix) with ESMTP id A9109431FAF\r
  20         for <notmuch@notmuchmail.org>; Mon, 24 Jun 2013 15:32:33 -0700 (PDT)\r
  21 X-AuditID: 1209190c-b7fa48e000000947-37-51c8c900efde\r
  22 Received: from mailhub-auth-1.mit.edu ( [18.9.21.35])\r
  23         by dmz-mailsec-scanner-1.mit.edu (Symantec Messaging Gateway) with SMTP\r
  24         id 65.8E.02375.009C8C15; Mon, 24 Jun 2013 18:32:32 -0400 (EDT)\r
  25 Received: from outgoing.mit.edu (outgoing-auth-1.mit.edu [18.9.28.11])\r
  26         by mailhub-auth-1.mit.edu (8.13.8/8.9.2) with ESMTP id r5OMWTXe021271; \r
  27         Mon, 24 Jun 2013 18:32:30 -0400\r
  28 Received: from drake.dyndns.org (26-4-182.dynamic.csail.mit.edu [18.26.4.182])\r
  29         (authenticated bits=0)\r
  30         (User authenticated as amdragon@ATHENA.MIT.EDU)\r
  31         by outgoing.mit.edu (8.13.8/8.12.4) with ESMTP id r5OMWSTf025791\r
  32         (version=TLSv1/SSLv3 cipher=AES256-SHA bits=256 verify=NOT);\r
  33         Mon, 24 Jun 2013 18:32:29 -0400\r
  34 Received: from amthrax by drake.dyndns.org with local (Exim 4.77)\r
  35         (envelope-from <amdragon@mit.edu>)\r
  36         id 1UrFJE-0000Zw-0g; Mon, 24 Jun 2013 18:32:28 -0400\r
  37 From: Austin Clements <amdragon@MIT.EDU>\r
  38 To: notmuch@notmuchmail.org\r
  39 Subject: [PATCH] emacs: Echo the output of notmuch new as it runs\r
  40 Date: Mon, 24 Jun 2013 18:32:25 -0400\r
  41 Message-Id: <1372113145-1944-1-git-send-email-amdragon@mit.edu>\r
  42 X-Mailer: git-send-email 1.7.10.4\r
  43 X-Brightmail-Tracker:\r
  44  H4sIAAAAAAAAA+NgFlrGIsWRmVeSWpSXmKPExsUixCmqrMtw8kSgwfL9IhbXb85kdmD0eLbq\r
  45         FnMAYxSXTUpqTmZZapG+XQJXxtZJi1gKXmhXTH6T18B4TKmLkZNDQsBEYvm7dUwQtpjEhXvr\r
  46         2boYuTiEBPYxSlxb8IcFwtnIKLH53Wco5wiTxKm316CcuYwSn973s4D0swloSGzbv5wRxBYR\r
  47         kJbYeXc2axcjBwezgJrEny4VkLCwgKPEt+6FbCA2i4CqxKKmZjCbV8Be4u2HPYwQZyhKdD+b\r
  48         wDaBkXcBI8MqRtmU3Crd3MTMnOLUZN3i5MS8vNQiXUO93MwSvdSU0k2M4CCQ5NnB+Oag0iFG\r
  49         AQ5GJR7eGTEnAoVYE8uKK3MPMUpyMCmJ8k4+ARTiS8pPqcxILM6ILyrNSS0+xCjBwawkwhsq\r
  50         ApTjTUmsrEotyodJSXOwKInzitzaGSgkkJ5YkpqdmlqQWgSTleHgUJLgVQUZKliUmp5akZaZ\r
  51         U4KQZuLgBBnOAzT8x3GQ4cUFibnFmekQ+VOMuhyTz255zyjEkpeflyolzvsbpEgApCijNA9u\r
  52         Dix6XzGKA70lzHsdpIoHGPlwk14BLWECWjI59TjIkpJEhJRUA+PEtvp5e5tOnLlUM10oIeWM\r
  53         ZF7m7FmmNxV/KDgzPlg7MfqnavbcW/rv3U0WHJse0HlS20s3MmGF1tuoJX5609T/rlxuerfT\r
  54         S/B0Wo1VdKj653+LvLe8O2kqqNthUilXvdSvYcOuGXtjOKeEnTpU0X6jp8Hk2tW/Lz6eXx6y\r
  55         n+OT1c5/cysrFCWVWIozEg21mIuKEwEVeRj+uQIAAA==\r
  56 X-BeenThere: notmuch@notmuchmail.org\r
  57 X-Mailman-Version: 2.1.13\r
  58 Precedence: list\r
  59 List-Id: "Use and development of the notmuch mail system."\r
  60         <notmuch.notmuchmail.org>\r
  61 List-Unsubscribe: <http://notmuchmail.org/mailman/options/notmuch>,\r
  62         <mailto:notmuch-request@notmuchmail.org?subject=unsubscribe>\r
  63 List-Archive: <http://notmuchmail.org/pipermail/notmuch>\r
  64 List-Post: <mailto:notmuch@notmuchmail.org>\r
  65 List-Help: <mailto:notmuch-request@notmuchmail.org?subject=help>\r
  66 List-Subscribe: <http://notmuchmail.org/mailman/listinfo/notmuch>,\r
  67         <mailto:notmuch-request@notmuchmail.org?subject=subscribe>\r
  68 X-List-Received-Date: Mon, 24 Jun 2013 22:32:40 -0000\r
  69 \r
  70 Previously, when the user pressed "G" to invoke notmuch new, Emacs\r
  71 would go out to lunch until it finished, giving the user no sense that\r
  72 the (potentially long-running) notmuch new process was making\r
  73 progress.  This patch fixes this by continuously updating the echo\r
  74 area to display the last output line of notmuch new as it runs.\r
  75 ---\r
  76 \r
  77 This turned out to be a little more complex than I was expecting, but\r
  78 the effect is really nice, especially if you have a slow computer.\r
  79 \r
  80  emacs/notmuch-lib.el |   87 ++++++++++++++++++++++++++++++++++++++++++++++++++\r
  81  emacs/notmuch.el     |    5 +--\r
  82  2 files changed, 90 insertions(+), 2 deletions(-)\r
  83 \r
  84 diff --git a/emacs/notmuch-lib.el b/emacs/notmuch-lib.el\r
  85 index 534f217..5329146 100644\r
  86 --- a/emacs/notmuch-lib.el\r
  87 +++ b/emacs/notmuch-lib.el\r
  88 @@ -372,6 +372,9 @@ returned by FUNC."\r
  89        (put-text-property start next prop (funcall func value) object)\r
  90        (setq start next))))\r
  91  \r
  92 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\r
  93 +;; Process helpers\r
  94 +\r
  95  (defun notmuch-logged-error (msg &optional extra)\r
  96    "Log MSG and EXTRA to *Notmuch errors* and signal MSG.\r
  97  \r
  98 @@ -554,6 +557,90 @@ status."\r
  99         (message "%s" (error-message-string err))))\r
 100      (ignore-errors (delete-file err-file))))\r
 101  \r
 102 +(defun notmuch-call-process-with-progress (msg-prefix program &rest args)\r
 103 +  "Call PROGRAM with ARGS, tailing its last line in the echo area.\r
 104 +\r
 105 +This is useful for potentially long-running commands that print\r
 106 +their progress, since it will continuously display the last line\r
 107 +of the command's output in the echo area as it runs.  In other\r
 108 +respects, this is very similar to `call-process': it's\r
 109 +synchronous, handles quits the same way, and its return value is\r
 110 +the same.\r
 111 +\r
 112 +MSG-PREFIX is the string to prefix echo area messages with.  If\r
 113 +nil, the message will be constructed from PROGRAM."\r
 114 +\r
 115 +  (unless msg-prefix\r
 116 +    (setq msg-prefix (format "Running %s" program)))\r
 117 +\r
 118 +  (with-temp-buffer\r
 119 +    (let* (;; Inhibit quit until we're ready to handle it properly\r
 120 +          (inhibit-quit t)\r
 121 +          (proc\r
 122 +           (let ((process-environment\r
 123 +                  ;; We emulate a (very lame) VT100\r
 124 +                  (cons "TERM=vt100" process-environment)))\r
 125 +             (apply #'start-process program (current-buffer) program args)))\r
 126 +          (filter\r
 127 +           (lambda (proc string)\r
 128 +             (when (buffer-live-p (process-buffer proc))\r
 129 +               (with-current-buffer (process-buffer proc)\r
 130 +                 (goto-char (point-max))\r
 131 +                 ;; Treat both \r and \n as newline\r
 132 +                 (insert (replace-regexp-in-string "\r" "\n" string))\r
 133 +                 ;; Find the beginning of the last line with content\r
 134 +                 ;; (which might be the line we're on)\r
 135 +                 (while (and (bolp) (not (bobp)))\r
 136 +                   (backward-char))\r
 137 +                 (beginning-of-line)\r
 138 +                 (delete-region (point-min) (point))\r
 139 +                 ;; Strip VT100 control sequences.  This isn't\r
 140 +                 ;; perfect, but it's simple and it'll handle anything\r
 141 +                 ;; we're likely to see.\r
 142 +                 (save-excursion\r
 143 +                   (while (re-search-forward "\e\\[[0-9;?$]*[@a-zA-Z]" nil t)\r
 144 +                     (replace-match "")))\r
 145 +                 ;; Update the minibuffer.  The text is after the\r
 146 +                 ;; "..." so that Emacs will update the line in\r
 147 +                 ;; *Messages* rather than flooding the log.\r
 148 +                 (message "%s... %s" (process-get proc 'msg-prefix)\r
 149 +                          (buffer-substring (point) (line-end-position)))))))\r
 150 +          (sentinel\r
 151 +           (lambda (proc event)\r
 152 +             ;; This is the only way to get signal names\r
 153 +             (process-put proc 'sentinel-event (substring event 0 -1)))))\r
 154 +      (process-put proc 'msg-prefix msg-prefix)\r
 155 +      (set-process-filter proc filter)\r
 156 +      (set-process-sentinel proc sentinel)\r
 157 +      (process-send-eof proc)\r
 158 +      (message "%s..." msg-prefix)\r
 159 +\r
 160 +      ;; Wait for termination, emulating `call-process'\r
 161 +      (unwind-protect\r
 162 +         (while (eq (process-status proc) 'run)\r
 163 +           (let ((inhibit-quit nil))\r
 164 +             (accept-process-output proc nil nil t)))\r
 165 +       (when (eq (process-status proc) 'run)\r
 166 +         (interrupt-process proc t)\r
 167 +         (message "Waiting for process to die...(type C-g again to kill it instantly)")\r
 168 +         (unwind-protect\r
 169 +             (while (eq (process-status proc) 'run)\r
 170 +               (let ((inhibit-quit nil))\r
 171 +                 (accept-process-output proc nil nil t)))\r
 172 +           (delete-process proc))\r
 173 +         (message "Waiting for process to die...done")))\r
 174 +\r
 175 +      ;; Print the final status message and return like `call-process'\r
 176 +      (let ((event (process-get proc 'sentinel-event))\r
 177 +           (status (process-status proc))\r
 178 +           (exit-status (process-exit-status proc)))\r
 179 +       (if (eq status 'exit)\r
 180 +           (progn\r
 181 +             (message "%s...%s" msg-prefix (if (= exit-status 0) "done" event))\r
 182 +             exit-status)\r
 183 +         (message "%s...%s" msg-prefix event)\r
 184 +         event)))))\r
 185 +\r
 186  ;; This variable is used only buffer local, but it needs to be\r
 187  ;; declared globally first to avoid compiler warnings.\r
 188  (defvar notmuch-show-process-crypto nil)\r
 189 diff --git a/emacs/notmuch.el b/emacs/notmuch.el\r
 190 index a9949a1..9949b6c 100644\r
 191 --- a/emacs/notmuch.el\r
 192 +++ b/emacs/notmuch.el\r
 193 @@ -996,8 +996,9 @@ depending on the value of `notmuch-poll-script'."\r
 194    (interactive)\r
 195    (if (stringp notmuch-poll-script)\r
 196        (unless (string= notmuch-poll-script "")\r
 197 -       (call-process notmuch-poll-script nil nil))\r
 198 -    (call-process notmuch-command nil nil nil "new")))\r
 199 +       (notmuch-call-process-with-progress nil notmuch-poll-script))\r
 200 +    (notmuch-call-process-with-progress\r
 201 +     "Checking for mail" notmuch-command "new")))\r
 202  \r
 203  (defun notmuch-search-poll-and-refresh-view ()\r
 204    "Invoke `notmuch-poll' to import mail, then refresh the current view."\r
 205 -- \r
 206 1.7.10.4\r
 207 \r