bf/ad86d6b10386f32abc376f746e2bc861358323

   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 03DD1429E59\r
   6         for <notmuch@notmuchmail.org>; Sun, 12 Feb 2012 10:49:20 -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 Yh2uKN+D9GIx for <notmuch@notmuchmail.org>;\r
  18         Sun, 12 Feb 2012 10:49:15 -0800 (PST)\r
  19 Received: from mail-we0-f181.google.com (mail-we0-f181.google.com\r
  20         [74.125.82.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 618CB42117C\r
  23         for <notmuch@notmuchmail.org>; Sun, 12 Feb 2012 10:49:10 -0800 (PST)\r
  24 Received: by mail-we0-f181.google.com with SMTP id p13so3496132wer.26\r
  25         for <notmuch@notmuchmail.org>; Sun, 12 Feb 2012 10:49:10 -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=kdXc+GX7MgcNuyeLwGAidRddd3o+fuhMC0okTJd1+78=;\r
  30         b=MUuoDS0MUhp9kmi6kOopTP3jUQKFuURiiau6/xCPDeKFrryTHcS9BC5zIF11LT73tn\r
  31         /2Hyp7k20U8Kdr5qX7dsslkRMsDRnU8hykAttA1LlEqQuOiz8tcf17Vd++3dQFpsHIdb\r
  32         vd2nOBjF3ABUPI9HQ8VYMxokXDqw3fzwGevkY=\r
  33 Received: by 10.216.136.200 with SMTP id w50mr5176659wei.2.1329072550126;\r
  34         Sun, 12 Feb 2012 10:49:10 -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  y1sm39219326wiw.6.2012.02.12.10.49.07  (version=TLSv1/SSLv3 cipher=OTHER);\r
  38         Sun, 12 Feb 2012 10:49:09 -0800 (PST)\r
  39 From: Mark Walters <markwalters1009@gmail.com>\r
  40 To: notmuch@notmuchmail.org\r
  41 Subject: [RFC PATCH v2 3/3] emacs: add notmuch-pick itself\r
  42 Date: Sun, 12 Feb 2012 18:49:39 +0000\r
  43 Message-Id: <1329072579-27340-4-git-send-email-markwalters1009@gmail.com>\r
  44 X-Mailer: git-send-email 1.7.2.3\r
  45 In-Reply-To: <1329072579-27340-1-git-send-email-markwalters1009@gmail.com>\r
  46 References: <1329072579-27340-1-git-send-email-markwalters1009@gmail.com>\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 18:49:20 -0000\r
  63 \r
  64 ---\r
  65  emacs/notmuch-pick.el |  585 +++++++++++++++++++++++++++++++++++++++++++++++++\r
  66  1 files changed, 585 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..46eb720\r
  72 --- /dev/null\r
  73 +++ b/emacs/notmuch-pick.el\r
  74 @@ -0,0 +1,585 @@\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 +  :type 'integer\r
 117 +  :group 'notmuch-pick)\r
 118 +\r
 119 +(defface notmuch-pick-match-face\r
 120 +  '((((class color)\r
 121 +      (background dark))\r
 122 +     (:foreground "white"))\r
 123 +    (((class color)\r
 124 +      (background light))\r
 125 +     (:foreground "black"))\r
 126 +    (t (:bold t)))\r
 127 +  "Face used in pick mode for matching messages."\r
 128 +  :group 'notmuch-pick)\r
 129 +\r
 130 +(defface notmuch-pick-no-match-face\r
 131 +  '((t (:foreground "gray")))\r
 132 +  "Face used in pick mode for messages not matching the query."\r
 133 +  :group 'notmuch-pick)\r
 134 +\r
 135 +(defvar notmuch-pick-previous-subject "")\r
 136 +(make-variable-buffer-local 'notmuch-pick-previous-subject)\r
 137 +\r
 138 +(defvar notmuch-pick-thread-id nil)\r
 139 +(make-variable-buffer-local 'notmuch-pick-thread-id)\r
 140 +(defvar notmuch-pick-query-context nil)\r
 141 +(make-variable-buffer-local 'notmuch-pick-query-context)\r
 142 +(defvar notmuch-pick-buffer-name nil)\r
 143 +(make-variable-buffer-local 'notmuch-pick-buffer-name)\r
 144 +(defvar notmuch-pick-view-just-messages nil)\r
 145 +(make-variable-buffer-local 'notmuch-pick-view-just-messages)\r
 146 +(put 'notmuch-pick-view-just-messages 'permanent-local t)\r
 147 +(defvar notmuch-pick-message-window nil)\r
 148 +(make-variable-buffer-local 'notmuch-pick-message-window)\r
 149 +(put 'notmuch-pick-message-window 'permanent-local t)\r
 150 +(defvar notmuch-pick-message-buffer nil)\r
 151 +(make-variable-buffer-local 'notmuch-pick-message-buffer-name)\r
 152 +(put 'notmuch-pick-message-buffer-name 'permanent-local t)\r
 153 +(defvar notmuch-pick-oldest-first nil)\r
 154 +(make-variable-buffer-local 'notmuch-pick-oldest-first)\r
 155 +(put 'notmuch-pick-oldest-first 'permanent-local t)\r
 156 +\r
 157 +(defvar notmuch-pick-mode-map\r
 158 +  (let ((map (make-sparse-keymap)))\r
 159 +    (define-key map (kbd "RET") 'notmuch-pick-show-message)\r
 160 +    (define-key map [mouse-1] 'notmuch-pick-show-message)\r
 161 +    (define-key map "q" 'notmuch-pick-quit)\r
 162 +    (define-key map "x" 'notmuch-pick-quit)\r
 163 +    (define-key map "?" 'notmuch-help)\r
 164 +    (define-key map "a" 'notmuch-pick-archive-message)\r
 165 +    (define-key map "=" 'notmuch-pick-refresh-view)\r
 166 +    (define-key map "t" 'notmuch-pick-toggle-view)\r
 167 +    (define-key map "o" 'notmuch-pick-toggle-order)\r
 168 +    (define-key map "s" 'notmuch-search)\r
 169 +    (define-key map "z" 'notmuch-pick)\r
 170 +    (define-key map "m" 'notmuch-pick-new-mail)\r
 171 +    (define-key map "f" 'notmuch-pick-forward-message)\r
 172 +    (define-key map "r" 'notmuch-pick-reply-sender)\r
 173 +    (define-key map "R" 'notmuch-pick-reply)\r
 174 +    (define-key map "n" 'notmuch-pick-next-message)\r
 175 +    (define-key map "p" 'notmuch-pick-prev-message)\r
 176 +    (define-key map "|" 'notmuch-pick-pipe-message)\r
 177 +    (define-key map "-" 'notmuch-pick-remove-tag)\r
 178 +    (define-key map "+" 'notmuch-pick-add-tag)\r
 179 +;;    (define-key map " " 'notmuch-pick-scroll-message-window)\r
 180 +    (define-key map " " 'notmuch-pick-scroll-or-next)\r
 181 +    (define-key map "b" 'notmuch-pick-scroll-message-window-back)\r
 182 +    map))\r
 183 +(fset 'notmuch-pick-mode-map notmuch-pick-mode-map)\r
 184 +\r
 185 +(defun notmuch-pick-get-message-properties ()\r
 186 +  "Return the properties of the current message as a plist.\r
 187 +\r
 188 +Some useful entries are:\r
 189 +:headers - Property list containing the headers :Date, :Subject, :From, etc.\r
 190 +:tags - Tags for this message"\r
 191 +  (save-excursion\r
 192 +    (beginning-of-line)\r
 193 +    (get-text-property (point) :notmuch-message-properties)))\r
 194 +\r
 195 +(defun notmuch-pick-set-message-properties (props)\r
 196 +  (save-excursion\r
 197 +    (beginning-of-line)\r
 198 +    (put-text-property (point) (+ (point) 1) :notmuch-message-properties props)))\r
 199 +\r
 200 +(defun notmuch-pick-set-prop (prop val &optional props)\r
 201 +  (let ((inhibit-read-only t)\r
 202 +       (props (or props\r
 203 +                  (notmuch-pick-get-message-properties))))\r
 204 +    (plist-put props prop val)\r
 205 +    (notmuch-pick-set-message-properties props)))\r
 206 +\r
 207 +(defun notmuch-pick-get-prop (prop &optional props)\r
 208 +  (let ((props (or props\r
 209 +                  (notmuch-pick-get-message-properties))))\r
 210 +    (plist-get props prop)))\r
 211 +\r
 212 +(defun notmuch-pick-set-tags (tags)\r
 213 +  "Set the tags of the current message."\r
 214 +  (notmuch-pick-set-prop :tags tags))\r
 215 +\r
 216 +(defun notmuch-pick-get-tags ()\r
 217 +  "Return the tags of the current message."\r
 218 +  (notmuch-pick-get-prop :tags))\r
 219 +\r
 220 +(defun notmuch-pick-tag-message (&rest tag-changes)\r
 221 +  "Change tags for the current message.\r
 222 +\r
 223 +TAG-CHANGES is a list of tag operations for `notmuch-tag'."\r
 224 +  (let* ((current-tags (notmuch-pick-get-tags))\r
 225 +        (new-tags (notmuch-update-tags current-tags tag-changes)))\r
 226 +    (unless (equal current-tags new-tags)\r
 227 +      (apply 'notmuch-tag (notmuch-pick-get-message-id) tag-changes)\r
 228 +      (notmuch-pick-set-tags new-tags))))\r
 229 +\r
 230 +(defun notmuch-pick-tag (&optional initial-input)\r
 231 +  "Change tags for the current message, read input from the minibuffer."\r
 232 +  (interactive)\r
 233 +  (let ((tag-changes (notmuch-read-tag-changes\r
 234 +                     initial-input (notmuch-pick-get-message-id))))\r
 235 +    (apply 'notmuch-pick-tag-message tag-changes)))\r
 236 +\r
 237 +(defun notmuch-pick-add-tag ()\r
 238 +  "Same as `notmuch-pick-tag' but sets initial input to '+'."\r
 239 +  (interactive)\r
 240 +  (notmuch-pick-tag "+"))\r
 241 +\r
 242 +(defun notmuch-pick-remove-tag ()\r
 243 +  "Same as `notmuch-pick-tag' but sets initial input to '-'."\r
 244 +  (interactive)\r
 245 +  (notmuch-pick-tag "-"))\r
 246 +\r
 247 +(defun notmuch-pick-get-message-id ()\r
 248 +  "Return the message id of the current message."\r
 249 +  (concat "id:\"" (notmuch-pick-get-prop :id) "\""))\r
 250 +\r
 251 +(defun notmuch-pick-get-match ()\r
 252 +  "Return whether the current message is a match."\r
 253 +  (interactive)\r
 254 +  (notmuch-pick-get-prop :match))\r
 255 +\r
 256 +(defun notmuch-pick-show-message ()\r
 257 +  "Show the current message."\r
 258 +  (interactive)\r
 259 +  (let ((id (notmuch-pick-get-message-id))\r
 260 +       (inhibit-read-only t)\r
 261 +       buffer)\r
 262 +    (when id\r
 263 +      ;; we close and reopen the window to kill off un-needed buffers\r
 264 +      ;; this might cause flickering but seems ok\r
 265 +      (notmuch-pick-close-message-window)\r
 266 +      (setq notmuch-pick-message-window\r
 267 +           (split-window-vertically (/ (window-height) 4)))\r
 268 +      (with-selected-window notmuch-pick-message-window\r
 269 +       (setq buffer (notmuch-show id nil nil nil t))))\r
 270 +    (setq notmuch-pick-message-buffer buffer)))\r
 271 +\r
 272 +(defun notmuch-pick-scroll-message-window ()\r
 273 +  "Scroll the message window (if it exists)"\r
 274 +  (interactive)\r
 275 +  (when (window-live-p notmuch-pick-message-window)\r
 276 +    (with-selected-window notmuch-pick-message-window\r
 277 +      (if (pos-visible-in-window-p (point-max))\r
 278 +         t\r
 279 +       (scroll-up)))))\r
 280 +\r
 281 +(defun notmuch-pick-scroll-message-window-back ()\r
 282 +  "Scroll the message window back(if it exists)"\r
 283 +  (interactive)\r
 284 +  (when (window-live-p notmuch-pick-message-window)\r
 285 +    (with-selected-window notmuch-pick-message-window\r
 286 +      (if (pos-visible-in-window-p (point-min))\r
 287 +         t\r
 288 +       (scroll-down)))))\r
 289 +\r
 290 +(defun notmuch-pick-scroll-or-next ()\r
 291 +  "Scroll the message window. If it at end go to next message."\r
 292 +  (interactive)\r
 293 +  (when (notmuch-pick-scroll-message-window)\r
 294 +    (notmuch-pick-next-message)))\r
 295 +\r
 296 +(defun notmuch-pick-toggle-order ()\r
 297 +  "Toggle the current search order.\r
 298 +\r
 299 +By default, the \"inbox\" view created by `notmuch' is displayed\r
 300 +in chronological order (oldest thread at the beginning of the\r
 301 +buffer), while any global searches created by `notmuch-search'\r
 302 +are displayed in reverse-chronological order (newest thread at\r
 303 +the beginning of the buffer).\r
 304 +\r
 305 +This command toggles the sort order for the current search."\r
 306 +  (interactive)\r
 307 +  (let ((inhibit-read-only t))\r
 308 +    (if notmuch-pick-oldest-first\r
 309 +       (message "Showing newest messages first")\r
 310 +      (message "Showing oldest messages first"))\r
 311 +    (set 'notmuch-pick-oldest-first (not notmuch-pick-oldest-first))\r
 312 +    (notmuch-pick-refresh-view)))\r
 313 +\r
 314 +(defun notmuch-pick-quit ()\r
 315 +  "Close the split view or exit pick."\r
 316 +  (interactive)\r
 317 +  (unless (notmuch-pick-close-message-window)\r
 318 +    (kill-buffer (current-buffer))))\r
 319 +\r
 320 +(defun notmuch-pick-close-message-window ()\r
 321 +  "Close the message-window. Return t if close succeeds."\r
 322 +  (interactive)\r
 323 +  (when (and (window-live-p notmuch-pick-message-window)\r
 324 +            (not (window-full-height-p notmuch-pick-message-window)))\r
 325 +    (delete-window notmuch-pick-message-window)\r
 326 +    (unless (get-buffer-window-list notmuch-pick-message-buffer)\r
 327 +      (kill-buffer notmuch-pick-message-buffer))\r
 328 +    t))\r
 329 +\r
 330 +(defun notmuch-pick-archive-message ()\r
 331 +  "Archive the current message and move to next message."\r
 332 +  (interactive)\r
 333 +  (let ((id (notmuch-pick-get-message-id)))\r
 334 +    (when id\r
 335 +      (notmuch-tag id "-inbox" )\r
 336 +      (forward-line))))\r
 337 +\r
 338 +(defun notmuch-pick-prev-message ()\r
 339 +  "Move to previous matching message."\r
 340 +  (interactive)\r
 341 +  (forward-line -1)\r
 342 +  (while (and (not (bobp)) (not (notmuch-pick-get-match)))\r
 343 +    (forward-line -1))\r
 344 +  (when (window-live-p notmuch-pick-message-window)\r
 345 +    (notmuch-pick-show-message)))\r
 346 +\r
 347 +(defun notmuch-pick-next-message ()\r
 348 +  "Move to next matching message."\r
 349 +  (interactive)\r
 350 +  (forward-line)\r
 351 +  (while (and (not (eobp)) (not (notmuch-pick-get-match)))\r
 352 +    (forward-line))\r
 353 +  (when (window-live-p notmuch-pick-message-window)\r
 354 +    (notmuch-pick-show-message)))\r
 355 +\r
 356 +(defun notmuch-pick-refresh-view ()\r
 357 +  "Refresh view."\r
 358 +  (interactive)\r
 359 +  (let ((inhibit-read-only t)\r
 360 +       (thread-id notmuch-pick-thread-id)\r
 361 +       (query-context notmuch-pick-query-context)\r
 362 +       (buffer-name notmuch-pick-buffer-name))\r
 363 +    (erase-buffer)\r
 364 +    (notmuch-pick-worker thread-id  query-context buffer-name)))\r
 365 +\r
 366 +(defun notmuch-pick-toggle-view ()\r
 367 +  "Toggle showing threads or as isolated messages."\r
 368 +  (interactive)\r
 369 +  (let ((inhibit-read-only t))\r
 370 +    (if notmuch-pick-view-just-messages\r
 371 +       (message "Showing as threads")\r
 372 +      (message "Showing as single messages"))\r
 373 +    (setq notmuch-pick-view-just-messages (not notmuch-pick-view-just-messages))\r
 374 +    (notmuch-pick-refresh-view)))\r
 375 +\r
 376 +(defun notmuch-pick-string-width (string width &optional right)\r
 377 +  (let ((s (format (format "%%%s%ds" (if right "" "-") width)\r
 378 +                  string)))\r
 379 +    (if (> (length s) width)\r
 380 +       (substring s 0 width)\r
 381 +      s)))\r
 382 +\r
 383 +(defmacro with-current-notmuch-pick-message (&rest body)\r
 384 +  "Evaluate body with current buffer set to the text of current message"\r
 385 +  `(save-excursion\r
 386 +     (let ((id (notmuch-pick-get-message-id)))\r
 387 +       (let ((buf (generate-new-buffer (concat "*notmuch-msg-" id "*"))))\r
 388 +         (with-current-buffer buf\r
 389 +           (call-process notmuch-command nil t nil "show" "--format=raw" id)\r
 390 +           ,@body)\r
 391 +        (kill-buffer buf)))))\r
 392 +\r
 393 +(defun notmuch-pick-new-mail (&optional prompt-for-sender)\r
 394 +  "Compose new mail."\r
 395 +  (interactive "P")\r
 396 +  (notmuch-pick-close-message-window)\r
 397 +  (notmuch-mua-new-mail prompt-for-sender ))\r
 398 +\r
 399 +(defun notmuch-pick-forward-message (&optional prompt-for-sender)\r
 400 +  "Forward the current message."\r
 401 +  (interactive "P")\r
 402 +  (notmuch-pick-close-message-window)\r
 403 +  (with-current-notmuch-pick-message\r
 404 +   (notmuch-mua-new-forward-message prompt-for-sender)))\r
 405 +\r
 406 +(defun notmuch-pick-reply (&optional prompt-for-sender)\r
 407 +  "Reply to the sender and all recipients of the current message."\r
 408 +  (interactive "P")\r
 409 +  (notmuch-pick-close-message-window)\r
 410 +  (notmuch-mua-new-reply (notmuch-pick-get-message-id) prompt-for-sender t))\r
 411 +\r
 412 +(defun notmuch-pick-reply-sender (&optional prompt-for-sender)\r
 413 +  "Reply to the sender of the current message."\r
 414 +  (interactive "P")\r
 415 +  (notmuch-pick-close-message-window)\r
 416 +  (notmuch-mua-new-reply (notmuch-pick-get-message-id) prompt-for-sender nil))\r
 417 +\r
 418 +;; Shamelessly stolen from notmuch-show.el: maybe should be unified MJW\r
 419 +(defun notmuch-pick-pipe-message (command)\r
 420 +  "Pipe the contents of the current message to the given command.\r
 421 +\r
 422 +The given command will be executed with the raw contents of the\r
 423 +current email message as stdin. Anything printed by the command\r
 424 +to stdout or stderr will appear in the *notmuch-pipe* buffer.\r
 425 +\r
 426 +When invoked with a prefix argument, the command will receive all\r
 427 +open messages in the current thread (formatted as an mbox) rather\r
 428 +than only the current message."\r
 429 +  (interactive "sPipe message to command: ")\r
 430 +  (let ((shell-command\r
 431 +        (concat notmuch-command " show --format=raw "\r
 432 +                (shell-quote-argument (notmuch-pick-get-message-id)) " | " command))\r
 433 +        (buf (get-buffer-create (concat "*notmuch-pipe*"))))\r
 434 +    (with-current-buffer buf\r
 435 +      (setq buffer-read-only nil)\r
 436 +      (erase-buffer)\r
 437 +      (let ((exit-code (call-process-shell-command shell-command nil buf)))\r
 438 +       (goto-char (point-max))\r
 439 +       (set-buffer-modified-p nil)\r
 440 +       (setq buffer-read-only t)\r
 441 +       (unless (zerop exit-code)\r
 442 +         (switch-to-buffer-other-window buf)\r
 443 +         (message (format "Command '%s' exited abnormally with code %d"\r
 444 +                          shell-command exit-code)))))))\r
 445 +\r
 446 +;; Shamelessly stolen from notmuch-show.el: should be unified MJW\r
 447 +(defun notmuch-pick-clean-address (address)\r
 448 +  "Try to clean a single email ADDRESS for display.  Return\r
 449 +unchanged ADDRESS if parsing fails."\r
 450 +  (condition-case nil\r
 451 +    (let (p-name p-address)\r
 452 +      ;; It would be convenient to use `mail-header-parse-address',\r
 453 +      ;; but that expects un-decoded mailbox parts, whereas our\r
 454 +      ;; mailbox parts are already decoded (and hence may contain\r
 455 +      ;; UTF-8). Given that notmuch should handle most of the awkward\r
 456 +      ;; cases, some simple string deconstruction should be sufficient\r
 457 +      ;; here.\r
 458 +      (cond\r
 459 +       ;; "User <user@dom.ain>" style.\r
 460 +       ((string-match "\\(.*\\) <\\(.*\\)>" address)\r
 461 +       (setq p-name (match-string 1 address)\r
 462 +             p-address (match-string 2 address)))\r
 463 +\r
 464 +       ;; "<user@dom.ain>" style.\r
 465 +       ((string-match "<\\(.*\\)>" address)\r
 466 +       (setq p-address (match-string 1 address)))\r
 467 +\r
 468 +       ;; Everything else.\r
 469 +       (t\r
 470 +       (setq p-address address)))\r
 471 +\r
 472 +      (when p-name\r
 473 +       ;; Remove elements of the mailbox part that are not relevant for\r
 474 +       ;; display, even if they are required during transport:\r
 475 +       ;;\r
 476 +       ;; Backslashes.\r
 477 +       (setq p-name (replace-regexp-in-string "\\\\" "" p-name))\r
 478 +\r
 479 +       ;; Outer single and double quotes, which might be nested.\r
 480 +       (loop\r
 481 +        with start-of-loop\r
 482 +        do (setq start-of-loop p-name)\r
 483 +\r
 484 +        when (string-match "^\"\\(.*\\)\"$" p-name)\r
 485 +        do (setq p-name (match-string 1 p-name))\r
 486 +\r
 487 +        when (string-match "^'\\(.*\\)'$" p-name)\r
 488 +        do (setq p-name (match-string 1 p-name))\r
 489 +\r
 490 +        until (string= start-of-loop p-name)))\r
 491 +\r
 492 +      ;; If the address is 'foo@bar.com <foo@bar.com>' then show just\r
 493 +      ;; 'foo@bar.com'.\r
 494 +      (when (string= p-name p-address)\r
 495 +       (setq p-name nil))\r
 496 +\r
 497 +      ;; If we have a name return that otherwise return the address.\r
 498 +      (if (not p-name)\r
 499 +         p-address\r
 500 +       p-name))\r
 501 +    (error address)))\r
 502 +\r
 503 +(defun notmuch-pick-insert-msg (msg depth tree-status)\r
 504 +  (let* ((headers (plist-get msg :headers))\r
 505 +        (match (plist-get msg :match))\r
 506 +        (tags (plist-get msg :tags))\r
 507 +        (bare-subject (notmuch-show-strip-re (plist-get headers :Subject)))\r
 508 +        (message-face (if match\r
 509 +                          'notmuch-pick-match-face\r
 510 +                        'notmuch-pick-no-match-face)))\r
 511 +\r
 512 +    (insert (propertize (concat\r
 513 +                        (notmuch-pick-string-width\r
 514 +                         (plist-get msg :date_relative) 12 t)\r
 515 +                        "  "\r
 516 +                        (format "%-75s"\r
 517 +                                (concat\r
 518 +                                 (notmuch-pick-string-width\r
 519 +                                  (notmuch-pick-clean-address (plist-get headers :From))\r
 520 +                                  (if notmuch-pick-view-just-messages\r
 521 +                                      (+ notmuch-pick-author-width 3)\r
 522 +                                    notmuch-pick-author-width))\r
 523 +                                 " "\r
 524 +                                 (unless notmuch-pick-view-just-messages\r
 525 +                                   (mapconcat #'identity (reverse tree-status) ""))\r
 526 +                                 (if (string= notmuch-pick-previous-subject bare-subject)\r
 527 +                                     " ..."\r
 528 +                                   bare-subject)))\r
 529 +                        (if tags\r
 530 +                            (concat " ("\r
 531 +                                    (mapconcat #'identity tags ", ") ")"))\r
 532 +                        "") 'face message-face))\r
 533 +    (notmuch-pick-set-message-properties msg)\r
 534 +    (insert "\n")\r
 535 +\r
 536 +    (setq notmuch-pick-previous-subject bare-subject)))\r
 537 +\r
 538 +(defun notmuch-pick-insert-tree (tree depth tree-status first last)\r
 539 +  "Insert the message tree TREE at depth DEPTH in the current thread."\r
 540 +  (let ((msg (car tree))\r
 541 +       (replies (cadr tree)))\r
 542 +\r
 543 +      (cond\r
 544 +       ((and (< 0 depth) (not last))\r
 545 +       (push "├" tree-status))\r
 546 +       ((and (< 0 depth) last)\r
 547 +       (push "╰" tree-status))\r
 548 +       ((and (eq 0 depth) first last)\r
 549 +;;       (push "─" tree-status)) choice between this and next line is matter of taste MJW\r
 550 +       (push " " tree-status))\r
 551 +       ((and (eq 0 depth) first (not last))\r
 552 +         (push "┬" tree-status))\r
 553 +       ((and (eq 0 depth) (not first) last)\r
 554 +       (push "╰" tree-status))\r
 555 +       ((and (eq 0 depth) (not first) (not last))\r
 556 +       (push "├" tree-status)))\r
 557 +\r
 558 +      (push (concat (if replies "┬" "─") "►") tree-status)\r
 559 +      (notmuch-pick-insert-msg msg depth tree-status)\r
 560 +      (pop tree-status)\r
 561 +      (pop tree-status)\r
 562 +\r
 563 +      (if last\r
 564 +         (push " " tree-status)\r
 565 +       (push "│" tree-status))\r
 566 +\r
 567 +    (notmuch-pick-insert-thread replies (1+ depth) tree-status)))\r
 568 +\r
 569 +(defun notmuch-pick-insert-thread (thread depth tree-status)\r
 570 +  "Insert the thread THREAD at depth DEPTH >= 1 in the current forest."\r
 571 +  (let ((n (length thread)))\r
 572 +    (loop for tree in thread\r
 573 +         for count from 1 to n\r
 574 +\r
 575 +         do (notmuch-pick-insert-tree tree depth tree-status (eq count 1) (eq count n)))))\r
 576 +\r
 577 +(defun notmuch-pick-insert-forest (forest)\r
 578 +  (mapc '(lambda (thread)\r
 579 +          (let (tree-status)\r
 580 +            ;; Reset at the start of each main thread.\r
 581 +            (setq notmuch-pick-previous-subject nil)\r
 582 +            (notmuch-pick-insert-thread thread 0 tree-status)))\r
 583 +       forest))\r
 584 +\r
 585 +(defun notmuch-pick-mode ()\r
 586 +  "Major mode displaying messages (as opposed to threads) of of a notmuch search.\r
 587 +\r
 588 +This buffer contains the results of a \"notmuch pick\" of your\r
 589 +email archives. Each line in the buffer represents a single\r
 590 +message giving the relative date, the author, subject, and any\r
 591 +tags.\r
 592 +\r
 593 +Pressing \\[notmuch-pick-show-message] on any line displays that message.\r
 594 +\r
 595 +Complete list of currently available key bindings:\r
 596 +\r
 597 +\\{notmuch-pick-mode-map}"\r
 598 +\r
 599 +  (interactive)\r
 600 +  (kill-all-local-variables)\r
 601 +  (use-local-map notmuch-pick-mode-map)\r
 602 +  (setq major-mode 'notmuch-pick-mode\r
 603 +       mode-name "notmuch-pick")\r
 604 +  (hl-line-mode 1)\r
 605 +  (setq buffer-read-only t\r
 606 +       truncate-lines t))\r
 607 +\r
 608 +(defun notmuch-pick-worker (thread-id &optional query-context buffer-name)\r
 609 +  (interactive)\r
 610 +  (notmuch-pick-mode)\r
 611 +  (setq notmuch-pick-thread-id thread-id)\r
 612 +  (setq notmuch-pick-query-context query-context)\r
 613 +  (setq notmuch-pick-buffer-name buffer-name)\r
 614 +\r
 615 +  (erase-buffer)\r
 616 +  (goto-char (point-min))\r
 617 +  (save-excursion\r
 618 +    (let* ((basic-args (list thread-id))\r
 619 +          (args (if query-context\r
 620 +                    (append (list "\'") basic-args (list "and (" query-context ")\'"))\r
 621 +                  (append (list "\'") basic-args (list "\'"))))\r
 622 +          (message-arg (if notmuch-pick-view-just-messages\r
 623 +                           "--thread=none"\r
 624 +                         "--thread=entire"))\r
 625 +          (sort-arg (if notmuch-pick-oldest-first\r
 626 +                         "--sort=oldest-first"\r
 627 +                       "--sort=newest-first")))\r
 628 +\r
 629 +      (notmuch-pick-insert-forest (notmuch-query-get-threads args "--headers-only" message-arg sort-arg))\r
 630 +      ;; If the query context reduced the results to nothing, run\r
 631 +      ;; the basic query.\r
 632 +      (when (and (eq (buffer-size) 0)\r
 633 +                query-context)\r
 634 +       (notmuch-pick-insert-forest\r
 635 +        (notmuch-query-get-threads basic-args message-arg sort-arg))))))\r
 636 +\r
 637 +(defun notmuch-pick (&optional query query-context buffer-name)\r
 638 +  "Run notmuch pick with the given `query' and display the results"\r
 639 +  (interactive "sNotmuch pick: ")\r
 640 +  (if (null query)\r
 641 +      (setq query (notmuch-read-query "Notmuch pick: ")))\r
 642 +  (let ((buffer (get-buffer-create (generate-new-buffer-name\r
 643 +                                   (or buffer-name\r
 644 +                                       (concat "*notmuch-" query "*")))))\r
 645 +       (inhibit-read-only t))\r
 646 +\r
 647 +    (switch-to-buffer buffer)\r
 648 +    ;; Don't track undo information for this buffer\r
 649 +    (set 'buffer-undo-list t)\r
 650 +\r
 651 +    (notmuch-pick-worker query query-context buffer-name)\r
 652 +\r
 653 +    (setq truncate-lines t)))\r
 654 +\r
 655 +;;  (use-local-map notmuch-pick-mode-map))\r
 656 +\r
 657 +;;\r
 658 +\r
 659 +(provide 'notmuch-pick)\r
 660 -- \r
 661 1.7.2.3\r
 662 \r