🚀 go-pugleaf

Since I haven't seen any code on the net for composing MIME-compliant
messages within Emacs, I hacked some up myself; for what it's worth,
here it is.  Comments and changes are welcome.

;; mime-compose.el
;; (C) Marc Andreessen [marca@ncsa.uiuc.edu], 1992.
;; Distribute under the GNU Copyleft; send changes to the author.
;;
;; How to use mime-compose:
;;
;; Use the normal Emacs mail composer (C-x m).
;;
;; Do nothing special to prepare a message to have MIME
;; elements included in it.
;;
;; The following key sequences can be used to add MIME elements
;; to the current message:
;;   C-c g       Add a GIF file.
;;   C-c j       Add a JPEG file.
;;   C-c a       Add a (basic) audio file.
;;   C-c p       Add a PostScript file.
;;   C-c x       Add the result of an X-window dump.
;;
;; The last option will run the program named in mime-xwd-command
;; and insert the resulting dump into the message automatically.
;;
;; After your message has been `mimified' (by including a MIME
;; element), it's best to not put trailing text outside the final
;; boundary at the end of the file.
;;
;; Extra features include:
;;   C-c e       Point to an external file.  You'll have to be
;;               a little familiar with MIME to do this.
;;   C-c m       Mimify a message.  Not usually necessary, unless
;;               you just want a plaintext message have MIME
;;               directives.

(provide 'mime-compose)
(require 'sendmail)

(defvar mime-boundary "bucketofwarmspit"
  "*Word used as a MIME boundary.")

(defvar mime-xwd-command "xwd -frame"
  "*Command used to do a window dump under the X Window System.")

(defun mime-insert-boundary (boundary)
  "At current point, insert a boundary."
  (insert "--" boundary "\n")
  (next-line))

(defun mime-mimify-message ()
  "Add MIME headers to a message.  Add an initial informational message
for mailreaders that don't process MIME automatically.  Add an initial
area for plaintext.  Add a closing boundary at the end of the message.
This function is safe to call more than once."
  (interactive)
  (or
   ;; See if this message has already been mimified.
   (save-excursion
     (goto-char (point-min))
     (re-search-forward "^Mime-Version: "
                        (save-excursion
                          (goto-char (point-min))
                          (search-forward mail-header-separator)
                          (point))
                        t))
   ;; Mimify the message.
   (progn
     (if (save-excursion
           (next-line -1)
           (looking-at mail-header-separator))
         (insert "\n"))
     (save-excursion
       (save-excursion
         (goto-char (point-min))
         (search-forward mail-header-separator)
         (beginning-of-line)
         (insert "Mime-Version: 1.0\n")
         (insert "Content-Type: multipart/mixed;\n")
         (insert "\tboundary=" mime-boundary "\n")
         (next-line 1)
         (insert "> THIS IS A MESSAGE IN 'MIME' FORMAT.\n")
         (insert "> If you are reading this, your mail reader may not support MIME.\n")
         (insert "> Some parts of this message will be readable as plain text.\n")
         (insert "\n")
         (goto-char (point-max))
         (insert "\n")
         (insert "\n")
         (insert "--" mime-boundary "\n")
         (insert "\n"))
       ;; Now we're still sitting where we started.
       (save-excursion
         (goto-char (point-min))
         (search-forward mail-header-separator)
         (beginning-of-line)
         (next-line 5)
         (insert "--" mime-boundary "\n")
         (insert "Content-type: text/plain\n")
         (insert "\n"))))))

(defun mime-include-binary-file (filename content-type)
  "Include a binary file at point in a MIME message."
  (mime-mimify-message)
  (insert "--" mime-boundary "\n")
  (insert "Content-type: " content-type "\n")
  (insert "Content-Transfer-Encoding: base64\n")
  (insert "\n")
  (let ((start (point)) end)
    ;; Mark is at top of this image.
    (push-mark)
    (next-line 1)
    (save-excursion
      (next-line -1)
      (insert-file filename))
    (setq end (point))
    (shell-command-on-region start end "mmencode" t)
    ;; Now point is at the end of the region.
    (setq end (point))
    (insert "\n")
    (insert "--" mime-boundary "\n")
    (insert "Content-type: text/plain\n")
    (insert "\n\n\n")
    (next-line -2)))

(defun mime-include-nonbinary-file (filename content-type)
  "Include a nonbinary file at point in a MIME message."
  (mime-mimify-message)
  (insert "--" mime-boundary "\n")
  (insert "Content-type: " content-type "\n")
  (insert "\n")
  ;; Mark is at top of this image.
  (push-mark)
  (next-line 1)
  (save-excursion
    (next-line -1)
    (insert-file filename))
  (insert "\n")
  (insert "--" mime-boundary "\n")
  (insert "Content-type: text/plain\n")
  (insert "\n\n\n")
  (next-line -2))

(defun mime-include-external (site directory name content-type description)
  "Include an external pointer in a MIME message.  This is incomplete."
  (interactive "sFTP site: \nsRemote directory name: \nsRemote filename: \nsContent type: \nsDescription: ")
  (mime-mimify-message)
  (insert "--" mime-boundary "\n")
  (insert "Content-type: message/external-body;\n")
  (insert "\taccess-type=\"anon-ftp\";\n")
  (insert "\tsite=\"" site "\";\n")
  (insert "\tdirectory=\"" directory "\";\n")
  (insert "\tname=\"" name "\"\n")
  (insert "Content-description: " description "\n")
  (insert "\n")
  (insert "Content-type: " content-type "\n")
  (insert "\n")
  (insert "\n")
  (insert "--" mime-boundary "\n")
  (insert "Content-type: text/plain\n")
  (insert "\n"))

(defun mime-include-xwd-dump ()
  "Run xwd and include the results in a MIME message."
  (interactive)
  (mime-mimify-message)
  (insert "--" mime-boundary "\n")
  (insert "Content-type: image/x-xwd\n")
  (insert "Content-Transfer-Encoding: base64\n")
  (insert "\n")
  (let ((start (point)) end)
    ;; Mark is at top of this image.
    (push-mark)
    (next-line 1)
    (save-excursion
      (next-line -1)
      (shell-command mime-xwd-command t))
    (setq end (point))
    (shell-command-on-region start end "mmencode" t)
    ;; Now point is at the end of the region.
    (setq end (point))
    (insert "\n")
    (insert "--" mime-boundary "\n")
    (insert "Content-type: text/plain\n")
    (insert "\n\n\n")
    (next-line -2)))

(defun mime-include-gif (filename)
  "Include a GIF file."
  (interactive "fGIF image filename: ")
  (mime-include-binary-file filename "image/gif"))
(defun mime-include-jpeg (filename)
  "Include a JPEG file."
  (interactive "fJPEG image filename: ")
  (mime-include-binary-file filename "image/jpeg"))
(defun mime-include-audio (filename)
  "Include an audio file."
  (interactive "fAudio filename: ")
  (mime-include-binary-file filename "audio/basic"))
(defun mime-include-postscript (filename)
  "Include a PostScript file."
  (interactive "fPostScript filename: ")
  (mime-include-nonbinary-file filename "application/postscript"))

;; Normally this is not used; however, if you want a message containing
;; purely plaintext to be mimified, then go ahead and use it.
(define-key mail-mode-map "\C-cm" 'mime-mimify-message)

;; These are used to insert something into a message in a MIME-compliant
;; fashion.  These take care of mimifying the message, if necessary.
(define-key mail-mode-map "\C-cg" 'mime-include-gif)
(define-key mail-mode-map "\C-cj" 'mime-include-jpeg)
(define-key mail-mode-map "\C-ca" 'mime-include-audio)
(define-key mail-mode-map "\C-cp" 'mime-include-postscript)
(define-key mail-mode-map "\C-cx" 'mime-include-xwd-dump)
(define-key mail-mode-map "\C-ce" 'mime-include-external)

Marc

--
Marc Andreessen
Software Development Group
National Center for Supercomputing Applications
marca@ncsa.uiuc.edu