8f/f7102473dd278438d7a3f991bf88f8852f7118

   1 Return-Path: <james@hackervisions.org>\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 5E55B431FBC\r
   6         for <notmuch@notmuchmail.org>; Tue, 23 Feb 2010 08:33:06 -0800 (PST)\r
   7 X-Virus-Scanned: Debian amavisd-new at olra.theworths.org\r
   8 X-Spam-Flag: NO\r
   9 X-Spam-Score: -1.249\r
  10 X-Spam-Level: \r
  11 X-Spam-Status: No, score=-1.249 tagged_above=-999 required=5\r
  12         tests=[AWL=-1.350, BAYES_50=0.001, RDNS_DYNAMIC=0.1] autolearn=no\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 oqouYxszil63 for <notmuch@notmuchmail.org>;\r
  16         Tue, 23 Feb 2010 08:33:04 -0800 (PST)\r
  17 Received: from hackervisions.org (67-207-143-141.slicehost.net\r
  18         [67.207.143.141])\r
  19         by olra.theworths.org (Postfix) with ESMTP id 2E31B431FAE\r
  20         for <notmuch@notmuchmail.org>; Tue, 23 Feb 2010 08:33:04 -0800 (PST)\r
  21 Received: from john-marshall.sflc.info ([216.27.154.200]\r
  22         helo=wyzanski.hackervisions.org)\r
  23         by hv with esmtpsa (TLS1.0:DHE_RSA_AES_128_CBC_SHA1:16) (Exim 4.69)\r
  24         (envelope-from <james@hackervisions.org>)\r
  25         id 1Njxh0-00031D-BS; Tue, 23 Feb 2010 11:33:02 -0500\r
  26 Date: Tue, 23 Feb 2010 11:32:51 -0500\r
  27 Message-ID: <87vddnlxos.wl%james@hackervisions.org>\r
  28 From: James Vasile <james@hackervisions.org>\r
  29 To: notmuch@notmuchmail.org\r
  30 X-Mailer: Wanderlust/2.15.6\r
  31 User-Agent: SEMI/1.14.6 (Maruoka) FLIM/1.14.9 (=?UTF-8?B?R29qxY0=?=)\r
  32         APEL/10.7 Emacs/23.1 (i486-pc-linux-gnu) MULE/6.0 (HANACHIRUSATO)\r
  33 MIME-Version: 1.0 (generated by SEMI 1.14.6 - "Maruoka")\r
  34 Content-Type: text/plain; charset=US-ASCII\r
  35 Subject: [notmuch] [PATCH] Calls to notmuch get queued and executed\r
  36         asynchronously.\r
  37 X-BeenThere: notmuch@notmuchmail.org\r
  38 X-Mailman-Version: 2.1.13\r
  39 Precedence: list\r
  40 List-Id: "Use and development of the notmuch mail system."\r
  41         <notmuch.notmuchmail.org>\r
  42 List-Unsubscribe: <http://notmuchmail.org/mailman/options/notmuch>,\r
  43         <mailto:notmuch-request@notmuchmail.org?subject=unsubscribe>\r
  44 List-Archive: <http://notmuchmail.org/pipermail/notmuch>\r
  45 List-Post: <mailto:notmuch@notmuchmail.org>\r
  46 List-Help: <mailto:notmuch-request@notmuchmail.org?subject=help>\r
  47 List-Subscribe: <http://notmuchmail.org/mailman/listinfo/notmuch>,\r
  48         <mailto:notmuch-request@notmuchmail.org?subject=subscribe>\r
  49 X-List-Received-Date: Tue, 23 Feb 2010 16:33:06 -0000\r
  50 \r
  51 Added notmuch-enqueue-asynch to replace calls to\r
  52 notmuch-call-notmuch-process.  Calls to notmuch are then queued and\r
  53 executed asynchronously.  If the db is busy and we get an error saying\r
  54 it was locked, keep trying until the db is no longer busy.  Errors go\r
  55 in a buffer as per usual.\r
  56 \r
  57 The only caveat here is that if the db is permanently locked (i.e. the\r
  58 lock is broken), we just keep on trying forever.  Maybe there should\r
  59 probably be a maximum number of tries or a timeout, but since 'notmuch\r
  60 new' can take a long time, it's difficult to come up with a reasonable\r
  61 limit.\r
  62 ---\r
  63  notmuch.el |   57 ++++++++++++++++++++++++++++++++++++++++++++++++++++-----\r
  64  1 files changed, 52 insertions(+), 5 deletions(-)\r
  65 \r
  66 diff --git a/notmuch.el b/notmuch.el\r
  67 index 6482170..7fc63e9 100644\r
  68 --- a/notmuch.el\r
  69 +++ b/notmuch.el\r
  70 @@ -302,7 +302,7 @@ pseudoheader summary"\r
  71    "Add a tag to the current message."\r
  72    (interactive\r
  73     (list (notmuch-select-tag-with-completion "Tag to add: ")))\r
  74 -  (apply 'notmuch-call-notmuch-process\r
  75 +  (apply 'notmuch-enqueue-asynch\r
  76          (append (cons "tag"\r
  77                        (mapcar (lambda (s) (concat "+" s)) toadd))\r
  78                  (cons (notmuch-show-get-message-id) nil)))\r
  79 @@ -315,7 +315,7 @@ pseudoheader summary"\r
  80    (let ((tags (notmuch-show-get-tags)))\r
  81      (if (intersection tags toremove :test 'string=)\r
  82         (progn\r
  83 -         (apply 'notmuch-call-notmuch-process\r
  84 +         (apply 'notmuch-enqueue-asynch\r
  85                  (append (cons "tag"\r
  86                                (mapcar (lambda (s) (concat "-" s)) toremove))\r
  87                          (cons (notmuch-show-get-message-id) nil)))\r
  88 @@ -1374,6 +1374,53 @@ Complete list of currently available key bindings:\r
  89    (let ((message-id (notmuch-search-find-thread-id)))\r
  90      (notmuch-reply message-id)))\r
  91  \r
  92 +(defun join-string-list (string-list)\r
  93 +    "Concatenates a list of strings and puts spaces between the\r
  94 +elements."\r
  95 +    (mapconcat 'identity string-list " "))\r
  96 +\r
  97 +(defvar notmuch-asynch-queue nil)\r
  98 +(defun notmuch-call-notmuch-process-asynch (&rest args)\r
  99 +  "Asynchronously invoke \"notmuch\" with the given list of arguments.\r
 100 +\r
 101 +Error output from the process will be presented to the user as an\r
 102 +error and will also appear in a buffer named \"*notmuch <arguments>*\"."\r
 103 +  (when args\r
 104 +    (let ((process-connection-type nil)\r
 105 +         (buffer-name (format "*notmuch %s*" (join-string-list args))))\r
 106 +      (when (get-buffer buffer-name)\r
 107 +       (kill-buffer (get-buffer buffer-name)))\r
 108 +      (let* ((process-buffer (get-buffer-create buffer-name))\r
 109 +            (process (apply 'start-process "notmuch-process" process-buffer\r
 110 +                            notmuch-command args)))\r
 111 +       (set-process-sentinel process 'notmuch-call-notmuch-process-asynch-sentinel)))))\r
 112 +(defun notmuch-enqueue-asynch (&rest args)\r
 113 +  "Add a call to notmuch to the queue of notmuch calls.\r
 114 +\r
 115 +args is a list of arguments to notmuch.  ex: (\"tag\" \"+list\"\r
 116 +\"to:mylist@example.com\")\r
 117 +\r
 118 +Calls to notmuch are queued and called asynchronously."\r
 119 +  (setq notmuch-asynch-queue (append notmuch-asynch-queue (list args)))\r
 120 +  (when (= (length notmuch-asynch-queue) 1)\r
 121 +    (apply 'notmuch-call-notmuch-process-asynch (pop notmuch-asynch-queue))))\r
 122 +  \r
 123 +(defun notmuch-call-notmuch-process-asynch-sentinel (process event)\r
 124 +  "Handle the exit of a notmuch asynch process.\r
 125 +\r
 126 +When notmuch is done processing, display the error or kill the\r
 127 +error buffer.  If the db was busy on the last attempt to execute\r
 128 +command, try it again."\r
 129 +  (with-current-buffer (process-buffer process)\r
 130 +    (goto-char (point-min))\r
 131 +    (if (= (process-exit-status process) 0)\r
 132 +       (kill-buffer (buffer-name (process-buffer process)))\r
 133 +       (if (search-forward "Unable to acquire database write lock" nil t)\r
 134 +           (apply 'notmuch-call-notmuch-process-asynch (cdr (process-command process)))\r
 135 +           (error (format "%s: %s" (join-string-list (process-command process))\r
 136 +                          (buffer-string))))))\r
 137 +  (apply 'notmuch-call-notmuch-process-asynch (pop notmuch-asynch-queue)))\r
 138 +\r
 139  (defun notmuch-call-notmuch-process (&rest args)\r
 140    "Synchronously invoke \"notmuch\" with the given list of arguments.\r
 141  \r
 142 @@ -1420,7 +1467,7 @@ The tag is added to messages in the currently selected thread\r
 143  which match the current search terms."\r
 144    (interactive\r
 145     (list (notmuch-select-tag-with-completion "Tag to add: ")))\r
 146 -  (notmuch-call-notmuch-process "tag" (concat "+" tag) (notmuch-search-find-thread-id))\r
 147 +  (notmuch-enqueue-asynch "tag" (concat "+" tag) (notmuch-search-find-thread-id))\r
 148    (notmuch-search-set-tags (delete-dups (sort (cons tag (notmuch-search-get-tags)) 'string<))))\r
 149  \r
 150  (defun notmuch-search-remove-tag (tag)\r
 151 @@ -1430,7 +1477,7 @@ The tag is removed from messages in the currently selected thread\r
 152  which match the current search terms."\r
 153    (interactive\r
 154     (list (notmuch-select-tag-with-completion "Tag to remove: " (notmuch-search-find-thread-id))))\r
 155 -  (notmuch-call-notmuch-process "tag" (concat "-" tag) (notmuch-search-find-thread-id))\r
 156 +  (notmuch-enqueue-asynch "tag" (concat "-" tag) (notmuch-search-find-thread-id))\r
 157    (notmuch-search-set-tags (delete tag (notmuch-search-get-tags))))\r
 158  \r
 159  (defun notmuch-search-archive-thread ()\r
 160 @@ -1511,7 +1558,7 @@ characters as well as `_.+-'.\r
 161         (unless (string-match-p "^[-+][-+_.[:word:]]+$" (car words))\r
 162           (error "Action must be of the form `+thistag -that_tag'"))\r
 163         (setq words (cdr words))))\r
 164 -    (apply 'notmuch-call-notmuch-process "tag"\r
 165 +    (apply 'notmuch-enqueue-asynch "tag"\r
 166            (append action-split (list notmuch-search-query-string) nil))))\r
 167  \r
 168  ;;;###autoload\r
 169 -- \r
 170 1.6.3.3\r
 171 \r