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

Import from CVS: tag r19-14
author cvs
date Mon, 13 Aug 2007 08:45:50 +0200
parents
children ec9a17fef872
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/packages/mime-compose.el	Mon Aug 13 08:45:50 2007 +0200
@@ -0,0 +1,1283 @@
+;;; File: --- mime-compose.el ---
+;;; Author: Marc Andreessen (marca@ncsa.uiuc.edu)
+;;; Additional code: Keith Waclena (k-waclena@uchicago.edu).
+;;;                  Christopher Davis (ckd@eff.org).
+;;; Copyright (C) National Center for Supercomputing Applications, 1992.
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 1, or (at your option)
+;;; any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with your copy of Emacs; if not, write to the Free Software
+;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+;;;
+;;; Synched up with: Not in FSF.
+
+;;; -------------------------------- CONTENTS --------------------------------
+;;;
+;;; mime-compose: Utility routines for composing MIME-compliant mail.
+;;; !Revision: 1.5 !
+;;; !Date: 1994/03/24 00:00:47 !
+;;;
+;;; Canonical list of features:
+;;;   Automatic MIME header construction.
+;;;   Include GIF/JPEG image.
+;;;   Include audio file.
+;;;   Include PostScript file.
+;;;   Include MPEG animation sequence.
+;;;   Include raw binary/nonbinary file.
+;;;   Include xwd window dump taken on the fly.
+;;;   Include reference to anonymous/regular FTP.
+;;;   Include audio snippet recorded on the fly.
+;;;   Convert region to MIME richtext.
+;;;   Convert region to any ISO 8859 charset.
+;;;   Optional conversion of plaintext bodyparts to quoted-printable
+;;;     with arbitrary charset when messages are sent.
+;;;   Deemphasizing/highlighting of MIME headers.
+;;;   Completion on content type and charset.
+;;;   Automatic encoding in base64 and quoted-printable formats.
+;;;   Selective display hides raw data.
+;;;   Works with mail-mode and mh.
+;;;
+;;; ------------------------------ INSTRUCTIONS ------------------------------
+;;;
+;;; Use the normal Emacs mail composer (C-x m).
+;;;
+;;; (Or, use with Emacs mh-e by loading this file *after* loading mh-e.
+;;; But due to incestuous hookification, you can't require mime-compose
+;;; inside mh-letter-mode-hook.)
+;;;
+;;; Do nothing special to prepare a message to have MIME elements
+;;; included in it.
+;;;
+;;; The basic commands to add MIME elements (images, audio, etc.) to a
+;;; message are as follows:
+;;;
+;;; mail-mode  (mh-e)       function                 what happens
+;;; ~~~~~~~~~  (~~~~~~~~~)  ~~~~~~~~                 ~~~~~~~~~~~~
+;;; C-c g      (C-c C-m g)  mime-include-gif         Add a GIF file.
+;;; C-c j      (C-c C-m j)  mime-include-jpeg        Add a JPEG file.
+;;; C-c a      (C-c C-m a)  mime-include-audio       Add an audio file.
+;;; C-c p      (C-c C-m p)  mime-include-postscript  Add a PostScript file.
+;;; C-c v      (C-c C-m v)  mime-include-mpeg        Add an MPEG file.
+;;;
+;;; (Note that mime-compose assumes you have the 'mmencode' program
+;;; installed on your system.  See 'WHAT MIME IS' below for more
+;;; information on mmencode and the metamail distribution.)
+;;;
+;;; Some mime-compose commands create data themselves; these follow:
+;;;
+;;; C-c x      (C-c C-m x)
+;;;   mime-include-xwd-dump
+;;;   Add the result of an X-window dump.  The program named in
+;;;   mime-xwd-command will be run, and the resulting dump will be
+;;;   inserted into the message.
+;;; C-c s      (C-c C-m s)
+;;;   mime-include-audio-snippet 
+;;;   Add an audio snippet, recorded on the fly.  CURRENTLY THIS WORKS
+;;;   ONLY FOR SILICON GRAPHICS INDIGO AND 4D/35's.  The Sun version
+;;;   may also work; see the source code below.  Recording begins
+;;;   immediately; press 'y' to end recording or 'n' to abort the
+;;;   whole process.  The resulting audio file will be converted to
+;;;   standard mulaw format and incorporated into the message.
+;;;
+;;; If you have a raw binary file and MIME or mime-compose doesn't
+;;; have built-in support for its format (e.g. an Emacs Lisp
+;;; byte-compiled file), you can use:
+;;;
+;;; C-c r      (C-c C-m r)
+;;;   mime-include-raw-binary
+;;;   Add a raw binary file.  You will be prompted for both the
+;;;   filename and the content type of the file; if you do not give a
+;;;   content type, the default (application/octet-stream) will be
+;;;   used, and the recipient will be able to have his/her MIME mail
+;;;   handler extract the raw binary file from the message.
+;;;
+;;; Similarly, to include nonbinary (text) files using
+;;; quoted-printable encoding, use:
+;;;
+;;; C-c n       (C-c C-m n)
+;;;   mime-include-raw-nonbinary 
+;;;   Add a raw nonbinary (text) file.  You will be prompted for both
+;;;   the filename and the content type of the file (which defaults to
+;;;   text/plain).  With prefix arg, you will also be prompted for the
+;;;   character set (default is US-ASCII).
+;;;
+;;; You can also point to external elements: files that will not be
+;;; included in the document, but can be accessed by the recipient in
+;;; some other way (most commonly, via FTP).  The following commands
+;;; handle this:
+;;;
+;;; C-c e       (C-c C-m e)
+;;;   mime-include-external-anonftp
+;;;   Point to an external file (assumed to be accessable via
+;;;   anonymous FTP).  You will be prompted for the name of the FTP
+;;;   site, the remote directory name, and remote filename, the remote
+;;;   file's content type, and a description of the remote file.
+;;; C-c f       (C-c C-m f)
+;;;   mime-include-external-ftp
+;;;   This is the same as 'C-c e', except that the file will be
+;;;   accessed via regular FTP rather than anonymous FTP -- a username
+;;;   and password will have to be provided by the recipient to gain
+;;;   access to the file.
+;;;
+;;; Note that whenever you are prompted for a content type, Emacs'
+;;; completion feature is active: press TAB for a list of valid types.
+;;; You can also enter a type not in the completion list.
+;;;
+;;; If you type in text that belongs in a character set other than the
+;;; default (US-ASCII), you can use the following function to encode
+;;; the text and generate appropriate MIME headers:
+;;;
+;;; C-c C-r i   (C-c C-m C-r i)
+;;;   mime-region-to-charset 
+;;;   Encode region in an alternate character set.  (MIME only
+;;;   sanctions the use of ISO charsets; thus, the command key for
+;;;   this function is 'i'.)  You will be prompted for a character set
+;;;   (minibuffer completion is provided).
+;;;
+;;; MIME also defines a 'richtext' format; you can encode the current
+;;; region as richtext with:
+;;;
+;;; C-c C-r r   (C-c C-m C-r r)
+;;;   mime-region-to-richtext
+;;;   Encode region as richtext.  With prefix arg, you will be
+;;;   prompted for a character set, else the default (US-ASCII) is
+;;;   used.
+;;;
+;;; If you regularly use 8-bit characters in your messages, you will
+;;; probably want all of your plaintext bodyparts automatically
+;;; encoded in quoted-printable and labeled as belonging to the
+;;; character set that you're using when a message is sent.  To have
+;;; this happen, set this variable:
+;;;
+;;; mime-encode-plaintext-on-send       (variable, default NIL)
+;;;   If T, all text/plain bodyparts in the message will be encoded in
+;;;   quoted-printable and labeled with charset mime-default-charset
+;;;   (by default, US-ASCII) when a message is sent.  If NIL,
+;;;   text/plain bodyparts will not be touched.
+;;;
+;;; ---------------------------- ADDITIONAL NOTES ----------------------------
+;;;
+;;; mime-compose uses Emacs' selective-display feature: only the first
+;;; line of any encoded data file will be displayed, followed by
+;;; ellipses (indicating that some data is not being shown).  See the
+;;; variable 'mime-use-selective-display' below.
+;;;
+;;; If you are running XEmacs/Lucid Emacs, the mail-mode popup menu (attached
+;;; to the third mouse button) will include mime-compose entries.
+;;;
+;;; If you are running XEmacs/Lucid Emacs or Epoch, highlighting will be used
+;;; to deemphasize the various MIME headers (but emphasize the various
+;;; MIME content types).  You can turn this feature off; see the
+;;; variable 'mime-use-highlighting'.
+;;;
+;;; After your message has been `mimified' (by including a MIME
+;;; element), it is best not to put trailing text outside the final
+;;; boundary at the end of the file -- such text will not be
+;;; considered to be part of the message by MIME-compliant mail
+;;; readers (although it will still be sent).
+;;;
+;;; As you compose a complex MIME message, you may notice useless
+;;; bodyparts accumulating: extra text/plain bodyparts, in particular,
+;;; containing no text.  These bodyparts will be stripped from the
+;;; message before the message is sent, so you (and I) won't look like
+;;; a moron to the recipient.
+;;;
+;;; A command that usually isn't necessary, but is provided in case
+;;; you wish to send a plaintext message with the various MIME headers
+;;; and boundaries, is:
+;;;
+;;; C-c m     (C-c C-m m)    mime-mimify-message   Mimify a message.
+;;;
+;;; MIME messages can contain elements and structures not yet
+;;; supported by mime-compose.  If you have ideas or code for support
+;;; that should be provided by mime-compose, please send them to the
+;;; author.
+;;;
+;;; ------------------------ WHAT MIME-COMPOSE IS NOT ------------------------
+;;;
+;;; mime-compose is not a MIME message handler.  It will not interpret
+;;; MIME messages, display images, or anything similar.
+;;;
+;;; mime-compose is not intelligent enough (yet) to construct complex
+;;; MIME messages (with nested boundaries, parallel message elements,
+;;; and so on).
+;;;
+;;; mime-compose will not enforce correctness (MIME compliance) on
+;;; your messages.  mime-compose generates MIME-compliant message
+;;; elements, but will sit quietly if you alter them or add your own
+;;; incorrect elements.
+;;;
+;;; In particular, note that the MIME specification demands a blank
+;;; line following the Content declarations for a bodypart.
+;;; mime-compose will give you that blank line, but will not demand
+;;; that you leave it blank; if you don't, your message will not be
+;;; happy.
+;;;
+;;; ------------------------------ WHAT MIME IS ------------------------------
+;;;
+;;; MIME defines a format for email messages containing non-plaintext
+;;; elements (images, audio, etc.).  MIME is detailed in Internet RFC
+;;; 1341, by N. Borenstein and N. Freed.  You can FTP this RFC from
+;;; many archive sites, including uxc.cso.uiuc.edu.
+;;;
+;;; Few mail readers handle MIME messages, yet.  However, most popular
+;;; mail readers can be easily patched to feed MIME messages to a
+;;; program called 'metamail', which can handle MIME messages.  You
+;;; can FTP metamail from thumper.bellcore.com in /pub/nsb as
+;;; mm.tar.Z.  Since mime-compose requires the existence of the
+;;; program 'mmencode' (from the metamail distribution) to insert
+;;; binary and nonbinary files into messages, it is a Good Idea to
+;;; have metamail installed on your system.
+;;;
+;;; --------------------------------------------------------------------------
+;;; LCD Archive Entry:
+;;; mime-compose|Marc Andreessen|marca@ncsa.uiuc.edu|
+;;; MIME-compliant message generation utilities.|
+;;; !Date: 1994/03/24 00:00:47 !|!Revision: 1.5 !|~/misc/mime-compose.el.Z|
+;;; --------------------------------------------------------------------------
+
+(provide 'mime-compose)
+
+(defvar mime-running-mh-e (featurep 'mh-e)
+  "Non-nil if running under mh-e.")
+
+(if (not mime-running-mh-e)
+    (require 'sendmail))
+
+;;; ---------------------- User-customizable variables -----------------------
+
+(defvar mime-compose-hook nil
+  "*Invoked exactly once by first invocation of mime-mimify-message,
+before any processing is done.")
+
+(defvar mime-use-selective-display t
+  "*Flag for using selective-display to hide bodies of MIME enclosures.
+If non-NIL, selective-display will be used; if NIL, it will not be used.")
+
+(defvar mime-default-charset "US-ASCII"
+  "*Default character set for MIME messages elements.  According to the
+MIME specification, this can be either US-ASCII or ISO-8859-x, where x
+must be between 1 and 9 inclusive.")
+
+(defvar mime-encode-plaintext-on-send nil
+  "*Non-NIL if plaintext bodyparts should be encoded in quoted-printable
+and labeled with mime-default-charset when a message is sent; NIL
+otherwise.")
+
+(defvar mime-use-highlighting t
+  "*Flag to use highlighting for MIME headers and content types in
+Epoch or XEmacs/Lucid Emacs; if non-NIL, highlighting will be used.")
+
+(defvar mime-deemphasize-color "grey80"
+  "*Color for de-highlighting MIME headers in Epoch or XEmacs/Lucid Emacs.")
+
+(defvar mime-emphasize-color "yellow"
+  "*Color for highlighting MIME content types in Epoch or XEmacs/Lucid Emacs.")
+
+(defvar mime-name-included-files t
+  "*If non-NIL, use name attribute for included files.")
+
+(defvar mime-use-waiting-messages t
+  "*If non-NIL, enable waiting messages feature.")
+
+(defvar mime-primary-boundary "mysteryboxofun"
+  "*Word used as the primary MIME boundary.")
+
+(defvar mime-xwd-command "xwd -frame"
+  "*Command used to do a window dump under the X Window System.")
+
+(defvar mime-encode-base64-command "mmencode"
+  "*Command used to encode data in base64 format.")
+
+(defvar mime-encode-qp-command "mmencode -q"
+  "*Command used to encode data in quoted-printable format.")
+
+(defvar mime-babbling-description "talking"
+  "*Adjective(s) (or gerunds; I never could tell them apart) applying to 
+audio snippets.")
+
+(defvar mime-sgi-record-program "/usr/sbin/recordaiff"
+  "*Full name of SGI audio record program.")
+
+(defvar mime-sun-record-program "/usr/demo/SOUND/record"
+  "*Full name of Sun audio record program, patched with the context
+diff found at the end of mime-compose.el.")
+
+;;; ---------------------------- Other variables -----------------------------
+
+(defvar mime-compose-hook-was-run nil
+  "NIL implies we haven't yet run mime-compose-hook.")
+
+(defvar mime-valid-include-types
+  '(("image/gif" 1)
+    ("image/jpeg" 2)
+    ("application/postscript" 3)
+    ("application/andrew-inset" 4)
+    ("application/octet-stream" 5)
+    ("text/richtext" 6)
+    ("text/plain" 7)
+    ("audio/basic" 8)
+    ("video/mpeg" 9)
+    ("message/rfc822" 10)
+    ;; These aren't ``standard'', but are useful.
+    ("application/x-emacs-lisp" 11)
+    ("application/x-unix-tar-z" 12)
+    ("application/x-dvi" 13)
+    ("image/x-xbm" 14)
+    ("image/x-xwd" 15)
+    ("image/x-tiff" 16)
+    ("audio/x-aiff" 17)
+    ("text/x-html" 18))
+  "A list of valid content types for minibuffer completion.")
+
+(defvar mime-valid-charsets
+  '(("US-ASCII" 1)
+    ("ISO-8859-1" 2)
+    ("ISO-8859-2" 3)
+    ("ISO-8859-3" 4)
+    ("ISO-8859-4" 5)
+    ("ISO-8859-5" 6)
+    ("ISO-8859-6" 7)
+    ("ISO-8859-7" 8)
+    ("ISO-8859-8" 9)
+    ("ISO-8859-9" 10))
+  "A list of valid charset names for minibuffer completion.")
+
+(defvar mime-using-silicon-graphics
+  (or (eq system-type 'silicon-graphics-unix) (eq system-type 'irix))
+  "Flag to indicate use of Silicon Graphics platform.  If T, Emacs is being
+run on a Silicon Graphics workstation; else it is not.")
+
+(defvar mime-running-lemacs (string-match "XEmacs\\|Lucid" emacs-version)
+  "Non-nil if running XEmacs/Lucid Emacs.")
+
+(defvar mime-running-epoch (boundp 'epoch::version)
+  "Non-nil if running Epoch.")
+
+(if (and mime-running-epoch mime-use-highlighting)
+    (progn
+      (defvar mime-deemphasize-style (make-style))
+      (set-style-foreground mime-deemphasize-style mime-deemphasize-color)
+      (defvar mime-emphasize-style (make-style))
+      (set-style-foreground mime-emphasize-style mime-emphasize-color)))
+
+(if (and mime-running-lemacs mime-use-highlighting)
+    (progn
+      (defvar mime-deemphasize-style (make-face 'mime-deemphasize-face))
+      (set-face-foreground mime-deemphasize-style mime-deemphasize-color)
+      (defvar mime-emphasize-style (make-face 'mime-emphasize-face))
+      (set-face-foreground mime-emphasize-style mime-emphasize-color)))
+
+(defvar mime-audio-file "/tmp/.fooblatz"
+  "Filename to store audio snippets recorded on the fly.")
+
+(defvar mime-audio-tmp-file "/tmp/.fooblatz.aiff"
+  "Filename to store audio snippets recorded on the fly.")
+
+(defconst mime-waiting-message-lines
+  '("Mail mime-compose bug reports to marca@ncsa.uiuc.edu and pray for help."
+    "For the daring: ftp.ncsa.uiuc.edu:/outgoing/marca/mime-compose.el"
+    "Feature requests?  Fervent wishes?  Unfulfilled desires?  Write code!"
+    "mime-compose.el: the Kitchen Sink(tm) of mail composers."
+    "Q: How many Elisp hackers does it take to change a light bulb?"
+    "A: None -- we glow in the dark."
+    ".gnol oot yaw rof scamE gnisu neeb ev'uoy ,siht daer nac uoy fI"
+    "Macs?  We don' need no steenkin Macs!  We got MIME!"
+    "All hail MIME.  All hail MIME.  Yay.  Yay.  Woo.  Woo.")
+  "List of stupid strings to display while waiting for more to do.")
+
+;;; --------------------------- Utility functions ----------------------------
+
+(defun mime-primary-boundary ()
+  "Return the current primary boundary.  Note that in the current version
+of mime-compose.el, there is no support for secondary boundaries (for
+parallel or alternate bodyparts, etc.).  In the future, there may be."
+  mime-primary-boundary)
+
+(defun mime-hide-region (from to hideflag)
+  "Hides or shows lines from FROM to TO, according to HIDEFLAG:
+If T, region is hidden, else if NIL, region is shown."
+  (let ((old (if hideflag ?\n ?\^M))
+        (new (if hideflag ?\^M ?\n))
+        (modp (buffer-modified-p)))
+    (unwind-protect (progn
+                      (subst-char-in-region from to old new t))
+      (set-buffer-modified-p modp))))
+
+(defun mime-maybe-hide-region (start end)
+  "Hide the current region if mime-use-selective-display is T."
+  (if mime-use-selective-display
+      (mime-hide-region start end t)))
+
+(defun mime-add-description (description)
+  "Add a description to the current MIME message element."
+  (interactive "sDescription: ")
+  (save-excursion
+    (if (re-search-backward (concat "--" (mime-primary-boundary))
+                            (point-min) t)
+        (progn
+          (next-line 2)
+          (insert "Content-Description: " description "\n")))))
+
+(defun mime-display-waiting-messages ()
+  "Display cute messages until input arrives.  Shamelessly stolen
+from VM, the Kitchen Sink(tm) of mail readers."
+  (if mime-use-waiting-messages
+      (progn
+        (if (sit-for 2)
+            (let ((lines mime-waiting-message-lines))
+              (message
+               "mime-compose.el !Revision: 1.5 !, by marca@ncsa.uiuc.edu")
+              (while (and (sit-for 4) lines)
+                (message (car lines))
+                (setq lines (cdr lines)))))
+        (message "")
+        (if (not (input-pending-p))
+            (progn
+              (sit-for 2)
+              ;; TODO: Don't recurse; iterate.
+              (if (not (input-pending-p))
+                  (mime-display-waiting-messages)))))))
+
+;;; ------------------------------ Highlighting ------------------------------
+
+(if mime-use-highlighting
+    (progn
+      (if mime-running-lemacs
+          (defun mime-add-zone (start end style)
+            "Add a XEmacs/Lucid Emacs extent from START to END with STYLE."
+            (let ((extent (make-extent start end)))
+              (set-extent-face extent style)
+              (set-extent-property extent 'mime-compose t))))
+      (if mime-running-epoch
+          (defun mime-add-zone (start end style)
+            "Add an Epoch zone from START to END with STYLE."
+            (let ((zone (add-zone start end style)))
+              (epoch::set-zone-data zone 'mime-compose))))))
+
+(defun mime-maybe-highlight-region (start end)
+  "Maybe highlight a region of text.  Region is from START to END."
+  (if (and (or mime-running-epoch mime-running-lemacs)
+           mime-use-highlighting)
+      (progn
+        (mime-add-zone start end mime-deemphasize-style)
+        (save-excursion
+          (goto-char start)
+          (if (re-search-forward "Content-Type: " end t)
+              (let ((s (match-end 0)))
+                (re-search-forward "[;\n]")
+                (mime-add-zone 
+                 s (- (match-end 0) 1) mime-emphasize-style)))))))
+
+;;; -------------------------- mime-mimify-message ---------------------------
+
+(defun mime-mimify-message ()
+  "Add MIME headers to a message.  Add an initial informational message
+for mail readers that don't process MIME messages automatically.  Add
+an initial area for plaintext.  Add a closing boundary at the end of
+the message.
+
+This function is safe to call more than once."
+  (interactive)
+  (if (not mime-compose-hook-was-run)
+      (progn
+	(setq mime-compose-hook-was-run t)
+	(run-hooks 'mime-compose-hook)))
+  (let ((mail-header-separator (if (eq major-mode 'mh-letter-mode)
+                                   "\n\n\\|^-+$"
+                                 mail-header-separator)))
+    (or
+     (save-excursion
+       (goto-char (point-min))
+       (re-search-forward "^Mime-Version: "
+                          (save-excursion
+                            (goto-char (point-min))
+                            (re-search-forward mail-header-separator)
+                            (point))
+                          t))
+     (let ((mime-virgin-message (save-excursion
+                                  (next-line -1)
+                                  (looking-at mail-header-separator))))
+       (if mime-virgin-message
+           (insert "\n"))
+       (save-excursion
+         (save-excursion
+           (goto-char (point-min))
+           (re-search-forward mail-header-separator)
+           (beginning-of-line)
+           (insert "Mime-Version: 1.0\n")
+           (insert "Content-Description: A MIME message created by mime-compose.el.\n")
+           (insert "Content-Type: multipart/mixed; boundary=" (mime-primary-boundary) "\n")
+           (mime-maybe-highlight-region (save-excursion (next-line -3) (point))
+                                        (- (point) 1))
+           (next-line 1)
+           (let ((start (point)) end)
+             (insert "> THIS IS A MESSAGE IN 'MIME' FORMAT.\n")
+             (insert
+              "> If you are reading this, your mail reader may not support MIME.\n")
+             (insert
+              "> Some parts of this message will be readable as plain text.\n")
+             (setq end (point))
+             (mime-maybe-hide-region start (- end 1)))
+           (insert "\n")
+           (goto-char (point-max))
+           (insert "\n")
+           (insert "\n")
+           (insert "--" (mime-primary-boundary) "--\n")
+           (mime-maybe-highlight-region (save-excursion (next-line -1) (point))
+                                        (- (point) 1)))
+         (save-excursion
+           (goto-char (point-min))
+           (re-search-forward mail-header-separator)
+           (beginning-of-line)
+           ;; THIS HAS TO MATCH the number of lines of text included
+           ;; as a message ``header'' above.
+           (if mime-use-selective-display
+               (next-line 3)
+             (next-line 5))
+           (insert "--" (mime-primary-boundary) "\n")
+           (insert "Content-Type: text/plain\n")
+           (mime-maybe-highlight-region
+            (save-excursion (next-line -2) (point))
+            (- (point) 1))
+           (insert "\n"))
+         (if mime-virgin-message
+             (backward-delete-char 1))))))
+  (if (interactive-p)
+      (mime-display-waiting-messages)))
+
+(defun mime-open-text-bodypart ()
+  "At current point, just open up a new plaintext bodypart."
+  (interactive)
+  (mime-mimify-message)
+  (push-mark)
+  (let ((start (point)) end)
+    (insert "--" (mime-primary-boundary) "\n")
+    (insert "Content-Type: text/plain")
+    (setq end (point))
+    (insert "\n\n")
+    (mime-maybe-highlight-region start end))
+  (mime-display-waiting-messages))
+
+;;; ---------------------------- file inclusions -----------------------------
+
+(defun mime-include-file (filename content-type binary &optional charset)
+  "Include a file named by FILENAME and with MIME content type
+CONTENT-TYPE.  If third argument BINARY is T, then the file is binary;
+else it's text.  Optional fourth arg CHARSET names character set for
+data.  Data will be encoded in base64 or quoted-printable format as
+appropriate."
+  (mime-mimify-message)
+  (push-mark)
+  (insert "--" (mime-primary-boundary) "\n")
+  (insert "Content-Type: " content-type)
+  (if charset
+      (insert "; charset=" charset))
+  (if (and mime-name-included-files (not (string= filename mime-audio-file)))
+      (insert "; name=\"" (file-name-nondirectory filename) "\""))
+  (insert "\n")
+  (if (not (string= filename mime-audio-file))
+      (insert "Content-Description: " filename "\n"))
+  (if binary
+      (insert "Content-Transfer-Encoding: base64\n")
+    (insert "Content-Transfer-Encoding: quoted-printable\n"))
+  (mime-maybe-highlight-region 
+   (save-excursion (re-search-backward 
+                    (concat "--" (mime-primary-boundary))) (point))
+   (- (point) 1))
+  (let ((start (point)) end (seldisp selective-display))
+    (next-line 1)
+    (save-excursion
+      (next-line -1)
+      (insert-file filename))
+    (setq end (- (point) 1))
+    (setq selective-display nil)
+    (if binary
+        (shell-command-on-region start end mime-encode-base64-command t)
+      (shell-command-on-region start end mime-encode-qp-command t))
+    (setq selective-display seldisp)
+    (setq end (point))
+    (mime-maybe-hide-region start (- end 1))
+    (insert "\n")
+    (insert "--" (mime-primary-boundary) "\n")
+    (insert "Content-Type: text/plain\n")
+    (mime-maybe-highlight-region 
+     (save-excursion (re-search-backward 
+                      (concat "--" (mime-primary-boundary))) (point))
+     (- (point) 1))
+    (insert "\n\n")
+    (next-line -1)))
+
+(defun mime-include-binary-file (filename content-type)
+  "Include a binary file named by FILENAME at point in a MIME message.
+CONTENT-TYPE names MIME content type of file.  Data will be encoded in
+base64 format."
+  (mime-include-file filename content-type t))
+
+(defun mime-include-nonbinary-file (filename content-type &optional charset)
+  "Include a nonbinary file named by FILENAME at point in a MIME
+message.  CONTENT-TYPE names MIME content type of file; optional third
+arg CHARSET names MIME character set.  Data will be encoded in
+quoted-printable format."
+  (mime-include-file filename content-type nil charset))
+
+;;; -------------------------- external references ---------------------------
+
+(defun mime-include-external (site directory name content-type description 
+                                   access-type)
+  "Include an external pointer in a MIME message.  Args are SITE,
+DIRECTORY, NAME, CONTENT-TYPE, DESCRIPTION, and ACCESS-TYPE; these are
+all strings."
+  (mime-mimify-message)
+  (push-mark)
+  (insert "--" (mime-primary-boundary) "\n")
+  (insert "Content-Type: message/external-body;\n")
+  (insert "\taccess-type=\"" access-type "\";\n")
+  (insert "\tsite=\"" site "\";\n")
+  (insert "\tdirectory=\"" directory "\";\n")
+  (insert "\tname=\"" name "\"\n")
+  (insert "Content-Description: " description "\n")
+  (insert "\n")
+  (insert "Content-Type: " content-type "\n")
+  (mime-maybe-highlight-region 
+   (save-excursion (re-search-backward 
+                    (concat "--" (mime-primary-boundary))) (point))
+   (- (point) 1))
+  (insert "\n")
+  (insert "\n")
+  (insert "--" (mime-primary-boundary) "\n")
+  (insert "Content-Type: text/plain\n")
+  (mime-maybe-highlight-region 
+   (save-excursion (re-search-backward 
+                    (concat "--" (mime-primary-boundary))) (point))
+   (- (point) 1))
+  (insert "\n"))
+
+(defun mime-include-external-anonftp (site directory name description)
+  "Include an external pointer (anonymous FTP) in a MIME message.  Args
+are SITE, DIRECTORY, NAME, and DESCRIPTION; these are all strings, and
+if interactive, will be prompted for."
+  (interactive 
+   "sFTP site: \nsRemote directory name: \nsRemote filename: \nsDescription: ")
+  (let ((content-type 
+         (completing-read "Content type: " mime-valid-include-types
+                          nil nil nil)))
+    ;; Unadvertised default.
+    (if (string= content-type "")
+        (setq content-type "application/octet-stream"))
+    (mime-include-external site directory name content-type 
+                           description "anon-ftp"))
+  (mime-display-waiting-messages))
+
+(defun mime-include-external-ftp (site directory name description)
+  "Include an external pointer (regular FTP) in a MIME message.  Args
+are SITE, DIRECTORY, NAME, and DESCRIPTION; these are all strings, and
+if interactive, will be prompted for."
+  (interactive 
+   "sFTP site: \nsRemote directory name: \nsRemote filename: \nsDescription: ")
+  (let ((content-type 
+         (completing-read "Content type: " mime-valid-include-types
+                          nil nil nil)))
+    ;; Unadvertised default.
+    (if (string= content-type "")
+        (setq content-type "application/octet-stream"))
+    (mime-include-external site directory name content-type 
+                           description "ftp"))
+  (mime-display-waiting-messages))
+
+;;; ------------------------------ window dumps ------------------------------
+
+(defun mime-include-xwd-dump ()
+  "Run program named by 'mime-xwd-command' and include the results in
+a MIME message."
+  (interactive)
+  (mime-mimify-message)
+  (push-mark)
+  (insert "--" (mime-primary-boundary) "\n")
+  (insert "Content-Type: image/x-xwd\n")
+  (insert "Content-Description: Window dump from " (system-name) "\n")
+  (insert "Content-Transfer-Encoding: base64\n")
+  (mime-maybe-highlight-region 
+   (save-excursion (re-search-backward 
+                    (concat "--" (mime-primary-boundary))) (point))
+   (- (point) 1))
+  (insert "\n")
+  (let ((start (point)) end (seldisp selective-display))
+    (next-line 1)
+    (save-excursion
+      (next-line -1)
+      (message "When crosshair cursor appears, click on window...")
+      (sit-for 0)
+      (call-process "/bin/sh" nil t nil "-c" mime-xwd-command)
+      (message "")
+      (sit-for 0))
+    (setq end (point))
+    (setq selective-display nil)
+    (shell-command-on-region start end mime-encode-base64-command t)
+    (setq selective-display seldisp)
+    (setq end (point))
+    (mime-maybe-hide-region start (- end 1))
+    (insert "\n")
+    (insert "--" (mime-primary-boundary) "\n")
+    (insert "Content-Type: text/plain\n")
+    (mime-maybe-highlight-region 
+     (save-excursion (re-search-backward 
+                      (concat "--" (mime-primary-boundary))) (point))
+     (- (point) 1))
+    (insert "\n\n")
+    (next-line -1))
+  (mime-display-waiting-messages))
+
+;;; ----------------------------- audio snippets -----------------------------
+
+(defun mime-sgi-grab-audio-snippet ()
+  "Grab an audio snippet into file named in 'mime-audio-file'.
+This routine works on SGI Indigo's and 4D/35's."
+  (let (audio-process done-flag)
+    (setq audio-process 
+          (start-process "snippet" "snippet" 
+                         mime-sgi-record-program "-n" "1" "-s" "8" "-r" "8000"
+                         mime-audio-tmp-file))
+    ;; Quick hack to make Emacs sit until recording is done.
+    (setq done-flag
+          (y-or-n-p "Press y when done recording (n to abort): "))
+    (interrupt-process "snippet")
+    ;; Wait until recordaiff has written data to disk.
+    (while (eq (process-status "snippet") 'run)
+      (message "Waiting...")
+      (sleep-for 1))
+    (message "Done waiting.")
+    ;; Kill off recordaiff and our buffer.
+    (delete-process "snippet")
+    (kill-buffer "snippet")
+    ;; Remove the old mulaw file and do the conversion.
+    (call-process "/bin/rm" nil nil nil "-f" mime-audio-file)
+    (if done-flag
+        (call-process "/usr/sbin/sfconvert" nil nil nil mime-audio-tmp-file
+                      mime-audio-file "-o" "mulaw"))
+    (call-process "/bin/rm" nil nil nil "-f" mime-audio-tmp-file)
+    ;; Return done flag.  If nil, mime-include-audio-snippet should
+    ;; clean up.
+    done-flag))
+
+(defun mime-sun-grab-audio-snippet ()
+  "Grab an audio snippet into file named in 'mime-audio-file'.
+This is the Sun version.  I don't know how well it works.  It also
+requires a patched version of /usr/demo/SOUND/record.c; see the 
+context diff at the end of mime-compose.el.
+
+Courtesy Christopher Davis <ckd@eff.org>."
+  (let (audio-process done-flag)
+    (setq audio-process
+          (start-process "snippet" "snippet"
+                         mime-sun-record-program "-m" mime-audio-file))
+    ;; Quick hack to make Emacs sit until recording is done.
+    (setq done-flag
+          (y-or-n-p "Press y when done recording (n to abort): "))
+    (interrupt-process "snippet")
+    ;; Wait until the record process is done.
+    (while (eq (process-status "snippet") 'run)
+      (message "Waiting...")
+      (sleep-for 1))
+    (message "Done waiting.")
+    ;; Kill off the record process and our buffer.
+    (delete-process "snippet")
+    (kill-buffer "snippet")
+    ;; Return done flag.  If nil, mime-include-audio-snippet should
+    ;; clean up.
+    done-flag))
+
+(defun mime-include-audio-snippet ()
+  "Record a snippet of audio in a MIME message.  This should work on
+both Silicon Graphics and Sun platforms.  Code contributions for other
+platforms are welcome."
+  (interactive)
+  (let ((mime-grab-audio-snippet
+         (if mime-using-silicon-graphics
+             'mime-sgi-grab-audio-snippet
+           'mime-sun-grab-audio-snippet)))
+    (if (eq (funcall mime-grab-audio-snippet) t)
+        (progn
+          (mime-include-binary-file mime-audio-file "audio/basic")
+          (save-excursion
+            (next-line -4)
+            (mime-add-description 
+             (concat (user-full-name) " " 
+                     mime-babbling-description "."))))))
+  (mime-display-waiting-messages))
+
+;;; ------------------------- Basic include commands -------------------------
+
+(defun mime-include-gif (filename)
+  "Include a GIF file named by FILENAME."
+  (interactive "fGIF image filename: ")
+  (mime-include-binary-file filename "image/gif")
+  (mime-display-waiting-messages))
+
+(defun mime-include-jpeg (filename)
+  "Include a JPEG file named by FILENAME."
+  (interactive "fJPEG image filename: ")
+  (mime-include-binary-file filename "image/jpeg")
+  (mime-display-waiting-messages))
+
+(defun mime-include-audio (filename &optional prefix-arg)
+  "Include an audio file named by FILENAME.  Note that to match the
+MIME specification for audio/basic, this should be an 8-bit mulaw file.
+With prefix arg, use AIFF format (unofficial MIME subtype audio/x-aiff)
+instead of audio/basic."
+  (interactive "fAudio filename: \nP")
+  (if prefix-arg
+      (mime-include-binary-file filename "audio/x-aiff")
+    (mime-include-binary-file filename "audio/basic"))
+  (mime-display-waiting-messages))
+
+(defun mime-include-mpeg (filename)
+  "Include a MPEG file named by FILENAME."
+  (interactive "fMPEG animation filename: ")
+  (mime-include-binary-file filename "video/mpeg")
+  (mime-display-waiting-messages))
+
+(defun mime-include-postscript (filename)
+  "Include a PostScript file named by FILENAME."
+  (interactive "fPostScript filename: ")
+  (mime-include-nonbinary-file filename "application/postscript")
+  (mime-display-waiting-messages))
+
+(defun mime-include-raw-binary (filename)
+  "Include a raw binary file named by FILENAME."
+  (interactive "fRaw binary filename: ")
+  (let ((content-type 
+         (completing-read "Content type (RET for default): " 
+                          mime-valid-include-types
+                          nil nil nil)))
+    (if (string= content-type "")
+        (setq content-type "application/octet-stream"))
+    (mime-include-binary-file filename content-type))
+  (mime-display-waiting-messages))
+
+(defun mime-include-raw-nonbinary (filename &optional prefix-arg)
+  "Include a raw nonbinary file named by FILENAME.  With prefix arg,
+prompt for character set."
+  (interactive "fRaw nonbinary filename: \nP")
+  (let ((charset
+         (if prefix-arg
+             (completing-read "Character set: " mime-valid-charsets
+                              nil nil nil)
+           mime-default-charset))
+        (content-type 
+         (completing-read "Content type (RET for default): " 
+                          mime-valid-include-types
+                          nil nil nil)))
+    (if (string= content-type "")
+        (setq content-type "text/plain"))
+    (if (string= charset "")
+        (setq charset "asdfasdfdfsdafs"))
+    (mime-include-nonbinary-file filename content-type charset))
+  (mime-display-waiting-messages))
+
+;;; ---------------------------- Region commands -----------------------------
+
+(defun mime-encode-region (start end content-type charset)
+  "Encode a region specified by START and END.  CONTENT-TYPE and
+CHARSET name the content type and character set of the data in the
+region."
+  ;; Start by encoding the region in quoted-printable.  This will
+  ;; move end, but not start.
+  (goto-char end)
+  (let ((seldisp selective-display))
+    (setq selective-display nil)
+    (shell-command-on-region start end mime-encode-qp-command t)
+    (setq selective-display seldisp))
+  ;; Now pick up the new end.
+  (setq end (point))
+  ;; Pop up to start and insert the header; this will also change
+  ;; end, but with save-excursion we'll end up at the new end.
+  (save-excursion
+    (goto-char start)
+    (push-mark)
+    (insert "--" (mime-primary-boundary) "\n")
+    (insert "Content-Type: " content-type "; charset=" charset "\n")
+    (insert "Content-Transfer-Encoding: quoted-printable\n")
+    (mime-maybe-highlight-region 
+     (save-excursion (re-search-backward 
+                      (concat "--" (mime-primary-boundary))) (point))
+     (- (point) 1))
+    (insert "\n"))
+  ;; Pick up the new end again.
+  (setq end (point))
+  ;; Insert the trailing boundary and the new text/plain header.
+  (insert "\n")
+  (insert "--" (mime-primary-boundary) "\n")
+  (insert "Content-Type: text/plain\n")
+  (mime-maybe-highlight-region 
+   (save-excursion (re-search-backward 
+                    (concat "--" (mime-primary-boundary))) (point))
+   (- (point) 1))
+  (insert "\n")
+  ;; Last but not least, add MIME headers if necessary.
+  (save-excursion
+    (mime-mimify-message)))
+
+(defun mime-region-to-richtext (start end &optional prefix-arg)
+  "Convert the current region to MIME richtext.  MIME headers are
+added if necessary; a MIME boundary is added at the start of the
+region to indicate richtext; the conversion (see below) is done; a new
+boundary is added for more text.
+
+With prefix arg, prompt for character set; else use value of
+mime-default-charset.
+
+Currently no textual conversion is done, other than encoding in
+quoted-printable format.  Instead, you use directives such as <bold>
+and </bold> in the text, as described in the MIME RFC.  The
+alternative would be to parse tilde sequences as is done in the mailto
+program.  Let me know if you think the latter would be more
+appropriate for mime-compose.el."
+  (interactive "r\nP")
+  (let ((charset
+         (if (not prefix-arg)
+             mime-default-charset
+           (completing-read "Character set: " mime-valid-charsets
+                            nil nil nil))))
+    ;; Unadvertised default.
+    (if (string= charset "")
+        (setq charset mime-default-charset))
+    (mime-encode-region start end "text/richtext" 
+                        charset))
+  (mime-display-waiting-messages))
+
+(defun mime-region-to-charset (start end)
+  "Convert the current region to plaintext in a non-default character
+set.  You are prompted for a character set, and the text in the region
+is encoded in quoted-printable format and identified as being in that
+character set."
+  (interactive "r")
+  (let ((charset
+         (completing-read "Character set: " mime-valid-charsets
+                          nil nil nil)))
+    ;; Unadvertised default.
+    (if (string= charset "")
+        (setq charset mime-default-charset))
+    (mime-encode-region start end "text/plain" charset))
+  (mime-display-waiting-messages))
+
+;;; -------------------------------- Keymaps ---------------------------------
+
+;;; Add functions to MH letter mode.
+(if mime-running-mh-e
+    ;; Running mh-e.
+    (if (or (not (boundp 'mh-letter-mode-mime-map)) 
+            (not mh-letter-mode-mime-map))
+        (progn
+          (setq mh-letter-mode-mime-map (make-sparse-keymap))
+          (define-key mh-letter-mode-map "\C-c\C-m" mh-letter-mode-mime-map)
+          (define-key mh-letter-mode-mime-map "m" 'mime-mimify-message)
+          (define-key mh-letter-mode-mime-map "g" 'mime-include-gif)
+          (define-key mh-letter-mode-mime-map "j" 'mime-include-jpeg)
+          (define-key mh-letter-mode-mime-map "a" 'mime-include-audio)
+          (define-key mh-letter-mode-mime-map "v" 'mime-include-mpeg)
+          (define-key mh-letter-mode-mime-map "p" 'mime-include-postscript)
+          (define-key mh-letter-mode-mime-map "r" 'mime-include-raw-binary)
+          (define-key mh-letter-mode-mime-map "n" 'mime-include-raw-nonbinary)
+          (define-key mh-letter-mode-mime-map "x" 'mime-include-xwd-dump)
+          (define-key mh-letter-mode-mime-map "e" 
+            'mime-include-external-anonftp)
+          (define-key mh-letter-mode-mime-map "f" 
+            'mime-include-external-ftp)
+          (define-key mh-letter-mode-mime-map "s"
+            'mime-include-audio-snippet)
+          ;; Functions that operate on regions.
+          (defvar mime-region-map (make-sparse-keymap))
+          (define-key mh-letter-mode-mime-map "\C-r" mime-region-map)
+          (define-key mime-region-map "r" 'mime-region-to-richtext)
+          (define-key mime-region-map "i" 'mime-region-to-charset)))
+  ;; Not running mh-e.
+  (progn
+    (define-key mail-mode-map "\C-cm" 'mime-mimify-message)
+    (define-key mail-mode-map "\C-cg" 'mime-include-gif)
+    (define-key mail-mode-map "\C-cj" 'mime-include-jpeg)
+    (define-key mail-mode-map "\C-ca" 'mime-include-audio)
+    (define-key mail-mode-map "\C-cp" 'mime-include-postscript)
+    (define-key mail-mode-map "\C-cr" 'mime-include-raw-binary)
+    (define-key mail-mode-map "\C-cn" 'mime-include-raw-nonbinary)
+    (define-key mail-mode-map "\C-cx" 'mime-include-xwd-dump)
+    (define-key mail-mode-map "\C-ce" 'mime-include-external-anonftp)
+    (define-key mail-mode-map "\C-cf" 'mime-include-external-ftp)
+    (define-key mail-mode-map "\C-cs" 'mime-include-audio-snippet)
+    (define-key mail-mode-map "\C-cv" 'mime-include-mpeg)
+    
+    ;; Functions that operate on regions.
+    (defvar mime-region-map (make-sparse-keymap))
+    (define-key mail-mode-map "\C-c\C-r" mime-region-map)
+    (define-key mime-region-map "r" 'mime-region-to-richtext)
+    (define-key mime-region-map "i" 'mime-region-to-charset)))
+  
+;;; -------------------------------- Menubar ---------------------------------
+
+(defvar mime-compose-menu
+  (list
+   "MIME Inclusions:"
+   "----"
+   ["Include GIF File"			mime-include-gif		t]
+   ["Include JPEG File"			mime-include-jpeg		t]
+   ["Include MPEG File"			mime-include-mpeg		t]
+   ["Include Audio File"		mime-include-audio		t]
+   ["Include PostScript File"		mime-include-postscript		t]
+   ["Include XWD Dump"			mime-include-xwd-dump		t]
+   ["Include Audio Snippet"		mime-include-audio-snippet	t]
+   ["Include Raw Binary File"		mime-include-raw-binary		t]
+   ["Include Raw Nonbinary File"	mime-include-raw-nonbinary	t]
+   ["Include External AnonFTP"		mime-include-external-anonftp	t]
+   ["Include External FTP"		mime-include-external-ftp	t]
+   )
+  "Popup menu for MIME Compose.")
+
+;; Attach menu to mail-mode-menu.
+(and mime-running-lemacs
+     (setq mail-menubar-menu (append mail-menubar-menu '("---") mime-compose-menu))
+     (setq mail-popup-menu (append mail-popup-menu '("---") mime-compose-menu)))
+
+;; Arrange to attach to VM's mail mode menu.
+(defun mime-compose-attach-to-mode-menu ()
+  (if (boundp 'vm-menu-mail-menu)
+      (progn
+	(setq vm-menu-mail-menu
+	      (nconc vm-menu-mail-menu (list "----") mime-compose-menu))
+	(remove-hook 'vm-mail-mode-hook 'mime-compose-attach-to-mode-menu))))
+
+(add-hook 'vm-mail-mode-hook 'mime-compose-attach-to-mode-menu)
+
+;;; ----------------------------- New mail-send ------------------------------
+
+;; If we're not running XEmacs, pop in a new mail-send routine.
+(if (not mime-running-lemacs)
+    (defun mail-send ()
+      "Send the message in the current buffer.
+If  mail-interactive  is non-nil, wait for success indication
+or error messages, and inform user.
+Otherwise any failure is reported in a message back to
+the user from the mailer."
+      (interactive)
+      (message "Sending...")
+      (run-hooks 'mail-send-hook)
+      (funcall send-mail-function)
+      (set-buffer-modified-p nil)
+      (delete-auto-save-file-if-necessary)
+      (message "Sending...done")))
+
+;;; --------------------------------- Hooks ----------------------------------
+
+;; Author: Daniel LaLiberte (liberte@cs.uiuc.edu).
+(defun mime-postpend-unique-hook (hook-var hook-function)
+  "Postpend HOOK-VAR with HOOK-FUNCTION, if it is not already an element.
+hook-var's value may be a single function or a list of functions."
+  (if (boundp hook-var)
+      (let ((value (symbol-value hook-var)))
+        (if (and (listp value) (not (eq (car value) 'lambda)))
+            (and (not (memq hook-function value))
+                 (set hook-var (append value (list hook-function))))
+          (and (not (eq hook-function value))
+               (set hook-var (append value (list hook-function))))))
+    (set hook-var (list hook-function))))
+
+(defun mime-unfrob-selective-display ()
+  "Turn off selective display throughout this buffer."
+  (if mime-use-selective-display
+      (progn
+        (message "Unfrobbing selective-display...")
+        (mime-hide-region (point-min) (point-max) nil))))
+
+(defun mime-strip-useless-bodyparts ()
+  "Strip useless (empty) bodyparts out of a message."
+  (save-excursion
+    (goto-char (point-min))
+    (while (re-search-forward
+            (concat "^--" (mime-primary-boundary)
+                    "\nContent-Type: text.*[\n]*--" (mime-primary-boundary))
+            (point-max) t)
+      (replace-match (concat "--" (mime-primary-boundary)) t t)
+      ;; Go all the way back up to start over.
+      (goto-char (point-min)))))
+
+(defun mime-encode-region-qp (start end)
+  "Encode a region specified by START and END in quoted-printable
+format.  Return the new endpoint.  Do not use save-excursion."
+  ;; Start by encoding the region in quoted-printable.  This will
+  ;; move end, but not start.
+  (goto-char end)
+  (let ((seldisp selective-display))
+    (setq selective-display nil)
+    (shell-command-on-region start end mime-encode-qp-command t)
+    (setq selective-display seldisp)))
+
+(defun mime-encode-plaintext ()
+  "Encode all plaintext bodyparts in the message in quoted-printable
+and set the charset to mime-default-charset."
+  (save-excursion
+    (goto-char (point-min))
+    ;; We're looking for text/plain bodyparts with no extra fields.
+    (while (re-search-forward
+            (concat "^--" (mime-primary-boundary)
+                    "\nContent-Type: text/plain\n") (point-max) t)
+      (let* ((head (match-beginning 0))
+             (start (match-end 0))
+             ;; Assume there's a closing boundary; go find it.
+             (end (save-excursion (re-search-forward
+                                   (concat "^--" (mime-primary-boundary)))
+                                  (- (match-beginning 0) 1))))
+        ;; Maybe there's already a Content-Transfer-Encoding.  If so,
+        ;; never mind.
+        (or (re-search-forward "^Content-Transfer-Encoding: " end t)
+            (let ((new-end (save-excursion
+                             (mime-encode-region-qp start end))))
+              (save-excursion
+                (goto-char head)
+                (next-line 1)
+                (end-of-line)
+                (let ((s (point)))
+                  (insert "; charset=" mime-default-charset "\n")
+                  (insert "Content-Transfer-Encoding: quoted-printable")
+                  (mime-maybe-highlight-region s (point))))))))))
+
+(defun mime-send-hook-function ()
+  "Function to be called from mail-send-hook.  Unfrob selective
+display if active, strip out empty (useless) bodyparts, and optionally
+encode plaintext bodyparts in quoted-printable with a given charset."
+  (mime-unfrob-selective-display)
+  (mime-strip-useless-bodyparts)
+  (and mime-encode-plaintext-on-send
+       (mime-encode-plaintext)))
+
+;; Before the message is sent, remove the selective display crap.
+(if mime-running-mh-e
+    (mime-postpend-unique-hook 'mh-before-send-letter-hook
+                               'mime-send-hook-function)
+  (mime-postpend-unique-hook 'mail-send-hook 'mime-send-hook-function))
+
+(defun mime-setup-hook-function ()
+  (if mime-use-selective-display
+      (setq selective-display t)))
+
+;; During mail setup, activate selective-display if necessary.  We use
+;; mail-mode-hook rather than mail-setup-hook because if a message is
+;; being composed and C-x m gets hit again, mail-mode will be
+;; reentered, causing selective-display to revert to nil and possibly
+;; screwing up the display bigtime unless mail-mode-hook knows what to
+;; do.
+(if mime-running-mh-e
+    (mime-postpend-unique-hook 'mh-letter-mode-hook
+                               'mime-setup-hook-function)
+  (mime-postpend-unique-hook 'mail-mode-hook 'mime-setup-hook-function))
+
+;;; ------------------------- END OF MIME-COMPOSE.EL -------------------------
+
+;;; ---------------------- PATCH FOR SUN RECORD PROGRAM ----------------------
+
+;;; This patch must be applied to record.c as found in the Sun demo
+;;; directories in order to enable on-the-fly audio recording in
+;;; mime-compose.
+
+;; *** record.c.orig	Wed Oct 23 13:56:38 1991
+;; --- record.c	Sun Dec  6 22:50:06 1992
+;; ***************
+;; *** 2,7 ****
+;; --- 2,9 ----
+;;   static	char sccsid[] = "@(#)record.c 1.2 90/01/02 Copyr 1989 Sun Micro";
+;;   #endif
+;;   /* Copyright (c) 1989 by Sun Microsystems, Inc. */
+;; + /* 921206: modifications to not output audio header (ckd@eff.org) */
+;; + /* yes, I know it's ugly code... sorry... */
+;;   
+;;   #include <stdio.h>
+;;   #include <errno.h>
+;; ***************
+;; *** 30,36 ****
+;;   /* Local variables */
+;;   char *prog;
+;;   char prog_desc[] = "Record an audio file";
+;; ! char prog_opts[] = "aft:v:d:i:?";	/* getopt() flags */
+;;   
+;;   char		*Stdout = "stdout";
+;;   
+;; --- 32,38 ----
+;;   /* Local variables */
+;;   char *prog;
+;;   char prog_desc[] = "Record an audio file";
+;; ! char prog_opts[] = "aft:v:d:i:?m";	/* getopt() flags */
+;;   
+;;   char		*Stdout = "stdout";
+;;   
+;; ***************
+;; *** 69,76 ****
+;;   usage()
+;;   {
+;;   	Error(stderr, "%s -- usage:\n\t%s ", prog_desc, prog);
+;; ! 	Error(stderr, "\t[-a] [-v #] [-t #] [-i msg] [-d dev] [file]\n");
+;;   	Error(stderr, "where:\n\t-a\tAppend to output file\n");
+;;   	Error(stderr, "\t-f\tIgnore sample rate differences on append\n");
+;;   	Error(stderr, "\t-v #\tSet record volume (0 - %d)\n", MAX_GAIN);
+;;   	Error(stderr, "\t-t #\tSpecify record time (hh:mm:ss.dd)\n");
+;; --- 71,79 ----
+;;   usage()
+;;   {
+;;   	Error(stderr, "%s -- usage:\n\t%s ", prog_desc, prog);
+;; ! 	Error(stderr, "\t[-a] [-m] [-v #] [-t #] [-i msg] [-d dev] [file]\n");
+;;   	Error(stderr, "where:\n\t-a\tAppend to output file\n");
+;; + 	Error(stderr, "\t-m\tDon't add audio header (for MIME)\n");
+;;   	Error(stderr, "\t-f\tIgnore sample rate differences on append\n");
+;;   	Error(stderr, "\t-v #\tSet record volume (0 - %d)\n", MAX_GAIN);
+;;   	Error(stderr, "\t-t #\tSpecify record time (hh:mm:ss.dd)\n");
+;; ***************
+;; *** 112,117 ****
+;; --- 115,121 ----
+;;   	int		cnt;
+;;   	int		err;
+;;   	int		ofd;
+;; + 	int		addheader = 1;
+;;   	double		vol;
+;;   	struct stat	st;
+;;   	struct sigvec	vec;
+;; ***************
+;; *** 150,155 ****
+;; --- 154,162 ----
+;;   		Info = optarg;		/* set information string */
+;;   		Ilen = strlen(Info);
+;;   		break;
+;; + 	case 'm':
+;; + 		addheader = 0;		/* no header (for MIME) */
+;; + 		break;
+;;   	case '?':
+;;   		usage();
+;;   /*NOTREACHED*/
+;; ***************
+;; *** 288,293 ****
+;; --- 295,301 ----
+;;   			exit(1);
+;;   		}
+;;   	} else {
+;; + 	  if (addheader) {
+;;   		if (audio_write_filehdr(ofd, &Dev_hdr, Info, Ilen) !=
+;;   		    AUDIO_SUCCESS) {
+;;   			Error(stderr, "%s: error writing header for \n", prog);
+;; ***************
+;; *** 294,299 ****
+;; --- 302,308 ----
+;;   			perror(Ofile);
+;;   			exit(1);
+;;   		}
+;; + 	      }
+;;   	}
+;;   
+;;   	/* If -v flag, set the record volume now */
+
+;;; ------------------------------ END OF PATCH ------------------------------
+