Mercurial > hg > xemacs-beta

comparison lisp/packages/mime-compose.el @ 0:376386a54a3c r19-14

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-14
author cvs
date Mon, 13 Aug 2007 08:45:50 +0200
parents
children ec9a17fef872
comparison
equal deleted inserted replaced
-1:000000000000 0:376386a54a3c
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