-
-
Notifications
You must be signed in to change notification settings - Fork 3
/
Copy pathconsult-mu-embark.el
243 lines (199 loc) · 10.4 KB
/
consult-mu-embark.el
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
;;; 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 "2.0"))
;; 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)
;;; 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