Commit | Line | Data |
---|---|---|
924df208 | 1 | ;;; mh-identity.el --- Multiple identify support for MH-E. |
c3d9274a | 2 | |
924df208 | 3 | ;; Copyright (C) 2002, 2003 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 | ||
42 | ||
43 | (require 'cl) | |
44 | ||
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 | |
50 | ||
51 | (autoload 'mml-insert-tag "mml") | |
52 | ||
53 | ;;;###mh-autoload | |
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 | |
58 | "mh-e identity menu" | |
59 | (append | |
60 | '("Identity") | |
61 | ;; Dynamically render :type corresponding to `mh-identity-list' | |
62 | ;; e.g.: | |
63 | ;; ["home" (mh-insert-identity "home") | |
64 | ;; :style radio :active (not (equal mh-identity-local "home")) | |
65 | ;; :selected (equal mh-identity-local "home")] | |
66 | (mapcar (function | |
67 | (lambda (arg) | |
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)) | |
72 | '("--" | |
73 | ["none" (mh-insert-identity "none") mh-identity-local] | |
74 | ["Set Default for Session" | |
75 | (setq mh-identity-default mh-identity-local) t] | |
76 | ["Save as Default" | |
77 | (customize-save-variable | |
78 | 'mh-identity-default mh-identity-local) t] | |
79 | ))))) | |
a1506d29 | 80 | |
c3d9274a BW |
81 | ;;;###mh-autoload |
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 | |
86 | `mh-identity-list'." | |
87 | (set-default symbol value) | |
88 | (mh-identity-make-menu)) | |
89 | ||
90 | (defvar mh-identity-local nil | |
91 | "Buffer-local variable holding the identity currently in use.") | |
92 | (make-variable-buffer-local 'mh-identity-local) | |
93 | ||
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) | |
98 | (if (not value-only) | |
99 | (beginning-of-line) | |
100 | (forward-char)) | |
101 | (delete-region (point) | |
102 | (progn (mh-header-field-end) | |
103 | (if (not value-only) (forward-char 1)) | |
104 | (point))) | |
105 | t)) | |
106 | ||
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'.") | |
111 | ||
112 | ;;;###mh-autoload | |
113 | (defun mh-insert-identity (identity) | |
114 | "Insert proper fields for given IDENTITY. | |
115 | Edit the `mh-identity-list' variable to define identity." | |
116 | (interactive | |
117 | (list (completing-read | |
118 | "Identity: " | |
119 | (if mh-identity-local | |
120 | (cons '("none") | |
121 | (mapcar 'list (mapcar 'car mh-identity-list))) | |
122 | (mapcar 'list (mapcar 'car mh-identity-list))) | |
123 | nil t))) | |
124 | (save-excursion | |
125 | ;;First remove old settings, if any. | |
126 | (when mh-identity-local | |
127 | (let ((pers-list (cadr (assoc mh-identity-local mh-identity-list)))) | |
128 | (while pers-list | |
129 | (let ((field (concat (caar pers-list) ":"))) | |
130 | (cond | |
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) | |
135 | (forward-char -1) | |
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)))) | |
142 | (while pers-list | |
143 | (let ((field (concat (caar pers-list) ":")) | |
144 | (value (cdar pers-list))) | |
145 | (cond | |
146 | ;; No value, remove field | |
147 | ((or (not value) | |
148 | (string= value "")) | |
149 | (mh-header-field-delete field nil)) | |
150 | ;; Existing field, replace | |
151 | ((mh-header-field-delete field t) | |
152 | (insert value)) | |
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)) | |
157 | (fboundp value))) | |
158 | (goto-char (point-max)) | |
159 | (if (not (looking-at "^$")) | |
160 | (insert "\n")) | |
161 | (insert "\n") | |
162 | (save-restriction | |
163 | (narrow-to-region (point) (point)) | |
164 | (set (make-local-variable 'mh-identity-signature-start) | |
165 | (make-marker)) | |
166 | (set-marker mh-identity-signature-start (point)) | |
167 | (cond | |
168 | ;; If MIME composition done, insert signature at the end as | |
169 | ;; an inline MIME part. | |
924df208 | 170 | ((mh-mhn-directive-present-p) |
c3d9274a | 171 | (insert "#\n" "Content-Description: Signature\n")) |
924df208 | 172 | ((mh-mml-directive-present-p) |
c3d9274a BW |
173 | (mml-insert-tag 'part 'type "text/plain" |
174 | 'disposition "inline" | |
175 | 'description "Signature"))) | |
176 | (if (stringp value) | |
177 | (insert-file-contents value) | |
178 | (funcall value)) | |
179 | (goto-char (point-min)) | |
180 | (when (not (re-search-forward "^--" nil t)) | |
924df208 BW |
181 | (cond ((mh-mhn-directive-present-p) |
182 | (forward-line 2)) | |
183 | ((mh-mml-directive-present-p) | |
184 | (forward-line 1))) | |
c3d9274a BW |
185 | (insert "-- \n")) |
186 | (set (make-local-variable 'mh-identity-signature-end) | |
187 | (make-marker)) | |
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))) | |
205 | ||
206 | (provide 'mh-identity) | |
207 | ||
208 | ;;; Local Variables: | |
209 | ;;; indent-tabs-mode: nil | |
210 | ;;; sentence-end-double-space: nil | |
211 | ;;; End: | |
212 | ||
6b61353c | 213 | ;;; arch-tag: 07d66ef6-8726-4ac6-9ecf-e566cd5bfb45 |
c3d9274a | 214 | ;;; mh-identity.el ends here |