|
4
|
1 ;;; tm-edit.el --- Simple MIME Composer for GNU Emacs
|
|
|
2
|
|
70
|
3 ;; Copyright (C) 1993 .. 1996 Free Software Foundation, Inc.
|
|
4
|
4
|
|
|
5 ;; Author: UMEDA Masanobu <umerin@mse.kyutech.ac.jp>
|
|
|
6 ;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
|
|
|
7 ;; Maintainer: MORIOKA Tomohiko <morioka@jaist.ac.jp>
|
|
|
8 ;; Created: 1994/08/21 renamed from mime.el
|
|
80
|
9 ;; Version: $Revision: 1.4 $
|
|
4
|
10 ;; Keywords: mail, news, MIME, multimedia, multilingual
|
|
|
11
|
|
|
12 ;; This file is part of tm (Tools for MIME).
|
|
|
13
|
|
|
14 ;; This program is free software; you can redistribute it and/or
|
|
|
15 ;; modify it under the terms of the GNU General Public License as
|
|
|
16 ;; published by the Free Software Foundation; either version 2, or (at
|
|
|
17 ;; your option) any later version.
|
|
|
18
|
|
|
19 ;; This program is distributed in the hope that it will be useful, but
|
|
|
20 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
|
22 ;; General Public License for more details.
|
|
|
23
|
|
|
24 ;; You should have received a copy of the GNU General Public License
|
|
|
25 ;; along with GNU Emacs; see the file COPYING. If not, write to the
|
|
|
26 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
|
|
27 ;; Boston, MA 02111-1307, USA.
|
|
|
28
|
|
|
29 ;;; Commentary:
|
|
|
30
|
|
|
31 ;; This is an Emacs minor mode for editing Internet multimedia
|
|
74
|
32 ;; messages formatted in MIME (RFC 2045, 2046, 2047, 2048 and 2049).
|
|
|
33 ;; All messages in this mode are composed in the tagged MIME format,
|
|
|
34 ;; that are described in the following examples. The messages
|
|
|
35 ;; composed in the tagged MIME format are automatically translated
|
|
|
36 ;; into a MIME compliant message when exiting the mode.
|
|
4
|
37
|
|
|
38 ;; Mule (a multilingual extension to Emacs 18 and 19) has a capability
|
|
|
39 ;; of handling multilingual text in limited ISO-2022 manner that is
|
|
|
40 ;; based on early experiences in Japanese Internet community and
|
|
74
|
41 ;; resulted in RFC 1468 (ISO-2022-JP charset for MIME). In order to
|
|
4
|
42 ;; enable multilingual capability in single text message in MIME,
|
|
|
43 ;; charset of multilingual text written in Mule is declared as either
|
|
74
|
44 ;; `ISO-2022-JP-2' [RFC 1554] or `ISO-2022-INT-1'. Mule is required
|
|
70
|
45 ;; for reading the such messages.
|
|
4
|
46
|
|
|
47 ;; This MIME composer can work with Mail mode, mh-e letter Mode, and
|
|
|
48 ;; News mode. First of all, you need the following autoload
|
|
|
49 ;; definition to load mime/editor-mode automatically:
|
|
|
50 ;;
|
|
|
51 ;; (autoload 'mime/editor-mode "tm-edit"
|
|
|
52 ;; "Minor mode for editing MIME message." t)
|
|
|
53 ;;
|
|
|
54 ;; In case of Mail mode (includes VM mode), you need the following
|
|
|
55 ;; hook definition:
|
|
|
56 ;;
|
|
|
57 ;; (add-hook 'mail-mode-hook 'mime/editor-mode)
|
|
|
58 ;; (add-hook 'mail-send-hook 'mime-editor/maybe-translate)
|
|
|
59 ;;
|
|
|
60 ;; In case of MH-E, you need the following hook definition:
|
|
|
61 ;;
|
|
|
62 ;; (add-hook 'mh-letter-mode-hook
|
|
|
63 ;; (function
|
|
|
64 ;; (lambda ()
|
|
|
65 ;; (mime/editor-mode)
|
|
|
66 ;; (make-local-variable 'mail-header-separator)
|
|
|
67 ;; (setq mail-header-separator "--------")
|
|
|
68 ;; ))))
|
|
|
69 ;; (add-hook 'mh-before-send-letter-hook 'mime-editor/maybe-translate)
|
|
|
70 ;;
|
|
|
71 ;; In case of News mode, you need the following hook definition:
|
|
|
72 ;;
|
|
|
73 ;; (add-hook 'news-reply-mode-hook 'mime/editor-mode)
|
|
|
74 ;; (add-hook 'news-inews-hook 'mime-editor/maybe-translate)
|
|
|
75 ;;
|
|
|
76 ;; In case of Emacs 19, it is possible to emphasize the message tags
|
|
|
77 ;; using font-lock mode as follows:
|
|
|
78 ;;
|
|
|
79 ;; (add-hook 'mime/editor-mode-hook
|
|
|
80 ;; (function
|
|
|
81 ;; (lambda ()
|
|
|
82 ;; (font-lock-mode 1)
|
|
|
83 ;; (setq font-lock-keywords (list mime-editor/tag-regexp))
|
|
|
84 ;; ))))
|
|
|
85
|
|
|
86 ;; The message tag looks like:
|
|
|
87 ;;
|
|
|
88 ;; --[[TYPE/SUBTYPE;PARAMETERS][ENCODING]]
|
|
|
89 ;;
|
|
|
90 ;; The tagged MIME message examples:
|
|
|
91 ;;
|
|
|
92 ;; This is a conventional plain text. It should be translated into
|
|
|
93 ;; text/plain.
|
|
|
94 ;;
|
|
|
95 ;;--[[text/plain]]
|
|
|
96 ;; This is also a plain text. But, it is explicitly specified as is.
|
|
|
97 ;;
|
|
70
|
98 ;;--[[text/plain; charset=ISO-2022-JP]]
|
|
|
99 ;;
|
|
|
100 ;;--[[text/richtext]]
|
|
4
|
101 ;; <center>This is a richtext.</center>
|
|
|
102 ;;
|
|
|
103 ;;--[[image/gif][base64]]^M...image encoded in base64 comes here...
|
|
|
104 ;;
|
|
|
105 ;;--[[audio/basic][base64]]^M...audio encoded in base64 comes here...
|
|
|
106
|
|
|
107 ;;; Code:
|
|
|
108
|
|
|
109 (require 'sendmail)
|
|
|
110 (require 'mail-utils)
|
|
|
111 (require 'mel)
|
|
|
112 (require 'tl-list)
|
|
|
113 (require 'tm-view)
|
|
|
114 (require 'tm-ew-e)
|
|
|
115 (require 'signature)
|
|
|
116
|
|
|
117
|
|
|
118 ;;; @ version
|
|
|
119 ;;;
|
|
|
120
|
|
|
121 (defconst mime-editor/RCS-ID
|
|
80
|
122 "$Id: tm-edit.el,v 1.4 1997/01/11 20:14:11 steve Exp $")
|
|
4
|
123
|
|
|
124 (defconst mime-editor/version (get-version-string mime-editor/RCS-ID))
|
|
|
125
|
|
|
126 (defconst mime-editor/version-name
|
|
|
127 (concat "tm-edit " mime-editor/version))
|
|
|
128
|
|
|
129
|
|
|
130 ;;; @ variables
|
|
|
131 ;;;
|
|
|
132
|
|
|
133 (defvar mime-prefix "\C-c\C-x"
|
|
|
134 "*Keymap prefix for MIME commands.")
|
|
|
135
|
|
|
136 (defvar mime-ignore-preceding-spaces nil
|
|
|
137 "*Ignore preceding white spaces if non-nil.")
|
|
|
138
|
|
|
139 (defvar mime-ignore-trailing-spaces nil
|
|
|
140 "*Ignore trailing white spaces if non-nil.")
|
|
|
141
|
|
|
142 (defvar mime-ignore-same-text-tag t
|
|
|
143 "*Ignore preceding text content-type tag that is same with new one.
|
|
|
144 If non-nil, the text tag is not inserted unless something different.")
|
|
|
145
|
|
|
146 (defvar mime-auto-hide-body t
|
|
|
147 "*Hide non-textual body encoded in base64 after insertion if non-nil.")
|
|
|
148
|
|
|
149 (defvar mime-editor/voice-recorder
|
|
|
150 (function mime-editor/voice-recorder-for-sun)
|
|
|
151 "*Function to record a voice message and encode it. [tm-edit.el]")
|
|
|
152
|
|
|
153 (defvar mime/editor-mode-hook nil
|
|
|
154 "*Hook called when enter MIME mode.")
|
|
|
155
|
|
|
156 (defvar mime-editor/translate-hook nil
|
|
|
157 "*Hook called before translating into a MIME compliant message.
|
|
|
158 To insert a signature file automatically, call the function
|
|
|
159 `mime-editor/insert-signature' from this hook.")
|
|
|
160
|
|
|
161 (defvar mime-editor/exit-hook nil
|
|
|
162 "*Hook called when exit MIME mode.")
|
|
|
163
|
|
|
164 (defvar mime-content-types
|
|
|
165 '(("text"
|
|
|
166 ;; Charset parameter need not to be specified, since it is
|
|
|
167 ;; defined automatically while translation.
|
|
|
168 ("plain"
|
|
|
169 ;;("charset" "" "ISO-2022-JP" "US-ASCII" "ISO-8859-1" "ISO-8859-8")
|
|
|
170 )
|
|
|
171 ("richtext"
|
|
|
172 ;;("charset" "" "ISO-2022-JP" "US-ASCII" "ISO-8859-1" "ISO-8859-8")
|
|
|
173 )
|
|
|
174 ("enriched"
|
|
|
175 ;;("charset" "" "ISO-2022-JP" "US-ASCII" "ISO-8859-1" "ISO-8859-8")
|
|
|
176 )
|
|
|
177 ("x-latex"
|
|
|
178 ;;("charset" "" "ISO-2022-JP" "US-ASCII" "ISO-8859-1" "ISO-8859-8")
|
|
|
179 )
|
|
|
180 ("html"
|
|
|
181 ;;("charset" "" "ISO-2022-JP" "US-ASCII" "ISO-8859-1" "ISO-8859-8")
|
|
|
182 )
|
|
|
183 ("x-rot13-47")
|
|
|
184 )
|
|
|
185 ("message"
|
|
|
186 ("external-body"
|
|
|
187 ("access-type"
|
|
|
188 ("anon-ftp"
|
|
|
189 ("site" "ftp.jaist.ac.jp" "wnoc-fuk.wide.ad.jp" "nic.karrn.ad.jp")
|
|
|
190 ("directory" "/pub/GNU/elisp/mime")
|
|
|
191 ("name")
|
|
|
192 ("mode" "image" "ascii" "local8"))
|
|
|
193 ("ftp"
|
|
|
194 ("site")
|
|
|
195 ("directory")
|
|
|
196 ("name")
|
|
|
197 ("mode" "image" "ascii" "local8"))
|
|
|
198 ("tftp" ("site") ("name"))
|
|
|
199 ("afs" ("site") ("name"))
|
|
|
200 ("local-file" ("site") ("name"))
|
|
|
201 ("mail-server" ("server" "ftpmail@nic.karrn.ad.jp"))
|
|
|
202 ))
|
|
|
203 ("rfc822")
|
|
|
204 )
|
|
|
205 ("application"
|
|
|
206 ("octet-stream" ("type" "" "tar" "shar"))
|
|
|
207 ("postscript")
|
|
|
208 ("x-kiss" ("x-cnf")))
|
|
|
209 ("image"
|
|
|
210 ("gif")
|
|
|
211 ("jpeg")
|
|
|
212 ("tiff")
|
|
|
213 ("x-pic")
|
|
|
214 ("x-mag")
|
|
|
215 ("x-xwd")
|
|
|
216 ("x-xbm")
|
|
|
217 )
|
|
|
218 ("audio" ("basic"))
|
|
|
219 ("video" ("mpeg"))
|
|
|
220 )
|
|
|
221 "*Alist of content-type, subtype, parameters and its values.")
|
|
|
222
|
|
|
223 (defvar mime-file-types
|
|
|
224 '(("\\.rtf$"
|
|
|
225 "text" "richtext" nil
|
|
|
226 nil
|
|
|
227 nil nil)
|
|
|
228 ("\\.html$"
|
|
|
229 "text" "html" nil
|
|
|
230 nil
|
|
|
231 nil nil)
|
|
|
232 ("\\.ps$"
|
|
|
233 "application" "postscript" nil
|
|
|
234 "quoted-printable"
|
|
|
235 "attachment" (("filename" . file))
|
|
|
236 )
|
|
|
237 ("\\.jpg$"
|
|
|
238 "image" "jpeg" nil
|
|
|
239 "base64"
|
|
|
240 "inline" (("filename" . file))
|
|
|
241 )
|
|
|
242 ("\\.gif$"
|
|
|
243 "image" "gif" nil
|
|
|
244 "base64"
|
|
|
245 "inline" (("filename" . file))
|
|
|
246 )
|
|
|
247 ("\\.tiff$"
|
|
|
248 "image" "tiff" nil
|
|
|
249 "base64"
|
|
|
250 "inline" (("filename" . file))
|
|
|
251 )
|
|
|
252 ("\\.pic$"
|
|
|
253 "image" "x-pic" nil
|
|
|
254 "base64"
|
|
|
255 "inline" (("filename" . file))
|
|
|
256 )
|
|
|
257 ("\\.mag$"
|
|
|
258 "image" "x-mag" nil
|
|
|
259 "base64"
|
|
|
260 "inline" (("filename" . file))
|
|
|
261 )
|
|
|
262 ("\\.xbm$"
|
|
|
263 "image" "x-xbm" nil
|
|
|
264 "base64"
|
|
|
265 "inline" (("filename" . file))
|
|
|
266 )
|
|
|
267 ("\\.xwd$"
|
|
|
268 "image" "x-xwd" nil
|
|
|
269 "base64"
|
|
|
270 "inline" (("filename" . file))
|
|
|
271 )
|
|
|
272 ("\\.au$"
|
|
|
273 "audio" "basic" nil
|
|
|
274 "base64"
|
|
|
275 "attachment" (("filename" . file))
|
|
|
276 )
|
|
|
277 ("\\.mpg$"
|
|
|
278 "video" "mpeg" nil
|
|
|
279 "base64"
|
|
|
280 "attachment" (("filename" . file))
|
|
|
281 )
|
|
|
282 ("\\.el$"
|
|
|
283 "application" "octet-stream" (("type" . "emacs-lisp"))
|
|
|
284 "7bit"
|
|
|
285 "attachment" (("filename" . file))
|
|
|
286 )
|
|
|
287 ("\\.lsp$"
|
|
|
288 "application" "octet-stream" (("type" . "common-lisp"))
|
|
|
289 "7bit"
|
|
|
290 "attachment" (("filename" . file))
|
|
|
291 )
|
|
|
292 ("\\.tar\\.gz$"
|
|
|
293 "application" "octet-stream" (("type" . "tar+gzip"))
|
|
76
|
294 "base64"
|
|
4
|
295 "attachment" (("filename" . file))
|
|
|
296 )
|
|
|
297 ("\\.tgz$"
|
|
|
298 "application" "octet-stream" (("type" . "tar+gzip"))
|
|
76
|
299 "base64"
|
|
4
|
300 "attachment" (("filename" . file))
|
|
|
301 )
|
|
|
302 ("\\.tar\\.Z$"
|
|
|
303 "application" "octet-stream" (("type" . "tar+compress"))
|
|
76
|
304 "base64"
|
|
4
|
305 "attachment" (("filename" . file))
|
|
|
306 )
|
|
|
307 ("\\.taz$"
|
|
|
308 "application" "octet-stream" (("type" . "tar+compress"))
|
|
76
|
309 "base64"
|
|
4
|
310 "attachment" (("filename" . file))
|
|
|
311 )
|
|
|
312 ("\\.gz$"
|
|
|
313 "application" "octet-stream" (("type" . "gzip"))
|
|
76
|
314 "base64"
|
|
4
|
315 "attachment" (("filename" . file))
|
|
|
316 )
|
|
|
317 ("\\.Z$"
|
|
|
318 "application" "octet-stream" (("type" . "compress"))
|
|
76
|
319 "base64"
|
|
4
|
320 "attachment" (("filename" . file))
|
|
|
321 )
|
|
|
322 ("\\.lzh$"
|
|
|
323 "application" "octet-stream" (("type" . "lha"))
|
|
76
|
324 "base64"
|
|
4
|
325 "attachment" (("filename" . file))
|
|
|
326 )
|
|
|
327 ("\\.zip$"
|
|
|
328 "application" "zip" nil
|
|
76
|
329 "base64"
|
|
4
|
330 "attachment" (("filename" . file))
|
|
|
331 )
|
|
|
332 ("\\.diff$"
|
|
|
333 "application" "octet-stream" (("type" . "patch"))
|
|
|
334 nil
|
|
|
335 "attachment" (("filename" . file))
|
|
|
336 )
|
|
|
337 ("\\.patch$"
|
|
|
338 "application" "octet-stream" (("type" . "patch"))
|
|
|
339 nil
|
|
|
340 "attachment" (("filename" . file))
|
|
|
341 )
|
|
|
342 ("\\.signature"
|
|
|
343 "text" "plain" nil nil)
|
|
|
344 (".*"
|
|
|
345 "application" "octet-stream" nil
|
|
|
346 nil
|
|
|
347 "attachment" (("filename" . file))
|
|
|
348 )
|
|
|
349 )
|
|
|
350 "*Alist of file name, types, parameters, and default encoding.
|
|
|
351 If encoding is nil, it is determined from its contents.")
|
|
|
352
|
|
|
353 ;;; @@ about charset, encoding and transfer-level
|
|
|
354 ;;;
|
|
|
355
|
|
|
356 (defvar mime-editor/transfer-level 7
|
|
76
|
357 "*A number of network transfer level. It should be bigger than 7.")
|
|
4
|
358 (make-variable-buffer-local 'mime-editor/transfer-level)
|
|
|
359
|
|
|
360 (defvar mime-editor/transfer-level-string
|
|
|
361 (mime/encoding-name mime-editor/transfer-level 'not-omit)
|
|
|
362 "*A string formatted version of mime/defaul-transfer-level")
|
|
|
363 (make-variable-buffer-local 'mime-editor/transfer-level-string)
|
|
|
364
|
|
|
365 (defun mime-editor/make-charset-default-encoding-alist (transfer-level)
|
|
|
366 (mapcar (function
|
|
|
367 (lambda (charset-type)
|
|
|
368 (let ((charset (car charset-type))
|
|
|
369 (type (nth 1 charset-type))
|
|
|
370 (encoding (nth 2 charset-type))
|
|
|
371 )
|
|
|
372 (if (<= type transfer-level)
|
|
|
373 (cons charset (mime/encoding-name type))
|
|
|
374 (cons charset encoding)
|
|
|
375 ))))
|
|
|
376 mime-charset-type-list))
|
|
|
377
|
|
|
378 (defvar mime-editor/charset-default-encoding-alist
|
|
|
379 (mime-editor/make-charset-default-encoding-alist mime-editor/transfer-level))
|
|
|
380 (make-variable-buffer-local 'mime-editor/charset-default-encoding-alist)
|
|
|
381
|
|
|
382 ;;; @@ about message inserting
|
|
|
383 ;;;
|
|
|
384
|
|
|
385 (defvar mime-editor/yank-ignored-field-list
|
|
|
386 '("Received" "Approved" "Path" "Replied" "Status"
|
|
|
387 "Xref" "X-UIDL" "X-Filter" "X-Gnus-.*" "X-VM-.*")
|
|
|
388 "Delete these fields from original message when it is inserted
|
|
|
389 as message/rfc822 part.
|
|
|
390 Each elements are regexp of field-name. [tm-edit.el]")
|
|
|
391
|
|
|
392 (defvar mime-editor/yank-ignored-field-regexp
|
|
|
393 (concat "^"
|
|
|
394 (apply (function regexp-or) mime-editor/yank-ignored-field-list)
|
|
|
395 ":"))
|
|
|
396
|
|
|
397 (defvar mime-editor/message-inserter-alist nil)
|
|
|
398 (defvar mime-editor/mail-inserter-alist nil)
|
|
|
399
|
|
|
400 ;;; @@ about message splitting
|
|
|
401 ;;;
|
|
|
402
|
|
|
403 (defvar mime-editor/split-message t
|
|
|
404 "*Split large message if it is non-nil. [tm-edit.el]")
|
|
|
405
|
|
|
406 (defvar mime-editor/message-default-max-lines 1000
|
|
|
407 "*Default maximum lines of a message. [tm-edit.el]")
|
|
|
408
|
|
|
409 (defvar mime-editor/message-max-lines-alist
|
|
|
410 '((news-reply-mode . 500))
|
|
|
411 "Alist of major-mode vs maximum lines of a message.
|
|
|
412 If it is not specified for a major-mode,
|
|
|
413 `mime-editor/message-default-max-lines' is used. [tm-edit.el]")
|
|
|
414
|
|
|
415 (defconst mime-editor/split-ignored-field-regexp
|
|
|
416 "\\(^Content-\\|^Subject:\\|^Mime-Version:\\)")
|
|
|
417
|
|
|
418 (defvar mime-editor/split-blind-field-regexp
|
|
|
419 "\\(^[BDFbdf]cc:\\|^cc:[ \t]*$\\)")
|
|
|
420
|
|
|
421 (defvar mime-editor/split-message-sender-alist nil)
|
|
|
422
|
|
|
423 (defvar mime-editor/news-reply-mode-server-running nil)
|
|
|
424
|
|
|
425
|
|
|
426 ;;; @@ about PGP
|
|
|
427 ;;;
|
|
|
428
|
|
|
429 (defvar mime-editor/signing-type 'pgp-elkins
|
|
|
430 "*PGP signing type (pgp-elkins, pgp-kazu or nil). [tm-edit.el]")
|
|
|
431
|
|
|
432 (defvar mime-editor/encrypting-type 'pgp-elkins
|
|
|
433 "*PGP encrypting type (pgp-elkins, pgp-kazu or nil). [tm-edit.el]")
|
|
|
434
|
|
70
|
435 (defvar mime-editor/pgp-sign-function 'tm:mc-pgp-sign-region)
|
|
|
436 (defvar mime-editor/pgp-encrypt-function 'tm:mc-pgp-encrypt-region)
|
|
|
437 (defvar mime-editor/traditional-pgp-sign-function 'mc-pgp-sign-region)
|
|
|
438 (defvar mime-editor/pgp-insert-public-key-function 'mc-insert-public-key)
|
|
|
439
|
|
|
440 (autoload mime-editor/pgp-sign-function "tm-edit-mc")
|
|
|
441 (autoload mime-editor/pgp-encrypt-function "tm-edit-mc")
|
|
|
442 (autoload mime-editor/traditional-pgp-sign-function "mc-pgp")
|
|
|
443 (autoload mime-editor/pgp-insert-public-key-function "mc-toplev")
|
|
|
444
|
|
4
|
445
|
|
|
446 ;;; @@ about tag
|
|
|
447 ;;;
|
|
|
448
|
|
|
449 (defconst mime-editor/single-part-tag-regexp
|
|
|
450 "--[[][[]\\([^]]*\\)]\\([[]\\([^]]*\\)]\\|\\)]"
|
|
|
451 "*Regexp of MIME tag in the form of [[CONTENT-TYPE][ENCODING]].")
|
|
|
452
|
|
|
453 (defconst mime-editor/quoted-single-part-tag-regexp
|
|
|
454 (concat "- " (substring mime-editor/single-part-tag-regexp 1)))
|
|
|
455
|
|
|
456 (defconst mime-editor/multipart-beginning-regexp "--<<\\([^<>]+\\)>>-{\n")
|
|
|
457
|
|
|
458 (defconst mime-editor/multipart-end-regexp "--}-<<\\([^<>]+\\)>>\n")
|
|
|
459
|
|
|
460 (defconst mime-editor/beginning-tag-regexp
|
|
|
461 (regexp-or mime-editor/single-part-tag-regexp
|
|
|
462 mime-editor/multipart-beginning-regexp))
|
|
|
463
|
|
|
464 (defconst mime-editor/end-tag-regexp
|
|
|
465 (regexp-or mime-editor/single-part-tag-regexp
|
|
|
466 mime-editor/multipart-end-regexp))
|
|
|
467
|
|
|
468 (defconst mime-editor/tag-regexp
|
|
|
469 (regexp-or mime-editor/single-part-tag-regexp
|
|
|
470 mime-editor/multipart-beginning-regexp
|
|
|
471 mime-editor/multipart-end-regexp))
|
|
|
472
|
|
|
473 (defvar mime-tag-format "--[[%s]]"
|
|
|
474 "*Control-string making a MIME tag.")
|
|
|
475
|
|
|
476 (defvar mime-tag-format-with-encoding "--[[%s][%s]]"
|
|
|
477 "*Control-string making a MIME tag with encoding.")
|
|
|
478
|
|
|
479 ;;; @@ multipart boundary
|
|
|
480 ;;;
|
|
|
481
|
|
|
482 (defvar mime-multipart-boundary "Multipart"
|
|
|
483 "*Boundary of a multipart message.")
|
|
|
484
|
|
|
485
|
|
|
486 ;;; @@ buffer local variables
|
|
|
487 ;;;
|
|
|
488
|
|
|
489 (defvar mime/editor-mode-old-local-map nil)
|
|
|
490 (defvar mime/editing-buffer nil)
|
|
|
491
|
|
|
492
|
|
|
493 ;;; @ constants
|
|
|
494 ;;;
|
|
|
495
|
|
|
496 (defconst mime-tspecials-regexp "[][()<>@,;:\\\"/?.= \t]"
|
|
|
497 "*Specify MIME tspecials.
|
|
|
498 Tspecials means any character that matches with it in header must be quoted.")
|
|
|
499
|
|
|
500 (defconst mime-editor/mime-version-value
|
|
|
501 (concat "1.0 (generated by " mime-editor/version-name ")")
|
|
|
502 "MIME version number.")
|
|
|
503
|
|
|
504 (defconst mime-editor/mime-map (make-sparse-keymap)
|
|
|
505 "Keymap for MIME commands.")
|
|
|
506
|
|
|
507 ;;; @ keymap and menu
|
|
|
508 ;;;
|
|
|
509
|
|
|
510 (defvar mime/editor-mode-flag nil)
|
|
|
511 (make-variable-buffer-local 'mime/editor-mode-flag)
|
|
|
512
|
|
|
513 (defun mime-editor/define-keymap (keymap)
|
|
|
514 "Add mime-editor commands to KEYMAP."
|
|
|
515 (if (not (keymapp keymap))
|
|
|
516 nil
|
|
|
517 (define-key keymap "\C-t" 'mime-editor/insert-text)
|
|
|
518 (define-key keymap "\C-i" 'mime-editor/insert-file)
|
|
|
519 (define-key keymap "\C-e" 'mime-editor/insert-external)
|
|
|
520 (define-key keymap "\C-v" 'mime-editor/insert-voice)
|
|
|
521 (define-key keymap "\C-y" 'mime-editor/insert-message)
|
|
|
522 (define-key keymap "\C-m" 'mime-editor/insert-mail)
|
|
|
523 (define-key keymap "\C-w" 'mime-editor/insert-signature)
|
|
|
524 (define-key keymap "\C-s" 'mime-editor/insert-signature)
|
|
|
525 (define-key keymap "\C-k" 'mime-editor/insert-key)
|
|
|
526 (define-key keymap "t" 'mime-editor/insert-tag)
|
|
|
527 (define-key keymap "a" 'mime-editor/enclose-alternative-region)
|
|
|
528 (define-key keymap "p" 'mime-editor/enclose-parallel-region)
|
|
|
529 (define-key keymap "m" 'mime-editor/enclose-mixed-region)
|
|
|
530 (define-key keymap "d" 'mime-editor/enclose-digest-region)
|
|
|
531 (define-key keymap "s" 'mime-editor/enclose-signed-region)
|
|
|
532 (define-key keymap "e" 'mime-editor/enclose-encrypted-region)
|
|
|
533 (define-key keymap "q" 'mime-editor/enclose-quote-region)
|
|
|
534 (define-key keymap "7" 'mime-editor/set-transfer-level-7bit)
|
|
|
535 (define-key keymap "8" 'mime-editor/set-transfer-level-8bit)
|
|
|
536 (define-key keymap "/" 'mime-editor/set-split)
|
|
|
537 (define-key keymap "v" 'mime-editor/set-sign)
|
|
|
538 (define-key keymap "h" 'mime-editor/set-encrypt)
|
|
|
539 (define-key keymap "\C-p" 'mime-editor/preview-message)
|
|
|
540 (define-key keymap "\C-z" 'mime-editor/exit)
|
|
|
541 (define-key keymap "?" 'mime-editor/help)
|
|
|
542 ))
|
|
|
543
|
|
|
544 (mime-editor/define-keymap mime-editor/mime-map)
|
|
|
545
|
|
|
546 (defun mime-editor/toggle-mode ()
|
|
|
547 (interactive)
|
|
|
548 (if mime/editor-mode-flag
|
|
|
549 (mime-editor/exit 'nomime)
|
|
|
550 (mime/editor-mode)
|
|
|
551 ))
|
|
|
552
|
|
|
553 (cond (running-xemacs
|
|
|
554 (defconst mime-editor/minor-mime-map nil "Keymap for MIME commands.")
|
|
|
555 (or mime-editor/minor-mime-map
|
|
|
556 (progn
|
|
|
557 (setq mime-editor/minor-mime-map
|
|
|
558 (make-sparse-keymap 'mime-editor/minor-mime-map))
|
|
|
559 (define-key
|
|
|
560 mime-editor/minor-mime-map mime-prefix mime-editor/mime-map)
|
|
|
561 ))
|
|
|
562 (add-minor-mode 'mime/editor-mode-flag
|
|
|
563 '((" MIME-Edit " mime-editor/transfer-level-string))
|
|
|
564 mime-editor/minor-mime-map
|
|
|
565 nil
|
|
|
566 'mime-editor/toggle-mode)
|
|
|
567 )
|
|
|
568 (t
|
|
|
569 (set-alist 'minor-mode-alist
|
|
|
570 'mime/editor-mode-flag
|
|
|
571 '((" MIME-Edit " mime-editor/transfer-level-string))))
|
|
|
572 )
|
|
|
573
|
|
|
574 (defconst mime-editor/menu-title "MIME-Edit")
|
|
|
575
|
|
|
576 (defconst mime-editor/menu-list
|
|
|
577 '((mime-help "Describe MIME editor mode" mime-editor/help)
|
|
|
578 (file "Insert File" mime-editor/insert-file)
|
|
|
579 (external "Insert External" mime-editor/insert-external)
|
|
|
580 (voice "Insert Voice" mime-editor/insert-voice)
|
|
|
581 (message "Insert Message" mime-editor/insert-message)
|
|
|
582 (mail "Insert Mail" mime-editor/insert-mail)
|
|
|
583 (signature "Insert Signature" mime-editor/insert-signature)
|
|
|
584 (text "Insert Text" mime-editor/insert-text)
|
|
|
585 (tag "Insert Tag" mime-editor/insert-tag)
|
|
|
586 (alternative "Enclose as alternative"
|
|
|
587 mime-editor/enclose-alternative-region)
|
|
|
588 (parallel "Enclose as parallel" mime-editor/enclose-parallel-region)
|
|
|
589 (mixed "Enclose as serial" mime-editor/enclose-mixed-region)
|
|
|
590 (digest "Enclose as digest" mime-editor/enclose-digest-region)
|
|
|
591 (signed "Enclose as signed" mime-editor/enclose-signed-region)
|
|
|
592 (encrypted "Enclose as encrypted" mime-editor/enclose-encrypted-region)
|
|
|
593 (quote "Verbatim region" mime-editor/enclose-quote-region)
|
|
|
594 (key "Insert Public Key" mime-editor/insert-key)
|
|
|
595 (split "About split" mime-editor/set-split)
|
|
|
596 (sign "About sign" mime-editor/set-sign)
|
|
|
597 (encrypt "About encryption" mime-editor/set-encrypt)
|
|
|
598 (preview "Preview Message" mime-editor/preview-message)
|
|
|
599 (level "Toggle transfer-level" mime-editor/toggle-transfer-level)
|
|
|
600 )
|
|
|
601 "MIME-edit menubar entry.")
|
|
|
602
|
|
|
603 (defun mime-editor/define-menu-for-emacs19 ()
|
|
|
604 "Define menu for Emacs 19."
|
|
|
605 (define-key (current-local-map) [menu-bar mime-edit]
|
|
|
606 (cons mime-editor/menu-title
|
|
|
607 (make-sparse-keymap mime-editor/menu-title)))
|
|
|
608 (mapcar (function
|
|
|
609 (lambda (item)
|
|
|
610 (define-key (current-local-map)
|
|
|
611 (vector 'menu-bar 'mime-edit (car item))
|
|
|
612 (cons (nth 1 item)(nth 2 item))
|
|
|
613 )
|
|
|
614 ))
|
|
|
615 (reverse mime-editor/menu-list)
|
|
|
616 ))
|
|
|
617
|
|
|
618 ;;; modified by Pekka Marjola <pema@iki.fi>
|
|
|
619 ;;; 1995/9/5 (c.f. [tm-en:69])
|
|
|
620 (defun mime-editor/define-menu-for-xemacs ()
|
|
|
621 "Define menu for Emacs 19."
|
|
|
622 (cond ((featurep 'menubar)
|
|
|
623 (make-local-variable 'current-menubar)
|
|
|
624 (set-buffer-menubar current-menubar)
|
|
|
625 (add-submenu nil
|
|
|
626 (cons mime-editor/menu-title
|
|
|
627 (mapcar (function
|
|
|
628 (lambda (item)
|
|
|
629 (vector (nth 1 item)(nth 2 item)
|
|
|
630 mime/editor-mode-flag)
|
|
|
631 ))
|
|
|
632 mime-editor/menu-list)))
|
|
|
633 )))
|
|
|
634
|
|
|
635 ;;; modified by Steven L. Baur <steve@miranova.com>
|
|
|
636 ;;; 1995/12/6 (c.f. [tm-en:209])
|
|
|
637 (if (and running-xemacs (not (boundp 'mime-editor/popup-menu-for-xemacs)))
|
|
|
638 (setq mime-editor/popup-menu-for-xemacs
|
|
|
639 (append '("MIME Commands" "---")
|
|
|
640 (mapcar (function (lambda (item)
|
|
|
641 (vector (nth 1 item)
|
|
|
642 (nth 2 item)
|
|
|
643 t)))
|
|
|
644 mime-editor/menu-list)))
|
|
|
645 )
|
|
|
646 ;;; end
|
|
|
647
|
|
|
648
|
|
|
649 ;;; @ functions
|
|
|
650 ;;;
|
|
|
651
|
|
76
|
652 ;; The following text was removed from the docstring of the subsequent
|
|
|
653 ;; functions due to problems with the resulting autoload file. -sb
|
|
|
654
|
|
|
655 ;; --[[text/plain; charset=ISO-2022-JP]]
|
|
|
656 ;; $B$3$l$O(B charset $B$r(B ISO-2022-JP $B$K;XDj$7$?F|K\8l$N(B plain $B%F%-%9(B
|
|
|
657 ;; $B%H$G$9(B.
|
|
|
658
|
|
|
659
|
|
4
|
660 ;;;###autoload
|
|
|
661 (defun mime/editor-mode ()
|
|
|
662 "MIME minor mode for editing the tagged MIME message.
|
|
|
663
|
|
|
664 In this mode, basically, the message is composed in the tagged MIME
|
|
|
665 format. The message tag looks like:
|
|
|
666
|
|
76
|
667 --[[text/plain; charset=ISO-2022-JP][7bit]]
|
|
4
|
668
|
|
|
669 The tag specifies the MIME content type, subtype, optional parameters
|
|
|
670 and transfer encoding of the message following the tag. Messages
|
|
|
671 without any tag are treated as `text/plain' by default. Charset and
|
|
|
672 transfer encoding are automatically defined unless explicitly
|
|
|
673 specified. Binary messages such as audio and image are usually hidden.
|
|
|
674 The messages in the tagged MIME format are automatically translated
|
|
|
675 into a MIME compliant message when exiting this mode.
|
|
|
676
|
|
|
677 Available charsets depend on Emacs version being used. The following
|
|
|
678 lists the available charsets of each emacs.
|
|
|
679
|
|
|
680 EMACS 18: US-ASCII is only available.
|
|
|
681 NEmacs: US-ASCII and ISO-2022-JP are available.
|
|
|
682 EMACS 19: US-ASCII and ISO-8859-1 (or other charset) are available.
|
|
|
683 XEmacs 19: US-ASCII and ISO-8859-1 (or other charset) are available.
|
|
|
684 Mule: US-ASCII, ISO-8859-* (except for ISO-8859-5), KOI8-R,
|
|
|
685 ISO-2022-JP, ISO-2022-JP-2, ISO-2022-KR, BIG5 and
|
|
|
686 ISO-2022-INT-1 are available.
|
|
|
687
|
|
|
688 ISO-2022-JP-2 and ISO-2022-INT-1 charsets used in mule is expected to
|
|
|
689 be used to represent multilingual text in intermixed manner. Any
|
|
|
690 languages that has no registered charset are represented as either
|
|
|
691 ISO-2022-JP-2 or ISO-2022-INT-1 in mule.
|
|
|
692
|
|
|
693 If you want to use non-ISO-8859-1 charset in EMACS 19 or XEmacs 19,
|
|
|
694 please set variable `default-mime-charset'. This variable must be
|
|
|
695 symbol of which name is a MIME charset.
|
|
|
696
|
|
|
697 If you want to add more charsets in mule, please set variable
|
|
|
698 `charsets-mime-charset-alist'. This variable must be alist of which
|
|
|
699 key is list of leading-char/charset and value is symbol of MIME
|
|
|
700 charset. (leading-char is a term of MULE 1.* and 2.*. charset is a
|
|
|
701 term of XEmacs/mule, mule merged EMACS and MULE 3.*) If name of
|
|
|
702 coding-system is different as MIME charset, please set variable
|
|
|
703 `mime-charset-coding-system-alist'. This variable must be alist of
|
|
|
704 which key is MIME charset and value is coding-system.
|
|
|
705
|
|
|
706 Following commands are available in addition to major mode commands:
|
|
76
|
707
|
|
|
708 \[make single part\]
|
|
4
|
709 \\[mime-editor/insert-text] insert a text message.
|
|
|
710 \\[mime-editor/insert-file] insert a (binary) file.
|
|
|
711 \\[mime-editor/insert-external] insert a reference to external body.
|
|
|
712 \\[mime-editor/insert-voice] insert a voice message.
|
|
|
713 \\[mime-editor/insert-message] insert a mail or news message.
|
|
|
714 \\[mime-editor/insert-mail] insert a mail message.
|
|
|
715 \\[mime-editor/insert-signature] insert a signature file at end.
|
|
76
|
716 \\[mime-editor/insert-key] insert PGP public key.
|
|
4
|
717 \\[mime-editor/insert-tag] insert a new MIME tag.
|
|
76
|
718
|
|
|
719 \[make enclosure (maybe multipart)\]
|
|
4
|
720 \\[mime-editor/enclose-alternative-region] enclose as multipart/alternative.
|
|
|
721 \\[mime-editor/enclose-parallel-region] enclose as multipart/parallel.
|
|
|
722 \\[mime-editor/enclose-mixed-region] enclose as multipart/mixed.
|
|
|
723 \\[mime-editor/enclose-digest-region] enclose as multipart/digest.
|
|
|
724 \\[mime-editor/enclose-signed-region] enclose as PGP signed.
|
|
|
725 \\[mime-editor/enclose-encrypted-region] enclose as PGP encrypted.
|
|
76
|
726 \\[mime-editor/enclose-quote-region] enclose as verbose mode (to avoid to expand tags)
|
|
|
727
|
|
|
728 \[other commands\]
|
|
|
729 \\[mime-editor/set-transfer-level-7bit] set transfer-level as 7.
|
|
|
730 \\[mime-editor/set-transfer-level-8bit] set transfer-level as 8.
|
|
|
731 \\[mime-editor/set-split] set message splitting mode.
|
|
|
732 \\[mime-editor/set-sign] set PGP-sign mode.
|
|
|
733 \\[mime-editor/set-encrypt] set PGP-encryption mode.
|
|
4
|
734 \\[mime-editor/preview-message] preview editing MIME message.
|
|
|
735 \\[mime-editor/exit] exit and translate into a MIME compliant message.
|
|
76
|
736 \\[mime-editor/help] show this help.
|
|
70
|
737 \\[mime-editor/maybe-translate] exit and translate if in MIME mode, then split.
|
|
4
|
738
|
|
|
739 Additional commands are available in some major modes:
|
|
|
740 C-c C-c exit, translate and run the original command.
|
|
|
741 C-c C-s exit, translate and run the original command.
|
|
|
742
|
|
|
743 The following is a message example written in the tagged MIME format.
|
|
|
744 TABs at the beginning of the line are not a part of the message:
|
|
|
745
|
|
|
746 This is a conventional plain text. It should be translated
|
|
|
747 into text/plain.
|
|
|
748 --[[text/plain]]
|
|
|
749 This is also a plain text. But, it is explicitly specified as
|
|
|
750 is.
|
|
78
|
751 --[[text/plain; charset=ISO-2022-JP]]
|
|
80
|
752 ... Japanese text here ...
|
|
70
|
753 --[[text/richtext]]
|
|
|
754 <center>This is a richtext.</center>
|
|
|
755 --[[image/gif][base64]]^M...image encoded in base64 here...
|
|
|
756 --[[audio/basic][base64]]^M...audio encoded in base64 here...
|
|
4
|
757
|
|
|
758 User customizable variables (not documented all of them):
|
|
|
759 mime-prefix
|
|
|
760 Specifies a key prefix for MIME minor mode commands.
|
|
|
761
|
|
|
762 mime-ignore-preceding-spaces
|
|
|
763 Preceding white spaces in a message body are ignored if non-nil.
|
|
|
764
|
|
|
765 mime-ignore-trailing-spaces
|
|
|
766 Trailing white spaces in a message body are ignored if non-nil.
|
|
|
767
|
|
|
768 mime-auto-hide-body
|
|
|
769 Hide a non-textual body message encoded in base64 after insertion
|
|
|
770 if non-nil.
|
|
|
771
|
|
76
|
772 mime-editor/transfer-level
|
|
|
773 A number of network transfer level. It should be bigger than 7.
|
|
|
774 If you are in 8bit-through environment, please set 8.
|
|
|
775
|
|
4
|
776 mime-editor/voice-recorder
|
|
|
777 Specifies a function to record a voice message and encode it.
|
|
|
778 The function `mime-editor/voice-recorder-for-sun' is for Sun
|
|
|
779 SparcStations.
|
|
|
780
|
|
|
781 mime/editor-mode-hook
|
|
|
782 Turning on MIME mode calls the value of mime/editor-mode-hook, if
|
|
|
783 it is non-nil.
|
|
|
784
|
|
|
785 mime-editor/translate-hook
|
|
|
786 The value of mime-editor/translate-hook is called just before translating
|
|
|
787 the tagged MIME format into a MIME compliant message if it is
|
|
|
788 non-nil. If the hook call the function mime-editor/insert-signature,
|
|
|
789 the signature file will be inserted automatically.
|
|
|
790
|
|
|
791 mime-editor/exit-hook
|
|
|
792 Turning off MIME mode calls the value of mime-editor/exit-hook, if it is
|
|
|
793 non-nil."
|
|
|
794 (interactive)
|
|
|
795 (if mime/editor-mode-flag
|
|
|
796 (error "You are already editing a MIME message.")
|
|
|
797 (setq mime/editor-mode-flag t)
|
|
|
798 ;; Remember old key bindings.
|
|
|
799 (if running-xemacs
|
|
|
800 (use-local-map (or (current-local-map) (make-sparse-keymap)))
|
|
|
801 (make-local-variable 'mime/editor-mode-old-local-map)
|
|
|
802 (setq mime/editor-mode-old-local-map (current-local-map))
|
|
|
803 ;; Add MIME commands to current local map.
|
|
|
804 (use-local-map (copy-keymap (or (current-local-map)
|
|
|
805 (make-sparse-keymap))))
|
|
|
806 )
|
|
|
807 (if (not (lookup-key (current-local-map) mime-prefix))
|
|
|
808 (define-key (current-local-map) mime-prefix mime-editor/mime-map))
|
|
|
809
|
|
|
810 ;; Set transfer level into mode line
|
|
|
811 ;;
|
|
|
812 (setq mime-editor/transfer-level-string
|
|
|
813 (mime/encoding-name mime-editor/transfer-level 'not-omit))
|
|
|
814 (force-mode-line-update)
|
|
|
815
|
|
|
816 ;; Define menu. Menus for other emacs implementations are
|
|
|
817 ;; welcome.
|
|
|
818 (cond (running-xemacs
|
|
|
819 (mime-editor/define-menu-for-xemacs))
|
|
|
820 ((>= emacs-major-version 19)
|
|
|
821 (mime-editor/define-menu-for-emacs19)
|
|
|
822 ))
|
|
|
823 ;; end
|
|
|
824
|
|
|
825 (enable-invisible)
|
|
|
826
|
|
|
827 ;; I don't care about saving these.
|
|
|
828 (setq paragraph-start
|
|
|
829 (regexp-or mime-editor/single-part-tag-regexp
|
|
|
830 paragraph-start))
|
|
|
831 (setq paragraph-separate
|
|
|
832 (regexp-or mime-editor/single-part-tag-regexp
|
|
|
833 paragraph-separate))
|
|
|
834 (run-hooks 'mime/editor-mode-hook)
|
|
|
835 (message
|
|
|
836 (substitute-command-keys
|
|
|
837 "Type \\[mime-editor/exit] to exit MIME mode, and type \\[mime-editor/help] to get help."))
|
|
|
838 ))
|
|
|
839
|
|
|
840 ;;;###autoload
|
|
|
841 (defalias 'edit-mime 'mime/editor-mode) ; for convenience
|
|
|
842 (defalias 'mime-mode 'mime/editor-mode) ; for convenience
|
|
|
843
|
|
|
844 (defun mime-editor/exit (&optional nomime no-error)
|
|
|
845 "Translate the tagged MIME message into a MIME compliant message.
|
|
|
846 With no argument encode a message in the buffer into MIME, otherwise
|
|
|
847 just return to previous mode."
|
|
|
848 (interactive "P")
|
|
|
849 (if (not mime/editor-mode-flag)
|
|
|
850 (if (null no-error)
|
|
|
851 (error "You aren't editing a MIME message.")
|
|
|
852 )
|
|
|
853 (if (not nomime)
|
|
|
854 (progn
|
|
|
855 (run-hooks 'mime-editor/translate-hook)
|
|
|
856 (mime-editor/translate-buffer)))
|
|
|
857 ;; Restore previous state.
|
|
|
858 (setq mime/editor-mode-flag nil)
|
|
|
859 (cond (running-xemacs
|
|
70
|
860 (delete-menu-item (list mime-editor/menu-title)))
|
|
4
|
861 (t
|
|
|
862 (use-local-map mime/editor-mode-old-local-map)))
|
|
|
863
|
|
|
864 (end-of-invisible)
|
|
|
865 (set-buffer-modified-p (buffer-modified-p))
|
|
|
866 (run-hooks 'mime-editor/exit-hook)
|
|
|
867 (message "Exit MIME editor mode.")
|
|
|
868 ))
|
|
|
869
|
|
|
870 (defun mime-editor/maybe-translate ()
|
|
|
871 (interactive)
|
|
|
872 (mime-editor/exit nil t)
|
|
|
873 (call-interactively 'mime-editor/maybe-split-and-send)
|
|
|
874 )
|
|
|
875
|
|
|
876 (defun mime-editor/help ()
|
|
|
877 "Show help message about MIME mode."
|
|
|
878 (interactive)
|
|
|
879 (with-output-to-temp-buffer "*Help*"
|
|
|
880 (princ "MIME editor mode:\n")
|
|
|
881 (princ (documentation 'mime/editor-mode))
|
|
|
882 (print-help-return-message)))
|
|
|
883
|
|
|
884 (defun mime-editor/insert-text ()
|
|
|
885 "Insert a text message.
|
|
70
|
886 Charset is automatically obtained from the `mime/lc-charset-alist'."
|
|
4
|
887 (interactive)
|
|
|
888 (let ((ret (mime-editor/insert-tag "text" nil nil)))
|
|
|
889 (if ret
|
|
|
890 (progn
|
|
|
891 (if (looking-at mime-editor/single-part-tag-regexp)
|
|
|
892 (progn
|
|
|
893 ;; Make a space between the following message.
|
|
|
894 (insert "\n")
|
|
|
895 (forward-char -1)
|
|
|
896 ))
|
|
|
897 (if (and (member (second ret) '("enriched" "richtext"))
|
|
|
898 (fboundp 'enriched-mode)
|
|
|
899 )
|
|
|
900 (enriched-mode t)
|
|
|
901 (if (boundp 'enriched-mode)
|
|
|
902 (enriched-mode nil)
|
|
|
903 ))))))
|
|
|
904
|
|
76
|
905 (defun mime-editor/insert-file (file &optional verbose)
|
|
4
|
906 "Insert a message from a file."
|
|
76
|
907 (interactive "fInsert file as MIME message: \nP")
|
|
4
|
908 (let* ((guess (mime-find-file-type file))
|
|
76
|
909 (type (nth 0 guess))
|
|
4
|
910 (subtype (nth 1 guess))
|
|
|
911 (parameters (nth 2 guess))
|
|
76
|
912 (encoding (nth 3 guess))
|
|
4
|
913 (disposition-type (nth 4 guess))
|
|
|
914 (disposition-params (nth 5 guess))
|
|
76
|
915 )
|
|
|
916 (if verbose
|
|
|
917 (setq type (mime-prompt-for-type type)
|
|
|
918 subtype (mime-prompt-for-subtype type subtype)
|
|
|
919 ))
|
|
|
920 (if (or (interactive-p) verbose)
|
|
|
921 (setq encoding (mime-prompt-for-encoding encoding))
|
|
|
922 )
|
|
4
|
923 (if (or (consp parameters) (stringp disposition-type))
|
|
|
924 (let ((rest parameters) cell attribute value)
|
|
|
925 (setq parameters "")
|
|
|
926 (while rest
|
|
|
927 (setq cell (car rest))
|
|
|
928 (setq attribute (car cell))
|
|
|
929 (setq value (cdr cell))
|
|
|
930 (if (eq value 'file)
|
|
|
931 (setq value (std11-wrap-as-quoted-string
|
|
|
932 (file-name-nondirectory file)))
|
|
|
933 )
|
|
|
934 (setq parameters (concat parameters "; " attribute "=" value))
|
|
|
935 (setq rest (cdr rest))
|
|
|
936 )
|
|
|
937 (if disposition-type
|
|
|
938 (progn
|
|
|
939 (setq parameters
|
|
|
940 (concat parameters "\n"
|
|
|
941 "Content-Disposition: " disposition-type))
|
|
|
942 (setq rest disposition-params)
|
|
|
943 (while rest
|
|
|
944 (setq cell (car rest))
|
|
|
945 (setq attribute (car cell))
|
|
|
946 (setq value (cdr cell))
|
|
|
947 (if (eq value 'file)
|
|
|
948 (setq value (std11-wrap-as-quoted-string
|
|
|
949 (file-name-nondirectory file)))
|
|
|
950 )
|
|
|
951 (setq parameters
|
|
|
952 (concat parameters "; " attribute "=" value))
|
|
|
953 (setq rest (cdr rest))
|
|
|
954 )
|
|
|
955 ))
|
|
|
956 ))
|
|
76
|
957 (mime-editor/insert-tag type subtype parameters)
|
|
4
|
958 (mime-editor/insert-binary-file file encoding)
|
|
|
959 ))
|
|
|
960
|
|
|
961 (defun mime-editor/insert-external ()
|
|
|
962 "Insert a reference to external body."
|
|
|
963 (interactive)
|
|
|
964 (mime-editor/insert-tag "message" "external-body" nil ";\n\t")
|
|
|
965 ;;(forward-char -1)
|
|
|
966 ;;(insert "Content-Description: " (read-string "Content-Description: ") "\n")
|
|
|
967 ;;(forward-line 1)
|
|
|
968 (let* ((pritype (mime-prompt-for-type))
|
|
|
969 (subtype (mime-prompt-for-subtype pritype))
|
|
|
970 (parameters (mime-prompt-for-parameters pritype subtype ";\n\t")))
|
|
|
971 (and pritype
|
|
|
972 subtype
|
|
|
973 (insert "Content-Type: "
|
|
|
974 pritype "/" subtype (or parameters "") "\n")))
|
|
|
975 (if (and (not (eobp))
|
|
|
976 (not (looking-at mime-editor/single-part-tag-regexp)))
|
|
|
977 (insert (mime-make-text-tag) "\n")))
|
|
|
978
|
|
|
979 (defun mime-editor/insert-voice ()
|
|
|
980 "Insert a voice message."
|
|
|
981 (interactive)
|
|
|
982 (let ((encoding
|
|
|
983 (completing-read
|
|
|
984 "What transfer encoding: "
|
|
|
985 mime-file-encoding-method-alist nil t nil)))
|
|
|
986 (mime-editor/insert-tag "audio" "basic" nil)
|
|
|
987 (mime-editor/define-encoding encoding)
|
|
|
988 (save-restriction
|
|
|
989 (narrow-to-region (1- (point))(point))
|
|
|
990 (unwind-protect
|
|
|
991 (funcall mime-editor/voice-recorder encoding)
|
|
|
992 (progn
|
|
|
993 (insert "\n")
|
|
|
994 (invisible-region (point-min)(point-max))
|
|
|
995 (goto-char (point-max))
|
|
|
996 )))))
|
|
|
997
|
|
|
998 (defun mime-editor/insert-signature (&optional arg)
|
|
|
999 "Insert a signature file."
|
|
|
1000 (interactive "P")
|
|
|
1001 (let ((signature-insert-hook
|
|
|
1002 (function
|
|
|
1003 (lambda ()
|
|
|
1004 (apply (function mime-editor/insert-tag)
|
|
|
1005 (mime-find-file-type signature-file-name))
|
|
|
1006 )))
|
|
|
1007 )
|
|
|
1008 (insert-signature arg)
|
|
|
1009 ))
|
|
|
1010
|
|
|
1011
|
|
|
1012 ;; Insert a new tag around a point.
|
|
|
1013
|
|
|
1014 (defun mime-editor/insert-tag (&optional pritype subtype parameters delimiter)
|
|
|
1015 "Insert new MIME tag and return a list of PRITYPE, SUBTYPE, and PARAMETERS.
|
|
|
1016 If nothing is inserted, return nil."
|
|
|
1017 (interactive)
|
|
|
1018 (let ((p (point)))
|
|
|
1019 (mime-editor/goto-tag)
|
|
|
1020 (if (and (re-search-forward mime-editor/tag-regexp nil t)
|
|
|
1021 (< (match-beginning 0) p)
|
|
|
1022 (< p (match-end 0))
|
|
|
1023 )
|
|
|
1024 (goto-char (match-beginning 0))
|
|
|
1025 (goto-char p)
|
|
|
1026 ))
|
|
|
1027 (let ((oldtag nil)
|
|
|
1028 (newtag nil)
|
|
|
1029 (current (point))
|
|
|
1030 )
|
|
|
1031 (setq pritype
|
|
|
1032 (or pritype
|
|
|
1033 (mime-prompt-for-type)))
|
|
|
1034 (setq subtype
|
|
|
1035 (or subtype
|
|
|
1036 (mime-prompt-for-subtype pritype)))
|
|
|
1037 (setq parameters
|
|
|
1038 (or parameters
|
|
|
1039 (mime-prompt-for-parameters pritype subtype delimiter)))
|
|
|
1040 ;; Make a new MIME tag.
|
|
|
1041 (setq newtag (mime-make-tag pritype subtype parameters))
|
|
|
1042 ;; Find an current MIME tag.
|
|
|
1043 (setq oldtag
|
|
|
1044 (save-excursion
|
|
|
1045 (if (mime-editor/goto-tag)
|
|
|
1046 (buffer-substring (match-beginning 0) (match-end 0))
|
|
|
1047 ;; Assume content type is 'text/plan'.
|
|
|
1048 (mime-make-tag "text" "plain")
|
|
|
1049 )))
|
|
|
1050 ;; We are only interested in TEXT.
|
|
|
1051 (if (and oldtag
|
|
|
1052 (not (mime-test-content-type
|
|
|
1053 (mime-editor/get-contype oldtag) "text")))
|
|
|
1054 (setq oldtag nil))
|
|
|
1055 ;; Make a new tag.
|
|
|
1056 (if (or (not oldtag) ;Not text
|
|
|
1057 (or mime-ignore-same-text-tag
|
|
|
1058 (not (string-equal oldtag newtag))))
|
|
|
1059 (progn
|
|
|
1060 ;; Mark the beginning of the tag for convenience.
|
|
|
1061 (push-mark (point) 'nomsg)
|
|
|
1062 (insert newtag "\n")
|
|
|
1063 (list pritype subtype parameters) ;New tag is created.
|
|
|
1064 )
|
|
|
1065 ;; Restore previous point.
|
|
|
1066 (goto-char current)
|
|
|
1067 nil ;Nothing is created.
|
|
|
1068 )
|
|
|
1069 ))
|
|
|
1070
|
|
|
1071 (defun mime-editor/insert-binary-file (file &optional encoding)
|
|
|
1072 "Insert binary FILE at point.
|
|
|
1073 Optional argument ENCODING specifies an encoding method such as base64."
|
|
|
1074 (let* ((tagend (1- (point))) ;End of the tag
|
|
|
1075 (hide-p (and mime-auto-hide-body
|
|
|
1076 (stringp encoding)
|
|
|
1077 (not
|
|
|
1078 (let ((en (downcase encoding)))
|
|
|
1079 (or (string-equal en "7bit")
|
|
|
1080 (string-equal en "8bit")
|
|
|
1081 (string-equal en "binary")
|
|
|
1082 )))))
|
|
|
1083 )
|
|
|
1084 (save-restriction
|
|
|
1085 (narrow-to-region tagend (point))
|
|
|
1086 (mime-insert-encoded-file file encoding)
|
|
|
1087 (if hide-p
|
|
|
1088 (progn
|
|
|
1089 (invisible-region (point-min) (point-max))
|
|
|
1090 (goto-char (point-max))
|
|
|
1091 )
|
|
|
1092 (goto-char (point-max))
|
|
|
1093 ))
|
|
|
1094 (or hide-p
|
|
|
1095 (looking-at mime-editor/tag-regexp)
|
|
|
1096 (= (point)(point-max))
|
|
|
1097 (mime-editor/insert-tag "text" "plain")
|
|
|
1098 )
|
|
|
1099 ;; Define encoding even if it is 7bit.
|
|
|
1100 (if (stringp encoding)
|
|
|
1101 (save-excursion
|
|
|
1102 (goto-char tagend) ; Make sure which line the tag is on.
|
|
|
1103 (mime-editor/define-encoding encoding)
|
|
|
1104 ))
|
|
|
1105 ))
|
|
|
1106
|
|
|
1107
|
|
|
1108 ;; Commands work on a current message flagment.
|
|
|
1109
|
|
|
1110 (defun mime-editor/goto-tag ()
|
|
|
1111 "Search for the beginning of the tagged MIME message."
|
|
|
1112 (let ((current (point)) multipart)
|
|
|
1113 (if (looking-at mime-editor/tag-regexp)
|
|
|
1114 t
|
|
|
1115 ;; At first, go to the end.
|
|
|
1116 (cond ((re-search-forward mime-editor/beginning-tag-regexp nil t)
|
|
|
1117 (goto-char (1- (match-beginning 0))) ;For multiline tag
|
|
|
1118 )
|
|
|
1119 (t
|
|
|
1120 (goto-char (point-max))
|
|
|
1121 ))
|
|
|
1122 ;; Then search for the beginning.
|
|
|
1123 (re-search-backward mime-editor/end-tag-regexp nil t)
|
|
|
1124 (or (looking-at mime-editor/beginning-tag-regexp)
|
|
|
1125 ;; Restore previous point.
|
|
|
1126 (progn
|
|
|
1127 (goto-char current)
|
|
|
1128 nil
|
|
|
1129 ))
|
|
|
1130 )))
|
|
|
1131
|
|
|
1132 (defun mime-editor/content-beginning ()
|
|
|
1133 "Return the point of the beginning of content."
|
|
|
1134 (save-excursion
|
|
|
1135 (let ((beg (save-excursion
|
|
|
1136 (beginning-of-line) (point))))
|
|
|
1137 (if (mime-editor/goto-tag)
|
|
|
1138 (let ((top (point)))
|
|
|
1139 (goto-char (match-end 0))
|
|
|
1140 (if (and (= beg top)
|
|
|
1141 (= (following-char) ?\^M))
|
|
|
1142 (point)
|
|
|
1143 (forward-line 1)
|
|
|
1144 (point)))
|
|
|
1145 ;; Default text/plain tag.
|
|
|
1146 (goto-char (point-min))
|
|
|
1147 (re-search-forward
|
|
|
1148 (concat "\n" (regexp-quote mail-header-separator)
|
|
|
1149 (if mime-ignore-preceding-spaces
|
|
|
1150 "[ \t\n]*\n" "\n")) nil 'move)
|
|
|
1151 (point))
|
|
|
1152 )))
|
|
|
1153
|
|
|
1154 (defun mime-editor/content-end ()
|
|
|
1155 "Return the point of the end of content."
|
|
|
1156 (save-excursion
|
|
|
1157 (let ((beg (point)))
|
|
|
1158 (if (mime-editor/goto-tag)
|
|
|
1159 (let ((top (point)))
|
|
|
1160 (goto-char (match-end 0))
|
|
|
1161 (if (invisible-p (point))
|
|
|
1162 (next-visible-point (point))
|
|
|
1163 ;; Move to the end of this text.
|
|
|
1164 (if (re-search-forward mime-editor/tag-regexp nil 'move)
|
|
|
1165 ;; Don't forget a multiline tag.
|
|
|
1166 (goto-char (match-beginning 0))
|
|
|
1167 )
|
|
|
1168 (point)
|
|
|
1169 ))
|
|
|
1170 ;; Assume the message begins with text/plain.
|
|
|
1171 (goto-char (mime-editor/content-beginning))
|
|
|
1172 (if (re-search-forward mime-editor/tag-regexp nil 'move)
|
|
|
1173 ;; Don't forget a multiline tag.
|
|
|
1174 (goto-char (match-beginning 0)))
|
|
|
1175 (point))
|
|
|
1176 )))
|
|
|
1177
|
|
|
1178 (defun mime-editor/define-charset (charset)
|
|
|
1179 "Set charset of current tag to CHARSET."
|
|
|
1180 (save-excursion
|
|
|
1181 (if (mime-editor/goto-tag)
|
|
|
1182 (let ((tag (buffer-substring (match-beginning 0) (match-end 0))))
|
|
|
1183 (delete-region (match-beginning 0) (match-end 0))
|
|
|
1184 (insert
|
|
|
1185 (mime-create-tag
|
|
|
1186 (mime-editor/set-parameter
|
|
|
1187 (mime-editor/get-contype tag)
|
|
|
1188 "charset" (upcase (symbol-name charset)))
|
|
|
1189 (mime-editor/get-encoding tag)))
|
|
|
1190 ))))
|
|
|
1191
|
|
|
1192 (defun mime-editor/define-encoding (encoding)
|
|
|
1193 "Set encoding of current tag to ENCODING."
|
|
|
1194 (save-excursion
|
|
|
1195 (if (mime-editor/goto-tag)
|
|
|
1196 (let ((tag (buffer-substring (match-beginning 0) (match-end 0))))
|
|
|
1197 (delete-region (match-beginning 0) (match-end 0))
|
|
|
1198 (insert (mime-create-tag (mime-editor/get-contype tag) encoding)))
|
|
|
1199 )))
|
|
|
1200
|
|
|
1201 (defun mime-editor/choose-charset ()
|
|
|
1202 "Choose charset of a text following current point."
|
|
|
1203 (detect-mime-charset-region (point) (mime-editor/content-end))
|
|
|
1204 )
|
|
|
1205
|
|
|
1206 (defun mime-make-text-tag (&optional subtype)
|
|
|
1207 "Make a tag for a text after current point.
|
|
|
1208 Subtype of text type can be specified by an optional argument SUBTYPE.
|
|
|
1209 Otherwise, it is obtained from mime-content-types."
|
|
|
1210 (let* ((pritype "text")
|
|
|
1211 (subtype (or subtype
|
|
|
1212 (car (car (cdr (assoc pritype mime-content-types)))))))
|
|
|
1213 ;; Charset should be defined later.
|
|
|
1214 (mime-make-tag pritype subtype)))
|
|
|
1215
|
|
|
1216
|
|
|
1217 ;; Tag handling functions
|
|
|
1218
|
|
|
1219 (defun mime-make-tag (pritype subtype &optional parameters encoding)
|
|
|
1220 "Make a tag of MIME message of PRITYPE, SUBTYPE and optional PARAMETERS."
|
|
|
1221 (mime-create-tag (concat (or pritype "") "/" (or subtype "")
|
|
|
1222 (or parameters ""))
|
|
|
1223 encoding))
|
|
|
1224
|
|
|
1225 (defun mime-create-tag (contype &optional encoding)
|
|
|
1226 "Make a tag with CONTENT-TYPE and optional ENCODING."
|
|
|
1227 (format (if encoding mime-tag-format-with-encoding mime-tag-format)
|
|
|
1228 contype encoding))
|
|
|
1229
|
|
|
1230 (defun mime-editor/get-contype (tag)
|
|
|
1231 "Return Content-Type (including parameters) of TAG."
|
|
|
1232 (and (stringp tag)
|
|
|
1233 (or (string-match mime-editor/single-part-tag-regexp tag)
|
|
|
1234 (string-match mime-editor/multipart-beginning-regexp tag)
|
|
|
1235 (string-match mime-editor/multipart-end-regexp tag)
|
|
|
1236 )
|
|
|
1237 (substring tag (match-beginning 1) (match-end 1))
|
|
|
1238 ))
|
|
|
1239
|
|
|
1240 (defun mime-editor/get-encoding (tag)
|
|
|
1241 "Return encoding of TAG."
|
|
|
1242 (and (stringp tag)
|
|
|
1243 (string-match mime-editor/single-part-tag-regexp tag)
|
|
|
1244 (match-beginning 3)
|
|
|
1245 (not (= (match-beginning 3) (match-end 3)))
|
|
|
1246 (substring tag (match-beginning 3) (match-end 3))))
|
|
|
1247
|
|
|
1248 (defun mime-get-parameter (contype parameter)
|
|
|
1249 "For given CONTYPE return value for PARAMETER.
|
|
|
1250 Nil if no such parameter."
|
|
|
1251 (if (string-match
|
|
|
1252 (concat
|
|
|
1253 ";[ \t\n]*"
|
|
|
1254 (regexp-quote parameter)
|
|
|
1255 "[ \t\n]*=[ \t\n]*\\([^\" \t\n;]*\\|\"[^\"]*\"\\)\\([ \t\n]*;\\|$\\)")
|
|
|
1256 contype)
|
|
|
1257 (substring contype (match-beginning 1) (match-end 1))
|
|
|
1258 nil ;No such parameter
|
|
|
1259 ))
|
|
|
1260
|
|
|
1261 (defun mime-editor/set-parameter (contype parameter value)
|
|
|
1262 "For given CONTYPE set PARAMETER to VALUE."
|
|
|
1263 (let (ctype opt-fields)
|
|
|
1264 (if (string-match "\n[^ \t\n\r]+:" contype)
|
|
|
1265 (setq ctype (substring contype 0 (match-beginning 0))
|
|
|
1266 opt-fields (substring contype (match-beginning 0)))
|
|
|
1267 (setq ctype contype)
|
|
|
1268 )
|
|
|
1269 (if (string-match
|
|
|
1270 (concat
|
|
|
1271 ";[ \t\n]*\\("
|
|
|
1272 (regexp-quote parameter)
|
|
|
1273 "[ \t\n]*=[ \t\n]*\\([^\" \t\n;]*\\|\"[^\"]*\"\\)\\)[ \t\n]*\\(;\\|$\\)")
|
|
|
1274 ctype)
|
|
|
1275 ;; Change value
|
|
|
1276 (concat (substring ctype 0 (match-beginning 1))
|
|
|
1277 parameter "=" value
|
|
|
1278 (substring contype (match-end 1))
|
|
|
1279 opt-fields)
|
|
|
1280 (concat ctype "; " parameter "=" value opt-fields)
|
|
|
1281 )))
|
|
|
1282
|
|
|
1283 (defun mime-strip-parameters (contype)
|
|
|
1284 "Return primary content-type and subtype without parameters for CONTYPE."
|
|
|
1285 (if (string-match "^[ \t]*\\([^; \t\n]*\\)" contype)
|
|
|
1286 (substring contype (match-beginning 1) (match-end 1)) nil))
|
|
|
1287
|
|
|
1288 (defun mime-test-content-type (contype type &optional subtype)
|
|
|
1289 "Test if CONTYPE is a TYPE and an optional SUBTYPE."
|
|
|
1290 (and (stringp contype)
|
|
|
1291 (stringp type)
|
|
|
1292 (string-match
|
|
|
1293 (concat "^[ \t]*" (downcase type) "/" (downcase (or subtype "")))
|
|
|
1294 (downcase contype))))
|
|
|
1295
|
|
|
1296
|
|
|
1297 ;; Basic functions
|
|
|
1298
|
|
|
1299 (defun mime-find-file-type (file)
|
|
|
1300 "Guess Content-Type, subtype, and parameters from FILE."
|
|
|
1301 (let ((guess nil)
|
|
|
1302 (guesses mime-file-types))
|
|
|
1303 (while (and (not guess) guesses)
|
|
|
1304 (if (string-match (car (car guesses)) file)
|
|
|
1305 (setq guess (cdr (car guesses))))
|
|
|
1306 (setq guesses (cdr guesses)))
|
|
|
1307 guess
|
|
|
1308 ))
|
|
|
1309
|
|
76
|
1310 (defun mime-prompt-for-type (&optional default)
|
|
4
|
1311 "Ask for Content-type."
|
|
|
1312 (let ((type ""))
|
|
|
1313 ;; Repeat until primary content type is specified.
|
|
|
1314 (while (string-equal type "")
|
|
|
1315 (setq type
|
|
|
1316 (completing-read "What content type: "
|
|
|
1317 mime-content-types
|
|
|
1318 nil
|
|
|
1319 'require-match ;Type must be specified.
|
|
76
|
1320 default
|
|
4
|
1321 ))
|
|
|
1322 (if (string-equal type "")
|
|
|
1323 (progn
|
|
|
1324 (message "Content type is required.")
|
|
|
1325 (beep)
|
|
|
1326 (sit-for 1)
|
|
|
1327 ))
|
|
|
1328 )
|
|
76
|
1329 type))
|
|
4
|
1330
|
|
76
|
1331 (defun mime-prompt-for-subtype (type &optional default)
|
|
|
1332 "Ask for subtype of media-type TYPE."
|
|
|
1333 (let ((subtypes (cdr (assoc type mime-content-types))))
|
|
|
1334 (or (and default
|
|
|
1335 (assoc default subtypes))
|
|
|
1336 (setq default (car (car subtypes)))
|
|
|
1337 ))
|
|
|
1338 (let* ((answer
|
|
4
|
1339 (completing-read
|
|
|
1340 (if default
|
|
|
1341 (concat
|
|
|
1342 "What content subtype: (default " default ") ")
|
|
|
1343 "What content subtype: ")
|
|
76
|
1344 (cdr (assoc type mime-content-types))
|
|
4
|
1345 nil
|
|
|
1346 'require-match ;Subtype must be specified.
|
|
|
1347 nil
|
|
|
1348 )))
|
|
|
1349 (if (string-equal answer "") default answer)))
|
|
|
1350
|
|
|
1351 (defun mime-prompt-for-parameters (pritype subtype &optional delimiter)
|
|
|
1352 "Ask for Content-type parameters of Content-Type PRITYPE and SUBTYPE.
|
|
|
1353 Optional DELIMITER specifies parameter delimiter (';' by default)."
|
|
|
1354 (let* ((delimiter (or delimiter "; "))
|
|
|
1355 (parameters
|
|
|
1356 (mapconcat
|
|
|
1357 (function identity)
|
|
|
1358 (delq nil
|
|
|
1359 (mime-prompt-for-parameters-1
|
|
|
1360 (cdr (assoc subtype
|
|
|
1361 (cdr (assoc pritype mime-content-types))))))
|
|
|
1362 delimiter
|
|
|
1363 )))
|
|
|
1364 (if (and (stringp parameters)
|
|
|
1365 (not (string-equal parameters "")))
|
|
|
1366 (concat delimiter parameters)
|
|
|
1367 "" ;"" if no parameters
|
|
|
1368 )))
|
|
|
1369
|
|
|
1370 (defun mime-prompt-for-parameters-1 (optlist)
|
|
|
1371 (apply (function append)
|
|
|
1372 (mapcar (function mime-prompt-for-parameter) optlist)))
|
|
|
1373
|
|
|
1374 (defun mime-prompt-for-parameter (parameter)
|
|
|
1375 "Ask for PARAMETER.
|
|
|
1376 Parameter must be '(PROMPT CHOICE1 (CHOISE2 ...))."
|
|
|
1377 (let* ((prompt (car parameter))
|
|
|
1378 (choices (mapcar (function
|
|
|
1379 (lambda (e)
|
|
|
1380 (if (consp e) e (list e))))
|
|
|
1381 (cdr parameter)))
|
|
|
1382 (default (car (car choices)))
|
|
|
1383 (answer nil))
|
|
|
1384 (if choices
|
|
|
1385 (progn
|
|
|
1386 (setq answer
|
|
|
1387 (completing-read
|
|
|
1388 (concat "What " prompt
|
|
|
1389 ": (default "
|
|
|
1390 (if (string-equal default "") "\"\"" default)
|
|
|
1391 ") ")
|
|
|
1392 choices nil nil ""))
|
|
|
1393 ;; If nothing is selected, use default.
|
|
|
1394 (if (string-equal answer "")
|
|
|
1395 (setq answer default)))
|
|
|
1396 (setq answer
|
|
|
1397 (read-string (concat "What " prompt ": "))))
|
|
|
1398 (cons (if (and answer
|
|
|
1399 (not (string-equal answer "")))
|
|
|
1400 (concat prompt "="
|
|
|
1401 ;; Note: control characters ignored!
|
|
|
1402 (if (string-match mime-tspecials-regexp answer)
|
|
|
1403 (concat "\"" answer "\"") answer)))
|
|
|
1404 (mime-prompt-for-parameters-1 (cdr (assoc answer (cdr parameter)))))
|
|
|
1405 ))
|
|
|
1406
|
|
76
|
1407 (defun mime-prompt-for-encoding (default)
|
|
|
1408 "Ask for Content-Transfer-Encoding. [tm-edit.el]"
|
|
|
1409 (let (encoding)
|
|
|
1410 (while (string=
|
|
|
1411 (setq encoding
|
|
|
1412 (completing-read
|
|
|
1413 "What transfer encoding: "
|
|
|
1414 mime-file-encoding-method-alist nil t default)
|
|
|
1415 )
|
|
|
1416 ""))
|
|
|
1417 encoding))
|
|
4
|
1418
|
|
|
1419
|
|
|
1420 ;;; @ Translate the tagged MIME messages into a MIME compliant message.
|
|
|
1421 ;;;
|
|
|
1422
|
|
|
1423 (defvar mime-editor/translate-buffer-hook
|
|
|
1424 '(mime-editor/pgp-enclose-buffer
|
|
|
1425 mime-editor/translate-header
|
|
|
1426 mime-editor/translate-body))
|
|
|
1427
|
|
|
1428 (defun mime-editor/translate-header ()
|
|
|
1429 "Encode the message header into network representation."
|
|
|
1430 (mime/encode-message-header 'code-conversion)
|
|
|
1431 (run-hooks 'mime-editor/translate-header-hook)
|
|
|
1432 )
|
|
|
1433
|
|
|
1434 (defun mime-editor/translate-buffer ()
|
|
|
1435 "Encode the tagged MIME message in current buffer in MIME compliant message."
|
|
|
1436 (interactive)
|
|
|
1437 (if (catch 'mime-editor/error
|
|
|
1438 (save-excursion
|
|
|
1439 (run-hooks 'mime-editor/translate-buffer-hook)
|
|
|
1440 ))
|
|
|
1441 (progn
|
|
|
1442 (undo)
|
|
|
1443 (error "Translation error!")
|
|
|
1444 )))
|
|
|
1445
|
|
|
1446 (defun mime-editor/find-inmost ()
|
|
|
1447 (goto-char (point-min))
|
|
|
1448 (if (re-search-forward mime-editor/multipart-beginning-regexp nil t)
|
|
|
1449 (let ((bb (match-beginning 0))
|
|
|
1450 (be (match-end 0))
|
|
|
1451 (type (buffer-substring (match-beginning 1)(match-end 1)))
|
|
|
1452 end-exp eb ee)
|
|
|
1453 (setq end-exp (format "--}-<<%s>>\n" type))
|
|
|
1454 (widen)
|
|
|
1455 (if (re-search-forward end-exp nil t)
|
|
|
1456 (progn
|
|
|
1457 (setq eb (match-beginning 0))
|
|
|
1458 (setq ee (match-end 0))
|
|
|
1459 )
|
|
|
1460 (setq eb (point-max))
|
|
|
1461 (setq ee (point-max))
|
|
|
1462 )
|
|
|
1463 (narrow-to-region be eb)
|
|
|
1464 (goto-char be)
|
|
|
1465 (if (re-search-forward mime-editor/multipart-beginning-regexp nil t)
|
|
|
1466 (let (ret)
|
|
|
1467 (narrow-to-region (match-beginning 0)(point-max))
|
|
|
1468 (mime-editor/find-inmost)
|
|
|
1469 )
|
|
|
1470 (widen)
|
|
|
1471 (list type bb be eb)
|
|
|
1472 ))))
|
|
|
1473
|
|
|
1474 (defun mime-editor/process-multipart-1 (boundary)
|
|
|
1475 (let ((ret (mime-editor/find-inmost)))
|
|
|
1476 (if ret
|
|
|
1477 (let ((type (car ret))
|
|
|
1478 (bb (nth 1 ret))(be (nth 2 ret))
|
|
|
1479 (eb (nth 3 ret))
|
|
|
1480 )
|
|
|
1481 (narrow-to-region bb eb)
|
|
|
1482 (delete-region bb be)
|
|
|
1483 (setq bb (point-min))
|
|
|
1484 (setq eb (point-max))
|
|
|
1485 (widen)
|
|
|
1486 (goto-char eb)
|
|
|
1487 (if (looking-at mime-editor/multipart-end-regexp)
|
|
|
1488 (let ((beg (match-beginning 0))
|
|
|
1489 (end (match-end 0))
|
|
|
1490 )
|
|
|
1491 (delete-region beg end)
|
|
|
1492 (or (looking-at mime-editor/beginning-tag-regexp)
|
|
|
1493 (eobp)
|
|
|
1494 (insert (concat (mime-make-text-tag) "\n"))
|
|
|
1495 )))
|
|
|
1496 (cond ((string-equal type "quote")
|
|
|
1497 (mime-editor/enquote-region bb eb)
|
|
|
1498 )
|
|
|
1499 ((string-equal type "signed")
|
|
|
1500 (cond ((eq mime-editor/signing-type 'pgp-elkins)
|
|
|
1501 (mime-editor/sign-pgp-elkins bb eb boundary)
|
|
|
1502 )
|
|
|
1503 ((eq mime-editor/signing-type 'pgp-kazu)
|
|
|
1504 (mime-editor/sign-pgp-kazu bb eb boundary)
|
|
|
1505 ))
|
|
|
1506 )
|
|
|
1507 ((string-equal type "encrypted")
|
|
|
1508 (cond ((eq mime-editor/encrypting-type 'pgp-elkins)
|
|
|
1509 (mime-editor/encrypt-pgp-elkins bb eb boundary)
|
|
|
1510 )
|
|
|
1511 ((eq mime-editor/encrypting-type 'pgp-kazu)
|
|
|
1512 (mime-editor/encrypt-pgp-kazu bb eb boundary)
|
|
|
1513 )))
|
|
|
1514 (t
|
|
|
1515 (setq boundary
|
|
|
1516 (nth 2 (mime-editor/translate-region bb eb
|
|
|
1517 boundary t)))
|
|
|
1518 (goto-char bb)
|
|
|
1519 (insert
|
|
|
1520 (format "--[[multipart/%s;
|
|
|
1521 boundary=\"%s\"][7bit]]\n"
|
|
|
1522 type boundary))
|
|
|
1523 ))
|
|
|
1524 boundary))))
|
|
|
1525
|
|
|
1526 (defun mime-editor/enquote-region (beg end)
|
|
|
1527 (save-excursion
|
|
|
1528 (save-restriction
|
|
|
1529 (narrow-to-region beg end)
|
|
|
1530 (goto-char beg)
|
|
|
1531 (while (re-search-forward mime-editor/single-part-tag-regexp nil t)
|
|
|
1532 (let ((tag (buffer-substring (match-beginning 0)(match-end 0))))
|
|
|
1533 (replace-match (concat "- " (substring tag 1)))
|
|
|
1534 )))))
|
|
|
1535
|
|
|
1536 (defun mime-editor/dequote-region (beg end)
|
|
|
1537 (save-excursion
|
|
|
1538 (save-restriction
|
|
|
1539 (narrow-to-region beg end)
|
|
|
1540 (goto-char beg)
|
|
|
1541 (while (re-search-forward
|
|
|
1542 mime-editor/quoted-single-part-tag-regexp nil t)
|
|
|
1543 (let ((tag (buffer-substring (match-beginning 0)(match-end 0))))
|
|
|
1544 (replace-match (concat "-" (substring tag 2)))
|
|
|
1545 )))))
|
|
|
1546
|
|
|
1547 (defun mime-editor/sign-pgp-elkins (beg end boundary)
|
|
|
1548 (save-excursion
|
|
|
1549 (save-restriction
|
|
|
1550 (narrow-to-region beg end)
|
|
|
1551 (let* ((ret
|
|
|
1552 (mime-editor/translate-region beg end boundary))
|
|
|
1553 (ctype (car ret))
|
|
|
1554 (encoding (nth 1 ret))
|
|
|
1555 (parts (nth 3 ret))
|
|
|
1556 (pgp-boundary (concat "pgp-sign-" boundary))
|
|
|
1557 )
|
|
|
1558 (goto-char beg)
|
|
|
1559 (insert (format "Content-Type: %s\n" ctype))
|
|
|
1560 (if encoding
|
|
|
1561 (insert (format "Content-Transfer-Encoding: %s\n" encoding))
|
|
|
1562 )
|
|
|
1563 (insert "\n")
|
|
70
|
1564 (or (funcall mime-editor/pgp-sign-function
|
|
4
|
1565 (point-min)(point-max) nil nil pgp-boundary)
|
|
|
1566 (throw 'mime-editor/error 'pgp-error)
|
|
|
1567 )
|
|
|
1568 ))))
|
|
|
1569
|
|
|
1570 (defvar mime-editor/encrypt-recipient-fields-list '("To" "cc"))
|
|
|
1571
|
|
|
1572 (defun mime-editor/make-encrypt-recipient-header ()
|
|
|
1573 (let* ((names mime-editor/encrypt-recipient-fields-list)
|
|
|
1574 (values
|
|
|
1575 (std11-field-bodies (cons "From" names)
|
|
|
1576 nil mail-header-separator))
|
|
|
1577 (from (prog1
|
|
|
1578 (car values)
|
|
|
1579 (setq values (cdr values))))
|
|
|
1580 (header (and (stringp from)
|
|
|
1581 (if (string-equal from "")
|
|
|
1582 ""
|
|
|
1583 (format "From: %s\n" from)
|
|
|
1584 )))
|
|
|
1585 recipients)
|
|
|
1586 (while (and names values)
|
|
|
1587 (let ((name (car names))
|
|
|
1588 (value (car values))
|
|
|
1589 )
|
|
|
1590 (and (stringp value)
|
|
|
1591 (or (string-equal value "")
|
|
|
1592 (progn
|
|
|
1593 (setq header (concat header name ": " value "\n")
|
|
|
1594 recipients (if recipients
|
|
|
1595 (concat recipients " ," value)
|
|
|
1596 value))
|
|
|
1597 ))))
|
|
|
1598 (setq names (cdr names)
|
|
|
1599 values (cdr values))
|
|
|
1600 )
|
|
|
1601 (vector from recipients header)
|
|
|
1602 ))
|
|
|
1603
|
|
|
1604 (defun mime-editor/encrypt-pgp-elkins (beg end boundary)
|
|
|
1605 (save-excursion
|
|
|
1606 (save-restriction
|
|
|
1607 (let (from recipients header)
|
|
|
1608 (let ((ret (mime-editor/make-encrypt-recipient-header)))
|
|
|
1609 (setq from (aref ret 0)
|
|
|
1610 recipients (aref ret 1)
|
|
|
1611 header (aref ret 2))
|
|
|
1612 )
|
|
|
1613 (narrow-to-region beg end)
|
|
|
1614 (let* ((ret
|
|
|
1615 (mime-editor/translate-region beg end boundary))
|
|
|
1616 (ctype (car ret))
|
|
|
1617 (encoding (nth 1 ret))
|
|
|
1618 (parts (nth 3 ret))
|
|
|
1619 (pgp-boundary (concat "pgp-" boundary))
|
|
|
1620 )
|
|
|
1621 (goto-char beg)
|
|
|
1622 (insert header)
|
|
|
1623 (insert (format "Content-Type: %s\n" ctype))
|
|
|
1624 (if encoding
|
|
|
1625 (insert (format "Content-Transfer-Encoding: %s\n" encoding))
|
|
|
1626 )
|
|
|
1627 (insert "\n")
|
|
70
|
1628 (or (funcall mime-editor/pgp-encrypt-function
|
|
4
|
1629 recipients (point-min) (point-max) from)
|
|
|
1630 (throw 'mime-editor/error 'pgp-error)
|
|
|
1631 )
|
|
|
1632 (goto-char beg)
|
|
|
1633 (insert (format "--[[multipart/encrypted;
|
|
|
1634 boundary=\"%s\";
|
|
|
1635 protocol=\"application/pgp-encrypted\"][7bit]]
|
|
|
1636 --%s
|
|
|
1637 Content-Type: application/pgp-encrypted
|
|
|
1638
|
|
|
1639 --%s
|
|
|
1640 Content-Type: application/octet-stream
|
|
|
1641 Content-Transfer-Encoding: 7bit
|
|
|
1642
|
|
|
1643 " pgp-boundary pgp-boundary pgp-boundary))
|
|
|
1644 (goto-char (point-max))
|
|
|
1645 (insert (format "\n--%s--\n" pgp-boundary))
|
|
|
1646 )))))
|
|
|
1647
|
|
|
1648 (defun mime-editor/sign-pgp-kazu (beg end boundary)
|
|
|
1649 (save-excursion
|
|
|
1650 (save-restriction
|
|
|
1651 (narrow-to-region beg end)
|
|
|
1652 (let* ((ret
|
|
|
1653 (mime-editor/translate-region beg end boundary))
|
|
|
1654 (ctype (car ret))
|
|
|
1655 (encoding (nth 1 ret))
|
|
|
1656 (parts (nth 3 ret))
|
|
|
1657 )
|
|
|
1658 (goto-char beg)
|
|
|
1659 (insert (format "Content-Type: %s\n" ctype))
|
|
|
1660 (if encoding
|
|
|
1661 (insert (format "Content-Transfer-Encoding: %s\n" encoding))
|
|
|
1662 )
|
|
|
1663 (insert "\n")
|
|
|
1664 (or (as-binary-process
|
|
70
|
1665 (funcall mime-editor/traditional-pgp-sign-function
|
|
4
|
1666 beg (point-max)))
|
|
|
1667 (throw 'mime-editor/error 'pgp-error)
|
|
|
1668 )
|
|
|
1669 (goto-char beg)
|
|
|
1670 (insert
|
|
|
1671 "--[[application/pgp; format=mime][7bit]]\n")
|
|
|
1672 ))
|
|
|
1673 ))
|
|
|
1674
|
|
|
1675 (defun mime-editor/encrypt-pgp-kazu (beg end boundary)
|
|
|
1676 (save-excursion
|
|
|
1677 (let (from recipients header)
|
|
|
1678 (let ((ret (mime-editor/make-encrypt-recipient-header)))
|
|
|
1679 (setq from (aref ret 0)
|
|
|
1680 recipients (aref ret 1)
|
|
|
1681 header (aref ret 2))
|
|
|
1682 )
|
|
|
1683 (save-restriction
|
|
|
1684 (narrow-to-region beg end)
|
|
|
1685 (let* ((ret
|
|
|
1686 (mime-editor/translate-region beg end boundary))
|
|
|
1687 (ctype (car ret))
|
|
|
1688 (encoding (nth 1 ret))
|
|
|
1689 (parts (nth 3 ret))
|
|
|
1690 )
|
|
|
1691 (goto-char beg)
|
|
|
1692 (insert header)
|
|
|
1693 (insert (format "Content-Type: %s\n" ctype))
|
|
|
1694 (if encoding
|
|
|
1695 (insert (format "Content-Transfer-Encoding: %s\n" encoding))
|
|
|
1696 )
|
|
|
1697 (insert "\n")
|
|
|
1698 (or (as-binary-process
|
|
70
|
1699 (funcall mime-editor/pgp-encrypt-function
|
|
4
|
1700 recipients beg (point-max) nil 'maybe)
|
|
|
1701 )
|
|
|
1702 (throw 'mime-editor/error 'pgp-error)
|
|
|
1703 )
|
|
|
1704 (goto-char beg)
|
|
|
1705 (insert
|
|
|
1706 "--[[application/pgp; format=mime][7bit]]\n")
|
|
|
1707 ))
|
|
|
1708 )))
|
|
|
1709
|
|
|
1710 (defun mime-editor/translate-body ()
|
|
|
1711 "Encode the tagged MIME body in current buffer in MIME compliant message."
|
|
|
1712 (interactive)
|
|
|
1713 (save-excursion
|
|
|
1714 (let ((boundary
|
|
|
1715 (concat mime-multipart-boundary "_"
|
|
|
1716 (replace-space-with-underline (current-time-string))
|
|
|
1717 ))
|
|
|
1718 (i 1)
|
|
|
1719 ret)
|
|
|
1720 (while (mime-editor/process-multipart-1
|
|
|
1721 (format "%s-%d" boundary i))
|
|
|
1722 (setq i (1+ i))
|
|
|
1723 )
|
|
|
1724 (save-restriction
|
|
|
1725 ;; We are interested in message body.
|
|
|
1726 (let* ((beg
|
|
|
1727 (progn
|
|
|
1728 (goto-char (point-min))
|
|
|
1729 (re-search-forward
|
|
|
1730 (concat "\n" (regexp-quote mail-header-separator)
|
|
|
1731 (if mime-ignore-preceding-spaces
|
|
|
1732 "[ \t\n]*\n" "\n")) nil 'move)
|
|
|
1733 (point)))
|
|
|
1734 (end
|
|
|
1735 (progn
|
|
|
1736 (goto-char (point-max))
|
|
|
1737 (and mime-ignore-trailing-spaces
|
|
|
1738 (re-search-backward "[^ \t\n]\n" beg t)
|
|
|
1739 (forward-char 1))
|
|
|
1740 (point))))
|
|
|
1741 (setq ret (mime-editor/translate-region
|
|
|
1742 beg end
|
|
|
1743 (format "%s-%d" boundary i)))
|
|
|
1744 ))
|
|
|
1745 (mime-editor/dequote-region (point-min)(point-max))
|
|
|
1746 (let ((contype (car ret)) ;Content-Type
|
|
|
1747 (encoding (nth 1 ret)) ;Content-Transfer-Encoding
|
|
|
1748 )
|
|
|
1749 ;; Make primary MIME headers.
|
|
|
1750 (or (mail-position-on-field "Mime-Version")
|
|
|
1751 (insert mime-editor/mime-version-value))
|
|
|
1752 ;; Remove old Content-Type and other fields.
|
|
|
1753 (save-restriction
|
|
|
1754 (goto-char (point-min))
|
|
|
1755 (search-forward (concat "\n" mail-header-separator "\n") nil t)
|
|
|
1756 (narrow-to-region (point-min) (point))
|
|
|
1757 (goto-char (point-min))
|
|
|
1758 (mime-delete-field "Content-Type")
|
|
|
1759 (mime-delete-field "Content-Transfer-Encoding"))
|
|
|
1760 ;; Then, insert Content-Type and Content-Transfer-Encoding fields.
|
|
|
1761 (mail-position-on-field "Content-Type")
|
|
|
1762 (insert contype)
|
|
|
1763 (if encoding
|
|
|
1764 (progn
|
|
|
1765 (mail-position-on-field "Content-Transfer-Encoding")
|
|
|
1766 (insert encoding)))
|
|
|
1767 ))))
|
|
|
1768
|
|
|
1769 (defun mime-editor/translate-single-part-tag (&optional prefix)
|
|
|
1770 (if (re-search-forward mime-editor/single-part-tag-regexp nil t)
|
|
|
1771 (let* ((beg (match-beginning 0))
|
|
|
1772 (end (match-end 0))
|
|
|
1773 (tag (buffer-substring beg end))
|
|
|
1774 )
|
|
|
1775 (delete-region beg end)
|
|
70
|
1776 (setq contype (mime-editor/get-contype tag))
|
|
|
1777 (setq encoding (mime-editor/get-encoding tag))
|
|
|
1778 (insert (concat prefix "--" boundary "\n"))
|
|
|
1779 (save-restriction
|
|
|
1780 (narrow-to-region (point)(point))
|
|
|
1781 (insert "Content-Type: " contype "\n")
|
|
|
1782 (if encoding
|
|
|
1783 (insert "Content-Transfer-Encoding: " encoding "\n"))
|
|
|
1784 (mime/encode-message-header)
|
|
|
1785 )
|
|
4
|
1786 t)))
|
|
|
1787
|
|
|
1788 (defun mime-editor/translate-region (beg end &optional boundary multipart)
|
|
|
1789 (if (null boundary)
|
|
|
1790 (setq boundary
|
|
|
1791 (concat mime-multipart-boundary "_"
|
|
|
1792 (replace-space-with-underline (current-time-string))))
|
|
|
1793 )
|
|
|
1794 (save-excursion
|
|
|
1795 (save-restriction
|
|
|
1796 (narrow-to-region beg end)
|
|
|
1797 (let ((tag nil) ;MIME tag
|
|
|
1798 (contype nil) ;Content-Type
|
|
|
1799 (encoding nil) ;Content-Transfer-Encoding
|
|
|
1800 (nparts 0)) ;Number of body parts
|
|
|
1801 ;; Normalize the body part by inserting appropriate message
|
|
|
1802 ;; tags for every message contents.
|
|
|
1803 (mime-editor/normalize-body)
|
|
|
1804 ;; Counting the number of Content-Type.
|
|
|
1805 (goto-char (point-min))
|
|
|
1806 (while (re-search-forward mime-editor/single-part-tag-regexp nil t)
|
|
|
1807 (setq nparts (1+ nparts)))
|
|
|
1808 ;; Begin translation.
|
|
|
1809 (cond
|
|
|
1810 ((and (<= nparts 1)(not multipart))
|
|
|
1811 ;; It's a singular message.
|
|
|
1812 (goto-char (point-min))
|
|
|
1813 (while (re-search-forward
|
|
|
1814 mime-editor/single-part-tag-regexp nil t)
|
|
|
1815 (setq tag
|
|
|
1816 (buffer-substring (match-beginning 0) (match-end 0)))
|
|
|
1817 (delete-region (match-beginning 0) (1+ (match-end 0)))
|
|
|
1818 (setq contype (mime-editor/get-contype tag))
|
|
|
1819 (setq encoding (mime-editor/get-encoding tag))
|
|
|
1820 ))
|
|
|
1821 (t
|
|
|
1822 ;; It's a multipart message.
|
|
|
1823 (goto-char (point-min))
|
|
|
1824 (and (mime-editor/translate-single-part-tag)
|
|
|
1825 (while (mime-editor/translate-single-part-tag "\n"))
|
|
|
1826 )
|
|
|
1827 ;; Define Content-Type as "multipart/mixed".
|
|
|
1828 (setq contype
|
|
|
1829 (concat "multipart/mixed;\n boundary=\"" boundary "\""))
|
|
|
1830 ;; Content-Transfer-Encoding must be "7bit".
|
|
|
1831 ;; The following encoding can be `nil', but is
|
|
|
1832 ;; specified as is since there is no way that a user
|
|
|
1833 ;; specifies it.
|
|
|
1834 (setq encoding "7bit")
|
|
|
1835 ;; Insert the trailer.
|
|
|
1836 (goto-char (point-max))
|
|
|
1837 (insert "\n--" boundary "--\n")
|
|
|
1838 ))
|
|
|
1839 (list contype encoding boundary nparts)
|
|
|
1840 ))))
|
|
|
1841
|
|
|
1842 (defun mime-editor/normalize-body ()
|
|
|
1843 "Normalize the body part by inserting appropriate message tags."
|
|
|
1844 ;; Insert the first MIME tags if necessary.
|
|
|
1845 (goto-char (point-min))
|
|
|
1846 (if (not (looking-at mime-editor/single-part-tag-regexp))
|
|
|
1847 (insert (mime-make-text-tag) "\n"))
|
|
|
1848 ;; Check each tag, and add new tag or correct it if necessary.
|
|
|
1849 (goto-char (point-min))
|
|
|
1850 (while (re-search-forward mime-editor/single-part-tag-regexp nil t)
|
|
|
1851 (let* ((tag (buffer-substring (match-beginning 0) (match-end 0)))
|
|
|
1852 (contype (mime-editor/get-contype tag))
|
|
|
1853 (charset (mime-get-parameter contype "charset"))
|
|
|
1854 (encoding (mime-editor/get-encoding tag)))
|
|
|
1855 ;; Remove extra whitespaces after the tag.
|
|
|
1856 (if (looking-at "[ \t]+$")
|
|
|
1857 (delete-region (match-beginning 0) (match-end 0)))
|
|
|
1858 (let ((beg (point))
|
|
|
1859 (end (mime-editor/content-end))
|
|
|
1860 )
|
|
|
1861 (if (= end (point-max))
|
|
|
1862 nil
|
|
|
1863 (goto-char end)
|
|
|
1864 (or (looking-at mime-editor/beginning-tag-regexp)
|
|
|
1865 (eobp)
|
|
|
1866 (insert (mime-make-text-tag) "\n")
|
|
|
1867 ))
|
|
|
1868 (visible-region beg end)
|
|
|
1869 (goto-char beg)
|
|
|
1870 )
|
|
|
1871 (cond
|
|
|
1872 ((mime-test-content-type contype "message")
|
|
|
1873 ;; Content-type "message" should be sent as is.
|
|
|
1874 (forward-line 1)
|
|
|
1875 )
|
|
|
1876 ((mime-test-content-type contype "text")
|
|
|
1877 ;; Define charset for text if necessary.
|
|
|
1878 (setq charset (if charset
|
|
|
1879 (intern (downcase charset))
|
|
|
1880 (mime-editor/choose-charset)))
|
|
|
1881 (mime-editor/define-charset charset)
|
|
|
1882 (cond ((string-equal contype "text/x-rot13-47")
|
|
|
1883 (save-excursion
|
|
|
1884 (forward-line)
|
|
|
1885 (set-mark (point))
|
|
|
1886 (goto-char (mime-editor/content-end))
|
|
|
1887 (tm:caesar-region)
|
|
|
1888 ))
|
|
|
1889 ((string-equal contype "text/enriched")
|
|
|
1890 (save-excursion
|
|
|
1891 (let ((beg (progn
|
|
|
1892 (forward-line)
|
|
|
1893 (point)))
|
|
|
1894 (end (mime-editor/content-end))
|
|
|
1895 )
|
|
|
1896 ;; Patch for hard newlines
|
|
|
1897 ;; (save-excursion
|
|
|
1898 ;; (goto-char beg)
|
|
|
1899 ;; (while (search-forward "\n" end t)
|
|
|
1900 ;; (put-text-property (match-beginning 0)
|
|
|
1901 ;; (point)
|
|
|
1902 ;; 'hard t)))
|
|
|
1903 ;; End patch for hard newlines
|
|
|
1904 (enriched-encode beg end)
|
|
|
1905 (goto-char beg)
|
|
|
1906 (if (search-forward "\n\n")
|
|
|
1907 (delete-region beg (match-end 0))
|
|
|
1908 )
|
|
|
1909 ))))
|
|
|
1910 ;; Point is now on current tag.
|
|
|
1911 ;; Define encoding and encode text if necessary.
|
|
|
1912 (or encoding ;Encoding is not specified.
|
|
|
1913 (let* ((encoding
|
|
|
1914 (cdr
|
|
|
1915 (assq charset
|
|
|
1916 mime-editor/charset-default-encoding-alist)
|
|
|
1917 ))
|
|
|
1918 (beg (mime-editor/content-beginning))
|
|
|
1919 )
|
|
|
1920 (encode-mime-charset-region beg (mime-editor/content-end)
|
|
|
1921 charset)
|
|
|
1922 (mime-encode-region beg (mime-editor/content-end) encoding)
|
|
|
1923 (mime-editor/define-encoding encoding)
|
|
|
1924 ))
|
|
|
1925 (goto-char (mime-editor/content-end))
|
|
|
1926 )
|
|
|
1927 ((null encoding) ;Encoding is not specified.
|
|
|
1928 ;; Application, image, audio, video, and any other
|
|
|
1929 ;; unknown content-type without encoding should be
|
|
|
1930 ;; encoded.
|
|
|
1931 (let* ((encoding "base64") ;Encode in BASE64 by default.
|
|
|
1932 (beg (mime-editor/content-beginning))
|
|
|
1933 (end (mime-editor/content-end))
|
|
|
1934 (body (buffer-substring beg end))
|
|
|
1935 )
|
|
|
1936 (mime-encode-region beg end encoding)
|
|
|
1937 (mime-editor/define-encoding encoding))
|
|
|
1938 (forward-line 1)
|
|
|
1939 ))
|
|
|
1940 )))
|
|
|
1941
|
|
|
1942 (defun mime-delete-field (field)
|
|
|
1943 "Delete header FIELD."
|
|
|
1944 (let ((regexp (format "^%s:[ \t]*" field)))
|
|
|
1945 (goto-char (point-min))
|
|
|
1946 (while (re-search-forward regexp nil t)
|
|
|
1947 (delete-region (match-beginning 0)
|
|
|
1948 (progn (forward-line 1) (point)))
|
|
|
1949 )))
|
|
|
1950
|
|
|
1951
|
|
|
1952 ;;;
|
|
|
1953 ;;; Platform dependent functions
|
|
|
1954 ;;;
|
|
|
1955
|
|
|
1956 ;; Sun implementations
|
|
|
1957
|
|
|
1958 (defun mime-editor/voice-recorder-for-sun (encoding)
|
|
|
1959 "Record voice in a buffer using Sun audio device,
|
|
|
1960 and insert data encoded as ENCODING. [tm-edit.el]"
|
|
|
1961 (message "Start the recording on %s. Type C-g to finish the recording..."
|
|
|
1962 (system-name))
|
|
|
1963 (mime-insert-encoded-file "/dev/audio" encoding)
|
|
|
1964 )
|
|
|
1965
|
|
|
1966
|
|
|
1967 ;;; @ Other useful commands.
|
|
|
1968 ;;;
|
|
|
1969
|
|
|
1970 ;; Message forwarding commands as content-type "message/rfc822".
|
|
|
1971
|
|
|
1972 (defun mime-editor/insert-message (&optional message)
|
|
|
1973 (interactive)
|
|
|
1974 (let ((inserter (assoc-value major-mode mime-editor/message-inserter-alist)))
|
|
|
1975 (if (and inserter (fboundp inserter))
|
|
|
1976 (progn
|
|
|
1977 (mime-editor/insert-tag "message" "rfc822")
|
|
|
1978 (funcall inserter message)
|
|
|
1979 )
|
|
|
1980 (message "Sorry, I don't have message inserter for your MUA.")
|
|
|
1981 )))
|
|
|
1982
|
|
|
1983 (defun mime-editor/insert-mail (&optional message)
|
|
|
1984 (interactive)
|
|
|
1985 (let ((inserter (assoc-value major-mode mime-editor/mail-inserter-alist)))
|
|
|
1986 (if (and inserter (fboundp inserter))
|
|
|
1987 (progn
|
|
|
1988 (mime-editor/insert-tag "message" "rfc822")
|
|
|
1989 (funcall inserter message)
|
|
|
1990 )
|
|
|
1991 (message "Sorry, I don't have mail inserter for your MUA.")
|
|
|
1992 )))
|
|
|
1993
|
|
|
1994 (defun mime-editor/inserted-message-filter ()
|
|
|
1995 (save-excursion
|
|
|
1996 (save-restriction
|
|
|
1997 (let ((header-start (point))
|
|
|
1998 (case-fold-search t)
|
|
|
1999 beg end)
|
|
|
2000 ;; for Emacs 18
|
|
|
2001 ;; (if (re-search-forward "^$" (marker-position (mark-marker)))
|
|
|
2002 (if (re-search-forward "^$" (mark t))
|
|
|
2003 (narrow-to-region header-start (match-beginning 0))
|
|
|
2004 )
|
|
|
2005 (goto-char header-start)
|
|
|
2006 (while (and (re-search-forward
|
|
|
2007 mime-editor/yank-ignored-field-regexp nil t)
|
|
|
2008 (setq beg (match-beginning 0))
|
|
|
2009 (setq end (1+ (std11-field-end)))
|
|
|
2010 )
|
|
|
2011 (delete-region beg end)
|
|
|
2012 )
|
|
|
2013 ))))
|
|
|
2014
|
|
|
2015
|
|
|
2016 ;;; @ multipart enclosure
|
|
|
2017 ;;;
|
|
|
2018
|
|
|
2019 (defun mime-editor/enclose-region (type beg end)
|
|
|
2020 (save-excursion
|
|
|
2021 (goto-char beg)
|
|
|
2022 (let ((current (point)))
|
|
|
2023 (save-restriction
|
|
|
2024 (narrow-to-region beg end)
|
|
|
2025 (insert (format "--<<%s>>-{\n" type))
|
|
|
2026 (goto-char (point-max))
|
|
|
2027 (insert (format "--}-<<%s>>\n" type))
|
|
|
2028 (goto-char (point-max))
|
|
|
2029 )
|
|
|
2030 (or (looking-at mime-editor/beginning-tag-regexp)
|
|
|
2031 (eobp)
|
|
|
2032 (insert (mime-make-text-tag) "\n")
|
|
|
2033 )
|
|
|
2034 )))
|
|
|
2035
|
|
|
2036 (defun mime-editor/enclose-quote-region (beg end)
|
|
|
2037 (interactive "*r")
|
|
|
2038 (mime-editor/enclose-region "quote" beg end)
|
|
|
2039 )
|
|
|
2040
|
|
|
2041 (defun mime-editor/enclose-mixed-region (beg end)
|
|
|
2042 (interactive "*r")
|
|
|
2043 (mime-editor/enclose-region "mixed" beg end)
|
|
|
2044 )
|
|
|
2045
|
|
|
2046 (defun mime-editor/enclose-parallel-region (beg end)
|
|
|
2047 (interactive "*r")
|
|
|
2048 (mime-editor/enclose-region "parallel" beg end)
|
|
|
2049 )
|
|
|
2050
|
|
|
2051 (defun mime-editor/enclose-digest-region (beg end)
|
|
|
2052 (interactive "*r")
|
|
|
2053 (mime-editor/enclose-region "digest" beg end)
|
|
|
2054 )
|
|
|
2055
|
|
|
2056 (defun mime-editor/enclose-alternative-region (beg end)
|
|
|
2057 (interactive "*r")
|
|
|
2058 (mime-editor/enclose-region "alternative" beg end)
|
|
|
2059 )
|
|
|
2060
|
|
|
2061 (defun mime-editor/enclose-signed-region (beg end)
|
|
|
2062 (interactive "*r")
|
|
|
2063 (if mime-editor/signing-type
|
|
|
2064 (mime-editor/enclose-region "signed" beg end)
|
|
|
2065 (message "Please specify signing type.")
|
|
|
2066 ))
|
|
|
2067
|
|
|
2068 (defun mime-editor/enclose-encrypted-region (beg end)
|
|
|
2069 (interactive "*r")
|
|
|
2070 (if mime-editor/signing-type
|
|
|
2071 (mime-editor/enclose-region "encrypted" beg end)
|
|
|
2072 (message "Please specify encrypting type.")
|
|
|
2073 ))
|
|
|
2074
|
|
|
2075 (defun mime-editor/insert-key (&optional arg)
|
|
|
2076 "Insert a pgp public key."
|
|
|
2077 (interactive "P")
|
|
|
2078 (mime-editor/insert-tag "application" "pgp-keys")
|
|
|
2079 (mime-editor/define-encoding "7bit")
|
|
70
|
2080 (funcall mime-editor/pgp-insert-public-key-function)
|
|
4
|
2081 )
|
|
|
2082
|
|
|
2083
|
|
|
2084 ;;; @ flag setting
|
|
|
2085 ;;;
|
|
|
2086
|
|
|
2087 (defun mime-editor/set-split (arg)
|
|
|
2088 (interactive
|
|
|
2089 (list
|
|
|
2090 (y-or-n-p "Do you want to enable split?")
|
|
|
2091 ))
|
|
|
2092 (setq mime-editor/split-message arg)
|
|
|
2093 (if arg
|
|
|
2094 (message "This message is enabled to split.")
|
|
|
2095 (message "This message is not enabled to split.")
|
|
|
2096 ))
|
|
|
2097
|
|
|
2098 (defun mime-editor/toggle-transfer-level (&optional transfer-level)
|
|
|
2099 "Toggle transfer-level is 7bit or 8bit through.
|
|
|
2100
|
|
|
2101 Optional TRANSFER-LEVEL is a number of transfer-level, 7 or 8."
|
|
|
2102 (interactive)
|
|
|
2103 (if (numberp transfer-level)
|
|
|
2104 (setq mime-editor/transfer-level transfer-level)
|
|
|
2105 (if (< mime-editor/transfer-level 8)
|
|
|
2106 (setq mime-editor/transfer-level 8)
|
|
|
2107 (setq mime-editor/transfer-level 7)
|
|
|
2108 ))
|
|
|
2109 (setq mime-editor/charset-default-encoding-alist
|
|
|
2110 (mime-editor/make-charset-default-encoding-alist
|
|
|
2111 mime-editor/transfer-level))
|
|
|
2112 (message (format "Current transfer-level is %d bit"
|
|
|
2113 mime-editor/transfer-level))
|
|
|
2114 (setq mime-editor/transfer-level-string
|
|
|
2115 (mime/encoding-name mime-editor/transfer-level 'not-omit))
|
|
|
2116 (force-mode-line-update)
|
|
|
2117 )
|
|
|
2118
|
|
|
2119 (defun mime-editor/set-transfer-level-7bit ()
|
|
|
2120 (interactive)
|
|
|
2121 (mime-editor/toggle-transfer-level 7)
|
|
|
2122 )
|
|
|
2123
|
|
|
2124 (defun mime-editor/set-transfer-level-8bit ()
|
|
|
2125 (interactive)
|
|
|
2126 (mime-editor/toggle-transfer-level 8)
|
|
|
2127 )
|
|
|
2128
|
|
|
2129
|
|
|
2130 ;;; @ pgp
|
|
|
2131 ;;;
|
|
|
2132
|
|
|
2133 (defun mime-editor/set-sign (arg)
|
|
|
2134 (interactive
|
|
|
2135 (list
|
|
|
2136 (y-or-n-p "Do you want to sign?")
|
|
|
2137 ))
|
|
|
2138 (if arg
|
|
|
2139 (if mime-editor/signing-type
|
|
|
2140 (progn
|
|
|
2141 (setq mime-editor/pgp-processing 'sign)
|
|
|
2142 (message "This message will be signed.")
|
|
|
2143 )
|
|
|
2144 (message "Please specify signing type.")
|
|
|
2145 )
|
|
|
2146 (if (eq mime-editor/pgp-processing 'sign)
|
|
|
2147 (setq mime-editor/pgp-processing nil)
|
|
|
2148 )
|
|
|
2149 (message "This message will not be signed.")
|
|
|
2150 ))
|
|
|
2151
|
|
|
2152 (defun mime-editor/set-encrypt (arg)
|
|
|
2153 (interactive
|
|
|
2154 (list
|
|
|
2155 (y-or-n-p "Do you want to encrypt?")
|
|
|
2156 ))
|
|
|
2157 (if arg
|
|
|
2158 (if mime-editor/encrypting-type
|
|
|
2159 (progn
|
|
|
2160 (setq mime-editor/pgp-processing 'encrypt)
|
|
|
2161 (message "This message will be encrypt.")
|
|
|
2162 )
|
|
|
2163 (message "Please specify encrypting type.")
|
|
|
2164 )
|
|
|
2165 (if (eq mime-editor/pgp-processing 'encrypt)
|
|
|
2166 (setq mime-editor/pgp-processing nil)
|
|
|
2167 )
|
|
|
2168 (message "This message will not be encrypt.")
|
|
|
2169 ))
|
|
|
2170
|
|
|
2171 (defvar mime-editor/pgp-processing nil)
|
|
|
2172 (make-variable-buffer-local 'mime-editor/pgp-processing)
|
|
|
2173
|
|
|
2174 (defun mime-editor/pgp-enclose-buffer ()
|
|
|
2175 (let ((beg (save-excursion
|
|
|
2176 (goto-char (point-min))
|
|
|
2177 (if (search-forward (concat "\n" mail-header-separator "\n"))
|
|
|
2178 (match-end 0)
|
|
|
2179 )))
|
|
|
2180 (end (point-max))
|
|
|
2181 )
|
|
|
2182 (if beg
|
|
|
2183 (cond ((eq mime-editor/pgp-processing 'sign)
|
|
|
2184 (mime-editor/enclose-signed-region beg end)
|
|
|
2185 )
|
|
|
2186 ((eq mime-editor/pgp-processing 'encrypt)
|
|
|
2187 (mime-editor/enclose-encrypted-region beg end)
|
|
|
2188 ))
|
|
|
2189 )))
|
|
|
2190
|
|
|
2191
|
|
|
2192 ;;; @ split
|
|
|
2193 ;;;
|
|
|
2194
|
|
|
2195 (defun mime-editor/insert-partial-header
|
|
|
2196 (fields subject id number total separator)
|
|
|
2197 (insert fields)
|
|
|
2198 (insert (format "Subject: %s (%d/%d)\n" subject number total))
|
|
|
2199 (insert (format "Mime-Version: 1.0 (split by %s)\n"
|
|
|
2200 mime-editor/version-name))
|
|
|
2201 (insert (format "\
|
|
|
2202 Content-Type: message/partial; id=%s; number=%d; total=%d\n%s\n"
|
|
|
2203 id number total separator))
|
|
|
2204 )
|
|
|
2205
|
|
|
2206 (defun mime-editor/split-and-send
|
|
|
2207 (&optional cmd lines mime-editor/message-max-length)
|
|
|
2208 (interactive)
|
|
|
2209 (or lines
|
|
|
2210 (setq lines
|
|
|
2211 (count-lines (point-min) (point-max)))
|
|
|
2212 )
|
|
|
2213 (or mime-editor/message-max-length
|
|
|
2214 (setq mime-editor/message-max-length
|
|
|
2215 (or (cdr (assq major-mode mime-editor/message-max-lines-alist))
|
|
|
2216 mime-editor/message-default-max-lines))
|
|
|
2217 )
|
|
|
2218 (let* ((mime-editor/draft-file-name
|
|
|
2219 (or (buffer-file-name)
|
|
|
2220 (make-temp-name
|
|
|
2221 (expand-file-name "tm-draft" mime/tmp-dir))))
|
|
|
2222 (separator mail-header-separator)
|
|
|
2223 (id (concat "\""
|
|
|
2224 (replace-space-with-underline (current-time-string))
|
|
|
2225 "@" (system-name) "\"")))
|
|
|
2226 (run-hooks 'mime-editor/before-split-hook)
|
|
|
2227 (let ((the-buf (current-buffer))
|
|
|
2228 (copy-buf (get-buffer-create " *Original Message*"))
|
|
|
2229 (header (std11-header-string-except
|
|
|
2230 mime-editor/split-ignored-field-regexp separator))
|
|
|
2231 (subject (mail-fetch-field "subject"))
|
|
|
2232 (total (+ (/ lines mime-editor/message-max-length)
|
|
|
2233 (if (> (mod lines mime-editor/message-max-length) 0)
|
|
|
2234 1)))
|
|
|
2235 (command
|
|
|
2236 (or cmd
|
|
|
2237 (cdr
|
|
|
2238 (assq major-mode
|
|
|
2239 mime-editor/split-message-sender-alist))
|
|
|
2240 (function
|
|
|
2241 (lambda ()
|
|
|
2242 (interactive)
|
|
|
2243 (error "Split sender is not specified for `%s'." major-mode)
|
|
|
2244 ))
|
|
|
2245 ))
|
|
|
2246 (mime-editor/partial-number 1)
|
|
|
2247 data)
|
|
|
2248 (save-excursion
|
|
|
2249 (set-buffer copy-buf)
|
|
|
2250 (erase-buffer)
|
|
|
2251 (insert-buffer the-buf)
|
|
|
2252 (save-restriction
|
|
|
2253 (if (re-search-forward
|
|
|
2254 (concat "^" (regexp-quote separator) "$") nil t)
|
|
|
2255 (let ((he (match-beginning 0)))
|
|
|
2256 (replace-match "")
|
|
|
2257 (narrow-to-region (point-min) he)
|
|
|
2258 ))
|
|
|
2259 (goto-char (point-min))
|
|
|
2260 (while (re-search-forward mime-editor/split-blind-field-regexp nil t)
|
|
|
2261 (delete-region (match-beginning 0)
|
|
|
2262 (1+ (std11-field-end)))
|
|
|
2263 )))
|
|
|
2264 (while (< mime-editor/partial-number total)
|
|
|
2265 (erase-buffer)
|
|
|
2266 (save-excursion
|
|
|
2267 (set-buffer copy-buf)
|
|
|
2268 (setq data (buffer-substring
|
|
|
2269 (point-min)
|
|
|
2270 (progn
|
|
|
2271 (goto-line mime-editor/message-max-length)
|
|
|
2272 (point))
|
|
|
2273 ))
|
|
|
2274 (delete-region (point-min)(point))
|
|
|
2275 )
|
|
|
2276 (mime-editor/insert-partial-header
|
|
|
2277 header subject id mime-editor/partial-number total separator)
|
|
|
2278 (insert data)
|
|
|
2279 (save-excursion
|
|
|
2280 (message (format "Sending %d/%d..."
|
|
|
2281 mime-editor/partial-number total))
|
|
|
2282 (call-interactively command)
|
|
|
2283 (message (format "Sending %d/%d... done"
|
|
|
2284 mime-editor/partial-number total))
|
|
|
2285 )
|
|
|
2286 (setq mime-editor/partial-number
|
|
|
2287 (1+ mime-editor/partial-number))
|
|
|
2288 )
|
|
|
2289 (erase-buffer)
|
|
|
2290 (save-excursion
|
|
|
2291 (set-buffer copy-buf)
|
|
|
2292 (setq data (buffer-string))
|
|
|
2293 (erase-buffer)
|
|
|
2294 )
|
|
|
2295 (mime-editor/insert-partial-header
|
|
|
2296 header subject id mime-editor/partial-number total separator)
|
|
|
2297 (insert data)
|
|
|
2298 (save-excursion
|
|
|
2299 (message (format "Sending %d/%d..."
|
|
|
2300 mime-editor/partial-number total))
|
|
|
2301 (message (format "Sending %d/%d... done"
|
|
|
2302 mime-editor/partial-number total))
|
|
|
2303 )
|
|
|
2304 )))
|
|
|
2305
|
|
|
2306 (defun mime-editor/maybe-split-and-send (&optional cmd)
|
|
|
2307 (interactive)
|
|
|
2308 (run-hooks 'mime-editor/before-send-hook)
|
|
|
2309 (let ((mime-editor/message-max-length
|
|
|
2310 (or (cdr (assq major-mode mime-editor/message-max-lines-alist))
|
|
|
2311 mime-editor/message-default-max-lines))
|
|
|
2312 (lines (count-lines (point-min) (point-max)))
|
|
|
2313 )
|
|
|
2314 (if (and (> lines mime-editor/message-max-length)
|
|
|
2315 mime-editor/split-message)
|
|
|
2316 (mime-editor/split-and-send cmd lines mime-editor/message-max-length)
|
|
|
2317 )))
|
|
|
2318
|
|
|
2319
|
|
|
2320 ;;; @ preview message
|
|
|
2321 ;;;
|
|
|
2322
|
|
|
2323 (defun mime-editor/preview-message ()
|
|
|
2324 "preview editing MIME message. [tm-edit.el]"
|
|
|
2325 (interactive)
|
|
|
2326 (let* ((str (buffer-string))
|
|
|
2327 (separator mail-header-separator)
|
|
|
2328 (the-buf (current-buffer))
|
|
|
2329 (buf-name (buffer-name))
|
|
|
2330 (temp-buf-name (concat "*temp-article:" buf-name "*"))
|
|
|
2331 (buf (get-buffer temp-buf-name))
|
|
|
2332 )
|
|
|
2333 (if buf
|
|
|
2334 (progn
|
|
|
2335 (switch-to-buffer buf)
|
|
|
2336 (erase-buffer)
|
|
|
2337 )
|
|
|
2338 (setq buf (get-buffer-create temp-buf-name))
|
|
|
2339 (switch-to-buffer buf)
|
|
|
2340 )
|
|
|
2341 (insert str)
|
|
|
2342 (setq major-mode 'mime/temporary-message-mode)
|
|
|
2343 (make-local-variable 'mail-header-separator)
|
|
|
2344 (setq mail-header-separator separator)
|
|
|
2345 (make-local-variable 'mime/editing-buffer)
|
|
|
2346 (setq mime/editing-buffer the-buf)
|
|
|
2347
|
|
|
2348 (run-hooks 'mime-editor/translate-hook)
|
|
|
2349 (mime-editor/translate-buffer)
|
|
|
2350 (goto-char (point-min))
|
|
|
2351 (if (re-search-forward
|
|
|
2352 (concat "^" (regexp-quote separator) "$"))
|
|
|
2353 (replace-match "")
|
|
|
2354 )
|
|
|
2355 (mime/viewer-mode)
|
|
|
2356 ))
|
|
|
2357
|
|
|
2358 (defun mime-editor/quitting-method ()
|
|
|
2359 (let ((temp mime::preview/article-buffer)
|
|
|
2360 buf)
|
|
|
2361 (mime-viewer/kill-buffer)
|
|
|
2362 (set-buffer temp)
|
|
|
2363 (setq buf mime/editing-buffer)
|
|
|
2364 (kill-buffer temp)
|
|
|
2365 (switch-to-buffer buf)
|
|
|
2366 ))
|
|
|
2367
|
|
|
2368 (set-alist 'mime-viewer/quitting-method-alist
|
|
|
2369 'mime/temporary-message-mode
|
|
|
2370 (function mime-editor/quitting-method)
|
|
|
2371 )
|
|
|
2372
|
|
|
2373
|
|
|
2374 ;;; @ draft preview
|
|
|
2375 ;;;
|
|
|
2376 ;; by "OKABE Yasuo <okabe@kudpc.kyoto-u.ac.jp>
|
|
|
2377 ;; Mon, 10 Apr 1995 20:03:07 +0900
|
|
|
2378
|
|
|
2379 (defvar mime-editor/draft-header-separator-alist
|
|
|
2380 '((news-reply-mode . mail-header-separator)
|
|
|
2381 (mh-letter-mode . mail-header-separator)
|
|
|
2382 ))
|
|
|
2383
|
|
|
2384 (defvar mime::article/draft-header-separator nil)
|
|
|
2385
|
|
|
2386 (defun mime-editor/draft-preview ()
|
|
|
2387 (interactive)
|
|
|
2388 (let ((sep (cdr (assq major-mode mime-editor/draft-header-separator-alist))))
|
|
|
2389 (or (stringp sep) (setq sep (eval sep)))
|
|
|
2390 (make-variable-buffer-local 'mime::article/draft-header-separator)
|
|
|
2391 (goto-char (point-min))
|
|
|
2392 (re-search-forward
|
|
|
2393 (concat "^\\(" (regexp-quote sep) "\\)?$"))
|
|
|
2394 (setq mime::article/draft-header-separator
|
|
|
2395 (buffer-substring (match-beginning 0) (match-end 0)))
|
|
|
2396 (replace-match "")
|
|
|
2397 (mime/viewer-mode (current-buffer))
|
|
|
2398 (pop-to-buffer (current-buffer))
|
|
|
2399 ))
|
|
|
2400
|
|
|
2401 (defun mime-viewer::quitting-method/draft-preview ()
|
|
|
2402 (let ((mother mime::preview/mother-buffer))
|
|
|
2403 (save-excursion
|
|
|
2404 (switch-to-buffer mother)
|
|
|
2405 (goto-char (point-min))
|
|
|
2406 (if (and
|
|
|
2407 (re-search-forward
|
|
|
2408 (concat "^\\("
|
|
|
2409 (regexp-quote mime::article/draft-header-separator)
|
|
|
2410 "\\)?$") nil t)
|
|
|
2411 (bolp))
|
|
|
2412 (progn
|
|
|
2413 (insert mime::article/draft-header-separator)
|
|
|
2414 (set-buffer-modified-p (buffer-modified-p))
|
|
|
2415 )))
|
|
|
2416 (mime-viewer/kill-buffer)
|
|
|
2417 (pop-to-buffer mother)
|
|
|
2418 ))
|
|
|
2419
|
|
|
2420 (set-alist 'mime-viewer/quitting-method-alist
|
|
|
2421 'mh-letter-mode
|
|
|
2422 (function mime-viewer::quitting-method/draft-preview)
|
|
|
2423 )
|
|
|
2424
|
|
|
2425 (set-alist 'mime-viewer/quitting-method-alist
|
|
|
2426 'news-reply-mode
|
|
|
2427 (function mime-viewer::quitting-method/draft-preview)
|
|
|
2428 )
|
|
|
2429
|
|
|
2430
|
|
|
2431 ;;; @ edit again
|
|
|
2432 ;;;
|
|
|
2433
|
|
|
2434 (defun mime-editor::edit-again (code-conversion)
|
|
|
2435 (save-excursion
|
|
|
2436 (goto-char (point-min))
|
|
|
2437 (let ((ctl (mime/Content-Type)))
|
|
|
2438 (if ctl
|
|
|
2439 (let ((ctype (car ctl))
|
|
|
2440 (params (cdr ctl))
|
|
|
2441 type stype)
|
|
|
2442 (if (string-match "/" ctype)
|
|
|
2443 (progn
|
|
|
2444 (setq type (substring ctype 0 (match-beginning 0)))
|
|
|
2445 (setq stype (substring ctype (match-end 0)))
|
|
|
2446 )
|
|
|
2447 (setq type ctype)
|
|
|
2448 )
|
|
|
2449 (cond
|
|
70
|
2450 ((string-equal type "multipart")
|
|
4
|
2451 (let* ((boundary (assoc-value "boundary" params))
|
|
|
2452 (boundary-pat
|
|
|
2453 (concat "\n--" (regexp-quote boundary) "[ \t]*\n"))
|
|
|
2454 )
|
|
|
2455 (re-search-forward boundary-pat nil t)
|
|
|
2456 (let ((bb (match-beginning 0)) eb tag)
|
|
|
2457 (setq tag (format "\n--<<%s>>-{\n" stype))
|
|
|
2458 (goto-char bb)
|
|
|
2459 (insert tag)
|
|
|
2460 (setq bb (+ bb (length tag)))
|
|
|
2461 (re-search-forward
|
|
|
2462 (concat "\n--" (regexp-quote boundary) "--[ \t]*\n")
|
|
|
2463 nil t)
|
|
|
2464 (setq eb (match-beginning 0))
|
|
|
2465 (replace-match (format "--}-<<%s>>\n" stype))
|
|
|
2466 (save-restriction
|
|
|
2467 (narrow-to-region bb eb)
|
|
|
2468 (goto-char (point-min))
|
|
|
2469 (while (re-search-forward boundary-pat nil t)
|
|
|
2470 (let ((beg (match-beginning 0))
|
|
|
2471 end)
|
|
|
2472 (delete-region beg (match-end 0))
|
|
|
2473 (save-excursion
|
|
|
2474 (if (re-search-forward boundary-pat nil t)
|
|
|
2475 (setq end (match-beginning 0))
|
|
|
2476 (setq end (point-max))
|
|
|
2477 )
|
|
|
2478 (save-restriction
|
|
|
2479 (narrow-to-region beg end)
|
|
|
2480 (mime-editor::edit-again code-conversion)
|
|
|
2481 (goto-char (point-max))
|
|
|
2482 ))))
|
|
|
2483 ))
|
|
|
2484 (goto-char (point-min))
|
|
|
2485 (or (= (point-min) 1)
|
|
|
2486 (delete-region (point-min)
|
|
|
2487 (if (search-forward "\n\n" nil t)
|
|
|
2488 (match-end 0)
|
|
|
2489 (point-min)
|
|
|
2490 )))
|
|
|
2491 ))
|
|
|
2492 (t
|
|
|
2493 (let* (charset
|
|
|
2494 (pstr
|
|
74
|
2495 (let ((bytes (+ 14 (length ctype))))
|
|
|
2496 (mapconcat (function
|
|
|
2497 (lambda (attr)
|
|
|
2498 (if (string-equal (car attr) "charset")
|
|
|
2499 (progn
|
|
|
2500 (setq charset (cdr attr))
|
|
|
2501 "")
|
|
|
2502 (let* ((str
|
|
|
2503 (concat (car attr)
|
|
|
2504 "=" (cdr attr))
|
|
|
2505 )
|
|
|
2506 (bs (length str))
|
|
|
2507 )
|
|
|
2508 (setq bytes (+ bytes bs 2))
|
|
|
2509 (if (< bytes 76)
|
|
|
2510 (concat "; " str)
|
|
|
2511 (setq bytes (+ bs 1))
|
|
|
2512 (concat ";\n " str)
|
|
|
2513 )
|
|
|
2514 ))))
|
|
|
2515 params "")))
|
|
4
|
2516 encoding
|
|
|
2517 encoded)
|
|
|
2518 (save-excursion
|
|
|
2519 (if (re-search-forward
|
|
|
2520 "Content-Transfer-Encoding:" nil t)
|
|
|
2521 (let ((beg (match-beginning 0))
|
|
|
2522 (hbeg (match-end 0))
|
|
|
2523 (end (std11-field-end)))
|
|
|
2524 (setq encoding
|
|
|
2525 (eliminate-top-spaces
|
|
|
2526 (std11-unfold-string
|
|
|
2527 (buffer-substring hbeg end))))
|
|
|
2528 (if (or charset (string-equal type "text"))
|
|
|
2529 (progn
|
|
|
2530 (delete-region beg (1+ end))
|
|
|
2531 (goto-char (point-min))
|
|
|
2532 (if (search-forward "\n\n" nil t)
|
|
|
2533 (progn
|
|
|
2534 (mime-decode-region
|
|
|
2535 (match-end 0)(point-max) encoding)
|
|
|
2536 (setq encoded t
|
|
|
2537 encoding nil)
|
|
|
2538 )))))))
|
|
|
2539 (if (or code-conversion encoded)
|
|
|
2540 (decode-mime-charset-region
|
|
|
2541 (point-min)(point-max)
|
|
|
2542 (or charset default-mime-charset))
|
|
|
2543 )
|
|
|
2544 (let ((he
|
|
|
2545 (if (re-search-forward "^$" nil t)
|
|
|
2546 (match-end 0)
|
|
|
2547 (point-min)
|
|
|
2548 )))
|
|
|
2549 (if (= (point-min) 1)
|
|
|
2550 (progn
|
|
|
2551 (goto-char he)
|
|
|
2552 (insert
|
|
|
2553 (concat "\n"
|
|
|
2554 (mime-create-tag
|
|
|
2555 (concat type "/" stype pstr) encoding)))
|
|
|
2556 )
|
|
|
2557 (delete-region (point-min) he)
|
|
|
2558 (insert
|
|
|
2559 (mime-create-tag
|
|
|
2560 (concat type "/" stype pstr) encoding))
|
|
|
2561 ))
|
|
|
2562 ))))
|
|
|
2563 (if code-conversion
|
|
|
2564 (decode-mime-charset-region (point-min) (point-max)
|
|
|
2565 default-mime-charset)
|
|
|
2566 )
|
|
|
2567 ))))
|
|
|
2568
|
|
|
2569 (defun mime/edit-again (&optional code-conversion no-separator no-mode)
|
|
|
2570 (interactive)
|
|
|
2571 (mime-editor::edit-again code-conversion)
|
|
|
2572 (goto-char (point-min))
|
|
|
2573 (save-restriction
|
|
|
2574 (narrow-to-region
|
|
|
2575 (point-min)
|
|
|
2576 (if (re-search-forward
|
|
|
2577 (concat "^\\(" (regexp-quote mail-header-separator) "\\)?$")
|
|
|
2578 nil t)
|
|
|
2579 (match-end 0)
|
|
|
2580 (point-max)
|
|
|
2581 ))
|
|
|
2582 (goto-char (point-min))
|
|
|
2583 (while (re-search-forward
|
|
|
2584 "^\\(Content-.*\\|Mime-Version\\):" nil t)
|
|
|
2585 (delete-region (match-beginning 0) (1+ (std11-field-end)))
|
|
|
2586 ))
|
|
|
2587 (or no-separator
|
|
|
2588 (and (re-search-forward "^$")
|
|
|
2589 (replace-match mail-header-separator)
|
|
|
2590 ))
|
|
|
2591 (or no-mode
|
|
|
2592 (mime/editor-mode)
|
|
|
2593 ))
|
|
|
2594
|
|
|
2595
|
|
|
2596 ;;; @ end
|
|
|
2597 ;;;
|
|
|
2598
|
|
|
2599 (provide 'tm-edit)
|
|
|
2600
|
|
|
2601 (run-hooks 'tm-edit-load-hook)
|
|
|
2602
|
|
|
2603 ;;; tm-edit.el ends here
|
