* [RFC PATCH 1/3] cli: notmuch-show changes to support pick
2012-02-12 10:32 RFC notmuch-pick: an emacs threaded message view with split-pane Mark Walters
@ 2012-02-12 10:36 ` Mark Walters
2012-02-12 10:36 ` [RFC PATCH 2/3] emacs: changes to other files to support notmuch-pick Mark Walters
` (4 subsequent siblings)
5 siblings, 0 replies; 11+ messages in thread
From: Mark Walters @ 2012-02-12 10:36 UTC (permalink / raw)
To: notmuch
---
notmuch-client.h | 9 +++++-
notmuch-show.c | 90 ++++++++++++++++++++++++++++++++++++++++++++++++------
2 files changed, 88 insertions(+), 11 deletions(-)
diff --git a/notmuch-client.h b/notmuch-client.h
index 60828aa..b4dc7bf 100644
--- a/notmuch-client.h
+++ b/notmuch-client.h
@@ -97,10 +97,17 @@ typedef struct notmuch_show_format {
const char *message_set_end;
} notmuch_show_format_t;
+enum {
+ NOTMUCH_SHOW_THREAD_MATCH,
+ NOTMUCH_SHOW_THREAD_ENTIRE,
+ NOTMUCH_SHOW_THREAD_NONE
+};
+
typedef struct notmuch_show_params {
- notmuch_bool_t entire_thread;
+ int entire_thread;
notmuch_bool_t raw;
int part;
+ int headers_only;
#ifdef GMIME_ATLEAST_26
GMimeCryptoContext* cryptoctx;
#else
diff --git a/notmuch-show.c b/notmuch-show.c
index c8fbd79..725d47d 100644
--- a/notmuch-show.c
+++ b/notmuch-show.c
@@ -876,7 +876,7 @@ show_message (void *ctx,
fputs (format->body_start, stdout);
}
- if (format->part_content)
+ if (format->part_content && !params->headers_only)
show_message_body (message, format, params);
if (params->part <= 0) {
@@ -923,11 +923,16 @@ show_messages (void *ctx,
fputs (format->message_set_sep, stdout);
}
- show_messages (ctx,
- format,
- notmuch_message_get_replies (message),
- next_indent,
- params);
+ if (params->entire_thread != NOTMUCH_SHOW_THREAD_NONE)
+ show_messages (ctx,
+ format,
+ notmuch_message_get_replies (message),
+ next_indent,
+ params);
+ else {
+ fputs (format->message_set_start, stdout);
+ fputs (format->message_set_end, stdout);
+ }
notmuch_message_destroy (message);
@@ -937,6 +942,50 @@ show_messages (void *ctx,
fputs (format->message_set_end, stdout);
}
+static int
+do_show_messages (void *ctx,
+ notmuch_query_t *query,
+ const notmuch_show_format_t *format,
+ notmuch_show_params_t *params)
+{
+ notmuch_messages_t *messages;
+ notmuch_message_t *message;
+ int first_set = 1;
+
+ fputs (format->message_set_start, stdout);
+ messages = notmuch_query_search_messages (query);
+
+ for (;
+ notmuch_messages_valid (messages);
+ notmuch_messages_move_to_next (messages))
+ {
+ if (!first_set)
+ fputs (format->message_set_sep, stdout);
+ first_set = 0;
+
+ fputs (format->message_set_start, stdout);
+ fputs (format->message_set_start, stdout);
+
+ message = notmuch_messages_get (messages);
+ notmuch_message_set_flag (message, NOTMUCH_MESSAGE_FLAG_MATCH, 1);
+ show_message (ctx, format, message, 0, params);
+
+ fputs (format->message_set_sep, stdout);
+
+ fputs (format->message_set_start, stdout);
+ fputs (format->message_set_end, stdout);
+
+
+ notmuch_message_destroy (message);
+
+ fputs (format->message_set_end, stdout);
+ fputs (format->message_set_end, stdout);
+ }
+
+ fputs (format->message_set_end, stdout);
+ return 0;
+}
+
/* Formatted output of single message */
static int
do_show_single (void *ctx,
@@ -1064,11 +1113,13 @@ notmuch_show_command (void *ctx, unused (int argc), unused (char *argv[]))
notmuch_database_t *notmuch;
notmuch_query_t *query;
char *query_string;
- int opt_index, ret;
+ int opt_index, ret, entire_thread;
+ notmuch_sort_t sort = NOTMUCH_SORT_NEWEST_FIRST;
const notmuch_show_format_t *format = &format_text;
notmuch_show_params_t params = { .part = -1 };
int format_sel = NOTMUCH_FORMAT_NOT_SPECIFIED;
notmuch_bool_t verify = FALSE;
+ notmuch_bool_t headers_only = FALSE;
notmuch_opt_desc_t options[] = {
{ NOTMUCH_OPT_KEYWORD, &format_sel, "format", 'f',
@@ -1077,10 +1128,19 @@ notmuch_show_command (void *ctx, unused (int argc), unused (char *argv[]))
{ "mbox", NOTMUCH_FORMAT_MBOX },
{ "raw", NOTMUCH_FORMAT_RAW },
{ 0, 0 } } },
+ { NOTMUCH_OPT_KEYWORD, &sort, "sort", 's',
+ (notmuch_keyword_t []){ { "oldest-first", NOTMUCH_SORT_OLDEST_FIRST },
+ { "newest-first", NOTMUCH_SORT_NEWEST_FIRST },
+ { 0, 0 } } },
{ NOTMUCH_OPT_INT, ¶ms.part, "part", 'p', 0 },
- { NOTMUCH_OPT_BOOLEAN, ¶ms.entire_thread, "entire-thread", 't', 0 },
+ { NOTMUCH_OPT_KEYWORD, &entire_thread, "thread", 't',
+ (notmuch_keyword_t []){ { "match", NOTMUCH_SHOW_THREAD_MATCH, },
+ { "entire", NOTMUCH_SHOW_THREAD_ENTIRE },
+ { "none", NOTMUCH_SHOW_THREAD_NONE },
+ { 0, 0 } } },
{ NOTMUCH_OPT_BOOLEAN, ¶ms.decrypt, "decrypt", 'd', 0 },
{ NOTMUCH_OPT_BOOLEAN, &verify, "verify", 'v', 0 },
+ { NOTMUCH_OPT_BOOLEAN, &headers_only, "headers-only", 'h', 0 },
{ 0, 0, 0, 0, 0 }
};
@@ -1090,6 +1150,9 @@ notmuch_show_command (void *ctx, unused (int argc), unused (char *argv[]))
return 1;
}
+ params.entire_thread = entire_thread;
+ params.headers_only = headers_only;
+
if (format_sel == NOTMUCH_FORMAT_NOT_SPECIFIED) {
/* if part was requested and format was not specified, use format=raw */
if (params.part >= 0)
@@ -1101,7 +1164,9 @@ notmuch_show_command (void *ctx, unused (int argc), unused (char *argv[]))
switch (format_sel) {
case NOTMUCH_FORMAT_JSON:
format = &format_json;
- params.entire_thread = TRUE;
+ if (!params.entire_thread) params.entire_thread = NOTMUCH_SHOW_THREAD_ENTIRE;
+ // params.entire_thread = 1;
+
break;
case NOTMUCH_FORMAT_TEXT:
format = &format_text;
@@ -1168,10 +1233,15 @@ notmuch_show_command (void *ctx, unused (int argc), unused (char *argv[]))
return 1;
}
+ notmuch_query_set_sort (query, sort);
+
if (params.part >= 0)
ret = do_show_single (ctx, query, format, ¶ms);
else
- ret = do_show (ctx, query, format, ¶ms);
+ if (params.entire_thread == NOTMUCH_SHOW_THREAD_NONE)
+ ret = do_show_messages (ctx, query, format, ¶ms);
+ else
+ ret = do_show (ctx, query, format, ¶ms);
notmuch_query_destroy (query);
notmuch_database_close (notmuch);
--
1.7.2.3
^ permalink raw reply related [flat|nested] 11+ messages in thread* [RFC PATCH 2/3] emacs: changes to other files to support notmuch-pick
2012-02-12 10:32 RFC notmuch-pick: an emacs threaded message view with split-pane Mark Walters
2012-02-12 10:36 ` [RFC PATCH 1/3] cli: notmuch-show changes to support pick Mark Walters
@ 2012-02-12 10:36 ` Mark Walters
2012-02-12 10:36 ` [RFC PATCH 3/3] emacs: add notmuch-pick itself Mark Walters
` (3 subsequent siblings)
5 siblings, 0 replies; 11+ messages in thread
From: Mark Walters @ 2012-02-12 10:36 UTC (permalink / raw)
To: notmuch
---
emacs/Makefile.local | 3 ++-
emacs/notmuch-hello.el | 10 ++++++++++
emacs/notmuch-query.el | 4 +++-
emacs/notmuch-show.el | 19 +++++++++++++++----
emacs/notmuch.el | 8 ++++++++
5 files changed, 38 insertions(+), 6 deletions(-)
diff --git a/emacs/Makefile.local b/emacs/Makefile.local
index 4fee0e8..2922d9e 100644
--- a/emacs/Makefile.local
+++ b/emacs/Makefile.local
@@ -14,7 +14,8 @@ emacs_sources := \
$(dir)/notmuch-message.el \
$(dir)/notmuch-crypto.el \
$(dir)/coolj.el \
- $(dir)/notmuch-print.el
+ $(dir)/notmuch-print.el \
+ $(dir)/notmuch-pick.el
emacs_images := \
$(srcdir)/$(dir)/notmuch-logo.png
diff --git a/emacs/notmuch-hello.el b/emacs/notmuch-hello.el
index d17a30f..6d28a7e 100644
--- a/emacs/notmuch-hello.el
+++ b/emacs/notmuch-hello.el
@@ -27,6 +27,7 @@
(require 'notmuch-mua)
(declare-function notmuch-search "notmuch" (query &optional oldest-first target-thread target-line continuation))
+(declare-function notmuch-pick "notmuch-pick" (query &optional query-context buffer-name))
(declare-function notmuch-poll "notmuch" ())
(defcustom notmuch-hello-recent-searches-max 10
@@ -181,6 +182,14 @@ International Bureau of Weights and Measures."
(notmuch-search search notmuch-search-oldest-first nil nil
#'notmuch-hello-search-continuation))
+(defun notmuch-hello-pick (&optional search)
+ (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))
+
(defun notmuch-hello-add-saved-search (widget)
(interactive)
(let ((search (widget-value
@@ -345,6 +354,7 @@ should be. Returns a cons cell `(tags-per-line width)'."
(define-key map (kbd "<C-tab>") 'widget-backward)
(define-key map "m" 'notmuch-mua-new-mail)
(define-key map "s" 'notmuch-hello-search)
+ (define-key map "z" 'notmuch-hello-pick)
map)
"Keymap for \"notmuch hello\" buffers.")
(fset 'notmuch-hello-mode-map notmuch-hello-mode-map)
diff --git a/emacs/notmuch-query.el b/emacs/notmuch-query.el
index d66baea..b3c91a3 100644
--- a/emacs/notmuch-query.el
+++ b/emacs/notmuch-query.el
@@ -22,7 +22,7 @@
(require 'notmuch-lib)
(require 'json)
-(defun notmuch-query-get-threads (search-terms)
+(defun notmuch-query-get-threads (search-terms &rest extra-format)
"Return a list of threads of messages matching SEARCH-TERMS.
A thread is a forest or list of trees. A tree is a two element
@@ -33,6 +33,8 @@ is a possibly empty forest of replies.
(json-object-type 'plist)
(json-array-type 'list)
(json-false 'nil))
+ (if extra-format
+ (setq args (append args extra-format)))
(if notmuch-show-process-crypto
(setq args (append args '("--decrypt"))))
(setq args (append args search-terms))
diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el
index 24fde05..825f7fe 100644
--- a/emacs/notmuch-show.el
+++ b/emacs/notmuch-show.el
@@ -42,6 +42,7 @@
(declare-function notmuch-search-next-thread "notmuch" nil)
(declare-function notmuch-search-show-thread "notmuch" nil)
(declare-function notmuch-update-tags "notmuch" (current-tags tag-changes))
+(declare-function notmuch-pick "notmuch-pick" (query &optional query-context buffer-name))
(defcustom notmuch-message-headers '("Subject" "To" "Cc" "Date")
"Headers that should be shown in a message, in this order.
@@ -962,7 +963,7 @@ a corresponding notmuch search."
'face goto-address-mail-face))))
;;;###autoload
-(defun notmuch-show (thread-id &optional parent-buffer query-context buffer-name crypto-switch)
+(defun notmuch-show (thread-id &optional parent-buffer query-context buffer-name crypto-switch just-matches)
"Run \"notmuch show\" with the given thread ID and display results.
The optional PARENT-BUFFER is the notmuch-search buffer from
@@ -986,9 +987,9 @@ buffer."
(let* ((process-crypto (if crypto-switch
(not notmuch-crypto-process-mime)
notmuch-crypto-process-mime)))
- (notmuch-show-worker thread-id parent-buffer query-context buffer-name process-crypto)))
+ (notmuch-show-worker thread-id parent-buffer query-context buffer-name process-crypto just-matches)))
-(defun notmuch-show-worker (thread-id parent-buffer query-context buffer-name process-crypto)
+(defun notmuch-show-worker (thread-id parent-buffer query-context buffer-name process-crypto &optional just-matches)
(let* ((buffer-name (generate-new-buffer-name
(or buffer-name
(concat "*notmuch-" thread-id "*"))))
@@ -1012,6 +1013,8 @@ buffer."
(args (if query-context
(append (list "\'") basic-args (list "and (" query-context ")\'"))
(append (list "\'") basic-args (list "\'")))))
+ (if just-matches
+ (setq args (append (list "--thread=none") args)))
(notmuch-show-insert-forest (notmuch-query-get-threads args))
;; If the query context reduced the results to nothing, run
;; the basic query.
@@ -1031,7 +1034,8 @@ buffer."
;; Set the header line to the subject of the first open message.
(setq header-line-format (notmuch-show-strip-re (notmuch-show-get-pretty-subject)))
- (notmuch-show-mark-read)))
+ (notmuch-show-mark-read)
+ buffer))
(defun notmuch-show-refresh-view (&optional crypto-switch)
"Refresh the current view (with crypto switch if prefix given).
@@ -1073,6 +1077,8 @@ thread id. If a prefix is given, crypto processing is toggled."
(define-key map (kbd "<backtab>") 'notmuch-show-previous-button)
(define-key map (kbd "TAB") 'notmuch-show-next-button)
(define-key map "s" 'notmuch-search)
+ (define-key map "z" 'notmuch-pick)
+ (define-key map "Z" 'notmuch-show-pick-current-query)
(define-key map "m" 'notmuch-mua-new-mail)
(define-key map "f" 'notmuch-show-forward-message)
(define-key map "r" 'notmuch-show-reply-sender)
@@ -1476,6 +1482,11 @@ to show, nil otherwise."
(notmuch-show-mark-read)
(notmuch-show-message-adjust))
+(defun notmuch-show-pick-current-query ()
+ "Call notmuch pick with the current query"
+ (interactive)
+ (notmuch-pick notmuch-show-thread-id notmuch-show-query-context))
+
(defun notmuch-show-view-raw-message ()
"View the file holding the current message."
(interactive)
diff --git a/emacs/notmuch.el b/emacs/notmuch.el
index 8250961..e95842e 100644
--- a/emacs/notmuch.el
+++ b/emacs/notmuch.el
@@ -54,6 +54,7 @@
(require 'notmuch-lib)
(require 'notmuch-show)
+(require 'notmuch-pick)
(require 'notmuch-mua)
(require 'notmuch-hello)
(require 'notmuch-maildir-fcc)
@@ -272,6 +273,8 @@ For a mouse binding, return nil."
(define-key map "R" 'notmuch-search-reply-to-thread)
(define-key map "m" 'notmuch-mua-new-mail)
(define-key map "s" 'notmuch-search)
+ (define-key map "z" 'notmuch-pick)
+ (define-key map "Z" 'notmuch-search-pick-current-query)
(define-key map "o" 'notmuch-search-toggle-order)
(define-key map "c" 'notmuch-search-stash-map)
(define-key map "=" 'notmuch-search-refresh-view)
@@ -1021,6 +1024,11 @@ same relative position within the new buffer."
(notmuch-search query oldest-first target-thread target-line continuation)
(goto-char (point-min))))
+(defun notmuch-search-pick-current-query ()
+ "Call notmuch pick with the current query"
+ (interactive)
+ (notmuch-pick notmuch-search-query-string))
+
(defcustom notmuch-poll-script nil
"An external script to incorporate new mail into the notmuch database.
--
1.7.2.3
^ permalink raw reply related [flat|nested] 11+ messages in thread* [RFC PATCH 3/3] emacs: add notmuch-pick itself
2012-02-12 10:32 RFC notmuch-pick: an emacs threaded message view with split-pane Mark Walters
2012-02-12 10:36 ` [RFC PATCH 1/3] cli: notmuch-show changes to support pick Mark Walters
2012-02-12 10:36 ` [RFC PATCH 2/3] emacs: changes to other files to support notmuch-pick Mark Walters
@ 2012-02-12 10:36 ` Mark Walters
[not found] ` <87ehu0cf16.fsf@schoepe.localhost>
` (2 subsequent siblings)
5 siblings, 0 replies; 11+ messages in thread
From: Mark Walters @ 2012-02-12 10:36 UTC (permalink / raw)
To: notmuch
---
emacs/notmuch-pick.el | 570 +++++++++++++++++++++++++++++++++++++++++++++++++
1 files changed, 570 insertions(+), 0 deletions(-)
create mode 100644 emacs/notmuch-pick.el
diff --git a/emacs/notmuch-pick.el b/emacs/notmuch-pick.el
new file mode 100644
index 0000000..4c91d7c
--- /dev/null
+++ b/emacs/notmuch-pick.el
@@ -0,0 +1,570 @@
+;; notmuch-pick.el --- displaying notmuch forests.
+;;
+;; Copyright © Carl Worth
+;; Copyright © David Edmondson
+;;
+;; 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 <http://www.gnu.org/licenses/>.
+;;
+;; Authors: David Edmondson <dme@dme.org>
+
+(require 'mail-parse)
+
+(require 'notmuch-lib)
+(require 'notmuch-query)
+(require 'notmuch-show)
+(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))
+
+(defcustom notmuch-pick-author-width 20
+ "Width of the author field."
+ :group 'notmuch
+ :type 'int)
+
+(defvar notmuch-pick-previous-subject "")
+(make-variable-buffer-local 'notmuch-pick-previous-subject)
+
+(defvar notmuch-pick-thread-id nil)
+(make-variable-buffer-local 'notmuch-pick-thread-id)
+(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-view-just-messages nil)
+(make-variable-buffer-local 'notmuch-pick-view-just-messages)
+(put 'notmuch-pick-view-just-messages 'permanent-local t)
+(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-oldest-first nil)
+(make-variable-buffer-local 'notmuch-pick-oldest-first)
+(put 'notmuch-pick-oldest-first 'permanent-local t)
+
+(defvar notmuch-pick-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map (kbd "RET") 'notmuch-pick-show-message)
+ (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 "t" 'notmuch-pick-toggle-view)
+ (define-key map "o" 'notmuch-pick-toggle-order)
+ (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-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-message-window)
+ (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-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-tag-message (&rest tag-changes)
+ "Change tags for the current message.
+
+TAG-CHANGES is a list of tag operations for `notmuch-tag'."
+ (let* ((current-tags (notmuch-pick-get-tags))
+ (new-tags (notmuch-update-tags current-tags tag-changes)))
+ (unless (equal current-tags new-tags)
+ (apply 'notmuch-tag (notmuch-pick-get-message-id) tag-changes)
+ (notmuch-pick-set-tags new-tags))))
+
+(defun notmuch-pick-tag (&optional initial-input)
+ "Change tags for the current message, read input from the minibuffer."
+ (interactive)
+ (let ((tag-changes (notmuch-read-tag-changes
+ initial-input (notmuch-pick-get-message-id))))
+ (apply 'notmuch-pick-tag-message 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 "-"))
+
+(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-show-message ()
+ "Show the current message."
+ (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 buffer (notmuch-show id nil nil nil nil t))))
+ (setq notmuch-pick-message-buffer buffer)))
+
+(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-message)))
+
+(defun notmuch-pick-toggle-order ()
+ "Toggle the current search order.
+
+By default, the \"inbox\" view created by `notmuch' is displayed
+in chronological order (oldest thread at the beginning of the
+buffer), while any global searches created by `notmuch-search'
+are displayed in reverse-chronological order (newest thread at
+the beginning of the buffer).
+
+This command toggles the sort order for the current search."
+ (interactive)
+ (let ((inhibit-read-only t))
+ (if notmuch-pick-oldest-first
+ (message "Showing newest messages first")
+ (message "Showing oldest messages first"))
+ (set 'notmuch-pick-oldest-first (not notmuch-pick-oldest-first))
+ (notmuch-pick-refresh-view)))
+
+(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)
+ (not (window-full-height-p notmuch-pick-message-window)))
+ (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 message."
+ (interactive)
+ (let ((id (notmuch-pick-get-message-id)))
+ (when id
+ (notmuch-tag id "-inbox" )
+ (forward-line))))
+
+(defun notmuch-pick-prev-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-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-refresh-view ()
+ "Refresh view."
+ (interactive)
+ (let ((inhibit-read-only t)
+ (thread-id notmuch-pick-thread-id)
+ (query-context notmuch-pick-query-context)
+ (buffer-name notmuch-pick-buffer-name))
+ (erase-buffer)
+ (notmuch-pick-worker thread-id query-context buffer-name)))
+
+(defun notmuch-pick-toggle-view ()
+ "Toggle showing threads or as isolated messages."
+ (interactive)
+ (let ((inhibit-read-only t))
+ (if notmuch-pick-view-just-messages
+ (message "Showing as threads")
+ (message "Showing as single messages"))
+ (setq notmuch-pick-view-just-messages (not notmuch-pick-view-just-messages))
+ (notmuch-pick-refresh-view)))
+
+(defun notmuch-pick-string-width (string width &optional right)
+ (let ((s (format (format "%%%s%ds" (if right "" "-") width)
+ string)))
+ (if (> (length s) width)
+ (substring s 0 width)
+ s)))
+
+(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 MJW
+(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 MJW
+(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 <user@dom.ain>" style.
+ ((string-match "\\(.*\\) <\\(.*\\)>" address)
+ (setq p-name (match-string 1 address)
+ p-address (match-string 2 address)))
+
+ ;; "<user@dom.ain>" 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 <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-msg (msg depth tree-status)
+ (let* ((headers (plist-get msg :headers))
+ (match (plist-get msg :match))
+ (tags (plist-get msg :tags))
+ (bare-subject (notmuch-show-strip-re (plist-get headers :Subject)))
+ ;; Face should be a defcustom or something MJW
+ (message-face (if match
+ '(:foreground "black")
+ '(:foreground "gray"))))
+
+ (insert (propertize (concat
+ (notmuch-pick-string-width
+ (plist-get msg :date_relative) 12 t)
+ " "
+ (format "%-75s"
+ (concat
+ (notmuch-pick-string-width
+ (notmuch-pick-clean-address (plist-get headers :From))
+ (if notmuch-pick-view-just-messages
+ (+ notmuch-pick-author-width 3)
+ notmuch-pick-author-width))
+ " "
+ (unless notmuch-pick-view-just-messages
+ (mapconcat #'identity (reverse tree-status) ""))
+ (if (string= notmuch-pick-previous-subject bare-subject)
+ " ..."
+ bare-subject)))
+ (if tags
+ (concat " ("
+ (mapconcat #'identity tags ", ") ")"))
+ "") 'face message-face))
+ (notmuch-pick-set-message-properties msg)
+ (insert "\n")
+
+ (setq notmuch-pick-previous-subject bare-subject)))
+
+(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 MJW
+ (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 msg depth 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 (forest)
+ (mapc '(lambda (thread)
+ (let (tree-status)
+ ;; Reset at the start of each main thread.
+ (setq notmuch-pick-previous-subject nil)
+ (notmuch-pick-insert-thread thread 0 tree-status)))
+ 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-worker (thread-id &optional query-context buffer-name)
+ (interactive)
+ (notmuch-pick-mode)
+ (setq notmuch-pick-thread-id thread-id)
+ (setq notmuch-pick-query-context query-context)
+ (setq notmuch-pick-buffer-name buffer-name)
+
+ (erase-buffer)
+ (goto-char (point-min))
+ (save-excursion
+ (let* ((basic-args (list thread-id))
+ (args (if query-context
+ (append (list "\'") basic-args (list "and (" query-context ")\'"))
+ (append (list "\'") basic-args (list "\'"))))
+ (message-arg (if notmuch-pick-view-just-messages
+ "--thread=none"
+ "--thread=entire"))
+ (sort-arg (if notmuch-pick-oldest-first
+ "--sort=oldest-first"
+ "--sort=newest-first")))
+
+ (notmuch-pick-insert-forest (notmuch-query-get-threads args "--headers-only" message-arg sort-arg))
+ ;; If the query context reduced the results to nothing, run
+ ;; the basic query.
+ (when (and (eq (buffer-size) 0)
+ query-context)
+ (notmuch-pick-insert-forest
+ (notmuch-query-get-threads basic-args message-arg sort-arg))))))
+
+(defun notmuch-pick (&optional query query-context buffer-name)
+ "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-" 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-name)
+
+ (setq truncate-lines t)))
+
+;; (use-local-map notmuch-pick-mode-map))
+
+;;
+
+(provide 'notmuch-pick)
--
1.7.2.3
^ permalink raw reply related [flat|nested] 11+ messages in thread