From: morioka Date: Mon, 2 Mar 1998 13:54:34 +0000 (+0000) Subject: tm 5.18 X-Git-Tag: tm5_18~1 X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=7ea8c7377706103d8f9afc39e3f29e5454ef6404;p=elisp%2Ftm.git tm 5.18 --- 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 である2つの引数 @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 . ) (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 +;;; modified by YAMATE Keiichirou +;;; + +(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 "" 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 "") 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 (1994/11/5) +;;; +;;; modified by MORIOKA Tomohiko (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 ;;; modified by YAMATE Keiichirou @@ -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"