From: morioka Date: Mon, 2 Mar 1998 13:30:34 +0000 (+0000) Subject: tm4.7.0. X-Git-Tag: tm4_7_0 X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=c8d67b7f628b6e02157bbee9018bcf0ef9b4f16d;p=elisp%2Ftm.git tm4.7.0. --- c8d67b7f628b6e02157bbee9018bcf0ef9b4f16d diff --git a/Makefile b/Makefile new file mode 100644 index 0000000..5d7368e --- /dev/null +++ b/Makefile @@ -0,0 +1,71 @@ +bindir = $(HOME)/bin +CC = gcc +CFLAGS = -O + +UTILS = ol2 decode-b +METHODS = tm-au tm-file tm-image tm-latex tm-mpeg +OLFILES = README-jp.ol tiny-mime-jp.ol tm-body-jp.ol \ + tm-mh-e-jp.ol tm-gnus-jp.ol signature-jp.ol +TEXFILES= README-jp.tex tiny-mime-jp.tex tm-body-jp.tex \ + tm-mh-e-jp.tex tm-gnus-jp.tex \ + README-eng.tex tm-body-eng.tex \ + tm-mh-e-eng.tex tm-gnus-eng.tex signature-jp.tex +DVIFILES= README-jp.dvi tiny-mime-jp.dvi tm-body-jp.dvi \ + tm-mh-e-jp.dvi tm-gnus-jp.dvi \ + README-eng.dvi tm-body-eng.dvi \ + tm-mh-e-eng.dvi tm-gnus-eng.dvi signature-jp.dvi +PSFILES = README-jp.ps tiny-mime-jp.ps tm-body-jp.ps \ + tm-mh-e-jp.ps tm-gnus-jp.ps signature-jp.ps +GOMI = *.aux *.log *.tex $(DVIFILES) *.ps $(UTILS) + +FILES = *.ol Makefile *.el *.c methods $(TEXFILES) + +TARFILE = tm4.7.tar + +.SUFFIXES: .ol .tex .dvi .ps + +.ol.tex: + ol2 < $< | plain2 -tex -tstyle=a4j > $@ + +.tex.dvi: + jlatex $< + +.dvi.ps: + dvi2ps $< > $@ + +all: $(UTILS) $(DVI) + +ol2: ol2.c + $(CC) $(CFLAGS) ol2.c -o ol2 + +decode-b: decode-b.c + $(CC) $(CFLAGS) decode-b.c -o decode-b + + +tex: $(TEXFILES) + +$(TEXFILES): $(OLFILES) + + +dvi: $(DVIFILES) + +$(DVIFILES): $(TEXFILES) + + +ps: $(PSFILES) + +$(PSFILES): $(DVIFILES) + + +install: $(UTILS) methods + cp -p $(UTILS) $(bindir) + cp -p methods/* $(bindir) + + +clean: + rm $(GOMI) + + +tar: $(FILES) + tar cvf $(TARFILE) $(FILES) + gzip -9 $(TARFILE) diff --git a/README-eng.ol b/README-eng.ol new file mode 100644 index 0000000..4694143 --- /dev/null +++ b/README-eng.ol @@ -0,0 +1,52 @@ +[[R +\title{tm-$<$MUA$>$ Manual (English Version)} +\author{Morioka Tomohiko} +\date{1994/7/22} +\maketitle +]]R + + tm- is a MIME tools for GNU Emacs. + + +* Files + +README-jp.ol README (Japanese) +README-eng.ol README (English) +tiny-mime.ol tiny-mime.el manual (Japanese) +tm-body.ol tm-body manual (Japanese) +tm-gnus-jp.ol tm-gnus manual (Japanese) +tm-gnus-eng.ol tm-gnus manual (English) +tm-mh-e-jp.ol tm-mh-e manual (Japanese) +tm-mh-e-eng.ol tm-mh-e manual (English) +decode-b.c Base64 decoder +methods/* methods + +tiny-mime.el Multilingual MIME header encoder/decoder +tm-body.el MIME body decoder +tm-gnus.el tm- for GNUS +tm-mh-e.el tm- for mh-e +tm-mh-e3.el tm-mh-e's module for mh-e 3.x. +tm-misc.el tm- library +tl-*.el library modules + +mime-setup.el setup program +signature.el signature selector +ol2.c Emacs outline mode to plain text converter + + +* How to install + +(1) Edit Makefile for your environment. + +(2) Edit methods in `methods/' directory for your environment. + +(3) Run `make all'. + +(4) Run `make install'. + +(5) Copy *.el to your emacs lisp directory. + + +* How to use + + Please read tm-mh-e-eng.ol and tm-gnus-eng.ol. diff --git a/README-eng.tex b/README-eng.tex new file mode 100644 index 0000000..996ebd7 --- /dev/null +++ b/README-eng.tex @@ -0,0 +1,80 @@ +\documentstyle[a4j]{jarticle} +\setcounter{secnumdepth}{6} +\setcounter{tocdepth}{6} +\topsep=0.1cm +\parsep=0.1cm +\itemsep=0.0cm +\begin{document} +\title{tm-$<$MUA$>$ Manual (English Version)} +\author{Morioka Tomohiko} +\date{1994/7/22} +\maketitle +\medskip +{\baselineskip=10pt +\begin{verbatim} + tm- is a MIME tools for GNU Emacs. +\end{verbatim}} +\medskip +\medskip + +\section{Files} +\medskip +{\baselineskip=10pt +\begin{verbatim} +README-jp.ol README (Japanese) +README-eng.ol README (English) +tiny-mime.ol tiny-mime.el manual (Japanese) +tm-body.ol tm-body manual (Japanese) +tm-gnus-jp.ol tm-gnus manual (Japanese) +tm-gnus-eng.ol tm-gnus manual (English) +tm-mh-e-jp.ol tm-mh-e manual (Japanese) +tm-mh-e-eng.ol tm-mh-e manual (English) +decode-b.c Base64 decoder +methods/* methods +\end{verbatim}} +\medskip +{\baselineskip=10pt +\begin{verbatim} +tiny-mime.el Multilingual MIME header encoder/decoder +tm-body.el MIME body decoder +tm-gnus.el tm- for GNUS +tm-mh-e.el tm- for mh-e +tm-mh-e3.el tm-mh-e's module for mh-e 3.x. +tm-misc.el tm- library +tl-*.el library modules +\end{verbatim}} +\medskip +{\baselineskip=10pt +\begin{verbatim} +mime-setup.el setup program +signature.el signature selector +ol2.c Emacs outline mode to plain text converter +\end{verbatim}} +\medskip +\medskip + +\section{How to install} +\medskip +{ +\renewcommand{\theenumi}{(\arabic{enumi})} +\renewcommand{\labelenumi}{\theenumi} +\begin{enumerate} +\item Edit Makefile for your environment. +\medskip +\item Edit methods in `methods/' directory for your environment. +\medskip +\item Run `make all'. +\medskip +\item Run `make install'. +\medskip +\item Copy *.el to your emacs lisp directory. +\medskip +\medskip +\end{enumerate} +} + +\section{How to use} +\medskip +\par +Please read tm-mh-e-eng.ol and tm-gnus-eng.ol. +\end{document} diff --git a/README-jp.ol b/README-jp.ol new file mode 100644 index 0000000..f416774 --- /dev/null +++ b/README-jp.ol @@ -0,0 +1,61 @@ +$B!X(Btm- $B@bL@=q!Y(B + +* install $B$N;EJ}(B + +(1) Makefile $B$N(B bindir $B$r<+J,$N4D6-$K9g$o$;$F=q$-49$($k!#(B + +(2) methods/ $B0J2<$N(B method $B$r!"(Btm-body $B$N@bL@=q$r8+$F!"<+J,$N4D6-$K9g(B + $B$&$h$&$K=q$-49$($k!#(B + +(3) make all $B$9$k!#(B + +(4) make install $B$9$k!#(B + +(5) *.el $B$r(B Emacs $B$NJQ?t(B load-path $B$G;XDj$5$l$?(B directory $B$K(B copy $B$9$k!#(B + + + tm-mh-e, tm-gnus $B$N@bL@$O!"(Btm-mh-e.ol, tm-gnus.ol $B$rFI$s$G2<$5$$!#(B +plain2 $B$,(B install $B$5$l$F$$$k>l9g!"(Bmake dvi $B$r9T$J$&$3$H$G(B dvi $B$KJQ49$G(B +$B$-$^$9!#(B + + +* $B$*$^$1(B + + mime-setup $B$H$$$&4J0W@_Dj(B tool $B$rIU$1$^$7$?!#(B.emacs $B$K0J2<$N$b$N$rF~(B +$B$l$k$H(B tm- $B$N@_Dj$H(B mime.el $B$r;H$C$?(B encode $B$N@_Dj$r9T$J$C$F$/$l(B +$B$^$9!#(B + +[[E +---------------------------------------------------------------------- +(load "mime-setup") +---------------------------------------------------------------------- +]]E + + mime-setup.el $B$OI8=`$G$O(B SuperCite $B$N@_Dj$b9T$J$$$^$9!#$3$l$r$d$a$k(B +$B>l9g(B .emacs $B$K0J2<$N$b$N$rF~$l$F2<$5$$!#(B + +[[E +---------------------------------------------------------------------- +(setq mime-setup-use-sc nil) +---------------------------------------------------------------------- +]]E + + mime-setup $B$G$O(B signature $B$N<+F0@ZBX$((B tool $B$bImB0$7$F$$$^$9!#(B +message header $B$N(B field $B$K9g$o$;$F(B signature $B$N<+F0@ZBX$r9T$J$$$?$$>l(B +$B9g$O(B .emacs $B$K0J2<$N$h$&$J$b$N$rF~$l$F2<$5$$!#(B + +[[E +---------------------------------------------------------------------- +(setq signature-file-alist + '( + (("Newsgroups" . "jokes") . "~/.signature-jokes") + (("Newsgroups" . ("zxr" "nzr")) . "~/.signature-sun") + (("To" . ("ishimaru" "z-suzuki")) . "~/.signature-sun") + (("To" . "tea") . "~/.signature-jokes") + (("To" . ("sim" "oku" "takuo")) . "~/.signature-formal") + )) +---------------------------------------------------------------------- +]]E + + mime-setup $B$r;H$&>l9g$O!"(Bmime.el $B$,I,MW$G$9!#$^$?!"(BSuperCite $B$r;H$&(B +$B>l9g$O!"(BSuperCite $B$bI,MW$G$9!#(B diff --git a/README-jp.tex b/README-jp.tex new file mode 100644 index 0000000..bdbf8a1 --- /dev/null +++ b/README-jp.tex @@ -0,0 +1,92 @@ +\documentstyle[a4j]{jarticle} +\setcounter{secnumdepth}{6} +\setcounter{tocdepth}{6} +\topsep=0.1cm +\parsep=0.1cm +\itemsep=0.0cm +\begin{document} +\title{ +tm-$<$MUA$>$ ÀâÌÀ½ñ} +\author{ +\\ +} +\date{ +} +\maketitle +\medskip + +\section{install ¤Î»ÅÊý} +\medskip +{ +\renewcommand{\theenumi}{(\arabic{enumi})} +\renewcommand{\labelenumi}{\theenumi} +\begin{enumerate} +\item Makefile ¤Î bindir ¤ò¼«Ê¬¤Î´Ä¶­¤Ë¹ç¤ï¤»¤Æ½ñ¤­´¹¤¨¤ë¡£ +\medskip +\item methods/ °Ê²¼¤Î method ¤ò¡¢tm-body ¤ÎÀâÌÀ½ñ¤ò¸«¤Æ¡¢¼«Ê¬¤Î´Ä¶­¤Ë¹ç +¤¦¤è¤¦¤Ë½ñ¤­´¹¤¨¤ë¡£ +\medskip +\item make all ¤¹¤ë¡£ +\medskip +\item make install ¤¹¤ë¡£ +\medskip +\item *.el ¤ò Emacs ¤ÎÊÑ¿ô load-path ¤Ç»ØÄꤵ¤ì¤¿ directory ¤Ë copy ¤¹¤ë¡£ +\medskip +\medskip +\end{enumerate} +} +\par +tm-mh-e, tm-gnus ¤ÎÀâÌÀ¤Ï¡¢tm-mh-e.ol, tm-gnus.ol ¤òÆɤó¤Ç²¼¤µ¤¤¡£ +plain2 ¤¬ install ¤µ¤ì¤Æ¤¤¤ë¾ì¹ç¡¢make dvi ¤ò¹Ô¤Ê¤¦¤³¤È¤Ç dvi ¤ËÊÑ´¹¤Ç +¤­¤Þ¤¹¡£ +\medskip +\medskip + +\section{¤ª¤Þ¤±} +\medskip +\par +mime-setup ¤È¤¤¤¦´Ê°×ÀßÄê tool ¤òÉÕ¤±¤Þ¤·¤¿¡£.emacs ¤Ë°Ê²¼¤Î¤â¤Î¤òÆþ +¤ì¤ë¤È tm-$<$MUA$>$ ¤ÎÀßÄê¤È mime.el ¤ò»È¤Ã¤¿ encode ¤ÎÀßÄê¤ò¹Ô¤Ê¤Ã¤Æ¤¯¤ì +¤Þ¤¹¡£ +\medskip +{\baselineskip=10pt +\begin{verbatim} +---------------------------------------------------------------------- +(load "mime-setup") +---------------------------------------------------------------------- +\end{verbatim}} +\medskip +\par +mime-setup.el ¤Ïɸ½à¤Ç¤Ï SuperCite ¤ÎÀßÄê¤â¹Ô¤Ê¤¤¤Þ¤¹¡£¤³¤ì¤ò¤ä¤á¤ë +¾ì¹ç .emacs ¤Ë°Ê²¼¤Î¤â¤Î¤òÆþ¤ì¤Æ²¼¤µ¤¤¡£ +\medskip +{\baselineskip=10pt +\begin{verbatim} +---------------------------------------------------------------------- +(setq mime-setup-use-sc nil) +---------------------------------------------------------------------- +\end{verbatim}} +\medskip +\par +mime-setup ¤Ç¤Ï signature ¤Î¼«Æ°ÀÚÂؤ¨ tool ¤âÉí°¤·¤Æ¤¤¤Þ¤¹¡£ +message header ¤Î field ¤Ë¹ç¤ï¤»¤Æ signature ¤Î¼«Æ°ÀÚÂؤò¹Ô¤Ê¤¤¤¿¤¤¾ì +¹ç¤Ï .emacs ¤Ë°Ê²¼¤Î¤è¤¦¤Ê¤â¤Î¤òÆþ¤ì¤Æ²¼¤µ¤¤¡£ +\medskip +{\baselineskip=10pt +\begin{verbatim} +---------------------------------------------------------------------- +(setq signature-file-alist + '( + (("Newsgroups" . "jokes") . "~/.signature-jokes") + (("Newsgroups" . ("zxr" "nzr")) . "~/.signature-sun") + (("To" . ("ishimaru" "z-suzuki")) . "~/.signature-sun") + (("To" . "tea") . "~/.signature-jokes") + (("To" . ("sim" "oku" "takuo")) . "~/.signature-formal") + )) +---------------------------------------------------------------------- +\end{verbatim}} +\medskip +\par +mime-setup ¤ò»È¤¦¾ì¹ç¤Ï¡¢mime.el ¤¬É¬ÍפǤ¹¡£¤Þ¤¿¡¢SuperCite ¤ò»È¤¦ +¾ì¹ç¤Ï¡¢SuperCite ¤âɬÍפǤ¹¡£ +\end{document} diff --git a/decode-b.c b/decode-b.c new file mode 100644 index 0000000..2bf63ea --- /dev/null +++ b/decode-b.c @@ -0,0 +1,64 @@ +/* + * $Id: decode-b.c,v 1.1 1994/07/22 06:22:43 morioka Exp morioka $ + */ + +#include +#include + +int get_base64_char_value(int chr) +{ + if( ('A' <= chr) && (chr <= 'Z') ){ + return chr - 'A'; + } + else if( ('a' <= chr) && (chr <= 'z') ){ + return chr - 'a' + 26; + } + else if( ('0' <= chr) && (chr <= '9') ){ + return chr - '0' + 52; + } + else if(chr == '+'){ + return 62; + } + else if(chr == '/'){ + return 63; + } + return -1; +} + +main() +{ + FILE* rfp = stdin; + FILE* wfp = stdout; + char str[128]; + char* sp; + int ret; + unsigned long int value; + unsigned char* buf = (void*)&value; + + while(fgets(str, 128, rfp)){ + for(sp = str; *sp; ){ + if( (*sp == '\r') || (*sp == '\n') ) break; + value = get_base64_char_value(*sp++) * 64 * 64 * 64; + ret = get_base64_char_value(*sp++); + value += ret * 64 * 64; + ret = get_base64_char_value(*sp++); + if(ret >= 0){ + value += ret * 64; + ret = get_base64_char_value(*sp++); + if(ret >= 0){ + value += ret; + fwrite(&buf[1], 1, 3, wfp); + } + else{ + fwrite(&buf[1], 1, 2, wfp); + return 0; + } + } + else{ + fwrite(&buf[1], 1, 1, wfp); + return 0; + } + } + } + return 0; +} diff --git a/methods/tm-au b/methods/tm-au new file mode 100755 index 0000000..52e053e --- /dev/null +++ b/methods/tm-au @@ -0,0 +1,37 @@ +#!/bin/csh + +switch( $4 ) +case "play": + set filename = /dev/audio + breaksw +case "extract": + if( $5 == "" ) then + set filename = "/tmp/mime$$.au" + else + set filename = "/tmp/$5" + endif + breaksw +default: + exit -1 +endsw + +echo "$2; $3 -> $filename" + +switch( $3 ) +case "7bit": +case "8bit": +case "binary": + /bin/cp $1 $filename + breaksw +case "base64": + decode-b < $1 > $filename + breaksw +case "quoted-printable": + mmencode -q -u $1 > $filename + breaksw +default: + echo "unkown encoding" + exit -1 +endsw + +/bin/rm $1 diff --git a/methods/tm-file b/methods/tm-file new file mode 100755 index 0000000..92b16c0 --- /dev/null +++ b/methods/tm-file @@ -0,0 +1,34 @@ +#!/bin/csh + +if( $5 == "" ) then + set filename="/tmp/mime$$" +else + set filename = /tmp/$5 +endif + +echo "$2; $3 -> $filename" + +switch ( $3 ) +case "7bit": +case "8bit": +case "binary": + /bin/cp $1 $filename + breaksw +case "base64": + decode-b < $1 > $filename + breaksw +case "quoted-printable": + mmencode -q -u $1 > $filename + breaksw +case "x-uue": + pushd /tmp + uudecode $1 + popd + breaksw +default: + echo "unkown encoding" + exit -1 +endsw + +/bin/rm $1 +echo "$1 was removed." diff --git a/methods/tm-image b/methods/tm-image new file mode 100755 index 0000000..852d822 --- /dev/null +++ b/methods/tm-image @@ -0,0 +1,50 @@ +#!/bin/csh + +if( $5 == "" ) then + switch ( $2 ) + case "image/gif": + set filename="/tmp/mime$$.gif" + breaksw + case "image/jpeg": + set filename="/tmp/mime$$.jpg" + breaksw + case "image/x-xwd": + set filename="/tmp/mime$$.xwd" + breaksw + case "image/x-xbm": + set filename="/tmp/mime$$.xbm" + breaksw + case "image/x-pic": + set filename="/tmp/mime$$.pic" + breaksw + default: + set filename="/tmp/mime$$.img" + endsw +else + set filename = /tmp/$5 +endif + +echo "$2; $3 -> $filename" + +switch( $3 ) +case "7bit": +case "8bit": +case "binary": + /bin/cp $1 $filename + breaksw +case "base64": + decode-b < $1 > $filename + breaksw +endsw + +/bin/rm $1 + +switch( $4 ) +case "play": + xv -geometry +1+1 $filename + /bin/rm $filename + breaksw +case "extract": + echo "extract to $filename" + breaksw +endsw diff --git a/methods/tm-latex b/methods/tm-latex new file mode 100755 index 0000000..8648050 --- /dev/null +++ b/methods/tm-latex @@ -0,0 +1,56 @@ +#!/bin/csh +# +# tm-latex: method for LaTeX +# + +set filename="/tmp/mime$$" + +switch ( $3 ) +case "7bit": +case "8bit": +case "binary": + /bin/cp $1 $filename.tex + breaksw +case "base64": + decode-b < $1 > $filename.tex + breaksw +case "quoted-printable": + mmencode -q -u $1 > $filename + breaksw +default: + echo "unkown encoding" + exit -1 +endsw + +/bin/rm $1 + +echo "$2; $3 -> $filename.tex" + +switch ( $4 ) +case "play": + pushd /tmp + jlatex $filename.tex + jlatex $filename.tex + xdvi $filename.dvi + popd + /bin/rm $filename.* + breaksw +case "extract": + if($5 != "") then + set name=/tmp/$5 + /bin/cp $filename.tex $name + /bin/rm $filename.tex + echo "extract to $name" + else + echo "extract to $filename.tex" + endif + breaksw +case "print": + pushd /tmp + jlatex $filename.tex + jlatex $filename.tex + dvi2ps $filename.dvi|lpr + popd + /bin/rm $filename.* + breaksw +endsw diff --git a/methods/tm-mpeg b/methods/tm-mpeg new file mode 100755 index 0000000..c5324f7 --- /dev/null +++ b/methods/tm-mpeg @@ -0,0 +1,38 @@ +#!/bin/csh + +if( $5 == "" ) then + set filename = /tmp/mime$$.mpg +else + set filename = /tmp/$5 +endif + +echo "$2; $3 -> $filename" + +switch( $3 ) +case "7bit": +case "8bit": +case "binary": + /bin/cp $1 $filename + breaksw +case "base64": + decode-b < $1 > $filename + breaksw +case "quoted-printable": + mmencode -q -u $1 > $filename + breaksw +default: + echo "unkown encoding" + exit -1 +endsw + +/bin/rm $1 + +switch( $4 ) +case "play": + mpeg_play -dither gray $filename + /bin/rm $filename + breaksw +case "extract": + echo "extrtact to $filename" + breaksw +endsw diff --git a/methods/tm-plain b/methods/tm-plain new file mode 100755 index 0000000..9800cdf --- /dev/null +++ b/methods/tm-plain @@ -0,0 +1,42 @@ +#!/bin/csh + +if( $5 == "" ) then + set filename="/tmp/mime$$.pln" +else + set filename = /tmp/$5 +endif + +echo "$2; $3 -> $filename" + +switch ( $3 ) +case "7bit": +case "8bit": +case "binary": + cp $1 $filename + breaksw +case "base64": + decode-b < $1 > $filename + breaksw +case "quoted-printable": + mmencode -q -u $1 > $filename + breaksw +default: + echo "unkown encoding" + exit -1 +endsw + +/bin/rm $1 + +switch( $4 ) +case "play": + cat $filename + /bin/rm $filename + breaksw +case "extract": + echo "extract to $filename" + breaksw +case "print": + txt2ps -n $filename | lpr + /bin/rm $filename + breaksw +endsw diff --git a/mime-setup.el b/mime-setup.el new file mode 100644 index 0000000..b007247 --- /dev/null +++ b/mime-setup.el @@ -0,0 +1,297 @@ +;;; +;;; $Id: mime-setup.el,v 1.14 1994/08/01 05:12:01 morioka Exp $ +;;; + +(provide 'mime-setup) + + +;;; @ for Emacs 18 +;;; +(if (< (string-to-int emacs-version) 19) + (progn + (require 'tl-18) + (defvar buffer-undo-list nil) + )) + + +;;; @ variables +;;; +(defvar mime-setup-use-sc t) + + +;;; @ for Edit MIME mode +;;; +(autoload 'mime-mode "mime" "Edit MIME message." t) +(autoload 'mime-convert-buffer "mime" "convert to MIME." t) + +(autoload 'mime/encode-message-header "tiny-mime" + "convert message header to MIME style." t) + +(autoload 'insert-signature "signature" "Insert signature" t) + +(add-hook 'mime-mode-hook + (function + (lambda () + (define-key (current-local-map) + "\C-c\C-s" (function insert-signature)) + ))) +(setq mime-translate-hook (function mime/encode-message-header)) + +(if (boundp 'MULE) + (progn + (defun mime-header-charset-chooser-for-mule-no-encode-ISO-2022-JP (begin end) + (let ((lclist (find-charset-region begin end))) + (cond ((null lclist) nil) ;US-ASCII requres no encoding. + ((memq lc-ltn1 lclist) + '("ISO-8859-1" . "Q")) + ((memq lc-ltn2 lclist) + '("ISO-8859-2" . "Q")) + ((memq lc-ltn3 lclist) + '("ISO-8859-3" . "Q")) + ((memq lc-ltn4 lclist) + '("ISO-8859-4" . "Q")) + ((memq lc-crl lclist) + '("ISO-8859-5" . "Q")) + ;;((memq lc-arb lclist) + ;; '("ISO-8859-6" . "Q")) + ((memq lc-grk lclist) + '("ISO-8859-7" . "Q")) + ((memq lc-hbw lclist) + '("ISO-8859-8" . "Q")) + ((memq lc-ltn5 lclist) + '("ISO-8859-9" . "Q")) + ((memq lc-jp lclist) nil) + (t ;Unknown charset. It must be Mule! + '("X-ISO-2022-JP-2" . "B")) + ))) + (setq mime-header-charset-chooser + 'mime-header-charset-chooser-for-mule-no-encode-ISO-2022-JP) + ) + (progn + (defun mime-header-charset-chooser-for-nemacs-no-encode-ISO-2022-JP (begin end)) + (setq mime-header-charset-chooser + 'mime-header-charset-chooser-for-nemacs-no-encode-ISO-2022-JP) + )) + +(setq mime-content-types + '(("text" + ;; Charset parameter need not to be specified, since it is + ;; defined automatically while translation. + ("plain" + ;;("charset" "" "ISO-2022-JP" "US-ASCII" "ISO-8859-1" "ISO-8859-8") + ) + ("richtext" + ;;("charset" "" "ISO-2022-JP" "US-ASCII" "ISO-8859-1" "ISO-8859-8") + ) + ("x-latex" + ("x-name") + ;;("charset" "" "ISO-2022-JP" "US-ASCII" "ISO-8859-1" "ISO-8859-8") + )) + ("message" + ("external-body" + ("access-type" + ("anon-ftp" + ("site" "wnoc-fuk.wide.ad.jp" "nic.karrn.ad.jp") + ("directory") + ("name") + ("mode" "binary" "ascii")) + ("ftp" + ("site") + ("directory") + ("name") + ("mode" "binary" "ascii")) + ("tftp" + ("site") + ("name")) + ("afs" + ("site") + ("name")) + ("local-file" + ("site") + ("name")) + ("mail-server" + ("server")))) + ("rfc822")) + ("application" + ("octet-stream" + ("name") + ("type" "" "tar" "shar") + ("conversions")) + ("postscript") + ("x-kiss" + ("x-name") + ("x-cnf"))) + ("image" + ("gif" ("x-name")) + ("jpeg" ("x-name")) + ("x-pic" ("x-name")) + ("x-xwd") + ("x-xbm")) + ("audio" + ("basic")) + ("video" + ("mpeg"))) + ) + +(setq mime-file-types + '(("\\.rtf$" "text" "richtext" nil nil) + ("\\.ps$" "application" "postscript" nil "quoted-printable") + ("\\.gif$" "image" "gif" nil "base64") + ("\\.jpg$" "image" "jpeg" nil "base64") + ("\\.xwd$" "image" "x-xwd" nil "base64") + ("\\.xbm$" "image" "x-xbm" nil "base64") + ("\\.PIC$" "image" "x-pic" nil "base64") + ("\\.pic$" "image" "x-pic" nil "base64") + ("\\.tiff$" "image" "x-tiff" nil "base64") + ("\\.au$" "audio" "basic" nil "base64") + ("\\.mpg$" "video" "mpeg" nil "base64") + ("\\.el$" "application" "octet-stream" nil "7bit") + ("\\.signature" "text" "plain" nil nil) + (".*" nil nil nil nil)) + ) + +(add-hook 'news-reply-mode-hook (function mime/decode-message-header)) + + +;;; @ about SuperCite +;;; +(if mime-setup-use-sc + (progn + ;; + ;; SuperCite + ;; + (autoload 'sc-cite-original "sc" nil t) + (setq sc-citation-leader "") + (if (and (boundp 'MULE) MULE) + ;; for MULE + (setq sc-cite-regexp + "\\s *\\([a-zA-Z0-9]\\|\\cj\\)*>+\\s *") + ;; for Nemacs + (setq sc-cite-regexp + "\\s *\\([a-zA-Z0-9]\\|\\cc\\|\\cC\\|\\ch\\|\\cH\\|\\ck\\|\\cK\\)*>+\\s *") + ) + + (defun my-sc-overload-hook () + (require 'sc-oloads) + (sc-overload-functions) + ) + + ;; for all but MH-E + (setq mail-yank-hooks 'sc-cite-original) + + ;; for RMAIL, PCMAIL, GNUS + (add-hook 'mail-setup-hook (function my-sc-overload-hook)) + + ;; for Gnus + (add-hook 'news-reply-mode-hook (function my-sc-overload-hook)) + (add-hook 'gnews-ready-hook (function my-sc-overload-hook)) + + ;; for mh-e + (add-hook 'mh-letter-mode-hook (function my-sc-overload-hook)) + (setq mh-yank-hooks 'sc-cite-original) ; for MH-E only + + ;; + ;; sc-register + ;; + ;; (setq sc-load-hook + ;; '(lambda () + ;; (require 'sc-register) + ;; (setq sc-rewrite-header-list + ;; (append sc-rewrite-header-list + ;; (list (list 'sc-header-in-Japanese)) + ;; )) + ;; (setq sc-preferred-header-style + ;; (- (length sc-rewrite-header-list) 1)) + ;; )) + (setq sc-preferred-attribution 'registeredname) + )) + + +;;; @ for mh-e +;;; +(add-hook 'mh-folder-mode-hook + (function + (lambda () + (require 'tm-mh-e) + ))) +(if (boundp 'NEMACS) + (add-hook 'mh-letter-mode-hook + (function + (lambda () + (setq kanji-fileio-code 2) + ))) + ) +(add-hook 'mh-letter-mode-hook (function mime/decode-message-header)) +(add-hook 'mh-letter-mode-hook + (function + (lambda () + (mime-mode) + (make-local-variable 'mail-header-separator) + (setq mail-header-separator "--------")) + )) + + +;;; @ for GNUS +;;; +(let ((le (function + (lambda () + (require 'tm-gnus) + ))) + ) + (if (boundp 'MULE) + (progn + (add-hook 'gnus-Group-mode-hook (function gnusutil-initialize)) + (add-hook 'gnus-group-mode-hook (function gnusutil-initialize)) + (autoload 'gnusutil-initialize "gnusutil") + (autoload 'gnusutil-add-group "gnusutil") + (add-hook 'gnusutil-initialize-hook le) + ) + (progn + (add-hook 'gnus-Startup-hook le) + (add-hook 'gnus-startup-hook le) + ))) + +(add-hook 'news-reply-mode-hook (function mime-mode)) +(setq gnus-signature-file nil) + + +;;; @ for RMAIL +;;; +(autoload 'rmail-show-mime "rmailmime" "Show MIME messages." t) +(autoload 'rmail-convert-mime-header "rmailmime" "Convert MIME header." nil) +(setq rmail-message-filter 'mime/decode-message-header) +(add-hook 'rmail-mode-hook + (function + (lambda () + ;; Forward mail using MIME. + (require 'mime) + (substitute-key-definition 'rmail-forward + 'mime-forward-from-rmail-using-mail + (current-local-map)) + (local-set-key "v" 'rmail-show-mime) + ))) + + +;;; @ for Mail mode (includes VM mode) +;;; +(add-hook 'mail-mode-hook (function mime-mode)) +(add-hook 'mail-setup-hook (function mime/decode-message-header)) + +;;; @@ In VM, the following definitions may be requried: +;;; +(if (boundp 'vm-visible-headers) + (progn + (setq vm-preview-lines nil) + (setq vm-invisible-header-regexp nil) + (setq vm-visible-headers + (append vm-visible-headers + '("Mime-Version:" + "Content-Type:" + "Content-Transfer-Encoding:"))) + )) + +;;; Local Variables: +;;; mode: emacs-lisp +;;; mode: outline-minor +;;; outline-regexp: ";;; @+\\|(......" +;;; End: diff --git a/ol2.c b/ol2.c new file mode 100644 index 0000000..20db10b --- /dev/null +++ b/ol2.c @@ -0,0 +1,76 @@ +/* + * This program `out2' is a converter + * from a text for outline-mode of GNU Emacs to normal text. + * This is a filter. So, input is `stdin', output is `stdout'. + * + * Copyright 1992, Timtia Software. + * + * This program is Copyfree. + */ + +#include + +main() +{ + unsigned char depth=0, offset=1; + + for(;;){ + char str[256], *cp; + unsigned short section[255]; + unsigned char d; + unsigned short i; + unsigned short code; + + if(gets(str)==NULL) break; + + for(d=0, cp=str; ;d++){ + if(*cp++!='*') break; + } + if(*--cp==' ') cp++; + if(d==0){ + puts(str); + } + else if(d==1){ + if(d>depth){ + depth=d; + section[0]=0; + } + else if(d==depth){ + section[0]++; + } + else{ + depth=d; + section[0]++; + } + code=0xa3b0+section[0]+offset; + printf("%c%c %s\n", code>>8,code&0xff, cp); + } + else if(d==depth){ + section[depth-1]++; + for(i=0; idepth){ + for(i=0; il9g$O(B .emacs $B$K0J2<$N$h$&$J$b(B +$B$N$rF~$l$F2<$5$$!#(B + +[[E +---------------------------------------------------------------------- +(setq signature-file-alist + '( + (("Newsgroups" . "jokes") . "~/.signature-jokes") + (("Newsgroups" . ("zxr" "nzr")) . "~/.signature-sun") + (("To" . ("ishimaru" "z-suzuki")) . "~/.signature-sun") + (("To" . "tea") . "~/.signature-jokes") + (("To" . ("sim" "oku" "takuo")) . "~/.signature-formal") + )) +---------------------------------------------------------------------- +]]E + + $B$^$?!"(B*insert-signature* $B$K?t0z?t$rM?$($k$3$H$K$h$j!"BPOCE*$K(B +`signature-file-name'-DISTRIBUTION $B$N7A$NL>A0$r;}$D%U%!%$%k$r;XDj(B +$B$9$k$3$H$,$G$-$^$9!#Nc$($P(B `C-u C-c C-s'(*insert-signature*) $B$H(B +$BF~NO$9$k$H!"%_%K%P%C%U%!$G(B + + Insert your signature: ~/.signature- + +$B$HJ9$$$F$-$^$9$N$G!"@ZBXMQ$KMQ0U$5$l$?%U%!%$%k$N$J$+$+$i!"5a$a$k$b$N$r(B +$B%3%s%W%j!<%7%g%s$r;H$C$FMQ0U$KA*Br$9$k$3$H$,$G$-$^$9!#6uJ8;zNs$r(B +$BF~NO$9$l$P!"(B`signature-file-name' $B$G;XDj$5$l$k%U%!%$%k$,FI$_9~$^$l$^$9!#(B diff --git a/signature-jp.tex b/signature-jp.tex new file mode 100644 index 0000000..ed7b800 --- /dev/null +++ b/signature-jp.tex @@ -0,0 +1,56 @@ +\documentstyle[a4j]{jarticle} +\setcounter{secnumdepth}{6} +\setcounter{tocdepth}{6} +\topsep=0.1cm +\parsep=0.1cm +\itemsep=0.0cm +\begin{document} +\title{ +signature.el ÀâÌÀ½ñ} +\author{ +²¬Éô ¼÷ÃË\\ +} +\date{ +1994ǯ8·î1Æü} +\maketitle +\medskip +\par +signature.el ¤Ï signature ¤Î¼«Æ°ÀÚÂؤ¨ tool ¤Ç¤¹¡£*insert-signature* +¤ò¹Ô¤¦¤³¤È¤Ë¤è¤ê¡¢`signature-insert-at-eof' ¤ÎÃͤ¬ non-nil ¤Î¤È¤­¥Ð¥Ã +¥Õ¥¡¤ÎËöÈø¤Ë¡¢nil ¤Î¤È¤­¤Ï¥«¥ì¥ó¥È¥Ý¥¤¥ó¥È¤Ë¡¢signature ¥Õ¥¡¥¤¥ë¤¬ÆÉ¤ß +¹þ¤Þ¤ì¤Þ¤¹¡£É¸½àŪ¤Êsignature ¤Ï¡¢ÊÑ¿ô `signature-file-name' ¤Ç»ØÄꤷ +¤Æ²¼¤µ¤¤(¥Ç¥Õ¥©¥ë¥ÈÃÍ¤Ï "\verb+~+/.signature")¡£message header ¤Î field ¤Ë¹ç +¤ï¤»¤Æ signature ¤Î¼«Æ°ÀÚÂؤò¹Ô¤Ê¤¤¤¿¤¤¾ì¹ç¤Ï .emacs ¤Ë°Ê²¼¤Î¤è¤¦¤Ê¤â +¤Î¤òÆþ¤ì¤Æ²¼¤µ¤¤¡£ +\medskip +{\baselineskip=10pt +\begin{verbatim} +---------------------------------------------------------------------- +(setq signature-file-alist + '( + (("Newsgroups" . "jokes") . "~/.signature-jokes") + (("Newsgroups" . ("zxr" "nzr")) . "~/.signature-sun") + (("To" . ("ishimaru" "z-suzuki")) . "~/.signature-sun") + (("To" . "tea") . "~/.signature-jokes") + (("To" . ("sim" "oku" "takuo")) . "~/.signature-formal") + )) +---------------------------------------------------------------------- +\end{verbatim}} +\medskip +\par +¤Þ¤¿¡¢*insert-signature* ¤Ë¿ô°ú¿ô¤òÍ¿¤¨¤ë¤³¤È¤Ë¤è¤ê¡¢ÂÐÏÃŪ¤Ë +`signature-file-name'-DISTRIBUTION ¤Î·Á¤Î̾Á°¤ò»ý¤Ä¥Õ¥¡¥¤¥ë¤ò»ØÄê +¤¹¤ë¤³¤È¤¬¤Ç¤­¤Þ¤¹¡£Î㤨¤Ð `C-u C-c C-s'(*insert-signature*) ¤È +ÆþÎϤ¹¤ë¤È¡¢¥ß¥Ë¥Ð¥Ã¥Õ¥¡¤Ç +\medskip +{\list{}{\leftmargin=4ex}\item[] +\begin{description} +\item[Insert your signature:]\verb+~+/.signature- +\medskip +\end{description} +\endlist} +\par +¤Èʹ¤¤¤Æ¤­¤Þ¤¹¤Î¤Ç¡¢ÀÚÂØÍѤËÍÑ°Õ¤µ¤ì¤¿¥Õ¥¡¥¤¥ë¤Î¤Ê¤«¤«¤é¡¢µá¤á¤ë¤â¤Î¤ò +¥³¥ó¥×¥ê¡¼¥·¥ç¥ó¤ò»È¤Ã¤ÆÍÑ°Õ¤ËÁªÂò¤¹¤ë¤³¤È¤¬¤Ç¤­¤Þ¤¹¡£¶õʸ»úÎó¤ò +ÆþÎϤ¹¤ì¤Ð¡¢`signature-file-name' ¤Ç»ØÄꤵ¤ì¤ë¥Õ¥¡¥¤¥ë¤¬Æɤ߹þ¤Þ¤ì¤Þ¤¹¡£ +\end{document} diff --git a/signature.el b/signature.el new file mode 100644 index 0000000..c1362d2 --- /dev/null +++ b/signature.el @@ -0,0 +1,98 @@ +;;; +;;; $Id: signature.el,v 1.6 1994/08/03 04:42:40 morioka Exp $ +;;; Modified by Yasuo OKABE 1994/08/01 +;;; + +(provide 'signature) + +(require 'tl-header) + +(defvar signature-insert-at-eof nil + "*Insert signature at the end of file if non-nil.") + +(defvar signature-file-name "~/.signature" + "*Name of file containing the user's signature.") + +(defvar signature-file-alist nil) + +;;; +;;; Example: +;;; +;;; (setq signature-file-alist +;;; '((("Newsgroups" . "zxr") . "~/.signature-sun") +;;; (("To" . "uramimi") . "~/.signature-sun") +;;; (("Newsgroups" . "jokes") . "~/.signature-jokes") +;;; (("To" . "tea") . "~/.signature-jokes") +;;; (("To" . ("sim" "oku")) . "~/.signature-formal") +;;; )) + +(defun signature/get-signature-file-name () + (catch 'tag + (let ((r signature-file-alist) cell b f) + (while r + (setq cell (car r)) + (setq b (car cell)) + (if (setq f (message/get-field-body (car b))) + (cond ((listp (cdr b)) + (let ((r (cdr b))) + (while r + (if (string-match (car r) f) + (throw 'tag (cdr cell)) + ) + (setq r (cdr r)) + )) + ) + ((stringp (cdr b)) + (if (string-match (cdr b) f) + (throw 'tag (cdr cell)) + )) + )) + (setq r (cdr r)) + )) + signature-file-name)) + +(defun signature/insert-signature-at-point (&optional arg) + "Insert the file named by signature-file-name at the current point." + (interactive "P") + (let ((signature + (expand-file-name + (if arg + (read-file-name "Insert your signature: " + (concat signature-file-name "-") + signature-file-name + nil) + (signature/get-signature-file-name))))) + (insert-file-contents signature) + (set-buffer-modified-p (buffer-modified-p)))) ; force mode line update + +(defun signature/insert-signature-at-eof (&optional arg) + "Insert the file named by signature-file-name at the end of file." + (interactive "P") + (let ((signature + (expand-file-name + (if arg + (read-file-name "Insert your signature: " + (concat signature-file-name "-") + signature-file-name + nil) + (signature/get-signature-file-name))))) + (save-excursion + (if (file-readable-p signature) + (progn + (goto-char (point-max)) + (if (not (bolp)) + (insert "\n")) + (delete-blank-lines) + (insert-file-contents signature) + (set-buffer-modified-p (buffer-modified-p)) ; force mode line update + ))))) + +(defun insert-signature (&optional arg) + "Insert the file named by signature-file-name. It is inserted at the +end of file if signature-insert-at-eof in non-nil, and otherwise at +the current point. A prefix argument enables user to specify a file +named -DISTRIBUTION interactively." + (interactive "P") + (if signature-insert-at-eof + (call-interactively 'signature/insert-signature-at-eof) + (call-interactively 'signature/insert-signature-at-point))) diff --git a/tiny-mime-jp.ol b/tiny-mime-jp.ol new file mode 100644 index 0000000..2b5368d --- /dev/null +++ b/tiny-mime-jp.ol @@ -0,0 +1,260 @@ +$B!X(Btiny-mime.el $B@bL@=q!Y(B +by. $Be$GF0:n$9$k(B MIME message +header $B$N(B encoder/decoder $B$G$9!#%*%j%8%J%k$O!"@N!"$($J$_(B $B$D$0$H$b(B $B$5$s(B +$B$,(B fj.editor.emacs $B$KEj9F$5$l$?(B MIME message header $B$N(B decoder $B$G$9!#(B + + $B8=:_$G$O!"Ev;~$N$b$N$KHf$Y!"(B + + $B!&(Bdecoding $B;~$K$*$1$k(B unfolding $B5!G=(B + $B!&(BISO-2022-JP $B$K2C$(!"(BISO-8859-*, US-ASCII $B$J$I$N(B encoding/decoding + $B!&(BQ-encoding $B$N(B decoding + +$B$H$$$C$?5!G=$r;}$C$F$$$^$9!#(B + + +* tiny-mime.el $B$N%5%]!<%H$9$k(B character set, encoding + + tiny-mime.el $B$O!"e$G!"(B + + M-x mime/decode-message-header + +$B$re$G!"(B + + M-x mime/encode-message-header + +$B$rl9g!"(Btiny-mime.el $B$,(B encode $B$7$J$/$F$b!"(B +mime.el $B$,(B encode $B$9$k$N$G!"(Bmime.el $B$N(B message header encoder $B$,F/$+$J(B +$B$$$h$&$K$K@_Dj$7$^$9!#(B + +** mime/use-X-Nsubject + + $B$3$NJQ?t$NCM$,(B t $B$N>l9g!"(Bmessage header $B$r(B encode $B$9$k;~!"(Bencode $B$7(B +$B$?7k2L!"(BSubject $B$K(B encoded-word $B$,4^$^$l$k>l9g!"(BSubject $B$r(B decode $B$7$?(B +$B$b$N$rF~$l$?(B X-Nsubject $B$r:n@.$7$^$9!#(B + + default $B$G$O(B nil $B$,;XDj$5$l$F$$$^$9!#(B + +$B!NCm0U!O(BMule $B$G(B ISO-2022-JP $B$K4^$^$l$k$b$N0J30$NJ8;z=89g$r;H$&>l9g$O!"(B +$B$3$l$r;XDj$7$J$$J}$,8-L@$G$9!#(B + +** mail-header-separator + + $B4X?t(B mime/encode-message-header $B$K$*$1$k(B message header $B$H(B body part +$B$N6h@Z$j$rI=$9JQ?t$G$9!#Nc$($P!"(BGNUS $B$G$O(B "--text follows this line--" +$B$,;XDj$5$l$^$9!#(B + +$B!NCm0U!O$3$NJQ?t$NJ8;zNs$O!"(Bversion 2.6 $B$h$j@55,I=8=$G$O$J$/$J$j$^$7$?!#(B + + +* mailer, news reader $B$X$NAH$_9~$_(B + + $BF|>oE*$K!"L50U<1$K(B MIME header $B$rK\Mh$N8@8l$G8+$?$$$H$$$&$N$OEvA3$N(B +$BM_5a$G$9!#$=$3$G!"(Btiny-mime.el $B$r(B mailer $B$d(B news reader $B$KAH$_9~$`$H<+(B +$BF0E*$K(B MIME header $B$N(B encode/decode $B$,$G$-$^$9!#(B + + $B$^$?!"(Bmetamail $B$r;H$C$F$*$i$l$kJ}$G$b!"IaCJ$O(B message header $B$N(B +decode $B$@$1$GNI$/$F!"3($d2;$J$I$r:F@8$9$k;~$@$1(B metamail $B$r;H$&$H$$$&(B +$B$h$&$J;H$$J}$b$G$-$^$9!#(B + + $B$3$NL\E*$rl9g$N$?$a$K!"(B + + (mime/decode-string $BJ8;zNs(B) + +$B$H$$$&4X?t$bMQ0U$7$F$$$^$9!#(B + + GNUS $B$H(B mh-e $B$K4X$7$F$O!"(Btm-gnus, tm-mh-e $B$H$$$&(B MIME $BBP1~2=%b%8%e!<(B +$B%k$rMQ0U$7$F$$$^$9!#(B + + $B$3$l$i$N!"3F(B MUA $B$KBP1~$9$k%b%8%e!<%k$r(B load $B$9$k$H(B tiny-mime.el $B$K(B +$B$h$k(B MIME header $B$NI|85$H(B tm-body $B$rMxMQ$7$?(B MIME body $B$N:F@8$,9T$J$((B +$B$^$9!#(B + + $B>\$7$/$O!"$=$l$>$l$N@bL@=q$r$*FI$_2<$5$$!#(B + + +* mime.el $B$H$NJ;MQ(B + + mime.el $B$HJ;MQ$9$kNc$r<($7$^$9!#$3$NNc$N>l9g!"(BISO-2022-JP $BJ8;zNs$N(B +encode $B$O(B tiny-mime.el $B$,9T$J$$!"$=$l0J30$NJ8;z=89g$KB0$9$kJ8;zNs$O(B +mime.el $B$,(B encode $B$7$^$9!#(B + + $B$^$?!"(Btiny-mime.el $B$,(B encode $B$7$J$+$C$?J8;zNs$b(B mime.el $B$,(B encode $B$9(B +$B$k$N$G!"7k2LE*$K!"I,$:A4$F$N(B field $B$,(B encode $B$5$l$k$3$H$KCm0U$7$F2<$5(B +$B$$!#(B + +[[E +---------------------------------------------------------------------- +;;; +;;; for Edit MIME mode +;;; +(autoload 'mime-mode "mime" "Edit MIME message." t) +(autoload 'mime-convert-buffer "mime" "convert to MIME." t) +(autoload 'insert-signature "signature" "Insert signature" t) +(add-hook 'mime-mode-hook + (function + (lambda () + (define-key (current-local-map) + "\C-c\C-s" (function insert-signature)) + ))) + +;; MIME header $B$N(B encoder $B$r(B tiny-mime $B$N$b$N$r;H$&!#(B +(setq mime-translate-hook 'mime/encode-message-header) + +;;; +;;; for GNUS +;;; +(add-hook 'news-reply-mode-hook (function mime-mode)) +(setq gnus-signature-file nil) + +;;; +;;; for mh-e +;;; +(add-hook 'mh-letter-mode-hook + (function + (lambda () + (mime/decode-message-header) + (mime-mode) + (make-local-variable 'mail-header-separator) + (setq mail-header-separator "--------")) + )) +---------------------------------------------------------------------- +]]E + +** $BFCDj$N(B field $B$r(B encode $B$7$?$/$J$$>l9g(B + + $BFCDj$N(B field $B$r(B encode $B$7$?$/$J$$>l9g!"(Btiny-mime.el $B$NJQ?t(B +mime/no-encoding-header-fields $B$K$h$C$F!"(Btiny-mime.el $B$K$h$k(B encode $B$r(B +$B$d$a$k$3$H$,$G$-$^$9$,!"(Bmime.el $B$,(B encode $B$9$k$N$G$O0UL#$,$"$j$^$;$s!#(B +$B$=$3$G!"l9g$O!"(Bnil $B$r;XDj$9$k!#(B + charset: MIME $B$N(B charset. + encoding: encode $B$9$k:]$N(B encoding. + + + $BNc!'(B KS C5601-1987 $B$r(B EUC-KR $B$N(B B encoding $B$9$k$h$&$K@_Dj$9$k(B + + (mime/set-charset-and-encoding lc-kr *euc-kr* "EUC-KR" "B") + + + $BNc!'(B koi8-r $B$r(B Q encoding $B$9$k$h$&$K@_Dj$9$k!#(B + + (mime/set-charset-and-encoding lc-prv11 nil "KOI8-R" "Q") + + +$B!NCm0U!O8=:_$N$H$3$m!"(Bprivate character $B$N@_Dj$OFq$"$j$G$9!#(B(^_^; diff --git a/tiny-mime-jp.tex b/tiny-mime-jp.tex new file mode 100644 index 0000000..3beb18b --- /dev/null +++ b/tiny-mime-jp.tex @@ -0,0 +1,353 @@ +\documentstyle[a4j]{jarticle} +\setcounter{secnumdepth}{6} +\setcounter{tocdepth}{6} +\topsep=0.1cm +\parsep=0.1cm +\itemsep=0.0cm +\begin{document} +\title{ +tiny-mime.el ÀâÌÀ½ñ} +\author{ +¼é²¬ ÃÎɧ\\ +} +\date{ +1994ǯ7·î27Æü} +\maketitle +\medskip +\par +¤³¤ÎÀâÌÀ½ñ¤Ï ol2 ¤È plain2 ¤òÍѤ¤¤ë¤³¤È¤Ë¤è¤Ã¤Æ LaTeX ·Á¼°¤ËÊÑ´¹¤¹¤ë +¤³¤È¤¬¤Ç¤­¤Þ¤¹¡£ +\medskip +\medskip + +\section{tiny-mime.el ¤È¤Ï} +\medskip +\par +tiny-mime.el ¤Ï Mule, NEmacs, NEpoch ¾å¤ÇÆ°ºî¤¹¤ë MIME message +header ¤Î encoder/decoder ¤Ç¤¹¡£¥ª¥ê¥¸¥Ê¥ë¤Ï¡¢ÀΡ¢¤¨¤Ê¤ß ¤Ä¤°¤È¤â ¤µ¤ó +¤¬ fj.editor.emacs ¤ËÅê¹Æ¤µ¤ì¤¿ MIME message header ¤Î decoder ¤Ç¤¹¡£ +\medskip +\par +¸½ºß¤Ç¤Ï¡¢Åö»þ¤Î¤â¤Î¤ËÈæ¤Ù¡¢ +\medskip +\begin{itemize} +\item decoding »þ¤Ë¤ª¤±¤ë unfolding µ¡Ç½ +\item ISO-2022-JP ¤Ë²Ã¤¨¡¢ISO-8859-*, US-ASCII ¤Ê¤É¤Î encoding/decoding +\item Q-encoding ¤Î decoding +\medskip +\end{itemize} +\par +¤È¤¤¤Ã¤¿µ¡Ç½¤ò»ý¤Ã¤Æ¤¤¤Þ¤¹¡£ +\medskip +\medskip + +\section{tiny-mime.el ¤Î¥µ¥Ý¡¼¥È¤¹¤ë character set, encoding} +\medskip +\par +tiny-mime.el ¤Ï¡¢¼¡¤Î character set, encoding ¤ò¥µ¥Ý¡¼¥È¤·¤Þ¤¹¡£ +\medskip + +\subsection{Mule} +\medskip +\par +ISO-2022-JP, US-ASCII, ISO-8859-1..9, ISO-2022-CN, ISO-2022-KR, +EUC-KR ¤Ê¤É¤Î encoding/decoding ¤ò¥µ¥Ý¡¼¥È¤·¤Þ¤¹¡£¤Þ¤¿¡¢´Ø¿ô +mime/set-charset-and-encoding ¤ÇÄɲá¦Êѹ¹¤¬¤Ç¤­¤Þ¤¹¡£ +\medskip + +\subsection{NEmacs, NEpoch} +\medskip +\par +ISO-2022-JP, US-ASCII ¤Î encoding/decoding ¤ò¥µ¥Ý¡¼¥È¤·¤Þ¤¹¡£ +\medskip +\par +¤Þ¤¿¡¢ISO-8859-*¤Ç¤¢¤Ã¤Æ¤â¡¢encoded-text ¤Ë´Þ¤Þ¤ì¤ëʸ»úÎó¤¬¼ÂºÝ¤Ë¤Ï +ASCII ¤Çɽ¤»¤ëÈϰϤʤéɽ¼¨¤·¤Þ¤¹¡£ +\medskip +\medskip + +\section{tiny-mime.el ¤Î´Êñ¤Ê»È¤¤Êý} +\medskip + +\subsection{decode} +\medskip +\par +tiny-mime.el ¤ò load ¤·¤Æ¡¢decode ¤·¤¿¤¤ buffer ¾å¤Ç¡¢ +\medskip +{\list{}{\leftmargin=8ex}\item[] +\par +M-x mime/decode-message-header +\endlist} +\medskip +\par +¤ò¼Â¹Ô¤·¤Þ¤¹¡£ +\medskip +\par +¤Þ¤¿¡¢decode ¤·¤¿¤¤ region ¤ò +\medskip +{\baselineskip=10pt +\begin{verbatim} + M-x mime/decode-region +\end{verbatim}} +\medskip +\par +¤Ç decode ¤¹¤ë¤³¤È¤¬¤Ç¤­¤Þ¤¹¡£°úÍÑ¤Ê¤É¤Ç body-part ¤Ë»Ä¤Ã¤¿ +encoded-word ¤ò decode ¤¹¤ë¤Î¤ËÊØÍø¤Ç¤·¤ç¤¦¡£ +\medskip + +\subsection{encode} +\medskip +\par +tiny-mime.el ¤ò load ¤·¤Æ¡¢encode ¤·¤¿¤¤ buffer ¾å¤Ç¡¢ +\medskip +{\list{}{\leftmargin=8ex}\item[] +\par +M-x mime/encode-message-header +\endlist} +\medskip +\par +¤ò¼Â¹Ô¤·¤Þ¤¹¡£ +\medskip +\medskip + +\section{tiny-mime.el ¤ÎÊÑ¿ô} +\medskip + +\subsection{mime/no-encoding-header-fields} +\medskip +\par +tiny-mime.el ¤Ç encode ¤·¤Ê¤¤ message header ¤Î field ¤ò»ØÄꤷ¤Þ¤¹¡£ +\medskip +\par +default ¤Ç¤Ï X-Nsubject ¤¬»ØÄꤵ¤ì¤Æ¤¤¤Þ¤¹¡£ +\medskip +\par +Î㡧 X-Nsubject ¤È Subject ¤ò encode ¤·¤Ê¤¤¤è¤¦¤Ë¤¹¤ë¡£ +\medskip +{\baselineskip=10pt +\begin{verbatim} +---------------------------------------------------------------------- +(setq mime/no-encoding-header-fields '("X-Nsubject" "Subject")) +---------------------------------------------------------------------- +\end{verbatim}} +\medskip +\par +¡ÎÃí°Õ¡Ï mime.el ¤ÈÊ»ÍѤ¹¤ë¾ì¹ç¡¢tiny-mime.el ¤¬ encode ¤·¤Ê¤¯¤Æ¤â¡¢ +mime.el ¤¬ encode ¤¹¤ë¤Î¤Ç¡¢mime.el ¤Î message header encoder ¤¬Æ¯¤«¤Ê +¤¤¤è¤¦¤Ë¤ËÀßÄꤷ¤Þ¤¹¡£ +\medskip + +\subsection{mime/use-X-Nsubject} +\medskip +\par +¤³¤ÎÊÑ¿ô¤ÎÃͤ¬ t ¤Î¾ì¹ç¡¢message header ¤ò encode ¤¹¤ë»þ¡¢encode ¤· +¤¿·ë²Ì¡¢Subject ¤Ë encoded-word ¤¬´Þ¤Þ¤ì¤ë¾ì¹ç¡¢Subject ¤ò decode ¤·¤¿ +¤â¤Î¤òÆþ¤ì¤¿ X-Nsubject ¤òºîÀ®¤·¤Þ¤¹¡£ +\medskip +\par +default ¤Ç¤Ï nil ¤¬»ØÄꤵ¤ì¤Æ¤¤¤Þ¤¹¡£ +\medskip +\par +¡ÎÃí°Õ¡ÏMule ¤Ç ISO-2022-JP ¤Ë´Þ¤Þ¤ì¤ë¤â¤Î°Ê³°¤Îʸ»ú½¸¹ç¤ò»È¤¦¾ì¹ç¤Ï¡¢ +¤³¤ì¤ò»ØÄꤷ¤Ê¤¤Êý¤¬¸­ÌÀ¤Ç¤¹¡£ +\medskip + +\subsection{mail-header-separator} +\medskip +\par +´Ø¿ô mime/encode-message-header ¤Ë¤ª¤±¤ë message header ¤È body part +¤Î¶èÀÚ¤ê¤òɽ¤¹ÊÑ¿ô¤Ç¤¹¡£Î㤨¤Ð¡¢GNUS ¤Ç¤Ï "--text follows this line--" +¤¬»ØÄꤵ¤ì¤Þ¤¹¡£ +\medskip +\par +¡ÎÃí°Õ¡Ï¤³¤ÎÊÑ¿ô¤Îʸ»úÎó¤Ï¡¢version 2.6 ¤è¤êÀµµ¬É½¸½¤Ç¤Ï¤Ê¤¯¤Ê¤ê¤Þ¤·¤¿¡£ +\medskip +\medskip + +\section{mailer, news reader ¤Ø¤ÎÁȤ߹þ¤ß} +\medskip +\par +Æü¾ïŪ¤Ë¡¢Ìµ°Õ¼±¤Ë MIME header ¤òËÜÍè¤Î¸À¸ì¤Ç¸«¤¿¤¤¤È¤¤¤¦¤Î¤ÏÅöÁ³¤Î +Íßµá¤Ç¤¹¡£¤½¤³¤Ç¡¢tiny-mime.el ¤ò mailer ¤ä news reader ¤ËÁȤ߹þ¤à¤È¼« +ưŪ¤Ë MIME header ¤Î encode/decode ¤¬¤Ç¤­¤Þ¤¹¡£ +\medskip +\par +¤Þ¤¿¡¢metamail ¤ò»È¤Ã¤Æ¤ª¤é¤ì¤ëÊý¤Ç¤â¡¢ÉáÃÊ¤Ï message header ¤Î +decode ¤À¤±¤ÇÎɤ¯¤Æ¡¢³¨¤ä²»¤Ê¤É¤òºÆÀ¸¤¹¤ë»þ¤À¤± metamail ¤ò»È¤¦¤È¤¤¤¦ +¤è¤¦¤Ê»È¤¤Êý¤â¤Ç¤­¤Þ¤¹¡£ +\medskip +\par +¤³¤ÎÌÜŪ¤ò¼Â¸½¤¹¤ë¤Ë¤Ï¡¢mailer ¤ä news reader ¤ÎŬÀÚ¤Ê hook ¤Ë +mime/decode-message-header ¤òÆþ¤ì¤ì¤ÐÎɤ¤¤Ç¤·¤ç¤¦¡£¤Þ¤¿¡¢Ê¸»úÎó¤Î +decode ¤ò¤·¤¿¤¤¾ì¹ç¤Î¤¿¤á¤Ë¡¢ +\medskip +{\list{}{\leftmargin=8ex}\item[] +\par +(mime/decode-string ʸ»úÎó) +\endlist} +\medskip +\par +¤È¤¤¤¦´Ø¿ô¤âÍÑ°Õ¤·¤Æ¤¤¤Þ¤¹¡£ +\medskip +\par +GNUS ¤È mh-e ¤Ë´Ø¤·¤Æ¤Ï¡¢tm-gnus, tm-mh-e ¤È¤¤¤¦ MIME Âбþ²½¥â¥¸¥å¡¼ +¥ë¤òÍÑ°Õ¤·¤Æ¤¤¤Þ¤¹¡£ +\medskip +\par +¤³¤ì¤é¤Î¡¢³Æ MUA ¤ËÂбþ¤¹¤ë¥â¥¸¥å¡¼¥ë¤ò load ¤¹¤ë¤È tiny-mime.el ¤Ë +¤è¤ë MIME header ¤ÎÉü¸µ¤È tm-body ¤òÍøÍѤ·¤¿ MIME body ¤ÎºÆÀ¸¤¬¹Ô¤Ê¤¨ +¤Þ¤¹¡£ +\medskip +\par +¾Ü¤·¤¯¤Ï¡¢¤½¤ì¤¾¤ì¤ÎÀâÌÀ½ñ¤ò¤ªÆɤ߲¼¤µ¤¤¡£ +\medskip +\medskip + +\section{mime.el ¤È¤ÎÊ»ÍÑ} +\medskip +\par +mime.el ¤ÈÊ»ÍѤ¹¤ëÎã¤ò¼¨¤·¤Þ¤¹¡£¤³¤ÎÎã¤Î¾ì¹ç¡¢ISO-2022-JP ʸ»úÎó¤Î +encode ¤Ï tiny-mime.el ¤¬¹Ô¤Ê¤¤¡¢¤½¤ì°Ê³°¤Îʸ»ú½¸¹ç¤Ë°¤¹¤ëʸ»úÎó¤Ï +mime.el ¤¬ encode ¤·¤Þ¤¹¡£ +\medskip +\par +¤Þ¤¿¡¢tiny-mime.el ¤¬ encode ¤·¤Ê¤«¤Ã¤¿Ê¸»úÎó¤â mime.el ¤¬ encode ¤¹ +¤ë¤Î¤Ç¡¢·ë²ÌŪ¤Ë¡¢É¬¤ºÁ´¤Æ¤Î field ¤¬ encode ¤µ¤ì¤ë¤³¤È¤ËÃí°Õ¤·¤Æ²¼¤µ +¤¤¡£ +\medskip +{\baselineskip=10pt +\begin{verbatim} +---------------------------------------------------------------------- +;;; +;;; for Edit MIME mode +;;; +(autoload 'mime-mode "mime" "Edit MIME message." t) +(autoload 'mime-convert-buffer "mime" "convert to MIME." t) +(autoload 'insert-signature "signature" "Insert signature" t) +(add-hook 'mime-mode-hook + (function + (lambda () + (define-key (current-local-map) + "\C-c\C-s" (function insert-signature)) + ))) + +;; MIME header ¤Î encoder ¤ò tiny-mime ¤Î¤â¤Î¤ò»È¤¦¡£ +(setq mime-translate-hook 'mime/encode-message-header) + +;;; +;;; for GNUS +;;; +(add-hook 'news-reply-mode-hook (function mime-mode)) +(setq gnus-signature-file nil) + +;;; +;;; for mh-e +;;; +(add-hook 'mh-letter-mode-hook + (function + (lambda () + (mime/decode-message-header) + (mime-mode) + (make-local-variable 'mail-header-separator) + (setq mail-header-separator "--------")) + )) +---------------------------------------------------------------------- +\end{verbatim}} +\medskip + +\subsection{ÆÃÄê¤Î field ¤ò encode ¤·¤¿¤¯¤Ê¤¤¾ì¹ç} +\medskip +\par +ÆÃÄê¤Î field ¤ò encode ¤·¤¿¤¯¤Ê¤¤¾ì¹ç¡¢tiny-mime.el ¤ÎÊÑ¿ô +mime/no-encoding-header-fields ¤Ë¤è¤Ã¤Æ¡¢tiny-mime.el ¤Ë¤è¤ë encode ¤ò +¤ä¤á¤ë¤³¤È¤¬¤Ç¤­¤Þ¤¹¤¬¡¢mime.el ¤¬ encode ¤¹¤ë¤Î¤Ç¤Ï°ÕÌ£¤¬¤¢¤ê¤Þ¤»¤ó¡£ +¤½¤³¤Ç¡¢¼¡¤Î¤è¤¦¤ËÀßÄꤹ¤ë¤³¤È¤Ç¡¢mime.el ¤Ç¤â encode ¤·¤Ê¤¤¤è¤¦¤Ë¤Ç¤­ +¤Þ¤¹¡£ +\medskip +{\baselineskip=10pt +\begin{verbatim} +---------------------------------------------------------------------- +(if (boundp 'MULE) + (progn + (defun mime-header-charset-chooser-for-mule-no-encode-ISO-2022-JP (begin end) + (let ((lclist (find-charset-region begin end))) + (cond ((null lclist) nil) ;US-ASCII requres no encoding. + ((memq lc-ltn1 lclist) + '("ISO-8859-1" . "Q")) + ((memq lc-ltn2 lclist) + '("ISO-8859-2" . "Q")) + ((memq lc-ltn3 lclist) + '("ISO-8859-3" . "Q")) + ((memq lc-ltn4 lclist) + '("ISO-8859-4" . "Q")) + ((memq lc-crl lclist) + '("ISO-8859-5" . "Q")) + ;;((memq lc-arb lclist) + ;; '("ISO-8859-6" . "Q")) + ((memq lc-grk lclist) + '("ISO-8859-7" . "Q")) + ((memq lc-hbw lclist) + '("ISO-8859-8" . "Q")) + ((memq lc-ltn5 lclist) + '("ISO-8859-9" . "Q")) + ((memq lc-jp lclist) nil) + (t ;Unknown charset. It must be Mule! + '("ISO-2022-JP-2" . "B")) + ))) + (setq mime-header-charset-chooser + 'mime-header-charset-chooser-for-mule-no-encode-ISO-2022-JP) + ) + (progn + (defun mime-header-charset-chooser-for-nemacs-no-encode-ISO-2022-JP (begin end)) + (setq mime-header-charset-chooser + 'mime-header-charset-chooser-for-nemacs-no-encode-ISO-2022-JP) + )) +---------------------------------------------------------------------- +\end{verbatim}} +\medskip +\par +Íפ¹¤ë¤Ë¡¢ISO-2022-JP ʸ»úÎó¤Î encode ¤ò mime.el ¤Ë¤µ¤»¤Ê¤¯¤¹¤ëÌõ¤Ç +¤¹¡£ +\medskip +\medskip + +\section{charset ¤ÎÄɲá¦Êѹ¹} +\medskip +\par +Mule ¤Ç¤Ï¡¢´Ø¿ô mime/set-charset-and-encoding ¤Ç¡¢charset ¤ÎÄɲá¦ÊÑ +¹¹¤¬¤Ç¤­¤Þ¤¹¡£ +\medskip +\begin{description} +\item[´Ø¿ô:]mime/set-charset-and-encoding lc cs charset encoding +\medskip +\begin{description} +\item[lc:]charset ¤ËÂбþ¤¹¤ë leading-char ¤ò»ØÄꤹ¤ë¡£ +\item[cs:]charset ¤ËÂбþ¤¹¤ë coding-system ¤ò»ØÄꤹ¤ë¡£1 octet ʸ»ú +½¸¹ç¤Ç coding-system ¤òºî¤é¤Ê¤¤¾ì¹ç¤Ï¡¢nil ¤ò»ØÄꤹ¤ë¡£ +\item[charset:]MIME ¤Î charset. +\item[encoding:]encode ¤¹¤ëºÝ¤Î encoding. +\medskip +\medskip +\end{description} +\end{description} +\par +Î㡧 KS C5601-1987 ¤ò EUC-KR ¤Î B encoding ¤¹¤ë¤è¤¦¤ËÀßÄꤹ¤ë +\medskip +{\list{}{\leftmargin=8ex}\item[] +\par +(mime/set-charset-and-encoding lc-kr *euc-kr* "EUC-KR" "B") +\endlist} +\medskip +\medskip +\par +Î㡧 koi8-r ¤ò Q encoding ¤¹¤ë¤è¤¦¤ËÀßÄꤹ¤ë¡£ +\medskip +{\list{}{\leftmargin=8ex}\item[] +\par +(mime/set-charset-and-encoding lc-prv11 nil "KOI8-R" "Q") +\endlist} +\medskip +\medskip +\par +¡ÎÃí°Õ¡Ï¸½ºß¤Î¤È¤³¤í¡¢private character ¤ÎÀßÄê¤ÏÆñ¤¢¤ê¤Ç¤¹¡£(\verb+^+\_\verb+^+; +\end{document} diff --git a/tiny-mime.el b/tiny-mime.el new file mode 100644 index 0000000..7052237 --- /dev/null +++ b/tiny-mime.el @@ -0,0 +1,831 @@ +;; +;; A multilingual MIME message header encoder/decoder. +;; by Morioka Tomohiko (morioka@jaist.ac.jp) +;; +;; original MIME decoder is +;; mime.el,v 1.5 1992/07/18 07:52:08 by Enami Tsugutomo +;; + +(provide 'tiny-mime) + +(defconst mime/RCS-ID + "$Id: tiny-mime.el,v 4.7 1994/08/03 05:40:35 morioka Exp $") + +(defconst mime/tiny-mime-version + (and (string-match "[0-9][0-9.]*" mime/RCS-ID) + (substring mime/RCS-ID (match-beginning 0)(match-end 0)) + )) + +(require 'tl-header) + + +;;; @ MIME encoded-word definition +;;; + +(defconst mime/charset-regexp "[A-Za-z0-9!#$%&'*+---^_`{}|~]") +(defconst mime/encoded-text-regexp "[!->@-~]+") + +(defconst mime/Base64-token-regexp "[A-Za-z0-9+/=]") +(defconst mime/Base64-encoded-text-regexp + (concat "\\(" + mime/Base64-token-regexp + mime/Base64-token-regexp + mime/Base64-token-regexp + mime/Base64-token-regexp + "\\)+")) +(defconst mime/Base64-encoding-and-encoded-text-regexp + (concat "\\(B\\)\\?" mime/Base64-encoded-text-regexp)) + +(defconst mime/Quoted-Printable-hex-char "[0123456789ABCDEF]") +(defconst mime/Quoted-Printable-encoded-text-regexp + (concat "\\([^=?_]\\|=" + mime/Quoted-Printable-hex-char + mime/Quoted-Printable-hex-char + "\\)+")) +(defconst mime/Quoted-Printable-encoding-and-encoded-text-regexp + (concat "\\(Q\\)\\?" mime/Quoted-Printable-encoded-text-regexp)) + +(defconst mime/encoded-word-regexp (concat (regexp-quote "=?") + "\\(" + mime/charset-regexp + "+\\)" + (regexp-quote "?") + "\\(B\\|Q\\)" + (regexp-quote "?") + "\\(" + mime/encoded-text-regexp + "\\)" + (regexp-quote "?="))) + +(defun mime/nth-string (s n) + (if (stringp s) + (substring s (match-beginning n) (match-end n)) + (buffer-substring (match-beginning n) (match-end n)))) + +(defun mime/encoded-word-charset (str) + (mime/nth-string str 1)) + +(defun mime/encoded-word-encoding (str) + (mime/nth-string str 2)) + +(defun mime/encoded-word-encoded-text (str) + (mime/nth-string str 3)) + +(defun mime/rest-of-string (str) + (if (stringp str) + (substring str (match-end 0)) + (buffer-substring (match-end 0)))) + +;;; @ variables +;;; + +(defvar mime/no-encoding-header-fields '("X-Nsubject")) + +(defvar mime/use-X-Nsubject nil) + + +;;; @ compatible module among Mule, NEmacs and NEpoch +;;; +(cond ((boundp 'MULE) (require 'tm-mule)) + ((boundp 'NEMACS)(require 'tm-nemacs)) + (t (require 'tm-orig)) + ) + + +;;; @ Application Interface +;;; + +;;; @@ MIME header decoders +;;; + +;; by mol. 1993/10/4 +(defun mime/decode-encoded-word (word) + (if (string-match mime/encoded-word-regexp word) + (let ((charset (upcase (mime/encoded-word-charset word))) + (encoding (mime/encoded-word-encoding word)) + (text (mime/encoded-word-encoded-text word))) + (mime/decode-encoded-text charset encoding text)) + word)) + +(defun mime/decode-region (beg end) + (interactive "*r") + (save-excursion + (save-restriction + (narrow-to-region beg end) + (goto-char (point-min)) + (let (charset encoding text) + (while (re-search-forward mime/encoded-word-regexp nil t) + (insert (mime/decode-encoded-word + (prog1 + (buffer-substring (match-beginning 0) (match-end 0)) + (delete-region (match-beginning 0) (match-end 0)) + ) + )) + )) + ))) + +(defun mime/decode-message-header () + (interactive "*") + (save-excursion + (save-restriction + (narrow-to-region (goto-char (point-min)) + (progn (re-search-forward "^$" nil t) (point))) + (mime/prepare-decode-message-header) + (mime/decode-region (point-min) (point-max)) + ))) + +(defun mime/decode-string (str) + (let ((dest "")(ew nil) + beg end) + (while (setq beg (string-match mime/encoded-word-regexp str)) + (if (> beg 0) + (if (not (and (eq ew t) (string= (substring str 0 beg) " "))) + (setq dest (concat dest (substring str 0 beg) + )) + ) + ) + (setq end (match-end 0)) + (setq dest (concat dest (mime/decode-encoded-word (substring str beg end)) + )) + (setq str (substring str end)) + (setq ew t) + ) + (concat dest str) + )) + +;;; @@ MIME header encoders +;;; + +(defun mime/encode-string (string encoding &optional mode) + (cond ((equal encoding "B") (mime/base64-encode-string string)) + ((equal encoding "Q") (mime/Quoted-Printable-encode-string string mode)) + (t nil) + )) + +(defun mime/encode-field (str) + (setq str (message/unfolding-string str)) + (let ((ret (message/divide-field str)) + field-name field-body) + (setq field-name (car ret)) + (setq field-body (nth 1 ret)) + (if (string= field-body "") + field-name + (concat field-name " " + (if (or (string-match "^Reply-To:$" field-name) + (string-match "^From:$" field-name) + (string-match "^Sender:$" field-name) + (string-match "^Resent-Reply-To:$" field-name) + (string-match "^Resent-From:$" field-name) + (string-match "^Resent-Sender:$" field-name) + (string-match "^To:$" field-name) + (string-match "^Resent-To:$" field-name) + (string-match "^cc:$" field-name) + (string-match "^Resent-cc:$" field-name) + (string-match "^bcc:$" field-name) + (string-match "^Resent-bcc:$" field-name) + ) + (mime/encode-address-list (+ (length field-name) 1) + field-body) + (catch 'label + (let ((i 0) + (n (length mime/no-encoding-header-fields)) + fn) + (while (< i n) + (setq fn (nth i mime/no-encoding-header-fields)) + (if (string-match (concat "^" fn ":$") field-name) + (progn + (throw 'label field-body) + )) + (setq i (+ i 1)) + ) + (nth 1 (mime/encode-header-string (+ (length field-name) 1) + field-body)) + )) + )) + ))) + +(defun mime/encode-message-header () + (interactive "*") + (save-excursion + (save-restriction + (narrow-to-region (goto-char (point-min)) + (progn + (re-search-forward + (concat "^" (regexp-quote mail-header-separator) "$") + nil t) + (match-beginning 0) + )) + (goto-char (point-min)) + (let (beg end field) + (while (re-search-forward "^.+:.*\\(\n\\s +.*\\)*" nil t) + (setq beg (match-beginning 0)) + (setq end (match-end 0)) + (setq field (buffer-substring beg end)) + (insert (mime/encode-field + (prog1 + (buffer-substring beg end) + (delete-region beg end) + ))) + )) + (if mime/use-X-Nsubject + (progn + (goto-char (point-min)) + (if (re-search-forward "^Subject:.*\\(\n\\s +.*\\)*" nil t) + (let ((str (buffer-substring (match-beginning 0)(match-end 0)))) + (if (string-match mime/encoded-word-regexp str) + (insert (concat + "\nX-Nsubject: " + (nth 1 (message/divide-field + (mime/decode-string + (message/unfolding-string str)) + )))) + )) + ))) + ))) + +;;; @ Base64 (B-encode) decoder/encoder +;;; by Enami Tsugutomo +;;; modified by mol. + +(defun mime/base64-decode-string (string) + (mime/base64-mapconcat (function mime/base64-decode-chars) 4 string)) + +;; (mime/base64-encode-string (mime/base64-decode-string "GyRAOjRGI0stGyhK")) +(defun mime/base64-encode-string (string &optional mode) + (let ((es (mime/base64-mapconcat (function mime/base64-encode-chars) 3 string)) + m) + (setq m (mod (length es) 4)) + (concat es + (cond ((= m 3) "=") + ((= m 2) "==") + )) + )) + +;; (char-to-string (mime/base64-bit-to-char 26)) +(defun mime/base64-bit-to-char (n) + (cond ((eq n nil) ?=) + ((< n 26) (+ ?A n)) + ((< n 52) (+ ?a (- n 26))) + ((< n 62) (+ ?0 (- n 52))) + ((= n 62) ?+) + ((= n 63) ?/) + (t (error "not a base64 integer %d" n)))) + +(defun mime/base64-char-to-bit (c) + (cond ((and (<= ?A c) (<= c ?Z)) (- c ?A)) + ((and (<= ?a c) (<= c ?z)) (+ (- c ?a) 26)) + ((and (<= ?0 c) (<= c ?9)) (+ (- c ?0) 52)) + ((= c ?+) 62) + ((= c ?/) 63) + ((= c ?=) nil) + (t (error "not a base64 character %c" c)))) + +(defun mime/mask (i n) (logand i (1- (ash 1 n)))) + +(defun mime/base64-encode-1 (a &optional b &optional c) + (cons (ash a -2) + (cons (logior (ash (mime/mask a 2) (- 6 2)) + (if b (ash b -4) 0)) + (if b + (cons (logior (ash (mime/mask b 4) (- 6 4)) + (if c (ash c -6) 0)) + (if c + (cons (mime/mask c (- 6 0)) + nil))))))) + +(defun mime/base64-decode-1 (a b &optional c &optional d) + (cons (logior (ash a 2) (ash b (- 2 6))) + (if c (cons (logior (ash (mime/mask b 4) 4) + (mime/mask (ash c (- 4 6)) 4)) + (if d (cons (logior (ash (mime/mask c 2) 6) d) + nil)))))) + +;; (mime/base64-decode-chars ?G ?y ?R ?A) +(defun mime/base64-decode-chars (a b c d) + (apply (function mime/base64-decode-1) + (mapcar (function mime/base64-char-to-bit) + (list a b c d)))) + +;; (mapcar (function char-to-string) (mime/base64-encode-chars 27 36 64)) +(defun mime/base64-encode-chars (a b c) + (mapcar (function mime/base64-bit-to-char) (mime/base64-encode-1 a b c))) + +(defun mime/base64-fecth-from (func from pos len) + (let (ret) + (while (< 0 len) + (setq len (1- len) + ret (cons (funcall func from (+ pos len)) ret))) + ret)) + +(defun mime/base64-fecth-from-buffer (from pos len) + (mime/base64-fecth-from (function (lambda (f p) (char-after p))) + from pos len)) + +(defun mime/base64-fecth-from-string (from pos len) + (mime/base64-fecth-from (function (lambda (f p) + (if (< p (length f)) (aref f p)))) + from pos len)) + +(defun mime/base64-fecth (source pos len) + (cond ((stringp source) (mime/base64-fecth-from-string source pos len)) + (t (mime/base64-fecth-from-buffer source pos len)))) + +(defun mime/base64-mapconcat (func unit string) + (let ((i 0) ret) + (while (< i (length string)) + (setq ret + (apply (function concat) + ret + (mapcar (function char-to-string) + (apply func (mime/base64-fecth string i unit))))) + (setq i (+ i unit))) + ret)) + +;;; @ Quoted-Printable (Q-encode) encoder/decoder +;;; + +(defun mime/Quoted-Printable-decode-string (str) + (let ((dest "") + (len (length str)) + (i 0) chr num h l) + (while (< i len) + (setq chr (elt str i)) + (cond ((eq chr ?=) + (if (< (+ i 2) len) + (progn + (setq h (hex-char-to-number (elt str (+ i 1)))) + (setq l (hex-char-to-number (elt str (+ i 2)))) + (setq num (+ (* h 16) l)) + (setq dest (concat dest (char-to-string num))) + (setq i (+ i 3)) + ) + (progn + (setq dest (concat dest (char-to-string chr))) + (setq i (+ i 1)) + ))) + ((eq chr ?_) + (setq dest (concat dest (char-to-string 32))) + (setq i (+ i 1)) + ) + (t + (setq dest (concat dest (char-to-string chr))) + (setq i (+ i 1)) + )) + ) + dest)) + +(defun mime/Quoted-Printable-encode-string (str &optional mode) + (if (null mode) + (setq mode 'phrase)) + (let ((dest "") + (len (length str)) + (i 0) chr) + (while (< i len) + (setq chr (elt str i)) + (cond ((eq chr 32) + (setq dest (concat dest "_")) + ) + ((or (eq chr ?=) + (eq chr ??) + (eq chr ?_) + (and (eq mode 'comment) + (or (eq chr ?\() + (eq chr ?\)) + (eq chr ?\\) + )) + (and (eq mode 'phrase) + (not (string-match "[A-Za-z0-9!*+/=_---]" + (char-to-string chr))) + ) + (< chr 32) + (> chr 126)) + (setq dest (concat dest + "=" + (char-to-string (number-to-hex-char (/ chr 16))) + (char-to-string (number-to-hex-char (% chr 16))) + )) + ) + (t (setq dest (concat dest (char-to-string chr))) + )) + (setq i (+ i 1)) + ) + dest)) + +;;; @ functions for message header encoding +;;; + +(defun mime/encode-and-split-string (n string charset encoding) + (let ((i 0) (j 0) + (len (length string)) + (js (mime/convert-string-from-emacs string charset)) + (cesl (+ (length charset) (length encoding) 6 )) + ewl m rest) + (setq ewl (mime/encoded-word-length js encoding)) + (if (null ewl) nil + (progn + (setq m (+ n ewl cesl)) + (if (> m 76) + (progn + (while (and (< i len) + (setq js (mime/convert-string-from-emacs + (substring string 0 i) charset)) + (setq m (+ n (mime/encoded-word-length js encoding) cesl)) + (< m 76)) + (setq j i) + (setq i (+ i (char-bytes (elt string i)))) + ) + (setq js (mime/convert-string-from-emacs + (substring string 0 j) charset)) + (setq m (+ n (mime/encoded-word-length js encoding) cesl)) + (setq rest (substring string j)) + ) + (setq rest nil)) + (if (string= js "") + (list 1 "" string) + (list m (concat "=?" charset "?" encoding "?" + (mime/encode-string js encoding) + "?=") rest)) + )) + )) + +(defun mime/encode-header-word (n string charset encoding) + (let (dest str ret m) + (if (null (setq ret (mime/encode-and-split-string n string charset encoding))) + nil + (progn + (setq dest (nth 1 ret)) + (setq m (car ret)) + (setq str (nth 2 ret)) + (while (and (stringp str) + (setq ret (mime/encode-and-split-string 1 str charset encoding)) + ) + (setq dest (concat dest "\n " (nth 1 ret))) + (setq m (car ret)) + (setq str (nth 2 ret)) + ) + (list m dest) + )) + )) + +(defun mime/encode-header-string (n string &optional mode) + (let ((ssl (mime/separate-string-for-encoder string)) + i len cell et w ew (dest "") b l) + (setq len (length ssl)) + (setq cell (nth 0 ssl)) + (setq et (car cell)) + (setq w (cdr cell)) + (if (eq et nil) + (progn + (if (> (+ n (string-width w)) 76) + (progn + (setq dest (concat dest "\n ")) + (setq b 1) + ) + (setq b n)) + (setq dest (concat dest w)) + (setq b (+ b (string-width w))) + ) + (progn + (setq ew (mime/encode-header-word n (cdr cell) (car et) (cdr et))) + (setq dest (nth 1 ew)) + (setq b (car ew)) + )) + (setq i 1) + (while (< i len) + (setq cell (nth i ssl)) + (setq et (car cell)) + (setq w (cdr cell)) + (cond ((string-match "^[ \t]*$" w) + (setq b (+ b (string-width (cdr cell)))) + (setq dest (concat dest (cdr cell))) + ) + ((eq et nil) + (if (> (+ b (string-width w)) 76) + (progn + (if (eq (elt dest (- (length dest) 1)) 32) + (setq dest (substring dest 0 (- (length dest) 1))) + ) + (setq dest (concat dest "\n " w)) + (setq b (+ (length w) 1)) + ) + (setq l (length dest)) + (if (and (>= l 2) + (eq (elt dest (- l 2)) ?\?) + (eq (elt dest (- l 1)) ?=) + ) + (progn + (setq dest (concat dest " ")) + (setq b (+ b 1)) + )) + (setq dest (concat dest w)) + (setq b (+ b (string-width w))) + )) + (t + (if (not (eq (elt dest (- (length dest) 1)) 32)) + (progn + (setq dest (concat dest " ")) + (setq b (+ b 1)) + )) + (setq ew (mime/encode-header-word b (cdr cell) (car et) (cdr et))) + (setq b (car ew)) + (if (string-match "^\n" (nth 1 ew)) + (setq dest (concat (substring dest 0 (- (length dest) 1)) + (nth 1 ew))) + (setq dest (concat dest (nth 1 ew))) + ) + )) + (setq i (+ i 1)) + ) + (list b dest))) + +(defun mime/encode-address-list (n str) + (let ((ret (message/parse-addresses str)) + len (i 0) cell en-ret j cl (dest "") s) + (setq len (length ret)) + (while (< i len) + (setq cell (nth i ret)) + (cond ((string= (nth 1 cell) "<") + (setq en-ret (mime/encode-header-string n (nth 0 cell) 'phrase)) + (setq dest (concat dest (nth 1 en-ret))) + (setq n (car en-ret)) + (if (< i (- len 1)) + (setq en-ret + (mime/encode-header-string + n (concat (nth 1 cell)(nth 2 cell)(nth 3 cell) ", "))) + (setq en-ret (mime/encode-header-string + n (concat (nth 1 cell)(nth 2 cell)(nth 3 cell)))) + ) + (if (and (eq (elt (nth 1 en-ret) 0) ?\n) + (eq (elt dest (- (length dest) 1)) 32)) + (setq dest (substring dest 0 (- (length dest) 1))) + ) + (setq dest (concat dest (nth 1 en-ret))) + (setq n (car en-ret)) + ) + ((= (length cell) 4) + (setq en-ret (mime/encode-header-string n (nth 0 cell))) + (setq dest (concat dest (nth 1 en-ret))) + (setq n (car en-ret)) + + (setq en-ret (mime/encode-header-string (+ n 2) (nth 2 cell) 'comment)) + (if (eq (elt (nth 1 en-ret) 0) ?\n) + (progn + (setq dest (concat dest "\n (")) + (setq en-ret (mime/encode-header-string 2 (nth 2 cell) 'comment)) + ) + (progn + (setq dest (concat dest " (")) + )) + (setq dest (concat dest (nth 1 en-ret))) + (setq n (car en-ret)) + (if (< i (- len 1)) + (setq en-ret + (mime/encode-header-string n (concat (nth 3 cell) ", "))) + (setq en-ret (mime/encode-header-string n (nth 3 cell))) + ) + (setq dest (concat dest (nth 1 en-ret))) + (setq n (car en-ret)) + ) + (t + (if (< i (- len 1)) + (setq en-ret + (mime/encode-header-string n (concat (nth 0 cell) ", "))) + (setq en-ret (mime/encode-header-string n (nth 0 cell))) + ) + (setq dest (concat dest (nth 1 en-ret))) + (setq n (car en-ret)) + )) + (setq i (+ i 1)) ) + dest)) + +;;; @ utility functions +;;; + +;; by mol. 1993/10/4 +(defun hex-char-to-number (chr) + (cond ((and (<= ?0 chr)(<= chr ?9)) (- chr ?0)) + ((and (<= ?A chr)(<= chr ?F)) (+ (- chr ?A) 10)) + ((and (<= ?a chr)(<= chr ?f)) (+ (- chr ?a) 10)) + )) + +(defun number-to-hex-char (n) + (if (< n 10) + (+ ?0 n) + (+ ?A (- n 10)))) + + +;;; @ utility for encoder +;;; + +;;; @@ encoded-word length +;;; + +(defun mime/encoded-word-length (string encoding) + (cond ((equal encoding "B") (mime/base64-length string)) + ((equal encoding "Q") (mime/Quoted-Printable-length string)) + (t nil) + )) + +(defun mime/base64-length (string) + (let ((l (length string)) + ) + (* (+ (/ l 3) + (if (= (mod l 3) 0) 0 1) + ) 4) + )) + +(defun mime/Quoted-Printable-length (string &optional mode) + (let ((l 0)(i 0)(len (length string)) chr) + (while (< i len) + (setq chr (elt string i)) + (if (string-match "[A-Za-z0-9!*+/=_---]" (char-to-string chr)) + (setq l (+ l 1)) + (setq l (+ l 3)) + ) + (setq i (+ i 1)) ) + l)) + +;;; @@ separate by character set +;;; + +;; by mol. 1993/11/2 +(defconst LC-space 2) + +;; by mol. 1993/10/16 +(defun mime/char-type (chr) + (if (or (= chr 32)(= chr ?\t)) + LC-space + (mime/char-leading-char chr) + )) + +(defun mime/separate-string-by-chartype (string) + (let ((len (length string)) + (dest nil) (ds "") s + pcs i j cs chr) + (if (= len 0) nil + (progn (setq chr (elt string 0)) + (setq pcs (mime/char-type chr)) + (setq i (char-bytes chr)) + (setq ds (substring string 0 i)) + (while (< i len) + (setq chr (elt string i)) + (setq cs (mime/char-type chr)) + (setq j (+ i (char-bytes chr))) + (setq s (substring string i j)) + (setq i j) + (if (= cs pcs) + (setq ds (concat ds s)) + (progn (setq dest (append dest (list (cons pcs ds)))) + (setq pcs cs) + (setq ds s) + )) + ) + (if (not (string= ds "")) + (setq dest (append dest (list (cons pcs ds))))) + dest) + ))) + +(defun mime/separate-string-by-charset (str) + (let ((rl (mime/separate-string-by-chartype str)) + (i 1) len (pcell nil) cell ncell dpcell (dest nil) LC) + (setq len (length rl)) + (setq dpcell (list (nth 0 rl))) + (setq cell (nth 1 rl)) + (setq ncell (nth 2 rl)) + (while (< i len) + (setq LC (car (car dpcell))) + (cond ((and (not (eq LC lc-ascii)) + (eq (car cell) LC-space) + (not (eq (car ncell) lc-ascii))) + (setq dpcell (list (cons LC + (concat (cdr (car dpcell)) (cdr cell)) + ))) + ) + ((and (not (eq LC lc-ascii)) + (eq LC (car cell))) + (setq dpcell (list (cons LC + (concat (cdr (car dpcell)) (cdr cell)) + ))) + ) + ((and (eq LC lc-ascii) + (member (car cell) mime/latin-lc-list)) + (setq dpcell (list (cons (car cell) + (concat (cdr (car dpcell)) (cdr cell)) + ))) + ) + ((and (member LC mime/latin-lc-list) + (eq (car cell) lc-ascii)) + (setq dpcell (list (cons LC + (concat (cdr (car dpcell)) (cdr cell)) + ))) + ) + (t + (setq dest (append dest dpcell)) + (setq dpcell (list cell)) + )) + (setq i (+ i 1)) + (setq cell ncell) + (setq ncell (nth (+ i 1) rl)) + ) + (setq dest (append dest dpcell)) + )) + +(defun mime/separate-string-for-encoder (string) + (let (lastspace) + (if (string-match "[ \t]+$" string) + (progn + (setq lastspace (substring string + (match-beginning 0) + (match-end 0))) + (setq string (substring string 0 (match-beginning 0))) + )) + (let ((rl (mime/separate-string-by-charset string)) + (i 0) len cell0 cell1 cell2 (dest nil)) + (setq len (length rl)) + (setq cell0 (nth 0 rl)) + (setq cell1 (nth 1 rl)) + (setq cell2 (nth 2 rl)) + (while (< i len) + (cond ((and (not (eq (car cell0) lc-ascii)) + (eq (car cell1) LC-space) + (not (eq (car cell2) lc-ascii)) + ) + (setq dest + (append dest (list + (cons + (cdr (assoc (car cell0) + mime/lc-charset-and-encoding-alist)) + (concat (cdr cell0) (cdr cell1)) + )))) + (setq i (+ i 2)) + (setq cell0 (nth i rl)) + (setq cell1 (nth (+ i 1) rl)) + (setq cell2 (nth (+ i 2) rl)) + ) + (t + (setq dest + (append dest (list + (cons + (cdr (assoc (car cell0) + mime/lc-charset-and-encoding-alist)) + (cdr cell0))))) + (setq i (+ i 1)) + (setq cell0 cell1) + (setq cell1 cell2) + (setq cell2 (nth (+ i 2) rl)) + )) + ) + (append dest + (if lastspace + (list (cons nil lastspace)))) + ))) + + + +;;; +;;; basic functions for MIME header decoder +;;; + +;;; @ utility for decoder +;;; + +(defun mime/unfolding () + (goto-char (point-min)) + (let (field beg end) + (while (re-search-forward message/field-regexp nil t) + (setq beg (match-beginning 0)) + (setq end (match-end 0)) + (setq field (buffer-substring beg end)) + (if (string-match mime/encoded-word-regexp field) + (progn + (save-excursion + (save-restriction + (narrow-to-region (goto-char beg) end) + (while (re-search-forward "\n[ \t]+" nil t) + (replace-match " ") + ) + )) + )) + )) + ) + +(defun mime/prepare-decode-message-header () + (mime/unfolding) + (goto-char (point-min)) + (while (re-search-forward + (concat (regexp-quote "?=") + "\\s +" + (regexp-quote "=?")) + nil t) + (replace-match "?==?") + ) + ) + +(run-hooks 'mime/tiny-mime-load-hook) + +;;; @ +;;; Local Variables: +;;; mode: emacs-lisp +;;; mode: outline-minor +;;; outline-regexp: ";;; @+\\|(......" +;;; End: diff --git a/tl-18.el b/tl-18.el new file mode 100644 index 0000000..52b33d7 --- /dev/null +++ b/tl-18.el @@ -0,0 +1,46 @@ +;;; +;;; $Id: tl-18.el,v 0.6 1994/08/01 05:07:03 morioka Exp $ +;;; + +(provide 'tl-18) + +(defun add-hook (hook function &optional append) + "Add to the value of HOOK the function FUNCTION. +FUNCTION is not added if already present. +FUNCTION is added (if necessary) at the beginning of the hook list +unless the optional argument APPEND is non-nil, in which case +FUNCTION is added at the end. + +HOOK should be a symbol, and FUNCTION may be any valid function. If +HOOK is void, it is first set to nil. If HOOK's value is a single +function, it is changed to a list of functions." + (or (boundp hook) + (set hook nil) + ) + ;; If the hook value is a single function, turn it into a list. + (let ((old (symbol-value hook))) + (if (or (not (listp old)) + (eq (car old) 'lambda)) + (set hook (list old)) + )) + (or (if (consp function) + ;; Clever way to tell whether a given lambda-expression + ;; is equal to anything in the hook. + (let ((tail (assoc (cdr function) (symbol-value hook)))) + (equal function tail) + ) + (memq function (symbol-value hook)) + ) + (set hook + (if append + (nconc (symbol-value hook) (list function)) + (cons function (symbol-value hook)) + )) + )) + +(defun member (elt list) + "Return non-nil if ELT is an element of LIST. Comparison done with EQUAL. +The value is actually the tail of LIST whose car is ELT." + (while (and list (not (equal elt (car list)))) + (setq list (cdr list))) + list) diff --git a/tl-header.el b/tl-header.el new file mode 100644 index 0000000..262ba1c --- /dev/null +++ b/tl-header.el @@ -0,0 +1,124 @@ +;;; +;;; $Id: tl-header.el,v 4.2 1994/08/03 04:39:55 morioka Exp $ +;;; + +(provide 'tl-header) + +(defconst message/quoted-string-regexp "\".*\"") +(defconst message/field-name-regexp "^[!-9;-~]+:") +(defconst message/field-body-regexp ".*\\(\n[ \t]+.*\\)*") +(defconst message/field-regexp + (concat message/field-name-regexp + message/field-body-regexp)) +(defconst message/word-regexp "[!#-'*+0-9=?A-Z^-~---]+") +(defconst message/local-part-regexp + (concat message/word-regexp "\\(\\." message/word-regexp "\\)*")) +(defconst message/domain-regexp (concat "@" message/local-part-regexp)) +(defconst message/addr-spec-regexp + (concat message/local-part-regexp "\\(" message/domain-regexp "\\)?")) + +(defun message/get-field-body (name) + (save-excursion + (save-restriction + (goto-char (point-min)) + (if (re-search-forward (concat "^" name ":[ \t]*") nil t) + (buffer-substring + (match-end 0) + (and (re-search-forward message/field-body-regexp nil t) + (match-end 0)) + ))))) + +(defun message/divide-field (str) + (let (field-name field-body) + (if (string-match message/field-name-regexp str) + (progn + (setq field-name (substring str 0 (match-end 0))) + (setq field-body (substring str (match-end 0))) + (if (string-match "^[ \t]+" field-body) + (setq field-body (substring field-body (match-end 0))) + ) + (list field-name field-body) + )))) + +(defun message/parse-addr-spec (str) + (if (string-match "^\\s +" str) + (setq str (substring str (match-end 0))) + ) + (if (eq (string-match message/addr-spec-regexp str) 0) + (list (list (substring str 0 (match-end 0))) + (substring str (match-end 0)) + ) + )) + +(defun message/parse-phrase-route-addr (str) + (let ((p (and (string-match "^\\(\".*\"\\|[^,]\\)*<" str) + (match-end 0))) + phrase ad) + (if (and p + (setq ad (message/parse-addr-spec (substring str p))) + (eq (elt (nth 1 ad) 0) ?>)) + (list (list (substring str 0 (- p 1)) + "<" + (car (car ad)) + ">") + (substring (nth 1 ad) 1) + ) + nil) + )) + +(defun message/parse-comment (str) + (if (string-match "^\\s +" str) + (setq str (substring str (match-end 0))) + ) + (if (string-match "^([^,]*)" str) + (list (list "(" (substring str 1 (- (match-end 0) 1)) ")") + (substring str (match-end 0)) + ) + )) + +(defun message/parse-address (str) + (let ((ret (or + (message/parse-phrase-route-addr str) + (message/parse-addr-spec str) + )) + n rest type cret) + (if ret + (progn + (setq rest (cdr ret)) + (setq cret (message/parse-comment (car rest))) + (if cret + (list (append (car ret) (car cret)) + (cdr cret)) + (list (car ret) rest) + ) + )) + )) + +(defun message/parse-addresses (str) + (let (dest + (ret (message/parse-address str)) + rs) + (if ret + (progn + (setq dest (list (car ret))) + (setq rs (car (nth 1 ret))) + (while (and (string-match "^\\s *,\\s *" rs) + (setq ret (message/parse-address + (substring rs (match-end 0)))) + ) + (setq dest (append dest (list (car ret)))) + (setq rs (car (nth 1 ret))) + ) + (if (string-match "^\\s *$" rs) + dest) + )) + )) + +(defun message/unfolding-string (str) + (let ((dest "")) + (while (string-match "\n\\s +" str) + (setq dest (concat dest (substring str 0 (match-beginning 0)) " ")) + (setq str (substring str (match-end 0))) + ) + (concat dest str) + )) diff --git a/tl-list.el b/tl-list.el new file mode 100644 index 0000000..8f3c781 --- /dev/null +++ b/tl-list.el @@ -0,0 +1,51 @@ +;;; +;;; $Id: tl-list.el,v 0.3 1994/07/16 04:08:52 morioka Exp morioka $ +;;; + +(provide 'tl-list) + +;;; @ alist +;;; + +(defun put-alist (item value alist) + "\t(put-alist )\n +If there is a pair whose car is , replace its cdr by . +If there is not such pair, create new pair ( . ) and +return new alist whose car is the new pair and cdr is . +[mol's ELIS emulating function]" + (if (assoc item alist) + (progn + (rplacd (assoc item alist) value) + alist) + (cons (cons item value) alist) + )) + +(defun del-alist (item alist) + "\t(del-alist )\n +If there is a pair whose key is , delete it from . +[mol's ELIS emulating function]" + (if (equal item (car (car alist))) + (cdr alist) + (let ((pr alist) + (r (cdr alist)) + ) + (catch 'tag + (while (not (null r)) + (if (equal item (car (car r))) + (progn + (rplacd pr (cdr r)) + (throw 'tag alist))) + (setq pr r) + (setq r (cdr r)) + ) + alist)))) + + +;;; @ field +;;; + +(defun fetch-field (key alist) + (assoc key alist)) + +(fset 'put-field 'put-alist) +(fset 'delete-field 'del-alist) diff --git a/tm-body-eng.ol b/tm-body-eng.ol new file mode 100644 index 0000000..b6a09d1 --- /dev/null +++ b/tm-body-eng.ol @@ -0,0 +1,93 @@ +[[R +\title{tm-body manual (English Version)} +\author{Morioka Tomohiko} +\date{1994/7/22} +\maketitle +]]R + +* Install + + Installing method is written in README-eng.ol. Please read it and +install. + +** tiny-mime.el + + Please copy tiny-mime.el to your Emacs lisp directory. + + +** tm-body + +*** *.el + + Please copy tm-body.el, tl-list.el and tl-header.el to your Emacs +lisp directory. + +*** methods + + Please edit methods for your environment, and copy to your +executable directory. + + +*** decode-b.c + + Please compile decode-b.c by gcc or another ANSI C. + +[[E + % gcc -O decode-b.c -o decode-b +]]E + + And please copy decode-b to your executable directory. + + However, if you have another decoder (e.g. mmencode in metamail), +you can replace decode-b (e.g. You can replace `decode-b <' by +`mmencode -b -u' in methods). + + +* Customize + + You can designate methods of Content-Types if you set variable +`mime/content-decoding-method-alist' in .emacs. + +[[E +---------------------------------------------------------------------- +(setq mime/content-decoding-method-alist + '(("audio/basic" . "tm-au") + ("image/gif" . "tm-image") + ("image/jpeg" . "tm-image") + ("image/x-pic" . "tm-image") + ("video/mpeg" . "tm-mpeg") + ("application/octet-stream" . "tm-file") + ("text/x-latex" . "tm-latex") + )) +---------------------------------------------------------------------- +]]E + + Each methods are shell scripts. Arguments of methods are written in +following table. + +---------------------------------------------------------------------------- +|argument| value | +============================================================================ +| $1 |temporary file name of encoded content | +| $2 |Content-Type (type/sub-type) | +| $3 |encoding {7bit / quoted-printable / base64 / 8bit / binary / ...}| +| $4 |decoding-mode {play / extract / print} | +| $5 |original file name of content | +---------------------------------------------------------------------------- + + Each Content-Types are decoded by methods. Exceptionally, +message/partial is decoded by tm-body.el. + + +* Limitation or bug + + In this version, message/external-body is not supported. + + Attached base64 decoder `decode-b.c' is not good program, so if it +can run normally, please correct it. But It is easy because decode-b.c +is too small, so please...(^_^; + + Or you can use mmencode attached in metamail as decoder. + + In this package, there is no Quoted-Printable decoder, so please use +mmencode. diff --git a/tm-body-eng.tex b/tm-body-eng.tex new file mode 100644 index 0000000..bb161bf --- /dev/null +++ b/tm-body-eng.tex @@ -0,0 +1,130 @@ +\documentstyle[a4j]{jarticle} +\setcounter{secnumdepth}{6} +\setcounter{tocdepth}{6} +\topsep=0.1cm +\parsep=0.1cm +\itemsep=0.0cm +\begin{document} +\title{tm-body manual (English Version)} +\author{Morioka Tomohiko} +\date{1994/7/22} +\maketitle +\medskip + +\section{Install} +\medskip +{\baselineskip=10pt +\begin{verbatim} + Installing method is written in README-eng.ol. Please read it and +install. +\end{verbatim}} +\medskip + +\subsection{tiny-mime.el} +\medskip +\par +Please copy tiny-mime.el to your Emacs lisp directory. +\medskip +\medskip + +\subsection{tm-body} +\medskip + +\subsubsection{$*$.el} +\medskip +\par +Please copy tm-body.el, tl-list.el and tl-header.el to your Emacs +lisp directory. +\medskip + +\subsubsection{methods} +\medskip +\par +Please edit methods for your environment, and copy to your +executable directory. +\medskip +\medskip + +\subsubsection{decode-b.c} +\medskip +\par +Please compile decode-b.c by gcc or another ANSI C. +\medskip +{\baselineskip=10pt +\begin{verbatim} + % gcc -O decode-b.c -o decode-b +\end{verbatim}} +\medskip +\par +And please copy decode-b to your executable directory. +\medskip +\par +However, if you have another decoder (e.g. mmencode in metamail), +you can replace decode-b (e.g. You can replace `decode-b $<$' by +`mmencode -b -u' in methods). +\medskip +\medskip + +\section{Customize} +\medskip +\par +You can designate methods of Content-Types if you set variable +`mime/content-decoding-method-alist' in .emacs. +\medskip +{\baselineskip=10pt +\begin{verbatim} +---------------------------------------------------------------------- +(setq mime/content-decoding-method-alist + '(("audio/basic" . "tm-au") + ("image/gif" . "tm-image") + ("image/jpeg" . "tm-image") + ("image/x-pic" . "tm-image") + ("video/mpeg" . "tm-mpeg") + ("application/octet-stream" . "tm-file") + ("text/x-latex" . "tm-latex") + )) +---------------------------------------------------------------------- +\end{verbatim}} +\medskip +\par +Each methods are shell scripts. Arguments of methods are written in +following table. +\medskip +~\\ +\begin{center} +\begin{tabular}{|c|l|} +\hline +argument & \multicolumn{1}{|c|}{ value }\\ +\hline\hline + \$1 & temporary file name of encoded content \\ + \$2 & Content-Type (type/sub-type) \\ + \$3 & encoding \{7bit / quoted-printable / base64 / 8bit / binary / ...\}\\ + \$4 & decoding-mode \{play / extract / print\} \\ + \$5 & original file name of content \\ +\hline +\end{tabular}\\ +\end{center} +\medskip +\par +Each Content-Types are decoded by methods. Exceptionally, +message/partial is decoded by tm-body.el. +\medskip +\medskip + +\section{Limitation or bug} +\medskip +\par +In this version, message/external-body is not supported. +\medskip +\par +Attached base64 decoder `decode-b.c' is not good program, so if it +can run normally, please correct it. But It is easy because decode-b.c +is too small, so please...(\verb+^+\_\verb+^+; +\medskip +\par +Or you can use mmencode attached in metamail as decoder. +\medskip +\par +In this package, there is no Quoted-Printable decoder, so please use +mmencode. +\end{document} diff --git a/tm-body-jp.ol b/tm-body-jp.ol new file mode 100644 index 0000000..2e0ed5f --- /dev/null +++ b/tm-body-jp.ol @@ -0,0 +1,90 @@ +$B!X(Btm-body $B@bL@=q!Y(B +by. $B$C$F(B install $B$r9T$J$C$F2<$5$$!#(B + +** tiny-mime $B$N(B install + + tiny-mime.el $B$r(B Emacs $B$NJQ?t(B load-path $B$G;XDj$5$l$?(B directory $B$K(B +copy $B$7$^$9!#(B + + +** tm-body $B$N(B install + +*** *.el $B$r(B copy $B$9$k(B + + tm-body.el, tl-list.el, tl-header.el $B$r(B Emacs $B$NJQ?t(B load-path $B$G;X(B +$BDj$5$l$?(B directory $B$K(B copy $B$7$^$9!#(B + + +*** method $B$r(B copy $B$9$k(B + + methods/ $B$KF~$C$F$$$k!"3F(B Content-Type $B$KBP1~$9$k(B method $B$r!"<+J,$N(B +$B4D6-$K9g$o$;$F=$@5$7!"(Bpath $B$NDL$C$?(B directory $B$K(B copy $B$7$^$9!#(B + + +*** decode-b.c $B$r(B compile $B$9$k(B + + Base64 decoder $B$G$"$k(B decode-b.c $B$r(B gcc $B$G(B compile $B$7$^$9!#(B + +[[E + % gcc -O decode-b.c -o decode-b +]]E + + $B$=$7$F!"=PMh>e$,$C$?(B decode-b $B$r(B path $B$NDL$C$?(B directory $B$K(B copy $B$7(B +$B$^$9!#(B + + $BC"$7!"B>$N(B decoder$B!JNc$($P!"(Bmetamail $BImB0$N(B mmencode $B$J$I!K$,$"$l$P!"(B +method $BCf$N(B decode-b $B$r$=$N(B decoder $B$GCV$-49$($F$b9=$$$^$;$s!#Nc$($P!"(B +decode-b < $B$r(B mmencode -b -u $B$GCV$-49$($F$_$F(B$B2<$5$$!#(B + + +* $B%+%9%?%^%$%:(B + + .emacs $B$K0J2<$N$h$&$J$b$N$rF~$l$F!"3F(B Content-Type $B$KBP1~$9$k(B method +$B$r;XDj$9$k$3$H$,$G$-$^$9!#(B + +[[E +---------------------------------------------------------------------- +(setq mime/content-decoding-method-alist + '(("audio/basic" . "tm-au") + ("image/gif" . "tm-image") + ("image/jpeg" . "tm-image") + ("image/x-pic" . "tm-image") + ("video/mpeg" . "tm-mpeg") + ("application/octet-stream" . "tm-file") + ("text/x-latex" . "tm-latex") + )) +---------------------------------------------------------------------- +]]E + + $B3F(B method $B$O(B shell script $B$G=q$-$^$9!#(Btm-body.el $B$+$iEO$5$l$k0z?t$O(B +$B0J2<$NDL$j$G$9!#(B + +------------------------------------------------------------------------ +|$B0z?t(B| $BCM(B | +======================================================================== +| $1 |decode $BA0$N(B file $BL>(B | +| $2 |Content-Type (type/sub-type) | +| $3 |encoding {7bit / quoted-printable / base64 / 8bit / binary / ...}| +| $4 |decoding-mode {play / extract / print} | +| $5 |file $BL>(B | +------------------------------------------------------------------------ + + $B$^$?!"(Bmessage/partial $B$@$1$O(B tm-body.el $B<+?H$GI|85$7$^$9!#(B + + +* $B@)8B(B + + message/external-body $B$K4X$7$F$O8=:_$N$H$3$m%5%]!<%H$7$F$$$^$;$s!#(B + + $BImB0$N(B BASE64 decoder $B$G$"$k(B decode-b.c $B$O$$$$2C8:$J:n$j$J$N$G!"F0$+(B +$B$J$+$C$?$i!"C;$$%W%m%0%i%`$J$N$G!"0U$r5b$s$G=$@5$7$F2<$5$$!#(B(^_^; + + $B$^$?!"(Bmetamail $BImB0$N(B mmencode $B$r;H$C$F(B decode $B$7$F$bNI$$$G$7$g$&!#(B + + $B$^$?!"(BQuoted-Printable $B$N(B decoder $B$OImB0$7$^$;$s$N$G!"(Bmmencode $B$r;H$C(B +$B$F2<$5$$!#(B diff --git a/tm-body-jp.tex b/tm-body-jp.tex new file mode 100644 index 0000000..0d5b212 --- /dev/null +++ b/tm-body-jp.tex @@ -0,0 +1,132 @@ +\documentstyle[a4j]{jarticle} +\setcounter{secnumdepth}{6} +\setcounter{tocdepth}{6} +\topsep=0.1cm +\parsep=0.1cm +\itemsep=0.0cm +\begin{document} +\title{ +tm-body ÀâÌÀ½ñ} +\author{ +¼é²¬ ÃÎɧ\\ +} +\date{ +1994ǯ7·î14Æü} +\maketitle +\medskip + +\section{install} +\medskip +\par +README ¤Ë½¾¤Ã¤Æ install ¤ò¹Ô¤Ê¤Ã¤Æ²¼¤µ¤¤¡£ +\medskip + +\subsection{tiny-mime ¤Î install} +\medskip +\par +tiny-mime.el ¤ò Emacs ¤ÎÊÑ¿ô load-path ¤Ç»ØÄꤵ¤ì¤¿ directory ¤Ë +copy ¤·¤Þ¤¹¡£ +\medskip +\medskip + +\subsection{tm-body ¤Î install} +\medskip + +\subsubsection{$*$.el ¤ò copy ¤¹¤ë} +\medskip +\par +tm-body.el, tl-list.el, tl-header.el ¤ò Emacs ¤ÎÊÑ¿ô load-path ¤Ç»Ø +Äꤵ¤ì¤¿ directory ¤Ë copy ¤·¤Þ¤¹¡£ +\medskip +\medskip + +\subsubsection{method ¤ò copy ¤¹¤ë} +\medskip +\par +methods/ ¤ËÆþ¤Ã¤Æ¤¤¤ë¡¢³Æ Content-Type ¤ËÂбþ¤¹¤ë method ¤ò¡¢¼«Ê¬¤Î +´Ä¶­¤Ë¹ç¤ï¤»¤Æ½¤Àµ¤·¡¢path ¤ÎÄ̤ä¿ directory ¤Ë copy ¤·¤Þ¤¹¡£ +\medskip +\medskip + +\subsubsection{decode-b.c ¤ò compile ¤¹¤ë} +\medskip +\par +Base64 decoder ¤Ç¤¢¤ë decode-b.c ¤ò gcc ¤Ç compile ¤·¤Þ¤¹¡£ +\medskip +{\baselineskip=10pt +\begin{verbatim} + % gcc -O decode-b.c -o decode-b +\end{verbatim}} +\medskip +\par +¤½¤·¤Æ¡¢½ÐÍè¾å¤¬¤Ã¤¿ decode-b ¤ò path ¤ÎÄ̤ä¿ directory ¤Ë copy ¤· +¤Þ¤¹¡£ +\medskip +\par +⤷¡¢Â¾¤Î decoder¡ÊÎ㤨¤Ð¡¢metamail Éí°¤Î mmencode ¤Ê¤É¡Ë¤¬¤¢¤ì¤Ð¡¢ +method Ãæ¤Î decode-b ¤ò¤½¤Î decoder ¤ÇÃÖ¤­´¹¤¨¤Æ¤â¹½¤¤¤Þ¤»¤ó¡£Î㤨¤Ð¡¢ +decode-b $<$ ¤ò mmencode -b -u ¤ÇÃÖ¤­´¹¤¨¤Æ¤ß¤Æ²¼¤µ¤¤¡£ +\medskip +\medskip + +\section{¥«¥¹¥¿¥Þ¥¤¥º} +\medskip +\par +.emacs ¤Ë°Ê²¼¤Î¤è¤¦¤Ê¤â¤Î¤òÆþ¤ì¤Æ¡¢³Æ Content-Type ¤ËÂбþ¤¹¤ë method +¤ò»ØÄꤹ¤ë¤³¤È¤¬¤Ç¤­¤Þ¤¹¡£ +\medskip +{\baselineskip=10pt +\begin{verbatim} +---------------------------------------------------------------------- +(setq mime/content-decoding-method-alist + '(("audio/basic" . "tm-au") + ("image/gif" . "tm-image") + ("image/jpeg" . "tm-image") + ("image/x-pic" . "tm-image") + ("video/mpeg" . "tm-mpeg") + ("application/octet-stream" . "tm-file") + ("text/x-latex" . "tm-latex") + )) +---------------------------------------------------------------------- +\end{verbatim}} +\medskip +\par +³Æ method ¤Ï shell script ¤Ç½ñ¤­¤Þ¤¹¡£tm-body.el ¤«¤éÅϤµ¤ì¤ë°ú¿ô¤Ï +°Ê²¼¤ÎÄ̤ê¤Ç¤¹¡£ +\medskip +~\\ +\begin{center} +\begin{tabular}{|c|l|} +\hline +°ú¿ô & \multicolumn{1}{|c|}{ ÃÍ }\\ +\hline\hline + \$1 & decode Á°¤Î file ̾ \\ + \$2 & Content-Type (type/sub-type) \\ + \$3 & encoding \{7bit / quoted-printable / base64 / 8bit / binary / ...\}\\ + \$4 & decoding-mode \{play / extract / print\} \\ + \$5 & file ̾ \\ +\hline +\end{tabular}\\ +\end{center} +\medskip +\par +¤Þ¤¿¡¢message/partial ¤À¤±¤Ï tm-body.el ¼«¿È¤ÇÉü¸µ¤·¤Þ¤¹¡£ +\medskip +\medskip + +\section{À©¸Â} +\medskip +\par +message/external-body ¤Ë´Ø¤·¤Æ¤Ï¸½ºß¤Î¤È¤³¤í¥µ¥Ý¡¼¥È¤·¤Æ¤¤¤Þ¤»¤ó¡£ +\medskip +\par +Éí°¤Î BASE64 decoder ¤Ç¤¢¤ë decode-b.c ¤Ï¤¤¤¤²Ã¸º¤Êºî¤ê¤Ê¤Î¤Ç¡¢Æ°¤« +¤Ê¤«¤Ã¤¿¤é¡¢Ã»¤¤¥×¥í¥°¥é¥à¤Ê¤Î¤Ç¡¢°Õ¤òµâ¤ó¤Ç½¤Àµ¤·¤Æ²¼¤µ¤¤¡£(\verb+^+\_\verb+^+; +\medskip +\par +¤Þ¤¿¡¢metamail Éí°¤Î mmencode ¤ò»È¤Ã¤Æ decode ¤·¤Æ¤âÎɤ¤¤Ç¤·¤ç¤¦¡£ +\medskip +\par +¤Þ¤¿¡¢Quoted-Printable ¤Î decoder ¤ÏÉí°¤·¤Þ¤»¤ó¤Î¤Ç¡¢mmencode ¤ò»È¤Ã +¤Æ²¼¤µ¤¤¡£ +\end{document} diff --git a/tm-body.el b/tm-body.el new file mode 100644 index 0000000..d23fd77 --- /dev/null +++ b/tm-body.el @@ -0,0 +1,327 @@ +;;; +;;; $Id: tm-body.el,v 0.14 1994/08/03 05:31:33 morioka Exp $ +;;; + +(provide 'tm-body) + +(require 'tl-list) +(require 'tl-header) +(require 'tiny-mime) + +(defun replace-as-filename (str) + (let ((dest "") + (i 0)(len (length str)) + chr) + (while (< i len) + (setq chr (elt str i)) + (if (or (and (<= ?+ chr)(<= chr ?.)) + (and (<= ?0 chr)(<= chr ?:)) + (= chr ?=) + (and (<= ?@ chr)(<= chr ?\[)) + (and (<= ?\] chr)(<= chr ?_)) + (and (<= ?a chr)(<= chr ?{)) + (and (<= ?} chr)(<= chr ?~)) + ) + (setq dest (concat dest + (char-to-string chr))) + ) + (setq i (+ i 1)) + ) + dest)) + +(defconst mime/tspecials "\000-\040()<>@,;:\\\"/[\093?.=") +(defconst mime/token-regexp + (concat "[^" mime/tspecials "]*")) +(defconst mime/content-type-subtype-regexp + (concat mime/token-regexp "/" mime/token-regexp)) +(defconst mime/content-parameter-value-regexp + (concat "\\(" + message/quoted-string-regexp + "\\|[^; \t\n]\\)*")) + +(defconst mime/output-buffer-name "*MIME-out*") +(defconst mime/decoding-buffer-name "*MIME-decoding*") + +(defvar mime/content-decoding-method-alist + '(("text/plain" . "tm-plain") + ("text/x-latex" . "tm-latex") + ("audio/basic" . "tm-au") + ("image/gif" . "tm-image") + ("image/jpeg" . "tm-image") + ("image/tiff" . "tm-image") + ("image/x-tiff" . "tm-image") + ("image/x-pic" . "tm-image") + ("video/mpeg" . "tm-mpeg") + ("application/octet-stream" . "tm-file") + )) +;;; (setq mime/content-decoding-method-alist +;;; '(("audio/basic" . "tm-au") +;;; ("image/gif" . "tm-image") +;;; ("image/jpeg" . "tm-image") +;;; ("image/x-pic" . "tm-image") +;;; ("video/mpeg" . "tm-mpeg") +;;; ("application/octet-stream" . "tm-file") +;;; )) +(defvar mime/use-internal-decoder nil) +;;; (setq mime/use-internal-decoder t) + +(defun mime/decode-body () + (interactive) + (if (get-buffer mime/output-buffer-name) + (kill-buffer mime/output-buffer-name)) + (save-excursion + (save-restriction + (goto-char (point-min)) + (let ((ctype (mime/Content-Type "^$")) + (encoding (mime/Content-Transfer-Encoding "^$" "7bit")) + ) + (if ctype + (cond ((equal (car ctype) "multipart/mixed") + (mime/decode-multipart/mixed ctype encoding) + ) + ((equal (car ctype) "message/partial") + (mime/decode-message/partial ctype encoding) + ) + (t + (mime/decode-content nil (car ctype) encoding + (mime/get-name ctype)) + )) + ))))) + +(defun mime/decode-multipart/mixed (ctype default-encoding) + (let ((boundary (cdr (assoc "boundary" (cdr ctype)))) + encoding b) + (if (eq (elt boundary 0) ?\") + (setq boundary + (substring boundary 1 (- (length boundary) 1)) + )) + (setq boundary (concat "^--" (regexp-quote boundary) "\\(--\\)?$")) + (while (re-search-forward boundary nil t) + (goto-char (point-min)) + (setq b (+ (match-end 0) 1)) + (goto-char b) + (and (setq ctype (mime/Content-Type)) + (setq encoding + (mime/Content-Transfer-Encoding boundary + default-encoding)) + (mime/decode-content boundary + (car ctype) encoding + (mime/get-name ctype)) + ) + ))) + +(defun mime/decode-message/partial (ctype default-encoding) + (let ((root-dir (concat "/tmp/m-prts-" (user-login-name))) + (id (cdr (assoc "id" (cdr ctype)))) + (number (cdr (assoc "number" (cdr ctype)))) + (total (cdr (assoc "total" (cdr ctype)))) + file + (the-buf (current-buffer)) + ) + (if (not (file-exists-p root-dir)) + (shell-command (concat "mkdir " root-dir)) + ) + (setq id (replace-as-filename id)) + (setq root-dir (concat root-dir "/" id)) + (if (not (file-exists-p root-dir)) + (shell-command (concat "mkdir " root-dir)) + ) + (setq file (concat root-dir "/FULL")) + (if (not (file-exists-p file)) + (progn + (setq file (concat root-dir "/CT")) + (if (not (file-exists-p file)) + (progn + (if (get-buffer "*MIME-temp*") + (kill-buffer "*MIME-temp*") + ) + (switch-to-buffer "*MIME-temp*") + (insert (concat total "\n")) + (write-file file) + (switch-to-buffer the-buf) + )) + (re-search-forward "^$") + (goto-char (+ (match-end 0) 1)) + (setq file (concat root-dir "/" number)) + (write-region (point) + (point-max) + file) + (if (get-buffer "*MIME-temp*") + (kill-buffer "*MIME-temp*") + ) + (switch-to-buffer "*MIME-temp*") + (let ((i 1) + (max (string-to-int total)) + ) + (catch 'tag + (while (<= i max) + (setq file (concat root-dir "/" + (int-to-string i) + )) + (if (not (file-exists-p file)) + (throw 'tag nil)) + (insert-file-contents file) + (goto-char (point-max)) + (setq i (+ i 1)) + ) + (write-file (concat root-dir "/FULL")) + (mime/decode-body) + (kill-buffer "FULL") + )) + (switch-to-buffer the-buf) + ) + (progn + (find-file file) + (mime/decode-body) + (kill-buffer "FULL") + )) + )) + +(defun mime/get-name (ctype) + (replace-as-filename + (or (cdr (assoc "name" (cdr ctype))) + (cdr (assoc "x-name" (cdr ctype))) + (message/get-field-body "Content-Description") + ""))) + +(defun mime/narrow-to-content (boundary) + (if boundary + (progn + (narrow-to-region (point) + (progn + (re-search-forward boundary nil t) + (match-beginning 0) + )) + (goto-char (point-min)) + ))) + +(defun mime/Content-Type (&optional boundary) + (save-excursion + (save-restriction + (mime/narrow-to-content boundary) + (if (and (re-search-forward "^Content-Type:[ \t]*" nil t) + (progn + (narrow-to-region + (point) + (and (re-search-forward ".*\\(\n[ \t].*\\)*" nil t) + (match-end 0)) + ) + (goto-char (point-min)) + (re-search-forward mime/content-type-subtype-regexp nil t) + )) + (let ((ctype + (downcase + (buffer-substring (match-beginning 0) (match-end 0)) + )) + dest attribute value) + (while (and (re-search-forward "[ \t\n]*;[ \t\n]*" nil t) + (re-search-forward mime/token-regexp nil t) + ) + (setq attribute + (downcase + (buffer-substring (match-beginning 0) (match-end 0)) + )) + (if (and (re-search-forward "=[ \t\n]*" nil t) + (re-search-forward mime/content-parameter-value-regexp + nil t) + ) + (setq dest + (put-alist attribute + (buffer-substring (match-beginning 0) + (match-end 0)) + dest)) + ) + ) + (cons ctype dest) + ))))) + +(defun mime/Content-Transfer-Encoding (&optional boundary default-encoding) + (save-excursion + (save-restriction + (mime/narrow-to-content boundary) + (or + (if (and (re-search-forward "^Content-Transfer-Encoding:[ \t]*" nil t) + (re-search-forward mime/token-regexp nil t) + ) + (downcase (buffer-substring (match-beginning 0) (match-end 0))) + ) + default-encoding) + ))) + +(defun mime/base64-decode-region (beg end &optional buf filename) + (let ((the-buf (current-buffer)) ret) + (if (null buf) + (setq buf (get-buffer-create mime/decoding-buffer-name)) + ) + (save-excursion + (save-restriction + (switch-to-buffer buf) + (erase-buffer) + (switch-to-buffer the-buf) + (narrow-to-region beg end) + (goto-char (point-min)) + (while (re-search-forward + (concat "^" + mime/Base64-encoded-text-regexp + "$") nil t) + (setq ret (mime/base64-decode-string + (buffer-substring (match-beginning 0) + (match-end 0) + ))) + (switch-to-buffer buf) + (insert ret) + (switch-to-buffer the-buf) + ))) + (if filename + (progn + (switch-to-buffer buf) + (let ((kanji-flag nil) + (mc-flag nil) + (file-coding-system + (if (featurep 'mule) *noconv*)) + ) + (write-file filename) + (kill-buffer buf) + (switch-to-buffer the-buf) + ))) + )) + +(defun mime/decode-content (boundary ctype encoding name) + (let ((method (cdr (assoc ctype mime/content-decoding-method-alist)))) + (if method + (save-excursion + (save-restriction + (re-search-forward "^$") + (goto-char (+ (match-end 0) 1)) + (let ((file (make-temp-name "/tmp/TM")) + (b (point)) e + ) + (setq e (if boundary + (and (re-search-forward boundary nil t) + (match-beginning 0)) + (point-max) + )) + (if (and (string= encoding "base64") + mime/use-internal-decoder) + (progn + (mime/base64-decode-region b e nil file) + (setq encoding "binary") + ) + (write-region b e file) + ) + (start-process method mime/output-buffer-name method file + ctype (if encoding + encoding + "7bit") + (if mime/body-decoding-mode + mime/body-decoding-mode + "decode") + (replace-as-filename name)) + )))))) + +(defun mime/show-body-decoded-result () + (interactive) + (if (get-buffer mime/output-buffer-name) + (set-window-buffer (get-largest-window) + mime/output-buffer-name) + )) diff --git a/tm-gnus-eng.ol b/tm-gnus-eng.ol new file mode 100644 index 0000000..f5c74bc --- /dev/null +++ b/tm-gnus-eng.ol @@ -0,0 +1,93 @@ +[[R +\title{tm-gnus manual (English Version)} +\author{Morioka Tomohiko} +\date{1994/7/25} +\maketitle +]]R + +* Install + +** tiny-mime + + Please copy tiny-mime.el to your emacs lisp directory. + + +** tm-body + + Please copy tm-body.el, tl-list.el and tl-header.el to your emacs +lisp directory. + + +** tm-misc + + Please copy tm-misc.el and tl-hook.el to your emacs lisp directory. + + +** tm-gnus + + Please copy tm-gnus.el to your emacs lisp directory. + + + +* .emacs + + Please insert following list to .emacs. + +[[E +---------------------------------------------------------------------- +(if (not (fboundp 'add-hook)) + (require 'tl-hook) + ) + +(let ((le (function + (lambda () + (require 'tm-gnus) + ))) + ) + (if (boundp 'MULE) + (progn + (add-hook 'gnus-Group-mode-hook (function gnusutil-initialize)) + (add-hook 'gnus-group-mode-hook (function gnusutil-initialize)) + (autoload 'gnusutil-initialize "gnusutil") + (autoload 'gnusutil-add-group "gnusutil") + (add-hook 'gnusutil-initialize-hook le) + ) + (progn + (add-hook 'gnus-Startup-hook le) + (add-hook 'gnus-startup-hook le) + ))) +---------------------------------------------------------------------- +]]E + + +* How to use + +------------------------------------------------------- +| key | function | +======================================================= +| M-t |toggle switch of message header decoding mode | +------------------------------------------------------- +| v |MIME decode message body and play | +| e |MIME decode message body and extract to file(s)| +|C-c p|MIME decode message body and print | +------------------------------------------------------- + + +* How to use metamail + + In normal definition, tm-mh-e use tm-body as MIME body decoder. +However, you can use metamail. In this case, Of course, you need +metamail and metamail.el. + + Please insert following list to .emacs if you want to use metamail. + +[[E +---------------------------------------------------------------------- +(autoload 'metamail-buffer "metamail" nil t) +(setq mime/body-decoding-method (function metamail-buffer)) +---------------------------------------------------------------------- +]]E + + If you use metamail, there are no decoding mode of MIME body +decoding. Therefore, functions for `v', `e', `C-c p' are equally +`metamail-buffer', and decoding is sequentially. diff --git a/tm-gnus-eng.tex b/tm-gnus-eng.tex new file mode 100644 index 0000000..e4815cb --- /dev/null +++ b/tm-gnus-eng.tex @@ -0,0 +1,120 @@ +\documentstyle[a4j]{jarticle} +\setcounter{secnumdepth}{6} +\setcounter{tocdepth}{6} +\topsep=0.1cm +\parsep=0.1cm +\itemsep=0.0cm +\begin{document} +\title{tm-gnus manual (English Version)} +\author{Morioka Tomohiko} +\date{1994/7/25} +\maketitle +\medskip + +\section{Install} +\medskip + +\subsection{tiny-mime} +\medskip +\par +Please copy tiny-mime.el to your emacs lisp directory. +\medskip +\medskip + +\subsection{tm-body} +\medskip +\par +Please copy tm-body.el, tl-list.el and tl-header.el to your emacs +lisp directory. +\medskip +\medskip + +\subsection{tm-misc} +\medskip +\par +Please copy tm-misc.el and tl-hook.el to your emacs lisp directory. +\medskip +\medskip + +\subsection{tm-gnus} +\medskip +\par +Please copy tm-gnus.el to your emacs lisp directory. +\medskip +\medskip +\medskip + +\section{.emacs} +\medskip +\par +Please insert following list to .emacs. +\medskip +{\baselineskip=10pt +\begin{verbatim} +---------------------------------------------------------------------- +(if (not (fboundp 'add-hook)) + (require 'tl-hook) + ) + +(let ((le (function + (lambda () + (require 'tm-gnus) + ))) + ) + (if (boundp 'MULE) + (progn + (add-hook 'gnus-Group-mode-hook (function gnusutil-initialize)) + (add-hook 'gnus-group-mode-hook (function gnusutil-initialize)) + (autoload 'gnusutil-initialize "gnusutil") + (autoload 'gnusutil-add-group "gnusutil") + (add-hook 'gnusutil-initialize-hook le) + ) + (progn + (add-hook 'gnus-Startup-hook le) + (add-hook 'gnus-startup-hook le) + ))) +---------------------------------------------------------------------- +\end{verbatim}} +\medskip +\medskip + +\section{How to use} +\medskip +~\\ +\begin{tabular}{|c|r|} +\hline + key & function \\ +\hline\hline + M-t & toggle switch of message header decoding mode \\ +\hline + v & MIME decode message body and play \\ + e & MIME decode message body and extract to file(s)\\ +C-c p & MIME decode message body and print \\ +\hline +\end{tabular}\\ +\medskip +\medskip + +\section{How to use metamail} +\medskip +\par +In normal definition, tm-mh-e use tm-body as MIME body decoder. +However, you can use metamail. In this case, Of course, you need +metamail and metamail.el. +\medskip +\par +Please insert following list to .emacs if you want to use metamail. +\medskip +{\baselineskip=10pt +\begin{verbatim} +---------------------------------------------------------------------- +(autoload 'metamail-buffer "metamail" nil t) +(setq mime/body-decoding-method (function metamail-buffer)) +---------------------------------------------------------------------- +\end{verbatim}} +\medskip +\par +If you use metamail, there are no decoding mode of MIME body +decoding. Therefore, functions for `v', `e', `C-c p' are equally +`metamail-buffer', and decoding is sequentially. +\end{document} diff --git a/tm-gnus-jp.ol b/tm-gnus-jp.ol new file mode 100644 index 0000000..8927a3f --- /dev/null +++ b/tm-gnus-jp.ol @@ -0,0 +1,182 @@ +$B!X(Btm-gnus $B@bL@=q!Y(B +by. $B $B6&DL(B module), tm-gnus $B$N3F(B module $B$+$i(B +$B$J$j$^$9!#3F(B module $BKh$N(B install $BK!$O0J2<$NDL$j$G$9!#(B + + +** tiny-mime $B$N(B install + + tiny-mime.el $B$r(B Emacs $B$NJQ?t(B load-path $B$G;XDj$5$l$?(B directory $B$K(B +copy $B$7$^$9!#(B + + +** tm-body $B$N(B install + + tm-body.el, tl-list.el, tl-header.el $B$r(B Emacs $B$NJQ?t(B load-path $B$G;X(B +$BDj$5$l$?(B directory $B$K(B copy $B$7$^$9!#(B + + +** tm-misc $B$N(B install + + tm-misc.el, tl-hook.el $B$r(B Emacs $B$NJQ?t(B load-path $B$G;XDj$5$l$?(B +directory $B$K(B copy $B$7$^$9!#(B + + +** tm-gnus $B$N(B install + + tm-gnus.el $B$H(B tm-gnus3.el $B$r(B Emacs $B$NJQ?t(B load-path $B$G;XDj$5$l$?(B +directory $B$K(B copy $B$7$^$9!#(Btm-gnus3.el $B$r(B byte-compile $B$9$k>l9g$O!"(BGNUS +3 $B$,(B load $B$5$l$?>uBV$G9T$J$C$F2<$5$$!#(B + + + +* $B@_Dj(B + + .emacs $B$K0J2<$N$b$N$rF~$l$^$9!#(B + +[[E +---------------------------------------------------------------------- +(if (not (fboundp 'add-hook)) + (require 'tl-hook) + ) + +(let ((le (function + (lambda () + (require 'tm-gnus) + ))) + ) + (if (boundp 'MULE) + (progn + (add-hook 'gnus-Group-mode-hook (function gnusutil-initialize)) + (add-hook 'gnus-group-mode-hook (function gnusutil-initialize)) + (autoload 'gnusutil-initialize "gnusutil") + (autoload 'gnusutil-add-group "gnusutil") + (add-hook 'gnusutil-initialize-hook le) + ) + (progn + (add-hook 'gnus-Startup-hook le) + (add-hook 'gnus-startup-hook le) + ))) +---------------------------------------------------------------------- +]]E + + Mule $B$K$*$1$k>e5-$N@_Dj$O!"(Bgnusutil $B$rJ;MQ$9$k>l9g$N$b$N$G$9$,!"(B +gnusutil $B$rJ;MQ$7$J$$>l9g$O(B (require 'tm-gnus) $B$@$1$G7k9=$G$9!#(B + + +* $B;H$$J}(B + +-------------------------------------------------------------------- +| key | $B5!G=(B | +==================================================================== +| M-t |message header $B$r(B decode $B$K4X$9$k(B toggle switch | +-------------------------------------------------------------------- +| v |message body $B$r(B MIME decode $B$7$F!":F@8$9$k(B (play mode) | +| e |message body $B$r(B MIME decode $B$7$F!"(Bfile $B$KMn$9(B (extract mode)| +|C-c p|message body $B$r(B MIME decode $B$7$F!"0u:~$9$k(B (print mode) | +-------------------------------------------------------------------- + + message body $B$N(B MIME decode $B$K$*$$$F!"l9g(B .emacs $B$K0J2<$N$b$N$rF~$l$F2<$5$$!#(B + +[[E +---------------------------------------------------------------------- +(autoload 'metamail-buffer "metamail" nil t) +(setq mime/body-decoding-method (function metamail-buffer)) +---------------------------------------------------------------------- +]]E + + metamail $B$r;H$&@_Dj$N>l9g!"(B`v', `e', `C-c p' $B$KBP1~$9$kF0:n$O(B +metamail $B$K$+$1$k$@$1$K$J$j!"F10l$NF0:n$K$J$j$^$9!#$^$?!"F0:n$OC`o$K!"(BMIME header decoding $B$r9T$J$o(B +$B$J$$!"@8$N(B message $B$GJ]B8$7$?$$>l9g$O(B +(tm-gnus/set-mime-header-decoding-mode nil) $B$r9T$J$C$F!"(BMIME header +decoding $B$r9T$J$o$J$$(B mode $B$K$7$F!"(Barticle save $B4X?t$ruBV$KLa$7$?$$>l9g$O!"(B +$B0J2<$N$h$&$K!"0l;~JQ?t$K(B MIME header decoding mode $B$rJ]B8$7$F$*$1$P(B OK +$B$G$9!#(B + +[[E + (let ((mm mime/header-decoding-mode)) + (tm-gnus/set-mime-header-decoding-mode nil) + (article save $B4X?t(B) + (tm-gnus/set-mime-header-decoding-mode mm) + ) +]]E + + $B0J2<$K!"(Bmh-e $B$N(B folder $B$K(B save $B$9$k>l9g$NNc$r<($7$^$9!#(B + +[[E +---------------------------------------------------------------------- +(add-hook 'gnus-Startup-hook + (function + (lambda () + (setq gnus-default-article-saver + (function + (lambda () + (interactive) + (let ((mm mime/header-decoding-mode)) + (tm-gnus/set-mime-header-decoding-mode nil) + (gnus-Subject-save-in-folder) + (tm-gnus/set-mime-header-decoding-mode mm) + ))))))) +(add-hook 'gnus-startup-hook + (function + (lambda () + (setq gnus-default-article-saver + (function + (lambda () + (interactive) + (let ((mm mime/header-decoding-mode)) + (tm-gnus/set-mime-header-decoding-mode nil) + (gnus-summary-save-in-folder) + (tm-gnus/set-mime-header-decoding-mode mm) + ))))))) +---------------------------------------------------------------------- +]]E + + +** reply $B$9$k;~(B Subject $B$N(B encoding $BK!$r(B reply $B85$K9g$o$;$k(B + + Reply $B$9$k;~!"(Breply $B85$N(B Subject $B$K(B ASCII $B0J30$NJ8;z=89g$NF~$C$F$$$k(B +$B>l9g!"(Breply $B85$,(B MIME encode $B$5$l$F$$$?$i(B encode $B$7!"$=$&$G$J$+$C$?$i(B +$B@8$GF~$l$?$$>l9g$O!"$ ¶¦ÄÌ module), tm-gnus ¤Î³Æ module ¤«¤é +¤Ê¤ê¤Þ¤¹¡£³Æ module Ëè¤Î install Ë¡¤Ï°Ê²¼¤ÎÄ̤ê¤Ç¤¹¡£ +\medskip +\medskip + +\subsection{tiny-mime ¤Î install} +\medskip +\par +tiny-mime.el ¤ò Emacs ¤ÎÊÑ¿ô load-path ¤Ç»ØÄꤵ¤ì¤¿ directory ¤Ë +copy ¤·¤Þ¤¹¡£ +\medskip +\medskip + +\subsection{tm-body ¤Î install} +\medskip +\par +tm-body.el, tl-list.el, tl-header.el ¤ò Emacs ¤ÎÊÑ¿ô load-path ¤Ç»Ø +Äꤵ¤ì¤¿ directory ¤Ë copy ¤·¤Þ¤¹¡£ +\medskip +\medskip + +\subsection{tm-misc ¤Î install} +\medskip +\par +tm-misc.el, tl-hook.el ¤ò Emacs ¤ÎÊÑ¿ô load-path ¤Ç»ØÄꤵ¤ì¤¿ +directory ¤Ë copy ¤·¤Þ¤¹¡£ +\medskip +\medskip + +\subsection{tm-gnus ¤Î install} +\medskip +\par +tm-gnus.el ¤È tm-gnus3.el ¤ò Emacs ¤ÎÊÑ¿ô load-path ¤Ç»ØÄꤵ¤ì¤¿ +directory ¤Ë copy ¤·¤Þ¤¹¡£tm-gnus3.el ¤ò byte-compile ¤¹¤ë¾ì¹ç¤Ï¡¢GNUS +3 ¤¬ load ¤µ¤ì¤¿¾õÂ֤ǹԤʤäƲ¼¤µ¤¤¡£ +\medskip +\medskip +\medskip + +\section{ÀßÄê} +\medskip +\par +.emacs ¤Ë°Ê²¼¤Î¤â¤Î¤òÆþ¤ì¤Þ¤¹¡£ +\medskip +{\baselineskip=10pt +\begin{verbatim} +---------------------------------------------------------------------- +(if (not (fboundp 'add-hook)) + (require 'tl-hook) + ) + +(let ((le (function + (lambda () + (require 'tm-gnus) + ))) + ) + (if (boundp 'MULE) + (progn + (add-hook 'gnus-Group-mode-hook (function gnusutil-initialize)) + (add-hook 'gnus-group-mode-hook (function gnusutil-initialize)) + (autoload 'gnusutil-initialize "gnusutil") + (autoload 'gnusutil-add-group "gnusutil") + (add-hook 'gnusutil-initialize-hook le) + ) + (progn + (add-hook 'gnus-Startup-hook le) + (add-hook 'gnus-startup-hook le) + ))) +---------------------------------------------------------------------- +\end{verbatim}} +\medskip +\par +Mule ¤Ë¤ª¤±¤ë¾åµ­¤ÎÀßÄê¤Ï¡¢gnusutil ¤òÊ»ÍѤ¹¤ë¾ì¹ç¤Î¤â¤Î¤Ç¤¹¤¬¡¢ +gnusutil ¤òÊ»ÍѤ·¤Ê¤¤¾ì¹ç¤Ï (require 'tm-gnus) ¤À¤±¤Ç·ë¹½¤Ç¤¹¡£ +\medskip +\medskip + +\section{»È¤¤Êý} +\medskip +~\\ +\begin{tabular}{|c|c|} +\hline + key & µ¡Ç½ \\ +\hline\hline + M-t & message header ¤ò decode ¤Ë´Ø¤¹¤ë toggle switch \\ +\hline + v & message body ¤ò MIME decode ¤·¤Æ¡¢ºÆÀ¸¤¹¤ë (play mode) \\ + e & message body ¤ò MIME decode ¤·¤Æ¡¢file ¤ËÍ (extract mode)\\ +C-c p & message body ¤ò MIME decode ¤·¤Æ¡¢°õºþ¤¹¤ë (print mode) \\ +\hline +\end{tabular}\\ +\medskip +\par +message body ¤Î MIME decode ¤Ë¤ª¤¤¤Æ¡¢¼ÂºÝ¤Ë³ÆÆ°ºî¤¬¹Ô¤Ê¤ï¤ì¤ë¤«¤É¤¦ +¤«¤Ï¡¢³Æ Content-Type ¤ËÂбþ¤¹¤ë tm-body ¤Î mthod ¤Ë°Í¸¤·¤Þ¤¹¡£ +\medskip +\medskip + +\section{³Æ¼ïÀßÄê} +\medskip + +\subsection{metamail ¤ò»È¤¦ÊýË¡} +\medskip +\par +tm-mh-e ¤Ï MIME body ¤Î decode ¤Ë tm-body ¤ò»È¤¤¤Þ¤¹¤¬¡¢metamail ¤ò +»È¤¦¤è¤¦¤ËÀßÄꤹ¤ë¤³¤È¤â²Äǽ¤Ç¤¹¡£Ã¢¤·¡¢metamail ¤È metamail.el ¤¬É¬Í× +¤Ç¤¹¡£ +\medskip +\par +¤³¤Î¾ì¹ç .emacs ¤Ë°Ê²¼¤Î¤â¤Î¤òÆþ¤ì¤Æ²¼¤µ¤¤¡£ +\medskip +{\baselineskip=10pt +\begin{verbatim} +---------------------------------------------------------------------- +(autoload 'metamail-buffer "metamail" nil t) +(setq mime/body-decoding-method (function metamail-buffer)) +---------------------------------------------------------------------- +\end{verbatim}} +\medskip +\par +metamail ¤ò»È¤¦ÀßÄê¤Î¾ì¹ç¡¢`v', `e', `C-c p' ¤ËÂбþ¤¹¤ëÆ°ºî¤Ï +metamail ¤Ë¤«¤±¤ë¤À¤±¤Ë¤Ê¤ê¡¢Æ±°ì¤ÎÆ°ºî¤Ë¤Ê¤ê¤Þ¤¹¡£¤Þ¤¿¡¢Æ°ºî¤ÏÃ༡Ū +¤Ë¤Ê¤ê¤Þ¤¹¡£ +\medskip +\medskip + +\subsection{article ¤ò save ¤¹¤ë»þ decoding ¤·¤Ê¤¤} +\medskip +\par +article ¤ò save ¤¹¤ë»þ¡¢Êݸ¤µ¤ì¤ë message ¤Ï¤½¤Î»þɽ¼¨¤µ¤ì¤Æ¤¤¤ë¤è +¤¦¤Ë¡¢¤½¤Î»þ¤Î MIME header decoding mode ¤Ë±þ¤¸¤Æ save ¤µ¤ì¤Þ¤¹¡£ +\medskip +\par +¤·¤«¤·¡¢article ¤ò save ¤¹¤ë»þ¡¢¾ï¤Ë¡¢MIME header decoding ¤ò¹Ô¤Ê¤ï +¤Ê¤¤¡¢À¸¤Î message ¤ÇÊݸ¤·¤¿¤¤¾ì¹ç¤Ï +(tm-gnus/set-mime-header-decoding-mode nil) ¤ò¹Ô¤Ê¤Ã¤Æ¡¢MIME header +decoding ¤ò¹Ô¤Ê¤ï¤Ê¤¤ mode ¤Ë¤·¤Æ¡¢article save ´Ø¿ô¤ò¼Â¹Ô¤¹¤ë¤è¤¦¤ËÀß +Äꤷ¤Æ²¼¤µ¤¤¡£ +\medskip +\par +Save ¤Î¼Â¹Ô¸å¡¢MIME header decoding mode ¤òÁ°¤Î¾õÂÖ¤ËÌᤷ¤¿¤¤¾ì¹ç¤Ï¡¢ +°Ê²¼¤Î¤è¤¦¤Ë¡¢°ì»þÊÑ¿ô¤Ë MIME header decoding mode ¤òÊݸ¤·¤Æ¤ª¤±¤Ð OK +¤Ç¤¹¡£ +\medskip +{\baselineskip=10pt +\begin{verbatim} + (let ((mm mime/header-decoding-mode)) + (tm-gnus/set-mime-header-decoding-mode nil) + (article save ´Ø¿ô) + (tm-gnus/set-mime-header-decoding-mode mm) + ) +\end{verbatim}} +\medskip +\par +°Ê²¼¤Ë¡¢mh-e ¤Î folder ¤Ë save ¤¹¤ë¾ì¹ç¤ÎÎã¤ò¼¨¤·¤Þ¤¹¡£ +\medskip +{\baselineskip=10pt +\begin{verbatim} +---------------------------------------------------------------------- +(add-hook 'gnus-Startup-hook + (function + (lambda () + (setq gnus-default-article-saver + (function + (lambda () + (interactive) + (let ((mm mime/header-decoding-mode)) + (tm-gnus/set-mime-header-decoding-mode nil) + (gnus-Subject-save-in-folder) + (tm-gnus/set-mime-header-decoding-mode mm) + ))))))) +(add-hook 'gnus-startup-hook + (function + (lambda () + (setq gnus-default-article-saver + (function + (lambda () + (interactive) + (let ((mm mime/header-decoding-mode)) + (tm-gnus/set-mime-header-decoding-mode nil) + (gnus-summary-save-in-folder) + (tm-gnus/set-mime-header-decoding-mode mm) + ))))))) +---------------------------------------------------------------------- +\end{verbatim}} +\medskip +\medskip + +\subsection{reply ¤¹¤ë»þ Subject ¤Î encoding Ë¡¤ò reply ¸µ¤Ë¹ç¤ï¤»¤ë} +\medskip +\par +Reply ¤¹¤ë»þ¡¢reply ¸µ¤Î Subject ¤Ë ASCII °Ê³°¤Îʸ»ú½¸¹ç¤ÎÆþ¤Ã¤Æ¤¤¤ë +¾ì¹ç¡¢reply ¸µ¤¬ MIME encode ¤µ¤ì¤Æ¤¤¤¿¤é encode ¤·¡¢¤½¤¦¤Ç¤Ê¤«¤Ã¤¿¤é +À¸¤ÇÆþ¤ì¤¿¤¤¾ì¹ç¤Ï¡¢¼¡¤Î¤è¤¦¤ËÀßÄꤷ¤Þ¤¹¡£ +\medskip +{\baselineskip=10pt +\begin{verbatim} +---------------------------------------------------------------------- +(add-hook 'gnus-article-prepare-hook + (function + (lambda () + (if (mime/exist-encoded-word-in-subject) + (setq mime/no-encoding-header-fields '("X-Nsubject")) + (setq mime/no-encoding-header-fields '("X-Nsubject" "Subject")) + )))) +---------------------------------------------------------------------- +\end{verbatim}} +\end{document} diff --git a/tm-gnus.el b/tm-gnus.el new file mode 100644 index 0000000..ec6a9d7 --- /dev/null +++ b/tm-gnus.el @@ -0,0 +1,122 @@ +;;; +;;; $Id: tm-gnus.el,v 2.0 1994/07/24 08:33:00 morioka Exp morioka $ +;;; +;;; A MIME extension for GNUS +;;; +;;; by Morioka Tomohiko, 1993/11/20 + +(provide 'tm-gnus) + +(require 'tm-misc) +(require 'gnus) + + +;;; @ variables +;;; +(defvar tm-gnus/startup-hook nil) + + +;;; @ to decode subject in mode-line +;;; +;; This function imported from gnus.el. +;; +;; New implementation in gnus 3.14.3 +;; +(defun tm-gnus/article-set-mode-line () + "Set Article mode line string. +If you don't like it, define your own gnus-article-set-mode-line." + (let ((maxlen 15) ;Maximum subject length + (subject + (if gnus-current-headers + (mime/decode-string (nntp-header-subject gnus-current-headers)) + "") + )) + ;; The value must be a string to escape %-constructs because of subject. + (setq mode-line-buffer-identification + (format "GNUS: %s%s %s%s%s" + gnus-newsgroup-name + (if gnus-current-article + (format "/%d" gnus-current-article) "") + (rightful-boundary-short-string subject + (min (string-width subject) + maxlen)) + (if (> (string-width subject) maxlen) "..." "") + (make-string (max 0 (- 17 (string-width subject))) ? ) + ))) + (set-buffer-modified-p t)) + + +;;; @ MIME full decode message +;;; +(defun tm-gnus/full-decode-message-old (arg) + "MIME full-decode this article." + (interactive "P") + (let ((gnus-Article-prepare-hook mime/body-decoding-method)) + ;; The following is a trick + ;; to force to read the current article again. + (setq gnus-have-all-headers (not gnus-have-all-headers)) + (gnus-summary-select-article (not gnus-have-all-headers) t) + )) + +(defun tm-gnus/full-decode-message-new (arg) + "MIME full-decode this article." + (interactive "P") + (setq gnus-show-mime t) + ;; The following is a trick to force to read the current article again. + (setq gnus-have-all-headers (not gnus-have-all-headers)) + (gnus-summary-select-article (not gnus-have-all-headers) t) + (setq gnus-show-mime nil)) + +(defun tm-gnus/play-message (arg) + "MIME decode and play this message." + (interactive "P") + (let ((mime/body-decoding-mode "play")) + (tm-gnus/full-decode-message arg) + ) + (mime/show-body-decoded-result) + ) + +(defun tm-gnus/extract-message (arg) + "MIME decode and extract files from this message." + (interactive "P") + (let ((mime/body-decoding-mode "extract")) + (tm-gnus/full-decode-message arg) + ) + (mime/show-body-decoded-result) + ) + +(defun tm-gnus/print-message (arg) + "MIME decode and print contents of this message." + (interactive "P") + (let ((mime/body-decoding-mode "print")) + (tm-gnus/full-decode-message arg) + ) + (mime/show-body-decoded-result) + ) + + +;;; @ change MIME header decoding mode, decoding or non decoding. +;;; +(defun tm-gnus/set-mime-header-decoding-mode (arg) + "Set MIME header processing. +With arg, turn MIME processing on iff arg is positive." + (setq mime/header-decoding-mode arg) + (setq gnus-have-all-headers (not gnus-have-all-headers)) + (gnus-summary-select-article (not gnus-have-all-headers) t) + ) + +(defun tm-gnus/toggle-mime-header-decoding-mode () + "Toggle MIME header processing. +With arg, turn MIME processing on iff arg is positive." + (interactive) + (tm-gnus/set-mime-header-decoding-mode (not mime/header-decoding-mode)) + ) + +;;; @ set up +;;; +(if (string-match "^GNUS [0-3]" gnus-version) + (require 'tm-gnus3) + (require 'tm-gnus4) + ) + +(run-hooks 'tm-gnus/startup-hook) diff --git a/tm-gnus3.el b/tm-gnus3.el new file mode 100644 index 0000000..8143b82 --- /dev/null +++ b/tm-gnus3.el @@ -0,0 +1,85 @@ +;;; +;;; $Id: tm-gnus3.el,v 2.0 1994/07/24 08:33:00 morioka Exp morioka $ +;;; + +(provide 'tm-gnus3) + +(require 'tm-gnus) + +(if (and (null gnus-Startup-hook) + (boundp 'gnus-startup-hook)) + (setq gnus-Startup-hook gnus-startup-hook) + ) +(if (and (null gnus-Select-group-hook) + (boundp 'gnus-select-group-hook)) + (setq gnus-Select-group-hook gnus-select-group-hook) + ) +(if (and (null gnus-Subject-mode-hook) + (boundp 'gnus-summary-mode-hook)) + (setq gnus-Subject-mode-hook gnus-summary-mode-hook) + ) +(if (and (null gnus-Article-mode-hook) + (boundp 'gnus-article-mode-hook)) + (setq gnus-Article-mode-hook gnus-article-mode-hook) + ) +(if (and (null gnus-Article-prepare-hook) + (boundp 'gnus-article-prepare-hook)) + (setq gnus-Article-prepare-hook gnus-article-prepare-hook) + ) + +(defun tm-gnus/full-decode-message-old (arg) + "MIME full-decode this article." + (interactive "P") + (let ((gnus-Article-prepare-hook mime/body-decoding-method)) + ;; The following is a trick + ;; to force to read the current article again. + (setq gnus-have-all-headers (not gnus-have-all-headers)) + (gnus-summary-select-article (not gnus-have-all-headers) t) + )) + +(add-hook 'gnus-Select-group-hook + (function + (lambda () + (mapcar (function + (lambda (header) + (nntp-set-header-subject + header + (mime/decode-string (gnus-header-subject header)) + ))) + gnus-newsgroup-headers) + ))) + +(define-key gnus-Subject-mode-map + "\et" 'tm-gnus/toggle-mime-header-decoding-mode) +(define-key gnus-Subject-mode-map "v" 'tm-gnus/play-message) +(define-key gnus-Subject-mode-map "e" 'tm-gnus/extract-message) +(define-key gnus-Subject-mode-map "\C-cp" 'tm-gnus/print-message) + +(fset 'gnus-summary-select-article 'gnus-Subject-select-article) + +(fset 'gnus-Article-set-mode-line 'tm-gnus/article-set-mode-line) +(add-hook 'gnus-Article-prepare-hook + (function + (lambda () + (if mime/header-decoding-mode + (mime/decode-message-header) + ))) t) + +(if (not (string-match "^GNUS 3\.14\.4" gnus-version)) + (progn + (add-hook 'gnus-Article-mode-hook + (function + (lambda () + (make-local-variable 'minor-mode-alist) + (mime/add-header-decoding-mode-to-mode-line) + ))) + + (fset 'tm-gnus/full-decode-message 'tm-gnus/full-decode-message-old) + ) + (progn + (add-hook 'gnus-Article-mode-hook + (function mime/add-header-decoding-mode-to-mode-line)) + + (fset 'tm-gnus/full-decode-message 'tm-gnus/full-decode-message-new) + (setq gnus-show-mime-method mime/body-decoding-method) + )) diff --git a/tm-gnus4.el b/tm-gnus4.el new file mode 100644 index 0000000..45ec0c2 --- /dev/null +++ b/tm-gnus4.el @@ -0,0 +1,60 @@ +;;; +;;; $Id: tm-gnus4.el,v 2.0 1994/07/24 08:33:00 morioka Exp morioka $ +;;; + +(provide 'tm-gnus4) + +(require 'tm-gnus) + +(if (and (null gnus-startup-hook) + (boundp 'gnus-Startup-hook)) + (setq gnus-startup-hook gnus-Startup-hook) + ) +(if (and (null gnus-select-group-hook) + (boundp 'gnus-Select-group-hook)) + (setq gnus-select-group-hook gnus-Select-group-hook) + ) +(if (and (null gnus-summary-mode-hook) + (boundp 'gnus-Subject-mode-hook)) + (setq gnus-summary-mode-hook gnus-Subject-mode-hook) + ) +(if (and (null gnus-article-mode-hook) + (boundp 'gnus-Article-mode-hook)) + (setq gnus-article-mode-hook gnus-Article-mode-hook) + ) +(if (and (null gnus-article-prepare-hook) + (boundp 'gnus-Article-prepare-hook)) + (setq gnus-article-prepare-hook gnus-Article-prepare-hook) + ) + +(add-hook 'gnus-select-group-hook + (function + (lambda () + (mapcar (function + (lambda (header) + (nntp-set-header-subject + header + (mime/decode-string (gnus-header-subject header)) + ))) + gnus-newsgroup-headers) + ))) + +(define-key gnus-summary-mode-map + "\et" 'tm-gnus/toggle-mime-header-decoding-mode) +(define-key gnus-summary-mode-map "v" 'tm-gnus/play-message) +(define-key gnus-summary-mode-map "e" 'tm-gnus/extract-message) +(define-key gnus-summary-mode-map "\C-cp" 'tm-gnus/print-message) + +(fset 'gnus-article-set-mode-line 'tm-gnus/article-set-mode-line) +(add-hook 'gnus-article-mode-hook + (function mime/add-header-decoding-mode-to-mode-line)) + +(add-hook 'gnus-article-prepare-hook + (function + (lambda () + (if mime/header-decoding-mode + (mime/decode-message-header) + ))) t) + +(fset 'tm-gnus/full-decode-message 'tm-gnus/full-decode-message-new) +(setq gnus-show-mime-method mime/body-decoding-method) diff --git a/tm-mh-e-eng.ol b/tm-mh-e-eng.ol new file mode 100644 index 0000000..5cc252d --- /dev/null +++ b/tm-mh-e-eng.ol @@ -0,0 +1,85 @@ +[[R +\title{tm-mh-e manual (English Version)} +\author{Morioka Tomohiko} +\date{1994/7/25} +\maketitle +]]R + +* Install + +** tiny-mime + + Please copy tiny-mime.el to your emacs lisp directory. + + +** tm-body + + Please copy tm-body.el, tl-list.el and tl-header.el to your emacs +lisp directory. + + +** tm-misc + + Please copy tm-misc.el and tl-hook.el to your emacs lisp directory. + + +** tm-mh-e + + Please copy tm-mh-e.el and tm-mh-e3.el to your emacs lisp directory. + + If you want to byte-compile tm-mh-e3.el, please do it after you did +load mh-e version 3.x. + + +* .emacs + + Please insert following list to .emacs. + +[[E +---------------------------------------------------------------------- +(if (< (string-to-int emacs-version) 19) + (progn + (require 'tl-hook) + (defvar buffer-undo-list nil) + )) + +(add-hook 'mh-folder-mode-hook + (function + (lambda () + (require 'tm-mh-e) + ))) +---------------------------------------------------------------------- +]]E + + +* How to use + +------------------------------------------------------- +| key | function | +======================================================= +| M-t |toggle switch of message header decoding mode | +------------------------------------------------------- +| v |MIME decode message body and play | +| e |MIME decode message body and extract to file(s)| +|C-c p|MIME decode message body and print | +------------------------------------------------------- + + +* How to use metamail + + In normal definition, tm-mh-e use tm-body as MIME body decoder. +However, you can use metamail. In this case, Of course, you need +metamail and metamail.el. + + Please insert following list to .emacs if you want to use metamail. + +[[E +---------------------------------------------------------------------- +(autoload 'metamail-buffer "metamail" nil t) +(setq mime/body-decoding-method (function metamail-buffer)) +---------------------------------------------------------------------- +]]E + + If you use metamail, there are no decoding mode of MIME body +decoding. Therefore, functions for `v', `e', `C-c p' are equally +`metamail-buffer', and decoding is sequentially. diff --git a/tm-mh-e-eng.tex b/tm-mh-e-eng.tex new file mode 100644 index 0000000..e6ede60 --- /dev/null +++ b/tm-mh-e-eng.tex @@ -0,0 +1,115 @@ +\documentstyle[a4j]{jarticle} +\setcounter{secnumdepth}{6} +\setcounter{tocdepth}{6} +\topsep=0.1cm +\parsep=0.1cm +\itemsep=0.0cm +\begin{document} +\title{tm-mh-e manual (English Version)} +\author{Morioka Tomohiko} +\date{1994/7/25} +\maketitle +\medskip + +\section{Install} +\medskip + +\subsection{tiny-mime} +\medskip +\par +Please copy tiny-mime.el to your emacs lisp directory. +\medskip +\medskip + +\subsection{tm-body} +\medskip +\par +Please copy tm-body.el, tl-list.el and tl-header.el to your emacs +lisp directory. +\medskip +\medskip + +\subsection{tm-misc} +\medskip +\par +Please copy tm-misc.el and tl-hook.el to your emacs lisp directory. +\medskip +\medskip + +\subsection{tm-mh-e} +\medskip +\par +Please copy tm-mh-e.el and tm-mh-e3.el to your emacs lisp directory. +\medskip +{\baselineskip=10pt +\begin{verbatim} + If you want to byte-compile tm-mh-e3.el, please do it after you did +load mh-e version 3.x. +\end{verbatim}} +\medskip +\medskip + +\section{.emacs} +\medskip +\par +Please insert following list to .emacs. +\medskip +{\baselineskip=10pt +\begin{verbatim} +---------------------------------------------------------------------- +(if (< (string-to-int emacs-version) 19) + (progn + (require 'tl-hook) + (defvar buffer-undo-list nil) + )) + +(add-hook 'mh-folder-mode-hook + (function + (lambda () + (require 'tm-mh-e) + ))) +---------------------------------------------------------------------- +\end{verbatim}} +\medskip +\medskip + +\section{How to use} +\medskip +~\\ +\begin{tabular}{|c|r|} +\hline + key & function \\ +\hline\hline + M-t & toggle switch of message header decoding mode \\ +\hline + v & MIME decode message body and play \\ + e & MIME decode message body and extract to file(s)\\ +C-c p & MIME decode message body and print \\ +\hline +\end{tabular}\\ +\medskip +\medskip + +\section{How to use metamail} +\medskip +\par +In normal definition, tm-mh-e use tm-body as MIME body decoder. +However, you can use metamail. In this case, Of course, you need +metamail and metamail.el. +\medskip +\par +Please insert following list to .emacs if you want to use metamail. +\medskip +{\baselineskip=10pt +\begin{verbatim} +---------------------------------------------------------------------- +(autoload 'metamail-buffer "metamail" nil t) +(setq mime/body-decoding-method (function metamail-buffer)) +---------------------------------------------------------------------- +\end{verbatim}} +\medskip +\par +If you use metamail, there are no decoding mode of MIME body +decoding. Therefore, functions for `v', `e', `C-c p' are equally +`metamail-buffer', and decoding is sequentially. +\end{document} diff --git a/tm-mh-e-jp.ol b/tm-mh-e-jp.ol new file mode 100644 index 0000000..2d1093f --- /dev/null +++ b/tm-mh-e-jp.ol @@ -0,0 +1,102 @@ +$B!X(Btm-mh-e $B@bL@=q!Y(B +by. $Bl9g$O!"(Bmh-e version 3.* $B$r(B load $B$7(B +$B$?>uBV$G9T$J$C$F2<$5$$!#(B + + +* $B@_Dj(B + + .emacs $B$K0J2<$N$b$N$rF~$l$^$9!#(B + +[[E +---------------------------------------------------------------------- +(if (< (string-to-int emacs-version) 19) + (progn + (require 'tl-hook) + (defvar buffer-undo-list nil) + )) + +(add-hook 'mh-folder-mode-hook + (function + (lambda () + (require 'tm-mh-e) + ))) +---------------------------------------------------------------------- +]]E + + $B$^$?!"(BMH $B$,(B MH-6.8JP2 $B$N>l9g!"(B~/.mh_profile $B$K(B + +[[E +---------------------------------------------------------------------- +scan: -form scan.mime +inc: -form inc.mime +repl: -form replcomps.mime +showproc: mhl +---------------------------------------------------------------------- +]]E + +$B$rDI2C$7$F$/$@$5$$!#$^$?!"$=$l0J30$N(B MH $B$N=hM}$O(B Emacs $B$NB&$Gl9g(B .emacs $B$K0J2<$N$b$N$rF~$l$F2<$5$$!#(B + +[[E +---------------------------------------------------------------------- +(autoload 'metamail-buffer "metamail" nil t) +(setq mime/body-decoding-method (function metamail-buffer)) +---------------------------------------------------------------------- +]]E + + metamail $B$r;H$&@_Dj$N>l9g!"(B`v', `e', `C-c p' $B$KBP1~$9$kF0:n$O(B +metamail $B$K$+$1$k$@$1$K$J$j!"F10l$NF0:n$K$J$j$^$9!#$^$?!"F0:n$OC` w width) + (throw 'label i)) + (setq i (+ i (char-bytes chr))) + ) + i)) + )) + +;;; @ functions to check field +;;; +(defun mime/exist-encoded-word-in-subject () + (string-match + mime/encoded-word-regexp + (save-excursion + (save-restriction + (goto-char (point-min)) + (if (re-search-forward "^Subject:.*\\(\n\\( \\|\t\\)+.*\\)*" nil t) + (buffer-substring (match-beginning 0) (match-end 0)) + ) + )))) diff --git a/tm-mule.el b/tm-mule.el new file mode 100644 index 0000000..3c7a64d --- /dev/null +++ b/tm-mule.el @@ -0,0 +1,144 @@ +;;; +;;; $Id: tm-mule.el,v 4.5 1994/08/01 05:10:34 morioka Exp $ +;;; + +(provide 'tm-mule) + +(require 'tl-list) + +(if (not (fboundp 'member)) + (require 'tl-18) + ) + +;;; @ variables +;;; + +(defvar mime/lc-charset-and-encoding-alist + (list + (cons lc-ascii nil) + (cons lc-jp '("ISO-2022-JP" . "B")) + (cons lc-cn '("ISO-2022-CN" . "B")) + (cons lc-kr '("ISO-2022-KR" . "B")) + (cons lc-ltn1 '("ISO-8859-1" . "Q")) + (cons lc-ltn2 '("ISO-8859-2" . "Q")) + (cons lc-ltn3 '("ISO-8859-3" . "Q")) + (cons lc-ltn4 '("ISO-8859-4" . "Q")) + (cons lc-crl '("ISO-8859-5" . "B")) + (cons lc-arb '("ISO-8859-6" . "B")) + (cons lc-grk '("ISO-8859-7" . "B")) + (cons lc-hbw '("ISO-8859-8" . "B")) + (cons lc-ltn5 '("ISO-8859-9" . "Q")) + )) + +(defvar mime/latin-lc-list + (list lc-ascii lc-ltn1 lc-ltn2 lc-ltn3 lc-ltn4 lc-ltn5)) + +(defvar mime/charset-coding-system-alist + '(("ISO-2022-JP" . *iso-2022-ss2-7*) + ("ISO-2022-JP-2" . *iso-2022-ss2-7*) + ("X-ISO-2022-JP-2" . *iso-2022-ss2-7*) + ("ISO-2022-CN" . *iso-2022-ss2-7*) + ("ISO-2022-KR" . *iso-2022-kr*) + ("EUC-KR" . *euc-kr*) + )) + +(defvar mime/charset-lc-alist + (list + (cons "ISO-8859-1" lc-ltn1) ; Latin-1 + (cons "ISO-8859-2" lc-ltn2) ; Latin-2 + (cons "ISO-8859-3" lc-ltn3) ; Latin-3 + (cons "ISO-8859-4" lc-ltn4) ; Latin-4 + (cons "ISO-8859-5" lc-crl ) ; Cyrillic + (cons "ISO-8859-6" lc-arb ) ; Arabic + (cons "ISO-8859-7" lc-grk ) ; Greek + (cons "ISO-8859-8" lc-hbw ) ; Hebrew + (cons "ISO-8859-9" lc-ltn5) ; Latin-5 + )) + + +;;; @ define charset and encoding +;;; +(defun mime/set-charset-and-encoding (lc cs charset encoding) + (setq mime/lc-charset-and-encoding-alist + (put-alist lc (cons charset encoding) + mime/lc-charset-and-encoding-alist)) + (if cs + (setq mime/charset-coding-system-alist + (put-alist charset cs mime/charset-coding-system-alist)) + (setq mime/charset-lc-alist + (put-alist charset lc mime/charset-lc-alist)) + )) +;;; example +;;; +;;; (mime/set-charset-and-encoding lc-kr *euc-kr* "EUC-KR" "B") +;;; (mime/set-charset-and-encoding lc-koi8 nil "KOI8" "B") + + +(defun mime/char-leading-char (chr) + (if (< chr 128) + lc-ascii + chr)) + +(defun mime/remove-leading-character (str) + (let ((dest "") (i 0) (len (length str)) chr) + (while (< i len) + (setq chr (elt str i)) + (if (< chr 128) + (progn + (setq dest (concat dest (char-to-string chr))) + (setq i (+ i 1)) + ) + (progn + (setq dest (concat dest (char-to-string (elt str (+ i 1))))) + (setq i (+ i 2)) + )) + ) + dest)) + +(defun mime/insert-leading-character (str lc) + (let ((lc-str (char-to-string lc)) + (dest "") + (i 0) (len (length str)) + chr chr-str) + (while (< i len) + (setq chr (elt str i)) + (setq chr-str (char-to-string chr)) + (setq dest (concat dest + (if (< chr 128) + chr-str + (concat lc-str chr-str) + ))) + (setq i (+ i 1)) + ) + dest)) + +(defun mime/convert-string-to-emacs (charset str) + (let ((cs (cdr (assoc charset mime/charset-coding-system-alist)))) + (cond (cs + (code-convert-string str cs *internal*) + ) + (t + (let ((lc (cdr (assoc charset mime/charset-lc-alist)))) + (if lc + (mime/insert-leading-character str lc) + str) + ))))) + +(defun mime/convert-string-from-emacs (str charset) + (let ((cs (cdr (assoc charset mime/charset-coding-system-alist)))) + (cond (cs + (code-convert-string str *internal* cs) + ) + (t + (if (assoc charset mime/charset-lc-alist) + (mime/remove-leading-character str) + str))))) + +;; by mol. 1993/10/4 +(defun mime/decode-encoded-text (charset encoding str) + (mime/convert-string-to-emacs + charset + (cond ((string-match "^B$" encoding) (mime/base64-decode-string str)) + ((string-match "^Q$" encoding) (mime/Quoted-Printable-decode-string str)) + (t (message "unknown encoding %s" encoding) str) + ))) diff --git a/tm-nemacs.el b/tm-nemacs.el new file mode 100644 index 0000000..fdd1c37 --- /dev/null +++ b/tm-nemacs.el @@ -0,0 +1,105 @@ +;;; +;;; $Id: tm-nemacs.el,v 4.4 1994/08/01 05:09:00 morioka Exp $ +;;; + +(provide 'tm-nemacs) + +(require 'tl-18) + +;;; @ constants +;;; +(defconst *junet* 2) +(defconst *internal* 3) +(defconst *euc-japan* 3) + +(defconst lc-ascii 0) +(defconst lc-jp 146) + + +;;; @ variables +;;; + +(defvar mime/lc-charset-and-encoding-alist + (list + (cons lc-ascii nil) + (cons lc-jp '("ISO-2022-JP" . "B")) + )) + +(defvar mime/latin-lc-list + (list lc-ascii)) + +(defun mime/char-leading-char (chr) + (if (< chr 128) + lc-ascii + lc-jp)) + +;; by mol. 1993/9/26 +(defun string-width (str) + "Return number of columns STRING will occupy. + [Mule compatible function in tm-nemacs]" + (length str)) + +(defun char-bytes (chr) + "Return number of bytes CHAR will occupy in a buffer. + [Mule compatible function in tm-nemacs]" + (if (< chr 128) 1 2)) + +(defun char-width (chr) + "Return number of columns CHAR will occupy when displayed. + [Mule compatible function in tm-nemacs]" + (if (< chr 128) 1 2)) + +(defun code-convert-string (str ic oc) + "Convert code in STRING from SOURCE code to TARGET code, +On successful converion, returns the result string, +else returns nil. [Mule compatible function in tm-nemacs]" + (if (not (eq ic oc)) + (convert-string-kanji-code str ic oc) + str)) + +(defun check-ASCII-string (str) + (let ((i 0) + len) + (setq len (length str)) + (catch 'label + (while (< i len) + (if (>= (elt str i) 128) + (throw 'label nil)) + (setq i (+ i 1)) + ) + str))) + +;; by mol. 1993/10/4 +(defun mime/convert-string-to-emacs (charset str) + (cond ((string-match "^ISO-2022-JP$" charset) + (convert-string-kanji-code str 2 3)) + ((string-match "^US-ASCII$" charset) str) + ((string-match "^ISO-8859-[1-9]$" charset) + (check-ASCII-string str)) + (t nil) + )) + +;; by mol. 1993/11/2 +(defun mime/convert-string-from-emacs (string charset) + (cond ((equal charset "ISO-2022-JP") + (code-convert-string string *internal* *junet*)) + ((equal charset "US-ASCII") string) + (t nil) + )) + +;; by mol. 1993/10/4 +(defun mime/decode-encoded-text (charset encoding str) + (let ((ds (mime/convert-string-to-emacs + charset + (cond ((string-match "^B$" encoding) + (mime/base64-decode-string str)) + ((string-match "^Q$" encoding) + (mime/Quoted-Printable-decode-string str)) + (t + (message "unknown encoding %s" encoding) + (concat "=?" charset "?" encoding "?" str "?=") + ))))) + (if ds + ds + (concat "=?" charset "?" encoding "?" str "?=")) + )) diff --git a/tm-orig.el b/tm-orig.el new file mode 100644 index 0000000..878d281 --- /dev/null +++ b/tm-orig.el @@ -0,0 +1,50 @@ +;;; +;;; $Id: tm-orig.el,v 1.1 1994/07/29 22:08:59 morioka Exp morioka $ +;;; + +(provide 'tm-orig) + +;;; @ constants +;;; +(defconst lc-ascii 0) +(defconst lc-ltn1 0) + + +;;; @ variables +;;; + +(defvar mime/lc-charset-and-encoding-alist + (list + (cons lc-ascii nil) + (cons lc-ltn1 '("ISO-8859-1" . "Q")) + )) + +(defvar mime/latin-lc-list + (list lc-ascii lc-ltn1)) + +(defvar mime/decoding-charset-list '("US-ASCII" "ISO-8859-1")) + + +;;; @ functions +;;; + +(defun mime/char-leading-char (chr) + (if (< chr 128) + lc-ascii + lc-ltn1)) + +(defun string-width (str) (length str)) +(defun char-bytes (chr) 1) +(defun char-width (chr) 1) + +(defun mime/decode-encoded-text (charset encoding str) + (if (member charset mime/decoding-charset-list) + (cond ((string-match "^B$" encoding) + (mime/base64-decode-string str)) + ((string-match "^Q$" encoding) + (mime/Quoted-Printable-decode-string str)) + (t (message "unknown encoding %s" encoding) + (concat "=?" charset "?" encoding "?" str "?=") + )) + (concat "=?" charset "?" encoding "?" str "?=") + ))