From a0a1ddc99e2a091b842f608db40de667b57858d2 Mon Sep 17 00:00:00 2001 From: akr Date: Wed, 30 Sep 1998 17:35:23 +0000 Subject: [PATCH] * Sync up with flim-1_10_0. * mime-def.el (mime-library-version): Bump up to FLAM-DOODLE 1.10.0. --- ChangeLog | 209 ++++++++++++++++++++ DOODLE-VERSION | 2 +- FLIM-ELS | 8 +- FLIM-VERSION | 40 ++-- Makefile | 4 +- README.en | 29 +-- TESTPAT | 3 +- ew-bq.el | 11 +- ew-dec.el | 2 + eword-decode.el | 50 +---- eword-encode.el | 12 +- mel-b-dl.el | 123 ++++++++++++ mel-b.el | 125 +++++------- mel-ccl.el | 133 ++++++------- mel-dl.el | 94 --------- mel-g.el | 7 +- mel-q.el | 83 ++++---- mel-u.el | 7 +- mel.el | 593 ++++++++++++++++--------------------------------------- mime-def.el | 95 ++++++++- mime.el | 10 - 21 files changed, 814 insertions(+), 826 deletions(-) create mode 100644 mel-b-dl.el delete mode 100644 mel-dl.el diff --git a/ChangeLog b/ChangeLog index 881b533..4dc2481 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,10 @@ +1998-09-30 Tanaka Akira + + * Sync up with flim-1_10_0. + + * mime-def.el (mime-library-version): Bump up to FLAM-DOODLE + 1.10.0. + 1998-09-25 Tanaka Akira * ew-compat.el: New file. @@ -1182,6 +1189,208 @@ * eword-decode.el: Copied from AKEMI branch of SEMI. +1998-09-29 MORIOKA Tomohiko + + * FLIM: Version 1.10.0 (K-Dòdo)-A was released. + + * README.en (What's FLIM): Add mel-ccl.el. + +1998-09-21 Tanaka Akira + + * mel-ccl.el: + - Require 'pccl instead of 'emu. + - Use `unless-broken' to check facility. + +1998-09-27 MORIOKA Tomohiko + + * mel.el (mime-encoding-list): New user option (renamed from + `mime-content-transfer-encoding-list'). + (mime-encoding-list): New function. + (mime-encoding-alist): New function. + (mime-encode-region): Use `mime-encoding-alist' for completion. + (mime-decode-region): Likewise. + (mime-insert-encoded-file): Likewise. + (mime-write-decoded-region): Likewise. + +1998-09-24 MORIOKA Tomohiko + + * eword-decode.el (eword-decode-structured-field-list): Add + Mail-Followup-To field. + +1998-09-20 MORIOKA Tomohiko + + * eword-encode.el (eword-charset-encoding-alist): Add utf-8. + +1998-09-20 MORIOKA Tomohiko + + * mel.el (mime-content-transfer-encoding-list): New user option. + (mime-encode-region): Use `mime-content-transfer-encoding-list' + for completion. + (mime-decode-region): Likewise. + (mime-insert-encoded-file): Likewise. + (mime-write-decoded-region): Likewise. + + * mel.el (mime-write-decoded-region): fix typo. + +1998-09-20 MORIOKA Tomohiko + + * mime-def.el (mel-define-method-function): Don't override. + +1998-09-20 MORIOKA Tomohiko + + * mel.el, mel-ccl.el, FLIM-ELS: Add mel-ccl.el. + +1998-09-20 MORIOKA Tomohiko + + * mel-dl.el, README.en, FLIM-ELS: Rename mel-dl.el to mel-b-dl.el. + + * mel.el: - Rename mel-dl.el to mel-b-dl.el. + - Move `mel-define-service' to mime-def.el. + + * mime-def.el (mel-define-service): New macro (moved from mel.el); + fixed problem in Emacs. + (mel-define-method): Use `mel-define-service'. + (mel-define-method-function): Use `mel-define-service'. + +1998-09-20 MORIOKA Tomohiko + + * mel.el (mime-encode-region): Don't regard nil encoding as + "7bit". + +1998-09-19 MORIOKA Tomohiko + + * eword-encode.el (eword-encode-text): Use + `encoded-text-encode-string'. + (tm-eword::encoded-word-length): `q-encoding-encoded-length' was + renamed to `Q-encoded-text-length'. + + * eword-decode.el: Move `base64-token-regexp', + `base64-token-padding-regexp', `eword-B-encoded-text-regexp' and + `eword-Q-encoded-text-regexp' to mime-def.el. + (eword-decode-encoded-text): Use `encoded-text-decode-string'. + + * mel-q.el: Define method functions of mel. + (mime-insert-encoded-file): Use `mel-define-method'; abolish + `quoted-printable-insert-encoded-file'. + (mime-write-decoded-region): Use `mel-define-method'; abolish + `quoted-printable-write-decoded-region'. + - Move `q-encoding-printable-char-p' and + `q-encoding-encoded-length' to mel.el. + + * mel-b.el: Define method functions of mel. + (mime-insert-encoded-file): Use `mel-define-method'; abolish + `base64-insert-encoded-file'. + (mime-write-decoded-region): Use `mel-define-method'; abolish + `base64-write-decoded-region'. + - Move `base64-encoded-length' to mel.el. + + * mel-dl.el (base64-encode-region): Define directly (abolish + `base64-dl-encode-region'). + (base64-decode-region): Define directly (abolish + `base64-dl-decode-region'). Define method functions of mel. + (mime-insert-encoded-file): Use `mel-define-method'; abolish + `base64-insert-encoded-file'; don't use external encoder. + (mime-write-decoded-region): Use `mel-define-method'; abolish + `base64-write-decoded-region'; don't use external decoder. + - Move `base64-encoded-length' to mel.el. + + * mime.el: Move `mm-arglist-to-arguments' to mime-def.el. + + * mime-def.el (base64-token-regexp): New constant (moved from + eword-decode.el). + (base64-token-padding-regexp): Likewise. + (B-encoded-text-regexp): New constant (moved from eword-decode.el, + and renamed from `eword-B-encoded-text-regexp'). + (Q-encoded-text-regexp): New constant (moved from eword-decode.el, + and renamed from `eword-Q-encoded-text-regexp'. + (mm-arglist-to-arguments): New function (moved from mime.el). + (mel-define-method): New macro. + (mel-define-method-function): New macro. + (mel-define-function): New macro. + + * mel.el (mel-encoding-module-alist): New variable. + (mel-use-module): New function. + (mel-find-function): New function. + (mel-define-service): New macro. + (mime-encode-region): Use `mel-find-function'; abolish variable + `mime-encoding-method-alist'. + (mime-decode-region): Use `mel-find-function'; abolish variable + `mime-decoding-method-alist'. + (mime-decode-string): Use `mel-find-function'; abolish variable + `mime-string-decoding-method-alist'. + (encoded-text-encode-string): New function. + (encoded-text-decode-string): New function. + (base64-encoded-length): New function (moved from mel-b.el and + mel-dl.el). + (Q-encoding-printable-char-p): New function (moved from mel-q.el, + and renamed from `q-encoding-printable-char-p'). + (Q-encoded-text-length): New function (moved from mel-q.el, and + renamed from `q-encoding-encoded-length'). + (mime-insert-encoded-file): Use `mel-find-function'; abolish + variable `mime-file-encoding-method-alist'. + (mime-write-decoded-region): Use `mel-find-function'; abolish + variable `mime-file-decoding-method-alist'. + +1998-09-16 MORIOKA Tomohiko + + * mel-b.el (base64-internal-encoding-limit): modify :type. + (base64-internal-decoding-limit): Change initial value to 70000; + modify :type. + + * mel-b.el (base64-decode-string!): Renamed from + `base64-internal-decode-string!'. + +1998-09-16 MORIOKA Tomohiko + + * mel-b.el (base64-characters): New constant. + (base64-num-to-char): Use `base64-characters'. + (base64-numbers): Use `base64-characters'. + (base64-internal-decode): Modify calculation third byte. + + * mel-dl.el (base64-dl-encode-string): New alias. + (base64-dl-decode-string): New alias. + (base64-dl-encode-region): Renamed from `base64-encode-region'; + don't save-excursion and save-restriction. + (base64-dl-decode-region): Renamed from `base64-decode-region'; + don't save-excursion and save-restriction; convert all at once. + (base64-encode-region): New alias. + (base64-decode-region): New alias. + + * mel-b.el (base64-internal-decode): New function. + (base64-internal-decode-string): Use `base64-internal-decode'. + (base64-internal-decode-string!): New function. + (base64-internal-decode-region): Use + `base64-internal-decode-string!' instead of + `base64-internal-decode-string'. + +1998-09-15 Tanaka Akira + + * mel-b.el (base64-numbers): Fix a position of 63. + +1998-09-15 MORIOKA Tomohiko + + * mel-b.el (base64-numbers): New constant. + (base64-char-to-num): New macro. + (base64-internal-decode-string): Don't use memq. + +1998-09-15 MORIOKA Tomohiko + + * mel-b.el (base64): New group. + (base64-external-encoder): Now a user option. + (base64-external-decoder): Now a user option. + (base64-external-decoder-option-to-specify-file): Now a user + option. + (base64-internal-encoding-limit): Now a user option. + (base64-internal-decoding-limit): Now a user option. + + * mel-b.el (base64-internal-decode-string): New implementation; + abolish function `base64-decode-unit'. + +1998-09-15 MORIOKA Tomohiko + + * README.en (Installation): Fix typo. + + 1998-09-15 MORIOKA Tomohiko * FLIM: Version 1.9.2 (Shin-Tanabe) was released. diff --git a/DOODLE-VERSION b/DOODLE-VERSION index d986b15..e8770a7 100644 --- a/DOODLE-VERSION +++ b/DOODLE-VERSION @@ -19,7 +19,7 @@ Order is not significant. 13 $(DT`(B $B$=$R(B 2.5YR7.0/11.0 FLAM-DOODLE 1.9.3 14 $B3A(B $B$+$-(B 10R6.5/10.0 FLAM-DOODLE 1.9.4 15 $B?<;Y;R(B $B$3$-$/$A$J$7(B 10YR7.5/8.0 FLAM-DOODLE 1.9.5 - 16 $B4;;R(B $B$3$&$8(B 7.5YR7.0/11.0 + 16 $B4;;R(B $B$3$&$8(B 7.5YR7.0/11.0 FLAM-DOODLE 1.10.0 17 $B5`MU(B $B$/$A$P(B 10YR7.5/10.0 18 $B@VGrFK(B $B$"$+$7$m$D$k$P$_(B 5.0YR8.0/6.0 19 $B>.F&(B $B$"$:$-(B 2.5R3.5/5.0 diff --git a/FLIM-ELS b/FLIM-ELS index 8b7e8e2..7c80cd5 100644 --- a/FLIM-ELS +++ b/FLIM-ELS @@ -6,7 +6,7 @@ (setq flim-modules '(std11 mime-def - mel mel-ccl mel-b mel-q mel-u mel-g + mel mel-b mel-q mel-u mel-g closure natset digraph @@ -32,7 +32,11 @@ )) (if (fboundp 'dynamic-link) - (setq flim-modules (cons 'mel-dl flim-modules)) + (setq flim-modules (cons 'mel-b-dl flim-modules)) + ) + +(if (featurep 'mule) + (setq flim-modules (cons 'mel-ccl flim-modules)) ) ;;; FLIM-ELS ends here diff --git a/FLIM-VERSION b/FLIM-VERSION index 0bd50b4..f865c35 100644 --- a/FLIM-VERSION +++ b/FLIM-VERSION @@ -4,43 +4,43 @@ ;;------------------------------------------------------------------------- ;; Kinki Nippon Railway $(B6a5&F|K\E4F;(B http://www.kintetsu.co.jp/ -;; Ky-Dòto Line $(B5~ET@~(B-A +;; Ky-Dòto-A Line $(B5~ET@~(B ;;------------------------------------------------------------------------- -1.0.1 Ky-Dòto $(B5~ET(B ; <=> JR, $(B5~ET;T8rDL6I(B-A -1.1.0 T-Dòji $(BEl;{(B-A -1.2.0 J-Dþjò $(B==>r(B-A +1.0.1 Ky-Dòto-A $(B5~ET(B ; <=> JR, $(B5~ET;T8rDL6I(B +1.1.0 T-Dòji-A $(BEl;{(B +1.2.0 J-Dþjò-A $(B==>r(B 1.2.1 Kamitobaguchi $(B>eD;1)8}(B 1.2.2 Takeda $(BC]ED(B ; = $(B5~ET;T8rDL6I(B $(B1(4]@~(B 1.3.0 Fushimi $(BIz8+(B 1.4.0 Kintetsu-Tambabashi $(B6aE4C0GH66(B ; <=> $(B5~:e(B $(BC0GH66(B -1.4.1 Momoyama-Gory-Dòmae $(BEm;38fNMA0(B-A +1.4.1 Momoyama-Gory-Dòmae-A $(BEm;38fNMA0(B 1.5.0 Mukaijima $(B8~Eg(B 1.6.0 Ogura $(B>.AR(B 1.7.0 Iseda $(B0K@*ED(B -1.8.0 -DÒkubo $(BBg5WJ](B-A +1.8.0 -DÒkubo-A $(BBg5WJ](B 1.8.1 Kutsukawa $(B5WDE@n(B 1.9.0 Terada $(B;{ED(B -1.9.1 Tonosh-Dò $(BIYLnAq(B-A +1.9.1 Tonosh-Dò-A $(BIYLnAq(B 1.9.2 Shin-Tanabe $(B?7EDJU(B ------ K-Dòdo $(B6=8M(B-A +1.10.0 K-Dòdo-A $(B6=8M(B ----- Miyamaki $(B;0;3LZ(B ----- Kintetsu-Miyazu $(B6aE45\DE(B ----- Komada $(B9}ED(B ------ Shin-H-Dòsono $(B?7=K1`(B-A +----- Shin-H-Dòsono-A $(B?7=K1`(B ----- Kizugawadai $(BLZDE@nBf(B ----- Yamadagawa $(B;3ED@n(B ----- Takanohara $(B9b$N86(B ------ Heij-Dò $(BJ?>k(B-A +----- Heij-Dò-A $(BJ?>k(B ----- Saidaiji $(B@>Bg;{(B ;;------------------------------------------------------------------------- ;; Kinki Nippon Railway $(B6a5&F|K\E4F;(B http://www.kintetsu.co.jp/ -;; Ky-Dòto Line $(B3`86@~(B-A +;; Ky-Dòto-A Line $(B3`86@~(B ;;------------------------------------------------------------------------- (Saidaiji) ($(B@>Bg;{(B) ----- Amagatsuji $(BFt%vDT(B ------ Nishinoky-Dò $(B@>$N5~(B-A ------ Kuj-Dò $(B6e>r(B-A ------ Kintetsu-K-Dòriyama $(B6aE474;3(B-A +----- Nishinoky-Dò-A $(B@>$N5~(B +----- Kuj-Dò-A $(B6e>r(B +----- Kintetsu-K-Dòriyama-A $(B6aE474;3(B [Chao Version names] @@ -53,8 +53,10 @@ ;;------------------------------------------------------------------------- 1.2.0 Takeda $(BC]ED(B ; = $(B6aE4(B $(B5~ET@~(B 1.3.0 Kuinabashi $(B$/$$$J66(B -1.4.0 J-Dþjò $(B==>r(B-A -1.6.0 Kuj-Dò $(B6e>r(B-A -1.6.1 Ky-Dòto $(B5~ET(B ; <=> JR, $(B6aE4(B-A -1.7.0 Goj-Dò $(B8^>r(B-A -1.8.0 Shij-Dò $(B;M>r(B-A +1.4.0 J-Dþjò-A $(B==>r(B +1.6.0 Kuj-Dò-A $(B6e>r(B +1.6.1 Ky-Dòto-A $(B5~ET(B ; <=> JR, $(B6aE4(B +1.7.0 Goj-Dò-A $(B8^>r(B +1.8.0 Shij-Dò-A $(B;M>r(B ; <=> $(B:e5^(B $(B5~ET@~(B +1.9.0 Karasuma Oike $(B1(4]8fCS(B ; = $(B5~ET;T8rDL6I(B $(BEl@>@~(B +----- Marutamach $(B4]B@D.(B diff --git a/Makefile b/Makefile index b787062..9c7d9b3 100644 --- a/Makefile +++ b/Makefile @@ -3,16 +3,16 @@ # PACKAGE = flim -VERSION = 1.9.2 +VERSION = 1.10.0 TAR = tar RM = /bin/rm -f CP = /bin/cp -p EMACS = emacs +XEMACS = xemacs FLAGS = -batch -q -no-site-file -eval "$${EVALARGS:-nil}" FLAGS_CURDIR = $(FLAGS) -eval '(setq load-path (cons "." load-path))' -XEMACS = xemacs PREFIX = NONE LISPDIR = NONE diff --git a/README.en b/README.en index 9cf5025..ce7ff24 100644 --- a/README.en +++ b/README.en @@ -11,21 +11,24 @@ What's FLIM mime.el --- MIME library - mime-def.el --- Definitions about MIME format + mime-def.el --- Definitions about MIME format - mime-parse.el --- MIME parser + mime-parse.el --- MIME parser - mel.el --- MIME encoder/decoder - mel-dl.el --- base64 (b-encoding) encoder/decoder - (for Emacs 20 with dynamic loading support) - mel-b.el --- base64 (b-encoding) encoder/decoder - (for other emacsen) - mel-q.el --- quoted-printable and q-encoding encoder/decoder - mel-u.el --- unofficial module for uuencode - mel-g.el --- unofficial module for gzip64 + mel.el --- MIME encoder/decoder + mel-b-dl.el --- base64 (B-encoding) encoder/decoder + (for Emacs 20 with dynamic loading support) + mel-b.el --- base64 (B-encoding) encoder/decoder + (for other emacsen) + mel-q.el --- quoted-printable and Q-encoding + encoder/decoder + mel-ccl.el --- base64 (B-encoding), quoted-printable and + Q-encoding encoder/decoder using CCL + mel-u.el --- unofficial module for uuencode + mel-g.el --- unofficial module for gzip64 - eword-decode.el --- encoded-word decoder - eword-encode.el --- encoded-word encoder + eword-decode.el --- encoded-word decoder + eword-encode.el --- encoded-word encoder mailcap.el --- mailcap parser and utility @@ -47,7 +50,7 @@ Installation You can specify the emacs command name, for example - % make install EMACS=xemacs + % make EMACS=xemacs If `EMACS=...' is omitted, EMACS=emacs is used. diff --git a/TESTPAT b/TESTPAT index cc51ee6..d9a81d6 100644 --- a/TESTPAT +++ b/TESTPAT @@ -70,7 +70,8 @@ (ew-ignore-75bytes-limit (memq 'ignore-75bytes-limit opts)) (ew-ignore-76bytes-limit (memq 'ignore-76bytes-limit opts)) (ew-permit-sticked-comment (memq 'permit-sticked-comment opts)) - (ew-permit-sticked-special (memq 'permit-sticked-special opts))) + (ew-permit-sticked-special (memq 'permit-sticked-special opts)) + (ew-permit-null-encoded-text nil)) (string-match "\\`[^:]*:" src) (let* ((field-name (substring src (match-beginning 0) diff --git a/ew-bq.el b/ew-bq.el index 980eb1d..ec0e8fe 100644 --- a/ew-bq.el +++ b/ew-bq.el @@ -1,7 +1,14 @@ (require 'emu) (require 'mel) -(defalias 'ew-decode-q 'q-encoding-decode-string) -(defalias 'ew-decode-b 'base64-decode-string) +(defun ew-decode-q (string) + (if (equal string "") + "" + (encoded-text-decode-string string "Q"))) + +(defun ew-decode-b (string) + (if (equal string "") + "" + (encoded-text-decode-string string "B"))) (provide 'ew-bq) diff --git a/ew-dec.el b/ew-dec.el index 90305e3..d958195 100644 --- a/ew-dec.el +++ b/ew-dec.el @@ -591,4 +591,6 @@ each line is separated by CRLF." (ew-decode-field-no-cache "From" "\"Cl\351ment Brousset\" ")) +(ew-decode-field-no-cache "From" " \"Jacek \\\"Jaytee\\\" Szyd\263owski\" ") + ) diff --git a/eword-decode.el b/eword-decode.el index dffad52..9982cbd 100644 --- a/eword-decode.el +++ b/eword-decode.el @@ -115,38 +115,6 @@ however this behaviour violates RFC2047." (defconst eword-encoded-word-regexp eword-encoded-word-in-unstructured-regexp) -;;; @@ 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)) - - ;;; @ internal utilities ;;; @@ -396,6 +364,7 @@ Each field name must be symbol." (defcustom eword-decode-structured-field-list '(Reply-To Resent-Reply-To From Resent-From Sender Resent-Sender To Resent-To Cc Resent-Cc Bcc Resent-Bcc Dcc + Mail-Followup-To Mime-Version Content-Type Content-Transfer-Encoding Content-Disposition User-Agent) "*List of field-names to decode as structured field. @@ -528,22 +497,7 @@ if there are in decoded encoded-text (generated by bad manner MUA such as a version of Net$cape)." (let ((cs (mime-charset-to-coding-system charset))) (if cs - (let ((dest - (cond - ((string-equal "B" encoding) - (if (and (string-match eword-B-encoded-text-regexp string) - (string-equal string (match-string 0 string))) - (base64-decode-string string) - (error "Invalid encoded-text %s" string))) - ((string-equal "Q" encoding) - (if (and (string-match eword-Q-encoded-text-regexp string) - (string-equal string (match-string 0 string))) - (q-encoding-decode-string string) - (error "Invalid encoded-text %s" string))) - (t - (error "Invalid encoding %s" encoding) - ))) - ) + (let ((dest (encoded-text-decode-string string encoding))) (when dest (setq dest (decode-mime-charset-string dest charset)) (if must-unfold diff --git a/eword-encode.el b/eword-encode.el index d7b77eb..c1603cd 100644 --- a/eword-encode.el +++ b/eword-encode.el @@ -85,6 +85,7 @@ If method is nil, this field will not be encoded." (euc-kr . "B") (iso-2022-jp-2 . "B") (iso-2022-int-1 . "B") + (utf-8 . "B") )) @@ -97,13 +98,7 @@ CHARSET is a symbol to indicate MIME charset of the encoded-word. ENCODING allows \"B\" or \"Q\". MODE is allows `text', `comment', `phrase' or nil. Default value is `phrase'." - (let ((text - (cond ((string= encoding "B") - (base64-encode-string string)) - ((string= encoding "Q") - (q-encoding-encode-string string mode)) - ) - )) + (let ((text (encoded-text-encode-string string encoding))) (if text (concat "=?" (upcase (symbol-name charset)) "?" encoding "?" text "?=") @@ -262,8 +257,7 @@ MODE is allows `text', `comment', `phrase' or nil. Default value is ) ((string-equal encoding "Q") (setq string (encode-mime-charset-string string charset)) - (q-encoding-encoded-length string - (ew-rword-type rword)) + (Q-encoded-text-length string (ew-rword-type rword)) ))) (if ret (cons (+ 7 (length (symbol-name charset)) ret) string) diff --git a/mel-b-dl.el b/mel-b-dl.el new file mode 100644 index 0000000..1d3fb14 --- /dev/null +++ b/mel-b-dl.el @@ -0,0 +1,123 @@ +;;; mel-b-dl.el: Base64 encoder/decoder using DL module + +;; Copyright (C) 1998 Free Software Foundation, Inc. + +;; Author: MORIOKA Tomohiko +;; Keywords: MIME, Base64 + +;; This file is part of MEL (MIME Encoding Library). + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License as +;; published by the Free Software Foundation; either version 2, or (at +;; your option) any later version. + +;; This program is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Code: + +(require 'emu) +(require 'mime-def) + +(eval-and-compile + (defvar base64-dl-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) + ) + +(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 base64-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) + + +(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")) + 'base64-decode-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 + (insert-file-contents-as-binary filename) + (buffer-string)))) + (or (bolp) + (insert "\n")) + ) + +(mel-define-method mime-write-decoded-region (start end filename + (nil "base64")) + "Decode and write current region encoded by base64 into FILENAME. +START and END are buffer positions." + (interactive + (list (region-beginning) (region-end) + (read-file-name "Write decoded region to file: "))) + (let ((str (buffer-substring start end))) + (with-temp-buffer + (insert (decode-base64-string str)) + (write-region-as-binary (point-min) (point-max) filename) + ))) + + +;;; @ end +;;; + +(provide 'mel-b-dl) + +;;; mel-b-dl.el ends here. diff --git a/mel-b.el b/mel-b.el index 70fe8be..deb54ff 100644 --- a/mel-b.el +++ b/mel-b.el @@ -101,7 +101,7 @@ external decoder is called." (base64-num-to-char (ash (logand a 3) 4))) "==") )))) -(defun base64-internal-encode-string (string) +(defun base64-encode-string (string) "Encode STRING to base64, and return the result." (let ((len (length string)) (b 0)(e 57) @@ -135,7 +135,7 @@ external decoder is called." (narrow-to-region beg end) (let ((str (buffer-substring beg end))) (delete-region beg end) - (insert (base64-internal-encode-string str)) + (insert (base64-encode-string str)) ) (or (bolp) (insert "\n") @@ -239,61 +239,10 @@ external decoder is called." (buffer-string))) -;;; @ base64 encoder/decoder for file +;;; @ application interfaces ;;; -(defun base64-external-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-internal-insert-encoded-file (filename) - "Encode contents of file FILENAME to base64, and insert the result." - (interactive (list (read-file-name "Insert encoded file: "))) - (insert - (base64-internal-encode-string - (with-temp-buffer - (insert-file-contents-as-binary filename) - (buffer-string)))) - (or (bolp) - (insert "\n")) - ) - -(defun base64-external-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))))) - -(defun base64-internal-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: "))) - (let ((str (buffer-substring start end))) - (with-temp-buffer - (insert (base64-internal-decode-string str)) - (write-region-as-binary (point-min) (point-max) filename)))) - - -;;; @ mixed functions -;;; - -(defun base64-int-ext-encode-region (start end) +(defun base64-encode-region (start end) "Encode current region by base64. START and END are buffer positions. This function calls internal base64 encoder if size of region is @@ -307,7 +256,7 @@ metamail or XEmacs package)." (base64-external-encode-region start end) (base64-internal-encode-region start end))) -(defun base64-int-ext-decode-region (start end) +(defun base64-decode-region (start end) "Decode current region by base64. START and END are buffer positions. This function calls internal base64 decoder if size of region is @@ -321,7 +270,7 @@ metamail or XEmacs package)." (base64-external-decode-region start end) (base64-internal-decode-region start end))) -(defun base64-int-ext-decode-string (string) +(defun base64-decode-string (string) "Decode STRING which is encoded in base64, and return the result. This function calls internal base64 decoder if size of STRING is smaller than `base64-internal-decoding-limit', otherwise it calls @@ -334,36 +283,70 @@ metamail or XEmacs package)." (base64-external-decode-string string) (base64-internal-decode-string string))) -(defun base64-int-ext-insert-encoded-file (filename) + +(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))) + +(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: "))) (if (and base64-internal-encoding-limit - (> (nth 7 (file-attributes filename)) - base64-internal-encoding-limit)) - (base64-external-insert-encoded-file filename) - (base64-internal-insert-encoded-file filename))) - -(defun base64-int-ext-write-decoded-region (start end filename) + (> (nth 7 (file-attributes filename)) + base64-internal-encoding-limit)) + (apply (function call-process) (car base64-external-encoder) + filename t nil (cdr base64-external-encoder)) + (insert + (base64-encode-string + (with-temp-buffer + (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: "))) + (read-file-name "Write decoded region to file: "))) (if (and base64-internal-decoding-limit - (> (- end start) base64-internal-decoding-limit)) - (base64-external-write-decoded-region start end filename) - (base64-internal-write-decoded-region start end filename))) + (> (- end start) base64-internal-decoding-limit)) + (as-binary-process + (apply (function call-process-region) + start end (car base64-external-decoder) + nil nil nil + (append (cdr base64-external-decoder) + base64-external-decoder-option-to-specify-file + (list filename)))) + (let ((str (buffer-substring start end))) + (with-temp-buffer + (insert (base64-internal-decode-string str)) + (write-region-as-binary (point-min) (point-max) filename))))) ;;; @ etc ;;; -(defun base64-internal-encoded-length (string) - (* (/ (+ (length string) 2) 3) 4)) - (defun pack-sequence (seq size) "Split sequence SEQ into SIZE elements packs, and return list of packs. [mel-b; tl-seq function]" diff --git a/mel-ccl.el b/mel-ccl.el index dc79e5a..e50ad5f 100644 --- a/mel-ccl.el +++ b/mel-ccl.el @@ -1,4 +1,5 @@ -;;; mel-ccl.el: Base64, Quoted-Printable and Q-encoding encoder/decoder for GNU Emacs +;;; mel-ccl.el: CCL based encoder/decoder of Base64, Quoted-Printable +;;; and Q-encoding ;; Copyright (C) 1998 Tanaka Akira @@ -23,8 +24,11 @@ ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. +;;; Code: + (require 'ccl) (require 'pccl) +(require 'mime-def) ;;; @ constants @@ -1186,6 +1190,16 @@ abcdefghijklmnopqrstuvwxyz\ (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) @@ -1205,6 +1219,20 @@ abcdefghijklmnopqrstuvwxyz\ (let ((coding-system-for-write 'mel-ccl-b-rev)) (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 ;;; @@ -1218,8 +1246,7 @@ abcdefghijklmnopqrstuvwxyz\ '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." + "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)) @@ -1229,6 +1256,15 @@ encoding." (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) @@ -1252,6 +1288,16 @@ encoding." (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 ;;; @@ -1287,78 +1333,19 @@ MODE allows `text', `comment', `phrase' or nil. Default value is (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) -'( -(let ((str0 "a\f \t\r -aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa\r -aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa\r -aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa\r -aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa\f\r -aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa\f\r -aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa\f\r - \r - \r - \r -aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa \r -aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa \r -aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa \r -aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa \r -bbb \r -bbbb\r -cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc\rccc\r -ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc\r\r\nccc\r -ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc\r\rccc\r -cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc\rccc\r -dddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddd\r\neee\r -dddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddd\reee\r -ddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddeee\r -") - str1 encoded decoded) - (setq str1 (ew-crlf-to-lf str0) - encoded - (list - (decode-coding-string - str0 - 'mel-ccl-quoted-printable-crlf-crlf-rev) - (decode-coding-string - str0 - 'mel-ccl-quoted-printable-lf-crlf-rev) - (decode-coding-string - str1 - 'mel-ccl-quoted-printable-crlf-lf-rev) - (decode-coding-string - str1 - 'mel-ccl-quoted-printable-lf-lf-rev)) - decoded - (list - (encode-coding-string - (nth 0 encoded) - 'mel-ccl-quoted-printable-crlf-crlf-rev) - (encode-coding-string - (nth 1 encoded) - 'mel-ccl-quoted-printable-lf-crlf-rev) - (encode-coding-string - (nth 2 encoded) - 'mel-ccl-quoted-printable-crlf-lf-rev) - (encode-coding-string - (nth 3 encoded) - 'mel-ccl-quoted-printable-lf-lf-rev))) - (list - (string= str0 (nth 0 decoded)) - (string= str0 (nth 1 decoded)) - (string= str1 (nth 2 decoded)) - (string= str1 (nth 3 decoded)))) - -;; for xemacs -(defun make-ccl-coding-system (name mnemonic doc-string decoder encoder) - (make-coding-system - name 'ccl doc-string - (list 'mnemonic (char-to-string mnemonic) - 'decode (symbol-value decoder) - 'encode (symbol-value encoder)))) - -) +;;; mel-ccl.el ends here diff --git a/mel-dl.el b/mel-dl.el deleted file mode 100644 index 8e641b1..0000000 --- a/mel-dl.el +++ /dev/null @@ -1,94 +0,0 @@ -;;; mel-dl.el: Base64 encoder/decoder using DL module - -;; Copyright (C) 1998 Free Software Foundation, Inc. - -;; Author: MORIOKA Tomohiko -;; Keywords: MIME, Base64 - -;; This file is part of MEL (MIME Encoding Library). - -;; This program is free software; you can redistribute it and/or -;; modify it under the terms of the GNU General Public License as -;; published by the Free Software Foundation; either version 2, or (at -;; your option) any later version. - -;; This program is distributed in the hope that it will be useful, but -;; WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;; General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Code: - -(require 'emu) - -(defvar base64-dl-module - (expand-file-name "base64.so" exec-directory)) - -(defvar base64-dl-handle - (and (file-exists-p base64-dl-module) - (dynamic-link base64-dl-module))) - -(dynamic-call "emacs_base64_init" base64-dl-handle) - -(defalias 'base64-dl-encode-string 'encode-base64-string) -(defalias 'base64-dl-decode-string 'decode-base64-string) - -(defun base64-dl-encode-region (start end) - "Encode current region by base64. -START and END are buffer positions." - (interactive "r") - (save-excursion - (save-restriction - (narrow-to-region start end) - (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") - (save-excursion - (save-restriction - (narrow-to-region start end) - (goto-char (point-min)) - (while (looking-at ".*\n") - (condition-case err - (replace-match - (decode-base64-string - (buffer-substring (match-beginning 0) (1- (match-end 0)))) - t t) - (error - (prog1 - (message (nth 1 err)) - (replace-match ""))))) - (if (looking-at ".*$") - (condition-case err - (replace-match - (decode-base64-string - (buffer-substring (match-beginning 0) (match-end 0))) - t t) - (error - (prog1 - (message (nth 1 err)) - (replace-match ""))) - )) - ))) - - -;;; @ end -;;; - -(provide 'mel-dl) - -;;; mel-dl.el ends here. diff --git a/mel-g.el b/mel-g.el index 88eae90..73db30f 100644 --- a/mel-g.el +++ b/mel-g.el @@ -82,18 +82,21 @@ ) )) +(defalias 'gzip64-encode-region 'gzip64-external-encode-region) +(defalias 'gzip64-decode-region 'gzip64-external-decode-region) + ;;; @ encoder/decoder for file ;;; -(defun gzip64-external-insert-encoded-file (filename) +(defun gzip64-insert-encoded-file (filename) (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-external-write-decoded-region (start end filename) +(defun gzip64-write-decoded-region (start end filename) "Decode and write current region encoded by gzip64 into FILENAME. START and END are buffer positions." (interactive diff --git a/mel-q.el b/mel-q.el index 04d27e6..0e80c16 100644 --- a/mel-q.el +++ b/mel-q.el @@ -119,7 +119,7 @@ If size of input to encode is larger than this limit, external encoder is called.") -(defun quoted-printable-int-ext-encode-region (start end) +(defun quoted-printable-encode-region (start end) "Encode current region by quoted-printable. START and END are buffer positions. This function calls internal quoted-printable encoder if size of @@ -135,23 +135,25 @@ the program (maybe mmencode included in metamail or XEmacs package)." )) -(defun quoted-printable-internal-encode-string (string) +(defun quoted-printable-encode-string (string) "Encode STRING to quoted-printable, and return the result." (with-temp-buffer (insert string) - (quoted-printable-internal-encode-region (point-min)(point-max)) + (quoted-printable-encode-region (point-min)(point-max)) (buffer-string) )) -(defun quoted-printable-external-encode-string (string) - "Encode STRING to quoted-printable, and return the result." - (with-temp-buffer - (insert string) - (quoted-printable-external-encode-region (point-min)(point-max)) - (buffer-string) - )) -(defun quoted-printable-external-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 @@ -214,7 +216,7 @@ It calls external quoted-printable encoder specified by If size of input to decode is larger than this limit, external decoder is called.") -(defun quoted-printable-int-ext-decode-region (start end) +(defun quoted-printable-decode-region (start end) "Decode current region by quoted-printable. START and END are buffer positions. This function calls internal quoted-printable decoder if size of @@ -229,24 +231,28 @@ the program (maybe mmencode included in metamail or XEmacs package)." (quoted-printable-internal-decode-region start end) )) -(defun quoted-printable-internal-decode-string (string) +(defun quoted-printable-decode-string (string) "Decode STRING which is encoded in quoted-printable, and return the result." (with-temp-buffer (insert string) - (quoted-printable-internal-decode-region (point-min)(point-max)) + (quoted-printable-decode-region (point-min)(point-max)) (buffer-string))) -(defun quoted-printable-external-decode-string (string) - "Decode STRING which is encoded in quoted-printable, and return the result." - (with-temp-buffer - (insert string) - (quoted-printable-external-decode-region (point-min)(point-max)) - (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-external-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 @@ -272,7 +278,7 @@ START and END are buffer positions." ?: ?\; ?< ?> ?@ ?\[ ?\] ?^ ?` ?{ ?| ?} ?~) )) -(defun q-encoding-internal-encode-string (string &optional mode) +(defun q-encoding-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'." @@ -294,7 +300,7 @@ MODE allows `text', `comment', `phrase' or nil. Default value is string "") )) -(defun q-encoding-internal-decode-string (string) +(defun q-encoding-decode-string (string) "Decode STRING which is encoded in Q-encoding and return the result." (let (q h l) (mapconcat (function @@ -316,31 +322,14 @@ MODE allows `text', `comment', `phrase' or nil. Default value is ))) string ""))) +(mel-define-method-function (encoded-text-encode-string string (nil "Q")) + 'q-encoding-encode-string) -;;; @@ etc -;;; - -(defun q-encoding-printable-char-p (chr mode) - (and (not (memq chr '(?= ?? ?_))) - (<= ?\ chr)(<= chr ?~) - (cond ((eq mode 'text) t) - ((eq mode 'comment) - (not (memq chr '(?\( ?\) ?\\))) - ) - (t - (string-match "[A-Za-z0-9!*+/=_---]" (char-to-string chr)) - )))) - -(defun q-encoding-internal-encoded-length (string &optional mode) - (let ((l 0)(i 0)(len (length string)) chr) - (while (< i len) - (setq chr (elt string i)) - (if (q-encoding-printable-char-p chr mode) - (setq l (+ l 1)) - (setq l (+ l 3)) - ) - (setq i (+ i 1)) ) - l)) +(mel-define-method encoded-text-decode-string (string (nil "Q")) + (if (and (string-match Q-encoded-text-regexp string) + (string= string (match-string 0 string))) + (q-encoding-decode-string string) + (error "Invalid encoded-text %s" string))) ;;; @ end diff --git a/mel-u.el b/mel-u.el index d4a50ea..d004d60 100644 --- a/mel-u.el +++ b/mel-u.el @@ -93,11 +93,14 @@ variable `uuencode-external-decoder'." )) ))) +(defalias 'uuencode-encode-region 'uuencode-external-encode-region) +(defalias 'uuencode-decode-region 'uuencode-external-decode-region) + ;;; @ uuencode encoder/decoder for file ;;; -(defun uuencode-external-insert-encoded-file (filename) +(defun uuencode-insert-encoded-file (filename) "Insert file encoded by unofficial uuencode format. This function uses external uuencode encoder which is specified by variable `uuencode-external-encoder'." @@ -106,7 +109,7 @@ variable `uuencode-external-encoder'." (file-name-nondirectory filename)) ) -(defun uuencode-external-write-decoded-region (start end filename) +(defun uuencode-write-decoded-region (start end filename) "Decode and write current region encoded by uuencode into FILENAME. START and END are buffer positions." (interactive diff --git a/mel.el b/mel.el index a0cbaf7..16bc0e0 100644 --- a/mel.el +++ b/mel.el @@ -3,11 +3,10 @@ ;; Copyright (C) 1995,1996,1997,1998 Free Software Foundation, Inc. ;; Author: MORIOKA Tomohiko -;; modified by Shuhei KOBAYASHI ;; Created: 1995/6/25 ;; Keywords: MIME, Base64, Quoted-Printable, uuencode, gzip64 -;; This file is part of MEL (MIME Encoding Library). +;; This file is part of FLIM (Faithful Library about Internet Message). ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the GNU General Public License as @@ -26,477 +25,217 @@ ;;; Code: -(require 'pccl) - - -;;; @ encoder/decoder selection framework -;;; - -(defconst mel-stems '(dl ccl int-ext internal external) - "List of encoder/decoder stems. First stem is most prefered.") - -(defmacro mel-call-next (fun formal-args) - (let ((caller 'funcall) - actual-args) - (while formal-args - (cond - ((eq (car formal-args) '&optional) nil) - ((eq (car formal-args) '&rest) (setq caller 'apply)) - (t (setq actual-args (cons (car formal-args) actual-args)))) - (setq formal-args (cdr formal-args))) - `(,caller ',fun ,@(nreverse actual-args)))) - -(put 'mel-defgeneric 'lisp-indent-function 4) -(defmacro mel-defgeneric (prefix suffix formal-args - &rest docstring-interactive) - "Define a generic function named PREFIX-SUFFIX for mel. -Arguments for the function is specified as FORMAL-ARGS as usual. -Rest of arguments DOCSTRING-INTERACTIVE should be DOCSTRING and/or -interactive specification placed at front of a function body. - -Before a generic function is called, at least one methods must be -defined by `mel-defmethod'. If more than one methods is defined, -preferest implementation is choosed by `mel-defpreference' and -`mel-stems'." - (let ((name (intern (format "%s-%s" prefix suffix))) - (tmp (make-symbol "tmp"))) - (put name 'prefix prefix) - (put name 'suffix suffix) - `(progn - (put ',name 'prefix ',prefix) - (put ',name 'suffix ',suffix) - (defun ,name ,formal-args - ,@docstring-interactive - (catch 'return - (let ((,tmp (or (get ',name 'stems) - (get ',prefix 'stems) - mel-stems)) - method) - (while ,tmp - (when (setq method (get ',name (car ,tmp))) - (fset ',name method) - (throw 'return (mel-call-next ,name ,formal-args))) - (setq ,tmp (cdr ,tmp)))) - (error ,(format "%s: no method" name))))))) - -(defun mel-defpreference (stems prefix &optional suffix) - "Define a preference for a generic functions PREFIX-* -(or PREFIX-SUFFIX if SUFFIX is non-nil) as STEMS." - (let ((name (if suffix (intern (format "%s-%s" prefix suffix)) prefix))) - (put name 'stems stems))) - -(defmacro mel-usemodule (file prefix stem &optional condition) - "Declare that FILE defines functions PREFIX-STEM-*. - -If the form CONDITION is non-nil, it is evaluated for each methods -PREFIX-STEM-*. If the value of CONDITION is nil, the method is NOT -defined. In CONDITION, five variables `prefix', `stem', `suffix', -`prefix-stem' and `prefix-stem-suffix' is available." - (let ((prefix-stem (intern (format "%s-%s" prefix stem)))) - `(progn - (put ',prefix-stem 'mel-condition ',(or condition t)) - (put ',prefix ',stem ,file)))) - -(defmacro mel-defmethod (name stem &optional condition file) - "Declare that NAME is implemented by STEM in FILE. - -If the form CONDITION is non-nil and evaluated to nil, -the method is NOT declared. In CONDITION, five variables `prefix', -`stem', `suffix', `prefix-stem' and `prefix-stem-suffix' is available. - -If FILE is nil, module declared with `mel-usemodule' is used." - (let* ((prefix (get name 'prefix)) - (suffix (get name 'suffix)) - (prefix-stem (intern (format "%s-%s" prefix stem))) - (prefix-stem-suffix (intern (format "%s-%s-%s" prefix stem suffix)))) - `(when (let ((prefix ',prefix) - (suffix ',suffix) - (stem ',stem) - (prefix-stem ',prefix-stem) - (prefix-stem-suffix ',prefix-stem-suffix)) - (and ,(or condition 't) - (eval (get prefix-stem 'mel-condition)))) - (autoload ',prefix-stem-suffix ,(or file `(get ',prefix ',stem))) - (put ',name ',stem ',prefix-stem-suffix)))) - - -;;; @ generic -;;; - -(mel-defgeneric base64 encode-string (string) - "Encode STRING with base64.") -(mel-defgeneric base64 decode-string (string) - "Decode STRING with base64.") -(mel-defgeneric base64 encode-region (start end) - "Encode current region with base64." - (interactive "r")) -(mel-defgeneric base64 decode-region (start end) - "Decode current region with base64." - (interactive "r")) -(mel-defgeneric base64 insert-encoded-file (filename) - "Insert a file named FILENAME as base64 encoded form." - (interactive (list (read-file-name "Insert encoded file: ")))) -(mel-defgeneric base64 write-decoded-region (start end filename) - "Decode and write base64 encoded current region to a file named FILENAME." - (interactive - (list (region-beginning) (region-end) - (read-file-name "Write decoded region to file: ")))) -(mel-defgeneric base64 encoded-length (string)) - -(mel-defgeneric quoted-printable encode-string (string) - "Encode STRING with quoted-printable.") -(mel-defgeneric quoted-printable decode-string (string) - "Decode STRING with quoted-printable.") -(mel-defgeneric quoted-printable encode-region (start end) - "Encode current region with quoted-printable." - (interactive "r")) -(mel-defgeneric quoted-printable decode-region (start end) - "Decode current region with quoted-printable." - (interactive "r")) -(mel-defgeneric quoted-printable insert-encoded-file (filename) - "Insert a file named FILENAME as quoted-printable encoded form." - (interactive (list (read-file-name "Insert encoded file: ")))) -(mel-defgeneric quoted-printable write-decoded-region (start end filename) - "Decode and write quoted-printable encoded current region to a file -named FILENAME." - (interactive - (list (region-beginning) (region-end) - (read-file-name "Write decoded region to file: ")))) - -(mel-defgeneric q-encoding encode-string (string &optional mode) - "Encode STRING with Q-encoding. -If MODE is `text', `comment' or `phrase', the result is appropriate for -unstructured field, comment or phrase in structured field. -If MODE is nil, the result is appropriate for phrase.") -(mel-defgeneric q-encoding decode-string (string) - "Decode STRING with Q-encoding.") -(mel-defgeneric q-encoding encoded-length (string &optional mode)) - -(mel-defgeneric uuencode encode-region (start end) - "Encode current region by unofficial uuencode format." - (interactive "*r")) -(mel-defgeneric uuencode decode-region (start end) - "Decode current region by unofficial uuencode format." - (interactive "*r")) -(mel-defgeneric uuencode insert-encoded-file (filename) - "Insert file encoded by unofficial uuencode format." - (interactive (list (read-file-name "Insert encoded file: ")))) -(mel-defgeneric uuencode write-decoded-region (start end filename) - "Decode and write current region encoded by uuencode into FILENAME." - (interactive - (list (region-beginning) (region-end) - (read-file-name "Write decoded region to file: ")))) - -(mel-defgeneric gzip64 encode-region (start end) - "Encode current region by unofficial gzip64 format." - (interactive "*r")) -(mel-defgeneric gzip64 decode-region (start end) - "Decode current region by unofficial gzip64 format." - (interactive "*r")) -(mel-defgeneric gzip64 insert-encoded-file (filename) - "Insert file encoded by unofficial gzip64 format." - (interactive (list (read-file-name "Insert encoded file: ")))) -(mel-defgeneric gzip64 write-decoded-region (start end filename) - "Decode and write current region encoded by gzip64 into FILENAME." - (interactive - (list (region-beginning) (region-end) - (read-file-name "Write decoded region to file: ")))) - +(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)) + +(defvar mel-encoding-module-alist nil) + +(defun mime-encoding-list (&optional service) + "Return list of Content-Transfer-Encoding." + (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)) + ))) -;;; @ method +(defsubst mel-find-function (service encoding) + (let* ((oba (symbol-value (intern (format "%s-obarray" service)))) + (f (intern-soft encoding oba))) + (or f + (let ((rest (cdr (assoc encoding mel-encoding-module-alist)))) + (while (and rest + (progn + (require (car rest)) + (null (setq f (intern-soft encoding oba))) + )) + (setq rest (cdr rest)) + ) + f)))) + + +;;; @ setting for modules ;;; -;; mel-dl (defvar base64-dl-module (and (fboundp 'dynamic-link) (let ((path (expand-file-name "base64.so" exec-directory))) (and (file-exists-p path) path)))) -(mel-usemodule "mel-dl" base64 dl base64-dl-module) - -(mel-defmethod base64-encode-string dl) -(mel-defmethod base64-decode-string dl) -(mel-defmethod base64-encode-region dl) -(mel-defmethod base64-decode-region dl) - -;; mel-b -(mel-usemodule "mel-b" base64 internal) -(mel-usemodule "mel-b" base64 external) -(mel-usemodule "mel-b" base64 int-ext) - -(mel-defmethod base64-encode-string internal) -(mel-defmethod base64-decode-string internal) -(mel-defmethod base64-encode-region internal) -(mel-defmethod base64-decode-region internal) -(mel-defmethod base64-insert-encoded-file internal) -(mel-defmethod base64-write-decoded-region internal) - -(mel-defmethod base64-encode-string external) -(mel-defmethod base64-decode-string external) -(mel-defmethod base64-encode-region external) -(mel-defmethod base64-decode-region external) -(mel-defmethod base64-insert-encoded-file external) -(mel-defmethod base64-write-decoded-region external) - -(mel-defmethod base64-encoded-length internal) - -(mel-defmethod base64-decode-string int-ext) -(mel-defmethod base64-encode-region int-ext) -(mel-defmethod base64-decode-region int-ext) -(mel-defmethod base64-insert-encoded-file int-ext) -(mel-defmethod base64-write-decoded-region int-ext) - -;; mel-q -(mel-usemodule "mel-q" quoted-printable internal) -(mel-usemodule "mel-q" quoted-printable external) -(mel-usemodule "mel-q" quoted-printable int-ext) -(mel-usemodule "mel-q" q-encoding internal) - -(mel-defmethod quoted-printable-encode-string internal) -(mel-defmethod quoted-printable-decode-string internal) -(mel-defmethod quoted-printable-encode-region internal) -(mel-defmethod quoted-printable-decode-region internal) - -(mel-defmethod quoted-printable-encode-string external) -(mel-defmethod quoted-printable-decode-string external) -(mel-defmethod quoted-printable-encode-region external) -(mel-defmethod quoted-printable-decode-region external) -(mel-defmethod quoted-printable-insert-encoded-file external) -(mel-defmethod quoted-printable-write-decoded-region external) - -(mel-defmethod quoted-printable-encode-region int-ext) -(mel-defmethod quoted-printable-decode-region int-ext) - -(mel-defmethod q-encoding-encode-string internal) -(mel-defmethod q-encoding-decode-string internal) -(mel-defmethod q-encoding-encoded-length internal) - -;; mel-u -(mel-usemodule "mel-u" uuencode external) - -(mel-defmethod uuencode-encode-region external) -(mel-defmethod uuencode-decode-region external) -(mel-defmethod uuencode-insert-encoded-file external) -(mel-defmethod uuencode-write-decoded-region external) -;; mel-g -(mel-usemodule "mel-g" gzip64 external) - -(mel-defmethod gzip64-encode-region external) -(mel-defmethod gzip64-decode-region external) -(mel-defmethod gzip64-insert-encoded-file external) -(mel-defmethod gzip64-write-decoded-region external) - -;; mel-ccl -(mel-usemodule "mel-ccl" base64 ccl (fboundp 'make-ccl-coding-system)) -(mel-usemodule "mel-ccl" quoted-printable ccl (fboundp 'make-ccl-coding-system)) -(mel-usemodule "mel-ccl" q-encoding ccl (fboundp 'make-ccl-coding-system)) - -(mel-defmethod base64-encode-string ccl (not (broken-p 'ccl-execute-eof-block-on-encoding-some))) -(mel-defmethod base64-encode-region ccl (not (broken-p 'ccl-execute-eof-block-on-encoding-some))) -(mel-defmethod base64-insert-encoded-file ccl (not (broken-p 'ccl-execute-eof-block-on-encoding-some))) - -(mel-defmethod quoted-printable-encode-string ccl (not (broken-p 'ccl-execute-eof-block-on-encoding-some))) -(mel-defmethod quoted-printable-encode-region ccl (not (broken-p 'ccl-execute-eof-block-on-encoding-some))) -(mel-defmethod quoted-printable-insert-encoded-file ccl (not (broken-p 'ccl-execute-eof-block-on-encoding-some))) - -(mel-defmethod base64-decode-string ccl) -(mel-defmethod base64-decode-region ccl) -(mel-defmethod base64-write-decoded-region ccl) - -(mel-defmethod quoted-printable-decode-string ccl) -(mel-defmethod quoted-printable-decode-region ccl) -(mel-defmethod quoted-printable-write-decoded-region ccl) - -(mel-defmethod q-encoding-encode-string ccl) -(mel-defmethod q-encoding-decode-string ccl) - -(mel-defmethod q-encoding-encoded-length ccl (not (featurep 'xemacs))) +(mel-use-module 'mel-b '("base64" "B")) +(mel-use-module 'mel-q '("quoted-printable" "Q")) +(mel-use-module 'mel-g '("x-gzip64")) +(mel-use-module 'mel-u '("x-uue" "x-uuencode")) + +(if (featurep 'mule) + (mel-use-module 'mel-ccl '("base64" "quoted-printable" "B" "Q")) + ) + +(if base64-dl-module + (mel-use-module 'mel-b-dl '("base64" "B")) + ) + +(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) + +(mel-define-method-function (mime-encode-string string (nil "8bit")) + 'identity) +(mel-define-method-function (mime-decode-string string (nil "8bit")) + 'identity) +(mel-define-method mime-encode-region (start end (nil "8bit"))) +(mel-define-method mime-decode-region (start end (nil "8bit"))) +(mel-define-method-function (mime-insert-encoded-file filename (nil "8bit")) + 'insert-file-contents-as-binary) +(mel-define-method-function (mime-write-decoded-region + start end filename (nil "8bit")) + 'write-region-as-binary) + +(mel-define-method-function (mime-encode-string string (nil "binary")) + 'identity) +(mel-define-method-function (mime-decode-string string (nil "binary")) + 'identity) +(mel-define-method mime-encode-region (start end (nil "binary"))) +(mel-define-method mime-decode-region (start end (nil "binary"))) +(mel-define-method-function (mime-insert-encoded-file filename (nil "binary")) + 'insert-file-contents-as-binary) +(mel-define-method-function (mime-write-decoded-region + start end filename (nil "binary")) + 'write-region-as-binary) ;;; @ region ;;; ;;;###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.") - -;;;###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) - ,@(when (fboundp 'base64-dl-decode-region) - '(("base64-dl" . base64-dl-decode-region))) - ,@(when (fboundp 'base64-ccl-decode-region) - '(("base64-ccl" . base64-ccl-decode-region))) - ,@(when (fboundp 'base64-internal-decode-region) - '(("base64-internal" . base64-internal-decode-region))) - ,@(when (fboundp 'base64-external-decode-region) - '(("base64-external" . base64-external-decode-region))) - ,@(when (fboundp 'base64-int-ext-decode-region) - '(("base64-int-ext" . base64-int-ext-decode-region))) - ,@(when (fboundp 'quoted-printable-internal-decode-region) - '(("quoted-printable-internal" - . quoted-printable-internal-decode-region))) - ,@(when (fboundp 'quoted-printable-ccl-decode-region) - '(("quoted-printable-ccl" - . quoted-printable-ccl-decode-region))) - ,@(when (fboundp 'quoted-printable-external-decode-region) - '(("quoted-printable-external" - . quoted-printable-external-decode-region))) - ,@(when (fboundp 'quoted-printable-int-ext-decode-region) - '(("quoted-printable-int-ext" - . quoted-printable-int-ext-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.") - -;;;###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) + (* (/ (+ (length string) 2) 3) 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) - ,@(when (fboundp 'base64-internal-write-decoded-region) - '(("base64-internal" . base64-internal-write-decoded-region))) - ,@(when (fboundp 'base64-external-write-decoded-region) - '(("base64-external" . base64-external-write-decoded-region))) - ,@(when (fboundp 'base64-int-ext-write-decoded-region) - '(("base64-int-ext" . base64-int-ext-write-decoded-region))) - ,@(when (fboundp 'base64-ccl-write-decoded-region) - '(("base64-ccl" . base64-ccl-write-decoded-region))) - ,@(when (fboundp 'quoted-printable-external-write-decoded-region) - '(("quoted-printable-external" - . quoted-printable-external-write-decoded-region))) - ,@(when (fboundp 'quoted-printable-ccl-write-decoded-region) - '(("quoted-printable-ccl" - . quoted-printable-ccl-write-decoded-region))) - ) - "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) @@ -506,12 +245,10 @@ START and END are buffer positions." (list (region-beginning) (region-end) (read-file-name "Write decoded region to file: ") (completing-read "encoding: " - mime-file-decoding-method-alist + (mime-encoding-alist 'mime-write-decoded-region) nil t "base64"))) - (let ((f (cdr (assoc encoding mime-file-decoding-method-alist)))) - (if f - (funcall f start end filename) - ))) + (funcall (mel-find-function 'mime-write-decoded-region encoding) + start end filename)) ;;; @ end diff --git a/mime-def.el b/mime-def.el index d879bcd..c870f25 100644 --- a/mime-def.el +++ b/mime-def.el @@ -25,7 +25,7 @@ ;;; Code: (defconst mime-library-version - '("FLAM-DOODLE" "$B?<;Y;R(B 10YR7.5/8.0" 1 9 5) + '("FLAM-DOODLE" "$B4;;R(B 7.5YR7.0/11.0" 1 10 0) "Implementation name, version name and numbers of MIME-library package.") (defconst mime-library-version-string @@ -107,7 +107,30 @@ (concat mime-token-regexp "/" mime-token-regexp)) -;;; @@ Quoted-Printable +;;; @@ base64 / B +;;; + +(defconst base64-token-regexp "[A-Za-z0-9+/]") +(defconst base64-token-padding-regexp "[A-Za-z0-9+/=]") + +(defconst B-encoded-text-regexp + (concat "\\(\\(" + base64-token-regexp + base64-token-regexp + base64-token-regexp + base64-token-regexp + "\\)*" + base64-token-regexp + base64-token-regexp + base64-token-padding-regexp + base64-token-padding-regexp + "\\)")) + +;; (defconst eword-B-encoding-and-encoded-text-regexp +;; (concat "\\(B\\)\\?" eword-B-encoded-text-regexp)) + + +;;; @@ Quoted-Printable / Q ;;; (defconst quoted-printable-hex-chars "0123456789ABCDEF") @@ -116,6 +139,12 @@ (concat "=[" quoted-printable-hex-chars "][" quoted-printable-hex-chars "]")) +(defconst Q-encoded-text-regexp + (concat "\\([^=?]\\|" quoted-printable-octet-regexp "\\)+")) + +;; (defconst eword-Q-encoding-and-encoded-text-regexp +;; (concat "\\(Q\\)\\?" eword-Q-encoded-text-regexp)) + ;;; @ Content-Type ;;; @@ -275,6 +304,8 @@ message/rfc822, `mime-entity' structures of them are included in ;;; @ for mm-backend ;;; +(require 'alist) + (defvar mime-entity-implementation-alist nil) (defmacro mm-define-backend (type &optional parents) @@ -310,6 +341,66 @@ message/rfc822, `mime-entity' structures of them are included in (put 'mm-define-method 'edebug-form-spec '(&define name ((arg symbolp) &rest arg) def-body)) +(defsubst mm-arglist-to-arguments (arglist) + (let (dest) + (while arglist + (let ((arg (car arglist))) + (or (memq arg '(&optional &rest)) + (setq dest (cons arg dest))) + ) + (setq arglist (cdr arglist))) + (nreverse dest))) + + +;;; @ for mel-backend +;;; + +(defmacro mel-define-service (name &optional args &rest rest) + (if args + `(progn + (defvar ,(intern (format "%s-obarray" name)) (make-vector 1 nil)) + (defun ,name ,args + ,@rest + (funcall (mel-find-function ',name ,(car (last args))) + ,@(mm-arglist-to-arguments (butlast args))) + )) + `(defvar ,(intern (format "%s-obarray" name)) (make-vector 1 nil)) + )) + +(put 'mel-define-service 'lisp-indent-function 'defun) + +(defmacro mel-define-method (name args &rest body) + (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) + (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)))) + ))) + ;;; @ end ;;; diff --git a/mime.el b/mime.el index dfb13fe..908923f 100644 --- a/mime.el +++ b/mime.el @@ -80,16 +80,6 @@ current-buffer, and return it.") entity args)) -(defsubst mm-arglist-to-arguments (arglist) - (let (dest) - (while arglist - (let ((arg (car arglist))) - (or (memq arg '(&optional &rest)) - (setq dest (cons arg dest))) - ) - (setq arglist (cdr arglist))) - (nreverse dest))) - (defmacro mm-define-generic (name args &optional doc) (if doc `(defun ,(intern (format "mime-%s" name)) ,args -- 1.7.10.4