--- /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 DA24A429E28\r
+ for <notmuch@notmuchmail.org>; Sat, 27 Oct 2012 04:27:00 -0700 (PDT)\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 B9f3j+u1Dlv8 for <notmuch@notmuchmail.org>;\r
+ Sat, 27 Oct 2012 04:26:54 -0700 (PDT)\r
+Received: from mail-we0-f181.google.com (mail-we0-f181.google.com\r
+ [74.125.82.181]) (using TLSv1 with cipher RC4-SHA (128/128 bits))\r
+ (No client certificate requested)\r
+ by olra.theworths.org (Postfix) with ESMTPS id 3A596429E2E\r
+ for <notmuch@notmuchmail.org>; Sat, 27 Oct 2012 04:26:50 -0700 (PDT)\r
+Received: by mail-we0-f181.google.com with SMTP id u54so1984348wey.26\r
+ for <notmuch@notmuchmail.org>; Sat, 27 Oct 2012 04:26:49 -0700 (PDT)\r
+DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20120113;\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=iODidPHH9A3K7dlmhb5iUN72u3tjkD95DYIscgO2JCs=;\r
+ b=DbovlkUmqGLhHFWYMHmjbJ4R4VBbkLKDMt/4e2mRot2H8IhAy8x2RcOz+KLmD3cSYB\r
+ 1e7U4mmc51l9SYlxRVA0drECELMK5xFlUdWKXy4EouffTFiRPDQLhhO3muZUbINkYmlO\r
+ ZhrcIFNV3wyA/moR9YL6IFowqjDfTeZ0IAyZSGDRQYKIAMb8KaDcXO5uBzSgn9y5b7/3\r
+ kUJ154pQulQ3gVZVtgF8iq6rkD6zjqWKBxe5bAivLnPI4obW0hP1YTtSVWuuFLSEVWyr\r
+ QQcukmN2ECDXzW1p9rE/R1IrQQQnF4a7oDRC9t/UgR55jktCcgDI9Bg110No6lta7Sa2\r
+ hVhw==\r
+Received: by 10.216.197.227 with SMTP id t77mr12299375wen.146.1351337209009;\r
+ Sat, 27 Oct 2012 04:26:49 -0700 (PDT)\r
+Received: from localhost (93-97-24-31.zone5.bethere.co.uk. [93.97.24.31])\r
+ by mx.google.com with ESMTPS id dt9sm1917770wib.1.2012.10.27.04.26.46\r
+ (version=TLSv1/SSLv3 cipher=OTHER);\r
+ Sat, 27 Oct 2012 04:26:48 -0700 (PDT)\r
+From: Mark Walters <markwalters1009@gmail.com>\r
+To: notmuch@notmuchmail.org\r
+Subject: [PATCH 1/3] contrib: add notmuch-pick.el file itself\r
+Date: Sat, 27 Oct 2012 12:26:38 +0100\r
+Message-Id: <1351337200-18050-2-git-send-email-markwalters1009@gmail.com>\r
+X-Mailer: git-send-email 1.7.9.1\r
+In-Reply-To: <1351337200-18050-1-git-send-email-markwalters1009@gmail.com>\r
+References: <1351337200-18050-1-git-send-email-markwalters1009@gmail.com>\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: Sat, 27 Oct 2012 11:27:01 -0000\r
+\r
+This adds the main notmuch-pick.el file.\r
+---\r
+ contrib/notmuch-pick/notmuch-pick.el | 867 ++++++++++++++++++++++++++++++++++\r
+ 1 files changed, 867 insertions(+), 0 deletions(-)\r
+ create mode 100644 contrib/notmuch-pick/notmuch-pick.el\r
+\r
+diff --git a/contrib/notmuch-pick/notmuch-pick.el b/contrib/notmuch-pick/notmuch-pick.el\r
+new file mode 100644\r
+index 0000000..be6a91a\r
+--- /dev/null\r
++++ b/contrib/notmuch-pick/notmuch-pick.el\r
+@@ -0,0 +1,867 @@\r
++;; notmuch-pick.el --- displaying notmuch forests.\r
++;;\r
++;; Copyright © Carl Worth\r
++;; Copyright © David Edmondson\r
++;; Copyright © Mark Walters\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
++;; Mark Walters <markwalters1009@gmail.com>\r
++\r
++(require 'mail-parse)\r
++\r
++(require 'notmuch-lib)\r
++(require 'notmuch-query)\r
++(require 'notmuch-show)\r
++(require 'notmuch) ;; XXX ATM, as notmuch-search-mode-map is defined here\r
++\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
++(declare-function notmuch-hello-trim "notmuch-hello" (search))\r
++(declare-function notmuch-search-find-thread-id "notmuch" ())\r
++(declare-function notmuch-search-find-subject "notmuch" ())\r
++\r
++;; the following variable is defined in notmuch.el\r
++(defvar notmuch-search-query-string)\r
++\r
++(defgroup notmuch-pick nil\r
++ "Showing message and thread structure."\r
++ :group 'notmuch)\r
++\r
++;; This is ugly. We can't run setup-show-out until it has been defined\r
++;; which needs the keymap to be defined. So we defer setting up to\r
++;; notmuch-pick-init.\r
++(defcustom notmuch-pick-show-out nil\r
++ "View selected messages in new window rather than split-pane."\r
++ :type 'boolean\r
++ :group 'notmuch-pick\r
++ :set (lambda (symbol value)\r
++ (set-default symbol value)\r
++ (when (fboundp 'notmuch-pick-setup-show-out)\r
++ (notmuch-pick-setup-show-out))))\r
++\r
++(defcustom notmuch-pick-result-format\r
++ `(("date" . "%12s ")\r
++ ("authors" . "%-20s")\r
++ ("subject" . " %-54s ")\r
++ ("tags" . "(%s)"))\r
++ "Result formatting for Pick. Supported fields are: date,\r
++ authors, subject, tags Note: subject includes the tree\r
++ structure graphics, and the author string should not\r
++ contain whitespace (put it in the neighbouring fields\r
++ instead). For example:\r
++ (setq notmuch-pick-result-format \(\(\"authors\" . \"%-40s\"\)\r
++ \(\"subject\" . \"%s\"\)\)\)"\r
++ :type '(alist :key-type (string) :value-type (string))\r
++ :group 'notmuch-pick)\r
++\r
++(defcustom notmuch-pick-asynchronous-parser t\r
++ "Use the asynchronous parser."\r
++ :type 'boolean\r
++ :group 'notmuch-pick)\r
++\r
++;; Faces for messages that match the query.\r
++(defface notmuch-pick-match-date-face\r
++ '((t :inherit default))\r
++ "Face used in pick mode for the date in messages matching the query."\r
++ :group 'notmuch-pick\r
++ :group 'notmuch-faces)\r
++\r
++(defface notmuch-pick-match-author-face\r
++ '((((class color)\r
++ (background dark))\r
++ (:foreground "OliveDrab1"))\r
++ (((class color)\r
++ (background light))\r
++ (:foreground "dark blue"))\r
++ (t\r
++ (:bold t)))\r
++ "Face used in pick mode for the date in messages matching the query."\r
++ :group 'notmuch-pick\r
++ :group 'notmuch-faces)\r
++\r
++(defface notmuch-pick-match-subject-face\r
++ '((t :inherit default))\r
++ "Face used in pick mode for the subject in messages matching the query."\r
++ :group 'notmuch-pick\r
++ :group 'notmuch-faces)\r
++\r
++(defface notmuch-pick-match-tag-face\r
++ '((((class color)\r
++ (background dark))\r
++ (:foreground "OliveDrab1"))\r
++ (((class color)\r
++ (background light))\r
++ (:foreground "navy blue" :bold t))\r
++ (t\r
++ (:bold t)))\r
++ "Face used in pick mode for tags in messages matching the query."\r
++ :group 'notmuch-pick\r
++ :group 'notmuch-faces)\r
++\r
++;; Faces for messages that do not match the query.\r
++(defface notmuch-pick-no-match-date-face\r
++ '((t (:foreground "gray")))\r
++ "Face used in pick mode for non-matching dates."\r
++ :group 'notmuch-pick\r
++ :group 'notmuch-faces)\r
++\r
++(defface notmuch-pick-no-match-subject-face\r
++ '((t (:foreground "gray")))\r
++ "Face used in pick mode for non-matching subjects."\r
++ :group 'notmuch-pick\r
++ :group 'notmuch-faces)\r
++\r
++(defface notmuch-pick-no-match-author-face\r
++ '((t (:foreground "gray")))\r
++ "Face used in pick mode for the date in messages matching the query."\r
++ :group 'notmuch-pick\r
++ :group 'notmuch-faces)\r
++\r
++(defface notmuch-pick-no-match-tag-face\r
++ '((t (:foreground "gray")))\r
++ "Face used in pick mode face for non-matching tags."\r
++ :group 'notmuch-pick\r
++ :group 'notmuch-faces)\r
++\r
++(defvar notmuch-pick-previous-subject "")\r
++(make-variable-buffer-local 'notmuch-pick-previous-subject)\r
++\r
++;; The basic query i.e. the key part of the search request.\r
++(defvar notmuch-pick-basic-query nil)\r
++(make-variable-buffer-local 'notmuch-pick-basic-query)\r
++;; The context of the search: i.e., useful but can be dropped.\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-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-process-state nil\r
++ "Parsing state of the search process filter.")\r
++\r
++\r
++(defvar notmuch-pick-mode-map\r
++ (let ((map (make-sparse-keymap)))\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 "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-matching-message)\r
++ (define-key map "p" 'notmuch-pick-prev-matching-message)\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-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-setup-show-out ()\r
++ (let ((map notmuch-pick-mode-map))\r
++ (if notmuch-pick-show-out\r
++ (progn\r
++ (define-key map (kbd "M-RET") 'notmuch-pick-show-message)\r
++ (define-key map (kbd "RET") 'notmuch-pick-show-message-out))\r
++ (progn\r
++ (define-key map (kbd "RET") 'notmuch-pick-show-message)\r
++ (define-key map (kbd "M-RET") 'notmuch-pick-show-message-out)))))\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-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-refresh-result ()\r
++ (let ((init-point (point))\r
++ (end (line-end-position))\r
++ (msg (notmuch-pick-get-message-properties))\r
++ (inhibit-read-only t))\r
++ (beginning-of-line)\r
++ (delete-region (point) (1+ (line-end-position)))\r
++ (notmuch-pick-insert-msg msg)\r
++ (let ((new-end (line-end-position)))\r
++ (goto-char (if (= init-point end)\r
++ new-end\r
++ (min init-point (- new-end 1)))))))\r
++\r
++(defun notmuch-pick-tag-update-display (&optional tag-changes)\r
++ "Update display for TAG-CHANGES to current message.\r
++\r
++Does NOT change the database."\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
++ (notmuch-pick-set-tags new-tags)\r
++ (notmuch-pick-refresh-result))))\r
++\r
++(defun notmuch-pick-tag (&optional tag-changes)\r
++ "Change tags for the current message"\r
++ (interactive)\r
++ (setq tag-changes (funcall 'notmuch-tag (notmuch-pick-get-message-id) tag-changes))\r
++ (notmuch-pick-tag-update-display 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
++;; This function should be in notmuch-hello.el but we are trying to\r
++;; minimise impact on the rest of the codebase.\r
++(defun notmuch-pick-from-hello (&optional search)\r
++ "Run a query and display results in experimental notmuch-pick mode"\r
++ (interactive)\r
++ (unless (null search)\r
++ (setq search (notmuch-hello-trim search))\r
++ (let ((history-delete-duplicates t))\r
++ (add-to-history 'notmuch-search-history search)))\r
++ (notmuch-pick search))\r
++\r
++;; This function should be in notmuch-show.el but be we trying to\r
++;; minimise impact on the rest of the codebase.\r
++(defun notmuch-pick-from-show-current-query ()\r
++ "Call notmuch pick with the current query"\r
++ (interactive)\r
++ (notmuch-pick notmuch-show-thread-id notmuch-show-query-context))\r
++\r
++;; This function should be in notmuch.el but be we trying to minimise\r
++;; impact on the rest of the codebase.\r
++(defun notmuch-pick-from-search-current-query ()\r
++ "Call notmuch pick with the current query"\r
++ (interactive)\r
++ (notmuch-pick notmuch-search-query-string))\r
++\r
++;; This function should be in notmuch.el but be we trying to minimise\r
++;; impact on the rest of the codebase.\r
++(defun notmuch-pick-from-search-thread ()\r
++ "Show the selected thread with notmuch-pick"\r
++ (interactive)\r
++ (notmuch-pick (notmuch-search-find-thread-id)\r
++ notmuch-search-query-string\r
++ (notmuch-prettify-subject (notmuch-search-find-subject)))\r
++ (notmuch-pick-show-match-message-with-wait))\r
++\r
++(defun notmuch-pick-show-message ()\r
++ "Show the current message (in split-pane)."\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 current-prefix-arg '(4))\r
++ (setq buffer (notmuch-show id nil nil nil)))\r
++ (notmuch-pick-tag-update-display (list "-unread")))\r
++ (setq notmuch-pick-message-buffer buffer)))\r
++\r
++(defun notmuch-pick-show-message-out ()\r
++ "Show the current message (in whole window)."\r
++ (interactive)\r
++ (let ((id (notmuch-pick-get-message-id))\r
++ (inhibit-read-only t)\r
++ buffer)\r
++ (when id\r
++ ;; We close the window to kill off un-needed buffers.\r
++ (notmuch-pick-close-message-window)\r
++ (notmuch-show id nil nil nil))))\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-matching-message)))\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
++ (eq (window-buffer notmuch-pick-message-window) notmuch-pick-message-buffer))\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 matching message."\r
++ (interactive)\r
++ (notmuch-pick-tag "-inbox")\r
++ (notmuch-pick-next-matching-message))\r
++\r
++(defun notmuch-pick-next-message ()\r
++ "Move to next message."\r
++ (interactive)\r
++ (forward-line)\r
++ (when (window-live-p notmuch-pick-message-window)\r
++ (notmuch-pick-show-message)))\r
++\r
++(defun notmuch-pick-prev-message ()\r
++ "Move to previous message."\r
++ (interactive)\r
++ (forward-line -1)\r
++ (when (window-live-p notmuch-pick-message-window)\r
++ (notmuch-pick-show-message)))\r
++\r
++(defun notmuch-pick-prev-matching-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-matching-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-show-match-message-with-wait ()\r
++ "Show the first matching message but wait for it to appear or search to finish."\r
++ (interactive)\r
++ (unless (notmuch-pick-get-match)\r
++ (notmuch-pick-next-matching-message))\r
++ (while (and (not (notmuch-pick-get-match))\r
++ (not (eq notmuch-pick-process-state 'end)))\r
++ (message "waiting for message")\r
++ (sit-for 0.1)\r
++ (goto-char (point-min))\r
++ (unless (notmuch-pick-get-match)\r
++ (notmuch-pick-next-matching-message)))\r
++ (message nil)\r
++ (when (notmuch-pick-get-match)\r
++ (notmuch-pick-show-message)))\r
++\r
++(defun notmuch-pick-refresh-view ()\r
++ "Refresh view."\r
++ (interactive)\r
++ (let ((inhibit-read-only t)\r
++ (basic-query notmuch-pick-basic-query)\r
++ (query-context notmuch-pick-query-context)\r
++ (buffer-name notmuch-pick-buffer-name))\r
++ (erase-buffer)\r
++ (notmuch-pick-worker basic-query query-context (get-buffer buffer-name))))\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.\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.\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-field (field format-string msg)\r
++ (let* ((headers (plist-get msg :headers))\r
++ (match (plist-get msg :match)))\r
++ (cond\r
++ ((string-equal field "date")\r
++ (let ((face (if match\r
++ 'notmuch-pick-match-date-face\r
++ 'notmuch-pick-no-match-date-face)))\r
++ (insert (propertize (format format-string (plist-get msg :date_relative))\r
++ 'face face))))\r
++\r
++ ((string-equal field "subject")\r
++ (let ((tree-status (plist-get msg :tree-status))\r
++ (bare-subject (notmuch-show-strip-re (plist-get headers :Subject)))\r
++ (face (if match\r
++ 'notmuch-pick-match-subject-face\r
++ 'notmuch-pick-no-match-subject-face)))\r
++ (insert (propertize (format format-string\r
++ (concat\r
++ (mapconcat #'identity (reverse tree-status) "")\r
++ (if (string= notmuch-pick-previous-subject bare-subject)\r
++ " ..."\r
++ bare-subject)))\r
++ 'face face))\r
++ (setq notmuch-pick-previous-subject bare-subject)))\r
++\r
++ ((string-equal field "authors")\r
++ (let ((author (notmuch-pick-clean-address (plist-get headers :From)))\r
++ (len (length (format format-string "")))\r
++ (face (if match\r
++ 'notmuch-pick-match-author-face\r
++ 'notmuch-pick-no-match-author-face)))\r
++ (when (> (length author) len)\r
++ (setq author (substring author 0 len)))\r
++ (insert (propertize (format format-string author)\r
++ 'face face))))\r
++\r
++ ((string-equal field "tags")\r
++ (let ((tags (plist-get msg :tags))\r
++ (face (if match\r
++ 'notmuch-pick-match-tag-face\r
++ 'notmuch-pick-no-match-tag-face)))\r
++ (when tags\r
++ (insert (propertize (format format-string\r
++ (mapconcat #'identity tags ", "))\r
++ 'face face))))))))\r
++\r
++(defun notmuch-pick-insert-msg (msg)\r
++ "Insert the message MSG according to notmuch-pick-result-format"\r
++ (dolist (spec notmuch-pick-result-format)\r
++ (notmuch-pick-insert-field (car spec) (cdr spec) msg))\r
++ (notmuch-pick-set-message-properties msg)\r
++ (insert "\n"))\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.\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 (plist-put msg :tree-status 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-thread (forest-thread)\r
++ (save-excursion\r
++ (goto-char (point-max))\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 forest-thread 0 tree-status))))\r
++\r
++(defun notmuch-pick-insert-forest (forest)\r
++ (mapc 'notmuch-pick-insert-forest-thread 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-process-sentinel (proc msg)\r
++ "Add a message to let user know when \"notmuch pick\" exits"\r
++ (let ((buffer (process-buffer proc))\r
++ (status (process-status proc))\r
++ (exit-status (process-exit-status proc))\r
++ (never-found-target-thread nil))\r
++ (when (memq status '(exit signal))\r
++ (kill-buffer (process-get proc 'parse-buf))\r
++ (if (buffer-live-p buffer)\r
++ (with-current-buffer buffer\r
++ (save-excursion\r
++ (let ((inhibit-read-only t)\r
++ (atbob (bobp)))\r
++ (goto-char (point-max))\r
++ (if (eq status 'signal)\r
++ (insert "Incomplete search results (pick process was killed).\n"))\r
++ (when (eq status 'exit)\r
++ (insert "End of search results.")\r
++ (unless (= exit-status 0)\r
++ (insert (format " (process returned %d)" exit-status)))\r
++ (insert "\n")))))))))\r
++\r
++\r
++(defun notmuch-pick-show-error (string &rest objects)\r
++ (save-excursion\r
++ (goto-char (point-max))\r
++ (insert "Error: Unexpected output from notmuch search:\n")\r
++ (insert (apply #'format string objects))\r
++ (insert "\n")))\r
++\r
++\r
++(defvar notmuch-pick-json-parser nil\r
++ "Incremental JSON parser for the search process filter.")\r
++\r
++(defun notmuch-pick-process-filter (proc string)\r
++ "Process and filter the output of \"notmuch show\" (for pick)"\r
++ (let ((results-buf (process-buffer proc))\r
++ (parse-buf (process-get proc 'parse-buf))\r
++ (inhibit-read-only t)\r
++ done)\r
++ (if (not (buffer-live-p results-buf))\r
++ (delete-process proc)\r
++ (with-current-buffer parse-buf\r
++ ;; Insert new data\r
++ (save-excursion\r
++ (goto-char (point-max))\r
++ (insert string)))\r
++ (with-current-buffer results-buf\r
++ (save-excursion\r
++ (goto-char (point-max))\r
++ (while (not done)\r
++ (condition-case nil\r
++ (case notmuch-pick-process-state\r
++ ((begin)\r
++ ;; Enter the results list\r
++ (if (eq (notmuch-json-begin-compound\r
++ notmuch-pick-json-parser) 'retry)\r
++ (setq done t)\r
++ (setq notmuch-pick-process-state 'result)))\r
++ ((result)\r
++ ;; Parse a result\r
++ (let ((result (notmuch-json-read notmuch-pick-json-parser)))\r
++ (case result\r
++ ((retry) (setq done t))\r
++ ((end) (setq notmuch-pick-process-state 'end))\r
++ (otherwise (notmuch-pick-insert-forest-thread result)))))\r
++ ((end)\r
++ ;; Any trailing data is unexpected\r
++ (with-current-buffer parse-buf\r
++ (skip-chars-forward " \t\r\n")\r
++ (if (eobp)\r
++ (setq done t)\r
++ (signal 'json-error nil)))))\r
++ (json-error\r
++ ;; Do our best to resynchronize and ensure forward\r
++ ;; progress\r
++ (notmuch-pick-show-error\r
++ "%s"\r
++ (with-current-buffer parse-buf\r
++ (let ((bad (buffer-substring (line-beginning-position)\r
++ (line-end-position))))\r
++ (forward-line)\r
++ bad))))))\r
++ ;; Clear out what we've parsed\r
++ (with-current-buffer parse-buf\r
++ (delete-region (point-min) (point))))))))\r
++\r
++(defun notmuch-pick-worker (basic-query &optional query-context buffer)\r
++ (interactive)\r
++ (notmuch-pick-mode)\r
++ (setq notmuch-pick-basic-query basic-query)\r
++ (setq notmuch-pick-query-context query-context)\r
++ (setq notmuch-pick-buffer-name (buffer-name buffer))\r
++\r
++ (erase-buffer)\r
++ (goto-char (point-min))\r
++ (let* ((search-args (concat basic-query\r
++ (if query-context (concat " and (" query-context ")"))\r
++ ))\r
++ (message-arg "--entire-thread"))\r
++ (if (equal (car (process-lines notmuch-command "count" search-args)) "0")\r
++ (setq search-args basic-query))\r
++ (message "starting parser %s"\r
++ (format-time-string "%r"))\r
++ (if notmuch-pick-asynchronous-parser\r
++ (let ((proc (start-process\r
++ "notmuch-pick" buffer\r
++ notmuch-command "show" "--body=false" "--format=json"\r
++ message-arg search-args))\r
++ ;; Use a scratch buffer to accumulate partial output.\r
++ ;; This buffer will be killed by the sentinel, which\r
++ ;; should be called no matter how the process dies.\r
++ (parse-buf (generate-new-buffer " *notmuch pick parse*")))\r
++ (set (make-local-variable 'notmuch-pick-process-state) 'begin)\r
++ (set (make-local-variable 'notmuch-pick-json-parser)\r
++ (notmuch-json-create-parser parse-buf))\r
++ (process-put proc 'parse-buf parse-buf)\r
++ (set-process-sentinel proc 'notmuch-pick-process-sentinel)\r
++ (set-process-filter proc 'notmuch-pick-process-filter)\r
++ (set-process-query-on-exit-flag proc nil))\r
++ (progn\r
++ (notmuch-pick-insert-forest\r
++ (notmuch-query-get-threads\r
++ (list "--body=false" message-arg search-args)))\r
++ (save-excursion\r
++ (goto-char (point-max))\r
++ (insert "End of search results.\n"))\r
++ (message "sync parser finished %s"\r
++ (format-time-string "%r"))))))\r
++\r
++\r
++(defun notmuch-pick (&optional query query-context buffer-name show-first-match)\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-pick-" 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)\r
++\r
++ (setq truncate-lines t)\r
++ (when show-first-match\r
++ (notmuch-pick-show-match-message-with-wait))))\r
++\r
++\r
++;; Set up key bindings from the rest of notmuch.\r
++(define-key 'notmuch-search-mode-map "z" 'notmuch-pick)\r
++(define-key 'notmuch-search-mode-map "Z" 'notmuch-pick-from-search-current-query)\r
++(define-key 'notmuch-search-mode-map (kbd "M-RET") 'notmuch-pick-from-search-thread)\r
++(define-key 'notmuch-hello-mode-map "z" 'notmuch-pick-from-hello)\r
++(define-key 'notmuch-show-mode-map "z" 'notmuch-pick)\r
++(define-key 'notmuch-show-mode-map "Z" 'notmuch-pick-from-show-current-query)\r
++(notmuch-pick-setup-show-out)\r
++(message "Initialised notmuch-pick")\r
++\r
++(provide 'notmuch-pick)\r
+-- \r
+1.7.9.1\r
+\r
projects / notmuch-archives.git / commitdiff