37/c391807e8419a9f1dfe75d82e8c6fe94120d83

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