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