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