Commit | Line | Data |
---|---|---|
c3d9274a BW |
1 | ;;; mh-identity.el --- Multiple Identify support for MH-E. |
2 | ||
3 | ;; Copyright (C) 2002 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., 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 | ||
a1506d29 | 40 | ;; $Id: mh-identity.el,v 1.2 2003/02/03 20:55:30 wohler Exp $ |
c3d9274a BW |
41 | |
42 | ;;; Code: | |
43 | ||
44 | ||
45 | (require 'cl) | |
46 | ||
47 | (eval-when (compile load eval) | |
48 | (defvar mh-comp-loaded nil) | |
49 | (unless mh-comp-loaded | |
50 | (setq mh-comp-loaded t) | |
51 | (require 'mh-comp))) ;Since we do this on sending | |
52 | ||
53 | (autoload 'mml-insert-tag "mml") | |
54 | ||
55 | ;;;###mh-autoload | |
56 | (defun mh-identity-make-menu () | |
57 | "Build (or rebuild) the Identity menu (e.g. after the list is modified)." | |
58 | (when (and mh-identity-list (boundp 'mh-letter-mode-map)) | |
59 | (easy-menu-define mh-identity-menu mh-letter-mode-map | |
60 | "mh-e identity menu" | |
61 | (append | |
62 | '("Identity") | |
63 | ;; Dynamically render :type corresponding to `mh-identity-list' | |
64 | ;; e.g.: | |
65 | ;; ["home" (mh-insert-identity "home") | |
66 | ;; :style radio :active (not (equal mh-identity-local "home")) | |
67 | ;; :selected (equal mh-identity-local "home")] | |
68 | (mapcar (function | |
69 | (lambda (arg) | |
70 | `[,arg (mh-insert-identity ,arg) :style radio | |
71 | :active (not (equal mh-identity-local ,arg)) | |
72 | :selected (equal mh-identity-local ,arg)])) | |
73 | (mapcar 'car mh-identity-list)) | |
74 | '("--" | |
75 | ["none" (mh-insert-identity "none") mh-identity-local] | |
76 | ["Set Default for Session" | |
77 | (setq mh-identity-default mh-identity-local) t] | |
78 | ["Save as Default" | |
79 | (customize-save-variable | |
80 | 'mh-identity-default mh-identity-local) t] | |
81 | ))))) | |
a1506d29 | 82 | |
c3d9274a BW |
83 | ;;;###mh-autoload |
84 | (defun mh-identity-list-set (symbol value) | |
85 | "Update the `mh-identity-list' variable, and rebuild the menu. | |
86 | Sets the default for SYMBOL (e.g. `mh-identity-list') to VALUE (as set in | |
87 | customization). This is called after 'customize is used to alter | |
88 | `mh-identity-list'." | |
89 | (set-default symbol value) | |
90 | (mh-identity-make-menu)) | |
91 | ||
92 | (defvar mh-identity-local nil | |
93 | "Buffer-local variable holding the identity currently in use.") | |
94 | (make-variable-buffer-local 'mh-identity-local) | |
95 | ||
96 | (defun mh-header-field-delete (field value-only) | |
97 | "Delete FIELD in the mail header, or only its value if VALUE-ONLY is t. | |
98 | Return t if anything is deleted." | |
99 | (when (mh-goto-header-field field) | |
100 | (if (not value-only) | |
101 | (beginning-of-line) | |
102 | (forward-char)) | |
103 | (delete-region (point) | |
104 | (progn (mh-header-field-end) | |
105 | (if (not value-only) (forward-char 1)) | |
106 | (point))) | |
107 | t)) | |
108 | ||
109 | (defvar mh-identity-signature-start nil | |
110 | "Marker for the beginning of a signature inserted by `mh-insert-identity'.") | |
111 | (defvar mh-identity-signature-end nil | |
112 | "Marker for the end of a signature inserted by `mh-insert-identity'.") | |
113 | ||
114 | ;;;###mh-autoload | |
115 | (defun mh-insert-identity (identity) | |
116 | "Insert proper fields for given IDENTITY. | |
117 | Edit the `mh-identity-list' variable to define identity." | |
118 | (interactive | |
119 | (list (completing-read | |
120 | "Identity: " | |
121 | (if mh-identity-local | |
122 | (cons '("none") | |
123 | (mapcar 'list (mapcar 'car mh-identity-list))) | |
124 | (mapcar 'list (mapcar 'car mh-identity-list))) | |
125 | nil t))) | |
126 | (save-excursion | |
127 | ;;First remove old settings, if any. | |
128 | (when mh-identity-local | |
129 | (let ((pers-list (cadr (assoc mh-identity-local mh-identity-list)))) | |
130 | (while pers-list | |
131 | (let ((field (concat (caar pers-list) ":"))) | |
132 | (cond | |
133 | ((string-equal "signature:" field) | |
134 | (when (and (boundp 'mh-identity-signature-start) | |
135 | (markerp mh-identity-signature-start)) | |
136 | (goto-char mh-identity-signature-start) | |
137 | (forward-char -1) | |
138 | (delete-region (point) mh-identity-signature-end))) | |
139 | ((mh-header-field-delete field nil)))) | |
140 | (setq pers-list (cdr pers-list))))) | |
141 | ;; Then insert the replacement | |
142 | (when (not (equal "none" identity)) | |
143 | (let ((pers-list (cadr (assoc identity mh-identity-list)))) | |
144 | (while pers-list | |
145 | (let ((field (concat (caar pers-list) ":")) | |
146 | (value (cdar pers-list))) | |
147 | (cond | |
148 | ;; No value, remove field | |
149 | ((or (not value) | |
150 | (string= value "")) | |
151 | (mh-header-field-delete field nil)) | |
152 | ;; Existing field, replace | |
153 | ((mh-header-field-delete field t) | |
154 | (insert value)) | |
155 | ;; Handle "signature" special case. Insert file or call function. | |
156 | ((and (string-equal "signature:" field) | |
157 | (or (and (stringp value) | |
158 | (file-readable-p value)) | |
159 | (fboundp value))) | |
160 | (goto-char (point-max)) | |
161 | (if (not (looking-at "^$")) | |
162 | (insert "\n")) | |
163 | (insert "\n") | |
164 | (save-restriction | |
165 | (narrow-to-region (point) (point)) | |
166 | (set (make-local-variable 'mh-identity-signature-start) | |
167 | (make-marker)) | |
168 | (set-marker mh-identity-signature-start (point)) | |
169 | (cond | |
170 | ;; If MIME composition done, insert signature at the end as | |
171 | ;; an inline MIME part. | |
172 | ((and (boundp 'mh-mhn-compose-insert-flag) | |
173 | mh-mhn-compose-insert-flag) | |
174 | (insert "#\n" "Content-Description: Signature\n")) | |
175 | ((and (boundp 'mh-mml-compose-insert-flag) | |
176 | mh-mml-compose-insert-flag) | |
177 | (mml-insert-tag 'part 'type "text/plain" | |
178 | 'disposition "inline" | |
179 | 'description "Signature"))) | |
180 | (if (stringp value) | |
181 | (insert-file-contents value) | |
182 | (funcall value)) | |
183 | (goto-char (point-min)) | |
184 | (when (not (re-search-forward "^--" nil t)) | |
185 | (if (and (boundp 'mh-mhn-compose-insert-flag) | |
186 | mh-mhn-compose-insert-flag) | |
187 | (forward-line 2)) | |
188 | (if (and (boundp 'mh-mml-compose-insert-flag) | |
189 | mh-mml-compose-insert-flag) | |
190 | (forward-line 1)) | |
191 | (insert "-- \n")) | |
192 | (set (make-local-variable 'mh-identity-signature-end) | |
193 | (make-marker)) | |
194 | (set-marker mh-identity-signature-end (point-max)))) | |
195 | ;; Handle "From" field differently, adding it at the beginning. | |
196 | ((string-equal "From:" field) | |
197 | (goto-char (point-min)) | |
198 | (insert "From: " value "\n")) | |
199 | ;; Skip empty signature (Can't remove what we don't know) | |
200 | ((string-equal "signature:" field)) | |
201 | ;; Other field, add at end | |
202 | (t ;Otherwise, add the end. | |
203 | (goto-char (point-min)) | |
204 | (mh-goto-header-end 0) | |
205 | (mh-insert-fields field value)))) | |
206 | (setq pers-list (cdr pers-list)))))) | |
207 | ;; Remember what is in use in this buffer | |
208 | (if (equal "none" identity) | |
209 | (setq mh-identity-local nil) | |
210 | (setq mh-identity-local identity))) | |
211 | ||
212 | (provide 'mh-identity) | |
213 | ||
214 | ;;; Local Variables: | |
215 | ;;; indent-tabs-mode: nil | |
216 | ;;; sentence-end-double-space: nil | |
217 | ;;; End: | |
218 | ||
219 | ;;; mh-identity.el ends here |