From 7ea8c7377706103d8f9afc39e3f29e5454ef6404 Mon Sep 17 00:00:00 2001
From: morioka <morioka>
Date: Mon, 2 Mar 1998 13:54:34 +0000
Subject: [PATCH] tm 5.18

---
 Makefile         |    4 +-
 Makefile.19      |   21 ++-
 doc/tl-jp.texi   |  548 ++++++++++++++++++++++++++++++++++++++++++++++++++++++
 methods/tm-au    |    2 +-
 methods/tm-file  |    2 +-
 methods/tm-image |    2 +-
 methods/tm-latex |    2 +-
 methods/tm-mpeg  |    2 +-
 methods/tm-plain |    2 +-
 tl-header.el     |    4 +-
 tl-list.el       |   20 +-
 tm-enriched.el   |  120 ++++++++++++
 tm-ftp.el        |   36 ++++
 tm-mh-e3.el      |    7 +-
 tm-mule.el       |    9 +-
 tm-rich.el       |    4 +-
 tm-view.el       |  121 +++++++-----
 tm-vm.el         |   68 +++----
 18 files changed, 856 insertions(+), 118 deletions(-)
 create mode 100644 doc/tl-jp.texi
 create mode 100644 tm-enriched.el
 create mode 100644 tm-ftp.el

diff --git a/Makefile b/Makefile
index 7f8c656..680ffa7 100644
--- a/Makefile
+++ b/Makefile
@@ -6,9 +6,9 @@ UTILS	= ol2 decode-b
 METHODS	= tm-au tm-file tm-image tm-latex tm-mpeg
 GOMI	= $(UTILS) *.elc
 FILES	= README.eng Makefile Makefile.18 Makefile.19 *.el *.c methods \
-		doc/Makefile doc/*.pln doc/*.ol doc/*.tex
+		doc/Makefile doc/*.pln doc/*.ol doc/*.tex doc/*.texi
 
-TARFILE = tm5.16.tar
+TARFILE = tm5.18.tar
 
 all:	$(UTILS) $(DVI)
 
diff --git a/Makefile.19 b/Makefile.19
index 6a669f0..f4814ae 100644
--- a/Makefile.19
+++ b/Makefile.19
@@ -2,7 +2,7 @@ EMACS	= mule2
 ORIG	= emacs19
 MULE	= mule2
 
-TLEL	= tl-header.el tl-str.el signature.el
+TLEL	= tl-header.el tl-str.el
 TLELC	= ${TLEL:el=elc}
 TMEL	= tm-misc.el
 TMELC	= ${TMEL:el=elc}
@@ -20,7 +20,7 @@ TMDIR	= $(HOME)/lib/emacs19/lisp/tm
 .el.elc:
 	$(EMACS) -batch -q . -f batch-byte-compile $<
 
-all:	$(TLELC) tl-orig.elc tl-mule.elc \
+all:	$(TLELC) tl-orig.elc tl-mule.elc signature.elc \
 	tiny-mime.elc $(TMELC) tm-orig.elc tm-mule.elc $(TMMELC) \
 	tm-mh-e.elc tm-gnus.elc $(TMVELC)
 
@@ -35,30 +35,35 @@ tl-mule.elc:	tl-mule.el
 tl-list.elc:	tl-list.el
 	$(EMACS) -batch -q . -l tl-list.el -f batch-byte-compile $<
 
+signature.elc:	signature.el
+	$(EMACS) -batch -q . -l tl-header.el -f batch-byte-compile $<
+
 tiny-mime.elc:	tiny-mime.el
+	$(EMACS) -batch -q . -l tl-header.el -f batch-byte-compile $<
 
 $(TMELC):
-	$(EMACS) -batch -q . -l tiny-mime -f batch-byte-compile $<
+	$(EMACS) -batch -q . -l tiny-mime.el -f batch-byte-compile $<
 
 tm-orig.elc:	tm-orig.el
 	$(ORIG) -batch -q . -l tl-orig.el -f batch-byte-compile $<
 
 tm-mule.elc:	tm-mule.el
-	$(MULE) -batch -q . -f batch-byte-compile $<
+	$(MULE) -batch -q . -l tl-list.el -f batch-byte-compile $<
 
 $(TMMELC):
-	$(EMACS) -batch -q . -l tiny-mime -l tm-misc -f batch-byte-compile $<
+	$(EMACS) -batch -q . -l tiny-mime.el -l tm-misc.el \
+		-f batch-byte-compile $<
 
 tm-gnus.elc:	tm-gnus.el
-	$(EMACS) -batch -q . -l tiny-mime -l tm-misc -l gnus \
+	$(EMACS) -batch -q . -l tiny-mime.el -l tm-misc.el -l gnus \
 		-f batch-byte-compile $<
 
 tm-mh-e.elc:	tm-mh-e.el
-	$(EMACS) -batch -q . -l tiny-mime -l tm-misc -l mh-e \
+	$(EMACS) -batch -q . -l tiny-mime.el -l tm-misc.el -l mh-e \
 		-f batch-byte-compile $<
 
 $(TMVELC):
-	$(EMACS) -batch -q . -l tiny-mime -l tm-misc -l tm-view \
+	$(EMACS) -batch -q . -l tiny-mime.el -l tm-misc.el -l tm-view.el \
 		-f batch-byte-compile $<
 
 install:	all tl-install tm-install
diff --git a/doc/tl-jp.texi b/doc/tl-jp.texi
new file mode 100644
index 0000000..576191b
--- /dev/null
+++ b/doc/tl-jp.texi
@@ -0,0 +1,548 @@
+\input texinfo.tex
+@c{-*-tl manual-*-}
+@setfilename tl-jp.info
+@settitle{tl manual}
+
+@titlepage
+@sp{5}
+@center{@titlefont{Emacs Lisp library `tl'}}
+@sp{15}
+@center{@titlefont{守岡 知彦}}
+@sp{1}
+@center{$Id: tl-jp.texi,v 1.2 1994/11/08 19:07:28 morioka Exp $}
+
+@end titlepage
+
+@node Top, Abstract, (dir), (dir)
+@comment  node-name,  next,  previous,  up
+
+@ifinfo
+tm などで使われる Emacs Lisp の library, `tl' に関して説明します。
+@end ifinfo
+
+@menu
+* Abstract::
+* Compatible::
+* tl-list::
+* tl-str::
+* tl-header::
+* Concept Index::
+* Command Index::
+* Variable Index::
+@end menu
+
+
+@node Abstract, Compatible, Top, Top
+@comment  node-name,  next,  previous,  up
+@chapter{概要}
+@cindex{概要}
+
+tl は tm などの Emacs Lisp program で共通に使うための汎用的な module 
+を集めた package です。
+
+tl は以下のような module から成ります。
+
+@itemize @bullet
+@item tl-18
+@item tl-nemacs
+@item tl-orig
+@item tl-mule
+@item tl-list
+@item tl-str
+@item tl-header
+@end itemize
+
+
+@node Compatible, tl-18, Abstract, Top
+@comment  node-name,  next,  previous,  up
+@chapter{互換性をとるための機構}
+@cindex{互換性をとるための機構}
+
+tl では、Original Emacs での version の差や、その日本語化や多言語化な
+どの拡張による差を埋め、これらの多様な Emacs の上で互換性をとるための
+機構を用意しています。
+
+その一つは、Emacs 18 で Emacs 19 の関数を用意して、Emacs 19 で拡張され
+た機能を Emacs 18 で利用するための module `tl-18' です。
+
+もう一つは、NEmacs, Original Emacs, Mule などでの文字、文字列の取扱い
+の差異を埋め、これらで共通に動く program を書くための module です。
+
+
+@menu
+* tl-18::
+* tl-nemacs::
+* tl-orig::
+* tl-mule::
+@end menu
+
+
+@node tl-18, tl-nemacs, Compatible, Compatible
+@comment  node-name,  next,  previous,  up
+@section{tl-18}
+@cindex{tl-18}
+
+tl-18 は Emacs 18 で Emacs 19 の関数を使うための module です。
+
+tl-18.el では、現在、Emacs 19 の関数のうち、@code{add-hook},
+@code{member} を実現しています。
+
+tl-18 を利用するには @code{(require 'tl-18)} を書いて下さい。
+
+
+@node tl-nemacs, tl-orig, tl-18, Compatible
+@comment  node-name,  next,  previous,  up
+@section{tl-nemacs}
+@cindex{tl-nemacs}
+
+tl-nemacs は、NEmacs において、主に、日本語処理に関して、Mule などの他
+の Emacs との互換性を取るための module です。tl-nemacs を使うことによっ
+て、NEmacs, Original Emacs, Mule の別に依らない program を書くことがで
+きます。
+
+tl-nemacs を利用するには @code{(require 'tl-nemacs)} を書いて下さい。
+
+
+@subsection{文字 code}
+
+@defvr{Constant} *junet*
+
+ISO-2022-JP (JIS) を表す。値は 2.（MULE 互換定数）
+@end defvr
+
+@defvr{Constant} *internal*
+
+NEmacs の内部 code を表す。値は 3. 実際には、EUC と同じ。（MULE 互換定
+数）
+@end defvr
+
+@defvr{Constant} *euc-japan*
+
+EUC-JP (EUC) を表す。値は 3.（MULE 互換定数）
+@end defvr
+
+@deffn{Function} code-convert-string STR SOURCE TARGET
+
+文字列 @var{STR} を @var{SOURCE} code から @var{TARGET} code に変換す
+る。（MULE 互換関数）
+@end deffn
+
+
+@subsection{leading character}
+
+@defvr{Constant} lc-ascii
+
+ASCII を表す leading character.（MULE 互換定数）
+@end defvr
+
+@defvr{Constant} lc-jp
+
+JIS X0208 を表す leading character.（MULE 互換定数）
+@end defvr
+
+@deffn{Function} get-lc CHR
+
+文字の先頭 octet @var{CHR} に対して、その文字の leading character を返
+す。
+@end deffn
+
+
+@subsection{文字処理}
+
+@deffn{Function} char-bytes CHR
+
+文字の先頭 octet @var{CHR} に対して、その文字の byte 数を返す。（MULE 
+互換関数）
+@end deffn
+
+@deffn{Function} char-width CHR
+
+文字の先頭 octet @var{CHR} に対して、その文字の幅を返す。（MULE 互換関
+数）
+@end deffn
+
+
+@subsection{文字列処理}
+
+@deffn{Function} string-width STR
+
+文字列 @var{STR} の幅を返す。（MULE 互換関数）
+@end deffn
+
+@deffn{Function} check-ASCII-string STR
+
+文字列 @var{STR} の中に ASCII 以外の文字が含まれないことを確かめる。も
+し、ASCII 以外の文字が含まれていれば nil を返す。
+@end deffn
+
+
+@subsection{その他}
+
+@deffn{Function} attribute-add-narrow-attribute ATR FROM TO
+
+@var{FROM} と @var{TO} で囲まれた region に @var{ATR} の attribute を
+付ける。
+@end deffn
+
+
+@node tl-orig, tl-mule, tl-nemacs, Compatible
+@comment  node-name,  next,  previous,  up
+@section{tl-orig}
+@cindex{tl-orig}
+
+tl-orig は、Original Emacs 19 において、主に、ISO-8859-1 の処理に関し
+て、Mule などの他の Emacs との互換性を取るための module です。tl-orig 
+を使うことによって、NEmacs, Original Emacs, Mule の別に依らない 
+program を書くことができます。
+
+tl-orig を利用するには @code{(require 'tl-orig)} を書いて下さい。
+
+
+@subsection{leading character}
+
+@defvr{Constant} lc-ascii
+
+ASCII を表す leading character.（MULE 互換定数）
+@end defvr
+
+@defvr{Constant} lc-ltn1
+
+ISO 8859-1 を表す leading character.（MULE 互換定数）
+@end defvr
+
+@deffn{Function} get-lc CHR
+
+文字の先頭 octet @var{CHR} に対して、その文字の leading character を返
+す。
+@end deffn
+
+
+@subsection{文字処理}
+
+@deffn{Function} char-bytes CHR
+
+文字の先頭 octet @var{CHR} に対して、その文字の byte 数を返す。（MULE 
+互換関数）
+@end deffn
+
+@deffn{Function} char-width CHR
+
+文字の先頭 octet @var{CHR} に対して、その文字の幅を返す。（MULE 互換関
+数）
+@end deffn
+
+
+@subsection{文字列処理}
+
+@deffn{Function} string-width STR
+
+文字列 @var{STR} の幅を返す。（MULE 互換関数）
+@end deffn
+
+
+@node tl-mule, tl-list, tl-orig, Compatible
+@comment  node-name,  next,  previous,  up
+@section{tl-mule}
+@cindex{tl-mule}
+
+tl-mule は、Mule において、主に、多言語文字列の処理に関して、NEmacs や 
+Original Emacs などの他の Emacs との互換性を取るための module です。
+tl-mule を使うことによって、NEmacs, Original Emacs, Mule の別に依らな
+い program を書くことができます。
+
+tl-mule を利用するには @code{(require 'tl-mule)} を書いて下さい。
+
+
+@subsection{leading character}
+
+@deffn{Function} get-lc CHR
+
+文字の先頭 octet @var{CHR} に対して、その文字の leading character を返
+す。
+@end deffn
+
+
+@node tl-list, tl-str, Compatible, Top
+@comment  node-name,  next,  previous,  up
+@chapter{tl-list}
+@cindex{tl-list}
+
+tl-list は list 処理に関する有用な関数を集めた module です。
+
+tl-list を利用するには @code{(require 'tl-list)} を書いて下さい。
+
+@section{list}
+
+@deffn{Function} last LIST
+
+@var{LIST} の最後の要素を返す。（Common Lisp 互換関数）
+@end deffn
+
+@deffn{Function} butlast LIST &optional n
+
+@var{LIST} の最後の @var{n} 要素を除いた copy を返す。（Common Lisp 互
+換関数）
+@end deffn
+
+@deffn{Function} nbutlast LIST &optional n
+
+@var{LIST} の最後の @var{n} 要素を除いたものを返す。（破壊的）（Common
+Lisp 互換関数）
+@end deffn
+
+
+@section{連想リスト}
+
+@deffn{Function} put-alist ITEM VALUE ALIST
+
+連想リスト @var{ALIST} の key @var{ITEM} に対応する値を @var{VALUE} に
+する。（破壊的）（ELIS 互換関数）
+@end deffn
+
+@deffn{Function} del-alist ITEM ALIST
+
+連想リスト @var{ALIST} の key @var{ITEM} に対応する値を削除する。（破
+壊的）（ELIS 互換関数）
+@end deffn
+
+@deffn{Function} set-alist SYM ITEM VALUE
+
+連想リストを入れた symbol @var{SYM} の key @var{ITEM} の値を 
+@var{VALUE} にする。（破壊的）
+@end deffn
+
+
+@section{単一化子}
+
+field とは @code{(field-type . field-value)} という形をした対である。
+この field を要素とした @code{(field1 field2 ...)} という形の連想リス
+トを「型」として取り扱う。
+
+
+@deffn{Function} fetch-field KEY ALIST
+
+連想リスト @var{ALIST} の key @var{KEY} に対応する対を返す。assoc と同
+じ。（jinn 互換関数）
+@end deffn
+
+@deffn{Function} put-field KEY VALUE ALIST
+
+連想リスト @var{ALIST} の key @var{KEY} に対応する値を @var{VALUE} に
+する。put-field と同じ。（破壊的）（jinn 互換関数）
+@end deffn
+
+@deffn{Function} delete-field KEY VALUE
+
+連想リスト @var{ALIST} の key @var{KEY} に対応する値を削除する。（破壊
+的）（jinn 互換関数）
+@end deffn
+
+
+@deffn{Function} field-unifier-for-default CLASS INSTANCE
+
+他に適当な field-unifier が見つからなかった場合に起動される 
+field-unifier. field @var{CLASS} と field @var{INSTANCE} の 
+field-unify を行う。（jinn 互換関数）
+@end deffn
+
+
+@deffn{Function} field-unify CLASS INSTANCE
+
+field @var{CLASS} と field @var{INSTANCE} の field-unify を行う。実際
+には、@var{CLASS} の field-type に対応した field-unifier が起動される。
+（jinn 互換関数）
+@end deffn
+
+
+@deffn{Function} assoc-unify CLASS INSTANCE
+
+連想リスト @var{CLASS} と連想リスト @var{INSTANCE} の type-unify を行
+う。（jinn 互換関数）
+@end deffn
+
+
+@node tl-str, tl-header, tl-list, Top
+@comment  node-name,  next,  previous,  up
+@chapter{tl-str}
+@cindex{tl-str}
+
+tl-str は文字列処理に関する有用な関数を集めた module です。
+
+tl-str を利用するには @code{(require 'tl-str)} を書いて下さい。
+
+
+@deffn{Function} rightful-boundary-short-string STR WIDTH
+
+文字列 @var{str} を先頭から幅 @var{WIDTH} 以内で切った文字列を返します。
+multi octet 文字列の場合でも正しく文字単位で切断します。
+@end deffn
+
+
+@deffn{Function} get-version-string ID
+
+RCS の version 文字列 @var{ID} から数字と `.' からのみ構成される 
+version number 文字列を返す。
+@end deffn
+
+
+@deffn{Function} replace-as-filename STR
+
+文字列 @var{STR} のから file name として問題のある文字を取り除いた 
+file name として使える文字列を返す。
+@end deffn
+
+
+@defvr{Variable} cited-prefix-regexp
+
+命令 @code{fill-cited-region} で用いる、引用文字列の先頭文字列を表す 
+prefix. 正規表現を指定する。
+@end defvr
+
+@deffn{Command} fill-cited-region BEGIN END
+
+先頭位置 @var{BEGIN} と終了位置 @var{END} で囲まれた region を引用文字
+列として fill する。
+@end deffn
+
+
+@deffn{Function} symbol-concat A B
+
+文字列か symbol である２つの引数 @var{A} と @var{B} を文字列としてつな
+いだ名前の symbol を返す。（jinn 互換関数）
+@end deffn
+
+@deffn{Function} top-string-match PAT STR
+
+文字列 @var{PAT} が文字列 @var{STR} の先頭に含まれる場合、@code{(PAT 
+残り)} という形式の list を返す。（jinn 互換関数）
+@end deffn
+
+@deffn{Function} middle-string-match PAT STR
+
+文字列 @var{PAT} が文字列 @var{STR} のどこかに含まれる場合、@code{(前 
+PAT 残り)} という形式の list を返す。（jinn 互換関数）
+@end deffn
+
+
+@node tl-header, Concept Index, tl-str, Top
+@comment  node-name,  next,  previous,  up
+@chapter{tl-header}
+@cindex{tl-header}
+
+tl-header は mail や News などの message header の処理に関する有用な関
+数を集めた module です。
+
+tl-header を利用するには @code{(require 'tl-header)} を書いて下さい。
+
+
+@defvr{Constant} message/quoted-string-regexp
+
+RFC 822 における quoted-string を表す正規表現。
+@end defvr
+
+@defvr{Constant} message/field-name-regexp
+
+RFC 822 における field-name を表す正規表現。
+@end defvr
+
+@defvr{Constant} message/field-body-regexp
+
+RFC 822 における field-body を表す正規表現。
+@end defvr
+
+@defvr{Constant} message/field-regexp
+
+RFC 822 における field を表す正規表現。
+@end defvr
+
+@defvr{Constant} message/word-regexp
+
+RFC 822 における word を表す正規表現。
+@end defvr
+
+@defvr{Constant} message/local-part-regexp
+
+RFC 822 における local-part を表す正規表現。
+@end defvr
+
+@defvr{Constant} message/domain-regexp
+
+RFC 822 における domain を表す正規表現。
+@end defvr
+
+@defvr{Constant} message/addr-spec-regexp
+
+RFC 822 における addr-spec を表す正規表現。
+@end defvr
+
+@deffn{Function} message/get-field-body NAME
+
+message header において @var{NAME} field の body を返す。
+@end deffn
+
+@deffn{Function} message/divide-field STR
+
+field 文字列 @var{STR} を @code{(field-name field-body)} という形式の 
+list にして返す。
+@end deffn
+
+@deffn{Function} message/parse-addr-spec STR
+
+文字列 @var{STR} を addr-spec として構文解析し、@code{(addr-spec 残り)} 
+という形式のリストにして返す。
+@end deffn
+
+@deffn{Function} message/parse-phrase-route-addr STR
+
+文字列 @var{STR} を phrase route-addr として構文解析し、@code{((phrase
+"<" addr-spec ">") 残り)} という形式のリストにして返す。（注：正確には、
+route も見なければいけないが、route は無いものとして解析している）
+@end deffn
+
+@deffn{Function} message/parse-comment STR
+
+文字列 @var{STR} を comment として構文解析し、@code{(("(" comment ")") 
+残り)} という形式のリストにして返す。
+@end deffn
+
+@deffn{Function} message/parse-address STR
+
+文字列 @var{STR} を address として構文解析し、@code{(address 残り)} と
+いう形式のリストにして返す。
+@end deffn
+
+@deffn{Function} message/parse-addresses STR
+
+文字列 @var{STR} を address list として構文解析し、@code{(address1
+address2 ...)} という形式のリストにして返す。
+@end deffn
+
+@deffn{Function} message/unfolding-string STR
+
+文字列 @var{STR} を field として unfolding した文字列を返す。
+@end deffn
+
+@deffn{Function} message/strip-quoted-string STR
+
+文字列 @var{STR} を quoted-string として strip した文字列を返す。
+@end deffn
+
+
+@node Concept Index, Command Index, Command List, Top
+@unnumbered 概念索引
+
+@printindex cp
+
+
+@node Command Index, Variable Index, Concept Index, Top
+@unnumbered 関数・コマンド索引
+
+@printindex fn
+
+
+@node Variable Index, Concept Index, Command Index, Top
+@unnumbered 変数索引
+
+@printindex vr
+
+@bye
diff --git a/methods/tm-au b/methods/tm-au
index 3fccba0..1561030 100755
--- a/methods/tm-au
+++ b/methods/tm-au
@@ -1,4 +1,4 @@
-#!/bin/csh
+#!/bin/csh -f
 
 switch( $4 )
 case "play":
diff --git a/methods/tm-file b/methods/tm-file
index 752e75d..99d939c 100755
--- a/methods/tm-file
+++ b/methods/tm-file
@@ -1,4 +1,4 @@
-#!/bin/csh
+#!/bin/csh -f
 
 if (! $?TM_TMP_DIR) then
     set TM_TMP_DIR=/tmp
diff --git a/methods/tm-image b/methods/tm-image
index f5bc63b..d05dfe3 100755
--- a/methods/tm-image
+++ b/methods/tm-image
@@ -1,4 +1,4 @@
-#!/bin/csh
+#!/bin/csh -f
 
 if (! $?TM_TMP_DIR) then
     set TM_TMP_DIR=/tmp
diff --git a/methods/tm-latex b/methods/tm-latex
index d4d72c9..278ad38 100755
--- a/methods/tm-latex
+++ b/methods/tm-latex
@@ -1,4 +1,4 @@
-#!/bin/csh
+#!/bin/csh -f
 #
 #	tm-latex: method for LaTeX
 #
diff --git a/methods/tm-mpeg b/methods/tm-mpeg
index 643421e..c4e085e 100755
--- a/methods/tm-mpeg
+++ b/methods/tm-mpeg
@@ -1,4 +1,4 @@
-#!/bin/csh
+#!/bin/csh -f
 
 if( $5 == "" ) then
 	set filename = /tmp/mime$$.mpg
diff --git a/methods/tm-plain b/methods/tm-plain
index f28934f..ae2e66a 100755
--- a/methods/tm-plain
+++ b/methods/tm-plain
@@ -1,4 +1,4 @@
-#!/bin/csh
+#!/bin/csh -f
 
 if( $5 == "" ) then
 	set filename="/tmp/mime$$.pln"
diff --git a/tl-header.el b/tl-header.el
index 5622691..ef696df 100644
--- a/tl-header.el
+++ b/tl-header.el
@@ -1,10 +1,10 @@
 ;;;
-;;; $Id: tl-header.el,v 4.5 1994/09/02 07:10:15 morioka Exp $
+;;; $Id: tl-header.el,v 4.6 1994/11/08 10:30:11 morioka Exp $
 ;;;
 
 (provide 'tl-header)
 
-(defconst message/quoted-string-regexp "\".*\"")
+(defconst message/quoted-string-regexp "\"[^\"]*\"")
 (defconst message/field-name-regexp "^[!-9;-~]+:")
 (defconst message/field-body-regexp ".*\\(\n[ \t].*\\)*")
 (defconst message/field-regexp
diff --git a/tl-list.el b/tl-list.el
index 93f861c..9bb08b1 100644
--- a/tl-list.el
+++ b/tl-list.el
@@ -1,5 +1,5 @@
 ;;;
-;;; $Id: tl-list.el,v 1.2 1994/10/29 14:40:02 morioka Exp $
+;;; $Id: tl-list.el,v 2.0 1994/11/08 11:14:20 morioka Exp $
 ;;;
 
 (provide 'tl-list)
@@ -165,3 +165,21 @@ return new alist whose car is the new pair and cdr is <ALIST>.
 	)
       (list prev (append cla ins) rest)
       )))
+
+(defun get-unified-alist (db al)
+  (let ((r db) ret)
+    (catch 'tag
+      (while r
+	(if (setq ret (nth 1 (assoc-unify (car r) al)))
+	    (throw 'tag ret)
+	  )
+	(setq r (cdr r))
+	))))
+
+(defun set-atype (sym al)
+  (if (null (boundp sym))
+      (set sym al)
+    (let ((ret (get-unified-alist (eval sym) al)))
+      (if (not (equal ret al))
+	  (set sym (cons al (eval sym)))
+	))))
diff --git a/tm-enriched.el b/tm-enriched.el
new file mode 100644
index 0000000..abff363
--- /dev/null
+++ b/tm-enriched.el
@@ -0,0 +1,120 @@
+;;;
+;;; $Id: tm-rich.el,v 2.2 1994/10/31 07:44:51 morioka Exp $
+;;;
+;;;          by MORIOKA Tomohiko  <morioka@jaist.ac.jp>
+;;; modified by YAMATE Keiichirou <ics9118@sem1.info.osaka-cu.ac.jp>
+;;;
+
+(provide 'tm-enriched)
+
+(require 'tm-view)
+
+(defvar mime/text/enriched-face-list
+  '("bold" "italic" "fixed" "underline"))
+
+(cond ((and (>= (string-to-int emacs-version) 19) window-system)
+       (require 'hilit19)
+       (defun mime/set-face-region (b e face)
+	 (let ((sym (intern face)))
+	   (if (eq sym 'italic)
+	       (setq sym 'modeline)
+	     )
+	   (if (member sym (face-list))
+	       (progn
+		 (hilit-unhighlight-region b e)
+		 (hilit-region-set-face b e sym)
+		 ))))
+       )
+      ((and (boundp 'NEMACS) NEMACS)
+       (setq mime/text/enriched-face-list
+	     '("bold" "italic" "underline"))
+       (setq mime/text/enriched-face-attribute-alist
+	     '(("bold"      . inversed-region)
+	       ("italic"    . underlined-region)
+	       ("underline" . underlined-region)
+	       ))
+       (defun mime/set-face-region (beg end sym)
+	 (attribute-add-narrow-attribute
+	  (cdr (assoc sym mime/text/enriched-face-attribute-alist))
+	  beg end))
+       )
+      (t
+       (setq mime/text/enriched-face-list
+	     nil)
+       (defun mime/set-face-region (beg end sym)
+	 )
+       ))
+
+(defun mime/decode-text/enriched-region (beg end)
+  (interactive "*r")
+  (save-excursion
+    (save-restriction
+      (narrow-to-region beg end)
+      (while (re-search-forward "[\n]+" nil t)
+	(let ((str (buffer-substring (match-beginning 0)
+				     (match-end 0))))
+	  (if (string= str "\n")
+	      (replace-match " ")
+	    (replace-match (substring str 1))
+	    )))
+      (goto-char beg)
+      (let (cmd str (fb (point)) fe b e)
+	(while (re-search-forward "<\\(<\\|[^<>\n\r \t]+>\\)" nil t)
+	  (setq b (match-beginning 0))
+	  (setq cmd (buffer-substring b (match-end 0)))
+	  (if (string= cmd "<<")
+	      (replace-match "<")
+	    (replace-match "")
+	    (setq cmd (downcase (substring cmd 1 (- (length cmd) 1))))
+	    )
+	  (cond ((string= cmd "param")
+		 (setq b (point))
+		 (save-excursion
+		   (save-restriction
+		     (if (search-forward "</param>" nil t)
+			 (progn
+			   (replace-match "")
+			   (setq e (point))
+			   )
+		       (setq e end)
+		       )))
+		 (delete-region b e)
+		 )
+		((member cmd mime/text/enriched-face-list)
+		 (setq b (point))
+		 (save-excursion
+		   (save-restriction
+		     (if (re-search-forward (concat "</" cmd ">") nil t)
+			 (progn
+			   (replace-match "")
+			   (setq e (point))
+			   )
+		       (setq e end)
+		       )))
+		 (mime/set-face-region b e cmd)
+		 )))
+	(goto-char (point-max))
+	(if (not (eq (preceding-char) ?\n))
+	    (insert "\n")
+	  )
+	))))
+
+(defun mime/decode-text/enriched (&optional ctl)
+  (interactive)
+  (save-excursion
+    (save-restriction
+      (let ((beg (point-min)) (end (point-max)))
+	(goto-char (point-min))
+	(if (search-forward "\n\n" nil t)
+	    (setq beg (match-end 0))
+	  )
+	(mime/decode-text/enriched-region beg end)
+	))))
+
+
+(set-alist 'mime/content-filter-alist
+	   "text/enriched" (function mime/decode-text/enriched))
+
+(set-alist 'mime/content-filter-alist
+	   "text/richtext" (function mime/decode-text/enriched))
+
diff --git a/tm-ftp.el b/tm-ftp.el
new file mode 100644
index 0000000..9044ed8
--- /dev/null
+++ b/tm-ftp.el
@@ -0,0 +1,36 @@
+;;;
+;;; tm-ftp: anonymous ftp processor for tm-view
+;;;
+;;; by MASUTANI Yasuhiro <masutani@me.es.osaka-u.ac.jp> (1994/11/5)
+;;;    
+;;; modified by MORIOKA Tomohiko <morioka@jaist.ac.jp> (1994/11/8)
+;;;
+
+(provide 'tm-ftp)
+
+(require 'ange-ftp)
+
+(defun mime/decode-message/external-ftp (beg end cal)
+  (let ((access-type (cdr (assoc "access-type" cal)))
+	(site (cdr (assoc "site" cal)))
+	(directory (cdr (assoc "directory" cal)))
+	(name (cdr (assoc "name" cal)))
+	(mode (cdr (assoc "mode" cal)))
+	(pathname))
+    (setq pathname
+	  (concat "/anonymous@" site ":" directory))
+    (message (concat "Accessing " pathname "/" name "..."))
+    (dired pathname)
+    (goto-char (point-min))
+    (search-forward name)
+    ))
+
+(set-atype 'mime/content-decoding-condition
+	   '((type . "message/external-body")
+	     ("access-type" . "anon-ftp")
+	     (method . mime/decode-message/external-ftp)
+	     ))
+
+	   
+
+	
\ No newline at end of file
diff --git a/tm-mh-e3.el b/tm-mh-e3.el
index 0f88eba..a5b3d6d 100644
--- a/tm-mh-e3.el
+++ b/tm-mh-e3.el
@@ -1,5 +1,5 @@
 ;;;
-;;; $Id: tm-mh-e3.el,v 1.1 1994/07/10 20:03:10 morioka Exp morioka $
+;;; $Id: tm-mh-e3.el,v 1.2 1994/11/01 18:06:16 morioka Exp $
 ;;;
 ;;; This is a part of tm-mh-e.el which is a module for old mh-e
 ;;; to emulate mh-e 4.0.
@@ -20,17 +20,18 @@ The value of mh-show-mode-hook is called when a new message is displayed."
   (mh-set-mode-name "MH-Show")
   (run-hooks 'mh-show-mode-hook))
 
-(defun mh-display-msg (msg-num folder)
+(defun mh-display-msg (msg-num folder &optional show-buffer)
   ;; Display message NUMBER of FOLDER.
   ;; Sets the current buffer to the show buffer.
   (set-buffer folder)
+  (or show-buffer
+      (setq show-buffer mh-show-buffer))
   ;; Bind variables in folder buffer in case they are local
   (let ((formfile mhl-formfile)
 	(clean-message-header mh-clean-message-header)
 	(invisible-headers mh-invisible-headers)
 	(visible-headers mh-visible-headers)
 	(msg-filename (mh-msg-filename msg-num))
-	(show-buffer mh-show-buffer)
 	(folder mh-current-folder))
     (if (not (file-exists-p msg-filename))
 	(error "Message %d does not exist" msg-num))
diff --git a/tm-mule.el b/tm-mule.el
index 8f73ecb..c197b2e 100644
--- a/tm-mule.el
+++ b/tm-mule.el
@@ -1,5 +1,5 @@
 ;;;
-;;; $Id: tm-mule.el,v 5.1 1994/10/26 14:43:57 morioka Exp $
+;;; $Id: tm-mule.el,v 5.2 1994/11/08 11:18:43 morioka Exp $
 ;;;
 
 (provide 'tm-mule)
@@ -14,6 +14,8 @@
 ;;; @ variables
 ;;;
 
+(defvar mime/default-charset *ctext*)
+
 (defvar mime/lc-charset-and-encoding-alist
   (list
    (cons lc-ascii nil)
@@ -150,4 +152,7 @@
 	(let ((ct (cdr (assoc charset mime/charset-coding-system-alist))))
 	  (if ct
 	      (code-convert beg end ct *internal*)
-	    )))))
+	    )))
+    (if mime/default-charset
+	(code-convert beg end mime/default-charset *internal*)
+      )))
diff --git a/tm-rich.el b/tm-rich.el
index f498b72..e93e36a 100644
--- a/tm-rich.el
+++ b/tm-rich.el
@@ -1,5 +1,5 @@
 ;;;
-;;; $Id: tm-rich.el,v 2.1 1994/10/31 05:05:51 morioka Exp $
+;;; $Id: tm-rich.el,v 2.2 1994/10/31 07:44:51 morioka Exp morioka $
 ;;;
 ;;;          by MORIOKA Tomohiko  <morioka@jaist.ac.jp>
 ;;; modified by YAMATE Keiichirou <ics9118@sem1.info.osaka-cu.ac.jp>
@@ -82,7 +82,7 @@
 		 )))
 	(fill-region fb (point-max) t)
 	(goto-char (point-max))
-	(if (not (eq (char-before (point)) ?\n))
+	(if (not (eq (preceding-char) ?\n))
 	    (insert "\n")
 	  )
 	))))
diff --git a/tm-view.el b/tm-view.el
index aadc2b3..0eb9369 100644
--- a/tm-view.el
+++ b/tm-view.el
@@ -20,7 +20,7 @@
 ;;;
 
 (defconst mime/viewer-RCS-ID
-  "$Id: tm-view.el,v 5.16 1994/10/26 19:03:12 morioka Exp $")
+  "$Id: tm-view.el,v 5.19 1994/11/08 11:13:12 morioka Exp $")
 
 (defconst mime/viewer-version (get-version-string mime/viewer-RCS-ID))
 
@@ -36,7 +36,7 @@
 (defconst mime/content-parameter-value-regexp
   (concat "\\("
 	  message/quoted-string-regexp
-	  "\\|[^; \t\n]\\)*"))
+	  "\\|[^; \t\n]*\\)"))
 
 (defconst mime/output-buffer-name "*MIME-out*")
 (defconst mime/decoding-buffer-name "*MIME-decoding*")
@@ -610,14 +610,8 @@
     ))
 
 (defun mime/get-content-decoding-alist (al)
-  (let ((r mime/content-decoding-condition) ret)
-    (catch 'tag
-      (while r
-	(if (setq ret (nth 1 (assoc-unify (car r) al)))
-	    (throw 'tag ret)
-	  )
-	(setq r (cdr r))
-	))))
+  (get-unified-alist mime/content-decoding-condition al)
+  )
 
 (defun mime/decode-content-region (beg end)
   (interactive "*r")
@@ -710,7 +704,42 @@
 ;;; @ MIME viewer mode
 ;;;
 
+(defvar mime/viewer-mode-map nil)
+(if (null mime/viewer-mode-map)
+    (progn
+      (setq mime/viewer-mode-map (make-keymap))
+      (suppress-keymap mime/viewer-mode-map)
+      (define-key mime/viewer-mode-map "u" 'mime/up-content)
+      (define-key mime/viewer-mode-map "p" 'mime/previous-content)
+      (define-key mime/viewer-mode-map "n" 'mime/next-content)
+      (define-key mime/viewer-mode-map " " 'mime/scroll-up-content)
+      (define-key mime/viewer-mode-map "\M- " 'mime/scroll-down-content)
+      (define-key mime/viewer-mode-map "\177" 'mime/scroll-down-content)
+      (define-key mime/viewer-mode-map "\C-m" 'mime/next-line-content)
+      (define-key mime/viewer-mode-map "\C-\M-m" 'mime/previous-line-content)
+      (define-key mime/viewer-mode-map "v" 'mime/play-content)
+      (define-key mime/viewer-mode-map "e" 'mime/extract-content)
+      (define-key mime/viewer-mode-map "\C-c\C-p" 'mime/print-content)
+      (define-key mime/viewer-mode-map "q" 'mime/quit-view-mode)
+      (define-key mime/viewer-mode-map "\C-c\C-x" 'mime/exit-view-mode)
+      ))
+
 (defun mime/viewer-mode (&optional mother)
+  "Major mode for viewing MIME message.
+
+u	Move to upper content
+p	Move to previous content
+n	Move to next content
+SPC	Scroll up
+M-SPC	Scroll down
+DEL	Scroll down
+RET	Move to next line
+M-RET	Move to previous line
+v	Decode the content as `play mode'
+e	Decode the content as `extract mode'
+C-c C-p	Decode the content as `print mode'
+q	Quit
+"
   (interactive)
   (let ((buf (get-buffer mime/output-buffer-name))
 	(the-buf (current-buffer))
@@ -726,7 +755,6 @@
     (switch-to-buffer (car ret))
     (setq major-mode 'mime/viewer-mode)
     (setq mode-name "MIME-View")
-
     (make-variable-buffer-local 'mime/viewer-original-major-mode)
     (setq mime/viewer-original-major-mode
 	  (if mother
@@ -739,38 +767,20 @@
 		(setq mime/mother-buffer mother)
 		'mime/show-message-mode)
 	    mode))
-    (let ((keymap (current-local-map)))
-      (if (null keymap)
-	  (setq keymap (make-sparse-keymap))
-	(setq keymap (copy-keymap keymap))
-	)
-      (use-local-map keymap)
-      (define-key keymap "u" 'mime/up-content)
-      (define-key keymap "p" 'mime/previous-content)
-      (define-key keymap "n" 'mime/next-content)
-      (define-key keymap " " 'mime/scroll-up-content)
-      (define-key keymap "\M- " 'mime/scroll-down-content)
-      (define-key keymap "\177" 'mime/scroll-down-content)
-      (define-key keymap "\C-m" 'mime/next-line-content)
-      (define-key keymap "\C-\M-m" 'mime/previous-line-content)
-      (define-key keymap "v" 'mime/play-content)
-      (define-key keymap "e" 'mime/extract-content)
-      (define-key keymap "\C-c\C-p" 'mime/print-content)
-      (define-key keymap "\C-c\C-x" 'mime/exit-view-mode)
-      
-      (make-variable-buffer-local 'mime/preview-flat-content-list)
-      (setq mime/preview-flat-content-list (nth 1 ret))
-      
-      (goto-char
-       (let ((ce (nth 1 (car mime/preview-flat-content-list)))
-	     e)
-	 (goto-char (point-min))
-	 (search-forward "\n\n" nil t)
-	 (setq e (match-end 0))
-	 (if (<= e ce)
-	    e
-	   ce)))
-      )))
+    (use-local-map mime/viewer-mode-map)
+    (make-variable-buffer-local 'mime/preview-flat-content-list)
+    (setq mime/preview-flat-content-list (nth 1 ret))
+    (goto-char
+     (let ((ce (nth 1 (car mime/preview-flat-content-list)))
+	   e)
+       (goto-char (point-min))
+       (search-forward "\n\n" nil t)
+       (setq e (match-end 0))
+       (if (<= e ce)
+	   e
+	 ce)))
+    (run-hooks 'mime/viewer-mode-hook)
+    ))
 
 (defun mime/decode-content ()
   (interactive)
@@ -810,11 +820,7 @@
     (switch-to-buffer (nth 2 pc))
     (setq cn (mime/get-point-content-number (nth 3 pc)))
     (if (eq cn t)
-	(if (setq r (assoc major-mode mime/go-to-top-node-method-alist))
-	    (progn
-	      (switch-to-buffer the-buf)
-	      (funcall (cdr r))
-	      ))
+	(mime/quit-view-mode the-buf (nth 2 pc))
       (setq r (mime/get-content-region (butlast cn)))
       (switch-to-buffer the-buf)
       (catch 'tag
@@ -914,6 +920,25 @@
   (mime/scroll-down-content 1)
   )
 
+(defun mime/quit-view-mode (&optional the-buf buf)
+  (interactive)
+  (if (null the-buf)
+      (setq the-buf (current-buffer))
+    )
+  (if (null buf)
+      (setq buf (nth 2 (mime/get-point-preview-content (point))))
+    )
+  (let ((r (progn
+	     (switch-to-buffer buf)
+	     (assoc major-mode mime/go-to-top-node-method-alist)
+	     )))
+    (if r
+	(progn
+	  (switch-to-buffer the-buf)
+	  (funcall (cdr r))
+	  ))
+    ))
+
 (defun mime/exit-view-mode ()
   (interactive)
   (kill-buffer (current-buffer))
diff --git a/tm-vm.el b/tm-vm.el
index 61184f5..574b5a8 100644
--- a/tm-vm.el
+++ b/tm-vm.el
@@ -12,57 +12,37 @@
 (require 'tl-list)
 (require 'tm-view)
 
-
 (defconst tm-vm/RCS-ID
-  "$Id: tm-vm.el,v 1.3 1994/10/29 10:01:21 morioka Exp $")
+  "$Id: tm-vm.el,v 1.5 1994/11/01 16:30:12 morioka Exp $")
 (defconst tm-vm/version (get-version-string tm-vm/RCS-ID))
 
-
 (define-key vm-mode-map "Z" 'tm-vm/view-message)
 
-(set-alist mime/go-to-top-node-method-alist
+(set-alist 'mime/go-to-top-node-method-alist
 	   'vm-mode
-	   (function
-	    (lambda ()
-	      (mime/exit-view-mode)
-	      (let ((w (get-buffer-window mime/output-buffer-name)))
-		(if w (delete-window w)))
-	      (vm-display vm-summary-buffer t
-			  '(mime/exit-view-mode)
-			  '(this-command))
-	      (vm-widen-page)
-	      (goto-char (point-max))
-	      (widen)
-	      (narrow-to-region (point)
-				(vm-vheaders-of
-				 (car vm-message-pointer)))
-	      (goto-char (point-min))
-	      (if vm-honor-page-delimiters
-		  (vm-narrow-to-page))
-	      (select-window (get-buffer-window vm-summary-buffer))
-	      )))
-(set-alist mime/go-to-top-node-method-alist
+	   'tm-vm/quit-view-message)
+
+(set-alist 'mime/go-to-top-node-method-alist
 	   'vm-virtual-mode
-	   (function
-	    (lambda ()
-	      (mime/exit-view-mode)
-	      (let ((w (get-buffer-window mime/output-buffer-name)))
-		(if w (delete-window w)))
-	      (vm-display vm-summary-buffer t
-			  '(mime/exit-view-mode)
-			  '(this-command))
-	      (vm-widen-page)
-	      (goto-char (point-max))
-	      (widen)
-	      (narrow-to-region (point)
-				(vm-vheaders-of
-				 (car vm-message-pointer)))
-	      (goto-char (point-min))
-	      (if vm-honor-page-delimiters
-		  (vm-narrow-to-page))
-	      (select-window (get-buffer-window vm-summary-buffer))
-	      ))
-	   )
+	   'tm-vm/quit-view-message)
+
+(defun tm-vm/quit-view-message()
+  (mime/exit-view-mode)
+  (let ((w (get-buffer-window mime/output-buffer-name)))
+    (if w (delete-window w)))
+  (vm-display vm-summary-buffer t
+	      '(mime/exit-view-mode)
+	      '(this-command))
+  (vm-widen-page)
+  (goto-char (point-max))
+  (widen)
+  (narrow-to-region (point)
+		    (vm-vheaders-of
+		     (car vm-message-pointer)))
+  (goto-char (point-min))
+  (if vm-honor-page-delimiters
+      (vm-narrow-to-page))
+  (select-window (get-buffer-window vm-summary-buffer)))
 
 (defun tm-vm/view-message ()
   "Decode and view MIME message for VM"
-- 
1.7.10.4