1 ;;; mh-identity.el --- Multiple identify support for MH-E.
3 ;; Copyright (C) 2002, 2003 Free Software Foundation, Inc.
5 ;; Author: Peter S. Galbraith <psg@debian.org>
6 ;; Maintainer: Bill Wohler <wohler@newt.com>
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 2, or (at your option)
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; 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.
29 ;; Multiple identity support for MH-E.
31 ;; Used to easily set different fields such as From and Organization, as
32 ;; well as different signature files.
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.
45 (eval-when (compile load eval
)
46 (defvar mh-comp-loaded nil
)
47 (unless mh-comp-loaded
48 (setq mh-comp-loaded t
)
49 (require 'mh-comp
))) ;Since we do this on sending
51 (autoload 'mml-insert-tag
"mml")
54 (defun mh-identity-make-menu ()
55 "Build (or rebuild) the Identity menu (e.g. after the list is modified)."
56 (when (and mh-identity-list
(boundp 'mh-letter-mode-map
))
57 (easy-menu-define mh-identity-menu mh-letter-mode-map
61 ;; Dynamically render :type corresponding to `mh-identity-list'
63 ;; ["home" (mh-insert-identity "home")
64 ;; :style radio :active (not (equal mh-identity-local "home"))
65 ;; :selected (equal mh-identity-local "home")]
68 `[,arg
(mh-insert-identity ,arg
) :style radio
69 :active
(not (equal mh-identity-local
,arg
))
70 :selected
(equal mh-identity-local
,arg
)]))
71 (mapcar 'car mh-identity-list
))
73 ["none" (mh-insert-identity "none") mh-identity-local
]
74 ["Set Default for Session"
75 (setq mh-identity-default mh-identity-local
) t
]
77 (customize-save-variable
78 'mh-identity-default mh-identity-local
) t
]
82 (defun mh-identity-list-set (symbol value
)
83 "Update the `mh-identity-list' variable, and rebuild the menu.
84 Sets the default for SYMBOL (e.g. `mh-identity-list') to VALUE (as set in
85 customization). This is called after 'customize is used to alter
87 (set-default symbol value
)
88 (mh-identity-make-menu))
90 (defvar mh-identity-local nil
91 "Buffer-local variable holding the identity currently in use.")
92 (make-variable-buffer-local 'mh-identity-local
)
94 (defun mh-header-field-delete (field value-only
)
95 "Delete FIELD in the mail header, or only its value if VALUE-ONLY is t.
96 Return t if anything is deleted."
97 (when (mh-goto-header-field field
)
101 (delete-region (point)
102 (progn (mh-header-field-end)
103 (if (not value-only
) (forward-char 1))
107 (defvar mh-identity-signature-start nil
108 "Marker for the beginning of a signature inserted by `mh-insert-identity'.")
109 (defvar mh-identity-signature-end nil
110 "Marker for the end of a signature inserted by `mh-insert-identity'.")
113 (defun mh-insert-identity (identity)
114 "Insert proper fields for given IDENTITY.
115 Edit the `mh-identity-list' variable to define identity."
117 (list (completing-read
119 (if mh-identity-local
121 (mapcar 'list
(mapcar 'car mh-identity-list
)))
122 (mapcar 'list
(mapcar 'car mh-identity-list
)))
125 ;;First remove old settings, if any.
126 (when mh-identity-local
127 (let ((pers-list (cadr (assoc mh-identity-local mh-identity-list
))))
129 (let ((field (concat (caar pers-list
) ":")))
131 ((string-equal "signature:" field
)
132 (when (and (boundp 'mh-identity-signature-start
)
133 (markerp mh-identity-signature-start
))
134 (goto-char mh-identity-signature-start
)
136 (delete-region (point) mh-identity-signature-end
)))
137 ((mh-header-field-delete field nil
))))
138 (setq pers-list
(cdr pers-list
)))))
139 ;; Then insert the replacement
140 (when (not (equal "none" identity
))
141 (let ((pers-list (cadr (assoc identity mh-identity-list
))))
143 (let ((field (concat (caar pers-list
) ":"))
144 (value (cdar pers-list
)))
146 ;; No value, remove field
149 (mh-header-field-delete field nil
))
150 ;; Existing field, replace
151 ((mh-header-field-delete field t
)
153 ;; Handle "signature" special case. Insert file or call function.
154 ((and (string-equal "signature:" field
)
155 (or (and (stringp value
)
156 (file-readable-p value
))
158 (goto-char (point-max))
159 (if (not (looking-at "^$"))
163 (narrow-to-region (point) (point))
164 (set (make-local-variable 'mh-identity-signature-start
)
166 (set-marker mh-identity-signature-start
(point))
168 ;; If MIME composition done, insert signature at the end as
169 ;; an inline MIME part.
170 ((mh-mhn-directive-present-p)
171 (insert "#\n" "Content-Description: Signature\n"))
172 ((mh-mml-directive-present-p)
173 (mml-insert-tag 'part
'type
"text/plain"
174 'disposition
"inline"
175 'description
"Signature")))
177 (insert-file-contents value
)
179 (goto-char (point-min))
180 (when (not (re-search-forward "^--" nil t
))
181 (cond ((mh-mhn-directive-present-p)
183 ((mh-mml-directive-present-p)
186 (set (make-local-variable 'mh-identity-signature-end
)
188 (set-marker mh-identity-signature-end
(point-max))))
189 ;; Handle "From" field differently, adding it at the beginning.
190 ((string-equal "From:" field
)
191 (goto-char (point-min))
192 (insert "From: " value
"\n"))
193 ;; Skip empty signature (Can't remove what we don't know)
194 ((string-equal "signature:" field
))
195 ;; Other field, add at end
196 (t ;Otherwise, add the end.
197 (goto-char (point-min))
198 (mh-goto-header-end 0)
199 (mh-insert-fields field value
))))
200 (setq pers-list
(cdr pers-list
))))))
201 ;; Remember what is in use in this buffer
202 (if (equal "none" identity
)
203 (setq mh-identity-local nil
)
204 (setq mh-identity-local identity
)))
206 (provide 'mh-identity
)
209 ;;; indent-tabs-mode: nil
210 ;;; sentence-end-double-space: nil
213 ;;; arch-tag: 07d66ef6-8726-4ac6-9ecf-e566cd5bfb45
214 ;;; mh-identity.el ends here