0
|
1 ;;; File: --- mime-compose.el ---
|
|
2 ;;; Author: Marc Andreessen (marca@ncsa.uiuc.edu)
|
|
3 ;;; Additional code: Keith Waclena (k-waclena@uchicago.edu).
|
|
4 ;;; Christopher Davis (ckd@eff.org).
|
|
5 ;;; Copyright (C) National Center for Supercomputing Applications, 1992.
|
|
6 ;;;
|
|
7 ;;; This program is free software; you can redistribute it and/or modify
|
|
8 ;;; it under the terms of the GNU General Public License as published by
|
|
9 ;;; the Free Software Foundation; either version 1, or (at your option)
|
|
10 ;;; any later version.
|
|
11 ;;;
|
|
12 ;;; This program is distributed in the hope that it will be useful,
|
|
13 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
14 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
15 ;;; GNU General Public License for more details.
|
|
16 ;;;
|
|
17 ;;; You should have received a copy of the GNU General Public License
|
|
18 ;;; along with your copy of Emacs; if not, write to the Free Software
|
|
19 ;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
|
|
20 ;;;
|
|
21 ;;; Synched up with: Not in FSF.
|
|
22
|
|
23 ;;; -------------------------------- CONTENTS --------------------------------
|
|
24 ;;;
|
|
25 ;;; mime-compose: Utility routines for composing MIME-compliant mail.
|
|
26 ;;; !Revision: 1.5 !
|
|
27 ;;; !Date: 1994/03/24 00:00:47 !
|
|
28 ;;;
|
|
29 ;;; Canonical list of features:
|
|
30 ;;; Automatic MIME header construction.
|
|
31 ;;; Include GIF/JPEG image.
|
|
32 ;;; Include audio file.
|
|
33 ;;; Include PostScript file.
|
|
34 ;;; Include MPEG animation sequence.
|
|
35 ;;; Include raw binary/nonbinary file.
|
|
36 ;;; Include xwd window dump taken on the fly.
|
|
37 ;;; Include reference to anonymous/regular FTP.
|
|
38 ;;; Include audio snippet recorded on the fly.
|
|
39 ;;; Convert region to MIME richtext.
|
|
40 ;;; Convert region to any ISO 8859 charset.
|
|
41 ;;; Optional conversion of plaintext bodyparts to quoted-printable
|
|
42 ;;; with arbitrary charset when messages are sent.
|
|
43 ;;; Deemphasizing/highlighting of MIME headers.
|
|
44 ;;; Completion on content type and charset.
|
|
45 ;;; Automatic encoding in base64 and quoted-printable formats.
|
|
46 ;;; Selective display hides raw data.
|
|
47 ;;; Works with mail-mode and mh.
|
|
48 ;;;
|
|
49 ;;; ------------------------------ INSTRUCTIONS ------------------------------
|
|
50 ;;;
|
|
51 ;;; Use the normal Emacs mail composer (C-x m).
|
|
52 ;;;
|
|
53 ;;; (Or, use with Emacs mh-e by loading this file *after* loading mh-e.
|
|
54 ;;; But due to incestuous hookification, you can't require mime-compose
|
|
55 ;;; inside mh-letter-mode-hook.)
|
|
56 ;;;
|
|
57 ;;; Do nothing special to prepare a message to have MIME elements
|
|
58 ;;; included in it.
|
|
59 ;;;
|
|
60 ;;; The basic commands to add MIME elements (images, audio, etc.) to a
|
|
61 ;;; message are as follows:
|
|
62 ;;;
|
|
63 ;;; mail-mode (mh-e) function what happens
|
|
64 ;;; ~~~~~~~~~ (~~~~~~~~~) ~~~~~~~~ ~~~~~~~~~~~~
|
|
65 ;;; C-c g (C-c C-m g) mime-include-gif Add a GIF file.
|
|
66 ;;; C-c j (C-c C-m j) mime-include-jpeg Add a JPEG file.
|
|
67 ;;; C-c a (C-c C-m a) mime-include-audio Add an audio file.
|
|
68 ;;; C-c p (C-c C-m p) mime-include-postscript Add a PostScript file.
|
|
69 ;;; C-c v (C-c C-m v) mime-include-mpeg Add an MPEG file.
|
|
70 ;;;
|
|
71 ;;; (Note that mime-compose assumes you have the 'mmencode' program
|
|
72 ;;; installed on your system. See 'WHAT MIME IS' below for more
|
|
73 ;;; information on mmencode and the metamail distribution.)
|
|
74 ;;;
|
|
75 ;;; Some mime-compose commands create data themselves; these follow:
|
|
76 ;;;
|
|
77 ;;; C-c x (C-c C-m x)
|
|
78 ;;; mime-include-xwd-dump
|
|
79 ;;; Add the result of an X-window dump. The program named in
|
|
80 ;;; mime-xwd-command will be run, and the resulting dump will be
|
|
81 ;;; inserted into the message.
|
|
82 ;;; C-c s (C-c C-m s)
|
|
83 ;;; mime-include-audio-snippet
|
|
84 ;;; Add an audio snippet, recorded on the fly. CURRENTLY THIS WORKS
|
|
85 ;;; ONLY FOR SILICON GRAPHICS INDIGO AND 4D/35's. The Sun version
|
|
86 ;;; may also work; see the source code below. Recording begins
|
|
87 ;;; immediately; press 'y' to end recording or 'n' to abort the
|
|
88 ;;; whole process. The resulting audio file will be converted to
|
|
89 ;;; standard mulaw format and incorporated into the message.
|
|
90 ;;;
|
|
91 ;;; If you have a raw binary file and MIME or mime-compose doesn't
|
|
92 ;;; have built-in support for its format (e.g. an Emacs Lisp
|
|
93 ;;; byte-compiled file), you can use:
|
|
94 ;;;
|
|
95 ;;; C-c r (C-c C-m r)
|
|
96 ;;; mime-include-raw-binary
|
|
97 ;;; Add a raw binary file. You will be prompted for both the
|
|
98 ;;; filename and the content type of the file; if you do not give a
|
|
99 ;;; content type, the default (application/octet-stream) will be
|
|
100 ;;; used, and the recipient will be able to have his/her MIME mail
|
|
101 ;;; handler extract the raw binary file from the message.
|
|
102 ;;;
|
|
103 ;;; Similarly, to include nonbinary (text) files using
|
|
104 ;;; quoted-printable encoding, use:
|
|
105 ;;;
|
|
106 ;;; C-c n (C-c C-m n)
|
|
107 ;;; mime-include-raw-nonbinary
|
|
108 ;;; Add a raw nonbinary (text) file. You will be prompted for both
|
|
109 ;;; the filename and the content type of the file (which defaults to
|
|
110 ;;; text/plain). With prefix arg, you will also be prompted for the
|
|
111 ;;; character set (default is US-ASCII).
|
|
112 ;;;
|
|
113 ;;; You can also point to external elements: files that will not be
|
|
114 ;;; included in the document, but can be accessed by the recipient in
|
|
115 ;;; some other way (most commonly, via FTP). The following commands
|
|
116 ;;; handle this:
|
|
117 ;;;
|
|
118 ;;; C-c e (C-c C-m e)
|
|
119 ;;; mime-include-external-anonftp
|
|
120 ;;; Point to an external file (assumed to be accessable via
|
|
121 ;;; anonymous FTP). You will be prompted for the name of the FTP
|
|
122 ;;; site, the remote directory name, and remote filename, the remote
|
|
123 ;;; file's content type, and a description of the remote file.
|
|
124 ;;; C-c f (C-c C-m f)
|
|
125 ;;; mime-include-external-ftp
|
|
126 ;;; This is the same as 'C-c e', except that the file will be
|
|
127 ;;; accessed via regular FTP rather than anonymous FTP -- a username
|
|
128 ;;; and password will have to be provided by the recipient to gain
|
|
129 ;;; access to the file.
|
|
130 ;;;
|
|
131 ;;; Note that whenever you are prompted for a content type, Emacs'
|
|
132 ;;; completion feature is active: press TAB for a list of valid types.
|
|
133 ;;; You can also enter a type not in the completion list.
|
|
134 ;;;
|
|
135 ;;; If you type in text that belongs in a character set other than the
|
|
136 ;;; default (US-ASCII), you can use the following function to encode
|
|
137 ;;; the text and generate appropriate MIME headers:
|
|
138 ;;;
|
|
139 ;;; C-c C-r i (C-c C-m C-r i)
|
|
140 ;;; mime-region-to-charset
|
|
141 ;;; Encode region in an alternate character set. (MIME only
|
|
142 ;;; sanctions the use of ISO charsets; thus, the command key for
|
|
143 ;;; this function is 'i'.) You will be prompted for a character set
|
|
144 ;;; (minibuffer completion is provided).
|
|
145 ;;;
|
|
146 ;;; MIME also defines a 'richtext' format; you can encode the current
|
|
147 ;;; region as richtext with:
|
|
148 ;;;
|
|
149 ;;; C-c C-r r (C-c C-m C-r r)
|
|
150 ;;; mime-region-to-richtext
|
|
151 ;;; Encode region as richtext. With prefix arg, you will be
|
|
152 ;;; prompted for a character set, else the default (US-ASCII) is
|
|
153 ;;; used.
|
|
154 ;;;
|
|
155 ;;; If you regularly use 8-bit characters in your messages, you will
|
|
156 ;;; probably want all of your plaintext bodyparts automatically
|
|
157 ;;; encoded in quoted-printable and labeled as belonging to the
|
|
158 ;;; character set that you're using when a message is sent. To have
|
|
159 ;;; this happen, set this variable:
|
|
160 ;;;
|
|
161 ;;; mime-encode-plaintext-on-send (variable, default NIL)
|
|
162 ;;; If T, all text/plain bodyparts in the message will be encoded in
|
|
163 ;;; quoted-printable and labeled with charset mime-default-charset
|
|
164 ;;; (by default, US-ASCII) when a message is sent. If NIL,
|
|
165 ;;; text/plain bodyparts will not be touched.
|
|
166 ;;;
|
|
167 ;;; ---------------------------- ADDITIONAL NOTES ----------------------------
|
|
168 ;;;
|
|
169 ;;; mime-compose uses Emacs' selective-display feature: only the first
|
|
170 ;;; line of any encoded data file will be displayed, followed by
|
|
171 ;;; ellipses (indicating that some data is not being shown). See the
|
|
172 ;;; variable 'mime-use-selective-display' below.
|
|
173 ;;;
|
|
174 ;;; If you are running XEmacs/Lucid Emacs, the mail-mode popup menu (attached
|
|
175 ;;; to the third mouse button) will include mime-compose entries.
|
|
176 ;;;
|
|
177 ;;; If you are running XEmacs/Lucid Emacs or Epoch, highlighting will be used
|
|
178 ;;; to deemphasize the various MIME headers (but emphasize the various
|
|
179 ;;; MIME content types). You can turn this feature off; see the
|
|
180 ;;; variable 'mime-use-highlighting'.
|
|
181 ;;;
|
|
182 ;;; After your message has been `mimified' (by including a MIME
|
|
183 ;;; element), it is best not to put trailing text outside the final
|
|
184 ;;; boundary at the end of the file -- such text will not be
|
|
185 ;;; considered to be part of the message by MIME-compliant mail
|
|
186 ;;; readers (although it will still be sent).
|
|
187 ;;;
|
|
188 ;;; As you compose a complex MIME message, you may notice useless
|
|
189 ;;; bodyparts accumulating: extra text/plain bodyparts, in particular,
|
|
190 ;;; containing no text. These bodyparts will be stripped from the
|
|
191 ;;; message before the message is sent, so you (and I) won't look like
|
|
192 ;;; a moron to the recipient.
|
|
193 ;;;
|
|
194 ;;; A command that usually isn't necessary, but is provided in case
|
|
195 ;;; you wish to send a plaintext message with the various MIME headers
|
|
196 ;;; and boundaries, is:
|
|
197 ;;;
|
|
198 ;;; C-c m (C-c C-m m) mime-mimify-message Mimify a message.
|
|
199 ;;;
|
|
200 ;;; MIME messages can contain elements and structures not yet
|
|
201 ;;; supported by mime-compose. If you have ideas or code for support
|
|
202 ;;; that should be provided by mime-compose, please send them to the
|
|
203 ;;; author.
|
|
204 ;;;
|
|
205 ;;; ------------------------ WHAT MIME-COMPOSE IS NOT ------------------------
|
|
206 ;;;
|
|
207 ;;; mime-compose is not a MIME message handler. It will not interpret
|
|
208 ;;; MIME messages, display images, or anything similar.
|
|
209 ;;;
|
|
210 ;;; mime-compose is not intelligent enough (yet) to construct complex
|
|
211 ;;; MIME messages (with nested boundaries, parallel message elements,
|
|
212 ;;; and so on).
|
|
213 ;;;
|
|
214 ;;; mime-compose will not enforce correctness (MIME compliance) on
|
|
215 ;;; your messages. mime-compose generates MIME-compliant message
|
|
216 ;;; elements, but will sit quietly if you alter them or add your own
|
|
217 ;;; incorrect elements.
|
|
218 ;;;
|
|
219 ;;; In particular, note that the MIME specification demands a blank
|
|
220 ;;; line following the Content declarations for a bodypart.
|
|
221 ;;; mime-compose will give you that blank line, but will not demand
|
|
222 ;;; that you leave it blank; if you don't, your message will not be
|
|
223 ;;; happy.
|
|
224 ;;;
|
|
225 ;;; ------------------------------ WHAT MIME IS ------------------------------
|
|
226 ;;;
|
|
227 ;;; MIME defines a format for email messages containing non-plaintext
|
|
228 ;;; elements (images, audio, etc.). MIME is detailed in Internet RFC
|
|
229 ;;; 1341, by N. Borenstein and N. Freed. You can FTP this RFC from
|
|
230 ;;; many archive sites, including uxc.cso.uiuc.edu.
|
|
231 ;;;
|
|
232 ;;; Few mail readers handle MIME messages, yet. However, most popular
|
|
233 ;;; mail readers can be easily patched to feed MIME messages to a
|
|
234 ;;; program called 'metamail', which can handle MIME messages. You
|
|
235 ;;; can FTP metamail from thumper.bellcore.com in /pub/nsb as
|
|
236 ;;; mm.tar.Z. Since mime-compose requires the existence of the
|
|
237 ;;; program 'mmencode' (from the metamail distribution) to insert
|
|
238 ;;; binary and nonbinary files into messages, it is a Good Idea to
|
|
239 ;;; have metamail installed on your system.
|
|
240 ;;;
|
|
241 ;;; --------------------------------------------------------------------------
|
|
242 ;;; LCD Archive Entry:
|
|
243 ;;; mime-compose|Marc Andreessen|marca@ncsa.uiuc.edu|
|
|
244 ;;; MIME-compliant message generation utilities.|
|
|
245 ;;; !Date: 1994/03/24 00:00:47 !|!Revision: 1.5 !|~/misc/mime-compose.el.Z|
|
|
246 ;;; --------------------------------------------------------------------------
|
|
247
|
|
248 (provide 'mime-compose)
|
|
249
|
|
250 (defvar mime-running-mh-e (featurep 'mh-e)
|
|
251 "Non-nil if running under mh-e.")
|
|
252
|
|
253 (if (not mime-running-mh-e)
|
|
254 (require 'sendmail))
|
|
255
|
|
256 ;;; ---------------------- User-customizable variables -----------------------
|
|
257
|
|
258 (defvar mime-compose-hook nil
|
|
259 "*Invoked exactly once by first invocation of mime-mimify-message,
|
|
260 before any processing is done.")
|
|
261
|
|
262 (defvar mime-use-selective-display t
|
|
263 "*Flag for using selective-display to hide bodies of MIME enclosures.
|
|
264 If non-NIL, selective-display will be used; if NIL, it will not be used.")
|
|
265
|
|
266 (defvar mime-default-charset "US-ASCII"
|
|
267 "*Default character set for MIME messages elements. According to the
|
|
268 MIME specification, this can be either US-ASCII or ISO-8859-x, where x
|
|
269 must be between 1 and 9 inclusive.")
|
|
270
|
|
271 (defvar mime-encode-plaintext-on-send nil
|
|
272 "*Non-NIL if plaintext bodyparts should be encoded in quoted-printable
|
|
273 and labeled with mime-default-charset when a message is sent; NIL
|
|
274 otherwise.")
|
|
275
|
|
276 (defvar mime-use-highlighting t
|
|
277 "*Flag to use highlighting for MIME headers and content types in
|
|
278 Epoch or XEmacs/Lucid Emacs; if non-NIL, highlighting will be used.")
|
|
279
|
|
280 (defvar mime-deemphasize-color "grey80"
|
|
281 "*Color for de-highlighting MIME headers in Epoch or XEmacs/Lucid Emacs.")
|
|
282
|
|
283 (defvar mime-emphasize-color "yellow"
|
|
284 "*Color for highlighting MIME content types in Epoch or XEmacs/Lucid Emacs.")
|
|
285
|
|
286 (defvar mime-name-included-files t
|
|
287 "*If non-NIL, use name attribute for included files.")
|
|
288
|
|
289 (defvar mime-use-waiting-messages t
|
|
290 "*If non-NIL, enable waiting messages feature.")
|
|
291
|
|
292 (defvar mime-primary-boundary "mysteryboxofun"
|
|
293 "*Word used as the primary MIME boundary.")
|
|
294
|
|
295 (defvar mime-xwd-command "xwd -frame"
|
|
296 "*Command used to do a window dump under the X Window System.")
|
|
297
|
|
298 (defvar mime-encode-base64-command "mmencode"
|
|
299 "*Command used to encode data in base64 format.")
|
|
300
|
|
301 (defvar mime-encode-qp-command "mmencode -q"
|
|
302 "*Command used to encode data in quoted-printable format.")
|
|
303
|
|
304 (defvar mime-babbling-description "talking"
|
|
305 "*Adjective(s) (or gerunds; I never could tell them apart) applying to
|
|
306 audio snippets.")
|
|
307
|
|
308 (defvar mime-sgi-record-program "/usr/sbin/recordaiff"
|
|
309 "*Full name of SGI audio record program.")
|
|
310
|
|
311 (defvar mime-sun-record-program "/usr/demo/SOUND/record"
|
|
312 "*Full name of Sun audio record program, patched with the context
|
|
313 diff found at the end of mime-compose.el.")
|
|
314
|
|
315 ;;; ---------------------------- Other variables -----------------------------
|
|
316
|
|
317 (defvar mime-compose-hook-was-run nil
|
|
318 "NIL implies we haven't yet run mime-compose-hook.")
|
|
319
|
|
320 (defvar mime-valid-include-types
|
|
321 '(("image/gif" 1)
|
|
322 ("image/jpeg" 2)
|
|
323 ("application/postscript" 3)
|
|
324 ("application/andrew-inset" 4)
|
|
325 ("application/octet-stream" 5)
|
|
326 ("text/richtext" 6)
|
|
327 ("text/plain" 7)
|
|
328 ("audio/basic" 8)
|
|
329 ("video/mpeg" 9)
|
|
330 ("message/rfc822" 10)
|
|
331 ;; These aren't ``standard'', but are useful.
|
|
332 ("application/x-emacs-lisp" 11)
|
|
333 ("application/x-unix-tar-z" 12)
|
|
334 ("application/x-dvi" 13)
|
|
335 ("image/x-xbm" 14)
|
|
336 ("image/x-xwd" 15)
|
|
337 ("image/x-tiff" 16)
|
|
338 ("audio/x-aiff" 17)
|
|
339 ("text/x-html" 18))
|
|
340 "A list of valid content types for minibuffer completion.")
|
|
341
|
|
342 (defvar mime-valid-charsets
|
|
343 '(("US-ASCII" 1)
|
|
344 ("ISO-8859-1" 2)
|
|
345 ("ISO-8859-2" 3)
|
|
346 ("ISO-8859-3" 4)
|
|
347 ("ISO-8859-4" 5)
|
|
348 ("ISO-8859-5" 6)
|
|
349 ("ISO-8859-6" 7)
|
|
350 ("ISO-8859-7" 8)
|
|
351 ("ISO-8859-8" 9)
|
|
352 ("ISO-8859-9" 10))
|
|
353 "A list of valid charset names for minibuffer completion.")
|
|
354
|
|
355 (defvar mime-using-silicon-graphics
|
|
356 (or (eq system-type 'silicon-graphics-unix) (eq system-type 'irix))
|
|
357 "Flag to indicate use of Silicon Graphics platform. If T, Emacs is being
|
|
358 run on a Silicon Graphics workstation; else it is not.")
|
|
359
|
|
360 (defvar mime-running-lemacs (string-match "XEmacs\\|Lucid" emacs-version)
|
|
361 "Non-nil if running XEmacs/Lucid Emacs.")
|
|
362
|
|
363 (defvar mime-running-epoch (boundp 'epoch::version)
|
|
364 "Non-nil if running Epoch.")
|
|
365
|
|
366 (if (and mime-running-epoch mime-use-highlighting)
|
|
367 (progn
|
|
368 (defvar mime-deemphasize-style (make-style))
|
|
369 (set-style-foreground mime-deemphasize-style mime-deemphasize-color)
|
|
370 (defvar mime-emphasize-style (make-style))
|
|
371 (set-style-foreground mime-emphasize-style mime-emphasize-color)))
|
|
372
|
|
373 (if (and mime-running-lemacs mime-use-highlighting)
|
|
374 (progn
|
|
375 (defvar mime-deemphasize-style (make-face 'mime-deemphasize-face))
|
|
376 (set-face-foreground mime-deemphasize-style mime-deemphasize-color)
|
|
377 (defvar mime-emphasize-style (make-face 'mime-emphasize-face))
|
|
378 (set-face-foreground mime-emphasize-style mime-emphasize-color)))
|
|
379
|
|
380 (defvar mime-audio-file "/tmp/.fooblatz"
|
|
381 "Filename to store audio snippets recorded on the fly.")
|
|
382
|
|
383 (defvar mime-audio-tmp-file "/tmp/.fooblatz.aiff"
|
|
384 "Filename to store audio snippets recorded on the fly.")
|
|
385
|
|
386 (defconst mime-waiting-message-lines
|
|
387 '("Mail mime-compose bug reports to marca@ncsa.uiuc.edu and pray for help."
|
|
388 "For the daring: ftp.ncsa.uiuc.edu:/outgoing/marca/mime-compose.el"
|
|
389 "Feature requests? Fervent wishes? Unfulfilled desires? Write code!"
|
|
390 "mime-compose.el: the Kitchen Sink(tm) of mail composers."
|
|
391 "Q: How many Elisp hackers does it take to change a light bulb?"
|
|
392 "A: None -- we glow in the dark."
|
|
393 ".gnol oot yaw rof scamE gnisu neeb ev'uoy ,siht daer nac uoy fI"
|
|
394 "Macs? We don' need no steenkin Macs! We got MIME!"
|
|
395 "All hail MIME. All hail MIME. Yay. Yay. Woo. Woo.")
|
|
396 "List of stupid strings to display while waiting for more to do.")
|
|
397
|
|
398 ;;; --------------------------- Utility functions ----------------------------
|
|
399
|
|
400 (defun mime-primary-boundary ()
|
|
401 "Return the current primary boundary. Note that in the current version
|
|
402 of mime-compose.el, there is no support for secondary boundaries (for
|
|
403 parallel or alternate bodyparts, etc.). In the future, there may be."
|
|
404 mime-primary-boundary)
|
|
405
|
|
406 (defun mime-hide-region (from to hideflag)
|
|
407 "Hides or shows lines from FROM to TO, according to HIDEFLAG:
|
|
408 If T, region is hidden, else if NIL, region is shown."
|
|
409 (let ((old (if hideflag ?\n ?\^M))
|
|
410 (new (if hideflag ?\^M ?\n))
|
|
411 (modp (buffer-modified-p)))
|
|
412 (unwind-protect (progn
|
|
413 (subst-char-in-region from to old new t))
|
|
414 (set-buffer-modified-p modp))))
|
|
415
|
|
416 (defun mime-maybe-hide-region (start end)
|
|
417 "Hide the current region if mime-use-selective-display is T."
|
|
418 (if mime-use-selective-display
|
|
419 (mime-hide-region start end t)))
|
|
420
|
|
421 (defun mime-add-description (description)
|
|
422 "Add a description to the current MIME message element."
|
|
423 (interactive "sDescription: ")
|
|
424 (save-excursion
|
|
425 (if (re-search-backward (concat "--" (mime-primary-boundary))
|
|
426 (point-min) t)
|
|
427 (progn
|
|
428 (next-line 2)
|
|
429 (insert "Content-Description: " description "\n")))))
|
|
430
|
|
431 (defun mime-display-waiting-messages ()
|
|
432 "Display cute messages until input arrives. Shamelessly stolen
|
|
433 from VM, the Kitchen Sink(tm) of mail readers."
|
|
434 (if mime-use-waiting-messages
|
|
435 (progn
|
|
436 (if (sit-for 2)
|
|
437 (let ((lines mime-waiting-message-lines))
|
|
438 (message
|
|
439 "mime-compose.el !Revision: 1.5 !, by marca@ncsa.uiuc.edu")
|
|
440 (while (and (sit-for 4) lines)
|
|
441 (message (car lines))
|
|
442 (setq lines (cdr lines)))))
|
|
443 (message "")
|
|
444 (if (not (input-pending-p))
|
|
445 (progn
|
|
446 (sit-for 2)
|
|
447 ;; TODO: Don't recurse; iterate.
|
|
448 (if (not (input-pending-p))
|
|
449 (mime-display-waiting-messages)))))))
|
|
450
|
|
451 ;;; ------------------------------ Highlighting ------------------------------
|
|
452
|
|
453 (if mime-use-highlighting
|
|
454 (progn
|
|
455 (if mime-running-lemacs
|
|
456 (defun mime-add-zone (start end style)
|
|
457 "Add a XEmacs/Lucid Emacs extent from START to END with STYLE."
|
|
458 (let ((extent (make-extent start end)))
|
|
459 (set-extent-face extent style)
|
|
460 (set-extent-property extent 'mime-compose t))))
|
|
461 (if mime-running-epoch
|
|
462 (defun mime-add-zone (start end style)
|
|
463 "Add an Epoch zone from START to END with STYLE."
|
|
464 (let ((zone (add-zone start end style)))
|
|
465 (epoch::set-zone-data zone 'mime-compose))))))
|
|
466
|
|
467 (defun mime-maybe-highlight-region (start end)
|
|
468 "Maybe highlight a region of text. Region is from START to END."
|
|
469 (if (and (or mime-running-epoch mime-running-lemacs)
|
|
470 mime-use-highlighting)
|
|
471 (progn
|
|
472 (mime-add-zone start end mime-deemphasize-style)
|
|
473 (save-excursion
|
|
474 (goto-char start)
|
|
475 (if (re-search-forward "Content-Type: " end t)
|
|
476 (let ((s (match-end 0)))
|
|
477 (re-search-forward "[;\n]")
|
|
478 (mime-add-zone
|
|
479 s (- (match-end 0) 1) mime-emphasize-style)))))))
|
|
480
|
|
481 ;;; -------------------------- mime-mimify-message ---------------------------
|
|
482
|
|
483 (defun mime-mimify-message ()
|
|
484 "Add MIME headers to a message. Add an initial informational message
|
|
485 for mail readers that don't process MIME messages automatically. Add
|
|
486 an initial area for plaintext. Add a closing boundary at the end of
|
|
487 the message.
|
|
488
|
|
489 This function is safe to call more than once."
|
|
490 (interactive)
|
|
491 (if (not mime-compose-hook-was-run)
|
|
492 (progn
|
|
493 (setq mime-compose-hook-was-run t)
|
|
494 (run-hooks 'mime-compose-hook)))
|
|
495 (let ((mail-header-separator (if (eq major-mode 'mh-letter-mode)
|
|
496 "\n\n\\|^-+$"
|
|
497 mail-header-separator)))
|
|
498 (or
|
|
499 (save-excursion
|
|
500 (goto-char (point-min))
|
|
501 (re-search-forward "^Mime-Version: "
|
|
502 (save-excursion
|
|
503 (goto-char (point-min))
|
|
504 (re-search-forward mail-header-separator)
|
|
505 (point))
|
|
506 t))
|
|
507 (let ((mime-virgin-message (save-excursion
|
|
508 (next-line -1)
|
|
509 (looking-at mail-header-separator))))
|
|
510 (if mime-virgin-message
|
|
511 (insert "\n"))
|
|
512 (save-excursion
|
|
513 (save-excursion
|
|
514 (goto-char (point-min))
|
|
515 (re-search-forward mail-header-separator)
|
|
516 (beginning-of-line)
|
|
517 (insert "Mime-Version: 1.0\n")
|
|
518 (insert "Content-Description: A MIME message created by mime-compose.el.\n")
|
|
519 (insert "Content-Type: multipart/mixed; boundary=" (mime-primary-boundary) "\n")
|
|
520 (mime-maybe-highlight-region (save-excursion (next-line -3) (point))
|
|
521 (- (point) 1))
|
|
522 (next-line 1)
|
|
523 (let ((start (point)) end)
|
|
524 (insert "> THIS IS A MESSAGE IN 'MIME' FORMAT.\n")
|
|
525 (insert
|
|
526 "> If you are reading this, your mail reader may not support MIME.\n")
|
|
527 (insert
|
|
528 "> Some parts of this message will be readable as plain text.\n")
|
|
529 (setq end (point))
|
|
530 (mime-maybe-hide-region start (- end 1)))
|
|
531 (insert "\n")
|
|
532 (goto-char (point-max))
|
|
533 (insert "\n")
|
|
534 (insert "\n")
|
|
535 (insert "--" (mime-primary-boundary) "--\n")
|
|
536 (mime-maybe-highlight-region (save-excursion (next-line -1) (point))
|
|
537 (- (point) 1)))
|
|
538 (save-excursion
|
|
539 (goto-char (point-min))
|
|
540 (re-search-forward mail-header-separator)
|
|
541 (beginning-of-line)
|
|
542 ;; THIS HAS TO MATCH the number of lines of text included
|
|
543 ;; as a message ``header'' above.
|
|
544 (if mime-use-selective-display
|
|
545 (next-line 3)
|
|
546 (next-line 5))
|
|
547 (insert "--" (mime-primary-boundary) "\n")
|
|
548 (insert "Content-Type: text/plain\n")
|
|
549 (mime-maybe-highlight-region
|
|
550 (save-excursion (next-line -2) (point))
|
|
551 (- (point) 1))
|
|
552 (insert "\n"))
|
|
553 (if mime-virgin-message
|
|
554 (backward-delete-char 1))))))
|
|
555 (if (interactive-p)
|
|
556 (mime-display-waiting-messages)))
|
|
557
|
|
558 (defun mime-open-text-bodypart ()
|
|
559 "At current point, just open up a new plaintext bodypart."
|
|
560 (interactive)
|
|
561 (mime-mimify-message)
|
|
562 (push-mark)
|
|
563 (let ((start (point)) end)
|
|
564 (insert "--" (mime-primary-boundary) "\n")
|
|
565 (insert "Content-Type: text/plain")
|
|
566 (setq end (point))
|
|
567 (insert "\n\n")
|
|
568 (mime-maybe-highlight-region start end))
|
|
569 (mime-display-waiting-messages))
|
|
570
|
|
571 ;;; ---------------------------- file inclusions -----------------------------
|
|
572
|
|
573 (defun mime-include-file (filename content-type binary &optional charset)
|
|
574 "Include a file named by FILENAME and with MIME content type
|
|
575 CONTENT-TYPE. If third argument BINARY is T, then the file is binary;
|
|
576 else it's text. Optional fourth arg CHARSET names character set for
|
|
577 data. Data will be encoded in base64 or quoted-printable format as
|
|
578 appropriate."
|
|
579 (mime-mimify-message)
|
|
580 (push-mark)
|
|
581 (insert "--" (mime-primary-boundary) "\n")
|
|
582 (insert "Content-Type: " content-type)
|
|
583 (if charset
|
|
584 (insert "; charset=" charset))
|
|
585 (if (and mime-name-included-files (not (string= filename mime-audio-file)))
|
|
586 (insert "; name=\"" (file-name-nondirectory filename) "\""))
|
|
587 (insert "\n")
|
|
588 (if (not (string= filename mime-audio-file))
|
|
589 (insert "Content-Description: " filename "\n"))
|
|
590 (if binary
|
|
591 (insert "Content-Transfer-Encoding: base64\n")
|
|
592 (insert "Content-Transfer-Encoding: quoted-printable\n"))
|
|
593 (mime-maybe-highlight-region
|
|
594 (save-excursion (re-search-backward
|
|
595 (concat "--" (mime-primary-boundary))) (point))
|
|
596 (- (point) 1))
|
|
597 (let ((start (point)) end (seldisp selective-display))
|
|
598 (next-line 1)
|
|
599 (save-excursion
|
|
600 (next-line -1)
|
|
601 (insert-file filename))
|
|
602 (setq end (- (point) 1))
|
|
603 (setq selective-display nil)
|
|
604 (if binary
|
|
605 (shell-command-on-region start end mime-encode-base64-command t)
|
|
606 (shell-command-on-region start end mime-encode-qp-command t))
|
|
607 (setq selective-display seldisp)
|
|
608 (setq end (point))
|
|
609 (mime-maybe-hide-region start (- end 1))
|
|
610 (insert "\n")
|
|
611 (insert "--" (mime-primary-boundary) "\n")
|
|
612 (insert "Content-Type: text/plain\n")
|
|
613 (mime-maybe-highlight-region
|
|
614 (save-excursion (re-search-backward
|
|
615 (concat "--" (mime-primary-boundary))) (point))
|
|
616 (- (point) 1))
|
|
617 (insert "\n\n")
|
|
618 (next-line -1)))
|
|
619
|
|
620 (defun mime-include-binary-file (filename content-type)
|
|
621 "Include a binary file named by FILENAME at point in a MIME message.
|
|
622 CONTENT-TYPE names MIME content type of file. Data will be encoded in
|
|
623 base64 format."
|
|
624 (mime-include-file filename content-type t))
|
|
625
|
|
626 (defun mime-include-nonbinary-file (filename content-type &optional charset)
|
|
627 "Include a nonbinary file named by FILENAME at point in a MIME
|
|
628 message. CONTENT-TYPE names MIME content type of file; optional third
|
|
629 arg CHARSET names MIME character set. Data will be encoded in
|
|
630 quoted-printable format."
|
|
631 (mime-include-file filename content-type nil charset))
|
|
632
|
|
633 ;;; -------------------------- external references ---------------------------
|
|
634
|
|
635 (defun mime-include-external (site directory name content-type description
|
|
636 access-type)
|
|
637 "Include an external pointer in a MIME message. Args are SITE,
|
|
638 DIRECTORY, NAME, CONTENT-TYPE, DESCRIPTION, and ACCESS-TYPE; these are
|
|
639 all strings."
|
|
640 (mime-mimify-message)
|
|
641 (push-mark)
|
|
642 (insert "--" (mime-primary-boundary) "\n")
|
|
643 (insert "Content-Type: message/external-body;\n")
|
|
644 (insert "\taccess-type=\"" access-type "\";\n")
|
|
645 (insert "\tsite=\"" site "\";\n")
|
|
646 (insert "\tdirectory=\"" directory "\";\n")
|
|
647 (insert "\tname=\"" name "\"\n")
|
|
648 (insert "Content-Description: " description "\n")
|
|
649 (insert "\n")
|
|
650 (insert "Content-Type: " content-type "\n")
|
|
651 (mime-maybe-highlight-region
|
|
652 (save-excursion (re-search-backward
|
|
653 (concat "--" (mime-primary-boundary))) (point))
|
|
654 (- (point) 1))
|
|
655 (insert "\n")
|
|
656 (insert "\n")
|
|
657 (insert "--" (mime-primary-boundary) "\n")
|
|
658 (insert "Content-Type: text/plain\n")
|
|
659 (mime-maybe-highlight-region
|
|
660 (save-excursion (re-search-backward
|
|
661 (concat "--" (mime-primary-boundary))) (point))
|
|
662 (- (point) 1))
|
|
663 (insert "\n"))
|
|
664
|
|
665 (defun mime-include-external-anonftp (site directory name description)
|
|
666 "Include an external pointer (anonymous FTP) in a MIME message. Args
|
|
667 are SITE, DIRECTORY, NAME, and DESCRIPTION; these are all strings, and
|
|
668 if interactive, will be prompted for."
|
|
669 (interactive
|
|
670 "sFTP site: \nsRemote directory name: \nsRemote filename: \nsDescription: ")
|
|
671 (let ((content-type
|
|
672 (completing-read "Content type: " mime-valid-include-types
|
|
673 nil nil nil)))
|
|
674 ;; Unadvertised default.
|
|
675 (if (string= content-type "")
|
|
676 (setq content-type "application/octet-stream"))
|
|
677 (mime-include-external site directory name content-type
|
|
678 description "anon-ftp"))
|
|
679 (mime-display-waiting-messages))
|
|
680
|
|
681 (defun mime-include-external-ftp (site directory name description)
|
|
682 "Include an external pointer (regular FTP) in a MIME message. Args
|
|
683 are SITE, DIRECTORY, NAME, and DESCRIPTION; these are all strings, and
|
|
684 if interactive, will be prompted for."
|
|
685 (interactive
|
|
686 "sFTP site: \nsRemote directory name: \nsRemote filename: \nsDescription: ")
|
|
687 (let ((content-type
|
|
688 (completing-read "Content type: " mime-valid-include-types
|
|
689 nil nil nil)))
|
|
690 ;; Unadvertised default.
|
|
691 (if (string= content-type "")
|
|
692 (setq content-type "application/octet-stream"))
|
|
693 (mime-include-external site directory name content-type
|
|
694 description "ftp"))
|
|
695 (mime-display-waiting-messages))
|
|
696
|
|
697 ;;; ------------------------------ window dumps ------------------------------
|
|
698
|
|
699 (defun mime-include-xwd-dump ()
|
|
700 "Run program named by 'mime-xwd-command' and include the results in
|
|
701 a MIME message."
|
|
702 (interactive)
|
|
703 (mime-mimify-message)
|
|
704 (push-mark)
|
|
705 (insert "--" (mime-primary-boundary) "\n")
|
|
706 (insert "Content-Type: image/x-xwd\n")
|
|
707 (insert "Content-Description: Window dump from " (system-name) "\n")
|
|
708 (insert "Content-Transfer-Encoding: base64\n")
|
|
709 (mime-maybe-highlight-region
|
|
710 (save-excursion (re-search-backward
|
|
711 (concat "--" (mime-primary-boundary))) (point))
|
|
712 (- (point) 1))
|
|
713 (insert "\n")
|
|
714 (let ((start (point)) end (seldisp selective-display))
|
|
715 (next-line 1)
|
|
716 (save-excursion
|
|
717 (next-line -1)
|
|
718 (message "When crosshair cursor appears, click on window...")
|
|
719 (sit-for 0)
|
|
720 (call-process "/bin/sh" nil t nil "-c" mime-xwd-command)
|
|
721 (message "")
|
|
722 (sit-for 0))
|
|
723 (setq end (point))
|
|
724 (setq selective-display nil)
|
|
725 (shell-command-on-region start end mime-encode-base64-command t)
|
|
726 (setq selective-display seldisp)
|
|
727 (setq end (point))
|
|
728 (mime-maybe-hide-region start (- end 1))
|
|
729 (insert "\n")
|
|
730 (insert "--" (mime-primary-boundary) "\n")
|
|
731 (insert "Content-Type: text/plain\n")
|
|
732 (mime-maybe-highlight-region
|
|
733 (save-excursion (re-search-backward
|
|
734 (concat "--" (mime-primary-boundary))) (point))
|
|
735 (- (point) 1))
|
|
736 (insert "\n\n")
|
|
737 (next-line -1))
|
|
738 (mime-display-waiting-messages))
|
|
739
|
|
740 ;;; ----------------------------- audio snippets -----------------------------
|
|
741
|
|
742 (defun mime-sgi-grab-audio-snippet ()
|
|
743 "Grab an audio snippet into file named in 'mime-audio-file'.
|
|
744 This routine works on SGI Indigo's and 4D/35's."
|
|
745 (let (audio-process done-flag)
|
|
746 (setq audio-process
|
|
747 (start-process "snippet" "snippet"
|
|
748 mime-sgi-record-program "-n" "1" "-s" "8" "-r" "8000"
|
|
749 mime-audio-tmp-file))
|
|
750 ;; Quick hack to make Emacs sit until recording is done.
|
|
751 (setq done-flag
|
|
752 (y-or-n-p "Press y when done recording (n to abort): "))
|
|
753 (interrupt-process "snippet")
|
|
754 ;; Wait until recordaiff has written data to disk.
|
|
755 (while (eq (process-status "snippet") 'run)
|
|
756 (message "Waiting...")
|
|
757 (sleep-for 1))
|
|
758 (message "Done waiting.")
|
|
759 ;; Kill off recordaiff and our buffer.
|
|
760 (delete-process "snippet")
|
|
761 (kill-buffer "snippet")
|
|
762 ;; Remove the old mulaw file and do the conversion.
|
|
763 (call-process "/bin/rm" nil nil nil "-f" mime-audio-file)
|
|
764 (if done-flag
|
|
765 (call-process "/usr/sbin/sfconvert" nil nil nil mime-audio-tmp-file
|
|
766 mime-audio-file "-o" "mulaw"))
|
|
767 (call-process "/bin/rm" nil nil nil "-f" mime-audio-tmp-file)
|
|
768 ;; Return done flag. If nil, mime-include-audio-snippet should
|
|
769 ;; clean up.
|
|
770 done-flag))
|
|
771
|
|
772 (defun mime-sun-grab-audio-snippet ()
|
|
773 "Grab an audio snippet into file named in 'mime-audio-file'.
|
|
774 This is the Sun version. I don't know how well it works. It also
|
|
775 requires a patched version of /usr/demo/SOUND/record.c; see the
|
|
776 context diff at the end of mime-compose.el.
|
|
777
|
|
778 Courtesy Christopher Davis <ckd@eff.org>."
|
|
779 (let (audio-process done-flag)
|
|
780 (setq audio-process
|
|
781 (start-process "snippet" "snippet"
|
|
782 mime-sun-record-program "-m" mime-audio-file))
|
|
783 ;; Quick hack to make Emacs sit until recording is done.
|
|
784 (setq done-flag
|
|
785 (y-or-n-p "Press y when done recording (n to abort): "))
|
|
786 (interrupt-process "snippet")
|
|
787 ;; Wait until the record process is done.
|
|
788 (while (eq (process-status "snippet") 'run)
|
|
789 (message "Waiting...")
|
|
790 (sleep-for 1))
|
|
791 (message "Done waiting.")
|
|
792 ;; Kill off the record process and our buffer.
|
|
793 (delete-process "snippet")
|
|
794 (kill-buffer "snippet")
|
|
795 ;; Return done flag. If nil, mime-include-audio-snippet should
|
|
796 ;; clean up.
|
|
797 done-flag))
|
|
798
|
|
799 (defun mime-include-audio-snippet ()
|
|
800 "Record a snippet of audio in a MIME message. This should work on
|
|
801 both Silicon Graphics and Sun platforms. Code contributions for other
|
|
802 platforms are welcome."
|
|
803 (interactive)
|
|
804 (let ((mime-grab-audio-snippet
|
|
805 (if mime-using-silicon-graphics
|
|
806 'mime-sgi-grab-audio-snippet
|
|
807 'mime-sun-grab-audio-snippet)))
|
|
808 (if (eq (funcall mime-grab-audio-snippet) t)
|
|
809 (progn
|
|
810 (mime-include-binary-file mime-audio-file "audio/basic")
|
|
811 (save-excursion
|
|
812 (next-line -4)
|
|
813 (mime-add-description
|
|
814 (concat (user-full-name) " "
|
|
815 mime-babbling-description "."))))))
|
|
816 (mime-display-waiting-messages))
|
|
817
|
|
818 ;;; ------------------------- Basic include commands -------------------------
|
|
819
|
|
820 (defun mime-include-gif (filename)
|
|
821 "Include a GIF file named by FILENAME."
|
|
822 (interactive "fGIF image filename: ")
|
|
823 (mime-include-binary-file filename "image/gif")
|
|
824 (mime-display-waiting-messages))
|
|
825
|
|
826 (defun mime-include-jpeg (filename)
|
|
827 "Include a JPEG file named by FILENAME."
|
|
828 (interactive "fJPEG image filename: ")
|
|
829 (mime-include-binary-file filename "image/jpeg")
|
|
830 (mime-display-waiting-messages))
|
|
831
|
|
832 (defun mime-include-audio (filename &optional prefix-arg)
|
|
833 "Include an audio file named by FILENAME. Note that to match the
|
|
834 MIME specification for audio/basic, this should be an 8-bit mulaw file.
|
|
835 With prefix arg, use AIFF format (unofficial MIME subtype audio/x-aiff)
|
|
836 instead of audio/basic."
|
|
837 (interactive "fAudio filename: \nP")
|
|
838 (if prefix-arg
|
|
839 (mime-include-binary-file filename "audio/x-aiff")
|
|
840 (mime-include-binary-file filename "audio/basic"))
|
|
841 (mime-display-waiting-messages))
|
|
842
|
|
843 (defun mime-include-mpeg (filename)
|
|
844 "Include a MPEG file named by FILENAME."
|
|
845 (interactive "fMPEG animation filename: ")
|
|
846 (mime-include-binary-file filename "video/mpeg")
|
|
847 (mime-display-waiting-messages))
|
|
848
|
|
849 (defun mime-include-postscript (filename)
|
|
850 "Include a PostScript file named by FILENAME."
|
|
851 (interactive "fPostScript filename: ")
|
|
852 (mime-include-nonbinary-file filename "application/postscript")
|
|
853 (mime-display-waiting-messages))
|
|
854
|
|
855 (defun mime-include-raw-binary (filename)
|
|
856 "Include a raw binary file named by FILENAME."
|
|
857 (interactive "fRaw binary filename: ")
|
|
858 (let ((content-type
|
|
859 (completing-read "Content type (RET for default): "
|
|
860 mime-valid-include-types
|
|
861 nil nil nil)))
|
|
862 (if (string= content-type "")
|
|
863 (setq content-type "application/octet-stream"))
|
|
864 (mime-include-binary-file filename content-type))
|
|
865 (mime-display-waiting-messages))
|
|
866
|
|
867 (defun mime-include-raw-nonbinary (filename &optional prefix-arg)
|
|
868 "Include a raw nonbinary file named by FILENAME. With prefix arg,
|
|
869 prompt for character set."
|
|
870 (interactive "fRaw nonbinary filename: \nP")
|
|
871 (let ((charset
|
|
872 (if prefix-arg
|
|
873 (completing-read "Character set: " mime-valid-charsets
|
|
874 nil nil nil)
|
|
875 mime-default-charset))
|
|
876 (content-type
|
|
877 (completing-read "Content type (RET for default): "
|
|
878 mime-valid-include-types
|
|
879 nil nil nil)))
|
|
880 (if (string= content-type "")
|
|
881 (setq content-type "text/plain"))
|
|
882 (if (string= charset "")
|
|
883 (setq charset "asdfasdfdfsdafs"))
|
|
884 (mime-include-nonbinary-file filename content-type charset))
|
|
885 (mime-display-waiting-messages))
|
|
886
|
|
887 ;;; ---------------------------- Region commands -----------------------------
|
|
888
|
|
889 (defun mime-encode-region (start end content-type charset)
|
|
890 "Encode a region specified by START and END. CONTENT-TYPE and
|
|
891 CHARSET name the content type and character set of the data in the
|
|
892 region."
|
|
893 ;; Start by encoding the region in quoted-printable. This will
|
|
894 ;; move end, but not start.
|
|
895 (goto-char end)
|
|
896 (let ((seldisp selective-display))
|
|
897 (setq selective-display nil)
|
|
898 (shell-command-on-region start end mime-encode-qp-command t)
|
|
899 (setq selective-display seldisp))
|
|
900 ;; Now pick up the new end.
|
|
901 (setq end (point))
|
|
902 ;; Pop up to start and insert the header; this will also change
|
|
903 ;; end, but with save-excursion we'll end up at the new end.
|
|
904 (save-excursion
|
|
905 (goto-char start)
|
|
906 (push-mark)
|
|
907 (insert "--" (mime-primary-boundary) "\n")
|
|
908 (insert "Content-Type: " content-type "; charset=" charset "\n")
|
|
909 (insert "Content-Transfer-Encoding: quoted-printable\n")
|
|
910 (mime-maybe-highlight-region
|
|
911 (save-excursion (re-search-backward
|
|
912 (concat "--" (mime-primary-boundary))) (point))
|
|
913 (- (point) 1))
|
|
914 (insert "\n"))
|
|
915 ;; Pick up the new end again.
|
|
916 (setq end (point))
|
|
917 ;; Insert the trailing boundary and the new text/plain header.
|
|
918 (insert "\n")
|
|
919 (insert "--" (mime-primary-boundary) "\n")
|
|
920 (insert "Content-Type: text/plain\n")
|
|
921 (mime-maybe-highlight-region
|
|
922 (save-excursion (re-search-backward
|
|
923 (concat "--" (mime-primary-boundary))) (point))
|
|
924 (- (point) 1))
|
|
925 (insert "\n")
|
|
926 ;; Last but not least, add MIME headers if necessary.
|
|
927 (save-excursion
|
|
928 (mime-mimify-message)))
|
|
929
|
|
930 (defun mime-region-to-richtext (start end &optional prefix-arg)
|
|
931 "Convert the current region to MIME richtext. MIME headers are
|
|
932 added if necessary; a MIME boundary is added at the start of the
|
|
933 region to indicate richtext; the conversion (see below) is done; a new
|
|
934 boundary is added for more text.
|
|
935
|
|
936 With prefix arg, prompt for character set; else use value of
|
|
937 mime-default-charset.
|
|
938
|
|
939 Currently no textual conversion is done, other than encoding in
|
|
940 quoted-printable format. Instead, you use directives such as <bold>
|
|
941 and </bold> in the text, as described in the MIME RFC. The
|
|
942 alternative would be to parse tilde sequences as is done in the mailto
|
|
943 program. Let me know if you think the latter would be more
|
|
944 appropriate for mime-compose.el."
|
|
945 (interactive "r\nP")
|
|
946 (let ((charset
|
|
947 (if (not prefix-arg)
|
|
948 mime-default-charset
|
|
949 (completing-read "Character set: " mime-valid-charsets
|
|
950 nil nil nil))))
|
|
951 ;; Unadvertised default.
|
|
952 (if (string= charset "")
|
|
953 (setq charset mime-default-charset))
|
|
954 (mime-encode-region start end "text/richtext"
|
|
955 charset))
|
|
956 (mime-display-waiting-messages))
|
|
957
|
|
958 (defun mime-region-to-charset (start end)
|
|
959 "Convert the current region to plaintext in a non-default character
|
|
960 set. You are prompted for a character set, and the text in the region
|
|
961 is encoded in quoted-printable format and identified as being in that
|
|
962 character set."
|
|
963 (interactive "r")
|
|
964 (let ((charset
|
|
965 (completing-read "Character set: " mime-valid-charsets
|
|
966 nil nil nil)))
|
|
967 ;; Unadvertised default.
|
|
968 (if (string= charset "")
|
|
969 (setq charset mime-default-charset))
|
|
970 (mime-encode-region start end "text/plain" charset))
|
|
971 (mime-display-waiting-messages))
|
|
972
|
|
973 ;;; -------------------------------- Keymaps ---------------------------------
|
|
974
|
|
975 ;;; Add functions to MH letter mode.
|
|
976 (if mime-running-mh-e
|
|
977 ;; Running mh-e.
|
|
978 (if (or (not (boundp 'mh-letter-mode-mime-map))
|
|
979 (not mh-letter-mode-mime-map))
|
|
980 (progn
|
|
981 (setq mh-letter-mode-mime-map (make-sparse-keymap))
|
|
982 (define-key mh-letter-mode-map "\C-c\C-m" mh-letter-mode-mime-map)
|
|
983 (define-key mh-letter-mode-mime-map "m" 'mime-mimify-message)
|
|
984 (define-key mh-letter-mode-mime-map "g" 'mime-include-gif)
|
|
985 (define-key mh-letter-mode-mime-map "j" 'mime-include-jpeg)
|
|
986 (define-key mh-letter-mode-mime-map "a" 'mime-include-audio)
|
|
987 (define-key mh-letter-mode-mime-map "v" 'mime-include-mpeg)
|
|
988 (define-key mh-letter-mode-mime-map "p" 'mime-include-postscript)
|
|
989 (define-key mh-letter-mode-mime-map "r" 'mime-include-raw-binary)
|
|
990 (define-key mh-letter-mode-mime-map "n" 'mime-include-raw-nonbinary)
|
|
991 (define-key mh-letter-mode-mime-map "x" 'mime-include-xwd-dump)
|
|
992 (define-key mh-letter-mode-mime-map "e"
|
|
993 'mime-include-external-anonftp)
|
|
994 (define-key mh-letter-mode-mime-map "f"
|
|
995 'mime-include-external-ftp)
|
|
996 (define-key mh-letter-mode-mime-map "s"
|
|
997 'mime-include-audio-snippet)
|
|
998 ;; Functions that operate on regions.
|
|
999 (defvar mime-region-map (make-sparse-keymap))
|
|
1000 (define-key mh-letter-mode-mime-map "\C-r" mime-region-map)
|
|
1001 (define-key mime-region-map "r" 'mime-region-to-richtext)
|
|
1002 (define-key mime-region-map "i" 'mime-region-to-charset)))
|
|
1003 ;; Not running mh-e.
|
|
1004 (progn
|
|
1005 (define-key mail-mode-map "\C-cm" 'mime-mimify-message)
|
|
1006 (define-key mail-mode-map "\C-cg" 'mime-include-gif)
|
|
1007 (define-key mail-mode-map "\C-cj" 'mime-include-jpeg)
|
|
1008 (define-key mail-mode-map "\C-ca" 'mime-include-audio)
|
|
1009 (define-key mail-mode-map "\C-cp" 'mime-include-postscript)
|
|
1010 (define-key mail-mode-map "\C-cr" 'mime-include-raw-binary)
|
|
1011 (define-key mail-mode-map "\C-cn" 'mime-include-raw-nonbinary)
|
|
1012 (define-key mail-mode-map "\C-cx" 'mime-include-xwd-dump)
|
|
1013 (define-key mail-mode-map "\C-ce" 'mime-include-external-anonftp)
|
|
1014 (define-key mail-mode-map "\C-cf" 'mime-include-external-ftp)
|
|
1015 (define-key mail-mode-map "\C-cs" 'mime-include-audio-snippet)
|
|
1016 (define-key mail-mode-map "\C-cv" 'mime-include-mpeg)
|
|
1017
|
|
1018 ;; Functions that operate on regions.
|
|
1019 (defvar mime-region-map (make-sparse-keymap))
|
|
1020 (define-key mail-mode-map "\C-c\C-r" mime-region-map)
|
|
1021 (define-key mime-region-map "r" 'mime-region-to-richtext)
|
|
1022 (define-key mime-region-map "i" 'mime-region-to-charset)))
|
|
1023
|
|
1024 ;;; -------------------------------- Menubar ---------------------------------
|
|
1025
|
|
1026 (defvar mime-compose-menu
|
|
1027 (list
|
|
1028 "MIME Inclusions:"
|
|
1029 "----"
|
|
1030 ["Include GIF File" mime-include-gif t]
|
|
1031 ["Include JPEG File" mime-include-jpeg t]
|
|
1032 ["Include MPEG File" mime-include-mpeg t]
|
|
1033 ["Include Audio File" mime-include-audio t]
|
|
1034 ["Include PostScript File" mime-include-postscript t]
|
|
1035 ["Include XWD Dump" mime-include-xwd-dump t]
|
|
1036 ["Include Audio Snippet" mime-include-audio-snippet t]
|
|
1037 ["Include Raw Binary File" mime-include-raw-binary t]
|
|
1038 ["Include Raw Nonbinary File" mime-include-raw-nonbinary t]
|
|
1039 ["Include External AnonFTP" mime-include-external-anonftp t]
|
|
1040 ["Include External FTP" mime-include-external-ftp t]
|
|
1041 )
|
|
1042 "Popup menu for MIME Compose.")
|
|
1043
|
|
1044 ;; Attach menu to mail-mode-menu.
|
|
1045 (and mime-running-lemacs
|
|
1046 (setq mail-menubar-menu (append mail-menubar-menu '("---") mime-compose-menu))
|
|
1047 (setq mail-popup-menu (append mail-popup-menu '("---") mime-compose-menu)))
|
|
1048
|
|
1049 ;; Arrange to attach to VM's mail mode menu.
|
|
1050 (defun mime-compose-attach-to-mode-menu ()
|
|
1051 (if (boundp 'vm-menu-mail-menu)
|
|
1052 (progn
|
|
1053 (setq vm-menu-mail-menu
|
|
1054 (nconc vm-menu-mail-menu (list "----") mime-compose-menu))
|
|
1055 (remove-hook 'vm-mail-mode-hook 'mime-compose-attach-to-mode-menu))))
|
|
1056
|
|
1057 (add-hook 'vm-mail-mode-hook 'mime-compose-attach-to-mode-menu)
|
|
1058
|
|
1059 ;;; ----------------------------- New mail-send ------------------------------
|
|
1060
|
|
1061 ;; If we're not running XEmacs, pop in a new mail-send routine.
|
|
1062 (if (not mime-running-lemacs)
|
|
1063 (defun mail-send ()
|
|
1064 "Send the message in the current buffer.
|
|
1065 If mail-interactive is non-nil, wait for success indication
|
|
1066 or error messages, and inform user.
|
|
1067 Otherwise any failure is reported in a message back to
|
|
1068 the user from the mailer."
|
|
1069 (interactive)
|
|
1070 (message "Sending...")
|
|
1071 (run-hooks 'mail-send-hook)
|
|
1072 (funcall send-mail-function)
|
|
1073 (set-buffer-modified-p nil)
|
|
1074 (delete-auto-save-file-if-necessary)
|
|
1075 (message "Sending...done")))
|
|
1076
|
|
1077 ;;; --------------------------------- Hooks ----------------------------------
|
|
1078
|
|
1079 ;; Author: Daniel LaLiberte (liberte@cs.uiuc.edu).
|
|
1080 (defun mime-postpend-unique-hook (hook-var hook-function)
|
|
1081 "Postpend HOOK-VAR with HOOK-FUNCTION, if it is not already an element.
|
|
1082 hook-var's value may be a single function or a list of functions."
|
|
1083 (if (boundp hook-var)
|
|
1084 (let ((value (symbol-value hook-var)))
|
|
1085 (if (and (listp value) (not (eq (car value) 'lambda)))
|
|
1086 (and (not (memq hook-function value))
|
|
1087 (set hook-var (append value (list hook-function))))
|
|
1088 (and (not (eq hook-function value))
|
|
1089 (set hook-var (append value (list hook-function))))))
|
|
1090 (set hook-var (list hook-function))))
|
|
1091
|
|
1092 (defun mime-unfrob-selective-display ()
|
|
1093 "Turn off selective display throughout this buffer."
|
|
1094 (if mime-use-selective-display
|
|
1095 (progn
|
|
1096 (message "Unfrobbing selective-display...")
|
|
1097 (mime-hide-region (point-min) (point-max) nil))))
|
|
1098
|
|
1099 (defun mime-strip-useless-bodyparts ()
|
|
1100 "Strip useless (empty) bodyparts out of a message."
|
|
1101 (save-excursion
|
|
1102 (goto-char (point-min))
|
|
1103 (while (re-search-forward
|
|
1104 (concat "^--" (mime-primary-boundary)
|
|
1105 "\nContent-Type: text.*[\n]*--" (mime-primary-boundary))
|
|
1106 (point-max) t)
|
|
1107 (replace-match (concat "--" (mime-primary-boundary)) t t)
|
|
1108 ;; Go all the way back up to start over.
|
|
1109 (goto-char (point-min)))))
|
|
1110
|
|
1111 (defun mime-encode-region-qp (start end)
|
|
1112 "Encode a region specified by START and END in quoted-printable
|
|
1113 format. Return the new endpoint. Do not use save-excursion."
|
|
1114 ;; Start by encoding the region in quoted-printable. This will
|
|
1115 ;; move end, but not start.
|
|
1116 (goto-char end)
|
|
1117 (let ((seldisp selective-display))
|
|
1118 (setq selective-display nil)
|
|
1119 (shell-command-on-region start end mime-encode-qp-command t)
|
|
1120 (setq selective-display seldisp)))
|
|
1121
|
|
1122 (defun mime-encode-plaintext ()
|
|
1123 "Encode all plaintext bodyparts in the message in quoted-printable
|
|
1124 and set the charset to mime-default-charset."
|
|
1125 (save-excursion
|
|
1126 (goto-char (point-min))
|
|
1127 ;; We're looking for text/plain bodyparts with no extra fields.
|
|
1128 (while (re-search-forward
|
|
1129 (concat "^--" (mime-primary-boundary)
|
|
1130 "\nContent-Type: text/plain\n") (point-max) t)
|
|
1131 (let* ((head (match-beginning 0))
|
|
1132 (start (match-end 0))
|
|
1133 ;; Assume there's a closing boundary; go find it.
|
|
1134 (end (save-excursion (re-search-forward
|
|
1135 (concat "^--" (mime-primary-boundary)))
|
|
1136 (- (match-beginning 0) 1))))
|
|
1137 ;; Maybe there's already a Content-Transfer-Encoding. If so,
|
|
1138 ;; never mind.
|
|
1139 (or (re-search-forward "^Content-Transfer-Encoding: " end t)
|
|
1140 (let ((new-end (save-excursion
|
|
1141 (mime-encode-region-qp start end))))
|
|
1142 (save-excursion
|
|
1143 (goto-char head)
|
|
1144 (next-line 1)
|
|
1145 (end-of-line)
|
|
1146 (let ((s (point)))
|
|
1147 (insert "; charset=" mime-default-charset "\n")
|
|
1148 (insert "Content-Transfer-Encoding: quoted-printable")
|
|
1149 (mime-maybe-highlight-region s (point))))))))))
|
|
1150
|
|
1151 (defun mime-send-hook-function ()
|
|
1152 "Function to be called from mail-send-hook. Unfrob selective
|
|
1153 display if active, strip out empty (useless) bodyparts, and optionally
|
|
1154 encode plaintext bodyparts in quoted-printable with a given charset."
|
|
1155 (mime-unfrob-selective-display)
|
|
1156 (mime-strip-useless-bodyparts)
|
|
1157 (and mime-encode-plaintext-on-send
|
|
1158 (mime-encode-plaintext)))
|
|
1159
|
|
1160 ;; Before the message is sent, remove the selective display crap.
|
|
1161 (if mime-running-mh-e
|
|
1162 (mime-postpend-unique-hook 'mh-before-send-letter-hook
|
|
1163 'mime-send-hook-function)
|
|
1164 (mime-postpend-unique-hook 'mail-send-hook 'mime-send-hook-function))
|
|
1165
|
|
1166 (defun mime-setup-hook-function ()
|
|
1167 (if mime-use-selective-display
|
|
1168 (setq selective-display t)))
|
|
1169
|
|
1170 ;; During mail setup, activate selective-display if necessary. We use
|
|
1171 ;; mail-mode-hook rather than mail-setup-hook because if a message is
|
|
1172 ;; being composed and C-x m gets hit again, mail-mode will be
|
|
1173 ;; reentered, causing selective-display to revert to nil and possibly
|
|
1174 ;; screwing up the display bigtime unless mail-mode-hook knows what to
|
|
1175 ;; do.
|
|
1176 (if mime-running-mh-e
|
|
1177 (mime-postpend-unique-hook 'mh-letter-mode-hook
|
|
1178 'mime-setup-hook-function)
|
|
1179 (mime-postpend-unique-hook 'mail-mode-hook 'mime-setup-hook-function))
|
|
1180
|
|
1181 ;;; ------------------------- END OF MIME-COMPOSE.EL -------------------------
|
|
1182
|
|
1183 ;;; ---------------------- PATCH FOR SUN RECORD PROGRAM ----------------------
|
|
1184
|
|
1185 ;;; This patch must be applied to record.c as found in the Sun demo
|
|
1186 ;;; directories in order to enable on-the-fly audio recording in
|
|
1187 ;;; mime-compose.
|
|
1188
|
|
1189 ;; *** record.c.orig Wed Oct 23 13:56:38 1991
|
|
1190 ;; --- record.c Sun Dec 6 22:50:06 1992
|
|
1191 ;; ***************
|
|
1192 ;; *** 2,7 ****
|
|
1193 ;; --- 2,9 ----
|
|
1194 ;; static char sccsid[] = "@(#)record.c 1.2 90/01/02 Copyr 1989 Sun Micro";
|
|
1195 ;; #endif
|
|
1196 ;; /* Copyright (c) 1989 by Sun Microsystems, Inc. */
|
|
1197 ;; + /* 921206: modifications to not output audio header (ckd@eff.org) */
|
|
1198 ;; + /* yes, I know it's ugly code... sorry... */
|
|
1199 ;;
|
|
1200 ;; #include <stdio.h>
|
|
1201 ;; #include <errno.h>
|
|
1202 ;; ***************
|
|
1203 ;; *** 30,36 ****
|
|
1204 ;; /* Local variables */
|
|
1205 ;; char *prog;
|
|
1206 ;; char prog_desc[] = "Record an audio file";
|
|
1207 ;; ! char prog_opts[] = "aft:v:d:i:?"; /* getopt() flags */
|
|
1208 ;;
|
|
1209 ;; char *Stdout = "stdout";
|
|
1210 ;;
|
|
1211 ;; --- 32,38 ----
|
|
1212 ;; /* Local variables */
|
|
1213 ;; char *prog;
|
|
1214 ;; char prog_desc[] = "Record an audio file";
|
|
1215 ;; ! char prog_opts[] = "aft:v:d:i:?m"; /* getopt() flags */
|
|
1216 ;;
|
|
1217 ;; char *Stdout = "stdout";
|
|
1218 ;;
|
|
1219 ;; ***************
|
|
1220 ;; *** 69,76 ****
|
|
1221 ;; usage()
|
|
1222 ;; {
|
|
1223 ;; Error(stderr, "%s -- usage:\n\t%s ", prog_desc, prog);
|
|
1224 ;; ! Error(stderr, "\t[-a] [-v #] [-t #] [-i msg] [-d dev] [file]\n");
|
|
1225 ;; Error(stderr, "where:\n\t-a\tAppend to output file\n");
|
|
1226 ;; Error(stderr, "\t-f\tIgnore sample rate differences on append\n");
|
|
1227 ;; Error(stderr, "\t-v #\tSet record volume (0 - %d)\n", MAX_GAIN);
|
|
1228 ;; Error(stderr, "\t-t #\tSpecify record time (hh:mm:ss.dd)\n");
|
|
1229 ;; --- 71,79 ----
|
|
1230 ;; usage()
|
|
1231 ;; {
|
|
1232 ;; Error(stderr, "%s -- usage:\n\t%s ", prog_desc, prog);
|
|
1233 ;; ! Error(stderr, "\t[-a] [-m] [-v #] [-t #] [-i msg] [-d dev] [file]\n");
|
|
1234 ;; Error(stderr, "where:\n\t-a\tAppend to output file\n");
|
|
1235 ;; + Error(stderr, "\t-m\tDon't add audio header (for MIME)\n");
|
|
1236 ;; Error(stderr, "\t-f\tIgnore sample rate differences on append\n");
|
|
1237 ;; Error(stderr, "\t-v #\tSet record volume (0 - %d)\n", MAX_GAIN);
|
|
1238 ;; Error(stderr, "\t-t #\tSpecify record time (hh:mm:ss.dd)\n");
|
|
1239 ;; ***************
|
|
1240 ;; *** 112,117 ****
|
|
1241 ;; --- 115,121 ----
|
|
1242 ;; int cnt;
|
|
1243 ;; int err;
|
|
1244 ;; int ofd;
|
|
1245 ;; + int addheader = 1;
|
|
1246 ;; double vol;
|
|
1247 ;; struct stat st;
|
|
1248 ;; struct sigvec vec;
|
|
1249 ;; ***************
|
|
1250 ;; *** 150,155 ****
|
|
1251 ;; --- 154,162 ----
|
|
1252 ;; Info = optarg; /* set information string */
|
|
1253 ;; Ilen = strlen(Info);
|
|
1254 ;; break;
|
|
1255 ;; + case 'm':
|
|
1256 ;; + addheader = 0; /* no header (for MIME) */
|
|
1257 ;; + break;
|
|
1258 ;; case '?':
|
|
1259 ;; usage();
|
|
1260 ;; /*NOTREACHED*/
|
|
1261 ;; ***************
|
|
1262 ;; *** 288,293 ****
|
|
1263 ;; --- 295,301 ----
|
|
1264 ;; exit(1);
|
|
1265 ;; }
|
|
1266 ;; } else {
|
|
1267 ;; + if (addheader) {
|
|
1268 ;; if (audio_write_filehdr(ofd, &Dev_hdr, Info, Ilen) !=
|
|
1269 ;; AUDIO_SUCCESS) {
|
|
1270 ;; Error(stderr, "%s: error writing header for \n", prog);
|
|
1271 ;; ***************
|
|
1272 ;; *** 294,299 ****
|
|
1273 ;; --- 302,308 ----
|
|
1274 ;; perror(Ofile);
|
|
1275 ;; exit(1);
|
|
1276 ;; }
|
|
1277 ;; + }
|
|
1278 ;; }
|
|
1279 ;;
|
|
1280 ;; /* If -v flag, set the record volume now */
|
|
1281
|
|
1282 ;;; ------------------------------ END OF PATCH ------------------------------
|
|
1283
|