1 Return-Path: <markwalters1009@gmail.com>
\r
2 X-Original-To: notmuch@notmuchmail.org
\r
3 Delivered-To: notmuch@notmuchmail.org
\r
4 Received: from localhost (localhost [127.0.0.1])
\r
5 by olra.theworths.org (Postfix) with ESMTP id 8492B431FDB
\r
6 for <notmuch@notmuchmail.org>; Sun, 20 Oct 2013 01:28:51 -0700 (PDT)
\r
7 X-Virus-Scanned: Debian amavisd-new at olra.theworths.org
\r
11 X-Spam-Status: No, score=0.201 tagged_above=-999 required=5
\r
12 tests=[DKIM_SIGNED=0.1, DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1,
\r
13 FREEMAIL_ENVFROM_END_DIGIT=1, FREEMAIL_FROM=0.001,
\r
14 RCVD_IN_DNSWL_LOW=-0.7] autolearn=disabled
\r
15 Received: from olra.theworths.org ([127.0.0.1])
\r
16 by localhost (olra.theworths.org [127.0.0.1]) (amavisd-new, port 10024)
\r
17 with ESMTP id oF4PLm6nrr0h for <notmuch@notmuchmail.org>;
\r
18 Sun, 20 Oct 2013 01:28:33 -0700 (PDT)
\r
19 Received: from mail-wg0-f53.google.com (mail-wg0-f53.google.com
\r
20 [74.125.82.53]) (using TLSv1 with cipher RC4-SHA (128/128 bits)) (No client
\r
21 certificate requested) by olra.theworths.org (Postfix) with ESMTPS id
\r
22 C02CF431FC0 for <notmuch@notmuchmail.org>; Sun, 20 Oct 2013 01:28:27 -0700
\r
24 Received: by mail-wg0-f53.google.com with SMTP id y10so5365775wgg.20
\r
25 for <notmuch@notmuchmail.org>; Sun, 20 Oct 2013 01:28:25 -0700 (PDT)
\r
26 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20120113;
\r
27 h=from:to:cc:subject:date:message-id:in-reply-to:references
\r
28 :mime-version:content-type:content-transfer-encoding;
\r
29 bh=ae3bpNvams7wy2zVrG3y4Xy0+W9DCyT/VybeiR2/1oY=;
\r
30 b=cU00DEzCq6PhLumQvMqrrDFVYaPiJ+DpnENaZi7bKJgXjqT91aAh+H9yxhJmxbcwdk
\r
31 kXgjWpI75hYo3GednWqtaBROBrMZNpcoIldWtF7b2RIIG3k50IKrs400fMcSy0JxFSm9
\r
32 RNRtHJBML7aI4PGB2JPbbvpE8OGQm2gzmtuyjaBqvv7MWotBFvleFyNx37PHrAyF/eaf
\r
33 FUnMJg5NKRViI0g9ZoBT+N8gvKGvjRC5tzJiYQj8d7cu3iIzytZyk/qHejhJ2RiUrofj
\r
34 SOGrvjU+iuGp8nAlManOSCvGKEtcZwx4aW+4L5CfRSGM409UUavLqGPveCHKBwmbG8jP
\r
36 X-Received: by 10.180.9.134 with SMTP id z6mr5449925wia.9.1382257705168;
\r
37 Sun, 20 Oct 2013 01:28:25 -0700 (PDT)
\r
38 Received: from localhost (93-97-24-31.zone5.bethere.co.uk. [93.97.24.31])
\r
39 by mx.google.com with ESMTPSA id gp9sm43729420wib.8.2013.10.20.01.28.23
\r
40 for <multiple recipients>
\r
41 (version=TLSv1.2 cipher=RC4-SHA bits=128/128);
\r
42 Sun, 20 Oct 2013 01:28:24 -0700 (PDT)
\r
43 From: Mark Walters <markwalters1009@gmail.com>
\r
44 To: notmuch@notmuchmail.org
\r
45 Subject: [PATCH 1/5] emacs: move pick from contrib into mainline
\r
46 Date: Sun, 20 Oct 2013 09:28:15 +0100
\r
47 Message-Id: <1382257699-29860-2-git-send-email-markwalters1009@gmail.com>
\r
48 X-Mailer: git-send-email 1.7.9.1
\r
49 In-Reply-To: <1382257699-29860-1-git-send-email-markwalters1009@gmail.com>
\r
50 References: <1382257699-29860-1-git-send-email-markwalters1009@gmail.com>
\r
52 Content-Type: text/plain; charset=UTF-8
\r
53 Content-Transfer-Encoding: 8bit
\r
54 X-BeenThere: notmuch@notmuchmail.org
\r
55 X-Mailman-Version: 2.1.13
\r
57 List-Id: "Use and development of the notmuch mail system."
\r
58 <notmuch.notmuchmail.org>
\r
59 List-Unsubscribe: <http://notmuchmail.org/mailman/options/notmuch>,
\r
60 <mailto:notmuch-request@notmuchmail.org?subject=unsubscribe>
\r
61 List-Archive: <http://notmuchmail.org/pipermail/notmuch>
\r
62 List-Post: <mailto:notmuch@notmuchmail.org>
\r
63 List-Help: <mailto:notmuch-request@notmuchmail.org?subject=help>
\r
64 List-Subscribe: <http://notmuchmail.org/mailman/listinfo/notmuch>,
\r
65 <mailto:notmuch-request@notmuchmail.org?subject=subscribe>
\r
66 X-List-Received-Date: Sun, 20 Oct 2013 08:28:52 -0000
\r
68 This moves the notmuch-pick.el file into the main emacs directory. The
\r
69 file is not changed in the move.
\r
71 contrib/notmuch-pick/notmuch-pick.el | 946 ----------------------------------
\r
72 emacs/notmuch-pick.el | 946 ++++++++++++++++++++++++++++++++++
\r
73 2 files changed, 946 insertions(+), 946 deletions(-)
\r
74 delete mode 100644 contrib/notmuch-pick/notmuch-pick.el
\r
75 create mode 100644 emacs/notmuch-pick.el
\r
77 diff --git a/contrib/notmuch-pick/notmuch-pick.el b/contrib/notmuch-pick/notmuch-pick.el
\r
78 deleted file mode 100644
\r
79 index a492214..0000000
\r
80 --- a/contrib/notmuch-pick/notmuch-pick.el
\r
83 -;; notmuch-pick.el --- displaying notmuch forests.
\r
85 -;; Copyright © Carl Worth
\r
86 -;; Copyright © David Edmondson
\r
87 -;; Copyright © Mark Walters
\r
89 -;; This file is part of Notmuch.
\r
91 -;; Notmuch is free software: you can redistribute it and/or modify it
\r
92 -;; under the terms of the GNU General Public License as published by
\r
93 -;; the Free Software Foundation, either version 3 of the License, or
\r
94 -;; (at your option) any later version.
\r
96 -;; Notmuch is distributed in the hope that it will be useful, but
\r
97 -;; WITHOUT ANY WARRANTY; without even the implied warranty of
\r
98 -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
\r
99 -;; General Public License for more details.
\r
101 -;; You should have received a copy of the GNU General Public License
\r
102 -;; along with Notmuch. If not, see <http://www.gnu.org/licenses/>.
\r
104 -;; Authors: David Edmondson <dme@dme.org>
\r
105 -;; Mark Walters <markwalters1009@gmail.com>
\r
107 -(require 'mail-parse)
\r
109 -(require 'notmuch-lib)
\r
110 -(require 'notmuch-query)
\r
111 -(require 'notmuch-show)
\r
112 -(require 'notmuch) ;; XXX ATM, as notmuch-search-mode-map is defined here
\r
114 -(eval-when-compile (require 'cl))
\r
116 -(declare-function notmuch-call-notmuch-process "notmuch" (&rest args))
\r
117 -(declare-function notmuch-show "notmuch-show" (&rest args))
\r
118 -(declare-function notmuch-tag "notmuch" (query &rest tags))
\r
119 -(declare-function notmuch-show-strip-re "notmuch-show" (subject))
\r
120 -(declare-function notmuch-show-spaces-n "notmuch-show" (n))
\r
121 -(declare-function notmuch-read-query "notmuch" (prompt))
\r
122 -(declare-function notmuch-read-tag-changes "notmuch" (&optional initial-input &rest search-terms))
\r
123 -(declare-function notmuch-update-tags "notmuch" (current-tags tag-changes))
\r
124 -(declare-function notmuch-hello-trim "notmuch-hello" (search))
\r
125 -(declare-function notmuch-search-find-thread-id "notmuch" ())
\r
126 -(declare-function notmuch-search-find-subject "notmuch" ())
\r
128 -;; the following variable is defined in notmuch.el
\r
129 -(defvar notmuch-search-query-string)
\r
131 -(defgroup notmuch-pick nil
\r
132 - "Showing message and thread structure."
\r
135 -(defcustom notmuch-pick-show-out nil
\r
136 - "View selected messages in new window rather than split-pane."
\r
138 - :group 'notmuch-pick)
\r
140 -(defcustom notmuch-pick-result-format
\r
141 - `(("date" . "%12s ")
\r
142 - ("authors" . "%-20s")
\r
143 - ((("tree" . "%s")("subject" . "%s")) ." %-54s ")
\r
144 - ("tags" . "(%s)"))
\r
145 - "Result formatting for Pick. Supported fields are: date,
\r
146 - authors, subject, tree, tags. Tree means the thread tree
\r
147 - box graphics. The field may also be a list in which case
\r
148 - the formatting rules are applied recursively and then the
\r
149 - output of all the fields in the list is inserted
\r
150 - according to format-string.
\r
152 -Note the author string should not contain
\r
153 - whitespace (put it in the neighbouring fields instead).
\r
155 - (setq notmuch-pick-result-format \(\(\"authors\" . \"%-40s\"\)
\r
156 - \(\"subject\" . \"%s\"\)\)\)"
\r
157 - :type '(alist :key-type (string) :value-type (string))
\r
158 - :group 'notmuch-pick)
\r
160 -;; Faces for messages that match the query.
\r
161 -(defface notmuch-pick-match-date-face
\r
162 - '((t :inherit default))
\r
163 - "Face used in pick mode for the date in messages matching the query."
\r
164 - :group 'notmuch-pick
\r
165 - :group 'notmuch-faces)
\r
167 -(defface notmuch-pick-match-author-face
\r
168 - '((((class color)
\r
169 - (background dark))
\r
170 - (:foreground "OliveDrab1"))
\r
172 - (background light))
\r
173 - (:foreground "dark blue"))
\r
176 - "Face used in pick mode for the date in messages matching the query."
\r
177 - :group 'notmuch-pick
\r
178 - :group 'notmuch-faces)
\r
180 -(defface notmuch-pick-match-subject-face
\r
181 - '((t :inherit default))
\r
182 - "Face used in pick mode for the subject in messages matching the query."
\r
183 - :group 'notmuch-pick
\r
184 - :group 'notmuch-faces)
\r
186 -(defface notmuch-pick-match-tree-face
\r
187 - '((t :inherit default))
\r
188 - "Face used in pick mode for the thread tree block graphics in messages matching the query."
\r
189 - :group 'notmuch-pick
\r
190 - :group 'notmuch-faces)
\r
192 -(defface notmuch-pick-match-tag-face
\r
193 - '((((class color)
\r
194 - (background dark))
\r
195 - (:foreground "OliveDrab1"))
\r
197 - (background light))
\r
198 - (:foreground "navy blue" :bold t))
\r
201 - "Face used in pick mode for tags in messages matching the query."
\r
202 - :group 'notmuch-pick
\r
203 - :group 'notmuch-faces)
\r
205 -;; Faces for messages that do not match the query.
\r
206 -(defface notmuch-pick-no-match-date-face
\r
207 - '((t (:foreground "gray")))
\r
208 - "Face used in pick mode for non-matching dates."
\r
209 - :group 'notmuch-pick
\r
210 - :group 'notmuch-faces)
\r
212 -(defface notmuch-pick-no-match-subject-face
\r
213 - '((t (:foreground "gray")))
\r
214 - "Face used in pick mode for non-matching subjects."
\r
215 - :group 'notmuch-pick
\r
216 - :group 'notmuch-faces)
\r
218 -(defface notmuch-pick-no-match-tree-face
\r
219 - '((t (:foreground "gray")))
\r
220 - "Face used in pick mode for the thread tree block graphics in messages matching the query."
\r
221 - :group 'notmuch-pick
\r
222 - :group 'notmuch-faces)
\r
224 -(defface notmuch-pick-no-match-author-face
\r
225 - '((t (:foreground "gray")))
\r
226 - "Face used in pick mode for the date in messages matching the query."
\r
227 - :group 'notmuch-pick
\r
228 - :group 'notmuch-faces)
\r
230 -(defface notmuch-pick-no-match-tag-face
\r
231 - '((t (:foreground "gray")))
\r
232 - "Face used in pick mode face for non-matching tags."
\r
233 - :group 'notmuch-pick
\r
234 - :group 'notmuch-faces)
\r
236 -(defvar notmuch-pick-previous-subject
\r
237 - "The subject of the most recent result shown during the async display")
\r
238 -(make-variable-buffer-local 'notmuch-pick-previous-subject)
\r
240 -(defvar notmuch-pick-basic-query nil
\r
241 - "A buffer local copy of argument query to the function notmuch-pick")
\r
242 -(make-variable-buffer-local 'notmuch-pick-basic-query)
\r
244 -(defvar notmuch-pick-query-context nil
\r
245 - "A buffer local copy of argument query-context to the function notmuch-pick")
\r
246 -(make-variable-buffer-local 'notmuch-pick-query-context)
\r
248 -(defvar notmuch-pick-target-msg nil
\r
249 - "A buffer local copy of argument target to the function notmuch-pick")
\r
250 -(make-variable-buffer-local 'notmuch-pick-target-msg)
\r
252 -(defvar notmuch-pick-open-target nil
\r
253 - "A buffer local copy of argument open-target to the function notmuch-pick")
\r
254 -(make-variable-buffer-local 'notmuch-pick-open-target)
\r
256 -(defvar notmuch-pick-message-window nil
\r
257 - "The window of the message pane.
\r
259 -It is set in both the pick buffer and the child show buffer. It
\r
260 -is used to try and close the message pane when quitting pick or
\r
261 -the child show buffer.")
\r
262 -(make-variable-buffer-local 'notmuch-pick-message-window)
\r
263 -(put 'notmuch-pick-message-window 'permanent-local t)
\r
265 -(defvar notmuch-pick-message-buffer nil
\r
266 - "The buffer name of the show buffer in the message pane.
\r
268 -This is used to try and make sure we don't close the message pane
\r
269 -if the user has loaded a different buffer in that window.")
\r
270 -(make-variable-buffer-local 'notmuch-pick-message-buffer)
\r
271 -(put 'notmuch-pick-message-buffer 'permanent-local t)
\r
273 -(defun notmuch-pick-to-message-pane (func)
\r
274 - "Execute FUNC in message pane.
\r
276 -This function returns a function (so can be used as a keybinding)
\r
277 -which executes function FUNC in the message pane if it is
\r
278 -open (if the message pane is closed it does nothing)."
\r
280 - ,(concat "(In message pane) " (documentation func t))
\r
282 - (when (window-live-p notmuch-pick-message-window)
\r
283 - (with-selected-window notmuch-pick-message-window
\r
284 - (call-interactively #',func)))))
\r
286 -(defun notmuch-pick-button-activate (&optional button)
\r
287 - "Activate BUTTON or button at point
\r
289 -This function does not give an error if there is no button."
\r
291 - (let ((button (or button (button-at (point)))))
\r
292 - (when button (button-activate button))))
\r
294 -(defun notmuch-pick-close-message-pane-and (func)
\r
295 - "Close message pane and execute FUNC.
\r
297 -This function returns a function (so can be used as a keybinding)
\r
298 -which closes the message pane if open and then executes function
\r
301 - ,(concat "(Close message pane and) " (documentation func t))
\r
303 - (notmuch-pick-close-message-window)
\r
304 - (call-interactively #',func)))
\r
306 -(defvar notmuch-pick-mode-map
\r
307 - (let ((map (make-sparse-keymap)))
\r
308 - (set-keymap-parent map notmuch-common-keymap)
\r
309 - ;; The following override the global keymap.
\r
310 - ;; Override because we want to close message pane first.
\r
311 - (define-key map "?" (notmuch-pick-close-message-pane-and #'notmuch-help))
\r
312 - ;; Override because we first close message pane and then close pick buffer.
\r
313 - (define-key map "q" 'notmuch-pick-quit)
\r
314 - ;; Override because we close message pane after the search query is entered.
\r
315 - (define-key map "s" 'notmuch-pick-to-search)
\r
316 - ;; Override because we want to close message pane first.
\r
317 - (define-key map "m" (notmuch-pick-close-message-pane-and #'notmuch-mua-new-mail))
\r
319 - ;; these use notmuch-show functions directly
\r
320 - (define-key map "|" 'notmuch-show-pipe-message)
\r
321 - (define-key map "w" 'notmuch-show-save-attachments)
\r
322 - (define-key map "v" 'notmuch-show-view-all-mime-parts)
\r
323 - (define-key map "c" 'notmuch-show-stash-map)
\r
325 - ;; these apply to the message pane
\r
326 - (define-key map (kbd "M-TAB") (notmuch-pick-to-message-pane #'notmuch-show-previous-button))
\r
327 - (define-key map (kbd "<backtab>") (notmuch-pick-to-message-pane #'notmuch-show-previous-button))
\r
328 - (define-key map (kbd "TAB") (notmuch-pick-to-message-pane #'notmuch-show-next-button))
\r
329 - (define-key map "e" (notmuch-pick-to-message-pane #'notmuch-pick-button-activate))
\r
331 - ;; bindings from show (or elsewhere) but we close the message pane first.
\r
332 - (define-key map "f" (notmuch-pick-close-message-pane-and #'notmuch-show-forward-message))
\r
333 - (define-key map "r" (notmuch-pick-close-message-pane-and #'notmuch-show-reply-sender))
\r
334 - (define-key map "R" (notmuch-pick-close-message-pane-and #'notmuch-show-reply))
\r
335 - (define-key map "V" (notmuch-pick-close-message-pane-and #'notmuch-show-view-raw-message))
\r
337 - ;; The main pick bindings
\r
338 - (define-key map (kbd "RET") 'notmuch-pick-show-message)
\r
339 - (define-key map [mouse-1] 'notmuch-pick-show-message)
\r
340 - (define-key map "x" 'notmuch-pick-quit)
\r
341 - (define-key map "A" 'notmuch-pick-archive-thread)
\r
342 - (define-key map "a" 'notmuch-pick-archive-message-then-next)
\r
343 - (define-key map "=" 'notmuch-pick-refresh-view)
\r
344 - (define-key map "z" 'notmuch-pick-to-pick)
\r
345 - (define-key map "n" 'notmuch-pick-next-matching-message)
\r
346 - (define-key map "p" 'notmuch-pick-prev-matching-message)
\r
347 - (define-key map "N" 'notmuch-pick-next-message)
\r
348 - (define-key map "P" 'notmuch-pick-prev-message)
\r
349 - (define-key map (kbd "M-p") 'notmuch-pick-prev-thread)
\r
350 - (define-key map (kbd "M-n") 'notmuch-pick-next-thread)
\r
351 - (define-key map "-" 'notmuch-pick-remove-tag)
\r
352 - (define-key map "+" 'notmuch-pick-add-tag)
\r
353 - (define-key map "*" 'notmuch-pick-tag-thread)
\r
354 - (define-key map " " 'notmuch-pick-scroll-or-next)
\r
355 - (define-key map "b" 'notmuch-pick-scroll-message-window-back)
\r
357 -(fset 'notmuch-pick-mode-map notmuch-pick-mode-map)
\r
359 -(defun notmuch-pick-get-message-properties ()
\r
360 - "Return the properties of the current message as a plist.
\r
362 -Some useful entries are:
\r
363 -:headers - Property list containing the headers :Date, :Subject, :From, etc.
\r
364 -:tags - Tags for this message"
\r
366 - (beginning-of-line)
\r
367 - (get-text-property (point) :notmuch-message-properties)))
\r
369 -;; XXX This should really be a lib function but we are trying to
\r
370 -;; reduce impact on the code base.
\r
371 -(defun notmuch-show-get-prop (prop &optional props)
\r
372 - "This is a pick overridden version of notmuch-show-get-prop
\r
374 -It gets property PROP from PROPS or, if PROPS is nil, the current
\r
375 -message in either pick or show. This means that several functions
\r
376 -in notmuch-show now work unchanged in pick as they just need the
\r
377 -correct message properties."
\r
378 - (let ((props (or props
\r
379 - (cond ((eq major-mode 'notmuch-show-mode)
\r
380 - (notmuch-show-get-message-properties))
\r
381 - ((eq major-mode 'notmuch-pick-mode)
\r
382 - (notmuch-pick-get-message-properties))))))
\r
383 - (plist-get props prop)))
\r
385 -(defun notmuch-pick-set-message-properties (props)
\r
387 - (beginning-of-line)
\r
388 - (put-text-property (point) (+ (point) 1) :notmuch-message-properties props)))
\r
390 -(defun notmuch-pick-set-prop (prop val &optional props)
\r
391 - (let ((inhibit-read-only t)
\r
393 - (notmuch-pick-get-message-properties))))
\r
394 - (plist-put props prop val)
\r
395 - (notmuch-pick-set-message-properties props)))
\r
397 -(defun notmuch-pick-get-prop (prop &optional props)
\r
398 - (let ((props (or props
\r
399 - (notmuch-pick-get-message-properties))))
\r
400 - (plist-get props prop)))
\r
402 -(defun notmuch-pick-set-tags (tags)
\r
403 - "Set the tags of the current message."
\r
404 - (notmuch-pick-set-prop :tags tags))
\r
406 -(defun notmuch-pick-get-tags ()
\r
407 - "Return the tags of the current message."
\r
408 - (notmuch-pick-get-prop :tags))
\r
410 -(defun notmuch-pick-get-message-id ()
\r
411 - "Return the message id of the current message."
\r
412 - (let ((id (notmuch-pick-get-prop :id)))
\r
414 - (notmuch-id-to-query id)
\r
417 -(defun notmuch-pick-get-match ()
\r
418 - "Return whether the current message is a match."
\r
420 - (notmuch-pick-get-prop :match))
\r
422 -(defun notmuch-pick-refresh-result ()
\r
423 - "Redisplay the current message line.
\r
425 -This redisplays the current line based on the messages
\r
426 -properties (as they are now). This is used when tags are
\r
428 - (let ((init-point (point))
\r
429 - (end (line-end-position))
\r
430 - (msg (notmuch-pick-get-message-properties))
\r
431 - (inhibit-read-only t))
\r
432 - (beginning-of-line)
\r
433 - ;; This is a little tricky: we override
\r
434 - ;; notmuch-pick-previous-subject to get the decision between
\r
435 - ;; ... and a subject right and it stops notmuch-pick-insert-msg
\r
436 - ;; from overwriting the buffer local copy of
\r
437 - ;; notmuch-pick-previous-subject if this is called while the
\r
438 - ;; buffer is displaying.
\r
439 - (let ((notmuch-pick-previous-subject (notmuch-pick-get-prop :previous-subject)))
\r
440 - (delete-region (point) (1+ (line-end-position)))
\r
441 - (notmuch-pick-insert-msg msg))
\r
442 - (let ((new-end (line-end-position)))
\r
443 - (goto-char (if (= init-point end)
\r
445 - (min init-point (- new-end 1)))))))
\r
447 -(defun notmuch-pick-tag-update-display (&optional tag-changes)
\r
448 - "Update display for TAG-CHANGES to current message.
\r
450 -Does NOT change the database."
\r
451 - (let* ((current-tags (notmuch-pick-get-tags))
\r
452 - (new-tags (notmuch-update-tags current-tags tag-changes)))
\r
453 - (unless (equal current-tags new-tags)
\r
454 - (notmuch-pick-set-tags new-tags)
\r
455 - (notmuch-pick-refresh-result))))
\r
457 -(defun notmuch-pick-tag (&optional tag-changes)
\r
458 - "Change tags for the current message"
\r
460 - (setq tag-changes (notmuch-tag (notmuch-pick-get-message-id) tag-changes))
\r
461 - (notmuch-pick-tag-update-display tag-changes))
\r
463 -(defun notmuch-pick-add-tag ()
\r
464 - "Same as `notmuch-pick-tag' but sets initial input to '+'."
\r
466 - (notmuch-pick-tag "+"))
\r
468 -(defun notmuch-pick-remove-tag ()
\r
469 - "Same as `notmuch-pick-tag' but sets initial input to '-'."
\r
471 - (notmuch-pick-tag "-"))
\r
473 -;; The next two functions close the message window before searching or
\r
474 -;; picking but they do so after the user has entered the query (in
\r
475 -;; case the user was basing the query on something in the message
\r
478 -(defun notmuch-pick-to-search ()
\r
479 - "Run \"notmuch search\" with the given `query' and display results."
\r
481 - (let ((query (notmuch-read-query "Notmuch search: ")))
\r
482 - (notmuch-pick-close-message-window)
\r
483 - (notmuch-search query)))
\r
485 -(defun notmuch-pick-to-pick ()
\r
486 - "Run a query and display results in experimental notmuch-pick mode"
\r
488 - (let ((query (notmuch-read-query "Notmuch pick: ")))
\r
489 - (notmuch-pick-close-message-window)
\r
490 - (notmuch-pick query)))
\r
492 -;; This function should be in notmuch-show.el but be we trying to
\r
493 -;; minimise impact on the rest of the codebase.
\r
494 -(defun notmuch-pick-from-show-current-query ()
\r
495 - "Call notmuch pick with the current query"
\r
497 - (notmuch-pick notmuch-show-thread-id
\r
498 - notmuch-show-query-context
\r
499 - (notmuch-show-get-message-id)))
\r
501 -;; This function should be in notmuch.el but be we trying to minimise
\r
502 -;; impact on the rest of the codebase.
\r
503 -(defun notmuch-pick-from-search-current-query ()
\r
504 - "Call notmuch pick with the current query"
\r
506 - (notmuch-pick notmuch-search-query-string))
\r
508 -;; This function should be in notmuch.el but be we trying to minimise
\r
509 -;; impact on the rest of the codebase.
\r
510 -(defun notmuch-pick-from-search-thread ()
\r
511 - "Show the selected thread with notmuch-pick"
\r
513 - (notmuch-pick (notmuch-search-find-thread-id)
\r
514 - notmuch-search-query-string
\r
516 - (notmuch-prettify-subject (notmuch-search-find-subject))
\r
519 -(defun notmuch-pick-message-window-kill-hook ()
\r
520 - "Close the message pane when exiting the show buffer."
\r
521 - (let ((buffer (current-buffer)))
\r
522 - (when (and (window-live-p notmuch-pick-message-window)
\r
523 - (eq (window-buffer notmuch-pick-message-window) buffer))
\r
524 - ;; We do not want an error if this is the sole window in the
\r
525 - ;; frame and I do not know how to test for that in emacs pre
\r
526 - ;; 24. Hence we just ignore-errors.
\r
528 - (delete-window notmuch-pick-message-window)))))
\r
530 -(defun notmuch-pick-show-message-in ()
\r
531 - "Show the current message (in split-pane)."
\r
533 - (let ((id (notmuch-pick-get-message-id))
\r
534 - (inhibit-read-only t)
\r
537 - ;; We close and reopen the window to kill off un-needed buffers
\r
538 - ;; this might cause flickering but seems ok.
\r
539 - (notmuch-pick-close-message-window)
\r
540 - (setq notmuch-pick-message-window
\r
541 - (split-window-vertically (/ (window-height) 4)))
\r
542 - (with-selected-window notmuch-pick-message-window
\r
543 - ;; Since we are only displaying one message do not indent.
\r
544 - (let ((notmuch-show-indent-messages-width 0)
\r
545 - (notmuch-show-only-matching-messages t))
\r
546 - (setq buffer (notmuch-show id))))
\r
547 - ;; We need the `let' as notmuch-pick-message-window is buffer local.
\r
548 - (let ((window notmuch-pick-message-window))
\r
549 - (with-current-buffer buffer
\r
550 - (setq notmuch-pick-message-window window)
\r
551 - (add-hook 'kill-buffer-hook 'notmuch-pick-message-window-kill-hook)))
\r
552 - (when notmuch-show-mark-read-tags
\r
553 - (notmuch-pick-tag-update-display notmuch-show-mark-read-tags))
\r
554 - (setq notmuch-pick-message-buffer buffer))))
\r
556 -(defun notmuch-pick-show-message-out ()
\r
557 - "Show the current message (in whole window)."
\r
559 - (let ((id (notmuch-pick-get-message-id))
\r
560 - (inhibit-read-only t)
\r
563 - ;; We close the window to kill off un-needed buffers.
\r
564 - (notmuch-pick-close-message-window)
\r
565 - (notmuch-show id))))
\r
567 -(defun notmuch-pick-show-message (arg)
\r
568 - "Show the current message.
\r
570 -Shows in split pane or whole window according to value of
\r
571 -`notmuch-pick-show-out'. A prefix argument reverses the choice."
\r
572 - (interactive "P")
\r
573 - (if (or (and notmuch-pick-show-out (not arg))
\r
574 - (and (not notmuch-pick-show-out) arg))
\r
575 - (notmuch-pick-show-message-out)
\r
576 - (notmuch-pick-show-message-in)))
\r
578 -(defun notmuch-pick-scroll-message-window ()
\r
579 - "Scroll the message window (if it exists)"
\r
581 - (when (window-live-p notmuch-pick-message-window)
\r
582 - (with-selected-window notmuch-pick-message-window
\r
583 - (if (pos-visible-in-window-p (point-max))
\r
587 -(defun notmuch-pick-scroll-message-window-back ()
\r
588 - "Scroll the message window back(if it exists)"
\r
590 - (when (window-live-p notmuch-pick-message-window)
\r
591 - (with-selected-window notmuch-pick-message-window
\r
592 - (if (pos-visible-in-window-p (point-min))
\r
594 - (scroll-down)))))
\r
596 -(defun notmuch-pick-scroll-or-next ()
\r
597 - "Scroll the message window. If it at end go to next message."
\r
599 - (when (notmuch-pick-scroll-message-window)
\r
600 - (notmuch-pick-next-matching-message)))
\r
602 -(defun notmuch-pick-quit ()
\r
603 - "Close the split view or exit pick."
\r
605 - (unless (notmuch-pick-close-message-window)
\r
606 - (kill-buffer (current-buffer))))
\r
608 -(defun notmuch-pick-close-message-window ()
\r
609 - "Close the message-window. Return t if close succeeds."
\r
611 - (when (and (window-live-p notmuch-pick-message-window)
\r
612 - (eq (window-buffer notmuch-pick-message-window) notmuch-pick-message-buffer))
\r
613 - (delete-window notmuch-pick-message-window)
\r
614 - (unless (get-buffer-window-list notmuch-pick-message-buffer)
\r
615 - (kill-buffer notmuch-pick-message-buffer))
\r
618 -(defun notmuch-pick-archive-message (&optional unarchive)
\r
619 - "Archive the current message.
\r
621 -Archive the current message by applying the tag changes in
\r
622 -`notmuch-archive-tags' to it. If a prefix argument is given, the
\r
623 -message will be \"unarchived\", i.e. the tag changes in
\r
624 -`notmuch-archive-tags' will be reversed."
\r
625 - (interactive "P")
\r
626 - (when notmuch-archive-tags
\r
627 - (apply 'notmuch-pick-tag
\r
628 - (notmuch-tag-change-list notmuch-archive-tags unarchive))))
\r
630 -(defun notmuch-pick-archive-message-then-next (&optional unarchive)
\r
631 - "Archive the current message and move to next matching message."
\r
632 - (interactive "P")
\r
633 - (notmuch-pick-archive-message unarchive)
\r
634 - (notmuch-pick-next-matching-message))
\r
636 -(defun notmuch-pick-next-message ()
\r
637 - "Move to next message."
\r
640 - (when (window-live-p notmuch-pick-message-window)
\r
641 - (notmuch-pick-show-message-in)))
\r
643 -(defun notmuch-pick-prev-message ()
\r
644 - "Move to previous message."
\r
646 - (forward-line -1)
\r
647 - (when (window-live-p notmuch-pick-message-window)
\r
648 - (notmuch-pick-show-message-in)))
\r
650 -(defun notmuch-pick-prev-matching-message ()
\r
651 - "Move to previous matching message."
\r
653 - (forward-line -1)
\r
654 - (while (and (not (bobp)) (not (notmuch-pick-get-match)))
\r
655 - (forward-line -1))
\r
656 - (when (window-live-p notmuch-pick-message-window)
\r
657 - (notmuch-pick-show-message-in)))
\r
659 -(defun notmuch-pick-next-matching-message ()
\r
660 - "Move to next matching message."
\r
663 - (while (and (not (eobp)) (not (notmuch-pick-get-match)))
\r
665 - (when (window-live-p notmuch-pick-message-window)
\r
666 - (notmuch-pick-show-message-in)))
\r
668 -(defun notmuch-pick-refresh-view ()
\r
671 - (let ((inhibit-read-only t)
\r
672 - (basic-query notmuch-pick-basic-query)
\r
673 - (query-context notmuch-pick-query-context)
\r
674 - (target (notmuch-pick-get-message-id)))
\r
676 - (notmuch-pick-worker basic-query
\r
680 -(defun notmuch-pick-thread-top ()
\r
681 - (when (notmuch-pick-get-message-properties)
\r
682 - (while (not (or (notmuch-pick-get-prop :first) (eobp)))
\r
683 - (forward-line -1))))
\r
685 -(defun notmuch-pick-prev-thread ()
\r
687 - (forward-line -1)
\r
688 - (notmuch-pick-thread-top))
\r
690 -(defun notmuch-pick-next-thread ()
\r
693 - (while (not (or (notmuch-pick-get-prop :first) (eobp)))
\r
694 - (forward-line 1)))
\r
696 -(defun notmuch-pick-thread-mapcar (function)
\r
697 - "Iterate through all messages in the current thread
\r
698 - and call FUNCTION for side effects."
\r
700 - (notmuch-pick-thread-top)
\r
701 - (loop collect (funcall function)
\r
702 - do (forward-line)
\r
703 - while (and (notmuch-pick-get-message-properties)
\r
704 - (not (notmuch-pick-get-prop :first))))))
\r
706 -(defun notmuch-pick-get-messages-ids-thread-search ()
\r
707 - "Return a search string for all message ids of messages in the current thread."
\r
708 - (mapconcat 'identity
\r
709 - (notmuch-pick-thread-mapcar 'notmuch-pick-get-message-id)
\r
712 -(defun notmuch-pick-tag-thread (&optional tag-changes)
\r
713 - "Tag all messages in the current thread"
\r
715 - (when (notmuch-pick-get-message-properties)
\r
716 - (let ((tag-changes (notmuch-tag (notmuch-pick-get-messages-ids-thread-search) tag-changes)))
\r
717 - (notmuch-pick-thread-mapcar
\r
718 - (lambda () (notmuch-pick-tag-update-display tag-changes))))))
\r
720 -(defun notmuch-pick-archive-thread (&optional unarchive)
\r
721 - "Archive each message in thread.
\r
723 -Archive each message currently shown by applying the tag changes
\r
724 -in `notmuch-archive-tags' to each. If a prefix argument is given,
\r
725 -the messages will be \"unarchived\", i.e. the tag changes in
\r
726 -`notmuch-archive-tags' will be reversed.
\r
728 -Note: This command is safe from any race condition of new messages
\r
729 -being delivered to the same thread. It does not archive the
\r
730 -entire thread, but only the messages shown in the current
\r
732 - (interactive "P")
\r
733 - (when notmuch-archive-tags
\r
734 - (notmuch-pick-tag-thread
\r
735 - (notmuch-tag-change-list notmuch-archive-tags unarchive))))
\r
737 -;; Functions below here display the pick buffer itself.
\r
739 -(defun notmuch-pick-clean-address (address)
\r
740 - "Try to clean a single email ADDRESS for display. Return
\r
741 -AUTHOR_NAME if present, otherwise return AUTHOR_EMAIL. Return
\r
742 -unchanged ADDRESS if parsing fails."
\r
743 - (let* ((clean-address (notmuch-clean-address address))
\r
744 - (p-address (car clean-address))
\r
745 - (p-name (cdr clean-address)))
\r
747 - ;; If we have a name return that otherwise return the address.
\r
748 - (or p-name p-address)))
\r
750 -(defun notmuch-pick-format-field (field format-string msg)
\r
751 - "Format a FIELD of MSG according to FORMAT-STRING and return string"
\r
752 - (let* ((headers (plist-get msg :headers))
\r
753 - (match (plist-get msg :match)))
\r
756 - (format format-string (notmuch-pick-format-field-list field msg)))
\r
758 - ((string-equal field "date")
\r
759 - (let ((face (if match
\r
760 - 'notmuch-pick-match-date-face
\r
761 - 'notmuch-pick-no-match-date-face)))
\r
762 - (propertize (format format-string (plist-get msg :date_relative)) 'face face)))
\r
764 - ((string-equal field "tree")
\r
765 - (let ((tree-status (plist-get msg :tree-status))
\r
767 - 'notmuch-pick-match-tree-face
\r
768 - 'notmuch-pick-no-match-tree-face)))
\r
770 - (propertize (format format-string
\r
771 - (mapconcat #'identity (reverse tree-status) ""))
\r
774 - ((string-equal field "subject")
\r
775 - (let ((bare-subject (notmuch-show-strip-re (plist-get headers :Subject)))
\r
776 - (previous-subject notmuch-pick-previous-subject)
\r
778 - 'notmuch-pick-match-subject-face
\r
779 - 'notmuch-pick-no-match-subject-face)))
\r
781 - (setq notmuch-pick-previous-subject bare-subject)
\r
782 - (propertize (format format-string
\r
783 - (if (string= previous-subject bare-subject)
\r
788 - ((string-equal field "authors")
\r
789 - (let ((author (notmuch-pick-clean-address (plist-get headers :From)))
\r
790 - (len (length (format format-string "")))
\r
792 - 'notmuch-pick-match-author-face
\r
793 - 'notmuch-pick-no-match-author-face)))
\r
794 - (when (> (length author) len)
\r
795 - (setq author (substring author 0 len)))
\r
796 - (propertize (format format-string author) 'face face)))
\r
798 - ((string-equal field "tags")
\r
799 - (let ((tags (plist-get msg :tags))
\r
801 - 'notmuch-pick-match-tag-face
\r
802 - 'notmuch-pick-no-match-tag-face)))
\r
803 - (propertize (format format-string
\r
804 - (mapconcat #'identity tags ", "))
\r
808 -(defun notmuch-pick-format-field-list (field-list msg)
\r
809 - "Format fields of MSG according to FIELD-LIST and return string"
\r
810 - (let (result-string)
\r
811 - (dolist (spec field-list result-string)
\r
812 - (let ((field-string (notmuch-pick-format-field (car spec) (cdr spec) msg)))
\r
813 - (setq result-string (concat result-string field-string))))))
\r
815 -(defun notmuch-pick-insert-msg (msg)
\r
816 - "Insert the message MSG according to notmuch-pick-result-format"
\r
817 - ;; We need to save the previous subject as it will get overwritten
\r
818 - ;; by the insert-field calls.
\r
819 - (let ((previous-subject notmuch-pick-previous-subject))
\r
820 - (insert (notmuch-pick-format-field-list notmuch-pick-result-format msg))
\r
821 - (notmuch-pick-set-message-properties msg)
\r
822 - (notmuch-pick-set-prop :previous-subject previous-subject)
\r
825 -(defun notmuch-pick-goto-and-insert-msg (msg)
\r
826 - "Insert msg at the end of the buffer. Move point to msg if it is the target"
\r
828 - (goto-char (point-max))
\r
829 - (notmuch-pick-insert-msg msg))
\r
830 - (let ((msg-id (notmuch-id-to-query (plist-get msg :id)))
\r
831 - (target notmuch-pick-target-msg))
\r
832 - (when (or (and (not target) (plist-get msg :match))
\r
833 - (string= msg-id target))
\r
834 - (setq notmuch-pick-target-msg "found")
\r
835 - (goto-char (point-max))
\r
836 - (forward-line -1)
\r
837 - (when notmuch-pick-open-target
\r
838 - (notmuch-pick-show-message-in)))))
\r
840 -(defun notmuch-pick-insert-tree (tree depth tree-status first last)
\r
841 - "Insert the message tree TREE at depth DEPTH in the current thread.
\r
843 -A message tree is another name for a single sub-thread: i.e., a
\r
844 -message together with all its descendents."
\r
845 - (let ((msg (car tree))
\r
846 - (replies (cadr tree)))
\r
849 - ((and (< 0 depth) (not last))
\r
850 - (push "├" tree-status))
\r
851 - ((and (< 0 depth) last)
\r
852 - (push "╰" tree-status))
\r
853 - ((and (eq 0 depth) first last)
\r
854 -;; (push "─" tree-status)) choice between this and next line is matter of taste.
\r
855 - (push " " tree-status))
\r
856 - ((and (eq 0 depth) first (not last))
\r
857 - (push "┬" tree-status))
\r
858 - ((and (eq 0 depth) (not first) last)
\r
859 - (push "╰" tree-status))
\r
860 - ((and (eq 0 depth) (not first) (not last))
\r
861 - (push "├" tree-status)))
\r
863 - (push (concat (if replies "┬" "─") "►") tree-status)
\r
864 - (plist-put msg :first (and first (eq 0 depth)))
\r
865 - (notmuch-pick-goto-and-insert-msg (plist-put msg :tree-status tree-status))
\r
866 - (pop tree-status)
\r
867 - (pop tree-status)
\r
870 - (push " " tree-status)
\r
871 - (push "│" tree-status))
\r
873 - (notmuch-pick-insert-thread replies (1+ depth) tree-status)))
\r
875 -(defun notmuch-pick-insert-thread (thread depth tree-status)
\r
876 - "Insert the collection of sibling sub-threads THREAD at depth DEPTH in the current forest."
\r
877 - (let ((n (length thread)))
\r
878 - (loop for tree in thread
\r
879 - for count from 1 to n
\r
881 - do (notmuch-pick-insert-tree tree depth tree-status (eq count 1) (eq count n)))))
\r
883 -(defun notmuch-pick-insert-forest-thread (forest-thread)
\r
884 - "Insert a single complete thread."
\r
885 - (let (tree-status)
\r
886 - ;; Reset at the start of each main thread.
\r
887 - (setq notmuch-pick-previous-subject nil)
\r
888 - (notmuch-pick-insert-thread forest-thread 0 tree-status)))
\r
890 -(defun notmuch-pick-insert-forest (forest)
\r
891 - "Insert a forest of threads.
\r
893 -This function inserts a collection of several complete threads as
\r
894 -passed to it by notmuch-pick-process-filter."
\r
895 - (mapc 'notmuch-pick-insert-forest-thread forest))
\r
897 -(defun notmuch-pick-mode ()
\r
898 - "Major mode displaying messages (as opposed to threads) of of a notmuch search.
\r
900 -This buffer contains the results of a \"notmuch pick\" of your
\r
901 -email archives. Each line in the buffer represents a single
\r
902 -message giving the relative date, the author, subject, and any
\r
905 -Pressing \\[notmuch-pick-show-message] on any line displays that message.
\r
907 -Complete list of currently available key bindings:
\r
909 -\\{notmuch-pick-mode-map}"
\r
912 - (kill-all-local-variables)
\r
913 - (setq notmuch-buffer-refresh-function #'notmuch-pick-refresh-view)
\r
914 - (use-local-map notmuch-pick-mode-map)
\r
915 - (setq major-mode 'notmuch-pick-mode
\r
916 - mode-name "notmuch-pick")
\r
918 - (setq buffer-read-only t
\r
919 - truncate-lines t))
\r
921 -(defun notmuch-pick-process-sentinel (proc msg)
\r
922 - "Add a message to let user know when \"notmuch pick\" exits"
\r
923 - (let ((buffer (process-buffer proc))
\r
924 - (status (process-status proc))
\r
925 - (exit-status (process-exit-status proc))
\r
926 - (never-found-target-thread nil))
\r
927 - (when (memq status '(exit signal))
\r
928 - (kill-buffer (process-get proc 'parse-buf))
\r
929 - (if (buffer-live-p buffer)
\r
930 - (with-current-buffer buffer
\r
932 - (let ((inhibit-read-only t)
\r
934 - (goto-char (point-max))
\r
935 - (if (eq status 'signal)
\r
936 - (insert "Incomplete search results (pick process was killed).\n"))
\r
937 - (when (eq status 'exit)
\r
938 - (insert "End of search results.")
\r
939 - (unless (= exit-status 0)
\r
940 - (insert (format " (process returned %d)" exit-status)))
\r
941 - (insert "\n")))))))))
\r
943 -(defun notmuch-pick-process-filter (proc string)
\r
944 - "Process and filter the output of \"notmuch show\" (for pick)"
\r
945 - (let ((results-buf (process-buffer proc))
\r
946 - (parse-buf (process-get proc 'parse-buf))
\r
947 - (inhibit-read-only t)
\r
949 - (if (not (buffer-live-p results-buf))
\r
950 - (delete-process proc)
\r
951 - (with-current-buffer parse-buf
\r
952 - ;; Insert new data
\r
954 - (goto-char (point-max))
\r
956 - (notmuch-sexp-parse-partial-list 'notmuch-pick-insert-forest-thread
\r
959 -(defun notmuch-pick-worker (basic-query &optional query-context target open-target)
\r
960 - "Insert the actual pick search in the current buffer.
\r
962 -This is is a helper function for notmuch-pick. The arguments are
\r
963 -the same as for the function notmuch-pick."
\r
965 - (notmuch-pick-mode)
\r
966 - (setq notmuch-pick-basic-query basic-query)
\r
967 - (setq notmuch-pick-query-context query-context)
\r
968 - (setq notmuch-pick-target-msg target)
\r
969 - (setq notmuch-pick-open-target open-target)
\r
972 - (goto-char (point-min))
\r
973 - (let* ((search-args (concat basic-query
\r
974 - (if query-context (concat " and (" query-context ")"))
\r
976 - (message-arg "--entire-thread"))
\r
977 - (if (equal (car (process-lines notmuch-command "count" search-args)) "0")
\r
978 - (setq search-args basic-query))
\r
979 - (let ((proc (notmuch-start-notmuch
\r
980 - "notmuch-pick" (current-buffer) #'notmuch-pick-process-sentinel
\r
981 - "show" "--body=false" "--format=sexp"
\r
982 - message-arg search-args))
\r
983 - ;; Use a scratch buffer to accumulate partial output.
\r
984 - ;; This buffer will be killed by the sentinel, which
\r
985 - ;; should be called no matter how the process dies.
\r
986 - (parse-buf (generate-new-buffer " *notmuch pick parse*")))
\r
987 - (process-put proc 'parse-buf parse-buf)
\r
988 - (set-process-filter proc 'notmuch-pick-process-filter)
\r
989 - (set-process-query-on-exit-flag proc nil))))
\r
991 -(defun notmuch-pick (&optional query query-context target buffer-name open-target)
\r
992 - "Run notmuch pick with the given `query' and display the results.
\r
994 -The arguments are:
\r
995 - QUERY: the main query. This can be any query but in many cases will be
\r
996 - a single thread. If nil this is read interactively from the minibuffer.
\r
997 - QUERY-CONTEXT: is an additional term for the query. The query used
\r
998 - is QUERY and QUERY-CONTEXT unless that does not match any messages
\r
999 - in which case we fall back to just QUERY.
\r
1000 - TARGET: A message ID (with the id: prefix) that will be made
\r
1001 - current if it appears in the pick results.
\r
1002 - BUFFER-NAME: the name of the buffer to show the pick tree. If
\r
1003 - it is nil \"*notmuch-pick\" followed by QUERY is used.
\r
1004 - OPEN-TARGET: If TRUE open the target message in the message pane."
\r
1006 - (if (null query)
\r
1007 - (setq query (notmuch-read-query "Notmuch pick: ")))
\r
1008 - (let ((buffer (get-buffer-create (generate-new-buffer-name
\r
1010 - (concat "*notmuch-pick-" query "*")))))
\r
1011 - (inhibit-read-only t))
\r
1013 - (switch-to-buffer buffer))
\r
1014 - ;; Don't track undo information for this buffer
\r
1015 - (set 'buffer-undo-list t)
\r
1017 - (notmuch-pick-worker query query-context target open-target)
\r
1019 - (setq truncate-lines t))
\r
1022 -;; Set up key bindings from the rest of notmuch.
\r
1023 -(define-key notmuch-common-keymap "z" 'notmuch-pick)
\r
1024 -(define-key notmuch-search-mode-map "Z" 'notmuch-pick-from-search-current-query)
\r
1025 -(define-key notmuch-show-mode-map "Z" 'notmuch-pick-from-show-current-query)
\r
1026 -(message "Initialised notmuch-pick")
\r
1028 -(provide 'notmuch-pick)
\r
1029 diff --git a/emacs/notmuch-pick.el b/emacs/notmuch-pick.el
\r
1030 new file mode 100644
\r
1031 index 0000000..a492214
\r
1033 +++ b/emacs/notmuch-pick.el
\r
1035 +;; notmuch-pick.el --- displaying notmuch forests.
\r
1037 +;; Copyright © Carl Worth
\r
1038 +;; Copyright © David Edmondson
\r
1039 +;; Copyright © Mark Walters
\r
1041 +;; This file is part of Notmuch.
\r
1043 +;; Notmuch is free software: you can redistribute it and/or modify it
\r
1044 +;; under the terms of the GNU General Public License as published by
\r
1045 +;; the Free Software Foundation, either version 3 of the License, or
\r
1046 +;; (at your option) any later version.
\r
1048 +;; Notmuch is distributed in the hope that it will be useful, but
\r
1049 +;; WITHOUT ANY WARRANTY; without even the implied warranty of
\r
1050 +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
\r
1051 +;; General Public License for more details.
\r
1053 +;; You should have received a copy of the GNU General Public License
\r
1054 +;; along with Notmuch. If not, see <http://www.gnu.org/licenses/>.
\r
1056 +;; Authors: David Edmondson <dme@dme.org>
\r
1057 +;; Mark Walters <markwalters1009@gmail.com>
\r
1059 +(require 'mail-parse)
\r
1061 +(require 'notmuch-lib)
\r
1062 +(require 'notmuch-query)
\r
1063 +(require 'notmuch-show)
\r
1064 +(require 'notmuch) ;; XXX ATM, as notmuch-search-mode-map is defined here
\r
1066 +(eval-when-compile (require 'cl))
\r
1068 +(declare-function notmuch-call-notmuch-process "notmuch" (&rest args))
\r
1069 +(declare-function notmuch-show "notmuch-show" (&rest args))
\r
1070 +(declare-function notmuch-tag "notmuch" (query &rest tags))
\r
1071 +(declare-function notmuch-show-strip-re "notmuch-show" (subject))
\r
1072 +(declare-function notmuch-show-spaces-n "notmuch-show" (n))
\r
1073 +(declare-function notmuch-read-query "notmuch" (prompt))
\r
1074 +(declare-function notmuch-read-tag-changes "notmuch" (&optional initial-input &rest search-terms))
\r
1075 +(declare-function notmuch-update-tags "notmuch" (current-tags tag-changes))
\r
1076 +(declare-function notmuch-hello-trim "notmuch-hello" (search))
\r
1077 +(declare-function notmuch-search-find-thread-id "notmuch" ())
\r
1078 +(declare-function notmuch-search-find-subject "notmuch" ())
\r
1080 +;; the following variable is defined in notmuch.el
\r
1081 +(defvar notmuch-search-query-string)
\r
1083 +(defgroup notmuch-pick nil
\r
1084 + "Showing message and thread structure."
\r
1085 + :group 'notmuch)
\r
1087 +(defcustom notmuch-pick-show-out nil
\r
1088 + "View selected messages in new window rather than split-pane."
\r
1090 + :group 'notmuch-pick)
\r
1092 +(defcustom notmuch-pick-result-format
\r
1093 + `(("date" . "%12s ")
\r
1094 + ("authors" . "%-20s")
\r
1095 + ((("tree" . "%s")("subject" . "%s")) ." %-54s ")
\r
1096 + ("tags" . "(%s)"))
\r
1097 + "Result formatting for Pick. Supported fields are: date,
\r
1098 + authors, subject, tree, tags. Tree means the thread tree
\r
1099 + box graphics. The field may also be a list in which case
\r
1100 + the formatting rules are applied recursively and then the
\r
1101 + output of all the fields in the list is inserted
\r
1102 + according to format-string.
\r
1104 +Note the author string should not contain
\r
1105 + whitespace (put it in the neighbouring fields instead).
\r
1107 + (setq notmuch-pick-result-format \(\(\"authors\" . \"%-40s\"\)
\r
1108 + \(\"subject\" . \"%s\"\)\)\)"
\r
1109 + :type '(alist :key-type (string) :value-type (string))
\r
1110 + :group 'notmuch-pick)
\r
1112 +;; Faces for messages that match the query.
\r
1113 +(defface notmuch-pick-match-date-face
\r
1114 + '((t :inherit default))
\r
1115 + "Face used in pick mode for the date in messages matching the query."
\r
1116 + :group 'notmuch-pick
\r
1117 + :group 'notmuch-faces)
\r
1119 +(defface notmuch-pick-match-author-face
\r
1120 + '((((class color)
\r
1121 + (background dark))
\r
1122 + (:foreground "OliveDrab1"))
\r
1124 + (background light))
\r
1125 + (:foreground "dark blue"))
\r
1128 + "Face used in pick mode for the date in messages matching the query."
\r
1129 + :group 'notmuch-pick
\r
1130 + :group 'notmuch-faces)
\r
1132 +(defface notmuch-pick-match-subject-face
\r
1133 + '((t :inherit default))
\r
1134 + "Face used in pick mode for the subject in messages matching the query."
\r
1135 + :group 'notmuch-pick
\r
1136 + :group 'notmuch-faces)
\r
1138 +(defface notmuch-pick-match-tree-face
\r
1139 + '((t :inherit default))
\r
1140 + "Face used in pick mode for the thread tree block graphics in messages matching the query."
\r
1141 + :group 'notmuch-pick
\r
1142 + :group 'notmuch-faces)
\r
1144 +(defface notmuch-pick-match-tag-face
\r
1145 + '((((class color)
\r
1146 + (background dark))
\r
1147 + (:foreground "OliveDrab1"))
\r
1149 + (background light))
\r
1150 + (:foreground "navy blue" :bold t))
\r
1153 + "Face used in pick mode for tags in messages matching the query."
\r
1154 + :group 'notmuch-pick
\r
1155 + :group 'notmuch-faces)
\r
1157 +;; Faces for messages that do not match the query.
\r
1158 +(defface notmuch-pick-no-match-date-face
\r
1159 + '((t (:foreground "gray")))
\r
1160 + "Face used in pick mode for non-matching dates."
\r
1161 + :group 'notmuch-pick
\r
1162 + :group 'notmuch-faces)
\r
1164 +(defface notmuch-pick-no-match-subject-face
\r
1165 + '((t (:foreground "gray")))
\r
1166 + "Face used in pick mode for non-matching subjects."
\r
1167 + :group 'notmuch-pick
\r
1168 + :group 'notmuch-faces)
\r
1170 +(defface notmuch-pick-no-match-tree-face
\r
1171 + '((t (:foreground "gray")))
\r
1172 + "Face used in pick mode for the thread tree block graphics in messages matching the query."
\r
1173 + :group 'notmuch-pick
\r
1174 + :group 'notmuch-faces)
\r
1176 +(defface notmuch-pick-no-match-author-face
\r
1177 + '((t (:foreground "gray")))
\r
1178 + "Face used in pick mode for the date in messages matching the query."
\r
1179 + :group 'notmuch-pick
\r
1180 + :group 'notmuch-faces)
\r
1182 +(defface notmuch-pick-no-match-tag-face
\r
1183 + '((t (:foreground "gray")))
\r
1184 + "Face used in pick mode face for non-matching tags."
\r
1185 + :group 'notmuch-pick
\r
1186 + :group 'notmuch-faces)
\r
1188 +(defvar notmuch-pick-previous-subject
\r
1189 + "The subject of the most recent result shown during the async display")
\r
1190 +(make-variable-buffer-local 'notmuch-pick-previous-subject)
\r
1192 +(defvar notmuch-pick-basic-query nil
\r
1193 + "A buffer local copy of argument query to the function notmuch-pick")
\r
1194 +(make-variable-buffer-local 'notmuch-pick-basic-query)
\r
1196 +(defvar notmuch-pick-query-context nil
\r
1197 + "A buffer local copy of argument query-context to the function notmuch-pick")
\r
1198 +(make-variable-buffer-local 'notmuch-pick-query-context)
\r
1200 +(defvar notmuch-pick-target-msg nil
\r
1201 + "A buffer local copy of argument target to the function notmuch-pick")
\r
1202 +(make-variable-buffer-local 'notmuch-pick-target-msg)
\r
1204 +(defvar notmuch-pick-open-target nil
\r
1205 + "A buffer local copy of argument open-target to the function notmuch-pick")
\r
1206 +(make-variable-buffer-local 'notmuch-pick-open-target)
\r
1208 +(defvar notmuch-pick-message-window nil
\r
1209 + "The window of the message pane.
\r
1211 +It is set in both the pick buffer and the child show buffer. It
\r
1212 +is used to try and close the message pane when quitting pick or
\r
1213 +the child show buffer.")
\r
1214 +(make-variable-buffer-local 'notmuch-pick-message-window)
\r
1215 +(put 'notmuch-pick-message-window 'permanent-local t)
\r
1217 +(defvar notmuch-pick-message-buffer nil
\r
1218 + "The buffer name of the show buffer in the message pane.
\r
1220 +This is used to try and make sure we don't close the message pane
\r
1221 +if the user has loaded a different buffer in that window.")
\r
1222 +(make-variable-buffer-local 'notmuch-pick-message-buffer)
\r
1223 +(put 'notmuch-pick-message-buffer 'permanent-local t)
\r
1225 +(defun notmuch-pick-to-message-pane (func)
\r
1226 + "Execute FUNC in message pane.
\r
1228 +This function returns a function (so can be used as a keybinding)
\r
1229 +which executes function FUNC in the message pane if it is
\r
1230 +open (if the message pane is closed it does nothing)."
\r
1232 + ,(concat "(In message pane) " (documentation func t))
\r
1234 + (when (window-live-p notmuch-pick-message-window)
\r
1235 + (with-selected-window notmuch-pick-message-window
\r
1236 + (call-interactively #',func)))))
\r
1238 +(defun notmuch-pick-button-activate (&optional button)
\r
1239 + "Activate BUTTON or button at point
\r
1241 +This function does not give an error if there is no button."
\r
1243 + (let ((button (or button (button-at (point)))))
\r
1244 + (when button (button-activate button))))
\r
1246 +(defun notmuch-pick-close-message-pane-and (func)
\r
1247 + "Close message pane and execute FUNC.
\r
1249 +This function returns a function (so can be used as a keybinding)
\r
1250 +which closes the message pane if open and then executes function
\r
1253 + ,(concat "(Close message pane and) " (documentation func t))
\r
1255 + (notmuch-pick-close-message-window)
\r
1256 + (call-interactively #',func)))
\r
1258 +(defvar notmuch-pick-mode-map
\r
1259 + (let ((map (make-sparse-keymap)))
\r
1260 + (set-keymap-parent map notmuch-common-keymap)
\r
1261 + ;; The following override the global keymap.
\r
1262 + ;; Override because we want to close message pane first.
\r
1263 + (define-key map "?" (notmuch-pick-close-message-pane-and #'notmuch-help))
\r
1264 + ;; Override because we first close message pane and then close pick buffer.
\r
1265 + (define-key map "q" 'notmuch-pick-quit)
\r
1266 + ;; Override because we close message pane after the search query is entered.
\r
1267 + (define-key map "s" 'notmuch-pick-to-search)
\r
1268 + ;; Override because we want to close message pane first.
\r
1269 + (define-key map "m" (notmuch-pick-close-message-pane-and #'notmuch-mua-new-mail))
\r
1271 + ;; these use notmuch-show functions directly
\r
1272 + (define-key map "|" 'notmuch-show-pipe-message)
\r
1273 + (define-key map "w" 'notmuch-show-save-attachments)
\r
1274 + (define-key map "v" 'notmuch-show-view-all-mime-parts)
\r
1275 + (define-key map "c" 'notmuch-show-stash-map)
\r
1277 + ;; these apply to the message pane
\r
1278 + (define-key map (kbd "M-TAB") (notmuch-pick-to-message-pane #'notmuch-show-previous-button))
\r
1279 + (define-key map (kbd "<backtab>") (notmuch-pick-to-message-pane #'notmuch-show-previous-button))
\r
1280 + (define-key map (kbd "TAB") (notmuch-pick-to-message-pane #'notmuch-show-next-button))
\r
1281 + (define-key map "e" (notmuch-pick-to-message-pane #'notmuch-pick-button-activate))
\r
1283 + ;; bindings from show (or elsewhere) but we close the message pane first.
\r
1284 + (define-key map "f" (notmuch-pick-close-message-pane-and #'notmuch-show-forward-message))
\r
1285 + (define-key map "r" (notmuch-pick-close-message-pane-and #'notmuch-show-reply-sender))
\r
1286 + (define-key map "R" (notmuch-pick-close-message-pane-and #'notmuch-show-reply))
\r
1287 + (define-key map "V" (notmuch-pick-close-message-pane-and #'notmuch-show-view-raw-message))
\r
1289 + ;; The main pick bindings
\r
1290 + (define-key map (kbd "RET") 'notmuch-pick-show-message)
\r
1291 + (define-key map [mouse-1] 'notmuch-pick-show-message)
\r
1292 + (define-key map "x" 'notmuch-pick-quit)
\r
1293 + (define-key map "A" 'notmuch-pick-archive-thread)
\r
1294 + (define-key map "a" 'notmuch-pick-archive-message-then-next)
\r
1295 + (define-key map "=" 'notmuch-pick-refresh-view)
\r
1296 + (define-key map "z" 'notmuch-pick-to-pick)
\r
1297 + (define-key map "n" 'notmuch-pick-next-matching-message)
\r
1298 + (define-key map "p" 'notmuch-pick-prev-matching-message)
\r
1299 + (define-key map "N" 'notmuch-pick-next-message)
\r
1300 + (define-key map "P" 'notmuch-pick-prev-message)
\r
1301 + (define-key map (kbd "M-p") 'notmuch-pick-prev-thread)
\r
1302 + (define-key map (kbd "M-n") 'notmuch-pick-next-thread)
\r
1303 + (define-key map "-" 'notmuch-pick-remove-tag)
\r
1304 + (define-key map "+" 'notmuch-pick-add-tag)
\r
1305 + (define-key map "*" 'notmuch-pick-tag-thread)
\r
1306 + (define-key map " " 'notmuch-pick-scroll-or-next)
\r
1307 + (define-key map "b" 'notmuch-pick-scroll-message-window-back)
\r
1309 +(fset 'notmuch-pick-mode-map notmuch-pick-mode-map)
\r
1311 +(defun notmuch-pick-get-message-properties ()
\r
1312 + "Return the properties of the current message as a plist.
\r
1314 +Some useful entries are:
\r
1315 +:headers - Property list containing the headers :Date, :Subject, :From, etc.
\r
1316 +:tags - Tags for this message"
\r
1318 + (beginning-of-line)
\r
1319 + (get-text-property (point) :notmuch-message-properties)))
\r
1321 +;; XXX This should really be a lib function but we are trying to
\r
1322 +;; reduce impact on the code base.
\r
1323 +(defun notmuch-show-get-prop (prop &optional props)
\r
1324 + "This is a pick overridden version of notmuch-show-get-prop
\r
1326 +It gets property PROP from PROPS or, if PROPS is nil, the current
\r
1327 +message in either pick or show. This means that several functions
\r
1328 +in notmuch-show now work unchanged in pick as they just need the
\r
1329 +correct message properties."
\r
1330 + (let ((props (or props
\r
1331 + (cond ((eq major-mode 'notmuch-show-mode)
\r
1332 + (notmuch-show-get-message-properties))
\r
1333 + ((eq major-mode 'notmuch-pick-mode)
\r
1334 + (notmuch-pick-get-message-properties))))))
\r
1335 + (plist-get props prop)))
\r
1337 +(defun notmuch-pick-set-message-properties (props)
\r
1339 + (beginning-of-line)
\r
1340 + (put-text-property (point) (+ (point) 1) :notmuch-message-properties props)))
\r
1342 +(defun notmuch-pick-set-prop (prop val &optional props)
\r
1343 + (let ((inhibit-read-only t)
\r
1344 + (props (or props
\r
1345 + (notmuch-pick-get-message-properties))))
\r
1346 + (plist-put props prop val)
\r
1347 + (notmuch-pick-set-message-properties props)))
\r
1349 +(defun notmuch-pick-get-prop (prop &optional props)
\r
1350 + (let ((props (or props
\r
1351 + (notmuch-pick-get-message-properties))))
\r
1352 + (plist-get props prop)))
\r
1354 +(defun notmuch-pick-set-tags (tags)
\r
1355 + "Set the tags of the current message."
\r
1356 + (notmuch-pick-set-prop :tags tags))
\r
1358 +(defun notmuch-pick-get-tags ()
\r
1359 + "Return the tags of the current message."
\r
1360 + (notmuch-pick-get-prop :tags))
\r
1362 +(defun notmuch-pick-get-message-id ()
\r
1363 + "Return the message id of the current message."
\r
1364 + (let ((id (notmuch-pick-get-prop :id)))
\r
1366 + (notmuch-id-to-query id)
\r
1369 +(defun notmuch-pick-get-match ()
\r
1370 + "Return whether the current message is a match."
\r
1372 + (notmuch-pick-get-prop :match))
\r
1374 +(defun notmuch-pick-refresh-result ()
\r
1375 + "Redisplay the current message line.
\r
1377 +This redisplays the current line based on the messages
\r
1378 +properties (as they are now). This is used when tags are
\r
1380 + (let ((init-point (point))
\r
1381 + (end (line-end-position))
\r
1382 + (msg (notmuch-pick-get-message-properties))
\r
1383 + (inhibit-read-only t))
\r
1384 + (beginning-of-line)
\r
1385 + ;; This is a little tricky: we override
\r
1386 + ;; notmuch-pick-previous-subject to get the decision between
\r
1387 + ;; ... and a subject right and it stops notmuch-pick-insert-msg
\r
1388 + ;; from overwriting the buffer local copy of
\r
1389 + ;; notmuch-pick-previous-subject if this is called while the
\r
1390 + ;; buffer is displaying.
\r
1391 + (let ((notmuch-pick-previous-subject (notmuch-pick-get-prop :previous-subject)))
\r
1392 + (delete-region (point) (1+ (line-end-position)))
\r
1393 + (notmuch-pick-insert-msg msg))
\r
1394 + (let ((new-end (line-end-position)))
\r
1395 + (goto-char (if (= init-point end)
\r
1397 + (min init-point (- new-end 1)))))))
\r
1399 +(defun notmuch-pick-tag-update-display (&optional tag-changes)
\r
1400 + "Update display for TAG-CHANGES to current message.
\r
1402 +Does NOT change the database."
\r
1403 + (let* ((current-tags (notmuch-pick-get-tags))
\r
1404 + (new-tags (notmuch-update-tags current-tags tag-changes)))
\r
1405 + (unless (equal current-tags new-tags)
\r
1406 + (notmuch-pick-set-tags new-tags)
\r
1407 + (notmuch-pick-refresh-result))))
\r
1409 +(defun notmuch-pick-tag (&optional tag-changes)
\r
1410 + "Change tags for the current message"
\r
1412 + (setq tag-changes (notmuch-tag (notmuch-pick-get-message-id) tag-changes))
\r
1413 + (notmuch-pick-tag-update-display tag-changes))
\r
1415 +(defun notmuch-pick-add-tag ()
\r
1416 + "Same as `notmuch-pick-tag' but sets initial input to '+'."
\r
1418 + (notmuch-pick-tag "+"))
\r
1420 +(defun notmuch-pick-remove-tag ()
\r
1421 + "Same as `notmuch-pick-tag' but sets initial input to '-'."
\r
1423 + (notmuch-pick-tag "-"))
\r
1425 +;; The next two functions close the message window before searching or
\r
1426 +;; picking but they do so after the user has entered the query (in
\r
1427 +;; case the user was basing the query on something in the message
\r
1430 +(defun notmuch-pick-to-search ()
\r
1431 + "Run \"notmuch search\" with the given `query' and display results."
\r
1433 + (let ((query (notmuch-read-query "Notmuch search: ")))
\r
1434 + (notmuch-pick-close-message-window)
\r
1435 + (notmuch-search query)))
\r
1437 +(defun notmuch-pick-to-pick ()
\r
1438 + "Run a query and display results in experimental notmuch-pick mode"
\r
1440 + (let ((query (notmuch-read-query "Notmuch pick: ")))
\r
1441 + (notmuch-pick-close-message-window)
\r
1442 + (notmuch-pick query)))
\r
1444 +;; This function should be in notmuch-show.el but be we trying to
\r
1445 +;; minimise impact on the rest of the codebase.
\r
1446 +(defun notmuch-pick-from-show-current-query ()
\r
1447 + "Call notmuch pick with the current query"
\r
1449 + (notmuch-pick notmuch-show-thread-id
\r
1450 + notmuch-show-query-context
\r
1451 + (notmuch-show-get-message-id)))
\r
1453 +;; This function should be in notmuch.el but be we trying to minimise
\r
1454 +;; impact on the rest of the codebase.
\r
1455 +(defun notmuch-pick-from-search-current-query ()
\r
1456 + "Call notmuch pick with the current query"
\r
1458 + (notmuch-pick notmuch-search-query-string))
\r
1460 +;; This function should be in notmuch.el but be we trying to minimise
\r
1461 +;; impact on the rest of the codebase.
\r
1462 +(defun notmuch-pick-from-search-thread ()
\r
1463 + "Show the selected thread with notmuch-pick"
\r
1465 + (notmuch-pick (notmuch-search-find-thread-id)
\r
1466 + notmuch-search-query-string
\r
1468 + (notmuch-prettify-subject (notmuch-search-find-subject))
\r
1471 +(defun notmuch-pick-message-window-kill-hook ()
\r
1472 + "Close the message pane when exiting the show buffer."
\r
1473 + (let ((buffer (current-buffer)))
\r
1474 + (when (and (window-live-p notmuch-pick-message-window)
\r
1475 + (eq (window-buffer notmuch-pick-message-window) buffer))
\r
1476 + ;; We do not want an error if this is the sole window in the
\r
1477 + ;; frame and I do not know how to test for that in emacs pre
\r
1478 + ;; 24. Hence we just ignore-errors.
\r
1480 + (delete-window notmuch-pick-message-window)))))
\r
1482 +(defun notmuch-pick-show-message-in ()
\r
1483 + "Show the current message (in split-pane)."
\r
1485 + (let ((id (notmuch-pick-get-message-id))
\r
1486 + (inhibit-read-only t)
\r
1489 + ;; We close and reopen the window to kill off un-needed buffers
\r
1490 + ;; this might cause flickering but seems ok.
\r
1491 + (notmuch-pick-close-message-window)
\r
1492 + (setq notmuch-pick-message-window
\r
1493 + (split-window-vertically (/ (window-height) 4)))
\r
1494 + (with-selected-window notmuch-pick-message-window
\r
1495 + ;; Since we are only displaying one message do not indent.
\r
1496 + (let ((notmuch-show-indent-messages-width 0)
\r
1497 + (notmuch-show-only-matching-messages t))
\r
1498 + (setq buffer (notmuch-show id))))
\r
1499 + ;; We need the `let' as notmuch-pick-message-window is buffer local.
\r
1500 + (let ((window notmuch-pick-message-window))
\r
1501 + (with-current-buffer buffer
\r
1502 + (setq notmuch-pick-message-window window)
\r
1503 + (add-hook 'kill-buffer-hook 'notmuch-pick-message-window-kill-hook)))
\r
1504 + (when notmuch-show-mark-read-tags
\r
1505 + (notmuch-pick-tag-update-display notmuch-show-mark-read-tags))
\r
1506 + (setq notmuch-pick-message-buffer buffer))))
\r
1508 +(defun notmuch-pick-show-message-out ()
\r
1509 + "Show the current message (in whole window)."
\r
1511 + (let ((id (notmuch-pick-get-message-id))
\r
1512 + (inhibit-read-only t)
\r
1515 + ;; We close the window to kill off un-needed buffers.
\r
1516 + (notmuch-pick-close-message-window)
\r
1517 + (notmuch-show id))))
\r
1519 +(defun notmuch-pick-show-message (arg)
\r
1520 + "Show the current message.
\r
1522 +Shows in split pane or whole window according to value of
\r
1523 +`notmuch-pick-show-out'. A prefix argument reverses the choice."
\r
1524 + (interactive "P")
\r
1525 + (if (or (and notmuch-pick-show-out (not arg))
\r
1526 + (and (not notmuch-pick-show-out) arg))
\r
1527 + (notmuch-pick-show-message-out)
\r
1528 + (notmuch-pick-show-message-in)))
\r
1530 +(defun notmuch-pick-scroll-message-window ()
\r
1531 + "Scroll the message window (if it exists)"
\r
1533 + (when (window-live-p notmuch-pick-message-window)
\r
1534 + (with-selected-window notmuch-pick-message-window
\r
1535 + (if (pos-visible-in-window-p (point-max))
\r
1539 +(defun notmuch-pick-scroll-message-window-back ()
\r
1540 + "Scroll the message window back(if it exists)"
\r
1542 + (when (window-live-p notmuch-pick-message-window)
\r
1543 + (with-selected-window notmuch-pick-message-window
\r
1544 + (if (pos-visible-in-window-p (point-min))
\r
1546 + (scroll-down)))))
\r
1548 +(defun notmuch-pick-scroll-or-next ()
\r
1549 + "Scroll the message window. If it at end go to next message."
\r
1551 + (when (notmuch-pick-scroll-message-window)
\r
1552 + (notmuch-pick-next-matching-message)))
\r
1554 +(defun notmuch-pick-quit ()
\r
1555 + "Close the split view or exit pick."
\r
1557 + (unless (notmuch-pick-close-message-window)
\r
1558 + (kill-buffer (current-buffer))))
\r
1560 +(defun notmuch-pick-close-message-window ()
\r
1561 + "Close the message-window. Return t if close succeeds."
\r
1563 + (when (and (window-live-p notmuch-pick-message-window)
\r
1564 + (eq (window-buffer notmuch-pick-message-window) notmuch-pick-message-buffer))
\r
1565 + (delete-window notmuch-pick-message-window)
\r
1566 + (unless (get-buffer-window-list notmuch-pick-message-buffer)
\r
1567 + (kill-buffer notmuch-pick-message-buffer))
\r
1570 +(defun notmuch-pick-archive-message (&optional unarchive)
\r
1571 + "Archive the current message.
\r
1573 +Archive the current message by applying the tag changes in
\r
1574 +`notmuch-archive-tags' to it. If a prefix argument is given, the
\r
1575 +message will be \"unarchived\", i.e. the tag changes in
\r
1576 +`notmuch-archive-tags' will be reversed."
\r
1577 + (interactive "P")
\r
1578 + (when notmuch-archive-tags
\r
1579 + (apply 'notmuch-pick-tag
\r
1580 + (notmuch-tag-change-list notmuch-archive-tags unarchive))))
\r
1582 +(defun notmuch-pick-archive-message-then-next (&optional unarchive)
\r
1583 + "Archive the current message and move to next matching message."
\r
1584 + (interactive "P")
\r
1585 + (notmuch-pick-archive-message unarchive)
\r
1586 + (notmuch-pick-next-matching-message))
\r
1588 +(defun notmuch-pick-next-message ()
\r
1589 + "Move to next message."
\r
1592 + (when (window-live-p notmuch-pick-message-window)
\r
1593 + (notmuch-pick-show-message-in)))
\r
1595 +(defun notmuch-pick-prev-message ()
\r
1596 + "Move to previous message."
\r
1598 + (forward-line -1)
\r
1599 + (when (window-live-p notmuch-pick-message-window)
\r
1600 + (notmuch-pick-show-message-in)))
\r
1602 +(defun notmuch-pick-prev-matching-message ()
\r
1603 + "Move to previous matching message."
\r
1605 + (forward-line -1)
\r
1606 + (while (and (not (bobp)) (not (notmuch-pick-get-match)))
\r
1607 + (forward-line -1))
\r
1608 + (when (window-live-p notmuch-pick-message-window)
\r
1609 + (notmuch-pick-show-message-in)))
\r
1611 +(defun notmuch-pick-next-matching-message ()
\r
1612 + "Move to next matching message."
\r
1615 + (while (and (not (eobp)) (not (notmuch-pick-get-match)))
\r
1617 + (when (window-live-p notmuch-pick-message-window)
\r
1618 + (notmuch-pick-show-message-in)))
\r
1620 +(defun notmuch-pick-refresh-view ()
\r
1623 + (let ((inhibit-read-only t)
\r
1624 + (basic-query notmuch-pick-basic-query)
\r
1625 + (query-context notmuch-pick-query-context)
\r
1626 + (target (notmuch-pick-get-message-id)))
\r
1628 + (notmuch-pick-worker basic-query
\r
1632 +(defun notmuch-pick-thread-top ()
\r
1633 + (when (notmuch-pick-get-message-properties)
\r
1634 + (while (not (or (notmuch-pick-get-prop :first) (eobp)))
\r
1635 + (forward-line -1))))
\r
1637 +(defun notmuch-pick-prev-thread ()
\r
1639 + (forward-line -1)
\r
1640 + (notmuch-pick-thread-top))
\r
1642 +(defun notmuch-pick-next-thread ()
\r
1644 + (forward-line 1)
\r
1645 + (while (not (or (notmuch-pick-get-prop :first) (eobp)))
\r
1646 + (forward-line 1)))
\r
1648 +(defun notmuch-pick-thread-mapcar (function)
\r
1649 + "Iterate through all messages in the current thread
\r
1650 + and call FUNCTION for side effects."
\r
1652 + (notmuch-pick-thread-top)
\r
1653 + (loop collect (funcall function)
\r
1654 + do (forward-line)
\r
1655 + while (and (notmuch-pick-get-message-properties)
\r
1656 + (not (notmuch-pick-get-prop :first))))))
\r
1658 +(defun notmuch-pick-get-messages-ids-thread-search ()
\r
1659 + "Return a search string for all message ids of messages in the current thread."
\r
1660 + (mapconcat 'identity
\r
1661 + (notmuch-pick-thread-mapcar 'notmuch-pick-get-message-id)
\r
1664 +(defun notmuch-pick-tag-thread (&optional tag-changes)
\r
1665 + "Tag all messages in the current thread"
\r
1667 + (when (notmuch-pick-get-message-properties)
\r
1668 + (let ((tag-changes (notmuch-tag (notmuch-pick-get-messages-ids-thread-search) tag-changes)))
\r
1669 + (notmuch-pick-thread-mapcar
\r
1670 + (lambda () (notmuch-pick-tag-update-display tag-changes))))))
\r
1672 +(defun notmuch-pick-archive-thread (&optional unarchive)
\r
1673 + "Archive each message in thread.
\r
1675 +Archive each message currently shown by applying the tag changes
\r
1676 +in `notmuch-archive-tags' to each. If a prefix argument is given,
\r
1677 +the messages will be \"unarchived\", i.e. the tag changes in
\r
1678 +`notmuch-archive-tags' will be reversed.
\r
1680 +Note: This command is safe from any race condition of new messages
\r
1681 +being delivered to the same thread. It does not archive the
\r
1682 +entire thread, but only the messages shown in the current
\r
1684 + (interactive "P")
\r
1685 + (when notmuch-archive-tags
\r
1686 + (notmuch-pick-tag-thread
\r
1687 + (notmuch-tag-change-list notmuch-archive-tags unarchive))))
\r
1689 +;; Functions below here display the pick buffer itself.
\r
1691 +(defun notmuch-pick-clean-address (address)
\r
1692 + "Try to clean a single email ADDRESS for display. Return
\r
1693 +AUTHOR_NAME if present, otherwise return AUTHOR_EMAIL. Return
\r
1694 +unchanged ADDRESS if parsing fails."
\r
1695 + (let* ((clean-address (notmuch-clean-address address))
\r
1696 + (p-address (car clean-address))
\r
1697 + (p-name (cdr clean-address)))
\r
1699 + ;; If we have a name return that otherwise return the address.
\r
1700 + (or p-name p-address)))
\r
1702 +(defun notmuch-pick-format-field (field format-string msg)
\r
1703 + "Format a FIELD of MSG according to FORMAT-STRING and return string"
\r
1704 + (let* ((headers (plist-get msg :headers))
\r
1705 + (match (plist-get msg :match)))
\r
1708 + (format format-string (notmuch-pick-format-field-list field msg)))
\r
1710 + ((string-equal field "date")
\r
1711 + (let ((face (if match
\r
1712 + 'notmuch-pick-match-date-face
\r
1713 + 'notmuch-pick-no-match-date-face)))
\r
1714 + (propertize (format format-string (plist-get msg :date_relative)) 'face face)))
\r
1716 + ((string-equal field "tree")
\r
1717 + (let ((tree-status (plist-get msg :tree-status))
\r
1719 + 'notmuch-pick-match-tree-face
\r
1720 + 'notmuch-pick-no-match-tree-face)))
\r
1722 + (propertize (format format-string
\r
1723 + (mapconcat #'identity (reverse tree-status) ""))
\r
1726 + ((string-equal field "subject")
\r
1727 + (let ((bare-subject (notmuch-show-strip-re (plist-get headers :Subject)))
\r
1728 + (previous-subject notmuch-pick-previous-subject)
\r
1730 + 'notmuch-pick-match-subject-face
\r
1731 + 'notmuch-pick-no-match-subject-face)))
\r
1733 + (setq notmuch-pick-previous-subject bare-subject)
\r
1734 + (propertize (format format-string
\r
1735 + (if (string= previous-subject bare-subject)
\r
1740 + ((string-equal field "authors")
\r
1741 + (let ((author (notmuch-pick-clean-address (plist-get headers :From)))
\r
1742 + (len (length (format format-string "")))
\r
1744 + 'notmuch-pick-match-author-face
\r
1745 + 'notmuch-pick-no-match-author-face)))
\r
1746 + (when (> (length author) len)
\r
1747 + (setq author (substring author 0 len)))
\r
1748 + (propertize (format format-string author) 'face face)))
\r
1750 + ((string-equal field "tags")
\r
1751 + (let ((tags (plist-get msg :tags))
\r
1753 + 'notmuch-pick-match-tag-face
\r
1754 + 'notmuch-pick-no-match-tag-face)))
\r
1755 + (propertize (format format-string
\r
1756 + (mapconcat #'identity tags ", "))
\r
1757 + 'face face))))))
\r
1760 +(defun notmuch-pick-format-field-list (field-list msg)
\r
1761 + "Format fields of MSG according to FIELD-LIST and return string"
\r
1762 + (let (result-string)
\r
1763 + (dolist (spec field-list result-string)
\r
1764 + (let ((field-string (notmuch-pick-format-field (car spec) (cdr spec) msg)))
\r
1765 + (setq result-string (concat result-string field-string))))))
\r
1767 +(defun notmuch-pick-insert-msg (msg)
\r
1768 + "Insert the message MSG according to notmuch-pick-result-format"
\r
1769 + ;; We need to save the previous subject as it will get overwritten
\r
1770 + ;; by the insert-field calls.
\r
1771 + (let ((previous-subject notmuch-pick-previous-subject))
\r
1772 + (insert (notmuch-pick-format-field-list notmuch-pick-result-format msg))
\r
1773 + (notmuch-pick-set-message-properties msg)
\r
1774 + (notmuch-pick-set-prop :previous-subject previous-subject)
\r
1777 +(defun notmuch-pick-goto-and-insert-msg (msg)
\r
1778 + "Insert msg at the end of the buffer. Move point to msg if it is the target"
\r
1780 + (goto-char (point-max))
\r
1781 + (notmuch-pick-insert-msg msg))
\r
1782 + (let ((msg-id (notmuch-id-to-query (plist-get msg :id)))
\r
1783 + (target notmuch-pick-target-msg))
\r
1784 + (when (or (and (not target) (plist-get msg :match))
\r
1785 + (string= msg-id target))
\r
1786 + (setq notmuch-pick-target-msg "found")
\r
1787 + (goto-char (point-max))
\r
1788 + (forward-line -1)
\r
1789 + (when notmuch-pick-open-target
\r
1790 + (notmuch-pick-show-message-in)))))
\r
1792 +(defun notmuch-pick-insert-tree (tree depth tree-status first last)
\r
1793 + "Insert the message tree TREE at depth DEPTH in the current thread.
\r
1795 +A message tree is another name for a single sub-thread: i.e., a
\r
1796 +message together with all its descendents."
\r
1797 + (let ((msg (car tree))
\r
1798 + (replies (cadr tree)))
\r
1801 + ((and (< 0 depth) (not last))
\r
1802 + (push "├" tree-status))
\r
1803 + ((and (< 0 depth) last)
\r
1804 + (push "╰" tree-status))
\r
1805 + ((and (eq 0 depth) first last)
\r
1806 +;; (push "─" tree-status)) choice between this and next line is matter of taste.
\r
1807 + (push " " tree-status))
\r
1808 + ((and (eq 0 depth) first (not last))
\r
1809 + (push "┬" tree-status))
\r
1810 + ((and (eq 0 depth) (not first) last)
\r
1811 + (push "╰" tree-status))
\r
1812 + ((and (eq 0 depth) (not first) (not last))
\r
1813 + (push "├" tree-status)))
\r
1815 + (push (concat (if replies "┬" "─") "►") tree-status)
\r
1816 + (plist-put msg :first (and first (eq 0 depth)))
\r
1817 + (notmuch-pick-goto-and-insert-msg (plist-put msg :tree-status tree-status))
\r
1818 + (pop tree-status)
\r
1819 + (pop tree-status)
\r
1822 + (push " " tree-status)
\r
1823 + (push "│" tree-status))
\r
1825 + (notmuch-pick-insert-thread replies (1+ depth) tree-status)))
\r
1827 +(defun notmuch-pick-insert-thread (thread depth tree-status)
\r
1828 + "Insert the collection of sibling sub-threads THREAD at depth DEPTH in the current forest."
\r
1829 + (let ((n (length thread)))
\r
1830 + (loop for tree in thread
\r
1831 + for count from 1 to n
\r
1833 + do (notmuch-pick-insert-tree tree depth tree-status (eq count 1) (eq count n)))))
\r
1835 +(defun notmuch-pick-insert-forest-thread (forest-thread)
\r
1836 + "Insert a single complete thread."
\r
1837 + (let (tree-status)
\r
1838 + ;; Reset at the start of each main thread.
\r
1839 + (setq notmuch-pick-previous-subject nil)
\r
1840 + (notmuch-pick-insert-thread forest-thread 0 tree-status)))
\r
1842 +(defun notmuch-pick-insert-forest (forest)
\r
1843 + "Insert a forest of threads.
\r
1845 +This function inserts a collection of several complete threads as
\r
1846 +passed to it by notmuch-pick-process-filter."
\r
1847 + (mapc 'notmuch-pick-insert-forest-thread forest))
\r
1849 +(defun notmuch-pick-mode ()
\r
1850 + "Major mode displaying messages (as opposed to threads) of of a notmuch search.
\r
1852 +This buffer contains the results of a \"notmuch pick\" of your
\r
1853 +email archives. Each line in the buffer represents a single
\r
1854 +message giving the relative date, the author, subject, and any
\r
1857 +Pressing \\[notmuch-pick-show-message] on any line displays that message.
\r
1859 +Complete list of currently available key bindings:
\r
1861 +\\{notmuch-pick-mode-map}"
\r
1864 + (kill-all-local-variables)
\r
1865 + (setq notmuch-buffer-refresh-function #'notmuch-pick-refresh-view)
\r
1866 + (use-local-map notmuch-pick-mode-map)
\r
1867 + (setq major-mode 'notmuch-pick-mode
\r
1868 + mode-name "notmuch-pick")
\r
1869 + (hl-line-mode 1)
\r
1870 + (setq buffer-read-only t
\r
1871 + truncate-lines t))
\r
1873 +(defun notmuch-pick-process-sentinel (proc msg)
\r
1874 + "Add a message to let user know when \"notmuch pick\" exits"
\r
1875 + (let ((buffer (process-buffer proc))
\r
1876 + (status (process-status proc))
\r
1877 + (exit-status (process-exit-status proc))
\r
1878 + (never-found-target-thread nil))
\r
1879 + (when (memq status '(exit signal))
\r
1880 + (kill-buffer (process-get proc 'parse-buf))
\r
1881 + (if (buffer-live-p buffer)
\r
1882 + (with-current-buffer buffer
\r
1884 + (let ((inhibit-read-only t)
\r
1886 + (goto-char (point-max))
\r
1887 + (if (eq status 'signal)
\r
1888 + (insert "Incomplete search results (pick process was killed).\n"))
\r
1889 + (when (eq status 'exit)
\r
1890 + (insert "End of search results.")
\r
1891 + (unless (= exit-status 0)
\r
1892 + (insert (format " (process returned %d)" exit-status)))
\r
1893 + (insert "\n")))))))))
\r
1895 +(defun notmuch-pick-process-filter (proc string)
\r
1896 + "Process and filter the output of \"notmuch show\" (for pick)"
\r
1897 + (let ((results-buf (process-buffer proc))
\r
1898 + (parse-buf (process-get proc 'parse-buf))
\r
1899 + (inhibit-read-only t)
\r
1901 + (if (not (buffer-live-p results-buf))
\r
1902 + (delete-process proc)
\r
1903 + (with-current-buffer parse-buf
\r
1904 + ;; Insert new data
\r
1906 + (goto-char (point-max))
\r
1907 + (insert string))
\r
1908 + (notmuch-sexp-parse-partial-list 'notmuch-pick-insert-forest-thread
\r
1909 + results-buf)))))
\r
1911 +(defun notmuch-pick-worker (basic-query &optional query-context target open-target)
\r
1912 + "Insert the actual pick search in the current buffer.
\r
1914 +This is is a helper function for notmuch-pick. The arguments are
\r
1915 +the same as for the function notmuch-pick."
\r
1917 + (notmuch-pick-mode)
\r
1918 + (setq notmuch-pick-basic-query basic-query)
\r
1919 + (setq notmuch-pick-query-context query-context)
\r
1920 + (setq notmuch-pick-target-msg target)
\r
1921 + (setq notmuch-pick-open-target open-target)
\r
1924 + (goto-char (point-min))
\r
1925 + (let* ((search-args (concat basic-query
\r
1926 + (if query-context (concat " and (" query-context ")"))
\r
1928 + (message-arg "--entire-thread"))
\r
1929 + (if (equal (car (process-lines notmuch-command "count" search-args)) "0")
\r
1930 + (setq search-args basic-query))
\r
1931 + (let ((proc (notmuch-start-notmuch
\r
1932 + "notmuch-pick" (current-buffer) #'notmuch-pick-process-sentinel
\r
1933 + "show" "--body=false" "--format=sexp"
\r
1934 + message-arg search-args))
\r
1935 + ;; Use a scratch buffer to accumulate partial output.
\r
1936 + ;; This buffer will be killed by the sentinel, which
\r
1937 + ;; should be called no matter how the process dies.
\r
1938 + (parse-buf (generate-new-buffer " *notmuch pick parse*")))
\r
1939 + (process-put proc 'parse-buf parse-buf)
\r
1940 + (set-process-filter proc 'notmuch-pick-process-filter)
\r
1941 + (set-process-query-on-exit-flag proc nil))))
\r
1943 +(defun notmuch-pick (&optional query query-context target buffer-name open-target)
\r
1944 + "Run notmuch pick with the given `query' and display the results.
\r
1946 +The arguments are:
\r
1947 + QUERY: the main query. This can be any query but in many cases will be
\r
1948 + a single thread. If nil this is read interactively from the minibuffer.
\r
1949 + QUERY-CONTEXT: is an additional term for the query. The query used
\r
1950 + is QUERY and QUERY-CONTEXT unless that does not match any messages
\r
1951 + in which case we fall back to just QUERY.
\r
1952 + TARGET: A message ID (with the id: prefix) that will be made
\r
1953 + current if it appears in the pick results.
\r
1954 + BUFFER-NAME: the name of the buffer to show the pick tree. If
\r
1955 + it is nil \"*notmuch-pick\" followed by QUERY is used.
\r
1956 + OPEN-TARGET: If TRUE open the target message in the message pane."
\r
1958 + (if (null query)
\r
1959 + (setq query (notmuch-read-query "Notmuch pick: ")))
\r
1960 + (let ((buffer (get-buffer-create (generate-new-buffer-name
\r
1962 + (concat "*notmuch-pick-" query "*")))))
\r
1963 + (inhibit-read-only t))
\r
1965 + (switch-to-buffer buffer))
\r
1966 + ;; Don't track undo information for this buffer
\r
1967 + (set 'buffer-undo-list t)
\r
1969 + (notmuch-pick-worker query query-context target open-target)
\r
1971 + (setq truncate-lines t))
\r
1974 +;; Set up key bindings from the rest of notmuch.
\r
1975 +(define-key notmuch-common-keymap "z" 'notmuch-pick)
\r
1976 +(define-key notmuch-search-mode-map "Z" 'notmuch-pick-from-search-current-query)
\r
1977 +(define-key notmuch-show-mode-map "Z" 'notmuch-pick-from-show-current-query)
\r
1978 +(message "Initialised notmuch-pick")
\r
1980 +(provide 'notmuch-pick)
\r
projects / notmuch-archives.git / blob