fedora-csb-system-manager
1* consult-mu.el
2:PROPERTIES:
3:header-args:emacs-lisp: :results none :lexical t :mkdirp yes :comments none :tangle ./consult-mu.el
4:END:
5** Header
6#+begin_src emacs-lisp
7;;; consult-mu.el --- Consult Mu4e asynchronously -*- lexical-binding: t -*-
8
9;; Copyright (C) 2023 Armin Darvish
10
11;; Author: Armin Darvish
12;; Maintainer: Armin Darvish
13;; Created: 2023
14;; Version: 1.0
15;; Package-Requires: ((emacs "28.0") (consult "2.0"))
16;; Keywords: convenience, matching, tools, email
17;; Homepage: https://github.com/armindarvish/consult-mu
18
19;; SPDX-License-Identifier: GPL-3.0-or-later
20
21;; This file is free software: you can redistribute it and/or modify
22;; it under the terms of the GNU General Public License as published
23;; by the Free Software Foundation, either version 3 of the License,
24;; or (at your option) any later version.
25;;
26;; This file is distributed in the hope that it will be useful,
27;; but WITHOUT ANY WARRANTY; without even the implied warranty of
28;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
29;; GNU General Public License for more details.
30;;
31;; You should have received a copy of the GNU General Public License
32;; along with this file. If not, see <https://www.gnu.org/licenses/>.
33
34
35;;; Commentary:
36
37;; This package provides an alternative interactive serach interface for
38;; mu and mu4e (see URL `https://djcbsoftware.nl/code/mu/mu4e.html').
39;; It uses a consult-based minibuffer completion for searching and
40;; selecting, and marking emails, as well as additional utilities for
41;; composing emails and more.
42
43;; This package requires mu4e version "1.10.8" or later.
44
45;;; Code:
46
47#+end_src
48
49** Requirements
50#+begin_src emacs-lisp
51;;; Requirements
52(require 'consult)
53(require 'mu4e)
54
55#+end_src
56
57** Define Group, Customs, Vars, etc.
58*** Group
59#+begin_src emacs-lisp
60;;; Group
61
62(defgroup consult-mu nil
63 "Options for `consult-mu'."
64 :group 'convenience
65 :group 'minibuffer
66 :group 'consult
67 :group 'mu4e
68 :prefix "consult-mu-")
69
70#+end_src
71
72*** Custom Variables
73#+begin_src emacs-lisp
74;;; Customization Variables
75
76(defcustom consult-mu-args '("mu")
77 "Command line arguments to call `mu` asynchronously.
78
79The dynamically computed arguments are appended.
80Can be either a string, or a list of strings or expressions."
81 :group 'consult-mu
82 :type '(choice string (repeat (choice string sexp))))
83
84(defcustom consult-mu-maxnum mu4e-search-results-limit
85 "Maximum number of results.
86
87This is normally passed to “--maxnum” in the command line or is defined by
88`mu4e-search-results-limit'. By default inherits from
89`mu4e-search-results-limit'."
90 :group 'consult-mu
91 :type '(choice (const :tag "Unlimited" -1)
92 (integer :tag "Limit")))
93
94(defcustom consult-mu-search-sort-field mu4e-search-sort-field
95 "What field to sort results by?
96
97By defualt inherits from `mu4e-search-sort-field'."
98 :group 'consult-mu
99 :type '(radio (const :tag "Date" :date)
100 (const :tag "Subject" :subject)
101 (const :tag "File Size" :size)
102 (const :tag "Priority" :prio)
103 (const :tag "From (Sender)" :from)
104 (const :tag "To (Recipients)" :to)
105 (const :tag "Mailing List" :list)))
106
107(defcustom consult-mu-headers-fields mu4e-headers-fields
108 "A list of header fields to show in the headers buffer.
109
110By default inherits from `mu4e-headers-field'.
111
112From mu4e docs:
113
114Each element has the form (HEADER . WIDTH), where HEADER is one of
115the available headers (see `mu4e-header-info') and WIDTH is the
116respective width in characters.
117
118A width of nil means “unrestricted”, and this is best reserved
119for the rightmost \(last\) field. Note that Emacs may become very
120slow with excessively long lines \(1000s of characters\), so if you
121regularly get such messages, you want to avoid fields with nil
122altogether."
123 :group 'consult-mu
124 :type `(repeat (cons (choice ,@(mapcar (lambda (h)
125 (list 'const
126 :tag (plist-get (cdr h) :help)
127 (car h)))
128 mu4e-header-info))
129 (choice (integer :tag "width")
130 (const :tag "unrestricted width" nil)))))
131
132(defcustom consult-mu-headers-template nil
133 "A template string to make custom header formats.
134
135If non-nil, `consult-mu' uses this string to format the headers instead of
136`consult-mu-headers-field'.
137
138The string should be of the format “%[char][integer]%[char][integer]...”,
139and allow dynamic insertion of the content. Each “%[char][integer]“ chunk
140represents a different field and the integer defines the length of the
141field.
142
143The list of available fields are:
144
145 %f sender(s) \(e.g. from: field of email\)
146 %t receivers(s) \(i.e. to: field of email\)
147 %s subject \(i.e. title of email\)
148 %d date \(i.e. the date email was sent/received\)
149 %p priority
150 %z size
151 %i message-id \(as defined by mu\)
152 %g flags \(as defined by mu\)
153 %G pretty flags \(this uses `mu4e~headers-flags-str' to pretify flags\)
154 %x tags \(as defined by mu\)
155 %c cc \(i.e. cc: field of the email\)
156 %h bcc \(i.e. bcc: field of the email\)
157 %r date chaged \(as defined by :changed in mu4e\)
158
159For exmaple, “%d15%s50” means 15 characters for date and 50 charcters for
160subject, and “%d13%s37%f17” would make a header containing 13 characters
161for Date, 37 characters for Subject, and 20 characters for From field,
162making a header that looks like this:
163
164Thu 09 Nov 23 Title of the Email Limited to 50 Char... example@domain..."
165 :group 'consult-mu
166 :type '(choice (const :tag "Fromatted String" :format "%{%%d13%%s50%%f17%}")
167 (function :tag "Custom Function")))
168
169(defcustom consult-mu-search-sort-direction mu4e-search-sort-direction
170 "Direction to sort by a symbol.
171
172By defualt inherits from `mu4e-search-sort-direction', and can either be
173\='descending (sorting Z->A) or \='ascending (sorting A->Z)."
174
175 :group 'consult-mu
176 :type '(radio (const ascending)
177 (const descending)))
178
179
180(defcustom consult-mu-search-threads mu4e-search-threads
181 "Whether to calculate threads for search results.
182
183By defualt inherits from `mu4e-search-threads'.
184
185Note that per mu4e docs:
186When threading is enabled, the headers are exclusively sorted
187chronologically (:date) by the newest message in the thread."
188 :group 'consult-mu
189 :type 'boolean)
190
191(defcustom consult-mu-group-by nil
192 "What field to use to group the results in the minibuffer.
193
194By default it is set to :date, but can be any of:
195
196 :subject group by subject
197 :from group by the name/email the sender(s)
198 :to group by name/email of the reciver(s)
199 :date group by date
200 :time group by the time of email \(i.e. hour, minute, seconds\)
201 :datetime group by date and time of the email
202 :year group by the year of the email \(i.e. 2023, 2022, ...\)
203 :month group by the month of the email \(i.e. Jan, Feb, ..., Dec\)
204 :week group by the week number of the email
205 \(i.e. 1st week, 2nd week, ... 52nd week\)
206 :day-of-week group by the day email was sent (i.e. Mondays, Tuesdays, ...)
207 :day group by the day email was sent (similar to :day-of-week)
208 :size group by the file size of the email
209 :flags group by flags (as defined by mu)
210 :tags group by tags (as defined by mu)
211 :changed group by the date changed
212 \(as defined by :changed field in mu4e\)"
213 :group 'consult-mu
214 :type '(radio (const :date)
215 (const :subject)
216 (const :from)
217 (const :to)
218 (const :time)
219 (const :datetime)
220 (const :year)
221 (const :month)
222 (const :week)
223 (const :day-of-week)
224 (const :day)
225 (const :size)
226 (const :flags)
227 (const :tags)
228 (const :changed)
229 (const nil)))
230
231(defcustom consult-mu-mark-previewed-as-read nil
232 "Whether to mark PREVIEWED emails as read or not?"
233 :group 'consult-mu
234 :type 'boolean)
235
236(defcustom consult-mu-mark-viewed-as-read t
237 "Whether to mark VIEWED emails as read or not?"
238 :group 'consult-mu
239 :type 'boolean)
240
241(defcustom consult-mu-headers-buffer-name "*consult-mu-headers*"
242 "Default name for HEADERS buffer explicitly for `consult-mu'.
243
244For more info see `mu4e-headers-buffer-name'."
245 :group 'consult-mu
246 :type 'string)
247
248(defcustom consult-mu-view-buffer-name "*consult-mu-view*"
249 "Default name for VIEW buffer explicitly for `consult-mu'.
250
251For more info see `mu4e-view-buffer-name'."
252 :group 'consult-mu
253 :type 'string)
254
255(defcustom consult-mu-preview-key consult-preview-key
256 "Preview key for `consult-mu'.
257
258This is similar to `consult-preview-key' but explicitly for `consult-mu'."
259 :group 'consult-mu
260 :type '(choice (symbol :tag "Any key" 'any)
261 (list :tag "Debounced"
262 (const :debounce)
263 (float :tag "Seconds" 0.1)
264 (const any))
265 (const :tag "No preview" nil)
266 (key :tag "Key")
267 (repeat :tag "List of keys" key)))
268
269
270(defcustom consult-mu-highlight-matches t
271 "Should `consult-mu' highlight search queries in preview buffers?"
272 :group 'consult-mu
273 :type 'boolean)
274
275(defcustom consult-mu-use-wide-reply 'ask
276 "Reply to all or not?
277
278This defines whether `consult-mu--reply-action' should reply to all or not."
279 :group 'consult-mu
280 :type '(choice (symbol :tag "Ask for confirmation" 'ask)
281 (const :tag "Do not reply to all" nil)
282 (const :tag "Always reply to all" t)))
283
284(defcustom consult-mu-action #'consult-mu--view-action
285 "The function that is used when selecting a message.
286By default it is bound to `consult-mu--view-action'."
287 :group 'consult-mu
288 :type '(choice (function :tag "(Default) View Message in Mu4e Buffers" consult-mu--view-action)
289 (function :tag "Reply to Message" consult-mu--reply-action)
290 (function :tag "Forward Message" consult-mu--forward-action)
291 (function :tag "Custom Function")))
292
293(defcustom consult-mu-default-command #'consult-mu-dynamic
294 "Which command should `consult-mu' call."
295 :group 'consult-mu
296 :type '(choice (function :tag "(Default) Use Dynamic Collection (i.e. `consult-mu-dynamic')" #'consult-mu-dynamic)
297 (function :tag "Use Async Collection (i.e. `consult-mu-async')" #'consult-mu-async)
298 (function :tag "Custom Function")))
299
300#+end_src
301
302*** Other Variables
303#+begin_src emacs-lisp
304;;; Other Variables
305(defvar consult-mu-category 'consult-mu
306 "Category symbol for the `consult-mu' package.")
307
308(defvar consult-mu-messages-category 'consult-mu-messages
309 "Category symbol for messages in `consult-mu' package.")
310
311(defvar consult-mu--view-buffers-list (list)
312 "List of currently open preview buffers for `consult-mu'.")
313
314(defvar consult-mu--history nil
315 "History variable for `consult-mu'.")
316
317(defvar consult-mu-delimiter " "
318 "Delimiter to use for fields in mu command output.
319
320The idea is Taken from https://github.com/seanfarley/counsel-mu.")
321
322(defvar consult-mu-saved-searches-dynamic (list)
323 "List of Favorite searches for `consult-mu-dynamic'.")
324
325(defvar consult-mu-saved-searches-async consult-mu-saved-searches-dynamic
326 "List of Favorite searches for `consult-mu-async'.")
327
328(defvar consult-mu--override-group nil
329 "Override grouping in `consult-mu' based on user input.")
330
331(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")
332 "List of possible headers in a message.")
333
334#+end_src
335
336** Define faces
337#+begin_src emacs-lisp
338;;; Faces
339
340(defface consult-mu-highlight-match-face
341 `((t :inherit 'consult-highlight-match))
342 "Highlight match face in `consult-mu' view buffer.
343
344By default inherits from `consult-highlight-match'.
345This is used to highlight matches of search queries in the minibufffer
346completion list.")
347
348(defface consult-mu-preview-match-face
349 `((t :inherit 'consult-preview-match))
350 "Preview match face in `consult-mu' preview buffers.
351
352By default inherits from `consult-preview-match'.
353This is used to highlight matches of search query terms in preview buffers
354\(i.e. `consult-mu-view-buffer-name'\).")
355
356(defface consult-mu-default-face
357 `((t :inherit 'default))
358 "Default face in `consult-mu' minibuffer annotations.
359
360By default inherits from `default' face.")
361
362(defface consult-mu-subject-face
363 `((t :inherit 'font-lock-keyword-face))
364 "Subject face in `consult-mu' minibuffer annotations.
365
366By default inherits from `font-lock-keyword-face'.")
367
368(defface consult-mu-sender-face
369 `((t :inherit 'font-lock-variable-name-face))
370 "Contact face in `consult-mu' minibuffer annotations.
371
372By default inherits from `font-lock-variable-name-face'.")
373
374(defface consult-mu-receiver-face
375 `((t :inherit 'font-lock-variable-name-face))
376 "Contact face in `consult-mu' minibuffer annotations.
377
378By default inherits from `font-lock-variable-name-face'.")
379
380(defface consult-mu-date-face
381 `((t :inherit 'font-lock-preprocessor-face))
382 "Date face in `consult-mu' minibuffer annotations.
383
384By default inherits from `font-lock-preprocessor-face'.")
385
386(defface consult-mu-count-face
387 `((t :inherit 'font-lock-string-face))
388 "Count face in `consult-mu' minibuffer annotations.
389
390By default inherits from `font-lock-string-face'.")
391
392(defface consult-mu-size-face
393 `((t :inherit 'font-lock-string-face))
394 "Size face in `consult-mu' minibuffer annotations.
395
396By default inherits from `font-lock-string-face'.")
397
398(defface consult-mu-tags-face
399 `((t :inherit 'font-lock-comment-face))
400 "Tags/Comments face in `consult-mu' minibuffer annotations.
401
402By default inherits from `font-lock-comment-face'.")
403
404(defface consult-mu-flags-face
405 `((t :inherit 'font-lock-function-call-face))
406 "Flags face in `consult-mu' minibuffer annotations.
407
408By default inherits from `font-lock-function-call-face'.")
409
410(defface consult-mu-url-face
411 `((t :inherit 'link))
412 "URL face in `consult-mu' minibuffer annotations;
413
414By default inherits from `link'.")
415
416#+end_src
417
418** Backend functions
419This section includes functions (utilities, mu4e hacks, ...).
420*** general utility
421**** pulses
422***** pulse-regexp
423#+begin_src emacs-lisp
424(defun consult-mu--pulse-regexp (regexp)
425 "Find and pulse REGEXP."
426 (goto-char (point-min))
427 (while (re-search-forward regexp nil t)
428 (when-let* ((m (match-data))
429 (beg (car m))
430 (end (cadr m))
431 (ov (make-overlay beg end))
432 (pulse-delay 0.075))
433 (pulse-momentary-highlight-overlay ov 'highlight))))
434
435#+end_src
436***** pulse-region
437#+begin_src emacs-lisp
438(defun consult-mu--pulse-region (beg end)
439 "Find and pulse region from BEG to END."
440 (let ((ov (make-overlay beg end))
441 (pulse-delay 0.075))
442 (pulse-momentary-highlight-overlay ov 'highlight)))
443
444#+end_src
445***** pulse-line
446#+begin_src emacs-lisp
447(defun consult-mu--pulse-line ()
448 "Pulse line at point momentarily."
449 (let* ((pulse-delay 0.055)
450 (ov (make-overlay (car (bounds-of-thing-at-point 'line))
451 (cdr (bounds-of-thing-at-point 'line)))))
452 (pulse-momentary-highlight-overlay ov 'highlight)))
453
454#+end_src
455
456**** formatting strings
457***** fix string length
458#+begin_src emacs-lisp
459(defun consult-mu--set-string-width (string width &optional prepend)
460 "Set the STRING width to a fixed value, WIDTH.
461
462If the STRING is longer than WIDTH, it truncates the string and adds
463ellipsis, “...”. If the string is shorter, it adds whitespace to the
464string. If PREPEND is non-nil, it truncates or adds whitespace from the
465beginning of string, instead of the end."
466 (let* ((string (format "%s" string))
467 (w (string-width string)))
468 (when (< w width)
469 (if prepend
470 (setq string (format "%s%s" (make-string (- width w) ?\s) (substring string)))
471 (setq string (format "%s%s" (substring string) (make-string (- width w) ?\s)))))
472 (when (> w width)
473 (if prepend
474 (setq string (format "...%s" (substring string (- w (- width 3)) w)))
475 (setq string (format "%s..." (substring string 0 (- width (+ w 3)))))))
476 string))
477
478(defun consult-mu--justify-left (string prefix maxwidth)
479 "Set the width of STRING+PREFIX justified from left.
480
481Use `consult-mu--set-string-width' to the width of the concatenate of
482STRING+PREFIX \(e.g. “(concat prefix string)”\) within MAXWIDTH. This is
483used for aligning marginalia info in the minibuffer."
484 (let ((w (string-width prefix)))
485 (if (> maxwidth w)
486 (consult-mu--set-string-width string (- maxwidth w) t)
487 string)))
488
489#+end_src
490***** highlight match with text-properties
491#+begin_src emacs-lisp
492(defun consult-mu--highlight-match (regexp str ignore-case)
493 "Highlight REGEXP in STR.
494
495If a REGEXP contains a capturing group, only the captured group is
496highlighted, otherwise, the whole match is highlighted.
497Case is ignored if IGNORE-CASE is non-nil.
498\(This is adapted from `consult--highlight-regexps'.\)"
499 (let ((i 0))
500 (while (and (let ((case-fold-search ignore-case))
501 (string-match regexp str i))
502 (> (match-end 0) i))
503 (let ((m (match-data)))
504 (setq i (cadr m)
505 m (or (cddr m) m))
506 (while m
507 (when (car m)
508 (add-face-text-property (car m) (cadr m)
509 'consult-mu-highlight-match-face nil str))
510 (setq m (cddr m))))))
511 str)
512
513#+end_src
514***** highlight match with overlay
515#+begin_src emacs-lisp
516(defun consult-mu--overlay-match (match-str buffer ignore-case)
517 "Highlight MATCH-STR in BUFFER using an overlay.
518
519If IGNORE-CASE is non-nil, it uses case-insensitive match.
520
521This is used to highlight matches to use queries when viewing emails. See
522`consult-mu-overlays-toggle' for toggling highligths on/off."
523 (with-current-buffer (or (get-buffer buffer) (current-buffer))
524 (remove-overlays (point-min) (point-max) 'consult-mu-overlay t)
525 (goto-char (point-min))
526 (let ((case-fold-search ignore-case))
527 (while (search-forward match-str nil t)
528 (when-let* ((m (match-data))
529 (beg (car m))
530 (end (cadr m))
531 (overlay (make-overlay beg end)))
532 (overlay-put overlay 'consult-mu-overlay t)
533 (overlay-put overlay 'face 'consult-mu-highlight-match-face))))))
534
535(defun consult-mu-overlays-toggle (&optional buffer)
536 "Toggle overlay highlight in BUFFER.
537
538BUFFER defaults to `current-buffer'."
539 (interactive)
540 (let ((buffer (or buffer (current-buffer))))
541 (with-current-buffer buffer
542 (dolist (o (overlays-in (point-min) (point-max)))
543 (when (overlay-get o 'consult-mu-overlay)
544 (if (and (overlay-get o 'face) (eq (overlay-get o 'face) 'consult-mu-highlight-match-face))
545 (overlay-put o 'face nil)
546 (overlay-put o 'face 'consult-mu-highlight-match-face)))))))
547
548#+end_src
549
550**** format date
551#+begin_src emacs-lisp
552(defun consult-mu--format-date (string)
553 "Format the date STRING from mu output.
554
555STRING is the output form a mu command, for example:
556`mu find query --fields d`
557Returns the date in the format Day-of-Week Month Day Year Time
558\(e.g. Sat Nov 04 2023 09:46:54\)"
559 (let ((string (replace-regexp-in-string " " "0" string)))
560 (format "%s %s %s"
561 (substring string 0 10)
562 (substring string -4 nil)
563 (substring string 11 -4))))
564
565#+end_src
566**** flags to string
567#+begin_src emacs-lisp
568(defun consult-mu-flags-to-string (FLAG)
569 "Covert FLAGS, from mu output to strings.
570
571FLAG is the output form mu command in the terminal, for example:
572 `mu find query --fields g`.
573This function converts each character in FLAG to an expanded string of the
574flag and returns the list of these strings."
575 (cl-loop for c across FLAG
576 collect
577 (pcase (string c)
578 ("D" 'draft)
579 ("F" 'flagged)
580 ("N" 'new)
581 ("P" 'forwarded)
582 ("R" 'replied)
583 ("S" 'read)
584 ("T" 'trashed)
585 ("a" 'attachment)
586 ("x" 'encrrypted)
587 ("s" 'signed)
588 ("u" 'unread)
589 ("l" 'list)
590 ("q" 'personal)
591 ("c" 'calendar)
592 (_ nil))))
593
594#+end_src
595**** extract email from string
596#+begin_src emacs-lisp
597(defun consult-mu--message-extract-email-from-string (string)
598 "Find and return the first email address in the STRING."
599 (when (stringp string)
600 (string-match "[a-zA-Z0-9\_\.\+\-]+@[a-zA-Z0-9\-]+\.[a-zA-Z0-9\-\.]+" string)
601 (match-string 0 string)))
602
603#+end_src
604**** split string of emails to list of emails
605#+begin_src emacs-lisp
606(defun consult-mu--message-emails-string-to-list (string)
607 "Convert comma-separated STRING of email addresses to a list."
608 (when (stringp string)
609 (remove '(" " "\s" "\t")
610 (mapcar #'consult-mu--message-extract-email-from-string
611 (split-string string ",\\|;\\|\t" t)))))
612
613#+end_src
614**** get header field from message
615#+begin_src emacs-lisp
616(defun consult-mu--message-get-header-field (&optional field)
617 "Retrive FIELD header from the message/mail in the current buffer."
618 (save-match-data
619 (save-excursion
620 (when (or (derived-mode-p 'message-mode)
621 (derived-mode-p 'mu4e-view-mode)
622 (derived-mode-p 'org-msg-edit-mode)
623 (derived-mode-p 'mu4e-compose-mode))
624 (let* ((case-fold-search t)
625 (header-regexp (mapconcat (lambda (str) (concat "\n" str ": "))
626 consult-mu--mail-headers "\\|"))
627 (field (or (downcase field)
628 (downcase (consult--read consult-mu--mail-headers
629 :prompt "Header Field: ")))))
630 (if (string-prefix-p "attachment" field) (setq field "\\(attachment\\|attachments\\)"))
631 (goto-char (point-min))
632 (message-goto-body)
633 (let* ((match (re-search-backward (concat "^" field ": \\(?1:[[:ascii:][:nonascii:]]*?\\)\n\\(.*?:\\|\n\\)") nil t))
634 (str (if (and match (match-string 1)) (string-trim (match-string 1)))))
635 (if (string-empty-p str) nil str)))))))
636#+end_src
637
638*** mu4e and message backend
639**** append-handler
640#+begin_src emacs-lisp
641(defun consult-mu--headers-append-handler (msglst)
642 "Append one-line descriptions of messages in MSGLST.
643
644This is used to override `mu4e~headers-append-handler' to ensure that
645buffer handling is done right for `consult-mu'."
646 (with-current-buffer "*consult-mu-headers*"
647 (let ((inhibit-read-only t))
648 (seq-do
649 ;; 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.
650 (if (and (featurep 'mu4e-column-faces) mu4e-column-faces-mode)
651 (lambda (msg)
652 (mu4e-column-faces--insert-header msg (point-max)))
653 (lambda (msg)
654 (mu4e~headers-insert-header msg (point-max))))
655 msglst))))
656
657#+end_src
658
659**** view-msg
660#+begin_src emacs-lisp
661(defun consult-mu--view-msg (msg &optional buffername)
662 "Display the message MSG in a buffer with BUFFERNAME.
663
664BUFFERNAME defaults to `consult-mu-view-buffer-name'.
665
666This s used to overrides `mu4e-view' to ensure that buffer handling is done
667right for `consult-mu'."
668 (let* ((linked-headers-buffer (mu4e-get-headers-buffer "*consult-mu-headers*" t))
669 (mu4e-view-buffer-name (or buffername consult-mu-view-buffer-name)))
670 (setq gnus-article-buffer (mu4e-get-view-buffer linked-headers-buffer t))
671 (with-current-buffer gnus-article-buffer
672 (let ((inhibit-read-only t))
673 (remove-overlays (point-min) (point-max) 'mu4e-overlay t)
674 (erase-buffer)
675 (insert-file-contents-literally
676 (mu4e-message-readable-path msg) nil nil nil t)
677 (setq-local mu4e--view-message msg)
678 (mu4e--view-render-buffer msg)
679 (mu4e-loading-mode 0)
680 (with-current-buffer linked-headers-buffer
681 (setq-local mu4e~headers-view-win (mu4e-display-buffer gnus-article-buffer nil)))
682 (run-hooks 'mu4e-view-rendered-hook)))))
683
684#+end_src
685
686**** headers-clear
687#+begin_src emacs-lisp
688(defun consult-mu--headers-clear (&optional text)
689 "Clear the headers buffer and related data structures.
690
691Optionally, show TEXT.
692
693This is used to override `mu4e~headers-clear' to ensure that buffer
694handling is done right for `consult-mu'."
695 (setq mu4e~headers-render-start (float-time)
696 mu4e~headers-hidden 0)
697 (with-current-buffer "*consult-mu-headers*"
698 (let ((inhibit-read-only t))
699 (mu4e--mark-clear)
700 (erase-buffer)
701 (when text
702 (goto-char (point-min))
703 (insert (propertize text 'face 'mu4e-system-face 'intangible t))))))
704
705#+end_src
706
707
708**** set mu4e search properties from opts
709#+begin_src emacs-lisp
710(defun consult-mu--set-mu4e-search-sortfield (opts)
711 "Dynamically set the `mu4e-search-sort-field' based on user input.
712
713Uses user input (i.e. from `consult-mu' command) to define the sort field.
714
715OPTS is the command line options for mu and can be set by entering options
716in the minibuffer input. For more details, refer to `consult-grep' and
717consult async documentation.
718
719For example if the user enters the following in the minibuffer:
720
721“#query -- --maxnum 400 --sortfield from”
722
723`mu4e-search-sort-field' is set to :from
724
725Note that per mu4e docs:
726When threading is enabled, the headers are exclusively sorted
727chronologically (:date) by the newest message in the thread."
728 (let* ((sortfield (cond
729 ((member "-s" opts) (nth (+ (cl-position "-s" opts :test 'equal) 1) opts))
730 ((member "--sortfield" opts) (nth (+ (cl-position "--sortfield" opts :test 'equal) 1) opts))
731 (t consult-mu-search-sort-field))))
732 (pcase sortfield
733 ('nil
734 consult-mu-search-sort-field)
735 ((or "date" "d")
736 :date)
737 ((or "subject" "s")
738 :subject)
739 ((or "size" "z")
740 :size)
741 ((or "prio" "p")
742 :prio)
743 ((or "from" "f")
744 :from)
745 ((or "to" "t")
746 :to)
747 ((or "list" "v")
748 :list)
749 ;; ((or "tags" "x")
750 ;; :tags)
751 (_
752 consult-mu-search-sort-field))))
753
754(defun consult-mu--set-mu4e-search-sort-direction (opts)
755 "Dynamically set the `mu4e-search-sort-direction' based on user input.
756
757Uses user input \(i.e. from `consult-mu' command\) to define the sort field.
758
759OPTS is the command line options for mu and can be set by entering options
760in the minibuffer input. For more details, refer to `consult-grep' and
761consult async documentation.
762
763For example, if the user enters the following in the minibuffer:
764
765“#query -- --maxnum 400 --sortfield from --reverse”
766
767The `mu4e-search-sort-direction' is reversed; If it is set to
768\='ascending, it is toggled to \='descending and vise versa."
769 (if (or (member "-z" opts) (member "--reverse" opts))
770 (pcase consult-mu-search-sort-direction
771 ('descending
772 'ascending)
773 ('ascending
774 'descending))
775 consult-mu-search-sort-direction))
776
777(defun consult-mu--set-mu4e-skip-duplicates (opts)
778 "Dynamically set the `mu4e-search-skip-duplicates' based on user input.
779
780Uses user input \(i.e. from `consult-mu' command\) to define whether to
781skip duplicates.
782
783OPTS is the command line options for mu and can be set by entering options
784in the minibuffer input. For more details, refer to `consult-grep' and
785consult async documentation.
786
787For example, if the user enters the following in the minibuffer:
788
789“#query -- --maxnum 400 --skip-dups”
790
791The `mu4e-search-skip-duplicates' is set to t."
792 (if (or (member "--skip-dups" opts) mu4e-search-skip-duplicates) t nil))
793
794(defun consult-mu--set-mu4e-results-limit (opts)
795 "Dynamically set the `mu4e-search-results-limit' based on user input.
796
797
798Uses user input \(i.e. from `consult-mu' command\) to define the number of
799results shown.
800
801OPTS is the command line options for mu and can be set by entering options
802in the minibuffer input. For more details, refer to `consult-grep' and
803consult async documentation.
804
805For example, if the user enters the following in the minibuffer:
806
807“#query -- --maxnum 400”
808
809The `mu4e-search-results-limit' is set to 400."
810 (cond
811 ((member "-n" opts) (string-to-number (nth (+ (cl-position "-n" opts :test 'equal) 1) opts)))
812 ((member "--maxnum" opts) (string-to-number (nth (+ (cl-position "--maxnum" opts :test 'equal) 1) opts)))
813 (t consult-mu-maxnum)))
814
815
816(defun consult-mu--set-mu4e-include-related (opts)
817 "Dynamically set the `mu4e-search-include-related' based on user input.
818
819Uses user input \(i.e. from `consult-mu' command\) to define whether to
820include related messages.
821
822OPTS is the command line options for mu and can be set by entering options
823in the minibuffer input. For more details, refer to `consult-grep' and
824consult async documentation.
825
826For example if the user enters the following in the minibuffer:
827
828“#query -- --include-related”
829
830The `mu4e-search-include-related' is set to t."
831 (if (or (member "-r" opts) (member "--include-related" opts) mu4e-search-include-related) t nil))
832
833
834
835(defun consult-mu--set-mu4e-threads (opts)
836 "Set the `mu4e-search-threads' based on `mu4e-search-sort-field'.
837
838Uses user input \(i.e. from `consult-mu' command\) to define whether to
839show threads.
840
841OPTS is the command line options for mu and can be set by entering options
842in the minibuffer input. For more details, refer to `consult-grep' and
843consult async documentation.
844
845Note that per mu4e docs, when threading is enabled, the headers are
846exclusively sorted by date. Here the logic is reversed in order to allow
847dynamically sorting by fields other than date \(even when threads are
848enabled\). In other words, if the sort-field is not the :date, threading
849is disabled because otherwise sort field will be ignored. This allows the
850user to use command line arguments to sort messages by fields other than
851the date. For example, the user can enter the following in the minibuffer
852input to sort by subject
853
854“#query -- --sortfield subject”
855
856When the sort-field is :date, the default setting,
857`consult-mu-search-threads' is used, and if that is set to nil, the user
858can use command line arguments \(a.k.a. -t or --thread\) to enable it
859dynamically."
860 (cond
861 ((not (equal mu4e-search-sort-field :date))
862 nil)
863 ((or (member "-t" opts) (member "--threads" opts) consult-mu-search-threads)
864 t)))
865
866#+end_src
867**** update headers
868#+begin_src emacs-lisp
869(defun consult-mu--update-headers (query ignore-history msg type)
870 "Search for QUERY, and update `consult-mu-headers-buffer-name' buffer.
871
872If IGNORE-HISTORY is true, does *not* update the query history stack,
873`mu4e--search-query-past'.
874If MSG is non-nil, put the cursor on MSG.
875TYPE can be either \=':dynamic or \=':async"
876 (consult-mu--execute-all-marks)
877 (cl-letf* (((symbol-function #'mu4e~headers-append-handler) #'consult-mu--headers-append-handler))
878 (unless (mu4e-running-p) (mu4e--server-start))
879 (let* ((buf (mu4e-get-headers-buffer consult-mu-headers-buffer-name t))
880 (view-buffer (get-buffer consult-mu-view-buffer-name))
881 (expr (car (consult--command-split (substring-no-properties query))))
882 (rewritten-expr (funcall mu4e-query-rewrite-function expr))
883 (mu4e-headers-fields consult-mu-headers-fields))
884 (pcase type
885 (:dynamic)
886 (:async
887 (setq rewritten-expr (funcall mu4e-query-rewrite-function (concat "msgid:" (plist-get msg :message-id)))))
888 (_ ))
889
890 (with-current-buffer buf
891 (save-excursion
892 (let ((inhibit-read-only t))
893 (erase-buffer)
894 (mu4e-headers-mode)
895 (setq-local mu4e-view-buffer-name consult-mu-view-buffer-name)
896 (if view-buffer
897 (setq-local mu4e~headers-view-win (mu4e-display-buffer gnus-article-buffer nil)))
898 (unless ignore-history
899 ; save the old present query to the history list
900 (when mu4e--search-last-query
901 (mu4e--search-push-query mu4e--search-last-query 'past)))
902 (setq mu4e--search-last-query rewritten-expr)
903 (setq list-buffers-directory rewritten-expr)
904 (mu4e--modeline-update)
905 (run-hook-with-args 'mu4e-search-hook expr)
906 (consult-mu--headers-clear mu4e~search-message)
907 (setq mu4e~headers-search-start (float-time))
908
909 (pcase-let* ((`(,_arg . ,opts) (consult--command-split query))
910 (mu4e-search-sort-field (consult-mu--set-mu4e-search-sortfield opts))
911 (mu4e-search-sort-direction (consult-mu--set-mu4e-search-sort-direction opts))
912 (mu4e-search-skip-duplicates (consult-mu--set-mu4e-skip-duplicates opts))
913 (mu4e-search-results-limit (consult-mu--set-mu4e-results-limit opts))
914 (mu4e-search-threads (consult-mu--set-mu4e-threads opts))
915 (mu4e-search-include-related (consult-mu--set-mu4e-include-related opts)))
916 (mu4e--server-find
917 rewritten-expr
918 mu4e-search-threads
919 mu4e-search-sort-field
920 mu4e-search-sort-direction
921 mu4e-search-results-limit
922 mu4e-search-skip-duplicates
923 mu4e-search-include-related))
924 (while (or (string-empty-p (buffer-substring (point-min) (point-max)))
925 (equal (buffer-substring (point-min) (+ (point-min) (length mu4e~search-message))) mu4e~search-message)
926 (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))))
927 (sleep-for 0.005))))))))
928
929#+end_src
930
931**** execute-marks
932#+begin_src emacs-lisp
933(defun consult-mu--execute-all-marks (&optional no-confirmation)
934 "Execute the actions for all marked messages.
935
936Executes all actions for marked messages in the buffer
937`consult-mu-headers-buffer-name'.
938
939If NO-CONFIRMATION is non-nil, don't ask user for confirmation.
940
941This is similar to `mu4e-mark-execute-all' but, with buffer/window
942handling set accordingly for `consult-mu'."
943 (interactive "P")
944 (when-let* ((buf (get-buffer consult-mu-headers-buffer-name)))
945 (with-current-buffer buf
946 (when (eq major-mode 'mu4e-headers-mode)
947 (mu4e--mark-in-context
948 (let* ((marknum (mu4e-mark-marks-num)))
949 (unless (zerop marknum)
950 (pop-to-buffer buf)
951 (unless (one-window-p) (delete-other-windows))
952 (mu4e-mark-execute-all no-confirmation)
953 (quit-window))))))))
954
955#+end_src
956
957**** goto-message by message-id
958#+begin_src emacs-lisp
959(defun consult-mu--headers-goto-message-id (msgid)
960 "Jump to message with MSGID.
961
962This is done in `consult-mu-headers-buffer-name' buffer."
963 (when-let ((buffer consult-mu-headers-buffer-name))
964 (with-current-buffer buffer
965 (setq mu4e-view-buffer-name consult-mu-view-buffer-name)
966 (mu4e-headers-goto-message-id msgid))))
967
968#+end_src
969**** get message form message-id
970#+begin_src emacs-lisp
971(defun consult-mu--get-message-by-id (msgid)
972 "Find the message with MSGID and return the mu4e MSG plist for it."
973 (cl-letf* (((symbol-function #'mu4e-view) #'consult-mu--view-msg))
974 (when-let ((buffer consult-mu-headers-buffer-name))
975 (with-current-buffer buffer
976 (setq mu4e-view-buffer-name consult-mu-view-buffer-name)
977 (mu4e-headers-goto-message-id msgid)
978 (mu4e-message-at-point)))))
979
980#+end_src
981**** make or retrive from/to/cc/bcc plist
982#+begin_src emacs-lisp
983(defun consult-mu--contact-string-to-plist (string)
984 "Convert STRING for contacts to plist.
985
986STRING is the output form mu command, for example from:
987`mu find query --fields f`
988
989Returns a plist with \=':email and \':name keys.
990
991For example
992
993“John Doe <john.doe@example.com>”
994
995will be converted to
996
997\(:name “John Doe” :email “john.doe@example.com”\)"
998 (let* ((string (replace-regexp-in-string ">,\s\\|>;\s" ">\n" string))
999 (list (split-string string "\n" t)))
1000 (mapcar (lambda (item)
1001 (cond
1002 ((string-match "\\(?2:.*\\)\s+<\\(?1:.+\\)>" item)
1003 (list :email (or (match-string 1 item) nil) :name (or (match-string 2 item) nil)))
1004 ((string-match "^\\(?1:[a-zA-Z0-9\_\.\+\-]+@[a-zA-Z0-9\-]+\.[a-zA-Z0-9\-\.]+\\)" item)
1005 (list :email (or (match-string 1 item) nil) :name nil))
1006 (t
1007 (list :email (format "%s" item) :name nil)))) list)))
1008
1009#+end_src
1010
1011#+begin_src emacs-lisp
1012(defun consult-mu--contact-name-or-email (contact)
1013 "Retrieve name or email of CONTACT.
1014
1015Looks at the contact plist \(e.g. (:name “John Doe” :email
1016“john.doe@example.com”)\) and returns the name. If the name is missing,
1017returns the email address."
1018 (cond
1019 ((stringp contact)
1020 contact)
1021 ((listp contact)
1022 (mapconcat (lambda (item) (or (plist-get item :name) (plist-get item :email) "")) contact ","))))
1023
1024#+end_src
1025**** make custom headers info
1026***** make headers template
1027#+begin_src emacs-lisp
1028(defun consult-mu--headers-template ()
1029 "Make headers template using `consult-mu-headers-template'."
1030 (if (and consult-mu-headers-template (functionp consult-mu-headers-template))
1031 (funcall consult-mu-headers-template)
1032 consult-mu-headers-template))
1033
1034#+end_src
1035***** expand headers template
1036#+begin_src emacs-lisp
1037(defun consult-mu--expand-headers-template (msg string)
1038 "Expand STRING to create a custom header format for MSG.
1039
1040See `consult-mu-headers-template' for explanation of the format of
1041STRING."
1042
1043 (cl-loop for c in (split-string string "%" t)
1044 concat (concat (pcase (substring c 0 1)
1045 ("f" (let ((sender (consult-mu--contact-name-or-email (plist-get msg :from)))
1046 (length (string-to-number (substring c 1 nil))))
1047 (if sender
1048 (propertize (if (> length 0) (consult-mu--set-string-width sender length) sender) 'face 'consult-mu-sender-face))))
1049 ("t" (let ((receiver (consult-mu--contact-name-or-email (plist-get msg :to)))
1050 (length (string-to-number (substring c 1 nil))))
1051 (if receiver
1052 (propertize (if (> length 0) (consult-mu--set-string-width receiver length) receiver) 'face 'consult-mu-sender-face))))
1053 ("s" (let ((subject (plist-get msg :subject))
1054 (length (string-to-number (substring c 1 nil))))
1055 (if subject
1056 (propertize (if (> length 0) (consult-mu--set-string-width subject length) subject) 'face 'consult-mu-subject-face))))
1057 ("d" (let ((date (format-time-string "%a %d %b %y" (plist-get msg :date)))
1058 (length (string-to-number (substring c 1 nil))))
1059 (if date
1060 (propertize (if (> length 0) (consult-mu--set-string-width date length) date) 'face 'consult-mu-date-face))))
1061
1062 ("p" (let ((priority (plist-get msg :priority))
1063 (length (string-to-number (substring c 1 nil))))
1064 (if priority
1065 (propertize (if (> length 0) (consult-mu--set-string-width (format "%s" priority) length) (format "%s" priority)) 'face 'consult-mu-size-face))))
1066 ("z" (let ((size (file-size-human-readable (plist-get msg :size)))
1067 (length (string-to-number (substring c 1 nil))))
1068 (if size
1069 (propertize (if (> length 0) (consult-mu--set-string-width size length) size) 'face 'consult-mu-size-face))))
1070 ("i" (let ((id (plist-get msg :message-id))
1071 (length (string-to-number (substring c 1 nil))))
1072 (if id
1073 (propertize (if (> length 0) (consult-mu--set-string-width id length) id) 'face 'consult-mu-default-face))))
1074
1075 ("g" (let ((flags (plist-get msg :flags))
1076 (length (string-to-number (substring c 1 nil))))
1077 (if flags
1078 (propertize (if (> length 0) (consult-mu--set-string-width (format "%s" flags) length) (format "%s" flags)) 'face 'consult-mu-flags-face))))
1079
1080 ("G" (let ((flags (plist-get msg :flags))
1081 (length (string-to-number (substring c 1 nil))))
1082 (if flags
1083 (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))))
1084
1085 ("x" (let ((tags (plist-get msg :tags))
1086 (length (string-to-number (substring c 1 nil))))
1087 (if tags
1088 (propertize (if (> length 0) (consult-mu--set-string-width tags length) tags) 'face 'consult-mu-tags-face) nil)))
1089
1090 ("c" (let ((cc (consult-mu--contact-name-or-email (plist-get msg :cc)))
1091 (length (string-to-number (substring c 1 nil))))
1092 (if cc
1093 (propertize (if (> length 0) (consult-mu--set-string-width cc length) cc) 'face 'consult-mu-tags-face))))
1094
1095 ("h" (let ((bcc (consult-mu--contact-name-or-email (plist-get msg :bcc)))
1096 (length (string-to-number (substring c 1 nil))))
1097 (if bcc
1098 (propertize (if (> length 0) (consult-mu--set-string-width bcc length) bcc) 'face 'consult-mu-tags-face))))
1099
1100 ("r" (let ((changed (format-time-string "%a %d %b %y" (plist-get msg :changed)))
1101 (length (string-to-number (substring c 1 nil))))
1102 (if changed
1103 (propertize (if (> length 0) (consult-mu--set-string-width changed length) changed) 'face 'consult-mu-tags-face))))
1104 (_ nil))
1105 " ")))
1106
1107#+end_src
1108*** consult-mu backend
1109**** buffer handling
1110***** quit header buffer
1111#+begin_src emacs-lisp
1112(defun consult-mu--quit-header-buffer ()
1113 "Quits `consult-mu-headers-buffer-name' buffer."
1114 (save-mark-and-excursion
1115 (when-let* ((buf (get-buffer consult-mu-headers-buffer-name)))
1116 (with-current-buffer buf
1117 (if (eq major-mode 'mu4e-headers-mode)
1118 (mu4e-mark-handle-when-leaving)
1119 (quit-window t)
1120 ;; clear the decks before going to the main-view
1121 (mu4e--query-items-refresh 'reset-baseline))))))
1122
1123#+end_src
1124***** quit view buffer
1125#+begin_src emacs-lisp
1126(defun consult-mu--quit-view-buffer ()
1127 "Quits `consult-mu-view-buffer-name' buffer."
1128 (when-let* ((buf (get-buffer consult-mu-view-buffer-name)))
1129 (with-current-buffer buf
1130 (if (eq major-mode 'mu4e-view-mode)
1131 (mu4e-view-quit)))))
1132
1133#+end_src
1134***** quit main buffer
1135#+begin_src emacs-lisp
1136(defun consult-mu--quit-main-buffer ()
1137 "Quits `mu4e-main-buffer-name' buffer."
1138 (when-let* ((buf (get-buffer mu4e-main-buffer-name)))
1139 (with-current-buffer buf
1140 (if (eq major-mode 'mu4e-main-mode)
1141 (mu4e-quit)))))
1142
1143#+end_src
1144**** minibuffer completion utilities
1145***** lookup
1146#+begin_src emacs-lisp
1147(defun consult-mu--lookup ()
1148 "Lookup function for `consult-mu' or `consult-mu-async' candidates.
1149
1150This is passed as LOOKUP to `consult--read' on candidates and is used to
1151format the output when a candidate is selected."
1152 (lambda (sel cands &rest _args)
1153 (let* ((info (cdr (assoc sel cands)))
1154 (msg (plist-get info :msg))
1155 (subject (plist-get msg :subject)))
1156 (cons subject info))))
1157
1158#+end_src
1159
1160
1161***** group
1162#+begin_src emacs-lisp
1163(defun consult-mu--group-name (cand)
1164 "Get the group name of CAND using `consult-mu-group-by'.
1165
1166See `consult-mu-group-by' for details of grouping options."
1167 (let* ((msg (get-text-property 0 :msg cand))
1168 (group (or consult-mu--override-group consult-mu-group-by))
1169 (field (if (not (keywordp group)) (intern (concat ":" (format "%s" group))) group)))
1170 (pcase field
1171 (:date (format-time-string "%a %d %b %y" (plist-get msg field)))
1172 (:from (cond
1173 ((listp (plist-get msg field))
1174 (mapconcat (lambda (item) (or (plist-get item :name) (plist-get item :email))) (plist-get msg field) ";"))
1175 ((stringp (plist-get msg field)) (plist-get msg field))))
1176 (:to (cond
1177 ((listp (plist-get msg field))
1178 (mapconcat (lambda (item) (or (plist-get item :name) (plist-get item :email))) (plist-get msg field) ";"))
1179 ((stringp (plist-get msg field)) (plist-get msg field))))
1180 (:changed (format-time-string "%a %d %b %y" (plist-get msg field)))
1181 (:datetime (format-time-string "%F %r" (plist-get msg :date)))
1182 (:time (format-time-string "%X" (plist-get msg :date)))
1183 (:year (format-time-string "%Y" (plist-get msg :date)))
1184 (:month (format-time-string "%B" (plist-get msg :date)))
1185 (:day-of-week (format-time-string "%A" (plist-get msg :date)))
1186 (:day (format-time-string "%A" (plist-get msg :date)))
1187 (:week (format-time-string "%V" (plist-get msg :date)))
1188 (:size (file-size-human-readable (plist-get msg field)))
1189 (:flags (format "%s" (plist-get msg field)))
1190 (:tags (format "%s" (plist-get msg field)))
1191 (_ (if (plist-get msg field) (format "%s" (plist-get msg field)) nil)))))
1192
1193(defun consult-mu--group (cand transform)
1194 "Group function for `consult-mu' or `consult-mu-async'.
1195
1196CAND is passed to `consult-mu--group-name' to get the group for CAND.
1197When TRANSFORM is non-nil, the name of CAND is used for group."
1198 (when-let ((name (consult-mu--group-name cand)))
1199 (if transform (substring cand) name)))
1200
1201#+end_src
1202
1203***** actions
1204In this section we define action functions that can be run on a candidate for example view, reply, forward, etc.
1205****** view messages
1206#+begin_src emacs-lisp
1207(defun consult-mu--view (msg noselect mark-as-read match-str)
1208 "Opens MSG in `consult-mu-headers' and `consult-mu-view'.
1209
1210If NOSELECT is non-nil, does not select the view buffer/window.
1211If MARK-AS-READ is non-nil, marks the MSG as read.
1212If MATCH-STR is non-nil, highlights the MATCH-STR in the view buffer."
1213 (let ((msgid (plist-get msg :message-id)))
1214 (when-let ((buf (mu4e-get-headers-buffer consult-mu-headers-buffer-name t)))
1215 (with-current-buffer buf
1216 ;;(mu4e-headers-mode)
1217 (goto-char (point-min))
1218 (setq mu4e-view-buffer-name consult-mu-view-buffer-name)
1219 (unless noselect
1220 (switch-to-buffer buf))))
1221
1222 (consult-mu--view-msg msg consult-mu-view-buffer-name)
1223
1224 (with-current-buffer consult-mu-headers-buffer-name
1225 (if msgid
1226 (progn
1227 (mu4e-headers-goto-message-id msgid)
1228 (if mark-as-read
1229 (mu4e--server-move (mu4e-message-field-at-point :docid) nil "+S-u-N")))))
1230
1231 (when match-str
1232 (add-to-history 'search-ring match-str)
1233 (consult-mu--overlay-match match-str consult-mu-view-buffer-name t))
1234
1235 (with-current-buffer consult-mu-view-buffer-name
1236 (goto-char (point-min)))
1237
1238 (unless noselect
1239 (when msg
1240 (select-window (get-buffer-window consult-mu-view-buffer-name))))
1241 consult-mu-view-buffer-name))
1242
1243
1244(defun consult-mu--view-action (cand)
1245 "Open the candidate, CAND.
1246
1247This is a wrapper function around `consult-mu--view'. It parses CAND to
1248extract relevant MSG plist and other information and passes them to
1249`consult-mu--view'.
1250
1251To use this as the default action for `consult-mu', set
1252`consult-mu-default-action' to \=#'consult-mu--view-action."
1253
1254 (let* ((info (cdr cand))
1255 (msg (plist-get info :msg))
1256 (query (plist-get info :query))
1257 (match-str (car (consult--command-split query))))
1258 (consult-mu--view msg nil consult-mu-mark-viewed-as-read match-str)
1259 (consult-mu-overlays-toggle consult-mu-view-buffer-name)))
1260
1261#+end_src
1262
1263****** reply to message
1264#+begin_src emacs-lisp
1265(defun consult-mu--reply (msg &optional wide-reply)
1266 "Reply to MSG using `mu4e-compose-reply'.
1267
1268If WIDE-REPLY is non-nil use wide-reply \(a.k.a. reply all\) with
1269`mu4e-compose-wide-reply'."
1270 (let ((msgid (plist-get msg :message-id)))
1271 (when-let ((buf (mu4e-get-headers-buffer consult-mu-headers-buffer-name t)))
1272 (with-current-buffer buf
1273 (goto-char (point-min))
1274 (setq mu4e-view-buffer-name consult-mu-view-buffer-name)))
1275
1276
1277 (with-current-buffer consult-mu-headers-buffer-name
1278 (mu4e-headers-goto-message-id msgid)
1279 (if (not wide-reply)
1280 (mu4e-compose-reply)
1281 (mu4e-compose-wide-reply)))))
1282
1283(defun consult-mu--reply-action (cand &optional wide-reply)
1284 "Reply to CAND.
1285
1286This is a wrapper function around `consult-mu--reply'. It passes
1287relevant message plist, from CAND, as well as WIDE-REPLY to
1288`consult-mu--reply'.
1289
1290To use this as the default action for `consult-mu', set
1291`consult-mu-default-action' to \=#'consult-mu--reply-action."
1292 (let* ((info (cdr cand))
1293 (msg (plist-get info :msg))
1294 (wide-reply (or wide-reply
1295 (pcase consult-mu-use-wide-reply
1296 ('ask (y-or-n-p "Reply All?"))
1297 ('nil nil)
1298 ('t t)))))
1299 (consult-mu--reply msg wide-reply)))
1300
1301#+end_src
1302
1303****** forward a message
1304#+begin_src emacs-lisp
1305(defun consult-mu--forward (msg)
1306 "Forward the MSG using `mu4e-compose-forward'."
1307 (let ((msgid (plist-get msg :message-id)))
1308 (when-let ((buf (mu4e-get-headers-buffer consult-mu-headers-buffer-name t)))
1309 (with-current-buffer buf
1310 (goto-char (point-min))
1311 (setq mu4e-view-buffer-name consult-mu-view-buffer-name)))
1312 (with-current-buffer consult-mu-headers-buffer-name
1313 (mu4e-headers-goto-message-id msgid)
1314 (mu4e-compose-forward))))
1315
1316(defun consult-mu--forward-action (cand)
1317 "Forward CAND.
1318
1319This is a wrapper function around `consult-mu--forward'. It passes
1320the relevant message plist, from CAND to `consult-mu--forward'.
1321
1322To use this as the default action for `consult-mu', set
1323`consult-mu-default-action' to \=#'consult-mu--forward-action."
1324 (let* ((info (cdr cand))
1325 (msg (plist-get info :msg)))
1326 (consult-mu--forward msg)))
1327
1328#+end_src
1329
1330**** get consult split style character
1331#+begin_src emacs-lisp
1332(defun consult-mu--get-split-style-character (&optional style)
1333 "Get the character for consult async split STYLE.
1334
1335STYLE defaults to `consult-async-split-style'."
1336 (let ((style (or style consult-async-split-style 'none)))
1337 (or (char-to-string (plist-get (alist-get style consult-async-split-styles-alist) :initial))
1338 (char-to-string (plist-get (alist-get style consult-async-split-styles-alist) :separator))
1339 "")))
1340
1341#+end_src
1342** Frontend Interactive Commands
1343**** consult-mu-dynamic (dynamic collection)
1344***** format candidate
1345#+begin_src emacs-lisp
1346(defun consult-mu--dynamic-format-candidate (cand highlight)
1347 "Format minibuffer candidate, CAND.
1348
1349CAND is the minibuffer completion candidate \(a mu4e message collected by
1350`consult-mu--dynamic-collection'\). If HIGHLIGHT is non-nil, it is
1351highlighted with `consult-mu-highlight-match-face'."
1352
1353 (let* ((string (car cand))
1354 (info (cadr cand))
1355 (msg (plist-get info :msg))
1356 (query (plist-get info :query))
1357 (match-str (if (stringp query) (consult--split-escaped (car (consult--command-split query))) nil))
1358 (headers-template (consult-mu--headers-template))
1359 (str (if headers-template
1360 (consult-mu--expand-headers-template msg headers-template)
1361 string))
1362 (str (propertize str :msg msg :query query :type :dynamic)))
1363 (if (and consult-mu-highlight-matches highlight)
1364 (cond
1365 ((listp match-str)
1366 (mapc (lambda (match) (setq str (consult-mu--highlight-match match str t))) match-str))
1367 ((stringp match-str)
1368 (setq str (consult-mu--highlight-match match-str str t))))
1369 str)
1370 (when msg
1371 (cons str (list :msg msg :query query :type :dynamic)))))
1372#+end_src
1373
1374***** dynamic collection
1375#+begin_src emacs-lisp
1376(defun consult-mu--dynamic-collection (input)
1377 "Dynamically collect mu4e search results.
1378
1379INPUT is the user input. It is passed as QUERY to
1380`consult-mu--update-headers', appends the result to
1381`consult-mu-headers-buffer-name' and returns a list of found
1382messages."
1383
1384 (save-excursion
1385 (pcase-let* ((`(,_arg . ,opts) (consult--command-split input)))
1386 (consult-mu--update-headers (substring-no-properties input) nil nil :dynamic)
1387 (if (or (member "-g" opts) (member "--group" opts))
1388 (cond
1389 ((member "-g" opts)
1390 (setq consult-mu--override-group (intern (or (nth (+ (cl-position "-g" opts :test 'equal) 1) opts) "nil"))))
1391 ((member "--group" opts)
1392 (setq consult-mu--override-group (intern (or (nth (+ (cl-position "--group" opts :test 'equal) 1) opts) "nil")))))
1393 (setq consult-mu--override-group nil)))
1394
1395 (with-current-buffer consult-mu-headers-buffer-name
1396 (goto-char (point-min))
1397 (remove nil
1398 (cl-loop until (eobp)
1399 collect (consult-mu--dynamic-format-candidate (list (buffer-substring (point) (line-end-position)) (list :msg (ignore-errors (mu4e-message-at-point)) :query input)) t)
1400 do (forward-line 1))))))
1401#+end_src
1402***** state/preview
1403#+begin_src emacs-lisp
1404(defun consult-mu--dynamic-state ()
1405 "State function for `consult-mu' candidates.
1406This is passed as STATE to `consult--read' and is used to preview or do
1407other actions on the candidate."
1408 (lambda (action cand)
1409 (let ((preview (consult--buffer-preview)))
1410 (pcase action
1411 ('preview
1412 (if cand
1413 (when-let* ((info (cdr cand))
1414 (msg (plist-get info :msg))
1415 (query (plist-get info :query))
1416 (msgid (substring-no-properties (plist-get msg :message-id)))
1417 (match-str (car (consult--command-split query)))
1418 (match-str (car (consult--command-split query)))
1419 (mu4e-headers-buffer-name consult-mu-headers-buffer-name)
1420 (buffer consult-mu-view-buffer-name))
1421 ;;(get-buffer-create consult-mu-view-buffer-name)
1422 (add-to-list 'consult-mu--view-buffers-list buffer)
1423 (funcall preview action
1424 (consult-mu--view msg t consult-mu-mark-previewed-as-read match-str))
1425 (with-current-buffer consult-mu-view-buffer-name
1426 (unless (one-window-p) (delete-other-windows))))))
1427 ('return
1428 (save-mark-and-excursion
1429 (consult-mu--execute-all-marks))
1430 (setq consult-mu--override-group nil)
1431 cand)))))
1432
1433#+end_src
1434
1435***** internal dynamic call
1436#+begin_src emacs-lisp
1437(defun consult-mu--dynamic (prompt collection &optional initial)
1438 "Query mu4e messages dyunamically.
1439
1440This is a non-interactive internal function. For the interactive version
1441see `consult-mu'.
1442
1443It runs the `consult-mu--dynamic-collection' to do a `mu4e-search' with
1444user input \(e.g. INITIAL\) and returns the results \(list of messages
1445found\) as a completion table in minibuffer.
1446
1447The completion table gets dynamically updated as the user types in the
1448minibuffer. Each candidate in the minibuffer is formatted by
1449`consult-mu--dynamic-format-candidate' to add annotation and other info to
1450the candidate.
1451
1452Description of Arguments:
1453 PROMPT the prompt in the minibuffer
1454 \(passed as PROMPT to `consult--read'\)
1455 COLLECTION a colection function passed to `consult--dynamic-collection'.
1456 INITIAL an optional arg for the initial input in the minibuffer.
1457 \(passed as INITITAL to `consult--read'\)
1458
1459commandline arguments/options \(see `mu find --help` in the command line
1460for details\) can be passed to the minibuffer input similar to
1461`consult-grep'. For example the user can enter:
1462
1463“#paper -- --maxnum 200 --sortfield from --reverse”
1464
1465this will search for mu4e messages with the query “paper”, retrives a
1466maximum of 200 messages and sorts them by the “from:” field and reverses
1467the sort direction (opposite of `consult-mu-search-sort-field').
1468
1469Note that some command line arguments are not supported by mu4e (for
1470example sorting based on cc: or bcc: fields are not supported in
1471`mu4e-search-sort-field')
1472
1473Also, the results can further be narrowed by
1474`consult-async-split-style' \(e.g. by entering “#” when
1475`consult-async-split-style' is set to \='perl\).
1476
1477For example:
1478
1479“#paper -- --maxnum 200 --sortfield from --reverse#accepted”
1480
1481will retrieve the message as the example above, then narrows down the
1482candidates to those that that match “accepted”."
1483 (consult--read
1484 (consult--dynamic-collection (or collection #'consult-mu--dynamic-collection))
1485 :prompt (or prompt "Select: ")
1486 :lookup (consult-mu--lookup)
1487 :state (funcall #'consult-mu--dynamic-state)
1488 :initial initial
1489 :group #'consult-mu--group
1490 :add-history (append (list (thing-at-point 'symbol))
1491 consult-mu-saved-searches-dynamic)
1492 :history '(:input consult-mu--history)
1493 :require-match t
1494 :category 'consult-mu-messages
1495 :preview-key consult-mu-preview-key
1496 :sort nil))
1497
1498#+end_src
1499
1500***** interactive command
1501#+begin_src emacs-lisp
1502(defun consult-mu-dynamic (&optional initial noaction)
1503 "Lists results of `mu4e-search' dynamically.
1504
1505This is an interactive wrapper function around `consult-mu--dynamic'. It
1506queries the user for a search term in the minibuffer, then fetches a list
1507of messages for the entered search term as a minibuffer completion table
1508for selection. The list of candidates in the completion table are
1509dynamically updated as the user changes the entry.
1510
1511Upon selection of a candidate either
1512 - the candidate is returned if NOACTION is non-nil
1513 or
1514 - the candidate is passed to `consult-mu-action' if NOACTION is nil.
1515
1516Additional commandline arguments can be passed in the minibuffer entry by
1517typing “--” followed by command line arguments.
1518
1519For example, the user can enter:
1520
1521“#consult-mu -- -n 10”
1522
1523this will run a `mu4e-search' with the query “consult-mu” and changes the
1524search limit \(i.e. `mu4e-search-results-limit' to 10\).
1525
1526
1527Also, the results can further be narrowed by
1528`consult-async-split-style' \(e.g. by entering “#” when
1529`consult-async-split-style' is set to \='perl\).
1530
1531For example:
1532
1533“#consult-mu -- -n 10#github”
1534
1535will retrieve the messages as the example above, then narrows down the
1536completion table to candidates that match “github”.
1537
1538INITIAL is an optional arg for the initial input in the minibuffer.
1539\(passed as INITITAL to `consult-mu--dynamic'\)
1540
1541For more details on consult--async functionalities, see `consult-grep' and
1542the official manual of consult, here:
1543URL `https://github.com/minad/consult'"
1544 (interactive)
1545 (save-mark-and-excursion
1546 (consult-mu--execute-all-marks))
1547 (let* ((sel
1548 (consult-mu--dynamic (concat "[" (propertize "consult-mu-dynamic" 'face 'consult-mu-sender-face) "]" " Search For: ") #'consult-mu--dynamic-collection initial)))
1549 (save-mark-and-excursion
1550 (consult-mu--execute-all-marks))
1551 (if noaction
1552 sel
1553 (progn
1554 (funcall consult-mu-action sel)
1555 sel))))
1556#+end_src
1557
1558**** consult-mu-async
1559***** format candidate
1560#+begin_src emacs-lisp
1561(defun consult-mu--async-format-candidate (string input highlight)
1562 "Formats minibuffer candidates for `consult-mu-async'.
1563
1564STRING is the output retrieved from `mu find INPUT ...` in the command line.
1565INPUT is the query from the user.
1566
1567If HIGHLIGHT is t, input is highlighted with
1568`consult-mu-highlight-match-face' in the minibuffer."
1569
1570 (let* ((query input)
1571 (parts (split-string (replace-regexp-in-string "^\\\\->\s\\|^\\\/->\s" "" string) consult-mu-delimiter))
1572 (msgid (car parts))
1573 (date (date-to-time (cadr parts)))
1574 (sender (cadr (cdr parts)))
1575 (sender (consult-mu--contact-string-to-plist sender))
1576 (receiver (cadr (cdr (cdr parts))))
1577 (receiver (consult-mu--contact-string-to-plist receiver))
1578 (subject (cadr (cdr (cdr (cdr parts)))))
1579 (size (string-to-number (cadr (cdr (cdr (cdr (cdr parts)))))))
1580 (flags (consult-mu-flags-to-string (cadr (cdr (cdr (cdr (cdr (cdr parts))))))))
1581 (tags (cadr (cdr (cdr (cdr (cdr (cdr (cdr parts))))))))
1582 (priority (cadr (cdr (cdr (cdr (cdr (cdr (cdr (cdr parts)))))))))
1583 (cc (cadr (cdr (cdr (cdr (cdr (cdr (cdr (cdr (cdr parts))))))))))
1584 (cc (consult-mu--contact-string-to-plist cc))
1585 (bcc (cadr (cdr (cdr (cdr (cdr (cdr (cdr (cdr (cdr (cdr parts)))))))))))
1586 (bcc (consult-mu--contact-string-to-plist bcc))
1587 (path (cadr (cdr (cdr (cdr (cdr (cdr (cdr (cdr (cdr (cdr (cdr parts))))))))))))
1588 (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))
1589 (match-str (if (stringp input) (consult--split-escaped (car (consult--command-split query))) nil))
1590 (headers-template (consult-mu--headers-template))
1591 (str (if headers-template
1592 (consult-mu--expand-headers-template msg headers-template)
1593 (format "%s\s\s%s\s\s%s\s\s%s\s\s%s\s\s%s"
1594 (propertize (consult-mu--set-string-width
1595 (format-time-string "%x" date) 10)
1596 'face 'consult-mu-date-face)
1597 (propertize (consult-mu--set-string-width (consult-mu--contact-name-or-email sender) (floor (* (frame-width) 0.2))) 'face 'consult-mu-sender-face)
1598 (propertize (consult-mu--set-string-width subject (floor (* (frame-width) 0.55))) 'face 'consult-mu-subject-face)
1599 (propertize (file-size-human-readable size) 'face 'consult-mu-size-face)
1600 (propertize (format "%s" flags) 'face 'consult-mu-flags-face)
1601 (propertize (if tags (format "%s" tags) nil) 'face 'consult-mu-tags-face))))
1602 (str (propertize str :msg msg :query query :type :async)))
1603 (if (and consult-mu-highlight-matches highlight)
1604 (cond
1605 ((listp match-str)
1606 (mapc (lambda (match) (setq str (consult-mu--highlight-match match str t))) match-str))
1607 ((stringp match-str)
1608 (setq str (consult-mu--highlight-match match-str str t))))
1609 str)
1610 (cons str (list :msg msg :query query :type :async))))
1611
1612#+end_src
1613
1614
1615***** state/preview
1616#+begin_src emacs-lisp
1617(defun consult-mu--async-state ()
1618 "State function for `consult-mu-async' candidates.
1619
1620This is passed as STATE to `consult--read' and is used to preview or do
1621other actions on the candidate."
1622 (lambda (action cand)
1623 (let ((preview (consult--buffer-preview)))
1624 (pcase action
1625 ('preview
1626 (if cand
1627 (when-let* ((info (cdr cand))
1628 (msg (plist-get info :msg))
1629 (msgid (substring-no-properties (plist-get msg :message-id)))
1630 (query (plist-get info :query))
1631 (match-str (car (consult--command-split query)))
1632 (mu4e-headers-buffer-name consult-mu-headers-buffer-name)
1633 (buffer consult-mu-view-buffer-name))
1634 (add-to-list 'consult-mu--view-buffers-list buffer)
1635 (funcall preview action
1636 (consult-mu--view msg t consult-mu-mark-previewed-as-read match-str))
1637 (with-current-buffer consult-mu-view-buffer-name
1638 (unless (one-window-p) (delete-other-windows))))))
1639 ('return
1640 (save-mark-and-excursion
1641 (consult-mu--execute-all-marks))
1642 cand)))))
1643
1644#+end_src
1645
1646
1647***** transform
1648#+begin_src emacs-lisp
1649(defun consult-mu--async-transform (input)
1650 "Add annotation to minibuffer candiates for `consult-mu'.
1651
1652Format each candidates with `consult-gh--repo-format' and INPUT."
1653 (lambda (cands)
1654 (cl-loop for cand in cands
1655 collect
1656 (consult-mu--async-format-candidate cand input t))))
1657
1658#+end_src
1659
1660***** builder
1661#+begin_src emacs-lisp
1662(defun consult-mu--async-builder (input)
1663 "Build mu command line for searching messages by INPUT (e.g. `mu find INPUT)`."
1664 (pcase-let* ((consult-mu-args (append consult-mu-args '("find")))
1665 (cmd (consult--build-args consult-mu-args))
1666 (`(,arg . ,opts) (consult--command-split input))
1667 (flags (append cmd opts))
1668 (sortfield (cond
1669 ((member "-s" flags) (nth (+ (cl-position "-s" opts :test 'equal) 1) flags))
1670 ((member "--sortfield" flags) (nth (+ (cl-position "--sortfield" flags :test 'equal) 1) flags))
1671 (t (substring (symbol-name consult-mu-search-sort-field) 1))))
1672 (threads (if (not (equal sortfield :date)) nil (or (member "-t" flags) (member "--threads" flags) mu4e-search-threads)))
1673 (skip-dups (or (member "-u" flags) (member "--skip-dups" flags) mu4e-search-skip-duplicates))
1674 (include-related (or (member "-r" flags) (member "--include-related" flags) mu4e-search-include-related)))
1675 (if (or (member "-g" flags) (member "--group" flags))
1676 (cond
1677 ((member "-g" flags)
1678 (setq consult-mu--override-group (intern (or (nth (+ (cl-position "-g" opts :test 'equal) 1) opts) "nil")))
1679 (setq opts (remove "-g" (remove (nth (+ (cl-position "-g" opts :test 'equal) 1) opts) opts))))
1680 ((member "--group" flags)
1681 (setq consult-mu--override-group (intern (or (nth (+ (cl-position "--group" opts :test 'equal) 1) opts) "nil")))
1682 (setq opts (remove "--group" (remove (nth (+ (cl-position "--group" opts :test 'equal) 1) opts) opts)))))
1683 (setq consult-mu--override-group nil))
1684 (setq opts (append opts (list "--nocolor")))
1685 (setq opts (append opts (list "--fields" (format "i%sd%sf%st%ss%sz%sg%sx%sp%sc%sh%sl"
1686 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))))
1687 (unless (or (member "-s" flags) (member "--sortfiled" flags))
1688 (setq opts (append opts (list "--sortfield" (substring (symbol-name consult-mu-search-sort-field) 1)))))
1689 (if threads (setq opts (append opts (list "--thread"))))
1690 (if skip-dups (setq opts (append opts (list "--skip-dups"))))
1691 (if include-related (setq opts (append opts (list "--include-related"))))
1692 (cond
1693 ((and (member "-n" flags) (< (string-to-number (nth (+ (cl-position "-n" opts :test 'equal) 1) opts)) 0))
1694 (setq opts (remove "-n" (remove (nth (+ (cl-position "-n" opts :test 'equal) 1) opts) opts))))
1695 ((and (member "--maxnum" flags) (< (string-to-number (nth (+ (cl-position "--maxnum" opts :test 'equal) 1) opts)) 0))
1696 (setq opts (remove "--maxnum" (remove (nth (+ (cl-position "--maxnum" opts :test 'equal) 1) opts) opts)))))
1697 (unless (or (member "-n" flags) (member "--maxnum" flags))
1698 (if (and consult-mu-maxnum (> consult-mu-maxnum 0))
1699 (setq opts (append opts (list "--maxnum" (format "%s" consult-mu-maxnum))))))
1700
1701 (pcase consult-mu-search-sort-direction
1702 ('descending
1703 (if (or (member "-z" flags) (member "--reverse" flags))
1704 (setq opts (remove "-z" (remove "--reverse" opts)))
1705 (setq opts (append opts (list "--reverse")))))
1706 ('ascending)
1707 (_))
1708 (pcase-let* ((`(,re . ,hl) (funcall consult--regexp-compiler arg 'basic t)))
1709 (when re
1710 (cons (append cmd
1711 (list (string-join re " "))
1712 opts)
1713 hl)))))
1714
1715#+end_src
1716
1717
1718***** internal async command
1719#+begin_src emacs-lisp
1720(defun consult-mu--async (prompt builder &optional initial)
1721 "Query mu4e messages asynchronously.
1722
1723This is a non-interactive internal function. For the interactive
1724version, see `consult-mu-async'.
1725
1726It runs the command line from `consult-mu--async-builder' in an async
1727process and returns the results (list of messages) as a completion table
1728in minibuffer that will be passed to `consult--read'. The completion
1729table gets dynamically updated as the user types in the minibuffer. Each
1730candidate in the minibuffer is formatted by `consult-mu--async-transform'
1731to add annotation and other info to the candidate.
1732
1733Description of Arguments:
1734
1735PROMPT the prompt in the minibuffer
1736 \(passed as PROMPT to `consult--red'\)
1737BUILDER an async builder function passed to `consult--async-command'
1738INITIAL an optional arg for the initial input in the minibuffer
1739 \(passed as INITITAL to `consult--read'\)
1740
1741commandline arguments/options \(see `mu find --help` in the command line
1742for details\) can be passed to the minibuffer input similar to
1743`consult-grep'. For example the user can enter:
1744
1745“#paper -- --maxnum 200 --sortfield from --reverse”
1746
1747this will search for mu4e messages with the query “paper”, retrives a
1748maximum of 200 messages sorts them by the “from:” field and reverses the
1749sort direction (opposite of `consult-mu-search-sort-field').
1750
1751Also, the results can further be narrowed by
1752`consult-async-split-style' \(e.g. by entering “#” when
1753`consult-async-split-style' is set to \='perl\).
1754
1755For example:
1756
1757`#paper -- --maxnum 200 --sortfield from --reverse#accepted'
1758
1759will retrieve the message as the example above, then narrows down the
1760completion table to candidates that match “accepted”."
1761 (consult--read
1762 (consult--process-collection builder
1763 :transform (consult--async-transform-by-input #'consult-mu--async-transform))
1764 :prompt prompt
1765 :lookup (consult-mu--lookup)
1766 :state (funcall #'consult-mu--async-state)
1767 :initial initial
1768 :group #'consult-mu--group
1769 :add-history (append (list (thing-at-point 'symbol))
1770 consult-mu-saved-searches-async)
1771 :history '(:input consult-mu--history)
1772 :require-match t
1773 :category 'consult-mu-messages
1774 :preview-key consult-mu-preview-key
1775 :sort nil))
1776
1777#+end_src
1778
1779***** interactive command
1780#+begin_src emacs-lisp
1781(defun consult-mu-async (&optional initial noaction)
1782 "Lists results of `mu find` Asynchronously.
1783
1784This is an interactive wrapper function around `consult-mu--async'. It
1785queries the user for a search term in the minibuffer, then fetches a list
1786of messages for the entered search term as a minibuffer completion table
1787for selection. The list of candidates in the completion table are
1788dynamically updated as the user changes the entry.
1789
1790Upon selection of a candidate either
1791 - the candidate is returned if NOACTION is non-nil
1792 or
1793 - the candidate is passed to `consult-mu-action' if NOACTION is nil.
1794
1795Additional commandline arguments can be passed in the minibuffer entry by
1796typing `--` followed by command line arguments.
1797
1798For example the user can enter:
1799
1800`#consult-mu -- -n 10'
1801
1802this will run a `mu4e-search' with the query \"consult-my\" and changes the
1803search limit (i.e. `mu4e-search-results-limit' to 10.
1804
1805
1806Also, the results can further be narrowed by `consult-async-split-style'
1807\(e.g. by entering “#” when `consult-async-split-style' is set to \='perl\).
1808
1809For example:
1810
1811“#consult-mu -- -n 10#github”
1812
1813will retrieve the message as the example above, then narrows down the
1814completion table to candidates that match “github”.
1815
1816INITIAL is an optional arg for the initial input in the minibuffer.
1817\(passed as INITITAL to `consult-mu--async'\).
1818
1819For more details on consult--async functionalities, see `consult-grep' and
1820the official manual of consult, here:
1821URL `https://github.com/minad/consult'
1822
1823Note that this is the async search directly using the commandline `mu`
1824command and not mu4e-search. As a result, mu4e-headers buffers are not
1825created until a single message is selected \(or interacted with using
1826embark, etc.\) Previews are shown in a mu4e-view buffer \(see
1827`consult-mu-view-buffer-name'\) attached to an empty mu4e-headers buffer
1828\(i.e. `consult-mu-headers-buffer-name'\). This allows quick retrieval of
1829many messages \(tens of thousands\) and previews, but not opening the
1830results in a mu4e-headers buffer. If you want ot open the results in a
1831mu4e-headers buffer for other work flow, then you should use the
1832dynamically collected function `consult-mu' which is slower if searching
1833for many emails but allows follow up interactions in a mu4e-headers
1834buffer."
1835 (interactive)
1836 (save-mark-and-excursion
1837 (consult-mu--execute-all-marks))
1838 (let* ((sel
1839 (consult-mu--async (concat "[" (propertize "consult-mu async" 'face 'consult-mu-sender-face) "]" " Search For: ") #'consult-mu--async-builder initial))
1840 (info (cdr sel))
1841 (msg (plist-get info :msg))
1842 (query (plist-get info :query)))
1843 (save-mark-and-excursion
1844 (consult-mu--execute-all-marks))
1845 (if noaction
1846 sel
1847 (progn
1848 (consult-mu--update-headers query t msg :async))
1849 (funcall consult-mu-action sel)
1850 sel)))
1851
1852#+end_src
1853
1854
1855**** consult-mu
1856
1857***** interactive command
1858#+begin_src emacs-lisp
1859(defun consult-mu (&optional initial noaction)
1860 "Default interactive command.
1861
1862This is a wrapper function that calls `consult-mu-default-command' with
1863INITIAL and NOACTION.
1864
1865For example, the `consult-mu-default-command can be set to
1866 `#'consult-mu-dynamic' sets the default behavior to dynamic collection
1867 `#'consult-mu-async' sets the default behavior to async collection"
1868
1869 (interactive "P")
1870 (funcall consult-mu-default-command initial noaction))
1871
1872#+end_src
1873
1874
1875** Provide
1876#+begin_src emacs-lisp
1877;;; provide `consult-mu' module
1878(provide 'consult-mu)
1879
1880#+end_src
1881** Footer
1882#+begin_src emacs-lisp
1883;;; consult-mu.el ends here
1884#+end_src
1885
1886* consult-mu-embark.el
1887:PROPERTIES:
1888:header-args:emacs-lisp: :results none :mkdirp yes :comments none :tangle ./consult-mu-embark.el
1889:END:
1890*** Header
1891#+begin_src emacs-lisp
1892;;; consult-mu-embark.el --- Emabrk Actions for consult-mu -*- lexical-binding: t -*-
1893
1894;; Copyright (C) 2021-2023
1895
1896;; Author: Armin Darvish
1897;; Maintainer: Armin Darvish
1898;; Created: 2023
1899;; Version: 1.0
1900;; Package-Requires: ((emacs "28.0") (consult "2.0"))
1901;; Homepage: https://github.com/armindarvish/consult-mu
1902;; Keywords: convenience, matching, tools, email
1903;; Homepage: https://github.com/armindarvish/consult-mu
1904
1905;; SPDX-License-Identifier: GPL-3.0-or-later
1906
1907;; This file is free software: you can redistribute it and/or modify
1908;; it under the terms of the GNU General Public License as published
1909;; by the Free Software Foundation, either version 3 of the License,
1910;; or (at your option) any later version.
1911;;
1912;; This file is distributed in the hope that it will be useful,
1913;; but WITHOUT ANY WARRANTY; without even the implied warranty of
1914;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
1915;; GNU General Public License for more details.
1916;;
1917;; You should have received a copy of the GNU General Public License
1918;; along with this file. If not, see <https://www.gnu.org/licenses/>.
1919
1920
1921;;; Commentary:
1922
1923;; This package provides an alternative interactive serach interface for
1924;; mu and mu4e (see URL `https://djcbsoftware.nl/code/mu/mu4e.html').
1925;; It uses a consult-based minibuffer completion for searching and
1926;; selecting, and marking emails, as well as additional utilities for
1927;; composing emails and more.
1928
1929;; This package requires mu4e version "1.10.8" or later.
1930
1931;;; Code:
1932
1933#+end_src
1934
1935*** Main
1936This section includes additional useful embark actions as well as possible keymaps. This will be provided as examples and starting point to users, so that they can make their own custom embark actions and functions.
1937
1938#+begin_src emacs-lisp
1939;;; Requirements
1940(require 'embark)
1941(require 'consult-mu)
1942
1943;;; Customization Variables
1944(defcustom consult-mu-embark-noconfirm-before-execute nil
1945 "Should consult-mu-embark skip confirmation when executing marks?"
1946 :group 'consult-mu
1947 :type 'boolean)
1948
1949;;; Define Embark Action Functions
1950(defun consult-mu-embark-default-action (cand)
1951 "Run `consult-mu-action' on the candidate, CAND."
1952 (let* ((msg (get-text-property 0 :msg cand))
1953 (query (get-text-property 0 :query cand))
1954 (type (get-text-property 0 :type cand))
1955 (newcand (cons cand `(:msg ,msg :query ,query :type ,type))))
1956 (if (equal type :async)
1957 (consult-mu--update-headers query t msg :async))
1958 (funcall consult-mu-action newcand)))
1959
1960
1961
1962(defun consult-mu-embark-reply (cand)
1963 "Reply to message in CAND."
1964 (let* ((msg (get-text-property 0 :msg cand))
1965 (query (get-text-property 0 :query cand))
1966 (type (get-text-property 0 :type cand)))
1967 (if (equal type :async)
1968 (consult-mu--update-headers query t msg :async))
1969 (consult-mu--reply msg nil)))
1970
1971(defun consult-mu-embark-wide-reply (cand)
1972 "Reply all for message in CAND."
1973 (let* ((msg (get-text-property 0 :msg cand))
1974 (query (get-text-property 0 :query cand))
1975 (type (get-text-property 0 :type cand)))
1976 (if (equal type :async)
1977 (consult-mu--update-headers query t msg :async))
1978 (consult-mu--reply msg )))
1979
1980(defun consult-mu-embark-forward (cand)
1981 "Forward the message in CAND."
1982 (let* ((msg (get-text-property 0 :msg cand))
1983 (query (get-text-property 0 :query cand))
1984 (type (get-text-property 0 :type cand)))
1985 (if (equal type :async)
1986 (consult-mu--update-headers query t msg :async))
1987 (consult-mu--forward msg)))
1988
1989(defun consult-mu-embark-kill-message-field (cand)
1990 "Get a header field of message in CAND."
1991 (let* ((msg (get-text-property 0 :msg cand))
1992 (query (get-text-property 0 :query cand))
1993 (type (get-text-property 0 :type cand))
1994 (msg-id (plist-get msg :message-id)))
1995 (if (equal type :async)
1996 (consult-mu--update-headers query t msg :async))
1997 (with-current-buffer consult-mu-headers-buffer-name
1998 (unless (equal (mu4e-message-field-at-point :message-id) msg-id)
1999 (mu4e-headers-goto-message-id msg-id))
2000 (if (equal (mu4e-message-field-at-point :message-id) msg-id)
2001 (progn
2002 (mu4e~headers-update-handler msg nil nil))))
2003
2004 (with-current-buffer consult-mu-view-buffer-name
2005 (kill-new (consult-mu--message-get-header-field))
2006 (consult-mu--pulse-region (point) (line-end-position)))))
2007
2008(defun consult-mu-embark-save-attachmnts (cand)
2009 "Save attachments of CAND."
2010 (let* ((msg (get-text-property 0 :msg cand))
2011 (query (get-text-property 0 :query cand))
2012 (type (get-text-property 0 :type cand))
2013 (msg-id (plist-get msg :message-id)))
2014
2015 (if (equal type :async)
2016 (consult-mu--update-headers query t msg :async))
2017
2018 (with-current-buffer consult-mu-headers-buffer-name
2019 (unless (equal (mu4e-message-field-at-point :message-id) msg-id)
2020 (mu4e-headers-goto-message-id msg-id))
2021 (if (equal (mu4e-message-field-at-point :message-id) msg-id)
2022 (progn
2023 (mu4e~headers-update-handler msg nil nil))))
2024
2025 (with-current-buffer consult-mu-view-buffer-name
2026 (goto-char (point-min))
2027 (re-search-forward "^\\(Attachment\\|Attachments\\): " nil t)
2028 (consult-mu--pulse-region (point) (line-end-position))
2029 (mu4e-view-save-attachments t))))
2030
2031(defun consult-mu-embark-search-messages-from-contact (cand)
2032 "Search messages from the same sender as the message in CAND."
2033 (let* ((msg (get-text-property 0 :msg cand))
2034 (from (car (plist-get msg :from)))
2035 (email (plist-get from :email)))
2036 (consult-mu (concat "from:" email))))
2037
2038(defun consult-mu-embark-search-messages-with-subject (cand)
2039 "Search all messages for the same subject as the message in CAND."
2040 (let* ((msg (get-text-property 0 :msg cand))
2041 ;;(subject (replace-regexp-in-string ":\\|#\\|\\.\\|\\+" "" (plist-get msg :subject)))
2042 (subject (replace-regexp-in-string ":\\|#\\|\\.\\|\\+\\|\\(\\[.*\\]\\)" "" (format "%s" (plist-get msg :subject)))))
2043 (consult-mu (concat "subject:" subject))))
2044
2045;; macro for defining functions for marks
2046(defmacro consult-mu-embark--defun-mark-for (mark)
2047 "Define a function mu4e-view-mark-for- MARK."
2048 (let ((funcname (intern (format "consult-mu-embark-mark-for-%s" mark)))
2049 (docstring (format "Mark the current message for %s." mark)))
2050 `(progn
2051 (defun ,funcname (cand) ,docstring
2052 (let* ((msg (get-text-property 0 :msg cand))
2053 (msgid (plist-get msg :message-id))
2054 (query (get-text-property 0 :query cand))
2055 (buf (get-buffer consult-mu-headers-buffer-name)))
2056 (if buf
2057 (progn
2058 (with-current-buffer buf
2059 (if (eq major-mode 'mu4e-headers-mode)
2060 (progn
2061 (goto-char (point-min))
2062 (mu4e-headers-goto-message-id msgid)
2063 (if (equal (mu4e-message-field-at-point :message-id) msgid)
2064 (mu4e-headers-mark-and-next ',mark)
2065 (progn
2066 (consult-mu--update-headers query t msg :async)
2067 (with-current-buffer buf
2068 (goto-char (point-min))
2069 (mu4e-headers-goto-message-id msgid)
2070 (if (equal (mu4e-message-field-at-point :message-id) msgid)
2071 (mu4e-headers-mark-and-next ',mark))))))
2072 (progn
2073 (consult-mu--update-headers query t msg :async)
2074 (with-current-buffer buf
2075 (goto-char (point-min))
2076 (mu4e-headers-goto-message-id msgid)
2077 (if (equal (mu4e-message-field-at-point :message-id) msgid)
2078 (mu4e-headers-mark-and-next ',mark)))))))))))))
2079
2080;; add embark functions for marks
2081(defun consult-mu-embark--defun-func-for-marks (marks)
2082 "Run the macro `consult-mu-embark--defun-mark-for' on MARKS.
2083
2084MARKS is a list of marks.
2085
2086This is useful for creating embark functions for all the `mu4e-marks'
2087elements."
2088 (mapcar (lambda (mark) (eval `(consult-mu-embark--defun-mark-for ,mark))) marks))
2089
2090;; use consult-mu-embark--defun-func-for-marks to make a function for each `mu4e-marks' element.
2091(consult-mu-embark--defun-func-for-marks (mapcar 'car mu4e-marks))
2092
2093;;; Define Embark Keymaps
2094(defvar-keymap consult-mu-embark-general-actions-map
2095 :doc "Keymap for consult-mu-embark"
2096 :parent embark-general-map)
2097
2098(add-to-list 'embark-keymap-alist '(consult-mu . consult-mu-embark-general-actions-map))
2099
2100
2101(defvar-keymap consult-mu-embark-messages-actions-map
2102 :doc "Keymap for consult-mu-embark-messages"
2103 :parent consult-mu-embark-general-actions-map
2104 "r" #'consult-mu-embark-reply
2105 "w" #'consult-mu-embark-wide-reply
2106 "f" #'consult-mu-embark-forward
2107 "?" #'consult-mu-embark-kill-message-field
2108 "c" #'consult-mu-embark-search-messages-from-contact
2109 "s" #'consult-mu-embark-search-messages-with-subject
2110 "S" #'consult-mu-embark-save-attachmnts)
2111
2112(add-to-list 'embark-keymap-alist '(consult-mu-messages . consult-mu-embark-messages-actions-map))
2113
2114
2115;; add mark keys to `consult-mu-embark-messages-actions-map' keymap
2116(defun consult-mu-embark--add-keys-for-marks (marks)
2117 "Add a key for each mark in MARKS to embark map.
2118
2119Adds the keys in `consult-mu-embark-messages-actions-map', and binds the
2120combination “m key”, where key is the :char in mark plist in the
2121`consult-mu-embark-messages-actions-map' to the function defined by the
2122prefix “consult-mu-embark-mark-for-” and mark.
2123
2124This is useful for adding all `mu4e-marks' to embark key bindings under a
2125submenu (called by “m”), for example, the default mark-for-archive mark
2126that is bound to r in mu4e buffers can be called in embark by “m r”."
2127 (mapcar (lambda (mark)
2128 (let* ((key (plist-get (cdr mark) :char))
2129 (key (cond ((consp key) (car key)) ((stringp key) key)))
2130 (func (intern (concat "consult-mu-embark-mark-for-" (format "%s" (car mark)))))
2131 (key (concat "m" key)))
2132 (define-key consult-mu-embark-messages-actions-map key func)))
2133 marks))
2134
2135;; add all `mu4e-marks to embark keybindings. See `consult-mu-embark--add-keys-for-marks' above for more details
2136(consult-mu-embark--add-keys-for-marks mu4e-marks)
2137
2138;; change the default action on `consult-mu-messages' category.
2139(add-to-list 'embark-default-action-overrides '(consult-mu-messages . consult-mu-embark-default-action))
2140
2141
2142;;; Provide `consult-mu-embark' module
2143
2144(provide 'consult-mu-embark)
2145
2146;;; consult-mu-embark.el ends here
2147#+end_src
2148
2149
2150* consult-mu-compose.el
2151:PROPERTIES:
2152:header-args:emacs-lisp: :results none :mkdirp yes :comments none :tangle ./extras/consult-mu-compose.el
2153:END:
2154** Header
2155#+begin_src emacs-lisp
2156;;; consult-mu-compose.el --- Consult Mu4e asynchronously -*- lexical-binding: t -*-
2157
2158;; Copyright (C) 2023 Armin Darvish
2159
2160;; Author: Armin Darvish
2161;; Maintainer: Armin Darvish
2162;; Created: 2023
2163;; Version: 1.0
2164;; Package-Requires: ((emacs "28.0") (consult "2.0"))
2165;; Homepage: https://github.com/armindarvish/consult-mu
2166;; Keywords: convenience, matching, tools, email
2167;; Homepage: https://github.com/armindarvish/consult-mu
2168
2169;; SPDX-License-Identifier: GPL-3.0-or-later
2170
2171;; This file is free software: you can redistribute it and/or modify
2172;; it under the terms of the GNU General Public License as published
2173;; by the Free Software Foundation, either version 3 of the License,
2174;; or (at your option) any later version.
2175;;
2176;; This file is distributed in the hope that it will be useful,
2177;; but WITHOUT ANY WARRANTY; without even the implied warranty of
2178;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
2179;; GNU General Public License for more details.
2180;;
2181;; You should have received a copy of the GNU General Public License
2182;; along with this file. If not, see <https://www.gnu.org/licenses/>.
2183
2184
2185;;; Commentary:
2186
2187;; This package provides an alternative interactive serach interface for
2188;; mu and mu4e (see URL `https://djcbsoftware.nl/code/mu/mu4e.html').
2189;; It uses a consult-based minibuffer completion for searching and
2190;; selecting, and marking emails, as well as additional utilities for
2191;; composing emails and more.
2192
2193;; This package requires mu4e version "1.10.8" or later.
2194
2195;;; Code:
2196
2197#+end_src
2198
2199** Requirements
2200#+begin_src emacs-lisp
2201(require 'consult-mu)
2202
2203#+end_src
2204
2205** Define Group, Customs, Vars, etc.
2206*** Custom Variables
2207#+begin_src emacs-lisp
2208;;; Customization Variables
2209(defcustom consult-mu-compose-use-dired-attachment 'in-dired
2210 "Use a Dired buffer for multiple file attachment?
2211
2212If set to \='in-dired uses `dired' buffer and `dired' marks only when inside
2213a `dired' buffer. If \='t, a `dired' buffer will be used for selecting attachment files similar to what Doom Emacs does:
2214URL `https://github.com/doomemacs/doomemacs/blob/bea81278fd2ecb65db6a63dbcd6db2f52921ee41/modules/email/mu4e/autoload/email.el#L272'.
2215
2216If \='nil, consult-mu uses minibuffer completion for selection files to
2217attach, even if inside a `dired' buffer.
2218
2219By default this is set to \='in-dired."
2220 :group 'consult-mu
2221 :type '(choice (const :tag "Only use Dired if inside Dired Buffer" 'in-dired)
2222 (const :tag "Always use Dired" t)
2223 (const :tag "Never use Dired" nil)))
2224
2225(defcustom consult-mu-large-file-warning-threshold large-file-warning-threshold
2226 "Threshold for size of file to require confirmation for preview.
2227
2228This is used when selecting files to attach to emails. Files larger than this value in size will require user confirmation before previewing the file. Default value is set by `large-file-warning-threshold'. If nil, no cofnirmation is required."
2229 :group 'consult-mu
2230 :type '(choice integer (const :tag "Never request confirmation" nil)))
2231
2232
2233(defcustom consult-mu-compose-preview-key consult-mu-preview-key
2234 "Preview key for `consult-mu-compose'.
2235
2236This is similar to `consult-mu-preview-key' but explicitly for
2237consult-mu-compose. It is recommended to set this to something other than
2238\='any to avoid loading preview buffers for each file."
2239 :group 'consult-mu
2240 :type '(choice (const :tag "Any key" any)
2241 (list :tag "Debounced"
2242 (const :debounce)
2243 (float :tag "Seconds" 0.1)
2244 (const any))
2245 (const :tag "No preview" nil)
2246 (key :tag "Key")
2247 (repeat :tag "List of keys" key)))
2248
2249(defcustom consult-mu-embark-attach-file-key nil
2250 "Embark key binding for interactive file attachement."
2251 :group 'consult-mu
2252 :type '(choice (key :tag "Key")
2253 (const :tag "no key binding" nil)))
2254
2255#+end_src
2256*** Others
2257#+begin_src emacs-lisp
2258(defvar consult-mu-compose-attach-history nil
2259 "History variable for file attachment.
2260
2261It is used in `consult-mu-compose--read-file-attach'.")
2262
2263(defvar consult-mu-compose-current-draft-buffer nil
2264 "Store the buffer that is being edited.")
2265
2266#+end_src
2267
2268** Backend Functions
2269
2270*** utilities
2271**** read file name to attach
2272#+begin_src emacs-lisp
2273(defun consult-mu-compose--read-file-attach (&optional initial)
2274 "Read files in the minibuffer to attach to an email.
2275
2276INITIAL is the initial input in the minibuffer."
2277 (consult--read (completion-table-in-turn #'completion--embedded-envvar-table
2278 #'completion--file-name-table)
2279 :prompt "Attach File: "
2280 :require-match t
2281 :category 'file
2282 :initial (or initial default-directory)
2283 :lookup (lambda (sel cands &rest args)
2284 (file-truename sel))
2285 :state (lambda (action cand)
2286 (let ((preview (consult--buffer-preview)))
2287 (pcase action
2288 ('preview
2289 (if cand
2290 (when (not (file-directory-p cand))
2291 (let* ((filename (file-truename cand))
2292 (filesize (float
2293 (file-attribute-size
2294 (file-attributes filename))))
2295 (confirm (if (and filename
2296 (>= filesize consult-mu-large-file-warning-threshold))
2297 (yes-or-no-p (format "File is %s Bytes. Do you really want to preview it?" filesize))
2298 t)))
2299 (if confirm
2300 (funcall preview action
2301 (find-file-noselect (file-truename cand))))))))
2302 ('return
2303 cand))))
2304 :preview-key consult-mu-compose-preview-key
2305 :add-history (list mu4e-attachment-dir)
2306 :history 'consult-mu-compose-attach-history))
2307#+end_src
2308
2309**** read file to remove
2310#+begin_src emacs-lisp
2311(defun consult-mu-compose--read-file-remove (&optional initial)
2312 "Select attached files to remove from email.
2313
2314INITIAL is the initial input in the minibuffer."
2315
2316 (if-let ((current-files (pcase major-mode
2317 ('org-msg-edit-mode
2318 (org-msg-get-prop "attachment"))
2319 ((or 'mu4e-compose-mode 'message-mode)
2320 (goto-char (point-max))
2321 (cl-loop while (re-search-backward "<#part.*filename=\"\\(?1:.*\\)\"[[:ascii:][:nonascii:]]*?/part>" nil t)
2322 collect (match-string-no-properties 1)))
2323 (_
2324 (error "Not in a compose message buffer")
2325 nil))))
2326
2327 (consult--read current-files
2328 :prompt "Remove File:"
2329 :category 'file
2330 :state (lambda (action cand)
2331 (let ((preview (consult--buffer-preview)))
2332 (pcase action
2333 ('preview
2334 (if cand
2335 (when (not (file-directory-p cand))
2336 (let* ((filename (file-truename cand))
2337 (filesize (float
2338 (file-attribute-size
2339 (file-attributes filename))))
2340 (confirm (if (and filename
2341 (>= filesize consult-mu-large-file-warning-threshold))
2342 (yes-or-no-p (format "File is %s Bytes. Do you really want to preview it?" filesize))
2343 t)))
2344 (if confirm
2345 (funcall preview action
2346 (find-file-noselect (file-truename cand))))))))
2347 ('return
2348 cand))))
2349 :preview-key consult-mu-compose-preview-key
2350 :initial initial)
2351 (progn
2352 (message "No files currently attached!")
2353 nil)))
2354
2355#+end_src
2356
2357**** get draft buffer
2358#+begin_src emacs-lisp
2359(defun consult-mu-compose-get-draft-buffer ()
2360 "Query user to select a mu4e compose draft buffer."
2361 (save-excursion
2362 (if (and (consult-mu-compose-get-current-buffers)
2363 (y-or-n-p "Attach the files to an existing compose buffer? "))
2364 (consult--read (consult-mu-compose-get-current-buffers)
2365 :prompt "Select Message Buffer: "
2366 :require-match nil
2367 :category 'consult-mu-messages
2368 :preview-key consult-mu-preview-key
2369 :lookup (lambda (sel cands &rest args)
2370 (or (get-buffer sel) sel))
2371 :state (lambda (action cand)
2372 (let ((preview (consult--buffer-preview)))
2373 (pcase action
2374 ('preview
2375 (if (and cand (buffer-live-p cand))
2376 (funcall preview action
2377 cand)))
2378 ('return
2379 cand))))))))
2380
2381#+end_src
2382**** get current compose buffers
2383#+begin_src emacs-lisp
2384(defun consult-mu-compose-get-current-buffers ()
2385 "Return a list of active compose message buffers."
2386 (let (buffers)
2387 (save-current-buffer
2388 (dolist (buffer (buffer-list t))
2389 (set-buffer buffer)
2390 (when (or (and (derived-mode-p 'message-mode)
2391 (null message-sent-message-via))
2392 (derived-mode-p 'org-msg-edit-mode)
2393 (derived-mode-p 'mu4e-compose-mode))
2394 (push (buffer-name buffer) buffers))))
2395 (nreverse buffers)))
2396#+end_src
2397*** actions
2398**** add attachment
2399***** attach a file
2400#+begin_src emacs-lisp
2401(defun consult-mu-compose--attach-files (files &optional mail-buffer &rest _args)
2402 "Attach FILES to email in MAIL-BUFFER compose buffer."
2403 (let ((files (if (stringp files) (list files) files))
2404 (mail-buffer (or mail-buffer (if (version<= mu4e-mu-version "1.12")
2405 (mu4e-compose 'new) (mu4e-compose-new)))))
2406 (with-current-buffer mail-buffer
2407 (pcase major-mode
2408 ('org-msg-edit-mode
2409 (save-excursion
2410 (let* ((new-files (delete-dups (append (org-msg-get-prop "attachment") files))))
2411 (org-msg-set-prop "attachment" new-files))
2412 (goto-last-change 0)
2413 (org-reveal)
2414 (consult-mu--pulse-line)))
2415 ((or 'mu4e-compose-mode 'message-mode)
2416 (save-excursion
2417 (dolist (file files)
2418 (goto-char (point-max))
2419 (unless (eq (current-column) 0)
2420 (insert "\n\n")
2421 (forward-line 2))
2422 (mail-add-attachment (file-truename file))
2423 (goto-last-change 0)
2424 (forward-line -2)
2425 (consult-mu--pulse-line))))
2426 (_
2427 (error "%s is not a compose buffer" (current-buffer)))))))
2428#+end_src
2429
2430**** remove attachment
2431#+begin_src emacs-lisp
2432(defun consult-mu-compose--remove-files (files &optional mail-buffer &rest _args)
2433 "Remove FILES from current attachments in MAIL-BUFFER."
2434 (let ((files (if (stringp files) (list files) files))
2435 (mail-buffer (or mail-buffer (current-buffer))))
2436 (with-current-buffer mail-buffer
2437 (save-excursion
2438 (pcase major-mode
2439 ('org-msg-edit-mode
2440 (let ((current-files (org-msg-get-prop "attachment"))
2441 (removed-files (list)))
2442 (mapcar (lambda (file)
2443 (when (member file current-files)
2444 (org-msg-set-prop "attachment" (delete-dups (remove file current-files)))
2445 (add-to-list 'removed-files file)
2446 (setq current-files (org-msg-get-prop "attachment"))
2447 (goto-last-change 0)
2448 (org-reveal)
2449 (consult-mu--pulse-line)))
2450 files)
2451 (message "file(s) %s detached" (mapconcat 'identity removed-files ","))))
2452 ('mu4e-compose-mode
2453 (let ((removed-files (list)))
2454 (mapcar (lambda (file)
2455 (goto-char (point-min))
2456 (while (re-search-forward (format "<#part.*filename=\"%s\"[[:ascii:][:nonascii:]]*?/part>" file) nil t)
2457 (replace-match "" nil nil)
2458 (setq removed-files (append removed-files (list file)))
2459 (goto-last-change 0)
2460 (consult-mu--pulse-line)
2461 (whitespace-cleanup)))
2462 files)
2463 (message "file(s) %s detached" (mapconcat 'identity removed-files ", ")))))))))
2464#+end_src
2465
2466** Frontend Interactive Commands
2467#+begin_src emacs-lisp
2468(defun consult-mu-compose-attach (&optional files mail-buffer)
2469 "Attach FILES to email in MAIL-BUFFER interactively.
2470
2471MAIL-BUFFER defaults to `consult-mu-compose-current-draft-buffer'."
2472 (interactive)
2473 (let* ((consult-mu-compose-current-draft-buffer (cond
2474 ((or (derived-mode-p 'mu4e-compose-mode) (derived-mode-p 'org-msg-edit-mode) (derived-mode-p 'message-mode)) (current-buffer))
2475 ((derived-mode-p 'dired-mode)
2476 (and (bound-and-true-p dired-mail-buffer) (buffer-live-p dired-mail-buffer) dired-mail-buffer))
2477 (t
2478 consult-mu-compose-current-draft-buffer)))
2479 (mail-buffer (or mail-buffer
2480 (and (buffer-live-p consult-mu-compose-current-draft-buffer) consult-mu-compose-current-draft-buffer)
2481 nil))
2482 (files (or files
2483 (if (and (derived-mode-p 'dired-mode) consult-mu-compose-use-dired-attachment)
2484 (delq nil
2485 (mapcar
2486 ;; don't attach directories
2487 (lambda (f) (if (file-directory-p f)
2488 nil
2489 f))
2490 (nreverse (dired-map-over-marks (dired-get-filename) nil))))
2491 (consult-mu-compose--read-file-attach files)))))
2492 (pcase major-mode
2493 ((or 'mu4e-compose-mode 'org-msg-edit-mode 'message-mode)
2494 (setq mail-buffer (current-buffer))
2495 (setq consult-mu-compose-current-draft-buffer mail-buffer)
2496 (cond
2497 ((stringp files)
2498 (cond
2499 ((and (not (file-directory-p files)) (file-truename files))
2500 (consult-mu-compose--attach-files (file-truename files) mail-buffer))
2501 ((and (file-directory-p files) (eq consult-mu-compose-use-dired-attachment 'always))
2502 (progn
2503 (split-window-sensibly)
2504 (with-current-buffer (dired files)
2505 (setq-local dired-mail-buffer mail-buffer))))
2506 ((and (file-directory-p files) (not (eq consult-mu-compose-use-dired-attachment 'always)))
2507 (progn
2508 (while (file-directory-p files)
2509 (setq files (consult-mu-compose--read-file-attach files)))
2510 (consult-mu-compose--attach-files (file-truename files) mail-buffer)))))
2511 ((listp files)
2512 (consult-mu-compose--attach-files files mail-buffer))))
2513 ('dired-mode
2514 (setq mail-buffer (or (and (bound-and-true-p dired-mail-buffer) (buffer-live-p dired-mail-buffer) dired-mail-buffer)
2515 (consult-mu-compose-get-draft-buffer)
2516 (if (version<= mu4e-mu-version "1.12")
2517 (mu4e-compose 'new) (mu4e-compose-new))))
2518
2519 (cond
2520 ((and mail-buffer (buffer-live-p mail-buffer)))
2521 ((stringp mail-buffer) (with-current-buffer (if (version<= mu4e-mu-version "1.12")
2522 (mu4e-compose 'new) (mu4e-compose-new))
2523 (save-excursion (message-goto-subject)
2524 (insert mail-buffer)
2525 (rename-buffer mail-buffer t)))
2526 (setq mail-buffer (get-buffer mail-buffer))))
2527
2528 (if (and mail-buffer (buffer-live-p mail-buffer))
2529 (progn
2530 (setq-local dired-mail-buffer mail-buffer)
2531 (switch-to-buffer mail-buffer)
2532 (cond
2533 ((not files)
2534 (message "no files were selected!"))
2535 ((stringp files)
2536 (cond
2537 ((and (file-truename files) (not (file-directory-p files)))
2538 (consult-mu-compose--attach-files (file-truename files) mail-buffer))
2539 ((and (not consult-mu-compose-use-dired-attachment) (file-directory-p files))
2540 (progn
2541 (while (file-directory-p files)
2542 (setq files (consult-mu-compose--read-file-attach files)))
2543 (consult-mu-compose--attach-files (file-truename files) mail-buffer)))))
2544 ((listp files)
2545 (consult-mu-compose--attach-files files mail-buffer))))))
2546 (_
2547 (setq mail-buffer (or
2548 consult-mu-compose-current-draft-buffer
2549 (consult-mu-compose-get-draft-buffer)
2550 (if (version<= mu4e-mu-version "1.12")
2551 (mu4e-compose 'new) (mu4e-compose-new))))
2552 (cond
2553 ((and mail-buffer (buffer-live-p mail-buffer)))
2554 ((stringp mail-buffer) (with-current-buffer (if (version<= mu4e-mu-version "1.12")
2555 (mu4e-compose 'new) (mu4e-compose-new))
2556 (save-excursion (message-goto-subject)
2557 (insert mail-buffer)
2558 (rename-buffer mail-buffer t)))
2559 (setq mail-buffer (get-buffer mail-buffer))))
2560 (if (and mail-buffer (buffer-live-p mail-buffer))
2561 (progn
2562 (switch-to-buffer mail-buffer)
2563 (setq consult-mu-compose-current-draft-buffer mail-buffer)
2564 (cond
2565 ((and (not (file-directory-p files)) (file-truename files))
2566 (consult-mu-compose--attach-files (file-truename files) mail-buffer))
2567 ((and (file-directory-p files) (eq consult-mu-compose-use-dired-attachment 'always))
2568 (progn
2569 (split-window-sensibly)
2570 (with-current-buffer (dired files)
2571 (setq-local dired-mail-buffer mail-buffer)
2572 )))
2573 ((and (file-directory-p files) (not (eq consult-mu-compose-use-dired-attachment 'always)))
2574 (progn
2575 (while (file-directory-p files)
2576 (setq files (consult-mu-compose--read-file-attach files)))
2577 (consult-mu-compose--attach-files (file-truename files) mail-buffer)))
2578 ((listp files)
2579 (consult-mu-compose--attach-files files mail-buffer))))))))
2580 mail-buffer)
2581
2582(defun consult-mu-compose-detach (&optional file)
2583 "Remove FILE from email attachments interactively."
2584 (interactive)
2585 (save-mark-and-excursion
2586 (when-let (file (consult-mu-compose--read-file-remove))
2587 (consult-mu-compose--remove-files file))))
2588#+end_src
2589
2590** Provide
2591#+begin_src emacs-lisp
2592;;; provide `consult-mu-compose' module
2593(provide 'consult-mu-compose)
2594#+end_src
2595** Footer
2596#+begin_src emacs-lisp
2597;;; consult-mu-compose.el ends here
2598#+end_src
2599* consult-mu-compose-embark.el
2600:PROPERTIES:
2601:header-args:emacs-lisp: :results none :mkdirp yes :comments none :tangle ./extras/consult-mu-compose-embark.el
2602:END:
2603*** Header
2604#+begin_src emacs-lisp
2605;;; consult-mu-compose-embark.el --- Emabrk Actions for consult-mu-compose -*- lexical-binding: t -*-
2606
2607;; Copyright (C) 2021-2023
2608
2609;; Author: Armin Darvish
2610;; Maintainer: Armin Darvish
2611;; Created: 2023
2612;; Version: 1.0
2613;; Package-Requires: ((emacs "28.0") (consult "2.0"))
2614;; Homepage: https://github.com/armindarvish/consult-mu
2615;; Keywords: convenience, matching, tools, email
2616;; Homepage: https://github.com/armindarvish/consult-mu
2617
2618;; SPDX-License-Identifier: GPL-3.0-or-later
2619
2620;; This file is free software: you can redistribute it and/or modify
2621;; it under the terms of the GNU General Public License as published
2622;; by the Free Software Foundation, either version 3 of the License,
2623;; or (at your option) any later version.
2624;;
2625;; This file is distributed in the hope that it will be useful,
2626;; but WITHOUT ANY WARRANTY; without even the implied warranty of
2627;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
2628;; GNU General Public License for more details.
2629;;
2630;; You should have received a copy of the GNU General Public License
2631;; along with this file. If not, see <https://www.gnu.org/licenses/>.
2632
2633
2634;;; Commentary:
2635
2636;; This package provides an alternative interactive serach interface for
2637;; mu and mu4e (see URL `https://djcbsoftware.nl/code/mu/mu4e.html').
2638;; It uses a consult-based minibuffer completion for searching and
2639;; selecting, and marking emails, as well as additional utilities for
2640;; composing emails and more.
2641
2642;; This package requires mu4e version "1.10.8" or later.
2643
2644
2645;;; Code:
2646#+end_src
2647*** Main
2648#+begin_src emacs-lisp
2649;;; Requirements
2650(require 'embark)
2651(require 'consult-mu)
2652(require 'consult-mu-embark)
2653
2654(defun consult-mu-compose-embark-attach-file (cand)
2655 "Run `consult-mu-attach-files' on CAND."
2656 (funcall (apply-partially #'consult-mu-compose-attach cand)))
2657
2658;;; add consult-mu-attach to embark-file-map
2659(defun consult-mu-compose-embark-bind-attach-file-key (&optional key)
2660 "Binds `consult-mu-embark-attach-file-key'.
2661
2662Bind `consult-mu-embark-attach-file-key' to
2663`consult-mu-compose-embark-attach-file' in `embark-file-map'. If KEY is
2664non-nil binds KEY instead of `consult-mu-embark-attach-file-key'."
2665 (if-let ((keyb (or key (kbd consult-mu-embark-attach-file-key))))
2666 (define-key embark-file-map keyb #'consult-mu-compose-embark-attach-file)))
2667
2668(consult-mu-compose-embark-bind-attach-file-key)
2669
2670;; change the default action on `consult-mu-contacts category.
2671(add-to-list 'embark-default-action-overrides '((file . consult-mu-compose--read-file-attach) . consult-mu-compose-attach))
2672(add-to-list 'embark-default-action-overrides '((file . consult-mu-compose-attach) . consult-mu-compose-attach))
2673
2674;;; Provide `consult-mu-compose-embark' module
2675
2676(provide 'consult-mu-compose-embark)
2677
2678;;; consult-mu-compose-embark.el ends here
2679#+end_src
2680
2681* consult-mu-contacts.el
2682:PROPERTIES:
2683:header-args:emacs-lisp: :results none :mkdirp yes :comments none :tangle ./extras/consult-mu-contacts.el
2684:END:
2685** Header
2686#+begin_src emacs-lisp
2687;;; consult-mu-contacts.el --- Consult Mu4e asynchronously -*- lexical-binding: t -*-
2688
2689;; Copyright (C) 2023 Armin Darvish
2690
2691;; Author: Armin Darvish
2692;; Maintainer: Armin Darvish
2693;; Created: 2023
2694;; Version: 1.0
2695;; Package-Requires: ((emacs "28.0") (consult "2.0"))
2696;; Homepage: https://github.com/armindarvish/consult-mu
2697;; Keywords: convenience, matching, tools, email
2698;; Homepage: https://github.com/armindarvish/consult-mu
2699
2700;; SPDX-License-Identifier: GPL-3.0-or-later
2701
2702;; This file is free software: you can redistribute it and/or modify
2703;; it under the terms of the GNU General Public License as published
2704;; by the Free Software Foundation, either version 3 of the License,
2705;; or (at your option) any later version.
2706;;
2707;; This file is distributed in the hope that it will be useful,
2708;; but WITHOUT ANY WARRANTY; without even the implied warranty of
2709;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
2710;; GNU General Public License for more details.
2711;;
2712;; You should have received a copy of the GNU General Public License
2713;; along with this file. If not, see <https://www.gnu.org/licenses/>.
2714
2715
2716;;; Commentary:
2717
2718;; This package provides an alternative interactive serach interface for
2719;; mu and mu4e (see URL `https://djcbsoftware.nl/code/mu/mu4e.html').
2720;; It uses a consult-based minibuffer completion for searching and
2721;; selecting, and marking emails, as well as additional utilities for
2722;; composing emails and more.
2723
2724;; This package requires mu4e version "1.10.8" or later.
2725
2726
2727;;; Code:
2728
2729#+end_src
2730
2731** Requirements
2732#+begin_src emacs-lisp
2733(require 'consult-mu)
2734
2735#+end_src
2736** Define Group, Customs, Vars, etc.
2737*** Custom Variables
2738#+begin_src emacs-lisp
2739;;; Customization Variables
2740
2741(defcustom consult-mu-contacts-group-by :name
2742 "What field to use to group the results in the minibuffer?
2743
2744By default it is set to :name, but can be any of:
2745
2746 :name group by contact name
2747 :email group by email of the contact
2748 :domain group by the domain of the contact's email
2749 \(e.g. domain.com in user@domain.com\)
2750 :user group by the ncontact's user name
2751 \(e.g. user in user@domain.com\)"
2752 :group 'consult-mu
2753 :type '(radio (const :name)
2754 (const :email)
2755 (const :domain)
2756 (const :user)))
2757
2758(defcustom consult-mu-contacts-action #'consult-mu-contacts--list-messages-action
2759 "Which function to use when selecting a contact?
2760
2761By default it is bound to
2762`consult-mu-contacts--list-messages-action'."
2763 :group 'consult-mu
2764 :type '(choice (function :tag "(Default) Show Messages from Contact" #'consult-mu-contacts--list-messages-action)
2765 (function :tag "Insert Email" #'consult-mu-contacts--insert-email-action)
2766 (function :tag "Copy Email to Kill Ring" #'consult-mu-contacts--copy-email-action)
2767 (function :tag "Custom Function")))
2768
2769(defcustom consult-mu-contacts-ignore-list (list)
2770 "List of Regexps to ignore when searching contacts.
2771
2772This is useful to filter certain addreses from contacts. For example, you
2773can remove no-reply adresses by setting this variable to
2774\='((“no-reply@example.com”))."
2775 :group 'consult-mu
2776 :type '(repeat :tag "Regexp List" regexp))
2777
2778(defcustom consult-mu-contacts-ignore-case-fold-search case-fold-search
2779 "Whether to ignore case when matching against ignore-list?
2780
2781When non-nil, `consult-mu-contacts' performs case *insensitive* match with
2782`consult-mu-contacts-ignore-list' and removes matches from candidates.
2783
2784By default it is inherited from `case-fold-search'."
2785 :group 'consult-mu
2786 :type 'boolean)
2787
2788#+end_src
2789
2790*** Other Variables
2791#+begin_src emacs-lisp
2792;;; Other Variables
2793
2794(defvar consult-mu-contacts-category 'consult-mu-contacts
2795 "Category symbol for contacts in `consult-mu' package.")
2796
2797(defvar consult-mu-contacts--override-group nil
2798 "Override grouping in `consult-mu-contacs' based on user input.")
2799
2800(defvar consult-mu-contacts--history nil
2801 "History variable for `consult-mu-contacts'.")
2802
2803#+end_src
2804
2805** Backend Commands
2806*** view messages form contact
2807#+begin_src emacs-lisp
2808(defun consult-mu-contacts--list-messages (contact)
2809 "List messages from CONTACT using `consult-mu'."
2810 (let* ((consult-mu-maxnum nil)
2811 (email (plist-get contact :email)))
2812 (consult-mu (format "contact:%s" email))))
2813
2814(defun consult-mu-contacts--list-messages-action (cand)
2815 "Search the messages from contact candidate, CAND.
2816
2817This is a wrapper function around `consult-mu-contacts--list-messages'. It
2818parses CAND to extract relevant CONTACT plist and other information and
2819passes them to `consult-mu-contacts--list-messages'.
2820
2821To use this as the default action for consult-mu-contacts, set
2822`consult-mu-contacts-default-action' to
2823\=#'consult-mu-contacts--list-messages-action."
2824
2825
2826 (let* ((info (cdr cand))
2827 (contact (plist-get info :contact)))
2828 (consult-mu-contacts--list-messages contact)))
2829
2830#+end_src
2831*** insert contact
2832#+begin_src emacs-lisp
2833(defun consult-mu-contacts--insert-email (contact)
2834 "Insert email of CONTACT at point.
2835
2836This is useful for inserting email when composing an email to contact."
2837 (let* ((email (plist-get contact :email)))
2838 (insert (concat email "; "))))
2839
2840(defun consult-mu-contacts--insert-email-action (cand)
2841 "Insert the email from contact candidate, CAND.
2842
2843This is a wrapper function around `consult-mu-contacts--insert-email'. It
2844parses CAND to extract relevant CONTACT plist and other information and
2845passes them to `consult-mu-contacts--insert-email'.
2846
2847To use this as the default action for consult-mu-contacts, set
2848`consult-mu-contacts-default-action' to
2849\=#'consult-mu-contacts--insert-email-action."
2850 (let* ((info (cdr cand))
2851 (contact (plist-get info :contact)))
2852 (consult-mu-contacts--insert-email contact)))
2853
2854#+end_src
2855*** copy contact
2856#+begin_src emacs-lisp
2857(defun consult-mu-contacts--copy-email (contact)
2858 "Copy email of CONTACT to kill ring."
2859 (let* ((email (plist-get contact :email)))
2860 (kill-new email)))
2861
2862(defun consult-mu-contacts--copy-email-action (cand)
2863 "Copy the email from contact candidate, CAND, to kill ring.
2864
2865This is a wrapper function around `consult-mu-contacts--copy-email'. It
2866parses CAND to extract relevant CONTACT plist and other information and
2867passes them to `consult-mu-contacts--copy-email'.
2868
2869To use this as the default action for consult-mu-contacts, set
2870`consult-mu-contacts-default-action' to
2871\=#'consult-mu-contacts--copy-email-action."
2872 (let* ((info (cdr cand))
2873 (contact (plist-get info :contact)))
2874 (consult-mu-contacts--copy-email contact)))
2875
2876#+end_src
2877*** compose email
2878#+begin_src emacs-lisp
2879(defun consult-mu-contacts--compose-to (contact)
2880 "Compose an email to CONTACT using `mu4e-compose-new'."
2881 (let* ((email (plist-get contact :email)))
2882 (mu4e-compose-new email)))
2883
2884(defun consult-mu-contacts--compose-to-action (cand)
2885 "Open a new buffer to compose a message to contact candidate, CAND.
2886
2887This is a wrapper function around `consult-mu-contacts--compose-to'. It
2888parses CAND to extract relevant CONTACT plist and other information and
2889passes them to `consult-mu-contacts--compose-to'.
2890
2891To use this as the default action for consult-mu-contacts, set
2892`consult-mu-contacts-default-action' to \=#'consult-mu-contacts--compose-to-action."
2893
2894 (let* ((info (cdr cand))
2895 (contact (plist-get info :contact)))
2896 (consult-mu-contacts--compose-to contact)))
2897
2898#+end_src
2899** Fontend Interactive Commands
2900**** consult-mu-contacts
2901***** format candidate
2902#+begin_src emacs-lisp
2903(defun consult-mu-contacts--format-candidate (string input highlight)
2904 "Format minibuffer candidates for `consult-mu-contacts'.
2905
2906STRING is the output retrieved from “mu cfind INPUT ...” in the command
2907line.
2908
2909INPUT is the query from the user.
2910
2911If HIGHLIGHT is non-nil, input is highlighted with
2912`consult-mu-highlight-match-face' in the minibuffer."
2913 (let* ((query input)
2914 (email (consult-mu--message-extract-email-from-string string))
2915 (name (string-trim (replace-regexp-in-string email "" string nil t nil nil)))
2916 (contact (list :name name :email email))
2917 (match-str (if (stringp input) (consult--split-escaped (car (consult--command-split query))) nil))
2918 (str (format "%s\s\s%s"
2919 (propertize (consult-mu--set-string-width email (floor (* (frame-width) 0.55))) 'face 'consult-mu-sender-face)
2920 (propertize name 'face 'consult-mu-subject-face)))
2921 (str (propertize str :contact contact :query query)))
2922 (if (and consult-mu-highlight-matches highlight)
2923 (cond
2924 ((listp match-str)
2925 (mapc (lambda (match) (setq str (consult-mu--highlight-match match str t))) match-str))
2926 ((stringp match-str)
2927 (setq str (consult-mu--highlight-match match-str str t))))
2928 str)
2929 (cons str (list :contact contact :query query))))
2930
2931#+end_src
2932***** add history
2933#+begin_src emacs-lisp
2934(defun consult-mu-contacts--add-history ()
2935 "Get list of emails in the current buffer.
2936
2937This is used to add the emails in the current buffer to history."
2938 (let ((add (list)))
2939 (pcase major-mode
2940 ((or mu4e-view-mode mu4e-compose-mode org-msg-edit-mode message-mode)
2941 (mapcar (lambda (item)
2942 (concat "#" (consult-mu--message-extract-email-from-string item)))
2943 (append add
2944 (consult-mu--message-emails-string-to-list (consult-mu--message-get-header-field "from"))
2945 (consult-mu--message-emails-string-to-list (consult-mu--message-get-header-field "to"))
2946 (consult-mu--message-emails-string-to-list (consult-mu--message-get-header-field "cc"))
2947 (consult-mu--message-emails-string-to-list (consult-mu--message-get-header-field "bcc"))
2948 (consult-mu--message-emails-string-to-list (consult-mu--message-get-header-field "reply-to")))))
2949 (_ (list)))))
2950
2951#+end_src
2952***** group
2953#+begin_src emacs-lisp
2954(defun consult-mu-contacts--group-name (cand)
2955 "Get the group name of CAND using `consult-mu-contacts-group-by'.
2956
2957See `consult-mu-contacts-group-by' for details of grouping options."
2958(let* ((contact (get-text-property 0 :contact cand))
2959 (email (plist-get contact :email))
2960 (name (plist-get contact :name))
2961 (_ (string-match "\\(?1:[a-zA-Z0-9\_\.\+\-]+\\)@\\(?2:[a-zA-Z0-9\-]+\.[a-zA-Z0-9\-\.]+\\)" email))
2962 (user (match-string 1 email))
2963 (domain (match-string 2 email))
2964 (group (or consult-mu-contacts--override-group consult-mu-contacts-group-by))
2965 (field (if (not (keywordp group)) (intern (concat ":" (format "%s" group))) group)))
2966 (pcase field
2967 (:email email)
2968 (:name (if (string-empty-p name) "n/a" name))
2969 (:domain domain)
2970 (:user user)
2971 (_ nil))))
2972
2973(defun consult-mu-contacts--group (cand transform)
2974"Group function for `consult-mu-contacts' candidates.
2975
2976CAND `consult-mu-contacts--group-name' to get the group name for contact.
2977When TRANSFORM is non-nil, the name of the candiate is used as group title."
2978 (when-let ((name (consult-mu-contacts--group-name cand)))
2979 (if transform (substring cand) name)))
2980
2981#+end_src
2982
2983***** lookup
2984#+begin_src emacs-lisp
2985(defun consult-mu-contacs--lookup ()
2986 "Lookup function for `consult-mu-contacs' minibuffer candidates.
2987
2988This is passed as LOOKUP to `consult--read' on candidates and is used to
2989format the output when a candidate is selected."
2990 (lambda (sel cands &rest args)
2991 (let* ((info (cdr (assoc sel cands)))
2992 (contact (plist-get info :contact))
2993 (name (plist-get contact :name))
2994 (email (plist-get contact :email)))
2995 (cons (or name email) info))))
2996
2997#+end_src
2998
2999***** predicate
3000#+begin_src emacs-lisp
3001(defun consult-mu-contatcs--predicate (cand)
3002 "Predicate function for `consult-mu-contacs' candidate, CAND.
3003
3004This is passed as Predicate to `consult--read' on candidates and is used to
3005remove contacts matching `consult-mu-contacts-ignore-list' from the list of
3006candidtaes.
3007
3008Note that `consult-mu-contacts-ignore-case-fold-search' is used to define
3009case (in)sensitivity as well."
3010
3011 (let* ((contact (plist-get (cdr cand) :contact))
3012 (email (plist-get contact :email))
3013 (name (plist-get contact :name))
3014 (case-fold-search consult-mu-contacts-ignore-case-fold-search))
3015 (if (seq-empty-p (seq-filter (lambda (reg) (or (string-match-p reg email)
3016 (string-match-p reg name)))
3017 consult-mu-contacts-ignore-list))
3018 t
3019 nil)))
3020#+end_src
3021***** state/preview
3022#+begin_src emacs-lisp
3023(defun consult-mu-contacts--state ()
3024 "State function for `consult-mu-contacts' candidates.
3025
3026This is passed as STATE to `consult--read' and is used to preview or do
3027other actions on the candidate."
3028 (lambda (action cand)
3029 (let ((preview (consult--buffer-preview)))
3030 (pcase action
3031 ('preview)
3032 ('return
3033 (save-mark-and-excursion
3034 (consult-mu--execute-all-marks))
3035 (setq consult-mu-contacts--override-group nil)
3036 cand)))))
3037
3038#+end_src
3039
3040
3041***** transform
3042#+begin_src emacs-lisp :lexical t
3043(defun consult-mu-contacts--transform (input)
3044 "Add annotation to minibuffer candiates for `consult-mu-contacts'.
3045
3046Format each candidates with `consult-gh--repo-format' and INPUT."
3047 (lambda (cands)
3048 (cl-loop for cand in cands
3049 collect
3050 (consult-mu-contacts--format-candidate cand input t))))
3051
3052#+end_src
3053
3054***** builder
3055#+begin_src emacs-lisp
3056(defun consult-mu-contacts--builder (input)
3057 "Build mu command line for searching contacts by INPUT."
3058 (pcase-let* ((consult-mu-args (append consult-mu-args '("cfind")))
3059 (cmd (consult--build-args consult-mu-args))
3060 (`(,arg . ,opts) (consult--command-split input))
3061 (flags (append cmd opts)))
3062 (unless (or (member "-n" flags) (member "--maxnum" flags))
3063 (if (and consult-mu-maxnum (> consult-mu-maxnum 0))
3064 (setq opts (append opts (list "--maxnum" (format "%s" consult-mu-maxnum))))))
3065 (if (or (member "-g" opts) (member "--group" opts))
3066 (cond
3067 ((member "-g" opts)
3068 (setq consult-mu-contacts--override-group (ignore-errors (intern (nth (+ (cl-position "-g" opts :test 'equal) 1) opts))))
3069 (setq opts (remove "-g" (remove (ignore-errors (nth (+ (cl-position "-g" opts :test 'equal) 1) opts)) opts))))
3070 ((member "--group" opts)
3071 (setq consult-mu-contacts--override-group (ignore-errors (intern (nth (+ (cl-position "--group" opts :test 'equal) 1) opts))))
3072 (setq opts (remove "--group" (remove (ignore-errors (nth (+ (cl-position "--group" opts :test 'equal) 1) opts)) opts)))))
3073 (setq consult-mu-contacts--override-group nil))
3074 (pcase-let* ((`(,re . ,hl) (funcall consult--regexp-compiler arg 'pcre t)))
3075 (when re
3076 (cons (append cmd
3077 (list (string-join re " "))
3078 opts)
3079 hl)))))
3080
3081#+end_src
3082
3083
3084***** internal async command
3085#+begin_src emacs-lisp :lexical t
3086(defun consult-mu-contacts--async (prompt builder &optional initial)
3087 "Query mu4e contacts asynchronously.
3088
3089This is a non-interactive internal function. For the interactive version
3090see `consult-mu-contacts'.
3091
3092It runs the command line from `consult-mu-contacts--builder' in an async
3093process and returns the results \(list of contacts\) as a completion table
3094in minibuffer that will be passed to `consult--read'. The completion table
3095gets dynamically updated as the user types in the minibuffer. Each
3096candidate in the minibuffer is formatted by
3097`consult-mu-contacts--transform' to add annotation and other info to the
3098candidate.
3099
3100Description of Arguments:
3101 PROMPT the prompt in the minibuffer.
3102 \(passed as PROMPT to `consult--red'\)
3103 BUILDER an async builder function passed to `consult--async-command'.
3104 INITIAL an optional arg for the initial input in the minibuffer.
3105 \(passed as INITITAL to `consult--read'\)
3106
3107commandline arguments/options \(run “mu cfind --help” in the command line
3108for details\) can be passed to the minibuffer input similar to
3109`consult-grep'. For example the user can enter:
3110
3111“#john -- --maxnum 10”
3112
3113This will search for contacts with the query “john”, and retrives a maximum
3114of 10 contacts.
3115
3116Also, the results can further be narrowed by
3117`consult-async-split-style' \(e.g. by entering “#” when
3118`consult-async-split-style' is set to \='perl\).
3119
3120For example:
3121
3122“#john -- --maxnum 10#@gmail”
3123
3124Will retrieve the message as the example above, then narrows down the
3125completion table to candidates that match “@gmail”."
3126 (consult--read
3127 (consult--process-collection builder
3128 :transform (consult--async-transform-by-input #'consult-mu-contacts--transform))
3129 :prompt prompt
3130 :lookup (consult-mu-contacs--lookup)
3131 :state (funcall #'consult-mu-contacts--state)
3132 :initial initial
3133 :group #'consult-mu-contacts--group
3134 :add-history (consult-mu-contacts--add-history)
3135 :history '(:input consult-mu-contacts--history)
3136 :category 'consult-mu-contacts
3137 :preview-key consult-mu-preview-key
3138 :predicate #'consult-mu-contatcs--predicate
3139 :sort t))
3140
3141#+end_src
3142
3143
3144***** interactive command
3145#+begin_src emacs-lisp
3146(defun consult-mu-contacts (&optional initial noaction)
3147 "List results of “mu cfind” asynchronously.
3148
3149This is an interactive wrapper function around
3150`consult-mu-contacts--async'. It queries the user for a search term in the
3151minibuffer, then fetches a list of contacts for the entered search term as
3152a minibuffer completion table for selection. The list of candidates in the
3153completion table are dynamically updated as the user changes the entry.
3154
3155INITIAL is an optional arg for the initial input in the minibuffer \(passed
3156as INITITAL to `consult-mu-contacts--async'\).
3157
3158Upon selection of a candidate either
3159 - the candidate is returned if NOACTION is non-nil
3160 or
3161 - the candidate is passed to `consult-mu-contacts-action' if NOACTION is
3162 nil.
3163
3164Additional commandline arguments can be passed in the minibuffer entry by
3165typing “--” followed by command line arguments.
3166
3167For example the user can enter:
3168
3169“#john doe -- -n 10”
3170
3171This will run a contact search with the query “john doe” and changes the
3172search limit to 10.
3173
3174Also, the results can further be narrowed by `consult-async-split-style'
3175\(e.g. by entering “#” when `consult-async-split-style' is set to \='perl\).
3176
3177
3178For example:
3179
3180“#john doe -- -n 10#@gmail”
3181
3182will retrieve the message as the example above, then narrows down to the
3183candidates that match “@gmail”.
3184
3185For more details on consult--async functionalities, see `consult-grep' and
3186the official manual of consult, here: https://github.com/minad/consult."
3187 (interactive)
3188 (save-mark-and-excursion
3189 (consult-mu--execute-all-marks))
3190 (let* ((sel
3191 (consult-mu-contacts--async (concat "[" (propertize "consult-mu-contacts" 'face 'consult-mu-sender-face) "]" " Search Contacts: ") #'consult-mu-contacts--builder initial)))
3192 (save-mark-and-excursion
3193 (consult-mu--execute-all-marks))
3194 (if noaction
3195 sel
3196 (progn
3197 (funcall consult-mu-contacts-action sel)
3198 sel))))
3199
3200#+end_src
3201
3202** Provide
3203#+begin_src emacs-lisp
3204;;; provide `consult-mu-contacts' module
3205(provide 'consult-mu-contacts)
3206
3207#+end_src
3208** Footer
3209#+begin_src emacs-lisp
3210;;; consult-mu-contacts.el ends here
3211#+end_src
3212* consult-mu-contacts-embark.el
3213:PROPERTIES:
3214:header-args:emacs-lisp: :results none :mkdirp yes :comments none :tangle ./extras/consult-mu-contacts-embark.el
3215:END:
3216*** Header
3217#+begin_src emacs-lisp
3218;;; consult-mu-contacts-embark.el --- Emabrk Actions for consult-mu-contacts -*- lexical-binding: t -*-
3219
3220;; Copyright (C) 2021-2023
3221
3222;; Author: Armin Darvish
3223;; Maintainer: Armin Darvish
3224;; Created: 2023
3225;; Version: 1.0
3226;; Package-Requires: ((emacs "28.0") (consult "2.0"))
3227;; Homepage: https://github.com/armindarvish/consult-mu
3228;; Keywords: convenience, matching, tools, email
3229;; Homepage: https://github.com/armindarvish/consult-mu
3230
3231;; SPDX-License-Identifier: GPL-3.0-or-later
3232
3233;; This file is free software: you can redistribute it and/or modify
3234;; it under the terms of the GNU General Public License as published
3235;; by the Free Software Foundation, either version 3 of the License,
3236;; or (at your option) any later version.
3237;;
3238;; This file is distributed in the hope that it will be useful,
3239;; but WITHOUT ANY WARRANTY; without even the implied warranty of
3240;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
3241;; GNU General Public License for more details.
3242;;
3243;; You should have received a copy of the GNU General Public License
3244;; along with this file. If not, see <https://www.gnu.org/licenses/>.
3245
3246
3247;;; Commentary:
3248
3249;; This package provides an alternative interactive serach interface for
3250;; mu and mu4e (see URL `https://djcbsoftware.nl/code/mu/mu4e.html').
3251;; It uses a consult-based minibuffer completion for searching and
3252;; selecting, and marking emails, as well as additional utilities for
3253;; composing emails and more.
3254
3255;; This package requires mu4e version "1.10.8" or later.
3256
3257
3258;;; Code:
3259
3260#+end_src
3261
3262*** Main
3263This section includes additional useful embark actions as well as possible keymaps. This will be provided as examples and starting point to users, so that they can make their own custom embark actions and functions.
3264
3265#+begin_src emacs-lisp
3266;;; Requirements
3267
3268(require 'embark)
3269(require 'consult-mu)
3270(require 'consult-mu-embark)
3271
3272(defun consult-mu-contacts-embark-insert-email (cand)
3273 "Embark function for inserting CAND's email."
3274 (let* ((contact (get-text-property 0 :contact cand))
3275 (email (plist-get contact :email)))
3276 (insert (concat email "; "))))
3277
3278(defun consult-mu-contacts-embark-kill-email (cand)
3279 "Embark function for copying CAND's email."
3280 (let* ((contact (get-text-property 0 :contact cand))
3281 (email (plist-get contact :email)))
3282 (kill-new email)))
3283
3284(defun consult-mu-contacts-embark-get-alternative (cand)
3285 "Embark function for copying CAND's email."
3286 (let* ((contact (get-text-property 0 :contact cand))
3287 (name (string-trim (plist-get contact :name)))
3288 (email (plist-get contact :email))
3289 (user (string-trim (replace-regexp-in-string "@.*" "" email))))
3290 (consult-mu-contacts (cond
3291 ((not (string-empty-p name))
3292 name)
3293 ((not (string-empty-p user))
3294 user)
3295 ((t ""))))))
3296
3297(defun consult-mu-contacts-embark-compose (cand)
3298 "Embark function for composing an email to CAND."
3299 (let* ((contact (get-text-property 0 :contact cand)))
3300 (consult-mu-contacts--compose-to contact)))
3301
3302(defun consult-mu-contacts-embark-search-messages (cand)
3303 "Embark function for searching messages from CAND using `consult-mu'."
3304 (let* ((contact (get-text-property 0 :contact cand))
3305 (email (plist-get contact :email)))
3306 (consult-mu (concat "from:" email))))
3307
3308(defun consult-mu-contacts-embark-default-action (cand)
3309 "Run `consult-mu-contacts-action' on CAND."
3310 (let* ((contact (get-text-property 0 :contact cand))
3311 (query (get-text-property 0 :query cand))
3312 (newcand (cons cand `(:contact ,contact :query ,query))))
3313 (funcall #'consult-mu-contacts--insert-email-action newcand)))
3314
3315;;; Define Embark Keymaps
3316(defvar-keymap consult-mu-embark-contacts-actions-map
3317 :doc "Keymap for consult-mu-embark-contacts"
3318 :parent consult-mu-embark-general-actions-map
3319 "c" #'consult-mu-contacts-embark-compose
3320 "s" #'consult-mu-contacts-embark-search-messages
3321 "i" #'consult-mu-contacts-embark-insert-email
3322 "w" #'consult-mu-contacts-embark-kill-email
3323 "a" #'consult-mu-contacts-embark-get-alternative)
3324
3325
3326(add-to-list 'embark-keymap-alist '(consult-mu-contacts . consult-mu-embark-contacts-actions-map))
3327
3328;; change the default action on `consult-mu-contacts category.
3329(add-to-list 'embark-default-action-overrides '(consult-mu-contacts . consult-mu-contacts-embark-default-action))
3330
3331;;; Provide `consult-mu-contacts-embark' module
3332
3333(provide 'consult-mu-contacts-embark)
3334
3335;;; consult-mu-contacts-embark.el ends here
3336#+end_src