1;;; mh-identity.el --- multiple identify support for MH-E
2
3;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
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., 51 Franklin Street, Fifth Floor,
25;; Boston, MA 02110-1301, 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,
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.
37
38;;; Change Log:
39
40;;; Code:
41
42(require 'mh-e)
43
44(autoload 'mml-insert-tag "mml")
45
46(defvar mh-identity-pgg-default-user-id nil
47  "Holds the GPG key ID to be used by pgg.el.
48This is normally set as part of an Identity in
49`mh-identity-list'.")
50(make-variable-buffer-local 'mh-identity-pgg-default-user-id)
51
52(defvar mh-identity-menu nil
53  "The Identity menu.")
54
55(defalias 'mh-identity-make-menu-no-autoload 'mh-identity-make-menu)
56
57;;;###mh-autoload
58(defun mh-identity-make-menu ()
59  "Build the Identity menu.
60This should be called any time `mh-identity-list' or
61`mh-auto-fields-list' change.
62See `mh-identity-add-menu'."
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       ))))
91
92;;;###mh-autoload
93(defun mh-identity-add-menu ()
94  "Add the current Identity menu.
95See `mh-identity-make-menu'."
96  (if mh-identity-menu
97      (easy-menu-add mh-identity-menu)))
98
99(defvar mh-identity-local nil
100  "Buffer-local variable that holds the identity currently in use.")
101(make-variable-buffer-local 'mh-identity-local)
102
103(defun mh-header-field-delete (field value-only)
104  "Delete header FIELD, or only its value if VALUE-ONLY is t.
105Return t if anything is deleted."
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)))
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
124(defun mh-identity-field-handler (field)
125  "Return the handler for header FIELD or nil if none set.
126The field name is downcased. If the FIELD begins with the
127character \":\", then it must have a special handler defined in
128`mh-identity-handlers', else return an error since it is not a
129valid header field."
130  (or (cdr (mh-assoc-string field mh-identity-handlers t))
131      (and (eq (aref field 0) ?:)
132           (error "Field %s not found in `mh-identity-handlers'" field))
133      (cdr (assoc ":default" mh-identity-handlers))
134      'mh-identity-handler-default))
135
136;;;###mh-autoload
137(defun mh-insert-identity (identity &optional maybe-insert)
138  "Insert fields specified by given IDENTITY.
139
140In a program, do not insert fields if MAYBE-INSERT is non-nil,
141`mh-identity-default' is non-nil, and fields have already been
142inserted.
143
144See `mh-identity-list'."
145  (interactive
146   (list (completing-read
147          "Identity: "
148          (if mh-identity-local
149              (cons '("None")
150                    (mapcar 'list (mapcar 'car mh-identity-list)))
151            (mapcar 'list (mapcar 'car mh-identity-list)))
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))))
181
182;;;###mh-autoload
183(defun mh-identity-handler-gpg-identity (field action &optional value)
184  "Process header FIELD \":pgg-default-user-id\".
185The ACTION is one of 'remove or 'add. If 'add, the VALUE is added.
186The buffer-local variable `mh-identity-pgg-default-user-id' is set to
187VALUE when action 'add is selected."
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)
198  "Process header FIELD \":signature\".
199The ACTION is one of 'remove or 'add. If 'add, the VALUE is
200added."
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)
229  "Process header FIELD \":attribution-verb\".
230The ACTION is one of 'remove or 'add. If 'add, the VALUE is
231added."
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.
246If 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)
259  "Process header FIELD.
260The ACTION is one of 'remove or 'add. If TOP is non-nil, add the
261field and its VALUE at the top of the header, else add it at the
262bottom of the header. If action is 'add, the VALUE is added."
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)
282            (mh-goto-header-end 0))
283        (insert field-colon " " value "\n")))))))
284
285;;;###mh-autoload
286(defun mh-identity-handler-top (field action &optional value)
287  "Process header FIELD.
288The ACTION is one of 'remove or 'add. If 'add, the VALUE is
289added. If the field wasn't present, it is added to the top of the
290header."
291  (mh-identity-handler-default field action t value))
292
293;;;###mh-autoload
294(defun mh-identity-handler-bottom (field action &optional value)
295  "Process header FIELD.
296The ACTION is one of 'remove or 'add. If 'add, the VALUE is
297added. If the field wasn't present, it is added to the bottom of
298the header."
299  (mh-identity-handler-default field action nil value))
300
301(provide 'mh-identity)
302
303;; Local Variables:
304;; indent-tabs-mode: nil
305;; sentence-end-double-space: nil
306;; End:
307
308;; arch-tag: 07d66ef6-8726-4ac6-9ecf-e566cd5bfb45
309;;; mh-identity.el ends here
310