🚀 go-pugleaf

Following shell archive is a set of emacs tools that are useful for
reading and composing MIME messages.  The archive contains the
following elisp packages:

mime.el		MIME message composer
rmailmime.el	Functions for reading MIME messages from Rmail
metamail.el	Functions to use metamail from Emacs

metamail package is required for using these tools.
----------------------------------------------------------------------
: This is a shar archive.  Extract with sh, not csh.
: The rest of this file will extract:
: metamail.el mime.el rmailmime.el
echo x metamail.el
sed 's/^X//' > metamail.el << '*-*-END-of-metamail.el-*-*'
X;;; Metamail interface for GNU Emacs
X;; Copyright (C) 1993 Masanobu UMEDA
X
X;; Author: Masanobu UMEDA <umerin@mse.kyutech.ac.jp>
X;; Version: $Header: metamail.el,v 1.3 93/06/21 15:37:28 umerin Exp $
X;; Keywords: mail, news, mime, multimedia
X
X;; This file is part of GNU Emacs.
X
X;; GNU Emacs is free software; you can redistribute it and/or modify
X;; it under the terms of the GNU General Public License as published by
X;; the Free Software Foundation; either version 2, or (at your option)
X;; any later version.
X
X;; GNU Emacs is distributed in the hope that it will be useful,
X;; but WITHOUT ANY WARRANTY; without even the implied warranty of
X;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
X;; GNU General Public License for more details.
X
X;; You should have received a copy of the GNU General Public License
X;; along with GNU Emacs; see the file COPYING.  If not, write to
X;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
X
X;;; Commentary:
X
X;; LCD Archive Entry:
X;; metamail|Masanobu UMEDA|umerin@mse.kyutech.ac.jp|
X;; Metamail interface for GNU Emacs|
X;; $Date: 93/06/21 15:37:28 $|$Revision: 1.3 $|~/misc/metamail.el.Z|
X
X;; Note: Metamail does not have all options which is compatible with
X;; the environment variables.  For that reason, matamail.el have to
X;; hack the environment variables.  In addition, there is no way to
X;; display all header fields without extra informative body messages
X;; which is suppressed by "-q" option.
X
X;; The idea of using metamail to process MIME messages is from
X;; gnus-mime.el by Spike <Spike@world.std.com>.
X
X;;; Code:
X
X(defvar metamail-program-name "metamail"
X  "*Metamail program name.")
X
X(defvar metamail-environment "KEYHEADS='*';export KEYHEADS;"
X  "*Environment variables for Metamail.
XIt must be an emtpy string or a string terminated with ';'.")
X
X(defvar metamail-switches '("-m" "emacs" "-x" "-d" "-z")
X  "*Switches for Metamail program.
X-z is required to remove zap file.")
X
X(defun metamail-buffer (&optional buffer)
X  "Process current buffer through 'metamail'.
XOptional argument BUFFER specifies a buffer to be filled (nil means current)."
X  (interactive)
X  (metamail-region (point-min) (point-max) buffer))
X
X(defun metamail-region (beg end &optional buffer)
X  "Process current region through 'metamail'.
XOptional argument BUFFER specifies a buffer to be filled (nil means current)."
X  (interactive "r")
X  (let ((curbuf (current-buffer))
X	(buffer-read-only nil)
X	(metafile (make-temp-name "/tmp/metamail")))
X    (save-excursion
X      ;; Gee!  Metamail does not ouput to stdout if input comes from
X      ;; stdin.
X      (write-region beg end metafile nil 'nomessage)
X      (if buffer
X	  (set-buffer buffer))
X      (setq buffer-read-only nil)
X      ;; Clear destination buffer.
X      (if (eq curbuf (current-buffer))
X	  (delete-region beg end)
X	(delete-region (point-min) (point-max)))
X      ;; We have to pass the environment variable KEYHEADS to /bin/sh
X      ;; to display all header fields.  Metamail should have an
X      ;; optional argument to pass such information directly.
X      (apply (function call-process)
X	     "/bin/sh"
X	     nil
X	     t				;Output to current buffer
X	     t				;Force redisplay
X	     (list "-c"
X		   ;; Construct environment and the command.
X		   (concat
X		    metamail-environment
X		    metamail-program-name
X		    " "
X		    (mapconcat (function identity) metamail-switches " ")
X		    " "
X		    metafile
X		    )))
X      )))
X
X;(defun metamail-region (beg end &optional buffer)
X;  "Process current region through 'metamail'.
X;Optional argument BUFFER specifies a buffer to be filled (nil means current)."
X;  (interactive "r")
X;  (let ((curbuf (current-buffer))
X;	(buffer-read-only nil)
X;	(metafile (make-temp-name "/tmp/metamail")))
X;    (save-excursion
X;      (write-region (point-min) (point-max) metafile nil 'nomessage)
X;      (if (eq curbuf
X;	      (if buffer (get-buffer buffer) (current-buffer)))
X;	  (delete-region (point-min) (point-max)))
X;      (apply (function call-process)
X;	     metamail-program-name
X;	     nil
X;	     (or buffer t)		;BUFFER or current buffer
X;	     nil			;don't redisplay
X;	     (append metamail-switches (list metafile)))
X;      )))
X
X(provide 'metamail)
X
X;;; metamail.el ends here
*-*-END-of-metamail.el-*-*
echo x mime.el
sed 's/^X//' > mime.el << '*-*-END-of-mime.el-*-*'
X;;; Poorman's Simple MIME Composer for Emacs
X;; Copyright (C) 1993 Masanobu UMEDA
X
X;; Author: Masanobu UMEDA <umerin@mse.kyutech.ac.jp>
X;; Version: $Header: mime.el,v 1.19 93/07/05 21:33:36 umerin Locked $
X;; Keywords: mail, news, mime
X
X;; This file is part of GNU Emacs.
X
X;; GNU Emacs is free software; you can redistribute it and/or modify
X;; it under the terms of the GNU General Public License as published by
X;; the Free Software Foundation; either version 2, or (at your option)
X;; any later version.
X
X;; GNU Emacs is distributed in the hope that it will be useful,
X;; but WITHOUT ANY WARRANTY; without even the implied warranty of
X;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
X;; GNU General Public License for more details.
X
X;; You should have received a copy of the GNU General Public License
X;; along with GNU Emacs; see the file COPYING.  If not, write to
X;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
X
X;;; Commentary:
X
X;; LCD Archive Entry:
X;; mime|Masanobu UMEDA|umerin@mse.kyutech.ac.jp|
X;; Simple MIME Composer|
X;; $Date: 93/07/05 21:33:36 $|$Revision: 1.19 $|~/misc/mime.el.Z|
X
X;; This is an Emacs minor mode for editing Internet multimedia
X;; messages encoded in MIME (RFC1341 and RFC1342).  All messages in
X;; this mode are composed in the tagged MIME format, that are
X;; described in the following examples.  The messages in the tagged
X;; MIME format are automatically translated into a MIME compliant
X;; message when exiting the mode.
X
X;; Content-Type Tag:
X;;	--[[TYPE/SUBTYPE; OPTIONS]]
X;;
X;; The tagged MIME message examples:
X;;
X;; This is a conventional plain text.  It should be translated into
X;; text/plain.
X;; 
X;;--[[text/plain]]
X;; This is also a plain text.  But, it is explicitly specified as is.
X;;
X;;--[[text/plain; charset=ISO-2022-JP]]
X;; これは charset を ISO-2022-JP に指定した日本語の plain テキストです.
X;;
X;;--[[text/richtext]]
X;; <center>This is a richtext.</center>
X;;
X;;--[[image/gif]]^MContent-Transfer-Encoding: base64^M...image comes here...
X;;
X;;--[[audio/basic]]^MContent-Transfer-Encoding: base64^M...audio comes here...
X
X;;; Code:
X
X(require 'sendmail)
X(require 'mail-utils)
X
X(autoload 'metamail-buffer "metamail"
X	  "Process current buffer through 'metamail'." t)
X
X(defvar mime-prefix "\C-c\C-x"
X  "*Keymap prefix for MIME commands.")
X
X(defvar mime-ignore-preceding-spaces nil
X  "*Ignore preceding white spaces if non-nil.")
X
X(defvar mime-ignore-trailing-spaces nil
X  "*Ignore trailing white spaces if non-nil.")
X
X(defvar mime-auto-fill-header t
X  "*Fill header fields that contain encoded-words.")
X
X(defvar mime-content-types
X  '(("text"
X     ("plain"
X      ("charset" "ISO-2022-JP" "US-ASCII"))
X     ("richtext"
X      ("charset" "ISO-2022-JP" "US-ASCII")))
X    ("message"
X     ("external-body"
X      ("access-type"
X       ("anon-ftp"
X	("site" "wnoc-fuk.wide.ad.jp" "nic.karrn.ad.jp")
X	("directory")
X	("name")
X	("mode" "binary" "ascii"))
X       ("ftp"
X	("site")
X	("directory")
X	("name")
X	("mode" "binary" "ascii"))
X       ("tftp"
X	("site")
X	("name"))
X       ("afs"
X	("site")
X	("name"))
X       ("local-file"
X	("site")
X	("name"))
X       ("mail-server"
X	("server"))))
X     ("rfc822"))
X    ("application"
X     ("postscript")
X     ("octet-stream"
X      ("name")
X      ("type" "" "tar" "shar")
X      ("conversions")
X      ))
X    ("image"
X     ("gif")
X     ("jpeg")
X     ("x-xwd")
X     ("x-xbm"))
X    ("audio"
X     ("basic"))
X    ("video"
X     ("mpeg")))
X  "*Alist of content-type, subtype, options and its values.")
X
X(defvar mime-file-types
X  '(("\\.ps$"	"application"	"postscript"	nil)
X    ("\\.gif$"	"image"		"gif"	nil)
X    ("\\.xwd$"	"image"		"x-xwd"	nil)
X    ("\\.xbm$"	"image"		"x-xbm"	nil)
X    ("\\.jpg$"	"image"		"jpeg"	nil)
X    ("\\.au$"	"audio"		"basic"	nil)
X    ("\\.mpg$"	"video"		"mpeg"	nil))
X  "*Alist of file name, types and options.")
X
X(defvar mime-message-encoder
X  '(("base64"			"mmencode"	"mmencode -u")
X    ("b"			"mmencode"	"mmencode -u") ;in header
X    ("quoted-printable"		"mmencode -q"	"mmencode -q -u")
X    ("q"			"mmencode -q"	"mmencode -q -u") ;in header
X    ("7bit"			nil nil) ;Default
X    ("8bit"			nil nil)
X    ("binary"			nil nil))
X  "*Alist of encoding, encoder, and decoder.
XEncoder and decoder is a command string, function symbol or lambda
Xlist which take two arguments.  If it is nil, no conversion is done.")
X
X(defvar mime-message-handler
X  '(("text/richtext"		t)
X    ("text/plain"		t)
X    (t				mime-run-metamail))
X  "*Alist of Content-type and its preview method.
XThe method can be a function symbol or a lambda list that takes a
Xregion, nil or t.  nil means no handler is defined.  t means what you
Xsee is what you get.  If content-type is t, it is a default.")
X
X(defvar mime-charset-chooser
X  (function mime-charset-chooser-for-nemacs)
X  "*Function that identify charset of a text in a given region.")
X
X(defvar mime-header-encoding-chooser
X  (function mime-header-encoding-chooser-for-nemacs)
X  "*Function to identify encoding method of a header in a give region.
XThe method is a form of (CHARSET . ENCODING), where ENCODING is either
X'B' or 'Q'.  Nil means no encoding is necessary.")
X
X(defvar mime-header-string-encoder
X  (function mime-header-string-encoder-for-nemacs)
X  "*Function to encode string for using in header for given encoding method.")
X
X(defvar mime-voice-recorder
X  (function mime-voice-recorder-for-sun)
X  "*Function to record voice message.")
X
X(defvar mime-max-header-length 76
X  "*Any header should not exceed this value.")
X
X(defvar mime-tspecials-regexp "[][()<>@,;:\\\"/?.= \t]"
X  "*Specify MIME tspecials.
XTspecials means any character that matches with it must be quoted.")
X
X(defvar mime-tag-regexp "^--[[][[]\\([^]]*\\)]]"
X  "*Regexp of Content-Type tag in the text.")
X
X(defvar mime-tag-format "--[[%s]]"
X  "*Control-string generating a Content-Type tag.")
X
X(defvar mime-multipart-boundary "Multipart"
X  "*Boundary of a multipart message.")
X
X
X(defconst mime-version-number "1.0"
X  "MIME version number.")
X
X(defvar mime-mode-flag nil)
X(make-variable-buffer-local 'mime-mode-flag)
X
X(or (assq 'mime-mode-flag minor-mode-alist)
X    (setq minor-mode-alist
X	  (cons (list 'mime-mode-flag " MIME") minor-mode-alist)))
X
X(defun mime-define-keymap (keymap)
X  "Add MIME commands to KEYMAP."
X  (if (not (keymapp keymap))
X      nil
X    (define-key keymap "\C-t" 'mime-insert-text)
X    (define-key keymap "\C-v" 'mime-insert-voice)
X    (define-key keymap "\C-e" 'mime-insert-external)
X    (define-key keymap "\C-i" 'mime-include-file)
X    (define-key keymap "\C-p" 'mime-preview-content)
X    (define-key keymap "\C-z" 'mime-mode-exit)
X    (define-key keymap "?" 'help-mime-mode)))
X
X;;;###autoload
X(defun mime-mode ()
X  "Minor mode for editing the tagged MIME message.
X
XIn this mode, basically, the message should be composed in the tagged
XMIME format.  The message tag looks like:
X
X	'--[[text/plain; charset=ISO-2022-JP]]'.
X
XThe tag specifies the content-type, subtype, and options of the
Xmessage following the tag in terms of MIME.  Messages without any tag
Xare treated as text/plain by default.  Binary messages such as audio
Xand image are usually hidden in this mode using selective-display
Xfacility.  The messages in the tagged MIME format are automatically
Xtranslated into a MIME compliant message when exiting the mode.
X
XCommands with a prefix (specified by the variable mime-prefix):
XC-t	mime-insert-text	insert text message
XC-v	mime-insert-voice	insert voice message
XC-e	mime-insert-external	insert reference to external body
XC-i	mime-include-file	insert from a (binary) file
XC-p	mime-preview-content	preview an included content
XC-z	mime-mode-exit		Convert into MIME
X?	help-mime-mode		show this message
X
XAdditional commands:
XC-c C-s	mime-mode-exit-and-run	Convert into MIME and run original command
XC-c C-c	mime-mode-exit-and-run	Convert into MIME and run original command
X
XThe following is a message example in the tagged MIME format (TABs at
Xthe beginning of the line are not a part of the message):
X
X	This is a conventional plain text.  It should be translated
X	into text/plain.
X	--[[text/plain]]
X	This is also a plain text.  But, it is explicitly specified as
X	is.
X	--[[text/plain; charset=ISO-2022-JP]]
X	これは charset を ISO-2022-JP に指定した日本語の plain テキス
X	トです.
X	--[[text/richtext]]
X	<center>This is a richtext.</center>
X	--[[image/gif]]^MContent-Transfer-Encoding: base64^M...image here...
X	--[[audio/basic]]^Montent-Transfer-Encoding: base64^M...audio here...
X
XTurning on MIME mode calls the value of mime-mode-hook, if they are
Xnon-nil."
X  (interactive)
X  (if mime-mode-flag
X      (error "You are already editing a MIME.")
X    (setq mime-mode-flag t)
X    ;; Remember old key bindings.
X    (make-local-variable 'mime-mode-old-local-map)
X    (setq mime-mode-old-local-map (current-local-map))
X    ;; Add MIME commands to current local map.
X    (use-local-map (copy-keymap (current-local-map)))
X    (if (not (lookup-key (current-local-map) mime-prefix))
X	(define-key (current-local-map) mime-prefix (make-sparse-keymap)))
X    (mime-define-keymap (lookup-key (current-local-map) mime-prefix))
X    ;; These are useful to avoid sending before conversion into
X    ;; MIME in Mail mode and News mode.
X    (define-key (current-local-map) "\C-c\C-c" 'mime-mode-exit-and-run)
X    (define-key (current-local-map) "\C-c\C-s" 'mime-mode-exit-and-run)
X    ;; Remember old selective-display.
X    (make-local-variable 'mime-mode-old-selective-display)
X    (setq mime-mode-old-selective-display selective-display)
X    (setq selective-display t)
X    ;; I don't care about saving these.
X    (setq paragraph-start
X	  (concat mime-tag-regexp "\\|" paragraph-start))
X    (setq paragraph-separate
X	  (concat mime-tag-regexp "\\|" paragraph-separate))
X    (run-hooks 'mime-mode-hook)
X    (message
X     (substitute-command-keys
X      "Type \\[mime-mode-exit] in this buffer to exit MIME mode."))
X    ))
X
X;;;###autoload
X(fset 'edit-mime 'mime-mode)		; for convenience
X
X(defun mime-mode-exit (&optional nomime)
X  "Convert the tagged MIME message into MIME compliant message.
XWith no argument encode a message in the buffer into MIME, otherwise
Xjust return to previous mode."
X  (interactive "P")
X  (if (not mime-mode-flag)
X      (error "You aren't editing a MIME.")
X    (if (not nomime)
X	(mime-convert-buffer))
X    (setq mime-mode-flag nil)
X    ;; Restore previous state.
X    (use-local-map mime-mode-old-local-map)
X    (setq selective-display mime-mode-old-selective-display)
X    (set-buffer-modified-p (buffer-modified-p))
X    (message "Exit MIME mode.")
X    ))
X
X(defun mime-mode-exit-and-run ()
X  "Run a command bound on the same key in old keymap after the conversion."
X  (interactive)
X  (let ((cmd (lookup-key mime-mode-old-local-map (this-command-keys))))
X    (mime-mode-exit)
X    (if cmd
X	(call-interactively cmd))))
X
X(defun help-mime-mode ()
X  "Show help message about MIME mode."
X  (interactive)
X  (with-output-to-temp-buffer "*Help*"
X    (princ "Edit MIME Mode:\n")
X    (princ (documentation 'mime-mode))
X    (print-help-return-message)))
X
X(defun mime-insert-text ()
X  "Insert text message."
X  (interactive)
X  (if (and (mime-insert-message "text" nil nil)
X	   (looking-at mime-tag-regexp))
X      (progn
X	;; Make a space between the following message.
X	(insert "\n")
X	(forward-char -1))))
X
X(defun mime-insert-voice ()
X  "Insert voice message."
X  (interactive)
X  (mime-insert-message "audio" "basic" nil)
X  (let ((buffer (funcall mime-voice-recorder)))
X    (unwind-protect
X	(mime-insert-binary-buffer buffer "base64")
X      (kill-buffer buffer)
X      )))
X
X(defun mime-insert-external ()
X  "Insert reference to external body."
X  (interactive)
X  (mime-insert-message "message" "external-body" nil ";\n\t")
X  ;;(forward-char -1)
X  ;;(insert "Content-description: " (read-string "Content-description: ") "\n")
X  ;;(forward-line 1)
X  (let* ((pritype (mime-prompt-for-type))
X	 (subtype (mime-prompt-for-subtype pritype))
X	 (options (mime-prompt-for-options pritype subtype ";\n\t")))
X    (and pritype
X	 subtype
X	 (insert "Content-type: " pritype "/" subtype (or options "") "\n")))
X  (if (and (not (eobp))
X	   (not (looking-at mime-tag-regexp)))
X      (insert (mime-make-text-tag) "\n")))
X
X(defun mime-include-file (file)
X  "Insert message from a file."
X  (interactive "fInclude file: ")
X  (let*  ((guess (mime-find-file-type file))
X	  (pritype (nth 0 guess))
X	  (subtype (nth 1 guess))
X	  (options (nth 2 guess)))
X    (mime-insert-message pritype subtype options)
X    (mime-insert-binary-file file "base64")))
X
X(defun mime-preview-content ()
X  "Preview an included message content around point through metamail."
X  (interactive)
X  (save-excursion
X    ;; Search for the beginning of the tagged MIME message.
X    (if (looking-at mime-tag-regexp)
X	nil
X      ;; At first, go to the end.
X      (if (re-search-forward mime-tag-regexp nil t)
X	  (progn
X	    (forward-line -1)
X	    (end-of-line))
X	(goto-char (point-max)))
X      ;; Then search for the beginning. 
X      (re-search-backward mime-tag-regexp nil t)
X      (beginning-of-line))
X    (if (looking-at mime-tag-regexp)
X	(let* ((handler
X		(mime-find-handler
X		 (mime-strip-options
X		  (buffer-substring (match-beginning 1) (match-end 1)))))
X	       (beg (point))
X	       (end (save-excursion
X		      (forward-line 1)
X		      (re-search-forward mime-tag-regexp nil 'move)
X		      (point))))
X	  (cond ((eq handler t)		;As is.
X		 (message "Nothing to do.  You are seeing as is."))
X		((or (symbolp handler) (consp handler))
X		 (funcall handler beg end))
X		(t
X		 (ding) (message "No message handler defined."))
X		))
X      (ding) (message "No messages to preview around here.")
X      )))
X
X
X;; Additional commands
X
X(defun mime-encode-region (encoding begin end)
X  "Encode current buffer using ENCODING from BEGIN to END."
X  (interactive
X   (list (completing-read "Encoding: " mime-message-encoder nil 'req)
X	 (region-beginning) (region-end)))
X  (let* ((kanji-flag nil)
X	 (encoding (or encoding "base64"))
X	 (encoder (mime-find-encoder encoding)))
X    (cond ((stringp encoder)
X	   (shell-command-on-region begin end encoder t))
X	  (encoder
X	   (funcall encoder begin end))
X	  )))
X
X(defun mime-decode-region (encoding begin end)
X  "Decode current buffer using ENCODING from BEGIN to END."
X  (interactive
X   (list (completing-read "Encoding: " mime-message-encoder nil 'req)
X	 (region-beginning) (region-end)))
X  (let* ((kanji-flag nil)
X	 (encoding (or encoding "base64"))
X	 (decoder (mime-find-decoder encoding)))
X    (cond ((stringp decoder)
X	   (shell-command-on-region begin end decoder t))
X	  (decoder
X	   (funcall decoder begin end))
X	  )))
X
X
X;; Insert new MIME tag at around point.
X
X(defun mime-insert-message (&optional pritype subtype options delimiter)
X  "Insert new MIME message tag.
XIf nothing is inserted, return nil."
X  (let ((oldtag nil)
X	(newtag nil)
X	(current (point)))
X    (setq pritype
X	  (or pritype (mime-prompt-for-type)))
X    (setq subtype
X	  (or subtype (mime-prompt-for-subtype pritype)))
X    (setq options
X	  (or options (mime-prompt-for-options pritype subtype delimiter)))
X    ;; Make a new MIME tag.
X    (setq newtag (mime-make-tag pritype subtype options))
X    ;; Find an old MIME tag.
X    (setq oldtag
X	  (save-excursion
X	    (end-of-line)
X	    (if (re-search-backward mime-tag-regexp nil t)
X		(buffer-substring (match-beginning 0) (match-end 0)))))
X    ;; We are only interested in TEXT.
X    (if (and oldtag
X	     ;;(not (string-match "[^a-zA-Z0-9]text/" oldtag))
X	     (not (mime-text-tag-p oldtag)))
X	(setq oldtag nil))
X    ;; Copy the tag for a message at current point if necessary.
X    (if (save-excursion
X	  (forward-line -1)
X	  (and (looking-at mime-tag-regexp)
X	       (progn
X		 (goto-char (match-end 0))
X		 (not (= (following-char) ?\^M)))))
X	(forward-line -1))
X    (beginning-of-line)
X    (if (and oldtag
X	     (not (eobp))
X	     (not (looking-at mime-tag-regexp))
X	     (not (string-equal oldtag newtag)))
X	(save-excursion
X	  (insert oldtag "\n")))
X    ;; Make a new tag.
X    (if (or (not oldtag)
X	    (not (string-equal oldtag newtag)))
X	(progn
X	  (insert newtag "\n")
X	  t				;New entry is created.
X	  )
X      ;; Restore previous point.
X      (goto-char current)
X      nil				;Nothing is created.
X      )
X    ))
X
X;; Insert the content of binary file after MIME tag.
X
X(defun mime-insert-binary-file (file &optional encoding)
X  "Insert binary FILE at point.
XOptional argument specifies an encoding method such as base64 (default)."
X  (let* ((encoding (or encoding "base64")))
X    (save-restriction
X      (narrow-to-region (1- (point)) (point))
X      (insert "Content-Transfer-Encoding: " encoding "\n\n")
X      (let ((start (point))
X	    (kanji-flag nil))		;NEmacs hack.
X	(insert-file-contents file)
X	;; Encode binary message if necessary.
X	(mime-encode-region encoding start (point-max)))
X      (mime-flag-region (point-min) (1- (point-max)) ?\^M)
X      (goto-char (point-max))
X      )))
X
X(defun mime-insert-binary-buffer (buffer &optional encoding)
X  "Insert binary BUFFER at point.
XOptional argument specifies an encoding method such as base64 (default)."
X  (let* ((encoding (or encoding "base64")))
X    (save-restriction
X      (narrow-to-region (1- (point)) (point))
X      (insert "Content-Transfer-Encoding: " encoding "\n\n")
X      (let ((start (point))
X	    (kanji-flag nil))		;NEmacs hack.
X	(insert-buffer-substring buffer)
X	;; Encode binary message if necessary.
X	(mime-encode-region encoding start (point-max)))
X      (mime-flag-region (point-min) (1- (point-max)) ?\^M)
X      (goto-char (point-max))
X      )))
X
X(defun mime-run-metamail (begin end)
X  "Run metamail on current tagged MIME message from BEGIN to END."
X  (save-excursion
X    (let ((tmpbuf (get-buffer-create " *MIME preview*")))
X      (copy-to-buffer tmpbuf begin end)
X      (set-buffer tmpbuf)
X      ;; Mock Mail mode buffer.
X      (goto-char (point-min))
X      (insert "From: PreviewTheContent\n"
X	      mail-header-separator "\n")
X      ;; Then convert it into MIME. 
X      (mime-convert-body)
X      (goto-char (point-min))
X      (if (search-forward (concat "\n" mail-header-separator "\n") nil t)
X	  (replace-match "\n\n"))
X      ;; Preview the content using metamail.
X      (metamail-buffer)
X      (kill-buffer tmpbuf)
X      )))
X
X(defun mime-encode-string (encoding string)
X  "Using ENCODING encode a STRING."
X  (save-excursion
X    (set-buffer (get-buffer-create " *MIME encoding*"))
X    (erase-buffer)
X    (insert string)
X    (mime-encode-region encoding (point-min) (point-max))
X    ;; Unfold lines since mmencode breaks long lines.
X    (goto-char (point-min))
X    (while (re-search-forward "\n" nil t)
X      (replace-match ""))
X    (prog1
X	(buffer-substring (point-min) (point-max))
X      (kill-buffer (current-buffer)))))
X
X(defun mime-decode-string (encoding string)
X  "Using ENCODING decode a STRING."
X  (save-excursion
X    (set-buffer (get-buffer-create " *MIME decoding*"))
X    (erase-buffer)
X    (insert string)
X    (mime-decode-region encoding (point-min) (point-max))
X    (prog1
X	(buffer-substring (point-min) (point-max))
X      (kill-buffer (current-buffer)))))
X
X(defun mime-find-encoder (encoding)
X  "Return encoder of message for ENCODING."
X  (and encoding
X       (nth 1 (assoc (downcase encoding) mime-message-encoder))))
X
X(defun mime-find-decoder (encoding)
X  "Return decoder of message for ENCODING."
X  (and encoding
X       (nth 2 (assoc (downcase encoding) mime-message-encoder))))
X
X(defun mime-find-file-type (file)
X  "Guess Content-Type, subtype, and options from FILE."
X  (let ((guess nil)
X	(guesses mime-file-types))
X    (while (and (not guess) guesses)
X      (if (string-match (car (car guesses)) file)
X	  (setq guess (cdr (car guesses))))
X      (setq guesses (cdr guesses)))
X    guess
X    ))
X
X(defun mime-find-handler (type)
X  "Return message handler for Content-type TYPE."
X  (and type
X       (let ((pair (assoc (downcase type) mime-message-handler)))
X	 (if pair
X	     (nth 1 pair)
X	   ;; Search default if no entry.
X	   (nth 1 (assoc t mime-message-handler))))))
X
X(defun mime-strip-options (content-type)
X  "Return content-type and subtype without options."
X  (if (string-match "^[ \t]*\\([^; \t\n]*\\)" content-type)
X      (substring content-type (match-beginning 1) (match-end 1)) nil))
X
X(defun mime-prompt-for-type ()
X  "Ask for Content-type."
X  (completing-read "Content-Type: "
X		   mime-content-types
X		   nil
X		   t
X		   nil
X		   ))
X
X(defun mime-prompt-for-subtype (pritype)
X  "Ask for Content-type subtype for Content-Type PRITYPE."
X  (let* ((default (car (car (cdr (assoc pritype mime-content-types)))))
X	 (answer
X	  (completing-read (if default
X			       (concat
X				"Content subtype: (default " default ") ")
X			     "Content subtype: ")
X			   (cdr (assoc pritype mime-content-types))
X			   nil
X			   t
X			   ""
X			   )))
X    (if (string-equal answer "") default answer)))
X
X(defun mime-prompt-for-options (pritype subtype &optional delimiter)
X  "Ask for Content-type options for Content-Type PRITYPE and SUBTYPE.
XOptional DELIMITER specifies option delimiter (';' by default)."
X  (let* ((delimiter (or delimiter "; "))
X	 (options
X	  (mapconcat
X	   (function identity)
X	   (delq nil
X		 (mime-prompt-for-options-1
X		  (cdr (assoc subtype
X			      (cdr (assoc pritype mime-content-types))))))
X	   delimiter
X	   )))
X    (if (and (stringp options)
X	     (not (string-equal options "")))
X	(concat delimiter options)
X      ""				;"" if no options
X      )))
X
X(defun mime-prompt-for-options-1 (optlist)
X  (apply (function append)
X	 (mapcar (function mime-prompt-for-option) optlist)))
X
X(defun mime-prompt-for-option (option)
X  "Ask for OPTION.
XOption must be '(PROMPT CHOICE1 (CHOISE2 ...))."
X  (let* ((prompt (car option))
X	 (choices (mapcar (function
X			   (lambda (e)
X			     (if (consp e) e (list e))))
X			  (cdr option)))
X	 (default (car (car choices)))
X	 (answer nil))
X    (if choices
X	(progn
X	  (setq answer
X		(completing-read
X		 (concat prompt
X			 ": (default "
X			 (if (string-equal default "") "\"\"" default)
X			 ") ")
X		 choices nil nil ""))
X	  ;; If nothing is selected, use default.
X	  (if (string-equal answer "")
X	      (setq answer default)))
X      (setq answer
X	    (read-string (concat prompt ": "))))
X    (cons (if (and answer
X		   (not (string-equal answer "")))
X	      (concat prompt "="
X		      ;; Note: control characters ignored!
X		      (if (string-match mime-tspecials-regexp answer)
X			  (concat "\"" answer "\"") answer)))
X	  (mime-prompt-for-options-1 (cdr (assoc answer (cdr option)))))
X    ))
X
X(defun mime-make-tag (pritype subtype &optional options)
X  "Make a tag of MIME message of PRITYPE, SUBTYPE and optional OPTIONS."
X  (format mime-tag-format
X	  (concat (or pritype "") "/" (or subtype "") (or options ""))))
X
X(defun mime-make-text-tag ()
X  "Make a tag for a text.
XContent-type is 'text' and its subtype is obtained from mime-content-types.
XCharset is inferenced from the message content."
X  (save-excursion
X    (let* ((pritype "text")
X	   (subtype (car (car (cdr (assoc pritype mime-content-types)))))
X	   (begin (point)))
X      ;; Move to the end of this text.
X      (if (re-search-forward mime-tag-regexp nil 'move)
X	  (beginning-of-line))
X      (mime-make-tag pritype subtype
X		     (concat "; charset="
X			     (funcall mime-charset-chooser begin (point))))
X      )))
X
X(defun mime-text-tag-p (tag)
X  "Non-nil if TAG is a kind of text content-type."
X  (and (string-match mime-tag-regexp tag)
X       (string-match "^text\\(/\\|$\\)"
X		     (substring tag (match-beginning 1) (match-end 1)))))
X
X(defun mime-flag-region (from to flag)
X  "Hides or shows lines from FROM to TO, according to FLAG.
XIf FLAG is `\\n' (newline character) then text is shown,
Xwhile if FLAG is `\\^M' (control-M) the text is hidden."
X  (let ((buffer-read-only nil)		;Okay even if write protected.
X	(modp (buffer-modified-p)))
X    (unwind-protect
X        (subst-char-in-region from to
X			      (if (= flag ?\n) ?\^M ?\n)
X			      flag t)
X      (set-buffer-modified-p modp))))
X
X;;(defun mime-default-options (pritype subtype)
X;;  "Return default options for content-type PRITYPE and SUBTYPE."
X;;  (mapconcat
X;;   (function
X;;    (lambda (optlist)
X;;      (concat (car optlist)
X;;	      "="
X;;	      (car (cdr optlist)))))
X;;   (cdr (assoc subtype (cdr (assoc pritype mime-content-types))))
X;;   "; "
X;;   ))
X
X
X;; Translate the tagged MIME messages into a MIME compliant message.
X
X(defun mime-convert-buffer ()
X  "Encode the tagged MIME message in current buffer in MIME compliant message."
X  (interactive)
X  (mime-convert-header)
X  (mime-convert-body))
X
X(defun mime-convert-header ()
X  "Encode headers in MIME compliant message headers."
X  (interactive)
X  (save-excursion
X    (save-restriction
X      (goto-char (point-min))
X      (search-forward (concat "\n" mail-header-separator "\n") nil t)
X      (narrow-to-region (point-min) (point))
X      (goto-char (point-min))
X      (while (re-search-forward "^[^ \t\n:]+:[ \t]*" nil t)
X	(let* ((beg (point))
X	       (end (progn
X		      (while (progn (forward-line 1) (looking-at "[ \t]")))
X		      (1- (point)))))
X	  (if (funcall mime-header-encoding-chooser beg end)
X	      (let* ((string (buffer-substring beg end))
X		     (newstr (mime-convert-header-string string))
X		     (fill-column mime-max-header-length)
X		     (fill-prefix " "))
X		(if (not (string-equal string newstr))
X		    (save-excursion
X		      (goto-char beg)
X		      (delete-region beg end)
X		      (insert newstr)
X		      ;; Fill header fields.
X		      (if mime-auto-fill-header
X			  ;; The region must end with a newline to
X			  ;; fill the region without inserting extra
X			  ;; newline.
X			  (fill-region-as-paragraph beg (1+ (point))))
X		      ))))
X	  ))
X      )))
X
X(defun mime-convert-header-string (string)
X  "Encode STRING suitable for using in header."
X  (save-excursion
X    (let* ((poslist nil)		;Possible break points.
X	   (last-encoding nil)		;last chunk encoding
X	   (this-encoding nil)		;this chunk encoding
X	   (start nil)			;Chunk start point
X	   (chunk nil)
X	   (saved nil)			;Saved last line.
X	   (separator nil)
X	   (result ""))
X      (set-buffer (get-buffer-create " *MIME header*"))
X      (erase-buffer)
X      (insert string)
X      ;; Replace white spaces for continuation line with a space.
X      (goto-char (point-min))
X      (while (re-search-forward "\n[ \t]*" nil t)
X	(replace-match " "))
X      ;; Encode string
X      (goto-char (point-min))
X      (while (not (eobp))
X	(setq start (point))
X	;; Set initial code.
X	(setq last-encoding this-encoding) 
X	(setq this-encoding
X	      (funcall mime-header-encoding-chooser
X		       start
X		       (save-excursion
X			 (forward-char 1) (point))))
X	(setq poslist (mime-search-for-code-boundary))
X	(if (not this-encoding)
X	    (setq chunk (buffer-substring start (point)))
X	  ;; Break line if too long in terms of RFC1342.
X	  (let ((repeat t))
X	    (while repeat
X	      (setq chunk
X		    (funcall mime-header-string-encoder
X			     this-encoding
X			     (buffer-substring start (point))))
X	      (if (<= (length chunk) mime-max-header-length)
X		  (setq repeat nil)
X		;; Must break since too long.
X		(setq poslist (cdr poslist))
X		(if poslist
X		    ;; There is a break point candidate.
X		    (progn
X		      (goto-char (car poslist))
X		      (skip-chars-backward " \t"))
X		  ;; Still too long, so insert a newline.
X		  (backward-char
X		   (max 1
X			(/ (* (- (point) start)
X			      (- (length chunk) mime-max-header-length))
X			   (- (length chunk)
X			      (length (car this-encoding))
X			      (length (cdr this-encoding)) 6))))
X		  ))
X	      ))
X	  )
X	;; Fold line if necessary.
X	;; BUG: An extra space may be inserted after a white space
X	;; followed by non-ascii characters.
X	(cond ((string-equal result "")
X	       (setq saved chunk)
X	       (setq separator ""))
X	      ((and (or last-encoding this-encoding)
X		    (> (length (concat saved chunk))
X		       mime-max-header-length))
X	       (setq saved (concat chunk " "))
X	       (setq separator "\n "))
X	      ;; (not (equal last-encoding this-encoding))
X	      ((and last-encoding (not this-encoding)
X		    (> (length (concat saved " " chunk))
X		       mime-max-header-length))
X	       (setq saved (concat chunk " "))
X	       (setq separator "\n "))
X	      ;; (not (equal last-encoding this-encoding))
X	      ((and last-encoding (not this-encoding)
X		    (string-match "^[^ \t]" chunk))
X	       (setq saved (concat saved " " chunk))
X	       (setq separator " "))
X	      (t
X	       (setq saved (concat saved chunk))
X	       (setq separator "")))
X	(setq result (concat result separator chunk)))
X      (kill-buffer (current-buffer))
X      result
X      )))
X
X(defun mime-search-for-code-boundary ()
X  "Search for code boundary starting from current point and return points."
X  (let ((repeat t)
X	(lastwhite nil)
X	(poslist nil)			;possible boundary points
X	(encoding (and (not (eobp))
X		       (funcall mime-header-encoding-chooser
X				(point)
X				(save-excursion
X				  (forward-char 1) (point))))))
X    (while repeat
X      (while (and (not (eobp))
X		  (equal encoding
X			 (funcall mime-header-encoding-chooser
X				  (point)
X				  (save-excursion
X				    (forward-char 1) (point)))))
X	(setq lastwhite nil)
X	(forward-char 1))
X      ;; Remember the candidate.
X      (if (not lastwhite)
X	  (setq poslist (cons (point) poslist)))
X      ;; Iterate if the next of the next whitespace is the same.
X      (if (looking-at "[ \t]")
X	  (skip-chars-forward " \t")
X	(setq repeat nil))
X      (setq lastwhite t)
X      )
X    ;; Goto the last point.
X    (goto-char (car poslist))
X    poslist
X    ))
X
X(defun mime-convert-body ()
X  "Encode the tagged MIME body in current buffer in MIME compliant message."
X  (interactive)
X  (save-excursion
X    (let ((boundary
X	   (concat mime-multipart-boundary " " (current-time-string)))
X	  (ctype nil)			;Content type
X	  (fields nil)			;Some additional fields
X	  (npart 0))			;Number of body part
X      (save-restriction
X	;; We are interested in message body.
X	(let* ((beg
X		(progn
X		  (goto-char (point-min))
X		  (re-search-forward
X		   (concat "\n" mail-header-separator
X			   (if mime-ignore-preceding-spaces
X			       "[ \t\n]*\n" "\n")) nil 'move)
X		  (point)))
X	       (end
X		(progn
X		  (goto-char (point-max))
X		  (and mime-ignore-trailing-spaces
X		       (re-search-backward "[^ \t\n]\n" beg t)
X		       (forward-char 1))
X		  (point))))
X	  (narrow-to-region beg end))
X	;; Counting the number of Content-Type.
X	(goto-char (point-min))
X	(while (re-search-forward mime-tag-regexp nil t)
X	  (setq npart (1+ npart)))
X	;; Normalize the body.
X	(goto-char (point-min))
X	;; Insert the first MIME tags if necessary.
X	(if (not (looking-at mime-tag-regexp))
X	    (progn
X	      (setq npart (1+ npart))
X	      (insert (mime-make-text-tag) "\n")
X	      ))
X	;; Insert MIME tags after mmencoded messages.
X	(while (re-search-forward mime-tag-regexp nil t)
X	  (if (= (following-char) ?\^M)
X	      (progn
X		(forward-line 1)
X		(if (and (not (eobp))
X			 (not (looking-at mime-tag-regexp)))
X		    (progn
X		      (setq npart (1+ npart))
X		      (insert (mime-make-text-tag) "\n")))
X		))
X	  )
X	;; Begin translation.
X	(cond ((<= npart 1)
X	       ;; It's a singular message.
X	       (goto-char (point-min))
X	       (while (re-search-forward mime-tag-regexp nil t)
X		 (setq ctype
X		       (buffer-substring (match-beginning 1) (match-end 1)))
X		 (delete-region (match-beginning 0)
X				(match-end 0))
X		 (if (= (following-char) ?\^M)
X		     (save-restriction
X		       (narrow-to-region (point)
X					 (save-excursion
X					   (end-of-line) (point)))
X		       ;; Show the text hiden with selective display.
X		       (mime-flag-region (point-min) (point-max) ?\n)
X		       (goto-char (point-min))
X		       (if (search-forward "\n\n" nil t)
X			   (progn
X			     (setq fields
X				   (buffer-substring (point-min)
X						     (- (point) 2)))
X			     (delete-region (point-min) (point)))))
X		   ;; Delete the following newline.
X		   (delete-char 1))
X		 ))
X	      (t
X	       ;; It's a multipart message.
X	       (goto-char (point-min))
X	       (while (re-search-forward mime-tag-regexp nil t)
X		 (setq ctype
X		       (buffer-substring (match-beginning 1) (match-end 1)))
X		 (delete-region (match-beginning 0) (match-end 0))
X		 (insert "--" boundary "\n")
X		 (insert "Content-Type: " ctype)
X		 ;; Show the text hiden with selective display.
X		 (if (= (following-char) ?\^M)
X		     (mime-flag-region (progn (beginning-of-line) (point))
X				       (progn (end-of-line) (point))
X				       ?\n)
X		   (insert "\n"))
X		 )
X	       ;; Insert the trailer.
X	       (goto-char (point-max))
X	       (if (not (= (preceding-char) ?\n))
X		   ;; Boundary must start with a newline.
X		   (insert "\n"))
X	       (insert "--" boundary "--\n"))
X	      )
X	)
X      ;; Make primary MIME headers.
X      (or (mail-position-on-field "Mime-Version")
X	  (insert mime-version-number))
X      ;; Remove old Content-Type and other fields.
X      (save-restriction
X	(goto-char (point-min))
X	(search-forward (concat "\n" mail-header-separator "\n") nil t)
X	(narrow-to-region (point-min) (point))
X	(goto-char (point-min))
X	(mime-delete-field "Content-Type")
X	(mime-delete-field "Content-Transfer-Encoding"))
X      ;; Then, insert new Content-Type field.
X      (cond ((<= npart 1)
X	     (mail-position-on-field "Content-Type")
X	     (insert ctype)
X	     ;; Insert additional fields if exists.
X	     (if fields
X		 (insert fields)))
X	    (t
X	     (mail-position-on-field "Content-Type")
X	     (insert "multipart/mixed; boundary=\"" boundary "\""))
X	    )
X      )))
X
X(defun mime-delete-field (field)
X  "Delete header FIELD."
X  (let ((regexp (format "^%s:[ \t]*" field)))
X    (goto-char (point-min))
X    (while (re-search-forward regexp nil t)
X      (delete-region (match-beginning 0)
X		     (progn (forward-line 1) (point)))
X      )))
X
X
X;;;
X;;; Platform dependents functions
X;;;
X
X(defun mime-charset-chooser-for-nemacs (begin end)
X  "Identify charset of a message in a given region (NEmacs only)."
X  (cond ((and (fboundp 'check-region-kanji-code) ;In case of NEmacs.
X	      (check-region-kanji-code begin end))
X	 "ISO-2022-JP")
X	(t "us-ascii")			;Default charset of MIME.
X	))
X
X(defun mime-header-encoding-chooser-for-nemacs (begin end)
X  "Return header encoding method for a given region (NEmacs only)."
X  (cond ((and (fboundp 'check-region-kanji-code) ;In case of NEmacs.
X	      (check-region-kanji-code begin end))
X	 '("ISO-2022-JP" . "B"))
X	(t nil)				;No encoding is necessary.
X	))
X
X(defun mime-header-string-encoder-for-nemacs (method string)
X  "For given encoding METHOD encode STRING for using in header (NEmacs only)."
X  (let ((charset (car method))
X	(encoding (cdr method)))
X    (concat "=?" charset "?" encoding "?"
X	    (mime-encode-string
X	     encoding
X	     (if (fboundp 'convert-string-kanji-code) ;In case of NEmacs.
X		 ;; Convert internal (EUC) to JIS code.
X		 (convert-string-kanji-code string 3 2) string)
X	     )
X	    "?="
X	    )))
X
X(defun mime-voice-recorder-for-sun ()
X  "Record voice in a buffer using Sun audio device, and return the buffer."
X  (let ((buffer (get-buffer-create " *MIME audio*")))
X    (message "Type C-g to finish recording...")
X    (save-excursion
X      (set-buffer buffer)
X      (erase-buffer)
X      (condition-case errorcode
X	  (call-process "cat"
X			"/dev/audio"
X			buffer
X			nil
X			)
X	(quit (message "Type C-g to finish recording... done.")
X	      buffer			;Return the buffer
X	      )))))
X
X
X;;;
X;;; Other useful commands.
X;;;
X
X;; Message forwarding commands as content-type "message/rfc822".
X;; Usages are as follows:
X;;
X;;(setq rmail-mode-hook
X;;      '(lambda ()
X;;	 ;; Forward mail using MIME.
X;;	 (require 'mime)
X;;	 (substitute-key-definition 'rmail-forward
X;;				    'mime-forward-from-rmail-using-mail
X;;				    (current-local-map))
X;;	 ))
X;;
X;;(setq gnus-mail-forward-method 'mime-forward-from-gnus-using-mail)
X;;(setq gnus-summary-mode-hook
X;;      '(lambda ()
X;;	 ;; Forward article using MIME.
X;;	 (require 'mime)
X;;	 ))
X
X(defun mime-forward-from-rmail-using-mail ()
X  "Forward current message in message/rfc822 content-type message from rmail."
X  (interactive)
X  ;;>> this gets set even if we abort. Can't do anything about it, though.
X  (rmail-set-attribute "forwarded" t)
X  (let ((forward-buffer (current-buffer))
X	(subject (concat "["
X			 (mail-strip-quoted-names (mail-fetch-field "From"))
X			 ": " (or (mail-fetch-field "Subject") "") "]")))
X    ;; If only one window, use it for the mail buffer.
X    ;; Otherwise, use another window for the mail buffer
X    ;; so that the Rmail buffer remains visible
X    ;; and sending the mail will get back to it.
X    (if (if (one-window-p t)
X	    (mail nil nil subject)
X	  (mail-other-window nil nil subject))
X	(save-excursion
X	  (goto-char (point-max))
X	  (forward-line 1)
X	  (mime-insert-message "message" "rfc822")
X	  (insert-buffer forward-buffer)))))
X
X(defun mime-forward-from-gnus-using-mail ()
X  "Forward current article in message/rfc822 content-type message from GNUS."
X  (let ((forward-buffer (current-buffer))
X	(subject
X	 (concat "[" gnus-newsgroup-name "] "
X		 ;;(mail-strip-quoted-names (gnus-fetch-field "From")) ": "
X		 (or (gnus-fetch-field "Subject") ""))))
X    ;; If only one window, use it for the mail buffer.
X    ;; Otherwise, use another window for the mail buffer
X    ;; so that the Rmail buffer remains visible
X    ;; and sending the mail will get back to it.
X    (if (if (one-window-p t)
X	    (mail nil nil subject)
X	  (mail-other-window nil nil subject))
X	(save-excursion
X	  (goto-char (point-max))
X	  (mime-insert-message "message" "rfc822")
X	  (insert-buffer forward-buffer)
X	  ;; You have a chance to arrange the message.
X	  (run-hooks 'gnus-mail-forward-hook)
X	  ))))
X
X(provide 'mime)
X
X;;; mime.el ends here
*-*-END-of-mime.el-*-*
echo x rmailmime.el
sed 's/^X//' > rmailmime.el << '*-*-END-of-rmailmime.el-*-*'
X;;; rmailmime.el --- Rmail: MIME message support.
X
X;; Copyright (C) 1993 Masanobu UMEDA
X
X;; Author: Masanobu UMEDA <umerin@mse.kyutech.ac.jp>
X;; Version: $Header: rmailmime.el,v 1.1 93/07/02 12:16:19 umerin Locked $
X;; Keywords: mail, mime
X
X;; This file is part of GNU Emacs.
X
X;; GNU Emacs is free software; you can redistribute it and/or modify
X;; it under the terms of the GNU General Public License as published by
X;; the Free Software Foundation; either version 2, or (at your option)
X;; any later version.
X
X;; GNU Emacs is distributed in the hope that it will be useful,
X;; but WITHOUT ANY WARRANTY; without even the implied warranty of
X;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
X;; GNU General Public License for more details.
X
X;; You should have received a copy of the GNU General Public License
X;; along with GNU Emacs; see the file COPYING.  If not, write to
X;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
X
X;;; Commentary:
X
X;; LCD Archive Entry:
X;; rmailmime|Masanobu UMEDA|umerin@mse.kyutech.ac.jp|
X;; Rmail: MIME message support.|
X;; $Date: 93/07/02 12:16:19 $|$Revision: 1.1 $|~/misc/rmailmime.el.Z|
X
X;; Usage examples:
X;; 
X;; To convert MIME headers into readable form automatically, set the
X;; variable rmail-message-filter to the function
X;; rmail-convert-mime-header as follows:
X;;	(setq rmail-message-filter 'rmail-convert-mime-header)
X;;
X;; To show MIME messages using metamail program, bind the command
X;; rmail-show-mime to some key in rmail mode.  The following example
X;; binds it to the key '!'.
X;;	(setq rmail-mode-hook
X;;	      '(lambda ()
X;;		 (local-set-key "!" 'rmail-show-mime)
X;;		 ))
X
X;;; Code:
X
X(require 'metamail)
X
X(defun rmail-show-mime ()
X  "Show MIME messages using temporary buffer in View mode."
X  (interactive)
X  (let ((tmpbuf (get-buffer-create "*metamail*")))
X    (metamail-region
X     (point-min) (point-max) tmpbuf)
X    (switch-to-buffer tmpbuf)
X    (view-buffer tmpbuf)
X    (goto-char (point-min))))
X
X(defun rmail-convert-mime-header ()
X  "Convert MIME headers of current message into readable form.
XOriginal headers are preserved.
XIt is expected to be used as rmail-message-filter."
X  (save-excursion
X    (let ((end (progn
X		 (goto-char (point-min))
X		 (search-forward "\n\n" nil t)
X		 (point))))
X      (if (save-restriction
X	    (narrow-to-region (point-min) end)
X	    (mail-fetch-field "Mime-Version"))
X	  (progn
X	    (metamail-region (point-min) end)
X	    ;; Remove an extra newline inserted by metamail.
X	    (goto-char (point-min))
X	    (if (search-forward "\n\n\n" nil t)
X		(delete-char -1))))
X      )))
X
X(provide 'rmailmime)
X
X;;; rmailsort.el ends here
*-*-END-of-rmailmime.el-*-*
exit 0
--
Masanobu UMEDA
umerin@mse.kyutech.ac.jp
Faculty of Computer Science and System Engineering
Kyushu Institute of Technology