๐Ÿš€ go-pugleaf

RetroBBS NetNews Server

Inspired by RockSolid Light RIP Retro Guy

Article View: gnu.emacs.sources
Article #355

Improved Emacs MIME tools: mime.el (part 1/2)

#355
From: Masanobu UMEDA
Date: Sat, 21 Aug 1993 12:22
1437 lines
51379 bytes
---- Cut Here and unpack ----
#!/bin/sh
# shar:	Shell Archiver  (v1.22)
#
# This is part 1 of a multipart archive                                    
# do not concatenate these parts, unpack them in order with /bin/sh        
#
#	Run the following text with /bin/sh to create:
#	  mime.el
#
if test -r s2_seq_.tmp
then echo "Must unpack archives in sequence!"
     next=`cat s2_seq_.tmp`; echo "Please unpack part $next next"
     exit 1; fi
sed 's/^X//' << 'SHAR_EOF' > mime.el &&
X;;; mime.el --- Simple MIME Composer for Emacs
X
X;; Copyright (C) 1993 Masanobu UMEDA
X
X;; Author: Masanobu UMEDA <umerin@mse.kyutech.ac.jp>
X;; Version: $Header: mime.el,v 1.60 93/08/21 19:40:55 umerin Locked $
X;; Keywords: mail, news, mime
X
X;; This file is not 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;; This is an Emacs minor mode for editing Internet multimedia
X;; messages formatted 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 composed in the
X;; tagged MIME format are automatically translated into a MIME
X;; compliant message when exiting the mode.
X
X;; Mule (a multilingual extension to Emacs 18) has a capability of
X;; handling multilingual text in limited ISO-2022 manner that is based
X;; on early experiences in Japanese Internet community and resulted in
X;; RFC1468 (ISO-2022-JP charset for MIME).  In order to enable
X;; multilingual capability in single text message in MIME, charset of
X;; multilingual text written in Mule is declared as `X-ISO-2022-JP-2'
X;; and such messages are encoded in Mule style.  Mule is required for
X;; reading the messages of `X-ISO-2022-JP-2' charset.  As it contains
X;; leading `X-', `X-ISO-2022-JP-2' charset is still experimental.  For
X;; more information on Mule, please make a contact to mule@etl.go.jp
X;; or mule-jp@etl.go.jp.
X
X;; This MIME composer can work with Mail mode, mh-e letter Mode, and
X;; News mode.  First of all, you need the following autoload
X;; definition to load mime-mode automatically:
X;;
X;; (autoload 'mime-mode "mime" "Minor mode for editing MIME message." t)
X;;
X;; In case of Mail mode (includes VM mode), you need the following
X;; hook definition:
X;;
X;; (setq mail-mode-hook
X;;       (list
X;;        (function
X;;         (lambda ()
X;;           (mime-mode)))))
X;;
X;; In case of MH-E, you need the following hook definition:
X;;
X;; (setq mh-letter-mode-hook
X;;       (list
X;;        (function
X;;         (lambda ()
X;;           (mime-mode)
X;;           (make-local-variable 'mail-header-separator)
X;;           (setq mail-header-separator "--------")))))
X;;
X;; In case of News mode, you need the following hook definition:
X;;
X;; (setq news-reply-mode-hook
X;;       (list
X;;        (function
X;;         (lambda ()
X;;           (mime-mode)))))
X;;
X;; Followings are for message forwarding as content-type
X;; "message/rfc822".
X;;
X;; (setq rmail-mode-hook
X;;       (list
X;;        (function
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;;       (list
X;;        (function
X;;         (lambda ()
X;;           ;; Forward article using MIME.
X;;           (require 'mime)
X;;           ))))
X;;
X;; In case of Emacs 19, it is possible to emphasize the message tags
X;; using font-lock mode as follows:
X;;
X;; (setq mime-mode-hook
X;;       (list
X;;        (function
X;;         (lambda ()
X;;           (font-lock-mode 1)
X;;           (setq font-lock-keywords (list mime-tag-regexp))))))
X
X;; The message tag looks like:
X;;
X;;	--[[TYPE/SUBTYPE;PARAMETERS][ENCODING]]
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][base64]]^M...image encoded in base64 comes here...
X;;
X;;--[[audio/basic][base64]]^M...audio encoded in base64 comes here...
X
X;; LCD Archive Entry:
X;; mime|Masanobu UMEDA|umerin@mse.kyutech.ac.jp|
X;; Simple MIME Composer|
X;; $Date: 93/08/21 19:40:55 $|$Revision: 1.60 $|~/misc/mime.el.Z|
X
X;;; Code:
X
X(require 'sendmail)
X(require 'mail-utils)
X(require 'metamail)
X
X(defvar mime-prefix "\C-c\C-x"
X  "*Keymap prefix for MIME commands.")
X
X(defvar mime-signature-file "~/.signature.rtf"
X  "*Signature file to be included as a part of a multipart message.")
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-ignore-same-text-tag t
X  "*Ignore preceding text content-type tag that is same with new one.
XIf non-nil, the text tag is not inserted unless something different.")
X
X(defvar mime-auto-fill-header t
X  "*Fill header fields that contain encoded-words if non-nil.")
X
X(defvar mime-auto-hide-body t
X  "*Hide non-textual body encoded in base64 after insertion if non-nil.")
X
X(defvar mime-header-charset-chooser
X  (cond ((boundp 'NEMACS)
X	 (function mime-header-charset-chooser-for-nemacs))
X	((featurep 'mule)
X	 (function mime-header-charset-chooser-for-mule))
X	((string-match "^19\\." emacs-version)
X	 (function mime-header-charset-chooser-for-emacs19))
X	(t				;ASCII only emacs
X	 (function mime-header-charset-chooser-for-emacs18)))
X  "*Function to identify charset and encoding of a header in a give region.
XThe value is a form of (CHARSET . ENCODING), where ENCODING is either
X'B' or 'Q'.  Nil means no encoding is necessary.")
X
X(defvar mime-body-charset-chooser
X  (cond ((boundp 'NEMACS)
X	 (function mime-body-charset-chooser-for-nemacs))
X	((featurep 'mule)
X	 (function mime-body-charset-chooser-for-mule))
X	((string-match "^19\\." emacs-version)
X	 (function mime-body-charset-chooser-for-emacs19))
X	(t				;ASCII only emacs
X	 (function mime-body-charset-chooser-for-emacs18)))
X  "*Function to identify charset and encoding of a text in a given region.
XThe value is a form of (CHARSET . ENCODING), where ENCODING must be a
Xfull name, such as base64.")
X
X(defvar mime-string-encoder
X  (cond ((boundp 'NEMACS)
X	 (function mime-string-encoder-for-nemacs))
X	((featurep 'mule)
X	 (function mime-string-encoder-for-mule))
X	((string-match "^19\\." emacs-version)
X	 (function mime-string-encoder-for-emacs19))
X	(t				;ASCII only emacs
X	 (function mime-string-encoder-for-emacs18)))
X  "*Function to encode a string for given encoding method.
XThe method is a form of (CHARSET . ENCODING).")
X
X(defvar mime-voice-recorder
X  (function mime-voice-recorder-for-sun)
X  "*Function to record a voice message and return a buffer that contains it.")
X
X(defvar mime-mode-hook nil
X  "*Hook called when enter MIME mode.")
X
X(defvar mime-translate-hook nil
X  "*Hook called before translating into a MIME compliant message.
XTo insert a signature file specified by mime-signature-file
X(`.signature.rtf' by default) automatically, call the function
X`mime-insert-signature' from this hook.")
X
X(defvar mime-exit-hook nil
X  "*Hook called when exit MIME mode.")
X
X(defvar mime-content-types
X  '(("text"
X     ;; Charset parameter need not to be specified, since it is
X     ;; defined automatically while translation.
X     ("plain"
X      ;;("charset" "" "ISO-2022-JP" "US-ASCII" "ISO-8859-1" "ISO-8859-8")
X      )
X     ("richtext"
X      ;;("charset" "" "ISO-2022-JP" "US-ASCII" "ISO-8859-1" "ISO-8859-8")
X      ))
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     ("octet-stream"
X      ("name")
X      ("type" "" "tar" "shar")
X      ("conversions"))
X     ("postscript"))
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, parameters and its values.")
X
X(defvar mime-file-types
X  '(("\\.rtf$"	"text"	"richtext"	nil	nil)
X    ("\\.ps$"	"application"	"postscript"	nil	"quoted-printable")
X    ("\\.gif$"	"image"		"gif"	nil	"base64")
X    ("\\.jpg$"	"image"		"jpeg"	nil	"base64")
X    ("\\.xwd$"	"image"		"x-xwd"	nil	"base64")
X    ("\\.xbm$"	"image"		"x-xbm"	nil	"base64")
X    ("\\.au$"	"audio"		"basic"	nil	"base64")
X    ("\\.mpg$"	"video"		"mpeg"	nil	"base64")
X    (".*"	nil		nil	nil	nil))
X  "*Alist of file name, types, parameters, and default encoding.
XIf encoding is nil, it is determined from its contents.")
X
X(defvar mime-transfer-encoders
X  '(("base64"			"mmencode")
X    ("quoted-printable"		"mmencode" "-q")
X    ("7bit"			nil)	;Default
X    ("8bit"			nil)
X    ("binary"			nil))
X  "*Alist of a canonical encoding name, and encoder and optional arguments.
XContent transfer encoder is either a command string or a function
Xsymbol or a lambda list that takes two arguments.  If it is nil, no
Xconversion is necessary.")
X
X(defvar mime-transfer-decoders
X  '(("base64"			"mmencode" "-u")
X    ("quoted-printable"		"mmencode" "-q" "-u")
X    ("7bit"			nil)	;Default
X    ("8bit"			nil)
X    ("binary"			nil))
X  "*Alist of a canonical encoding name, and decoder and optional arguments.
XContent transfer decoder is either a command string or a function
Xsymbol or a lambda list that takes two arguments.  If it is nil, no
Xconversion is necessary.")
X
X(defvar mime-encoding-cnames
X  '(("b"	"base64")
X    ("q"	"quoted-printable"))
X  "*Alist of a short encoding name used in headers and its canonical name.")
X
X(defvar mime-message-handlers
X  '(("text/plain"		t)
X    ;;("text/richtext"		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-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 in header must be quoted.")
X
X(defvar mime-tag-regexp "^--[[][[]\\([^]]*\\)]\\([[]\\([^]]*\\)]\\|\\)]"
X  "*Regexp of MIME tag in the form of [[CONTENT-TYPE][ENCODING]].")
X
X(defvar mime-tag-format "--[[%s]]"
X  "*Control-string making a MIME tag.")
X
X(defvar mime-tag-format-with-encoding "--[[%s][%s]]"
X  "*Control-string making a MIME tag with encoding.")
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-i" 'mime-insert-file)
X    (define-key keymap "\C-e" 'mime-insert-external)
X    (define-key keymap "\C-v" 'mime-insert-voice)
X    (define-key keymap "\C-w" 'mime-insert-signature)
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(defun mime-define-menu-for-emacs19 ()
X  "Define menu for Emacs 19."
X  (define-key (current-local-map) [menu-bar mime]
X    (cons "MIME" (make-sparse-keymap "MIME")))
X  (define-key (current-local-map) [menu-bar mime help]
X    '("Describe MIME Mode" . help-mime-mode))
X  (define-key (current-local-map) [menu-bar mime preview]
X    '("Preview Content" . mime-preview-content))
X  (define-key (current-local-map) [menu-bar mime signature]
X    '("Insert Signature" . mime-insert-signature))
X  (define-key (current-local-map) [menu-bar mime voice]
X    '("Insert Voice" . mime-insert-voice))
X  (define-key (current-local-map) [menu-bar mime external]
X    '("Insert External" . mime-insert-external))
X  (define-key (current-local-map) [menu-bar mime file]
X    '("Insert File" . mime-insert-file))
X  (define-key (current-local-map) [menu-bar mime text]
X    '("Insert Text" . mime-insert-text)))
X
X;;;###autoload
X(defun mime-mode ()
X  "MIME minor mode for editing the tagged MIME message.
X
XIn this mode, basically, the message is composed in the tagged MIME
Xformat.  The message tag looks like:
X
X	`--[[text/plain; charset=ISO-2022-JP][7bit]]'.
X
XThe tag specifies the MIME content type, subtype, optional parameters
Xand transfer encoding of the message following the tag.  Messages
Xwithout any tag are treated as `text/plain' by default.  Charset and
Xtransfer encoding are automatically defined unless explicitly
Xspecified.  Binary messages such as audio and image are usually hidden
Xusing selective-display facility.  The messages in the tagged MIME
Xformat are automatically translated into a MIME compliant message when
Xexiting this mode.
X
XAvailable charsets depend on Emacs version being used.  The following
Xlists the available charsets of each emacs.
X
XEmacs18:	US-ASCII is only available.
XNEmacs:		US-ASCII and ISO-2022-JP are available.
XEmacs19:	US-ASCII and ISO-8859-1 are available.
XMule:		US-ASCII, ISO-8859-* (except for ISO-8859-6),
X		ISO-2022-JP, and X-ISO-2022-JP-2 are available.
X
XX-ISO-2022-JP-2 charset used in Mule is experimental and expected to
Xbe used to represent multilingual text in intermixed manner.  Any
Xlanguages that has no registered charset are also represented as
XX-ISO-2022-JP-2 in Mule.
X
XFollowing commands are available in addition to major mode commands:
X\\[mime-insert-text]	insert a text message.
X\\[mime-insert-file]	insert a (binary) file.
X\\[mime-insert-external]	insert a reference to external body.
X\\[mime-insert-voice]	insert a voice message.
X\\[mime-insert-signature]	insert a signature file at end.
X\\[mime-preview-content]	preview an included content.
X\\[mime-mode-exit]	exit and translate into a MIME compliant message.
X\\[mime-mode-exit-and-run]		exit, translate and run the original command.
X\\[help-mime-mode]	show this help.
X
XAdditional commands are available in some major modes:
XC-c C-c		exit, translate and run the original command.
XC-c C-s		exit, translate and run the original command.
X
XThe following is a message example written in the tagged MIME format.
XTABs at the 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][base64]]^M...image encoded in base64 here...
X	--[[audio/basic][base64]]^M...audio encoded in base64 here...
X
XUser customizable variables (not documented all of them):
X mime-prefix
X    Specifies a key prefix for MIME minor mode commands.
X
X mime-signature-file
X    Specifies a signature file to be included as part of a multipart
X    message.
X
X mime-ignore-preceding-spaces
X    Preceding white spaces in a message body are ignored if non-nil.
X
X mime-ignore-trailing-spaces
X    Trailing white spaces in a message body are ignored if non-nil.
X
X mime-auto-fill-header
X    Fill header fields that contain encoded-words if non-nil.
X
X mime-auto-hide-body
X    Hide a non-textual body message encoded in base64 after insertion
X    if non-nil.
X
X mime-header-charset-chooser
X    Specifies a function to identify charset and encoding of a text in
X    a give region of header fields.  The value is a form of (CHARSET . 
X    ENCODING), where ENCODING is either 'B' or 'Q'.  Nil means no
X    encoding is necessary.
X
X mime-body-charset-chooser
X    Specifies a function to identify charset and encoding of a text in
X    a given region.  The value is a form of (CHARSET . ENCODING),
X    where ENCODING must be a full name, such as base64.
X
X mime-string-encoder
X    Specifies a function to encode a string for given encoding method.
X    The method is a form of (CHARSET . ENCODING).
X
X mime-voice-recorder
X    Specifies a function to record a voice message and return a buffer
X    that contains it.  The function mime-voice-recorder-for-sun is for
X    Sun SparcStations.
X
X mime-mode-hook
X    Turning on MIME mode calls the value of mime-mode-hook, if it is
X    non-nil.
X
X mime-translate-hook
X    The value of mime-translate-hook is called just before translating
X    the tagged MIME format into a MIME compliant message if it is
X    non-nil.  If the hook call the function mime-insert-signature, the
X    signature file will be inserted automatically.
X
X mime-exit-hook
X    Turning off MIME mode calls the value of mime-exit-hook, if it is
X    non-nil."
X  (interactive)
X  (if mime-mode-flag
X      (error "You are already editing a MIME message.")
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    ;; Replace key definitions to avoid sending a message without
X    ;; conversion into a MIME compliant message.
X    (let ((keymap nil)
X          (keymaps (accessible-keymaps (current-local-map))))
X      (while keymaps
X        (setq keymap (cdr (car keymaps)))
X        (setq keymaps (cdr keymaps))
X        (if (not (keymapp keymap))
X            nil
X          ;; Mail mode:
X          (substitute-key-definition
X           'mail-send 'mime-mode-exit-and-run keymap)
X          (substitute-key-definition
X           'mail-send-and-exit 'mime-mode-exit-and-run keymap)
X          ;; mh-e letter mode:
X          (substitute-key-definition
X           'mh-send-letter 'mime-mode-exit-and-run keymap)
X	  ;; Mail mode called from VM:
X	  (substitute-key-definition
X	   'vm-mail-send 'mime-mode-exit-and-run keymap)
X	  (substitute-key-definition
X	   'vm-mail-send-and-exit 'mime-mode-exit-and-run keymap)
X          ;; News mode:
X          (substitute-key-definition
X           'news-inews 'mime-mode-exit-and-run keymap)
X          )))
X    ;; Define menu.  Menus for other emacs implementations are
X    ;; welcome.
X    (cond ((string-match "^19\\." emacs-version)
X	   (mime-define-menu-for-emacs19)))
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] to exit MIME mode, and type \\[help-mime-mode] to get help."))
X    ))
X
X;;;###autoload
X(fset 'edit-mime 'mime-mode)		; for convenience
X
X(defun mime-mode-exit (&optional nomime)
X  "Translate the tagged MIME message into a 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 message.")
X    (if (not nomime)
X	(progn
X	  (run-hooks 'mime-translate-hook)
X	  (mime-translate-buffer)))
X    ;; Restore previous state.
X    (setq mime-mode-flag nil)
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    (run-hooks 'mime-exit-hook)
X    (message "Exit MIME mode.")
X    ))
X
X(defun mime-mode-exit-and-run ()
X  "Run a command bound to the same key on old keymap after the translation."
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 a text message.
XCharset is automatically obtained from the mime-body-charset-chooser."
X  (interactive)
X  (if (and (mime-insert-tag "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-file (file)
X  "Insert a message from a file."
X  (interactive "fInsert file as MIME message: ")
X  (let*  ((guess (mime-find-file-type file))
X	  (pritype (nth 0 guess))
X	  (subtype (nth 1 guess))
X	  (parameters (nth 2 guess))
X	  (default (nth 3 guess))	;Guess encoding from its file name.
X	  (encoding
X	   (if (not (interactive-p))
X	       default
X	     (completing-read
X	      (concat "What transfer encoding"
X		      (if default
X			  (concat " (default "
X				  (if (string-equal default "") "\"\"" default)
X				  ")"
X				  ))
X		      ": ")
X	      mime-transfer-encoders nil t nil))))
X    (if (string-equal encoding "")
X	(setq encoding default))
X    (mime-insert-tag pritype subtype parameters)
X    (mime-insert-binary-file file encoding)))
X
X(defun mime-insert-external ()
X  "Insert a reference to external body."
X  (interactive)
X  (mime-insert-tag "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	 (parameters (mime-prompt-for-parameters pritype subtype ";\n\t")))
X    (and pritype
X	 subtype
X	 (insert "Content-Type: "
X		 pritype "/" subtype (or parameters "") "\n")))
X  (if (and (not (eobp))
X	   (not (looking-at mime-tag-regexp)))
X      (insert (mime-make-text-tag) "\n")))
X
X(defun mime-insert-voice ()
X  "Insert a voice message."
X  (interactive)
X  (mime-insert-tag "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-signature ()
X  "Insert a signature file specified by mime-signature-file."
X  (interactive)
X  (let ((file (expand-file-name mime-signature-file)))
X    (if (file-exists-p file)
X	(progn
X	  (goto-char (point-max))
X	  (if (not (bolp))		;Make sure the end of message.
X	      (insert "\n"))
X	  (mime-insert-file file)))))
X
X(defun mime-preview-content ()
X  "Preview an included message content around point through metamail."
X  (interactive)
X  (let ((tag nil)
X	(handler nil)
X	(beg nil)
X	(end nil))
X    (save-excursion
X      (if (mime-goto-tag)
X	  (progn
X	    (setq tag (buffer-substring (match-beginning 0) (match-end 0)))
X	    (setq handler (mime-find-handler
X			   (mime-strip-parameters
X			    (mime-get-contype tag))))
X	    (setq beg (point))
X	    (setq end (mime-content-end))
X	    )))
X    (if tag
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      (ding) (message "No messages to preview around here.")
X      )))
X
X
X;; Insert a new tag around a point.
X
X(defun mime-insert-tag (&optional pritype subtype parameters delimiter)
X  "Insert new MIME tag and return a list of PRITYPE, SUBTYPE, and PARAMETERS.
XIf nothing is inserted, return nil."
X  (let ((oldtag nil)
X	(newtag nil)
X	(current (point)))
X    (setq pritype
X	  (or pritype
X	      (mime-prompt-for-type)))
X    (setq subtype
X	  (or subtype
X	      (mime-prompt-for-subtype pritype)))
X    (setq parameters
X	  (or parameters
X	      (mime-prompt-for-parameters pritype subtype delimiter)))
X    ;; Make a new MIME tag.
X    (setq newtag (mime-make-tag pritype subtype parameters))
X    ;; Find an current MIME tag.
X    (setq oldtag
X	  (save-excursion
X	    (if (mime-goto-tag)
X		(buffer-substring (match-beginning 0) (match-end 0))
X	      ;; Assume content type is 'text/plan'.
X	      (mime-make-tag "text" "plain")
X	      )))
X    ;; We are only interested in TEXT.
X    (if (and oldtag
X	     (not (mime-test-content-type (mime-get-contype oldtag) "text")))
X	(setq oldtag nil))
X    (beginning-of-line)
X    (cond ((and oldtag			;Text
X		(not (eobp))
X		(save-excursion
X		  (forward-line -1)
X		  (looking-at mime-tag-regexp))
X		(or mime-ignore-same-text-tag
X		    (not (string-equal oldtag newtag))))
X	   ;; If point is at the next of current tag, move to the
X	   ;; beginning of the tag to disable insertion of extra tag.
X	   (forward-line -1))
X	  ((and oldtag			;Text
X		(not (eobp))
X		(not (looking-at mime-tag-regexp))
X		(or mime-ignore-same-text-tag
X		    (not (string-equal oldtag newtag))))
X	   ;; Copy current tag to break a text into two.
X	   (save-excursion
X	     (insert oldtag "\n")))
X	  ((and (null oldtag)		;Not text
X		(not (looking-at mime-tag-regexp)))
X	   ;; Adjust insertion point.  In the middle of text, it is
X	   ;; okay to break the text into two.  However, it should not
X	   ;; be broken into two, if otherwise.
X	   (goto-char (mime-content-end))
X	   (if (eolp)
X	       (forward-line 1))
X	   (if (not (bolp))
X	       (insert "\n"))
X	   ))
X    ;; Make a new tag.
X    (if (or (not oldtag)		;Not text
X	    (or mime-ignore-same-text-tag
X		(not (string-equal oldtag newtag))))
X	(progn
X	  ;; Mark the beginning of the tag for convenience.
X	  (push-mark (point) 'nomsg)
X	  (insert newtag "\n")
X	  (list pritype subtype parameters) ;New tag is created.
X	  )
X      ;; Restore previous point.
X      (goto-char current)
X      nil				;Nothing is created.
X      )
X    ))
X
X;; Insert the binary content after MIME tag.
X
X(defun mime-insert-binary-file (file &optional encoding)
X  "Insert binary FILE at point.
XOptional argument ENCODING specifies an encoding method such as base64."
X  (let ((tmpbuf (get-buffer-create " *MIME insert*")))
X    (save-excursion
X      (set-buffer tmpbuf)
X      (erase-buffer)
X      (let ((mc-flag nil)		;Mule
X	    (kanji-flag nil))		;NEmacs
X	(insert-file-contents file)))
X    (prog1
X	(mime-insert-binary-buffer tmpbuf encoding)
X      (kill-buffer tmpbuf))))
X
X(defun mime-insert-binary-buffer (buffer &optional encoding)
X  "Insert binary BUFFER at point.
XOptional argument ENCODING specifies an encoding method such as base64."
X  (let* ((tagend (1- (point)))		;End of the tag
X	 (hide-p (and mime-auto-hide-body
X		      (stringp encoding)
X		      (string-equal (downcase encoding) "base64"))))
X    (save-restriction
X      (narrow-to-region (1- (point)) (point))
X      (let ((start (point)))
X	(insert-buffer-substring buffer)
X	;; Encode binary message if necessary.
X	(if encoding
X	    (mime-encode-region encoding start (point-max))))
X      (if hide-p
X	  (progn
X	    (mime-flag-region (point-min) (1- (point-max)) ?\^M)
X	    (goto-char (point-max)))
X	))
X    ;; Define encoding even if it is 7bit.
X    (if (stringp encoding)
X	(save-excursion
X	  (goto-char tagend)		;Make sure which line the tag is on.
X	  (mime-define-encoding encoding)))
X    ))
X
X(defun mime-run-metamail (begin end)
X  "Run metamail on a tagged MIME message from BEGIN to END."
X  (let ((msgbuf (current-buffer)))
X    (set-buffer (get-buffer-create "*Previewing MIME message*"))
X    (setq buffer-read-only nil)
X    (erase-buffer)
X    (insert-buffer-substring msgbuf begin end)
X    ;; Imitate mail mode buffer.
X    (goto-char (point-min))
X    (insert "Content-Description: Previewing current message.\n"
X	    mail-header-separator "\n")
X    ;; Then translate it into a MIME compliant message.
X    (mime-translate-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 contents using metamail.
X    ;; We are interested in its body.
X    (metamail-interpret-body)
X    (view-buffer (current-buffer))
X    ))
X
X
X;; Commands work on a current message flagment.
X
X(defun mime-goto-tag ()
X  "Search for the beginning of the tagged MIME message."
X  (let ((current (point)))
X    (if (looking-at mime-tag-regexp)
X	t
X      ;; At first, go to the end.
X      (if (re-search-forward mime-tag-regexp nil t)
X	  (progn
X	    (goto-char (match-beginning 0)) ;For multiline tag
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      (or (looking-at mime-tag-regexp)
X	  ;; Restore previous point.
X	  (progn
X	    (goto-char current)
X	    nil
X	    ))
X      )))
X
X(defun mime-content-beginning ()
X  "Return the point of the beginning of content."
X  (save-excursion
X    (let ((beg (save-excursion
X		 (beginning-of-line) (point))))
X      (if (mime-goto-tag)
X	  (let ((top (point)))
X	    (goto-char (match-end 0))
X	    (if (and (= beg top)
X		     (= (following-char) ?\^M))
X		(point)
X	      (forward-line 1)
X	      (point)))
X	;; Default text/plain tag.
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      )))
X
X(defun mime-content-end ()
X  "Return the point of the end of content."
X  (save-excursion
X    (let ((beg (save-excursion
X		 (beginning-of-line) (point))))
X      (if (mime-goto-tag)
X	  (let ((top (point)))
X	    (goto-char (match-end 0))
X	    (if (and (= beg top)	;Must be on the same line.
X		     (= (following-char) ?\^M))
X		(progn
X		  (end-of-line)
X		  (point))
X	      ;; Move to the end of this text.
X	      (if (re-search-forward mime-tag-regexp nil 'move)
X		  ;; Don't forget a multiline tag.
X		  (goto-char (match-beginning 0)))
X	      (point)
X	      ))
X	;; Assume the message begins with text/plain.
X	(goto-char (mime-content-beginning))
X	(if (re-search-forward mime-tag-regexp nil 'move)
X	    ;; Don't forget a multiline tag.
X	    (goto-char (match-beginning 0)))
X	(point))
X      )))
X
X(defun mime-define-charset (charset)
X  "Set charset of current tag to CHARSET."
X  (save-excursion
X    (if (mime-goto-tag)
X	(let ((tag (buffer-substring (match-beginning 0) (match-end 0))))
X	  (delete-region (match-beginning 0) (match-end 0))
X	  (insert
X	   (mime-create-tag (mime-set-parameter
X			     (mime-get-contype tag) "charset" charset)
X			    (mime-get-encoding tag))))
X      )))
X
X(defun mime-define-encoding (encoding)
X  "Set encoding of current tag to ENCODING."
X  (save-excursion
X    (if (mime-goto-tag)
X	(let ((tag (buffer-substring (match-beginning 0) (match-end 0))))
X	  (delete-region (match-beginning 0) (match-end 0))
X	  (insert (mime-create-tag (mime-get-contype tag) encoding)))
X      )))
X
X(defun mime-choose-charset ()
X  "Choose charset of a text following current point."
X  (save-excursion
X    (let* ((beg (point))
X	   (end (mime-content-end)))
X      (car (funcall mime-body-charset-chooser beg end)))))
X
X(defun mime-choose-encoding ()
X  "Choose encoding of a text following current point."
X  (save-excursion
X    (let* ((beg (point))
X	   (end (mime-content-end)))
X      (cdr (funcall mime-body-charset-chooser beg end)))))
X
X(defun mime-make-text-tag (&optional subtype)
X  "Make a tag for a text after current point.
XSubtype of text type can be specified by an optional argument SUBTYPE.
XOtherwise, it is obtained from mime-content-types."
X  (let* ((pritype "text")
X	 (subtype (or subtype
X		      (car (car (cdr (assoc pritype mime-content-types)))))))
X    ;; Charset should be defined later.
X    (mime-make-tag pritype subtype)))
X
X
X;; Tag handling functions
X
X(defun mime-make-tag (pritype subtype &optional parameters encoding)
X  "Make a tag of MIME message of PRITYPE, SUBTYPE and optional PARAMETERS."
X  (mime-create-tag (concat (or pritype "") "/" (or subtype "")
X			   (or parameters ""))
X		   encoding))
X
X(defun mime-create-tag (contype &optional encoding)
X  "Make a tag with CONTENT-TYPE and optional ENCODING."
X  (format (if encoding mime-tag-format-with-encoding mime-tag-format)
X	  contype encoding))
X
X(defun mime-get-contype (tag)
X  "Return Content-Type (including parameters) of TAG."
X  (and (stringp tag)
X       (string-match mime-tag-regexp tag)
X       (substring tag (match-beginning 1) (match-end 1))))
X
X(defun mime-get-encoding (tag)
X  "Return encoding of TAG."
X  (and (stringp tag)
X       (string-match mime-tag-regexp tag)
X       (match-beginning 3)
X       (not (= (match-beginning 3) (match-end 3)))
X       (substring tag (match-beginning 3) (match-end 3))))
X
X(defun mime-get-parameter (contype parameter)
X  "For given CONTYPE return value for PARAMETER.
XNil if no such parameter."
X  (if (string-match
X       (concat
X	";[ \t\n]*"
X	(regexp-quote parameter)
X	"[ \t\n]*=[ \t\n]*\\([^\" \t\n;]*\\|\"[^\"]*\"\\)\\([ \t\n]*;\\|$\\)")
X       contype)
X      (substring contype (match-beginning 1) (match-end 1))
X    nil					;No such parameter
X    ))
X
X(defun mime-set-parameter (contype parameter value)
X  "For given CONTYPE set PARAMETER to VALUE."
X  (if (string-match
X       (concat
X	";[ \t\n]*\\("
X	(regexp-quote parameter)
X	"[ \t\n]*=[ \t\n]*\\([^\" \t\n;]*\\|\"[^\"]*\"\\)\\)[ \t\n]*\\(;\\|$\\)")
X       contype)
X      ;; Change value
X      (concat (substring contype 0 (match-beginning 1))
X	      parameter "=" value
X	      (substring contype (match-end 1)))
X    (concat contype "; " parameter "=" value)))
X
X(defun mime-strip-parameters (contype)
X  "Return primary content-type and subtype without parameters for CONTYPE."
X  (if (string-match "^[ \t]*\\([^; \t\n]*\\)" contype)
X      (substring contype (match-beginning 1) (match-end 1)) nil))
X
X(defun mime-test-content-type (contype type &optional subtype)
X  "Test if CONTYPE is a TYPE and an optional SUBTYPE."
X  (and (stringp contype)
X       (string-match
X	(concat "^[ \t]*" type "/" (or subtype "")) contype)))
X
X
X;; Basic functions
X
X(defun mime-find-encoder (encoding)
X  "Return message transfer encoder for ENCODING."
X  (and (stringp encoding)
X       (let* ((encoding
X	       (or (nth 1 (assoc (downcase encoding) mime-encoding-cnames))
X		   encoding))
X	      (encoder
X	       (cdr (assoc (downcase encoding) mime-transfer-encoders))))
X	 ;; (nil) means there is no encoder.
X	 (if (and (consp encoder)
X		  (null (car encoder)))
X	     nil encoder
X	     ))))
X
X(defun mime-find-decoder (encoding)
X  "Return message transfer decoder for ENCODING."
X  (and (stringp encoding)
X       (let* ((encoding
X	       (or (nth 1 (assoc (downcase encoding) mime-encoding-cnames))
X		   encoding))
X	      (decoder
X	       (cdr (assoc (downcase encoding) mime-transfer-decoders))))
X	 ;; (nil) means there is no decoder.
X	 (if (and (consp decoder)
X		  (null (car decoder)))
X	     nil decoder
X	     ))))
X
X(defun mime-find-file-type (file)
X  "Guess Content-Type, subtype, and parameters 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 (stringp type)
X       (let ((pair (assoc (downcase type) mime-message-handlers)))
X	 (if pair
X	     (nth 1 pair)
X	   ;; Search default if no entry.
X	   (nth 1 (assoc t mime-message-handlers))))))
X
X(defun mime-prompt-for-type ()
X  "Ask for Content-type."
X  (let ((type ""))
X    ;; Repeat until primary content type is specified.
X    (while (string-equal type "")
X      (setq type
X	    (completing-read "What content type: "
X			     mime-content-types
X			     nil
X			     'require-match ;Type must be specified.
X			     nil
X			     ))
X      (if (string-equal type "")
X	  (progn
X	    (message "Content type is required.")
X	    (beep)
X	    (sit-for 1)
X	    ))
X      )
X    type
X    ))
X
X(defun mime-prompt-for-subtype (pritype)
X  "Ask for Content-type subtype of Content-Type PRITYPE."
X  (let* ((default (car (car (cdr (assoc pritype mime-content-types)))))
X	 (answer
X	  (completing-read
X	   (if default
X	       (concat
X		"What content subtype: (default " default ") ")
X	     "What content subtype: ")
X	   (cdr (assoc pritype mime-content-types))
X	   nil
X	   'require-match		;Subtype must be specified.
X	   nil
X	   )))
X    (if (string-equal answer "") default answer)))
X
X(defun mime-prompt-for-parameters (pritype subtype &optional delimiter)
X  "Ask for Content-type parameters of Content-Type PRITYPE and SUBTYPE.
XOptional DELIMITER specifies parameter delimiter (';' by default)."
X  (let* ((delimiter (or delimiter "; "))
X	 (parameters
X	  (mapconcat
X	   (function identity)
X	   (delq nil
X		 (mime-prompt-for-parameters-1
X		  (cdr (assoc subtype
X			      (cdr (assoc pritype mime-content-types))))))
X	   delimiter
X	   )))
X    (if (and (stringp parameters)
X	     (not (string-equal parameters "")))
X	(concat delimiter parameters)
X      ""				;"" if no parameters
X      )))
X
X(defun mime-prompt-for-parameters-1 (optlist)
X  (apply (function append)
X	 (mapcar (function mime-prompt-for-parameter) optlist)))
X
X(defun mime-prompt-for-parameter (parameter)
X  "Ask for PARAMETER.
XParameter must be '(PROMPT CHOICE1 (CHOISE2 ...))."
X  (let* ((prompt (car parameter))
X	 (choices (mapcar (function
X			   (lambda (e)
X			     (if (consp e) e (list e))))
X			  (cdr parameter)))
X	 (default (car (car choices)))
X	 (answer nil))
X    (if choices
X	(progn
X	  (setq answer
X		(completing-read
X		 (concat "What " 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 "What " 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-parameters-1 (cdr (assoc answer (cdr parameter)))))
X    ))
X
X(defun mime-encode-string (encoding string)
X  "Using ENCODING encode a STRING.
XIf the STRING is too long, the encoded string may be broken into
Xseveral lines."
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    (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-encode-region (encoding begin end)
X  "Encode current buffer using transfer ENCODING from BEGIN to END."
X  (interactive
X   (list (completing-read "Choose transfer encoding: "
X			  mime-transfer-encoders nil 'req)
X	 (region-beginning) (region-end)))
X  (save-excursion
X    (save-restriction
X      (narrow-to-region begin end)
X      (let ((encoder (mime-find-encoder encoding)))
X	(cond ((and (consp encoder)
X		    (stringp (car encoder)))
X	       ;; BUG: kanji-flag must be localized.
X	       (let ((selective-display nil) ;Disable ^M to nl translation.
X		     (mc-flag nil)	;Mule
X		     (kanji-flag nil))	;NEmacs
X		 ;; Disable automatic conversion of coding system if Mule.
X		 (if (featurep 'mule)
X		     (define-program-coding-system nil (car encoder) *noconv*))
X		 (apply (function call-process-region)
X			(point-min) (point-max)
X			(car encoder)
X			t		;Delete the text
X			t		;Output to current buffer
X			nil		;No display
X			(cdr encoder))))
X	      (encoder
X	       (funcall encoder (point-max) (point-min))))
X	))))
X
X(defun mime-decode-region (encoding begin end)
X  "Decode current buffer using transfer ENCODING from BEGIN to END."
X  (interactive
X   (list (completing-read "Choose transfer encoding: "
X			  mime-transfer-decoders nil 'req)
X	 (region-beginning) (region-end)))
X  (save-excursion
X    (save-restriction
X      (narrow-to-region begin end)
X      (let ((decoder (mime-find-decoder encoding)))
X	(cond ((and (consp decoder)
X		    (stringp (car decoder)))
X	       ;; BUG: kanji-flag must be localized.
X	       (let ((selective-display nil) ;Disable ^M to nl translation.
X		     (mc-flag nil)	;Mule
X		     (kanji-flag nil))	;NEmacs
X		 ;; Disable automatic conversion of coding system if Mule.
X		 (if (featurep 'mule)
X		     (define-program-coding-system nil (car decoder) *noconv*))
X		 (apply (function call-process-region)
X			(point-min) (point-max)
X			(car decoder)
X			t		;Delete the text
X			t		;Output to current buffer
X			nil		;No display
X			(cdr decoder))))
X	      (decoder
X	       (funcall decoder (point-min) (point-max))))
X	))))
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
X;; Translate the tagged MIME messages into a MIME compliant message.
X
X(defun mime-translate-buffer ()
X  "Encode the tagged MIME message in current buffer in MIME compliant message."
X  (interactive)
X  (mime-translate-header)
X  (mime-translate-body))
X
X(defun mime-translate-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-charset-chooser beg end)
X	      (let* ((string (buffer-substring beg end))
X		     (newstr (mime-translate-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			  (progn
X			    (fill-region-as-paragraph beg (1+ (point)))
X			    ;; If word is long, the first line may
X			    ;; contain only white spaces.  This causes
X			    ;; troubles.
X			    (goto-char beg)
X			    (if (looking-at "[ \t]*\n[ \t]")
X				(replace-match ""))
X			    ))
X		      ))))
X	  ))
X      )))
X
X(defun mime-translate-header-string (string)
X  "Encode STRING suitable for use 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-charset-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		    (mime-encode-header-string
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-encode-header-string (method string)
X  "For given encoding METHOD encode STRING for use in header."
X  (let* ((charset (car method))
X	 (encoding (cdr method))
X	 (qp (string-equal (downcase encoding) "q"))) ;quoted-printable?
X    (cond ((and (stringp charset)
SHAR_EOF
echo "End of part 1, continue with part 2"
echo "2" > s2_seq_.tmp
exit 0
--
Masanobu UMEDA
umerin@mse.kyutech.ac.jp
Faculty of Computer Science and System Engineering
Kyushu Institute of Technology
Technical Details
Message-ID: <UMERIN.93Aug21212259@orchid.mse.kyutech.ac.jp>
Path: arc1-ca.pugleaf.net!gmd.de!Germany.EU.net!mcsun!uunet!ccut!news.u-tokyo.ac.jp!wnoc-tyo-news!sh.wide!wnoc-kyo!kyu-cs!wnoc-fukuoka-news!shiwasu!shiwasu!umerin
References: <UMERIN.93Aug21210519@orchid.mse.kyutech.ac.jp>

Show Full Headers
Complete Article Headers
X-Google-Language: Japanese,JIS
X-Google-Thread: 10160c,18cea89dfaa710c0,start
X-Google-Attributes: gid10160c,public
X-Google-Thread: 107729,de723f7325371838
X-Google-Attributes: gid107729,public
X-Google-ArrivalTime: 1993-08-21 05:52:40 PST
Newsgroups: gnu.emacs.sources,fj.sources
Path: arc1-ca.pugleaf.net!gmd.de!Germany.EU.net!mcsun!uunet!ccut!news.u-tokyo.ac.jp!wnoc-tyo-news!sh.wide!wnoc-kyo!kyu-cs!wnoc-fukuoka-news!shiwasu!shiwasu!umerin
From: umerin@mse.kyutech.ac.jp (Masanobu UMEDA)
Subject: Improved Emacs MIME tools: mime.el (part 1/2)
Content-Type: text/plain; charset=ISO-2022-JP
References: <UMERIN.93Aug21210519@orchid.mse.kyutech.ac.jp>
Sender: news@shiwasu.isci.kyutech.ac.jp
Mime-Version: 1.0
Organization: Department of Mechanical System Engineering, Kyutech, Japan
Date: Sat, 21 Aug 1993 12:22:59 GMT
Message-ID: <UMERIN.93Aug21212259@orchid.mse.kyutech.ac.jp>
Reply-To: umerin@mse.kyutech.ac.jp
Lines: 1437