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