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