73/11f4a38d5259c6b9fe1c91855872524c3ed072

   1 Return-Path: <markwalters1009@gmail.com>\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 3A49C421171\r
   6         for <notmuch@notmuchmail.org>; Sun, 12 Feb 2012 02:35:28 -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: 0.201\r
  10 X-Spam-Level: \r
  11 X-Spam-Status: No, score=0.201 tagged_above=-999 required=5\r
  12         tests=[DKIM_SIGNED=0.1, DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1,\r
  13         FREEMAIL_ENVFROM_END_DIGIT=1, FREEMAIL_FROM=0.001,\r
  14         RCVD_IN_DNSWL_LOW=-0.7] autolearn=disabled\r
  15 Received: from olra.theworths.org ([127.0.0.1])\r
  16         by localhost (olra.theworths.org [127.0.0.1]) (amavisd-new, port 10024)\r
  17         with ESMTP id qNOjtUw1HYEo for <notmuch@notmuchmail.org>;\r
  18         Sun, 12 Feb 2012 02:35:21 -0800 (PST)\r
  19 Received: from mail-wi0-f181.google.com (mail-wi0-f181.google.com\r
  20         [209.85.212.181]) (using TLSv1 with cipher RC4-SHA (128/128 bits))\r
  21         (No client certificate requested)\r
  22         by olra.theworths.org (Postfix) with ESMTPS id CACB1421169\r
  23         for <notmuch@notmuchmail.org>; Sun, 12 Feb 2012 02:35:15 -0800 (PST)\r
  24 Received: by wibhi8 with SMTP id hi8so3249380wib.26\r
  25         for <notmuch@notmuchmail.org>; Sun, 12 Feb 2012 02:35:14 -0800 (PST)\r
  26 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=gamma;\r
  27         h=from:to:cc:subject:date:message-id:x-mailer:in-reply-to:references\r
  28         :mime-version:content-type:content-transfer-encoding;\r
  29         bh=q5calVLl3sNA/FLRnJUUWT3nPV1uaGbUGMr+ErBSdzE=;\r
  30         b=Y4CQADZI4L/IopvpCaBEbvy3gc14wYeC7j5pZTxtJ7BjHos4We0puv3xTMJz47Df/8\r
  31         yEDFKPCnbLzSoB/2cRgTkHzJSbjNK03vLRs7Kedf/4fJEws4a7yxP/6wV5P2NJPrIWrs\r
  32         X+rIeCULbf4dOFgeGOtGxDQnxz0pUQii6p15U=\r
  33 Received: by 10.180.89.71 with SMTP id bm7mr12348286wib.20.1329042914492;\r
  34         Sun, 12 Feb 2012 02:35:14 -0800 (PST)\r
  35 Received: from localhost (94-192-233-223.zone6.bethere.co.uk.\r
  36  [94.192.233.223])      by mx.google.com with ESMTPS id\r
  37  ex2sm35847342wib.1.2012.02.12.02.35.12 (version=TLSv1/SSLv3 cipher=OTHER);\r
  38         Sun, 12 Feb 2012 02:35:13 -0800 (PST)\r
  39 From: Mark Walters <markwalters1009@gmail.com>\r
  40 To: notmuch@notmuchmail.org\r
  41 Subject: [RFC PATCH 3/3] emacs: add notmuch-pick itself\r
  42 Date: Sun, 12 Feb 2012 10:36:05 +0000\r
  43 Message-Id: <1329042965-3871-3-git-send-email-markwalters1009@gmail.com>\r
  44 X-Mailer: git-send-email 1.7.2.3\r
  45 In-Reply-To: <87d39k1gvi.fsf@qmul.ac.uk>\r
  46 References: <87d39k1gvi.fsf@qmul.ac.uk>\r
  47 MIME-Version: 1.0\r
  48 Content-Type: text/plain; charset=UTF-8\r
  49 Content-Transfer-Encoding: 8bit\r
  50 X-BeenThere: notmuch@notmuchmail.org\r
  51 X-Mailman-Version: 2.1.13\r
  52 Precedence: list\r
  53 List-Id: "Use and development of the notmuch mail system."\r
  54         <notmuch.notmuchmail.org>\r
  55 List-Unsubscribe: <http://notmuchmail.org/mailman/options/notmuch>,\r
  56         <mailto:notmuch-request@notmuchmail.org?subject=unsubscribe>\r
  57 List-Archive: <http://notmuchmail.org/pipermail/notmuch>\r
  58 List-Post: <mailto:notmuch@notmuchmail.org>\r
  59 List-Help: <mailto:notmuch-request@notmuchmail.org?subject=help>\r
  60 List-Subscribe: <http://notmuchmail.org/mailman/listinfo/notmuch>,\r
  61         <mailto:notmuch-request@notmuchmail.org?subject=subscribe>\r
  62 X-List-Received-Date: Sun, 12 Feb 2012 10:35:28 -0000\r
  63 \r
  64 ---\r
  65  emacs/notmuch-pick.el |  570 +++++++++++++++++++++++++++++++++++++++++++++++++\r
  66  1 files changed, 570 insertions(+), 0 deletions(-)\r
  67  create mode 100644 emacs/notmuch-pick.el\r
  68 \r
  69 diff --git a/emacs/notmuch-pick.el b/emacs/notmuch-pick.el\r
  70 new file mode 100644\r
  71 index 0000000..4c91d7c\r
  72 --- /dev/null\r
  73 +++ b/emacs/notmuch-pick.el\r
  74 @@ -0,0 +1,570 @@\r
  75 +;; notmuch-pick.el --- displaying notmuch forests.\r
  76 +;;\r
  77 +;; Copyright © Carl Worth\r
  78 +;; Copyright © David Edmondson\r
  79 +;;\r
  80 +;; This file is part of Notmuch.\r
  81 +;;\r
  82 +;; Notmuch is free software: you can redistribute it and/or modify it\r
  83 +;; under the terms of the GNU General Public License as published by\r
  84 +;; the Free Software Foundation, either version 3 of the License, or\r
  85 +;; (at your option) any later version.\r
  86 +;;\r
  87 +;; Notmuch is distributed in the hope that it will be useful, but\r
  88 +;; WITHOUT ANY WARRANTY; without even the implied warranty of\r
  89 +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU\r
  90 +;; General Public License for more details.\r
  91 +;;\r
  92 +;; You should have received a copy of the GNU General Public License\r
  93 +;; along with Notmuch.  If not, see <http://www.gnu.org/licenses/>.\r
  94 +;;\r
  95 +;; Authors: David Edmondson <dme@dme.org>\r
  96 +\r
  97 +(require 'mail-parse)\r
  98 +\r
  99 +(require 'notmuch-lib)\r
 100 +(require 'notmuch-query)\r
 101 +(require 'notmuch-show)\r
 102 +(eval-when-compile (require 'cl))\r
 103 +\r
 104 +(declare-function notmuch-call-notmuch-process "notmuch" (&rest args))\r
 105 +(declare-function notmuch-show "notmuch-show" (&rest args))\r
 106 +(declare-function notmuch-tag "notmuch" (query &rest tags))\r
 107 +(declare-function notmuch-show-strip-re "notmuch-show" (subject))\r
 108 +(declare-function notmuch-show-clean-address "notmuch-show" (parsed-address))\r
 109 +(declare-function notmuch-show-spaces-n "notmuch-show" (n))\r
 110 +(declare-function notmuch-read-query "notmuch" (prompt))\r
 111 +(declare-function notmuch-read-tag-changes "notmuch" (&optional initial-input &rest search-terms))\r
 112 +(declare-function notmuch-update-tags "notmuch" (current-tags tag-changes))\r
 113 +\r
 114 +(defcustom notmuch-pick-author-width 20\r
 115 +  "Width of the author field."\r
 116 +  :group 'notmuch\r
 117 +  :type 'int)\r
 118 +\r
 119 +(defvar notmuch-pick-previous-subject "")\r
 120 +(make-variable-buffer-local 'notmuch-pick-previous-subject)\r
 121 +\r
 122 +(defvar notmuch-pick-thread-id nil)\r
 123 +(make-variable-buffer-local 'notmuch-pick-thread-id)\r
 124 +(defvar notmuch-pick-query-context nil)\r
 125 +(make-variable-buffer-local 'notmuch-pick-query-context)\r
 126 +(defvar notmuch-pick-buffer-name nil)\r
 127 +(make-variable-buffer-local 'notmuch-pick-buffer-name)\r
 128 +(defvar notmuch-pick-view-just-messages nil)\r
 129 +(make-variable-buffer-local 'notmuch-pick-view-just-messages)\r
 130 +(put 'notmuch-pick-view-just-messages 'permanent-local t)\r
 131 +(defvar notmuch-pick-message-window nil)\r
 132 +(make-variable-buffer-local 'notmuch-pick-message-window)\r
 133 +(put 'notmuch-pick-message-window 'permanent-local t)\r
 134 +(defvar notmuch-pick-message-buffer nil)\r
 135 +(make-variable-buffer-local 'notmuch-pick-message-buffer-name)\r
 136 +(put 'notmuch-pick-message-buffer-name 'permanent-local t)\r
 137 +(defvar notmuch-pick-oldest-first nil)\r
 138 +(make-variable-buffer-local 'notmuch-pick-oldest-first)\r
 139 +(put 'notmuch-pick-oldest-first 'permanent-local t)\r
 140 +\r
 141 +(defvar notmuch-pick-mode-map\r
 142 +  (let ((map (make-sparse-keymap)))\r
 143 +    (define-key map (kbd "RET") 'notmuch-pick-show-message)\r
 144 +    (define-key map [mouse-1] 'notmuch-pick-show-message)\r
 145 +    (define-key map "q" 'notmuch-pick-quit)\r
 146 +    (define-key map "x" 'notmuch-pick-quit)\r
 147 +    (define-key map "?" 'notmuch-help)\r
 148 +    (define-key map "a" 'notmuch-pick-archive-message)\r
 149 +    (define-key map "=" 'notmuch-pick-refresh-view)\r
 150 +    (define-key map "t" 'notmuch-pick-toggle-view)\r
 151 +    (define-key map "o" 'notmuch-pick-toggle-order)\r
 152 +    (define-key map "s" 'notmuch-search)\r
 153 +    (define-key map "z" 'notmuch-pick)\r
 154 +    (define-key map "m" 'notmuch-pick-new-mail)\r
 155 +    (define-key map "f" 'notmuch-pick-forward-message)\r
 156 +    (define-key map "r" 'notmuch-pick-reply-sender)\r
 157 +    (define-key map "R" 'notmuch-pick-reply)\r
 158 +    (define-key map "n" 'notmuch-pick-next-message)\r
 159 +    (define-key map "p" 'notmuch-pick-prev-message)\r
 160 +    (define-key map "|" 'notmuch-pick-pipe-message)\r
 161 +    (define-key map "-" 'notmuch-pick-remove-tag)\r
 162 +    (define-key map "+" 'notmuch-pick-add-tag)\r
 163 +;;    (define-key map " " 'notmuch-pick-scroll-message-window)\r
 164 +    (define-key map " " 'notmuch-pick-scroll-or-next)\r
 165 +    (define-key map "b" 'notmuch-pick-scroll-message-window-back)\r
 166 +    map))\r
 167 +(fset 'notmuch-pick-mode-map notmuch-pick-mode-map)\r
 168 +\r
 169 +(defun notmuch-pick-get-message-properties ()\r
 170 +  "Return the properties of the current message as a plist.\r
 171 +\r
 172 +Some useful entries are:\r
 173 +:headers - Property list containing the headers :Date, :Subject, :From, etc.\r
 174 +:tags - Tags for this message"\r
 175 +  (save-excursion\r
 176 +    (beginning-of-line)\r
 177 +    (get-text-property (point) :notmuch-message-properties)))\r
 178 +\r
 179 +(defun notmuch-pick-set-message-properties (props)\r
 180 +  (save-excursion\r
 181 +    (beginning-of-line)\r
 182 +    (put-text-property (point) (+ (point) 1) :notmuch-message-properties props)))\r
 183 +\r
 184 +(defun notmuch-pick-set-prop (prop val &optional props)\r
 185 +  (let ((inhibit-read-only t)\r
 186 +       (props (or props\r
 187 +                  (notmuch-pick-get-message-properties))))\r
 188 +    (plist-put props prop val)\r
 189 +    (notmuch-pick-set-message-properties props)))\r
 190 +\r
 191 +(defun notmuch-pick-get-prop (prop &optional props)\r
 192 +  (let ((props (or props\r
 193 +                  (notmuch-pick-get-message-properties))))\r
 194 +    (plist-get props prop)))\r
 195 +\r
 196 +(defun notmuch-pick-set-tags (tags)\r
 197 +  "Set the tags of the current message."\r
 198 +  (notmuch-pick-set-prop :tags tags))\r
 199 +\r
 200 +(defun notmuch-pick-get-tags ()\r
 201 +  "Return the tags of the current message."\r
 202 +  (notmuch-pick-get-prop :tags))\r
 203 +\r
 204 +(defun notmuch-pick-tag-message (&rest tag-changes)\r
 205 +  "Change tags for the current message.\r
 206 +\r
 207 +TAG-CHANGES is a list of tag operations for `notmuch-tag'."\r
 208 +  (let* ((current-tags (notmuch-pick-get-tags))\r
 209 +        (new-tags (notmuch-update-tags current-tags tag-changes)))\r
 210 +    (unless (equal current-tags new-tags)\r
 211 +      (apply 'notmuch-tag (notmuch-pick-get-message-id) tag-changes)\r
 212 +      (notmuch-pick-set-tags new-tags))))\r
 213 +\r
 214 +(defun notmuch-pick-tag (&optional initial-input)\r
 215 +  "Change tags for the current message, read input from the minibuffer."\r
 216 +  (interactive)\r
 217 +  (let ((tag-changes (notmuch-read-tag-changes\r
 218 +                     initial-input (notmuch-pick-get-message-id))))\r
 219 +    (apply 'notmuch-pick-tag-message tag-changes)))\r
 220 +\r
 221 +(defun notmuch-pick-add-tag ()\r
 222 +  "Same as `notmuch-pick-tag' but sets initial input to '+'."\r
 223 +  (interactive)\r
 224 +  (notmuch-pick-tag "+"))\r
 225 +\r
 226 +(defun notmuch-pick-remove-tag ()\r
 227 +  "Same as `notmuch-pick-tag' but sets initial input to '-'."\r
 228 +  (interactive)\r
 229 +  (notmuch-pick-tag "-"))\r
 230 +\r
 231 +(defun notmuch-pick-get-message-id ()\r
 232 +  "Return the message id of the current message."\r
 233 +  (concat "id:\"" (notmuch-pick-get-prop :id) "\""))\r
 234 +\r
 235 +(defun notmuch-pick-get-match ()\r
 236 +  "Return whether the current message is a match."\r
 237 +  (interactive)\r
 238 +  (notmuch-pick-get-prop :match))\r
 239 +\r
 240 +(defun notmuch-pick-show-message ()\r
 241 +  "Show the current message."\r
 242 +  (interactive)\r
 243 +  (let ((id (notmuch-pick-get-message-id))\r
 244 +       (inhibit-read-only t)\r
 245 +       buffer)\r
 246 +    (when id\r
 247 +      ;; we close and reopen the window to kill off un-needed buffers\r
 248 +      ;; this might cause flickering but seems ok\r
 249 +      (notmuch-pick-close-message-window)\r
 250 +      (setq notmuch-pick-message-window\r
 251 +           (split-window-vertically (/ (window-height) 4)))\r
 252 +      (with-selected-window notmuch-pick-message-window\r
 253 +       (setq buffer (notmuch-show id nil nil nil nil t))))\r
 254 +    (setq notmuch-pick-message-buffer buffer)))\r
 255 +\r
 256 +(defun notmuch-pick-scroll-message-window ()\r
 257 +  "Scroll the message window (if it exists)"\r
 258 +  (interactive)\r
 259 +  (when (window-live-p notmuch-pick-message-window)\r
 260 +    (with-selected-window notmuch-pick-message-window\r
 261 +      (if (pos-visible-in-window-p (point-max))\r
 262 +         t\r
 263 +       (scroll-up)))))\r
 264 +\r
 265 +(defun notmuch-pick-scroll-message-window-back ()\r
 266 +  "Scroll the message window back(if it exists)"\r
 267 +  (interactive)\r
 268 +  (when (window-live-p notmuch-pick-message-window)\r
 269 +    (with-selected-window notmuch-pick-message-window\r
 270 +      (if (pos-visible-in-window-p (point-min))\r
 271 +         t\r
 272 +       (scroll-down)))))\r
 273 +\r
 274 +(defun notmuch-pick-scroll-or-next ()\r
 275 +  "Scroll the message window. If it at end go to next message."\r
 276 +  (interactive)\r
 277 +  (when (notmuch-pick-scroll-message-window)\r
 278 +    (notmuch-pick-next-message)))\r
 279 +\r
 280 +(defun notmuch-pick-toggle-order ()\r
 281 +  "Toggle the current search order.\r
 282 +\r
 283 +By default, the \"inbox\" view created by `notmuch' is displayed\r
 284 +in chronological order (oldest thread at the beginning of the\r
 285 +buffer), while any global searches created by `notmuch-search'\r
 286 +are displayed in reverse-chronological order (newest thread at\r
 287 +the beginning of the buffer).\r
 288 +\r
 289 +This command toggles the sort order for the current search."\r
 290 +  (interactive)\r
 291 +  (let ((inhibit-read-only t))\r
 292 +    (if notmuch-pick-oldest-first\r
 293 +       (message "Showing newest messages first")\r
 294 +      (message "Showing oldest messages first"))\r
 295 +    (set 'notmuch-pick-oldest-first (not notmuch-pick-oldest-first))\r
 296 +    (notmuch-pick-refresh-view)))\r
 297 +\r
 298 +(defun notmuch-pick-quit ()\r
 299 +  "Close the split view or exit pick."\r
 300 +  (interactive)\r
 301 +  (unless (notmuch-pick-close-message-window)\r
 302 +    (kill-buffer (current-buffer))))\r
 303 +\r
 304 +(defun notmuch-pick-close-message-window ()\r
 305 +  "Close the message-window. Return t if close succeeds."\r
 306 +  (interactive)\r
 307 +  (when (and (window-live-p notmuch-pick-message-window)\r
 308 +            (not (window-full-height-p notmuch-pick-message-window)))\r
 309 +    (delete-window notmuch-pick-message-window)\r
 310 +    (unless (get-buffer-window-list notmuch-pick-message-buffer)\r
 311 +      (kill-buffer notmuch-pick-message-buffer))\r
 312 +    t))\r
 313 +\r
 314 +(defun notmuch-pick-archive-message ()\r
 315 +  "Archive the current message and move to next message."\r
 316 +  (interactive)\r
 317 +  (let ((id (notmuch-pick-get-message-id)))\r
 318 +    (when id\r
 319 +      (notmuch-tag id "-inbox" )\r
 320 +      (forward-line))))\r
 321 +\r
 322 +(defun notmuch-pick-prev-message ()\r
 323 +  "Move to previous matching message."\r
 324 +  (interactive)\r
 325 +  (forward-line -1)\r
 326 +  (while (and (not (bobp)) (not (notmuch-pick-get-match)))\r
 327 +    (forward-line -1))\r
 328 +  (when (window-live-p notmuch-pick-message-window)\r
 329 +    (notmuch-pick-show-message)))\r
 330 +\r
 331 +(defun notmuch-pick-next-message ()\r
 332 +  "Move to next matching message."\r
 333 +  (interactive)\r
 334 +  (forward-line)\r
 335 +  (while (and (not (eobp)) (not (notmuch-pick-get-match)))\r
 336 +    (forward-line))\r
 337 +  (when (window-live-p notmuch-pick-message-window)\r
 338 +    (notmuch-pick-show-message)))\r
 339 +\r
 340 +(defun notmuch-pick-refresh-view ()\r
 341 +  "Refresh view."\r
 342 +  (interactive)\r
 343 +  (let ((inhibit-read-only t)\r
 344 +       (thread-id notmuch-pick-thread-id)\r
 345 +       (query-context notmuch-pick-query-context)\r
 346 +       (buffer-name notmuch-pick-buffer-name))\r
 347 +    (erase-buffer)\r
 348 +    (notmuch-pick-worker thread-id  query-context buffer-name)))\r
 349 +\r
 350 +(defun notmuch-pick-toggle-view ()\r
 351 +  "Toggle showing threads or as isolated messages."\r
 352 +  (interactive)\r
 353 +  (let ((inhibit-read-only t))\r
 354 +    (if notmuch-pick-view-just-messages\r
 355 +       (message "Showing as threads")\r
 356 +      (message "Showing as single messages"))\r
 357 +    (setq notmuch-pick-view-just-messages (not notmuch-pick-view-just-messages))\r
 358 +    (notmuch-pick-refresh-view)))\r
 359 +\r
 360 +(defun notmuch-pick-string-width (string width &optional right)\r
 361 +  (let ((s (format (format "%%%s%ds" (if right "" "-") width)\r
 362 +                  string)))\r
 363 +    (if (> (length s) width)\r
 364 +       (substring s 0 width)\r
 365 +      s)))\r
 366 +\r
 367 +(defmacro with-current-notmuch-pick-message (&rest body)\r
 368 +  "Evaluate body with current buffer set to the text of current message"\r
 369 +  `(save-excursion\r
 370 +     (let ((id (notmuch-pick-get-message-id)))\r
 371 +       (let ((buf (generate-new-buffer (concat "*notmuch-msg-" id "*"))))\r
 372 +         (with-current-buffer buf\r
 373 +           (call-process notmuch-command nil t nil "show" "--format=raw" id)\r
 374 +           ,@body)\r
 375 +        (kill-buffer buf)))))\r
 376 +\r
 377 +(defun notmuch-pick-new-mail (&optional prompt-for-sender)\r
 378 +  "Compose new mail."\r
 379 +  (interactive "P")\r
 380 +  (notmuch-pick-close-message-window)\r
 381 +  (notmuch-mua-new-mail prompt-for-sender ))\r
 382 +\r
 383 +(defun notmuch-pick-forward-message (&optional prompt-for-sender)\r
 384 +  "Forward the current message."\r
 385 +  (interactive "P")\r
 386 +  (notmuch-pick-close-message-window)\r
 387 +  (with-current-notmuch-pick-message\r
 388 +   (notmuch-mua-new-forward-message prompt-for-sender)))\r
 389 +\r
 390 +(defun notmuch-pick-reply (&optional prompt-for-sender)\r
 391 +  "Reply to the sender and all recipients of the current message."\r
 392 +  (interactive "P")\r
 393 +  (notmuch-pick-close-message-window)\r
 394 +  (notmuch-mua-new-reply (notmuch-pick-get-message-id) prompt-for-sender t))\r
 395 +\r
 396 +(defun notmuch-pick-reply-sender (&optional prompt-for-sender)\r
 397 +  "Reply to the sender of the current message."\r
 398 +  (interactive "P")\r
 399 +  (notmuch-pick-close-message-window)\r
 400 +  (notmuch-mua-new-reply (notmuch-pick-get-message-id) prompt-for-sender nil))\r
 401 +\r
 402 +;; Shamelessly stolen from notmuch-show.el: maybe should be unified MJW\r
 403 +(defun notmuch-pick-pipe-message (command)\r
 404 +  "Pipe the contents of the current message to the given command.\r
 405 +\r
 406 +The given command will be executed with the raw contents of the\r
 407 +current email message as stdin. Anything printed by the command\r
 408 +to stdout or stderr will appear in the *notmuch-pipe* buffer.\r
 409 +\r
 410 +When invoked with a prefix argument, the command will receive all\r
 411 +open messages in the current thread (formatted as an mbox) rather\r
 412 +than only the current message."\r
 413 +  (interactive "sPipe message to command: ")\r
 414 +  (let ((shell-command\r
 415 +        (concat notmuch-command " show --format=raw "\r
 416 +                (shell-quote-argument (notmuch-pick-get-message-id)) " | " command))\r
 417 +        (buf (get-buffer-create (concat "*notmuch-pipe*"))))\r
 418 +    (with-current-buffer buf\r
 419 +      (setq buffer-read-only nil)\r
 420 +      (erase-buffer)\r
 421 +      (let ((exit-code (call-process-shell-command shell-command nil buf)))\r
 422 +       (goto-char (point-max))\r
 423 +       (set-buffer-modified-p nil)\r
 424 +       (setq buffer-read-only t)\r
 425 +       (unless (zerop exit-code)\r
 426 +         (switch-to-buffer-other-window buf)\r
 427 +         (message (format "Command '%s' exited abnormally with code %d"\r
 428 +                          shell-command exit-code)))))))\r
 429 +\r
 430 +;; Shamelessly stolen from notmuch-show.el: should be unified MJW\r
 431 +(defun notmuch-pick-clean-address (address)\r
 432 +  "Try to clean a single email ADDRESS for display.  Return\r
 433 +unchanged ADDRESS if parsing fails."\r
 434 +  (condition-case nil\r
 435 +    (let (p-name p-address)\r
 436 +      ;; It would be convenient to use `mail-header-parse-address',\r
 437 +      ;; but that expects un-decoded mailbox parts, whereas our\r
 438 +      ;; mailbox parts are already decoded (and hence may contain\r
 439 +      ;; UTF-8). Given that notmuch should handle most of the awkward\r
 440 +      ;; cases, some simple string deconstruction should be sufficient\r
 441 +      ;; here.\r
 442 +      (cond\r
 443 +       ;; "User <user@dom.ain>" style.\r
 444 +       ((string-match "\\(.*\\) <\\(.*\\)>" address)\r
 445 +       (setq p-name (match-string 1 address)\r
 446 +             p-address (match-string 2 address)))\r
 447 +\r
 448 +       ;; "<user@dom.ain>" style.\r
 449 +       ((string-match "<\\(.*\\)>" address)\r
 450 +       (setq p-address (match-string 1 address)))\r
 451 +\r
 452 +       ;; Everything else.\r
 453 +       (t\r
 454 +       (setq p-address address)))\r
 455 +\r
 456 +      (when p-name\r
 457 +       ;; Remove elements of the mailbox part that are not relevant for\r
 458 +       ;; display, even if they are required during transport:\r
 459 +       ;;\r
 460 +       ;; Backslashes.\r
 461 +       (setq p-name (replace-regexp-in-string "\\\\" "" p-name))\r
 462 +\r
 463 +       ;; Outer single and double quotes, which might be nested.\r
 464 +       (loop\r
 465 +        with start-of-loop\r
 466 +        do (setq start-of-loop p-name)\r
 467 +\r
 468 +        when (string-match "^\"\\(.*\\)\"$" p-name)\r
 469 +        do (setq p-name (match-string 1 p-name))\r
 470 +\r
 471 +        when (string-match "^'\\(.*\\)'$" p-name)\r
 472 +        do (setq p-name (match-string 1 p-name))\r
 473 +\r
 474 +        until (string= start-of-loop p-name)))\r
 475 +\r
 476 +      ;; If the address is 'foo@bar.com <foo@bar.com>' then show just\r
 477 +      ;; 'foo@bar.com'.\r
 478 +      (when (string= p-name p-address)\r
 479 +       (setq p-name nil))\r
 480 +\r
 481 +      ;; If we have a name return that otherwise return the address.\r
 482 +      (if (not p-name)\r
 483 +         p-address\r
 484 +       p-name))\r
 485 +    (error address)))\r
 486 +\r
 487 +(defun notmuch-pick-insert-msg (msg depth tree-status)\r
 488 +  (let* ((headers (plist-get msg :headers))\r
 489 +        (match (plist-get msg :match))\r
 490 +        (tags (plist-get msg :tags))\r
 491 +        (bare-subject (notmuch-show-strip-re (plist-get headers :Subject)))\r
 492 +        ;; Face should be a defcustom or something MJW\r
 493 +        (message-face (if match\r
 494 +                          '(:foreground "black")\r
 495 +                      '(:foreground "gray"))))\r
 496 +\r
 497 +    (insert (propertize (concat\r
 498 +                        (notmuch-pick-string-width\r
 499 +                         (plist-get msg :date_relative) 12 t)\r
 500 +                        "  "\r
 501 +                        (format "%-75s"\r
 502 +                                (concat\r
 503 +                                 (notmuch-pick-string-width\r
 504 +                                  (notmuch-pick-clean-address (plist-get headers :From))\r
 505 +                                  (if notmuch-pick-view-just-messages\r
 506 +                                      (+ notmuch-pick-author-width 3)\r
 507 +                                    notmuch-pick-author-width))\r
 508 +                                 " "\r
 509 +                                 (unless notmuch-pick-view-just-messages\r
 510 +                                   (mapconcat #'identity (reverse tree-status) ""))\r
 511 +                                 (if (string= notmuch-pick-previous-subject bare-subject)\r
 512 +                                     " ..."\r
 513 +                                   bare-subject)))\r
 514 +                        (if tags\r
 515 +                            (concat " ("\r
 516 +                                    (mapconcat #'identity tags ", ") ")"))\r
 517 +                        "") 'face message-face))\r
 518 +    (notmuch-pick-set-message-properties msg)\r
 519 +    (insert "\n")\r
 520 +\r
 521 +    (setq notmuch-pick-previous-subject bare-subject)))\r
 522 +\r
 523 +(defun notmuch-pick-insert-tree (tree depth tree-status first last)\r
 524 +  "Insert the message tree TREE at depth DEPTH in the current thread."\r
 525 +  (let ((msg (car tree))\r
 526 +       (replies (cadr tree)))\r
 527 +\r
 528 +      (cond\r
 529 +       ((and (< 0 depth) (not last))\r
 530 +       (push "├" tree-status))\r
 531 +       ((and (< 0 depth) last)\r
 532 +       (push "╰" tree-status))\r
 533 +       ((and (eq 0 depth) first last)\r
 534 +;;       (push "─" tree-status)) choice between this and next line is matter of taste MJW\r
 535 +       (push " " tree-status))\r
 536 +       ((and (eq 0 depth) first (not last))\r
 537 +         (push "┬" tree-status))\r
 538 +       ((and (eq 0 depth) (not first) last)\r
 539 +       (push "╰" tree-status))\r
 540 +       ((and (eq 0 depth) (not first) (not last))\r
 541 +       (push "├" tree-status)))\r
 542 +\r
 543 +      (push (concat (if replies "┬" "─") "►") tree-status)\r
 544 +      (notmuch-pick-insert-msg msg depth tree-status)\r
 545 +      (pop tree-status)\r
 546 +      (pop tree-status)\r
 547 +\r
 548 +      (if last\r
 549 +         (push " " tree-status)\r
 550 +       (push "│" tree-status))\r
 551 +\r
 552 +    (notmuch-pick-insert-thread replies (1+ depth) tree-status)))\r
 553 +\r
 554 +(defun notmuch-pick-insert-thread (thread depth tree-status)\r
 555 +  "Insert the thread THREAD at depth DEPTH >= 1 in the current forest."\r
 556 +  (let ((n (length thread)))\r
 557 +    (loop for tree in thread\r
 558 +         for count from 1 to n\r
 559 +\r
 560 +         do (notmuch-pick-insert-tree tree depth tree-status (eq count 1) (eq count n)))))\r
 561 +\r
 562 +(defun notmuch-pick-insert-forest (forest)\r
 563 +  (mapc '(lambda (thread)\r
 564 +          (let (tree-status)\r
 565 +            ;; Reset at the start of each main thread.\r
 566 +            (setq notmuch-pick-previous-subject nil)\r
 567 +            (notmuch-pick-insert-thread thread 0 tree-status)))\r
 568 +       forest))\r
 569 +\r
 570 +(defun notmuch-pick-mode ()\r
 571 +  "Major mode displaying messages (as opposed to threads) of of a notmuch search.\r
 572 +\r
 573 +This buffer contains the results of a \"notmuch pick\" of your\r
 574 +email archives. Each line in the buffer represents a single\r
 575 +message giving the relative date, the author, subject, and any\r
 576 +tags.\r
 577 +\r
 578 +Pressing \\[notmuch-pick-show-message] on any line displays that message.\r
 579 +\r
 580 +Complete list of currently available key bindings:\r
 581 +\r
 582 +\\{notmuch-pick-mode-map}"\r
 583 +\r
 584 +  (interactive)\r
 585 +  (kill-all-local-variables)\r
 586 +  (use-local-map notmuch-pick-mode-map)\r
 587 +  (setq major-mode 'notmuch-pick-mode\r
 588 +       mode-name "notmuch-pick")\r
 589 +  (hl-line-mode 1)\r
 590 +  (setq buffer-read-only t\r
 591 +       truncate-lines t))\r
 592 +\r
 593 +(defun notmuch-pick-worker (thread-id &optional query-context buffer-name)\r
 594 +  (interactive)\r
 595 +  (notmuch-pick-mode)\r
 596 +  (setq notmuch-pick-thread-id thread-id)\r
 597 +  (setq notmuch-pick-query-context query-context)\r
 598 +  (setq notmuch-pick-buffer-name buffer-name)\r
 599 +\r
 600 +  (erase-buffer)\r
 601 +  (goto-char (point-min))\r
 602 +  (save-excursion\r
 603 +    (let* ((basic-args (list thread-id))\r
 604 +          (args (if query-context\r
 605 +                    (append (list "\'") basic-args (list "and (" query-context ")\'"))\r
 606 +                  (append (list "\'") basic-args (list "\'"))))\r
 607 +          (message-arg (if notmuch-pick-view-just-messages\r
 608 +                           "--thread=none"\r
 609 +                         "--thread=entire"))\r
 610 +          (sort-arg (if notmuch-pick-oldest-first\r
 611 +                         "--sort=oldest-first"\r
 612 +                       "--sort=newest-first")))\r
 613 +\r
 614 +      (notmuch-pick-insert-forest (notmuch-query-get-threads args "--headers-only" message-arg sort-arg))\r
 615 +      ;; If the query context reduced the results to nothing, run\r
 616 +      ;; the basic query.\r
 617 +      (when (and (eq (buffer-size) 0)\r
 618 +                query-context)\r
 619 +       (notmuch-pick-insert-forest\r
 620 +        (notmuch-query-get-threads basic-args message-arg sort-arg))))))\r
 621 +\r
 622 +(defun notmuch-pick (&optional query query-context buffer-name)\r
 623 +  "Run notmuch pick with the given `query' and display the results"\r
 624 +  (interactive "sNotmuch pick: ")\r
 625 +  (if (null query)\r
 626 +      (setq query (notmuch-read-query "Notmuch pick: ")))\r
 627 +  (let ((buffer (get-buffer-create (generate-new-buffer-name\r
 628 +                                   (or buffer-name\r
 629 +                                       (concat "*notmuch-" query "*")))))\r
 630 +       (inhibit-read-only t))\r
 631 +\r
 632 +    (switch-to-buffer buffer)\r
 633 +    ;; Don't track undo information for this buffer\r
 634 +    (set 'buffer-undo-list t)\r
 635 +\r
 636 +    (notmuch-pick-worker query query-context buffer-name)\r
 637 +\r
 638 +    (setq truncate-lines t)))\r
 639 +\r
 640 +;;  (use-local-map notmuch-pick-mode-map))\r
 641 +\r
 642 +;;\r
 643 +\r
 644 +(provide 'notmuch-pick)\r
 645 -- \r
 646 1.7.2.3\r
 647 \r