From: Mark Walters Date: Sat, 27 Oct 2012 11:26:38 +0000 (+0100) Subject: [PATCH 1/3] contrib: add notmuch-pick.el file itself X-Git-Url: http://git.tremily.us/gitweb.cgi?a=commitdiff_plain;h=219595e6463aa714f13664e8b4937ae0e8294f7a;p=notmuch-archives.git [PATCH 1/3] contrib: add notmuch-pick.el file itself --- diff --git a/c7/4a530353952d02bea075f4642dd7d892927cdd b/c7/4a530353952d02bea075f4642dd7d892927cdd new file mode 100644 index 000000000..caf131ea4 --- /dev/null +++ b/c7/4a530353952d02bea075f4642dd7d892927cdd @@ -0,0 +1,948 @@ +Return-Path: +X-Original-To: notmuch@notmuchmail.org +Delivered-To: notmuch@notmuchmail.org +Received: from localhost (localhost [127.0.0.1]) + by olra.theworths.org (Postfix) with ESMTP id DA24A429E28 + for ; Sat, 27 Oct 2012 04:27:00 -0700 (PDT) +X-Virus-Scanned: Debian amavisd-new at olra.theworths.org +X-Spam-Flag: NO +X-Spam-Score: 0.201 +X-Spam-Level: +X-Spam-Status: No, score=0.201 tagged_above=-999 required=5 + tests=[DKIM_SIGNED=0.1, DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1, + FREEMAIL_ENVFROM_END_DIGIT=1, FREEMAIL_FROM=0.001, + RCVD_IN_DNSWL_LOW=-0.7] autolearn=disabled +Received: from olra.theworths.org ([127.0.0.1]) + by localhost (olra.theworths.org [127.0.0.1]) (amavisd-new, port 10024) + with ESMTP id B9f3j+u1Dlv8 for ; + Sat, 27 Oct 2012 04:26:54 -0700 (PDT) +Received: from mail-we0-f181.google.com (mail-we0-f181.google.com + [74.125.82.181]) (using TLSv1 with cipher RC4-SHA (128/128 bits)) + (No client certificate requested) + by olra.theworths.org (Postfix) with ESMTPS id 3A596429E2E + for ; Sat, 27 Oct 2012 04:26:50 -0700 (PDT) +Received: by mail-we0-f181.google.com with SMTP id u54so1984348wey.26 + for ; Sat, 27 Oct 2012 04:26:49 -0700 (PDT) +DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20120113; + h=from:to:cc:subject:date:message-id:x-mailer:in-reply-to:references + :mime-version:content-type:content-transfer-encoding; + bh=iODidPHH9A3K7dlmhb5iUN72u3tjkD95DYIscgO2JCs=; + b=DbovlkUmqGLhHFWYMHmjbJ4R4VBbkLKDMt/4e2mRot2H8IhAy8x2RcOz+KLmD3cSYB + 1e7U4mmc51l9SYlxRVA0drECELMK5xFlUdWKXy4EouffTFiRPDQLhhO3muZUbINkYmlO + ZhrcIFNV3wyA/moR9YL6IFowqjDfTeZ0IAyZSGDRQYKIAMb8KaDcXO5uBzSgn9y5b7/3 + kUJ154pQulQ3gVZVtgF8iq6rkD6zjqWKBxe5bAivLnPI4obW0hP1YTtSVWuuFLSEVWyr + QQcukmN2ECDXzW1p9rE/R1IrQQQnF4a7oDRC9t/UgR55jktCcgDI9Bg110No6lta7Sa2 + hVhw== +Received: by 10.216.197.227 with SMTP id t77mr12299375wen.146.1351337209009; + Sat, 27 Oct 2012 04:26:49 -0700 (PDT) +Received: from localhost (93-97-24-31.zone5.bethere.co.uk. [93.97.24.31]) + by mx.google.com with ESMTPS id dt9sm1917770wib.1.2012.10.27.04.26.46 + (version=TLSv1/SSLv3 cipher=OTHER); + Sat, 27 Oct 2012 04:26:48 -0700 (PDT) +From: Mark Walters +To: notmuch@notmuchmail.org +Subject: [PATCH 1/3] contrib: add notmuch-pick.el file itself +Date: Sat, 27 Oct 2012 12:26:38 +0100 +Message-Id: <1351337200-18050-2-git-send-email-markwalters1009@gmail.com> +X-Mailer: git-send-email 1.7.9.1 +In-Reply-To: <1351337200-18050-1-git-send-email-markwalters1009@gmail.com> +References: <1351337200-18050-1-git-send-email-markwalters1009@gmail.com> +MIME-Version: 1.0 +Content-Type: text/plain; charset=UTF-8 +Content-Transfer-Encoding: 8bit +X-BeenThere: notmuch@notmuchmail.org +X-Mailman-Version: 2.1.13 +Precedence: list +List-Id: "Use and development of the notmuch mail system." + +List-Unsubscribe: , + +List-Archive: +List-Post: +List-Help: +List-Subscribe: , + +X-List-Received-Date: Sat, 27 Oct 2012 11:27:01 -0000 + +This adds the main notmuch-pick.el file. +--- + contrib/notmuch-pick/notmuch-pick.el | 867 ++++++++++++++++++++++++++++++++++ + 1 files changed, 867 insertions(+), 0 deletions(-) + create mode 100644 contrib/notmuch-pick/notmuch-pick.el + +diff --git a/contrib/notmuch-pick/notmuch-pick.el b/contrib/notmuch-pick/notmuch-pick.el +new file mode 100644 +index 0000000..be6a91a +--- /dev/null ++++ b/contrib/notmuch-pick/notmuch-pick.el +@@ -0,0 +1,867 @@ ++;; notmuch-pick.el --- displaying notmuch forests. ++;; ++;; Copyright © Carl Worth ++;; Copyright © David Edmondson ++;; Copyright © Mark Walters ++;; ++;; This file is part of Notmuch. ++;; ++;; Notmuch is free software: you can redistribute it and/or modify it ++;; under the terms of the GNU General Public License as published by ++;; the Free Software Foundation, either version 3 of the License, or ++;; (at your option) any later version. ++;; ++;; Notmuch is distributed in the hope that it will be useful, but ++;; WITHOUT ANY WARRANTY; without even the implied warranty of ++;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ++;; General Public License for more details. ++;; ++;; You should have received a copy of the GNU General Public License ++;; along with Notmuch. If not, see . ++;; ++;; Authors: David Edmondson ++;; Mark Walters ++ ++(require 'mail-parse) ++ ++(require 'notmuch-lib) ++(require 'notmuch-query) ++(require 'notmuch-show) ++(require 'notmuch) ;; XXX ATM, as notmuch-search-mode-map is defined here ++ ++(eval-when-compile (require 'cl)) ++ ++(declare-function notmuch-call-notmuch-process "notmuch" (&rest args)) ++(declare-function notmuch-show "notmuch-show" (&rest args)) ++(declare-function notmuch-tag "notmuch" (query &rest tags)) ++(declare-function notmuch-show-strip-re "notmuch-show" (subject)) ++(declare-function notmuch-show-clean-address "notmuch-show" (parsed-address)) ++(declare-function notmuch-show-spaces-n "notmuch-show" (n)) ++(declare-function notmuch-read-query "notmuch" (prompt)) ++(declare-function notmuch-read-tag-changes "notmuch" (&optional initial-input &rest search-terms)) ++(declare-function notmuch-update-tags "notmuch" (current-tags tag-changes)) ++(declare-function notmuch-hello-trim "notmuch-hello" (search)) ++(declare-function notmuch-search-find-thread-id "notmuch" ()) ++(declare-function notmuch-search-find-subject "notmuch" ()) ++ ++;; the following variable is defined in notmuch.el ++(defvar notmuch-search-query-string) ++ ++(defgroup notmuch-pick nil ++ "Showing message and thread structure." ++ :group 'notmuch) ++ ++;; This is ugly. We can't run setup-show-out until it has been defined ++;; which needs the keymap to be defined. So we defer setting up to ++;; notmuch-pick-init. ++(defcustom notmuch-pick-show-out nil ++ "View selected messages in new window rather than split-pane." ++ :type 'boolean ++ :group 'notmuch-pick ++ :set (lambda (symbol value) ++ (set-default symbol value) ++ (when (fboundp 'notmuch-pick-setup-show-out) ++ (notmuch-pick-setup-show-out)))) ++ ++(defcustom notmuch-pick-result-format ++ `(("date" . "%12s ") ++ ("authors" . "%-20s") ++ ("subject" . " %-54s ") ++ ("tags" . "(%s)")) ++ "Result formatting for Pick. Supported fields are: date, ++ authors, subject, tags Note: subject includes the tree ++ structure graphics, and the author string should not ++ contain whitespace (put it in the neighbouring fields ++ instead). For example: ++ (setq notmuch-pick-result-format \(\(\"authors\" . \"%-40s\"\) ++ \(\"subject\" . \"%s\"\)\)\)" ++ :type '(alist :key-type (string) :value-type (string)) ++ :group 'notmuch-pick) ++ ++(defcustom notmuch-pick-asynchronous-parser t ++ "Use the asynchronous parser." ++ :type 'boolean ++ :group 'notmuch-pick) ++ ++;; Faces for messages that match the query. ++(defface notmuch-pick-match-date-face ++ '((t :inherit default)) ++ "Face used in pick mode for the date in messages matching the query." ++ :group 'notmuch-pick ++ :group 'notmuch-faces) ++ ++(defface notmuch-pick-match-author-face ++ '((((class color) ++ (background dark)) ++ (:foreground "OliveDrab1")) ++ (((class color) ++ (background light)) ++ (:foreground "dark blue")) ++ (t ++ (:bold t))) ++ "Face used in pick mode for the date in messages matching the query." ++ :group 'notmuch-pick ++ :group 'notmuch-faces) ++ ++(defface notmuch-pick-match-subject-face ++ '((t :inherit default)) ++ "Face used in pick mode for the subject in messages matching the query." ++ :group 'notmuch-pick ++ :group 'notmuch-faces) ++ ++(defface notmuch-pick-match-tag-face ++ '((((class color) ++ (background dark)) ++ (:foreground "OliveDrab1")) ++ (((class color) ++ (background light)) ++ (:foreground "navy blue" :bold t)) ++ (t ++ (:bold t))) ++ "Face used in pick mode for tags in messages matching the query." ++ :group 'notmuch-pick ++ :group 'notmuch-faces) ++ ++;; Faces for messages that do not match the query. ++(defface notmuch-pick-no-match-date-face ++ '((t (:foreground "gray"))) ++ "Face used in pick mode for non-matching dates." ++ :group 'notmuch-pick ++ :group 'notmuch-faces) ++ ++(defface notmuch-pick-no-match-subject-face ++ '((t (:foreground "gray"))) ++ "Face used in pick mode for non-matching subjects." ++ :group 'notmuch-pick ++ :group 'notmuch-faces) ++ ++(defface notmuch-pick-no-match-author-face ++ '((t (:foreground "gray"))) ++ "Face used in pick mode for the date in messages matching the query." ++ :group 'notmuch-pick ++ :group 'notmuch-faces) ++ ++(defface notmuch-pick-no-match-tag-face ++ '((t (:foreground "gray"))) ++ "Face used in pick mode face for non-matching tags." ++ :group 'notmuch-pick ++ :group 'notmuch-faces) ++ ++(defvar notmuch-pick-previous-subject "") ++(make-variable-buffer-local 'notmuch-pick-previous-subject) ++ ++;; The basic query i.e. the key part of the search request. ++(defvar notmuch-pick-basic-query nil) ++(make-variable-buffer-local 'notmuch-pick-basic-query) ++;; The context of the search: i.e., useful but can be dropped. ++(defvar notmuch-pick-query-context nil) ++(make-variable-buffer-local 'notmuch-pick-query-context) ++(defvar notmuch-pick-buffer-name nil) ++(make-variable-buffer-local 'notmuch-pick-buffer-name) ++(defvar notmuch-pick-message-window nil) ++(make-variable-buffer-local 'notmuch-pick-message-window) ++(put 'notmuch-pick-message-window 'permanent-local t) ++(defvar notmuch-pick-message-buffer nil) ++(make-variable-buffer-local 'notmuch-pick-message-buffer-name) ++(put 'notmuch-pick-message-buffer-name 'permanent-local t) ++(defvar notmuch-pick-process-state nil ++ "Parsing state of the search process filter.") ++ ++ ++(defvar notmuch-pick-mode-map ++ (let ((map (make-sparse-keymap))) ++ (define-key map [mouse-1] 'notmuch-pick-show-message) ++ (define-key map "q" 'notmuch-pick-quit) ++ (define-key map "x" 'notmuch-pick-quit) ++ (define-key map "?" 'notmuch-help) ++ (define-key map "a" 'notmuch-pick-archive-message) ++ (define-key map "=" 'notmuch-pick-refresh-view) ++ (define-key map "s" 'notmuch-search) ++ (define-key map "z" 'notmuch-pick) ++ (define-key map "m" 'notmuch-pick-new-mail) ++ (define-key map "f" 'notmuch-pick-forward-message) ++ (define-key map "r" 'notmuch-pick-reply-sender) ++ (define-key map "R" 'notmuch-pick-reply) ++ (define-key map "n" 'notmuch-pick-next-matching-message) ++ (define-key map "p" 'notmuch-pick-prev-matching-message) ++ (define-key map "N" 'notmuch-pick-next-message) ++ (define-key map "P" 'notmuch-pick-prev-message) ++ (define-key map "|" 'notmuch-pick-pipe-message) ++ (define-key map "-" 'notmuch-pick-remove-tag) ++ (define-key map "+" 'notmuch-pick-add-tag) ++ (define-key map " " 'notmuch-pick-scroll-or-next) ++ (define-key map "b" 'notmuch-pick-scroll-message-window-back) ++ map)) ++(fset 'notmuch-pick-mode-map notmuch-pick-mode-map) ++ ++(defun notmuch-pick-setup-show-out () ++ (let ((map notmuch-pick-mode-map)) ++ (if notmuch-pick-show-out ++ (progn ++ (define-key map (kbd "M-RET") 'notmuch-pick-show-message) ++ (define-key map (kbd "RET") 'notmuch-pick-show-message-out)) ++ (progn ++ (define-key map (kbd "RET") 'notmuch-pick-show-message) ++ (define-key map (kbd "M-RET") 'notmuch-pick-show-message-out))))) ++ ++(defun notmuch-pick-get-message-properties () ++ "Return the properties of the current message as a plist. ++ ++Some useful entries are: ++:headers - Property list containing the headers :Date, :Subject, :From, etc. ++:tags - Tags for this message" ++ (save-excursion ++ (beginning-of-line) ++ (get-text-property (point) :notmuch-message-properties))) ++ ++(defun notmuch-pick-set-message-properties (props) ++ (save-excursion ++ (beginning-of-line) ++ (put-text-property (point) (+ (point) 1) :notmuch-message-properties props))) ++ ++(defun notmuch-pick-set-prop (prop val &optional props) ++ (let ((inhibit-read-only t) ++ (props (or props ++ (notmuch-pick-get-message-properties)))) ++ (plist-put props prop val) ++ (notmuch-pick-set-message-properties props))) ++ ++(defun notmuch-pick-get-prop (prop &optional props) ++ (let ((props (or props ++ (notmuch-pick-get-message-properties)))) ++ (plist-get props prop))) ++ ++(defun notmuch-pick-set-tags (tags) ++ "Set the tags of the current message." ++ (notmuch-pick-set-prop :tags tags)) ++ ++(defun notmuch-pick-get-tags () ++ "Return the tags of the current message." ++ (notmuch-pick-get-prop :tags)) ++ ++(defun notmuch-pick-get-message-id () ++ "Return the message id of the current message." ++ (concat "id:\"" (notmuch-pick-get-prop :id) "\"")) ++ ++(defun notmuch-pick-get-match () ++ "Return whether the current message is a match." ++ (interactive) ++ (notmuch-pick-get-prop :match)) ++ ++(defun notmuch-pick-refresh-result () ++ (let ((init-point (point)) ++ (end (line-end-position)) ++ (msg (notmuch-pick-get-message-properties)) ++ (inhibit-read-only t)) ++ (beginning-of-line) ++ (delete-region (point) (1+ (line-end-position))) ++ (notmuch-pick-insert-msg msg) ++ (let ((new-end (line-end-position))) ++ (goto-char (if (= init-point end) ++ new-end ++ (min init-point (- new-end 1))))))) ++ ++(defun notmuch-pick-tag-update-display (&optional tag-changes) ++ "Update display for TAG-CHANGES to current message. ++ ++Does NOT change the database." ++ (let* ((current-tags (notmuch-pick-get-tags)) ++ (new-tags (notmuch-update-tags current-tags tag-changes))) ++ (unless (equal current-tags new-tags) ++ (notmuch-pick-set-tags new-tags) ++ (notmuch-pick-refresh-result)))) ++ ++(defun notmuch-pick-tag (&optional tag-changes) ++ "Change tags for the current message" ++ (interactive) ++ (setq tag-changes (funcall 'notmuch-tag (notmuch-pick-get-message-id) tag-changes)) ++ (notmuch-pick-tag-update-display tag-changes)) ++ ++(defun notmuch-pick-add-tag () ++ "Same as `notmuch-pick-tag' but sets initial input to '+'." ++ (interactive) ++ (notmuch-pick-tag "+")) ++ ++(defun notmuch-pick-remove-tag () ++ "Same as `notmuch-pick-tag' but sets initial input to '-'." ++ (interactive) ++ (notmuch-pick-tag "-")) ++ ++;; This function should be in notmuch-hello.el but we are trying to ++;; minimise impact on the rest of the codebase. ++(defun notmuch-pick-from-hello (&optional search) ++ "Run a query and display results in experimental notmuch-pick mode" ++ (interactive) ++ (unless (null search) ++ (setq search (notmuch-hello-trim search)) ++ (let ((history-delete-duplicates t)) ++ (add-to-history 'notmuch-search-history search))) ++ (notmuch-pick search)) ++ ++;; This function should be in notmuch-show.el but be we trying to ++;; minimise impact on the rest of the codebase. ++(defun notmuch-pick-from-show-current-query () ++ "Call notmuch pick with the current query" ++ (interactive) ++ (notmuch-pick notmuch-show-thread-id notmuch-show-query-context)) ++ ++;; This function should be in notmuch.el but be we trying to minimise ++;; impact on the rest of the codebase. ++(defun notmuch-pick-from-search-current-query () ++ "Call notmuch pick with the current query" ++ (interactive) ++ (notmuch-pick notmuch-search-query-string)) ++ ++;; This function should be in notmuch.el but be we trying to minimise ++;; impact on the rest of the codebase. ++(defun notmuch-pick-from-search-thread () ++ "Show the selected thread with notmuch-pick" ++ (interactive) ++ (notmuch-pick (notmuch-search-find-thread-id) ++ notmuch-search-query-string ++ (notmuch-prettify-subject (notmuch-search-find-subject))) ++ (notmuch-pick-show-match-message-with-wait)) ++ ++(defun notmuch-pick-show-message () ++ "Show the current message (in split-pane)." ++ (interactive) ++ (let ((id (notmuch-pick-get-message-id)) ++ (inhibit-read-only t) ++ buffer) ++ (when id ++ ;; We close and reopen the window to kill off un-needed buffers ++ ;; this might cause flickering but seems ok. ++ (notmuch-pick-close-message-window) ++ (setq notmuch-pick-message-window ++ (split-window-vertically (/ (window-height) 4))) ++ (with-selected-window notmuch-pick-message-window ++ (setq current-prefix-arg '(4)) ++ (setq buffer (notmuch-show id nil nil nil))) ++ (notmuch-pick-tag-update-display (list "-unread"))) ++ (setq notmuch-pick-message-buffer buffer))) ++ ++(defun notmuch-pick-show-message-out () ++ "Show the current message (in whole window)." ++ (interactive) ++ (let ((id (notmuch-pick-get-message-id)) ++ (inhibit-read-only t) ++ buffer) ++ (when id ++ ;; We close the window to kill off un-needed buffers. ++ (notmuch-pick-close-message-window) ++ (notmuch-show id nil nil nil)))) ++ ++(defun notmuch-pick-scroll-message-window () ++ "Scroll the message window (if it exists)" ++ (interactive) ++ (when (window-live-p notmuch-pick-message-window) ++ (with-selected-window notmuch-pick-message-window ++ (if (pos-visible-in-window-p (point-max)) ++ t ++ (scroll-up))))) ++ ++(defun notmuch-pick-scroll-message-window-back () ++ "Scroll the message window back(if it exists)" ++ (interactive) ++ (when (window-live-p notmuch-pick-message-window) ++ (with-selected-window notmuch-pick-message-window ++ (if (pos-visible-in-window-p (point-min)) ++ t ++ (scroll-down))))) ++ ++(defun notmuch-pick-scroll-or-next () ++ "Scroll the message window. If it at end go to next message." ++ (interactive) ++ (when (notmuch-pick-scroll-message-window) ++ (notmuch-pick-next-matching-message))) ++ ++(defun notmuch-pick-quit () ++ "Close the split view or exit pick." ++ (interactive) ++ (unless (notmuch-pick-close-message-window) ++ (kill-buffer (current-buffer)))) ++ ++(defun notmuch-pick-close-message-window () ++ "Close the message-window. Return t if close succeeds." ++ (interactive) ++ (when (and (window-live-p notmuch-pick-message-window) ++ (eq (window-buffer notmuch-pick-message-window) notmuch-pick-message-buffer)) ++ (delete-window notmuch-pick-message-window) ++ (unless (get-buffer-window-list notmuch-pick-message-buffer) ++ (kill-buffer notmuch-pick-message-buffer)) ++ t)) ++ ++(defun notmuch-pick-archive-message () ++ "Archive the current message and move to next matching message." ++ (interactive) ++ (notmuch-pick-tag "-inbox") ++ (notmuch-pick-next-matching-message)) ++ ++(defun notmuch-pick-next-message () ++ "Move to next message." ++ (interactive) ++ (forward-line) ++ (when (window-live-p notmuch-pick-message-window) ++ (notmuch-pick-show-message))) ++ ++(defun notmuch-pick-prev-message () ++ "Move to previous message." ++ (interactive) ++ (forward-line -1) ++ (when (window-live-p notmuch-pick-message-window) ++ (notmuch-pick-show-message))) ++ ++(defun notmuch-pick-prev-matching-message () ++ "Move to previous matching message." ++ (interactive) ++ (forward-line -1) ++ (while (and (not (bobp)) (not (notmuch-pick-get-match))) ++ (forward-line -1)) ++ (when (window-live-p notmuch-pick-message-window) ++ (notmuch-pick-show-message))) ++ ++(defun notmuch-pick-next-matching-message () ++ "Move to next matching message." ++ (interactive) ++ (forward-line) ++ (while (and (not (eobp)) (not (notmuch-pick-get-match))) ++ (forward-line)) ++ (when (window-live-p notmuch-pick-message-window) ++ (notmuch-pick-show-message))) ++ ++(defun notmuch-pick-show-match-message-with-wait () ++ "Show the first matching message but wait for it to appear or search to finish." ++ (interactive) ++ (unless (notmuch-pick-get-match) ++ (notmuch-pick-next-matching-message)) ++ (while (and (not (notmuch-pick-get-match)) ++ (not (eq notmuch-pick-process-state 'end))) ++ (message "waiting for message") ++ (sit-for 0.1) ++ (goto-char (point-min)) ++ (unless (notmuch-pick-get-match) ++ (notmuch-pick-next-matching-message))) ++ (message nil) ++ (when (notmuch-pick-get-match) ++ (notmuch-pick-show-message))) ++ ++(defun notmuch-pick-refresh-view () ++ "Refresh view." ++ (interactive) ++ (let ((inhibit-read-only t) ++ (basic-query notmuch-pick-basic-query) ++ (query-context notmuch-pick-query-context) ++ (buffer-name notmuch-pick-buffer-name)) ++ (erase-buffer) ++ (notmuch-pick-worker basic-query query-context (get-buffer buffer-name)))) ++ ++(defmacro with-current-notmuch-pick-message (&rest body) ++ "Evaluate body with current buffer set to the text of current message" ++ `(save-excursion ++ (let ((id (notmuch-pick-get-message-id))) ++ (let ((buf (generate-new-buffer (concat "*notmuch-msg-" id "*")))) ++ (with-current-buffer buf ++ (call-process notmuch-command nil t nil "show" "--format=raw" id) ++ ,@body) ++ (kill-buffer buf))))) ++ ++(defun notmuch-pick-new-mail (&optional prompt-for-sender) ++ "Compose new mail." ++ (interactive "P") ++ (notmuch-pick-close-message-window) ++ (notmuch-mua-new-mail prompt-for-sender )) ++ ++(defun notmuch-pick-forward-message (&optional prompt-for-sender) ++ "Forward the current message." ++ (interactive "P") ++ (notmuch-pick-close-message-window) ++ (with-current-notmuch-pick-message ++ (notmuch-mua-new-forward-message prompt-for-sender))) ++ ++(defun notmuch-pick-reply (&optional prompt-for-sender) ++ "Reply to the sender and all recipients of the current message." ++ (interactive "P") ++ (notmuch-pick-close-message-window) ++ (notmuch-mua-new-reply (notmuch-pick-get-message-id) prompt-for-sender t)) ++ ++(defun notmuch-pick-reply-sender (&optional prompt-for-sender) ++ "Reply to the sender of the current message." ++ (interactive "P") ++ (notmuch-pick-close-message-window) ++ (notmuch-mua-new-reply (notmuch-pick-get-message-id) prompt-for-sender nil)) ++ ++;; Shamelessly stolen from notmuch-show.el: maybe should be unified. ++(defun notmuch-pick-pipe-message (command) ++ "Pipe the contents of the current message to the given command. ++ ++The given command will be executed with the raw contents of the ++current email message as stdin. Anything printed by the command ++to stdout or stderr will appear in the *notmuch-pipe* buffer. ++ ++When invoked with a prefix argument, the command will receive all ++open messages in the current thread (formatted as an mbox) rather ++than only the current message." ++ (interactive "sPipe message to command: ") ++ (let ((shell-command ++ (concat notmuch-command " show --format=raw " ++ (shell-quote-argument (notmuch-pick-get-message-id)) " | " command)) ++ (buf (get-buffer-create (concat "*notmuch-pipe*")))) ++ (with-current-buffer buf ++ (setq buffer-read-only nil) ++ (erase-buffer) ++ (let ((exit-code (call-process-shell-command shell-command nil buf))) ++ (goto-char (point-max)) ++ (set-buffer-modified-p nil) ++ (setq buffer-read-only t) ++ (unless (zerop exit-code) ++ (switch-to-buffer-other-window buf) ++ (message (format "Command '%s' exited abnormally with code %d" ++ shell-command exit-code))))))) ++ ++;; Shamelessly stolen from notmuch-show.el: should be unified. ++(defun notmuch-pick-clean-address (address) ++ "Try to clean a single email ADDRESS for display. Return ++unchanged ADDRESS if parsing fails." ++ (condition-case nil ++ (let (p-name p-address) ++ ;; It would be convenient to use `mail-header-parse-address', ++ ;; but that expects un-decoded mailbox parts, whereas our ++ ;; mailbox parts are already decoded (and hence may contain ++ ;; UTF-8). Given that notmuch should handle most of the awkward ++ ;; cases, some simple string deconstruction should be sufficient ++ ;; here. ++ (cond ++ ;; "User " style. ++ ((string-match "\\(.*\\) <\\(.*\\)>" address) ++ (setq p-name (match-string 1 address) ++ p-address (match-string 2 address))) ++ ++ ;; "" style. ++ ((string-match "<\\(.*\\)>" address) ++ (setq p-address (match-string 1 address))) ++ ++ ;; Everything else. ++ (t ++ (setq p-address address))) ++ ++ (when p-name ++ ;; Remove elements of the mailbox part that are not relevant for ++ ;; display, even if they are required during transport: ++ ;; ++ ;; Backslashes. ++ (setq p-name (replace-regexp-in-string "\\\\" "" p-name)) ++ ++ ;; Outer single and double quotes, which might be nested. ++ (loop ++ with start-of-loop ++ do (setq start-of-loop p-name) ++ ++ when (string-match "^\"\\(.*\\)\"$" p-name) ++ do (setq p-name (match-string 1 p-name)) ++ ++ when (string-match "^'\\(.*\\)'$" p-name) ++ do (setq p-name (match-string 1 p-name)) ++ ++ until (string= start-of-loop p-name))) ++ ++ ;; If the address is 'foo@bar.com ' then show just ++ ;; 'foo@bar.com'. ++ (when (string= p-name p-address) ++ (setq p-name nil)) ++ ++ ;; If we have a name return that otherwise return the address. ++ (if (not p-name) ++ p-address ++ p-name)) ++ (error address))) ++ ++(defun notmuch-pick-insert-field (field format-string msg) ++ (let* ((headers (plist-get msg :headers)) ++ (match (plist-get msg :match))) ++ (cond ++ ((string-equal field "date") ++ (let ((face (if match ++ 'notmuch-pick-match-date-face ++ 'notmuch-pick-no-match-date-face))) ++ (insert (propertize (format format-string (plist-get msg :date_relative)) ++ 'face face)))) ++ ++ ((string-equal field "subject") ++ (let ((tree-status (plist-get msg :tree-status)) ++ (bare-subject (notmuch-show-strip-re (plist-get headers :Subject))) ++ (face (if match ++ 'notmuch-pick-match-subject-face ++ 'notmuch-pick-no-match-subject-face))) ++ (insert (propertize (format format-string ++ (concat ++ (mapconcat #'identity (reverse tree-status) "") ++ (if (string= notmuch-pick-previous-subject bare-subject) ++ " ..." ++ bare-subject))) ++ 'face face)) ++ (setq notmuch-pick-previous-subject bare-subject))) ++ ++ ((string-equal field "authors") ++ (let ((author (notmuch-pick-clean-address (plist-get headers :From))) ++ (len (length (format format-string ""))) ++ (face (if match ++ 'notmuch-pick-match-author-face ++ 'notmuch-pick-no-match-author-face))) ++ (when (> (length author) len) ++ (setq author (substring author 0 len))) ++ (insert (propertize (format format-string author) ++ 'face face)))) ++ ++ ((string-equal field "tags") ++ (let ((tags (plist-get msg :tags)) ++ (face (if match ++ 'notmuch-pick-match-tag-face ++ 'notmuch-pick-no-match-tag-face))) ++ (when tags ++ (insert (propertize (format format-string ++ (mapconcat #'identity tags ", ")) ++ 'face face)))))))) ++ ++(defun notmuch-pick-insert-msg (msg) ++ "Insert the message MSG according to notmuch-pick-result-format" ++ (dolist (spec notmuch-pick-result-format) ++ (notmuch-pick-insert-field (car spec) (cdr spec) msg)) ++ (notmuch-pick-set-message-properties msg) ++ (insert "\n")) ++ ++(defun notmuch-pick-insert-tree (tree depth tree-status first last) ++ "Insert the message tree TREE at depth DEPTH in the current thread." ++ (let ((msg (car tree)) ++ (replies (cadr tree))) ++ ++ (cond ++ ((and (< 0 depth) (not last)) ++ (push "├" tree-status)) ++ ((and (< 0 depth) last) ++ (push "╰" tree-status)) ++ ((and (eq 0 depth) first last) ++;; (push "─" tree-status)) choice between this and next line is matter of taste. ++ (push " " tree-status)) ++ ((and (eq 0 depth) first (not last)) ++ (push "┬" tree-status)) ++ ((and (eq 0 depth) (not first) last) ++ (push "╰" tree-status)) ++ ((and (eq 0 depth) (not first) (not last)) ++ (push "├" tree-status))) ++ ++ (push (concat (if replies "┬" "─") "►") tree-status) ++ (notmuch-pick-insert-msg (plist-put msg :tree-status tree-status)) ++ (pop tree-status) ++ (pop tree-status) ++ ++ (if last ++ (push " " tree-status) ++ (push "│" tree-status)) ++ ++ (notmuch-pick-insert-thread replies (1+ depth) tree-status))) ++ ++(defun notmuch-pick-insert-thread (thread depth tree-status) ++ "Insert the thread THREAD at depth DEPTH >= 1 in the current forest." ++ (let ((n (length thread))) ++ (loop for tree in thread ++ for count from 1 to n ++ ++ do (notmuch-pick-insert-tree tree depth tree-status (eq count 1) (eq count n))))) ++ ++(defun notmuch-pick-insert-forest-thread (forest-thread) ++ (save-excursion ++ (goto-char (point-max)) ++ (let (tree-status) ++ ;; Reset at the start of each main thread. ++ (setq notmuch-pick-previous-subject nil) ++ (notmuch-pick-insert-thread forest-thread 0 tree-status)))) ++ ++(defun notmuch-pick-insert-forest (forest) ++ (mapc 'notmuch-pick-insert-forest-thread forest)) ++ ++(defun notmuch-pick-mode () ++ "Major mode displaying messages (as opposed to threads) of of a notmuch search. ++ ++This buffer contains the results of a \"notmuch pick\" of your ++email archives. Each line in the buffer represents a single ++message giving the relative date, the author, subject, and any ++tags. ++ ++Pressing \\[notmuch-pick-show-message] on any line displays that message. ++ ++Complete list of currently available key bindings: ++ ++\\{notmuch-pick-mode-map}" ++ ++ (interactive) ++ (kill-all-local-variables) ++ (use-local-map notmuch-pick-mode-map) ++ (setq major-mode 'notmuch-pick-mode ++ mode-name "notmuch-pick") ++ (hl-line-mode 1) ++ (setq buffer-read-only t ++ truncate-lines t)) ++ ++(defun notmuch-pick-process-sentinel (proc msg) ++ "Add a message to let user know when \"notmuch pick\" exits" ++ (let ((buffer (process-buffer proc)) ++ (status (process-status proc)) ++ (exit-status (process-exit-status proc)) ++ (never-found-target-thread nil)) ++ (when (memq status '(exit signal)) ++ (kill-buffer (process-get proc 'parse-buf)) ++ (if (buffer-live-p buffer) ++ (with-current-buffer buffer ++ (save-excursion ++ (let ((inhibit-read-only t) ++ (atbob (bobp))) ++ (goto-char (point-max)) ++ (if (eq status 'signal) ++ (insert "Incomplete search results (pick process was killed).\n")) ++ (when (eq status 'exit) ++ (insert "End of search results.") ++ (unless (= exit-status 0) ++ (insert (format " (process returned %d)" exit-status))) ++ (insert "\n"))))))))) ++ ++ ++(defun notmuch-pick-show-error (string &rest objects) ++ (save-excursion ++ (goto-char (point-max)) ++ (insert "Error: Unexpected output from notmuch search:\n") ++ (insert (apply #'format string objects)) ++ (insert "\n"))) ++ ++ ++(defvar notmuch-pick-json-parser nil ++ "Incremental JSON parser for the search process filter.") ++ ++(defun notmuch-pick-process-filter (proc string) ++ "Process and filter the output of \"notmuch show\" (for pick)" ++ (let ((results-buf (process-buffer proc)) ++ (parse-buf (process-get proc 'parse-buf)) ++ (inhibit-read-only t) ++ done) ++ (if (not (buffer-live-p results-buf)) ++ (delete-process proc) ++ (with-current-buffer parse-buf ++ ;; Insert new data ++ (save-excursion ++ (goto-char (point-max)) ++ (insert string))) ++ (with-current-buffer results-buf ++ (save-excursion ++ (goto-char (point-max)) ++ (while (not done) ++ (condition-case nil ++ (case notmuch-pick-process-state ++ ((begin) ++ ;; Enter the results list ++ (if (eq (notmuch-json-begin-compound ++ notmuch-pick-json-parser) 'retry) ++ (setq done t) ++ (setq notmuch-pick-process-state 'result))) ++ ((result) ++ ;; Parse a result ++ (let ((result (notmuch-json-read notmuch-pick-json-parser))) ++ (case result ++ ((retry) (setq done t)) ++ ((end) (setq notmuch-pick-process-state 'end)) ++ (otherwise (notmuch-pick-insert-forest-thread result))))) ++ ((end) ++ ;; Any trailing data is unexpected ++ (with-current-buffer parse-buf ++ (skip-chars-forward " \t\r\n") ++ (if (eobp) ++ (setq done t) ++ (signal 'json-error nil))))) ++ (json-error ++ ;; Do our best to resynchronize and ensure forward ++ ;; progress ++ (notmuch-pick-show-error ++ "%s" ++ (with-current-buffer parse-buf ++ (let ((bad (buffer-substring (line-beginning-position) ++ (line-end-position)))) ++ (forward-line) ++ bad)))))) ++ ;; Clear out what we've parsed ++ (with-current-buffer parse-buf ++ (delete-region (point-min) (point)))))))) ++ ++(defun notmuch-pick-worker (basic-query &optional query-context buffer) ++ (interactive) ++ (notmuch-pick-mode) ++ (setq notmuch-pick-basic-query basic-query) ++ (setq notmuch-pick-query-context query-context) ++ (setq notmuch-pick-buffer-name (buffer-name buffer)) ++ ++ (erase-buffer) ++ (goto-char (point-min)) ++ (let* ((search-args (concat basic-query ++ (if query-context (concat " and (" query-context ")")) ++ )) ++ (message-arg "--entire-thread")) ++ (if (equal (car (process-lines notmuch-command "count" search-args)) "0") ++ (setq search-args basic-query)) ++ (message "starting parser %s" ++ (format-time-string "%r")) ++ (if notmuch-pick-asynchronous-parser ++ (let ((proc (start-process ++ "notmuch-pick" buffer ++ notmuch-command "show" "--body=false" "--format=json" ++ message-arg search-args)) ++ ;; Use a scratch buffer to accumulate partial output. ++ ;; This buffer will be killed by the sentinel, which ++ ;; should be called no matter how the process dies. ++ (parse-buf (generate-new-buffer " *notmuch pick parse*"))) ++ (set (make-local-variable 'notmuch-pick-process-state) 'begin) ++ (set (make-local-variable 'notmuch-pick-json-parser) ++ (notmuch-json-create-parser parse-buf)) ++ (process-put proc 'parse-buf parse-buf) ++ (set-process-sentinel proc 'notmuch-pick-process-sentinel) ++ (set-process-filter proc 'notmuch-pick-process-filter) ++ (set-process-query-on-exit-flag proc nil)) ++ (progn ++ (notmuch-pick-insert-forest ++ (notmuch-query-get-threads ++ (list "--body=false" message-arg search-args))) ++ (save-excursion ++ (goto-char (point-max)) ++ (insert "End of search results.\n")) ++ (message "sync parser finished %s" ++ (format-time-string "%r")))))) ++ ++ ++(defun notmuch-pick (&optional query query-context buffer-name show-first-match) ++ "Run notmuch pick with the given `query' and display the results" ++ (interactive "sNotmuch pick: ") ++ (if (null query) ++ (setq query (notmuch-read-query "Notmuch pick: "))) ++ (let ((buffer (get-buffer-create (generate-new-buffer-name ++ (or buffer-name ++ (concat "*notmuch-pick-" query "*"))))) ++ (inhibit-read-only t)) ++ ++ (switch-to-buffer buffer) ++ ;; Don't track undo information for this buffer ++ (set 'buffer-undo-list t) ++ ++ (notmuch-pick-worker query query-context buffer) ++ ++ (setq truncate-lines t) ++ (when show-first-match ++ (notmuch-pick-show-match-message-with-wait)))) ++ ++ ++;; Set up key bindings from the rest of notmuch. ++(define-key 'notmuch-search-mode-map "z" 'notmuch-pick) ++(define-key 'notmuch-search-mode-map "Z" 'notmuch-pick-from-search-current-query) ++(define-key 'notmuch-search-mode-map (kbd "M-RET") 'notmuch-pick-from-search-thread) ++(define-key 'notmuch-hello-mode-map "z" 'notmuch-pick-from-hello) ++(define-key 'notmuch-show-mode-map "z" 'notmuch-pick) ++(define-key 'notmuch-show-mode-map "Z" 'notmuch-pick-from-show-current-query) ++(notmuch-pick-setup-show-out) ++(message "Initialised notmuch-pick") ++ ++(provide 'notmuch-pick) +-- +1.7.9.1 +