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