Fix a comment whitespace typo.
[emacs.git] / lisp / mh-e / mh-identity.el
blobecc7f7e54308593302dba3fcf1f7cf1868192ee5
1 ;;; mh-identity.el --- multiple identify support for MH-E
3 ;; Copyright (C) 2002-2017 Free Software Foundation, Inc.
5 ;; Author: Peter S. Galbraith <psg@debian.org>
6 ;; Maintainer: Bill Wohler <wohler@newt.com>
7 ;; Keywords: mail
8 ;; See: mh-e.el
10 ;; This file is part of GNU Emacs.
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 3 of the License, or
15 ;; (at your option) any later version.
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.
22 ;; You should have received a copy of the GNU General Public License
23 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
25 ;;; Commentary:
27 ;; Multiple identity support for MH-E.
29 ;; Used to easily set different fields such as From and Organization,
30 ;; as well as different signature files.
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.
36 ;;; Change Log:
38 ;;; Code:
40 (require 'mh-e)
42 (autoload 'mml-insert-tag "mml")
44 (defvar mh-identity-pgg-default-user-id nil
45 "Holds the GPG key ID to be used by pgg.el.
46 This is normally set as part of an Identity in
47 `mh-identity-list'.")
48 (make-variable-buffer-local 'mh-identity-pgg-default-user-id)
50 (defvar mh-identity-menu nil
51 "The Identity menu.")
53 (defalias 'mh-identity-make-menu-no-autoload 'mh-identity-make-menu)
55 ;;;###mh-autoload
56 (defun mh-identity-make-menu ()
57 "Build the Identity menu.
58 This should be called any time `mh-identity-list' or
59 `mh-auto-fields-list' change.
60 See `mh-identity-add-menu'."
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 "--")
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 ))))
90 ;;;###mh-autoload
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)))
97 (defvar mh-identity-local nil
98 "Buffer-local variable that holds the identity currently in use.")
99 (make-variable-buffer-local 'mh-identity-local)
101 (defun mh-header-field-delete (field value-only)
102 "Delete header FIELD, or only its value if VALUE-ONLY is t.
103 Return t if anything is deleted."
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)))
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'.")
122 (defun mh-identity-field-handler (field)
123 "Return the handler for header FIELD or nil if none set.
124 The field name is downcased. If the FIELD begins with the
125 character \":\", then it must have a special handler defined in
126 `mh-identity-handlers', else return an error since it is not a
127 valid header field."
128 (or (cdr (mh-assoc-string field mh-identity-handlers t))
129 (and (eq (aref field 0) ?:)
130 (error "Field %s not found in `mh-identity-handlers'" field))
131 (cdr (assoc ":default" mh-identity-handlers))
132 'mh-identity-handler-default))
134 ;;;###mh-autoload
135 (defun mh-insert-identity (identity &optional maybe-insert)
136 "Insert fields specified by given IDENTITY.
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.
142 See `mh-identity-list'."
143 (interactive
144 (list (completing-read
145 "Identity: "
146 (if mh-identity-local
147 (cons '("None")
148 (mapcar 'list (mapcar 'car mh-identity-list)))
149 (mapcar 'list (mapcar 'car mh-identity-list)))
150 nil t)
151 nil))
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))))
180 ;;;###mh-autoload
181 (defun mh-identity-handler-gpg-identity (field action &optional value)
182 "Process header FIELD \":pgg-default-user-id\".
183 The ACTION is one of `remove' or `add'. If `add', the VALUE is added.
184 The buffer-local variable `mh-identity-pgg-default-user-id' is set to
185 VALUE when action `add' is selected."
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))))
194 ;;;###mh-autoload
195 (defun mh-identity-handler-signature (field action &optional value)
196 "Process header FIELD \":signature\".
197 The ACTION is one of `remove' or `add'. If `add', the VALUE is
198 added."
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)))
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)))))))
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.")
225 ;;;###mh-autoload
226 (defun mh-identity-handler-attribution-verb (field action &optional value)
227 "Process header FIELD \":attribution-verb\".
228 The ACTION is one of `remove' or `add'. If `add', the VALUE is
229 added."
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)))))
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))))
256 (defun mh-identity-handler-default (field action top &optional value)
257 "Process header FIELD.
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."
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))
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
278 (goto-char (point-min))
279 (if (not top)
280 (mh-goto-header-end 0))
281 (insert field-colon " " value "\n")))))))
283 ;;;###mh-autoload
284 (defun mh-identity-handler-top (field action &optional value)
285 "Process header FIELD.
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."
289 (mh-identity-handler-default field action t value))
291 ;;;###mh-autoload
292 (defun mh-identity-handler-bottom (field action &optional value)
293 "Process header FIELD.
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."
297 (mh-identity-handler-default field action nil value))
299 (provide 'mh-identity)
301 ;; Local Variables:
302 ;; indent-tabs-mode: nil
303 ;; sentence-end-double-space: nil
304 ;; End:
306 ;;; mh-identity.el ends here