Article View: gnu.emacs.sources
Article #355Improved Emacs MIME tools: mime.el (part 1/2)
From: Masanobu UMEDA
Date: Sat, 21 Aug 1993 12:22
Date: Sat, 21 Aug 1993 12:22
1437 lines
51379 bytes
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!umerinReferences:
<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