;;; consult-mu.el --- Consult Mu4e asynchronously in GNU Emacs -*- lexical-binding: t -*-
;; Copyright (C) 2023 Armin Darvish
;; Author: Armin Darvish
;; Maintainer: Armin Darvish
;; Created: 2023
;; Version: 1.0
;; Package-Requires: ((emacs "28.0") (consult "0.34"))
;; Keywords: convenience, matching, tools, email
;; Homepage: https://github.com/armindarvish/consult-mu
;; SPDX-License-Identifier: GPL-3.0-or-later
;; This file is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published
;; by the Free Software Foundation, either version 3 of the License,
;; or (at your option) any later version.
;;
;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this file. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; This package provides an alternative interactive serach interface for
;; mu and mu4e (see URL `https://djcbsoftware.nl/code/mu/mu4e.html').
;; It uses a consult-based minibuffer completion for searching and
;; selecting, and marking emails, as well as additional utilities for
;; composing emails and more.
;; This package requires mu4e version "1.10.8" or later.
;;; Code:
;;; Requirements
(require 'consult)
(require 'mu4e);;; Group
(defgroup consult-mu nil
"Options for `consult-mu'."
:group 'convenience
:group 'minibuffer
:group 'consult
:group 'mu4e
:prefix "consult-mu-");;; Customization Variables
(defcustom consult-mu-args '("mu")
"Command line arguments to call `mu` asynchronously.
The dynamically computed arguments are appended.
Can be either a string, or a list of strings or expressions."
:group 'consult-mu
:type '(choice string (repeat (choice string sexp))))
(defcustom consult-mu-maxnum mu4e-search-results-limit
"Maximum number of results
This is normally passed to \"--maxnum\" in the command line or is defined by `mu4e-search-results-limit'. By default inherits from `mu4e-search-results-limit'. "
:group 'consult-mu
:type '(choice (const :tag "Unlimited" -1)
(integer :tag "Limit"))
)
(defcustom consult-mu-search-sort-field mu4e-search-sort-field
"What field to sort results by?
By defualt inherits from `mu4e-search-sort-field'."
:group 'consult-mu
:type '(radio (const :tag "Date" :date)
(const :tag "Subject" :subject)
(const :tag "File Size" :size)
(const :tag "Priority" :prio)
(const :tag "From (Sender)" :from)
(const :tag "To (Recipients)" :to)
(const :tag "Mailing List" :list)
))
(defcustom consult-mu-headers-fields mu4e-headers-fields
"A list of header fields to show in the headers buffer.
By default inherits from `mu4e-headers-field'.
From mu4e docs:
Each element has the form (HEADER . WIDTH), where HEADER is one of
the available headers (see `mu4e-header-info') and WIDTH is the
respective width in characters.
A width of nil means \"unrestricted\", and this is best reserved
for the rightmost (last) field. Note that emacs may become very
slow with excessively long lines (1000s of characters), so if you
regularly get such messages, you want to avoid fields with nil
altogether."
:group 'consult-mu
:type `(repeat (cons (choice ,@(mapcar (lambda (h)
(list 'const :tag
(plist-get (cdr h) :help)
(car h)))
mu4e-header-info))
(choice (integer :tag "width")
(const :tag "unrestricted width" nil)))))
(defcustom consult-mu-headers-template nil
"A template string to make custom header formats.
If non-nil, consult-mu uses this string to format the headers instead of `consult-mu-headers-field'.
The string should be of the format “%[char][integer]%[char][integer]...”, and allow dynamic insertion of the content. Each “%[char][integer]“ chunk represents a different field and the integer defines the length of the field. for exmaple \"%d15%s50\" means 15 characters for date and 50 charcters for subject.
The list of available fields are:
%f sender(s) (e.g. from: field of email)
%t receivers(s) (i.e. to: field of email)
%s subject (i.e. title of email)
%d date (i.e. the date email was sent/received)
%p priority
%z size
%i message-id (as defined by mu)
%g flags (as defined by mu)
%G pretty flags (this uses `mu4e~headers-flags-str' to pretify flags)
%x tags (as defined by mu)
%c cc (i.e. cc: field of the email)
%h bcc (i.e. bcc: field of the email)
%r date chaged (as defined by :changed in mu4e)
For example, the string \"%d13%s50%f17\" would make a header containing 13 characters for Date, 50 characters for Subject, and 20 characters for From field, making a header that looks like this:
Thu 09 Nov 23 Title of the Email Limited to 50 Characters Onl... example@domain...
"
:group 'consult-mu
:type '(choice (const :tag "Fromatted String" :format "%{%%d13%%s50%%f17%}")
(function :tag "Custom Function")))
(defcustom consult-mu-search-sort-direction mu4e-search-sort-direction
"Direction to sort by a symbol.
By defualt inherits from 'mu4e-search-sort-direction'. and can either be
`descending' (sorting Z->A)
or
`ascending' (sorting A->Z)."
:group 'consult-mu
:type '(radio (const ascending)
(const descending)))
(defcustom consult-mu-search-threads mu4e-search-threads
"Whether to calculate threads for search results.
By defualt inherits from 'mu4e-search-threads'.
Note that per mu4e docs:
When threading is enabled, the headers are exclusively sorted
chronologically (:date) by the newest message in the thread.
"
:group 'consult-mu
:type 'boolean)
(defcustom consult-mu-group-by nil
"What field to use to group the results in the minibuffer.
By default it is set to :date. But can be any of:
:subject group by subject
:from group by the name/email the sender(s)
:to group by name/email of the reciver(s)
:date group by date
:time group by the time of email (i.e. hour, minute, seconds)
:datetime group by date and time of the email
:year group by the year of the email (i.e. 2023, 2022, ...)
:month group by the month of the email (i.e. Jan, Feb, ..., Dec)
:week group by the week number of the email (.i.e. 1st week, 2nd week, ... 52nd week)
:day-of-week group by the day email was sent (i.e. Mondays, Tuesdays, ...)
:day group by the day email was sent (similar to :day-of-week)
:size group by the file size of the email
:flags group by flags (as defined by mu)
:tags group by tags (as defined by mu)
:changed group by the date changed (as defined by :changed field in mu4e)
"
:group 'consult-mu
:type '(radio (const :date)
(const :subject)
(const :from)
(const :to)
(const :time)
(const :datetime)
(const :year)
(const :month)
(const :week)
(const :day-of-week)
(const :day)
(const :size)
(const :flags)
(const :tags)
(const :changed)
(const nil)))
(defcustom consult-mu-mark-previewed-as-read nil
"Whether to mark PREVIEWED emails as read or not?"
:group 'consult-mu
:type 'boolean)
(defcustom consult-mu-mark-viewed-as-read t
"Whether to mark VIEWED emails as read or not?"
:group 'consult-mu
:type 'boolean)
(defcustom consult-mu-headers-buffer-name "*consult-mu-headers*"
"Default name for HEADERS buffer explicitly for consult-mu.
For more info see `mu4e-headers-buffer-name'."
:group 'consult-mu
:type 'string)
(defcustom consult-mu-view-buffer-name "*consult-mu-view*"
"Default name for VIEW buffer explicitly for consult-mu.
For more info see `mu4e-view-buffer-name'."
:group 'consult-mu
:type 'string)
(defcustom consult-mu-preview-key consult-preview-key
"Preview key for `consult-mu'.
This is similar to `consult-preview-key' but explicitly for consult-mu."
:type '(choice (const :tag "Any key" any)
(list :tag "Debounced"
(const :debounce)
(float :tag "Seconds" 0.1)
(const any))
(const :tag "No preview" nil)
(key :tag "Key")
(repeat :tag "List of keys" key)))
(defcustom consult-mu-highlight-matches t
"Should `consult-mu' highlight search queries in preview buffers?"
:group 'consult-mu
:type 'boolean)
(defcustom consult-mu-use-wide-reply 'ask
"Reply to all or not?
This defines whether `consult-mu--reply-action' should reply to all or not."
:group 'consult-mu
:type '(choice (const :tag "Ask for confirmation" 'ask)
(const :tag "Do not reply to all" nil)
(const :tag "Always reply to all" t)
))
(defcustom consult-mu-action #'consult-mu--view-action
"The function that is used when selecting a message.
By default it is bound to `consult-mu--view-action'."
:group 'consult-mu
:type '(choice (function :tag "(Default) View Message in Mu4e Buffers" #'consult-mu--view-action)
(function :tag "Reply to Message" #'consult-mu--reply-action)
(function :tag "Forward Message" #'consult-mu--forward-action)
(function :tag "Custom Function")))
(defcustom consult-mu-default-command #'consult-mu-dynamic
"Which command should `consult-mu' call."
:group 'consult-mu
:type '(choice (function :tag "(Default) Use Dynamic Collection (i.e. `consult-mu-dynamic')" #'consult-mu-dynamic)
(function :tag "Use Async Collection (i.e. `consult-mu-async')" #'consult-mu-async)
(function :tag "Custom Function")))
;;; Other Variables
(defvar consult-mu-category 'consult-mu
"Category symbol for the `consult-mu' package.")
(defvar consult-mu-messages-category 'consult-mu-messages
"Category symbol for messages in `consult-mu' package.")
(defvar consult-mu--view-buffers-list (list)
"List of currently open preview buffers for `consult-mu'.")
(defvar consult-mu--history nil
"History variable for `consult-mu'.")
(defvar consult-mu-delimiter " "
"Delimiter to use for fields in mu command output.
The idea is Taken from https://github.com/seanfarley/counsel-mu.")
(defvar consult-mu-saved-searches-dynamic (list)
"List of Favorite searches for `consult-mu-dynamic'.")
(defvar consult-mu-saved-searches-async consult-mu-saved-searches-dynamic
"List of Favorite searches for `consult-mu-async'.")
(defvar consult-mu--override-group nil
"Override grouping in `consult-mu' based on user input.")
;;; Faces
(defface consult-mu-highlight-match-face
`((t :inherit 'consult-highlight-match))
"Highlight match face in `consult-mu''s view buffer.
By default inherits from `consult-highlight-match'.
This is used to highlight matches of search queries in the minibufffer completion list."
)
(defface consult-mu-preview-match-face
`((t :inherit 'consult-preview-match))
"Preview match face in `consult-mu''s preview buffers.
By default inherits from `consult-preview-match'.
This is used to highlight matches of search query terms in preview buffers (i.e. `consult-mu-view-buffer-name').")
(defface consult-mu-default-face
`((t :inherit 'default))
"Default face in `consult-mu''s minibuffer annotations.
By default inherits from `default' face.")
(defface consult-mu-subject-face
`((t :inherit 'font-lock-keyword-face))
"Subject face in `consult-mu''s minibuffer annotations.
By default inherits from `font-lock-keyword-face'.")
(defface consult-mu-sender-face
`((t :inherit 'font-lock-variable-name-face))
"Contact face in `consult-mu''s minibuffer annotations.
By default inherits from `font-lock-variable-name-face'.")
(defface consult-mu-receiver-face
`((t :inherit 'font-lock-variable-name-face))
"Contact face in `consult-mu''s minibuffer annotations.
By default inherits from `font-lock-variable-name-face'.")
(defface consult-mu-date-face
`((t :inherit 'font-lock-preprocessor-face))
"Date face in `consult-mu''s minibuffer annotations.
By default inherits from `font-lock-preprocessor-face'.")
(defface consult-mu-count-face
`((t :inherit 'font-lock-string-face))
"Count face in `consult-mu''s minibuffer annotations.
By default inherits from `font-lock-string-face'.")
(defface consult-mu-size-face
`((t :inherit 'font-lock-string-face))
"Size face in `consult-mu''s minibuffer annotations.
By default inherits from `font-lock-string-face'.")
(defface consult-mu-tags-face
`((t :inherit 'font-lock-comment-face))
"Tags/Comments face in `consult-mu''s minibuffer annotations.
By default inherits from `font-lock-comment-face'.")
(defface consult-mu-flags-face
`((t :inherit 'font-lock-function-call-face))
"Flags face in `consult-mu''s minibuffer annotations.
By default inherits from `font-lock-function-call-face'.")
(defface consult-mu-url-face
`((t :inherit 'link))
"URL face in `consult-mu''s minibuffer annotations;
By default inherits from `link'.")
This section includes functions (utilities, mu4e hacks, …).
(defun consult-mu--pulse-regexp (regexp)
"Finds and pulses REGEXP"
(goto-char (point-min))
(while (re-search-forward regexp nil t)
(when-let* ((m (match-data))
(beg (car m))
(end (cadr m))
(ov (make-overlay beg end))
(pulse-delay 0.075)
)
(pulse-momentary-highlight-overlay ov 'highlight))
))(defun consult-mu--pulse-region (beg end)
"Finds and pulses region from BEG to END"
(let ((ov (make-overlay beg end))
(pulse-delay 0.075)
)
(pulse-momentary-highlight-overlay ov 'highlight))
)
(defun consult-mu--pulse-line ()
"Pulses line at point momentarily"
(let* ((pulse-delay 0.055)
(ov (make-overlay (car (bounds-of-thing-at-point 'line)) (cdr (bounds-of-thing-at-point 'line)))))
(pulse-momentary-highlight-overlay ov 'highlight))
)(defun consult-mu--set-string-width (string width &optional prepend)
"Sets the STRING width to a fixed value, WIDTH.
If the STRING is longer than WIDTH, it truncates the string and adds ellipsis, \"...\". If the string is shorter it adds whitespace to the string.
If PREPEND is non-nil, it truncates or adds whitespace from the beginning of string, instead of the end."
(let* ((string (format "%s" string))
(w (string-width string)))
(when (< w width)
(if prepend
(setq string (format "%s%s" (make-string (- width w) ?\s) (substring string)))
(setq string (format "%s%s" (substring string) (make-string (- width w) ?\s)))))
(when (> w width)
(if prepend
(setq string (format "...%s" (substring string (- w (- width 3)) w)))
(setq string (format "%s..." (substring string 0 (- width (+ w 3)))))))
string))
(defun consult-mu--justify-left (string prefix maxwidth)
"Sets the width of STRING+PREFIX justified from left.
It uses `consult-mu--set-string-width' and sets the width of the concatenate of STRING+PREFIX (e.g. `(concat prefix string)`) within MAXWIDTH. This is used for aligning marginalia info in minibuffer when using `consult-mu'."
(let ((s (string-width string))
(w (string-width prefix)))
(if (> maxwidth w)
(consult-mu--set-string-width string (- maxwidth w) t)
string
)
))
(defun consult-mu--highlight-match (regexp str ignore-case)
"Highlights REGEXP in STR.
If a regular expression contains capturing groups, only these are highlighted.
If no capturing groups are used highlight the whole match. Case is ignored
if IGNORE-CASE is non-nil.
(This is adapted from `consult--highlight-regexps'.)"
(let ((i 0))
(while (and (let ((case-fold-search ignore-case))
(string-match regexp str i))
(> (match-end 0) i))
(let ((m (match-data)))
(setq i (cadr m)
m (or (cddr m) m))
(while m
(when (car m)
(add-face-text-property (car m) (cadr m)
'consult-mu-highlight-match-face nil str)
)
(setq m (cddr m))))))
str)(defun consult-mu--overlay-match (match-str buffer ignore-case)
"Highlights MATCH-STR in BUFFER using an overlay.
If IGNORE-CASE is non-nil, it uses case-insensitive match.
This is used to highlight matches to use rqueries when viewing emails in consult-mu. See `consult-mu-overlays-toggle' for toggling highligths on/off."
(with-current-buffer (or (get-buffer buffer) (current-buffer))
(remove-overlays (point-min) (point-max) 'consult-mu-overlay t)
(goto-char (point-min))
(let ((case-fold-search ignore-case)
(consult-mu-overlays (list)))
(while (search-forward match-str nil t)
(when-let* ((m (match-data))
(beg (car m))
(end (cadr m))
(overlay (make-overlay beg end))
)
(overlay-put overlay 'consult-mu-overlay t)
(overlay-put overlay 'face 'consult-mu-highlight-match-face)
)))))
(defun consult-mu-overlays-toggle (&optional buffer)
"Toggles overlay highlights in consult-mu view/preview buffers."
(interactive)
(let ((buffer (or buffer (current-buffer))))
(with-current-buffer buffer
(dolist (o (overlays-in (point-min) (point-max)))
(when (overlay-get o 'consult-mu-overlay)
(if (and (overlay-get o 'face) (eq (overlay-get o 'face) 'consult-mu-highlight-match-face))
(overlay-put o 'face nil)
(overlay-put o 'face 'consult-mu-highlight-match-face))
)
))))(defun consult-mu--format-date (string)
"Format the date STRING from mu output.
STRING is the output form mu command. for example from `mu find query --fields d`
Returns the date in the format Day-of-Week Month Day Year Time (e.g. Sat Nov 04 2023 09:46:54)"
(let ((string (replace-regexp-in-string " " "0" string)))
(format "%s %s %s"
(substring string 0 10)
(substring string -4 nil)
(substring string 11 -4)
)))(defun consult-mu-flags-to-string (FLAG)
"Coverts FLAGS, from mu output to strings.
FLAG is the output form mu command in the terminal. For example `mu find query --fields g`.
This function converts each character in FLAG to an expanded string of the flag and returns the list of these strings."
(cl-loop for c across FLAG
collect
(pcase (string c)
("D" 'draft)
("F" 'flagged)
("N" 'new)
("P" 'forwarded)
("R" 'replied)
("S" 'read)
("T" 'trashed)
("a" 'attachment)
("x" 'encrrypted)
("s" 'signed)
("u" 'unread)
("l" 'list)
("q" 'personal)
("c" 'calendar)
(_ nil))))(defun consult-mu--message-extract-email-from-string (string)
"Finds and returns the first email address in the STRING"
(when (stringp string)
(string-match "[a-zA-Z0-9\_\.\+\-]+@[a-zA-Z0-9\-]+\.[a-zA-Z0-9\-\.]+" string)
(match-string 0 string)
))(defun consult-mu--message-emails-string-to-list (string)
"Converts comma-separated STRING containing email addresses to list of emails"
(when (stringp string)
(remove '(" " "\s" "\t") (mapcar #'consult-mu--message-extract-email-from-string
(split-string string ",\\|;\\|\t" t)))
))(defun consult-mu--message-get-header-field (&optional field)
"Retrive FIELD header from the message/mail in the current buffer"
(save-excursion
(when (or (derived-mode-p 'message-mode)
(derived-mode-p 'mu4e-view-mode)
(derived-mode-p 'org-msg-edit-mode)
(derived-mode-p'mu4e-compose-mode))
(let ((field (or field
(s-lower-camel-case (consult--read '("Subject" "From" "To" "Cc" "Bcc" "Reply-To" "Date" "Attachments" "Tags" "Flags" "Maildir" "Summary")
:prompt "Header Field: ")))))
(if (equal field "attachments") (setq field "\\(attachment\\|attachments\\)"))
(goto-char (point-min))
(let* ((match (re-search-forward (concat "^" field ": ") nil t))
(str (if match (string-trim (buffer-substring-no-properties (point) (point-at-eol))))))
(if (string-empty-p str) nil str))))))(defun consult-mu--headers-append-handler (msglst)
"Overrides `mu4e~headers-append-handler' for `consult-mu'.
This is to ensure that buffer handling is done right for consult-mu.
From mu4e docs:
Append one-line descriptions of messages in MSGLIST.
Do this at the end of the headers-buffer.
"
(with-current-buffer "*consult-mu-headers*"
(let ((inhibit-read-only t))
(seq-do
;; 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.
(if (and (featurep 'mu4e-column-faces) mu4e-column-faces-mode)
(lambda (msg)
(mu4e-column-faces--insert-header msg (point-max)))
(lambda (msg)
(mu4e~headers-insert-header msg (point-max))))
msglst))))(defun consult-mu--view-msg (msg &optional buffername)
"Overrides `mu4e-view' for `consult-mu'.
This is to ensure that buffer handling is done right for consult-mu.
From mu4e docs:
Display the message MSG in a new buffer, and keep in sync with `consult-mu-headers-buffer-name' buffer.
\"In sync\" here means that moving to the next/previous message
in the the message view affects `consult-mu-headers-buffer-name', as does marking etc.
"
(let* ((linked-headers-buffer (mu4e-get-headers-buffer "*consult-mu-headers*" t))
(mu4e-view-buffer-name (or buffername consult-mu-view-buffer-name)))
(setq gnus-article-buffer (mu4e-get-view-buffer linked-headers-buffer t))
(with-current-buffer gnus-article-buffer
(let ((inhibit-read-only t))
(remove-overlays (point-min) (point-max) 'mu4e-overlay t)
(erase-buffer)
(insert-file-contents-literally
(mu4e-message-readable-path msg) nil nil nil t)
(setq-local mu4e--view-message msg)
(mu4e--view-render-buffer msg)
(mu4e-loading-mode 0)
(with-current-buffer linked-headers-buffer
(setq-local mu4e~headers-view-win (mu4e-display-buffer gnus-article-buffer nil)))
(run-hooks 'mu4e-view-rendered-hook)
))))
(defun consult-mu--headers-clear (&optional text)
"Overrides `mu4e~headers-clear' for `consult-mu'.
This is to ensure that buffer handling is done right for consult-mu.
From mu4e docs:
Clear the headers buffer and related data structures.
Optionally, show TEXT. "
(setq mu4e~headers-render-start (float-time)
mu4e~headers-hidden 0)
(with-current-buffer "*consult-mu-headers*"
(let ((inhibit-read-only t))
(mu4e--mark-clear)
(erase-buffer)
(when text
(goto-char (point-min))
(insert (propertize text 'face 'mu4e-system-face 'intangible t))))))(defun consult-mu--set-mu4e-search-sortfield (opts)
"Dynamically sets the `mu4e-search-sort-field' based on user input.
Uses user input (i.e. from `consult-mu' command) to define the sort field.
OPTS is the command line options for mu and can be set by entering options in the minibuffer input. For more details refer to `cpnsult-grep' and consult async documentation.
For example if the user enters the following in the minibuffer:
`#query -- --maxnum 400 --sortfield from --reverse --include-related --skip-dups --threads'
mu4e-search-sort-field is set to :from
Note that per mu4e docs:
When threading is enabled, the headers are exclusively sorted
chronologically (:date) by the newest message in the thread.
"
(let* ((sortfield (cond
((member "-s" opts) (nth (+ (cl-position "-s" opts :test 'equal) 1) opts))
((member "--sortfield" opts) (nth (+ (cl-position "--sortfield" opts :test 'equal) 1) opts))
(t consult-mu-search-sort-field))))
(pcase sortfield
('nil
consult-mu-search-sort-field)
((or "date" "d")
:date)
((or "subject" "s")
:subject)
((or "size" "z")
:size)
((or "prio" "p")
:prio)
((or "from" "f")
:from)
((or "to" "t")
:to)
((or "list" "v")
:list)
;; ((or "tags" "x")
;; :tags)
(_
consult-mu-search-sort-field)
)))
(defun consult-mu--set-mu4e-search-sort-direction (opts)
"Dynamically sets the `mu4e-search-sort-direction' based on user input.
Uses user input (i.e. from `consult-mu' command) to define the sort field.
OPTS is the command line options for mu and can be set by entering options in the minibuffer input. For more details refer to `cpnsult-grep' and consult async documentation.
For example if the user enters the following in the minibuffer:
`#query -- --maxnum 400 --sortfield from --reverse --include-related --skip-dups --threads'
the `mu4e-search-sort-direction' is reversed; if it is set to 'ascending, it is toggled to 'descending and vise versa.
"
(if (or (member "-z" opts) (member "--reverse" opts))
(pcase consult-mu-search-sort-direction
('descending
'ascending)
('ascending
'descending))
consult-mu-search-sort-direction))
(defun consult-mu--set-mu4e-skip-duplicates (opts)
"Dynamically sets the `mu4e-search-skip-duplicates' based on user input.
Uses user input (i.e. from `consult-mu' command) to define the sort field.
OPTS is the command line options for mu and can be set by entering options in the minibuffer input. For more details refer to `cpnsult-grep' and consult async documentation.
For example if the user enters the following in the minibuffer:
`#query -- --maxnum 400 --sortfield from --reverse --include-related --skip-dups --threads'
the `mu4e-search-skip-duplicates' is set to t.
"
(if (or (member "--skip-dups" opts) mu4e-search-skip-duplicates) t nil))
(defun consult-mu--set-mu4e-results-limit (opts)
"Dynamically sets the `mu4e-search-results-limit' based on user input.
Uses user input (i.e. from `consult-mu' command) to define the maximum number of results.
OPTS is the command line options for mu and can be set by entering options in the minibuffer input. For more details refer to `consult-mu' or `consult-mu-async' documentation.
For example if the user enters the following in the minibuffer:
`#query -- --maxnum 400 --sortfield from --reverse --include-related --skip-dups --threads'
the `mu4e-search-results-limit' is set to 400.
"
(cond
((member "-n" opts) (string-to-number (nth (+ (cl-position "-n" opts :test 'equal) 1) opts)))
((member "--maxnum" opts) (string-to-number (nth (+ (cl-position "--maxnum" opts :test 'equal) 1) opts)))
(t consult-mu-maxnum))
)
(defun consult-mu--set-mu4e-include-related (opts)
"Dynamically sets the `mu4e-search-include-related' based on user input.
Uses user input (i.e. from `consult-mu' command) to define the include-related property.
OPTS is the command line options for mu and can be set by entering options in the minibuffer input. For more details refer to `consult-mu' or `consult-mu-async' documentation.
For example if the user enters the following in the minibuffer:
`#query -- --maxnum 400 --sortfield from --reverse --include-related --skip-dups --threads'
the `mu4e-search-include-related' is set to t.
"
(if (or (member "-r" opts) (member "--include-related" opts) mu4e-search-include-related) t nil))
(defun consult-mu--set-mu4e-threads (opts)
"Sets the `mu4e-search-threads' based on `mu4e-search-sort-field'.
Note that per mu4e docs, when threading is enabled, the headers are exclusively sorted by date.
Here the logic is reversed in order to allow dynamically sorting by fields other than date (even when threads are enabled).
In other words if the sort-field is not the :date threading is disabled (because otherwise sort field will be ignored anyway).This allows the user to use command line arguments to sort messages by fields other than the date. For example the user can enter the following in the minibuffer input to sort by subject
`#query -- --sortfield from'
When the sort-field is :date, then `consult-mu-search-threads' is used. If `consult-mu-search-threads' is set to nil, the user can use command line arguments (a.k.a. -t or --thread) to enable it dynamically.
"
(cond
((not (equal mu4e-search-sort-field :date))
nil)
((or (member "-t" opts) (member "--threads" opts) consult-mu-search-threads)
t)))
(defun consult-mu--update-headers (query ignore-history msg type)
"Search for QUERY, and updates `consult-mu-headers-buffer-name' buffer.
If IGNORE-HISTORY is true, does *not* update the query history stack, `mu4e--search-query-past'.
If MSGID is non-nil, put the cursor on message with MSGID.
"
(consult-mu--execute-all-marks)
(cl-letf* (((symbol-function #'mu4e~headers-append-handler) #'consult-mu--headers-append-handler))
(unless (mu4e-running-p) (mu4e--server-start))
(let* ((buf (mu4e-get-headers-buffer consult-mu-headers-buffer-name t))
(view-buffer (get-buffer consult-mu-view-buffer-name))
(expr (car (consult--command-split query)))
(rewritten-expr (funcall mu4e-query-rewrite-function expr))
(maxnum (unless mu4e-search-full mu4e-search-results-limit))
(mu4e-headers-fields consult-mu-headers-fields)
)
(pcase type
(:dynamic )
(:async
(setq rewritten-expr (funcall mu4e-query-rewrite-function (concat "msgid:" (plist-get msg :message-id)))))
(_ ))
(with-current-buffer buf
(save-excursion
(let ((inhibit-read-only t))
(erase-buffer)
(mu4e-headers-mode)
(setq-local mu4e-view-buffer-name consult-mu-view-buffer-name)
(if view-buffer
(setq-local mu4e~headers-view-win (mu4e-display-buffer gnus-article-buffer nil)))
(unless ignore-history
; save the old present query to the history list
(when mu4e--search-last-query
(mu4e--search-push-query mu4e--search-last-query 'past)))
(setq mu4e--search-last-query rewritten-expr)
(setq list-buffers-directory rewritten-expr)
(mu4e--modeline-update)
(run-hook-with-args 'mu4e-search-hook expr)
(consult-mu--headers-clear mu4e~search-message)
(setq mu4e~headers-search-start (float-time))
(pcase-let* ((`(,arg . ,opts) (consult--command-split query))
(mu4e-search-sort-field (consult-mu--set-mu4e-search-sortfield opts))
(mu4e-search-sort-direction (consult-mu--set-mu4e-search-sort-direction opts))
(mu4e-search-skip-duplicates (consult-mu--set-mu4e-skip-duplicates opts))
(mu4e-search-results-limit (consult-mu--set-mu4e-results-limit opts))
(mu4e-search-threads (consult-mu--set-mu4e-threads opts))
(mu4e-search-include-related (consult-mu--set-mu4e-include-related opts))
)
(mu4e--server-find
rewritten-expr
mu4e-search-threads
mu4e-search-sort-field
mu4e-search-sort-direction
mu4e-search-results-limit
mu4e-search-skip-duplicates
mu4e-search-include-related))
(while (or (string-empty-p (buffer-substring (point-min) (point-max)))
(equal (buffer-substring (point-min) (+ (point-min) (length mu4e~search-message))) mu4e~search-message)
(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)))
)
(sleep-for 0.005)
)
))))))(defun consult-mu--execute-all-marks (&optional no-confirmation)
"Execute the actions for all marked messages in `consult-mu-headers-buffer-name' buffer.
If NO-CONFIRMATION is non-nil, don't ask user for confirmation.
This is similar to `mu4e-mark-execute-all' but, with buffer/window handling set accordingly for consult-mu.
"
(interactive "P")
(when-let* ((buf (get-buffer consult-mu-headers-buffer-name)))
(with-current-buffer buf
(when (eq major-mode 'mu4e-headers-mode)
(mu4e--mark-in-context
(let* ((marknum (mu4e-mark-marks-num)))
(unless (zerop marknum)
(pop-to-buffer buf)
(unless (one-window-p) (delete-other-windows))
(mu4e-mark-execute-all no-confirmation)
(quit-window))))
)
))
)(defun consult-mu--headers-goto-message-id (msgid)
"Jumps to message with MSGID
in `consult-mu-headers-buffer-name' buffer."
(when-let ((buffer consult-mu-headers-buffer-name))
(with-current-buffer buffer
(setq mu4e-view-buffer-name consult-mu-view-buffer-name)
(mu4e-headers-goto-message-id msgid))))(defun consult-mu--get-message-by-id (msgid)
"Finds the message with MSGID and returns the mu4e MSG plist for it."
(cl-letf* (((symbol-function #'mu4e-view) #'consult-mu--view-msg))
(when-let ((buffer consult-mu-headers-buffer-name))
(with-current-buffer buffer
(setq mu4e-view-buffer-name consult-mu-view-buffer-name)
(mu4e-headers-goto-message-id msgid)
(mu4e-message-at-point)
)
)))(defun consult-mu--contact-string-to-plist (string)
"Convert STRING for contacts to plist.
STRING is the output form mu command. for example from `mu find query --fields f`
Returns plist with :email and :name keys.
For example
\"John Doe <[email protected]>\"
will be converted to
(:name \"John Doe\" :email \"[email protected]\")
"
(let* ((string (replace-regexp-in-string ">,\s\\|>;\s" ">\n" string))
(list (string-split string "\n" t)))
(mapcar (lambda (item)
(cond
((string-match "\\(?2:.*\\)\s+<\\(?1:.+\\)>" item)
(list :email (or (match-string 1 item) nil) :name (or (match-string 2 item) nil)))
((string-match "^\\(?1:[a-zA-Z0-9\_\.\+\-]+@[a-zA-Z0-9\-]+\.[a-zA-Z0-9\-\.]+\\)" item)
(list :email (or (match-string 1 item) nil) :name nil))
(t
(list :email (format "%s" item) :name nil))
)) list)))(defun consult-mu--contact-name-or-email (contact)
"Retrieve name or email of CONTACT.
Looks at the contact plist (e.g. (:name \"John Doe\" :email \"[email protected]\") ) and returns the name. If the name is missing returns the email address.
"
(cond
((stringp contact)
contact)
((listp contact)
(mapconcat (lambda (item) (or (plist-get item :name) (plist-get item :email) "")) contact ","))
))(defun consult-mu--headers-template ()
"Make headers template using `consult-mu-headers-template'."
(if (and consult-mu-headers-template (functionp consult-mu-headers-template))
(funcall consult-mu-headers-template)
consult-mu-headers-template))(defun consult-mu--expand-headers-template (msg string)
"Expands STRING to create a custom header format for MSG.
See `consult-mu-headers-template' for explanation of the format of STRING.
"
(cl-loop with str = nil
for c in (string-split string "%" t)
concat (concat (pcase (substring c 0 1)
("f" (let ((sender (consult-mu--contact-name-or-email (plist-get msg :from)))
(length (string-to-number (substring c 1 nil))))
(if sender
(propertize (if (> length 0) (consult-mu--set-string-width sender length) sender) 'face 'consult-mu-sender-face))))
("t" (let ((receiver (consult-mu--contact-name-or-email (plist-get msg :to)))
(length (string-to-number (substring c 1 nil))))
(if receiver
(propertize (if (> length 0) (consult-mu--set-string-width receiver length) receiver) 'face 'consult-mu-sender-face))))
("s" (let ((subject (plist-get msg :subject))
(length (string-to-number (substring c 1 nil))))
(if subject
(propertize (if (> length 0) (consult-mu--set-string-width subject length) subject) 'face 'consult-mu-subject-face))))
("d" (let ((date (format-time-string "%a %d %b %y" (plist-get msg :date)))
(length (string-to-number (substring c 1 nil))))
(if date
(propertize (if (> length 0) (consult-mu--set-string-width date length) date) 'face 'consult-mu-date-face))))
("p" (let ((priority (plist-get msg :priority))
(length (string-to-number (substring c 1 nil))))
(if priority
(propertize (if (> length 0) (consult-mu--set-string-width (format "%s" priority) length) (format "%s" priority)) 'face 'consult-mu-size-face))))
("z" (let ((size (file-size-human-readable (plist-get msg :size)))
(length (string-to-number (substring c 1 nil))))
(if size
(propertize (if (> length 0) (consult-mu--set-string-width size length) size) 'face 'consult-mu-size-face))))
("i" (let ((id (plist-get msg :message-id))
(length (string-to-number (substring c 1 nil))))
(if id
(propertize (if (> length 0) (consult-mu--set-string-width id length) id) 'face 'consult-mu-default-face))))
("g" (let ((flags (plist-get msg :flags))
(length (string-to-number (substring c 1 nil))))
(if flags
(propertize (if (> length 0) (consult-mu--set-string-width (format "%s" flags) length) (format "%s" flags)) 'face 'consult-mu-flags-face))))
("G" (let ((flags (plist-get msg :flags))
(length (string-to-number (substring c 1 nil))))
(if flags
(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))))
("x" (let ((tags (plist-get msg :tags))
(length (string-to-number (substring c 1 nil))))
(if tags
(propertize (if (> length 0) (consult-mu--set-string-width tags length) tags) 'face 'consult-mu-tags-face) nil)))
("c" (let ((cc (consult-mu--contact-name-or-email (plist-get msg :cc)))
(length (string-to-number (substring c 1 nil))))
(if cc
(propertize (if (> length 0) (consult-mu--set-string-width cc length) cc) 'face 'consult-mu-tags-face))))
("h" (let ((bcc (consult-mu--contact-name-or-email (plist-get msg :bcc)))
(length (string-to-number (substring c 1 nil))))
(if bcc
(propertize (if (> length 0) (consult-mu--set-string-width bcc length) bcc) 'face 'consult-mu-tags-face))))
("r" (let ((changed (format-time-string "%a %d %b %y" (plist-get msg :changed)))
(length (string-to-number (substring c 1 nil))))
(if changed
(propertize (if (> length 0) (consult-mu--set-string-width changed length) changed) 'face 'consult-mu-tags-face))))
(_ nil)
) " ")))(defun consult-mu--quit-header-buffer ()
"Quits `consult-mu-headers-buffer-name' buffer."
(save-mark-and-excursion
(when-let* ((buf (get-buffer consult-mu-headers-buffer-name)))
(with-current-buffer buf
(if (eq major-mode 'mu4e-headers-mode)
(mu4e-mark-handle-when-leaving)
(quit-window t)
;; clear the decks before going to the main-view
(mu4e--query-items-refresh 'reset-baseline)
)))))(defun consult-mu--quit-view-buffer ()
"Quits `consult-mu-view-buffer-name' buffer."
(when-let* ((buf (get-buffer consult-mu-view-buffer-name)))
(with-current-buffer buf
(if (eq major-mode 'mu4e-view-mode)
(mu4e-view-quit)
))))(defun consult-mu--quit-main-buffer ()
"Quits 'mu4e-main-buffer-name' buffer."
(when-let* ((buf (get-buffer mu4e-main-buffer-name)))
(with-current-buffer buf
(if (eq major-mode 'mu4e-main-mode)
(mu4e-quit)
))))(defun consult-mu--lookup ()
"Lookup function for `consult-mu' or `consult-mu-async' minibuffer candidates.
This is passed as LOOKUP to `consult--read' on candidates and is used to format the output when a candidate is selected."
(lambda (sel cands &rest args)
(let* ((info (cdr (assoc sel cands)))
(msg (plist-get info :msg))
(subject (plist-get msg :subject))
)
(cons subject info)
)))(defun consult-mu--group-name (cand)
"Gets the group name of CAND using `consult-mu-group-by'
See `consult-mu-group-by' for details of grouping options.
"
(let* ((msg (get-text-property 0 :msg cand))
(group (or consult-mu--override-group consult-mu-group-by))
(field (if (not (keywordp group)) (intern (concat ":" (format "%s" group))) group)))
(pcase field
(:date (format-time-string "%a %d %b %y" (plist-get msg field)))
(:from (cond
((listp (plist-get msg field))
(mapconcat (lambda (item) (or (plist-get item :name) (plist-get item :email))) (plist-get msg field) ";"))
(stringp (plist-get msg field) (plist-get msg field))))
(:to (cond
((listp (plist-get msg field))
(mapconcat (lambda (item) (or (plist-get item :name) (plist-get item :email))) (plist-get msg field) ";"))
(stringp (plist-get msg field) (plist-get msg field))))
(:changed (format-time-string "%a %d %b %y" (plist-get msg field)))
(:datetime (format-time-string "%F %r" (plist-get msg :date)))
(:time (format-time-string "%X" (plist-get msg :date)))
(:year (format-time-string "%Y" (plist-get msg :date)))
(:month (format-time-string "%B" (plist-get msg :date)))
(:day-of-week (format-time-string "%A" (plist-get msg :date)))
(:day (format-time-string "%A" (plist-get msg :date)))
(:week (format-time-string "%V" (plist-get msg :date)))
(:size (file-size-human-readable (plist-get msg field)))
(:flags (format "%s" (plist-get msg field)))
(:tags (format "%s" (plist-get msg field)))
(_ (if (plist-get msg field) (format "%s" (plist-get msg field)) nil))
)))
(defun consult-mu--group (cand transform)
"Group function for `consult-mu' or `consult-mu-async' minibuffer candidates.
This is passed as GROUP to `consult--read' on candidates and is used to group emails using `consult-mu--group-name'."
(when-let ((name (consult-mu--group-name cand)))
(if transform (substring cand) name)
))In this section we define action functions that can be run on a candidate for example view, reply, forward, etc.
(defun consult-mu--view (msg noselect mark-as-read match-str)
"Opens MSG in `consult-mu-headers' and `consult-mu-view'.
If NOSELECT is non-nil, does not select the view buffer/window.
If MARK-AS-READ is non-nil, marks the MSG as read.
If MATCH-STR is non-nil, highlights the MATCH-STR in the view buffer.
"
(let ((msgid (plist-get msg :message-id)))
(when-let ((buf (mu4e-get-headers-buffer consult-mu-headers-buffer-name t)))
(with-current-buffer buf
;;(mu4e-headers-mode)
(goto-char (point-min))
(setq mu4e-view-buffer-name consult-mu-view-buffer-name)
(unless noselect
(switch-to-buffer buf))
))
(consult-mu--view-msg msg consult-mu-view-buffer-name)
(with-current-buffer consult-mu-headers-buffer-name
(if msgid
(progn
(mu4e-headers-goto-message-id msgid)
(if mark-as-read
(mu4e--server-move (mu4e-message-field-at-point :docid) nil "+S-u-N"))))
)
(when match-str
(add-to-history 'search-ring match-str)
(consult-mu--overlay-match match-str consult-mu-view-buffer-name t))
(with-current-buffer consult-mu-view-buffer-name
(goto-char (point-min)))
(unless noselect
(when msg
(select-window (get-buffer-window consult-mu-view-buffer-name))))
consult-mu-view-buffer-name))
(defun consult-mu--view-action (cand)
"Opens the candidate, CAND, from consult-mu.
This is a wrapper function around `consult-mu--view'. It parses CAND to extract relevant MSG plist and other information and passes them to `consult-mu--view'.
To use this as the default action for consult-mu, set `consult-mu-default-action' to #'consult-mu--view-action."
(let* ((info (cdr cand))
(msg (plist-get info :msg))
(query (plist-get info :query))
(match-str (car (consult--command-split query)))
)
(consult-mu--view msg nil consult-mu-mark-viewed-as-read match-str)
(consult-mu-overlays-toggle consult-mu-view-buffer-name)
))(defun consult-mu--reply (msg &optional wide-reply)
"Reply to MSG using `mu4e-compose-reply'.
If WIDE-REPLY is non-nil use wide-reply (a.k.a. reply all) with `mu4e-compose-wide-reply'.
"
(let ((msgid (plist-get msg :message-id)))
(when-let ((buf (mu4e-get-headers-buffer consult-mu-headers-buffer-name t)))
(with-current-buffer buf
(goto-char (point-min))
(setq mu4e-view-buffer-name consult-mu-view-buffer-name)
))
(with-current-buffer consult-mu-headers-buffer-name
(mu4e-headers-goto-message-id msgid)
(if (not wide-reply)
(mu4e-compose-reply)
(mu4e-compose-wide-reply)
)
)))
(defun consult-mu--reply-action (cand &optional wide-reply)
(let* ((info (cdr cand))
(msg (plist-get info :msg))
(wide-reply (or wide-reply
(pcase consult-mu-use-wide-reply
('ask (y-or-n-p "reply all?"))
('nil nil)
('t t)
))))
(consult-mu--reply msg wide-reply)
))(defun consult-mu--forward (msg)
"Forward the MSG using `mu4e-compose-forward'."
(let ((msgid (plist-get msg :message-id)))
(when-let ((buf (mu4e-get-headers-buffer consult-mu-headers-buffer-name t)))
(with-current-buffer buf
(goto-char (point-min))
(setq mu4e-view-buffer-name consult-mu-view-buffer-name)
))
(with-current-buffer consult-mu-headers-buffer-name
(mu4e-headers-goto-message-id msgid)
(mu4e-compose-forward)
)
))
(defun consult-mu--forward-action (cand)
(let* ((info (cdr cand))
(msg (plist-get info :msg)))
(consult-mu--forward msg)
))(defun consult-mu--dynamic-format-candidate (cand highlight)
"Formats minibuffer candidates for `consult-mu'.
CAND is the minibuffer completion candidate (a mu4e message collected by `consult-mu--dynamic-collection').
if HIGHLIGHT is non-nil, it is highlighted with `consult-mu-highlight-match-face' in the minibuffer completion list."
(let* ((string (car cand))
(info (cadr cand))
(msg (plist-get info :msg))
(query (plist-get info :query))
(match-str (if (stringp query) (consult--split-escaped (car (consult--command-split query))) nil))
(headers-template (consult-mu--headers-template))
(str (if headers-template
(consult-mu--expand-headers-template msg headers-template)
string)
)
(str (propertize str :msg msg :query query :type :dynamic))
)
(if (and consult-mu-highlight-matches highlight)
(cond
((listp match-str)
(mapcar (lambda (match) (setq str (consult-mu--highlight-match match str t))) match-str))
((stringp match-str)
(setq str (consult-mu--highlight-match match-str str t))))
str)
(when msg
(cons str (list :msg msg :query query :type :dynamic)))))(defun consult-mu--dynamic-collection (input)
"Dynamically collects mu4e search results.
INPUT is the user input. It is passed as QUERY to `consult-mu--update-headers', appends the result to `consult-mu-headers-buffer-name' and returns the collects list of found messages and returns it as minibuffer completion table.
"
(save-excursion
(pcase-let* ((`(,arg . ,opts) (consult--command-split input)))
(consult-mu--update-headers input nil nil :dynamic)
(if (or (member "-g" opts) (member "--group" opts))
(cond
((member "-g" opts)
(setq consult-mu--override-group (intern (or (nth (+ (cl-position "-g" opts :test 'equal) 1) opts) "nil")))
)
((member "--group" opts)
(setq consult-mu--override-group (intern (or (nth (+ (cl-position "--group" opts :test 'equal) 1) opts) "nil")))
)
)
(setq consult-mu--override-group nil)
))
(with-current-buffer consult-mu-headers-buffer-name
(goto-char (point-min))
(remove nil
(cl-loop until (eobp)
collect (let ((msg (ignore-errors (mu4e-message-at-point))))
(consult-mu--dynamic-format-candidate `(,(buffer-substring (point) (point-at-eol)) (:msg ,(ignore-errors (mu4e-message-at-point)) :query ,input)) t))
do (forward-line 1)))
)))(defun consult-mu--dynamic-state ()
"State function for consult-mu candidates.
This is passed as STATE to `consult--read' and is used to preview or do other actions on the candidate."
(lambda (action cand)
(let ((preview (consult--buffer-preview)))
(pcase action
('preview
(if cand
(when-let* ((info (cdr cand))
(msg (plist-get info :msg))
(query (plist-get info :query))
(msgid (substring-no-properties (plist-get msg :message-id)))
(match-str (car (consult--command-split query)))
(match-str (car (consult--command-split query)))
(mu4e-headers-buffer-name consult-mu-headers-buffer-name)
(buffer consult-mu-view-buffer-name))
;;(get-buffer-create consult-mu-view-buffer-name)
(add-to-list 'consult-mu--view-buffers-list buffer)
(funcall preview action
(consult-mu--view msg t consult-mu-mark-previewed-as-read match-str)
)
(with-current-buffer consult-mu-view-buffer-name
(unless (one-window-p) (delete-other-windows))
))))
('return
(save-mark-and-excursion
(consult-mu--execute-all-marks)
)
(setq consult-mu--override-group nil)
cand)
))))
(defun consult-mu--dynamic (prompt collection &optional initial)
"Query mu4e messages dyunamically.
This is a non-interactive internal function. For the interactive version see `consult-mu'.
It runs the `consult-mu--dynamic-collection' to do a `mu4e-search' with user input (e.g. INITIAL) and returns the results (list of messages found) as a completion table in minibuffer.
The completion table gets dynamically updated as the user types in the minibuffer. Each candidate in the minibuffer is formatted by `consult-mu--dynamic-format-candidate' to add annotation and other info to the candidate.
PROMPT is the prompt in the minibuffer (passed as PROMPT to `consult--read'.)
COLLECTION is a colection function passed to `consult--dynamic-collection'.
INITIAL is an optional arg for the initial input in the minibuffer. (passed as INITITAL to `consult--read'.)
commandline arguments/options (see `mu find --help` in the command line for details) can be passed to the minibuffer input similar to `consult-grep'. For example the user can enter:
`#paper -- --maxnum 200 --sortfield from --reverse'
this will search for mu4e messages with the query \"paper\", retrives a maximum of 200 messagesn sorts them by the \"from:\" field and reverses the sort direction (opposite of `consult-mu-search-sort-field').
Note that some command line arguments are not supported by mu4e (for example sorting base on cc: field or bcc: field is not supported in `mu4e-search-sort-field')
Also, the results can further be narrowed by entering \"#\" similar to `consult-grep'.
For example:
`#paper -- --maxnum 200 --sortfield from --reverse#accepted'
will retrieve the message as the example above, then narrows down the completion table to candidates that match \"accepted\".
"
(consult--read
(consult--dynamic-collection collection)
:prompt prompt
:lookup (consult-mu--lookup)
:state (funcall #'consult-mu--dynamic-state)
:initial (consult--async-split-initial initial)
:group #'consult-mu--group
:add-history (append (list (consult--async-split-thingatpt 'symbol))
consult-mu-saved-searches-dynamic
)
:history '(:input consult-mu--history)
:require-match t
:category 'consult-mu-messages
:preview-key consult-mu-preview-key
:sort nil))
(defun consult-mu-dynamic (&optional initial noaction)
"Lists results of `mu4e-search' dynamically.
This is an interactive wrapper function around `consult-mu--dynamic'. It queries the user for a search term in the minibuffer, then fetches a list of messages for the entered search term as a minibuffer completion table for selection. The list of candidates in the completion table are dynamically updated as the user changes the entry.
Upon selection of a candidate either
- the candidate is returned if NOACTION is non-nil
or
- the candidate is passed to `consult-mu-action' if NOACTION is nil.
Additional commandline arguments can be passed in the minibuffer entry by typing `--` followed by command line arguments.
For example the user can enter:
`#consult-mu -- -n 10'
this will run a `mu4e-search' with the query \"consult-my\" and changes the search limit (i.e. `mu4e-search-results-limit' to 10.
Also, the results can further be narrowed by entering \"#\" similar to `consult-grep'.
For example:
`#consult-mu -- -n 10#github'
will retrieve the message as the example above, then narrows down the completion table to candidates that match \"github\".
INITIAL is an optional arg for the initial input in the minibuffer. (passed as INITITAL to `consult-mu--dynamic')
For more details on consult--async functionalities, see `consult-grep' and the official manual of consult, here: https://github.com/minad/consult.
"
(interactive)
(save-mark-and-excursion
(consult-mu--execute-all-marks)
)
(let* ((sel
(consult-mu--dynamic (concat "[" (propertize "consult-mu-dynamic" 'face 'consult-mu-sender-face) "]" " Search For: ") #'consult-mu--dynamic-collection initial)
))
(save-mark-and-excursion
(consult-mu--execute-all-marks)
)
(if noaction
sel
(progn
(funcall consult-mu-action sel)
sel))))(defun consult-mu--async-format-candidate (string input highlight)
"Formats minibuffer candidates for `consult-mu-async'.
STRING is the output retrieved from `mu find INPUT ...` in the command line.
INPUT is the query from the user.
if HIGHLIGHT is t, input is highlighted with `consult-mu-highlight-match-face' in the minibuffer."
(let* ((query input)
(parts (string-split (replace-regexp-in-string "^\\\\->\s\\|^\\\/->\s" "" string) consult-mu-delimiter))
(msgid (car parts))
(date (date-to-time (cadr parts)))
(sender (cadr (cdr parts)))
(sender (consult-mu--contact-string-to-plist sender))
(receiver (cadr (cdr (cdr parts))))
(receiver (consult-mu--contact-string-to-plist receiver))
(subject (cadr (cdr (cdr (cdr parts)))))
(size (string-to-number (cadr (cdr (cdr (cdr (cdr parts)))))))
(flags (consult-mu-flags-to-string (cadr (cdr (cdr (cdr (cdr (cdr parts))))))))
(tags (cadr (cdr (cdr (cdr (cdr (cdr (cdr parts))))))))
(priority (cadr (cdr (cdr (cdr (cdr (cdr (cdr (cdr parts)))))))))
(cc (cadr (cdr (cdr (cdr (cdr (cdr (cdr (cdr (cdr parts))))))))))
(cc (consult-mu--contact-string-to-plist cc))
(bcc (cadr (cdr (cdr (cdr (cdr (cdr (cdr (cdr (cdr (cdr parts)))))))))))
(bcc (consult-mu--contact-string-to-plist bcc))
(path (cadr (cdr (cdr (cdr (cdr (cdr (cdr (cdr (cdr (cdr (cdr parts))))))))))))
(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))
(match-str (if (stringp input) (consult--split-escaped (car (consult--command-split query))) nil))
(headers-template (consult-mu--headers-template))
(str (if headers-template
(consult-mu--expand-headers-template msg headers-template)
(format "%s\s\s%s\s\s%s\s\s%s\s\s%s"
(propertize (consult-mu--set-string-width
(format-time-string "%x" date) 10) 'face 'consult-mu-date-face)
(propertize (consult-mu--set-string-width (consult-mu--contact-name-or-email sender) (floor (* (frame-width) 0.2))) 'face 'consult-mu-sender-face)
(propertize (consult-mu--set-string-width subject (floor (* (frame-width) 0.55))) 'face 'consult-mu-subject-face)
(propertize (file-size-human-readable size) 'face 'consult-mu-size-face)
(propertize (format "%s" flags) 'face 'consult-mu-flags-face)
(propertize (if tags (format "%s" tags) nil) 'face 'consult-mu-tags-face)
)))
(str (propertize str :msg msg :query query :type :async))
)
(if (and consult-mu-highlight-matches highlight)
(cond
((listp match-str)
(mapcar (lambda (match) (setq str (consult-mu--highlight-match match str t))) match-str))
((stringp match-str)
(setq str (consult-mu--highlight-match match-str str t))))
str)
(cons str (list :msg msg :query query :type :async))))(defun consult-mu--async-state ()
"State function for `consult-mu-async' candidates.
This is passed as STATE to `consult--read' and is used to preview or do other actions on the candidate."
(lambda (action cand)
(let ((preview (consult--buffer-preview)))
(pcase action
('preview
(if cand
(when-let* ((info (cdr cand))
(msg (plist-get info :msg))
(msgid (substring-no-properties (plist-get msg :message-id)))
(query (plist-get info :query))
(match-str (car (consult--command-split query)))
(mu4e-headers-buffer-name consult-mu-headers-buffer-name)
(buffer consult-mu-view-buffer-name))
(add-to-list 'consult-mu--view-buffers-list buffer)
(funcall preview action
(consult-mu--view msg t consult-mu-mark-previewed-as-read match-str)
)
(with-current-buffer consult-mu-view-buffer-name
(unless (one-window-p) (delete-other-windows))
))))
('return
(save-mark-and-excursion
(consult-mu--execute-all-marks)
)
cand)
))))
(defun consult-mu--async-transform (async builder)
"Adds annotation to minibuffer candiates for `consult-mu'.
Returns ASYNC function after formating results with `consult-mu--async-format-candidate'.
BUILDER is the command line builder function (e.g. `consult-mu--async-builder')."
(let ((input))
`(lambda (action)
(cond
((stringp action)
(setq input action)
(funcall ,async action)
)
((consp action)
(funcall ,async (mapcar (lambda (string)
(consult-mu--async-format-candidate string input t))
action))
)
(t (funcall ,async action))
)
)))(defun consult-mu--async-builder (input)
"Build mu command line for searching messages by INPUT (e.g. `mu find INPUT)`."
(pcase-let* ((consult-mu-args (append consult-mu-args '("find")))
(cmd (consult--build-args consult-mu-args))
(`(,arg . ,opts) (consult--command-split input))
(flags (append cmd opts))
(sortfield (cond
((member "-s" flags) (nth (+ (cl-position "-s" opts :test 'equal) 1) flags))
((member "--sortfield" flags) (nth (+ (cl-position "--sortfield" flags :test 'equal) 1) flags))
(t (substring (symbol-name consult-mu-search-sort-field) 1))))
(threads (if (not (equal sortfield :date)) nil (or (member "-t" flags) (member "--threads" flags) mu4e-search-threads)))
(skip-dups (or (member "-u" flags) (member "--skip-dups" flags) mu4e-search-skip-duplicates))
(include-related (or (member "-r" flags) (member "--include-related" flags) mu4e-search-include-related)))
(if (or (member "-g" flags) (member "--group" flags))
(cond
((member "-g" flags)
(setq consult-mu--override-group (intern (or (nth (+ (cl-position "-g" opts :test 'equal) 1) opts) "nil")))
(setq opts (remove "-g" (remove (nth (+ (cl-position "-g" opts :test 'equal) 1) opts) opts))))
((member "--group" flags)
(setq consult-mu--override-group (intern (or (nth (+ (cl-position "--group" opts :test 'equal) 1) opts) "nil")))
(setq opts (remove "--group" (remove (nth (+ (cl-position "--group" opts :test 'equal) 1) opts) opts)))))
(setq consult-mu--override-group nil)
)
(setq opts (append opts (list "--nocolor")))
(setq opts (append opts (list "--fields" (format "i%sd%sf%st%ss%sz%sg%sx%sp%sc%sh%sl"
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))))
(unless (or (member "-s" flags) (member "--sortfiled" flags))
(setq opts (append opts (list "--sortfield" (substring (symbol-name consult-mu-search-sort-field) 1)))))
(if threads (setq opts (append opts (list "--thread"))))
(if skip-dups (setq opts (append opts (list "--skip-dups"))))
(if include-related (setq opts (append opts (list "--include-related"))))
(cond
((and (member "-n" flags) (< (string-to-number (nth (+ (cl-position "-n" opts :test 'equal) 1) opts)) 0))
(setq opts (remove "-n" (remove (nth (+ (cl-position "-n" opts :test 'equal) 1) opts) opts))))
((and (member "--maxnum" flags) (< (string-to-number (nth (+ (cl-position "--maxnum" opts :test 'equal) 1) opts)) 0))
(setq opts (remove "--maxnum" (remove (nth (+ (cl-position "--maxnum" opts :test 'equal) 1) opts) opts)))))
(unless (or (member "-n" flags) (member "--maxnum" flags))
(if (and consult-mu-maxnum (> consult-mu-maxnum 0))
(setq opts (append opts (list "--maxnum" (format "%s" consult-mu-maxnum))))))
(pcase consult-mu-search-sort-direction
('descending
(if (or (member "-z" flags) (member "--reverse" flags))
(setq opts (remove "-z" (remove "--reverse" opts)))
(setq opts (append opts (list "--reverse")))))
('ascending
)
(_
)
)
(pcase-let* ((`(,re . ,hl) (funcall consult--regexp-compiler arg 'basic t)))
(when re
(cons (append cmd
(list (string-join re " "))
opts)
hl)))))(defun consult-mu--async (prompt builder &optional initial)
"Query mu4e messages asynchronously.
This is a non-interactive internal function. For the interactive version see `consult-mu-async'.
It runs the command line from `consult-mu--async-builder' in an async process and returns the results (list of messages) as a completion table in minibuffer that will be passed to `consult--read'. The completion table gets dynamically updated as the user types in the minibuffer. Each candidate in the minibuffer is formatted by `consult-mu--async-transform' to add annotation and other info to the candidate.
PROMPT is the prompt in the minibuffer (passed as PROMPT to `consult--red'.)
BUILDER is an async builder function passed to `consult--async-command'.
INITIAL is an optional arg for the initial input in the minibuffer. (passed as INITITAL to `consult--read'.)
commandline arguments/options (see `mu find --help` in the command line for details) can be passed to the minibuffer input similar to `consult-grep'. For example the user can enter:
`#paper -- --maxnum 200 --sortfield from --reverse'
this will search for mu4e messages with the query \"paper\", retrives a maximum of 200 messages sorts them by the \"from:\" field and reverses the sort direction (opposite of `consult-mu-search-sort-field').
Also, the results can further be narrowed by entering \"#\" similar to `consult-grep'.
For example:
`#paper -- --maxnum 200 --sortfield from --reverse#accepted'
will retrieve the message as the example above, then narrows down the completion table to candidates that match \"accepted\".
"
(consult--read
(consult--async-command builder
(consult-mu--async-transform builder)
)
:prompt prompt
:lookup (consult-mu--lookup)
:state (funcall #'consult-mu--async-state)
:initial (consult--async-split-initial initial)
:group #'consult-mu--group
:add-history (append (list (consult--async-split-thingatpt 'symbol))
consult-mu-saved-searches-async
)
:history '(:input consult-mu--history)
:require-match t
:category 'consult-mu-messages
:preview-key consult-mu-preview-key
:sort nil))
(defun consult-mu-async (&optional initial noaction)
"Lists results of `mu find` Asynchronously.
This is an interactive wrapper function around `consult-mu--async'. It queries the user for a search term in the minibuffer, then fetches a list of messages for the entered search term as a minibuffer completion table for selection. The list of candidates in the completion table are dynamically updated as the user changes the entry.
Upon selection of a candidate either
- the candidate is returned if NOACTION is non-nil
or
- the candidate is passed to `consult-mu-action' if NOACTION is nil.
Additional commandline arguments can be passed in the minibuffer entry by typing `--` followed by command line arguments.
For example the user can enter:
`#consult-mu -- -n 10'
this will run a `mu4e-search' with the query \"consult-my\" and changes the search limit (i.e. `mu4e-search-results-limit' to 10.
Also, the results can further be narrowed by entering \"#\" similar to `consult-grep'.
For example:
`#consult-mu -- -n 10#github'
will retrieve the message as the example above, then narrows down the completion table to candidates that match \"github\".
INITIAL is an optional arg for the initial input in the minibuffer. (passed as INITITAL to `consult-mu--async').
For more details on consult--async functionalities, see `consult-grep' and the official manual of consult, here: https://github.com/minad/consult.
Note that this is the async search directly using the commandline `mu` command and not mu4e-search. As a result, mu4e-headers buffers are not created until a single message is selected (or interacted with using embark, etc.) Previews are shown in a mu4e-view buffer (see `consult-mu-view-buffer-name') attached to an empty mu4e-headers buffer (i.e. `consult-mu-headers-buffer-name'). This allows quick retrieval of many messages (tens of thousands) and previews, but not opening the results in a mu4e-headers buffer. If you want ot open the results in a mu4e-headers buffer for other work flow, then you should use the dynamically collected function `consult-mu' which is slower if searching for many emails but allows follow up interactions in a mu4e-headers buffer.
"
(interactive)
(save-mark-and-excursion
(consult-mu--execute-all-marks)
)
(let* ((sel
(consult-mu--async (concat "[" (propertize "consult-mu async" 'face 'consult-mu-sender-face) "]" " Search For: ") #'consult-mu--async-builder initial)
)
(info (cdr sel))
(msg (plist-get info :msg))
(query (plist-get info :query)))
(save-mark-and-excursion
(consult-mu--execute-all-marks)
)
(if noaction
sel
(progn
(consult-mu--update-headers query t msg :async))
(funcall consult-mu-action sel)
sel)))(defun consult-mu (&optional initial noaction)
"Default consult-mu command.
This is a wrapper function that calls `consult-mu-default-command'.
For example, the `consult-mu-default-command can be set to
`#'consult-mu-dynamic' sets the default behavior to dynamic collection
`#'consult-mu-async' sets the default behavior to async collection
"
(interactive "P")
(funcall consult-mu-default-command initial noaction)
);;; provide `consult-mu' module
(provide 'consult-mu);;; consult-mu.el ends here;;; consult-mu-embark.el --- Emabrk Actions for consult-mu -*- lexical-binding: t -*-
;; Copyright (C) 2021-2023
;; Author: Armin Darvish
;; Maintainer: Armin Darvish
;; Created: 2023
;; Version: 1.0
;; Package-Requires: ((emacs "28.0") (consult "0.34"))
;; Homepage: https://github.com/armindarvish/consult-mu
;; Keywords: convenience, matching, tools, email
;; Homepage: https://github.com/armindarvish/consult-mu
;; SPDX-License-Identifier: GPL-3.0-or-later
;; This file is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published
;; by the Free Software Foundation, either version 3 of the License,
;; or (at your option) any later version.
;;
;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this file. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; This package provides an alternative interactive serach interface for
;; mu and mu4e (see URL `https://djcbsoftware.nl/code/mu/mu4e.html').
;; It uses a consult-based minibuffer completion for searching and
;; selecting, and marking emails, as well as additional utilities for
;; composing emails and more.
;; This package requires mu4e version "1.10.8" or later.
;;; Code:This 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.
;;; Requirements
(require 'embark)
(require 'consult-mu)
;;; Customization Variables
(defcustom consult-mu-embark-noconfirm-before-execute nil
"Should consult-mu-embark skip confirmation when executing marks?"
:group 'consult-mu
:type 'boolean
)
;;; Define Embark Action Functions
(defun consult-mu-embark-default-action (cand)
"Run `consult-mu-action' on the candidate."
(let* ((msg (get-text-property 0 :msg cand))
(query (get-text-property 0 :query cand))
(type (get-text-property 0 :type cand))
(newcand (cons cand `(:msg ,msg :query ,query :type ,type))))
(if (equal type :async)
(consult-mu--update-headers query t msg :async)
)
(funcall consult-mu-action newcand))
)
(defun consult-mu-embark-reply (cand)
"Reply to message in CAND."
(let* ((msg (get-text-property 0 :msg cand))
(query (get-text-property 0 :query cand))
(type (get-text-property 0 :type cand))
)
(if (equal type :async)
(consult-mu--update-headers query t msg :async)
)
(consult-mu--reply msg nil)))
(defun consult-mu-embark-wide-reply (cand)
"Reply all for message in CAND."
(let* ((msg (get-text-property 0 :msg cand))
(query (get-text-property 0 :query cand))
(type (get-text-property 0 :type cand))
)
(if (equal type :async)
(consult-mu--update-headers query t msg :async)
)
(consult-mu--reply msg )))
(defun consult-mu-embark-forward (cand)
"Forward the message in CAND."
(let* ((msg (get-text-property 0 :msg cand))
(query (get-text-property 0 :query cand))
(type (get-text-property 0 :type cand))
)
(if (equal type :async)
(consult-mu--update-headers query t msg :async)
)
(consult-mu--forward msg)))
(defun consult-mu-embark-kill-message-field (cand)
"Get a header field of message in CAND."
(let* ((msg (get-text-property 0 :msg cand))
(query (get-text-property 0 :query cand))
(type (get-text-property 0 :type cand))
(newcand (cons cand `(:msg ,msg :query ,query :type ,type)))
(msg-id (plist-get msg :message-id))
)
(if (equal type :async)
(consult-mu--update-headers query t msg :async)
)
(with-current-buffer consult-mu-headers-buffer-name
(unless (equal (mu4e-message-field-at-point :message-id) msg-id)
(mu4e-headers-goto-message-id msg-id))
(if (equal (mu4e-message-field-at-point :message-id) msg-id)
(progn
(mu4e~headers-update-handler msg nil nil)
)
))
(with-current-buffer consult-mu-view-buffer-name
(kill-new (consult-mu--message-get-header-field))
(consult-mu--pulse-region (point) (point-at-eol))
)
))
(defun consult-mu-embark-save-attachmnts (cand)
"Save attachments of CAND."
(let* ((msg (get-text-property 0 :msg cand))
(query (get-text-property 0 :query cand))
(type (get-text-property 0 :type cand))
(newcand (cons cand `(:msg ,msg :query ,query :type ,type)))
(msg-id (plist-get msg :message-id))
)
(if (equal type :async)
(consult-mu--update-headers query t msg :async)
)
(with-current-buffer consult-mu-headers-buffer-name
(unless (equal (mu4e-message-field-at-point :message-id) msg-id)
(mu4e-headers-goto-message-id msg-id))
(if (equal (mu4e-message-field-at-point :message-id) msg-id)
(progn
(mu4e~headers-update-handler msg nil nil)
)
))
(with-current-buffer consult-mu-view-buffer-name
(goto-char (point-min))
(re-search-forward "^\\(Attachment\\|Attachments\\): " nil t)
(consult-mu--pulse-region (point) (point-at-eol))
(mu4e-view-save-attachments t)
)
))
(defun consult-mu-embark-search-messages-from-contact (cand)
"Search messages from the same sender as the message in CAND."
(let* ((msg (get-text-property 0 :msg cand))
(from (car (plist-get msg :from)))
(email (plist-get from :email))
)
(consult-mu (concat "from:" email)))
)
(defun consult-mu-embark-search-messages-with-subject (cand)
"Search all messages for the same subject as the message in CAND."
(let* ((msg (get-text-property 0 :msg cand))
;;(subject (replace-regexp-in-string ":\\|#\\|\\.\\|\\+" "" (plist-get msg :subject)))
(subject (replace-regexp-in-string ":\\|#\\|\\.\\|\\+\\|\\(\\[.*\\]\\)" "" (format "%s" (plist-get msg :subject))))
)
(consult-mu (concat "subject:" subject)))
)
;; macro for defining functions for marks
(defmacro consult-mu-embark--defun-mark-for (mark)
"Define a function mu4e-view-mark-for- MARK."
(let ((funcname (intern (format "consult-mu-embark-mark-for-%s" mark)))
(docstring (format "Mark the current message for %s." mark)))
`(progn
(defun ,funcname (cand) ,docstring
(let* ((msg (get-text-property 0 :msg cand))
(msgid (plist-get msg :message-id))
(query (get-text-property 0 :query cand))
(buf (get-buffer consult-mu-headers-buffer-name))
)
(if buf
(progn
(with-current-buffer buf
(if (eq major-mode 'mu4e-headers-mode)
(progn
(goto-char (point-min))
(mu4e-headers-goto-message-id msgid)
(if (equal (mu4e-message-field-at-point :message-id) msgid)
(mu4e-headers-mark-and-next ',mark)
(progn
(consult-mu--update-headers query t msg :async)
(with-current-buffer buf
(goto-char (point-min))
(mu4e-headers-goto-message-id msgid)
(if (equal (mu4e-message-field-at-point :message-id) msgid)
(mu4e-headers-mark-and-next ',mark))))))
(progn
(consult-mu--update-headers query t msg :async)
(with-current-buffer buf
(goto-char (point-min))
(mu4e-headers-goto-message-id msgid)
(if (equal (mu4e-message-field-at-point :message-id) msgid)
(mu4e-headers-mark-and-next ',mark)))))
)
)
)
)))))
;; add embark functions for marks
(defun consult-mu-embark--defun-func-for-marks (marks)
"Runs the macro `consult-mu-embark--defun-mark-for' on a list of marks.
This is useful for creating embark functions for all the `mu4e-marks' elements."
(mapcar (lambda (mark) (eval `(consult-mu-embark--defun-mark-for ,mark))) marks))
;; use consult-mu-embark--defun-func-for-marks to make a function for each `mu4e-marks' element.
(consult-mu-embark--defun-func-for-marks (mapcar 'car mu4e-marks))
;;; Define Embark Keymaps
(defvar-keymap consult-mu-embark-general-actions-map
:doc "Keymap for consult-mu-embark"
:parent embark-general-map
)
(add-to-list 'embark-keymap-alist '(consult-mu . consult-mu-embark-general-actions-map))
(defvar-keymap consult-mu-embark-messages-actions-map
:doc "Keymap for consult-mu-embark-messages"
:parent consult-mu-embark-general-actions-map
"r" #'consult-mu-embark-reply
"w" #'consult-mu-embark-wide-reply
"f" #'consult-mu-embark-forward
"?" #'consult-mu-embark-kill-message-field
"c" #'consult-mu-embark-search-messages-from-contact
"s" #'consult-mu-embark-search-messages-with-subject
"S" #'consult-mu-embark-save-attachmnts
)
(add-to-list 'embark-keymap-alist '(consult-mu-messages . consult-mu-embark-messages-actions-map))
;; add mark keys to `consult-mu-embark-messages-actions-map' keymap
(defun consult-mu-embark--add-keys-for-marks (marks)
"Adds a key for each mark in MARKS to `consult-mu-embark-messages-actions-map'.
Binds the combination “m key”, where key is the :char in mark plist in the `consult-mu-embark-messages-actions-map' to the function defined by the prefix “consult-mu-embark-mark-for-” and mark.
This is useful for adding all `mu4e-marks' to embark key bindings under a submenu (called by “m”) ,for example the default mark-for-archive mark that is bound to r in mu4e buffers can be called in embark by “m r”."
(mapcar (lambda (mark)
(let* ((key (plist-get (cdr mark) :char))
(key (cond ((consp key) (car key)) ((stringp key) key)))
(func (intern (concat "consult-mu-embark-mark-for-" (format "%s" (car mark)))))
(key (concat "m" key)))
(define-key consult-mu-embark-messages-actions-map key func)
))
marks))
;; add all `mu4e-marks to embark keybindings. See `consult-mu-embark--add-keys-for-marks' above for more details
(consult-mu-embark--add-keys-for-marks mu4e-marks)
;; change the default action on `consult-mu-messages' category.
(add-to-list 'embark-default-action-overrides '(consult-mu-messages . consult-mu-embark-default-action))
;;; Provide `consult-mu-embark' module
(provide 'consult-mu-embark)
;;; consult-mu-embark.el ends here;;; consult-mu-compose.el --- Consult Mu4e asynchronously in GNU Emacs -*- lexical-binding: t -*-
;; Copyright (C) 2023 Armin Darvish
;; Author: Armin Darvish
;; Maintainer: Armin Darvish
;; Created: 2023
;; Version: 1.0
;; Package-Requires: ((emacs "28.0") (consult "0.34"))
;; Homepage: https://github.com/armindarvish/consult-mu
;; Keywords: convenience, matching, tools, email
;; Homepage: https://github.com/armindarvish/consult-mu
;; SPDX-License-Identifier: GPL-3.0-or-later
;; This file is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published
;; by the Free Software Foundation, either version 3 of the License,
;; or (at your option) any later version.
;;
;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this file. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; This package provides an alternative interactive serach interface for
;; mu and mu4e (see URL `https://djcbsoftware.nl/code/mu/mu4e.html').
;; It uses a consult-based minibuffer completion for searching and
;; selecting, and marking emails, as well as additional utilities for
;; composing emails and more.
;; This package requires mu4e version "1.10.8" or later.
;;; Code:
(require 'consult-mu);;; Customization Variables
(defcustom consult-mu-compose-use-dired-attachment 'in-dired
"Use a dired buffer for multiple file attachment?
If set to 'in-dired uses dired buffer and dired marks only when inside dired buffer
If 't, consult-mu will always use dired buffer for selecting attachment files similar to what Doom Emacs does (see https://github.com/doomemacs/doomemacs/blob/bea81278fd2ecb65db6a63dbcd6db2f52921ee41/modules/email/mu4e/autoload/email.el#L272).
If 'nil, consult-mu uses minibuffer completion for selection files to attach even if inside a dired buffer.
By default this is set to 'in-dired."
:group 'consult-mu
:type '(choice (const :tag "Only use Dired if inside Dired Buffer" 'in-dired)
(const :tag "Always use Dired" t)
(const :tag "Never use Dired" nil)
))
(defcustom consult-mu-large-file-warning-threshold large-file-warning-threshold
"Threshold for size of file to require confirmation for preview 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."
:group 'consult-mu
:type '(choice integer (const :tag "Never request confirmation" nil)))
(defcustom consult-mu-compose-preview-key consult-mu-preview-key
"Preview key for `consult-mu-compose'.
This is similar to `consult-mu-preview-key' but explicitly for consult-mu-compose.
It is recommended to set this to something other than 'any to avoid loading preview buffers for each file."
:group 'consult-mu
:type '(choice (const :tag "Any key" any)
(list :tag "Debounced"
(const :debounce)
(float :tag "Seconds" 0.1)
(const any))
(const :tag "No preview" nil)
(key :tag "Key")
(repeat :tag "List of keys" key)))
(defcustom consult-mu-embark-attach-file-key nil
"Embark key binding for interactive file attachement."
:group 'consult-mu
:type '(choice (key :tag "Key")
(const :tag "no key binding" nil)))(defvar consult-mu-compose-attach-history nil
"History variable for file attachment used in `consult-mu-compose--read-file-attach'.")
(defvar consult-mu-compose-current-draft-buffer nil
"Stores the buffer that is being edited.")(defun consult-mu-compose--read-file-attach (&optional initial)
"Read files in the minibuffer to attach to an email.
INITIAL is the initial input in the minibuffer."
(consult--read (completion-table-in-turn #'completion--embedded-envvar-table
#'completion--file-name-table)
:prompt "Attach File: "
:require-match t
:category 'file
:initial (or initial default-directory)
:lookup (lambda (sel cands &rest args)
(file-truename sel))
:state (lambda (action cand)
(let ((preview (consult--buffer-preview)))
(pcase action
('preview
(if cand
(when (not (file-directory-p cand))
(let* ((filename (file-truename cand))
(filesize (float
(file-attribute-size
(file-attributes filename))))
(confirm (if (and filename
(>= filesize consult-mu-large-file-warning-threshold))
(yes-or-no-p (format "File is %s Bytes. Do you really want to preview it?" filesize))
t)))
(if confirm
(funcall preview action
(find-file-noselect (file-truename cand))
))))))
('return
cand
)
)))
:preview-key consult-mu-compose-preview-key
:add-history (list mu4e-attachment-dir)
:history 'consult-mu-compose-attach-history
))(defun consult-mu-compose--read-file-remove (&optional initial)
"Select attached files to remove from email.
INITIAL is the initial input in the minibuffer."
(if-let ((current-files (pcase major-mode
('org-msg-edit-mode
(org-msg-get-prop "attachment"))
((or 'mu4e-compose-mode 'message-mode)
(goto-char (point-max))
(cl-loop while (re-search-backward "<#part.*filename=\"\\(?1:.*\\)\"[[:ascii:][:nonascii:]]*?/part>" nil t)
collect (match-string-no-properties 1)))
(_
(error "Not in a compose message buffer")
nil))))
(consult--read current-files
:prompt "Remove File:"
:category 'file
:state (lambda (action cand)
(let ((preview (consult--buffer-preview)))
(pcase action
('preview
(if cand
(when (not (file-directory-p cand))
(let* ((filename (file-truename cand))
(filesize (float
(file-attribute-size
(file-attributes filename))))
(confirm (if (and filename
(>= filesize consult-mu-large-file-warning-threshold))
(yes-or-no-p (format "File is %s Bytes. Do you really want to preview it?" filesize))
t)))
(if confirm
(funcall preview action
(find-file-noselect (file-truename cand))
))))))
('return
cand
)
)))
:preview-key consult-mu-compose-preview-key
:initial initial
)
(progn
(message "No files currently attached!")
nil)))
(defun consult-mu-compose-get-draft-buffer ()
"Queries user to select a mu4e compose draft buffer"
(save-excursion
(if (and (consult-mu-compose-get-current-buffers)
(y-or-n-p "Attach the files to an existing compose buffer? "))
(consult--read (consult-mu-compose-get-current-buffers)
:prompt "Select Message Buffer: "
:require-match nil
:category 'consult-mu-messages
:preview-key consult-mu-preview-key
:lookup (lambda (sel cands &rest args)
(or (get-buffer sel) sel))
:state (lambda (action cand)
(let ((preview (consult--buffer-preview)))
(pcase action
('preview
(if (and cand (buffer-live-p cand))
(funcall preview action
cand)
))
('return
cand
)
)))
))))
(defun consult-mu-compose-get-current-buffers ()
"Return a list of active compose message buffers."
(let (buffers)
(save-current-buffer
(dolist (buffer (buffer-list t))
(set-buffer buffer)
(when (or (and (derived-mode-p 'message-mode)
(null message-sent-message-via))
(derived-mode-p 'org-msg-edit-mode)
(derived-mode-p 'mu4e-compose-mode))
(push (buffer-name buffer) buffers))))
(nreverse buffers)))(defun consult-mu-compose--attach-files (files &optional mail-buffer &rest args)
"Attach FILE to email in MAIL-BUFFER compose buffer."
(let ((files (if (stringp files) (list files) files))
(mail-buffer (or mail-buffer (if (version<= mu4e-mu-version "1.12")
(mu4e-compose 'new) (mu4e-compose-new)))))
(with-current-buffer mail-buffer
(pcase major-mode
('org-msg-edit-mode
(save-excursion
(let* ((new-files (delete-dups (append (org-msg-get-prop "attachment") files))))
(org-msg-set-prop "attachment" new-files))
(goto-last-change 0)
(org-reveal)
(consult-mu--pulse-line))
)
((or 'mu4e-compose-mode 'message-mode)
(save-excursion
(dolist (file files)
(goto-char (point-max))
(unless (eq (current-column) 0)
(insert "\n\n")
(forward-line 2))
(mail-add-attachment (file-truename file))
(goto-last-change 0)
(forward-line -2)
(consult-mu--pulse-line)
)))
(_
(error "%s is not a compose buffer" (current-buffer)))
))))(defun consult-mu-compose--remove-files (files &optional mail-buffer &rest args)
"Removes FILES from current attachments in MAIL-BUFFER."
(let ((files (if (stringp files) (list files) files))
(mail-buffer (or mail-buffer (current-buffer))))
(with-current-buffer mail-buffer
(save-excursion
(pcase major-mode
('org-msg-edit-mode
(let ((current-files (org-msg-get-prop "attachment"))
(removed-files (list)))
(mapcar (lambda (file)
(when (member file current-files)
(org-msg-set-prop "attachment" (delete-dups (remove file current-files)))
(add-to-list 'removed-files file)
(setq current-files (org-msg-get-prop "attachment"))
(goto-last-change 0)
(org-reveal)
(consult-mu--pulse-line)
)) files)
(message "file(s) %s detached" (mapconcat 'identity removed-files ","))))
('mu4e-compose-mode
(let ((removed-files (list)))
(mapcar (lambda (file)
(goto-char (point-min))
(while (re-search-forward (format "<#part.*filename=\"%s\"[[:ascii:][:nonascii:]]*?/part>" file) nil t)
(replace-match "" nil nil)
(setq removed-files (append removed-files (list file)))
(goto-last-change 0)
(consult-mu--pulse-line)
(whitespace-cleanup)
)) files)
(message "file(s) %s detached" (mapconcat 'identity removed-files ", ")))
))))))(defun consult-mu-compose-attach (&optional files mail-buffer)
"Attach FILES to email interactively."
(interactive)
(let* ((consult-mu-compose-current-draft-buffer (cond
((or (derived-mode-p 'mu4e-compose-mode) (derived-mode-p 'org-msg-edit-mode) (derived-mode-p 'message-mode)) (current-buffer))
((derived-mode-p 'dired-mode)
(and (bound-and-true-p dired-mail-buffer) (buffer-live-p dired-mail-buffer) dired-mail-buffer))
(t
consult-mu-compose-current-draft-buffer)))
(mail-buffer (or mail-buffer
(and (buffer-live-p consult-mu-compose-current-draft-buffer) consult-mu-compose-current-draft-buffer)
nil))
(files (or files
(if (and (derived-mode-p 'dired-mode) consult-mu-compose-use-dired-attachment)
(delq nil
(mapcar
;; don't attach directories
(lambda (f) (if (file-directory-p f)
nil
f))
(nreverse (dired-map-over-marks (dired-get-filename) nil))))
(consult-mu-compose--read-file-attach files))))
)
(pcase major-mode
((or 'mu4e-compose-mode 'org-msg-edit-mode 'message-mode)
(setq mail-buffer (current-buffer))
(setq consult-mu-compose-current-draft-buffer mail-buffer)
(cond
((stringp files)
(cond
((and (not (file-directory-p files)) (file-truename files))
(consult-mu-compose--attach-files (file-truename files) mail-buffer))
((and (file-directory-p files) (eq consult-mu-compose-use-dired-attachment 'always))
(progn
(split-window-sensibly)
(with-current-buffer (dired files)
(setq-local dired-mail-buffer mail-buffer)
)))
((and (file-directory-p files) (not (eq consult-mu-compose-use-dired-attachment 'always)))
(progn
(while (file-directory-p files)
(setq files (consult-mu-compose--read-file-attach files)))
(consult-mu-compose--attach-files (file-truename files) mail-buffer)))))
((listp files)
(consult-mu-compose--attach-files files mail-buffer))))
('dired-mode
(setq mail-buffer (or (and (bound-and-true-p dired-mail-buffer) (buffer-live-p dired-mail-buffer) dired-mail-buffer)
(consult-mu-compose-get-draft-buffer)
(if (version<= mu4e-mu-version "1.12")
(mu4e-compose 'new) (mu4e-compose-new))
))
(cond
((and mail-buffer (buffer-live-p mail-buffer)))
((stringp mail-buffer) (with-current-buffer (if (version<= mu4e-mu-version "1.12")
(mu4e-compose 'new) (mu4e-compose-new))
(save-excursion (message-goto-subject)
(insert mail-buffer)
(rename-buffer mail-buffer t)))
(setq mail-buffer (get-buffer mail-buffer))))
(if (and mail-buffer (buffer-live-p mail-buffer))
(progn
(setq-local dired-mail-buffer mail-buffer)
(switch-to-buffer mail-buffer)
(cond
((not files)
(message "no files were selected!"))
((stringp files)
(cond
((and (file-truename files) (not (file-directory-p files)))
(consult-mu-compose--attach-files (file-truename files) mail-buffer))
((and (not consult-mu-compose-use-dired-attachment) (file-directory-p files))
(progn
(while (file-directory-p files)
(setq files (consult-mu-compose--read-file-attach files)))
(consult-mu-compose--attach-files (file-truename files) mail-buffer)))))
((listp files)
(consult-mu-compose--attach-files files mail-buffer)))
)))
(_
(setq mail-buffer (or
consult-mu-compose-current-draft-buffer
(consult-mu-compose-get-draft-buffer)
(if (version<= mu4e-mu-version "1.12")
(mu4e-compose 'new) (mu4e-compose-new))
))
(cond
((and mail-buffer (buffer-live-p mail-buffer)))
((stringp mail-buffer) (with-current-buffer (if (version<= mu4e-mu-version "1.12")
(mu4e-compose 'new) (mu4e-compose-new))
(save-excursion (message-goto-subject)
(insert mail-buffer)
(rename-buffer mail-buffer t)))
(setq mail-buffer (get-buffer mail-buffer))))
(if (and mail-buffer (buffer-live-p mail-buffer))
(progn
(switch-to-buffer mail-buffer)
(setq consult-mu-compose-current-draft-buffer mail-buffer)
(cond
((and (not (file-directory-p files)) (file-truename files))
(consult-mu-compose--attach-files (file-truename files) mail-buffer))
((and (file-directory-p files) (eq consult-mu-compose-use-dired-attachment 'always))
(progn
(split-window-sensibly)
(with-current-buffer (dired files)
(setq-local dired-mail-buffer mail-buffer)
)))
((and (file-directory-p files) (not (eq consult-mu-compose-use-dired-attachment 'always)))
(progn
(while (file-directory-p files)
(setq files (consult-mu-compose--read-file-attach files)))
(consult-mu-compose--attach-files (file-truename files) mail-buffer)
)
)
((listp files)
(consult-mu-compose--attach-files files mail-buffer))))))))
mail-buffer)
(defun consult-mu-compose-detach (&optional file)
"Remove FILE from email attachments interactively."
(interactive)
(save-mark-and-excursion
(when-let (file (consult-mu-compose--read-file-remove))
(consult-mu-compose--remove-files file)
)
));;; provide `consult-mu-compose' module
(provide 'consult-mu-compose);;; consult-mu-compose.el ends here;;; consult-mu-compose-embark.el --- Emabrk Actions for consult-mu-compose -*- lexical-binding: t -*-
;; Copyright (C) 2021-2023
;; Author: Armin Darvish
;; Maintainer: Armin Darvish
;; Created: 2023
;; Version: 1.0
;; Package-Requires: ((emacs "28.0") (consult "0.34"))
;; Homepage: https://github.com/armindarvish/consult-mu
;; Keywords: convenience, matching, tools, email
;; Homepage: https://github.com/armindarvish/consult-mu
;; SPDX-License-Identifier: GPL-3.0-or-later
;; This file is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published
;; by the Free Software Foundation, either version 3 of the License,
;; or (at your option) any later version.
;;
;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this file. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; This package provides an alternative interactive serach interface for
;; mu and mu4e (see URL `https://djcbsoftware.nl/code/mu/mu4e.html').
;; It uses a consult-based minibuffer completion for searching and
;; selecting, and marking emails, as well as additional utilities for
;; composing emails and more.
;; This package requires mu4e version "1.10.8" or later.
;;; Code:;;; Requirements
(require 'embark)
(require 'consult-mu)
(require 'consult-mu-embark)
(defun consult-mu-compose-embark-attach-file (cand)
"Run `consult-mu-attach-files' on the candidate."
(funcall (apply-partially #'consult-mu-compose-attach cand)))
;;; add consult-mu-attach to embark-file-map
(defun consult-mu-compose-embark-bind-attach-file-key (&optional key)
"Binds `consult-mu-embark-attach-file-key' to `consult-mu-compose-embark-attach-file' in `embark-file-map'.
If KEY is non-nil binds KEY instead of `consult-mu-embark-attach-file-key'."
(if-let ((keyb (or key (kbd consult-mu-embark-attach-file-key))))
(define-key embark-file-map keyb #'consult-mu-compose-embark-attach-file)))
(consult-mu-compose-embark-bind-attach-file-key)
;; change the default action on `consult-mu-contacts category.
(add-to-list 'embark-default-action-overrides '((file . consult-mu-compose--read-file-attach) . consult-mu-compose-attach))
(add-to-list 'embark-default-action-overrides '((file . consult-mu-compose-attach) . consult-mu-compose-attach))
;;; Provide `consult-mu-compose-embark' module
(provide 'consult-mu-compose-embark)
;;; consult-mu-compose-embark.el ends here;;; consult-mu-contacts.el --- Consult Mu4e asynchronously in GNU Emacs -*- lexical-binding: t -*-
;; Copyright (C) 2023 Armin Darvish
;; Author: Armin Darvish
;; Maintainer: Armin Darvish
;; Created: 2023
;; Version: 1.0
;; Package-Requires: ((emacs "28.0") (consult "0.34"))
;; Homepage: https://github.com/armindarvish/consult-mu
;; Keywords: convenience, matching, tools, email
;; Homepage: https://github.com/armindarvish/consult-mu
;; SPDX-License-Identifier: GPL-3.0-or-later
;; This file is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published
;; by the Free Software Foundation, either version 3 of the License,
;; or (at your option) any later version.
;;
;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this file. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; This package provides an alternative interactive serach interface for
;; mu and mu4e (see URL `https://djcbsoftware.nl/code/mu/mu4e.html').
;; It uses a consult-based minibuffer completion for searching and
;; selecting, and marking emails, as well as additional utilities for
;; composing emails and more.
;; This package requires mu4e version "1.10.8" or later.
;;; Code:
(require 'consult-mu);;; Customization Variables
(defcustom consult-mu-contacts-group-by :name
"What field to use to group the results in the minibuffer.
By default it is set to :name. But can be any of:
:name group by contact name
:email group by email of the contact
:domain group by the domain of the contact's email (e.g. domain.com in [email protected])
:user group by the ncontact's user name (e.g. user in [email protected])
"
:group 'consult-mu
:type '(radio (const :name)
(const :email)
(const :domain)
(const :user)))
(defcustom consult-mu-contacts-action #'consult-mu-contacts--list-messages-action
"Which function to use when selecting a contact.
By default it is bound to `consult-mu-contacts--list-messages-action'.
"
:group 'consult-mu
:type '(choice (function :tag "(Default) Show Messages from Contact" #'consult-mu-contacts--list-messages-action)
(function :tag "Insert Email" #'consult-mu-contacts--insert-email-action)
(function :tag "Copy Email to Kill Ring" #'consult-mu-contacts--copy-email-action)
(function :tag "Custom Function")))
(defcustom consult-mu-contacts-ignore-list (list)
"List of Regexps to ignore when searching contacts.
This is useful to filter certain addreses from contacts. For example you can remove no-reply adresses by setting this variable to '((“[email protected]”)).
"
:group 'consult-mu
:type '(repeat :tag "Regexp List" regexp))
(defcustom consult-mu-contacts-ignore-case-fold-search case-fold-search
"Whether to ignore case when matching against `consult-mu-contacts-ignore-list'.
When non-nil, `consult-mu-contacts' performs case *insensitive* match with `consult-mu-contacts-ignore-list' and removes matches from candidates.
By default it is inherited from `case-fold-search'.
"
:group 'consult-mu
:type 'boolean)
;;; Other Variables
(defvar consult-mu-contacts-category 'consult-mu-contacts
"Category symbol for contacts in `consult-mu' package.")
(defvar consult-mu-contacts--override-group nil
"Override grouping in `consult-mu-contacs' based on user input.")
(defvar consult-mu-contacts--history nil
"History variable for `consult-mu-contacts'.")
(defun consult-mu-contacts--list-messages (contact)
"List messages from CONTACT using `consult-mu'."
(let* ((consult-mu-maxnum nil)
(email (plist-get contact :email))
)
(consult-mu (format "contact:%s" email))
))
(defun consult-mu-contacts--list-messages-action (cand)
"Searches the messages from contact candidate, CAND.
This is a wrapper function around `consult-mu-contacts--list-messages'. It parses CAND to extract relevant CONTACT plist and other information and passes them to `consult-mu-contacts--list-messages'.
To use this as the default action for consult-mu-contacts, set `consult-mu-contacts-default-action' to #'consult-mu-contacts--list-messages-action."
(let* ((info (cdr cand))
(contact (plist-get info :contact))
)
(consult-mu-contacts--list-messages contact)
)
)(defun consult-mu-contacts--insert-email (contact)
"insert email of CONTACT at point.
This is useful for inserting email when composing an email to contact."
(let* ((email (plist-get contact :email)))
(insert (concat email "; ")))
)
(defun consult-mu-contacts--insert-email-action (cand)
"inserts the email from contact candidate, CAND.
This is a wrapper function around `consult-mu-contacts--insert-email'. It parses CAND to extract relevant CONTACT plist and other information and passes them to `consult-mu-contacts--insert-email'.
To use this as the default action for consult-mu-contacts, set `consult-mu-contacts-default-action' to #'consult-mu-contacts--insert-email-action."
(let* ((info (cdr cand))
(contact (plist-get info :contact))
)
(consult-mu-contacts--insert-email contact)
)
)(defun consult-mu-contacts--copy-email (contact)
"copy email of CONTACT to kill ring."
(let* ((email (plist-get contact :email)))
(kill-new email))
)
(defun consult-mu-contacts--copy-email-action (cand)
"Copies the email from contact candidate, CAND, to kill ring.
This is a wrapper function around `consult-mu-contacts--copy-email'. It parses CAND to extract relevant CONTACT plist and other information and passes them to `consult-mu-contacts--copy-email'.
To use this as the default action for consult-mu-contacts, set `consult-mu-contacts-default-action' to #'consult-mu-contacts--copy-email-action."
(let* ((info (cdr cand))
(contact (plist-get info :contact))
)
(consult-mu-contacts--copy-email contact)
)
)
(defun consult-mu-contacts--compose-to (contact)
"compose an email to CONTACT using `mu4e-compose-new'."
(let* ((email (plist-get contact :email)))
(mu4e-compose-new email)
))
(defun consult-mu-contacts--compose-to-action (cand)
"Open a new buffer to compose a message to contact candidate, CAND.
This is a wrapper function around `consult-mu-contacts--compose-to'. It parses CAND to extract relevant CONTACT plist and other information and passes them to `consult-mu-contacts--compose-to'.
To use this as the default action for consult-mu-contacts, set `consult-mu-contacts-default-action' to #'consult-mu-contacts--compose-to-action."
(let* ((info (cdr cand))
(contact (plist-get info :contact))
)
(consult-mu-contacts--compose-to contact)
)
)(defun consult-mu-contacts--format-candidate (string input highlight)
"Formats minibuffer candidates for `consult-mu-contacts'.
STRING is the output retrieved from `mu cfind INPUT ...` in the command line.
INPUT is the query from the user.
if HIGHLIGHT is t, input is highlighted with `consult-mu-highlight-match-face' in the minibuffer."
(let* ((query input)
(email (consult-mu--message-extract-email-from-string string))
(name (string-trim (replace-regexp-in-string email "" string nil t nil nil)))
(contact (list :name name :email email))
(match-str (if (stringp input) (consult--split-escaped (car (consult--command-split query))) nil))
(str (format "%s\s\s%s"
(propertize (consult-mu--set-string-width email (floor (* (frame-width) 0.55))) 'face 'consult-mu-sender-face)
(propertize name 'face 'consult-mu-subject-face)
))
(str (propertize str :contact contact :query query))
)
(if (and consult-mu-highlight-matches highlight)
(cond
((listp match-str)
(mapcar (lambda (match) (setq str (consult-mu--highlight-match match str t))) match-str))
((stringp match-str)
(setq str (consult-mu--highlight-match match-str str t))))
str)
(cons str (list :contact contact :query query))))
(defun consult-mu-contacts--add-history ()
"Make a list of emails from current buffer to add to `consult-mu-contacts''s history."
(let ((add (list)))
(pcase major-mode
((or 'mu4e-view-mode 'mu4e-compose-mode 'org-msg-edit-mode 'message-mode)
(mapcar (lambda (item)
(concat "#" (consult-mu--message-extract-email-from-string item)))
(append add
(consult-mu--message-emails-string-to-list (consult-mu--message-get-header-field "from"))
(consult-mu--message-emails-string-to-list (consult-mu--message-get-header-field "to"))
(consult-mu--message-emails-string-to-list (consult-mu--message-get-header-field "cc"))
(consult-mu--message-emails-string-to-list (consult-mu--message-get-header-field "bcc"))
(consult-mu--message-emails-string-to-list (consult-mu--message-get-header-field "reply-to"))
)
))
(_
(list)))))(defun consult-mu-contacts--group-name (cand)
"Gets the group name of CAND using `consult-mu-contacts-group-by'
See `consult-mu-contacts-group-by' for details of grouping options.
"
(let* ((contact (get-text-property 0 :contact cand))
(email (plist-get contact :email))
(name (plist-get contact :name))
(_ (string-match "\\(?1:[a-zA-Z0-9\_\.\+\-]+\\)@\\(?2:[a-zA-Z0-9\-]+\.[a-zA-Z0-9\-\.]+\\)" email))
(user (match-string 1 email))
(domain (match-string 2 email))
(group (or consult-mu-contacts--override-group consult-mu-contacts-group-by))
(field (if (not (keywordp group)) (intern (concat ":" (format "%s" group))) group)))
(pcase field
(:email email)
(:name (if (string-empty-p name) "n/a" name))
(:domain domain)
(:user user)
(_ nil)
)))
(defun consult-mu-contacts--group (cand transform)
"Group function for `consult-mu-contacts''s minibuffer candidates.
This is passed as GROUP to `consult--read' on candidates and is used to group contacts using `consult-mu-contacts--group-name'."
(when-let ((name (consult-mu-contacts--group-name cand)))
(if transform (substring cand) name)
))(defun consult-mu-contacs--lookup ()
"Lookup function for `consult-mu-contacs' minibuffer candidates.
This is passed as LOOKUP to `consult--read' on candidates and is used to format the output when a candidate is selected."
(lambda (sel cands &rest args)
(let* ((info (cdr (assoc sel cands)))
(contact (plist-get info :contact))
(name (plist-get contact :name))
(email (plist-get contact :email))
)
(cons (or name email) info)
)))(defun consult-mu-contatcs--predicate (cand)
"Predicate function for `consult-mu-contacs' minibuffer candidates.
This is passed as Predicate to `consult--read' on candidates and is used to remove contacts matching `consult-mu-contacts-ignore-list' from the list of candidtaes.
note that `consult-mu-contacts-ignore-case-fold-search' is used to define case (in)sensitivity as well."
(let* ((contact (plist-get (cdr cand) :contact))
(email (plist-get contact :email))
(name (plist-get contact :name))
(case-fold-search consult-mu-contacts-ignore-case-fold-search))
(if (seq-empty-p (seq-filter (lambda (reg) (or (string-match-p reg email)
(string-match-p reg name))
) consult-mu-contacts-ignore-list))
t
nil)
))(defun consult-mu-contacts--state ()
"State function for `consult-mu-contacts' candidates.
This is passed as STATE to `consult--read' and is used to preview or do other actions on the candidate."
(lambda (action cand)
(let ((preview (consult--buffer-preview)))
(pcase action
('preview
)
('return
(save-mark-and-excursion
(consult-mu--execute-all-marks)
)
(setq consult-mu-contacts--override-group nil)
cand)
))))
(defun consult-mu-contacts--transform (async builder)
"Adds annotation to minibuffer candiates for `consult-mu-contacts'.
Returns ASYNC function after formating results with `consult-mu-contacts--format-candidate'.
BUILDER is the command line builder function (e.g. `consult-mu-contacts--async-builder')."
(let ((input))
`(lambda (action)
(cond
((stringp action)
(setq input action)
(funcall ,async action)
)
((consp action)
(funcall ,async (mapcar (lambda (string)
(consult-mu-contacts--format-candidate string input t))
action))
)
(t (funcall ,async action))
)
)))(defun consult-mu-contacts--builder (input)
"Build mu command line for searching contacts by INPUT (e.g. `mu cfind INPUT)`."
(pcase-let* ((consult-mu-args (append consult-mu-args '("cfind")))
(cmd (consult--build-args consult-mu-args))
(`(,arg . ,opts) (consult--command-split input))
(flags (append cmd opts)))
(unless (or (member "-n" flags) (member "--maxnum" flags))
(if (and consult-mu-maxnum (> consult-mu-maxnum 0))
(setq opts (append opts (list "--maxnum" (format "%s" consult-mu-maxnum))))))
(if (or (member "-g" opts) (member "--group" opts))
(cond
((member "-g" opts)
(setq consult-mu-contacts--override-group (ignore-errors (intern (nth (+ (cl-position "-g" opts :test 'equal) 1) opts))))
(setq opts (remove "-g" (remove (ignore-errors (nth (+ (cl-position "-g" opts :test 'equal) 1) opts)) opts))))
((member "--group" opts)
(setq consult-mu-contacts--override-group (ignore-errors (intern (nth (+ (cl-position "--group" opts :test 'equal) 1) opts))))
(setq opts (remove "--group" (remove (ignore-errors (nth (+ (cl-position "--group" opts :test 'equal) 1) opts)) opts))))
)
(setq consult-mu-contacts--override-group nil)
)
(pcase-let* ((`(,re . ,hl) (funcall consult--regexp-compiler arg 'pcre t)))
(when re
(cons (append cmd
(list (string-join re " "))
opts)
hl)))))(defun consult-mu-contacts--async (prompt builder &optional initial)
"Query mu4e contacts asynchronously.
This is a non-interactive internal function. For the interactive version see `consult-mu-contacts'.
It runs the command line from `consult-mu-contacts--builder' in an async process and returns the results (list of contacts) as a completion table in minibuffer that will be passed to `consult--read'. The completion table gets dynamically updated as the user types in the minibuffer. Each candidate in the minibuffer is formatted by `consult-mu-contacts--transform' to add annotation and other info to the candidate.
PROMPT is the prompt in the minibuffer (passed as PROMPT to `consult--red'.)
BUILDER is an async builder function passed to `consult--async-command'.
INITIAL is an optional arg for the initial input in the minibuffer. (passed as INITITAL to `consult--read'.)
commandline arguments/options (see `mu cfind --help` in the command line for details) can be passed to the minibuffer input similar to `consult-grep'. For example the user can enter:
`#john -- --maxnum 10'
this will search for contacts with the query \"john\", and retrives a maximum of 10 contacts.
Also, the results can further be narrowed by entering \"#\" similar to `consult-grep'.
For example:
`#john -- --maxnum 10#@gmail'
will retrieve the message as the example above, then narrows down the completion table to candidates that match \"@gmail\".
"
(consult--read
(consult--async-command builder
(consult-mu-contacts--transform builder)
)
:prompt prompt
:lookup (consult-mu-contacs--lookup)
:state (funcall #'consult-mu-contacts--state)
:initial (consult--async-split-initial initial)
:group #'consult-mu-contacts--group
:add-history (consult-mu-contacts--add-history)
:history '(:input consult-mu-contacts--history)
:category 'consult-mu-contacts
:preview-key consult-mu-preview-key
:predicate #'consult-mu-contatcs--predicate
:sort t))
(defun consult-mu-contacts (&optional initial noaction)
"Lists results of `mu cfind` Asynchronously.
This is an interactive wrapper function around `consult-mu-contacts--async'. It queries the user for a search term in the minibuffer, then fetches a list of contacts for the entered search term as a minibuffer completion table for selection. The list of candidates in the completion table are dynamically updated as the user changes the entry.
Upon selection of a candidate either
- the candidate is returned if NOACTION is non-nil
or
- the candidate is passed to `consult-mu-contacts-action' if NOACTION is nil.
Additional commandline arguments can be passed in the minibuffer entry by typing `--` followed by command line arguments.
For example the user can enter:
`#john doe -- -n 10'
this will run a contact search with the query \"john doe\" and changes the search limit to 10.
Also, the results can further be narrowed by entering \"#\" similar to `consult-grep'.
For example:
`#john doe -- -n 10#@gmail'
will retrieve the message as the example above, then narrows down the completion table to candidates that match \"@gmail\".
INITIAL is an optional arg for the initial input in the minibuffer. (passed as INITITAL to `consult-mu-contacts--async').
For more details on consult--async functionalities, see `consult-grep' and the official manual of consult, here: https://github.com/minad/consult.
"
(interactive)
(save-mark-and-excursion
(consult-mu--execute-all-marks)
)
(let* ((sel
(consult-mu-contacts--async (concat "[" (propertize "consult-mu-contacts" 'face 'consult-mu-sender-face) "]" " Search Contacts: ") #'consult-mu-contacts--builder initial)
)
)
(save-mark-and-excursion
(consult-mu--execute-all-marks)
)
(if noaction
sel
(progn
(funcall consult-mu-contacts-action sel)
sel))));;; provide `consult-mu-contacts' module
(provide 'consult-mu-contacts);;; consult-mu-contacts.el ends here;;; consult-mu-contacts-embark.el --- Emabrk Actions for consult-mu-contacts -*- lexical-binding: t -*-
;; Copyright (C) 2021-2023
;; Author: Armin Darvish
;; Maintainer: Armin Darvish
;; Created: 2023
;; Version: 1.0
;; Package-Requires: ((emacs "28.0") (consult "0.34"))
;; Homepage: https://github.com/armindarvish/consult-mu
;; Keywords: convenience, matching, tools, email
;; Homepage: https://github.com/armindarvish/consult-mu
;; SPDX-License-Identifier: GPL-3.0-or-later
;; This file is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published
;; by the Free Software Foundation, either version 3 of the License,
;; or (at your option) any later version.
;;
;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this file. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; This package provides an alternative interactive serach interface for
;; mu and mu4e (see URL `https://djcbsoftware.nl/code/mu/mu4e.html').
;; It uses a consult-based minibuffer completion for searching and
;; selecting, and marking emails, as well as additional utilities for
;; composing emails and more.
;; This package requires mu4e version "1.10.8" or later.
;;; Code:This 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.
;;; Requirements
(require 'embark)
(require 'consult-mu)
(require 'consult-mu-embark)
(defun consult-mu-contacts-embark-insert-email (cand)
"Embark function for inserting contact's email."
(let* ((contact (get-text-property 0 :contact cand))
(email (plist-get contact :email)))
(insert (concat email "; "))))
(defun consult-mu-contacts-embark-kill-email (cand)
"Embark function for copying contact's email."
(let* ((contact (get-text-property 0 :contact cand))
(email (plist-get contact :email)))
(kill-new email)))
(defun consult-mu-contacts-embark-get-alternative (cand)
"Embark function for copying contact's email."
(let* ((contact (get-text-property 0 :contact cand))
(name (string-trim (plist-get contact :name)))
(email (plist-get contact :email))
(user (string-trim (replace-regexp-in-string "@.*" "" email))))
(consult-mu-contacts (cond
((not (string-empty-p name))
name)
((not (string-empty-p user))
user)
((t ""))))))
(defun consult-mu-contacts-embark-compose (cand)
"Embark function for `consult-mu-contacts--compose-to'."
(let* ((contact (get-text-property 0 :contact cand)))
(consult-mu-contacts--compose-to contact)))
(defun consult-mu-contacts-embark-search-messages (cand)
"Embark function for searching messages from CAND using `consult-mu'."
(let* ((contact (get-text-property 0 :contact cand))
(email (plist-get contact :email)))
(consult-mu (concat "from:" email))))
(defun consult-mu-contacts-embark-default-action (cand)
"Run `consult-mu-contacts-action' on the candidate."
(let* ((contact (get-text-property 0 :contact cand))
(query (get-text-property 0 :query cand))
(newcand (cons cand `(:contact ,contact :query ,query))))
(funcall #'consult-mu-contacts--insert-email-action newcand))
)
;;; Define Embark Keymaps
(defvar-keymap consult-mu-embark-contacts-actions-map
:doc "Keymap for consult-mu-embark-contacts"
:parent consult-mu-embark-general-actions-map
"c" #'consult-mu-contacts-embark-compose
"s" #'consult-mu-contacts-embark-search-messages
"i" #'consult-mu-contacts-embark-insert-email
"w" #'consult-mu-contacts-embark-kill-email
"a" #'consult-mu-contacts-embark-get-alternative
)
(add-to-list 'embark-keymap-alist '(consult-mu-contacts . consult-mu-embark-contacts-actions-map))
;; change the default action on `consult-mu-contacts category.
(add-to-list 'embark-default-action-overrides '(consult-mu-contacts . consult-mu-contacts-embark-default-action))
;;; Provide `consult-mu-contacts-embark' module
(provide 'consult-mu-contacts-embark)
;;; consult-mu-contacts-embark.el ends here