Commit | Line | Data |
---|---|---|
dda00b2c | 1 | ;;; mh-identity.el --- multiple identify support for MH-E |
c3d9274a | 2 | |
ba318903 | 3 | ;; Copyright (C) 2002-2014 Free Software Foundation, Inc. |
c3d9274a BW |
4 | |
5 | ;; Author: Peter S. Galbraith <psg@debian.org> | |
6 | ;; Maintainer: Bill Wohler <wohler@newt.com> | |
7 | ;; Keywords: mail | |
8 | ;; See: mh-e.el | |
9 | ||
10 | ;; This file is part of GNU Emacs. | |
11 | ||
5e809f55 | 12 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
c3d9274a | 13 | ;; it under the terms of the GNU General Public License as published by |
5e809f55 GM |
14 | ;; the Free Software Foundation, either version 3 of the License, or |
15 | ;; (at your option) any later version. | |
c3d9274a BW |
16 | |
17 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
18 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
19 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
20 | ;; GNU General Public License for more details. | |
21 | ||
22 | ;; You should have received a copy of the GNU General Public License | |
5e809f55 | 23 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
c3d9274a BW |
24 | |
25 | ;;; Commentary: | |
26 | ||
27 | ;; Multiple identity support for MH-E. | |
dda00b2c BW |
28 | |
29 | ;; Used to easily set different fields such as From and Organization, | |
30 | ;; as well as different signature files. | |
31 | ||
32 | ;; Customize the variable `mh-identity-list' and see the Identity menu | |
33 | ;; in MH-Letter mode. The command `mh-insert-identity' can be used | |
34 | ;; to manually insert an identity. | |
c3d9274a BW |
35 | |
36 | ;;; Change Log: | |
37 | ||
c3d9274a BW |
38 | ;;; Code: |
39 | ||
dda00b2c | 40 | (require 'mh-e) |
c3d9274a BW |
41 | |
42 | (autoload 'mml-insert-tag "mml") | |
43 | ||
f0d73c14 BW |
44 | (defvar mh-identity-pgg-default-user-id nil |
45 | "Holds the GPG key ID to be used by pgg.el. | |
2dcf34f9 BW |
46 | This is normally set as part of an Identity in |
47 | `mh-identity-list'.") | |
f0d73c14 BW |
48 | (make-variable-buffer-local 'mh-identity-pgg-default-user-id) |
49 | ||
dda00b2c BW |
50 | (defvar mh-identity-menu nil |
51 | "The Identity menu.") | |
52 | ||
53 | (defalias 'mh-identity-make-menu-no-autoload 'mh-identity-make-menu) | |
54 | ||
c3d9274a BW |
55 | ;;;###mh-autoload |
56 | (defun mh-identity-make-menu () | |
f0d73c14 | 57 | "Build the Identity menu. |
2dcf34f9 | 58 | This should be called any time `mh-identity-list' or |
dda00b2c BW |
59 | `mh-auto-fields-list' change. |
60 | See `mh-identity-add-menu'." | |
f0d73c14 BW |
61 | (easy-menu-define mh-identity-menu mh-letter-mode-map |
62 | "MH-E identity menu" | |
63 | (append | |
64 | '("Identity") | |
65 | ;; Dynamically render :type corresponding to `mh-identity-list' | |
66 | ;; e.g.: | |
67 | ;; ["Home" (mh-insert-identity "Home") | |
68 | ;; :style radio :active (not (equal mh-identity-local "Home")) | |
69 | ;; :selected (equal mh-identity-local "Home")] | |
70 | '(["Insert Auto Fields" | |
71 | (mh-insert-auto-fields) mh-auto-fields-list] | |
72 | "--") | |
73 | ||
74 | (mapcar (function | |
75 | (lambda (arg) | |
76 | `[,arg (mh-insert-identity ,arg) :style radio | |
77 | :selected (equal mh-identity-local ,arg)])) | |
78 | (mapcar 'car mh-identity-list)) | |
79 | '(["None" | |
80 | (mh-insert-identity "None") :style radio | |
81 | :selected (not mh-identity-local)] | |
82 | "--" | |
83 | ["Set Default for Session" | |
84 | (setq mh-identity-default mh-identity-local) t] | |
85 | ["Save as Default" | |
86 | (customize-save-variable 'mh-identity-default mh-identity-local) t] | |
87 | ["Customize Identities" (customize-variable 'mh-identity-list) t] | |
88 | )))) | |
a1506d29 | 89 | |
c3d9274a | 90 | ;;;###mh-autoload |
dda00b2c BW |
91 | (defun mh-identity-add-menu () |
92 | "Add the current Identity menu. | |
93 | See `mh-identity-make-menu'." | |
94 | (if mh-identity-menu | |
95 | (easy-menu-add mh-identity-menu))) | |
c3d9274a BW |
96 | |
97 | (defvar mh-identity-local nil | |
e495eaec | 98 | "Buffer-local variable that holds the identity currently in use.") |
c3d9274a BW |
99 | (make-variable-buffer-local 'mh-identity-local) |
100 | ||
101 | (defun mh-header-field-delete (field value-only) | |
e495eaec | 102 | "Delete header FIELD, or only its value if VALUE-ONLY is t. |
c3d9274a | 103 | Return t if anything is deleted." |
f0d73c14 BW |
104 | (let ((field-colon (if (string-match "^.*:$" field) |
105 | field | |
106 | (concat field ":")))) | |
107 | (when (mh-goto-header-field field-colon) | |
108 | (if (not value-only) | |
109 | (beginning-of-line) | |
110 | (forward-char)) | |
111 | (delete-region (point) | |
112 | (progn (mh-header-field-end) | |
113 | (if (not value-only) (forward-char 1)) | |
114 | (point))) | |
115 | t))) | |
c3d9274a BW |
116 | |
117 | (defvar mh-identity-signature-start nil | |
118 | "Marker for the beginning of a signature inserted by `mh-insert-identity'.") | |
119 | (defvar mh-identity-signature-end nil | |
120 | "Marker for the end of a signature inserted by `mh-insert-identity'.") | |
121 | ||
f0d73c14 | 122 | (defun mh-identity-field-handler (field) |
e495eaec | 123 | "Return the handler for header FIELD or nil if none set. |
2dcf34f9 | 124 | The field name is downcased. If the FIELD begins with the |
5a4aad03 | 125 | character \":\", then it must have a special handler defined in |
2dcf34f9 BW |
126 | `mh-identity-handlers', else return an error since it is not a |
127 | valid header field." | |
06e7028b | 128 | (or (cdr (mh-assoc-string field mh-identity-handlers t)) |
f0d73c14 | 129 | (and (eq (aref field 0) ?:) |
f9c53c97 | 130 | (error "Field %s not found in `mh-identity-handlers'" field)) |
d103d8b3 | 131 | (cdr (assoc ":default" mh-identity-handlers)) |
f0d73c14 BW |
132 | 'mh-identity-handler-default)) |
133 | ||
c3d9274a | 134 | ;;;###mh-autoload |
dda00b2c | 135 | (defun mh-insert-identity (identity &optional maybe-insert) |
e495eaec | 136 | "Insert fields specified by given IDENTITY. |
dda00b2c BW |
137 | |
138 | In a program, do not insert fields if MAYBE-INSERT is non-nil, | |
139 | `mh-identity-default' is non-nil, and fields have already been | |
140 | inserted. | |
141 | ||
e495eaec | 142 | See `mh-identity-list'." |
c3d9274a BW |
143 | (interactive |
144 | (list (completing-read | |
145 | "Identity: " | |
146 | (if mh-identity-local | |
f0d73c14 | 147 | (cons '("None") |
c3d9274a BW |
148 | (mapcar 'list (mapcar 'car mh-identity-list))) |
149 | (mapcar 'list (mapcar 'car mh-identity-list))) | |
dda00b2c BW |
150 | nil t) |
151 | nil)) | |
152 | ||
153 | (when (or (not maybe-insert) | |
154 | (and (boundp 'mh-identity-default) | |
155 | mh-identity-default | |
156 | (not mh-identity-local))) | |
157 | (save-excursion | |
158 | ;;First remove old settings, if any. | |
159 | (when mh-identity-local | |
160 | (let ((pers-list (cadr (assoc mh-identity-local mh-identity-list)))) | |
161 | (while pers-list | |
162 | (let* ((field (caar pers-list)) | |
163 | (handler (mh-identity-field-handler field))) | |
164 | (funcall handler field 'remove)) | |
165 | (setq pers-list (cdr pers-list))))) | |
166 | ;; Then insert the replacement | |
167 | (when (not (equal "None" identity)) | |
168 | (let ((pers-list (cadr (assoc identity mh-identity-list)))) | |
169 | (while pers-list | |
170 | (let* ((field (caar pers-list)) | |
171 | (value (cdar pers-list)) | |
172 | (handler (mh-identity-field-handler field))) | |
173 | (funcall handler field 'add value)) | |
174 | (setq pers-list (cdr pers-list)))))) | |
175 | ;; Remember what is in use in this buffer | |
176 | (if (equal "None" identity) | |
177 | (setq mh-identity-local nil) | |
178 | (setq mh-identity-local identity)))) | |
c3d9274a | 179 | |
f0d73c14 BW |
180 | ;;;###mh-autoload |
181 | (defun mh-identity-handler-gpg-identity (field action &optional value) | |
e495eaec BW |
182 | "Process header FIELD \":pgg-default-user-id\". |
183 | The ACTION is one of 'remove or 'add. If 'add, the VALUE is added. | |
2dcf34f9 BW |
184 | The buffer-local variable `mh-identity-pgg-default-user-id' is set to |
185 | VALUE when action 'add is selected." | |
f0d73c14 BW |
186 | (cond |
187 | ((or (equal action 'remove) | |
188 | (not value) | |
189 | (string= value "")) | |
190 | (setq mh-identity-pgg-default-user-id nil)) | |
191 | ((equal action 'add) | |
192 | (setq mh-identity-pgg-default-user-id value)))) | |
193 | ||
194 | ;;;###mh-autoload | |
195 | (defun mh-identity-handler-signature (field action &optional value) | |
e495eaec | 196 | "Process header FIELD \":signature\". |
2dcf34f9 BW |
197 | The ACTION is one of 'remove or 'add. If 'add, the VALUE is |
198 | added." | |
f0d73c14 BW |
199 | (cond |
200 | ((equal action 'remove) | |
201 | (when (and (markerp mh-identity-signature-start) | |
202 | (markerp mh-identity-signature-end)) | |
203 | (delete-region mh-identity-signature-start | |
204 | mh-identity-signature-end))) | |
205 | (t | |
206 | ;; Insert "signature". Nil value means to use `mh-signature-file-name'. | |
207 | (when (not (mh-signature-separator-p)) ;...unless already present | |
208 | (goto-char (point-max)) | |
209 | (save-restriction | |
210 | (narrow-to-region (point) (point)) | |
211 | (if (null value) | |
212 | (mh-insert-signature) | |
213 | (mh-insert-signature value)) | |
214 | (set (make-local-variable 'mh-identity-signature-start) | |
215 | (point-min-marker)) | |
216 | (set-marker-insertion-type mh-identity-signature-start t) | |
217 | (set (make-local-variable 'mh-identity-signature-end) | |
218 | (point-max-marker))))))) | |
219 | ||
220 | (defvar mh-identity-attribution-verb-start nil | |
221 | "Marker for the beginning of the attribution verb.") | |
222 | (defvar mh-identity-attribution-verb-end nil | |
223 | "Marker for the end of the attribution verb.") | |
224 | ||
225 | ;;;###mh-autoload | |
226 | (defun mh-identity-handler-attribution-verb (field action &optional value) | |
e495eaec | 227 | "Process header FIELD \":attribution-verb\". |
2dcf34f9 BW |
228 | The ACTION is one of 'remove or 'add. If 'add, the VALUE is |
229 | added." | |
f0d73c14 BW |
230 | (when (and (markerp mh-identity-attribution-verb-start) |
231 | (markerp mh-identity-attribution-verb-end)) | |
232 | (delete-region mh-identity-attribution-verb-start | |
233 | mh-identity-attribution-verb-end) | |
234 | (goto-char mh-identity-attribution-verb-start) | |
235 | (cond | |
236 | ((equal action 'remove) ; Replace with default | |
237 | (mh-identity-insert-attribution-verb nil)) | |
238 | (t ; Insert attribution verb. | |
239 | (mh-identity-insert-attribution-verb value))))) | |
240 | ||
241 | ;;;###mh-autoload | |
242 | (defun mh-identity-insert-attribution-verb (value) | |
243 | "Insert VALUE as attribution verb, setting up delimiting markers. | |
244 | If VALUE is nil, use `mh-extract-from-attribution-verb'." | |
245 | (save-restriction | |
246 | (narrow-to-region (point) (point)) | |
247 | (if (null value) | |
248 | (insert mh-extract-from-attribution-verb) | |
249 | (insert value)) | |
250 | (set (make-local-variable 'mh-identity-attribution-verb-start) | |
251 | (point-min-marker)) | |
252 | (set-marker-insertion-type mh-identity-attribution-verb-start t) | |
253 | (set (make-local-variable 'mh-identity-attribution-verb-end) | |
254 | (point-max-marker)))) | |
255 | ||
256 | (defun mh-identity-handler-default (field action top &optional value) | |
e495eaec | 257 | "Process header FIELD. |
2dcf34f9 BW |
258 | The ACTION is one of 'remove or 'add. If TOP is non-nil, add the |
259 | field and its VALUE at the top of the header, else add it at the | |
260 | bottom of the header. If action is 'add, the VALUE is added." | |
f0d73c14 BW |
261 | (let ((field-colon (if (string-match "^.*:$" field) |
262 | field | |
263 | (concat field ":")))) | |
264 | (cond | |
265 | ((equal action 'remove) | |
266 | (mh-header-field-delete field-colon nil)) | |
267 | (t | |
268 | (cond | |
269 | ;; No value, remove field | |
270 | ((or (not value) | |
271 | (string= value "")) | |
272 | (mh-header-field-delete field-colon nil)) | |
273 | ;; Existing field, replace | |
274 | ((mh-header-field-delete field-colon t) | |
275 | (insert value)) | |
276 | ;; Other field, add at end or top | |
277 | (t | |
278 | (goto-char (point-min)) | |
279 | (if (not top) | |
dda00b2c | 280 | (mh-goto-header-end 0)) |
f0d73c14 BW |
281 | (insert field-colon " " value "\n"))))))) |
282 | ||
283 | ;;;###mh-autoload | |
284 | (defun mh-identity-handler-top (field action &optional value) | |
e495eaec | 285 | "Process header FIELD. |
2dcf34f9 BW |
286 | The ACTION is one of 'remove or 'add. If 'add, the VALUE is |
287 | added. If the field wasn't present, it is added to the top of the | |
288 | header." | |
f0d73c14 BW |
289 | (mh-identity-handler-default field action t value)) |
290 | ||
291 | ;;;###mh-autoload | |
292 | (defun mh-identity-handler-bottom (field action &optional value) | |
e495eaec | 293 | "Process header FIELD. |
2dcf34f9 BW |
294 | The ACTION is one of 'remove or 'add. If 'add, the VALUE is |
295 | added. If the field wasn't present, it is added to the bottom of | |
296 | the header." | |
f0d73c14 BW |
297 | (mh-identity-handler-default field action nil value)) |
298 | ||
c3d9274a BW |
299 | (provide 'mh-identity) |
300 | ||
cee9f5c6 BW |
301 | ;; Local Variables: |
302 | ;; indent-tabs-mode: nil | |
303 | ;; sentence-end-double-space: nil | |
304 | ;; End: | |
c3d9274a BW |
305 | |
306 | ;;; mh-identity.el ends here |