+1998-10-28 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * FLIM: Version 1.11.3 (Saidaiji) was released.
+
+1998-10-27 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * VERSION: New file (Renamed from FLIM-VERSION).
+
+1998-10-27 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * eword-encode.el (eword-encode-char-type): Return nil for ?\n.
+
+1998-10-27 Tanaka Akira <akr@jaist.ac.jp>
+
+ * eword-encode.el (eword-encode-field-body): Unfold `field-body'.
+
+1998-10-27 Yoshiki Hayashi <g740685@komaba.ecc.u-tokyo.ac.jp>
+
+ * README.ja: Update.
+
+\f
+1998-10-26 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * FLIM: Version 1.11.2 (Heij\e-Dò)\e-A was released.
+
+ * NEWS (Abolish variable `mime-temp-directory'): New subsection.
+
+ * README.en (Installation): Modify for APEL 9.6.
+
+1998-10-26 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * eword-encode.el (eword-encode-field-body): Don't eliminate
+ top-spaces.
+
+1998-10-25 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * FLIM-ELS (flim-modules): Don't install mel-b-el for Emacs 20.4.
+
+1998-10-25 Tanaka Akira <akr@jaist.ac.jp>
+
+ * eword-decode.el (eword-decode-field-body): Refine implementation.
+
+1998-10-24 Tanaka Akira <akr@jaist.ac.jp>
+
+ * mel-b-ccl.el, mel-q-ccl.el, mel.el, FLIM-ELS: Divide mel-ccl.el
+ into mel-b-ccl.el and mel-q-ccl.el.
+
+1998-09-11 Tanaka Akira <akr@jaist.ac.jp>
+
+ * mel.el (base64-encoded-length): New implementation.
+
+1998-10-25 Tanaka Akira <akr@jaist.ac.jp>
+
+ * eword-decode.el (eword-decode-field-body): New function.
+
+1998-10-25 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * eword-encode.el (eword-encode-field-body): Change interface.
+ (eword-encode-header): Use `eword-encode-field-body'; abolish
+ function `eword-encode-field'.
+
+1998-10-25 Tanaka Akira <akr@jaist.ac.jp>
+
+ * eword-encode.el (eword-encode-field-body): New function.
+ (eword-encode-field): Use `eword-encode-field-body'.
+
+1998-10-24 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * mel.el, mel-b-el.el, FLIM-ELS: Rename mel-b.el -> mel-b-el.el.
+
+1998-10-24 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * mel-u.el (uuencode-external-decode-region): Use
+ `temporary-file-directory' instead of `mime-temp-directory'.
+ (mime-write-decoded-region): Likewise.
+
+ * mime-def.el: Abolish variable `mime-temp-directory'.
+
+1998-10-24 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * mmgeneric.el (mime-insert-header-from-buffer): New function.
+ (insert-header): Use `mime-insert-header-from-buffer'.
+
+1998-10-24 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * FLIM-ELS: Don't install mel-b-dl.el if the running emacs has
+ builtin base64 encoder/decoder.
+
+ * mel.el: Set up builtin base64 encoder/decoder if they are
+ available.
+
+ * mime-def.el (base64-dl-module): Set nil as initial value if the
+ running emacs has builtin base64 encoder/decoder.
+
+ * mel-b.el: Require `poe' instead of `emu'.
+ (base64-encode-string): Use `defun-maybe'.
+ (base64-encode-region): Likewise.
+ (base64-decode-region): Likewise.
+ (base64-decode-string): Likewise.
+
+ * mel-b-dl.el: Require `poe' instead of `emu'.
+
+\f
+1998-10-23 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * FLIM: Version 1.11.1 (Takanohara) was released.
+
+1998-10-22 Yoshiki Hayashi <g740685@komaba.ecc.u-tokyo.ac.jp>
+
+ * README.ja: New file.
+
+1998-10-20 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * mime-def.el: Require mcharset.
+
+1998-10-20 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * mel-u.el (mime-write-decoded-region): Fix typo.
+
+ * mime-def.el: Enclose defining procedure for the constants
+ `std11-quoted-pair-regexp', `std11-non-qtext-char-list' and
+ `std11-qtext-regexp' with `eval-and-compile'.
+
+1998-10-19 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * NEWS (Behavior change of `mime-insert-header'): New subsection.
+
+ * mmgeneric.el (insert-header): Include `:' in field-name.
+
+1998-10-19 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * mime-def.el (std11-qtext-regexp): Use `eval-when-compile'; don't
+ use `char-list-to-string'.
+ (std11-quoted-string-regexp): Use `eval-when-compile'.
+ - Use `def-edebug-spec' to define edebug-form-spec of
+ mm-define-method; fix definition of edebug-form-spec of
+ mm-define-method.
+
1998-10-18 MORIOKA Tomohiko <morioka@jaist.ac.jp>
* mime-en.sgml, mime-ja.sgml (Header encoder/decoder): Add
(setq flim-modules '(std11
mime-def
- mel mel-b mel-q mel-u mel-g
+ mel mel-q mel-u mel-g
eword-decode eword-encode
mime mime-parse mmgeneric mmbuffer mmcooked
mailcap))
-(if (fboundp 'dynamic-link)
- (setq flim-modules (cons 'mel-b-dl flim-modules))
+(unless (and (fboundp 'base64-encode-string)
+ (subrp (symbol-function 'base64-encode-string)))
+ (if (fboundp 'dynamic-link)
+ (setq flim-modules (cons 'mel-b-dl flim-modules))
+ )
+ (setq flim-modules (cons 'mel-b-el flim-modules))
)
(if (and (featurep 'mule)
(not (or (and (boundp 'MULE) MULE)
(and (featurep 'xemacs) (< emacs-major-version 21))
)))
- (setq flim-modules (cons 'mel-ccl flim-modules))
+ (setq flim-modules (cons 'mel-b-ccl (cons 'mel-q-ccl flim-modules)))
)
;;; FLIM-ELS ends here
+++ /dev/null
-[FLIM Version names]
-
-1.0.0 -----
-
-;;-------------------------------------------------------------------------
-;; Kinki Nippon Railway \e$(B6a5&F|K\E4F;\e(B http://www.kintetsu.co.jp/
-;; Ky\e-Dòto\e-A Line \e$(B5~ET@~\e(B
-;;-------------------------------------------------------------------------
-1.0.1 Ky\e-Dòto\e-A \e$(B5~ET\e(B ; <=> JR, \e$(B5~ET;T8rDL6I\e(B
-1.1.0 T\e-Dòji\e-A \e$(BEl;{\e(B
-1.2.0 J\e-Dþjò\e-A \e$(B==>r\e(B
-1.2.1 Kamitobaguchi \e$(B>eD;1)8}\e(B
-1.2.2 Takeda \e$(BC]ED\e(B ; = \e$(B5~ET;T8rDL6I\e(B \e$(B1(4]@~\e(B
-1.3.0 Fushimi \e$(BIz8+\e(B
-1.4.0 Kintetsu-Tambabashi \e$(B6aE4C0GH66\e(B ; <=> \e$(B5~:e\e(B \e$(BC0GH66\e(B
-1.4.1 Momoyama-Gory\e-Dòmae\e-A \e$(BEm;38fNMA0\e(B
-1.5.0 Mukaijima \e$(B8~Eg\e(B
-1.6.0 Ogura \e$(B>.AR\e(B
-1.7.0 Iseda \e$(B0K@*ED\e(B
-1.8.0 \e-DÒkubo\e-A \e$(BBg5WJ]\e(B
-1.8.1 Kutsukawa \e$(B5WDE@n\e(B
-1.9.0 Terada \e$(B;{ED\e(B
-1.9.1 Tonosh\e-Dò\e-A \e$(BIYLnAq\e(B
-1.9.2 Shin-Tanabe \e$(B?7EDJU\e(B
-1.10.0 K\e-Dòdo\e-A \e$(B6=8M\e(B
-1.10.1 Miyamaki \e$(B;0;3LZ\e(B
-1.10.2 Kintetsu-Miyazu \e$(B6aE45\DE\e(B
-1.10.3 Komada \e$(B9}ED\e(B
-1.10.4 Shin-H\e-Dòsono\e-A \e$(B?7=K1`\e(B ; <=> JR \e$(BJRD.@~\e(B \e$(B=K1`\e(B
-1.10.5 Kizugawadai \e$(BLZDE@nBf\e(B
-1.11.0 Yamadagawa \e$(B;3ED@n\e(B
------ Takanohara \e$(B9b$N86\e(B
------ Heij\e-Dò\e-A \e$(BJ?>k\e(B
------ Saidaiji \e$(B@>Bg;{\e(B
-;;-------------------------------------------------------------------------
-;; Kinki Nippon Railway \e$(B6a5&F|K\E4F;\e(B http://www.kintetsu.co.jp/
-;; Ky\e-Dòto\e-A Line \e$(B3`86@~\e(B
-;;-------------------------------------------------------------------------
- (Saidaiji) (\e$(B@>Bg;{\e(B)
------ Amagatsuji \e$(BFt%vDT\e(B
------ Nishinoky\e-Dò\e-A \e$(B@>$N5~\e(B
------ Kuj\e-Dò\e-A \e$(B6e>r\e(B
------ Kintetsu-K\e-Dòriyama\e-A \e$(B6aE474;3\e(B
-
-
-[Chao Version names]
-
-;;-------------------------------------------------------------------------
-;; Kyoto Municipal Transfer Bureau
-;; \e$(B5~ET;T8rDL6I\e(B
-;; http://www.city.kyoto.jp/kotsu/main.htm
-;; Karasuma Line \e$(B1(4]@~\e(B
-;;-------------------------------------------------------------------------
-1.2.0 Takeda \e$(BC]ED\e(B ; = \e$(B6aE4\e(B \e$(B5~ET@~\e(B
-1.3.0 Kuinabashi \e$(B$/$$$J66\e(B
-1.4.0 J\e-Dþjò\e-A \e$(B==>r\e(B
-1.6.0 Kuj\e-Dò\e-A \e$(B6e>r\e(B
-1.6.1 Ky\e-Dòto\e-A \e$(B5~ET\e(B ; <=> JR, \e$(B6aE4\e(B
-1.7.0 Goj\e-Dò\e-A \e$(B8^>r\e(B
-1.8.0 Shij\e-Dò\e-A \e$(B;M>r\e(B ; <=> \e$(B:e5^\e(B \e$(B5~ET@~\e(B
-1.9.0 Karasuma Oike \e$(B1(4]8fCS\e(B ; = \e$(B5~ET;T8rDL6I\e(B \e$(BEl@>@~\e(B
-1.10.0 Marutamach \e$(B4]B@D.\e(B
-1.11.0 Imadegawa \e$(B:#=P@n\e(B
-1.11.1 Kuramaguchi \e$(B0HGO8}\e(B
-1.11.2 Kita\e-Dòji\e-A \e$(BKLBgO)\e(B
-1.11.3 Kitayama \e$(BKL;3\e(B
-1.11.4 Matugasaki \e$(B>>%v:j\e(B
-1.11.5 Kokusaikaikan \e$(B9q:]2q4[\e(B
#
PACKAGE = flim
-VERSION = 1.11.0
+VERSION = 1.11.3
TAR = tar
RM = /bin/rm -f
as an obsolete alias.
+** Behavior change of `mime-insert-header'
+
+Each field-name of second and third argument of function
+`mime-insert-header' can include `:'.
+
+
+** Abolish variable `mime-temp-directory'
+
+Now FLIM uses `temporary-file-directory' instead of
+`mime-temp-directory'. So environment variable "MIME_TMP_DIR" and
+"TM_TMP_DIR" are not effective to specify temporary directory of FLIM.
+
+
** Add new function `eword-decode-and-unfold-unstructured-field'
Installation
============
-(0) before installing it, please install APEL (9.4 or later) package.
+(0) before installing it, please install APEL (9.6 or later) package.
APEL package is available at:
ftp://ftp.jaist.ac.jp/pub/GNU/elisp/apel/
--- /dev/null
+[FLIM \e$B$N\e(B README (\e$BF|K\8lHG\e(B)]
+
+FLIM \e$B$H$O!)\e(B
+===========
+
+ FLIM \e$B$O%a%C%;!<%8I=8=$HId9f2=$K4X$9$k4pACE*$J5!G=$rDs6!$9$k%i%$%V%i\e(B
+ \e$B%j!<$G$9!#0J2<$N%b%8%e!<%k$+$i9=@.$5$l$F$$$^$9\e(B:
+
+ std11.el --- STD 11 (RFC 822) \e$B$N2r@O4o$H%f!<%F%#%j%F%#!<\e(B
+
+ mime.el --- MIME \e$B%i%$%V%i%j!<\e(B
+
+ mime-def.el --- MIME \e$B$NMM<0$K4X$9$kDj5A\e(B
+
+ mime-parse.el --- MIME \e$B2r@O4o\e(B
+
+ mel.el --- MIME \e$BId9f4o\e(B/\e$BI|9f4o\e(B
+ mel-b-dl.el --- base64 (B-encoding) \e$BId9f4o\e(B/\e$BI|9f4o\e(B
+ (Emacs 20 \e$B$NF0E*FI$_9~$_5!G=IU$-MQ\e(B)
+ mel-b.el --- base64 (B-encoding) \e$BId9f4o\e(B/\e$BI|9f4o\e(B
+ (\e$BB>$N\e(B emacs \e$B4D6-MQ\e(B)
+ mel-q.el --- quoted-printable \e$B$H\e(B Q-encoding
+ \e$BId9f4o\e(B/\e$BI|9f4o\e(B
+ mel-ccl.el --- CCL \e$B$r;H$C$?\e(B base64 (B-encoding),
+ quoted-printable \e$B$H\e(B Q-encoding \e$B$NId9f4o\e(B/\e$BI|9f4o\e(B
+ mel-u.el --- uuencode \e$B$N$?$a$NHs8x<0%b%8%e!<%k\e(B
+ mel-g.el --- gzip64 \e$B$N$?$a$NHs8x<0%b%8%e!<%k\e(B
+
+ eword-decode.el --- encoded-word \e$BI|9f4o\e(B
+ eword-encode.el --- encoded-word \e$BId9f4o\e(B
+
+ mailcap.el --- mailcap \e$B2r@O4o$H%f!<%F%#%j%F%#!<\e(B
+
+
+\e$B%$%s%9%H!<%k\e(B
+============
+
+(0) \e$B%$%s%9%H!<%k$9$kA0$K!"\e(BAPEL \e$B%Q%C%1!<%8\e(B (9.6 \e$B0J9_\e(B)
+ \e$B$r%$%s%9%H!<%k$7$F$/$@$5$$!#\e(BAPEL \e$B%Q%C%1!<%8$O0J2<$N$H$3$m$G<hF@$G\e(B
+ \e$B$-$^$9\e(B:
+
+ ftp://ftp.jaist.ac.jp/pub/GNU/elisp/apel/
+
+(1-a) \e$BE83+$7$?>l=j$G<B9T\e(B
+
+ \e$BB>$N%G%#%l%/%H%j!<$K%$%s%9%H!<%k$7$?$/$J$$$J$i!"0J2<$N$3$H$@$1$r$d$C\e(B
+ \e$B$F$/$@$5$$\e(B:
+
+ % make
+
+ emacs \e$B$N%3%^%s%IL>$r;XDj$9$k$3$H$,$G$-$^$9!#Nc$($P!"\e(B
+
+ % make EMACS=xemacs
+
+ `EMACS=...' \e$B$,>JN,$5$l$k$H!"\e(BEmacs=emacs \e$B$,;H$o$l$^$9!#\e(B
+
+(b) make install
+
+ \e$BB>$N%G%#%l%/%H%j!<$K%$%s%9%H!<%k$7$?$$$J$i!"0J2<$N$3$H$r$7$F$/$@$5$$\e(B:
+
+ % make install
+
+ emacs \e$B$N%3%^%s%IL>$r;XDj$9$k$3$H$,$G$-$^$9!#Nc$($P!"\e(B
+
+ % make install EMACS=xemacs
+
+ `EMACS=...' \e$B$,>JN,$5$l$k$H!"\e(BEmacs=emacs \e$B$,;H$o$l$^$9!#\e(B
+
+ Emacs Lisp \e$B%W%m%0%i%`$H%7%'%k%9%/%j%W%H$N$?$a$N%G%#%l%/%H%j!<LZ$N@\\e(B
+ \e$BF,<-\e(B (prefix) \e$B$r;XDj$9$k$3$H$,$G$-$^$9!#Nc$($P!"\e(B
+
+ % make install PREFIX=~/
+
+ `PREFIX=...' \e$B$,>JN,$5$l$k$H!";XDj$5$l$?\e(B emacs \e$B%3%^%s%I$N%G%#%l%/%H%j!<\e(B
+ \e$BLZ$N@\F,<-$,;HMQ$5$l$^$9\e(B (\e$B$*$=$i$/\e(B /usr/local \e$B$G$9\e(B)\e$B!#\e(B
+
+ \e$BNc$($P!"\e(BPREFIX=/usr/local \e$B$H\e(B Emacs 19.34 \e$B$,;XDj$5$l$l$P!"0J2<$N%G%#%l\e(B
+ \e$B%/%H%j!<LZ$,:n@.$5$l$^$9!#\e(B
+
+ /usr/local/share/emacs/site-lisp/flim/ --- FLIM
+
+ Emacs Lisp \e$B%W%m%0%i%`$N$?$a$N\e(B lisp \e$B%G%#%l%/%H%j!<$r;XDj$9$k$3$H$,$G\e(B
+ \e$B$-$^$9!#Nc$($P!"\e(B:
+
+ % make install LISPDIR=~/share/emacs/elisp
+
+ `LISPDIR=...' \e$B$,>JN,$5$l$k$H!";XDj$5$l$?\e(B emacs \e$B$N%3%^%s%I$N\e(B
+ site-lisp \e$B%G%#%l%/%H%j!<$,;H$o$l$^$9\e(B (\e$B$*$=$i$/\e(B
+ /usr/local/share/emacs/site-lisp \e$B$+\e(B /usr/local/lib/xemacs/site-lisp)
+ \e$B$G$9!#\e(B
+
+ emu \e$B%b%8%e!<%k\e(B (APEL \e$B%Q%C%1!<%8$KF~$C$F$$$^$9\e(B) \e$B$,I8=`$G$J$$%G%#%l%/\e(B
+ \e$B%H%j!<$K%$%s%9%H!<%k$5$l$F$$$k>l9g$O!"$=$l$i$N$"$k>l=j$r;XDj$9$kI,MW\e(B
+ \e$B$,$"$j$^$9!#Nc$($P!"\e(B:
+
+ % make install VERSION_SPECIFIC_LISPDIR=~/elisp
+
+ \e$B$I$N%U%!%$%k$,\e(B emu \e$B%b%8%e!<%k$+\e(B apel \e$B%b%8%e!<%k$N0lIt$J$N$+!"$=$l$i\e(B
+ \e$B$,$I$3$K%$%s%9%H!<%k$5$l$k$+$rCN$j$?$$$H$-$O!"<!$N$h$&$J%3%^%s%I$rF~\e(B
+ \e$BNO$9$k$3$H$,$G$-$^$9!#\e(B
+
+ % make what-where LISPDIR=~/elisp VERSION_SPECIFIC_LISPDIR=~/elisp
+
+ \e$B%U%!%$%k\e(B FLIM-CFG \e$B$rJT=8$9$k$3$H$GB>$NA*Br<+M3$J@_Dj$r;XDj$9$k$3$H$,\e(B
+ \e$B$G$-$^$9!#$=$NCf$N%3%a%s%H$rFI$s$G$/$@$5$$!#\e(B
+
+(1-c) XEmacs \e$B$N%Q%C%1!<%8$H$7$F%$%s%9%H!<%k$9$k\e(B
+
+ XEmacs \e$B$N%Q%C%1!<%8%G%#%l%/%H%j!<$K%$%s%9%H!<%k$9$k>l9g$O!"0J2<$N$3\e(B
+ \e$B$H$r$7$F$/$@$5$$\e(B:
+
+ % make install-package
+
+ emacs \e$B$N%3%^%s%IL>$r;XDj$9$k$3$H$,$G$-$^$9!#Nc$($P!"\e(B
+
+ % make install-package XEMACS=xemacs-21
+
+ `XEMACS=...' \e$B$,>JN,$5$l$k$H!"\e(BXEMACS=xemacs \e$B$,;HMQ$5$l$^$9!#\e(B
+
+ \e$B%Q%C%1!<%8$N%G%#%l%/%H%j!<$r;XDj$9$k$3$H$,$G$-$^$9!#Nc$($P\e(B:
+
+ % make install PACKAGEDIR=~/.xemacs
+
+ `PACKAGEDIR=...' \e$B$,>JN,$5$l$k$H!"B8:_$9$k%Q%C%1!<%8%G%#%l%/%H%j!<$N\e(B
+ \e$B:G=i$N$b$N$,;H$o$l$^$9!#\e(B
+
+ XEmacs \e$B$N%Q%C%1!<%8%7%9%F%`$O\e(B XEmacs 21.0 \e$B$+$=$l0J9_$rMW5a$9$k$3$H$K\e(B
+ \e$BCm0U$7$F$/$@$5$$!#\e(B
+
+load-path (Emacs \e$B$H\e(B MULE \e$BMQ\e(B)
+=============================
+
+ Emacs \e$B$+\e(B Mule \e$B$r;H$C$F$$$k$J$i!"\e(BFLIM \e$B$N%G%#%l%/%H%j!<$r\e(B
+ load-path \e$B$KDI2C$7$F$/$@$5$$!#=i4|@_Dj$G%$%s%9%H!<%k$7$?$J$i!"<!$N$h\e(B
+ \e$B$&$K\e(B subdirs.el \e$B$r=q$/$3$H$,$G$-$^$9!#Nc\e(B:
+
+ --------------------------------------------------------------------
+ (normal-top-level-add-to-load-path '("apel" "flim"))
+ --------------------------------------------------------------------
+
+ XEmacs \e$B$r;H$C$F$$$k$J$i!"\e(Bload-path \e$B$r@_Dj$9$kI,MW$O$"$j$^$;$s!#\e(B
+
+\e$B%P%0Js9p\e(B
+===========
+
+ \e$B%P%0Js9p$d2~A1$NDs0F$r=q$$$?$H$-$O!"@'Hs\e(B tm \e$B%a!<%j%s%0%j%9%H$KAw$C$F\e(B
+ \e$B$/$@$5$$\e(B:
+
+ bug-tm-en@chamonix.jaist.ac.jp (\e$B1Q8l\e(B)
+ bug-tm-ja@chamonix.jaist.ac.jp (\e$BF|K\8l\e(B)
+
+ tm ML \e$B$rDL$7$F!"\e(BFLIM \e$B$N%P%0$rJs9p$7$?$j!"\e(BFLIM \e$B$N:G?7$N%j%j!<%9$r<hF@\e(B
+ \e$B$7$?$j!"\e(BFLIM \e$B$N>-Mh$N3HD%$N5DO@$r$7$?$j$9$k$3$H$,$G$-$^$9!#\e(Btm ML \e$B$K\e(B
+ \e$B;22C$9$k$K$O!"6u$NEE;R%a!<%k$r\e(B
+
+ tm-en-help@chamonix.jaist.ac.jp (\e$B1Q8l\e(B)
+ tm-ja-help@chamonix.jaist.ac.jp (\e$BF|K\8l\e(B)
+
+ \e$B$KAw$C$F$/$@$5$$!#\e(B
--- /dev/null
+[FLIM Version names]
+
+1.0.0 -----
+
+;;-------------------------------------------------------------------------
+;; Kinki Nippon Railway \e$(B6a5&F|K\E4F;\e(B http://www.kintetsu.co.jp/
+;; Ky\e-Dòto\e-A Line \e$(B5~ET@~\e(B
+;;-------------------------------------------------------------------------
+1.0.1 Ky\e-Dòto\e-A \e$(B5~ET\e(B ; <=> JR, \e$(B5~ET;T8rDL6I\e(B
+1.1.0 T\e-Dòji\e-A \e$(BEl;{\e(B
+1.2.0 J\e-Dþjò\e-A \e$(B==>r\e(B
+1.2.1 Kamitobaguchi \e$(B>eD;1)8}\e(B
+1.2.2 Takeda \e$(BC]ED\e(B ; = \e$(B5~ET;T8rDL6I\e(B \e$(B1(4]@~\e(B
+1.3.0 Fushimi \e$(BIz8+\e(B
+1.4.0 Kintetsu-Tambabashi \e$(B6aE4C0GH66\e(B ; <=> \e$(B5~:e\e(B \e$(BC0GH66\e(B
+1.4.1 Momoyama-Gory\e-Dòmae\e-A \e$(BEm;38fNMA0\e(B
+1.5.0 Mukaijima \e$(B8~Eg\e(B
+1.6.0 Ogura \e$(B>.AR\e(B
+1.7.0 Iseda \e$(B0K@*ED\e(B
+1.8.0 \e-DÒkubo\e-A \e$(BBg5WJ]\e(B
+1.8.1 Kutsukawa \e$(B5WDE@n\e(B
+1.9.0 Terada \e$(B;{ED\e(B
+1.9.1 Tonosh\e-Dò\e-A \e$(BIYLnAq\e(B
+1.9.2 Shin-Tanabe \e$(B?7EDJU\e(B
+1.10.0 K\e-Dòdo\e-A \e$(B6=8M\e(B
+1.10.1 Miyamaki \e$(B;0;3LZ\e(B
+1.10.2 Kintetsu-Miyazu \e$(B6aE45\DE\e(B
+1.10.3 Komada \e$(B9}ED\e(B
+1.10.4 Shin-H\e-Dòsono\e-A \e$(B?7=K1`\e(B ; <=> JR \e$(BJRD.@~\e(B \e$(B=K1`\e(B
+1.10.5 Kizugawadai \e$(BLZDE@nBf\e(B
+1.11.0 Yamadagawa \e$(B;3ED@n\e(B
+1.11.1 Takanohara \e$(B9b$N86\e(B
+1.11.2 Heij\e-Dò\e-A \e$(BJ?>k\e(B
+1.11.3 Saidaiji \e$(B@>Bg;{\e(B
+;;-------------------------------------------------------------------------
+;; Kinki Nippon Railway \e$(B6a5&F|K\E4F;\e(B http://www.kintetsu.co.jp/
+;; Ky\e-Dòto\e-A Line \e$(B3`86@~\e(B
+;;-------------------------------------------------------------------------
+ (Saidaiji) (\e$(B@>Bg;{\e(B)
+----- Amagatsuji \e$(BFt%vDT\e(B
+----- Nishinoky\e-Dò\e-A \e$(B@>$N5~\e(B
+----- Kuj\e-Dò\e-A \e$(B6e>r\e(B
+----- Kintetsu-K\e-Dòriyama\e-A \e$(B6aE474;3\e(B
+
+
+[Chao Version names]
+
+;;-------------------------------------------------------------------------
+;; Kyoto Municipal Transfer Bureau
+;; \e$(B5~ET;T8rDL6I\e(B
+;; http://www.city.kyoto.jp/kotsu/main.htm
+;; Karasuma Line \e$(B1(4]@~\e(B
+;;-------------------------------------------------------------------------
+1.2.0 Takeda \e$(BC]ED\e(B ; = \e$(B6aE4\e(B \e$(B5~ET@~\e(B
+1.3.0 Kuinabashi \e$(B$/$$$J66\e(B
+1.4.0 J\e-Dþjò\e-A \e$(B==>r\e(B
+1.6.0 Kuj\e-Dò\e-A \e$(B6e>r\e(B
+1.6.1 Ky\e-Dòto\e-A \e$(B5~ET\e(B ; <=> JR, \e$(B6aE4\e(B
+1.7.0 Goj\e-Dò\e-A \e$(B8^>r\e(B
+1.8.0 Shij\e-Dò\e-A \e$(B;M>r\e(B ; <=> \e$(B:e5^\e(B \e$(B5~ET@~\e(B
+1.9.0 Karasuma Oike \e$(B1(4]8fCS\e(B ; = \e$(B5~ET;T8rDL6I\e(B \e$(BEl@>@~\e(B
+1.10.0 Marutamach \e$(B4]B@D.\e(B
+1.11.0 Imadegawa \e$(B:#=P@n\e(B
+1.11.1 Kuramaguchi \e$(B0HGO8}\e(B
+1.11.2 Kita\e-Dòji\e-A \e$(BKLBgO)\e(B
+1.11.3 Kitayama \e$(BKL;3\e(B
+1.11.4 Matugasaki \e$(B>>%v:j\e(B
+1.11.5 Kokusaikaikan \e$(B9q:]2q4[\e(B
;; Author: ENAMI Tsugutomo <enami@sys.ptg.sony.co.jp>
;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
-;; Maintainer: MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; TANAKA Akira <akr@jaist.ac.jp>
;; Created: 1995/10/03
;; Original: 1992/07/20 ENAMI Tsugutomo's `mime.el'.
;; Renamed: 1993/06/03 to tiny-mime.el
:group 'eword-decode
:type '(repeat symbol))
+(defun eword-decode-field-body
+ (field-body field-name &optional unfolded max-column)
+ "Decode FIELD-BODY as FIELD-NAME, and return the result.
+
+If UNFOLDED is non-nil, it is assumed that FIELD-BODY is
+already unfolded.
+
+If MAX-COLUMN is non-nil, the result is folded with MAX-COLUMN
+or `fill-column' if MAX-COLUMN is t.
+Otherwise, the result is unfolded.
+
+MIME encoded-word in FIELD-BODY is recognized according to
+`eword-decode-ignored-field-list',
+`eword-decode-structured-field-list' and FIELD-NAME.
+
+Non MIME encoded-word part in FILED-BODY is decoded with
+`default-mime-charset'."
+ (when (eq max-column t)
+ (setq max-column fill-column))
+ (let (field-name-symbol len)
+ (if (symbolp field-name)
+ (setq field-name-symbol field-name
+ len (1+ (string-width (symbol-name field-name))))
+ (setq field-name-symbol (intern (capitalize field-name))
+ len (1+ (string-width field-name))))
+ (if (memq field-name-symbol eword-decode-ignored-field-list)
+ ;; Don't decode
+ (if max-column
+ field-body
+ (std11-unfold-string field-body))
+ (if (memq field-name-symbol eword-decode-structured-field-list)
+ ;; Decode as structured field
+ (if max-column
+ (eword-decode-and-fold-structured-field
+ field-body len max-column t)
+ (eword-decode-and-unfold-structured-field field-body))
+ ;; Decode as unstructured field
+ (if max-column
+ (eword-decode-unstructured-field-body field-body len)
+ (eword-decode-unstructured-field-body
+ (std11-unfold-string field-body) len))))))
+
(defun eword-decode-header (&optional code-conversion separator)
"Decode MIME encoded-words in header fields.
If CODE-CONVERSION is nil, it decodes only encoded-words. If it is
;;;
(defsubst eword-encode-char-type (character)
- (if (or (eq character ? )(eq character ?\t))
+ (if (memq character '(? ?\t ?\n))
nil
(char-charset character)
))
(or column eword-encode-default-start-column)
(eword-encode-split-string string 'text))))
-(defun eword-encode-field (string)
- "Encode header field STRING, and return the result.
+(defun eword-encode-field-body (field-body field-name)
+ "Encode FIELD-BODY as FIELD-NAME, and return the result.
A lexical token includes non-ASCII character is encoded as MIME
encoded-word. ASCII token is not encoded."
- (setq string (std11-unfold-string string))
- (let ((ret (string-match std11-field-head-regexp string)))
- (or (if ret
- (let ((field-name (substring string 0 (1- (match-end 0))))
- (field-body (eliminate-top-spaces
- (substring string (match-end 0))))
- field-name-symbol)
- (if (setq ret
- (cond ((string= field-body "") "")
- ((memq (setq field-name-symbol
- (intern (capitalize field-name)))
- '(Reply-To
- From Sender
- Resent-Reply-To Resent-From
- Resent-Sender To Resent-To
- Cc Resent-Cc Bcc Resent-Bcc
- Dcc))
- (eword-encode-address-list
- field-body (+ (length field-name) 2))
- )
- ((eq field-name-symbol 'In-Reply-To)
- (eword-encode-in-reply-to
- field-body (+ (length field-name) 2))
- )
- ((memq field-name-symbol
- '(Mime-Version User-Agent))
- (eword-encode-structured-field-body
- field-body (+ (length field-name) 2))
- )
- (t
- (eword-encode-unstructured-field-body
- field-body (1+ (length field-name)))
- ))
- )
- (concat field-name ": " ret)
- )))
- (eword-encode-string string 0)
- )))
+ (setq field-body (std11-unfold-string field-body))
+ (if (string= field-body "")
+ ""
+ (let (start)
+ (if (symbolp field-name)
+ (setq start (1+ (length (symbol-name field-name))))
+ (setq start (1+ (length field-name))
+ field-name (intern (capitalize field-name))))
+ (cond ((memq field-name
+ '(Reply-To
+ From Sender
+ Resent-Reply-To Resent-From
+ Resent-Sender To Resent-To
+ Cc Resent-Cc Bcc Resent-Bcc
+ Dcc))
+ (eword-encode-address-list field-body start)
+ )
+ ((eq field-name 'In-Reply-To)
+ (eword-encode-in-reply-to field-body start)
+ )
+ ((memq field-name '(Mime-Version User-Agent))
+ (eword-encode-structured-field-body field-body start)
+ )
+ (t
+ (eword-encode-unstructured-field-body field-body start)
+ ))
+ )))
(defun eword-in-subject-p ()
(let ((str (std11-field-body "Subject")))
(std11-narrow-to-header mail-header-separator)
(goto-char (point-min))
(let ((default-cs (mime-charset-to-coding-system default-mime-charset))
- beg end field-name)
+ bbeg end field-name)
(while (re-search-forward std11-field-head-regexp nil t)
- (setq beg (match-beginning 0))
- (setq field-name (buffer-substring beg (1- (match-end 0))))
- (setq end (std11-field-end))
- (and (find-non-ascii-charset-region beg end)
+ (setq bbeg (match-end 0)
+ field-name (buffer-substring (match-beginning 0) (1- bbeg))
+ end (std11-field-end))
+ (and (find-non-ascii-charset-region bbeg end)
(let ((method (eword-find-field-encoding-method
(downcase field-name))))
(cond ((eq method 'mime)
- (let ((field
- (buffer-substring-no-properties beg end)
+ (let ((field-body
+ (buffer-substring-no-properties bbeg end)
))
- (delete-region beg end)
- (insert (eword-encode-field field))
+ (delete-region bbeg end)
+ (insert (eword-encode-field-body field-body
+ field-name))
))
(code-conversion
(let ((cs
(or (mime-charset-to-coding-system
method)
default-cs)))
- (encode-coding-region beg end cs)
+ (encode-coding-region bbeg end cs)
)))
))
))
--- /dev/null
+;;; mel-b-ccl.el: CCL based encoder/decoder of Base64
+
+;; Copyright (C) 1998 Tanaka Akira
+
+;; Author: Tanaka Akira <akr@jaist.ac.jp>
+;; Created: 1998/9/17
+;; Keywords: MIME, Base64
+
+;; This file is part of FLIM (Faithful Library about Internet Message).
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or (at
+;; your option) any later version.
+
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Code:
+
+(require 'ccl)
+(require 'pccl)
+(require 'mime-def)
+
+
+;;; @ constants
+;;;
+
+(eval-when-compile
+
+(defconst mel-ccl-4-table
+ '( 0 1 2 3))
+
+(defconst mel-ccl-16-table
+ '( 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15))
+
+(defconst mel-ccl-64-table
+ '( 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
+ 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31
+ 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47
+ 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63))
+
+(defconst mel-ccl-256-table
+ '( 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
+ 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31
+ 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47
+ 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63
+ 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79
+ 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95
+ 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111
+ 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127
+ 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143
+ 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159
+ 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175
+ 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191
+ 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207
+ 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223
+ 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239
+ 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255))
+
+(defconst mel-ccl-256-to-64-table
+ '(nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
+ nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
+ nil nil nil nil nil nil nil nil nil nil nil 62 nil nil nil 63
+ 52 53 54 55 56 57 58 59 60 61 nil nil nil t nil nil
+ nil 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14
+ 15 16 17 18 19 20 21 22 23 24 25 nil nil nil nil nil
+ nil 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40
+ 41 42 43 44 45 46 47 48 49 50 51 nil nil nil nil nil
+ nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
+ nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
+ nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
+ nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
+ nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
+ nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
+ nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
+ nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil))
+
+(defconst mel-ccl-64-to-256-table
+ (mapcar
+ 'char-int
+ "ABCDEFGHIJKLMNOPQRSTUVWXYZ\
+abcdefghijklmnopqrstuvwxyz\
+0123456789\
++/"))
+
+)
+
+
+;;; @ CCL programs
+;;;
+
+(eval-when-compile
+
+(defun mel-ccl-decode-b-bit-ex (v)
+ (logior
+ (lsh (logand v (lsh 255 16)) -16)
+ (logand v (lsh 255 8))
+ (lsh (logand v 255) 16)))
+
+(defconst mel-ccl-decode-b-0-table
+ (vconcat
+ (mapcar
+ (lambda (v)
+ (if (integerp v)
+ (mel-ccl-decode-b-bit-ex (lsh v 18))
+ (lsh 1 24)))
+ mel-ccl-256-to-64-table)))
+
+(defconst mel-ccl-decode-b-1-table
+ (vconcat
+ (mapcar
+ (lambda (v)
+ (if (integerp v)
+ (mel-ccl-decode-b-bit-ex (lsh v 12))
+ (lsh 1 25)))
+ mel-ccl-256-to-64-table)))
+
+(defconst mel-ccl-decode-b-2-table
+ (vconcat
+ (mapcar
+ (lambda (v)
+ (if (integerp v)
+ (mel-ccl-decode-b-bit-ex (lsh v 6))
+ (lsh 1 26)))
+ mel-ccl-256-to-64-table)))
+
+(defconst mel-ccl-decode-b-3-table
+ (vconcat
+ (mapcar
+ (lambda (v)
+ (if (integerp v)
+ (mel-ccl-decode-b-bit-ex v)
+ (lsh 1 27)))
+ mel-ccl-256-to-64-table)))
+
+)
+
+(define-ccl-program mel-ccl-decode-b
+ `(1
+ (loop
+ (read r0 r1 r2 r3)
+ (r4 = r0 ,mel-ccl-decode-b-0-table)
+ (r5 = r1 ,mel-ccl-decode-b-1-table)
+ (r4 |= r5)
+ (r5 = r2 ,mel-ccl-decode-b-2-table)
+ (r4 |= r5)
+ (r5 = r3 ,mel-ccl-decode-b-3-table)
+ (r4 |= r5)
+ (if (r4 & ,(lognot (1- (lsh 1 24))))
+ ((loop
+ (if (r4 & ,(lsh 1 24))
+ ((r0 = r1) (r1 = r2) (r2 = r3) (read r3)
+ (r4 >>= 1) (r4 &= ,(logior (lsh 7 24)))
+ (r5 = r3 ,mel-ccl-decode-b-3-table)
+ (r4 |= r5)
+ (repeat))
+ (break)))
+ (loop
+ (if (r4 & ,(lsh 1 25))
+ ((r1 = r2) (r2 = r3) (read r3)
+ (r4 >>= 1) (r4 &= ,(logior (lsh 7 24)))
+ (r5 = r3 ,mel-ccl-decode-b-3-table)
+ (r4 |= r5)
+ (repeat))
+ (break)))
+ (loop
+ (if (r2 != ?=)
+ (if (r4 & ,(lsh 1 26))
+ ((r2 = r3) (read r3)
+ (r4 >>= 1) (r4 &= ,(logior (lsh 7 24)))
+ (r5 = r3 ,mel-ccl-decode-b-3-table)
+ (r4 |= r5)
+ (repeat))
+ ((r6 = 0)
+ (break)))
+ ((r6 = 1)
+ (break))))
+ (loop
+ (if (r3 != ?=)
+ (if (r4 & ,(lsh 1 27))
+ ((read r3)
+ (r4 = r3 ,mel-ccl-decode-b-3-table)
+ (repeat))
+ (break))
+ ((r6 |= 2)
+ (break))))
+ (r4 = r0 ,mel-ccl-decode-b-0-table)
+ (r5 = r1 ,mel-ccl-decode-b-1-table)
+ (r4 |= r5)
+ (branch
+ r6
+ ;; BBBB
+ ((r5 = r2 ,mel-ccl-decode-b-2-table)
+ (r4 |= r5)
+ (r5 = r3 ,mel-ccl-decode-b-3-table)
+ (r4 |= r5)
+ (r4 >8= 0)
+ (write r7)
+ (r4 >8= 0)
+ (write r7)
+ (write-repeat r4))
+ ;; error: BB=B
+ ((write (r4 & 255))
+ (end))
+ ;; BBB=
+ ((r5 = r2 ,mel-ccl-decode-b-2-table)
+ (r4 |= r5)
+ (r4 >8= 0)
+ (write r7)
+ (write (r4 & 255))
+ (end) ; Excessive (end) is workaround for XEmacs 21.0.
+ ; Without this, "AAA=" is converted to "^@^@^@".
+ (end))
+ ;; BB==
+ ((write (r4 & 255))
+ (end))))
+ ((r4 >8= 0)
+ (write r7)
+ (r4 >8= 0)
+ (write r7)
+ (write-repeat r4))))))
+
+(eval-when-compile
+
+;; Generated CCL program works not properly on 20.2 because CCL_EOF_BLOCK
+;; is not executed.
+(defun mel-ccl-encode-base64-generic (&optional quantums-per-line output-crlf terminate-with-newline)
+ `(2
+ ((r3 = 0)
+ (loop
+ (r2 = 0)
+ (read-branch
+ r1
+ ,@(mapcar
+ (lambda (r1)
+ `((write ,(nth (lsh r1 -2) mel-ccl-64-to-256-table))
+ (r0 = ,(logand r1 3))))
+ mel-ccl-256-table))
+ (r2 = 1)
+ (read-branch
+ r1
+ ,@(mapcar
+ (lambda (r1)
+ `((write r0 ,(vconcat
+ (mapcar
+ (lambda (r0)
+ (nth (logior (lsh r0 4)
+ (lsh r1 -4))
+ mel-ccl-64-to-256-table))
+ mel-ccl-4-table)))
+ (r0 = ,(logand r1 15))))
+ mel-ccl-256-table))
+ (r2 = 2)
+ (read-branch
+ r1
+ ,@(mapcar
+ (lambda (r1)
+ `((write r0 ,(vconcat
+ (mapcar
+ (lambda (r0)
+ (nth (logior (lsh r0 2)
+ (lsh r1 -6))
+ mel-ccl-64-to-256-table))
+ mel-ccl-16-table)))))
+ mel-ccl-256-table))
+ (r1 &= 63)
+ (write r1 ,(vconcat
+ (mapcar
+ (lambda (r1)
+ (nth r1 mel-ccl-64-to-256-table))
+ mel-ccl-64-table)))
+ (r3 += 1)
+ ,@(when quantums-per-line
+ `((if (r3 == ,quantums-per-line)
+ ((write ,(if output-crlf "\r\n" "\n"))
+ (r3 = 0)))))
+ (repeat)))
+ (branch
+ r2
+ ,(if terminate-with-newline
+ `(if (r3 > 0) (write ,(if output-crlf "\r\n" "\n")))
+ `(r0 = 0))
+ ((write r0 ,(vconcat
+ (mapcar
+ (lambda (r0)
+ (nth (lsh r0 4) mel-ccl-64-to-256-table))
+ mel-ccl-4-table)))
+ (write ,(if terminate-with-newline
+ (if output-crlf "==\r\n" "==\n")
+ "==")))
+ ((write r0 ,(vconcat
+ (mapcar
+ (lambda (r0)
+ (nth (lsh r0 2) mel-ccl-64-to-256-table))
+ mel-ccl-16-table)))
+ (write ,(if terminate-with-newline
+ (if output-crlf "=\r\n" "=\n")
+ "="))))
+ ))
+)
+
+(define-ccl-program mel-ccl-encode-b
+ (mel-ccl-encode-base64-generic))
+
+;; 19 * 4 = 76
+(define-ccl-program mel-ccl-encode-base64-crlf-crlf
+ (mel-ccl-encode-base64-generic 19 t))
+
+(define-ccl-program mel-ccl-encode-base64-crlf-lf
+ (mel-ccl-encode-base64-generic 19 nil))
+
+
+;;; @ coding system
+;;;
+
+(make-ccl-coding-system
+ 'mel-ccl-b-rev ?B "MIME B-encoding (reversed)"
+ 'mel-ccl-encode-b 'mel-ccl-decode-b)
+
+(make-ccl-coding-system
+ 'mel-ccl-base64-crlf-rev
+ ?B "MIME Base64-encoding (reversed)"
+ 'mel-ccl-encode-base64-crlf-crlf
+ 'mel-ccl-decode-b)
+
+(make-ccl-coding-system
+ 'mel-ccl-base64-lf-rev
+ ?B "MIME Base64-encoding (LF encoding) (reversed)"
+ 'mel-ccl-encode-base64-crlf-lf
+ 'mel-ccl-decode-b)
+
+
+;;; @ B
+;;;
+
+(check-broken-facility ccl-execute-eof-block-on-decoding-some)
+
+(unless-broken ccl-execute-eof-block-on-decoding-some
+
+ (defun base64-ccl-encode-string (string)
+ "Encode STRING with base64 encoding."
+ (decode-coding-string string 'mel-ccl-base64-lf-rev))
+
+ (defun base64-ccl-encode-region (start end)
+ "Encode region from START to END with base64 encoding."
+ (interactive "r")
+ (decode-coding-region start end 'mel-ccl-base64-lf-rev))
+
+ (defun base64-ccl-insert-encoded-file (filename)
+ "Encode contents of file FILENAME to base64, and insert the result."
+ (interactive (list (read-file-name "Insert encoded file: ")))
+ (let ((coding-system-for-read 'mel-ccl-base64-lf-rev))
+ (insert-file-contents filename)))
+
+ (mel-define-method-function (mime-encode-string string (nil "base64"))
+ 'base64-ccl-encode-string)
+ (mel-define-method-function (mime-encode-region start end (nil "base64"))
+ 'base64-ccl-encode-region)
+ (mel-define-method-function
+ (mime-insert-encoded-file filename (nil "base64"))
+ 'base64-ccl-insert-encoded-file)
+
+ (mel-define-method-function (encoded-text-encode-string string (nil "B"))
+ 'base64-ccl-encode-string)
+ )
+
+(defun base64-ccl-decode-string (string)
+ "Decode base64 encoded STRING"
+ (encode-coding-string string 'mel-ccl-b-rev))
+
+(defun base64-ccl-decode-region (start end)
+ "Decode base64 encoded the region from START to END."
+ (interactive "r")
+ (encode-coding-region start end 'mel-ccl-b-rev))
+
+(defun base64-ccl-write-decoded-region (start end filename)
+ "Decode the region from START to END and write out to FILENAME."
+ (interactive
+ (list (region-beginning) (region-end)
+ (read-file-name "Write decoded region to file: ")))
+ (let ((coding-system-for-write 'mel-ccl-b-rev)
+ jka-compr-compression-info-list)
+ (write-region start end filename)))
+
+(mel-define-method-function (mime-decode-string string (nil "base64"))
+ 'base64-ccl-decode-string)
+(mel-define-method-function (mime-decode-region start end (nil "base64"))
+ 'base64-ccl-decode-region)
+(mel-define-method-function
+ (mime-write-decoded-region start end filename (nil "base64"))
+ 'base64-ccl-write-decoded-region)
+
+(mel-define-method encoded-text-decode-string (string (nil "B"))
+ (if (and (string-match B-encoded-text-regexp string)
+ (string= string (match-string 0 string)))
+ (base64-ccl-decode-string string)
+ (error "Invalid encoded-text %s" string)))
+
+
+;;; @ end
+;;;
+
+(provide 'mel-b-ccl)
+
+;;; mel-b-ccl.el ends here
;;; Code:
-(require 'emu)
+(require 'poe)
(require 'mime-def)
(eval-and-compile
--- /dev/null
+;;; mel-b-el.el: Base64 encoder/decoder for GNU Emacs
+
+;; Copyright (C) 1992,1995,1996,1997,1998 Free Software Foundation, Inc.
+
+;; Author: ENAMI Tsugutomo <enami@sys.ptg.sony.co.jp>
+;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; Created: 1995/6/24
+;; Keywords: MIME, Base64
+
+;; This file is part of MEL (MIME Encoding Library).
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or (at
+;; your option) any later version.
+
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Code:
+
+(require 'poe)
+(require 'mime-def)
+
+
+;;; @ variables
+;;;
+
+(defgroup base64 nil
+ "Base64 encoder/decoder"
+ :group 'mime)
+
+(defcustom base64-external-encoder '("mmencode")
+ "*list of base64 encoder program name and its arguments."
+ :group 'base64
+ :type '(cons (file :tag "Command")(repeat :tag "Arguments" string)))
+
+(defcustom base64-external-decoder '("mmencode" "-u")
+ "*list of base64 decoder program name and its arguments."
+ :group 'base64
+ :type '(cons (file :tag "Command")(repeat :tag "Arguments" string)))
+
+(defcustom base64-external-decoder-option-to-specify-file '("-o")
+ "*list of options of base64 decoder program to specify file."
+ :group 'base64
+ :type '(repeat :tag "Arguments" string))
+
+(defcustom base64-internal-encoding-limit 1000
+ "*limit size to use internal base64 encoder.
+If size of input to encode is larger than this limit,
+external encoder is called."
+ :group 'base64
+ :type '(choice (const :tag "Always use internal encoder" nil)
+ (integer :tag "Size")))
+
+(defcustom base64-internal-decoding-limit (if (and (featurep 'xemacs)
+ (featurep 'mule))
+ 1000
+ 7600)
+ "*limit size to use internal base64 decoder.
+If size of input to decode is larger than this limit,
+external decoder is called."
+ :group 'base64
+ :type '(choice (const :tag "Always use internal decoder" nil)
+ (integer :tag "Size")))
+
+
+;;; @ internal base64 encoder
+;;; based on base64 decoder by Enami Tsugutomo
+
+(eval-and-compile
+ (defconst base64-characters
+ "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/")
+ )
+
+(defmacro base64-num-to-char (n)
+ `(aref base64-characters ,n))
+
+(defun base64-encode-1 (pack)
+ (let ((a (car pack))
+ (b (nth 1 pack))
+ (c (nth 2 pack)))
+ (concat
+ (char-to-string (base64-num-to-char (ash a -2)))
+ (if b
+ (concat
+ (char-to-string
+ (base64-num-to-char (logior (ash (logand a 3) 4) (ash b -4))))
+ (if c
+ (concat
+ (char-to-string
+ (base64-num-to-char (logior (ash (logand b 15) 2) (ash c -6))))
+ (char-to-string (base64-num-to-char (logand c 63)))
+ )
+ (concat (char-to-string
+ (base64-num-to-char (ash (logand b 15) 2))) "=")
+ ))
+ (concat (char-to-string
+ (base64-num-to-char (ash (logand a 3) 4))) "==")
+ ))))
+
+(defun-maybe base64-encode-string (string)
+ "Encode STRING to base64, and return the result."
+ (let ((len (length string))
+ (b 0)(e 57)
+ dest)
+ (while (< e len)
+ (setq dest
+ (concat dest
+ (mapconcat
+ (function base64-encode-1)
+ (pack-sequence (substring string b e) 3)
+ "")
+ "\n"))
+ (setq b e
+ e (+ e 57)
+ )
+ )
+ (let* ((es (mapconcat
+ (function base64-encode-1)
+ (pack-sequence (substring string b) 3)
+ ""))
+ (m (mod (length es) 4))
+ )
+ (concat dest es (cond ((= m 3) "=")
+ ((= m 2) "==")
+ ))
+ )))
+
+(defun base64-internal-encode-region (beg end)
+ (save-excursion
+ (save-restriction
+ (narrow-to-region beg end)
+ (let ((str (buffer-substring beg end)))
+ (delete-region beg end)
+ (insert (base64-encode-string str))
+ )
+ (or (bolp)
+ (insert "\n")
+ )
+ )))
+
+
+;;; @ internal base64 decoder
+;;;
+
+(defconst base64-numbers
+ (eval-when-compile
+ (let ((len (length base64-characters))
+ (vec (make-vector 123 nil))
+ (i 0))
+ (while (< i len)
+ (aset vec (aref base64-characters i) i)
+ (setq i (1+ i)))
+ vec)))
+
+(defmacro base64-char-to-num (c)
+ `(aref base64-numbers ,c))
+
+(defsubst base64-internal-decode (string buffer)
+ (let* ((len (length string))
+ (i 0)
+ (j 0)
+ v1 v2 v3)
+ (catch 'tag
+ (while (< i len)
+ (when (prog1 (setq v1 (base64-char-to-num (aref string i)))
+ (setq i (1+ i)))
+ (setq v2 (base64-char-to-num (aref string i))
+ i (1+ i)
+ v3 (base64-char-to-num (aref string i))
+ i (1+ i))
+ (aset buffer j (logior (lsh v1 2)(lsh v2 -4)))
+ (setq j (1+ j))
+ (if v3
+ (let ((v4 (base64-char-to-num (aref string i))))
+ (setq i (1+ i))
+ (aset buffer j (logior (lsh (logand v2 15) 4)(lsh v3 -2)))
+ (setq j (1+ j))
+ (if v4
+ (aset buffer (prog1 j (setq j (1+ j)))
+ (logior (lsh (logand v3 3) 6) v4))
+ (throw 'tag nil)
+ ))
+ (throw 'tag nil)
+ ))))
+ (substring buffer 0 j)
+ ))
+
+(defun base64-internal-decode-string (string)
+ (base64-internal-decode string (make-string (length string) 0)))
+
+;; (defsubst base64-decode-string! (string)
+;; (setq string (string-as-unibyte string))
+;; (base64-internal-decode string string))
+
+(defun base64-internal-decode-region (beg end)
+ (save-excursion
+ (let ((str (string-as-unibyte (buffer-substring beg end))))
+ (delete-region beg end)
+ (goto-char beg)
+ (insert (base64-internal-decode str str)))))
+
+;; (defun base64-internal-decode-region2 (beg end)
+;; (save-excursion
+;; (let ((str (buffer-substring beg end)))
+;; (delete-region beg end)
+;; (goto-char beg)
+;; (insert (base64-decode-string! str)))))
+
+;; (defun base64-internal-decode-region3 (beg end)
+;; (save-excursion
+;; (let ((str (buffer-substring beg end)))
+;; (delete-region beg end)
+;; (goto-char beg)
+;; (insert (base64-internal-decode-string str)))))
+
+
+;;; @ external encoder/decoder
+;;;
+
+(defun base64-external-encode-region (beg end)
+ (save-excursion
+ (save-restriction
+ (narrow-to-region beg end)
+ (as-binary-process
+ (apply (function call-process-region)
+ beg end (car base64-external-encoder)
+ t t nil (cdr base64-external-encoder)))
+ ;; for OS/2
+ ;; regularize line break code
+ (goto-char (point-min))
+ (while (re-search-forward "\r$" nil t)
+ (replace-match ""))
+ )))
+
+(defun base64-external-decode-region (beg end)
+ (save-excursion
+ (as-binary-process
+ (apply (function call-process-region)
+ beg end (car base64-external-decoder)
+ t t nil (cdr base64-external-decoder)))
+ ))
+
+(defun base64-external-decode-string (string)
+ (with-temp-buffer
+ (insert string)
+ (as-binary-process
+ (apply (function call-process-region)
+ (point-min) (point-max)
+ (car base64-external-decoder)
+ t t nil (cdr base64-external-decoder)))
+ (buffer-string)))
+
+
+;;; @ application interfaces
+;;;
+
+(defun-maybe base64-encode-region (start end)
+ "Encode current region by base64.
+START and END are buffer positions.
+This function calls internal base64 encoder if size of region is
+smaller than `base64-internal-encoding-limit', otherwise it calls
+external base64 encoder specified by `base64-external-encoder'. In
+this case, you must install the program (maybe mmencode included in
+metamail or XEmacs package)."
+ (interactive "r")
+ (if (and base64-internal-encoding-limit
+ (> (- end start) base64-internal-encoding-limit))
+ (base64-external-encode-region start end)
+ (base64-internal-encode-region start end)))
+
+(defun-maybe base64-decode-region (start end)
+ "Decode current region by base64.
+START and END are buffer positions.
+This function calls internal base64 decoder if size of region is
+smaller than `base64-internal-decoding-limit', otherwise it calls
+external base64 decoder specified by `base64-external-decoder'. In
+this case, you must install the program (maybe mmencode included in
+metamail or XEmacs package)."
+ (interactive "r")
+ (if (and base64-internal-decoding-limit
+ (> (- end start) base64-internal-decoding-limit))
+ (base64-external-decode-region start end)
+ (base64-internal-decode-region start end)))
+
+(defun-maybe base64-decode-string (string)
+ "Decode STRING which is encoded in base64, and return the result.
+This function calls internal base64 decoder if size of STRING is
+smaller than `base64-internal-decoding-limit', otherwise it calls
+external base64 decoder specified by `base64-external-decoder'. In
+this case, you must install the program (maybe mmencode included in
+metamail or XEmacs package)."
+ (interactive "r")
+ (if (and base64-internal-decoding-limit
+ (> (length string) base64-internal-decoding-limit))
+ (base64-external-decode-string string)
+ (base64-internal-decode-string string)))
+
+
+(mel-define-method-function (mime-encode-string string (nil "base64"))
+ 'base64-encode-string)
+(mel-define-method-function (mime-decode-string string (nil "base64"))
+ 'base64-decode-string)
+(mel-define-method-function (mime-encode-region start end (nil "base64"))
+ 'base64-encode-region)
+(mel-define-method-function (mime-decode-region start end (nil "base64"))
+ 'base64-decode-region)
+
+(mel-define-method-function (encoded-text-encode-string string (nil "B"))
+ 'base64-encode-string)
+
+(mel-define-method encoded-text-decode-string (string (nil "B"))
+ (if (and (string-match B-encoded-text-regexp string)
+ (string= string (match-string 0 string)))
+ (base64-decode-string string)
+ (error "Invalid encoded-text %s" string)))
+
+(defun base64-insert-encoded-file (filename)
+ "Encode contents of file FILENAME to base64, and insert the result.
+It calls external base64 encoder specified by
+`base64-external-encoder'. So you must install the program (maybe
+mmencode included in metamail or XEmacs package)."
+ (interactive (list (read-file-name "Insert encoded file: ")))
+ (if (and base64-internal-encoding-limit
+ (> (nth 7 (file-attributes filename))
+ base64-internal-encoding-limit))
+ (apply (function call-process) (car base64-external-encoder)
+ filename t nil (cdr base64-external-encoder))
+ (insert
+ (base64-encode-string
+ (with-temp-buffer
+ (set-buffer-multibyte nil)
+ (insert-file-contents-as-binary filename)
+ (buffer-string))))
+ (or (bolp)
+ (insert "\n"))
+ ))
+
+(mel-define-method-function (mime-insert-encoded-file filename (nil "base64"))
+ 'base64-insert-encoded-file)
+
+(defun base64-write-decoded-region (start end filename)
+ "Decode and write current region encoded by base64 into FILENAME.
+START and END are buffer positions."
+ (interactive
+ (list (region-beginning) (region-end)
+ (read-file-name "Write decoded region to file: ")))
+ (if (and base64-internal-decoding-limit
+ (> (- end start) base64-internal-decoding-limit))
+ (as-binary-process
+ (apply (function call-process-region)
+ start end (car base64-external-decoder)
+ nil nil nil
+ (append (cdr base64-external-decoder)
+ base64-external-decoder-option-to-specify-file
+ (list filename))))
+ (let ((str (buffer-substring start end)))
+ (with-temp-buffer
+ (insert (base64-internal-decode-string str))
+ (write-region-as-binary (point-min) (point-max) filename)
+ ))))
+
+(mel-define-method-function
+ (mime-write-decoded-region start end filename (nil "base64"))
+ 'base64-write-decoded-region)
+
+
+;;; @ etc
+;;;
+
+(defun pack-sequence (seq size)
+ "Split sequence SEQ into SIZE elements packs,
+and return list of packs. [mel-b-el; tl-seq function]"
+ (let ((len (length seq)) (p 0) obj
+ unit (i 0)
+ dest)
+ (while (< p len)
+ (setq obj (elt seq p))
+ (setq unit (cons obj unit))
+ (setq i (1+ i))
+ (if (= i size)
+ (progn
+ (setq dest (cons (reverse unit) dest))
+ (setq unit nil)
+ (setq i 0)
+ ))
+ (setq p (1+ p))
+ )
+ (if unit
+ (setq dest (cons (reverse unit) dest))
+ )
+ (reverse dest)
+ ))
+
+
+;;; @ end
+;;;
+
+(provide 'mel-b-el)
+
+;;; mel-b-el.el ends here.
+++ /dev/null
-;;; mel-b.el: Base64 encoder/decoder for GNU Emacs
-
-;; Copyright (C) 1992,1995,1996,1997,1998 Free Software Foundation, Inc.
-
-;; Author: ENAMI Tsugutomo <enami@sys.ptg.sony.co.jp>
-;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
-;; Created: 1995/6/24
-;; Keywords: MIME, Base64
-
-;; This file is part of MEL (MIME Encoding Library).
-
-;; This program is free software; you can redistribute it and/or
-;; modify it under the terms of the GNU General Public License as
-;; published by the Free Software Foundation; either version 2, or (at
-;; your option) any later version.
-
-;; This program is distributed in the hope that it will be useful, but
-;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-;; General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Code:
-
-(require 'emu)
-(require 'mime-def)
-
-
-;;; @ variables
-;;;
-
-(defgroup base64 nil
- "Base64 encoder/decoder"
- :group 'mime)
-
-(defcustom base64-external-encoder '("mmencode")
- "*list of base64 encoder program name and its arguments."
- :group 'base64
- :type '(cons (file :tag "Command")(repeat :tag "Arguments" string)))
-
-(defcustom base64-external-decoder '("mmencode" "-u")
- "*list of base64 decoder program name and its arguments."
- :group 'base64
- :type '(cons (file :tag "Command")(repeat :tag "Arguments" string)))
-
-(defcustom base64-external-decoder-option-to-specify-file '("-o")
- "*list of options of base64 decoder program to specify file."
- :group 'base64
- :type '(repeat :tag "Arguments" string))
-
-(defcustom base64-internal-encoding-limit 1000
- "*limit size to use internal base64 encoder.
-If size of input to encode is larger than this limit,
-external encoder is called."
- :group 'base64
- :type '(choice (const :tag "Always use internal encoder" nil)
- (integer :tag "Size")))
-
-(defcustom base64-internal-decoding-limit (if (and (featurep 'xemacs)
- (featurep 'mule))
- 1000
- 7600)
- "*limit size to use internal base64 decoder.
-If size of input to decode is larger than this limit,
-external decoder is called."
- :group 'base64
- :type '(choice (const :tag "Always use internal decoder" nil)
- (integer :tag "Size")))
-
-
-;;; @ internal base64 encoder
-;;; based on base64 decoder by Enami Tsugutomo
-
-(eval-and-compile
- (defconst base64-characters
- "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/")
- )
-
-(defmacro base64-num-to-char (n)
- `(aref base64-characters ,n))
-
-(defun base64-encode-1 (pack)
- (let ((a (car pack))
- (b (nth 1 pack))
- (c (nth 2 pack)))
- (concat
- (char-to-string (base64-num-to-char (ash a -2)))
- (if b
- (concat
- (char-to-string
- (base64-num-to-char (logior (ash (logand a 3) 4) (ash b -4))))
- (if c
- (concat
- (char-to-string
- (base64-num-to-char (logior (ash (logand b 15) 2) (ash c -6))))
- (char-to-string (base64-num-to-char (logand c 63)))
- )
- (concat (char-to-string
- (base64-num-to-char (ash (logand b 15) 2))) "=")
- ))
- (concat (char-to-string
- (base64-num-to-char (ash (logand a 3) 4))) "==")
- ))))
-
-(defun base64-encode-string (string)
- "Encode STRING to base64, and return the result."
- (let ((len (length string))
- (b 0)(e 57)
- dest)
- (while (< e len)
- (setq dest
- (concat dest
- (mapconcat
- (function base64-encode-1)
- (pack-sequence (substring string b e) 3)
- "")
- "\n"))
- (setq b e
- e (+ e 57)
- )
- )
- (let* ((es (mapconcat
- (function base64-encode-1)
- (pack-sequence (substring string b) 3)
- ""))
- (m (mod (length es) 4))
- )
- (concat dest es (cond ((= m 3) "=")
- ((= m 2) "==")
- ))
- )))
-
-(defun base64-internal-encode-region (beg end)
- (save-excursion
- (save-restriction
- (narrow-to-region beg end)
- (let ((str (buffer-substring beg end)))
- (delete-region beg end)
- (insert (base64-encode-string str))
- )
- (or (bolp)
- (insert "\n")
- )
- )))
-
-
-;;; @ internal base64 decoder
-;;;
-
-(defconst base64-numbers
- (eval-when-compile
- (let ((len (length base64-characters))
- (vec (make-vector 123 nil))
- (i 0))
- (while (< i len)
- (aset vec (aref base64-characters i) i)
- (setq i (1+ i)))
- vec)))
-
-(defmacro base64-char-to-num (c)
- `(aref base64-numbers ,c))
-
-(defsubst base64-internal-decode (string buffer)
- (let* ((len (length string))
- (i 0)
- (j 0)
- v1 v2 v3)
- (catch 'tag
- (while (< i len)
- (when (prog1 (setq v1 (base64-char-to-num (aref string i)))
- (setq i (1+ i)))
- (setq v2 (base64-char-to-num (aref string i))
- i (1+ i)
- v3 (base64-char-to-num (aref string i))
- i (1+ i))
- (aset buffer j (logior (lsh v1 2)(lsh v2 -4)))
- (setq j (1+ j))
- (if v3
- (let ((v4 (base64-char-to-num (aref string i))))
- (setq i (1+ i))
- (aset buffer j (logior (lsh (logand v2 15) 4)(lsh v3 -2)))
- (setq j (1+ j))
- (if v4
- (aset buffer (prog1 j (setq j (1+ j)))
- (logior (lsh (logand v3 3) 6) v4))
- (throw 'tag nil)
- ))
- (throw 'tag nil)
- ))))
- (substring buffer 0 j)
- ))
-
-(defun base64-internal-decode-string (string)
- (base64-internal-decode string (make-string (length string) 0)))
-
-;; (defsubst base64-decode-string! (string)
-;; (setq string (string-as-unibyte string))
-;; (base64-internal-decode string string))
-
-(defun base64-internal-decode-region (beg end)
- (save-excursion
- (let ((str (string-as-unibyte (buffer-substring beg end))))
- (delete-region beg end)
- (goto-char beg)
- (insert (base64-internal-decode str str)))))
-
-;; (defun base64-internal-decode-region2 (beg end)
-;; (save-excursion
-;; (let ((str (buffer-substring beg end)))
-;; (delete-region beg end)
-;; (goto-char beg)
-;; (insert (base64-decode-string! str)))))
-
-;; (defun base64-internal-decode-region3 (beg end)
-;; (save-excursion
-;; (let ((str (buffer-substring beg end)))
-;; (delete-region beg end)
-;; (goto-char beg)
-;; (insert (base64-internal-decode-string str)))))
-
-
-;;; @ external encoder/decoder
-;;;
-
-(defun base64-external-encode-region (beg end)
- (save-excursion
- (save-restriction
- (narrow-to-region beg end)
- (as-binary-process
- (apply (function call-process-region)
- beg end (car base64-external-encoder)
- t t nil (cdr base64-external-encoder)))
- ;; for OS/2
- ;; regularize line break code
- (goto-char (point-min))
- (while (re-search-forward "\r$" nil t)
- (replace-match ""))
- )))
-
-(defun base64-external-decode-region (beg end)
- (save-excursion
- (as-binary-process
- (apply (function call-process-region)
- beg end (car base64-external-decoder)
- t t nil (cdr base64-external-decoder)))
- ))
-
-(defun base64-external-decode-string (string)
- (with-temp-buffer
- (insert string)
- (as-binary-process
- (apply (function call-process-region)
- (point-min) (point-max)
- (car base64-external-decoder)
- t t nil (cdr base64-external-decoder)))
- (buffer-string)))
-
-
-;;; @ application interfaces
-;;;
-
-(defun base64-encode-region (start end)
- "Encode current region by base64.
-START and END are buffer positions.
-This function calls internal base64 encoder if size of region is
-smaller than `base64-internal-encoding-limit', otherwise it calls
-external base64 encoder specified by `base64-external-encoder'. In
-this case, you must install the program (maybe mmencode included in
-metamail or XEmacs package)."
- (interactive "r")
- (if (and base64-internal-encoding-limit
- (> (- end start) base64-internal-encoding-limit))
- (base64-external-encode-region start end)
- (base64-internal-encode-region start end)))
-
-(defun base64-decode-region (start end)
- "Decode current region by base64.
-START and END are buffer positions.
-This function calls internal base64 decoder if size of region is
-smaller than `base64-internal-decoding-limit', otherwise it calls
-external base64 decoder specified by `base64-external-decoder'. In
-this case, you must install the program (maybe mmencode included in
-metamail or XEmacs package)."
- (interactive "r")
- (if (and base64-internal-decoding-limit
- (> (- end start) base64-internal-decoding-limit))
- (base64-external-decode-region start end)
- (base64-internal-decode-region start end)))
-
-(defun base64-decode-string (string)
- "Decode STRING which is encoded in base64, and return the result.
-This function calls internal base64 decoder if size of STRING is
-smaller than `base64-internal-decoding-limit', otherwise it calls
-external base64 decoder specified by `base64-external-decoder'. In
-this case, you must install the program (maybe mmencode included in
-metamail or XEmacs package)."
- (interactive "r")
- (if (and base64-internal-decoding-limit
- (> (length string) base64-internal-decoding-limit))
- (base64-external-decode-string string)
- (base64-internal-decode-string string)))
-
-
-(mel-define-method-function (mime-encode-string string (nil "base64"))
- 'base64-encode-string)
-(mel-define-method-function (mime-decode-string string (nil "base64"))
- 'base64-decode-string)
-(mel-define-method-function (mime-encode-region start end (nil "base64"))
- 'base64-encode-region)
-(mel-define-method-function (mime-decode-region start end (nil "base64"))
- 'base64-decode-region)
-
-(mel-define-method-function (encoded-text-encode-string string (nil "B"))
- 'base64-encode-string)
-
-(mel-define-method encoded-text-decode-string (string (nil "B"))
- (if (and (string-match B-encoded-text-regexp string)
- (string= string (match-string 0 string)))
- (base64-decode-string string)
- (error "Invalid encoded-text %s" string)))
-
-(defun base64-insert-encoded-file (filename)
- "Encode contents of file FILENAME to base64, and insert the result.
-It calls external base64 encoder specified by
-`base64-external-encoder'. So you must install the program (maybe
-mmencode included in metamail or XEmacs package)."
- (interactive (list (read-file-name "Insert encoded file: ")))
- (if (and base64-internal-encoding-limit
- (> (nth 7 (file-attributes filename))
- base64-internal-encoding-limit))
- (apply (function call-process) (car base64-external-encoder)
- filename t nil (cdr base64-external-encoder))
- (insert
- (base64-encode-string
- (with-temp-buffer
- (set-buffer-multibyte nil)
- (insert-file-contents-as-binary filename)
- (buffer-string))))
- (or (bolp)
- (insert "\n"))
- ))
-
-(mel-define-method-function (mime-insert-encoded-file filename (nil "base64"))
- 'base64-insert-encoded-file)
-
-(defun base64-write-decoded-region (start end filename)
- "Decode and write current region encoded by base64 into FILENAME.
-START and END are buffer positions."
- (interactive
- (list (region-beginning) (region-end)
- (read-file-name "Write decoded region to file: ")))
- (if (and base64-internal-decoding-limit
- (> (- end start) base64-internal-decoding-limit))
- (as-binary-process
- (apply (function call-process-region)
- start end (car base64-external-decoder)
- nil nil nil
- (append (cdr base64-external-decoder)
- base64-external-decoder-option-to-specify-file
- (list filename))))
- (let ((str (buffer-substring start end)))
- (with-temp-buffer
- (insert (base64-internal-decode-string str))
- (write-region-as-binary (point-min) (point-max) filename)
- ))))
-
-(mel-define-method-function
- (mime-write-decoded-region start end filename (nil "base64"))
- 'base64-write-decoded-region)
-
-
-;;; @ etc
-;;;
-
-(defun pack-sequence (seq size)
- "Split sequence SEQ into SIZE elements packs,
-and return list of packs. [mel-b; tl-seq function]"
- (let ((len (length seq)) (p 0) obj
- unit (i 0)
- dest)
- (while (< p len)
- (setq obj (elt seq p))
- (setq unit (cons obj unit))
- (setq i (1+ i))
- (if (= i size)
- (progn
- (setq dest (cons (reverse unit) dest))
- (setq unit nil)
- (setq i 0)
- ))
- (setq p (1+ p))
- )
- (if unit
- (setq dest (cons (reverse unit) dest))
- )
- (reverse dest)
- ))
-
-
-;;; @ end
-;;;
-
-(provide 'mel-b)
-
-;;; mel-b.el ends here.
+++ /dev/null
-;;; mel-ccl.el: CCL based encoder/decoder of Base64, Quoted-Printable
-;;; and Q-encoding
-
-;; Copyright (C) 1998 Tanaka Akira
-
-;; Author: Tanaka Akira <akr@jaist.ac.jp>
-;; Created: 1998/9/17
-;; Keywords: MIME, Base64, Quoted-Printable, Q-encoding
-
-;; This file is part of FLIM (Faithful Library about Internet Message).
-
-;; This program is free software; you can redistribute it and/or
-;; modify it under the terms of the GNU General Public License as
-;; published by the Free Software Foundation; either version 2, or (at
-;; your option) any later version.
-
-;; This program is distributed in the hope that it will be useful, but
-;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-;; General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Code:
-
-(require 'ccl)
-(require 'pccl)
-(require 'mime-def)
-
-
-;;; @ constants
-;;;
-
-(eval-when-compile
-
-(defconst mel-ccl-4-table
- '( 0 1 2 3))
-
-(defconst mel-ccl-16-table
- '( 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15))
-
-(defconst mel-ccl-28-table
- '( 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
- 16 17 18 19 20 21 22 23 24 25 26 27))
-
-(defconst mel-ccl-64-table
- '( 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
- 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31
- 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47
- 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63))
-
-(defconst mel-ccl-256-table
- '( 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
- 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31
- 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47
- 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63
- 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79
- 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95
- 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111
- 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127
- 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143
- 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159
- 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175
- 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191
- 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207
- 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223
- 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239
- 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255))
-
-(defconst mel-ccl-256-to-16-table
- '(nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
- nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
- nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
- 0 1 2 3 4 5 6 7 8 9 nil nil nil nil nil nil
- nil 10 11 12 13 14 15 nil nil nil nil nil nil nil nil nil
- nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
- nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
- nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
- nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
- nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
- nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
- nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
- nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
- nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
- nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
- nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil))
-
-(defconst mel-ccl-16-to-256-table
- (mapcar 'char-int "0123456789ABCDEF"))
-
-(defconst mel-ccl-high-table
- (vconcat
- (mapcar
- (lambda (v) (nth (lsh v -4) mel-ccl-16-to-256-table))
- mel-ccl-256-table)))
-
-(defconst mel-ccl-low-table
- (vconcat
- (mapcar
- (lambda (v) (nth (logand v 15) mel-ccl-16-to-256-table))
- mel-ccl-256-table)))
-
-(defconst mel-ccl-u-raw
- (mapcar
- 'char-int
- "0123456789\
-ABCDEFGHIJKLMNOPQRSTUVWXYZ\
-abcdefghijklmnopqrstuvwxyz\
-!@#$%&'()*+,-./:;<>@[\\]^`{|}~"))
-
-(defconst mel-ccl-c-raw
- (mapcar
- 'char-int
- "0123456789\
-ABCDEFGHIJKLMNOPQRSTUVWXYZ\
-abcdefghijklmnopqrstuvwxyz\
-!@#$%&'*+,-./:;<>@[]^`{|}~"))
-
-(defconst mel-ccl-p-raw
- (mapcar
- 'char-int
- "0123456789\
-ABCDEFGHIJKLMNOPQRSTUVWXYZ\
-abcdefghijklmnopqrstuvwxyz\
-!*+-/"))
-
-(defconst mel-ccl-256-to-64-table
- '(nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
- nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
- nil nil nil nil nil nil nil nil nil nil nil 62 nil nil nil 63
- 52 53 54 55 56 57 58 59 60 61 nil nil nil t nil nil
- nil 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14
- 15 16 17 18 19 20 21 22 23 24 25 nil nil nil nil nil
- nil 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40
- 41 42 43 44 45 46 47 48 49 50 51 nil nil nil nil nil
- nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
- nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
- nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
- nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
- nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
- nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
- nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
- nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil))
-
-(defconst mel-ccl-64-to-256-table
- (mapcar
- 'char-int
- "ABCDEFGHIJKLMNOPQRSTUVWXYZ\
-abcdefghijklmnopqrstuvwxyz\
-0123456789\
-+/"))
-
-(defconst mel-ccl-qp-table
- [enc enc enc enc enc enc enc enc enc wsp lf enc enc cr enc enc
- enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc
- wsp raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw
- raw raw raw raw raw raw raw raw raw raw raw raw raw enc raw raw
- raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw
- raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw
- raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw
- raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw enc
- enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc
- enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc
- enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc
- enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc
- enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc
- enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc
- enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc
- enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc])
-
-)
-
-
-;;; @ CCL programs
-;;;
-
-;;; Q
-
-(define-ccl-program mel-ccl-decode-q
- `(1
- ((loop
- (read-branch
- r0
- ,@(mapcar
- (lambda (r0)
- (cond
- ((= r0 (char-int ?_))
- `(write-repeat ? ))
- ((= r0 (char-int ?=))
- `((loop
- (read-branch
- r1
- ,@(mapcar
- (lambda (v)
- (if (integerp v)
- `((r0 = ,v) (break))
- '(repeat)))
- mel-ccl-256-to-16-table)))
- (loop
- (read-branch
- r1
- ,@(mapcar
- (lambda (v)
- (if (integerp v)
- `((write r0 ,(vconcat
- (mapcar
- (lambda (r0)
- (logior (lsh r0 4) v))
- mel-ccl-16-table)))
- (break))
- '(repeat)))
- mel-ccl-256-to-16-table)))
- (repeat)))
- (t
- `(write-repeat ,r0))))
- mel-ccl-256-table))))))
-
-(eval-when-compile
-
-(defun mel-ccl-encode-q-generic (raw)
- `(3
- (loop
- (loop
- (read-branch
- r0
- ,@(mapcar
- (lambda (r0)
- (cond
- ((= r0 32) `(write-repeat ?_))
- ((member r0 raw) `(write-repeat ,r0))
- (t '(break))))
- mel-ccl-256-table)))
- (write ?=)
- (write r0 ,mel-ccl-high-table)
- (write r0 ,mel-ccl-low-table)
- (repeat))))
-
-;; On xemacs, generated program counts iso-8859-1 8bit character as 6bytes.
-(defun mel-ccl-count-q-length (raw)
- `(0
- ((r0 = 0)
- (loop
- (read-branch
- r1
- ,@(mapcar
- (lambda (r1)
- (if (or (= r1 32) (member r1 raw))
- '((r0 += 1) (repeat))
- '((r0 += 3) (repeat))))
- mel-ccl-256-table))))))
-
-)
-
-(define-ccl-program mel-ccl-encode-uq
- (mel-ccl-encode-q-generic mel-ccl-u-raw))
-(define-ccl-program mel-ccl-encode-cq
- (mel-ccl-encode-q-generic mel-ccl-c-raw))
-(define-ccl-program mel-ccl-encode-pq
- (mel-ccl-encode-q-generic mel-ccl-p-raw))
-
-(define-ccl-program mel-ccl-count-uq
- (mel-ccl-count-q-length mel-ccl-u-raw))
-(define-ccl-program mel-ccl-count-cq
- (mel-ccl-count-q-length mel-ccl-c-raw))
-(define-ccl-program mel-ccl-count-pq
- (mel-ccl-count-q-length mel-ccl-p-raw))
-
-;;; B/Base64
-
-(eval-when-compile
-
-(defun mel-ccl-decode-b-bit-ex (v)
- (logior
- (lsh (logand v (lsh 255 16)) -16)
- (logand v (lsh 255 8))
- (lsh (logand v 255) 16)))
-
-(defconst mel-ccl-decode-b-0-table
- (vconcat
- (mapcar
- (lambda (v)
- (if (integerp v)
- (mel-ccl-decode-b-bit-ex (lsh v 18))
- (lsh 1 24)))
- mel-ccl-256-to-64-table)))
-
-(defconst mel-ccl-decode-b-1-table
- (vconcat
- (mapcar
- (lambda (v)
- (if (integerp v)
- (mel-ccl-decode-b-bit-ex (lsh v 12))
- (lsh 1 25)))
- mel-ccl-256-to-64-table)))
-
-(defconst mel-ccl-decode-b-2-table
- (vconcat
- (mapcar
- (lambda (v)
- (if (integerp v)
- (mel-ccl-decode-b-bit-ex (lsh v 6))
- (lsh 1 26)))
- mel-ccl-256-to-64-table)))
-
-(defconst mel-ccl-decode-b-3-table
- (vconcat
- (mapcar
- (lambda (v)
- (if (integerp v)
- (mel-ccl-decode-b-bit-ex v)
- (lsh 1 27)))
- mel-ccl-256-to-64-table)))
-
-)
-
-(define-ccl-program mel-ccl-decode-b
- `(1
- (loop
- (read r0 r1 r2 r3)
- (r4 = r0 ,mel-ccl-decode-b-0-table)
- (r5 = r1 ,mel-ccl-decode-b-1-table)
- (r4 |= r5)
- (r5 = r2 ,mel-ccl-decode-b-2-table)
- (r4 |= r5)
- (r5 = r3 ,mel-ccl-decode-b-3-table)
- (r4 |= r5)
- (if (r4 & ,(lognot (1- (lsh 1 24))))
- ((loop
- (if (r4 & ,(lsh 1 24))
- ((r0 = r1) (r1 = r2) (r2 = r3) (read r3)
- (r4 >>= 1) (r4 &= ,(logior (lsh 7 24)))
- (r5 = r3 ,mel-ccl-decode-b-3-table)
- (r4 |= r5)
- (repeat))
- (break)))
- (loop
- (if (r4 & ,(lsh 1 25))
- ((r1 = r2) (r2 = r3) (read r3)
- (r4 >>= 1) (r4 &= ,(logior (lsh 7 24)))
- (r5 = r3 ,mel-ccl-decode-b-3-table)
- (r4 |= r5)
- (repeat))
- (break)))
- (loop
- (if (r2 != ?=)
- (if (r4 & ,(lsh 1 26))
- ((r2 = r3) (read r3)
- (r4 >>= 1) (r4 &= ,(logior (lsh 7 24)))
- (r5 = r3 ,mel-ccl-decode-b-3-table)
- (r4 |= r5)
- (repeat))
- ((r6 = 0)
- (break)))
- ((r6 = 1)
- (break))))
- (loop
- (if (r3 != ?=)
- (if (r4 & ,(lsh 1 27))
- ((read r3)
- (r4 = r3 ,mel-ccl-decode-b-3-table)
- (repeat))
- (break))
- ((r6 |= 2)
- (break))))
- (r4 = r0 ,mel-ccl-decode-b-0-table)
- (r5 = r1 ,mel-ccl-decode-b-1-table)
- (r4 |= r5)
- (branch
- r6
- ;; BBBB
- ((r5 = r2 ,mel-ccl-decode-b-2-table)
- (r4 |= r5)
- (r5 = r3 ,mel-ccl-decode-b-3-table)
- (r4 |= r5)
- (r4 >8= 0)
- (write r7)
- (r4 >8= 0)
- (write r7)
- (write-repeat r4))
- ;; error: BB=B
- ((write (r4 & 255))
- (end))
- ;; BBB=
- ((r5 = r2 ,mel-ccl-decode-b-2-table)
- (r4 |= r5)
- (r4 >8= 0)
- (write r7)
- (write (r4 & 255))
- (end) ; Excessive (end) is workaround for XEmacs 21.0.
- ; Without this, "AAA=" is converted to "^@^@^@".
- (end))
- ;; BB==
- ((write (r4 & 255))
- (end))))
- ((r4 >8= 0)
- (write r7)
- (r4 >8= 0)
- (write r7)
- (write-repeat r4))))))
-
-(eval-when-compile
-
-;; Generated CCL program works not properly on 20.2 because CCL_EOF_BLOCK
-;; is not executed.
-(defun mel-ccl-encode-base64-generic (&optional quantums-per-line output-crlf terminate-with-newline)
- `(2
- ((r3 = 0)
- (loop
- (r2 = 0)
- (read-branch
- r1
- ,@(mapcar
- (lambda (r1)
- `((write ,(nth (lsh r1 -2) mel-ccl-64-to-256-table))
- (r0 = ,(logand r1 3))))
- mel-ccl-256-table))
- (r2 = 1)
- (read-branch
- r1
- ,@(mapcar
- (lambda (r1)
- `((write r0 ,(vconcat
- (mapcar
- (lambda (r0)
- (nth (logior (lsh r0 4)
- (lsh r1 -4))
- mel-ccl-64-to-256-table))
- mel-ccl-4-table)))
- (r0 = ,(logand r1 15))))
- mel-ccl-256-table))
- (r2 = 2)
- (read-branch
- r1
- ,@(mapcar
- (lambda (r1)
- `((write r0 ,(vconcat
- (mapcar
- (lambda (r0)
- (nth (logior (lsh r0 2)
- (lsh r1 -6))
- mel-ccl-64-to-256-table))
- mel-ccl-16-table)))))
- mel-ccl-256-table))
- (r1 &= 63)
- (write r1 ,(vconcat
- (mapcar
- (lambda (r1)
- (nth r1 mel-ccl-64-to-256-table))
- mel-ccl-64-table)))
- (r3 += 1)
- ,@(when quantums-per-line
- `((if (r3 == ,quantums-per-line)
- ((write ,(if output-crlf "\r\n" "\n"))
- (r3 = 0)))))
- (repeat)))
- (branch
- r2
- ,(if terminate-with-newline
- `(if (r3 > 0) (write ,(if output-crlf "\r\n" "\n")))
- `(r0 = 0))
- ((write r0 ,(vconcat
- (mapcar
- (lambda (r0)
- (nth (lsh r0 4) mel-ccl-64-to-256-table))
- mel-ccl-4-table)))
- (write ,(if terminate-with-newline
- (if output-crlf "==\r\n" "==\n")
- "==")))
- ((write r0 ,(vconcat
- (mapcar
- (lambda (r0)
- (nth (lsh r0 2) mel-ccl-64-to-256-table))
- mel-ccl-16-table)))
- (write ,(if terminate-with-newline
- (if output-crlf "=\r\n" "=\n")
- "="))))
- ))
-)
-
-(define-ccl-program mel-ccl-encode-b
- (mel-ccl-encode-base64-generic))
-
-;; 19 * 4 = 76
-(define-ccl-program mel-ccl-encode-base64-crlf-crlf
- (mel-ccl-encode-base64-generic 19 t))
-
-(define-ccl-program mel-ccl-encode-base64-crlf-lf
- (mel-ccl-encode-base64-generic 19 nil))
-
-;; Quoted-Printable
-
-(eval-when-compile
-
-(defun mel-ccl-try-to-read-crlf (input-crlf reg eof-reg cr-eof lf-eof crlf-eof succ fail-cr fail-lf fail-crlf)
- (if input-crlf
- `((,eof-reg = ,cr-eof) (read-if (,reg == ?\r)
- ((,eof-reg = ,lf-eof) (read-if (,reg == ?\n)
- ,succ
- ,fail-lf))
- ,fail-cr))
- `((,eof-reg = ,crlf-eof) (read-if (,reg == ?\n)
- ,succ
- ,fail-crlf))))
-
-;; Generated CCL program works not properly on 20.2 because CCL_EOF_BLOCK
-;; is not executed.
-(defun mel-ccl-encode-quoted-printable-generic (input-crlf output-crlf)
- `(4
- ((r6 = 0) ; column
- (r5 = 0) ; previous character is white space
- (r4 = 0)
- (read r0)
- (loop ; r6 <= 75
- (loop
- (loop
- (branch
- r0
- ,@(mapcar
- (lambda (r0)
- (let ((tmp (aref mel-ccl-qp-table r0)))
- (cond
- ((eq r0 (char-int ?F))
- `(if (r6 == 0)
- ((r4 = 15) (read-if (r0 == ?r)
- ((r4 = 16) (read-if (r0 == ?o)
- ((r4 = 17) (read-if (r0 == ?m)
- ((r4 = 18) (read-if (r0 == ? )
- ((r6 = 7)
- (r5 = 1)
- (write "=46rom ")
- (r4 = 19)
- (read r0)
- (repeat))
- ((r6 = 4)
- (write-repeat "From"))))
- ((r6 = 3)
- (write-repeat "Fro"))))
- ((r6 = 2)
- (write-repeat "Fr"))))
- ((r6 = 1)
- (write-repeat "F"))))
- ((r3 = 0) (break)) ; RAW
- ))
- ((eq r0 (char-int ?.))
- `(if (r6 == 0)
- ,(mel-ccl-try-to-read-crlf
- input-crlf
- 'r0 'r4 20 21 22
- `((write ,(if output-crlf "=2E\r\n" "=2E\n"))
- (r4 = 23)
- (read r0)
- (repeat))
- '((r6 = 1)
- (write-repeat "."))
- '((r6 = 4)
- (write-repeat ".=0D"))
- '((r6 = 1)
- (write-repeat ".")))
- ((r3 = 0) (break)) ; RAW
- ))
- ((eq tmp 'raw) '((r3 = 0) (break))) ; RAW
- ((eq tmp 'enc) '((r3 = 1) (break))) ; ENC
- ((eq tmp 'wsp) '((r3 = 2) (break))) ; WSP
- ((eq tmp 'cr) (if input-crlf
- '((r3 = 3) (break)) ; CR
- '((r3 = 1) (break)))) ; ENC
- ((eq tmp 'lf) (if input-crlf
- '((r3 = 1) (break)) ; ENC
- '((r3 = 3) (break)))) ; CRLF
- )))
- mel-ccl-256-table)))
- (branch
- r3
- ;; r0:r3=RAW
- (if (r6 < 75)
- ((r6 += 1)
- (r5 = 0)
- (r4 = 1)
- (write-read-repeat r0))
- (break))
- ;; r0:r3=ENC
- ((r5 = 0)
- (if (r6 < 73)
- ((r6 += 3)
- (write "=")
- (write r0 ,mel-ccl-high-table)
- (r4 = 2)
- (write-read-repeat r0 ,mel-ccl-low-table))
- (if (r6 > 73)
- ((r6 = 3)
- (write ,(if output-crlf "=\r\n=" "=\n="))
- (write r0 ,mel-ccl-high-table)
- (r4 = 3)
- (write-read-repeat r0 ,mel-ccl-low-table))
- (break))))
- ;; r0:r3=WSP
- ((r5 = 1)
- (if (r6 < 75)
- ((r6 += 1)
- (r4 = 4)
- (write-read-repeat r0))
- ((r6 = 1)
- (write ,(if output-crlf "=\r\n" "=\n"))
- (r4 = 5)
- (write-read-repeat r0))))
- ;; r0:r3=CR/CRLF
- ,(if input-crlf
- ;; r0:r3=CR
- `((if ((r6 > 73) & r5)
- ((r6 = 0)
- (r5 = 0)
- (write ,(if output-crlf "=\r\n" "=\n"))))
- (break))
- ;; r0:r3=CRLF
- `(if r5
- ;; WSP ; r0:r3=CRLF
- ((r5 = 0)
- (r6 = 0)
- (write ,(if output-crlf "=\r\n" "=\n"))
- ,@(if output-crlf '((write ?\r)) '())
- (r4 = 0)
- (write-read-repeat r0))
- ;; noWSP ; r0:r3=CRLF
- ((r5 = 0)
- (r6 = 0)
- ,@(if output-crlf '((write ?\r)) '())
- (r4 = 0)
- (write-read-repeat r0)))
- )))
- ;; r0:r3={RAW,ENC,CR}
- (loop
- ,(funcall
- (lambda (after-cr after-raw-enc)
- (if input-crlf
- `(if (r0 == ?\r)
- ,after-cr
- ,after-raw-enc)
- after-raw-enc))
- ;; r0=\r:r3=CR
- `((r4 = 6)
- (read r0)
- ;; CR:r3=CR r0
- (if (r0 == ?\n)
- ;; CR:r3=CR r0=LF
- (if r5
- ;; r5=WSP ; CR:r3=CR r0=LF
- ((r6 = 0)
- (r5 = 0)
- (write ,(if output-crlf "=\r\n\r\n" "=\n\n"))
- (r4 = 7)
- (read r0)
- (break))
- ;; r5=noWSP ; CR:r3=CR r0=LF
- ((r6 = 0)
- (r5 = 0)
- (write ,(if output-crlf "\r\n" "\n"))
- (r4 = 8)
- (read r0)
- (break)))
- ;; CR:r3=CR r0=noLF
- (if (r6 < 73)
- ((r6 += 3)
- (r5 = 0)
- (write "=0D")
- (break))
- (if (r6 == 73)
- (if (r0 == ?\r)
- ;; CR:r3=CR r0=CR
- ((r4 = 9)
- (read r0)
- ;; CR:r3=CR CR r0
- (if (r0 == ?\n)
- ;; CR:r3=CR CR LF
- ((r6 = 0)
- (r5 = 0)
- (write ,(if output-crlf "=0D\r\n" "=0D\n"))
- (r4 = 10)
- (read r0)
- (break))
- ;; CR:r3=CR CR noLF
- ((r6 = 6)
- (r5 = 0)
- (write ,(if output-crlf "=\r\n=0D=0D" "=\n=0D=0D"))
- (break))))
- ;; CR:r3=CR r0=noLFnorCR
- ((r6 = 3)
- (r5 = 0)
- (write ,(if output-crlf "=\r\n=0D" "=\n=0D"))
- (break)))
- ((r6 = 3)
- (r5 = 0)
- (write ,(if output-crlf "=\r\n=0D" "=\n=0D"))
- (break))))))
- (funcall
- (lambda (after-newline after-cr-nolf after-nonewline)
- (if input-crlf
- ;; r0:r3={RAW,ENC}
- `((r4 = 11)
- (read r1)
- ;; r0:r3={RAW,ENC} r1
- (if (r1 == ?\r)
- ;; r0:r3={RAW,ENC} r1=CR
- ((r4 = 12)
- (read r1)
- ;; r0:r3={RAW,ENC} CR r1
- (if (r1 == ?\n)
- ;; r0:r3=RAW CR r1=LF
- ,after-newline
- ;; r0:r3=RAW CR r1=noLF
- ,after-cr-nolf))
- ;; r0:r3={RAW,ENC} r1:noCR
- ,after-nonewline))
- ;; r0:r3={RAW,ENC}
- `((r4 = 11)
- (read r1)
- ;; r0:r3={RAW,ENC} r1
- (if (r1 == ?\n)
- ;; r0:r3={RAW,ENC} r1=CRLF
- ,after-newline
- ;; r0:r3={RAW,ENC} r1:noCRLF
- ,after-nonewline))))
- ;; r0:r3={RAW,ENC} CR r1=LF
- ;; r0:r3={RAW,ENC} r1=CRLF
- `((r6 = 0)
- (r5 = 0)
- (branch
- r3
- ;; r0:r3=RAW CR r1=LF
- ;; r0:r3=RAW r1=CRLF
- ((write r0)
- (write ,(if output-crlf "\r\n" "\n"))
- (r4 = 13)
- (read r0)
- (break))
- ;; r0:r3=ENC CR r1=LF
- ;; r0:r3=ENC r1=CRLF
- ((write ?=)
- (write r0 ,mel-ccl-high-table)
- (write r0 ,mel-ccl-low-table)
- (write ,(if output-crlf "\r\n" "\n"))
- (r4 = 14)
- (read r0)
- (break))))
- ;; r0:r3={RAW,ENC} CR r1=noLF
- `((branch
- r3
- ;; r0:r3=RAW CR r1:noLF
- ((r6 = 4)
- (r5 = 0)
- (write ,(if output-crlf "=\r\n" "=\n"))
- (write r0)
- (write "=0D")
- (r0 = r1)
- (break))
- ;; r0:r3=ENC CR r1:noLF
- ((r6 = 6)
- (r5 = 0)
- (write ,(if output-crlf "=\r\n=" "=\n="))
- (write r0 ,mel-ccl-high-table)
- (write r0 ,mel-ccl-low-table)
- (write "=0D")
- (r0 = r1)
- (break))))
- ;; r0:r3={RAW,ENC} r1:noCR
- ;; r0:r3={RAW,ENC} r1:noCRLF
- `((branch
- r3
- ;; r0:r3=RAW r1:noCR
- ;; r0:r3=RAW r1:noCRLF
- ((r6 = 1)
- (r5 = 0)
- (write ,(if output-crlf "=\r\n" "=\n"))
- (write r0)
- (r0 = r1)
- (break))
- ;; r0:r3=ENC r1:noCR
- ;; r0:r3=ENC r1:noCRLF
- ((r6 = 3)
- (r5 = 0)
- (write ,(if output-crlf "=\r\n=" "=\n="))
- (write r0 ,mel-ccl-high-table)
- (write r0 ,mel-ccl-low-table)
- (r0 = r1)
- (break)))))))
- (repeat)))
- ;; EOF
- ( ;(write "[EOF:") (write r4 ,mel-ccl-high-table) (write r4 ,mel-ccl-low-table) (write "]")
- (branch
- r4
- ;; 0: (start) ;
- (end)
- ;; 1: RAW ;
- (end)
- ;; 2: r0:r3=ENC ;
- (end)
- ;; 3: SOFTBREAK r0:r3=ENC ;
- (end)
- ;; 4: r0:r3=WSP ;
- ((write ,(if output-crlf "=\r\n" "=\n")) (end))
- ;; 5: SOFTBREAK r0:r3=WSP ;
- ((write ,(if output-crlf "=\r\n" "=\n")) (end))
- ;; 6: ; r0=\r:r3=CR
- (if (r6 <= 73)
- ((write "=0D") (end))
- ((write ,(if output-crlf "=\r\n=0D" "=\n=0D")) (end)))
- ;; 7: r5=WSP SOFTBREAK CR:r3=CR r0=LF ;
- (end)
- ;; 8: r5=noWSP CR:r3=CR r0=LF ;
- (end)
- ;; 9: (r6=73) ; CR:r3=CR r0=CR
- ((write ,(if output-crlf "=\r\n=0D=0D" "=\n=0D=0D")) (end))
- ;; 10: (r6=73) CR:r3=CR CR LF ;
- (end)
- ;; 11: ; r0:r3={RAW,ENC}
- (branch
- r3
- ((write r0) (end))
- ((write "=")
- (write r0 ,mel-ccl-high-table)
- (write r0 ,mel-ccl-low-table)
- (end)))
- ;; 12: ; r0:r3={RAW,ENC} r1=CR
- (branch
- r3
- ;; ; r0:r3=RAW r1=CR
- ((write ,(if output-crlf "=\r\n" "=\n"))
- (write r0)
- (write "=0D")
- (end))
- ;; ; r0:r3=ENC r1=CR
- ((write ,(if output-crlf "=\r\n=" "=\n="))
- (write r0 ,mel-ccl-high-table)
- (write r0 ,mel-ccl-low-table)
- (write "=0D")
- (end)))
- ;; 13: r0:r3=RAW CR LF ;
- ;; 13: r0:r3=RAW CRLF ;
- (end)
- ;; 14: r0:r3=ENC CR LF ;
- ;; 14: r0:r3=ENC CRLF ;
- (end)
- ;; 15: r6=0 ; "F"
- ((write "F") (end))
- ;; 16: r6=0 ; "Fr"
- ((write "Fr") (end))
- ;; 17: r6=0 ; "Fro"
- ((write "Fro") (end))
- ;; 18: r6=0 ; "From"
- ((write "From") (end))
- ;; 19: r6=0 "From " ;
- (end)
- ;; 20: r6=0 ; "."
- ((write ".") (end))
- ;; 21: r6=0 ; ".\r"
- ((write ".=0D") (end))
- ;; 22: r6=0 ; "."
- ((write ".") (end))
- ;; 23: r6=0 ".\r\n" ;
- (end)
- ))
- ))
-
-(defun mel-ccl-decode-quoted-printable-generic (input-crlf output-crlf)
- `(1
- ((read r0)
- (loop
- (branch
- r0
- ,@(mapcar
- (lambda (r0)
- (let ((tmp (aref mel-ccl-qp-table r0)))
- (cond
- ((eq tmp 'raw) `(write-read-repeat r0))
- ((eq tmp 'wsp) (if (eq r0 (char-int ? ))
- `(r1 = 1)
- `(r1 = 0)))
- ((eq tmp 'cr)
- (if input-crlf
- ;; r0='\r'
- `((read r0)
- ;; '\r' r0
- (if (r0 == ?\n)
- ;; '\r' r0='\n'
- ;; hard line break found.
- ,(if output-crlf
- '((write ?\r)
- (write-read-repeat r0))
- '(write-read-repeat r0))
- ;; '\r' r0:[^\n]
- ;; invalid control character (bare CR) found.
- ;; -> ignore it and rescan from r0.
- (repeat)))
- ;; r0='\r'
- ;; invalid character (bare CR) found.
- ;; -> ignore.
- `((read r0)
- (repeat))))
- ((eq tmp 'lf)
- (if input-crlf
- ;; r0='\n'
- ;; invalid character (bare LF) found.
- ;; -> ignore.
- `((read r0)
- (repeat))
- ;; r0='\r\n'
- ;; hard line break found.
- (if output-crlf
- '((write ?\r)
- (write-read-repeat r0))
- '(write-read-repeat r0))))
- ((eq r0 (char-int ?=))
- ;; r0='='
- `((read r0)
- ;; '=' r0
- (r1 = (r0 == ?\t))
- (if ((r0 == ? ) | r1)
- ;; '=' r0:[\t ]
- ;; Skip transport-padding.
- ;; It should check CR LF after
- ;; transport-padding.
- (loop
- (read-if (r0 == ?\t)
- (repeat)
- (if (r0 == ? )
- (repeat)
- (break)))))
- ;; '=' [\t ]* r0:[^\t ]
- (branch
- r0
- ,@(mapcar
- (lambda (r0)
- (cond
- ((eq r0 (char-int ?\r))
- (if input-crlf
- ;; '=' [\t ]* r0='\r'
- `((read r0)
- ;; '=' [\t ]* '\r' r0
- (if (r0 == ?\n)
- ;; '=' [\t ]* '\r' r0='\n'
- ;; soft line break found.
- ((read r0)
- (repeat))
- ;; '=' [\t ]* '\r' r0:[^\n]
- ;; invalid input ->
- ;; output "=" and rescan from r0.
- ((write "=")
- (repeat))))
- ;; '=' [\t ]* r0='\r'
- ;; invalid input (bare CR found) ->
- ;; output "=" and rescan from next.
- `((write ?=)
- (read r0)
- (repeat))))
- ((eq r0 (char-int ?\n))
- (if input-crlf
- ;; '=' [\t ]* r0='\n'
- ;; invalid input (bare LF found) ->
- ;; output "=" and rescan from next.
- `((write ?=)
- (read r0)
- (repeat))
- ;; '=' [\t ]* r0='\r\n'
- ;; soft line break found.
- `((read r0)
- (repeat))))
- ((setq tmp (nth r0 mel-ccl-256-to-16-table))
- ;; '=' [\t ]* r0:[0-9A-F]
- ;; upper nibble of hexadecimal digit found.
- `((r1 = r0)
- (r0 = ,tmp)))
- (t
- ;; '=' [\t ]* r0:[^\r0-9A-F]
- ;; invalid input ->
- ;; output "=" and rescan from r0.
- `((write ?=)
- (repeat)))))
- mel-ccl-256-table))
- ;; '=' [\t ]* r1:r0:[0-9A-F]
- (read-branch
- r2
- ,@(mapcar
- (lambda (r2)
- (if (setq tmp (nth r2 mel-ccl-256-to-16-table))
- ;; '=' [\t ]* r1:r0:[0-9A-F] r2:[0-9A-F]
- `(write-read-repeat
- r0
- ,(vconcat
- (mapcar
- (lambda (r0)
- (logior (lsh r0 4) tmp))
- mel-ccl-16-table)))
- ;; '=' [\t ]* r1:r0:[0-9A-F] r2:[^0-9A-F]
- ;; invalid input
- `(r3 = 0) ; nop
- ))
- mel-ccl-256-table))
- ;; '=' [\t ]* r1:r0:[0-9A-F] r2:[^0-9A-F]
- ;; invalid input ->
- ;; output "=" with hex digit and rescan from r2.
- (write ?=)
- (r0 = r2)
- (write-repeat r1)))
- (t
- ;; r0:[^\t\r -~]
- ;; invalid character found.
- ;; -> ignore.
- `((read r0)
- (repeat))))))
- mel-ccl-256-table))
- ;; r1[0]:[\t ]
- (loop
- ,@(apply
- 'append
- (mapcar
- (lambda (regnum)
- (let ((reg (aref [r1 r2 r3 r4 r5] regnum)))
- (apply
- 'append
- (mapcar
- (lambda (bit)
- (if (= bit 0)
- (if (= regnum 0)
- nil
- `((read r0)
- (if (r0 == ?\t)
- (,reg = 0)
- (if (r0 == ?\ )
- (,reg = 1)
- ((r6 = ,(+ (* regnum 28) bit))
- (break))))))
- `((read r0)
- (if (r0 == ?\ )
- (,reg |= ,(lsh 1 bit))
- (if (r0 != ?\t)
- ((r6 = ,(+ (* regnum 28) bit))
- (break)))))))
- mel-ccl-28-table))))
- '(0 1 2 3 4)))
- ;; white space buffer exhaust.
- ;; error: line length limit (76bytes) violation.
- ;; -> ignore these white spaces.
- (repeat))
- ,(if input-crlf
- `(if (r0 == ?\r)
- ((read r0)
- (if (r0 == ?\n)
- ;; trailing white spaces found.
- ;; -> ignore these white spacs.
- ((write ,(if output-crlf "\r\n" "\n"))
- (read r0)
- (repeat))
- ;; [\t ]* \r r0:[^\n]
- ;; error: bare CR found.
- ;; -> output white spaces and ignore bare CR.
- ))
- ;; [\t ]* r0:[^\r]
- ;; middle white spaces found.
- )
- `(if (r0 == ?\n)
- ;; trailing white spaces found.
- ;; -> ignore these white spacs.
- ((write ,(if output-crlf "\r\n" "\n"))
- (read r0)
- (repeat))
- ;; [\t ]* r0:[^\n]
- ;; middle white spaces found.
- ))
- ,@(apply
- 'append
- (mapcar
- (lambda (regnum)
- (let ((reg (aref [r1 r2 r3 r4 r5] regnum)))
- (apply
- 'append
- (mapcar
- (lambda (bit)
- `((if (,reg & ,(lsh 1 bit))
- (write ?\ )
- (write ?\t))
- (if (r6 == ,(+ (* regnum 28) bit 1))
- (repeat))))
- mel-ccl-28-table))))
- '(0 1 2 3 4)))
- (repeat)
- ))))
-
-)
-
-(define-ccl-program mel-ccl-encode-quoted-printable-crlf-crlf
- (mel-ccl-encode-quoted-printable-generic t t))
-
-(define-ccl-program mel-ccl-encode-quoted-printable-crlf-lf
- (mel-ccl-encode-quoted-printable-generic t nil))
-
-(define-ccl-program mel-ccl-encode-quoted-printable-lf-crlf
- (mel-ccl-encode-quoted-printable-generic nil t))
-
-(define-ccl-program mel-ccl-encode-quoted-printable-lf-lf
- (mel-ccl-encode-quoted-printable-generic nil nil))
-
-(define-ccl-program mel-ccl-decode-quoted-printable-crlf-crlf
- (mel-ccl-decode-quoted-printable-generic t t))
-
-(define-ccl-program mel-ccl-decode-quoted-printable-crlf-lf
- (mel-ccl-decode-quoted-printable-generic t nil))
-
-(define-ccl-program mel-ccl-decode-quoted-printable-lf-crlf
- (mel-ccl-decode-quoted-printable-generic nil t))
-
-(define-ccl-program mel-ccl-decode-quoted-printable-lf-lf
- (mel-ccl-decode-quoted-printable-generic nil nil))
-
-
-;;; @ coding system
-;;;
-
-(make-ccl-coding-system
- 'mel-ccl-uq-rev ?Q "MIME Q-encoding in unstructured field (reversed)"
- 'mel-ccl-encode-uq 'mel-ccl-decode-q)
-
-(make-ccl-coding-system
- 'mel-ccl-cq-rev ?Q "MIME Q-encoding in comment (reversed)"
- 'mel-ccl-encode-cq 'mel-ccl-decode-q)
-
-(make-ccl-coding-system
- 'mel-ccl-pq-rev ?Q "MIME Q-encoding in phrase (reversed)"
- 'mel-ccl-encode-pq 'mel-ccl-decode-q)
-
-(make-ccl-coding-system
- 'mel-ccl-b-rev ?B "MIME B-encoding (reversed)"
- 'mel-ccl-encode-b 'mel-ccl-decode-b)
-
-(make-ccl-coding-system
- 'mel-ccl-quoted-printable-crlf-crlf-rev
- ?Q "MIME Quoted-Printable-encoding (reversed)"
- 'mel-ccl-encode-quoted-printable-crlf-crlf
- 'mel-ccl-decode-quoted-printable-crlf-crlf)
-
-(make-ccl-coding-system
- 'mel-ccl-quoted-printable-lf-crlf-rev
- ?Q "MIME Quoted-Printable-encoding (LF encoding) (reversed)"
- 'mel-ccl-encode-quoted-printable-crlf-lf
- 'mel-ccl-decode-quoted-printable-lf-crlf)
-
-(make-ccl-coding-system
- 'mel-ccl-quoted-printable-crlf-lf-rev
- ?Q "MIME Quoted-Printable-encoding (LF internal) (reversed)"
- 'mel-ccl-encode-quoted-printable-lf-crlf
- 'mel-ccl-decode-quoted-printable-crlf-lf)
-
-(make-ccl-coding-system
- 'mel-ccl-quoted-printable-lf-lf-rev
- ?Q "MIME Quoted-Printable-encoding (LF encoding) (LF internal) (reversed)"
- 'mel-ccl-encode-quoted-printable-lf-lf
- 'mel-ccl-decode-quoted-printable-lf-lf)
-
-(make-ccl-coding-system
- 'mel-ccl-base64-crlf-rev
- ?B "MIME Base64-encoding (reversed)"
- 'mel-ccl-encode-base64-crlf-crlf
- 'mel-ccl-decode-b)
-
-(make-ccl-coding-system
- 'mel-ccl-base64-lf-rev
- ?B "MIME Base64-encoding (LF encoding) (reversed)"
- 'mel-ccl-encode-base64-crlf-lf
- 'mel-ccl-decode-b)
-
-
-;;; @ B
-;;;
-
-(unless-broken ccl-execute-eof-block-on-decoding-some
-
- (defun base64-ccl-encode-string (string)
- "Encode STRING with base64 encoding."
- (decode-coding-string string 'mel-ccl-base64-lf-rev))
-
- (defun base64-ccl-encode-region (start end)
- "Encode region from START to END with base64 encoding."
- (interactive "r")
- (decode-coding-region start end 'mel-ccl-base64-lf-rev))
-
- (defun base64-ccl-insert-encoded-file (filename)
- "Encode contents of file FILENAME to base64, and insert the result."
- (interactive (list (read-file-name "Insert encoded file: ")))
- (let ((coding-system-for-read 'mel-ccl-base64-lf-rev))
- (insert-file-contents filename)))
-
- (mel-define-method-function (mime-encode-string string (nil "base64"))
- 'base64-ccl-encode-string)
- (mel-define-method-function (mime-encode-region start end (nil "base64"))
- 'base64-ccl-encode-region)
- (mel-define-method-function
- (mime-insert-encoded-file filename (nil "base64"))
- 'base64-ccl-insert-encoded-file)
-
- (mel-define-method-function (encoded-text-encode-string string (nil "B"))
- 'base64-ccl-encode-string)
- )
-
-(defun base64-ccl-decode-string (string)
- "Decode base64 encoded STRING"
- (encode-coding-string string 'mel-ccl-b-rev))
-
-(defun base64-ccl-decode-region (start end)
- "Decode base64 encoded the region from START to END."
- (interactive "r")
- (encode-coding-region start end 'mel-ccl-b-rev))
-
-(defun base64-ccl-write-decoded-region (start end filename)
- "Decode the region from START to END and write out to FILENAME."
- (interactive
- (list (region-beginning) (region-end)
- (read-file-name "Write decoded region to file: ")))
- (let ((coding-system-for-write 'mel-ccl-b-rev)
- jka-compr-compression-info-list)
- (write-region start end filename)))
-
-(mel-define-method-function (mime-decode-string string (nil "base64"))
- 'base64-ccl-decode-string)
-(mel-define-method-function (mime-decode-region start end (nil "base64"))
- 'base64-ccl-decode-region)
-(mel-define-method-function
- (mime-write-decoded-region start end filename (nil "base64"))
- 'base64-ccl-write-decoded-region)
-
-(mel-define-method encoded-text-decode-string (string (nil "B"))
- (if (and (string-match B-encoded-text-regexp string)
- (string= string (match-string 0 string)))
- (base64-ccl-decode-string string)
- (error "Invalid encoded-text %s" string)))
-
-
-;;; @ quoted-printable
-;;;
-
-(unless-broken ccl-execute-eof-block-on-decoding-some
-
- (defun quoted-printable-ccl-encode-string (string)
- "Encode STRING with quoted-printable encoding."
- (decode-coding-string
- string
- 'mel-ccl-quoted-printable-lf-lf-rev))
-
- (defun quoted-printable-ccl-encode-region (start end)
- "Encode the region from START to END with quoted-printable encoding."
- (interactive "r")
- (decode-coding-region start end 'mel-ccl-quoted-printable-lf-lf-rev))
-
- (defun quoted-printable-ccl-insert-encoded-file (filename)
- "Encode contents of the file named as FILENAME, and insert it."
- (interactive (list (read-file-name "Insert encoded file: ")))
- (let ((coding-system-for-read 'mel-ccl-quoted-printable-lf-lf-rev))
- (insert-file-contents filename)))
-
- (mel-define-method-function
- (mime-encode-string string (nil "quoted-printable"))
- 'quoted-printable-ccl-encode-string)
- (mel-define-method-function
- (mime-encode-region start end (nil "quoted-printable"))
- 'quoted-printable-ccl-encode-region)
- (mel-define-method-function
- (mime-insert-encoded-file filename (nil "quoted-printable"))
- 'quoted-printable-ccl-insert-encoded-file)
- )
-
-(defun quoted-printable-ccl-decode-string (string)
- "Decode quoted-printable encoded STRING."
- (encode-coding-string
- string
- 'mel-ccl-quoted-printable-lf-lf-rev))
-
-(defun quoted-printable-ccl-decode-region (start end)
- "Decode the region from START to END with quoted-printable
-encoding."
- (interactive "r")
- (encode-coding-region start end 'mel-ccl-quoted-printable-lf-lf-rev))
-
-(defun quoted-printable-ccl-write-decoded-region
- (start end filename)
- "Decode quoted-printable encoded current region and write out to FILENAME."
- (interactive
- (list (region-beginning) (region-end)
- (read-file-name "Write decoded region to file: ")))
- (let ((coding-system-for-write 'mel-ccl-quoted-printable-lf-lf-rev))
- (write-region start end filename)))
-
-(mel-define-method-function
- (mime-decode-string string (nil "quoted-printable"))
- 'quoted-printable-ccl-decode-string)
-(mel-define-method-function
- (mime-decode-region start end (nil "quoted-printable"))
- 'quoted-printable-ccl-decode-region)
-(mel-define-method-function
- (mime-write-decoded-region start end filename (nil "quoted-printable"))
- 'quoted-printable-ccl-write-decoded-region)
-
-
-;;; @ Q
-;;;
-
-(defun q-encoding-ccl-encode-string (string &optional mode)
- "Encode STRING to Q-encoding of encoded-word, and return the result.
-MODE allows `text', `comment', `phrase' or nil. Default value is
-`phrase'."
- (decode-coding-string
- string
- (cond
- ((eq mode 'text) 'mel-ccl-uq-rev)
- ((eq mode 'comment) 'mel-ccl-cq-rev)
- (t 'mel-ccl-pq-rev))))
-
-(defun q-encoding-ccl-decode-string (string)
- "Decode Q encoded STRING and return the result."
- (encode-coding-string
- string
- 'mel-ccl-uq-rev))
-
-(unless (featurep 'xemacs)
- (defun q-encoding-ccl-encoded-length (string &optional mode)
- (let ((status [nil nil nil nil nil nil nil nil nil]))
- (fillarray status nil)
- (ccl-execute-on-string
- (cond
- ((eq mode 'text) 'mel-ccl-count-uq)
- ((eq mode 'comment) 'mel-ccl-count-cq)
- (t 'mel-ccl-count-pq))
- status
- string)
- (aref status 0)))
- )
-
-(mel-define-method-function (encoded-text-encode-string string (nil "Q"))
- 'q-encoding-ccl-encode-string)
-
-(mel-define-method encoded-text-decode-string (string (nil "Q"))
- (if (and (string-match Q-encoded-text-regexp string)
- (string= string (match-string 0 string)))
- (q-encoding-ccl-decode-string string)
- (error "Invalid encoded-text %s" string)))
-
-
-;;; @ end
-;;;
-
-(provide 'mel-ccl)
-
-;;; mel-ccl.el ends here
--- /dev/null
+;;; mel-ccl.el: CCL based encoder/decoder of Quoted-Printable
+;;; and Q-encoding
+
+;; Copyright (C) 1998 Tanaka Akira
+
+;; Author: Tanaka Akira <akr@jaist.ac.jp>
+;; Created: 1998/9/17
+;; Keywords: MIME, Quoted-Printable, Q-encoding
+
+;; This file is part of FLIM (Faithful Library about Internet Message).
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or (at
+;; your option) any later version.
+
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Code:
+
+(require 'ccl)
+(require 'pccl)
+(require 'mime-def)
+
+
+;;; @ constants
+;;;
+
+(eval-when-compile
+
+(defconst mel-ccl-16-table
+ '( 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15))
+
+(defconst mel-ccl-28-table
+ '( 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
+ 16 17 18 19 20 21 22 23 24 25 26 27))
+
+(defconst mel-ccl-256-table
+ '( 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
+ 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31
+ 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47
+ 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63
+ 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79
+ 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95
+ 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111
+ 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127
+ 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143
+ 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159
+ 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175
+ 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191
+ 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207
+ 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223
+ 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239
+ 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255))
+
+(defconst mel-ccl-256-to-16-table
+ '(nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
+ nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
+ nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
+ 0 1 2 3 4 5 6 7 8 9 nil nil nil nil nil nil
+ nil 10 11 12 13 14 15 nil nil nil nil nil nil nil nil nil
+ nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
+ nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
+ nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
+ nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
+ nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
+ nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
+ nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
+ nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
+ nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
+ nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
+ nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil))
+
+(defconst mel-ccl-16-to-256-table
+ (mapcar 'char-int "0123456789ABCDEF"))
+
+(defconst mel-ccl-high-table
+ (vconcat
+ (mapcar
+ (lambda (v) (nth (lsh v -4) mel-ccl-16-to-256-table))
+ mel-ccl-256-table)))
+
+(defconst mel-ccl-low-table
+ (vconcat
+ (mapcar
+ (lambda (v) (nth (logand v 15) mel-ccl-16-to-256-table))
+ mel-ccl-256-table)))
+
+(defconst mel-ccl-u-raw
+ (mapcar
+ 'char-int
+ "0123456789\
+ABCDEFGHIJKLMNOPQRSTUVWXYZ\
+abcdefghijklmnopqrstuvwxyz\
+!@#$%&'()*+,-./:;<>@[\\]^`{|}~"))
+
+(defconst mel-ccl-c-raw
+ (mapcar
+ 'char-int
+ "0123456789\
+ABCDEFGHIJKLMNOPQRSTUVWXYZ\
+abcdefghijklmnopqrstuvwxyz\
+!@#$%&'*+,-./:;<>@[]^`{|}~"))
+
+(defconst mel-ccl-p-raw
+ (mapcar
+ 'char-int
+ "0123456789\
+ABCDEFGHIJKLMNOPQRSTUVWXYZ\
+abcdefghijklmnopqrstuvwxyz\
+!*+-/"))
+
+(defconst mel-ccl-qp-table
+ [enc enc enc enc enc enc enc enc enc wsp lf enc enc cr enc enc
+ enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc
+ wsp raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw
+ raw raw raw raw raw raw raw raw raw raw raw raw raw enc raw raw
+ raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw
+ raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw
+ raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw
+ raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw enc
+ enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc
+ enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc
+ enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc
+ enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc
+ enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc
+ enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc
+ enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc
+ enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc])
+
+)
+
+
+;;; @ CCL programs
+;;;
+
+;;; Q
+
+(define-ccl-program mel-ccl-decode-q
+ `(1
+ ((loop
+ (read-branch
+ r0
+ ,@(mapcar
+ (lambda (r0)
+ (cond
+ ((= r0 (char-int ?_))
+ `(write-repeat ? ))
+ ((= r0 (char-int ?=))
+ `((loop
+ (read-branch
+ r1
+ ,@(mapcar
+ (lambda (v)
+ (if (integerp v)
+ `((r0 = ,v) (break))
+ '(repeat)))
+ mel-ccl-256-to-16-table)))
+ (loop
+ (read-branch
+ r1
+ ,@(mapcar
+ (lambda (v)
+ (if (integerp v)
+ `((write r0 ,(vconcat
+ (mapcar
+ (lambda (r0)
+ (logior (lsh r0 4) v))
+ mel-ccl-16-table)))
+ (break))
+ '(repeat)))
+ mel-ccl-256-to-16-table)))
+ (repeat)))
+ (t
+ `(write-repeat ,r0))))
+ mel-ccl-256-table))))))
+
+(eval-when-compile
+
+(defun mel-ccl-encode-q-generic (raw)
+ `(3
+ (loop
+ (loop
+ (read-branch
+ r0
+ ,@(mapcar
+ (lambda (r0)
+ (cond
+ ((= r0 32) `(write-repeat ?_))
+ ((member r0 raw) `(write-repeat ,r0))
+ (t '(break))))
+ mel-ccl-256-table)))
+ (write ?=)
+ (write r0 ,mel-ccl-high-table)
+ (write r0 ,mel-ccl-low-table)
+ (repeat))))
+
+;; On xemacs, generated program counts iso-8859-1 8bit character as 6bytes.
+(defun mel-ccl-count-q-length (raw)
+ `(0
+ ((r0 = 0)
+ (loop
+ (read-branch
+ r1
+ ,@(mapcar
+ (lambda (r1)
+ (if (or (= r1 32) (member r1 raw))
+ '((r0 += 1) (repeat))
+ '((r0 += 3) (repeat))))
+ mel-ccl-256-table))))))
+
+)
+
+(define-ccl-program mel-ccl-encode-uq
+ (mel-ccl-encode-q-generic mel-ccl-u-raw))
+(define-ccl-program mel-ccl-encode-cq
+ (mel-ccl-encode-q-generic mel-ccl-c-raw))
+(define-ccl-program mel-ccl-encode-pq
+ (mel-ccl-encode-q-generic mel-ccl-p-raw))
+
+(define-ccl-program mel-ccl-count-uq
+ (mel-ccl-count-q-length mel-ccl-u-raw))
+(define-ccl-program mel-ccl-count-cq
+ (mel-ccl-count-q-length mel-ccl-c-raw))
+(define-ccl-program mel-ccl-count-pq
+ (mel-ccl-count-q-length mel-ccl-p-raw))
+
+;; Quoted-Printable
+
+(eval-when-compile
+
+(defun mel-ccl-try-to-read-crlf (input-crlf reg eof-reg cr-eof lf-eof crlf-eof succ fail-cr fail-lf fail-crlf)
+ (if input-crlf
+ `((,eof-reg = ,cr-eof) (read-if (,reg == ?\r)
+ ((,eof-reg = ,lf-eof) (read-if (,reg == ?\n)
+ ,succ
+ ,fail-lf))
+ ,fail-cr))
+ `((,eof-reg = ,crlf-eof) (read-if (,reg == ?\n)
+ ,succ
+ ,fail-crlf))))
+
+;; Generated CCL program works not properly on 20.2 because CCL_EOF_BLOCK
+;; is not executed.
+(defun mel-ccl-encode-quoted-printable-generic (input-crlf output-crlf)
+ `(4
+ ((r6 = 0) ; column
+ (r5 = 0) ; previous character is white space
+ (r4 = 0)
+ (read r0)
+ (loop ; r6 <= 75
+ (loop
+ (loop
+ (branch
+ r0
+ ,@(mapcar
+ (lambda (r0)
+ (let ((tmp (aref mel-ccl-qp-table r0)))
+ (cond
+ ((eq r0 (char-int ?F))
+ `(if (r6 == 0)
+ ((r4 = 15) (read-if (r0 == ?r)
+ ((r4 = 16) (read-if (r0 == ?o)
+ ((r4 = 17) (read-if (r0 == ?m)
+ ((r4 = 18) (read-if (r0 == ? )
+ ((r6 = 7)
+ (r5 = 1)
+ (write "=46rom ")
+ (r4 = 19)
+ (read r0)
+ (repeat))
+ ((r6 = 4)
+ (write-repeat "From"))))
+ ((r6 = 3)
+ (write-repeat "Fro"))))
+ ((r6 = 2)
+ (write-repeat "Fr"))))
+ ((r6 = 1)
+ (write-repeat "F"))))
+ ((r3 = 0) (break)) ; RAW
+ ))
+ ((eq r0 (char-int ?.))
+ `(if (r6 == 0)
+ ,(mel-ccl-try-to-read-crlf
+ input-crlf
+ 'r0 'r4 20 21 22
+ `((write ,(if output-crlf "=2E\r\n" "=2E\n"))
+ (r4 = 23)
+ (read r0)
+ (repeat))
+ '((r6 = 1)
+ (write-repeat "."))
+ '((r6 = 4)
+ (write-repeat ".=0D"))
+ '((r6 = 1)
+ (write-repeat ".")))
+ ((r3 = 0) (break)) ; RAW
+ ))
+ ((eq tmp 'raw) '((r3 = 0) (break))) ; RAW
+ ((eq tmp 'enc) '((r3 = 1) (break))) ; ENC
+ ((eq tmp 'wsp) '((r3 = 2) (break))) ; WSP
+ ((eq tmp 'cr) (if input-crlf
+ '((r3 = 3) (break)) ; CR
+ '((r3 = 1) (break)))) ; ENC
+ ((eq tmp 'lf) (if input-crlf
+ '((r3 = 1) (break)) ; ENC
+ '((r3 = 3) (break)))) ; CRLF
+ )))
+ mel-ccl-256-table)))
+ (branch
+ r3
+ ;; r0:r3=RAW
+ (if (r6 < 75)
+ ((r6 += 1)
+ (r5 = 0)
+ (r4 = 1)
+ (write-read-repeat r0))
+ (break))
+ ;; r0:r3=ENC
+ ((r5 = 0)
+ (if (r6 < 73)
+ ((r6 += 3)
+ (write "=")
+ (write r0 ,mel-ccl-high-table)
+ (r4 = 2)
+ (write-read-repeat r0 ,mel-ccl-low-table))
+ (if (r6 > 73)
+ ((r6 = 3)
+ (write ,(if output-crlf "=\r\n=" "=\n="))
+ (write r0 ,mel-ccl-high-table)
+ (r4 = 3)
+ (write-read-repeat r0 ,mel-ccl-low-table))
+ (break))))
+ ;; r0:r3=WSP
+ ((r5 = 1)
+ (if (r6 < 75)
+ ((r6 += 1)
+ (r4 = 4)
+ (write-read-repeat r0))
+ ((r6 = 1)
+ (write ,(if output-crlf "=\r\n" "=\n"))
+ (r4 = 5)
+ (write-read-repeat r0))))
+ ;; r0:r3=CR/CRLF
+ ,(if input-crlf
+ ;; r0:r3=CR
+ `((if ((r6 > 73) & r5)
+ ((r6 = 0)
+ (r5 = 0)
+ (write ,(if output-crlf "=\r\n" "=\n"))))
+ (break))
+ ;; r0:r3=CRLF
+ `(if r5
+ ;; WSP ; r0:r3=CRLF
+ ((r5 = 0)
+ (r6 = 0)
+ (write ,(if output-crlf "=\r\n" "=\n"))
+ ,@(if output-crlf '((write ?\r)) '())
+ (r4 = 0)
+ (write-read-repeat r0))
+ ;; noWSP ; r0:r3=CRLF
+ ((r5 = 0)
+ (r6 = 0)
+ ,@(if output-crlf '((write ?\r)) '())
+ (r4 = 0)
+ (write-read-repeat r0)))
+ )))
+ ;; r0:r3={RAW,ENC,CR}
+ (loop
+ ,(funcall
+ (lambda (after-cr after-raw-enc)
+ (if input-crlf
+ `(if (r0 == ?\r)
+ ,after-cr
+ ,after-raw-enc)
+ after-raw-enc))
+ ;; r0=\r:r3=CR
+ `((r4 = 6)
+ (read r0)
+ ;; CR:r3=CR r0
+ (if (r0 == ?\n)
+ ;; CR:r3=CR r0=LF
+ (if r5
+ ;; r5=WSP ; CR:r3=CR r0=LF
+ ((r6 = 0)
+ (r5 = 0)
+ (write ,(if output-crlf "=\r\n\r\n" "=\n\n"))
+ (r4 = 7)
+ (read r0)
+ (break))
+ ;; r5=noWSP ; CR:r3=CR r0=LF
+ ((r6 = 0)
+ (r5 = 0)
+ (write ,(if output-crlf "\r\n" "\n"))
+ (r4 = 8)
+ (read r0)
+ (break)))
+ ;; CR:r3=CR r0=noLF
+ (if (r6 < 73)
+ ((r6 += 3)
+ (r5 = 0)
+ (write "=0D")
+ (break))
+ (if (r6 == 73)
+ (if (r0 == ?\r)
+ ;; CR:r3=CR r0=CR
+ ((r4 = 9)
+ (read r0)
+ ;; CR:r3=CR CR r0
+ (if (r0 == ?\n)
+ ;; CR:r3=CR CR LF
+ ((r6 = 0)
+ (r5 = 0)
+ (write ,(if output-crlf "=0D\r\n" "=0D\n"))
+ (r4 = 10)
+ (read r0)
+ (break))
+ ;; CR:r3=CR CR noLF
+ ((r6 = 6)
+ (r5 = 0)
+ (write ,(if output-crlf "=\r\n=0D=0D" "=\n=0D=0D"))
+ (break))))
+ ;; CR:r3=CR r0=noLFnorCR
+ ((r6 = 3)
+ (r5 = 0)
+ (write ,(if output-crlf "=\r\n=0D" "=\n=0D"))
+ (break)))
+ ((r6 = 3)
+ (r5 = 0)
+ (write ,(if output-crlf "=\r\n=0D" "=\n=0D"))
+ (break))))))
+ (funcall
+ (lambda (after-newline after-cr-nolf after-nonewline)
+ (if input-crlf
+ ;; r0:r3={RAW,ENC}
+ `((r4 = 11)
+ (read r1)
+ ;; r0:r3={RAW,ENC} r1
+ (if (r1 == ?\r)
+ ;; r0:r3={RAW,ENC} r1=CR
+ ((r4 = 12)
+ (read r1)
+ ;; r0:r3={RAW,ENC} CR r1
+ (if (r1 == ?\n)
+ ;; r0:r3=RAW CR r1=LF
+ ,after-newline
+ ;; r0:r3=RAW CR r1=noLF
+ ,after-cr-nolf))
+ ;; r0:r3={RAW,ENC} r1:noCR
+ ,after-nonewline))
+ ;; r0:r3={RAW,ENC}
+ `((r4 = 11)
+ (read r1)
+ ;; r0:r3={RAW,ENC} r1
+ (if (r1 == ?\n)
+ ;; r0:r3={RAW,ENC} r1=CRLF
+ ,after-newline
+ ;; r0:r3={RAW,ENC} r1:noCRLF
+ ,after-nonewline))))
+ ;; r0:r3={RAW,ENC} CR r1=LF
+ ;; r0:r3={RAW,ENC} r1=CRLF
+ `((r6 = 0)
+ (r5 = 0)
+ (branch
+ r3
+ ;; r0:r3=RAW CR r1=LF
+ ;; r0:r3=RAW r1=CRLF
+ ((write r0)
+ (write ,(if output-crlf "\r\n" "\n"))
+ (r4 = 13)
+ (read r0)
+ (break))
+ ;; r0:r3=ENC CR r1=LF
+ ;; r0:r3=ENC r1=CRLF
+ ((write ?=)
+ (write r0 ,mel-ccl-high-table)
+ (write r0 ,mel-ccl-low-table)
+ (write ,(if output-crlf "\r\n" "\n"))
+ (r4 = 14)
+ (read r0)
+ (break))))
+ ;; r0:r3={RAW,ENC} CR r1=noLF
+ `((branch
+ r3
+ ;; r0:r3=RAW CR r1:noLF
+ ((r6 = 4)
+ (r5 = 0)
+ (write ,(if output-crlf "=\r\n" "=\n"))
+ (write r0)
+ (write "=0D")
+ (r0 = r1)
+ (break))
+ ;; r0:r3=ENC CR r1:noLF
+ ((r6 = 6)
+ (r5 = 0)
+ (write ,(if output-crlf "=\r\n=" "=\n="))
+ (write r0 ,mel-ccl-high-table)
+ (write r0 ,mel-ccl-low-table)
+ (write "=0D")
+ (r0 = r1)
+ (break))))
+ ;; r0:r3={RAW,ENC} r1:noCR
+ ;; r0:r3={RAW,ENC} r1:noCRLF
+ `((branch
+ r3
+ ;; r0:r3=RAW r1:noCR
+ ;; r0:r3=RAW r1:noCRLF
+ ((r6 = 1)
+ (r5 = 0)
+ (write ,(if output-crlf "=\r\n" "=\n"))
+ (write r0)
+ (r0 = r1)
+ (break))
+ ;; r0:r3=ENC r1:noCR
+ ;; r0:r3=ENC r1:noCRLF
+ ((r6 = 3)
+ (r5 = 0)
+ (write ,(if output-crlf "=\r\n=" "=\n="))
+ (write r0 ,mel-ccl-high-table)
+ (write r0 ,mel-ccl-low-table)
+ (r0 = r1)
+ (break)))))))
+ (repeat)))
+ ;; EOF
+ ( ;(write "[EOF:") (write r4 ,mel-ccl-high-table) (write r4 ,mel-ccl-low-table) (write "]")
+ (branch
+ r4
+ ;; 0: (start) ;
+ (end)
+ ;; 1: RAW ;
+ (end)
+ ;; 2: r0:r3=ENC ;
+ (end)
+ ;; 3: SOFTBREAK r0:r3=ENC ;
+ (end)
+ ;; 4: r0:r3=WSP ;
+ ((write ,(if output-crlf "=\r\n" "=\n")) (end))
+ ;; 5: SOFTBREAK r0:r3=WSP ;
+ ((write ,(if output-crlf "=\r\n" "=\n")) (end))
+ ;; 6: ; r0=\r:r3=CR
+ (if (r6 <= 73)
+ ((write "=0D") (end))
+ ((write ,(if output-crlf "=\r\n=0D" "=\n=0D")) (end)))
+ ;; 7: r5=WSP SOFTBREAK CR:r3=CR r0=LF ;
+ (end)
+ ;; 8: r5=noWSP CR:r3=CR r0=LF ;
+ (end)
+ ;; 9: (r6=73) ; CR:r3=CR r0=CR
+ ((write ,(if output-crlf "=\r\n=0D=0D" "=\n=0D=0D")) (end))
+ ;; 10: (r6=73) CR:r3=CR CR LF ;
+ (end)
+ ;; 11: ; r0:r3={RAW,ENC}
+ (branch
+ r3
+ ((write r0) (end))
+ ((write "=")
+ (write r0 ,mel-ccl-high-table)
+ (write r0 ,mel-ccl-low-table)
+ (end)))
+ ;; 12: ; r0:r3={RAW,ENC} r1=CR
+ (branch
+ r3
+ ;; ; r0:r3=RAW r1=CR
+ ((write ,(if output-crlf "=\r\n" "=\n"))
+ (write r0)
+ (write "=0D")
+ (end))
+ ;; ; r0:r3=ENC r1=CR
+ ((write ,(if output-crlf "=\r\n=" "=\n="))
+ (write r0 ,mel-ccl-high-table)
+ (write r0 ,mel-ccl-low-table)
+ (write "=0D")
+ (end)))
+ ;; 13: r0:r3=RAW CR LF ;
+ ;; 13: r0:r3=RAW CRLF ;
+ (end)
+ ;; 14: r0:r3=ENC CR LF ;
+ ;; 14: r0:r3=ENC CRLF ;
+ (end)
+ ;; 15: r6=0 ; "F"
+ ((write "F") (end))
+ ;; 16: r6=0 ; "Fr"
+ ((write "Fr") (end))
+ ;; 17: r6=0 ; "Fro"
+ ((write "Fro") (end))
+ ;; 18: r6=0 ; "From"
+ ((write "From") (end))
+ ;; 19: r6=0 "From " ;
+ (end)
+ ;; 20: r6=0 ; "."
+ ((write ".") (end))
+ ;; 21: r6=0 ; ".\r"
+ ((write ".=0D") (end))
+ ;; 22: r6=0 ; "."
+ ((write ".") (end))
+ ;; 23: r6=0 ".\r\n" ;
+ (end)
+ ))
+ ))
+
+(defun mel-ccl-decode-quoted-printable-generic (input-crlf output-crlf)
+ `(1
+ ((read r0)
+ (loop
+ (branch
+ r0
+ ,@(mapcar
+ (lambda (r0)
+ (let ((tmp (aref mel-ccl-qp-table r0)))
+ (cond
+ ((eq tmp 'raw) `(write-read-repeat r0))
+ ((eq tmp 'wsp) (if (eq r0 (char-int ? ))
+ `(r1 = 1)
+ `(r1 = 0)))
+ ((eq tmp 'cr)
+ (if input-crlf
+ ;; r0='\r'
+ `((read r0)
+ ;; '\r' r0
+ (if (r0 == ?\n)
+ ;; '\r' r0='\n'
+ ;; hard line break found.
+ ,(if output-crlf
+ '((write ?\r)
+ (write-read-repeat r0))
+ '(write-read-repeat r0))
+ ;; '\r' r0:[^\n]
+ ;; invalid control character (bare CR) found.
+ ;; -> ignore it and rescan from r0.
+ (repeat)))
+ ;; r0='\r'
+ ;; invalid character (bare CR) found.
+ ;; -> ignore.
+ `((read r0)
+ (repeat))))
+ ((eq tmp 'lf)
+ (if input-crlf
+ ;; r0='\n'
+ ;; invalid character (bare LF) found.
+ ;; -> ignore.
+ `((read r0)
+ (repeat))
+ ;; r0='\r\n'
+ ;; hard line break found.
+ (if output-crlf
+ '((write ?\r)
+ (write-read-repeat r0))
+ '(write-read-repeat r0))))
+ ((eq r0 (char-int ?=))
+ ;; r0='='
+ `((read r0)
+ ;; '=' r0
+ (r1 = (r0 == ?\t))
+ (if ((r0 == ? ) | r1)
+ ;; '=' r0:[\t ]
+ ;; Skip transport-padding.
+ ;; It should check CR LF after
+ ;; transport-padding.
+ (loop
+ (read-if (r0 == ?\t)
+ (repeat)
+ (if (r0 == ? )
+ (repeat)
+ (break)))))
+ ;; '=' [\t ]* r0:[^\t ]
+ (branch
+ r0
+ ,@(mapcar
+ (lambda (r0)
+ (cond
+ ((eq r0 (char-int ?\r))
+ (if input-crlf
+ ;; '=' [\t ]* r0='\r'
+ `((read r0)
+ ;; '=' [\t ]* '\r' r0
+ (if (r0 == ?\n)
+ ;; '=' [\t ]* '\r' r0='\n'
+ ;; soft line break found.
+ ((read r0)
+ (repeat))
+ ;; '=' [\t ]* '\r' r0:[^\n]
+ ;; invalid input ->
+ ;; output "=" and rescan from r0.
+ ((write "=")
+ (repeat))))
+ ;; '=' [\t ]* r0='\r'
+ ;; invalid input (bare CR found) ->
+ ;; output "=" and rescan from next.
+ `((write ?=)
+ (read r0)
+ (repeat))))
+ ((eq r0 (char-int ?\n))
+ (if input-crlf
+ ;; '=' [\t ]* r0='\n'
+ ;; invalid input (bare LF found) ->
+ ;; output "=" and rescan from next.
+ `((write ?=)
+ (read r0)
+ (repeat))
+ ;; '=' [\t ]* r0='\r\n'
+ ;; soft line break found.
+ `((read r0)
+ (repeat))))
+ ((setq tmp (nth r0 mel-ccl-256-to-16-table))
+ ;; '=' [\t ]* r0:[0-9A-F]
+ ;; upper nibble of hexadecimal digit found.
+ `((r1 = r0)
+ (r0 = ,tmp)))
+ (t
+ ;; '=' [\t ]* r0:[^\r0-9A-F]
+ ;; invalid input ->
+ ;; output "=" and rescan from r0.
+ `((write ?=)
+ (repeat)))))
+ mel-ccl-256-table))
+ ;; '=' [\t ]* r1:r0:[0-9A-F]
+ (read-branch
+ r2
+ ,@(mapcar
+ (lambda (r2)
+ (if (setq tmp (nth r2 mel-ccl-256-to-16-table))
+ ;; '=' [\t ]* r1:r0:[0-9A-F] r2:[0-9A-F]
+ `(write-read-repeat
+ r0
+ ,(vconcat
+ (mapcar
+ (lambda (r0)
+ (logior (lsh r0 4) tmp))
+ mel-ccl-16-table)))
+ ;; '=' [\t ]* r1:r0:[0-9A-F] r2:[^0-9A-F]
+ ;; invalid input
+ `(r3 = 0) ; nop
+ ))
+ mel-ccl-256-table))
+ ;; '=' [\t ]* r1:r0:[0-9A-F] r2:[^0-9A-F]
+ ;; invalid input ->
+ ;; output "=" with hex digit and rescan from r2.
+ (write ?=)
+ (r0 = r2)
+ (write-repeat r1)))
+ (t
+ ;; r0:[^\t\r -~]
+ ;; invalid character found.
+ ;; -> ignore.
+ `((read r0)
+ (repeat))))))
+ mel-ccl-256-table))
+ ;; r1[0]:[\t ]
+ (loop
+ ,@(apply
+ 'append
+ (mapcar
+ (lambda (regnum)
+ (let ((reg (aref [r1 r2 r3 r4 r5] regnum)))
+ (apply
+ 'append
+ (mapcar
+ (lambda (bit)
+ (if (= bit 0)
+ (if (= regnum 0)
+ nil
+ `((read r0)
+ (if (r0 == ?\t)
+ (,reg = 0)
+ (if (r0 == ?\ )
+ (,reg = 1)
+ ((r6 = ,(+ (* regnum 28) bit))
+ (break))))))
+ `((read r0)
+ (if (r0 == ?\ )
+ (,reg |= ,(lsh 1 bit))
+ (if (r0 != ?\t)
+ ((r6 = ,(+ (* regnum 28) bit))
+ (break)))))))
+ mel-ccl-28-table))))
+ '(0 1 2 3 4)))
+ ;; white space buffer exhaust.
+ ;; error: line length limit (76bytes) violation.
+ ;; -> ignore these white spaces.
+ (repeat))
+ ,(if input-crlf
+ `(if (r0 == ?\r)
+ ((read r0)
+ (if (r0 == ?\n)
+ ;; trailing white spaces found.
+ ;; -> ignore these white spacs.
+ ((write ,(if output-crlf "\r\n" "\n"))
+ (read r0)
+ (repeat))
+ ;; [\t ]* \r r0:[^\n]
+ ;; error: bare CR found.
+ ;; -> output white spaces and ignore bare CR.
+ ))
+ ;; [\t ]* r0:[^\r]
+ ;; middle white spaces found.
+ )
+ `(if (r0 == ?\n)
+ ;; trailing white spaces found.
+ ;; -> ignore these white spacs.
+ ((write ,(if output-crlf "\r\n" "\n"))
+ (read r0)
+ (repeat))
+ ;; [\t ]* r0:[^\n]
+ ;; middle white spaces found.
+ ))
+ ,@(apply
+ 'append
+ (mapcar
+ (lambda (regnum)
+ (let ((reg (aref [r1 r2 r3 r4 r5] regnum)))
+ (apply
+ 'append
+ (mapcar
+ (lambda (bit)
+ `((if (,reg & ,(lsh 1 bit))
+ (write ?\ )
+ (write ?\t))
+ (if (r6 == ,(+ (* regnum 28) bit 1))
+ (repeat))))
+ mel-ccl-28-table))))
+ '(0 1 2 3 4)))
+ (repeat)
+ ))))
+
+)
+
+(define-ccl-program mel-ccl-encode-quoted-printable-crlf-crlf
+ (mel-ccl-encode-quoted-printable-generic t t))
+
+(define-ccl-program mel-ccl-encode-quoted-printable-crlf-lf
+ (mel-ccl-encode-quoted-printable-generic t nil))
+
+(define-ccl-program mel-ccl-encode-quoted-printable-lf-crlf
+ (mel-ccl-encode-quoted-printable-generic nil t))
+
+(define-ccl-program mel-ccl-encode-quoted-printable-lf-lf
+ (mel-ccl-encode-quoted-printable-generic nil nil))
+
+(define-ccl-program mel-ccl-decode-quoted-printable-crlf-crlf
+ (mel-ccl-decode-quoted-printable-generic t t))
+
+(define-ccl-program mel-ccl-decode-quoted-printable-crlf-lf
+ (mel-ccl-decode-quoted-printable-generic t nil))
+
+(define-ccl-program mel-ccl-decode-quoted-printable-lf-crlf
+ (mel-ccl-decode-quoted-printable-generic nil t))
+
+(define-ccl-program mel-ccl-decode-quoted-printable-lf-lf
+ (mel-ccl-decode-quoted-printable-generic nil nil))
+
+
+;;; @ coding system
+;;;
+
+(make-ccl-coding-system
+ 'mel-ccl-uq-rev ?Q "MIME Q-encoding in unstructured field (reversed)"
+ 'mel-ccl-encode-uq 'mel-ccl-decode-q)
+
+(make-ccl-coding-system
+ 'mel-ccl-cq-rev ?Q "MIME Q-encoding in comment (reversed)"
+ 'mel-ccl-encode-cq 'mel-ccl-decode-q)
+
+(make-ccl-coding-system
+ 'mel-ccl-pq-rev ?Q "MIME Q-encoding in phrase (reversed)"
+ 'mel-ccl-encode-pq 'mel-ccl-decode-q)
+
+(make-ccl-coding-system
+ 'mel-ccl-quoted-printable-crlf-crlf-rev
+ ?Q "MIME Quoted-Printable-encoding (reversed)"
+ 'mel-ccl-encode-quoted-printable-crlf-crlf
+ 'mel-ccl-decode-quoted-printable-crlf-crlf)
+
+(make-ccl-coding-system
+ 'mel-ccl-quoted-printable-lf-crlf-rev
+ ?Q "MIME Quoted-Printable-encoding (LF encoding) (reversed)"
+ 'mel-ccl-encode-quoted-printable-crlf-lf
+ 'mel-ccl-decode-quoted-printable-lf-crlf)
+
+(make-ccl-coding-system
+ 'mel-ccl-quoted-printable-crlf-lf-rev
+ ?Q "MIME Quoted-Printable-encoding (LF internal) (reversed)"
+ 'mel-ccl-encode-quoted-printable-lf-crlf
+ 'mel-ccl-decode-quoted-printable-crlf-lf)
+
+(make-ccl-coding-system
+ 'mel-ccl-quoted-printable-lf-lf-rev
+ ?Q "MIME Quoted-Printable-encoding (LF encoding) (LF internal) (reversed)"
+ 'mel-ccl-encode-quoted-printable-lf-lf
+ 'mel-ccl-decode-quoted-printable-lf-lf)
+
+
+;;; @ quoted-printable
+;;;
+
+(check-broken-facility ccl-execute-eof-block-on-decoding-some)
+
+(unless-broken ccl-execute-eof-block-on-decoding-some
+
+ (defun quoted-printable-ccl-encode-string (string)
+ "Encode STRING with quoted-printable encoding."
+ (decode-coding-string
+ string
+ 'mel-ccl-quoted-printable-lf-lf-rev))
+
+ (defun quoted-printable-ccl-encode-region (start end)
+ "Encode the region from START to END with quoted-printable encoding."
+ (interactive "r")
+ (decode-coding-region start end 'mel-ccl-quoted-printable-lf-lf-rev))
+
+ (defun quoted-printable-ccl-insert-encoded-file (filename)
+ "Encode contents of the file named as FILENAME, and insert it."
+ (interactive (list (read-file-name "Insert encoded file: ")))
+ (let ((coding-system-for-read 'mel-ccl-quoted-printable-lf-lf-rev))
+ (insert-file-contents filename)))
+
+ (mel-define-method-function
+ (mime-encode-string string (nil "quoted-printable"))
+ 'quoted-printable-ccl-encode-string)
+ (mel-define-method-function
+ (mime-encode-region start end (nil "quoted-printable"))
+ 'quoted-printable-ccl-encode-region)
+ (mel-define-method-function
+ (mime-insert-encoded-file filename (nil "quoted-printable"))
+ 'quoted-printable-ccl-insert-encoded-file)
+ )
+
+(defun quoted-printable-ccl-decode-string (string)
+ "Decode quoted-printable encoded STRING."
+ (encode-coding-string
+ string
+ 'mel-ccl-quoted-printable-lf-lf-rev))
+
+(defun quoted-printable-ccl-decode-region (start end)
+ "Decode the region from START to END with quoted-printable
+encoding."
+ (interactive "r")
+ (encode-coding-region start end 'mel-ccl-quoted-printable-lf-lf-rev))
+
+(defun quoted-printable-ccl-write-decoded-region
+ (start end filename)
+ "Decode quoted-printable encoded current region and write out to FILENAME."
+ (interactive
+ (list (region-beginning) (region-end)
+ (read-file-name "Write decoded region to file: ")))
+ (let ((coding-system-for-write 'mel-ccl-quoted-printable-lf-lf-rev))
+ (write-region start end filename)))
+
+(mel-define-method-function
+ (mime-decode-string string (nil "quoted-printable"))
+ 'quoted-printable-ccl-decode-string)
+(mel-define-method-function
+ (mime-decode-region start end (nil "quoted-printable"))
+ 'quoted-printable-ccl-decode-region)
+(mel-define-method-function
+ (mime-write-decoded-region start end filename (nil "quoted-printable"))
+ 'quoted-printable-ccl-write-decoded-region)
+
+
+;;; @ Q
+;;;
+
+(defun q-encoding-ccl-encode-string (string &optional mode)
+ "Encode STRING to Q-encoding of encoded-word, and return the result.
+MODE allows `text', `comment', `phrase' or nil. Default value is
+`phrase'."
+ (decode-coding-string
+ string
+ (cond
+ ((eq mode 'text) 'mel-ccl-uq-rev)
+ ((eq mode 'comment) 'mel-ccl-cq-rev)
+ (t 'mel-ccl-pq-rev))))
+
+(defun q-encoding-ccl-decode-string (string)
+ "Decode Q encoded STRING and return the result."
+ (encode-coding-string
+ string
+ 'mel-ccl-uq-rev))
+
+(unless (featurep 'xemacs)
+ (defun q-encoding-ccl-encoded-length (string &optional mode)
+ (let ((status [nil nil nil nil nil nil nil nil nil]))
+ (fillarray status nil)
+ (ccl-execute-on-string
+ (cond
+ ((eq mode 'text) 'mel-ccl-count-uq)
+ ((eq mode 'comment) 'mel-ccl-count-cq)
+ (t 'mel-ccl-count-pq))
+ status
+ string)
+ (aref status 0)))
+ )
+
+(mel-define-method-function (encoded-text-encode-string string (nil "Q"))
+ 'q-encoding-ccl-encode-string)
+
+(mel-define-method encoded-text-decode-string (string (nil "Q"))
+ (if (and (string-match Q-encoded-text-regexp string)
+ (string= string (match-string 0 string)))
+ (q-encoding-ccl-decode-string string)
+ (error "Invalid encoded-text %s" string)))
+
+
+;;; @ end
+;;;
+
+(provide 'mel-q-ccl)
+
+;;; mel-q-ccl.el ends here
(buffer-substring (match-beginning 0)
(match-end 0))
)))))
- (default-directory mime-temp-directory))
+ (default-directory temporary-file-directory))
(if filename
(as-binary-process
(apply (function call-process-region)
)
(mel-define-method mime-write-decoded-region (start end filename
- (nil "x-gzip64"))
+ (nil "x-uue"))
"Decode and write current region encoded by uuencode into FILENAME.
START and END are buffer positions."
(interactive
(buffer-substring (match-beginning 0)
(match-end 0))
)))))
- (default-directory mime-temp-directory))
+ (default-directory temporary-file-directory))
(if file
(as-binary-process
(apply (function call-process-region)
;;; @ setting for modules
;;;
-(defvar mel-ccl-module
- (and (featurep 'mule)
- (progn
- (require 'path-util)
- (module-installed-p 'mel-ccl)
- )))
-
-(mel-use-module 'mel-b '("base64" "B"))
-(mel-use-module 'mel-q '("quoted-printable" "Q"))
-(mel-use-module 'mel-g '("x-gzip64"))
-(mel-use-module 'mel-u '("x-uue" "x-uuencode"))
-
-(if mel-ccl-module
- (mel-use-module 'mel-ccl '("base64" "quoted-printable" "B" "Q"))
- )
-
-(if base64-dl-module
- (mel-use-module 'mel-b-dl '("base64" "B"))
- )
-
(mel-define-backend "7bit")
(mel-define-method-function (mime-encode-string string (nil "7bit"))
'identity)
(mel-define-backend "binary" ("8bit"))
+(when (and (fboundp 'base64-encode-string)
+ (subrp (symbol-function 'base64-encode-string)))
+ (mel-define-backend "base64")
+ (mel-define-method-function (mime-encode-string string (nil "base64"))
+ 'base64-encode-string)
+ (mel-define-method-function (mime-decode-string string (nil "base64"))
+ 'base64-decode-string)
+ (mel-define-method-function (mime-encode-region start end (nil "base64"))
+ 'base64-encode-region)
+ (mel-define-method-function (mime-decode-region start end (nil "base64"))
+ 'base64-decode-region)
+ (mel-define-method mime-insert-encoded-file (filename (nil "base64"))
+ "Encode contents of file FILENAME to base64, and insert the result.
+It calls external base64 encoder specified by
+`base64-external-encoder'. So you must install the program (maybe
+mmencode included in metamail or XEmacs package)."
+ (interactive (list (read-file-name "Insert encoded file: ")))
+ (insert (base64-encode-string
+ (with-temp-buffer
+ (set-buffer-multibyte nil)
+ (insert-file-contents-as-binary filename)
+ (buffer-string))))
+ (or (bolp)
+ (insert "\n"))
+ )
+
+ (mel-define-method-function (encoded-text-encode-string string (nil "B"))
+ 'base64-encode-string)
+ (mel-define-method encoded-text-decode-string (string (nil "B"))
+ (if (and (string-match B-encoded-text-regexp string)
+ (string= string (match-string 0 string)))
+ (base64-decode-string string)
+ (error "Invalid encoded-text %s" string)))
+ )
+
+(mel-use-module 'mel-b-el '("base64" "B"))
+(mel-use-module 'mel-q '("quoted-printable" "Q"))
+(mel-use-module 'mel-g '("x-gzip64"))
+(mel-use-module 'mel-u '("x-uue" "x-uuencode"))
+
+(defvar mel-b-ccl-module
+ (and (featurep 'mule)
+ (progn
+ (require 'path-util)
+ (module-installed-p 'mel-b-ccl)
+ )))
+
+(defvar mel-q-ccl-module
+ (and (featurep 'mule)
+ (progn
+ (require 'path-util)
+ (module-installed-p 'mel-q-ccl)
+ )))
+
+(if mel-b-ccl-module
+ (mel-use-module 'mel-b-ccl '("base64" "B"))
+ )
+
+(if mel-q-ccl-module
+ (mel-use-module 'mel-q-ccl '("quoted-printable" "Q"))
+ )
+
+(if base64-dl-module
+ (mel-use-module 'mel-b-dl '("base64" "B"))
+ )
+
;;; @ region
;;;
ENCODING must be string.")
(defun base64-encoded-length (string)
- (let ((len (length string)))
- (* (+ (/ len 3)
- (if (= (mod len 3) 0) 0 1)
- ) 4)
- ))
+ (* (/ (+ (length string) 2) 3) 4))
(defsubst Q-encoding-printable-char-p (chr mode)
(and (not (memq chr '(?= ?? ?_)))
;;; Code:
+(require 'mcharset)
+
(eval-and-compile
- (defconst mime-library-product ["FLIM" (1 11 0) "Yamadagawa"]
+ (defconst mime-library-product ["FLIM" (1 11 3) "Saidaiji"]
"Product name, version number and code name of MIME-library package.")
)
(custom-handle-keyword 'default-mime-charset :group 'mime
'custom-variable)
-(defcustom mime-temp-directory (or (getenv "MIME_TMP_DIR")
- (getenv "TM_TMP_DIR")
- (getenv "TMPDIR")
- (getenv "TMP")
- (getenv "TEMP")
- "/tmp/")
- "*Directory for temporary files."
- :group 'mime
- :type 'directory)
-
(defcustom mime-uuencode-encoding-name-list '("x-uue" "x-uuencode")
"*List of encoding names for uuencode format."
:group 'mime
;;; @ about STD 11
;;;
-(defconst std11-quoted-pair-regexp "\\\\.")
-(defconst std11-non-qtext-char-list '(?\" ?\\ ?\r ?\n))
-(defconst std11-qtext-regexp
- (concat "[^" (char-list-to-string std11-non-qtext-char-list) "]"))
+(eval-and-compile
+ (defconst std11-quoted-pair-regexp "\\\\.")
+ (defconst std11-non-qtext-char-list '(?\" ?\\ ?\r ?\n))
+ (defconst std11-qtext-regexp
+ (eval-when-compile
+ (concat "[^" (apply #'string std11-non-qtext-char-list) "]"))))
(defconst std11-quoted-string-regexp
- (concat "\""
- (regexp-*
- (regexp-or std11-qtext-regexp std11-quoted-pair-regexp))
- "\""))
+ (eval-when-compile
+ (concat "\""
+ (regexp-*
+ (regexp-or std11-qtext-regexp std11-quoted-pair-regexp))
+ "\"")))
;;; @ about MIME
))))
(put 'mm-define-method 'lisp-indent-function 'defun)
-(put 'mm-define-method 'edebug-form-spec
- '(&define name ((arg symbolp) &rest arg) def-body))
+(def-edebug-spec mm-define-method
+ (&define name ((arg symbolp)
+ [&rest arg]
+ [&optional ["&optional" arg &rest arg]]
+ &optional ["&rest" arg]
+ )
+ def-body))
(defsubst mm-arglist-to-arguments (arglist)
(let (dest)
)))
(defvar base64-dl-module
- (and (fboundp 'dynamic-link)
- (let ((path (expand-file-name "base64.so" exec-directory)))
- (and (file-exists-p path)
- path))))
+ (if (and (fboundp 'base64-encode-string)
+ (subrp (symbol-function 'base64-encode-string)))
+ nil
+ (if (fboundp 'dynamic-link)
+ (let ((path (expand-file-name "base64.so" exec-directory)))
+ (and (file-exists-p path)
+ path)
+ ))))
;;; @ end
)
t)))
+(defun mime-insert-header-from-buffer (buffer start end
+ &optional invisible-fields
+ visible-fields)
+ (let ((the-buf (current-buffer))
+ f-b p f-e field-name len field field-body)
+ (save-excursion
+ (set-buffer buffer)
+ (save-restriction
+ (narrow-to-region start end)
+ (goto-char start)
+ (while (re-search-forward std11-field-head-regexp nil t)
+ (setq f-b (match-beginning 0)
+ p (match-end 0)
+ field-name (buffer-substring f-b p)
+ len (string-width field-name)
+ f-e (std11-field-end))
+ (when (mime-visible-field-p field-name
+ visible-fields invisible-fields)
+ (setq field (intern
+ (capitalize (buffer-substring f-b (1- p))))
+ field-body (buffer-substring p f-e))
+ (with-current-buffer the-buf
+ (insert field-name)
+ (insert
+ (if (memq field eword-decode-ignored-field-list)
+ ;; Don't decode
+ field-body
+ (if (memq field eword-decode-structured-field-list)
+ ;; Decode as structured field
+ (eword-decode-and-fold-structured-field field-body len)
+ ;; Decode as unstructured field
+ (eword-decode-unstructured-field-body field-body len)
+ )))
+ (insert "\n")
+ )))))))
+
(mm-define-method insert-header ((entity generic)
&optional invisible-fields visible-fields)
- (save-restriction
- (narrow-to-region (point)(point))
- (let ((the-buf (current-buffer))
- (src-buf (mime-entity-buffer entity))
- (h-end (mime-entity-header-end-internal entity))
- beg p end field-name len field)
- (save-excursion
- (set-buffer src-buf)
- (goto-char (mime-entity-header-start-internal entity))
- (save-restriction
- (narrow-to-region (point) h-end)
- (while (re-search-forward std11-field-head-regexp nil t)
- (setq beg (match-beginning 0)
- p (match-end 0)
- field-name (buffer-substring beg (1- p))
- len (string-width field-name)
- end (std11-field-end))
- (when (mime-visible-field-p field-name
- visible-fields invisible-fields)
- (setq field (intern (capitalize field-name)))
- (save-excursion
- (set-buffer the-buf)
- (insert field-name)
- (insert ":")
- (cond ((memq field eword-decode-ignored-field-list)
- ;; Don't decode
- (insert-buffer-substring src-buf p end)
- )
- ((memq field eword-decode-structured-field-list)
- ;; Decode as structured field
- (let ((body (save-excursion
- (set-buffer src-buf)
- (buffer-substring p end)
- )))
- (insert (eword-decode-and-fold-structured-field
- body (1+ len)))
- ))
- (t
- ;; Decode as unstructured field
- (let ((body (save-excursion
- (set-buffer src-buf)
- (buffer-substring p end)
- )))
- (insert (eword-decode-unstructured-field-body
- body (1+ len)))
- )))
- (insert "\n")
- ))))))))
+ (mime-insert-header-from-buffer
+ (mime-entity-buffer entity)
+ (mime-entity-header-start-internal entity)
+ (mime-entity-header-end-internal entity)
+ invisible-fields visible-fields)
+ )
(mm-define-method insert-text-content ((entity generic))
(insert
projects / elisp / flim.git / commitdiff