system-manager-wakasu
1;;; consult-mu.el --- Consult Mu4e asynchronously -*- lexical-binding: t -*-
2
3;; Copyright (C) 2023 Armin Darvish
4
5;; Author: Armin Darvish
6;; Maintainer: Armin Darvish
7;; Created: 2023
8;; Version: 1.0
9;; Package-Requires: ((emacs "28.0") (consult "2.0"))
10;; Keywords: convenience, matching, tools, email
11;; Homepage: https://github.com/armindarvish/consult-mu
12
13;; SPDX-License-Identifier: GPL-3.0-or-later
14
15;; This file is free software: you can redistribute it and/or modify
16;; it under the terms of the GNU General Public License as published
17;; by the Free Software Foundation, either version 3 of the License,
18;; or (at your option) any later version.
19;;
20;; This file is distributed in the hope that it will be useful,
21;; but WITHOUT ANY WARRANTY; without even the implied warranty of
22;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
23;; GNU General Public License for more details.
24;;
25;; You should have received a copy of the GNU General Public License
26;; along with this file. If not, see <https://www.gnu.org/licenses/>.
27
28
29;;; Commentary:
30
31;; This package provides an alternative interactive serach interface for
32;; mu and mu4e (see URL `https://djcbsoftware.nl/code/mu/mu4e.html').
33;; It uses a consult-based minibuffer completion for searching and
34;; selecting, and marking emails, as well as additional utilities for
35;; composing emails and more.
36
37;; This package requires mu4e version "1.10.8" or later.
38
39;;; Code:
40
41;;; Requirements
42(require 'consult)
43(require 'mu4e)
44
45;;; Group
46
47(defgroup consult-mu nil
48 "Options for `consult-mu'."
49 :group 'convenience
50 :group 'minibuffer
51 :group 'consult
52 :group 'mu4e
53 :prefix "consult-mu-")
54
55;;; Customization Variables
56
57(defcustom consult-mu-args '("mu")
58 "Command line arguments to call `mu` asynchronously.
59
60The dynamically computed arguments are appended.
61Can be either a string, or a list of strings or expressions."
62 :group 'consult-mu
63 :type '(choice string (repeat (choice string sexp))))
64
65(defcustom consult-mu-maxnum mu4e-search-results-limit
66 "Maximum number of results.
67
68This is normally passed to “--maxnum” in the command line or is defined by
69`mu4e-search-results-limit'. By default inherits from
70`mu4e-search-results-limit'."
71 :group 'consult-mu
72 :type '(choice (const :tag "Unlimited" -1)
73 (integer :tag "Limit")))
74
75(defcustom consult-mu-search-sort-field mu4e-search-sort-field
76 "What field to sort results by?
77
78By defualt inherits from `mu4e-search-sort-field'."
79 :group 'consult-mu
80 :type '(radio (const :tag "Date" :date)
81 (const :tag "Subject" :subject)
82 (const :tag "File Size" :size)
83 (const :tag "Priority" :prio)
84 (const :tag "From (Sender)" :from)
85 (const :tag "To (Recipients)" :to)
86 (const :tag "Mailing List" :list)))
87
88(defcustom consult-mu-headers-fields mu4e-headers-fields
89 "A list of header fields to show in the headers buffer.
90
91By default inherits from `mu4e-headers-field'.
92
93From mu4e docs:
94
95Each element has the form (HEADER . WIDTH), where HEADER is one of
96the available headers (see `mu4e-header-info') and WIDTH is the
97respective width in characters.
98
99A width of nil means “unrestricted”, and this is best reserved
100for the rightmost \(last\) field. Note that Emacs may become very
101slow with excessively long lines \(1000s of characters\), so if you
102regularly get such messages, you want to avoid fields with nil
103altogether."
104 :group 'consult-mu
105 :type `(repeat (cons (choice ,@(mapcar (lambda (h)
106 (list 'const
107 :tag (plist-get (cdr h) :help)
108 (car h)))
109 mu4e-header-info))
110 (choice (integer :tag "width")
111 (const :tag "unrestricted width" nil)))))
112
113(defcustom consult-mu-headers-template nil
114 "A template string to make custom header formats.
115
116If non-nil, `consult-mu' uses this string to format the headers instead of
117`consult-mu-headers-field'.
118
119The string should be of the format “%[char][integer]%[char][integer]...”,
120and allow dynamic insertion of the content. Each “%[char][integer]“ chunk
121represents a different field and the integer defines the length of the
122field.
123
124The list of available fields are:
125
126 %f sender(s) \(e.g. from: field of email\)
127 %t receivers(s) \(i.e. to: field of email\)
128 %s subject \(i.e. title of email\)
129 %d date \(i.e. the date email was sent/received\)
130 %p priority
131 %z size
132 %i message-id \(as defined by mu\)
133 %g flags \(as defined by mu\)
134 %G pretty flags \(this uses `mu4e~headers-flags-str' to pretify flags\)
135 %x tags \(as defined by mu\)
136 %c cc \(i.e. cc: field of the email\)
137 %h bcc \(i.e. bcc: field of the email\)
138 %r date chaged \(as defined by :changed in mu4e\)
139
140For exmaple, “%d15%s50” means 15 characters for date and 50 charcters for
141subject, and “%d13%s37%f17” would make a header containing 13 characters
142for Date, 37 characters for Subject, and 20 characters for From field,
143making a header that looks like this:
144
145Thu 09 Nov 23 Title of the Email Limited to 50 Char... example@domain..."
146 :group 'consult-mu
147 :type '(choice (const :tag "Fromatted String" :format "%{%%d13%%s50%%f17%}")
148 (function :tag "Custom Function")))
149
150(defcustom consult-mu-search-sort-direction mu4e-search-sort-direction
151 "Direction to sort by a symbol.
152
153By defualt inherits from `mu4e-search-sort-direction', and can either be
154\='descending (sorting Z->A) or \='ascending (sorting A->Z)."
155
156 :group 'consult-mu
157 :type '(radio (const ascending)
158 (const descending)))
159
160
161(defcustom consult-mu-search-threads mu4e-search-threads
162 "Whether to calculate threads for search results.
163
164By defualt inherits from `mu4e-search-threads'.
165
166Note that per mu4e docs:
167When threading is enabled, the headers are exclusively sorted
168chronologically (:date) by the newest message in the thread."
169 :group 'consult-mu
170 :type 'boolean)
171
172(defcustom consult-mu-group-by nil
173 "What field to use to group the results in the minibuffer.
174
175By default it is set to :date, but can be any of:
176
177 :subject group by subject
178 :from group by the name/email the sender(s)
179 :to group by name/email of the reciver(s)
180 :date group by date
181 :time group by the time of email \(i.e. hour, minute, seconds\)
182 :datetime group by date and time of the email
183 :year group by the year of the email \(i.e. 2023, 2022, ...\)
184 :month group by the month of the email \(i.e. Jan, Feb, ..., Dec\)
185 :week group by the week number of the email
186 \(i.e. 1st week, 2nd week, ... 52nd week\)
187 :day-of-week group by the day email was sent (i.e. Mondays, Tuesdays, ...)
188 :day group by the day email was sent (similar to :day-of-week)
189 :size group by the file size of the email
190 :flags group by flags (as defined by mu)
191 :tags group by tags (as defined by mu)
192 :changed group by the date changed
193 \(as defined by :changed field in mu4e\)"
194 :group 'consult-mu
195 :type '(radio (const :date)
196 (const :subject)
197 (const :from)
198 (const :to)
199 (const :time)
200 (const :datetime)
201 (const :year)
202 (const :month)
203 (const :week)
204 (const :day-of-week)
205 (const :day)
206 (const :size)
207 (const :flags)
208 (const :tags)
209 (const :changed)
210 (const nil)))
211
212(defcustom consult-mu-mark-previewed-as-read nil
213 "Whether to mark PREVIEWED emails as read or not?"
214 :group 'consult-mu
215 :type 'boolean)
216
217(defcustom consult-mu-mark-viewed-as-read t
218 "Whether to mark VIEWED emails as read or not?"
219 :group 'consult-mu
220 :type 'boolean)
221
222(defcustom consult-mu-headers-buffer-name "*consult-mu-headers*"
223 "Default name for HEADERS buffer explicitly for `consult-mu'.
224
225For more info see `mu4e-headers-buffer-name'."
226 :group 'consult-mu
227 :type 'string)
228
229(defcustom consult-mu-view-buffer-name "*consult-mu-view*"
230 "Default name for VIEW buffer explicitly for `consult-mu'.
231
232For more info see `mu4e-view-buffer-name'."
233 :group 'consult-mu
234 :type 'string)
235
236(defcustom consult-mu-preview-key consult-preview-key
237 "Preview key for `consult-mu'.
238
239This is similar to `consult-preview-key' but explicitly for `consult-mu'."
240 :group 'consult-mu
241 :type '(choice (symbol :tag "Any key" 'any)
242 (list :tag "Debounced"
243 (const :debounce)
244 (float :tag "Seconds" 0.1)
245 (const any))
246 (const :tag "No preview" nil)
247 (key :tag "Key")
248 (repeat :tag "List of keys" key)))
249
250
251(defcustom consult-mu-highlight-matches t
252 "Should `consult-mu' highlight search queries in preview buffers?"
253 :group 'consult-mu
254 :type 'boolean)
255
256(defcustom consult-mu-use-wide-reply 'ask
257 "Reply to all or not?
258
259This defines whether `consult-mu--reply-action' should reply to all or not."
260 :group 'consult-mu
261 :type '(choice (symbol :tag "Ask for confirmation" 'ask)
262 (const :tag "Do not reply to all" nil)
263 (const :tag "Always reply to all" t)))
264
265(defcustom consult-mu-action #'consult-mu--view-action
266 "The function that is used when selecting a message.
267By default it is bound to `consult-mu--view-action'."
268 :group 'consult-mu
269 :type '(choice (function :tag "(Default) View Message in Mu4e Buffers" consult-mu--view-action)
270 (function :tag "Reply to Message" consult-mu--reply-action)
271 (function :tag "Forward Message" consult-mu--forward-action)
272 (function :tag "Custom Function")))
273
274(defcustom consult-mu-default-command #'consult-mu-dynamic
275 "Which command should `consult-mu' call."
276 :group 'consult-mu
277 :type '(choice (function :tag "(Default) Use Dynamic Collection (i.e. `consult-mu-dynamic')" #'consult-mu-dynamic)
278 (function :tag "Use Async Collection (i.e. `consult-mu-async')" #'consult-mu-async)
279 (function :tag "Custom Function")))
280
281;;; Other Variables
282(defvar consult-mu-category 'consult-mu
283 "Category symbol for the `consult-mu' package.")
284
285(defvar consult-mu-messages-category 'consult-mu-messages
286 "Category symbol for messages in `consult-mu' package.")
287
288(defvar consult-mu--view-buffers-list (list)
289 "List of currently open preview buffers for `consult-mu'.")
290
291(defvar consult-mu--history nil
292 "History variable for `consult-mu'.")
293
294(defvar consult-mu-delimiter " "
295 "Delimiter to use for fields in mu command output.
296
297The idea is Taken from https://github.com/seanfarley/counsel-mu.")
298
299(defvar consult-mu-saved-searches-dynamic (list)
300 "List of Favorite searches for `consult-mu-dynamic'.")
301
302(defvar consult-mu-saved-searches-async consult-mu-saved-searches-dynamic
303 "List of Favorite searches for `consult-mu-async'.")
304
305(defvar consult-mu--override-group nil
306 "Override grouping in `consult-mu' based on user input.")
307
308(defvar consult-mu--mail-headers '("Subject" "From" "To" "From/To" "Cc" "Bcc" "Reply-To" "Date" "Attachments" "Tags" "Flags" "Maildir" "Summary" "List" "Path" "Size" "Message-Id" "List-Id" "Changed")
309 "List of possible headers in a message.")
310
311;;; Faces
312
313(defface consult-mu-highlight-match-face
314 `((t :inherit 'consult-highlight-match))
315 "Highlight match face in `consult-mu' view buffer.
316
317By default inherits from `consult-highlight-match'.
318This is used to highlight matches of search queries in the minibufffer
319completion list.")
320
321(defface consult-mu-preview-match-face
322 `((t :inherit 'consult-preview-match))
323 "Preview match face in `consult-mu' preview buffers.
324
325By default inherits from `consult-preview-match'.
326This is used to highlight matches of search query terms in preview buffers
327\(i.e. `consult-mu-view-buffer-name'\).")
328
329(defface consult-mu-default-face
330 `((t :inherit 'default))
331 "Default face in `consult-mu' minibuffer annotations.
332
333By default inherits from `default' face.")
334
335(defface consult-mu-subject-face
336 `((t :inherit 'font-lock-keyword-face))
337 "Subject face in `consult-mu' minibuffer annotations.
338
339By default inherits from `font-lock-keyword-face'.")
340
341(defface consult-mu-sender-face
342 `((t :inherit 'font-lock-variable-name-face))
343 "Contact face in `consult-mu' minibuffer annotations.
344
345By default inherits from `font-lock-variable-name-face'.")
346
347(defface consult-mu-receiver-face
348 `((t :inherit 'font-lock-variable-name-face))
349 "Contact face in `consult-mu' minibuffer annotations.
350
351By default inherits from `font-lock-variable-name-face'.")
352
353(defface consult-mu-date-face
354 `((t :inherit 'font-lock-preprocessor-face))
355 "Date face in `consult-mu' minibuffer annotations.
356
357By default inherits from `font-lock-preprocessor-face'.")
358
359(defface consult-mu-count-face
360 `((t :inherit 'font-lock-string-face))
361 "Count face in `consult-mu' minibuffer annotations.
362
363By default inherits from `font-lock-string-face'.")
364
365(defface consult-mu-size-face
366 `((t :inherit 'font-lock-string-face))
367 "Size face in `consult-mu' minibuffer annotations.
368
369By default inherits from `font-lock-string-face'.")
370
371(defface consult-mu-tags-face
372 `((t :inherit 'font-lock-comment-face))
373 "Tags/Comments face in `consult-mu' minibuffer annotations.
374
375By default inherits from `font-lock-comment-face'.")
376
377(defface consult-mu-flags-face
378 `((t :inherit 'font-lock-function-call-face))
379 "Flags face in `consult-mu' minibuffer annotations.
380
381By default inherits from `font-lock-function-call-face'.")
382
383(defface consult-mu-url-face
384 `((t :inherit 'link))
385 "URL face in `consult-mu' minibuffer annotations;
386
387By default inherits from `link'.")
388
389(defun consult-mu--pulse-regexp (regexp)
390 "Find and pulse REGEXP."
391 (goto-char (point-min))
392 (while (re-search-forward regexp nil t)
393 (when-let* ((m (match-data))
394 (beg (car m))
395 (end (cadr m))
396 (ov (make-overlay beg end))
397 (pulse-delay 0.075))
398 (pulse-momentary-highlight-overlay ov 'highlight))))
399
400(defun consult-mu--pulse-region (beg end)
401 "Find and pulse region from BEG to END."
402 (let ((ov (make-overlay beg end))
403 (pulse-delay 0.075))
404 (pulse-momentary-highlight-overlay ov 'highlight)))
405
406(defun consult-mu--pulse-line ()
407 "Pulse line at point momentarily."
408 (let* ((pulse-delay 0.055)
409 (ov (make-overlay (car (bounds-of-thing-at-point 'line))
410 (cdr (bounds-of-thing-at-point 'line)))))
411 (pulse-momentary-highlight-overlay ov 'highlight)))
412
413(defun consult-mu--set-string-width (string width &optional prepend)
414 "Set the STRING width to a fixed value, WIDTH.
415
416If the STRING is longer than WIDTH, it truncates the string and adds
417ellipsis, “...”. If the string is shorter, it adds whitespace to the
418string. If PREPEND is non-nil, it truncates or adds whitespace from the
419beginning of string, instead of the end."
420 (let* ((string (format "%s" string))
421 (w (string-width string)))
422 (when (< w width)
423 (if prepend
424 (setq string (format "%s%s" (make-string (- width w) ?\s) (substring string)))
425 (setq string (format "%s%s" (substring string) (make-string (- width w) ?\s)))))
426 (when (> w width)
427 (if prepend
428 (setq string (format "...%s" (substring string (- w (- width 3)) w)))
429 (setq string (format "%s..." (substring string 0 (- width (+ w 3)))))))
430 string))
431
432(defun consult-mu--justify-left (string prefix maxwidth)
433 "Set the width of STRING+PREFIX justified from left.
434
435Use `consult-mu--set-string-width' to the width of the concatenate of
436STRING+PREFIX \(e.g. “(concat prefix string)”\) within MAXWIDTH. This is
437used for aligning marginalia info in the minibuffer."
438 (let ((w (string-width prefix)))
439 (if (> maxwidth w)
440 (consult-mu--set-string-width string (- maxwidth w) t)
441 string)))
442
443(defun consult-mu--highlight-match (regexp str ignore-case)
444 "Highlight REGEXP in STR.
445
446If a REGEXP contains a capturing group, only the captured group is
447highlighted, otherwise, the whole match is highlighted.
448Case is ignored if IGNORE-CASE is non-nil.
449\(This is adapted from `consult--highlight-regexps'.\)"
450 (let ((i 0))
451 (while (and (let ((case-fold-search ignore-case))
452 (string-match regexp str i))
453 (> (match-end 0) i))
454 (let ((m (match-data)))
455 (setq i (cadr m)
456 m (or (cddr m) m))
457 (while m
458 (when (car m)
459 (add-face-text-property (car m) (cadr m)
460 'consult-mu-highlight-match-face nil str))
461 (setq m (cddr m))))))
462 str)
463
464(defun consult-mu--overlay-match (match-str buffer ignore-case)
465 "Highlight MATCH-STR in BUFFER using an overlay.
466
467If IGNORE-CASE is non-nil, it uses case-insensitive match.
468
469This is used to highlight matches to use queries when viewing emails. See
470`consult-mu-overlays-toggle' for toggling highligths on/off."
471 (with-current-buffer (or (get-buffer buffer) (current-buffer))
472 (remove-overlays (point-min) (point-max) 'consult-mu-overlay t)
473 (goto-char (point-min))
474 (let ((case-fold-search ignore-case))
475 (while (search-forward match-str nil t)
476 (when-let* ((m (match-data))
477 (beg (car m))
478 (end (cadr m))
479 (overlay (make-overlay beg end)))
480 (overlay-put overlay 'consult-mu-overlay t)
481 (overlay-put overlay 'face 'consult-mu-highlight-match-face))))))
482
483(defun consult-mu-overlays-toggle (&optional buffer)
484 "Toggle overlay highlight in BUFFER.
485
486BUFFER defaults to `current-buffer'."
487 (interactive)
488 (let ((buffer (or buffer (current-buffer))))
489 (with-current-buffer buffer
490 (dolist (o (overlays-in (point-min) (point-max)))
491 (when (overlay-get o 'consult-mu-overlay)
492 (if (and (overlay-get o 'face) (eq (overlay-get o 'face) 'consult-mu-highlight-match-face))
493 (overlay-put o 'face nil)
494 (overlay-put o 'face 'consult-mu-highlight-match-face)))))))
495
496(defun consult-mu--format-date (string)
497 "Format the date STRING from mu output.
498
499STRING is the output form a mu command, for example:
500`mu find query --fields d`
501Returns the date in the format Day-of-Week Month Day Year Time
502\(e.g. Sat Nov 04 2023 09:46:54\)"
503 (let ((string (replace-regexp-in-string " " "0" string)))
504 (format "%s %s %s"
505 (substring string 0 10)
506 (substring string -4 nil)
507 (substring string 11 -4))))
508
509(defun consult-mu-flags-to-string (FLAG)
510 "Covert FLAGS, from mu output to strings.
511
512FLAG is the output form mu command in the terminal, for example:
513 `mu find query --fields g`.
514This function converts each character in FLAG to an expanded string of the
515flag and returns the list of these strings."
516 (cl-loop for c across FLAG
517 collect
518 (pcase (string c)
519 ("D" 'draft)
520 ("F" 'flagged)
521 ("N" 'new)
522 ("P" 'forwarded)
523 ("R" 'replied)
524 ("S" 'read)
525 ("T" 'trashed)
526 ("a" 'attachment)
527 ("x" 'encrrypted)
528 ("s" 'signed)
529 ("u" 'unread)
530 ("l" 'list)
531 ("q" 'personal)
532 ("c" 'calendar)
533 (_ nil))))
534
535(defun consult-mu--message-extract-email-from-string (string)
536 "Find and return the first email address in the STRING."
537 (when (stringp string)
538 (string-match "[a-zA-Z0-9\_\.\+\-]+@[a-zA-Z0-9\-]+\.[a-zA-Z0-9\-\.]+" string)
539 (match-string 0 string)))
540
541(defun consult-mu--message-emails-string-to-list (string)
542 "Convert comma-separated STRING of email addresses to a list."
543 (when (stringp string)
544 (remove '(" " "\s" "\t")
545 (mapcar #'consult-mu--message-extract-email-from-string
546 (split-string string ",\\|;\\|\t" t)))))
547
548(defun consult-mu--message-get-header-field (&optional field)
549 "Retrive FIELD header from the message/mail in the current buffer."
550 (save-match-data
551 (save-excursion
552 (when (or (derived-mode-p 'message-mode)
553 (derived-mode-p 'mu4e-view-mode)
554 (derived-mode-p 'org-msg-edit-mode)
555 (derived-mode-p 'mu4e-compose-mode))
556 (let* ((case-fold-search t)
557 (header-regexp (mapconcat (lambda (str) (concat "\n" str ": "))
558 consult-mu--mail-headers "\\|"))
559 (field (or (downcase field)
560 (downcase (consult--read consult-mu--mail-headers
561 :prompt "Header Field: ")))))
562 (if (string-prefix-p "attachment" field) (setq field "\\(attachment\\|attachments\\)"))
563 (goto-char (point-min))
564 (message-goto-body)
565 (let* ((match (re-search-backward (concat "^" field ": \\(?1:[[:ascii:][:nonascii:]]*?\\)\n\\(.*?:\\|\n\\)") nil t))
566 (str (if (and match (match-string 1)) (string-trim (match-string 1)))))
567 (if (string-empty-p str) nil str)))))))
568
569(defun consult-mu--headers-append-handler (msglst)
570 "Append one-line descriptions of messages in MSGLST.
571
572This is used to override `mu4e~headers-append-handler' to ensure that
573buffer handling is done right for `consult-mu'."
574 (with-current-buffer "*consult-mu-headers*"
575 (let ((inhibit-read-only t))
576 (seq-do
577 ;; I use mu4e-column-faces and it overrides the default append-handler. To get the same effect I check if mu4e-column-faces is active and enabled.
578 (if (and (featurep 'mu4e-column-faces) mu4e-column-faces-mode)
579 (lambda (msg)
580 (mu4e-column-faces--insert-header msg (point-max)))
581 (lambda (msg)
582 (mu4e~headers-insert-header msg (point-max))))
583 msglst))))
584
585(defun consult-mu--view-msg (msg &optional buffername)
586 "Display the message MSG in a buffer with BUFFERNAME.
587
588BUFFERNAME defaults to `consult-mu-view-buffer-name'.
589
590This s used to overrides `mu4e-view' to ensure that buffer handling is done
591right for `consult-mu'."
592 (let* ((linked-headers-buffer (mu4e-get-headers-buffer "*consult-mu-headers*" t))
593 (mu4e-view-buffer-name (or buffername consult-mu-view-buffer-name)))
594 (setq gnus-article-buffer (mu4e-get-view-buffer linked-headers-buffer t))
595 (with-current-buffer gnus-article-buffer
596 (let ((inhibit-read-only t))
597 (remove-overlays (point-min) (point-max) 'mu4e-overlay t)
598 (erase-buffer)
599 (insert-file-contents-literally
600 (mu4e-message-readable-path msg) nil nil nil t)
601 (setq-local mu4e--view-message msg)
602 (mu4e--view-render-buffer msg)
603 (mu4e-loading-mode 0)
604 (with-current-buffer linked-headers-buffer
605 (setq-local mu4e~headers-view-win (mu4e-display-buffer gnus-article-buffer nil)))
606 (run-hooks 'mu4e-view-rendered-hook)))))
607
608(defun consult-mu--headers-clear (&optional text)
609 "Clear the headers buffer and related data structures.
610
611Optionally, show TEXT.
612
613This is used to override `mu4e~headers-clear' to ensure that buffer
614handling is done right for `consult-mu'."
615 (setq mu4e~headers-render-start (float-time)
616 mu4e~headers-hidden 0)
617 (with-current-buffer "*consult-mu-headers*"
618 (let ((inhibit-read-only t))
619 (mu4e--mark-clear)
620 (erase-buffer)
621 (when text
622 (goto-char (point-min))
623 (insert (propertize text 'face 'mu4e-system-face 'intangible t))))))
624
625(defun consult-mu--set-mu4e-search-sortfield (opts)
626 "Dynamically set the `mu4e-search-sort-field' based on user input.
627
628Uses user input (i.e. from `consult-mu' command) to define the sort field.
629
630OPTS is the command line options for mu and can be set by entering options
631in the minibuffer input. For more details, refer to `consult-grep' and
632consult async documentation.
633
634For example if the user enters the following in the minibuffer:
635
636“#query -- --maxnum 400 --sortfield from”
637
638`mu4e-search-sort-field' is set to :from
639
640Note that per mu4e docs:
641When threading is enabled, the headers are exclusively sorted
642chronologically (:date) by the newest message in the thread."
643 (let* ((sortfield (cond
644 ((member "-s" opts) (nth (+ (cl-position "-s" opts :test 'equal) 1) opts))
645 ((member "--sortfield" opts) (nth (+ (cl-position "--sortfield" opts :test 'equal) 1) opts))
646 (t consult-mu-search-sort-field))))
647 (pcase sortfield
648 ('nil
649 consult-mu-search-sort-field)
650 ((or "date" "d")
651 :date)
652 ((or "subject" "s")
653 :subject)
654 ((or "size" "z")
655 :size)
656 ((or "prio" "p")
657 :prio)
658 ((or "from" "f")
659 :from)
660 ((or "to" "t")
661 :to)
662 ((or "list" "v")
663 :list)
664 ;; ((or "tags" "x")
665 ;; :tags)
666 (_
667 consult-mu-search-sort-field))))
668
669(defun consult-mu--set-mu4e-search-sort-direction (opts)
670 "Dynamically set the `mu4e-search-sort-direction' based on user input.
671
672Uses user input \(i.e. from `consult-mu' command\) to define the sort field.
673
674OPTS is the command line options for mu and can be set by entering options
675in the minibuffer input. For more details, refer to `consult-grep' and
676consult async documentation.
677
678For example, if the user enters the following in the minibuffer:
679
680“#query -- --maxnum 400 --sortfield from --reverse”
681
682The `mu4e-search-sort-direction' is reversed; If it is set to
683\='ascending, it is toggled to \='descending and vise versa."
684 (if (or (member "-z" opts) (member "--reverse" opts))
685 (pcase consult-mu-search-sort-direction
686 ('descending
687 'ascending)
688 ('ascending
689 'descending))
690 consult-mu-search-sort-direction))
691
692(defun consult-mu--set-mu4e-skip-duplicates (opts)
693 "Dynamically set the `mu4e-search-skip-duplicates' based on user input.
694
695Uses user input \(i.e. from `consult-mu' command\) to define whether to
696skip duplicates.
697
698OPTS is the command line options for mu and can be set by entering options
699in the minibuffer input. For more details, refer to `consult-grep' and
700consult async documentation.
701
702For example, if the user enters the following in the minibuffer:
703
704“#query -- --maxnum 400 --skip-dups”
705
706The `mu4e-search-skip-duplicates' is set to t."
707 (if (or (member "--skip-dups" opts) mu4e-search-skip-duplicates) t nil))
708
709(defun consult-mu--set-mu4e-results-limit (opts)
710 "Dynamically set the `mu4e-search-results-limit' based on user input.
711
712
713Uses user input \(i.e. from `consult-mu' command\) to define the number of
714results shown.
715
716OPTS is the command line options for mu and can be set by entering options
717in the minibuffer input. For more details, refer to `consult-grep' and
718consult async documentation.
719
720For example, if the user enters the following in the minibuffer:
721
722“#query -- --maxnum 400”
723
724The `mu4e-search-results-limit' is set to 400."
725 (cond
726 ((member "-n" opts) (string-to-number (nth (+ (cl-position "-n" opts :test 'equal) 1) opts)))
727 ((member "--maxnum" opts) (string-to-number (nth (+ (cl-position "--maxnum" opts :test 'equal) 1) opts)))
728 (t consult-mu-maxnum)))
729
730
731(defun consult-mu--set-mu4e-include-related (opts)
732 "Dynamically set the `mu4e-search-include-related' based on user input.
733
734Uses user input \(i.e. from `consult-mu' command\) to define whether to
735include related messages.
736
737OPTS is the command line options for mu and can be set by entering options
738in the minibuffer input. For more details, refer to `consult-grep' and
739consult async documentation.
740
741For example if the user enters the following in the minibuffer:
742
743“#query -- --include-related”
744
745The `mu4e-search-include-related' is set to t."
746 (if (or (member "-r" opts) (member "--include-related" opts) mu4e-search-include-related) t nil))
747
748
749
750(defun consult-mu--set-mu4e-threads (opts)
751 "Set the `mu4e-search-threads' based on `mu4e-search-sort-field'.
752
753Uses user input \(i.e. from `consult-mu' command\) to define whether to
754show threads.
755
756OPTS is the command line options for mu and can be set by entering options
757in the minibuffer input. For more details, refer to `consult-grep' and
758consult async documentation.
759
760Note that per mu4e docs, when threading is enabled, the headers are
761exclusively sorted by date. Here the logic is reversed in order to allow
762dynamically sorting by fields other than date \(even when threads are
763enabled\). In other words, if the sort-field is not the :date, threading
764is disabled because otherwise sort field will be ignored. This allows the
765user to use command line arguments to sort messages by fields other than
766the date. For example, the user can enter the following in the minibuffer
767input to sort by subject
768
769“#query -- --sortfield subject”
770
771When the sort-field is :date, the default setting,
772`consult-mu-search-threads' is used, and if that is set to nil, the user
773can use command line arguments \(a.k.a. -t or --thread\) to enable it
774dynamically."
775 (cond
776 ((not (equal mu4e-search-sort-field :date))
777 nil)
778 ((or (member "-t" opts) (member "--threads" opts) consult-mu-search-threads)
779 t)))
780
781(defun consult-mu--update-headers (query ignore-history msg type)
782 "Search for QUERY, and update `consult-mu-headers-buffer-name' buffer.
783
784If IGNORE-HISTORY is true, does *not* update the query history stack,
785`mu4e--search-query-past'.
786If MSG is non-nil, put the cursor on MSG.
787TYPE can be either \=':dynamic or \=':async"
788 (consult-mu--execute-all-marks)
789 (cl-letf* (((symbol-function #'mu4e~headers-append-handler) #'consult-mu--headers-append-handler))
790 (unless (mu4e-running-p) (mu4e--server-start))
791 (let* ((buf (mu4e-get-headers-buffer consult-mu-headers-buffer-name t))
792 (view-buffer (get-buffer consult-mu-view-buffer-name))
793 (expr (car (consult--command-split (substring-no-properties query))))
794 (rewritten-expr (funcall mu4e-query-rewrite-function expr))
795 (mu4e-headers-fields consult-mu-headers-fields))
796 (pcase type
797 (:dynamic)
798 (:async
799 (setq rewritten-expr (funcall mu4e-query-rewrite-function (concat "msgid:" (plist-get msg :message-id)))))
800 (_ ))
801
802 (with-current-buffer buf
803 (save-excursion
804 (let ((inhibit-read-only t))
805 (erase-buffer)
806 (mu4e-headers-mode)
807 (setq-local mu4e-view-buffer-name consult-mu-view-buffer-name)
808 (if view-buffer
809 (setq-local mu4e~headers-view-win (mu4e-display-buffer gnus-article-buffer nil)))
810 (unless ignore-history
811 ; save the old present query to the history list
812 (when mu4e--search-last-query
813 (mu4e--search-push-query mu4e--search-last-query 'past)))
814 (setq mu4e--search-last-query rewritten-expr)
815 (setq list-buffers-directory rewritten-expr)
816 (mu4e--modeline-update)
817 (run-hook-with-args 'mu4e-search-hook expr)
818 (consult-mu--headers-clear mu4e~search-message)
819 (setq mu4e~headers-search-start (float-time))
820
821 (pcase-let* ((`(,_arg . ,opts) (consult--command-split query))
822 (mu4e-search-sort-field (consult-mu--set-mu4e-search-sortfield opts))
823 (mu4e-search-sort-direction (consult-mu--set-mu4e-search-sort-direction opts))
824 (mu4e-search-skip-duplicates (consult-mu--set-mu4e-skip-duplicates opts))
825 (mu4e-search-results-limit (consult-mu--set-mu4e-results-limit opts))
826 (mu4e-search-threads (consult-mu--set-mu4e-threads opts))
827 (mu4e-search-include-related (consult-mu--set-mu4e-include-related opts)))
828 (mu4e--server-find
829 rewritten-expr
830 mu4e-search-threads
831 mu4e-search-sort-field
832 mu4e-search-sort-direction
833 mu4e-search-results-limit
834 mu4e-search-skip-duplicates
835 mu4e-search-include-related))
836 (while (or (string-empty-p (buffer-substring (point-min) (point-max)))
837 (equal (buffer-substring (point-min) (+ (point-min) (length mu4e~search-message))) mu4e~search-message)
838 (not (or (equal (buffer-substring (- (point-max) (length mu4e~no-matches)) (point-max)) mu4e~no-matches) (equal (buffer-substring (- (point-max) (length mu4e~end-of-results)) (point-max)) mu4e~end-of-results))))
839 (sleep-for 0.005))))))))
840
841(defun consult-mu--execute-all-marks (&optional no-confirmation)
842 "Execute the actions for all marked messages.
843
844Executes all actions for marked messages in the buffer
845`consult-mu-headers-buffer-name'.
846
847If NO-CONFIRMATION is non-nil, don't ask user for confirmation.
848
849This is similar to `mu4e-mark-execute-all' but, with buffer/window
850handling set accordingly for `consult-mu'."
851 (interactive "P")
852 (when-let* ((buf (get-buffer consult-mu-headers-buffer-name)))
853 (with-current-buffer buf
854 (when (eq major-mode 'mu4e-headers-mode)
855 (mu4e--mark-in-context
856 (let* ((marknum (mu4e-mark-marks-num)))
857 (unless (zerop marknum)
858 (pop-to-buffer buf)
859 (unless (one-window-p) (delete-other-windows))
860 (mu4e-mark-execute-all no-confirmation)
861 (quit-window))))))))
862
863(defun consult-mu--headers-goto-message-id (msgid)
864 "Jump to message with MSGID.
865
866This is done in `consult-mu-headers-buffer-name' buffer."
867 (when-let ((buffer consult-mu-headers-buffer-name))
868 (with-current-buffer buffer
869 (setq mu4e-view-buffer-name consult-mu-view-buffer-name)
870 (mu4e-headers-goto-message-id msgid))))
871
872(defun consult-mu--get-message-by-id (msgid)
873 "Find the message with MSGID and return the mu4e MSG plist for it."
874 (cl-letf* (((symbol-function #'mu4e-view) #'consult-mu--view-msg))
875 (when-let ((buffer consult-mu-headers-buffer-name))
876 (with-current-buffer buffer
877 (setq mu4e-view-buffer-name consult-mu-view-buffer-name)
878 (mu4e-headers-goto-message-id msgid)
879 (mu4e-message-at-point)))))
880
881(defun consult-mu--contact-string-to-plist (string)
882 "Convert STRING for contacts to plist.
883
884STRING is the output form mu command, for example from:
885`mu find query --fields f`
886
887Returns a plist with \=':email and \':name keys.
888
889For example
890
891“John Doe <john.doe@example.com>”
892
893will be converted to
894
895\(:name “John Doe” :email “john.doe@example.com”\)"
896 (let* ((string (replace-regexp-in-string ">,\s\\|>;\s" ">\n" string))
897 (list (split-string string "\n" t)))
898 (mapcar (lambda (item)
899 (cond
900 ((string-match "\\(?2:.*\\)\s+<\\(?1:.+\\)>" item)
901 (list :email (or (match-string 1 item) nil) :name (or (match-string 2 item) nil)))
902 ((string-match "^\\(?1:[a-zA-Z0-9\_\.\+\-]+@[a-zA-Z0-9\-]+\.[a-zA-Z0-9\-\.]+\\)" item)
903 (list :email (or (match-string 1 item) nil) :name nil))
904 (t
905 (list :email (format "%s" item) :name nil)))) list)))
906
907(defun consult-mu--contact-name-or-email (contact)
908 "Retrieve name or email of CONTACT.
909
910Looks at the contact plist \(e.g. (:name “John Doe” :email
911“john.doe@example.com”)\) and returns the name. If the name is missing,
912returns the email address."
913 (cond
914 ((stringp contact)
915 contact)
916 ((listp contact)
917 (mapconcat (lambda (item) (or (plist-get item :name) (plist-get item :email) "")) contact ","))))
918
919(defun consult-mu--headers-template ()
920 "Make headers template using `consult-mu-headers-template'."
921 (if (and consult-mu-headers-template (functionp consult-mu-headers-template))
922 (funcall consult-mu-headers-template)
923 consult-mu-headers-template))
924
925(defun consult-mu--expand-headers-template (msg string)
926 "Expand STRING to create a custom header format for MSG.
927
928See `consult-mu-headers-template' for explanation of the format of
929STRING."
930
931 (cl-loop for c in (split-string string "%" t)
932 concat (concat (pcase (substring c 0 1)
933 ("f" (let ((sender (consult-mu--contact-name-or-email (plist-get msg :from)))
934 (length (string-to-number (substring c 1 nil))))
935 (if sender
936 (propertize (if (> length 0) (consult-mu--set-string-width sender length) sender) 'face 'consult-mu-sender-face))))
937 ("t" (let ((receiver (consult-mu--contact-name-or-email (plist-get msg :to)))
938 (length (string-to-number (substring c 1 nil))))
939 (if receiver
940 (propertize (if (> length 0) (consult-mu--set-string-width receiver length) receiver) 'face 'consult-mu-sender-face))))
941 ("s" (let ((subject (plist-get msg :subject))
942 (length (string-to-number (substring c 1 nil))))
943 (if subject
944 (propertize (if (> length 0) (consult-mu--set-string-width subject length) subject) 'face 'consult-mu-subject-face))))
945 ("d" (let ((date (format-time-string "%a %d %b %y" (plist-get msg :date)))
946 (length (string-to-number (substring c 1 nil))))
947 (if date
948 (propertize (if (> length 0) (consult-mu--set-string-width date length) date) 'face 'consult-mu-date-face))))
949
950 ("p" (let ((priority (plist-get msg :priority))
951 (length (string-to-number (substring c 1 nil))))
952 (if priority
953 (propertize (if (> length 0) (consult-mu--set-string-width (format "%s" priority) length) (format "%s" priority)) 'face 'consult-mu-size-face))))
954 ("z" (let ((size (file-size-human-readable (plist-get msg :size)))
955 (length (string-to-number (substring c 1 nil))))
956 (if size
957 (propertize (if (> length 0) (consult-mu--set-string-width size length) size) 'face 'consult-mu-size-face))))
958 ("i" (let ((id (plist-get msg :message-id))
959 (length (string-to-number (substring c 1 nil))))
960 (if id
961 (propertize (if (> length 0) (consult-mu--set-string-width id length) id) 'face 'consult-mu-default-face))))
962
963 ("g" (let ((flags (plist-get msg :flags))
964 (length (string-to-number (substring c 1 nil))))
965 (if flags
966 (propertize (if (> length 0) (consult-mu--set-string-width (format "%s" flags) length) (format "%s" flags)) 'face 'consult-mu-flags-face))))
967
968 ("G" (let ((flags (plist-get msg :flags))
969 (length (string-to-number (substring c 1 nil))))
970 (if flags
971 (propertize (if (> length 0) (consult-mu--set-string-width (format "%s" (mu4e~headers-flags-str flags)) length) (format "%s" (mu4e~headers-flags-str flags))) 'face 'consult-mu-flags-face))))
972
973 ("x" (let ((tags (plist-get msg :tags))
974 (length (string-to-number (substring c 1 nil))))
975 (if tags
976 (propertize (if (> length 0) (consult-mu--set-string-width tags length) tags) 'face 'consult-mu-tags-face) nil)))
977
978 ("c" (let ((cc (consult-mu--contact-name-or-email (plist-get msg :cc)))
979 (length (string-to-number (substring c 1 nil))))
980 (if cc
981 (propertize (if (> length 0) (consult-mu--set-string-width cc length) cc) 'face 'consult-mu-tags-face))))
982
983 ("h" (let ((bcc (consult-mu--contact-name-or-email (plist-get msg :bcc)))
984 (length (string-to-number (substring c 1 nil))))
985 (if bcc
986 (propertize (if (> length 0) (consult-mu--set-string-width bcc length) bcc) 'face 'consult-mu-tags-face))))
987
988 ("r" (let ((changed (format-time-string "%a %d %b %y" (plist-get msg :changed)))
989 (length (string-to-number (substring c 1 nil))))
990 (if changed
991 (propertize (if (> length 0) (consult-mu--set-string-width changed length) changed) 'face 'consult-mu-tags-face))))
992 (_ nil))
993 " ")))
994
995(defun consult-mu--quit-header-buffer ()
996 "Quits `consult-mu-headers-buffer-name' buffer."
997 (save-mark-and-excursion
998 (when-let* ((buf (get-buffer consult-mu-headers-buffer-name)))
999 (with-current-buffer buf
1000 (if (eq major-mode 'mu4e-headers-mode)
1001 (mu4e-mark-handle-when-leaving)
1002 (quit-window t)
1003 ;; clear the decks before going to the main-view
1004 (mu4e--query-items-refresh 'reset-baseline))))))
1005
1006(defun consult-mu--quit-view-buffer ()
1007 "Quits `consult-mu-view-buffer-name' buffer."
1008 (when-let* ((buf (get-buffer consult-mu-view-buffer-name)))
1009 (with-current-buffer buf
1010 (if (eq major-mode 'mu4e-view-mode)
1011 (mu4e-view-quit)))))
1012
1013(defun consult-mu--quit-main-buffer ()
1014 "Quits `mu4e-main-buffer-name' buffer."
1015 (when-let* ((buf (get-buffer mu4e-main-buffer-name)))
1016 (with-current-buffer buf
1017 (if (eq major-mode 'mu4e-main-mode)
1018 (mu4e-quit)))))
1019
1020(defun consult-mu--lookup ()
1021 "Lookup function for `consult-mu' or `consult-mu-async' candidates.
1022
1023This is passed as LOOKUP to `consult--read' on candidates and is used to
1024format the output when a candidate is selected."
1025 (lambda (sel cands &rest _args)
1026 (let* ((info (cdr (assoc sel cands)))
1027 (msg (plist-get info :msg))
1028 (subject (plist-get msg :subject)))
1029 (cons subject info))))
1030
1031(defun consult-mu--group-name (cand)
1032 "Get the group name of CAND using `consult-mu-group-by'.
1033
1034See `consult-mu-group-by' for details of grouping options."
1035 (let* ((msg (get-text-property 0 :msg cand))
1036 (group (or consult-mu--override-group consult-mu-group-by))
1037 (field (if (not (keywordp group)) (intern (concat ":" (format "%s" group))) group)))
1038 (pcase field
1039 (:date (format-time-string "%a %d %b %y" (plist-get msg field)))
1040 (:from (cond
1041 ((listp (plist-get msg field))
1042 (mapconcat (lambda (item) (or (plist-get item :name) (plist-get item :email))) (plist-get msg field) ";"))
1043 ((stringp (plist-get msg field)) (plist-get msg field))))
1044 (:to (cond
1045 ((listp (plist-get msg field))
1046 (mapconcat (lambda (item) (or (plist-get item :name) (plist-get item :email))) (plist-get msg field) ";"))
1047 ((stringp (plist-get msg field)) (plist-get msg field))))
1048 (:changed (format-time-string "%a %d %b %y" (plist-get msg field)))
1049 (:datetime (format-time-string "%F %r" (plist-get msg :date)))
1050 (:time (format-time-string "%X" (plist-get msg :date)))
1051 (:year (format-time-string "%Y" (plist-get msg :date)))
1052 (:month (format-time-string "%B" (plist-get msg :date)))
1053 (:day-of-week (format-time-string "%A" (plist-get msg :date)))
1054 (:day (format-time-string "%A" (plist-get msg :date)))
1055 (:week (format-time-string "%V" (plist-get msg :date)))
1056 (:size (file-size-human-readable (plist-get msg field)))
1057 (:flags (format "%s" (plist-get msg field)))
1058 (:tags (format "%s" (plist-get msg field)))
1059 (_ (if (plist-get msg field) (format "%s" (plist-get msg field)) nil)))))
1060
1061(defun consult-mu--group (cand transform)
1062 "Group function for `consult-mu' or `consult-mu-async'.
1063
1064CAND is passed to `consult-mu--group-name' to get the group for CAND.
1065When TRANSFORM is non-nil, the name of CAND is used for group."
1066 (when-let ((name (consult-mu--group-name cand)))
1067 (if transform (substring cand) name)))
1068
1069(defun consult-mu--view (msg noselect mark-as-read match-str)
1070 "Opens MSG in `consult-mu-headers' and `consult-mu-view'.
1071
1072If NOSELECT is non-nil, does not select the view buffer/window.
1073If MARK-AS-READ is non-nil, marks the MSG as read.
1074If MATCH-STR is non-nil, highlights the MATCH-STR in the view buffer."
1075 (let ((msgid (plist-get msg :message-id)))
1076 (when-let ((buf (mu4e-get-headers-buffer consult-mu-headers-buffer-name t)))
1077 (with-current-buffer buf
1078 ;;(mu4e-headers-mode)
1079 (goto-char (point-min))
1080 (setq mu4e-view-buffer-name consult-mu-view-buffer-name)
1081 (unless noselect
1082 (switch-to-buffer buf))))
1083
1084 (consult-mu--view-msg msg consult-mu-view-buffer-name)
1085
1086 (with-current-buffer consult-mu-headers-buffer-name
1087 (if msgid
1088 (progn
1089 (mu4e-headers-goto-message-id msgid)
1090 (if mark-as-read
1091 (mu4e--server-move (mu4e-message-field-at-point :docid) nil "+S-u-N")))))
1092
1093 (when match-str
1094 (add-to-history 'search-ring match-str)
1095 (consult-mu--overlay-match match-str consult-mu-view-buffer-name t))
1096
1097 (with-current-buffer consult-mu-view-buffer-name
1098 (goto-char (point-min)))
1099
1100 (unless noselect
1101 (when msg
1102 (select-window (get-buffer-window consult-mu-view-buffer-name))))
1103 consult-mu-view-buffer-name))
1104
1105
1106(defun consult-mu--view-action (cand)
1107 "Open the candidate, CAND.
1108
1109This is a wrapper function around `consult-mu--view'. It parses CAND to
1110extract relevant MSG plist and other information and passes them to
1111`consult-mu--view'.
1112
1113To use this as the default action for `consult-mu', set
1114`consult-mu-default-action' to \=#'consult-mu--view-action."
1115
1116 (let* ((info (cdr cand))
1117 (msg (plist-get info :msg))
1118 (query (plist-get info :query))
1119 (match-str (car (consult--command-split query))))
1120 (consult-mu--view msg nil consult-mu-mark-viewed-as-read match-str)
1121 (consult-mu-overlays-toggle consult-mu-view-buffer-name)))
1122
1123(defun consult-mu--reply (msg &optional wide-reply)
1124 "Reply to MSG using `mu4e-compose-reply'.
1125
1126If WIDE-REPLY is non-nil use wide-reply \(a.k.a. reply all\) with
1127`mu4e-compose-wide-reply'."
1128 (let ((msgid (plist-get msg :message-id)))
1129 (when-let ((buf (mu4e-get-headers-buffer consult-mu-headers-buffer-name t)))
1130 (with-current-buffer buf
1131 (goto-char (point-min))
1132 (setq mu4e-view-buffer-name consult-mu-view-buffer-name)))
1133
1134
1135 (with-current-buffer consult-mu-headers-buffer-name
1136 (mu4e-headers-goto-message-id msgid)
1137 (if (not wide-reply)
1138 (mu4e-compose-reply)
1139 (mu4e-compose-wide-reply)))))
1140
1141(defun consult-mu--reply-action (cand &optional wide-reply)
1142 "Reply to CAND.
1143
1144This is a wrapper function around `consult-mu--reply'. It passes
1145relevant message plist, from CAND, as well as WIDE-REPLY to
1146`consult-mu--reply'.
1147
1148To use this as the default action for `consult-mu', set
1149`consult-mu-default-action' to \=#'consult-mu--reply-action."
1150 (let* ((info (cdr cand))
1151 (msg (plist-get info :msg))
1152 (wide-reply (or wide-reply
1153 (pcase consult-mu-use-wide-reply
1154 ('ask (y-or-n-p "Reply All?"))
1155 ('nil nil)
1156 ('t t)))))
1157 (consult-mu--reply msg wide-reply)))
1158
1159(defun consult-mu--forward (msg)
1160 "Forward the MSG using `mu4e-compose-forward'."
1161 (let ((msgid (plist-get msg :message-id)))
1162 (when-let ((buf (mu4e-get-headers-buffer consult-mu-headers-buffer-name t)))
1163 (with-current-buffer buf
1164 (goto-char (point-min))
1165 (setq mu4e-view-buffer-name consult-mu-view-buffer-name)))
1166 (with-current-buffer consult-mu-headers-buffer-name
1167 (mu4e-headers-goto-message-id msgid)
1168 (mu4e-compose-forward))))
1169
1170(defun consult-mu--forward-action (cand)
1171 "Forward CAND.
1172
1173This is a wrapper function around `consult-mu--forward'. It passes
1174the relevant message plist, from CAND to `consult-mu--forward'.
1175
1176To use this as the default action for `consult-mu', set
1177`consult-mu-default-action' to \=#'consult-mu--forward-action."
1178 (let* ((info (cdr cand))
1179 (msg (plist-get info :msg)))
1180 (consult-mu--forward msg)))
1181
1182(defun consult-mu--get-split-style-character (&optional style)
1183 "Get the character for consult async split STYLE.
1184
1185STYLE defaults to `consult-async-split-style'."
1186 (let ((style (or style consult-async-split-style 'none)))
1187 (or (char-to-string (plist-get (alist-get style consult-async-split-styles-alist) :initial))
1188 (char-to-string (plist-get (alist-get style consult-async-split-styles-alist) :separator))
1189 "")))
1190
1191(defun consult-mu--dynamic-format-candidate (cand highlight)
1192 "Format minibuffer candidate, CAND.
1193
1194CAND is the minibuffer completion candidate \(a mu4e message collected by
1195`consult-mu--dynamic-collection'\). If HIGHLIGHT is non-nil, it is
1196highlighted with `consult-mu-highlight-match-face'."
1197
1198 (let* ((string (car cand))
1199 (info (cadr cand))
1200 (msg (plist-get info :msg))
1201 (query (plist-get info :query))
1202 (match-str (if (stringp query) (consult--split-escaped (car (consult--command-split query))) nil))
1203 (headers-template (consult-mu--headers-template))
1204 (str (if headers-template
1205 (consult-mu--expand-headers-template msg headers-template)
1206 string))
1207 (str (propertize str :msg msg :query query :type :dynamic)))
1208 (if (and consult-mu-highlight-matches highlight)
1209 (cond
1210 ((listp match-str)
1211 (mapc (lambda (match) (setq str (consult-mu--highlight-match match str t))) match-str))
1212 ((stringp match-str)
1213 (setq str (consult-mu--highlight-match match-str str t))))
1214 str)
1215 (when msg
1216 (cons str (list :msg msg :query query :type :dynamic)))))
1217
1218(defun consult-mu--dynamic-collection (input)
1219 "Dynamically collect mu4e search results.
1220
1221INPUT is the user input. It is passed as QUERY to
1222`consult-mu--update-headers', appends the result to
1223`consult-mu-headers-buffer-name' and returns a list of found
1224messages."
1225
1226 (save-excursion
1227 (pcase-let* ((`(,_arg . ,opts) (consult--command-split input)))
1228 (consult-mu--update-headers (substring-no-properties input) nil nil :dynamic)
1229 (if (or (member "-g" opts) (member "--group" opts))
1230 (cond
1231 ((member "-g" opts)
1232 (setq consult-mu--override-group (intern (or (nth (+ (cl-position "-g" opts :test 'equal) 1) opts) "nil"))))
1233 ((member "--group" opts)
1234 (setq consult-mu--override-group (intern (or (nth (+ (cl-position "--group" opts :test 'equal) 1) opts) "nil")))))
1235 (setq consult-mu--override-group nil)))
1236
1237 (with-current-buffer consult-mu-headers-buffer-name
1238 (goto-char (point-min))
1239 (remove nil
1240 (cl-loop until (eobp)
1241 collect (consult-mu--dynamic-format-candidate (list (buffer-substring (point) (line-end-position)) (list :msg (ignore-errors (mu4e-message-at-point)) :query input)) t)
1242 do (forward-line 1))))))
1243
1244(defun consult-mu--dynamic-state ()
1245 "State function for `consult-mu' candidates.
1246This is passed as STATE to `consult--read' and is used to preview or do
1247other actions on the candidate."
1248 (lambda (action cand)
1249 (let ((preview (consult--buffer-preview)))
1250 (pcase action
1251 ('preview
1252 (if cand
1253 (when-let* ((info (cdr cand))
1254 (msg (plist-get info :msg))
1255 (query (plist-get info :query))
1256 (msgid (substring-no-properties (plist-get msg :message-id)))
1257 (match-str (car (consult--command-split query)))
1258 (match-str (car (consult--command-split query)))
1259 (mu4e-headers-buffer-name consult-mu-headers-buffer-name)
1260 (buffer consult-mu-view-buffer-name))
1261 ;;(get-buffer-create consult-mu-view-buffer-name)
1262 (add-to-list 'consult-mu--view-buffers-list buffer)
1263 (funcall preview action
1264 (consult-mu--view msg t consult-mu-mark-previewed-as-read match-str))
1265 (with-current-buffer consult-mu-view-buffer-name
1266 (unless (one-window-p) (delete-other-windows))))))
1267 ('return
1268 (save-mark-and-excursion
1269 (consult-mu--execute-all-marks))
1270 (setq consult-mu--override-group nil)
1271 cand)))))
1272
1273(defun consult-mu--dynamic (prompt collection &optional initial)
1274 "Query mu4e messages dyunamically.
1275
1276This is a non-interactive internal function. For the interactive version
1277see `consult-mu'.
1278
1279It runs the `consult-mu--dynamic-collection' to do a `mu4e-search' with
1280user input \(e.g. INITIAL\) and returns the results \(list of messages
1281found\) as a completion table in minibuffer.
1282
1283The completion table gets dynamically updated as the user types in the
1284minibuffer. Each candidate in the minibuffer is formatted by
1285`consult-mu--dynamic-format-candidate' to add annotation and other info to
1286the candidate.
1287
1288Description of Arguments:
1289 PROMPT the prompt in the minibuffer
1290 \(passed as PROMPT to `consult--read'\)
1291 COLLECTION a colection function passed to `consult--dynamic-collection'.
1292 INITIAL an optional arg for the initial input in the minibuffer.
1293 \(passed as INITITAL to `consult--read'\)
1294
1295commandline arguments/options \(see `mu find --help` in the command line
1296for details\) can be passed to the minibuffer input similar to
1297`consult-grep'. For example the user can enter:
1298
1299“#paper -- --maxnum 200 --sortfield from --reverse”
1300
1301this will search for mu4e messages with the query “paper”, retrives a
1302maximum of 200 messages and sorts them by the “from:” field and reverses
1303the sort direction (opposite of `consult-mu-search-sort-field').
1304
1305Note that some command line arguments are not supported by mu4e (for
1306example sorting based on cc: or bcc: fields are not supported in
1307`mu4e-search-sort-field')
1308
1309Also, the results can further be narrowed by
1310`consult-async-split-style' \(e.g. by entering “#” when
1311`consult-async-split-style' is set to \='perl\).
1312
1313For example:
1314
1315“#paper -- --maxnum 200 --sortfield from --reverse#accepted”
1316
1317will retrieve the message as the example above, then narrows down the
1318candidates to those that that match “accepted”."
1319 (consult--read
1320 (consult--dynamic-collection (or collection #'consult-mu--dynamic-collection))
1321 :prompt (or prompt "Select: ")
1322 :lookup (consult-mu--lookup)
1323 :state (funcall #'consult-mu--dynamic-state)
1324 :initial initial
1325 :group #'consult-mu--group
1326 :add-history (append (list (thing-at-point 'symbol))
1327 consult-mu-saved-searches-dynamic)
1328 :history '(:input consult-mu--history)
1329 :require-match t
1330 :category 'consult-mu-messages
1331 :preview-key consult-mu-preview-key
1332 :sort nil))
1333
1334(defun consult-mu-dynamic (&optional initial noaction)
1335 "Lists results of `mu4e-search' dynamically.
1336
1337This is an interactive wrapper function around `consult-mu--dynamic'. It
1338queries the user for a search term in the minibuffer, then fetches a list
1339of messages for the entered search term as a minibuffer completion table
1340for selection. The list of candidates in the completion table are
1341dynamically updated as the user changes the entry.
1342
1343Upon selection of a candidate either
1344 - the candidate is returned if NOACTION is non-nil
1345 or
1346 - the candidate is passed to `consult-mu-action' if NOACTION is nil.
1347
1348Additional commandline arguments can be passed in the minibuffer entry by
1349typing “--” followed by command line arguments.
1350
1351For example, the user can enter:
1352
1353“#consult-mu -- -n 10”
1354
1355this will run a `mu4e-search' with the query “consult-mu” and changes the
1356search limit \(i.e. `mu4e-search-results-limit' to 10\).
1357
1358
1359Also, the results can further be narrowed by
1360`consult-async-split-style' \(e.g. by entering “#” when
1361`consult-async-split-style' is set to \='perl\).
1362
1363For example:
1364
1365“#consult-mu -- -n 10#github”
1366
1367will retrieve the messages as the example above, then narrows down the
1368completion table to candidates that match “github”.
1369
1370INITIAL is an optional arg for the initial input in the minibuffer.
1371\(passed as INITITAL to `consult-mu--dynamic'\)
1372
1373For more details on consult--async functionalities, see `consult-grep' and
1374the official manual of consult, here:
1375URL `https://github.com/minad/consult'"
1376 (interactive)
1377 (save-mark-and-excursion
1378 (consult-mu--execute-all-marks))
1379 (let* ((sel
1380 (consult-mu--dynamic (concat "[" (propertize "consult-mu-dynamic" 'face 'consult-mu-sender-face) "]" " Search For: ") #'consult-mu--dynamic-collection initial)))
1381 (save-mark-and-excursion
1382 (consult-mu--execute-all-marks))
1383 (if noaction
1384 sel
1385 (progn
1386 (funcall consult-mu-action sel)
1387 sel))))
1388
1389(defun consult-mu--async-format-candidate (string input highlight)
1390 "Formats minibuffer candidates for `consult-mu-async'.
1391
1392STRING is the output retrieved from `mu find INPUT ...` in the command line.
1393INPUT is the query from the user.
1394
1395If HIGHLIGHT is t, input is highlighted with
1396`consult-mu-highlight-match-face' in the minibuffer."
1397
1398 (let* ((query input)
1399 (parts (split-string (replace-regexp-in-string "^\\\\->\s\\|^\\\/->\s" "" string) consult-mu-delimiter))
1400 (msgid (car parts))
1401 (date (date-to-time (cadr parts)))
1402 (sender (cadr (cdr parts)))
1403 (sender (consult-mu--contact-string-to-plist sender))
1404 (receiver (cadr (cdr (cdr parts))))
1405 (receiver (consult-mu--contact-string-to-plist receiver))
1406 (subject (cadr (cdr (cdr (cdr parts)))))
1407 (size (string-to-number (cadr (cdr (cdr (cdr (cdr parts)))))))
1408 (flags (consult-mu-flags-to-string (cadr (cdr (cdr (cdr (cdr (cdr parts))))))))
1409 (tags (cadr (cdr (cdr (cdr (cdr (cdr (cdr parts))))))))
1410 (priority (cadr (cdr (cdr (cdr (cdr (cdr (cdr (cdr parts)))))))))
1411 (cc (cadr (cdr (cdr (cdr (cdr (cdr (cdr (cdr (cdr parts))))))))))
1412 (cc (consult-mu--contact-string-to-plist cc))
1413 (bcc (cadr (cdr (cdr (cdr (cdr (cdr (cdr (cdr (cdr (cdr parts)))))))))))
1414 (bcc (consult-mu--contact-string-to-plist bcc))
1415 (path (cadr (cdr (cdr (cdr (cdr (cdr (cdr (cdr (cdr (cdr (cdr parts))))))))))))
1416 (msg (list :subject subject :date date :from sender :to receiver :size size :message-id msgid :flags flags :tags tags :priority priority :cc cc :bcc bcc :path path))
1417 (match-str (if (stringp input) (consult--split-escaped (car (consult--command-split query))) nil))
1418 (headers-template (consult-mu--headers-template))
1419 (str (if headers-template
1420 (consult-mu--expand-headers-template msg headers-template)
1421 (format "%s\s\s%s\s\s%s\s\s%s\s\s%s\s\s%s"
1422 (propertize (consult-mu--set-string-width
1423 (format-time-string "%x" date) 10)
1424 'face 'consult-mu-date-face)
1425 (propertize (consult-mu--set-string-width (consult-mu--contact-name-or-email sender) (floor (* (frame-width) 0.2))) 'face 'consult-mu-sender-face)
1426 (propertize (consult-mu--set-string-width subject (floor (* (frame-width) 0.55))) 'face 'consult-mu-subject-face)
1427 (propertize (file-size-human-readable size) 'face 'consult-mu-size-face)
1428 (propertize (format "%s" flags) 'face 'consult-mu-flags-face)
1429 (propertize (if tags (format "%s" tags) nil) 'face 'consult-mu-tags-face))))
1430 (str (propertize str :msg msg :query query :type :async)))
1431 (if (and consult-mu-highlight-matches highlight)
1432 (cond
1433 ((listp match-str)
1434 (mapc (lambda (match) (setq str (consult-mu--highlight-match match str t))) match-str))
1435 ((stringp match-str)
1436 (setq str (consult-mu--highlight-match match-str str t))))
1437 str)
1438 (cons str (list :msg msg :query query :type :async))))
1439
1440(defun consult-mu--async-state ()
1441 "State function for `consult-mu-async' candidates.
1442
1443This is passed as STATE to `consult--read' and is used to preview or do
1444other actions on the candidate."
1445 (lambda (action cand)
1446 (let ((preview (consult--buffer-preview)))
1447 (pcase action
1448 ('preview
1449 (if cand
1450 (when-let* ((info (cdr cand))
1451 (msg (plist-get info :msg))
1452 (msgid (substring-no-properties (plist-get msg :message-id)))
1453 (query (plist-get info :query))
1454 (match-str (car (consult--command-split query)))
1455 (mu4e-headers-buffer-name consult-mu-headers-buffer-name)
1456 (buffer consult-mu-view-buffer-name))
1457 (add-to-list 'consult-mu--view-buffers-list buffer)
1458 (funcall preview action
1459 (consult-mu--view msg t consult-mu-mark-previewed-as-read match-str))
1460 (with-current-buffer consult-mu-view-buffer-name
1461 (unless (one-window-p) (delete-other-windows))))))
1462 ('return
1463 (save-mark-and-excursion
1464 (consult-mu--execute-all-marks))
1465 cand)))))
1466
1467(defun consult-mu--async-transform (input)
1468 "Add annotation to minibuffer candiates for `consult-mu'.
1469
1470Format each candidates with `consult-gh--repo-format' and INPUT."
1471 (lambda (cands)
1472 (cl-loop for cand in cands
1473 collect
1474 (consult-mu--async-format-candidate cand input t))))
1475
1476(defun consult-mu--async-builder (input)
1477 "Build mu command line for searching messages by INPUT (e.g. `mu find INPUT)`."
1478 (pcase-let* ((consult-mu-args (append consult-mu-args '("find")))
1479 (cmd (consult--build-args consult-mu-args))
1480 (`(,arg . ,opts) (consult--command-split input))
1481 (flags (append cmd opts))
1482 (sortfield (cond
1483 ((member "-s" flags) (nth (+ (cl-position "-s" opts :test 'equal) 1) flags))
1484 ((member "--sortfield" flags) (nth (+ (cl-position "--sortfield" flags :test 'equal) 1) flags))
1485 (t (substring (symbol-name consult-mu-search-sort-field) 1))))
1486 (threads (if (not (equal sortfield :date)) nil (or (member "-t" flags) (member "--threads" flags) mu4e-search-threads)))
1487 (skip-dups (or (member "-u" flags) (member "--skip-dups" flags) mu4e-search-skip-duplicates))
1488 (include-related (or (member "-r" flags) (member "--include-related" flags) mu4e-search-include-related)))
1489 (if (or (member "-g" flags) (member "--group" flags))
1490 (cond
1491 ((member "-g" flags)
1492 (setq consult-mu--override-group (intern (or (nth (+ (cl-position "-g" opts :test 'equal) 1) opts) "nil")))
1493 (setq opts (remove "-g" (remove (nth (+ (cl-position "-g" opts :test 'equal) 1) opts) opts))))
1494 ((member "--group" flags)
1495 (setq consult-mu--override-group (intern (or (nth (+ (cl-position "--group" opts :test 'equal) 1) opts) "nil")))
1496 (setq opts (remove "--group" (remove (nth (+ (cl-position "--group" opts :test 'equal) 1) opts) opts)))))
1497 (setq consult-mu--override-group nil))
1498 (setq opts (append opts (list "--nocolor")))
1499 (setq opts (append opts (list "--fields" (format "i%sd%sf%st%ss%sz%sg%sx%sp%sc%sh%sl"
1500 consult-mu-delimiter consult-mu-delimiter consult-mu-delimiter consult-mu-delimiter consult-mu-delimiter consult-mu-delimiter consult-mu-delimiter consult-mu-delimiter consult-mu-delimiter consult-mu-delimiter consult-mu-delimiter))))
1501 (unless (or (member "-s" flags) (member "--sortfiled" flags))
1502 (setq opts (append opts (list "--sortfield" (substring (symbol-name consult-mu-search-sort-field) 1)))))
1503 (if threads (setq opts (append opts (list "--thread"))))
1504 (if skip-dups (setq opts (append opts (list "--skip-dups"))))
1505 (if include-related (setq opts (append opts (list "--include-related"))))
1506 (cond
1507 ((and (member "-n" flags) (< (string-to-number (nth (+ (cl-position "-n" opts :test 'equal) 1) opts)) 0))
1508 (setq opts (remove "-n" (remove (nth (+ (cl-position "-n" opts :test 'equal) 1) opts) opts))))
1509 ((and (member "--maxnum" flags) (< (string-to-number (nth (+ (cl-position "--maxnum" opts :test 'equal) 1) opts)) 0))
1510 (setq opts (remove "--maxnum" (remove (nth (+ (cl-position "--maxnum" opts :test 'equal) 1) opts) opts)))))
1511 (unless (or (member "-n" flags) (member "--maxnum" flags))
1512 (if (and consult-mu-maxnum (> consult-mu-maxnum 0))
1513 (setq opts (append opts (list "--maxnum" (format "%s" consult-mu-maxnum))))))
1514
1515 (pcase consult-mu-search-sort-direction
1516 ('descending
1517 (if (or (member "-z" flags) (member "--reverse" flags))
1518 (setq opts (remove "-z" (remove "--reverse" opts)))
1519 (setq opts (append opts (list "--reverse")))))
1520 ('ascending)
1521 (_))
1522 (pcase-let* ((`(,re . ,hl) (funcall consult--regexp-compiler arg 'basic t)))
1523 (when re
1524 (cons (append cmd
1525 (list (string-join re " "))
1526 opts)
1527 hl)))))
1528
1529(defun consult-mu--async (prompt builder &optional initial)
1530 "Query mu4e messages asynchronously.
1531
1532This is a non-interactive internal function. For the interactive
1533version, see `consult-mu-async'.
1534
1535It runs the command line from `consult-mu--async-builder' in an async
1536process and returns the results (list of messages) as a completion table
1537in minibuffer that will be passed to `consult--read'. The completion
1538table gets dynamically updated as the user types in the minibuffer. Each
1539candidate in the minibuffer is formatted by `consult-mu--async-transform'
1540to add annotation and other info to the candidate.
1541
1542Description of Arguments:
1543
1544PROMPT the prompt in the minibuffer
1545 \(passed as PROMPT to `consult--red'\)
1546BUILDER an async builder function passed to `consult--async-command'
1547INITIAL an optional arg for the initial input in the minibuffer
1548 \(passed as INITITAL to `consult--read'\)
1549
1550commandline arguments/options \(see `mu find --help` in the command line
1551for details\) can be passed to the minibuffer input similar to
1552`consult-grep'. For example the user can enter:
1553
1554“#paper -- --maxnum 200 --sortfield from --reverse”
1555
1556this will search for mu4e messages with the query “paper”, retrives a
1557maximum of 200 messages sorts them by the “from:” field and reverses the
1558sort direction (opposite of `consult-mu-search-sort-field').
1559
1560Also, the results can further be narrowed by
1561`consult-async-split-style' \(e.g. by entering “#” when
1562`consult-async-split-style' is set to \='perl\).
1563
1564For example:
1565
1566`#paper -- --maxnum 200 --sortfield from --reverse#accepted'
1567
1568will retrieve the message as the example above, then narrows down the
1569completion table to candidates that match “accepted”."
1570 (consult--read
1571 (consult--process-collection builder
1572 :transform (consult--async-transform-by-input #'consult-mu--async-transform))
1573 :prompt prompt
1574 :lookup (consult-mu--lookup)
1575 :state (funcall #'consult-mu--async-state)
1576 :initial initial
1577 :group #'consult-mu--group
1578 :add-history (append (list (thing-at-point 'symbol))
1579 consult-mu-saved-searches-async)
1580 :history '(:input consult-mu--history)
1581 :require-match t
1582 :category 'consult-mu-messages
1583 :preview-key consult-mu-preview-key
1584 :sort nil))
1585
1586(defun consult-mu-async (&optional initial noaction)
1587 "Lists results of `mu find` Asynchronously.
1588
1589This is an interactive wrapper function around `consult-mu--async'. It
1590queries the user for a search term in the minibuffer, then fetches a list
1591of messages for the entered search term as a minibuffer completion table
1592for selection. The list of candidates in the completion table are
1593dynamically updated as the user changes the entry.
1594
1595Upon selection of a candidate either
1596 - the candidate is returned if NOACTION is non-nil
1597 or
1598 - the candidate is passed to `consult-mu-action' if NOACTION is nil.
1599
1600Additional commandline arguments can be passed in the minibuffer entry by
1601typing `--` followed by command line arguments.
1602
1603For example the user can enter:
1604
1605`#consult-mu -- -n 10'
1606
1607this will run a `mu4e-search' with the query \"consult-my\" and changes the
1608search limit (i.e. `mu4e-search-results-limit' to 10.
1609
1610
1611Also, the results can further be narrowed by `consult-async-split-style'
1612\(e.g. by entering “#” when `consult-async-split-style' is set to \='perl\).
1613
1614For example:
1615
1616“#consult-mu -- -n 10#github”
1617
1618will retrieve the message as the example above, then narrows down the
1619completion table to candidates that match “github”.
1620
1621INITIAL is an optional arg for the initial input in the minibuffer.
1622\(passed as INITITAL to `consult-mu--async'\).
1623
1624For more details on consult--async functionalities, see `consult-grep' and
1625the official manual of consult, here:
1626URL `https://github.com/minad/consult'
1627
1628Note that this is the async search directly using the commandline `mu`
1629command and not mu4e-search. As a result, mu4e-headers buffers are not
1630created until a single message is selected \(or interacted with using
1631embark, etc.\) Previews are shown in a mu4e-view buffer \(see
1632`consult-mu-view-buffer-name'\) attached to an empty mu4e-headers buffer
1633\(i.e. `consult-mu-headers-buffer-name'\). This allows quick retrieval of
1634many messages \(tens of thousands\) and previews, but not opening the
1635results in a mu4e-headers buffer. If you want ot open the results in a
1636mu4e-headers buffer for other work flow, then you should use the
1637dynamically collected function `consult-mu' which is slower if searching
1638for many emails but allows follow up interactions in a mu4e-headers
1639buffer."
1640 (interactive)
1641 (save-mark-and-excursion
1642 (consult-mu--execute-all-marks))
1643 (let* ((sel
1644 (consult-mu--async (concat "[" (propertize "consult-mu async" 'face 'consult-mu-sender-face) "]" " Search For: ") #'consult-mu--async-builder initial))
1645 (info (cdr sel))
1646 (msg (plist-get info :msg))
1647 (query (plist-get info :query)))
1648 (save-mark-and-excursion
1649 (consult-mu--execute-all-marks))
1650 (if noaction
1651 sel
1652 (progn
1653 (consult-mu--update-headers query t msg :async))
1654 (funcall consult-mu-action sel)
1655 sel)))
1656
1657(defun consult-mu (&optional initial noaction)
1658 "Default interactive command.
1659
1660This is a wrapper function that calls `consult-mu-default-command' with
1661INITIAL and NOACTION.
1662
1663For example, the `consult-mu-default-command can be set to
1664 `#'consult-mu-dynamic' sets the default behavior to dynamic collection
1665 `#'consult-mu-async' sets the default behavior to async collection"
1666
1667 (interactive "P")
1668 (funcall consult-mu-default-command initial noaction))
1669
1670;;; provide `consult-mu' module
1671(provide 'consult-mu)
1672
1673;;; consult-mu.el ends here