From 4248a1b9eb6e8271990355e6393683be2a0ec54b Mon Sep 17 00:00:00 2001 From: morioka Date: Mon, 12 Oct 1998 13:59:02 +0000 Subject: [PATCH] Merge flim-1_10_4. --- ChangeLog | 327 ++++++++++++++ FLIM-CFG | 7 + FLIM-ELS | 9 +- FLIM-MK | 12 +- FLIM-VERSION | 46 +- Makefile | 11 +- README.en | 33 +- eword-decode.el | 302 ++++++------- eword-encode.el | 12 +- mel-b-dl.el | 121 +++++ mel-b.el | 75 ++- mel-ccl.el | 1352 +++++++++++++++++++++++++++++++++++++++++++++++++++++++ mel-dl.el | 124 ----- mel-g.el | 27 +- mel-q.el | 54 +-- mel-u.el | 34 +- mel.el | 336 ++++++-------- mime-def.el | 188 +++++++- mime-en.sgml | 181 +++++--- mime-en.texi | 184 +++++--- mime-ja.sgml | 179 +++++--- mime-ja.texi | 180 +++++--- mime.el | 10 - 23 files changed, 2979 insertions(+), 825 deletions(-) create mode 100644 mel-b-dl.el create mode 100644 mel-ccl.el delete mode 100644 mel-dl.el diff --git a/ChangeLog b/ChangeLog index d7df39b..3d2d799 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,330 @@ +1998-10-12 MORIOKA Tomohiko + + * FLIM: Version 1.10.4 (Shin-H-Dòsono)-A was released. + +1998-10-12 Katsumi Yamaoka + + * README.en: Add explanation about `VERSION_SPECIFIC_LISPDIR'. + + * Makefile (install): Add new arg `VERSION_SPECIFIC_LISPDIR'. + (elc): Likewise. + + * FLIM-MK (config-flim): Refer to `VERSION_SPECIFIC_LISPDIR'. + + * FLIM-CFG (VERSION_SPECIFIC_LISPDIR): New variable. + +1998-10-12 MORIOKA Tomohiko + + * mel.el (mel-ccl-module): Require path-util when the running + emacs has MULE. + + * mel.el: Don't require emu. + +1998-10-11 MORIOKA Tomohiko + + * FLIM-ELS: Don't install mel-ccl in anything older than XEmacs 21 + with MULE. + + +1998-10-10 MORIOKA Tomohiko + + * FLIM: Version 1.10.3 (Komada) was released. + + * mel-ccl.el (base64-ccl-write-decoded-region): bind + `jka-compr-compression-info-list' with nil. + + * mel-b.el (base64-internal-decoding-limit): Switch default value + between XEmacs-mule and other emacsen. + Abolish function `base64-decode-string!'. + (base64-internal-decode-region): New implementation. + (base64-insert-encoded-file): New function. + (mime-insert-encoded-file): Use `base64-insert-encoded-file'. + (base64-write-decoded-region): New function. + (mime-write-decoded-region): Use `base64-write-decoded-region'. + + * mel-b-dl.el (decode-base64-region): Renamed from + `base64-decode-region'. + (mime-insert-encoded-file): Change temporary-buffer to unibyte + representation. Abolish method `mime-write-decoded-region' + because it is slower than CCL based implementation. + +1998-10-09 Tanaka Akira + + * mel-ccl.el: Check `ccl-execute-eof-block-on-decoding-some' + facility instead of `ccl-execute-eof-block-on-encoding-some'. + +1998-10-09 MORIOKA Tomohiko + + * mel-b.el (base64-characters): Enclose with `eval-and-compile'. + + * eword-decode.el (eword-encoded-text-regexp): Enclose with + `eval-and-compile'. + (eword-encoded-word-regexp): Use `eval-when-compile'. + +1998-10-09 MORIOKA Tomohiko + + * eword-decode.el (eword-max-size-to-decode): New user option. + (eword-decode-and-fold-structured-field): Do nothing if size of + input is bigger than `eword-max-size-to-decode'. + +1998-10-08 MORIOKA Tomohiko + + * mel-b.el (base64-numbers): Use `eval-when-compile'. + +1998-10-09 Katsumi Yamaoka + + * FLIM-CFG: Use `add-latest-path' instead of `add-path' for adding + "custom" to load-path. + +1998-10-09 Katsumi Yamaoka + + * mime-def.el (mime-library-product): Enclose with + `eval-and-compile'. + + * FLIM-CFG: Add "custom" to load-path. + + +1998-10-08 MORIOKA Tomohiko + + * FLIM: Version 1.10.2 (Kintetsu-Miyazu) was released. + + * mime-def.el, mel.el, mel-b-dl.el: Move variable + `base64-dl-module' from mel-b-dl.el and mel.el to mime-def.el. + +1998-10-08 MORIOKA Tomohiko + + * mel.el (mel-ccl-module): New variable; use it to check mel-ccl + is available. + + * FLIM-ELS: Don't install mel-ccl for anything older than MULE + 2.3. + +1998-10-08 MORIOKA Tomohiko + + * mel-u.el: Use `mel-define-backend' to define "x-uue". + Define "x-uuencode" as a clone of "x-uue". + + * Move variable `mel-encoding-module-alist' from mel.el to + mime-def.el. + + * mel.el (mel-find-function): Use function + `mel-find-function-from-obarray'. + Use `mel-define-backend' to define "7bit", "8bit" and "binary"; + don't define methods of "8bit" and "binary"; inherit methods from + "7bit". + + * mime-def.el (mel-service-list): New variable. + (mel-define-service): New implementation. + (mel-find-function-from-obarray): New inline function. + (mel-copy-method): New inline function. + (mel-copy-backend): New inline function. + (mel-define-backend): New macro. + +1998-10-08 MORIOKA Tomohiko + + * mel-u.el: Define method functions of mel. + (mime-encode-region): Use `mel-define-method-function'; abolish + `uuencode-encode-region'. + (mime-decode-region): Use `mel-define-method-function'; abolish + `uuencode-decode-region'. + (mime-encode-string): New method. + (mime-decode-string): New method. + (mime-insert-encoded-file): Use `mel-define-method'; abolish + `uuencode-insert-encoded-file'. + (mime-write-decoded-region): Use `mel-define-method'; abolish + `uuencode-write-decoded-region'. + +1998-10-07 MORIOKA Tomohiko + + * mime-def.el (mel-define-service): Add DOC. + (mel-define-method): Add DOC. + (mel-define-method-function): Add DOC. + + * mime-en.sgml, mime-ja.sgml: Modify for FLIM 1.10. + + +1998-10-07 MORIOKA Tomohiko + + * FLIM: Version 1.10.1 (Miyamaki) was released. + +1998-10-06 MORIOKA Tomohiko + + * mel-g.el: Define method functions of mel. + (mime-encode-region): Use `mel-define-method-function'; abolish + `gzip64-encode-region'. + (mime-decode-region): Use `mel-define-method-function'; abolish + `gzip64-decode-region'. + (mime-encode-string): New method. + (mime-decode-string): New method. + (mime-insert-encoded-file): Use `mel-define-method'; abolish + `gzip64-insert-encoded-file'. + (mime-write-decoded-region): Use `mel-define-method'; abolish + `gzip64-write-decoded-region'. + + * mime-def.el (mime-library-product): New variable; abolish + `mime-library-version'. + (mime-product-name): New macro. + (mime-product-version): New macro. + (mime-product-code-name): New macro. + (mime-library-version): Renamed from + `mime-library-version-string'; use `mime-library-product', + `mime-product-name', `mime-product-version' and + `mime-product-code-name'. + + * mime-def.el (mm-define-backend): Add DOC. + (mm-define-method): Add DOC. + + * mel.el (mime-encoding-list): Modify DOC to add description about + optional argument SERVICE. + +1998-10-04 MORIOKA Tomohiko + + * mime-ja.sgml, mime-en.sgml (mm-backend module): Write + description of `mm-define-backend' and `mm-define-method'. + + +1998-09-29 MORIOKA Tomohiko + + * FLIM: Version 1.10.0 (K-Dòdo)-A was released. + + * README.en (What's FLIM): Add mel-ccl.el. + +1998-09-21 Tanaka Akira + + * mel-ccl.el: + - Require 'pccl instead of 'emu. + - Use `unless-broken' to check facility. + +1998-09-27 MORIOKA Tomohiko + + * mel.el (mime-encoding-list): New user option (renamed from + `mime-content-transfer-encoding-list'). + (mime-encoding-list): New function. + (mime-encoding-alist): New function. + (mime-encode-region): Use `mime-encoding-alist' for completion. + (mime-decode-region): Likewise. + (mime-insert-encoded-file): Likewise. + (mime-write-decoded-region): Likewise. + +1998-09-24 MORIOKA Tomohiko + + * eword-decode.el (eword-decode-structured-field-list): Add + Mail-Followup-To field. + +1998-09-20 MORIOKA Tomohiko + + * eword-encode.el (eword-charset-encoding-alist): Add utf-8. + +1998-09-20 MORIOKA Tomohiko + + * mel.el (mime-content-transfer-encoding-list): New user option. + (mime-encode-region): Use `mime-content-transfer-encoding-list' + for completion. + (mime-decode-region): Likewise. + (mime-insert-encoded-file): Likewise. + (mime-write-decoded-region): Likewise. + + * mel.el (mime-write-decoded-region): fix typo. + +1998-09-20 MORIOKA Tomohiko + + * mime-def.el (mel-define-method-function): Don't override. + +1998-09-20 MORIOKA Tomohiko + + * mel.el, mel-ccl.el, FLIM-ELS: Add mel-ccl.el. + +1998-09-20 MORIOKA Tomohiko + + * mel-dl.el, README.en, FLIM-ELS: Rename mel-dl.el to mel-b-dl.el. + + * mel.el: - Rename mel-dl.el to mel-b-dl.el. + - Move `mel-define-service' to mime-def.el. + + * mime-def.el (mel-define-service): New macro (moved from mel.el); + fixed problem in Emacs. + (mel-define-method): Use `mel-define-service'. + (mel-define-method-function): Use `mel-define-service'. + +1998-09-20 MORIOKA Tomohiko + + * mel.el (mime-encode-region): Don't regard nil encoding as + "7bit". + +1998-09-19 MORIOKA Tomohiko + + * eword-encode.el (eword-encode-text): Use + `encoded-text-encode-string'. + (tm-eword::encoded-word-length): `q-encoding-encoded-length' was + renamed to `Q-encoded-text-length'. + + * eword-decode.el: Move `base64-token-regexp', + `base64-token-padding-regexp', `eword-B-encoded-text-regexp' and + `eword-Q-encoded-text-regexp' to mime-def.el. + (eword-decode-encoded-text): Use `encoded-text-decode-string'. + + * mel-q.el: Define method functions of mel. + (mime-insert-encoded-file): Use `mel-define-method'; abolish + `quoted-printable-insert-encoded-file'. + (mime-write-decoded-region): Use `mel-define-method'; abolish + `quoted-printable-write-decoded-region'. + - Move `q-encoding-printable-char-p' and + `q-encoding-encoded-length' to mel.el. + + * mel-b.el: Define method functions of mel. + (mime-insert-encoded-file): Use `mel-define-method'; abolish + `base64-insert-encoded-file'. + (mime-write-decoded-region): Use `mel-define-method'; abolish + `base64-write-decoded-region'. + - Move `base64-encoded-length' to mel.el. + + * mel-dl.el (base64-encode-region): Define directly (abolish + `base64-dl-encode-region'). + (base64-decode-region): Define directly (abolish + `base64-dl-decode-region'). Define method functions of mel. + (mime-insert-encoded-file): Use `mel-define-method'; abolish + `base64-insert-encoded-file'; don't use external encoder. + (mime-write-decoded-region): Use `mel-define-method'; abolish + `base64-write-decoded-region'; don't use external decoder. + - Move `base64-encoded-length' to mel.el. + + * mime.el: Move `mm-arglist-to-arguments' to mime-def.el. + + * mime-def.el (base64-token-regexp): New constant (moved from + eword-decode.el). + (base64-token-padding-regexp): Likewise. + (B-encoded-text-regexp): New constant (moved from eword-decode.el, + and renamed from `eword-B-encoded-text-regexp'). + (Q-encoded-text-regexp): New constant (moved from eword-decode.el, + and renamed from `eword-Q-encoded-text-regexp'. + (mm-arglist-to-arguments): New function (moved from mime.el). + (mel-define-method): New macro. + (mel-define-method-function): New macro. + (mel-define-function): New macro. + + * mel.el (mel-encoding-module-alist): New variable. + (mel-use-module): New function. + (mel-find-function): New function. + (mel-define-service): New macro. + (mime-encode-region): Use `mel-find-function'; abolish variable + `mime-encoding-method-alist'. + (mime-decode-region): Use `mel-find-function'; abolish variable + `mime-decoding-method-alist'. + (mime-decode-string): Use `mel-find-function'; abolish variable + `mime-string-decoding-method-alist'. + (encoded-text-encode-string): New function. + (encoded-text-decode-string): New function. + (base64-encoded-length): New function (moved from mel-b.el and + mel-dl.el). + (Q-encoding-printable-char-p): New function (moved from mel-q.el, + and renamed from `q-encoding-printable-char-p'). + (Q-encoded-text-length): New function (moved from mel-q.el, and + renamed from `q-encoding-encoded-length'). + (mime-insert-encoded-file): Use `mel-find-function'; abolish + variable `mime-file-encoding-method-alist'. + (mime-write-decoded-region): Use `mel-find-function'; abolish + variable `mime-file-decoding-method-alist'. + 1998-09-16 MORIOKA Tomohiko * mel-b.el (base64-internal-encoding-limit): modify :type. diff --git a/FLIM-CFG b/FLIM-CFG index 37ddd2a..57565ab 100644 --- a/FLIM-CFG +++ b/FLIM-CFG @@ -16,8 +16,15 @@ (add-to-list 'load-path (expand-file-name "apel" LISPDIR)) )) +(defvar VERSION_SPECIFIC_LISPDIR nil) + +(if VERSION_SPECIFIC_LISPDIR + (add-to-list 'load-path VERSION_SPECIFIC_LISPDIR)) + (require 'install) +(add-latest-path "custom") + (add-path default-directory) (or (fboundp 'write-region-as-binary) diff --git a/FLIM-ELS b/FLIM-ELS index 5dee670..5c232f2 100644 --- a/FLIM-ELS +++ b/FLIM-ELS @@ -12,7 +12,14 @@ mailcap)) (if (fboundp 'dynamic-link) - (setq flim-modules (cons 'mel-dl flim-modules)) + (setq flim-modules (cons 'mel-b-dl 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)) ) ;;; FLIM-ELS ends here diff --git a/FLIM-MK b/FLIM-MK index 9fcf319..25552c7 100644 --- a/FLIM-MK +++ b/FLIM-MK @@ -1,10 +1,10 @@ ;;; -*-Emacs-Lisp-*- ;;; -;;; $Id: FLIM-MK,v 1.3 1998-09-11 23:14:03 morioka Exp $ +;;; $Id: FLIM-MK,v 1.4 1998-10-12 13:58:19 morioka Exp $ ;;; (defun config-flim () - (let (prefix lisp-dir) + (let (prefix lisp-dir version-specific-lisp-dir) (and (setq prefix (car command-line-args-left)) (or (string-equal "NONE" prefix) (defvar PREFIX prefix) @@ -15,6 +15,14 @@ (defvar LISPDIR lisp-dir) )) (setq command-line-args-left (cdr command-line-args-left)) + (and (setq version-specific-lisp-dir (car command-line-args-left)) + (or (string-equal "NONE" version-specific-lisp-dir) + (progn + (defvar VERSION_SPECIFIC_LISPDIR version-specific-lisp-dir) + (princ (format "VERSION_SPECIFIC_LISPDIR=%s\n" + VERSION_SPECIFIC_LISPDIR))) + )) + (setq command-line-args-left (cdr command-line-args-left)) (load-file "FLIM-CFG") (load-file "FLIM-ELS") (princ (format "PREFIX=%s diff --git a/FLIM-VERSION b/FLIM-VERSION index 0bd50b4..fdf6dad 100644 --- a/FLIM-VERSION +++ b/FLIM-VERSION @@ -4,43 +4,43 @@ ;;------------------------------------------------------------------------- ;; Kinki Nippon Railway $(B6a5&F|K\E4F;(B http://www.kintetsu.co.jp/ -;; Ky-Dòto Line $(B5~ET@~(B-A +;; Ky-Dòto-A Line $(B5~ET@~(B ;;------------------------------------------------------------------------- -1.0.1 Ky-Dòto $(B5~ET(B ; <=> JR, $(B5~ET;T8rDL6I(B-A -1.1.0 T-Dòji $(BEl;{(B-A -1.2.0 J-Dþjò $(B==>r(B-A +1.0.1 Ky-Dòto-A $(B5~ET(B ; <=> JR, $(B5~ET;T8rDL6I(B +1.1.0 T-Dòji-A $(BEl;{(B +1.2.0 J-Dþjò-A $(B==>r(B 1.2.1 Kamitobaguchi $(B>eD;1)8}(B 1.2.2 Takeda $(BC]ED(B ; = $(B5~ET;T8rDL6I(B $(B1(4]@~(B 1.3.0 Fushimi $(BIz8+(B 1.4.0 Kintetsu-Tambabashi $(B6aE4C0GH66(B ; <=> $(B5~:e(B $(BC0GH66(B -1.4.1 Momoyama-Gory-Dòmae $(BEm;38fNMA0(B-A +1.4.1 Momoyama-Gory-Dòmae-A $(BEm;38fNMA0(B 1.5.0 Mukaijima $(B8~Eg(B 1.6.0 Ogura $(B>.AR(B 1.7.0 Iseda $(B0K@*ED(B -1.8.0 -DÒkubo $(BBg5WJ](B-A +1.8.0 -DÒkubo-A $(BBg5WJ](B 1.8.1 Kutsukawa $(B5WDE@n(B 1.9.0 Terada $(B;{ED(B -1.9.1 Tonosh-Dò $(BIYLnAq(B-A +1.9.1 Tonosh-Dò-A $(BIYLnAq(B 1.9.2 Shin-Tanabe $(B?7EDJU(B ------ K-Dòdo $(B6=8M(B-A ------ Miyamaki $(B;0;3LZ(B ------ Kintetsu-Miyazu $(B6aE45\DE(B ------ Komada $(B9}ED(B ------ Shin-H-Dòsono $(B?7=K1`(B-A +1.10.0 K-Dòdo-A $(B6=8M(B +1.10.1 Miyamaki $(B;0;3LZ(B +1.10.2 Kintetsu-Miyazu $(B6aE45\DE(B +1.10.3 Komada $(B9}ED(B +1.10.4 Shin-H-Dòsono-A $(B?7=K1`(B ; <=> JR $(BJRD.@~(B $(B=K1`(B ----- Kizugawadai $(BLZDE@nBf(B ----- Yamadagawa $(B;3ED@n(B ----- Takanohara $(B9b$N86(B ------ Heij-Dò $(BJ?>k(B-A +----- Heij-Dò-A $(BJ?>k(B ----- Saidaiji $(B@>Bg;{(B ;;------------------------------------------------------------------------- ;; Kinki Nippon Railway $(B6a5&F|K\E4F;(B http://www.kintetsu.co.jp/ -;; Ky-Dòto Line $(B3`86@~(B-A +;; Ky-Dòto-A Line $(B3`86@~(B ;;------------------------------------------------------------------------- (Saidaiji) ($(B@>Bg;{(B) ----- Amagatsuji $(BFt%vDT(B ------ Nishinoky-Dò $(B@>$N5~(B-A ------ Kuj-Dò $(B6e>r(B-A ------ Kintetsu-K-Dòriyama $(B6aE474;3(B-A +----- Nishinoky-Dò-A $(B@>$N5~(B +----- Kuj-Dò-A $(B6e>r(B +----- Kintetsu-K-Dòriyama-A $(B6aE474;3(B [Chao Version names] @@ -53,8 +53,10 @@ ;;------------------------------------------------------------------------- 1.2.0 Takeda $(BC]ED(B ; = $(B6aE4(B $(B5~ET@~(B 1.3.0 Kuinabashi $(B$/$$$J66(B -1.4.0 J-Dþjò $(B==>r(B-A -1.6.0 Kuj-Dò $(B6e>r(B-A -1.6.1 Ky-Dòto $(B5~ET(B ; <=> JR, $(B6aE4(B-A -1.7.0 Goj-Dò $(B8^>r(B-A -1.8.0 Shij-Dò $(B;M>r(B-A +1.4.0 J-Dþjò-A $(B==>r(B +1.6.0 Kuj-Dò-A $(B6e>r(B +1.6.1 Ky-Dòto-A $(B5~ET(B ; <=> JR, $(B6aE4(B +1.7.0 Goj-Dò-A $(B8^>r(B +1.8.0 Shij-Dò-A $(B;M>r(B ; <=> $(B:e5^(B $(B5~ET@~(B +1.9.0 Karasuma Oike $(B1(4]8fCS(B ; = $(B5~ET;T8rDL6I(B $(BEl@>@~(B +----- Marutamach $(B4]B@D.(B diff --git a/Makefile b/Makefile index cef0786..25d849c 100644 --- a/Makefile +++ b/Makefile @@ -3,7 +3,7 @@ # PACKAGE = flim -VERSION = 1.9.2 +VERSION = 1.10.4 TAR = tar RM = /bin/rm -f @@ -16,6 +16,7 @@ FLAGS = -batch -q -no-site-file -l FLIM-MK PREFIX = NONE LISPDIR = NONE PACKAGEDIR = NONE +VERSION_SPECIFIC_LISPDIR = NONE GOMI = *.elc \ *.cp *.cps *.ky *.kys *.fn *.fns *.vr *.vrs \ @@ -24,10 +25,12 @@ FILES = README.?? Makefile FLIM-MK FLIM-CFG FLIM-ELS *.el ChangeLog elc: - $(EMACS) $(FLAGS) -f compile-flim $(PREFIX) $(LISPDIR) + $(EMACS) $(FLAGS) -f compile-flim $(PREFIX) $(LISPDIR) \ + $(VERSION_SPECIFIC_LISPDIR) install: elc - $(EMACS) $(FLAGS) -f install-flim $(PREFIX) $(LISPDIR) + $(EMACS) $(FLAGS) -f install-flim $(PREFIX) $(LISPDIR) \ + $(VERSION_SPECIFIC_LISPDIR) package: @@ -55,7 +58,7 @@ tar: sed "s/VERSION/$(VERSION)/" < ftp.in > ftp release: - -$(RM) /pub/GNU/elisp/apel/$(PACKAGE)-$(VERSION).tar.gz + -$(RM) /pub/GNU/elisp/flim/$(PACKAGE)-$(VERSION).tar.gz mv /tmp/$(PACKAGE)-$(VERSION).tar.gz /pub/GNU/elisp/flim/ cd /pub/GNU/elisp/semi/ ; \ ln -s ../flim/$(PACKAGE)-$(VERSION).tar.gz . diff --git a/README.en b/README.en index 9d90e48..4dce259 100644 --- a/README.en +++ b/README.en @@ -11,21 +11,24 @@ What's FLIM mime.el --- MIME library - mime-def.el --- Definitions about MIME format + mime-def.el --- Definitions about MIME format - mime-parse.el --- MIME parser + mime-parse.el --- MIME parser - mel.el --- MIME encoder/decoder - mel-dl.el --- base64 (b-encoding) encoder/decoder - (for Emacs 20 with dynamic loading support) - mel-b.el --- base64 (b-encoding) encoder/decoder - (for other emacsen) - mel-q.el --- quoted-printable and q-encoding encoder/decoder - mel-u.el --- unofficial module for uuencode - mel-g.el --- unofficial module for gzip64 + mel.el --- MIME encoder/decoder + mel-b-dl.el --- base64 (B-encoding) encoder/decoder + (for Emacs 20 with dynamic loading support) + mel-b.el --- base64 (B-encoding) encoder/decoder + (for other emacsen) + mel-q.el --- quoted-printable and Q-encoding + encoder/decoder + mel-ccl.el --- base64 (B-encoding), quoted-printable and + Q-encoding encoder/decoder using CCL + mel-u.el --- unofficial module for uuencode + mel-g.el --- unofficial module for gzip64 - eword-decode.el --- encoded-word decoder - eword-encode.el --- encoded-word encoder + eword-decode.el --- encoded-word decoder + eword-encode.el --- encoded-word encoder mailcap.el --- mailcap parser and utility @@ -84,6 +87,12 @@ Installation emacs command is used (perhaps /usr/local/share/emacs/site-lisp or /usr/local/lib/xemacs/site-lisp). + If the emu modules (included in APEL package) have been installed in + the non-standard directory, you should specify where they will be + found, for example: + + % make install VERSION_SPECIFIC_LISPDIR=~/elisp + You can specify other optional settings by editing the file FLIM-CFG. Please read comments in it. diff --git a/eword-decode.el b/eword-decode.el index 32fd1d4..02e1c9a 100644 --- a/eword-decode.el +++ b/eword-decode.el @@ -39,55 +39,32 @@ "Encoded-word decoding" :group 'mime) +(defcustom eword-max-size-to-decode 1000 + "*Max size to decode header field." + :group 'eword-decode + :type '(choice (integer :tag "Limit (bytes)") + (const :tag "Don't limit" nil))) + ;;; @ MIME encoded-word definition ;;; -(defconst eword-encoded-text-regexp "[!->@-~]+") +(eval-and-compile + (defconst eword-encoded-text-regexp "[!->@-~]+") + ) (defconst eword-encoded-word-regexp - (concat (regexp-quote "=?") - "\\(" - mime-charset-regexp - "\\)" - (regexp-quote "?") - "\\(B\\|Q\\)" - (regexp-quote "?") - "\\(" - eword-encoded-text-regexp - "\\)" - (regexp-quote "?="))) - - -;;; @@ Base64 -;;; - -(defconst base64-token-regexp "[A-Za-z0-9+/]") -(defconst base64-token-padding-regexp "[A-Za-z0-9+/=]") - -(defconst eword-B-encoded-text-regexp - (concat "\\(\\(" - base64-token-regexp - base64-token-regexp - base64-token-regexp - base64-token-regexp - "\\)*" - base64-token-regexp - base64-token-regexp - base64-token-padding-regexp - base64-token-padding-regexp - "\\)")) - -;; (defconst eword-B-encoding-and-encoded-text-regexp -;; (concat "\\(B\\)\\?" eword-B-encoded-text-regexp)) - - -;;; @@ Quoted-Printable -;;; - -(defconst eword-Q-encoded-text-regexp - (concat "\\([^=?]\\|" quoted-printable-octet-regexp "\\)+")) -;; (defconst eword-Q-encoding-and-encoded-text-regexp -;; (concat "\\(Q\\)\\?" eword-Q-encoded-text-regexp)) + (eval-when-compile + (concat (regexp-quote "=?") + "\\(" + mime-charset-regexp + "\\)" + (regexp-quote "?") + "\\(B\\|Q\\)" + (regexp-quote "?") + "\\(" + eword-encoded-text-regexp + "\\)" + (regexp-quote "?=")))) ;;; @ for string @@ -130,6 +107,117 @@ such as a version of Net$cape)." (concat dest string) )) +(defun eword-decode-and-fold-structured-field + (string start-column &optional max-column must-unfold) + "Decode and fold (fill) STRING as structured field body. +It decodes non us-ascii characters in FULL-NAME encoded as +encoded-words or invalid \"raw\" string. \"Raw\" non us-ascii +characters are regarded as variable `default-mime-charset'. + +If an encoded-word is broken or your emacs implementation can not +decode the charset included in it, it is not decoded. + +If MAX-COLUMN is omitted, `fill-column' is used. + +If MUST-UNFOLD is non-nil, it unfolds and eliminates line-breaks even +if there are in decoded encoded-words (generated by bad manner MUA +such as a version of Net$cape)." + (if (and eword-max-size-to-decode + (> (length string) eword-max-size-to-decode)) + string + (or max-column + (setq max-column fill-column)) + (let ((c start-column) + (tokens (eword-lexical-analyze string must-unfold)) + (result "") + token) + (while (and (setq token (car tokens)) + (setq tokens (cdr tokens))) + (let* ((type (car token))) + (if (eq type 'spaces) + (let* ((next-token (car tokens)) + (next-str (eword-decode-token next-token)) + (next-len (string-width next-str)) + (next-c (+ c next-len 1))) + (if (< next-c max-column) + (setq result (concat result " " next-str) + c next-c) + (setq result (concat result "\n " next-str) + c (1+ next-len))) + (setq tokens (cdr tokens)) + ) + (let* ((str (eword-decode-token token))) + (setq result (concat result str) + c (+ c (string-width str))) + )))) + (if token + (concat result (eword-decode-token token)) + result)))) + +(defun eword-decode-and-unfold-structured-field (string) + "Decode and unfold STRING as structured field body. +It decodes non us-ascii characters in FULL-NAME encoded as +encoded-words or invalid \"raw\" string. \"Raw\" non us-ascii +characters are regarded as variable `default-mime-charset'. + +If an encoded-word is broken or your emacs implementation can not +decode the charset included in it, it is not decoded." + (let ((tokens (eword-lexical-analyze string 'must-unfold)) + (result "")) + (while tokens + (let* ((token (car tokens)) + (type (car token))) + (setq tokens (cdr tokens)) + (setq result + (if (eq type 'spaces) + (concat result " ") + (concat result (eword-decode-token token)) + )))) + result)) + +(defun eword-decode-structured-field-body (string &optional must-unfold + start-column max-column) + "Decode non us-ascii characters in STRING as structured field body. +STRING is unfolded before decoding. + +It decodes non us-ascii characters in FULL-NAME encoded as +encoded-words or invalid \"raw\" string. \"Raw\" non us-ascii +characters are regarded as variable `default-mime-charset'. + +If an encoded-word is broken or your emacs implementation can not +decode the charset included in it, it is not decoded. + +If MUST-UNFOLD is non-nil, it unfolds and eliminates line-breaks even +if there are in decoded encoded-words (generated by bad manner MUA +such as a version of Net$cape)." + (if start-column + ;; fold with max-column + (eword-decode-and-fold-structured-field + string start-column max-column must-unfold) + ;; Don't fold + (mapconcat (function eword-decode-token) + (eword-lexical-analyze string must-unfold) + "") + )) + +(defun eword-decode-unstructured-field-body (string &optional must-unfold) + "Decode non us-ascii characters in STRING as unstructured field body. +STRING is unfolded before decoding. + +It decodes non us-ascii characters in FULL-NAME encoded as +encoded-words or invalid \"raw\" string. \"Raw\" non us-ascii +characters are regarded as variable `default-mime-charset'. + +If an encoded-word is broken or your emacs implementation can not +decode the charset included in it, it is not decoded. + +If MUST-UNFOLD is non-nil, it unfolds and eliminates line-breaks even +if there are in decoded encoded-words (generated by bad manner MUA +such as a version of Net$cape)." + (eword-decode-string + (decode-mime-charset-string string default-mime-charset) + must-unfold)) + ;;; @ for region ;;; @@ -180,6 +268,7 @@ Each field name must be symbol." (defcustom eword-decode-structured-field-list '(Reply-To Resent-Reply-To From Resent-From Sender Resent-Sender To Resent-To Cc Resent-Cc Bcc Resent-Bcc Dcc + Mail-Followup-To Mime-Version Content-Type Content-Transfer-Encoding Content-Disposition User-Agent) "*List of field-names to decode as structured field. @@ -317,22 +406,7 @@ if there are in decoded encoded-text (generated by bad manner MUA such as a version of Net$cape)." (let ((cs (mime-charset-to-coding-system charset))) (if cs - (let ((dest - (cond - ((string-equal "B" encoding) - (if (and (string-match eword-B-encoded-text-regexp string) - (string-equal string (match-string 0 string))) - (base64-decode-string string) - (error "Invalid encoded-text %s" string))) - ((string-equal "Q" encoding) - (if (and (string-match eword-Q-encoded-text-regexp string) - (string-equal string (match-string 0 string))) - (q-encoding-decode-string string) - (error "Invalid encoded-text %s" string))) - (t - (error "Invalid encoding %s" encoding) - ))) - ) + (let ((dest (encoded-text-decode-string string encoding))) (when dest (setq dest (decode-mime-charset-string dest charset)) (if must-unfold @@ -485,114 +559,6 @@ characters encoded as encoded-words or invalid \"raw\" format. (concat "(" (std11-wrap-as-quoted-pairs value '(?( ?))) ")")) (t value)))) -(defun eword-decode-and-fold-structured-field - (string start-column &optional max-column must-unfold) - "Decode and fold (fill) STRING as structured field body. -It decodes non us-ascii characters in FULL-NAME encoded as -encoded-words or invalid \"raw\" string. \"Raw\" non us-ascii -characters are regarded as variable `default-mime-charset'. - -If an encoded-word is broken or your emacs implementation can not -decode the charset included in it, it is not decoded. - -If MAX-COLUMN is omitted, `fill-column' is used. - -If MUST-UNFOLD is non-nil, it unfolds and eliminates line-breaks even -if there are in decoded encoded-words (generated by bad manner MUA -such as a version of Net$cape)." - (or max-column - (setq max-column fill-column)) - (let ((c start-column) - (tokens (eword-lexical-analyze string must-unfold)) - (result "") - token) - (while (and (setq token (car tokens)) - (setq tokens (cdr tokens))) - (let* ((type (car token))) - (if (eq type 'spaces) - (let* ((next-token (car tokens)) - (next-str (eword-decode-token next-token)) - (next-len (string-width next-str)) - (next-c (+ c next-len 1))) - (if (< next-c max-column) - (setq result (concat result " " next-str) - c next-c) - (setq result (concat result "\n " next-str) - c (1+ next-len))) - (setq tokens (cdr tokens)) - ) - (let* ((str (eword-decode-token token))) - (setq result (concat result str) - c (+ c (string-width str))) - )))) - (if token - (concat result (eword-decode-token token)) - result))) - -(defun eword-decode-and-unfold-structured-field (string) - "Decode and unfold STRING as structured field body. -It decodes non us-ascii characters in FULL-NAME encoded as -encoded-words or invalid \"raw\" string. \"Raw\" non us-ascii -characters are regarded as variable `default-mime-charset'. - -If an encoded-word is broken or your emacs implementation can not -decode the charset included in it, it is not decoded." - (let ((tokens (eword-lexical-analyze string 'must-unfold)) - (result "")) - (while tokens - (let* ((token (car tokens)) - (type (car token))) - (setq tokens (cdr tokens)) - (setq result - (if (eq type 'spaces) - (concat result " ") - (concat result (eword-decode-token token)) - )))) - result)) - -(defun eword-decode-structured-field-body (string &optional must-unfold - start-column max-column) - "Decode non us-ascii characters in STRING as structured field body. -STRING is unfolded before decoding. - -It decodes non us-ascii characters in FULL-NAME encoded as -encoded-words or invalid \"raw\" string. \"Raw\" non us-ascii -characters are regarded as variable `default-mime-charset'. - -If an encoded-word is broken or your emacs implementation can not -decode the charset included in it, it is not decoded. - -If MUST-UNFOLD is non-nil, it unfolds and eliminates line-breaks even -if there are in decoded encoded-words (generated by bad manner MUA -such as a version of Net$cape)." - (if start-column - ;; fold with max-column - (eword-decode-and-fold-structured-field - string start-column max-column must-unfold) - ;; Don't fold - (mapconcat (function eword-decode-token) - (eword-lexical-analyze string must-unfold) - "") - )) - -(defun eword-decode-unstructured-field-body (string &optional must-unfold) - "Decode non us-ascii characters in STRING as unstructured field body. -STRING is unfolded before decoding. - -It decodes non us-ascii characters in FULL-NAME encoded as -encoded-words or invalid \"raw\" string. \"Raw\" non us-ascii -characters are regarded as variable `default-mime-charset'. - -If an encoded-word is broken or your emacs implementation can not -decode the charset included in it, it is not decoded. - -If MUST-UNFOLD is non-nil, it unfolds and eliminates line-breaks even -if there are in decoded encoded-words (generated by bad manner MUA -such as a version of Net$cape)." - (eword-decode-string - (decode-mime-charset-string string default-mime-charset) - must-unfold)) - (defun eword-extract-address-components (string) "Extract full name and canonical address from STRING. Returns a list of the form (FULL-NAME CANONICAL-ADDRESS). diff --git a/eword-encode.el b/eword-encode.el index d7b77eb..c1603cd 100644 --- a/eword-encode.el +++ b/eword-encode.el @@ -85,6 +85,7 @@ If method is nil, this field will not be encoded." (euc-kr . "B") (iso-2022-jp-2 . "B") (iso-2022-int-1 . "B") + (utf-8 . "B") )) @@ -97,13 +98,7 @@ CHARSET is a symbol to indicate MIME charset of the encoded-word. ENCODING allows \"B\" or \"Q\". MODE is allows `text', `comment', `phrase' or nil. Default value is `phrase'." - (let ((text - (cond ((string= encoding "B") - (base64-encode-string string)) - ((string= encoding "Q") - (q-encoding-encode-string string mode)) - ) - )) + (let ((text (encoded-text-encode-string string encoding))) (if text (concat "=?" (upcase (symbol-name charset)) "?" encoding "?" text "?=") @@ -262,8 +257,7 @@ MODE is allows `text', `comment', `phrase' or nil. Default value is ) ((string-equal encoding "Q") (setq string (encode-mime-charset-string string charset)) - (q-encoding-encoded-length string - (ew-rword-type rword)) + (Q-encoded-text-length string (ew-rword-type rword)) ))) (if ret (cons (+ 7 (length (symbol-name charset)) ret) string) diff --git a/mel-b-dl.el b/mel-b-dl.el new file mode 100644 index 0000000..3adea3d --- /dev/null +++ b/mel-b-dl.el @@ -0,0 +1,121 @@ +;;; mel-b-dl.el: Base64 encoder/decoder using DL module + +;; Copyright (C) 1998 Free Software Foundation, Inc. + +;; Author: MORIOKA Tomohiko +;; 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) + +(eval-and-compile + (defvar base64-dl-handle + (and (file-exists-p base64-dl-module) + (dynamic-link base64-dl-module))) + + (dynamic-call "emacs_base64_init" base64-dl-handle) + ) + +(defun base64-encode-region (start end) + "Encode current region by base64. +START and END are buffer positions." + (interactive "r") + (let ((str (buffer-substring start end))) + (delete-region start end) + (insert (encode-base64-string str)) + ) + (or (bolp) + (insert "\n")) + ) + +(defun decode-base64-region (start end) + "Decode current region by base64. +START and END are buffer positions." + (interactive "r") + (let ((str (buffer-substring start end))) + (delete-region start end) + (condition-case err + (insert (decode-base64-string str)) + (error (message (nth 1 err))) + ))) + +(defalias 'base64-encode-string 'encode-base64-string) +(defalias 'base64-decode-string 'decode-base64-string) + + +(mel-define-method-function (mime-encode-string string (nil "base64")) + 'encode-base64-string) +(mel-define-method-function (mime-decode-string string (nil "base64")) + 'decode-base64-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")) + 'decode-base64-region) + +(mel-define-method-function (encoded-text-encode-string string (nil "B")) + 'encode-base64-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))) + (decode-base64-string string) + (error "Invalid encoded-text %s" string))) + + +;;; @ base64 encoder/decoder for file +;;; + +(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 (encode-base64-string + (with-temp-buffer + (set-buffer-multibyte nil) + (insert-file-contents-as-binary filename) + (buffer-string)))) + (or (bolp) + (insert "\n")) + ) + +;; (mel-define-method mime-write-decoded-region (start end filename +;; (nil "base64")) +;; "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: "))) +;; (let ((str (buffer-substring start end))) +;; (with-temp-buffer +;; (insert (decode-base64-string str)) +;; (write-region-as-binary (point-min) (point-max) filename) +;; ))) + + +;;; @ end +;;; + +(provide 'mel-b-dl) + +;;; mel-b-dl.el ends here. diff --git a/mel-b.el b/mel-b.el index ae5472a..ad34a37 100644 --- a/mel-b.el +++ b/mel-b.el @@ -60,7 +60,10 @@ external encoder is called." :type '(choice (const :tag "Always use internal encoder" nil) (integer :tag "Size"))) -(defcustom base64-internal-decoding-limit 70000 +(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." @@ -72,8 +75,10 @@ external decoder is called." ;;; @ internal base64 encoder ;;; based on base64 decoder by Enami Tsugutomo -(defconst base64-characters - "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/") +(eval-and-compile + (defconst base64-characters + "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/") + ) (defmacro base64-num-to-char (n) `(aref base64-characters ,n)) @@ -147,13 +152,14 @@ external decoder is called." ;;; (defconst base64-numbers - `,(let ((len (length base64-characters)) + (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)) + vec))) (defmacro base64-char-to-num (c) `(aref base64-numbers ,c)) @@ -191,15 +197,30 @@ external decoder is called." (defun base64-internal-decode-string (string) (base64-internal-decode string (make-string (length string) 0))) -(defsubst base64-decode-string! (string) - (base64-internal-decode string string)) +;; (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 (buffer-substring beg end))) + (let ((str (string-as-unibyte (buffer-substring beg end)))) (delete-region beg end) (goto-char beg) - (insert (base64-decode-string! str))))) + (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 @@ -284,6 +305,24 @@ metamail or XEmacs package)." (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 @@ -298,12 +337,16 @@ mmencode included in metamail or XEmacs package)." (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." @@ -322,19 +365,17 @@ START and END are buffer positions." (let ((str (buffer-substring start end))) (with-temp-buffer (insert (base64-internal-decode-string str)) - (write-region-as-binary (point-min) (point-max) filename))))) + (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 base64-encoded-length (string) - (let ((len (length string))) - (* (+ (/ len 3) - (if (= (mod len 3) 0) 0 1) - ) 4) - )) - (defun pack-sequence (seq size) "Split sequence SEQ into SIZE elements packs, and return list of packs. [mel-b; tl-seq function]" diff --git a/mel-ccl.el b/mel-ccl.el new file mode 100644 index 0000000..12b18e1 --- /dev/null +++ b/mel-ccl.el @@ -0,0 +1,1352 @@ +;;; mel-ccl.el: CCL based encoder/decoder of Base64, Quoted-Printable +;;; and Q-encoding + +;; Copyright (C) 1998 Tanaka Akira + +;; Author: Tanaka Akira +;; 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 diff --git a/mel-dl.el b/mel-dl.el deleted file mode 100644 index e1df065..0000000 --- a/mel-dl.el +++ /dev/null @@ -1,124 +0,0 @@ -;;; mel-dl.el: Base64 encoder/decoder using DL module - -;; Copyright (C) 1998 Free Software Foundation, Inc. - -;; Author: MORIOKA Tomohiko -;; 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) - -(defvar base64-dl-module - (expand-file-name "base64.so" exec-directory)) - -(defvar base64-dl-handle - (and (file-exists-p base64-dl-module) - (dynamic-link base64-dl-module))) - -(dynamic-call "emacs_base64_init" base64-dl-handle) - -(defalias 'base64-dl-encode-string 'encode-base64-string) -(defalias 'base64-dl-decode-string 'decode-base64-string) - -(defun base64-dl-encode-region (start end) - "Encode current region by base64. -START and END are buffer positions." - (interactive "r") - (let ((str (buffer-substring start end))) - (delete-region start end) - (insert (encode-base64-string str)) - ) - (or (bolp) - (insert "\n")) - ) - -(defun base64-dl-decode-region (start end) - "Decode current region by base64. -START and END are buffer positions." - (interactive "r") - (let ((str (buffer-substring start end))) - (delete-region start end) - (condition-case err - (insert (decode-base64-string str)) - (error (message (nth 1 err))) - ))) - -(defalias 'base64-encode-string 'encode-base64-string) -(defalias 'base64-decode-string 'decode-base64-string) -(defalias 'base64-encode-region 'base64-dl-encode-region) -(defalias 'base64-decode-region 'base64-dl-decode-region) - - -;;; @ base64 encoder/decoder for file -;;; - -(defvar base64-external-encoder '("mmencode") - "*list of base64 encoder program name and its arguments.") - -(defvar base64-external-decoder '("mmencode" "-u") - "*list of base64 decoder program name and its arguments.") - -(defvar base64-external-decoder-option-to-specify-file '("-o") - "*list of options of base64 decoder program to specify file.") - -(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: "))) - (apply (function call-process) (car base64-external-encoder) - filename t nil (cdr base64-external-encoder)) - ) - -(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: "))) - (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)) - ))) - - -;;; @ etc -;;; - -(defun base64-encoded-length (string) - (let ((len (length string))) - (* (+ (/ len 3) - (if (= (mod len 3) 0) 0 1) - ) 4) - )) - - -;;; @ end -;;; - -(provide 'mel-dl) - -;;; mel-dl.el ends here. diff --git a/mel-g.el b/mel-g.el index 73db30f..bc2c510 100644 --- a/mel-g.el +++ b/mel-g.el @@ -82,21 +82,40 @@ ) )) -(defalias 'gzip64-encode-region 'gzip64-external-encode-region) -(defalias 'gzip64-decode-region 'gzip64-external-decode-region) +(mel-define-method-function (mime-encode-region start end (nil "x-gzip64")) + 'gzip64-external-encode-region) +(mel-define-method-function (mime-decode-region start end (nil "x-gzip64")) + 'gzip64-external-decode-region) + + +;;; @ encoder/decoder for string +;;; + +(mel-define-method mime-encode-string (string (nil "x-gzip64")) + (with-temp-buffer + (insert string) + (gzip64-external-encode-region (point-min)(point-max)) + (buffer-string))) + +(mel-define-method mime-decode-string (string (nil "x-gzip64")) + (with-temp-buffer + (insert string) + (gzip64-external-decode-region (point-min)(point-max)) + (buffer-string))) ;;; @ encoder/decoder for file ;;; -(defun gzip64-insert-encoded-file (filename) +(mel-define-method mime-insert-encoded-file (filename (nil "x-gzip64")) (interactive (list (read-file-name "Insert encoded file: "))) (apply (function call-process) (car gzip64-external-encoder) filename t nil (cdr gzip64-external-encoder)) ) -(defun gzip64-write-decoded-region (start end filename) +(mel-define-method mime-write-decoded-region (start end filename + (nil "x-gzip64")) "Decode and write current region encoded by gzip64 into FILENAME. START and END are buffer positions." (interactive diff --git a/mel-q.el b/mel-q.el index 47a7a2b..0e80c16 100644 --- a/mel-q.el +++ b/mel-q.el @@ -144,7 +144,16 @@ the program (maybe mmencode included in metamail or XEmacs package)." )) -(defun quoted-printable-insert-encoded-file (filename) +(mel-define-method-function + (mime-encode-string string (nil "quoted-printable")) + 'quoted-printable-encode-string) + +(mel-define-method-function + (mime-encode-region start end (nil "quoted-printable")) + 'quoted-printable-encode-region) + +(mel-define-method mime-insert-encoded-file (filename + (nil "quoted-printable")) "Encode contents of file FILENAME to quoted-printable, and insert the result. It calls external quoted-printable encoder specified by `quoted-printable-external-encoder'. So you must install the program @@ -230,10 +239,20 @@ the program (maybe mmencode included in metamail or XEmacs package)." (buffer-string))) +(mel-define-method-function + (mime-decode-string string (nil "quoted-printable")) + 'quoted-printable-decode-string) + +(mel-define-method-function + (mime-decode-region start end (nil "quoted-printable")) + 'quoted-printable-decode-region) + + (defvar quoted-printable-external-decoder-option-to-specify-file '("-o") "*list of options of quoted-printable decoder program to specify file.") -(defun quoted-printable-write-decoded-region (start end filename) +(mel-define-method mime-write-decoded-region (start end filename + (nil "quoted-printable")) "Decode and write current region encoded by quoted-printable into FILENAME. START and END are buffer positions." (interactive @@ -303,31 +322,14 @@ MODE allows `text', `comment', `phrase' or nil. Default value is ))) string ""))) +(mel-define-method-function (encoded-text-encode-string string (nil "Q")) + 'q-encoding-encode-string) -;;; @@ etc -;;; - -(defun q-encoding-printable-char-p (chr mode) - (and (not (memq chr '(?= ?? ?_))) - (<= ?\ chr)(<= chr ?~) - (cond ((eq mode 'text) t) - ((eq mode 'comment) - (not (memq chr '(?\( ?\) ?\\))) - ) - (t - (string-match "[A-Za-z0-9!*+/=_---]" (char-to-string chr)) - )))) - -(defun q-encoding-encoded-length (string &optional mode) - (let ((l 0)(i 0)(len (length string)) chr) - (while (< i len) - (setq chr (elt string i)) - (if (q-encoding-printable-char-p chr mode) - (setq l (+ l 1)) - (setq l (+ l 3)) - ) - (setq i (+ i 1)) ) - l)) +(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-decode-string string) + (error "Invalid encoded-text %s" string))) ;;; @ end diff --git a/mel-u.el b/mel-u.el index d004d60..5a756aa 100644 --- a/mel-u.el +++ b/mel-u.el @@ -6,7 +6,7 @@ ;; Created: 1995/10/25 ;; Keywords: uuencode -;; This file is part of MEL (MIME Encoding Library). +;; 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 @@ -29,6 +29,9 @@ (require 'mime-def) +(mel-define-backend "x-uue") + + ;;; @ variables ;;; @@ -93,14 +96,32 @@ variable `uuencode-external-decoder'." )) ))) -(defalias 'uuencode-encode-region 'uuencode-external-encode-region) -(defalias 'uuencode-decode-region 'uuencode-external-decode-region) +(mel-define-method-function (mime-encode-region start end (nil "x-uue")) + 'uuencode-external-encode-region) +(mel-define-method-function (mime-decode-region start end (nil "x-uue")) + 'uuencode-external-decode-region) + + +;;; @ encoder/decoder for string +;;; + +(mel-define-method mime-encode-string (string (nil "x-uue")) + (with-temp-buffer + (insert string) + (uuencode-external-encode-region (point-min)(point-max)) + (buffer-string))) + +(mel-define-method mime-decode-string (string (nil "x-uue")) + (with-temp-buffer + (insert string) + (uuencode-external-decode-region (point-min)(point-max)) + (buffer-string))) ;;; @ uuencode encoder/decoder for file ;;; -(defun uuencode-insert-encoded-file (filename) +(mel-define-method mime-insert-encoded-file (filename (nil "x-uue")) "Insert file encoded by unofficial uuencode format. This function uses external uuencode encoder which is specified by variable `uuencode-external-encoder'." @@ -109,7 +130,8 @@ variable `uuencode-external-encoder'." (file-name-nondirectory filename)) ) -(defun uuencode-write-decoded-region (start end filename) +(mel-define-method mime-write-decoded-region (start end filename + (nil "x-gzip64")) "Decode and write current region encoded by uuencode into FILENAME. START and END are buffer positions." (interactive @@ -140,4 +162,6 @@ START and END are buffer positions." (provide 'mel-u) +(mel-define-backend "x-uuencode" ("x-uue")) + ;;; mel-u.el ends here diff --git a/mel.el b/mel.el index 2ed43a4..bd4ea11 100644 --- a/mel.el +++ b/mel.el @@ -3,11 +3,10 @@ ;; Copyright (C) 1995,1996,1997,1998 Free Software Foundation, Inc. ;; Author: MORIOKA Tomohiko -;; modified by Shuhei KOBAYASHI ;; Created: 1995/6/25 ;; Keywords: MIME, Base64, Quoted-Printable, uuencode, gzip64 -;; This file is part of MEL (MIME Encoding Library). +;; 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 @@ -26,240 +25,191 @@ ;;; Code: -(require 'emu) +(require 'mime-def) + +(defcustom mime-encoding-list + '("7bit" "8bit" "binary" "base64" "quoted-printable") + "List of Content-Transfer-Encoding. Each encoding must be string." + :group 'mime + :type '(repeat string)) + +(defun mime-encoding-list (&optional service) + "Return list of Content-Transfer-Encoding. +If SERVICE is specified, it returns available list of +Content-Transfer-Encoding for it." + (if service + (let (dest) + (mapatoms (lambda (sym) + (or (eq sym nil) + (setq dest (cons (symbol-name sym) dest))) + ) + (symbol-value (intern (format "%s-obarray" service)))) + (let ((rest mel-encoding-module-alist) + pair) + (while (setq pair (car rest)) + (let ((key (car pair))) + (or (member key dest) + (<= (length key) 1) + (setq dest (cons key dest)))) + (setq rest (cdr rest))) + ) + dest) + mime-encoding-list)) + +(defun mime-encoding-alist (&optional service) + "Return table of Content-Transfer-Encoding for completion." + (mapcar #'list (mime-encoding-list service)) + ) + +(defsubst mel-use-module (name encodings) + (let (encoding) + (while (setq encoding (car encodings)) + (set-alist 'mel-encoding-module-alist + encoding + (cons name (cdr (assoc encoding mel-encoding-module-alist)))) + (setq encodings (cdr encodings)) + ))) + +(defsubst mel-find-function (service encoding) + (mel-find-function-from-obarray + (symbol-value (intern (format "%s-obarray" service))) encoding)) -;;; @ variable +;;; @ setting for modules ;;; -(defvar base64-dl-module - (and (fboundp 'dynamic-link) - (let ((path (expand-file-name "base64.so" exec-directory))) - (and (file-exists-p path) - path)))) +(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")) -;;; @ autoload -;;; +(if mel-ccl-module + (mel-use-module 'mel-ccl '("base64" "quoted-printable" "B" "Q")) + ) -(cond (base64-dl-module - (autoload 'base64-encode-string "mel-dl" - "Encode STRING to base64, and return the result.") - (autoload 'base64-decode-string "mel-dl" - "Decode STRING which is encoded in base64, and return the result.") - (autoload 'base64-encode-region "mel-dl" - "Encode current region by base64." t) - (autoload 'base64-decode-region "mel-dl" - "Decode current region by base64." t) - (autoload 'base64-insert-encoded-file "mel-dl" - "Encode contents of file to base64, and insert the result." t) - (autoload 'base64-write-decoded-region "mel-dl" - "Decode and write current region encoded by base64 into FILENAME." t) - ;; for encoded-word - (autoload 'base64-encoded-length "mel-dl") - ) - (t - (autoload 'base64-encode-string "mel-b" - "Encode STRING to base64, and return the result.") - (autoload 'base64-decode-string "mel-b" - "Decode STRING which is encoded in base64, and return the result.") - (autoload 'base64-encode-region "mel-b" - "Encode current region by base64." t) - (autoload 'base64-decode-region "mel-b" - "Decode current region by base64." t) - (autoload 'base64-insert-encoded-file "mel-b" - "Encode contents of file to base64, and insert the result." t) - (autoload 'base64-write-decoded-region "mel-b" - "Decode and write current region encoded by base64 into FILENAME." t) - ;; for encoded-word - (autoload 'base64-encoded-length "mel-b") - )) - -(autoload 'quoted-printable-encode-string "mel-q" - "Encode STRING to quoted-printable, and return the result.") -(autoload 'quoted-printable-decode-string "mel-q" - "Decode STRING which is encoded in quoted-printable, and return the result.") -(autoload 'quoted-printable-encode-region "mel-q" - "Encode current region by Quoted-Printable." t) -(autoload 'quoted-printable-decode-region "mel-q" - "Decode current region by Quoted-Printable." t) -(autoload 'quoted-printable-insert-encoded-file "mel-q" - "Encode contents of file to quoted-printable, and insert the result." t) -(autoload 'quoted-printable-write-decoded-region "mel-q" - "Decode and write current region encoded by quoted-printable into FILENAME." - t) -;; for encoded-word -(autoload 'q-encoding-encode-string "mel-q" - "Encode STRING to Q-encoding of encoded-word, and return the result.") -(autoload 'q-encoding-decode-string "mel-q" - "Decode STRING which is encoded in Q-encoding and return the result.") -(autoload 'q-encoding-encoded-length "mel-q") - -(autoload 'uuencode-encode-region "mel-u" - "Encode current region by unofficial uuencode format." t) -(autoload 'uuencode-decode-region "mel-u" - "Decode current region by unofficial uuencode format." t) -(autoload 'uuencode-insert-encoded-file "mel-u" - "Insert file encoded by unofficial uuencode format." t) -(autoload 'uuencode-write-decoded-region "mel-u" - "Decode and write current region encoded by uuencode into FILENAME." t) - -(autoload 'gzip64-encode-region "mel-g" - "Encode current region by unofficial x-gzip64 format." t) -(autoload 'gzip64-decode-region "mel-g" - "Decode current region by unofficial x-gzip64 format." t) -(autoload 'gzip64-insert-encoded-file "mel-g" - "Insert file encoded by unofficial gzip64 format." t) -(autoload 'gzip64-write-decoded-region "mel-g" - "Decode and write current region encoded by gzip64 into FILENAME." t) +(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-method-function (mime-decode-string string (nil "7bit")) + 'identity) +(mel-define-method mime-encode-region (start end (nil "7bit"))) +(mel-define-method mime-decode-region (start end (nil "7bit"))) +(mel-define-method-function (mime-insert-encoded-file filename (nil "7bit")) + 'insert-file-contents-as-binary) +(mel-define-method-function (mime-write-decoded-region + start end filename (nil "7bit")) + 'write-region-as-binary) -;;; @ region -;;; +(mel-define-backend "8bit" ("7bit")) -;;;###autoload -(defvar mime-encoding-method-alist - '(("base64" . base64-encode-region) - ("quoted-printable" . quoted-printable-encode-region) - ;; Not standard, their use is DISCOURAGED. - ;; ("x-uue" . uuencode-encode-region) - ;; ("x-gzip64" . gzip64-encode-region) - ("7bit") - ("8bit") - ("binary") - ) - "Alist of encoding vs. corresponding method to encode region. -Each element looks like (STRING . FUNCTION) or (STRING . nil). -STRING is content-transfer-encoding. -FUNCTION is region encoder and nil means not to encode.") +(mel-define-backend "binary" ("8bit")) -;;;###autoload -(defvar mime-decoding-method-alist - '(("base64" . base64-decode-region) - ("quoted-printable" . quoted-printable-decode-region) - ("x-uue" . uuencode-decode-region) - ("x-uuencode" . uuencode-decode-region) - ("x-gzip64" . gzip64-decode-region) - ) - "Alist of encoding vs. corresponding method to decode region. -Each element looks like (STRING . FUNCTION). -STRING is content-transfer-encoding. -FUNCTION is region decoder.") + +;;; @ region +;;; ;;;###autoload (defun mime-encode-region (start end encoding) "Encode region START to END of current buffer using ENCODING. -ENCODING must be string. If ENCODING is found in -`mime-encoding-method-alist' as its key, this function encodes the -region by its value." +ENCODING must be string." (interactive (list (region-beginning) (region-end) (completing-read "encoding: " - mime-encoding-method-alist - nil t "base64")) - ) - (let ((f (cdr (assoc encoding mime-encoding-method-alist)))) - (if f - (funcall f start end) - ))) + (mime-encoding-alist) + nil t "base64"))) + (funcall (mel-find-function 'mime-encode-region encoding) start end) + ) + ;;;###autoload (defun mime-decode-region (start end encoding) "Decode region START to END of current buffer using ENCODING. -ENCODING must be string. If ENCODING is found in -`mime-decoding-method-alist' as its key, this function decodes the -region by its value." +ENCODING must be string." (interactive (list (region-beginning) (region-end) (completing-read "encoding: " - mime-decoding-method-alist - nil t "base64")) - ) - (let ((f (cdr (assoc encoding mime-decoding-method-alist)))) - (if f - (funcall f start end) - ))) + (mime-encoding-alist 'mime-decode-region) + nil t "base64"))) + (funcall (mel-find-function 'mime-decode-region encoding) + start end)) ;;; @ string ;;; ;;;###autoload -(defvar mime-string-decoding-method-alist - '(("base64" . base64-decode-string) - ("quoted-printable" . quoted-printable-decode-string) - ("7bit" . identity) - ("8bit" . identity) - ("binary" . identity) - ) - "Alist of encoding vs. corresponding method to decode string. -Each element looks like (STRING . FUNCTION). -STRING is content-transfer-encoding. -FUNCTION is string decoder.") - -;;;###autoload (defun mime-decode-string (string encoding) "Decode STRING using ENCODING. ENCODING must be string. If ENCODING is found in `mime-string-decoding-method-alist' as its key, this function decodes the STRING by its value." - (let ((f (cdr (assoc encoding mime-string-decoding-method-alist)))) - (if f - (funcall f string) - (with-temp-buffer - (insert string) - (mime-decode-region (point-min)(point-max) encoding) - (buffer-string) - )))) + (funcall (mel-find-function 'mime-decode-string encoding) + string)) + + +(mel-define-service encoded-text-encode-string (string encoding) + "Encode STRING as encoded-text using ENCODING. +ENCODING must be string.") + +(mel-define-service encoded-text-decode-string (string encoding) + "Decode STRING as encoded-text using ENCODING. +ENCODING must be string.") + +(defun base64-encoded-length (string) + (let ((len (length string))) + (* (+ (/ len 3) + (if (= (mod len 3) 0) 0 1) + ) 4) + )) + +(defsubst Q-encoding-printable-char-p (chr mode) + (and (not (memq chr '(?= ?? ?_))) + (<= ?\ chr)(<= chr ?~) + (cond ((eq mode 'text) t) + ((eq mode 'comment) + (not (memq chr '(?\( ?\) ?\\))) + ) + (t + (string-match "[A-Za-z0-9!*+/=_---]" (char-to-string chr)) + )))) + +(defun Q-encoded-text-length (string &optional mode) + (let ((l 0)(i 0)(len (length string)) chr) + (while (< i len) + (setq chr (elt string i)) + (if (Q-encoding-printable-char-p chr mode) + (setq l (+ l 1)) + (setq l (+ l 3)) + ) + (setq i (+ i 1)) ) + l)) ;;; @ file ;;; ;;;###autoload -(defvar mime-file-encoding-method-alist - '(("base64" . base64-insert-encoded-file) - ("quoted-printable" . quoted-printable-insert-encoded-file) - ;; Not standard, their use is DISCOURAGED. - ;; ("x-uue" . uuencode-insert-encoded-file) - ;; ("x-gzip64" . gzip64-insert-encoded-file) - ("7bit" . insert-file-contents-as-binary) - ("8bit" . insert-file-contents-as-binary) - ("binary" . insert-file-contents-as-binary) - ) - "Alist of encoding vs. corresponding method to insert encoded file. -Each element looks like (STRING . FUNCTION). -STRING is content-transfer-encoding. -FUNCTION is function to insert encoded file.") - -;;;###autoload -(defvar mime-file-decoding-method-alist - '(("base64" . base64-write-decoded-region) - ("quoted-printable" . quoted-printable-write-decoded-region) - ("x-uue" . uuencode-write-decoded-region) - ("x-gzip64" . gzip64-write-decoded-region) - ("7bit" . write-region-as-binary) - ("8bit" . write-region-as-binary) - ("binary" . write-region-as-binary) - ) - "Alist of encoding vs. corresponding method to write decoded region to file. -Each element looks like (STRING . FUNCTION). -STRING is content-transfer-encoding. -FUNCTION is function to write decoded region to file.") - -;;;###autoload (defun mime-insert-encoded-file (filename encoding) "Insert file FILENAME encoded by ENCODING format." (interactive (list (read-file-name "Insert encoded file: ") (completing-read "encoding: " - mime-encoding-method-alist - nil t "base64")) - ) - (let ((f (cdr (assoc encoding mime-file-encoding-method-alist)))) - (if f - (funcall f filename) - ))) + (mime-encoding-alist) + nil t "base64"))) + (funcall (mel-find-function 'mime-insert-encoded-file encoding) + filename)) + ;;;###autoload (defun mime-write-decoded-region (start end filename encoding) @@ -269,12 +219,10 @@ START and END are buffer positions." (list (region-beginning) (region-end) (read-file-name "Write decoded region to file: ") (completing-read "encoding: " - mime-file-decoding-method-alist + (mime-encoding-alist 'mime-write-decoded-region) nil t "base64"))) - (let ((f (cdr (assoc encoding mime-file-decoding-method-alist)))) - (if f - (funcall f start end filename) - ))) + (funcall (mel-find-function 'mime-write-decoded-region encoding) + start end filename)) ;;; @ end diff --git a/mime-def.el b/mime-def.el index 2e308c7..3106078 100644 --- a/mime-def.el +++ b/mime-def.el @@ -24,15 +24,26 @@ ;;; Code: -(defconst mime-library-version - '("FLIM" "Shin-Tanabe" 1 9 2) - "Implementation name, version name and numbers of MIME-library package.") +(eval-and-compile + (defconst mime-library-product ["FLIM" (1 10 4) "Shin-H.DŽòsono"] + "Product name, version number and code name of MIME-library package.") + ) + +(defmacro mime-product-name (product) + `(aref ,product 0)) -(defconst mime-library-version-string - `,(concat (car mime-library-version) " " +(defmacro mime-product-version (product) + `(aref ,product 1)) + +(defmacro mime-product-code-name (product) + `(aref ,product 2)) + +(defconst mime-library-version + (eval-when-compile + (concat (mime-product-name mime-library-product) " " (mapconcat #'number-to-string - (cddr mime-library-version) ".") - " - \"" (cadr mime-library-version) "\"")) + (mime-product-version mime-library-product) ".") + " - \"" (mime-product-code-name mime-library-product) "\""))) ;;; @ variables @@ -107,7 +118,30 @@ (concat mime-token-regexp "/" mime-token-regexp)) -;;; @@ Quoted-Printable +;;; @@ base64 / B +;;; + +(defconst base64-token-regexp "[A-Za-z0-9+/]") +(defconst base64-token-padding-regexp "[A-Za-z0-9+/=]") + +(defconst B-encoded-text-regexp + (concat "\\(\\(" + base64-token-regexp + base64-token-regexp + base64-token-regexp + base64-token-regexp + "\\)*" + base64-token-regexp + base64-token-regexp + base64-token-padding-regexp + base64-token-padding-regexp + "\\)")) + +;; (defconst eword-B-encoding-and-encoded-text-regexp +;; (concat "\\(B\\)\\?" eword-B-encoded-text-regexp)) + + +;;; @@ Quoted-Printable / Q ;;; (defconst quoted-printable-hex-chars "0123456789ABCDEF") @@ -116,6 +150,12 @@ (concat "=[" quoted-printable-hex-chars "][" quoted-printable-hex-chars "]")) +(defconst Q-encoded-text-regexp + (concat "\\([^=?]\\|" quoted-printable-octet-regexp "\\)+")) + +;; (defconst eword-Q-encoding-and-encoded-text-regexp +;; (concat "\\(Q\\)\\?" eword-Q-encoded-text-regexp)) + ;;; @ Content-Type ;;; @@ -275,9 +315,14 @@ message/rfc822, `mime-entity' structures of them are included in ;;; @ for mm-backend ;;; +(require 'alist) + (defvar mime-entity-implementation-alist nil) (defmacro mm-define-backend (type &optional parents) + "Define TYPE as a mm-backend. +If PARENTS is specified, TYPE inherits PARENTS. +Each parent must be backend name (symbol)." (if parents `(let ((rest ',(reverse parents))) (while rest @@ -290,6 +335,11 @@ message/rfc822, `mime-entity' structures of them are included in )))) (defmacro mm-define-method (name args &rest body) + "Define NAME as a method function of (nth 1 (car ARGS)) backend. + +ARGS is like an argument list of lambda, but (car ARGS) must be +specialized parameter. (car (car ARGS)) is name of variable and (nth +1 (car ARGS)) is name of backend." (let* ((specializer (car args)) (class (nth 1 specializer)) (self (car specializer))) @@ -310,6 +360,128 @@ message/rfc822, `mime-entity' structures of them are included in (put 'mm-define-method 'edebug-form-spec '(&define name ((arg symbolp) &rest arg) def-body)) +(defsubst mm-arglist-to-arguments (arglist) + (let (dest) + (while arglist + (let ((arg (car arglist))) + (or (memq arg '(&optional &rest)) + (setq dest (cons arg dest))) + ) + (setq arglist (cdr arglist))) + (nreverse dest))) + + +;;; @ for mel-backend +;;; + +(defvar mel-service-list nil) + +(defmacro mel-define-service (name &optional args &rest rest) + "Define NAME as a service for Content-Transfer-Encodings. +If ARGS is specified, NAME is defined as a generic function for the +service." + `(progn + (add-to-list 'mel-service-list ',name) + (defvar ,(intern (format "%s-obarray" name)) (make-vector 1 nil)) + ,@(if args + `((defun ,name ,args + ,@rest + (funcall (mel-find-function ',name ,(car (last args))) + ,@(mm-arglist-to-arguments (butlast args))) + ))) + )) + +(put 'mel-define-service 'lisp-indent-function 'defun) + + +(defvar mel-encoding-module-alist nil) + +(defsubst mel-find-function-from-obarray (ob-array encoding) + (let* ((f (intern-soft encoding ob-array))) + (or f + (let ((rest (cdr (assoc encoding mel-encoding-module-alist)))) + (while (and rest + (progn + (require (car rest)) + (null (setq f (intern-soft encoding ob-array))) + )) + (setq rest (cdr rest)) + ) + f)))) + +(defsubst mel-copy-method (service src-backend dst-backend) + (let* ((oa (symbol-value (intern (format "%s-obarray" service)))) + (f (mel-find-function-from-obarray oa src-backend)) + sym) + (when f + (setq sym (intern dst-backend oa)) + (or (fboundp sym) + (fset sym (symbol-function f)) + )))) + +(defsubst mel-copy-backend (src-backend dst-backend) + (let ((services mel-service-list)) + (while services + (mel-copy-method (car services) src-backend dst-backend) + (setq services (cdr services))))) + +(defmacro mel-define-backend (type &optional parents) + "Define TYPE as a mel-backend. +If PARENTS is specified, TYPE inherits PARENTS. +Each parent must be backend name (string)." + (cons 'progn + (mapcar (lambda (parent) + `(mel-copy-backend ,parent ,type) + ) + parents))) + +(defmacro mel-define-method (name args &rest body) + "Define NAME as a method function of (nth 1 (car (last ARGS))) backend. +ARGS is like an argument list of lambda, but (car (last ARGS)) must be +specialized parameter. (car (car (last ARGS))) is name of variable +and (nth 1 (car (last ARGS))) is name of backend (encoding)." + (let* ((specializer (car (last args))) + (class (nth 1 specializer))) + `(progn + (mel-define-service ,name) + (fset (intern ,class ,(intern (format "%s-obarray" name))) + (lambda ,(butlast args) + ,@body))))) + +(put 'mel-define-method 'lisp-indent-function 'defun) + +(defmacro mel-define-method-function (spec function) + "Set SPEC's function definition to FUNCTION. +First element of SPEC is service. +Rest of ARGS is like an argument list of lambda, but (car (last ARGS)) +must be specialized parameter. (car (car (last ARGS))) is name of +variable and (nth 1 (car (last ARGS))) is name of backend (encoding)." + (let* ((name (car spec)) + (args (cdr spec)) + (specializer (car (last args))) + (class (nth 1 specializer))) + `(let (sym) + (mel-define-service ,name) + (setq sym (intern ,class ,(intern (format "%s-obarray" name)))) + (or (fboundp sym) + (fset sym (symbol-function ,function)))))) + +(defmacro mel-define-function (function spec) + (let* ((name (car spec)) + (args (cdr spec)) + (specializer (car (last args))) + (class (nth 1 specializer))) + `(progn + (define-function ,function + (intern ,class ,(intern (format "%s-obarray" name)))) + ))) + +(defvar base64-dl-module + (and (fboundp 'dynamic-link) + (let ((path (expand-file-name "base64.so" exec-directory))) + (and (file-exists-p path) + path)))) + ;;; @ end ;;; diff --git a/mime-en.sgml b/mime-en.sgml index ed4b19f..1aeb63c 100644 --- a/mime-en.sgml +++ b/mime-en.sgml @@ -1,6 +1,6 @@ -FLIM 1.9 Manual about MIME Features +<title>FLIM 1.10 Manual about MIME Features <author>MORIOKA Tomohiko <mail>morioka@jaist.ac.jp</mail> <date>1998/07/01 @@ -393,12 +393,42 @@ return the result. </defun> -<h3> How to make mm-backend +<h3> Definition of mm-backend <node> mm-backend module <p> -(It is not written yet, sorry. (^_^;) +<defmacro name="mm-define-backend"> +<args> type +<opts> parents <p> -(Please read mm*.el) +Define <var>type</var> as a mm-backend. +<p> +If <var>PARENTS</var> is specified, <var>type</var> inherits parents. +Each parent must be representation-type. +<p> +Example: +<p> +<lisp> +(mm-define-backend chao (generic)) +</lisp> +</defmacro> + +<defmacro name="mm-define-method"> +<args> name args <rest> body +<p> +Define <var>name</var> as a method function of (nth 1 (car +<var>args</var>)) backend. +<p> +<var>args</var> is like an argument list of lambda, but (car +<var>args</var>) must be specialized parameter. (car (car +<var>args</var>)) is name of variable and (nth 1 (car +<var>args</var>)) is name of backend (representation-type). +<p> +Example: +<p> +<lisp> +(mm-define-method entity-cooked-p ((entity chao)) nil) +</lisp> +</defmacro> <h1> Information of Content-Type field @@ -636,8 +666,8 @@ Content-Transfer-Encoding $BMs$,B8:_$7$J$$>l9g$O(B </defun> -<h2> Region encoding/decoding -<node> Region encoder/decoder +<h2> Encoder/decoder +<node> encoder/decoder <p> <defun name="mime-encode-region"> <args> start end encoding @@ -653,49 +683,14 @@ Decode region <var>start</var> to <var>end</var> of current buffer using <var>encoding</var>. </defun> -<defvar name="mime-encoding-method-alist"> -<p> -Alist of encoding vs. corresponding method to encode region. -<p> -Each element looks like <code>(STRING . FUNCTION)</code> or -<code>(STRING . nil)</code>. <var>string</var> is -content-transfer-encoding. <code>function</code> is region encoder -and <code>nil</code> means not to encode. -</defvar> -<defvar name="mime-decoding-method-alist"> -<p> -Alist of encoding vs. corresponding method to decode region. -<p> -Each element looks like <code>(STRING . FUNCTION)</code> or -<code>(STRING . nil)</code>. <var>string</var> is -content-transfer-encoding. <code>function</code> is region decoder -and <code>nil</code> means not to decode. -</defvar> - - -<h2> String encoding/decoding -<node> String encoder/decoder -<p> <defun name="mime-decode-string"> <args> string encoding <p> <var>string</var> $B$r(B <var>encoding</var> $B$H$7$FI|9f$7$?7k2L$rJV$7$^$9!#(B </defun> -<defvar name="mime-string-decoding-method-alist"> -<p> -Alist of encoding vs. corresponding method to decode string. -<p> -Each element looks like <code>(STRING . FUNCTION)</code>. -STRING is content-transfer-encoding. -FUNCTION is string decoder. -</defvar> - -<h2> File encoding/decoding -<node> File encoder/decoder -<p> <defun name="mime-insert-encoded-file"> <args> filename encoding <p> @@ -711,24 +706,102 @@ Decode and write current region encoded by <var>encoding</var> into <var>start</var> and <var>end</var> are buffer positions. </defun> -<defvar name="mime-file-encoding-method-alist"> + +<h2> Other utilities +<node> Encoding information <p> -Alist of encoding vs. corresponding method to insert encoded file. +<defun name="mime-encoding-list"> + <opts> SERVICE <p> -Each element looks like <code>(STRING . FUNCTION)</code>. STRING is -content-transfer-encoding. FUNCTION is function to insert encoded -file. -</defvar> +Return list of Content-Transfer-Encoding. +<p> +If <var>service</var> is specified, it returns available list of +Content-Transfer-Encoding for it. +</defun> -<defvar name="mime-file-decoding-method-alist"> +<defun name="mime-encoding-alist"> + <opts> SERVICE <p> -Alist of encoding vs. corresponding method to write decoded region to -file. +Return table of Content-Transfer-Encoding for completion. <p> -Each element looks like <code>(STRING . FUNCTION)</code>. STRING is -content-transfer-encoding. FUNCTION is function to write decoded -region to file. -</defvar> +If <var>service</var> is specified, it returns available list of +Content-Transfer-Encoding for it. +</defun> + + +<h2> How to write encoder/decoder module +<node> mel-backend +<p> +<defmacro name="mel-define-method"> +<args> name args <rest> body +<p> +Define <var>name</var> as a method function of (nth 1 (car (last +<var>args</var>))) backend. +<p> +<var>args</var> is like an argument list of lambda, but (car (last +<var>args</var>)) must be specialized parameter. (car (car (last +<var>args</var>))) is name of variable and (nth 1 (car (last +<var>args</var>))) is name of backend (encoding). +<p> +Example: +<p> +<lisp> +(mel-define-method mime-write-decoded-region (start end filename + (nil "base64")) + "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: "))) + (let ((str (buffer-substring start end))) + (with-temp-buffer + (insert (decode-base64-string str)) + (write-region-as-binary (point-min) (point-max) filename) + ))) +</lisp> +</defmacro> + +<defmacro name="mel-define-method-function"> +<args> spec function +<p> +Set <var>spec</var>'s function definition to <var>function</var>. +<p> +First element of <var>spec</var> is service. +<p> +Rest of <var>args</var> is like an argument list of lambda, but (car +(last <var>args</var>)) must be specialized parameter. (car (car +(last <var>args</var>))) is name of variable and (nth 1 (car (last +<var>args</var>))) is name of backend (encoding). +<p> +Example: +<p> +<lisp> +(mel-define-method-function (mime-encode-string string (nil "base64")) + 'encode-base64-string) +</lisp> +</defmacro> + + +<h2> How to add encoding/decoding service +<node> generic function for mel-backend +<p> +<defmacro name="mel-define-service"> +<args> name +<opts> args doc-string +<p> +Define <var>name</var> as a service for Content-Transfer-Encodings. +<p> +If <var>args</var> is specified, <var>name</var> is defined as a +generic function for the service. +<p> +Example: +<p> +<lisp> +(mel-define-service encoded-text-encode-string (string encoding) + "Encode STRING as encoded-text using ENCODING. +ENCODING must be string.") +</lisp> +</defmacro> <h1> Network representation of header diff --git a/mime-en.texi b/mime-en.texi index f3bbf8a..1f28037 100644 --- a/mime-en.texi +++ b/mime-en.texi @@ -1,13 +1,13 @@ \input texinfo.tex @setfilename mime-en.info -@settitle{FLIM 1.9 Manual about MIME Features} +@settitle{FLIM 1.10 Manual about MIME Features} @titlepage -@title FLIM 1.9 Manual about MIME Features +@title FLIM 1.10 Manual about MIME Features @author MORIOKA Tomohiko <morioka@@jaist.ac.jp> @subtitle 1998/07/01 @end titlepage @node Top, Introduction, (dir), (dir) -@top FLIM 1.9 Manual about MIME Features +@top FLIM 1.10 Manual about MIME Features @ifinfo @@ -414,7 +414,7 @@ when its entity is created at first. @menu * Request for entity:: Message-passing for entity -* mm-backend module:: How to make mm-backend +* mm-backend module:: Definition of mm-backend @end menu @node Request for entity, mm-backend module, mm-backend, mm-backend @@ -431,11 +431,40 @@ result.@refill @node mm-backend module, , Request for entity, mm-backend -@subsection How to make mm-backend +@subsection Definition of mm-backend -(It is not written yet, sorry. (^_^;)@refill +@defmac mm-define-backend type &optional parents + +Define @var{type} as a mm-backend.@refill + +If @var{PARENTS} is specified, @var{type} inherits parents. Each parent +must be representation-type.@refill + +Example:@refill + +@lisp +(mm-define-backend chao (generic)) +@end lisp +@end defmac + + +@defmac mm-define-method name args &rest body + +Define @var{name} as a method function of (nth 1 (car @var{args})) +backend.@refill + +@var{args} is like an argument list of lambda, but (car @var{args}) must +be specialized parameter. (car (car @var{args})) is name of variable +and (nth 1 (car @var{args})) is name of backend +(representation-type).@refill + +Example:@refill + +@lisp +(mm-define-method entity-cooked-p ((entity chao)) nil) +@end lisp +@end defmac -(Please read mm*.el) @node Content-Type, Content-Disposition, Entity, Top @@ -694,12 +723,13 @@ Content-Transfer-Encoding. @menu * Content-Transfer-Encoding parser:: Parser -* Region encoder/decoder:: Region encoding/decoding -* String encoder/decoder:: String encoding/decoding -* File encoder/decoder:: File encoding/decoding +* encoder/decoder:: Encoder/decoder +* Encoding information:: Other utilities +* mel-backend:: How to write encoder/decoder module +* generic function for mel-backend:: How to add encoding/decoding service @end menu -@node Content-Transfer-Encoding parser, Region encoder/decoder, Content-Transfer-Encoding, Content-Transfer-Encoding +@node Content-Transfer-Encoding parser, encoder/decoder, Content-Transfer-Encoding, Content-Transfer-Encoding @section Parser @defun mime-parse-Content-Transfer-Encoding string @@ -719,8 +749,8 @@ Content-Transfer-Encoding $BMs$,B8:_$7$J$$>l9g$O(B@var{default-encoding} $B$r -@node Region encoder/decoder, String encoder/decoder, Content-Transfer-Encoding parser, Content-Transfer-Encoding -@section Region encoding/decoding +@node encoder/decoder, Encoding information, Content-Transfer-Encoding parser, Content-Transfer-Encoding +@section Encoder/decoder @defun mime-encode-region start end encoding @@ -736,83 +766,123 @@ Decode region @var{start} to @var{end} of current buffer using @end defun -@defvar mime-encoding-method-alist - -Alist of encoding vs. corresponding method to encode region.@refill -Each element looks like @code{(STRING . FUNCTION)} or @code{(STRING -. nil)}. @var{string} is content-transfer-encoding. @code{function} is -region encoder and @code{nil} means not to encode. -@end defvar +@defun mime-decode-string string encoding +@var{string} $B$r(B @var{encoding} $B$H$7$FI|9f$7$?7k2L$rJV$7$^$9!#(B +@end defun -@defvar mime-decoding-method-alist -Alist of encoding vs. corresponding method to decode region.@refill -Each element looks like @code{(STRING . FUNCTION)} or @code{(STRING -. nil)}. @var{string} is content-transfer-encoding. @code{function} is -region decoder and @code{nil} means not to decode. -@end defvar +@defun mime-insert-encoded-file filename encoding +Insert file @var{FILENAME} encoded by @var{ENCODING} format. +@end defun -@node String encoder/decoder, File encoder/decoder, Region encoder/decoder, Content-Transfer-Encoding -@section String encoding/decoding +@defun mime-write-decoded-region start end filename encoding -@defun mime-decode-string string encoding +Decode and write current region encoded by @var{encoding} into +@var{filename}.@refill -@var{string} $B$r(B @var{encoding} $B$H$7$FI|9f$7$?7k2L$rJV$7$^$9!#(B +@var{start} and @var{end} are buffer positions. @end defun -@defvar mime-string-decoding-method-alist -Alist of encoding vs. corresponding method to decode string.@refill +@node Encoding information, mel-backend, encoder/decoder, Content-Transfer-Encoding +@section Other utilities -Each element looks like @code{(STRING . FUNCTION)}. STRING is -content-transfer-encoding. FUNCTION is string decoder. -@end defvar +@defun mime-encoding-list &optional SERVICE +Return list of Content-Transfer-Encoding.@refill +If @var{service} is specified, it returns available list of +Content-Transfer-Encoding for it. +@end defun -@node File encoder/decoder, , String encoder/decoder, Content-Transfer-Encoding -@section File encoding/decoding -@defun mime-insert-encoded-file filename encoding +@defun mime-encoding-alist &optional SERVICE -Insert file @var{FILENAME} encoded by @var{ENCODING} format. +Return table of Content-Transfer-Encoding for completion.@refill + +If @var{service} is specified, it returns available list of +Content-Transfer-Encoding for it. @end defun -@defun mime-write-decoded-region start end filename encoding -Decode and write current region encoded by @var{encoding} into -@var{filename}.@refill +@node mel-backend, generic function for mel-backend, Encoding information, Content-Transfer-Encoding +@section How to write encoder/decoder module -@var{start} and @var{end} are buffer positions. -@end defun +@defmac mel-define-method name args &rest body +Define @var{name} as a method function of (nth 1 (car (last +@var{args}))) backend.@refill -@defvar mime-file-encoding-method-alist +@var{args} is like an argument list of lambda, but (car (last +@var{args})) must be specialized parameter. (car (car (last +@var{args}))) is name of variable and (nth 1 (car (last @var{args}))) is +name of backend (encoding).@refill -Alist of encoding vs. corresponding method to insert encoded -file.@refill +Example:@refill -Each element looks like @code{(STRING . FUNCTION)}. STRING is -content-transfer-encoding. FUNCTION is function to insert encoded file. -@end defvar +@lisp +(mel-define-method mime-write-decoded-region (start end filename + (nil "base64")) + "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: "))) + (let ((str (buffer-substring start end))) + (with-temp-buffer + (insert (decode-base64-string str)) + (write-region-as-binary (point-min) (point-max) filename) + ))) +@end lisp +@end defmac -@defvar mime-file-decoding-method-alist +@defmac mel-define-method-function spec function -Alist of encoding vs. corresponding method to write decoded region to -file.@refill +Set @var{spec}'s function definition to @var{function}.@refill -Each element looks like @code{(STRING . FUNCTION)}. STRING is -content-transfer-encoding. FUNCTION is function to write decoded region -to file. -@end defvar +First element of @var{spec} is service.@refill + +Rest of @var{args} is like an argument list of lambda, but (car (last +@var{args})) must be specialized parameter. (car (car (last +@var{args}))) is name of variable and (nth 1 (car (last @var{args}))) is +name of backend (encoding).@refill + +Example:@refill + +@lisp +(mel-define-method-function (mime-encode-string string (nil "base64")) + 'encode-base64-string) +@end lisp +@end defmac + + + +@node generic function for mel-backend, , mel-backend, Content-Transfer-Encoding +@section How to add encoding/decoding service + +@defmac mel-define-service name &optional args doc-string + +Define @var{name} as a service for Content-Transfer-Encodings.@refill + +If @var{args} is specified, @var{name} is defined as a generic function +for the service.@refill + +Example:@refill + +@lisp +(mel-define-service encoded-text-encode-string (string encoding) + "Encode STRING as encoded-text using ENCODING. +ENCODING must be string.") +@end lisp +@end defmac diff --git a/mime-ja.sgml b/mime-ja.sgml index 8240d6b..50d67d3 100644 --- a/mime-ja.sgml +++ b/mime-ja.sgml @@ -1,6 +1,6 @@ <!doctype sinfo system> <head> -<title>FLIM 1.9 MIME $B5!G=@bL@=q(B +<title>FLIM 1.10 MIME $B5!G=@bL@=q(B <author>$B<i2,(B $BCNI'(B <mail>morioka@jaist.ac.jp</mail> <date>1998/07/01 @@ -396,9 +396,39 @@ representation-type $B$NL>A0$N@hF,$K(B <code>mm</code> $B$rIU$1$?$b$N$K$J$C$F <h3> mm-backend $B$N:n$jJ}(B <node> mm-backend module <p> -$B!J$9$_$^$;$s!#$=$N$&$A=q$-$^$9(B (^_^;$B!K(B +<defmacro name="mm-define-backend"> +<args> type +<opts> parents <p> -$B!J$H$j$"$($:!"(Bmm*.el $B$r;29M$K$7$F$/$@$5$$!K(B +Define <var>type</var> as a mm-backend. +<p> +If <var>PARENTS</var> is specified, <var>type</var> inherits parents. +Each parent must be representation-type. +<p> +Example: +<p> +<lisp> +(mm-define-backend chao (generic)) +</lisp> +</defmacro> + +<defmacro name="mm-define-method"> +<args> name args <rest> body +<p> +Define <var>name</var> as a method function of (nth 1 (car +<var>args</var>)) backend. +<p> +<var>args</var> is like an argument list of lambda, but (car +<var>args</var>) must be specialized parameter. (car (car +<var>args</var>)) is name of variable and (nth 1 (car +<var>args</var>)) is name of backend (representation-type). +<p> +Example: +<p> +<lisp> +(mm-define-method entity-cooked-p ((entity chao)) nil) +</lisp> +</defmacro> <h1> Content-Type $BMs$N>pJs(B @@ -632,8 +662,8 @@ Content-Transfer-Encoding $BMs$,B8:_$7$J$$>l9g$O(B </defun> -<h2> $BNN0h$NId9f2=!&I|9f2=(B -<node> Region encoder/decoder +<h2> $BId9f2=!&I|9f2=(B +<node> encoder/decoder <p> <defun name="mime-encode-region"> <args> start end encoding @@ -649,49 +679,14 @@ Decode region <var>start</var> to <var>end</var> of current buffer using <var>encoding</var>. </defun> -<defvar name="mime-encoding-method-alist"> -<p> -Alist of encoding vs. corresponding method to encode region. -<p> -Each element looks like <code>(STRING . FUNCTION)</code> or -<code>(STRING . nil)</code>. <var>string</var> is -content-transfer-encoding. <code>function</code> is region encoder -and <code>nil</code> means not to encode. -</defvar> -<defvar name="mime-decoding-method-alist"> -<p> -Alist of encoding vs. corresponding method to decode region. -<p> -Each element looks like <code>(STRING . FUNCTION)</code> or -<code>(STRING . nil)</code>. <var>string</var> is -content-transfer-encoding. <code>function</code> is region decoder -and <code>nil</code> means not to decode. -</defvar> - - -<h2> $BJ8;zNs$NId9f2=!&I|9f2=(B -<node> String encoder/decoder -<p> <defun name="mime-decode-string"> <args> string encoding <p> <var>string</var> $B$r(B <var>encoding</var> $B$H$7$FI|9f$7$?7k2L$rJV$7$^$9!#(B </defun> -<defvar name="mime-string-decoding-method-alist"> -<p> -Alist of encoding vs. corresponding method to decode string. -<p> -Each element looks like <code>(STRING . FUNCTION)</code>. -STRING is content-transfer-encoding. -FUNCTION is string decoder. -</defvar> - -<h2> File $B$NId9f2=!&I|9f2=(B -<node> File encoder/decoder -<p> <defun name="mime-insert-encoded-file"> <args> filename encoding <p> @@ -707,24 +702,102 @@ Decode and write current region encoded by <var>encoding</var> into <var>start</var> and <var>end</var> are buffer positions. </defun> -<defvar name="mime-file-encoding-method-alist"> + +<h2> Other utilities +<node> Encoding information <p> -Alist of encoding vs. corresponding method to insert encoded file. +<defun name="mime-encoding-list"> + <opts> SERVICE <p> -Each element looks like <code>(STRING . FUNCTION)</code>. STRING is -content-transfer-encoding. FUNCTION is function to insert encoded -file. -</defvar> +Return list of Content-Transfer-Encoding. +<p> +If <var>service</var> is specified, it returns available list of +Content-Transfer-Encoding for it. +</defun> -<defvar name="mime-file-decoding-method-alist"> +<defun name="mime-encoding-alist"> + <opts> SERVICE <p> -Alist of encoding vs. corresponding method to write decoded region to -file. +Return table of Content-Transfer-Encoding for completion. <p> -Each element looks like <code>(STRING . FUNCTION)</code>. STRING is -content-transfer-encoding. FUNCTION is function to write decoded -region to file. -</defvar> +If <var>service</var> is specified, it returns available list of +Content-Transfer-Encoding for it. +</defun> + + +<h2> How to write encoder/decoder module +<node> mel-backend +<p> +<defmacro name="mel-define-method"> +<args> name args <rest> body +<p> +Define <var>name</var> as a method function of (nth 1 (car (last +<var>args</var>))) backend. +<p> +<var>args</var> is like an argument list of lambda, but (car (last +<var>args</var>)) must be specialized parameter. (car (car (last +<var>args</var>))) is name of variable and (nth 1 (car (last +<var>args</var>))) is name of backend (encoding). +<p> +Example: +<p> +<lisp> +(mel-define-method mime-write-decoded-region (start end filename + (nil "base64")) + "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: "))) + (let ((str (buffer-substring start end))) + (with-temp-buffer + (insert (decode-base64-string str)) + (write-region-as-binary (point-min) (point-max) filename) + ))) +</lisp> +</defmacro> + +<defmacro name="mel-define-method-function"> +<args> spec function +<p> +Set <var>spec</var>'s function definition to <var>function</var>. +<p> +First element of <var>spec</var> is service. +<p> +Rest of <var>args</var> is like an argument list of lambda, but (car +(last <var>args</var>)) must be specialized parameter. (car (car +(last <var>args</var>))) is name of variable and (nth 1 (car (last +<var>args</var>))) is name of backend (encoding). +<p> +Example: +<p> +<lisp> +(mel-define-method-function (mime-encode-string string (nil "base64")) + 'encode-base64-string) +</lisp> +</defmacro> + + +<h2> How to add encoding/decoding service +<node> generic function for mel-backend +<p> +<defmacro name="mel-define-service"> +<args> name +<opts> args doc-string +<p> +Define <var>name</var> as a service for Content-Transfer-Encodings. +<p> +If <var>args</var> is specified, <var>name</var> is defined as a +generic function for the service. +<p> +Example: +<p> +<lisp> +(mel-define-service encoded-text-encode-string (string encoding) + "Encode STRING as encoded-text using ENCODING. +ENCODING must be string.") +</lisp> +</defmacro> <h1> Header $B$N(B network $BI=8=(B diff --git a/mime-ja.texi b/mime-ja.texi index c2df06a..4c77393 100644 --- a/mime-ja.texi +++ b/mime-ja.texi @@ -1,13 +1,13 @@ \input texinfo.tex @setfilename mime-ja.info -@settitle{FLIM 1.9 MIME $B5!G=@bL@=q(B} +@settitle{FLIM 1.10 MIME $B5!G=@bL@=q(B} @titlepage -@title FLIM 1.9 MIME $B5!G=@bL@=q(B +@title FLIM 1.10 MIME $B5!G=@bL@=q(B @author $B<i2,(B $BCNI'(B <morioka@@jaist.ac.jp> @subtitle 1998/07/01 @end titlepage @node Top, Introduction, (dir), (dir) -@top FLIM 1.9 MIME $B5!G=@bL@=q(B +@top FLIM 1.10 MIME $B5!G=@bL@=q(B @ifinfo @@ -433,9 +433,38 @@ representation-type $B$NL>A0$N@hF,$K(B @code{mm} $B$rIU$1$?$b$N$K$J$C$F(B @node mm-backend module, , Request for entity, mm-backend @subsection mm-backend $B$N:n$jJ}(B -$B!J$9$_$^$;$s!#$=$N$&$A=q$-$^$9(B (^_^;$B!K(B@refill +@defmac mm-define-backend type &optional parents + +Define @var{type} as a mm-backend.@refill + +If @var{PARENTS} is specified, @var{type} inherits parents. Each parent +must be representation-type.@refill + +Example:@refill + +@lisp +(mm-define-backend chao (generic)) +@end lisp +@end defmac + + +@defmac mm-define-method name args &rest body + +Define @var{name} as a method function of (nth 1 (car @var{args})) +backend.@refill + +@var{args} is like an argument list of lambda, but (car @var{args}) must +be specialized parameter. (car (car @var{args})) is name of variable +and (nth 1 (car @var{args})) is name of backend +(representation-type).@refill + +Example:@refill + +@lisp +(mm-define-method entity-cooked-p ((entity chao)) nil) +@end lisp +@end defmac -$B!J$H$j$"$($:!"(Bmm*.el $B$r;29M$K$7$F$/$@$5$$!K(B @node Content-Type, Content-Disposition, Entity, Top @@ -692,12 +721,13 @@ FLIM $B$G$O(B Content-Transfer-Encoding $BMs$r9=J82r@O$9$k4X?t$rDs6!$7$^$9!#$ @menu * Content-Transfer-Encoding parser:: Content-Transfer-Encoding $BMs$N2r@O4o(B -* Region encoder/decoder:: $BNN0h$NId9f2=!&I|9f2=(B -* String encoder/decoder:: $BJ8;zNs$NId9f2=!&I|9f2=(B -* File encoder/decoder:: File $B$NId9f2=!&I|9f2=(B +* encoder/decoder:: $BId9f2=!&I|9f2=(B +* Encoding information:: Other utilities +* mel-backend:: How to write encoder/decoder module +* generic function for mel-backend:: How to add encoding/decoding service @end menu -@node Content-Transfer-Encoding parser, Region encoder/decoder, Content-Transfer-Encoding, Content-Transfer-Encoding +@node Content-Transfer-Encoding parser, encoder/decoder, Content-Transfer-Encoding, Content-Transfer-Encoding @section Content-Transfer-Encoding $BMs$N2r@O4o(B @defun mime-parse-Content-Transfer-Encoding string @@ -717,8 +747,8 @@ Content-Transfer-Encoding $BMs$,B8:_$7$J$$>l9g$O(B@var{default-encoding} $B$r -@node Region encoder/decoder, String encoder/decoder, Content-Transfer-Encoding parser, Content-Transfer-Encoding -@section $BNN0h$NId9f2=!&I|9f2=(B +@node encoder/decoder, Encoding information, Content-Transfer-Encoding parser, Content-Transfer-Encoding +@section $BId9f2=!&I|9f2=(B @defun mime-encode-region start end encoding @@ -734,83 +764,123 @@ Decode region @var{start} to @var{end} of current buffer using @end defun -@defvar mime-encoding-method-alist - -Alist of encoding vs. corresponding method to encode region.@refill -Each element looks like @code{(STRING . FUNCTION)} or @code{(STRING -. nil)}. @var{string} is content-transfer-encoding. @code{function} is -region encoder and @code{nil} means not to encode. -@end defvar +@defun mime-decode-string string encoding +@var{string} $B$r(B @var{encoding} $B$H$7$FI|9f$7$?7k2L$rJV$7$^$9!#(B +@end defun -@defvar mime-decoding-method-alist -Alist of encoding vs. corresponding method to decode region.@refill -Each element looks like @code{(STRING . FUNCTION)} or @code{(STRING -. nil)}. @var{string} is content-transfer-encoding. @code{function} is -region decoder and @code{nil} means not to decode. -@end defvar +@defun mime-insert-encoded-file filename encoding +Insert file @var{FILENAME} encoded by @var{ENCODING} format. +@end defun -@node String encoder/decoder, File encoder/decoder, Region encoder/decoder, Content-Transfer-Encoding -@section $BJ8;zNs$NId9f2=!&I|9f2=(B +@defun mime-write-decoded-region start end filename encoding -@defun mime-decode-string string encoding +Decode and write current region encoded by @var{encoding} into +@var{filename}.@refill -@var{string} $B$r(B @var{encoding} $B$H$7$FI|9f$7$?7k2L$rJV$7$^$9!#(B +@var{start} and @var{end} are buffer positions. @end defun -@defvar mime-string-decoding-method-alist -Alist of encoding vs. corresponding method to decode string.@refill +@node Encoding information, mel-backend, encoder/decoder, Content-Transfer-Encoding +@section Other utilities -Each element looks like @code{(STRING . FUNCTION)}. STRING is -content-transfer-encoding. FUNCTION is string decoder. -@end defvar +@defun mime-encoding-list &optional SERVICE +Return list of Content-Transfer-Encoding.@refill +If @var{service} is specified, it returns available list of +Content-Transfer-Encoding for it. +@end defun -@node File encoder/decoder, , String encoder/decoder, Content-Transfer-Encoding -@section File $B$NId9f2=!&I|9f2=(B -@defun mime-insert-encoded-file filename encoding +@defun mime-encoding-alist &optional SERVICE -Insert file @var{FILENAME} encoded by @var{ENCODING} format. +Return table of Content-Transfer-Encoding for completion.@refill + +If @var{service} is specified, it returns available list of +Content-Transfer-Encoding for it. @end defun -@defun mime-write-decoded-region start end filename encoding -Decode and write current region encoded by @var{encoding} into -@var{filename}.@refill +@node mel-backend, generic function for mel-backend, Encoding information, Content-Transfer-Encoding +@section How to write encoder/decoder module -@var{start} and @var{end} are buffer positions. -@end defun +@defmac mel-define-method name args &rest body +Define @var{name} as a method function of (nth 1 (car (last +@var{args}))) backend.@refill -@defvar mime-file-encoding-method-alist +@var{args} is like an argument list of lambda, but (car (last +@var{args})) must be specialized parameter. (car (car (last +@var{args}))) is name of variable and (nth 1 (car (last @var{args}))) is +name of backend (encoding).@refill -Alist of encoding vs. corresponding method to insert encoded -file.@refill +Example:@refill -Each element looks like @code{(STRING . FUNCTION)}. STRING is -content-transfer-encoding. FUNCTION is function to insert encoded file. -@end defvar +@lisp +(mel-define-method mime-write-decoded-region (start end filename + (nil "base64")) + "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: "))) + (let ((str (buffer-substring start end))) + (with-temp-buffer + (insert (decode-base64-string str)) + (write-region-as-binary (point-min) (point-max) filename) + ))) +@end lisp +@end defmac -@defvar mime-file-decoding-method-alist +@defmac mel-define-method-function spec function -Alist of encoding vs. corresponding method to write decoded region to -file.@refill +Set @var{spec}'s function definition to @var{function}.@refill -Each element looks like @code{(STRING . FUNCTION)}. STRING is -content-transfer-encoding. FUNCTION is function to write decoded region -to file. -@end defvar +First element of @var{spec} is service.@refill + +Rest of @var{args} is like an argument list of lambda, but (car (last +@var{args})) must be specialized parameter. (car (car (last +@var{args}))) is name of variable and (nth 1 (car (last @var{args}))) is +name of backend (encoding).@refill + +Example:@refill + +@lisp +(mel-define-method-function (mime-encode-string string (nil "base64")) + 'encode-base64-string) +@end lisp +@end defmac + + + +@node generic function for mel-backend, , mel-backend, Content-Transfer-Encoding +@section How to add encoding/decoding service + +@defmac mel-define-service name &optional args doc-string + +Define @var{name} as a service for Content-Transfer-Encodings.@refill + +If @var{args} is specified, @var{name} is defined as a generic function +for the service.@refill + +Example:@refill + +@lisp +(mel-define-service encoded-text-encode-string (string encoding) + "Encode STRING as encoded-text using ENCODING. +ENCODING must be string.") +@end lisp +@end defmac diff --git a/mime.el b/mime.el index 2d61fa7..bc38dae 100644 --- a/mime.el +++ b/mime.el @@ -80,16 +80,6 @@ current-buffer, and return it.") entity args)) -(defsubst mm-arglist-to-arguments (arglist) - (let (dest) - (while arglist - (let ((arg (car arglist))) - (or (memq arg '(&optional &rest)) - (setq dest (cons arg dest))) - ) - (setq arglist (cdr arglist))) - (nreverse dest))) - (defmacro mm-define-generic (name args &optional doc) (if doc `(defun ,(intern (format "mime-%s" name)) ,args -- 1.7.10.4