fedora-csb-system-manager
1;;; consult-mu-compose.el --- Consult Mu4e asynchronously -*- lexical-binding: t -*-
2
3;; Copyright (C) 2023 Armin Darvish
4
5;; Author: Armin Darvish
6;; Maintainer: Armin Darvish
7;; Created: 2023
8;; Version: 1.0
9;; Package-Requires: ((emacs "28.0") (consult "2.0"))
10;; Homepage: https://github.com/armindarvish/consult-mu
11;; Keywords: convenience, matching, tools, email
12;; Homepage: https://github.com/armindarvish/consult-mu
13
14;; SPDX-License-Identifier: GPL-3.0-or-later
15
16;; This file is free software: you can redistribute it and/or modify
17;; it under the terms of the GNU General Public License as published
18;; by the Free Software Foundation, either version 3 of the License,
19;; or (at your option) any later version.
20;;
21;; This file is distributed in the hope that it will be useful,
22;; but WITHOUT ANY WARRANTY; without even the implied warranty of
23;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
24;; GNU General Public License for more details.
25;;
26;; You should have received a copy of the GNU General Public License
27;; along with this file. If not, see <https://www.gnu.org/licenses/>.
28
29
30;;; Commentary:
31
32;; This package provides an alternative interactive serach interface for
33;; mu and mu4e (see URL `https://djcbsoftware.nl/code/mu/mu4e.html').
34;; It uses a consult-based minibuffer completion for searching and
35;; selecting, and marking emails, as well as additional utilities for
36;; composing emails and more.
37
38;; This package requires mu4e version "1.10.8" or later.
39
40;;; Code:
41
42(require 'consult-mu)
43
44;;; Customization Variables
45(defcustom consult-mu-compose-use-dired-attachment 'in-dired
46 "Use a Dired buffer for multiple file attachment?
47
48If set to \='in-dired uses `dired' buffer and `dired' marks only when inside
49a `dired' buffer. If \='t, a `dired' buffer will be used for selecting attachment files similar to what Doom Emacs does:
50URL `https://github.com/doomemacs/doomemacs/blob/bea81278fd2ecb65db6a63dbcd6db2f52921ee41/modules/email/mu4e/autoload/email.el#L272'.
51
52If \='nil, consult-mu uses minibuffer completion for selection files to
53attach, even if inside a `dired' buffer.
54
55By default this is set to \='in-dired."
56 :group 'consult-mu
57 :type '(choice (const :tag "Only use Dired if inside Dired Buffer" 'in-dired)
58 (const :tag "Always use Dired" t)
59 (const :tag "Never use Dired" nil)))
60
61(defcustom consult-mu-large-file-warning-threshold large-file-warning-threshold
62 "Threshold for size of file to require confirmation for preview.
63
64This is used when selecting files to attach to emails. Files larger than this value in size will require user confirmation before previewing the file. Default value is set by `large-file-warning-threshold'. If nil, no cofnirmation is required."
65 :group 'consult-mu
66 :type '(choice integer (const :tag "Never request confirmation" nil)))
67
68
69(defcustom consult-mu-compose-preview-key consult-mu-preview-key
70 "Preview key for `consult-mu-compose'.
71
72This is similar to `consult-mu-preview-key' but explicitly for
73consult-mu-compose. It is recommended to set this to something other than
74\='any to avoid loading preview buffers for each file."
75 :group 'consult-mu
76 :type '(choice (const :tag "Any key" any)
77 (list :tag "Debounced"
78 (const :debounce)
79 (float :tag "Seconds" 0.1)
80 (const any))
81 (const :tag "No preview" nil)
82 (key :tag "Key")
83 (repeat :tag "List of keys" key)))
84
85(defcustom consult-mu-embark-attach-file-key nil
86 "Embark key binding for interactive file attachement."
87 :group 'consult-mu
88 :type '(choice (key :tag "Key")
89 (const :tag "no key binding" nil)))
90
91(defvar consult-mu-compose-attach-history nil
92 "History variable for file attachment.
93
94It is used in `consult-mu-compose--read-file-attach'.")
95
96(defvar consult-mu-compose-current-draft-buffer nil
97 "Store the buffer that is being edited.")
98
99(defun consult-mu-compose--read-file-attach (&optional initial)
100 "Read files in the minibuffer to attach to an email.
101
102INITIAL is the initial input in the minibuffer."
103 (consult--read (completion-table-in-turn #'completion--embedded-envvar-table
104 #'completion--file-name-table)
105 :prompt "Attach File: "
106 :require-match t
107 :category 'file
108 :initial (or initial default-directory)
109 :lookup (lambda (sel cands &rest args)
110 (file-truename sel))
111 :state (lambda (action cand)
112 (let ((preview (consult--buffer-preview)))
113 (pcase action
114 ('preview
115 (if cand
116 (when (not (file-directory-p cand))
117 (let* ((filename (file-truename cand))
118 (filesize (float
119 (file-attribute-size
120 (file-attributes filename))))
121 (confirm (if (and filename
122 (>= filesize consult-mu-large-file-warning-threshold))
123 (yes-or-no-p (format "File is %s Bytes. Do you really want to preview it?" filesize))
124 t)))
125 (if confirm
126 (funcall preview action
127 (find-file-noselect (file-truename cand))))))))
128 ('return
129 cand))))
130 :preview-key consult-mu-compose-preview-key
131 :add-history (list mu4e-attachment-dir)
132 :history 'consult-mu-compose-attach-history))
133
134(defun consult-mu-compose--read-file-remove (&optional initial)
135 "Select attached files to remove from email.
136
137INITIAL is the initial input in the minibuffer."
138
139 (if-let ((current-files (pcase major-mode
140 ('org-msg-edit-mode
141 (org-msg-get-prop "attachment"))
142 ((or 'mu4e-compose-mode 'message-mode)
143 (goto-char (point-max))
144 (cl-loop while (re-search-backward "<#part.*filename=\"\\(?1:.*\\)\"[[:ascii:][:nonascii:]]*?/part>" nil t)
145 collect (match-string-no-properties 1)))
146 (_
147 (error "Not in a compose message buffer")
148 nil))))
149
150 (consult--read current-files
151 :prompt "Remove File:"
152 :category 'file
153 :state (lambda (action cand)
154 (let ((preview (consult--buffer-preview)))
155 (pcase action
156 ('preview
157 (if cand
158 (when (not (file-directory-p cand))
159 (let* ((filename (file-truename cand))
160 (filesize (float
161 (file-attribute-size
162 (file-attributes filename))))
163 (confirm (if (and filename
164 (>= filesize consult-mu-large-file-warning-threshold))
165 (yes-or-no-p (format "File is %s Bytes. Do you really want to preview it?" filesize))
166 t)))
167 (if confirm
168 (funcall preview action
169 (find-file-noselect (file-truename cand))))))))
170 ('return
171 cand))))
172 :preview-key consult-mu-compose-preview-key
173 :initial initial)
174 (progn
175 (message "No files currently attached!")
176 nil)))
177
178(defun consult-mu-compose-get-draft-buffer ()
179 "Query user to select a mu4e compose draft buffer."
180 (save-excursion
181 (if (and (consult-mu-compose-get-current-buffers)
182 (y-or-n-p "Attach the files to an existing compose buffer? "))
183 (consult--read (consult-mu-compose-get-current-buffers)
184 :prompt "Select Message Buffer: "
185 :require-match nil
186 :category 'consult-mu-messages
187 :preview-key consult-mu-preview-key
188 :lookup (lambda (sel cands &rest args)
189 (or (get-buffer sel) sel))
190 :state (lambda (action cand)
191 (let ((preview (consult--buffer-preview)))
192 (pcase action
193 ('preview
194 (if (and cand (buffer-live-p cand))
195 (funcall preview action
196 cand)))
197 ('return
198 cand))))))))
199
200(defun consult-mu-compose-get-current-buffers ()
201 "Return a list of active compose message buffers."
202 (let (buffers)
203 (save-current-buffer
204 (dolist (buffer (buffer-list t))
205 (set-buffer buffer)
206 (when (or (and (derived-mode-p 'message-mode)
207 (null message-sent-message-via))
208 (derived-mode-p 'org-msg-edit-mode)
209 (derived-mode-p 'mu4e-compose-mode))
210 (push (buffer-name buffer) buffers))))
211 (nreverse buffers)))
212
213(defun consult-mu-compose--attach-files (files &optional mail-buffer &rest _args)
214 "Attach FILES to email in MAIL-BUFFER compose buffer."
215 (let ((files (if (stringp files) (list files) files))
216 (mail-buffer (or mail-buffer (if (version<= mu4e-mu-version "1.12")
217 (mu4e-compose 'new) (mu4e-compose-new)))))
218 (with-current-buffer mail-buffer
219 (pcase major-mode
220 ('org-msg-edit-mode
221 (save-excursion
222 (let* ((new-files (delete-dups (append (org-msg-get-prop "attachment") files))))
223 (org-msg-set-prop "attachment" new-files))
224 (goto-last-change 0)
225 (org-reveal)
226 (consult-mu--pulse-line)))
227 ((or 'mu4e-compose-mode 'message-mode)
228 (save-excursion
229 (dolist (file files)
230 (goto-char (point-max))
231 (unless (eq (current-column) 0)
232 (insert "\n\n")
233 (forward-line 2))
234 (mail-add-attachment (file-truename file))
235 (goto-last-change 0)
236 (forward-line -2)
237 (consult-mu--pulse-line))))
238 (_
239 (error "%s is not a compose buffer" (current-buffer)))))))
240
241(defun consult-mu-compose--remove-files (files &optional mail-buffer &rest _args)
242 "Remove FILES from current attachments in MAIL-BUFFER."
243 (let ((files (if (stringp files) (list files) files))
244 (mail-buffer (or mail-buffer (current-buffer))))
245 (with-current-buffer mail-buffer
246 (save-excursion
247 (pcase major-mode
248 ('org-msg-edit-mode
249 (let ((current-files (org-msg-get-prop "attachment"))
250 (removed-files (list)))
251 (mapcar (lambda (file)
252 (when (member file current-files)
253 (org-msg-set-prop "attachment" (delete-dups (remove file current-files)))
254 (add-to-list 'removed-files file)
255 (setq current-files (org-msg-get-prop "attachment"))
256 (goto-last-change 0)
257 (org-reveal)
258 (consult-mu--pulse-line)))
259 files)
260 (message "file(s) %s detached" (mapconcat 'identity removed-files ","))))
261 ('mu4e-compose-mode
262 (let ((removed-files (list)))
263 (mapcar (lambda (file)
264 (goto-char (point-min))
265 (while (re-search-forward (format "<#part.*filename=\"%s\"[[:ascii:][:nonascii:]]*?/part>" file) nil t)
266 (replace-match "" nil nil)
267 (setq removed-files (append removed-files (list file)))
268 (goto-last-change 0)
269 (consult-mu--pulse-line)
270 (whitespace-cleanup)))
271 files)
272 (message "file(s) %s detached" (mapconcat 'identity removed-files ", ")))))))))
273
274(defun consult-mu-compose-attach (&optional files mail-buffer)
275 "Attach FILES to email in MAIL-BUFFER interactively.
276
277MAIL-BUFFER defaults to `consult-mu-compose-current-draft-buffer'."
278 (interactive)
279 (let* ((consult-mu-compose-current-draft-buffer (cond
280 ((or (derived-mode-p 'mu4e-compose-mode) (derived-mode-p 'org-msg-edit-mode) (derived-mode-p 'message-mode)) (current-buffer))
281 ((derived-mode-p 'dired-mode)
282 (and (bound-and-true-p dired-mail-buffer) (buffer-live-p dired-mail-buffer) dired-mail-buffer))
283 (t
284 consult-mu-compose-current-draft-buffer)))
285 (mail-buffer (or mail-buffer
286 (and (buffer-live-p consult-mu-compose-current-draft-buffer) consult-mu-compose-current-draft-buffer)
287 nil))
288 (files (or files
289 (if (and (derived-mode-p 'dired-mode) consult-mu-compose-use-dired-attachment)
290 (delq nil
291 (mapcar
292 ;; don't attach directories
293 (lambda (f) (if (file-directory-p f)
294 nil
295 f))
296 (nreverse (dired-map-over-marks (dired-get-filename) nil))))
297 (consult-mu-compose--read-file-attach files)))))
298 (pcase major-mode
299 ((or 'mu4e-compose-mode 'org-msg-edit-mode 'message-mode)
300 (setq mail-buffer (current-buffer))
301 (setq consult-mu-compose-current-draft-buffer mail-buffer)
302 (cond
303 ((stringp files)
304 (cond
305 ((and (not (file-directory-p files)) (file-truename files))
306 (consult-mu-compose--attach-files (file-truename files) mail-buffer))
307 ((and (file-directory-p files) (eq consult-mu-compose-use-dired-attachment 'always))
308 (progn
309 (split-window-sensibly)
310 (with-current-buffer (dired files)
311 (setq-local dired-mail-buffer mail-buffer))))
312 ((and (file-directory-p files) (not (eq consult-mu-compose-use-dired-attachment 'always)))
313 (progn
314 (while (file-directory-p files)
315 (setq files (consult-mu-compose--read-file-attach files)))
316 (consult-mu-compose--attach-files (file-truename files) mail-buffer)))))
317 ((listp files)
318 (consult-mu-compose--attach-files files mail-buffer))))
319 ('dired-mode
320 (setq mail-buffer (or (and (bound-and-true-p dired-mail-buffer) (buffer-live-p dired-mail-buffer) dired-mail-buffer)
321 (consult-mu-compose-get-draft-buffer)
322 (if (version<= mu4e-mu-version "1.12")
323 (mu4e-compose 'new) (mu4e-compose-new))))
324
325 (cond
326 ((and mail-buffer (buffer-live-p mail-buffer)))
327 ((stringp mail-buffer) (with-current-buffer (if (version<= mu4e-mu-version "1.12")
328 (mu4e-compose 'new) (mu4e-compose-new))
329 (save-excursion (message-goto-subject)
330 (insert mail-buffer)
331 (rename-buffer mail-buffer t)))
332 (setq mail-buffer (get-buffer mail-buffer))))
333
334 (if (and mail-buffer (buffer-live-p mail-buffer))
335 (progn
336 (setq-local dired-mail-buffer mail-buffer)
337 (switch-to-buffer mail-buffer)
338 (cond
339 ((not files)
340 (message "no files were selected!"))
341 ((stringp files)
342 (cond
343 ((and (file-truename files) (not (file-directory-p files)))
344 (consult-mu-compose--attach-files (file-truename files) mail-buffer))
345 ((and (not consult-mu-compose-use-dired-attachment) (file-directory-p files))
346 (progn
347 (while (file-directory-p files)
348 (setq files (consult-mu-compose--read-file-attach files)))
349 (consult-mu-compose--attach-files (file-truename files) mail-buffer)))))
350 ((listp files)
351 (consult-mu-compose--attach-files files mail-buffer))))))
352 (_
353 (setq mail-buffer (or
354 consult-mu-compose-current-draft-buffer
355 (consult-mu-compose-get-draft-buffer)
356 (if (version<= mu4e-mu-version "1.12")
357 (mu4e-compose 'new) (mu4e-compose-new))))
358 (cond
359 ((and mail-buffer (buffer-live-p mail-buffer)))
360 ((stringp mail-buffer) (with-current-buffer (if (version<= mu4e-mu-version "1.12")
361 (mu4e-compose 'new) (mu4e-compose-new))
362 (save-excursion (message-goto-subject)
363 (insert mail-buffer)
364 (rename-buffer mail-buffer t)))
365 (setq mail-buffer (get-buffer mail-buffer))))
366 (if (and mail-buffer (buffer-live-p mail-buffer))
367 (progn
368 (switch-to-buffer mail-buffer)
369 (setq consult-mu-compose-current-draft-buffer mail-buffer)
370 (cond
371 ((and (not (file-directory-p files)) (file-truename files))
372 (consult-mu-compose--attach-files (file-truename files) mail-buffer))
373 ((and (file-directory-p files) (eq consult-mu-compose-use-dired-attachment 'always))
374 (progn
375 (split-window-sensibly)
376 (with-current-buffer (dired files)
377 (setq-local dired-mail-buffer mail-buffer)
378 )))
379 ((and (file-directory-p files) (not (eq consult-mu-compose-use-dired-attachment 'always)))
380 (progn
381 (while (file-directory-p files)
382 (setq files (consult-mu-compose--read-file-attach files)))
383 (consult-mu-compose--attach-files (file-truename files) mail-buffer)))
384 ((listp files)
385 (consult-mu-compose--attach-files files mail-buffer))))))))
386 mail-buffer)
387
388(defun consult-mu-compose-detach (&optional file)
389 "Remove FILE from email attachments interactively."
390 (interactive)
391 (save-mark-and-excursion
392 (when-let (file (consult-mu-compose--read-file-remove))
393 (consult-mu-compose--remove-files file))))
394
395;;; provide `consult-mu-compose' module
396(provide 'consult-mu-compose)
397
398;;; consult-mu-compose.el ends here