--- /dev/null
+Return-Path: <markwalters1009@gmail.com>\r
+X-Original-To: notmuch@notmuchmail.org\r
+Delivered-To: notmuch@notmuchmail.org\r
+Received: from localhost (localhost [127.0.0.1])\r
+ by olra.theworths.org (Postfix) with ESMTP id 3A49C421171\r
+ for <notmuch@notmuchmail.org>; Sun, 12 Feb 2012 02:35:28 -0800 (PST)\r
+X-Virus-Scanned: Debian amavisd-new at olra.theworths.org\r
+X-Spam-Flag: NO\r
+X-Spam-Score: 0.201\r
+X-Spam-Level: \r
+X-Spam-Status: No, score=0.201 tagged_above=-999 required=5\r
+ tests=[DKIM_SIGNED=0.1, DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1,\r
+ FREEMAIL_ENVFROM_END_DIGIT=1, FREEMAIL_FROM=0.001,\r
+ RCVD_IN_DNSWL_LOW=-0.7] autolearn=disabled\r
+Received: from olra.theworths.org ([127.0.0.1])\r
+ by localhost (olra.theworths.org [127.0.0.1]) (amavisd-new, port 10024)\r
+ with ESMTP id qNOjtUw1HYEo for <notmuch@notmuchmail.org>;\r
+ Sun, 12 Feb 2012 02:35:21 -0800 (PST)\r
+Received: from mail-wi0-f181.google.com (mail-wi0-f181.google.com\r
+ [209.85.212.181]) (using TLSv1 with cipher RC4-SHA (128/128 bits))\r
+ (No client certificate requested)\r
+ by olra.theworths.org (Postfix) with ESMTPS id CACB1421169\r
+ for <notmuch@notmuchmail.org>; Sun, 12 Feb 2012 02:35:15 -0800 (PST)\r
+Received: by wibhi8 with SMTP id hi8so3249380wib.26\r
+ for <notmuch@notmuchmail.org>; Sun, 12 Feb 2012 02:35:14 -0800 (PST)\r
+DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=gamma;\r
+ h=from:to:cc:subject:date:message-id:x-mailer:in-reply-to:references\r
+ :mime-version:content-type:content-transfer-encoding;\r
+ bh=q5calVLl3sNA/FLRnJUUWT3nPV1uaGbUGMr+ErBSdzE=;\r
+ b=Y4CQADZI4L/IopvpCaBEbvy3gc14wYeC7j5pZTxtJ7BjHos4We0puv3xTMJz47Df/8\r
+ yEDFKPCnbLzSoB/2cRgTkHzJSbjNK03vLRs7Kedf/4fJEws4a7yxP/6wV5P2NJPrIWrs\r
+ X+rIeCULbf4dOFgeGOtGxDQnxz0pUQii6p15U=\r
+Received: by 10.180.89.71 with SMTP id bm7mr12348286wib.20.1329042914492;\r
+ Sun, 12 Feb 2012 02:35:14 -0800 (PST)\r
+Received: from localhost (94-192-233-223.zone6.bethere.co.uk.\r
+ [94.192.233.223]) by mx.google.com with ESMTPS id\r
+ ex2sm35847342wib.1.2012.02.12.02.35.12 (version=TLSv1/SSLv3 cipher=OTHER);\r
+ Sun, 12 Feb 2012 02:35:13 -0800 (PST)\r
+From: Mark Walters <markwalters1009@gmail.com>\r
+To: notmuch@notmuchmail.org\r
+Subject: [RFC PATCH 3/3] emacs: add notmuch-pick itself\r
+Date: Sun, 12 Feb 2012 10:36:05 +0000\r
+Message-Id: <1329042965-3871-3-git-send-email-markwalters1009@gmail.com>\r
+X-Mailer: git-send-email 1.7.2.3\r
+In-Reply-To: <87d39k1gvi.fsf@qmul.ac.uk>\r
+References: <87d39k1gvi.fsf@qmul.ac.uk>\r
+MIME-Version: 1.0\r
+Content-Type: text/plain; charset=UTF-8\r
+Content-Transfer-Encoding: 8bit\r
+X-BeenThere: notmuch@notmuchmail.org\r
+X-Mailman-Version: 2.1.13\r
+Precedence: list\r
+List-Id: "Use and development of the notmuch mail system."\r
+ <notmuch.notmuchmail.org>\r
+List-Unsubscribe: <http://notmuchmail.org/mailman/options/notmuch>,\r
+ <mailto:notmuch-request@notmuchmail.org?subject=unsubscribe>\r
+List-Archive: <http://notmuchmail.org/pipermail/notmuch>\r
+List-Post: <mailto:notmuch@notmuchmail.org>\r
+List-Help: <mailto:notmuch-request@notmuchmail.org?subject=help>\r
+List-Subscribe: <http://notmuchmail.org/mailman/listinfo/notmuch>,\r
+ <mailto:notmuch-request@notmuchmail.org?subject=subscribe>\r
+X-List-Received-Date: Sun, 12 Feb 2012 10:35:28 -0000\r
+\r
+---\r
+ emacs/notmuch-pick.el | 570 +++++++++++++++++++++++++++++++++++++++++++++++++\r
+ 1 files changed, 570 insertions(+), 0 deletions(-)\r
+ create mode 100644 emacs/notmuch-pick.el\r
+\r
+diff --git a/emacs/notmuch-pick.el b/emacs/notmuch-pick.el\r
+new file mode 100644\r
+index 0000000..4c91d7c\r
+--- /dev/null\r
++++ b/emacs/notmuch-pick.el\r
+@@ -0,0 +1,570 @@\r
++;; notmuch-pick.el --- displaying notmuch forests.\r
++;;\r
++;; Copyright © Carl Worth\r
++;; Copyright © David Edmondson\r
++;;\r
++;; This file is part of Notmuch.\r
++;;\r
++;; Notmuch is free software: you can redistribute it and/or modify it\r
++;; under the terms of the GNU General Public License as published by\r
++;; the Free Software Foundation, either version 3 of the License, or\r
++;; (at your option) any later version.\r
++;;\r
++;; Notmuch is distributed in the hope that it will be useful, but\r
++;; WITHOUT ANY WARRANTY; without even the implied warranty of\r
++;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU\r
++;; General Public License for more details.\r
++;;\r
++;; You should have received a copy of the GNU General Public License\r
++;; along with Notmuch. If not, see <http://www.gnu.org/licenses/>.\r
++;;\r
++;; Authors: David Edmondson <dme@dme.org>\r
++\r
++(require 'mail-parse)\r
++\r
++(require 'notmuch-lib)\r
++(require 'notmuch-query)\r
++(require 'notmuch-show)\r
++(eval-when-compile (require 'cl))\r
++\r
++(declare-function notmuch-call-notmuch-process "notmuch" (&rest args))\r
++(declare-function notmuch-show "notmuch-show" (&rest args))\r
++(declare-function notmuch-tag "notmuch" (query &rest tags))\r
++(declare-function notmuch-show-strip-re "notmuch-show" (subject))\r
++(declare-function notmuch-show-clean-address "notmuch-show" (parsed-address))\r
++(declare-function notmuch-show-spaces-n "notmuch-show" (n))\r
++(declare-function notmuch-read-query "notmuch" (prompt))\r
++(declare-function notmuch-read-tag-changes "notmuch" (&optional initial-input &rest search-terms))\r
++(declare-function notmuch-update-tags "notmuch" (current-tags tag-changes))\r
++\r
++(defcustom notmuch-pick-author-width 20\r
++ "Width of the author field."\r
++ :group 'notmuch\r
++ :type 'int)\r
++\r
++(defvar notmuch-pick-previous-subject "")\r
++(make-variable-buffer-local 'notmuch-pick-previous-subject)\r
++\r
++(defvar notmuch-pick-thread-id nil)\r
++(make-variable-buffer-local 'notmuch-pick-thread-id)\r
++(defvar notmuch-pick-query-context nil)\r
++(make-variable-buffer-local 'notmuch-pick-query-context)\r
++(defvar notmuch-pick-buffer-name nil)\r
++(make-variable-buffer-local 'notmuch-pick-buffer-name)\r
++(defvar notmuch-pick-view-just-messages nil)\r
++(make-variable-buffer-local 'notmuch-pick-view-just-messages)\r
++(put 'notmuch-pick-view-just-messages 'permanent-local t)\r
++(defvar notmuch-pick-message-window nil)\r
++(make-variable-buffer-local 'notmuch-pick-message-window)\r
++(put 'notmuch-pick-message-window 'permanent-local t)\r
++(defvar notmuch-pick-message-buffer nil)\r
++(make-variable-buffer-local 'notmuch-pick-message-buffer-name)\r
++(put 'notmuch-pick-message-buffer-name 'permanent-local t)\r
++(defvar notmuch-pick-oldest-first nil)\r
++(make-variable-buffer-local 'notmuch-pick-oldest-first)\r
++(put 'notmuch-pick-oldest-first 'permanent-local t)\r
++\r
++(defvar notmuch-pick-mode-map\r
++ (let ((map (make-sparse-keymap)))\r
++ (define-key map (kbd "RET") 'notmuch-pick-show-message)\r
++ (define-key map [mouse-1] 'notmuch-pick-show-message)\r
++ (define-key map "q" 'notmuch-pick-quit)\r
++ (define-key map "x" 'notmuch-pick-quit)\r
++ (define-key map "?" 'notmuch-help)\r
++ (define-key map "a" 'notmuch-pick-archive-message)\r
++ (define-key map "=" 'notmuch-pick-refresh-view)\r
++ (define-key map "t" 'notmuch-pick-toggle-view)\r
++ (define-key map "o" 'notmuch-pick-toggle-order)\r
++ (define-key map "s" 'notmuch-search)\r
++ (define-key map "z" 'notmuch-pick)\r
++ (define-key map "m" 'notmuch-pick-new-mail)\r
++ (define-key map "f" 'notmuch-pick-forward-message)\r
++ (define-key map "r" 'notmuch-pick-reply-sender)\r
++ (define-key map "R" 'notmuch-pick-reply)\r
++ (define-key map "n" 'notmuch-pick-next-message)\r
++ (define-key map "p" 'notmuch-pick-prev-message)\r
++ (define-key map "|" 'notmuch-pick-pipe-message)\r
++ (define-key map "-" 'notmuch-pick-remove-tag)\r
++ (define-key map "+" 'notmuch-pick-add-tag)\r
++;; (define-key map " " 'notmuch-pick-scroll-message-window)\r
++ (define-key map " " 'notmuch-pick-scroll-or-next)\r
++ (define-key map "b" 'notmuch-pick-scroll-message-window-back)\r
++ map))\r
++(fset 'notmuch-pick-mode-map notmuch-pick-mode-map)\r
++\r
++(defun notmuch-pick-get-message-properties ()\r
++ "Return the properties of the current message as a plist.\r
++\r
++Some useful entries are:\r
++:headers - Property list containing the headers :Date, :Subject, :From, etc.\r
++:tags - Tags for this message"\r
++ (save-excursion\r
++ (beginning-of-line)\r
++ (get-text-property (point) :notmuch-message-properties)))\r
++\r
++(defun notmuch-pick-set-message-properties (props)\r
++ (save-excursion\r
++ (beginning-of-line)\r
++ (put-text-property (point) (+ (point) 1) :notmuch-message-properties props)))\r
++\r
++(defun notmuch-pick-set-prop (prop val &optional props)\r
++ (let ((inhibit-read-only t)\r
++ (props (or props\r
++ (notmuch-pick-get-message-properties))))\r
++ (plist-put props prop val)\r
++ (notmuch-pick-set-message-properties props)))\r
++\r
++(defun notmuch-pick-get-prop (prop &optional props)\r
++ (let ((props (or props\r
++ (notmuch-pick-get-message-properties))))\r
++ (plist-get props prop)))\r
++\r
++(defun notmuch-pick-set-tags (tags)\r
++ "Set the tags of the current message."\r
++ (notmuch-pick-set-prop :tags tags))\r
++\r
++(defun notmuch-pick-get-tags ()\r
++ "Return the tags of the current message."\r
++ (notmuch-pick-get-prop :tags))\r
++\r
++(defun notmuch-pick-tag-message (&rest tag-changes)\r
++ "Change tags for the current message.\r
++\r
++TAG-CHANGES is a list of tag operations for `notmuch-tag'."\r
++ (let* ((current-tags (notmuch-pick-get-tags))\r
++ (new-tags (notmuch-update-tags current-tags tag-changes)))\r
++ (unless (equal current-tags new-tags)\r
++ (apply 'notmuch-tag (notmuch-pick-get-message-id) tag-changes)\r
++ (notmuch-pick-set-tags new-tags))))\r
++\r
++(defun notmuch-pick-tag (&optional initial-input)\r
++ "Change tags for the current message, read input from the minibuffer."\r
++ (interactive)\r
++ (let ((tag-changes (notmuch-read-tag-changes\r
++ initial-input (notmuch-pick-get-message-id))))\r
++ (apply 'notmuch-pick-tag-message tag-changes)))\r
++\r
++(defun notmuch-pick-add-tag ()\r
++ "Same as `notmuch-pick-tag' but sets initial input to '+'."\r
++ (interactive)\r
++ (notmuch-pick-tag "+"))\r
++\r
++(defun notmuch-pick-remove-tag ()\r
++ "Same as `notmuch-pick-tag' but sets initial input to '-'."\r
++ (interactive)\r
++ (notmuch-pick-tag "-"))\r
++\r
++(defun notmuch-pick-get-message-id ()\r
++ "Return the message id of the current message."\r
++ (concat "id:\"" (notmuch-pick-get-prop :id) "\""))\r
++\r
++(defun notmuch-pick-get-match ()\r
++ "Return whether the current message is a match."\r
++ (interactive)\r
++ (notmuch-pick-get-prop :match))\r
++\r
++(defun notmuch-pick-show-message ()\r
++ "Show the current message."\r
++ (interactive)\r
++ (let ((id (notmuch-pick-get-message-id))\r
++ (inhibit-read-only t)\r
++ buffer)\r
++ (when id\r
++ ;; we close and reopen the window to kill off un-needed buffers\r
++ ;; this might cause flickering but seems ok\r
++ (notmuch-pick-close-message-window)\r
++ (setq notmuch-pick-message-window\r
++ (split-window-vertically (/ (window-height) 4)))\r
++ (with-selected-window notmuch-pick-message-window\r
++ (setq buffer (notmuch-show id nil nil nil nil t))))\r
++ (setq notmuch-pick-message-buffer buffer)))\r
++\r
++(defun notmuch-pick-scroll-message-window ()\r
++ "Scroll the message window (if it exists)"\r
++ (interactive)\r
++ (when (window-live-p notmuch-pick-message-window)\r
++ (with-selected-window notmuch-pick-message-window\r
++ (if (pos-visible-in-window-p (point-max))\r
++ t\r
++ (scroll-up)))))\r
++\r
++(defun notmuch-pick-scroll-message-window-back ()\r
++ "Scroll the message window back(if it exists)"\r
++ (interactive)\r
++ (when (window-live-p notmuch-pick-message-window)\r
++ (with-selected-window notmuch-pick-message-window\r
++ (if (pos-visible-in-window-p (point-min))\r
++ t\r
++ (scroll-down)))))\r
++\r
++(defun notmuch-pick-scroll-or-next ()\r
++ "Scroll the message window. If it at end go to next message."\r
++ (interactive)\r
++ (when (notmuch-pick-scroll-message-window)\r
++ (notmuch-pick-next-message)))\r
++\r
++(defun notmuch-pick-toggle-order ()\r
++ "Toggle the current search order.\r
++\r
++By default, the \"inbox\" view created by `notmuch' is displayed\r
++in chronological order (oldest thread at the beginning of the\r
++buffer), while any global searches created by `notmuch-search'\r
++are displayed in reverse-chronological order (newest thread at\r
++the beginning of the buffer).\r
++\r
++This command toggles the sort order for the current search."\r
++ (interactive)\r
++ (let ((inhibit-read-only t))\r
++ (if notmuch-pick-oldest-first\r
++ (message "Showing newest messages first")\r
++ (message "Showing oldest messages first"))\r
++ (set 'notmuch-pick-oldest-first (not notmuch-pick-oldest-first))\r
++ (notmuch-pick-refresh-view)))\r
++\r
++(defun notmuch-pick-quit ()\r
++ "Close the split view or exit pick."\r
++ (interactive)\r
++ (unless (notmuch-pick-close-message-window)\r
++ (kill-buffer (current-buffer))))\r
++\r
++(defun notmuch-pick-close-message-window ()\r
++ "Close the message-window. Return t if close succeeds."\r
++ (interactive)\r
++ (when (and (window-live-p notmuch-pick-message-window)\r
++ (not (window-full-height-p notmuch-pick-message-window)))\r
++ (delete-window notmuch-pick-message-window)\r
++ (unless (get-buffer-window-list notmuch-pick-message-buffer)\r
++ (kill-buffer notmuch-pick-message-buffer))\r
++ t))\r
++\r
++(defun notmuch-pick-archive-message ()\r
++ "Archive the current message and move to next message."\r
++ (interactive)\r
++ (let ((id (notmuch-pick-get-message-id)))\r
++ (when id\r
++ (notmuch-tag id "-inbox" )\r
++ (forward-line))))\r
++\r
++(defun notmuch-pick-prev-message ()\r
++ "Move to previous matching message."\r
++ (interactive)\r
++ (forward-line -1)\r
++ (while (and (not (bobp)) (not (notmuch-pick-get-match)))\r
++ (forward-line -1))\r
++ (when (window-live-p notmuch-pick-message-window)\r
++ (notmuch-pick-show-message)))\r
++\r
++(defun notmuch-pick-next-message ()\r
++ "Move to next matching message."\r
++ (interactive)\r
++ (forward-line)\r
++ (while (and (not (eobp)) (not (notmuch-pick-get-match)))\r
++ (forward-line))\r
++ (when (window-live-p notmuch-pick-message-window)\r
++ (notmuch-pick-show-message)))\r
++\r
++(defun notmuch-pick-refresh-view ()\r
++ "Refresh view."\r
++ (interactive)\r
++ (let ((inhibit-read-only t)\r
++ (thread-id notmuch-pick-thread-id)\r
++ (query-context notmuch-pick-query-context)\r
++ (buffer-name notmuch-pick-buffer-name))\r
++ (erase-buffer)\r
++ (notmuch-pick-worker thread-id query-context buffer-name)))\r
++\r
++(defun notmuch-pick-toggle-view ()\r
++ "Toggle showing threads or as isolated messages."\r
++ (interactive)\r
++ (let ((inhibit-read-only t))\r
++ (if notmuch-pick-view-just-messages\r
++ (message "Showing as threads")\r
++ (message "Showing as single messages"))\r
++ (setq notmuch-pick-view-just-messages (not notmuch-pick-view-just-messages))\r
++ (notmuch-pick-refresh-view)))\r
++\r
++(defun notmuch-pick-string-width (string width &optional right)\r
++ (let ((s (format (format "%%%s%ds" (if right "" "-") width)\r
++ string)))\r
++ (if (> (length s) width)\r
++ (substring s 0 width)\r
++ s)))\r
++\r
++(defmacro with-current-notmuch-pick-message (&rest body)\r
++ "Evaluate body with current buffer set to the text of current message"\r
++ `(save-excursion\r
++ (let ((id (notmuch-pick-get-message-id)))\r
++ (let ((buf (generate-new-buffer (concat "*notmuch-msg-" id "*"))))\r
++ (with-current-buffer buf\r
++ (call-process notmuch-command nil t nil "show" "--format=raw" id)\r
++ ,@body)\r
++ (kill-buffer buf)))))\r
++\r
++(defun notmuch-pick-new-mail (&optional prompt-for-sender)\r
++ "Compose new mail."\r
++ (interactive "P")\r
++ (notmuch-pick-close-message-window)\r
++ (notmuch-mua-new-mail prompt-for-sender ))\r
++\r
++(defun notmuch-pick-forward-message (&optional prompt-for-sender)\r
++ "Forward the current message."\r
++ (interactive "P")\r
++ (notmuch-pick-close-message-window)\r
++ (with-current-notmuch-pick-message\r
++ (notmuch-mua-new-forward-message prompt-for-sender)))\r
++\r
++(defun notmuch-pick-reply (&optional prompt-for-sender)\r
++ "Reply to the sender and all recipients of the current message."\r
++ (interactive "P")\r
++ (notmuch-pick-close-message-window)\r
++ (notmuch-mua-new-reply (notmuch-pick-get-message-id) prompt-for-sender t))\r
++\r
++(defun notmuch-pick-reply-sender (&optional prompt-for-sender)\r
++ "Reply to the sender of the current message."\r
++ (interactive "P")\r
++ (notmuch-pick-close-message-window)\r
++ (notmuch-mua-new-reply (notmuch-pick-get-message-id) prompt-for-sender nil))\r
++\r
++;; Shamelessly stolen from notmuch-show.el: maybe should be unified MJW\r
++(defun notmuch-pick-pipe-message (command)\r
++ "Pipe the contents of the current message to the given command.\r
++\r
++The given command will be executed with the raw contents of the\r
++current email message as stdin. Anything printed by the command\r
++to stdout or stderr will appear in the *notmuch-pipe* buffer.\r
++\r
++When invoked with a prefix argument, the command will receive all\r
++open messages in the current thread (formatted as an mbox) rather\r
++than only the current message."\r
++ (interactive "sPipe message to command: ")\r
++ (let ((shell-command\r
++ (concat notmuch-command " show --format=raw "\r
++ (shell-quote-argument (notmuch-pick-get-message-id)) " | " command))\r
++ (buf (get-buffer-create (concat "*notmuch-pipe*"))))\r
++ (with-current-buffer buf\r
++ (setq buffer-read-only nil)\r
++ (erase-buffer)\r
++ (let ((exit-code (call-process-shell-command shell-command nil buf)))\r
++ (goto-char (point-max))\r
++ (set-buffer-modified-p nil)\r
++ (setq buffer-read-only t)\r
++ (unless (zerop exit-code)\r
++ (switch-to-buffer-other-window buf)\r
++ (message (format "Command '%s' exited abnormally with code %d"\r
++ shell-command exit-code)))))))\r
++\r
++;; Shamelessly stolen from notmuch-show.el: should be unified MJW\r
++(defun notmuch-pick-clean-address (address)\r
++ "Try to clean a single email ADDRESS for display. Return\r
++unchanged ADDRESS if parsing fails."\r
++ (condition-case nil\r
++ (let (p-name p-address)\r
++ ;; It would be convenient to use `mail-header-parse-address',\r
++ ;; but that expects un-decoded mailbox parts, whereas our\r
++ ;; mailbox parts are already decoded (and hence may contain\r
++ ;; UTF-8). Given that notmuch should handle most of the awkward\r
++ ;; cases, some simple string deconstruction should be sufficient\r
++ ;; here.\r
++ (cond\r
++ ;; "User <user@dom.ain>" style.\r
++ ((string-match "\\(.*\\) <\\(.*\\)>" address)\r
++ (setq p-name (match-string 1 address)\r
++ p-address (match-string 2 address)))\r
++\r
++ ;; "<user@dom.ain>" style.\r
++ ((string-match "<\\(.*\\)>" address)\r
++ (setq p-address (match-string 1 address)))\r
++\r
++ ;; Everything else.\r
++ (t\r
++ (setq p-address address)))\r
++\r
++ (when p-name\r
++ ;; Remove elements of the mailbox part that are not relevant for\r
++ ;; display, even if they are required during transport:\r
++ ;;\r
++ ;; Backslashes.\r
++ (setq p-name (replace-regexp-in-string "\\\\" "" p-name))\r
++\r
++ ;; Outer single and double quotes, which might be nested.\r
++ (loop\r
++ with start-of-loop\r
++ do (setq start-of-loop p-name)\r
++\r
++ when (string-match "^\"\\(.*\\)\"$" p-name)\r
++ do (setq p-name (match-string 1 p-name))\r
++\r
++ when (string-match "^'\\(.*\\)'$" p-name)\r
++ do (setq p-name (match-string 1 p-name))\r
++\r
++ until (string= start-of-loop p-name)))\r
++\r
++ ;; If the address is 'foo@bar.com <foo@bar.com>' then show just\r
++ ;; 'foo@bar.com'.\r
++ (when (string= p-name p-address)\r
++ (setq p-name nil))\r
++\r
++ ;; If we have a name return that otherwise return the address.\r
++ (if (not p-name)\r
++ p-address\r
++ p-name))\r
++ (error address)))\r
++\r
++(defun notmuch-pick-insert-msg (msg depth tree-status)\r
++ (let* ((headers (plist-get msg :headers))\r
++ (match (plist-get msg :match))\r
++ (tags (plist-get msg :tags))\r
++ (bare-subject (notmuch-show-strip-re (plist-get headers :Subject)))\r
++ ;; Face should be a defcustom or something MJW\r
++ (message-face (if match\r
++ '(:foreground "black")\r
++ '(:foreground "gray"))))\r
++\r
++ (insert (propertize (concat\r
++ (notmuch-pick-string-width\r
++ (plist-get msg :date_relative) 12 t)\r
++ " "\r
++ (format "%-75s"\r
++ (concat\r
++ (notmuch-pick-string-width\r
++ (notmuch-pick-clean-address (plist-get headers :From))\r
++ (if notmuch-pick-view-just-messages\r
++ (+ notmuch-pick-author-width 3)\r
++ notmuch-pick-author-width))\r
++ " "\r
++ (unless notmuch-pick-view-just-messages\r
++ (mapconcat #'identity (reverse tree-status) ""))\r
++ (if (string= notmuch-pick-previous-subject bare-subject)\r
++ " ..."\r
++ bare-subject)))\r
++ (if tags\r
++ (concat " ("\r
++ (mapconcat #'identity tags ", ") ")"))\r
++ "") 'face message-face))\r
++ (notmuch-pick-set-message-properties msg)\r
++ (insert "\n")\r
++\r
++ (setq notmuch-pick-previous-subject bare-subject)))\r
++\r
++(defun notmuch-pick-insert-tree (tree depth tree-status first last)\r
++ "Insert the message tree TREE at depth DEPTH in the current thread."\r
++ (let ((msg (car tree))\r
++ (replies (cadr tree)))\r
++\r
++ (cond\r
++ ((and (< 0 depth) (not last))\r
++ (push "├" tree-status))\r
++ ((and (< 0 depth) last)\r
++ (push "╰" tree-status))\r
++ ((and (eq 0 depth) first last)\r
++;; (push "─" tree-status)) choice between this and next line is matter of taste MJW\r
++ (push " " tree-status))\r
++ ((and (eq 0 depth) first (not last))\r
++ (push "┬" tree-status))\r
++ ((and (eq 0 depth) (not first) last)\r
++ (push "╰" tree-status))\r
++ ((and (eq 0 depth) (not first) (not last))\r
++ (push "├" tree-status)))\r
++\r
++ (push (concat (if replies "┬" "─") "►") tree-status)\r
++ (notmuch-pick-insert-msg msg depth tree-status)\r
++ (pop tree-status)\r
++ (pop tree-status)\r
++\r
++ (if last\r
++ (push " " tree-status)\r
++ (push "│" tree-status))\r
++\r
++ (notmuch-pick-insert-thread replies (1+ depth) tree-status)))\r
++\r
++(defun notmuch-pick-insert-thread (thread depth tree-status)\r
++ "Insert the thread THREAD at depth DEPTH >= 1 in the current forest."\r
++ (let ((n (length thread)))\r
++ (loop for tree in thread\r
++ for count from 1 to n\r
++\r
++ do (notmuch-pick-insert-tree tree depth tree-status (eq count 1) (eq count n)))))\r
++\r
++(defun notmuch-pick-insert-forest (forest)\r
++ (mapc '(lambda (thread)\r
++ (let (tree-status)\r
++ ;; Reset at the start of each main thread.\r
++ (setq notmuch-pick-previous-subject nil)\r
++ (notmuch-pick-insert-thread thread 0 tree-status)))\r
++ forest))\r
++\r
++(defun notmuch-pick-mode ()\r
++ "Major mode displaying messages (as opposed to threads) of of a notmuch search.\r
++\r
++This buffer contains the results of a \"notmuch pick\" of your\r
++email archives. Each line in the buffer represents a single\r
++message giving the relative date, the author, subject, and any\r
++tags.\r
++\r
++Pressing \\[notmuch-pick-show-message] on any line displays that message.\r
++\r
++Complete list of currently available key bindings:\r
++\r
++\\{notmuch-pick-mode-map}"\r
++\r
++ (interactive)\r
++ (kill-all-local-variables)\r
++ (use-local-map notmuch-pick-mode-map)\r
++ (setq major-mode 'notmuch-pick-mode\r
++ mode-name "notmuch-pick")\r
++ (hl-line-mode 1)\r
++ (setq buffer-read-only t\r
++ truncate-lines t))\r
++\r
++(defun notmuch-pick-worker (thread-id &optional query-context buffer-name)\r
++ (interactive)\r
++ (notmuch-pick-mode)\r
++ (setq notmuch-pick-thread-id thread-id)\r
++ (setq notmuch-pick-query-context query-context)\r
++ (setq notmuch-pick-buffer-name buffer-name)\r
++\r
++ (erase-buffer)\r
++ (goto-char (point-min))\r
++ (save-excursion\r
++ (let* ((basic-args (list thread-id))\r
++ (args (if query-context\r
++ (append (list "\'") basic-args (list "and (" query-context ")\'"))\r
++ (append (list "\'") basic-args (list "\'"))))\r
++ (message-arg (if notmuch-pick-view-just-messages\r
++ "--thread=none"\r
++ "--thread=entire"))\r
++ (sort-arg (if notmuch-pick-oldest-first\r
++ "--sort=oldest-first"\r
++ "--sort=newest-first")))\r
++\r
++ (notmuch-pick-insert-forest (notmuch-query-get-threads args "--headers-only" message-arg sort-arg))\r
++ ;; If the query context reduced the results to nothing, run\r
++ ;; the basic query.\r
++ (when (and (eq (buffer-size) 0)\r
++ query-context)\r
++ (notmuch-pick-insert-forest\r
++ (notmuch-query-get-threads basic-args message-arg sort-arg))))))\r
++\r
++(defun notmuch-pick (&optional query query-context buffer-name)\r
++ "Run notmuch pick with the given `query' and display the results"\r
++ (interactive "sNotmuch pick: ")\r
++ (if (null query)\r
++ (setq query (notmuch-read-query "Notmuch pick: ")))\r
++ (let ((buffer (get-buffer-create (generate-new-buffer-name\r
++ (or buffer-name\r
++ (concat "*notmuch-" query "*")))))\r
++ (inhibit-read-only t))\r
++\r
++ (switch-to-buffer buffer)\r
++ ;; Don't track undo information for this buffer\r
++ (set 'buffer-undo-list t)\r
++\r
++ (notmuch-pick-worker query query-context buffer-name)\r
++\r
++ (setq truncate-lines t)))\r
++\r
++;; (use-local-map notmuch-pick-mode-map))\r
++\r
++;;\r
++\r
++(provide 'notmuch-pick)\r
+-- \r
+1.7.2.3\r
+\r
projects / notmuch-archives.git / commitdiff