nftable-migration
1;;; consult-mu-contacts.el --- Consult Mu4e asynchronously -*- lexical-binding: t -*-
2
3;; Copyright (C) 2023 Armin Darvish
4
5;; Author: Armin Darvish
6;; Maintainer: Armin Darvish
7;; Created: 2023
8;; Version: 1.0
9;; Package-Requires: ((emacs "28.0") (consult "2.0"))
10;; Homepage: https://github.com/armindarvish/consult-mu
11;; Keywords: convenience, matching, tools, email
12;; Homepage: https://github.com/armindarvish/consult-mu
13
14;; SPDX-License-Identifier: GPL-3.0-or-later
15
16;; This file is free software: you can redistribute it and/or modify
17;; it under the terms of the GNU General Public License as published
18;; by the Free Software Foundation, either version 3 of the License,
19;; or (at your option) any later version.
20;;
21;; This file is distributed in the hope that it will be useful,
22;; but WITHOUT ANY WARRANTY; without even the implied warranty of
23;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
24;; GNU General Public License for more details.
25;;
26;; You should have received a copy of the GNU General Public License
27;; along with this file. If not, see <https://www.gnu.org/licenses/>.
28
29
30;;; Commentary:
31
32;; This package provides an alternative interactive serach interface for
33;; mu and mu4e (see URL `https://djcbsoftware.nl/code/mu/mu4e.html').
34;; It uses a consult-based minibuffer completion for searching and
35;; selecting, and marking emails, as well as additional utilities for
36;; composing emails and more.
37
38;; This package requires mu4e version "1.10.8" or later.
39
40
41;;; Code:
42
43(require 'consult-mu)
44
45;;; Customization Variables
46
47(defcustom consult-mu-contacts-group-by :name
48 "What field to use to group the results in the minibuffer?
49
50By default it is set to :name, but can be any of:
51
52 :name group by contact name
53 :email group by email of the contact
54 :domain group by the domain of the contact's email
55 \(e.g. domain.com in user@domain.com\)
56 :user group by the ncontact's user name
57 \(e.g. user in user@domain.com\)"
58 :group 'consult-mu
59 :type '(radio (const :name)
60 (const :email)
61 (const :domain)
62 (const :user)))
63
64(defcustom consult-mu-contacts-action #'consult-mu-contacts--list-messages-action
65 "Which function to use when selecting a contact?
66
67By default it is bound to
68`consult-mu-contacts--list-messages-action'."
69 :group 'consult-mu
70 :type '(choice (function :tag "(Default) Show Messages from Contact" #'consult-mu-contacts--list-messages-action)
71 (function :tag "Insert Email" #'consult-mu-contacts--insert-email-action)
72 (function :tag "Copy Email to Kill Ring" #'consult-mu-contacts--copy-email-action)
73 (function :tag "Custom Function")))
74
75(defcustom consult-mu-contacts-ignore-list (list)
76 "List of Regexps to ignore when searching contacts.
77
78This is useful to filter certain addreses from contacts. For example, you
79can remove no-reply adresses by setting this variable to
80\='((“no-reply@example.com”))."
81 :group 'consult-mu
82 :type '(repeat :tag "Regexp List" regexp))
83
84(defcustom consult-mu-contacts-ignore-case-fold-search case-fold-search
85 "Whether to ignore case when matching against ignore-list?
86
87When non-nil, `consult-mu-contacts' performs case *insensitive* match with
88`consult-mu-contacts-ignore-list' and removes matches from candidates.
89
90By default it is inherited from `case-fold-search'."
91 :group 'consult-mu
92 :type 'boolean)
93
94;;; Other Variables
95
96(defvar consult-mu-contacts-category 'consult-mu-contacts
97 "Category symbol for contacts in `consult-mu' package.")
98
99(defvar consult-mu-contacts--override-group nil
100 "Override grouping in `consult-mu-contacs' based on user input.")
101
102(defvar consult-mu-contacts--history nil
103 "History variable for `consult-mu-contacts'.")
104
105(defun consult-mu-contacts--list-messages (contact)
106 "List messages from CONTACT using `consult-mu'."
107 (let* ((consult-mu-maxnum nil)
108 (email (plist-get contact :email)))
109 (consult-mu (format "contact:%s" email))))
110
111(defun consult-mu-contacts--list-messages-action (cand)
112 "Search the messages from contact candidate, CAND.
113
114This is a wrapper function around `consult-mu-contacts--list-messages'. It
115parses CAND to extract relevant CONTACT plist and other information and
116passes them to `consult-mu-contacts--list-messages'.
117
118To use this as the default action for consult-mu-contacts, set
119`consult-mu-contacts-default-action' to
120\=#'consult-mu-contacts--list-messages-action."
121
122
123 (let* ((info (cdr cand))
124 (contact (plist-get info :contact)))
125 (consult-mu-contacts--list-messages contact)))
126
127(defun consult-mu-contacts--insert-email (contact)
128 "Insert email of CONTACT at point.
129
130This is useful for inserting email when composing an email to contact."
131 (let* ((email (plist-get contact :email)))
132 (insert (concat email "; "))))
133
134(defun consult-mu-contacts--insert-email-action (cand)
135 "Insert the email from contact candidate, CAND.
136
137This is a wrapper function around `consult-mu-contacts--insert-email'. It
138parses CAND to extract relevant CONTACT plist and other information and
139passes them to `consult-mu-contacts--insert-email'.
140
141To use this as the default action for consult-mu-contacts, set
142`consult-mu-contacts-default-action' to
143\=#'consult-mu-contacts--insert-email-action."
144 (let* ((info (cdr cand))
145 (contact (plist-get info :contact)))
146 (consult-mu-contacts--insert-email contact)))
147
148(defun consult-mu-contacts--copy-email (contact)
149 "Copy email of CONTACT to kill ring."
150 (let* ((email (plist-get contact :email)))
151 (kill-new email)))
152
153(defun consult-mu-contacts--copy-email-action (cand)
154 "Copy the email from contact candidate, CAND, to kill ring.
155
156This is a wrapper function around `consult-mu-contacts--copy-email'. It
157parses CAND to extract relevant CONTACT plist and other information and
158passes them to `consult-mu-contacts--copy-email'.
159
160To use this as the default action for consult-mu-contacts, set
161`consult-mu-contacts-default-action' to
162\=#'consult-mu-contacts--copy-email-action."
163 (let* ((info (cdr cand))
164 (contact (plist-get info :contact)))
165 (consult-mu-contacts--copy-email contact)))
166
167(defun consult-mu-contacts--compose-to (contact)
168 "Compose an email to CONTACT using `mu4e-compose-new'."
169 (let* ((email (plist-get contact :email)))
170 (mu4e-compose-new email)))
171
172(defun consult-mu-contacts--compose-to-action (cand)
173 "Open a new buffer to compose a message to contact candidate, CAND.
174
175This is a wrapper function around `consult-mu-contacts--compose-to'. It
176parses CAND to extract relevant CONTACT plist and other information and
177passes them to `consult-mu-contacts--compose-to'.
178
179To use this as the default action for consult-mu-contacts, set
180`consult-mu-contacts-default-action' to \=#'consult-mu-contacts--compose-to-action."
181
182 (let* ((info (cdr cand))
183 (contact (plist-get info :contact)))
184 (consult-mu-contacts--compose-to contact)))
185
186(defun consult-mu-contacts--format-candidate (string input highlight)
187 "Format minibuffer candidates for `consult-mu-contacts'.
188
189STRING is the output retrieved from “mu cfind INPUT ...” in the command
190line.
191
192INPUT is the query from the user.
193
194If HIGHLIGHT is non-nil, input is highlighted with
195`consult-mu-highlight-match-face' in the minibuffer."
196 (let* ((query input)
197 (email (consult-mu--message-extract-email-from-string string))
198 (name (string-trim (replace-regexp-in-string email "" string nil t nil nil)))
199 (contact (list :name name :email email))
200 (match-str (if (stringp input) (consult--split-escaped (car (consult--command-split query))) nil))
201 (str (format "%s\s\s%s"
202 (propertize (consult-mu--set-string-width email (floor (* (frame-width) 0.55))) 'face 'consult-mu-sender-face)
203 (propertize name 'face 'consult-mu-subject-face)))
204 (str (propertize str :contact contact :query query)))
205 (if (and consult-mu-highlight-matches highlight)
206 (cond
207 ((listp match-str)
208 (mapc (lambda (match) (setq str (consult-mu--highlight-match match str t))) match-str))
209 ((stringp match-str)
210 (setq str (consult-mu--highlight-match match-str str t))))
211 str)
212 (cons str (list :contact contact :query query))))
213
214(defun consult-mu-contacts--add-history ()
215 "Get list of emails in the current buffer.
216
217This is used to add the emails in the current buffer to history."
218 (let ((add (list)))
219 (pcase major-mode
220 ((or mu4e-view-mode mu4e-compose-mode org-msg-edit-mode message-mode)
221 (mapcar (lambda (item)
222 (concat "#" (consult-mu--message-extract-email-from-string item)))
223 (append add
224 (consult-mu--message-emails-string-to-list (consult-mu--message-get-header-field "from"))
225 (consult-mu--message-emails-string-to-list (consult-mu--message-get-header-field "to"))
226 (consult-mu--message-emails-string-to-list (consult-mu--message-get-header-field "cc"))
227 (consult-mu--message-emails-string-to-list (consult-mu--message-get-header-field "bcc"))
228 (consult-mu--message-emails-string-to-list (consult-mu--message-get-header-field "reply-to")))))
229 (_ (list)))))
230
231(defun consult-mu-contacts--group-name (cand)
232 "Get the group name of CAND using `consult-mu-contacts-group-by'.
233
234See `consult-mu-contacts-group-by' for details of grouping options."
235(let* ((contact (get-text-property 0 :contact cand))
236 (email (plist-get contact :email))
237 (name (plist-get contact :name))
238 (_ (string-match "\\(?1:[a-zA-Z0-9\_\.\+\-]+\\)@\\(?2:[a-zA-Z0-9\-]+\.[a-zA-Z0-9\-\.]+\\)" email))
239 (user (match-string 1 email))
240 (domain (match-string 2 email))
241 (group (or consult-mu-contacts--override-group consult-mu-contacts-group-by))
242 (field (if (not (keywordp group)) (intern (concat ":" (format "%s" group))) group)))
243 (pcase field
244 (:email email)
245 (:name (if (string-empty-p name) "n/a" name))
246 (:domain domain)
247 (:user user)
248 (_ nil))))
249
250(defun consult-mu-contacts--group (cand transform)
251"Group function for `consult-mu-contacts' candidates.
252
253CAND `consult-mu-contacts--group-name' to get the group name for contact.
254When TRANSFORM is non-nil, the name of the candiate is used as group title."
255 (when-let ((name (consult-mu-contacts--group-name cand)))
256 (if transform (substring cand) name)))
257
258(defun consult-mu-contacs--lookup ()
259 "Lookup function for `consult-mu-contacs' minibuffer candidates.
260
261This is passed as LOOKUP to `consult--read' on candidates and is used to
262format the output when a candidate is selected."
263 (lambda (sel cands &rest args)
264 (let* ((info (cdr (assoc sel cands)))
265 (contact (plist-get info :contact))
266 (name (plist-get contact :name))
267 (email (plist-get contact :email)))
268 (cons (or name email) info))))
269
270(defun consult-mu-contatcs--predicate (cand)
271 "Predicate function for `consult-mu-contacs' candidate, CAND.
272
273This is passed as Predicate to `consult--read' on candidates and is used to
274remove contacts matching `consult-mu-contacts-ignore-list' from the list of
275candidtaes.
276
277Note that `consult-mu-contacts-ignore-case-fold-search' is used to define
278case (in)sensitivity as well."
279
280 (let* ((contact (plist-get (cdr cand) :contact))
281 (email (plist-get contact :email))
282 (name (plist-get contact :name))
283 (case-fold-search consult-mu-contacts-ignore-case-fold-search))
284 (if (seq-empty-p (seq-filter (lambda (reg) (or (string-match-p reg email)
285 (string-match-p reg name)))
286 consult-mu-contacts-ignore-list))
287 t
288 nil)))
289
290(defun consult-mu-contacts--state ()
291 "State function for `consult-mu-contacts' candidates.
292
293This is passed as STATE to `consult--read' and is used to preview or do
294other actions on the candidate."
295 (lambda (action cand)
296 (let ((preview (consult--buffer-preview)))
297 (pcase action
298 ('preview)
299 ('return
300 (save-mark-and-excursion
301 (consult-mu--execute-all-marks))
302 (setq consult-mu-contacts--override-group nil)
303 cand)))))
304
305(defun consult-mu-contacts--transform (input)
306 "Add annotation to minibuffer candiates for `consult-mu-contacts'.
307
308Format each candidates with `consult-gh--repo-format' and INPUT."
309 (lambda (cands)
310 (cl-loop for cand in cands
311 collect
312 (consult-mu-contacts--format-candidate cand input t))))
313
314(defun consult-mu-contacts--builder (input)
315 "Build mu command line for searching contacts by INPUT."
316 (pcase-let* ((consult-mu-args (append consult-mu-args '("cfind")))
317 (cmd (consult--build-args consult-mu-args))
318 (`(,arg . ,opts) (consult--command-split input))
319 (flags (append cmd opts)))
320 (unless (or (member "-n" flags) (member "--maxnum" flags))
321 (if (and consult-mu-maxnum (> consult-mu-maxnum 0))
322 (setq opts (append opts (list "--maxnum" (format "%s" consult-mu-maxnum))))))
323 (if (or (member "-g" opts) (member "--group" opts))
324 (cond
325 ((member "-g" opts)
326 (setq consult-mu-contacts--override-group (ignore-errors (intern (nth (+ (cl-position "-g" opts :test 'equal) 1) opts))))
327 (setq opts (remove "-g" (remove (ignore-errors (nth (+ (cl-position "-g" opts :test 'equal) 1) opts)) opts))))
328 ((member "--group" opts)
329 (setq consult-mu-contacts--override-group (ignore-errors (intern (nth (+ (cl-position "--group" opts :test 'equal) 1) opts))))
330 (setq opts (remove "--group" (remove (ignore-errors (nth (+ (cl-position "--group" opts :test 'equal) 1) opts)) opts)))))
331 (setq consult-mu-contacts--override-group nil))
332 (pcase-let* ((`(,re . ,hl) (funcall consult--regexp-compiler arg 'pcre t)))
333 (when re
334 (cons (append cmd
335 (list (string-join re " "))
336 opts)
337 hl)))))
338
339(defun consult-mu-contacts--async (prompt builder &optional initial)
340 "Query mu4e contacts asynchronously.
341
342This is a non-interactive internal function. For the interactive version
343see `consult-mu-contacts'.
344
345It runs the command line from `consult-mu-contacts--builder' in an async
346process and returns the results \(list of contacts\) as a completion table
347in minibuffer that will be passed to `consult--read'. The completion table
348gets dynamically updated as the user types in the minibuffer. Each
349candidate in the minibuffer is formatted by
350`consult-mu-contacts--transform' to add annotation and other info to the
351candidate.
352
353Description of Arguments:
354 PROMPT the prompt in the minibuffer.
355 \(passed as PROMPT to `consult--red'\)
356 BUILDER an async builder function passed to `consult--async-command'.
357 INITIAL an optional arg for the initial input in the minibuffer.
358 \(passed as INITITAL to `consult--read'\)
359
360commandline arguments/options \(run “mu cfind --help” in the command line
361for details\) can be passed to the minibuffer input similar to
362`consult-grep'. For example the user can enter:
363
364“#john -- --maxnum 10”
365
366This will search for contacts with the query “john”, and retrives a maximum
367of 10 contacts.
368
369Also, the results can further be narrowed by
370`consult-async-split-style' \(e.g. by entering “#” when
371`consult-async-split-style' is set to \='perl\).
372
373For example:
374
375“#john -- --maxnum 10#@gmail”
376
377Will retrieve the message as the example above, then narrows down the
378completion table to candidates that match “@gmail”."
379 (consult--read
380 (consult--process-collection builder
381 :transform (consult--async-transform-by-input #'consult-mu-contacts--transform))
382 :prompt prompt
383 :lookup (consult-mu-contacs--lookup)
384 :state (funcall #'consult-mu-contacts--state)
385 :initial initial
386 :group #'consult-mu-contacts--group
387 :add-history (consult-mu-contacts--add-history)
388 :history '(:input consult-mu-contacts--history)
389 :category 'consult-mu-contacts
390 :preview-key consult-mu-preview-key
391 :predicate #'consult-mu-contatcs--predicate
392 :sort t))
393
394(defun consult-mu-contacts (&optional initial noaction)
395 "List results of “mu cfind” asynchronously.
396
397This is an interactive wrapper function around
398`consult-mu-contacts--async'. It queries the user for a search term in the
399minibuffer, then fetches a list of contacts for the entered search term as
400a minibuffer completion table for selection. The list of candidates in the
401completion table are dynamically updated as the user changes the entry.
402
403INITIAL is an optional arg for the initial input in the minibuffer \(passed
404as INITITAL to `consult-mu-contacts--async'\).
405
406Upon selection of a candidate either
407 - the candidate is returned if NOACTION is non-nil
408 or
409 - the candidate is passed to `consult-mu-contacts-action' if NOACTION is
410 nil.
411
412Additional commandline arguments can be passed in the minibuffer entry by
413typing “--” followed by command line arguments.
414
415For example the user can enter:
416
417“#john doe -- -n 10”
418
419This will run a contact search with the query “john doe” and changes the
420search limit to 10.
421
422Also, the results can further be narrowed by `consult-async-split-style'
423\(e.g. by entering “#” when `consult-async-split-style' is set to \='perl\).
424
425
426For example:
427
428“#john doe -- -n 10#@gmail”
429
430will retrieve the message as the example above, then narrows down to the
431candidates that match “@gmail”.
432
433For more details on consult--async functionalities, see `consult-grep' and
434the official manual of consult, here: https://github.com/minad/consult."
435 (interactive)
436 (save-mark-and-excursion
437 (consult-mu--execute-all-marks))
438 (let* ((sel
439 (consult-mu-contacts--async (concat "[" (propertize "consult-mu-contacts" 'face 'consult-mu-sender-face) "]" " Search Contacts: ") #'consult-mu-contacts--builder initial)))
440 (save-mark-and-excursion
441 (consult-mu--execute-all-marks))
442 (if noaction
443 sel
444 (progn
445 (funcall consult-mu-contacts-action sel)
446 sel))))
447
448;;; provide `consult-mu-contacts' module
449(provide 'consult-mu-contacts)
450
451;;; consult-mu-contacts.el ends here