+1998-10-12 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * FLIM: Version 1.10.4 (Shin-H\e-Dòsono)\e-A was released.
+
+1998-10-12 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * 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 <morioka@jaist.ac.jp>
+
+ * 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 <morioka@jaist.ac.jp>
+
+ * FLIM-ELS: Don't install mel-ccl in anything older than XEmacs 21
+ with MULE.
+
+\f
+1998-10-10 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * 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 <akr@jaist.ac.jp>
+
+ * 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 <morioka@jaist.ac.jp>
+
+ * 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 <morioka@jaist.ac.jp>
+
+ * 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 <morioka@jaist.ac.jp>
+
+ * mel-b.el (base64-numbers): Use `eval-when-compile'.
+
+1998-10-09 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * FLIM-CFG: Use `add-latest-path' instead of `add-path' for adding
+ "custom" to load-path.
+
+1998-10-09 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * mime-def.el (mime-library-product): Enclose with
+ `eval-and-compile'.
+
+ * FLIM-CFG: Add "custom" to load-path.
+
+\f
+1998-10-08 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * 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 <morioka@jaist.ac.jp>
+
+ * 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 <morioka@jaist.ac.jp>
+
+ * 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 <morioka@jaist.ac.jp>
+
+ * 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 <morioka@jaist.ac.jp>
+
+ * 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.
+
+\f
+1998-10-07 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * FLIM: Version 1.10.1 (Miyamaki) was released.
+
+1998-10-06 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * 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 <morioka@jaist.ac.jp>
+
+ * mime-ja.sgml, mime-en.sgml (mm-backend module): Write
+ description of `mm-define-backend' and `mm-define-method'.
+
+\f
+1998-09-29 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * FLIM: Version 1.10.0 (K\e-Dòdo)\e-A was released.
+
+ * README.en (What's FLIM): Add mel-ccl.el.
+
+1998-09-21 Tanaka Akira <akr@jaist.ac.jp>
+
+ * mel-ccl.el:
+ - Require 'pccl instead of 'emu.
+ - Use `unless-broken' to check facility.
+
+1998-09-27 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * 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 <morioka@jaist.ac.jp>
+
+ * eword-decode.el (eword-decode-structured-field-list): Add
+ Mail-Followup-To field.
+
+1998-09-20 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * eword-encode.el (eword-charset-encoding-alist): Add utf-8.
+
+1998-09-20 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * 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 <morioka@jaist.ac.jp>
+
+ * mime-def.el (mel-define-method-function): Don't override.
+
+1998-09-20 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * mel.el, mel-ccl.el, FLIM-ELS: Add mel-ccl.el.
+
+1998-09-20 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * 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 <morioka@jaist.ac.jp>
+
+ * mel.el (mime-encode-region): Don't regard nil encoding as
+ "7bit".
+
+1998-09-19 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * 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 <morioka@jaist.ac.jp>
* mel-b.el (base64-internal-encoding-limit): modify :type.
(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)
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
;;; -*-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)
(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
;;-------------------------------------------------------------------------
;; Kinki Nippon Railway \e$(B6a5&F|K\E4F;\e(B http://www.kintetsu.co.jp/
-;; Ky\e-Dòto Line \e$(B5~ET@~\e(B\e-A
+;; Ky\e-Dòto\e-A Line \e$(B5~ET@~\e(B
;;-------------------------------------------------------------------------
-1.0.1 Ky\e-Dòto \e$(B5~ET\e(B ; <=> JR, \e$(B5~ET;T8rDL6I\e(B\e-A
-1.1.0 T\e-Dòji \e$(BEl;{\e(B\e-A
-1.2.0 J\e-Dþjò \e$(B==>r\e(B\e-A
+1.0.1 Ky\e-Dòto\e-A \e$(B5~ET\e(B ; <=> JR, \e$(B5~ET;T8rDL6I\e(B
+1.1.0 T\e-Dòji\e-A \e$(BEl;{\e(B
+1.2.0 J\e-Dþjò\e-A \e$(B==>r\e(B
1.2.1 Kamitobaguchi \e$(B>eD;1)8}\e(B
1.2.2 Takeda \e$(BC]ED\e(B ; = \e$(B5~ET;T8rDL6I\e(B \e$(B1(4]@~\e(B
1.3.0 Fushimi \e$(BIz8+\e(B
1.4.0 Kintetsu-Tambabashi \e$(B6aE4C0GH66\e(B ; <=> \e$(B5~:e\e(B \e$(BC0GH66\e(B
-1.4.1 Momoyama-Gory\e-Dòmae \e$(BEm;38fNMA0\e(B\e-A
+1.4.1 Momoyama-Gory\e-Dòmae\e-A \e$(BEm;38fNMA0\e(B
1.5.0 Mukaijima \e$(B8~Eg\e(B
1.6.0 Ogura \e$(B>.AR\e(B
1.7.0 Iseda \e$(B0K@*ED\e(B
-1.8.0 \e-DÒkubo \e$(BBg5WJ]\e(B\e-A
+1.8.0 \e-DÒkubo\e-A \e$(BBg5WJ]\e(B
1.8.1 Kutsukawa \e$(B5WDE@n\e(B
1.9.0 Terada \e$(B;{ED\e(B
-1.9.1 Tonosh\e-Dò \e$(BIYLnAq\e(B\e-A
+1.9.1 Tonosh\e-Dò\e-A \e$(BIYLnAq\e(B
1.9.2 Shin-Tanabe \e$(B?7EDJU\e(B
------ K\e-Dòdo \e$(B6=8M\e(B\e-A
------ Miyamaki \e$(B;0;3LZ\e(B
------ Kintetsu-Miyazu \e$(B6aE45\DE\e(B
------ Komada \e$(B9}ED\e(B
------ Shin-H\e-Dòsono \e$(B?7=K1`\e(B\e-A
+1.10.0 K\e-Dòdo\e-A \e$(B6=8M\e(B
+1.10.1 Miyamaki \e$(B;0;3LZ\e(B
+1.10.2 Kintetsu-Miyazu \e$(B6aE45\DE\e(B
+1.10.3 Komada \e$(B9}ED\e(B
+1.10.4 Shin-H\e-Dòsono\e-A \e$(B?7=K1`\e(B ; <=> JR \e$(BJRD.@~\e(B \e$(B=K1`\e(B
----- Kizugawadai \e$(BLZDE@nBf\e(B
----- Yamadagawa \e$(B;3ED@n\e(B
----- Takanohara \e$(B9b$N86\e(B
------ Heij\e-Dò \e$(BJ?>k\e(B\e-A
+----- Heij\e-Dò\e-A \e$(BJ?>k\e(B
----- Saidaiji \e$(B@>Bg;{\e(B
;;-------------------------------------------------------------------------
;; Kinki Nippon Railway \e$(B6a5&F|K\E4F;\e(B http://www.kintetsu.co.jp/
-;; Ky\e-Dòto Line \e$(B3`86@~\e(B\e-A
+;; Ky\e-Dòto\e-A Line \e$(B3`86@~\e(B
;;-------------------------------------------------------------------------
(Saidaiji) (\e$(B@>Bg;{\e(B)
----- Amagatsuji \e$(BFt%vDT\e(B
------ Nishinoky\e-Dò \e$(B@>$N5~\e(B\e-A
------ Kuj\e-Dò \e$(B6e>r\e(B\e-A
------ Kintetsu-K\e-Dòriyama \e$(B6aE474;3\e(B\e-A
+----- Nishinoky\e-Dò\e-A \e$(B@>$N5~\e(B
+----- Kuj\e-Dò\e-A \e$(B6e>r\e(B
+----- Kintetsu-K\e-Dòriyama\e-A \e$(B6aE474;3\e(B
[Chao Version names]
;;-------------------------------------------------------------------------
1.2.0 Takeda \e$(BC]ED\e(B ; = \e$(B6aE4\e(B \e$(B5~ET@~\e(B
1.3.0 Kuinabashi \e$(B$/$$$J66\e(B
-1.4.0 J\e-Dþjò \e$(B==>r\e(B\e-A
-1.6.0 Kuj\e-Dò \e$(B6e>r\e(B\e-A
-1.6.1 Ky\e-Dòto \e$(B5~ET\e(B ; <=> JR, \e$(B6aE4\e(B\e-A
-1.7.0 Goj\e-Dò \e$(B8^>r\e(B\e-A
-1.8.0 Shij\e-Dò \e$(B;M>r\e(B\e-A
+1.4.0 J\e-Dþjò\e-A \e$(B==>r\e(B
+1.6.0 Kuj\e-Dò\e-A \e$(B6e>r\e(B
+1.6.1 Ky\e-Dòto\e-A \e$(B5~ET\e(B ; <=> JR, \e$(B6aE4\e(B
+1.7.0 Goj\e-Dò\e-A \e$(B8^>r\e(B
+1.8.0 Shij\e-Dò\e-A \e$(B;M>r\e(B ; <=> \e$(B:e5^\e(B \e$(B5~ET@~\e(B
+1.9.0 Karasuma Oike \e$(B1(4]8fCS\e(B ; = \e$(B5~ET;T8rDL6I\e(B \e$(BEl@>@~\e(B
+----- Marutamach \e$(B4]B@D.\e(B
#
PACKAGE = flim
-VERSION = 1.9.2
+VERSION = 1.10.4
TAR = tar
RM = /bin/rm -f
PREFIX = NONE
LISPDIR = NONE
PACKAGEDIR = NONE
+VERSION_SPECIFIC_LISPDIR = NONE
GOMI = *.elc \
*.cp *.cps *.ky *.kys *.fn *.fns *.vr *.vrs \
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:
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 .
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
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.
"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
(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
;;;
(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.
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
(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).
(euc-kr . "B")
(iso-2022-jp-2 . "B")
(iso-2022-int-1 . "B")
+ (utf-8 . "B")
))
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 "?=")
)
((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)
--- /dev/null
+;;; mel-b-dl.el: Base64 encoder/decoder using DL module
+
+;; Copyright (C) 1998 Free Software Foundation, Inc.
+
+;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; 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.
: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."
;;; @ 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))
;;;
(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))
(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
(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
(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."
(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]"
--- /dev/null
+;;; mel-ccl.el: CCL based encoder/decoder of Base64, Quoted-Printable
+;;; and Q-encoding
+
+;; Copyright (C) 1998 Tanaka Akira
+
+;; Author: Tanaka Akira <akr@jaist.ac.jp>
+;; Created: 1998/9/17
+;; Keywords: MIME, Base64, Quoted-Printable, Q-encoding
+
+;; This file is part of FLIM (Faithful Library about Internet Message).
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or (at
+;; your option) any later version.
+
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Code:
+
+(require 'ccl)
+(require 'pccl)
+(require 'mime-def)
+
+
+;;; @ constants
+;;;
+
+(eval-when-compile
+
+(defconst mel-ccl-4-table
+ '( 0 1 2 3))
+
+(defconst mel-ccl-16-table
+ '( 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15))
+
+(defconst mel-ccl-28-table
+ '( 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
+ 16 17 18 19 20 21 22 23 24 25 26 27))
+
+(defconst mel-ccl-64-table
+ '( 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
+ 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31
+ 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47
+ 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63))
+
+(defconst mel-ccl-256-table
+ '( 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
+ 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31
+ 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47
+ 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63
+ 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79
+ 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95
+ 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111
+ 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127
+ 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143
+ 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159
+ 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175
+ 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191
+ 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207
+ 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223
+ 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239
+ 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255))
+
+(defconst mel-ccl-256-to-16-table
+ '(nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
+ nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
+ nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
+ 0 1 2 3 4 5 6 7 8 9 nil nil nil nil nil nil
+ nil 10 11 12 13 14 15 nil nil nil nil nil nil nil nil nil
+ nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
+ nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
+ nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
+ nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
+ nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
+ nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
+ nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
+ nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
+ nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
+ nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
+ nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil))
+
+(defconst mel-ccl-16-to-256-table
+ (mapcar 'char-int "0123456789ABCDEF"))
+
+(defconst mel-ccl-high-table
+ (vconcat
+ (mapcar
+ (lambda (v) (nth (lsh v -4) mel-ccl-16-to-256-table))
+ mel-ccl-256-table)))
+
+(defconst mel-ccl-low-table
+ (vconcat
+ (mapcar
+ (lambda (v) (nth (logand v 15) mel-ccl-16-to-256-table))
+ mel-ccl-256-table)))
+
+(defconst mel-ccl-u-raw
+ (mapcar
+ 'char-int
+ "0123456789\
+ABCDEFGHIJKLMNOPQRSTUVWXYZ\
+abcdefghijklmnopqrstuvwxyz\
+!@#$%&'()*+,-./:;<>@[\\]^`{|}~"))
+
+(defconst mel-ccl-c-raw
+ (mapcar
+ 'char-int
+ "0123456789\
+ABCDEFGHIJKLMNOPQRSTUVWXYZ\
+abcdefghijklmnopqrstuvwxyz\
+!@#$%&'*+,-./:;<>@[]^`{|}~"))
+
+(defconst mel-ccl-p-raw
+ (mapcar
+ 'char-int
+ "0123456789\
+ABCDEFGHIJKLMNOPQRSTUVWXYZ\
+abcdefghijklmnopqrstuvwxyz\
+!*+-/"))
+
+(defconst mel-ccl-256-to-64-table
+ '(nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
+ nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
+ nil nil nil nil nil nil nil nil nil nil nil 62 nil nil nil 63
+ 52 53 54 55 56 57 58 59 60 61 nil nil nil t nil nil
+ nil 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14
+ 15 16 17 18 19 20 21 22 23 24 25 nil nil nil nil nil
+ nil 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40
+ 41 42 43 44 45 46 47 48 49 50 51 nil nil nil nil nil
+ nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
+ nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
+ nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
+ nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
+ nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
+ nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
+ nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
+ nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil))
+
+(defconst mel-ccl-64-to-256-table
+ (mapcar
+ 'char-int
+ "ABCDEFGHIJKLMNOPQRSTUVWXYZ\
+abcdefghijklmnopqrstuvwxyz\
+0123456789\
++/"))
+
+(defconst mel-ccl-qp-table
+ [enc enc enc enc enc enc enc enc enc wsp lf enc enc cr enc enc
+ enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc
+ wsp raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw
+ raw raw raw raw raw raw raw raw raw raw raw raw raw enc raw raw
+ raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw
+ raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw
+ raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw
+ raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw enc
+ enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc
+ enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc
+ enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc
+ enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc
+ enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc
+ enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc
+ enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc
+ enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc])
+
+)
+
+
+;;; @ CCL programs
+;;;
+
+;;; Q
+
+(define-ccl-program mel-ccl-decode-q
+ `(1
+ ((loop
+ (read-branch
+ r0
+ ,@(mapcar
+ (lambda (r0)
+ (cond
+ ((= r0 (char-int ?_))
+ `(write-repeat ? ))
+ ((= r0 (char-int ?=))
+ `((loop
+ (read-branch
+ r1
+ ,@(mapcar
+ (lambda (v)
+ (if (integerp v)
+ `((r0 = ,v) (break))
+ '(repeat)))
+ mel-ccl-256-to-16-table)))
+ (loop
+ (read-branch
+ r1
+ ,@(mapcar
+ (lambda (v)
+ (if (integerp v)
+ `((write r0 ,(vconcat
+ (mapcar
+ (lambda (r0)
+ (logior (lsh r0 4) v))
+ mel-ccl-16-table)))
+ (break))
+ '(repeat)))
+ mel-ccl-256-to-16-table)))
+ (repeat)))
+ (t
+ `(write-repeat ,r0))))
+ mel-ccl-256-table))))))
+
+(eval-when-compile
+
+(defun mel-ccl-encode-q-generic (raw)
+ `(3
+ (loop
+ (loop
+ (read-branch
+ r0
+ ,@(mapcar
+ (lambda (r0)
+ (cond
+ ((= r0 32) `(write-repeat ?_))
+ ((member r0 raw) `(write-repeat ,r0))
+ (t '(break))))
+ mel-ccl-256-table)))
+ (write ?=)
+ (write r0 ,mel-ccl-high-table)
+ (write r0 ,mel-ccl-low-table)
+ (repeat))))
+
+;; On xemacs, generated program counts iso-8859-1 8bit character as 6bytes.
+(defun mel-ccl-count-q-length (raw)
+ `(0
+ ((r0 = 0)
+ (loop
+ (read-branch
+ r1
+ ,@(mapcar
+ (lambda (r1)
+ (if (or (= r1 32) (member r1 raw))
+ '((r0 += 1) (repeat))
+ '((r0 += 3) (repeat))))
+ mel-ccl-256-table))))))
+
+)
+
+(define-ccl-program mel-ccl-encode-uq
+ (mel-ccl-encode-q-generic mel-ccl-u-raw))
+(define-ccl-program mel-ccl-encode-cq
+ (mel-ccl-encode-q-generic mel-ccl-c-raw))
+(define-ccl-program mel-ccl-encode-pq
+ (mel-ccl-encode-q-generic mel-ccl-p-raw))
+
+(define-ccl-program mel-ccl-count-uq
+ (mel-ccl-count-q-length mel-ccl-u-raw))
+(define-ccl-program mel-ccl-count-cq
+ (mel-ccl-count-q-length mel-ccl-c-raw))
+(define-ccl-program mel-ccl-count-pq
+ (mel-ccl-count-q-length mel-ccl-p-raw))
+
+;;; B/Base64
+
+(eval-when-compile
+
+(defun mel-ccl-decode-b-bit-ex (v)
+ (logior
+ (lsh (logand v (lsh 255 16)) -16)
+ (logand v (lsh 255 8))
+ (lsh (logand v 255) 16)))
+
+(defconst mel-ccl-decode-b-0-table
+ (vconcat
+ (mapcar
+ (lambda (v)
+ (if (integerp v)
+ (mel-ccl-decode-b-bit-ex (lsh v 18))
+ (lsh 1 24)))
+ mel-ccl-256-to-64-table)))
+
+(defconst mel-ccl-decode-b-1-table
+ (vconcat
+ (mapcar
+ (lambda (v)
+ (if (integerp v)
+ (mel-ccl-decode-b-bit-ex (lsh v 12))
+ (lsh 1 25)))
+ mel-ccl-256-to-64-table)))
+
+(defconst mel-ccl-decode-b-2-table
+ (vconcat
+ (mapcar
+ (lambda (v)
+ (if (integerp v)
+ (mel-ccl-decode-b-bit-ex (lsh v 6))
+ (lsh 1 26)))
+ mel-ccl-256-to-64-table)))
+
+(defconst mel-ccl-decode-b-3-table
+ (vconcat
+ (mapcar
+ (lambda (v)
+ (if (integerp v)
+ (mel-ccl-decode-b-bit-ex v)
+ (lsh 1 27)))
+ mel-ccl-256-to-64-table)))
+
+)
+
+(define-ccl-program mel-ccl-decode-b
+ `(1
+ (loop
+ (read r0 r1 r2 r3)
+ (r4 = r0 ,mel-ccl-decode-b-0-table)
+ (r5 = r1 ,mel-ccl-decode-b-1-table)
+ (r4 |= r5)
+ (r5 = r2 ,mel-ccl-decode-b-2-table)
+ (r4 |= r5)
+ (r5 = r3 ,mel-ccl-decode-b-3-table)
+ (r4 |= r5)
+ (if (r4 & ,(lognot (1- (lsh 1 24))))
+ ((loop
+ (if (r4 & ,(lsh 1 24))
+ ((r0 = r1) (r1 = r2) (r2 = r3) (read r3)
+ (r4 >>= 1) (r4 &= ,(logior (lsh 7 24)))
+ (r5 = r3 ,mel-ccl-decode-b-3-table)
+ (r4 |= r5)
+ (repeat))
+ (break)))
+ (loop
+ (if (r4 & ,(lsh 1 25))
+ ((r1 = r2) (r2 = r3) (read r3)
+ (r4 >>= 1) (r4 &= ,(logior (lsh 7 24)))
+ (r5 = r3 ,mel-ccl-decode-b-3-table)
+ (r4 |= r5)
+ (repeat))
+ (break)))
+ (loop
+ (if (r2 != ?=)
+ (if (r4 & ,(lsh 1 26))
+ ((r2 = r3) (read r3)
+ (r4 >>= 1) (r4 &= ,(logior (lsh 7 24)))
+ (r5 = r3 ,mel-ccl-decode-b-3-table)
+ (r4 |= r5)
+ (repeat))
+ ((r6 = 0)
+ (break)))
+ ((r6 = 1)
+ (break))))
+ (loop
+ (if (r3 != ?=)
+ (if (r4 & ,(lsh 1 27))
+ ((read r3)
+ (r4 = r3 ,mel-ccl-decode-b-3-table)
+ (repeat))
+ (break))
+ ((r6 |= 2)
+ (break))))
+ (r4 = r0 ,mel-ccl-decode-b-0-table)
+ (r5 = r1 ,mel-ccl-decode-b-1-table)
+ (r4 |= r5)
+ (branch
+ r6
+ ;; BBBB
+ ((r5 = r2 ,mel-ccl-decode-b-2-table)
+ (r4 |= r5)
+ (r5 = r3 ,mel-ccl-decode-b-3-table)
+ (r4 |= r5)
+ (r4 >8= 0)
+ (write r7)
+ (r4 >8= 0)
+ (write r7)
+ (write-repeat r4))
+ ;; error: BB=B
+ ((write (r4 & 255))
+ (end))
+ ;; BBB=
+ ((r5 = r2 ,mel-ccl-decode-b-2-table)
+ (r4 |= r5)
+ (r4 >8= 0)
+ (write r7)
+ (write (r4 & 255))
+ (end) ; Excessive (end) is workaround for XEmacs 21.0.
+ ; Without this, "AAA=" is converted to "^@^@^@".
+ (end))
+ ;; BB==
+ ((write (r4 & 255))
+ (end))))
+ ((r4 >8= 0)
+ (write r7)
+ (r4 >8= 0)
+ (write r7)
+ (write-repeat r4))))))
+
+(eval-when-compile
+
+;; Generated CCL program works not properly on 20.2 because CCL_EOF_BLOCK
+;; is not executed.
+(defun mel-ccl-encode-base64-generic (&optional quantums-per-line output-crlf terminate-with-newline)
+ `(2
+ ((r3 = 0)
+ (loop
+ (r2 = 0)
+ (read-branch
+ r1
+ ,@(mapcar
+ (lambda (r1)
+ `((write ,(nth (lsh r1 -2) mel-ccl-64-to-256-table))
+ (r0 = ,(logand r1 3))))
+ mel-ccl-256-table))
+ (r2 = 1)
+ (read-branch
+ r1
+ ,@(mapcar
+ (lambda (r1)
+ `((write r0 ,(vconcat
+ (mapcar
+ (lambda (r0)
+ (nth (logior (lsh r0 4)
+ (lsh r1 -4))
+ mel-ccl-64-to-256-table))
+ mel-ccl-4-table)))
+ (r0 = ,(logand r1 15))))
+ mel-ccl-256-table))
+ (r2 = 2)
+ (read-branch
+ r1
+ ,@(mapcar
+ (lambda (r1)
+ `((write r0 ,(vconcat
+ (mapcar
+ (lambda (r0)
+ (nth (logior (lsh r0 2)
+ (lsh r1 -6))
+ mel-ccl-64-to-256-table))
+ mel-ccl-16-table)))))
+ mel-ccl-256-table))
+ (r1 &= 63)
+ (write r1 ,(vconcat
+ (mapcar
+ (lambda (r1)
+ (nth r1 mel-ccl-64-to-256-table))
+ mel-ccl-64-table)))
+ (r3 += 1)
+ ,@(when quantums-per-line
+ `((if (r3 == ,quantums-per-line)
+ ((write ,(if output-crlf "\r\n" "\n"))
+ (r3 = 0)))))
+ (repeat)))
+ (branch
+ r2
+ ,(if terminate-with-newline
+ `(if (r3 > 0) (write ,(if output-crlf "\r\n" "\n")))
+ `(r0 = 0))
+ ((write r0 ,(vconcat
+ (mapcar
+ (lambda (r0)
+ (nth (lsh r0 4) mel-ccl-64-to-256-table))
+ mel-ccl-4-table)))
+ (write ,(if terminate-with-newline
+ (if output-crlf "==\r\n" "==\n")
+ "==")))
+ ((write r0 ,(vconcat
+ (mapcar
+ (lambda (r0)
+ (nth (lsh r0 2) mel-ccl-64-to-256-table))
+ mel-ccl-16-table)))
+ (write ,(if terminate-with-newline
+ (if output-crlf "=\r\n" "=\n")
+ "="))))
+ ))
+)
+
+(define-ccl-program mel-ccl-encode-b
+ (mel-ccl-encode-base64-generic))
+
+;; 19 * 4 = 76
+(define-ccl-program mel-ccl-encode-base64-crlf-crlf
+ (mel-ccl-encode-base64-generic 19 t))
+
+(define-ccl-program mel-ccl-encode-base64-crlf-lf
+ (mel-ccl-encode-base64-generic 19 nil))
+
+;; Quoted-Printable
+
+(eval-when-compile
+
+(defun mel-ccl-try-to-read-crlf (input-crlf reg eof-reg cr-eof lf-eof crlf-eof succ fail-cr fail-lf fail-crlf)
+ (if input-crlf
+ `((,eof-reg = ,cr-eof) (read-if (,reg == ?\r)
+ ((,eof-reg = ,lf-eof) (read-if (,reg == ?\n)
+ ,succ
+ ,fail-lf))
+ ,fail-cr))
+ `((,eof-reg = ,crlf-eof) (read-if (,reg == ?\n)
+ ,succ
+ ,fail-crlf))))
+
+;; Generated CCL program works not properly on 20.2 because CCL_EOF_BLOCK
+;; is not executed.
+(defun mel-ccl-encode-quoted-printable-generic (input-crlf output-crlf)
+ `(4
+ ((r6 = 0) ; column
+ (r5 = 0) ; previous character is white space
+ (r4 = 0)
+ (read r0)
+ (loop ; r6 <= 75
+ (loop
+ (loop
+ (branch
+ r0
+ ,@(mapcar
+ (lambda (r0)
+ (let ((tmp (aref mel-ccl-qp-table r0)))
+ (cond
+ ((eq r0 (char-int ?F))
+ `(if (r6 == 0)
+ ((r4 = 15) (read-if (r0 == ?r)
+ ((r4 = 16) (read-if (r0 == ?o)
+ ((r4 = 17) (read-if (r0 == ?m)
+ ((r4 = 18) (read-if (r0 == ? )
+ ((r6 = 7)
+ (r5 = 1)
+ (write "=46rom ")
+ (r4 = 19)
+ (read r0)
+ (repeat))
+ ((r6 = 4)
+ (write-repeat "From"))))
+ ((r6 = 3)
+ (write-repeat "Fro"))))
+ ((r6 = 2)
+ (write-repeat "Fr"))))
+ ((r6 = 1)
+ (write-repeat "F"))))
+ ((r3 = 0) (break)) ; RAW
+ ))
+ ((eq r0 (char-int ?.))
+ `(if (r6 == 0)
+ ,(mel-ccl-try-to-read-crlf
+ input-crlf
+ 'r0 'r4 20 21 22
+ `((write ,(if output-crlf "=2E\r\n" "=2E\n"))
+ (r4 = 23)
+ (read r0)
+ (repeat))
+ '((r6 = 1)
+ (write-repeat "."))
+ '((r6 = 4)
+ (write-repeat ".=0D"))
+ '((r6 = 1)
+ (write-repeat ".")))
+ ((r3 = 0) (break)) ; RAW
+ ))
+ ((eq tmp 'raw) '((r3 = 0) (break))) ; RAW
+ ((eq tmp 'enc) '((r3 = 1) (break))) ; ENC
+ ((eq tmp 'wsp) '((r3 = 2) (break))) ; WSP
+ ((eq tmp 'cr) (if input-crlf
+ '((r3 = 3) (break)) ; CR
+ '((r3 = 1) (break)))) ; ENC
+ ((eq tmp 'lf) (if input-crlf
+ '((r3 = 1) (break)) ; ENC
+ '((r3 = 3) (break)))) ; CRLF
+ )))
+ mel-ccl-256-table)))
+ (branch
+ r3
+ ;; r0:r3=RAW
+ (if (r6 < 75)
+ ((r6 += 1)
+ (r5 = 0)
+ (r4 = 1)
+ (write-read-repeat r0))
+ (break))
+ ;; r0:r3=ENC
+ ((r5 = 0)
+ (if (r6 < 73)
+ ((r6 += 3)
+ (write "=")
+ (write r0 ,mel-ccl-high-table)
+ (r4 = 2)
+ (write-read-repeat r0 ,mel-ccl-low-table))
+ (if (r6 > 73)
+ ((r6 = 3)
+ (write ,(if output-crlf "=\r\n=" "=\n="))
+ (write r0 ,mel-ccl-high-table)
+ (r4 = 3)
+ (write-read-repeat r0 ,mel-ccl-low-table))
+ (break))))
+ ;; r0:r3=WSP
+ ((r5 = 1)
+ (if (r6 < 75)
+ ((r6 += 1)
+ (r4 = 4)
+ (write-read-repeat r0))
+ ((r6 = 1)
+ (write ,(if output-crlf "=\r\n" "=\n"))
+ (r4 = 5)
+ (write-read-repeat r0))))
+ ;; r0:r3=CR/CRLF
+ ,(if input-crlf
+ ;; r0:r3=CR
+ `((if ((r6 > 73) & r5)
+ ((r6 = 0)
+ (r5 = 0)
+ (write ,(if output-crlf "=\r\n" "=\n"))))
+ (break))
+ ;; r0:r3=CRLF
+ `(if r5
+ ;; WSP ; r0:r3=CRLF
+ ((r5 = 0)
+ (r6 = 0)
+ (write ,(if output-crlf "=\r\n" "=\n"))
+ ,@(if output-crlf '((write ?\r)) '())
+ (r4 = 0)
+ (write-read-repeat r0))
+ ;; noWSP ; r0:r3=CRLF
+ ((r5 = 0)
+ (r6 = 0)
+ ,@(if output-crlf '((write ?\r)) '())
+ (r4 = 0)
+ (write-read-repeat r0)))
+ )))
+ ;; r0:r3={RAW,ENC,CR}
+ (loop
+ ,(funcall
+ (lambda (after-cr after-raw-enc)
+ (if input-crlf
+ `(if (r0 == ?\r)
+ ,after-cr
+ ,after-raw-enc)
+ after-raw-enc))
+ ;; r0=\r:r3=CR
+ `((r4 = 6)
+ (read r0)
+ ;; CR:r3=CR r0
+ (if (r0 == ?\n)
+ ;; CR:r3=CR r0=LF
+ (if r5
+ ;; r5=WSP ; CR:r3=CR r0=LF
+ ((r6 = 0)
+ (r5 = 0)
+ (write ,(if output-crlf "=\r\n\r\n" "=\n\n"))
+ (r4 = 7)
+ (read r0)
+ (break))
+ ;; r5=noWSP ; CR:r3=CR r0=LF
+ ((r6 = 0)
+ (r5 = 0)
+ (write ,(if output-crlf "\r\n" "\n"))
+ (r4 = 8)
+ (read r0)
+ (break)))
+ ;; CR:r3=CR r0=noLF
+ (if (r6 < 73)
+ ((r6 += 3)
+ (r5 = 0)
+ (write "=0D")
+ (break))
+ (if (r6 == 73)
+ (if (r0 == ?\r)
+ ;; CR:r3=CR r0=CR
+ ((r4 = 9)
+ (read r0)
+ ;; CR:r3=CR CR r0
+ (if (r0 == ?\n)
+ ;; CR:r3=CR CR LF
+ ((r6 = 0)
+ (r5 = 0)
+ (write ,(if output-crlf "=0D\r\n" "=0D\n"))
+ (r4 = 10)
+ (read r0)
+ (break))
+ ;; CR:r3=CR CR noLF
+ ((r6 = 6)
+ (r5 = 0)
+ (write ,(if output-crlf "=\r\n=0D=0D" "=\n=0D=0D"))
+ (break))))
+ ;; CR:r3=CR r0=noLFnorCR
+ ((r6 = 3)
+ (r5 = 0)
+ (write ,(if output-crlf "=\r\n=0D" "=\n=0D"))
+ (break)))
+ ((r6 = 3)
+ (r5 = 0)
+ (write ,(if output-crlf "=\r\n=0D" "=\n=0D"))
+ (break))))))
+ (funcall
+ (lambda (after-newline after-cr-nolf after-nonewline)
+ (if input-crlf
+ ;; r0:r3={RAW,ENC}
+ `((r4 = 11)
+ (read r1)
+ ;; r0:r3={RAW,ENC} r1
+ (if (r1 == ?\r)
+ ;; r0:r3={RAW,ENC} r1=CR
+ ((r4 = 12)
+ (read r1)
+ ;; r0:r3={RAW,ENC} CR r1
+ (if (r1 == ?\n)
+ ;; r0:r3=RAW CR r1=LF
+ ,after-newline
+ ;; r0:r3=RAW CR r1=noLF
+ ,after-cr-nolf))
+ ;; r0:r3={RAW,ENC} r1:noCR
+ ,after-nonewline))
+ ;; r0:r3={RAW,ENC}
+ `((r4 = 11)
+ (read r1)
+ ;; r0:r3={RAW,ENC} r1
+ (if (r1 == ?\n)
+ ;; r0:r3={RAW,ENC} r1=CRLF
+ ,after-newline
+ ;; r0:r3={RAW,ENC} r1:noCRLF
+ ,after-nonewline))))
+ ;; r0:r3={RAW,ENC} CR r1=LF
+ ;; r0:r3={RAW,ENC} r1=CRLF
+ `((r6 = 0)
+ (r5 = 0)
+ (branch
+ r3
+ ;; r0:r3=RAW CR r1=LF
+ ;; r0:r3=RAW r1=CRLF
+ ((write r0)
+ (write ,(if output-crlf "\r\n" "\n"))
+ (r4 = 13)
+ (read r0)
+ (break))
+ ;; r0:r3=ENC CR r1=LF
+ ;; r0:r3=ENC r1=CRLF
+ ((write ?=)
+ (write r0 ,mel-ccl-high-table)
+ (write r0 ,mel-ccl-low-table)
+ (write ,(if output-crlf "\r\n" "\n"))
+ (r4 = 14)
+ (read r0)
+ (break))))
+ ;; r0:r3={RAW,ENC} CR r1=noLF
+ `((branch
+ r3
+ ;; r0:r3=RAW CR r1:noLF
+ ((r6 = 4)
+ (r5 = 0)
+ (write ,(if output-crlf "=\r\n" "=\n"))
+ (write r0)
+ (write "=0D")
+ (r0 = r1)
+ (break))
+ ;; r0:r3=ENC CR r1:noLF
+ ((r6 = 6)
+ (r5 = 0)
+ (write ,(if output-crlf "=\r\n=" "=\n="))
+ (write r0 ,mel-ccl-high-table)
+ (write r0 ,mel-ccl-low-table)
+ (write "=0D")
+ (r0 = r1)
+ (break))))
+ ;; r0:r3={RAW,ENC} r1:noCR
+ ;; r0:r3={RAW,ENC} r1:noCRLF
+ `((branch
+ r3
+ ;; r0:r3=RAW r1:noCR
+ ;; r0:r3=RAW r1:noCRLF
+ ((r6 = 1)
+ (r5 = 0)
+ (write ,(if output-crlf "=\r\n" "=\n"))
+ (write r0)
+ (r0 = r1)
+ (break))
+ ;; r0:r3=ENC r1:noCR
+ ;; r0:r3=ENC r1:noCRLF
+ ((r6 = 3)
+ (r5 = 0)
+ (write ,(if output-crlf "=\r\n=" "=\n="))
+ (write r0 ,mel-ccl-high-table)
+ (write r0 ,mel-ccl-low-table)
+ (r0 = r1)
+ (break)))))))
+ (repeat)))
+ ;; EOF
+ ( ;(write "[EOF:") (write r4 ,mel-ccl-high-table) (write r4 ,mel-ccl-low-table) (write "]")
+ (branch
+ r4
+ ;; 0: (start) ;
+ (end)
+ ;; 1: RAW ;
+ (end)
+ ;; 2: r0:r3=ENC ;
+ (end)
+ ;; 3: SOFTBREAK r0:r3=ENC ;
+ (end)
+ ;; 4: r0:r3=WSP ;
+ ((write ,(if output-crlf "=\r\n" "=\n")) (end))
+ ;; 5: SOFTBREAK r0:r3=WSP ;
+ ((write ,(if output-crlf "=\r\n" "=\n")) (end))
+ ;; 6: ; r0=\r:r3=CR
+ (if (r6 <= 73)
+ ((write "=0D") (end))
+ ((write ,(if output-crlf "=\r\n=0D" "=\n=0D")) (end)))
+ ;; 7: r5=WSP SOFTBREAK CR:r3=CR r0=LF ;
+ (end)
+ ;; 8: r5=noWSP CR:r3=CR r0=LF ;
+ (end)
+ ;; 9: (r6=73) ; CR:r3=CR r0=CR
+ ((write ,(if output-crlf "=\r\n=0D=0D" "=\n=0D=0D")) (end))
+ ;; 10: (r6=73) CR:r3=CR CR LF ;
+ (end)
+ ;; 11: ; r0:r3={RAW,ENC}
+ (branch
+ r3
+ ((write r0) (end))
+ ((write "=")
+ (write r0 ,mel-ccl-high-table)
+ (write r0 ,mel-ccl-low-table)
+ (end)))
+ ;; 12: ; r0:r3={RAW,ENC} r1=CR
+ (branch
+ r3
+ ;; ; r0:r3=RAW r1=CR
+ ((write ,(if output-crlf "=\r\n" "=\n"))
+ (write r0)
+ (write "=0D")
+ (end))
+ ;; ; r0:r3=ENC r1=CR
+ ((write ,(if output-crlf "=\r\n=" "=\n="))
+ (write r0 ,mel-ccl-high-table)
+ (write r0 ,mel-ccl-low-table)
+ (write "=0D")
+ (end)))
+ ;; 13: r0:r3=RAW CR LF ;
+ ;; 13: r0:r3=RAW CRLF ;
+ (end)
+ ;; 14: r0:r3=ENC CR LF ;
+ ;; 14: r0:r3=ENC CRLF ;
+ (end)
+ ;; 15: r6=0 ; "F"
+ ((write "F") (end))
+ ;; 16: r6=0 ; "Fr"
+ ((write "Fr") (end))
+ ;; 17: r6=0 ; "Fro"
+ ((write "Fro") (end))
+ ;; 18: r6=0 ; "From"
+ ((write "From") (end))
+ ;; 19: r6=0 "From " ;
+ (end)
+ ;; 20: r6=0 ; "."
+ ((write ".") (end))
+ ;; 21: r6=0 ; ".\r"
+ ((write ".=0D") (end))
+ ;; 22: r6=0 ; "."
+ ((write ".") (end))
+ ;; 23: r6=0 ".\r\n" ;
+ (end)
+ ))
+ ))
+
+(defun mel-ccl-decode-quoted-printable-generic (input-crlf output-crlf)
+ `(1
+ ((read r0)
+ (loop
+ (branch
+ r0
+ ,@(mapcar
+ (lambda (r0)
+ (let ((tmp (aref mel-ccl-qp-table r0)))
+ (cond
+ ((eq tmp 'raw) `(write-read-repeat r0))
+ ((eq tmp 'wsp) (if (eq r0 (char-int ? ))
+ `(r1 = 1)
+ `(r1 = 0)))
+ ((eq tmp 'cr)
+ (if input-crlf
+ ;; r0='\r'
+ `((read r0)
+ ;; '\r' r0
+ (if (r0 == ?\n)
+ ;; '\r' r0='\n'
+ ;; hard line break found.
+ ,(if output-crlf
+ '((write ?\r)
+ (write-read-repeat r0))
+ '(write-read-repeat r0))
+ ;; '\r' r0:[^\n]
+ ;; invalid control character (bare CR) found.
+ ;; -> ignore it and rescan from r0.
+ (repeat)))
+ ;; r0='\r'
+ ;; invalid character (bare CR) found.
+ ;; -> ignore.
+ `((read r0)
+ (repeat))))
+ ((eq tmp 'lf)
+ (if input-crlf
+ ;; r0='\n'
+ ;; invalid character (bare LF) found.
+ ;; -> ignore.
+ `((read r0)
+ (repeat))
+ ;; r0='\r\n'
+ ;; hard line break found.
+ (if output-crlf
+ '((write ?\r)
+ (write-read-repeat r0))
+ '(write-read-repeat r0))))
+ ((eq r0 (char-int ?=))
+ ;; r0='='
+ `((read r0)
+ ;; '=' r0
+ (r1 = (r0 == ?\t))
+ (if ((r0 == ? ) | r1)
+ ;; '=' r0:[\t ]
+ ;; Skip transport-padding.
+ ;; It should check CR LF after
+ ;; transport-padding.
+ (loop
+ (read-if (r0 == ?\t)
+ (repeat)
+ (if (r0 == ? )
+ (repeat)
+ (break)))))
+ ;; '=' [\t ]* r0:[^\t ]
+ (branch
+ r0
+ ,@(mapcar
+ (lambda (r0)
+ (cond
+ ((eq r0 (char-int ?\r))
+ (if input-crlf
+ ;; '=' [\t ]* r0='\r'
+ `((read r0)
+ ;; '=' [\t ]* '\r' r0
+ (if (r0 == ?\n)
+ ;; '=' [\t ]* '\r' r0='\n'
+ ;; soft line break found.
+ ((read r0)
+ (repeat))
+ ;; '=' [\t ]* '\r' r0:[^\n]
+ ;; invalid input ->
+ ;; output "=" and rescan from r0.
+ ((write "=")
+ (repeat))))
+ ;; '=' [\t ]* r0='\r'
+ ;; invalid input (bare CR found) ->
+ ;; output "=" and rescan from next.
+ `((write ?=)
+ (read r0)
+ (repeat))))
+ ((eq r0 (char-int ?\n))
+ (if input-crlf
+ ;; '=' [\t ]* r0='\n'
+ ;; invalid input (bare LF found) ->
+ ;; output "=" and rescan from next.
+ `((write ?=)
+ (read r0)
+ (repeat))
+ ;; '=' [\t ]* r0='\r\n'
+ ;; soft line break found.
+ `((read r0)
+ (repeat))))
+ ((setq tmp (nth r0 mel-ccl-256-to-16-table))
+ ;; '=' [\t ]* r0:[0-9A-F]
+ ;; upper nibble of hexadecimal digit found.
+ `((r1 = r0)
+ (r0 = ,tmp)))
+ (t
+ ;; '=' [\t ]* r0:[^\r0-9A-F]
+ ;; invalid input ->
+ ;; output "=" and rescan from r0.
+ `((write ?=)
+ (repeat)))))
+ mel-ccl-256-table))
+ ;; '=' [\t ]* r1:r0:[0-9A-F]
+ (read-branch
+ r2
+ ,@(mapcar
+ (lambda (r2)
+ (if (setq tmp (nth r2 mel-ccl-256-to-16-table))
+ ;; '=' [\t ]* r1:r0:[0-9A-F] r2:[0-9A-F]
+ `(write-read-repeat
+ r0
+ ,(vconcat
+ (mapcar
+ (lambda (r0)
+ (logior (lsh r0 4) tmp))
+ mel-ccl-16-table)))
+ ;; '=' [\t ]* r1:r0:[0-9A-F] r2:[^0-9A-F]
+ ;; invalid input
+ `(r3 = 0) ; nop
+ ))
+ mel-ccl-256-table))
+ ;; '=' [\t ]* r1:r0:[0-9A-F] r2:[^0-9A-F]
+ ;; invalid input ->
+ ;; output "=" with hex digit and rescan from r2.
+ (write ?=)
+ (r0 = r2)
+ (write-repeat r1)))
+ (t
+ ;; r0:[^\t\r -~]
+ ;; invalid character found.
+ ;; -> ignore.
+ `((read r0)
+ (repeat))))))
+ mel-ccl-256-table))
+ ;; r1[0]:[\t ]
+ (loop
+ ,@(apply
+ 'append
+ (mapcar
+ (lambda (regnum)
+ (let ((reg (aref [r1 r2 r3 r4 r5] regnum)))
+ (apply
+ 'append
+ (mapcar
+ (lambda (bit)
+ (if (= bit 0)
+ (if (= regnum 0)
+ nil
+ `((read r0)
+ (if (r0 == ?\t)
+ (,reg = 0)
+ (if (r0 == ?\ )
+ (,reg = 1)
+ ((r6 = ,(+ (* regnum 28) bit))
+ (break))))))
+ `((read r0)
+ (if (r0 == ?\ )
+ (,reg |= ,(lsh 1 bit))
+ (if (r0 != ?\t)
+ ((r6 = ,(+ (* regnum 28) bit))
+ (break)))))))
+ mel-ccl-28-table))))
+ '(0 1 2 3 4)))
+ ;; white space buffer exhaust.
+ ;; error: line length limit (76bytes) violation.
+ ;; -> ignore these white spaces.
+ (repeat))
+ ,(if input-crlf
+ `(if (r0 == ?\r)
+ ((read r0)
+ (if (r0 == ?\n)
+ ;; trailing white spaces found.
+ ;; -> ignore these white spacs.
+ ((write ,(if output-crlf "\r\n" "\n"))
+ (read r0)
+ (repeat))
+ ;; [\t ]* \r r0:[^\n]
+ ;; error: bare CR found.
+ ;; -> output white spaces and ignore bare CR.
+ ))
+ ;; [\t ]* r0:[^\r]
+ ;; middle white spaces found.
+ )
+ `(if (r0 == ?\n)
+ ;; trailing white spaces found.
+ ;; -> ignore these white spacs.
+ ((write ,(if output-crlf "\r\n" "\n"))
+ (read r0)
+ (repeat))
+ ;; [\t ]* r0:[^\n]
+ ;; middle white spaces found.
+ ))
+ ,@(apply
+ 'append
+ (mapcar
+ (lambda (regnum)
+ (let ((reg (aref [r1 r2 r3 r4 r5] regnum)))
+ (apply
+ 'append
+ (mapcar
+ (lambda (bit)
+ `((if (,reg & ,(lsh 1 bit))
+ (write ?\ )
+ (write ?\t))
+ (if (r6 == ,(+ (* regnum 28) bit 1))
+ (repeat))))
+ mel-ccl-28-table))))
+ '(0 1 2 3 4)))
+ (repeat)
+ ))))
+
+)
+
+(define-ccl-program mel-ccl-encode-quoted-printable-crlf-crlf
+ (mel-ccl-encode-quoted-printable-generic t t))
+
+(define-ccl-program mel-ccl-encode-quoted-printable-crlf-lf
+ (mel-ccl-encode-quoted-printable-generic t nil))
+
+(define-ccl-program mel-ccl-encode-quoted-printable-lf-crlf
+ (mel-ccl-encode-quoted-printable-generic nil t))
+
+(define-ccl-program mel-ccl-encode-quoted-printable-lf-lf
+ (mel-ccl-encode-quoted-printable-generic nil nil))
+
+(define-ccl-program mel-ccl-decode-quoted-printable-crlf-crlf
+ (mel-ccl-decode-quoted-printable-generic t t))
+
+(define-ccl-program mel-ccl-decode-quoted-printable-crlf-lf
+ (mel-ccl-decode-quoted-printable-generic t nil))
+
+(define-ccl-program mel-ccl-decode-quoted-printable-lf-crlf
+ (mel-ccl-decode-quoted-printable-generic nil t))
+
+(define-ccl-program mel-ccl-decode-quoted-printable-lf-lf
+ (mel-ccl-decode-quoted-printable-generic nil nil))
+
+
+;;; @ coding system
+;;;
+
+(make-ccl-coding-system
+ 'mel-ccl-uq-rev ?Q "MIME Q-encoding in unstructured field (reversed)"
+ 'mel-ccl-encode-uq 'mel-ccl-decode-q)
+
+(make-ccl-coding-system
+ 'mel-ccl-cq-rev ?Q "MIME Q-encoding in comment (reversed)"
+ 'mel-ccl-encode-cq 'mel-ccl-decode-q)
+
+(make-ccl-coding-system
+ 'mel-ccl-pq-rev ?Q "MIME Q-encoding in phrase (reversed)"
+ 'mel-ccl-encode-pq 'mel-ccl-decode-q)
+
+(make-ccl-coding-system
+ 'mel-ccl-b-rev ?B "MIME B-encoding (reversed)"
+ 'mel-ccl-encode-b 'mel-ccl-decode-b)
+
+(make-ccl-coding-system
+ 'mel-ccl-quoted-printable-crlf-crlf-rev
+ ?Q "MIME Quoted-Printable-encoding (reversed)"
+ 'mel-ccl-encode-quoted-printable-crlf-crlf
+ 'mel-ccl-decode-quoted-printable-crlf-crlf)
+
+(make-ccl-coding-system
+ 'mel-ccl-quoted-printable-lf-crlf-rev
+ ?Q "MIME Quoted-Printable-encoding (LF encoding) (reversed)"
+ 'mel-ccl-encode-quoted-printable-crlf-lf
+ 'mel-ccl-decode-quoted-printable-lf-crlf)
+
+(make-ccl-coding-system
+ 'mel-ccl-quoted-printable-crlf-lf-rev
+ ?Q "MIME Quoted-Printable-encoding (LF internal) (reversed)"
+ 'mel-ccl-encode-quoted-printable-lf-crlf
+ 'mel-ccl-decode-quoted-printable-crlf-lf)
+
+(make-ccl-coding-system
+ 'mel-ccl-quoted-printable-lf-lf-rev
+ ?Q "MIME Quoted-Printable-encoding (LF encoding) (LF internal) (reversed)"
+ 'mel-ccl-encode-quoted-printable-lf-lf
+ 'mel-ccl-decode-quoted-printable-lf-lf)
+
+(make-ccl-coding-system
+ 'mel-ccl-base64-crlf-rev
+ ?B "MIME Base64-encoding (reversed)"
+ 'mel-ccl-encode-base64-crlf-crlf
+ 'mel-ccl-decode-b)
+
+(make-ccl-coding-system
+ 'mel-ccl-base64-lf-rev
+ ?B "MIME Base64-encoding (LF encoding) (reversed)"
+ 'mel-ccl-encode-base64-crlf-lf
+ 'mel-ccl-decode-b)
+
+
+;;; @ B
+;;;
+
+(unless-broken ccl-execute-eof-block-on-decoding-some
+
+ (defun base64-ccl-encode-string (string)
+ "Encode STRING with base64 encoding."
+ (decode-coding-string string 'mel-ccl-base64-lf-rev))
+
+ (defun base64-ccl-encode-region (start end)
+ "Encode region from START to END with base64 encoding."
+ (interactive "r")
+ (decode-coding-region start end 'mel-ccl-base64-lf-rev))
+
+ (defun base64-ccl-insert-encoded-file (filename)
+ "Encode contents of file FILENAME to base64, and insert the result."
+ (interactive (list (read-file-name "Insert encoded file: ")))
+ (let ((coding-system-for-read 'mel-ccl-base64-lf-rev))
+ (insert-file-contents filename)))
+
+ (mel-define-method-function (mime-encode-string string (nil "base64"))
+ 'base64-ccl-encode-string)
+ (mel-define-method-function (mime-encode-region start end (nil "base64"))
+ 'base64-ccl-encode-region)
+ (mel-define-method-function
+ (mime-insert-encoded-file filename (nil "base64"))
+ 'base64-ccl-insert-encoded-file)
+
+ (mel-define-method-function (encoded-text-encode-string string (nil "B"))
+ 'base64-ccl-encode-string)
+ )
+
+(defun base64-ccl-decode-string (string)
+ "Decode base64 encoded STRING"
+ (encode-coding-string string 'mel-ccl-b-rev))
+
+(defun base64-ccl-decode-region (start end)
+ "Decode base64 encoded the region from START to END."
+ (interactive "r")
+ (encode-coding-region start end 'mel-ccl-b-rev))
+
+(defun base64-ccl-write-decoded-region (start end filename)
+ "Decode the region from START to END and write out to FILENAME."
+ (interactive
+ (list (region-beginning) (region-end)
+ (read-file-name "Write decoded region to file: ")))
+ (let ((coding-system-for-write 'mel-ccl-b-rev)
+ jka-compr-compression-info-list)
+ (write-region start end filename)))
+
+(mel-define-method-function (mime-decode-string string (nil "base64"))
+ 'base64-ccl-decode-string)
+(mel-define-method-function (mime-decode-region start end (nil "base64"))
+ 'base64-ccl-decode-region)
+(mel-define-method-function
+ (mime-write-decoded-region start end filename (nil "base64"))
+ 'base64-ccl-write-decoded-region)
+
+(mel-define-method encoded-text-decode-string (string (nil "B"))
+ (if (and (string-match B-encoded-text-regexp string)
+ (string= string (match-string 0 string)))
+ (base64-ccl-decode-string string)
+ (error "Invalid encoded-text %s" string)))
+
+
+;;; @ quoted-printable
+;;;
+
+(unless-broken ccl-execute-eof-block-on-decoding-some
+
+ (defun quoted-printable-ccl-encode-string (string)
+ "Encode STRING with quoted-printable encoding."
+ (decode-coding-string
+ string
+ 'mel-ccl-quoted-printable-lf-lf-rev))
+
+ (defun quoted-printable-ccl-encode-region (start end)
+ "Encode the region from START to END with quoted-printable encoding."
+ (interactive "r")
+ (decode-coding-region start end 'mel-ccl-quoted-printable-lf-lf-rev))
+
+ (defun quoted-printable-ccl-insert-encoded-file (filename)
+ "Encode contents of the file named as FILENAME, and insert it."
+ (interactive (list (read-file-name "Insert encoded file: ")))
+ (let ((coding-system-for-read 'mel-ccl-quoted-printable-lf-lf-rev))
+ (insert-file-contents filename)))
+
+ (mel-define-method-function
+ (mime-encode-string string (nil "quoted-printable"))
+ 'quoted-printable-ccl-encode-string)
+ (mel-define-method-function
+ (mime-encode-region start end (nil "quoted-printable"))
+ 'quoted-printable-ccl-encode-region)
+ (mel-define-method-function
+ (mime-insert-encoded-file filename (nil "quoted-printable"))
+ 'quoted-printable-ccl-insert-encoded-file)
+ )
+
+(defun quoted-printable-ccl-decode-string (string)
+ "Decode quoted-printable encoded STRING."
+ (encode-coding-string
+ string
+ 'mel-ccl-quoted-printable-lf-lf-rev))
+
+(defun quoted-printable-ccl-decode-region (start end)
+ "Decode the region from START to END with quoted-printable
+encoding."
+ (interactive "r")
+ (encode-coding-region start end 'mel-ccl-quoted-printable-lf-lf-rev))
+
+(defun quoted-printable-ccl-write-decoded-region
+ (start end filename)
+ "Decode quoted-printable encoded current region and write out to FILENAME."
+ (interactive
+ (list (region-beginning) (region-end)
+ (read-file-name "Write decoded region to file: ")))
+ (let ((coding-system-for-write 'mel-ccl-quoted-printable-lf-lf-rev))
+ (write-region start end filename)))
+
+(mel-define-method-function
+ (mime-decode-string string (nil "quoted-printable"))
+ 'quoted-printable-ccl-decode-string)
+(mel-define-method-function
+ (mime-decode-region start end (nil "quoted-printable"))
+ 'quoted-printable-ccl-decode-region)
+(mel-define-method-function
+ (mime-write-decoded-region start end filename (nil "quoted-printable"))
+ 'quoted-printable-ccl-write-decoded-region)
+
+
+;;; @ Q
+;;;
+
+(defun q-encoding-ccl-encode-string (string &optional mode)
+ "Encode STRING to Q-encoding of encoded-word, and return the result.
+MODE allows `text', `comment', `phrase' or nil. Default value is
+`phrase'."
+ (decode-coding-string
+ string
+ (cond
+ ((eq mode 'text) 'mel-ccl-uq-rev)
+ ((eq mode 'comment) 'mel-ccl-cq-rev)
+ (t 'mel-ccl-pq-rev))))
+
+(defun q-encoding-ccl-decode-string (string)
+ "Decode Q encoded STRING and return the result."
+ (encode-coding-string
+ string
+ 'mel-ccl-uq-rev))
+
+(unless (featurep 'xemacs)
+ (defun q-encoding-ccl-encoded-length (string &optional mode)
+ (let ((status [nil nil nil nil nil nil nil nil nil]))
+ (fillarray status nil)
+ (ccl-execute-on-string
+ (cond
+ ((eq mode 'text) 'mel-ccl-count-uq)
+ ((eq mode 'comment) 'mel-ccl-count-cq)
+ (t 'mel-ccl-count-pq))
+ status
+ string)
+ (aref status 0)))
+ )
+
+(mel-define-method-function (encoded-text-encode-string string (nil "Q"))
+ 'q-encoding-ccl-encode-string)
+
+(mel-define-method encoded-text-decode-string (string (nil "Q"))
+ (if (and (string-match Q-encoded-text-regexp string)
+ (string= string (match-string 0 string)))
+ (q-encoding-ccl-decode-string string)
+ (error "Invalid encoded-text %s" string)))
+
+
+;;; @ end
+;;;
+
+(provide 'mel-ccl)
+
+;;; mel-ccl.el ends here
+++ /dev/null
-;;; mel-dl.el: Base64 encoder/decoder using DL module
-
-;; Copyright (C) 1998 Free Software Foundation, Inc.
-
-;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
-;; 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.
)
))
-(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
))
-(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
(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
)))
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
;; 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
(require 'mime-def)
+(mel-define-backend "x-uue")
+
+
;;; @ variables
;;;
))
)))
-(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'."
(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
(provide 'mel-u)
+(mel-define-backend "x-uuencode" ("x-uue"))
+
;;; mel-u.el ends here
;; Copyright (C) 1995,1996,1997,1998 Free Software Foundation, Inc.
;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
-;; modified by Shuhei KOBAYASHI <shuhei-k@jaist.ac.jp>
;; 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
;;; 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)
(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
;;; 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\e.D\8eò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
(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")
(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
;;;
;;; @ 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
))))
(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)))
(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
;;;
<!doctype sinfo system>
<head>
-<title>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
</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
</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
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> \e$B$r\e(B <var>encoding</var> \e$B$H$7$FI|9f$7$?7k2L$rJV$7$^$9!#\e(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>
<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
\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
@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
@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
@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
-@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
@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} \e$B$r\e(B @var{encoding} \e$B$H$7$FI|9f$7$?7k2L$rJV$7$^$9!#\e(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} \e$B$r\e(B @var{encoding} \e$B$H$7$FI|9f$7$?7k2L$rJV$7$^$9!#\e(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
<!doctype sinfo system>
<head>
-<title>FLIM 1.9 MIME \e$B5!G=@bL@=q\e(B
+<title>FLIM 1.10 MIME \e$B5!G=@bL@=q\e(B
<author>\e$B<i2,\e(B \e$BCNI'\e(B <mail>morioka@jaist.ac.jp</mail>
<date>1998/07/01
<h3> mm-backend \e$B$N:n$jJ}\e(B
<node> mm-backend module
<p>
-\e$B!J$9$_$^$;$s!#$=$N$&$A=q$-$^$9\e(B (^_^;\e$B!K\e(B
+<defmacro name="mm-define-backend">
+<args> type
+<opts> parents
<p>
-\e$B!J$H$j$"$($:!"\e(Bmm*.el \e$B$r;29M$K$7$F$/$@$5$$!K\e(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 \e$BMs$N>pJs\e(B
</defun>
-<h2> \e$BNN0h$NId9f2=!&I|9f2=\e(B
-<node> Region encoder/decoder
+<h2> \e$BId9f2=!&I|9f2=\e(B
+<node> encoder/decoder
<p>
<defun name="mime-encode-region">
<args> start end encoding
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> \e$BJ8;zNs$NId9f2=!&I|9f2=\e(B
-<node> String encoder/decoder
-<p>
<defun name="mime-decode-string">
<args> string encoding
<p>
<var>string</var> \e$B$r\e(B <var>encoding</var> \e$B$H$7$FI|9f$7$?7k2L$rJV$7$^$9!#\e(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 \e$B$NId9f2=!&I|9f2=\e(B
-<node> File encoder/decoder
-<p>
<defun name="mime-insert-encoded-file">
<args> filename encoding
<p>
<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 \e$B$N\e(B network \e$BI=8=\e(B
\input texinfo.tex
@setfilename mime-ja.info
-@settitle{FLIM 1.9 MIME \e$B5!G=@bL@=q\e(B}
+@settitle{FLIM 1.10 MIME \e$B5!G=@bL@=q\e(B}
@titlepage
-@title FLIM 1.9 MIME \e$B5!G=@bL@=q\e(B
+@title FLIM 1.10 MIME \e$B5!G=@bL@=q\e(B
@author \e$B<i2,\e(B \e$BCNI'\e(B <morioka@@jaist.ac.jp>
@subtitle 1998/07/01
@end titlepage
@node Top, Introduction, (dir), (dir)
-@top FLIM 1.9 MIME \e$B5!G=@bL@=q\e(B
+@top FLIM 1.10 MIME \e$B5!G=@bL@=q\e(B
@ifinfo
@node mm-backend module, , Request for entity, mm-backend
@subsection mm-backend \e$B$N:n$jJ}\e(B
-\e$B!J$9$_$^$;$s!#$=$N$&$A=q$-$^$9\e(B (^_^;\e$B!K\e(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
-\e$B!J$H$j$"$($:!"\e(Bmm*.el \e$B$r;29M$K$7$F$/$@$5$$!K\e(B
@node Content-Type, Content-Disposition, Entity, Top
@menu
* Content-Transfer-Encoding parser:: Content-Transfer-Encoding \e$BMs$N2r@O4o\e(B
-* Region encoder/decoder:: \e$BNN0h$NId9f2=!&I|9f2=\e(B
-* String encoder/decoder:: \e$BJ8;zNs$NId9f2=!&I|9f2=\e(B
-* File encoder/decoder:: File \e$B$NId9f2=!&I|9f2=\e(B
+* encoder/decoder:: \e$BId9f2=!&I|9f2=\e(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 \e$BMs$N2r@O4o\e(B
@defun mime-parse-Content-Transfer-Encoding string
-@node Region encoder/decoder, String encoder/decoder, Content-Transfer-Encoding parser, Content-Transfer-Encoding
-@section \e$BNN0h$NId9f2=!&I|9f2=\e(B
+@node encoder/decoder, Encoding information, Content-Transfer-Encoding parser, Content-Transfer-Encoding
+@section \e$BId9f2=!&I|9f2=\e(B
@defun mime-encode-region start end encoding
@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} \e$B$r\e(B @var{encoding} \e$B$H$7$FI|9f$7$?7k2L$rJV$7$^$9!#\e(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 \e$BJ8;zNs$NId9f2=!&I|9f2=\e(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} \e$B$r\e(B @var{encoding} \e$B$H$7$FI|9f$7$?7k2L$rJV$7$^$9!#\e(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 \e$B$NId9f2=!&I|9f2=\e(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
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
projects / elisp / flim.git / commitdiff