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