packaging: fedora: add ruby bindings
[notmuch] / contrib / notmuch-pick / notmuch-pick.el
1 ;; notmuch-pick.el --- displaying notmuch forests.
2 ;;
3 ;; Copyright © Carl Worth
4 ;; Copyright © David Edmondson
5 ;; Copyright © Mark Walters
6 ;;
7 ;; This file is part of Notmuch.
8 ;;
9 ;; Notmuch is free software: you can redistribute it and/or modify it
10 ;; under the terms of the GNU General Public License as published by
11 ;; the Free Software Foundation, either version 3 of the License, or
12 ;; (at your option) any later version.
13 ;;
14 ;; Notmuch is distributed in the hope that it will be useful, but
15 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
17 ;; General Public License for more details.
18 ;;
19 ;; You should have received a copy of the GNU General Public License
20 ;; along with Notmuch.  If not, see <http://www.gnu.org/licenses/>.
21 ;;
22 ;; Authors: David Edmondson <dme@dme.org>
23 ;;          Mark Walters <markwalters1009@gmail.com>
24
25 (require 'mail-parse)
26
27 (require 'notmuch-lib)
28 (require 'notmuch-query)
29 (require 'notmuch-show)
30 (require 'notmuch) ;; XXX ATM, as notmuch-search-mode-map is defined here
31
32 (eval-when-compile (require 'cl))
33
34 (declare-function notmuch-call-notmuch-process "notmuch" (&rest args))
35 (declare-function notmuch-show "notmuch-show" (&rest args))
36 (declare-function notmuch-tag "notmuch" (query &rest tags))
37 (declare-function notmuch-show-strip-re "notmuch-show" (subject))
38 (declare-function notmuch-show-spaces-n "notmuch-show" (n))
39 (declare-function notmuch-read-query "notmuch" (prompt))
40 (declare-function notmuch-read-tag-changes "notmuch" (&optional initial-input &rest search-terms))
41 (declare-function notmuch-update-tags "notmuch" (current-tags tag-changes))
42 (declare-function notmuch-hello-trim "notmuch-hello" (search))
43 (declare-function notmuch-search-find-thread-id "notmuch" ())
44 (declare-function notmuch-search-find-subject "notmuch" ())
45
46 ;; the following variable is defined in notmuch.el
47 (defvar notmuch-search-query-string)
48
49 (defgroup notmuch-pick nil
50   "Showing message and thread structure."
51   :group 'notmuch)
52
53 ;; This is ugly. We can't run setup-show-out until it has been defined
54 ;; which needs the keymap to be defined. So we defer setting up to
55 ;; notmuch-pick-init.
56 (defcustom notmuch-pick-show-out nil
57   "View selected messages in new window rather than split-pane."
58   :type 'boolean
59   :group 'notmuch-pick
60   :set (lambda (symbol value)
61          (set-default symbol value)
62          (when (fboundp 'notmuch-pick-setup-show-out)
63            (notmuch-pick-setup-show-out))))
64
65 (defcustom notmuch-pick-result-format
66   `(("date" . "%12s  ")
67     ("authors" . "%-20s")
68     ("subject" . " %-54s ")
69     ("tags" . "(%s)"))
70   "Result formatting for Pick. Supported fields are: date,
71         authors, subject, tags Note: subject includes the tree
72         structure graphics, and the author string should not
73         contain whitespace (put it in the neighbouring fields
74         instead).  For example:
75         (setq notmuch-pick-result-format \(\(\"authors\" . \"%-40s\"\)
76                                              \(\"subject\" . \"%s\"\)\)\)"
77   :type '(alist :key-type (string) :value-type (string))
78   :group 'notmuch-pick)
79
80 (defcustom notmuch-pick-asynchronous-parser t
81   "Use the asynchronous parser."
82   :type 'boolean
83   :group 'notmuch-pick)
84
85 ;; Faces for messages that match the query.
86 (defface notmuch-pick-match-date-face
87   '((t :inherit default))
88   "Face used in pick mode for the date in messages matching the query."
89   :group 'notmuch-pick
90   :group 'notmuch-faces)
91
92 (defface notmuch-pick-match-author-face
93   '((((class color)
94       (background dark))
95      (:foreground "OliveDrab1"))
96     (((class color)
97       (background light))
98      (:foreground "dark blue"))
99     (t
100      (:bold t)))
101   "Face used in pick mode for the date in messages matching the query."
102   :group 'notmuch-pick
103   :group 'notmuch-faces)
104
105 (defface notmuch-pick-match-subject-face
106   '((t :inherit default))
107   "Face used in pick mode for the subject in messages matching the query."
108   :group 'notmuch-pick
109   :group 'notmuch-faces)
110
111 (defface notmuch-pick-match-tag-face
112   '((((class color)
113       (background dark))
114      (:foreground "OliveDrab1"))
115     (((class color)
116       (background light))
117      (:foreground "navy blue" :bold t))
118     (t
119      (:bold t)))
120   "Face used in pick mode for tags in messages matching the query."
121   :group 'notmuch-pick
122   :group 'notmuch-faces)
123
124 ;; Faces for messages that do not match the query.
125 (defface notmuch-pick-no-match-date-face
126   '((t (:foreground "gray")))
127   "Face used in pick mode for non-matching dates."
128   :group 'notmuch-pick
129   :group 'notmuch-faces)
130
131 (defface notmuch-pick-no-match-subject-face
132   '((t (:foreground "gray")))
133   "Face used in pick mode for non-matching subjects."
134   :group 'notmuch-pick
135   :group 'notmuch-faces)
136
137 (defface notmuch-pick-no-match-author-face
138   '((t (:foreground "gray")))
139   "Face used in pick mode for the date in messages matching the query."
140   :group 'notmuch-pick
141   :group 'notmuch-faces)
142
143 (defface notmuch-pick-no-match-tag-face
144   '((t (:foreground "gray")))
145   "Face used in pick mode face for non-matching tags."
146   :group 'notmuch-pick
147   :group 'notmuch-faces)
148
149 (defvar notmuch-pick-previous-subject "")
150 (make-variable-buffer-local 'notmuch-pick-previous-subject)
151
152 ;; The basic query i.e. the key part of the search request.
153 (defvar notmuch-pick-basic-query nil)
154 (make-variable-buffer-local 'notmuch-pick-basic-query)
155 ;; The context of the search: i.e., useful but can be dropped.
156 (defvar notmuch-pick-query-context nil)
157 (make-variable-buffer-local 'notmuch-pick-query-context)
158 (defvar notmuch-pick-target-msg nil)
159 (make-variable-buffer-local 'notmuch-pick-target-msg)
160 (defvar notmuch-pick-buffer-name nil)
161 (make-variable-buffer-local 'notmuch-pick-buffer-name)
162 ;; This variable is the window used for the message pane. It is set
163 ;; in both the parent pick buffer and the child show buffer. It is
164 ;; used to try and close the message pane when quitting pick or the
165 ;; child show buffer.
166 (defvar notmuch-pick-message-window nil)
167 (make-variable-buffer-local 'notmuch-pick-message-window)
168 (put 'notmuch-pick-message-window 'permanent-local t)
169 (defvar notmuch-pick-message-buffer nil)
170 (make-variable-buffer-local 'notmuch-pick-message-buffer-name)
171 (put 'notmuch-pick-message-buffer-name 'permanent-local t)
172 (defvar notmuch-pick-process-state nil
173   "Parsing state of the search process filter.")
174
175
176 (defvar notmuch-pick-mode-map
177   (let ((map (make-sparse-keymap)))
178     (define-key map [mouse-1] 'notmuch-pick-show-message)
179     (define-key map "q" 'notmuch-pick-quit)
180     (define-key map "x" 'notmuch-pick-quit)
181     (define-key map "?" 'notmuch-help)
182     (define-key map "a" 'notmuch-pick-archive-message-then-next)
183     (define-key map "=" 'notmuch-pick-refresh-view)
184     (define-key map "s" 'notmuch-pick-to-search)
185     (define-key map "z" 'notmuch-pick-to-pick)
186     (define-key map "m" 'notmuch-pick-new-mail)
187     (define-key map "f" 'notmuch-pick-forward-message)
188     (define-key map "r" 'notmuch-pick-reply-sender)
189     (define-key map "R" 'notmuch-pick-reply)
190     (define-key map "n" 'notmuch-pick-next-matching-message)
191     (define-key map "p" 'notmuch-pick-prev-matching-message)
192     (define-key map "N" 'notmuch-pick-next-message)
193     (define-key map "P" 'notmuch-pick-prev-message)
194     (define-key map "|" 'notmuch-pick-pipe-message)
195     (define-key map "-" 'notmuch-pick-remove-tag)
196     (define-key map "+" 'notmuch-pick-add-tag)
197     (define-key map " " 'notmuch-pick-scroll-or-next)
198     (define-key map "b" 'notmuch-pick-scroll-message-window-back)
199     map))
200 (fset 'notmuch-pick-mode-map notmuch-pick-mode-map)
201
202 (defun notmuch-pick-setup-show-out ()
203   (let ((map notmuch-pick-mode-map))
204     (if notmuch-pick-show-out
205         (progn
206           (define-key map (kbd "M-RET") 'notmuch-pick-show-message)
207           (define-key map (kbd "RET") 'notmuch-pick-show-message-out))
208       (progn
209         (define-key map (kbd "RET") 'notmuch-pick-show-message)
210         (define-key map (kbd "M-RET") 'notmuch-pick-show-message-out)))))
211
212 (defun notmuch-pick-get-message-properties ()
213   "Return the properties of the current message as a plist.
214
215 Some useful entries are:
216 :headers - Property list containing the headers :Date, :Subject, :From, etc.
217 :tags - Tags for this message"
218   (save-excursion
219     (beginning-of-line)
220     (get-text-property (point) :notmuch-message-properties)))
221
222 (defun notmuch-pick-set-message-properties (props)
223   (save-excursion
224     (beginning-of-line)
225     (put-text-property (point) (+ (point) 1) :notmuch-message-properties props)))
226
227 (defun notmuch-pick-set-prop (prop val &optional props)
228   (let ((inhibit-read-only t)
229         (props (or props
230                    (notmuch-pick-get-message-properties))))
231     (plist-put props prop val)
232     (notmuch-pick-set-message-properties props)))
233
234 (defun notmuch-pick-get-prop (prop &optional props)
235   (let ((props (or props
236                    (notmuch-pick-get-message-properties))))
237     (plist-get props prop)))
238
239 (defun notmuch-pick-set-tags (tags)
240   "Set the tags of the current message."
241   (notmuch-pick-set-prop :tags tags))
242
243 (defun notmuch-pick-get-tags ()
244   "Return the tags of the current message."
245   (notmuch-pick-get-prop :tags))
246
247 (defun notmuch-pick-get-message-id ()
248   "Return the message id of the current message."
249   (let ((id (notmuch-pick-get-prop :id)))
250     (if id
251         (notmuch-id-to-query id)
252       nil)))
253
254 (defun notmuch-pick-get-match ()
255   "Return whether the current message is a match."
256   (interactive)
257   (notmuch-pick-get-prop :match))
258
259 (defun notmuch-pick-refresh-result ()
260   (let ((init-point (point))
261         (end (line-end-position))
262         (msg (notmuch-pick-get-message-properties))
263         (inhibit-read-only t))
264     (beginning-of-line)
265     (delete-region (point) (1+ (line-end-position)))
266     (notmuch-pick-insert-msg msg)
267     (let ((new-end (line-end-position)))
268       (goto-char (if (= init-point end)
269                      new-end
270                    (min init-point (- new-end 1)))))))
271
272 (defun notmuch-pick-tag-update-display (&optional tag-changes)
273   "Update display for TAG-CHANGES to current message.
274
275 Does NOT change the database."
276   (let* ((current-tags (notmuch-pick-get-tags))
277          (new-tags (notmuch-update-tags current-tags tag-changes)))
278     (unless (equal current-tags new-tags)
279       (notmuch-pick-set-tags new-tags)
280       (notmuch-pick-refresh-result))))
281
282 (defun notmuch-pick-tag (&optional tag-changes)
283   "Change tags for the current message"
284   (interactive)
285   (setq tag-changes (funcall 'notmuch-tag (notmuch-pick-get-message-id) tag-changes))
286   (notmuch-pick-tag-update-display tag-changes))
287
288 (defun notmuch-pick-add-tag ()
289   "Same as `notmuch-pick-tag' but sets initial input to '+'."
290   (interactive)
291   (notmuch-pick-tag "+"))
292
293 (defun notmuch-pick-remove-tag ()
294   "Same as `notmuch-pick-tag' but sets initial input to '-'."
295   (interactive)
296   (notmuch-pick-tag "-"))
297
298 ;; The next two functions close the message window before searching or
299 ;; picking but they do so after the user has entered the query (in
300 ;; case the user was basing the query on something in the message
301 ;; window).
302
303 (defun notmuch-pick-to-search ()
304   "Run \"notmuch search\" with the given `query' and display results."
305   (interactive)
306   (let ((query (notmuch-read-query "Notmuch search: ")))
307     (notmuch-pick-close-message-window)
308     (notmuch-search query)))
309
310 (defun notmuch-pick-to-pick ()
311   "Run a query and display results in experimental notmuch-pick mode"
312   (interactive)
313   (let ((query (notmuch-read-query "Notmuch pick: ")))
314     (notmuch-pick-close-message-window)
315     (notmuch-pick query)))
316
317 ;; This function should be in notmuch-hello.el but we are trying to
318 ;; minimise impact on the rest of the codebase.
319 (defun notmuch-pick-from-hello (&optional search)
320   "Run a query and display results in experimental notmuch-pick mode"
321   (interactive)
322   (unless (null search)
323     (setq search (notmuch-hello-trim search))
324     (let ((history-delete-duplicates t))
325       (add-to-history 'notmuch-search-history search)))
326   (notmuch-pick search))
327
328 ;; This function should be in notmuch-show.el but be we trying to
329 ;; minimise impact on the rest of the codebase.
330 (defun notmuch-pick-from-show-current-query ()
331   "Call notmuch pick with the current query"
332   (interactive)
333   (notmuch-pick notmuch-show-thread-id
334                 notmuch-show-query-context
335                 (notmuch-show-get-message-id)))
336
337 ;; This function should be in notmuch.el but be we trying to minimise
338 ;; impact on the rest of the codebase.
339 (defun notmuch-pick-from-search-current-query ()
340   "Call notmuch pick with the current query"
341   (interactive)
342   (notmuch-pick notmuch-search-query-string))
343
344 ;; This function should be in notmuch.el but be we trying to minimise
345 ;; impact on the rest of the codebase.
346 (defun notmuch-pick-from-search-thread ()
347   "Show the selected thread with notmuch-pick"
348   (interactive)
349   (notmuch-pick (notmuch-search-find-thread-id)
350                 notmuch-search-query-string
351                 nil
352                 (notmuch-prettify-subject (notmuch-search-find-subject)))
353   (notmuch-pick-show-match-message-with-wait))
354
355 (defun notmuch-pick-message-window-kill-hook ()
356   (let ((buffer (current-buffer)))
357     (when (and (window-live-p notmuch-pick-message-window)
358                (eq (window-buffer notmuch-pick-message-window) buffer))
359       ;; We do not want an error if this is the sole window in the
360       ;; frame and I do not know how to test for that in emacs pre
361       ;; 24. Hence we just ignore-errors.
362       (ignore-errors
363         (delete-window notmuch-pick-message-window)))))
364
365 (defun notmuch-pick-show-message ()
366   "Show the current message (in split-pane)."
367   (interactive)
368   (let ((id (notmuch-pick-get-message-id))
369         (inhibit-read-only t)
370         buffer)
371     (when id
372       ;; We close and reopen the window to kill off un-needed buffers
373       ;; this might cause flickering but seems ok.
374       (notmuch-pick-close-message-window)
375       (setq notmuch-pick-message-window
376             (split-window-vertically (/ (window-height) 4)))
377       (with-selected-window notmuch-pick-message-window
378         ;; Since we are only displaying one message do not indent.
379         (let ((notmuch-show-indent-messages-width 0))
380           (setq current-prefix-arg '(4))
381           (setq buffer (notmuch-show id nil nil nil))))
382       ;; We need the `let' as notmuch-pick-message-window is buffer local.
383       (let ((window notmuch-pick-message-window))
384         (with-current-buffer buffer
385           (setq notmuch-pick-message-window window)
386           (add-hook 'kill-buffer-hook 'notmuch-pick-message-window-kill-hook)))
387       (notmuch-pick-tag-update-display (list "-unread"))
388       (setq notmuch-pick-message-buffer buffer))))
389
390 (defun notmuch-pick-show-message-out ()
391   "Show the current message (in whole window)."
392   (interactive)
393   (let ((id (notmuch-pick-get-message-id))
394         (inhibit-read-only t)
395         buffer)
396     (when id
397       ;; We close the window to kill off un-needed buffers.
398       (notmuch-pick-close-message-window)
399       (notmuch-show id nil nil nil))))
400
401 (defun notmuch-pick-scroll-message-window ()
402   "Scroll the message window (if it exists)"
403   (interactive)
404   (when (window-live-p notmuch-pick-message-window)
405     (with-selected-window notmuch-pick-message-window
406       (if (pos-visible-in-window-p (point-max))
407           t
408         (scroll-up)))))
409
410 (defun notmuch-pick-scroll-message-window-back ()
411   "Scroll the message window back(if it exists)"
412   (interactive)
413   (when (window-live-p notmuch-pick-message-window)
414     (with-selected-window notmuch-pick-message-window
415       (if (pos-visible-in-window-p (point-min))
416           t
417         (scroll-down)))))
418
419 (defun notmuch-pick-scroll-or-next ()
420   "Scroll the message window. If it at end go to next message."
421   (interactive)
422   (when (notmuch-pick-scroll-message-window)
423     (notmuch-pick-next-matching-message)))
424
425 (defun notmuch-pick-quit ()
426   "Close the split view or exit pick."
427   (interactive)
428   (unless (notmuch-pick-close-message-window)
429     (kill-buffer (current-buffer))))
430
431 (defun notmuch-pick-close-message-window ()
432   "Close the message-window. Return t if close succeeds."
433   (interactive)
434   (when (and (window-live-p notmuch-pick-message-window)
435              (eq (window-buffer notmuch-pick-message-window) notmuch-pick-message-buffer))
436     (delete-window notmuch-pick-message-window)
437     (unless (get-buffer-window-list notmuch-pick-message-buffer)
438       (kill-buffer notmuch-pick-message-buffer))
439     t))
440
441 (defun notmuch-pick-archive-message (&optional unarchive)
442   "Archive the current message.
443
444 Archive the current message by applying the tag changes in
445 `notmuch-archive-tags' to it (remove the \"inbox\" tag by
446 default). If a prefix argument is given, the message will be
447 \"unarchived\", i.e. the tag changes in `notmuch-archive-tags'
448 will be reversed."
449   (interactive "P")
450   (when notmuch-archive-tags
451     (apply 'notmuch-pick-tag
452            (notmuch-tag-change-list notmuch-archive-tags unarchive))))
453
454 (defun notmuch-pick-archive-message-then-next (&optional unarchive)
455   "Archive the current message and move to next matching message."
456   (interactive "P")
457   (notmuch-pick-archive-message unarchive)
458   (notmuch-pick-next-matching-message))
459
460 (defun notmuch-pick-next-message ()
461   "Move to next message."
462   (interactive)
463   (forward-line)
464   (when (window-live-p notmuch-pick-message-window)
465     (notmuch-pick-show-message)))
466
467 (defun notmuch-pick-prev-message ()
468   "Move to previous message."
469   (interactive)
470   (forward-line -1)
471   (when (window-live-p notmuch-pick-message-window)
472     (notmuch-pick-show-message)))
473
474 (defun notmuch-pick-prev-matching-message ()
475   "Move to previous matching message."
476   (interactive)
477   (forward-line -1)
478   (while (and (not (bobp)) (not (notmuch-pick-get-match)))
479     (forward-line -1))
480   (when (window-live-p notmuch-pick-message-window)
481     (notmuch-pick-show-message)))
482
483 (defun notmuch-pick-next-matching-message ()
484   "Move to next matching message."
485   (interactive)
486   (forward-line)
487   (while (and (not (eobp)) (not (notmuch-pick-get-match)))
488     (forward-line))
489   (when (window-live-p notmuch-pick-message-window)
490     (notmuch-pick-show-message)))
491
492 (defun notmuch-pick-show-match-message-with-wait ()
493   "Show the first matching message but wait for it to appear or search to finish."
494   (interactive)
495   (unless (notmuch-pick-get-match)
496     (notmuch-pick-next-matching-message))
497   (while (and (not (notmuch-pick-get-match))
498               (get-buffer-process (current-buffer)))
499     (message "waiting for message")
500     (sit-for 0.1)
501     (goto-char (point-min))
502     (unless (notmuch-pick-get-match)
503       (notmuch-pick-next-matching-message)))
504   (message nil)
505   (when (notmuch-pick-get-match)
506     (notmuch-pick-show-message)))
507
508 (defun notmuch-pick-refresh-view ()
509   "Refresh view."
510   (interactive)
511   (let ((inhibit-read-only t)
512         (basic-query notmuch-pick-basic-query)
513         (query-context notmuch-pick-query-context)
514         (target (notmuch-pick-get-message-id))
515         (buffer-name notmuch-pick-buffer-name))
516     (erase-buffer)
517     (notmuch-pick-worker basic-query
518                          query-context
519                          target
520                          (get-buffer buffer-name))))
521
522 (defmacro with-current-notmuch-pick-message (&rest body)
523   "Evaluate body with current buffer set to the text of current message"
524   `(save-excursion
525      (let ((id (notmuch-pick-get-message-id)))
526        (let ((buf (generate-new-buffer (concat "*notmuch-msg-" id "*"))))
527          (with-current-buffer buf
528             (call-process notmuch-command nil t nil "show" "--format=raw" id)
529            ,@body)
530          (kill-buffer buf)))))
531
532 (defun notmuch-pick-new-mail (&optional prompt-for-sender)
533   "Compose new mail."
534   (interactive "P")
535   (notmuch-pick-close-message-window)
536   (notmuch-mua-new-mail prompt-for-sender ))
537
538 (defun notmuch-pick-forward-message (&optional prompt-for-sender)
539   "Forward the current message."
540   (interactive "P")
541   (notmuch-pick-close-message-window)
542   (with-current-notmuch-pick-message
543    (notmuch-mua-new-forward-message prompt-for-sender)))
544
545 (defun notmuch-pick-reply (&optional prompt-for-sender)
546   "Reply to the sender and all recipients of the current message."
547   (interactive "P")
548   (notmuch-pick-close-message-window)
549   (notmuch-mua-new-reply (notmuch-pick-get-message-id) prompt-for-sender t))
550
551 (defun notmuch-pick-reply-sender (&optional prompt-for-sender)
552   "Reply to the sender of the current message."
553   (interactive "P")
554   (notmuch-pick-close-message-window)
555   (notmuch-mua-new-reply (notmuch-pick-get-message-id) prompt-for-sender nil))
556
557 ;; Shamelessly stolen from notmuch-show.el: maybe should be unified.
558 (defun notmuch-pick-pipe-message (command)
559   "Pipe the contents of the current message to the given command.
560
561 The given command will be executed with the raw contents of the
562 current email message as stdin. Anything printed by the command
563 to stdout or stderr will appear in the *notmuch-pipe* buffer.
564
565 When invoked with a prefix argument, the command will receive all
566 open messages in the current thread (formatted as an mbox) rather
567 than only the current message."
568   (interactive "sPipe message to command: ")
569   (let ((shell-command
570          (concat notmuch-command " show --format=raw "
571                  (shell-quote-argument (notmuch-pick-get-message-id)) " | " command))
572          (buf (get-buffer-create (concat "*notmuch-pipe*"))))
573     (with-current-buffer buf
574       (setq buffer-read-only nil)
575       (erase-buffer)
576       (let ((exit-code (call-process-shell-command shell-command nil buf)))
577         (goto-char (point-max))
578         (set-buffer-modified-p nil)
579         (setq buffer-read-only t)
580         (unless (zerop exit-code)
581           (switch-to-buffer-other-window buf)
582           (message (format "Command '%s' exited abnormally with code %d"
583                            shell-command exit-code)))))))
584
585 (defun notmuch-pick-clean-address (address)
586   "Try to clean a single email ADDRESS for display. Return
587 AUTHOR_NAME if present, otherwise return AUTHOR_EMAIL. Return
588 unchanged ADDRESS if parsing fails."
589   (let* ((clean-address (notmuch-clean-address address))
590          (p-address (car clean-address))
591          (p-name (cdr clean-address)))
592
593     ;; If we have a name return that otherwise return the address.
594     (or p-name p-address)))
595
596 (defun notmuch-pick-insert-field (field format-string msg)
597   (let* ((headers (plist-get msg :headers))
598         (match (plist-get msg :match)))
599     (cond
600      ((string-equal field "date")
601       (let ((face (if match
602                       'notmuch-pick-match-date-face
603                     'notmuch-pick-no-match-date-face)))
604         (insert (propertize (format format-string (plist-get msg :date_relative))
605                             'face face))))
606
607      ((string-equal field "subject")
608       (let ((tree-status (plist-get msg :tree-status))
609             (bare-subject (notmuch-show-strip-re (plist-get headers :Subject)))
610             (face (if match
611                       'notmuch-pick-match-subject-face
612                     'notmuch-pick-no-match-subject-face)))
613         (insert (propertize (format format-string
614                                     (concat
615                                      (mapconcat #'identity (reverse tree-status) "")
616                                      (if (string= notmuch-pick-previous-subject bare-subject)
617                                          " ..."
618                                        bare-subject)))
619                             'face face))
620         (setq notmuch-pick-previous-subject bare-subject)))
621
622      ((string-equal field "authors")
623       (let ((author (notmuch-pick-clean-address (plist-get headers :From)))
624             (len (length (format format-string "")))
625             (face (if match
626                       'notmuch-pick-match-author-face
627                     'notmuch-pick-no-match-author-face)))
628         (when (> (length author) len)
629           (setq author (substring author 0 len)))
630         (insert (propertize (format format-string author)
631                             'face face))))
632
633      ((string-equal field "tags")
634       (let ((tags (plist-get msg :tags))
635             (face (if match
636                           'notmuch-pick-match-tag-face
637                         'notmuch-pick-no-match-tag-face)))
638         (when tags
639           (insert (propertize (format format-string
640                                       (mapconcat #'identity tags ", "))
641                               'face face))))))))
642
643 (defun notmuch-pick-insert-msg (msg)
644   "Insert the message MSG according to notmuch-pick-result-format"
645   (dolist (spec notmuch-pick-result-format)
646     (notmuch-pick-insert-field (car spec) (cdr spec) msg))
647   (notmuch-pick-set-message-properties msg)
648   (insert "\n"))
649
650 (defun notmuch-pick-goto-and-insert-msg (msg)
651   "Insert msg at the end of the buffer. Move point to msg if it is the target"
652   (save-excursion
653     (goto-char (point-max))
654     (notmuch-pick-insert-msg msg))
655   (let ((msg-id (notmuch-id-to-query (plist-get msg :id))))
656     (when (string= msg-id notmuch-pick-target-msg)
657       (setq notmuch-pick-target-msg "found")
658       (goto-char (point-max))
659       (forward-line -1))))
660
661 (defun notmuch-pick-insert-tree (tree depth tree-status first last)
662   "Insert the message tree TREE at depth DEPTH in the current thread."
663   (let ((msg (car tree))
664         (replies (cadr tree)))
665
666       (cond
667        ((and (< 0 depth) (not last))
668         (push "├" tree-status))
669        ((and (< 0 depth) last)
670         (push "╰" tree-status))
671        ((and (eq 0 depth) first last)
672 ;;        (push "─" tree-status)) choice between this and next line is matter of taste.
673         (push " " tree-status))
674        ((and (eq 0 depth) first (not last))
675           (push "┬" tree-status))
676        ((and (eq 0 depth) (not first) last)
677         (push "╰" tree-status))
678        ((and (eq 0 depth) (not first) (not last))
679         (push "├" tree-status)))
680
681       (push (concat (if replies "┬" "─") "►") tree-status)
682       (notmuch-pick-goto-and-insert-msg (plist-put msg :tree-status tree-status))
683       (pop tree-status)
684       (pop tree-status)
685
686       (if last
687           (push " " tree-status)
688         (push "│" tree-status))
689
690     (notmuch-pick-insert-thread replies (1+ depth) tree-status)))
691
692 (defun notmuch-pick-insert-thread (thread depth tree-status)
693   "Insert the thread THREAD at depth DEPTH >= 1 in the current forest."
694   (let ((n (length thread)))
695     (loop for tree in thread
696           for count from 1 to n
697
698           do (notmuch-pick-insert-tree tree depth tree-status (eq count 1) (eq count n)))))
699
700 (defun notmuch-pick-insert-forest-thread (forest-thread)
701   (let (tree-status)
702     ;; Reset at the start of each main thread.
703     (setq notmuch-pick-previous-subject nil)
704     (notmuch-pick-insert-thread forest-thread 0 tree-status)))
705
706 (defun notmuch-pick-insert-forest (forest)
707   (mapc 'notmuch-pick-insert-forest-thread forest))
708
709 (defun notmuch-pick-mode ()
710   "Major mode displaying messages (as opposed to threads) of of a notmuch search.
711
712 This buffer contains the results of a \"notmuch pick\" of your
713 email archives. Each line in the buffer represents a single
714 message giving the relative date, the author, subject, and any
715 tags.
716
717 Pressing \\[notmuch-pick-show-message] on any line displays that message.
718
719 Complete list of currently available key bindings:
720
721 \\{notmuch-pick-mode-map}"
722
723   (interactive)
724   (kill-all-local-variables)
725   (use-local-map notmuch-pick-mode-map)
726   (setq major-mode 'notmuch-pick-mode
727         mode-name "notmuch-pick")
728   (hl-line-mode 1)
729   (setq buffer-read-only t
730         truncate-lines t))
731
732 (defun notmuch-pick-process-sentinel (proc msg)
733   "Add a message to let user know when \"notmuch pick\" exits"
734   (let ((buffer (process-buffer proc))
735         (status (process-status proc))
736         (exit-status (process-exit-status proc))
737         (never-found-target-thread nil))
738     (when (memq status '(exit signal))
739         (kill-buffer (process-get proc 'parse-buf))
740         (if (buffer-live-p buffer)
741             (with-current-buffer buffer
742               (save-excursion
743                 (let ((inhibit-read-only t)
744                       (atbob (bobp)))
745                   (goto-char (point-max))
746                   (if (eq status 'signal)
747                       (insert "Incomplete search results (pick process was killed).\n"))
748                   (when (eq status 'exit)
749                     (insert "End of search results.")
750                     (unless (= exit-status 0)
751                       (insert (format " (process returned %d)" exit-status)))
752                     (insert "\n")))))))))
753
754
755 (defun notmuch-pick-show-error (string &rest objects)
756   (save-excursion
757     (goto-char (point-max))
758     (insert "Error: Unexpected output from notmuch search:\n")
759     (insert (apply #'format string objects))
760     (insert "\n")))
761
762
763 (defun notmuch-pick-process-filter (proc string)
764   "Process and filter the output of \"notmuch show\" (for pick)"
765   (let ((results-buf (process-buffer proc))
766         (parse-buf (process-get proc 'parse-buf))
767         (inhibit-read-only t)
768         done)
769     (if (not (buffer-live-p results-buf))
770         (delete-process proc)
771       (with-current-buffer parse-buf
772         ;; Insert new data
773         (save-excursion
774           (goto-char (point-max))
775           (insert string))
776         (notmuch-json-parse-partial-list 'notmuch-pick-insert-forest-thread
777                                          'notmuch-pick-show-error
778                                          results-buf)))))
779
780 (defun notmuch-pick-worker (basic-query &optional query-context target buffer)
781   (interactive)
782   (notmuch-pick-mode)
783   (setq notmuch-pick-basic-query basic-query)
784   (setq notmuch-pick-query-context query-context)
785   (setq notmuch-pick-buffer-name (buffer-name buffer))
786   (setq notmuch-pick-target-msg target)
787
788   (erase-buffer)
789   (goto-char (point-min))
790   (let* ((search-args (concat basic-query
791                        (if query-context (concat " and (" query-context ")"))
792                        ))
793          (message-arg "--entire-thread"))
794     (if (equal (car (process-lines notmuch-command "count" search-args)) "0")
795         (setq search-args basic-query))
796     (if notmuch-pick-asynchronous-parser
797         (let ((proc (start-process
798                      "notmuch-pick" buffer
799                      notmuch-command "show" "--body=false" "--format=json"
800                      message-arg search-args))
801               ;; Use a scratch buffer to accumulate partial output.
802               ;; This buffer will be killed by the sentinel, which
803               ;; should be called no matter how the process dies.
804               (parse-buf (generate-new-buffer " *notmuch pick parse*")))
805           (process-put proc 'parse-buf parse-buf)
806           (set-process-sentinel proc 'notmuch-pick-process-sentinel)
807           (set-process-filter proc 'notmuch-pick-process-filter)
808           (set-process-query-on-exit-flag proc nil))
809       (progn
810         (notmuch-pick-insert-forest
811          (notmuch-query-get-threads
812           (list "--body=false" message-arg search-args)))
813         (save-excursion
814           (goto-char (point-max))
815           (insert "End of search results.\n"))))))
816
817
818 (defun notmuch-pick (&optional query query-context target buffer-name show-first-match)
819   "Run notmuch pick with the given `query' and display the results"
820   (interactive "sNotmuch pick: ")
821   (if (null query)
822       (setq query (notmuch-read-query "Notmuch pick: ")))
823   (let ((buffer (get-buffer-create (generate-new-buffer-name
824                                     (or buffer-name
825                                         (concat "*notmuch-pick-" query "*")))))
826         (inhibit-read-only t))
827
828     (switch-to-buffer buffer)
829     ;; Don't track undo information for this buffer
830     (set 'buffer-undo-list t)
831
832     (notmuch-pick-worker query query-context target buffer)
833
834     (setq truncate-lines t)
835     (when show-first-match
836       (notmuch-pick-show-match-message-with-wait))))
837
838
839 ;; Set up key bindings from the rest of notmuch.
840 (define-key 'notmuch-search-mode-map "z" 'notmuch-pick)
841 (define-key 'notmuch-search-mode-map "Z" 'notmuch-pick-from-search-current-query)
842 (define-key 'notmuch-search-mode-map (kbd "M-RET") 'notmuch-pick-from-search-thread)
843 (define-key 'notmuch-hello-mode-map "z" 'notmuch-pick-from-hello)
844 (define-key 'notmuch-show-mode-map "z" 'notmuch-pick)
845 (define-key 'notmuch-show-mode-map "Z" 'notmuch-pick-from-show-current-query)
846 (notmuch-pick-setup-show-out)
847 (message "Initialised notmuch-pick")
848
849 (provide 'notmuch-pick)