39 |
|
|
40 |
;;; Code: |
;;; Code: |
41 |
|
|
42 |
|
(eval-when-compile (require 'mh-acros)) |
|
(require 'mh-utils) |
|
43 |
(mh-require-cl) |
(mh-require-cl) |
44 |
|
(require 'mh-comp) |
|
(eval-when (compile load eval) |
|
|
(defvar mh-comp-loaded nil) |
|
|
(unless mh-comp-loaded |
|
|
(setq mh-comp-loaded t) |
|
|
(require 'mh-comp))) ;Since we do this on sending |
|
45 |
|
|
46 |
(autoload 'mml-insert-tag "mml") |
(autoload 'mml-insert-tag "mml") |
47 |
|
|
48 |
|
(defvar mh-identity-pgg-default-user-id nil |
49 |
|
"Holds the GPG key ID to be used by pgg.el. |
50 |
|
This is normally set as part of an Identity in `mh-identity-list'.") |
51 |
|
(make-variable-buffer-local 'mh-identity-pgg-default-user-id) |
52 |
|
|
53 |
;;;###mh-autoload |
;;;###mh-autoload |
54 |
(defun mh-identity-make-menu () |
(defun mh-identity-make-menu () |
55 |
"Build (or rebuild) the Identity menu (e.g. after the list is modified)." |
"Build the Identity menu. |
56 |
(when (and mh-identity-list (boundp 'mh-letter-mode-map)) |
This should be called any time `mh-identity-list' or `mh-auto-fields-list' |
57 |
(easy-menu-define mh-identity-menu mh-letter-mode-map |
change." |
58 |
"mh-e identity menu" |
(easy-menu-define mh-identity-menu mh-letter-mode-map |
59 |
(append |
"MH-E identity menu" |
60 |
'("Identity") |
(append |
61 |
;; Dynamically render :type corresponding to `mh-identity-list' |
'("Identity") |
62 |
;; e.g.: |
;; Dynamically render :type corresponding to `mh-identity-list' |
63 |
;; ["home" (mh-insert-identity "home") |
;; e.g.: |
64 |
;; :style radio :active (not (equal mh-identity-local "home")) |
;; ["Home" (mh-insert-identity "Home") |
65 |
;; :selected (equal mh-identity-local "home")] |
;; :style radio :active (not (equal mh-identity-local "Home")) |
66 |
'(["Insert Auto Fields" (mh-insert-auto-fields) mh-auto-fields-list] |
;; :selected (equal mh-identity-local "Home")] |
67 |
"--") |
'(["Insert Auto Fields" |
68 |
(mapcar (function |
(mh-insert-auto-fields) mh-auto-fields-list] |
69 |
(lambda (arg) |
"--") |
70 |
`[,arg (mh-insert-identity ,arg) :style radio |
|
71 |
:active (not (equal mh-identity-local ,arg)) |
(mapcar (function |
72 |
:selected (equal mh-identity-local ,arg)])) |
(lambda (arg) |
73 |
(mapcar 'car mh-identity-list)) |
`[,arg (mh-insert-identity ,arg) :style radio |
74 |
'("--" |
:selected (equal mh-identity-local ,arg)])) |
75 |
["none" (mh-insert-identity "none") mh-identity-local] |
(mapcar 'car mh-identity-list)) |
76 |
["Set Default for Session" |
'(["None" |
77 |
(setq mh-identity-default mh-identity-local) t] |
(mh-insert-identity "None") :style radio |
78 |
["Save as Default" |
:selected (not mh-identity-local)] |
79 |
(customize-save-variable |
"--" |
80 |
'mh-identity-default mh-identity-local) t] |
["Set Default for Session" |
81 |
))))) |
(setq mh-identity-default mh-identity-local) t] |
82 |
|
["Save as Default" |
83 |
|
(customize-save-variable 'mh-identity-default mh-identity-local) t] |
84 |
|
["Customize Identities" (customize-variable 'mh-identity-list) t] |
85 |
|
)))) |
86 |
|
|
87 |
;;;###mh-autoload |
;;;###mh-autoload |
88 |
(defun mh-identity-list-set (symbol value) |
(defun mh-identity-list-set (symbol value) |
100 |
(defun mh-header-field-delete (field value-only) |
(defun mh-header-field-delete (field value-only) |
101 |
"Delete FIELD in the mail header, or only its value if VALUE-ONLY is t. |
"Delete FIELD in the mail header, or only its value if VALUE-ONLY is t. |
102 |
Return t if anything is deleted." |
Return t if anything is deleted." |
103 |
(when (mh-goto-header-field field) |
(let ((field-colon (if (string-match "^.*:$" field) |
104 |
(if (not value-only) |
field |
105 |
(beginning-of-line) |
(concat field ":")))) |
106 |
(forward-char)) |
(when (mh-goto-header-field field-colon) |
107 |
(delete-region (point) |
(if (not value-only) |
108 |
(progn (mh-header-field-end) |
(beginning-of-line) |
109 |
(if (not value-only) (forward-char 1)) |
(forward-char)) |
110 |
(point))) |
(delete-region (point) |
111 |
t)) |
(progn (mh-header-field-end) |
112 |
|
(if (not value-only) (forward-char 1)) |
113 |
|
(point))) |
114 |
|
t))) |
115 |
|
|
116 |
(defvar mh-identity-signature-start nil |
(defvar mh-identity-signature-start nil |
117 |
"Marker for the beginning of a signature inserted by `mh-insert-identity'.") |
"Marker for the beginning of a signature inserted by `mh-insert-identity'.") |
118 |
(defvar mh-identity-signature-end nil |
(defvar mh-identity-signature-end nil |
119 |
"Marker for the end of a signature inserted by `mh-insert-identity'.") |
"Marker for the end of a signature inserted by `mh-insert-identity'.") |
120 |
|
|
121 |
|
(defun mh-identity-field-handler (field) |
122 |
|
"Return the handler for a FIELD or nil if none set. |
123 |
|
The field name is downcased. If the FIELD begins with the character |
124 |
|
`:', then it must have a special handler defined in |
125 |
|
`mh-identity-handlers', else return an error since it is not a legal |
126 |
|
message header." |
127 |
|
(or (cdr (assoc (downcase field) mh-identity-handlers)) |
128 |
|
(and (eq (aref field 0) ?:) |
129 |
|
(error (format "Field %s - unknown mh-identity-handler" field))) |
130 |
|
(cdr (assoc "default" mh-identity-handlers)) |
131 |
|
'mh-identity-handler-default)) |
132 |
|
|
133 |
;;;###mh-autoload |
;;;###mh-autoload |
134 |
(defun mh-insert-identity (identity) |
(defun mh-insert-identity (identity) |
135 |
"Insert proper fields for given IDENTITY. |
"Insert proper fields for given IDENTITY. |
138 |
(list (completing-read |
(list (completing-read |
139 |
"Identity: " |
"Identity: " |
140 |
(if mh-identity-local |
(if mh-identity-local |
141 |
(cons '("none") |
(cons '("None") |
142 |
(mapcar 'list (mapcar 'car mh-identity-list))) |
(mapcar 'list (mapcar 'car mh-identity-list))) |
143 |
(mapcar 'list (mapcar 'car mh-identity-list))) |
(mapcar 'list (mapcar 'car mh-identity-list))) |
144 |
nil t))) |
nil t))) |
147 |
(when mh-identity-local |
(when mh-identity-local |
148 |
(let ((pers-list (cadr (assoc mh-identity-local mh-identity-list)))) |
(let ((pers-list (cadr (assoc mh-identity-local mh-identity-list)))) |
149 |
(while pers-list |
(while pers-list |
150 |
(let ((field (concat (caar pers-list) ":"))) |
(let* ((field (caar pers-list)) |
151 |
(cond |
(handler (mh-identity-field-handler field))) |
152 |
((string-equal "signature:" field) |
(funcall handler field 'remove)) |
|
(when (and (boundp 'mh-identity-signature-start) |
|
|
(markerp mh-identity-signature-start)) |
|
|
(goto-char mh-identity-signature-start) |
|
|
(forward-char -1) |
|
|
(delete-region (point) mh-identity-signature-end))) |
|
|
((mh-header-field-delete field nil)))) |
|
153 |
(setq pers-list (cdr pers-list))))) |
(setq pers-list (cdr pers-list))))) |
154 |
;; Then insert the replacement |
;; Then insert the replacement |
155 |
(when (not (equal "none" identity)) |
(when (not (equal "None" identity)) |
156 |
(let ((pers-list (cadr (assoc identity mh-identity-list)))) |
(let ((pers-list (cadr (assoc identity mh-identity-list)))) |
157 |
(while pers-list |
(while pers-list |
158 |
(let ((field (concat (caar pers-list) ":")) |
(let* ((field (caar pers-list)) |
159 |
(value (cdar pers-list))) |
(value (cdar pers-list)) |
160 |
(cond |
(handler (mh-identity-field-handler field))) |
161 |
;; No value, remove field |
(funcall handler field 'add value)) |
|
((or (not value) |
|
|
(string= value "")) |
|
|
(mh-header-field-delete field nil)) |
|
|
;; Existing field, replace |
|
|
((mh-header-field-delete field t) |
|
|
(insert value)) |
|
|
;; Handle "signature" special case. Insert file or call function. |
|
|
((and (string-equal "signature:" field) |
|
|
(or (and (stringp value) |
|
|
(file-readable-p value)) |
|
|
(fboundp value))) |
|
|
(goto-char (point-max)) |
|
|
(if (not (looking-at "^$")) |
|
|
(insert "\n")) |
|
|
(insert "\n") |
|
|
(save-restriction |
|
|
(narrow-to-region (point) (point)) |
|
|
(set (make-local-variable 'mh-identity-signature-start) |
|
|
(make-marker)) |
|
|
(set-marker mh-identity-signature-start (point)) |
|
|
(cond |
|
|
;; If MIME composition done, insert signature at the end as |
|
|
;; an inline MIME part. |
|
|
((mh-mhn-directive-present-p) |
|
|
(insert "#\n" "Content-Description: Signature\n")) |
|
|
((mh-mml-directive-present-p) |
|
|
(mml-insert-tag 'part 'type "text/plain" |
|
|
'disposition "inline" |
|
|
'description "Signature"))) |
|
|
(if (stringp value) |
|
|
(insert-file-contents value) |
|
|
(funcall value)) |
|
|
(goto-char (point-min)) |
|
|
(when (not (re-search-forward "^--" nil t)) |
|
|
(cond ((mh-mhn-directive-present-p) |
|
|
(forward-line 2)) |
|
|
((mh-mml-directive-present-p) |
|
|
(forward-line 1))) |
|
|
(insert "-- \n")) |
|
|
(set (make-local-variable 'mh-identity-signature-end) |
|
|
(make-marker)) |
|
|
(set-marker mh-identity-signature-end (point-max)))) |
|
|
;; Handle "From" field differently, adding it at the beginning. |
|
|
((string-equal "From:" field) |
|
|
(goto-char (point-min)) |
|
|
(insert "From: " value "\n")) |
|
|
;; Skip empty signature (Can't remove what we don't know) |
|
|
((string-equal "signature:" field)) |
|
|
;; Other field, add at end |
|
|
(t ;Otherwise, add the end. |
|
|
(goto-char (point-min)) |
|
|
(mh-goto-header-end 0) |
|
|
(mh-insert-fields field value)))) |
|
162 |
(setq pers-list (cdr pers-list)))))) |
(setq pers-list (cdr pers-list)))))) |
163 |
;; Remember what is in use in this buffer |
;; Remember what is in use in this buffer |
164 |
(if (equal "none" identity) |
(if (equal "None" identity) |
165 |
(setq mh-identity-local nil) |
(setq mh-identity-local nil) |
166 |
(setq mh-identity-local identity))) |
(setq mh-identity-local identity))) |
167 |
|
|
168 |
|
;;;###mh-autoload |
169 |
|
(defun mh-identity-handler-gpg-identity (field action &optional value) |
170 |
|
"For FIELD \"pgg-default-user-id\", process for ACTION 'remove or 'add. |
171 |
|
The buffer-local variable `mh-identity-pgg-default-user-id' is set to VALUE |
172 |
|
when action 'add is selected." |
173 |
|
(cond |
174 |
|
((or (equal action 'remove) |
175 |
|
(not value) |
176 |
|
(string= value "")) |
177 |
|
(setq mh-identity-pgg-default-user-id nil)) |
178 |
|
((equal action 'add) |
179 |
|
(setq mh-identity-pgg-default-user-id value)))) |
180 |
|
|
181 |
|
;;;###mh-autoload |
182 |
|
(defun mh-identity-handler-signature (field action &optional value) |
183 |
|
"For FIELD \"signature\", process headers for ACTION 'remove or 'add. |
184 |
|
The VALUE is added." |
185 |
|
(cond |
186 |
|
((equal action 'remove) |
187 |
|
(when (and (markerp mh-identity-signature-start) |
188 |
|
(markerp mh-identity-signature-end)) |
189 |
|
(delete-region mh-identity-signature-start |
190 |
|
mh-identity-signature-end))) |
191 |
|
(t |
192 |
|
;; Insert "signature". Nil value means to use `mh-signature-file-name'. |
193 |
|
(when (not (mh-signature-separator-p)) ;...unless already present |
194 |
|
(goto-char (point-max)) |
195 |
|
(save-restriction |
196 |
|
(narrow-to-region (point) (point)) |
197 |
|
(if (null value) |
198 |
|
(mh-insert-signature) |
199 |
|
(mh-insert-signature value)) |
200 |
|
(set (make-local-variable 'mh-identity-signature-start) |
201 |
|
(point-min-marker)) |
202 |
|
(set-marker-insertion-type mh-identity-signature-start t) |
203 |
|
(set (make-local-variable 'mh-identity-signature-end) |
204 |
|
(point-max-marker))))))) |
205 |
|
|
206 |
|
(defvar mh-identity-attribution-verb-start nil |
207 |
|
"Marker for the beginning of the attribution verb.") |
208 |
|
(defvar mh-identity-attribution-verb-end nil |
209 |
|
"Marker for the end of the attribution verb.") |
210 |
|
|
211 |
|
;;;###mh-autoload |
212 |
|
(defun mh-identity-handler-attribution-verb (field action &optional value) |
213 |
|
"For FIELD \"attribution_verb\", process headers for ACTION 'remove or 'add. |
214 |
|
The VALUE is added." |
215 |
|
(when (and (markerp mh-identity-attribution-verb-start) |
216 |
|
(markerp mh-identity-attribution-verb-end)) |
217 |
|
(delete-region mh-identity-attribution-verb-start |
218 |
|
mh-identity-attribution-verb-end) |
219 |
|
(goto-char mh-identity-attribution-verb-start) |
220 |
|
(cond |
221 |
|
((equal action 'remove) ; Replace with default |
222 |
|
(mh-identity-insert-attribution-verb nil)) |
223 |
|
(t ; Insert attribution verb. |
224 |
|
(mh-identity-insert-attribution-verb value))))) |
225 |
|
|
226 |
|
;;;###mh-autoload |
227 |
|
(defun mh-identity-insert-attribution-verb (value) |
228 |
|
"Insert VALUE as attribution verb, setting up delimiting markers. |
229 |
|
If VALUE is nil, use `mh-extract-from-attribution-verb'." |
230 |
|
(save-restriction |
231 |
|
(narrow-to-region (point) (point)) |
232 |
|
(if (null value) |
233 |
|
(insert mh-extract-from-attribution-verb) |
234 |
|
(insert value)) |
235 |
|
(set (make-local-variable 'mh-identity-attribution-verb-start) |
236 |
|
(point-min-marker)) |
237 |
|
(set-marker-insertion-type mh-identity-attribution-verb-start t) |
238 |
|
(set (make-local-variable 'mh-identity-attribution-verb-end) |
239 |
|
(point-max-marker)))) |
240 |
|
|
241 |
|
(defun mh-identity-handler-default (field action top &optional value) |
242 |
|
"For FIELD, process mh-identity headers for ACTION 'remove or 'add. |
243 |
|
if TOP is non-nil, add the field and it's VALUE at the top of the header, else |
244 |
|
add it at the bottom of the header." |
245 |
|
(let ((field-colon (if (string-match "^.*:$" field) |
246 |
|
field |
247 |
|
(concat field ":")))) |
248 |
|
(cond |
249 |
|
((equal action 'remove) |
250 |
|
(mh-header-field-delete field-colon nil)) |
251 |
|
(t |
252 |
|
(cond |
253 |
|
;; No value, remove field |
254 |
|
((or (not value) |
255 |
|
(string= value "")) |
256 |
|
(mh-header-field-delete field-colon nil)) |
257 |
|
;; Existing field, replace |
258 |
|
((mh-header-field-delete field-colon t) |
259 |
|
(insert value)) |
260 |
|
;; Other field, add at end or top |
261 |
|
(t |
262 |
|
(goto-char (point-min)) |
263 |
|
(if (not top) |
264 |
|
(mh-goto-header-end 0)) |
265 |
|
(insert field-colon " " value "\n"))))))) |
266 |
|
|
267 |
|
;;;###mh-autoload |
268 |
|
(defun mh-identity-handler-top (field action &optional value) |
269 |
|
"For FIELD, process mh-identity headers for ACTION 'remove or 'add. |
270 |
|
If the field wasn't present, the VALUE is added at the top of the header." |
271 |
|
(mh-identity-handler-default field action t value)) |
272 |
|
|
273 |
|
;;;###mh-autoload |
274 |
|
(defun mh-identity-handler-bottom (field action &optional value) |
275 |
|
"For FIELD, process mh-identity headers for ACTION 'remove or 'add. |
276 |
|
If the field wasn't present, the VALUE is added at the bottom of the header." |
277 |
|
(mh-identity-handler-default field action nil value)) |
278 |
|
|
279 |
(provide 'mh-identity) |
(provide 'mh-identity) |
280 |
|
|
281 |
;;; Local Variables: |
;;; Local Variables: |