fedora-csb-system-manager
1;;; consult-mu-embark.el --- Emabrk Actions for consult-mu -*- lexical-binding: t -*-
2
3;; Copyright (C) 2021-2023
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;;; Requirements
43(require 'embark)
44(require 'consult-mu)
45
46;;; Customization Variables
47(defcustom consult-mu-embark-noconfirm-before-execute nil
48 "Should consult-mu-embark skip confirmation when executing marks?"
49 :group 'consult-mu
50 :type 'boolean)
51
52;;; Define Embark Action Functions
53(defun consult-mu-embark-default-action (cand)
54 "Run `consult-mu-action' on the candidate, CAND."
55 (let* ((msg (get-text-property 0 :msg cand))
56 (query (get-text-property 0 :query cand))
57 (type (get-text-property 0 :type cand))
58 (newcand (cons cand `(:msg ,msg :query ,query :type ,type))))
59 (if (equal type :async)
60 (consult-mu--update-headers query t msg :async))
61 (funcall consult-mu-action newcand)))
62
63
64
65(defun consult-mu-embark-reply (cand)
66 "Reply to message in CAND."
67 (let* ((msg (get-text-property 0 :msg cand))
68 (query (get-text-property 0 :query cand))
69 (type (get-text-property 0 :type cand)))
70 (if (equal type :async)
71 (consult-mu--update-headers query t msg :async))
72 (consult-mu--reply msg nil)))
73
74(defun consult-mu-embark-wide-reply (cand)
75 "Reply all for message in CAND."
76 (let* ((msg (get-text-property 0 :msg cand))
77 (query (get-text-property 0 :query cand))
78 (type (get-text-property 0 :type cand)))
79 (if (equal type :async)
80 (consult-mu--update-headers query t msg :async))
81 (consult-mu--reply msg )))
82
83(defun consult-mu-embark-forward (cand)
84 "Forward the message in CAND."
85 (let* ((msg (get-text-property 0 :msg cand))
86 (query (get-text-property 0 :query cand))
87 (type (get-text-property 0 :type cand)))
88 (if (equal type :async)
89 (consult-mu--update-headers query t msg :async))
90 (consult-mu--forward msg)))
91
92(defun consult-mu-embark-kill-message-field (cand)
93 "Get a header field of message in CAND."
94 (let* ((msg (get-text-property 0 :msg cand))
95 (query (get-text-property 0 :query cand))
96 (type (get-text-property 0 :type cand))
97 (msg-id (plist-get msg :message-id)))
98 (if (equal type :async)
99 (consult-mu--update-headers query t msg :async))
100 (with-current-buffer consult-mu-headers-buffer-name
101 (unless (equal (mu4e-message-field-at-point :message-id) msg-id)
102 (mu4e-headers-goto-message-id msg-id))
103 (if (equal (mu4e-message-field-at-point :message-id) msg-id)
104 (progn
105 (mu4e~headers-update-handler msg nil nil))))
106
107 (with-current-buffer consult-mu-view-buffer-name
108 (kill-new (consult-mu--message-get-header-field))
109 (consult-mu--pulse-region (point) (line-end-position)))))
110
111(defun consult-mu-embark-save-attachmnts (cand)
112 "Save attachments of CAND."
113 (let* ((msg (get-text-property 0 :msg cand))
114 (query (get-text-property 0 :query cand))
115 (type (get-text-property 0 :type cand))
116 (msg-id (plist-get msg :message-id)))
117
118 (if (equal type :async)
119 (consult-mu--update-headers query t msg :async))
120
121 (with-current-buffer consult-mu-headers-buffer-name
122 (unless (equal (mu4e-message-field-at-point :message-id) msg-id)
123 (mu4e-headers-goto-message-id msg-id))
124 (if (equal (mu4e-message-field-at-point :message-id) msg-id)
125 (progn
126 (mu4e~headers-update-handler msg nil nil))))
127
128 (with-current-buffer consult-mu-view-buffer-name
129 (goto-char (point-min))
130 (re-search-forward "^\\(Attachment\\|Attachments\\): " nil t)
131 (consult-mu--pulse-region (point) (line-end-position))
132 (mu4e-view-save-attachments t))))
133
134(defun consult-mu-embark-search-messages-from-contact (cand)
135 "Search messages from the same sender as the message in CAND."
136 (let* ((msg (get-text-property 0 :msg cand))
137 (from (car (plist-get msg :from)))
138 (email (plist-get from :email)))
139 (consult-mu (concat "from:" email))))
140
141(defun consult-mu-embark-search-messages-with-subject (cand)
142 "Search all messages for the same subject as the message in CAND."
143 (let* ((msg (get-text-property 0 :msg cand))
144 ;;(subject (replace-regexp-in-string ":\\|#\\|\\.\\|\\+" "" (plist-get msg :subject)))
145 (subject (replace-regexp-in-string ":\\|#\\|\\.\\|\\+\\|\\(\\[.*\\]\\)" "" (format "%s" (plist-get msg :subject)))))
146 (consult-mu (concat "subject:" subject))))
147
148;; macro for defining functions for marks
149(defmacro consult-mu-embark--defun-mark-for (mark)
150 "Define a function mu4e-view-mark-for- MARK."
151 (let ((funcname (intern (format "consult-mu-embark-mark-for-%s" mark)))
152 (docstring (format "Mark the current message for %s." mark)))
153 `(progn
154 (defun ,funcname (cand) ,docstring
155 (let* ((msg (get-text-property 0 :msg cand))
156 (msgid (plist-get msg :message-id))
157 (query (get-text-property 0 :query cand))
158 (buf (get-buffer consult-mu-headers-buffer-name)))
159 (if buf
160 (progn
161 (with-current-buffer buf
162 (if (eq major-mode 'mu4e-headers-mode)
163 (progn
164 (goto-char (point-min))
165 (mu4e-headers-goto-message-id msgid)
166 (if (equal (mu4e-message-field-at-point :message-id) msgid)
167 (mu4e-headers-mark-and-next ',mark)
168 (progn
169 (consult-mu--update-headers query t msg :async)
170 (with-current-buffer buf
171 (goto-char (point-min))
172 (mu4e-headers-goto-message-id msgid)
173 (if (equal (mu4e-message-field-at-point :message-id) msgid)
174 (mu4e-headers-mark-and-next ',mark))))))
175 (progn
176 (consult-mu--update-headers query t msg :async)
177 (with-current-buffer buf
178 (goto-char (point-min))
179 (mu4e-headers-goto-message-id msgid)
180 (if (equal (mu4e-message-field-at-point :message-id) msgid)
181 (mu4e-headers-mark-and-next ',mark)))))))))))))
182
183;; add embark functions for marks
184(defun consult-mu-embark--defun-func-for-marks (marks)
185 "Run the macro `consult-mu-embark--defun-mark-for' on MARKS.
186
187MARKS is a list of marks.
188
189This is useful for creating embark functions for all the `mu4e-marks'
190elements."
191 (mapcar (lambda (mark) (eval `(consult-mu-embark--defun-mark-for ,mark))) marks))
192
193;; use consult-mu-embark--defun-func-for-marks to make a function for each `mu4e-marks' element.
194(consult-mu-embark--defun-func-for-marks (mapcar 'car mu4e-marks))
195
196;;; Define Embark Keymaps
197(defvar-keymap consult-mu-embark-general-actions-map
198 :doc "Keymap for consult-mu-embark"
199 :parent embark-general-map)
200
201(add-to-list 'embark-keymap-alist '(consult-mu . consult-mu-embark-general-actions-map))
202
203
204(defvar-keymap consult-mu-embark-messages-actions-map
205 :doc "Keymap for consult-mu-embark-messages"
206 :parent consult-mu-embark-general-actions-map
207 "r" #'consult-mu-embark-reply
208 "w" #'consult-mu-embark-wide-reply
209 "f" #'consult-mu-embark-forward
210 "?" #'consult-mu-embark-kill-message-field
211 "c" #'consult-mu-embark-search-messages-from-contact
212 "s" #'consult-mu-embark-search-messages-with-subject
213 "S" #'consult-mu-embark-save-attachmnts)
214
215(add-to-list 'embark-keymap-alist '(consult-mu-messages . consult-mu-embark-messages-actions-map))
216
217
218;; add mark keys to `consult-mu-embark-messages-actions-map' keymap
219(defun consult-mu-embark--add-keys-for-marks (marks)
220 "Add a key for each mark in MARKS to embark map.
221
222Adds the keys in `consult-mu-embark-messages-actions-map', and binds the
223combination “m key”, where key is the :char in mark plist in the
224`consult-mu-embark-messages-actions-map' to the function defined by the
225prefix “consult-mu-embark-mark-for-” and mark.
226
227This is useful for adding all `mu4e-marks' to embark key bindings under a
228submenu (called by “m”), for example, the default mark-for-archive mark
229that is bound to r in mu4e buffers can be called in embark by “m r”."
230 (mapcar (lambda (mark)
231 (let* ((key (plist-get (cdr mark) :char))
232 (key (cond ((consp key) (car key)) ((stringp key) key)))
233 (func (intern (concat "consult-mu-embark-mark-for-" (format "%s" (car mark)))))
234 (key (concat "m" key)))
235 (define-key consult-mu-embark-messages-actions-map key func)))
236 marks))
237
238;; add all `mu4e-marks to embark keybindings. See `consult-mu-embark--add-keys-for-marks' above for more details
239(consult-mu-embark--add-keys-for-marks mu4e-marks)
240
241;; change the default action on `consult-mu-messages' category.
242(add-to-list 'embark-default-action-overrides '(consult-mu-messages . consult-mu-embark-default-action))
243
244
245;;; Provide `consult-mu-embark' module
246
247(provide 'consult-mu-embark)
248
249;;; consult-mu-embark.el ends here