X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=mel-ccl.el;h=12b18e1fdf5887558b09dc34835544bad0d0946b;hb=f3b90515038974fbb46f00b7cd5a687fb19cd160;hp=df336624d8660075bb1c770ecb484aa4767805f7;hpb=ad48c8cef55bea00a362e6be6833ebca0f8d8f69;p=elisp%2Fflim.git

diff --git a/mel-ccl.el b/mel-ccl.el
index df33662..12b18e1 100644
--- a/mel-ccl.el
+++ b/mel-ccl.el
@@ -1,5 +1,34 @@
+;;; 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 'emu)
+(require 'pccl)
+(require 'mime-def)
 
 
 ;;; @ constants
@@ -189,7 +218,9 @@ abcdefghijklmnopqrstuvwxyz\
               `(write-repeat ,r0))))
           mel-ccl-256-table))))))
 
-(define-ccl-program mel-ccl-encode-uq
+(eval-when-compile
+
+(defun mel-ccl-encode-q-generic (raw)
   `(3
     (loop
      (loop
@@ -199,7 +230,7 @@ abcdefghijklmnopqrstuvwxyz\
           (lambda (r0)
             (cond
              ((= r0 32) `(write-repeat ?_))
-             ((member r0 mel-ccl-u-raw) `(write-repeat ,r0))
+             ((member r0 raw) `(write-repeat ,r0))
              (t '(break))))
           mel-ccl-256-table)))
      (write ?=)
@@ -207,45 +238,40 @@ abcdefghijklmnopqrstuvwxyz\
      (write r0 ,mel-ccl-low-table)
      (repeat))))
 
-(define-ccl-program mel-ccl-encode-cq
-  `(3
-    (loop
+;; 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
-       r0
+       r1
        ,@(mapcar
-          (lambda (r0)
-            (cond
-             ((= r0 32) `(write-repeat ?_))
-             ((member r0 mel-ccl-c-raw) `(write-repeat ,r0))
-             (t '(break))))
-          mel-ccl-256-table)))
-     (write ?=)
-     (write r0 ,mel-ccl-high-table)
-     (write r0 ,mel-ccl-low-table)
-     (repeat))))
+	  (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
-  `(3
-    (loop
-     (loop
-      (read-branch
-       r0
-       ,@(mapcar
-          (lambda (r0)
-            (cond
-             ((= r0 32) `(write-repeat ?_))
-             ((member r0 mel-ccl-p-raw) `(write-repeat ,r0))
-             (t '(break))))
-          mel-ccl-256-table)))
-     (write ?=)
-     (write r0 ,mel-ccl-high-table)
-     (write r0 ,mel-ccl-low-table)
-     (repeat))))
+  (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)
@@ -355,17 +381,19 @@ abcdefghijklmnopqrstuvwxyz\
 	    (write r7)
 	    (write-repeat r4))
 	   ;; error: BB=B 
-	   ((write r4)
+	   ((write (r4 & 255))
 	    (end))
 	   ;; BBB=
 	   ((r5 = r2 ,mel-ccl-decode-b-2-table)
 	    (r4 |= r5)
 	    (r4 >8= 0)
 	    (write r7)
-	    (write r4)
+	    (write (r4 & 255))
+	    (end)			; Excessive (end) is workaround for XEmacs 21.0.
+					; Without this, "AAA=" is converted to "^@^@^@".
 	    (end))
 	   ;; BB==
-	   ((write r4)
+	   ((write (r4 & 255))
 	    (end))))
        ((r4 >8= 0)
 	(write r7)
@@ -373,76 +401,11 @@ abcdefghijklmnopqrstuvwxyz\
 	(write r7)
 	(write-repeat r4))))))
 
-;;; B
-
-;; mel-ccl-encode-b works only 20.3 or later because CCL_EOF_BLOCK
-;; is not executed on 20.2 (or former?).
-(define-ccl-program mel-ccl-encode-b
-  `(2
-    (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)))
-     (repeat))
-    (branch
-     r2
-     (end)
-     ((write r0 ,(vconcat
-                  (mapcar
-                   (lambda (r0)
-                     (nth (lsh r0 4) mel-ccl-64-to-256-table))
-                   mel-ccl-4-table)))
-      (write "=="))
-     ((write r0 ,(vconcat
-                  (mapcar
-                   (lambda (r0)
-                     (nth (lsh r0 2) mel-ccl-64-to-256-table))
-                   mel-ccl-16-table)))
-      (write ?=)))
-    ))
-
-;;; Base64
+(eval-when-compile
 
-;; mel-ccl-encode-base64 does not works on 20.2 by same reason of mel-ccl-encode-b
-(define-ccl-program mel-ccl-encode-base64-crlf-crlf
+;; 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
@@ -488,100 +451,62 @@ abcdefghijklmnopqrstuvwxyz\
                      (nth r1 mel-ccl-64-to-256-table))
                    mel-ccl-64-table)))
       (r3 += 1)
-      (if (r3 == 19) ; 4 * 19 = 76 --> line break.
-          ((write "\r\n")
-           (r3 = 0)))
+      ,@(when quantums-per-line
+	  `((if (r3 == ,quantums-per-line)
+		((write ,(if output-crlf "\r\n" "\n"))
+		 (r3 = 0)))))
       (repeat)))
     (branch
      r2
-     (if (r0 > 0) (write "\r\n"))
+     ,(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 "==\r\n"))
+      (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 "=\r\n")))
+      (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))
 
-;; produce newline as LF instead of CRLF.
 (define-ccl-program mel-ccl-encode-base64-crlf-lf
-  `(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)
-      (if (r3 == 19) ; 4 * 19 = 76 --> line break.
-          ((write "\n")
-           (r3 = 0)))
-      (repeat)))
-    (branch
-     r2
-     (if (r0 > 0) (write "\n"))
-     ((write r0 ,(vconcat
-                  (mapcar
-                   (lambda (r0)
-                     (nth (lsh r0 4) mel-ccl-64-to-256-table))
-                   mel-ccl-4-table)))
-      (write "==\n"))
-     ((write r0 ,(vconcat
-                  (mapcar
-                   (lambda (r0)
-                     (nth (lsh r0 2) mel-ccl-64-to-256-table))
-                   mel-ccl-16-table)))
-      (write "=\n")))
-    ))
+  (mel-ccl-encode-base64-generic 19 nil))
 
 ;; Quoted-Printable
 
 (eval-when-compile
 
-;; mel-ccl-encode-quoted-printable does not works on 20.2 by same reason of mel-ccl-encode-b
+(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
@@ -597,6 +522,45 @@ abcdefghijklmnopqrstuvwxyz\
             (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
@@ -657,11 +621,13 @@ abcdefghijklmnopqrstuvwxyz\
                  (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}
@@ -876,6 +842,24 @@ abcdefghijklmnopqrstuvwxyz\
       ;; 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)
       ))
     ))
 
@@ -1189,29 +1173,38 @@ abcdefghijklmnopqrstuvwxyz\
 ;;; @ B
 ;;;
 
-(unless (and (boundp 'ccl-encoder-eof-block-is-broken)
-	     ccl-encoder-eof-block-is-broken)
+(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-b-rev))
+  (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-b-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-b-rev))
-    (insert-file-contents filename)))
+  (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"
-  (string-as-unibyte (encode-coding-string string 'mel-ccl-b-rev)))
+  (encode-coding-string string 'mel-ccl-b-rev))
 
 (defun base64-ccl-decode-region (start end)
   "Decode base64 encoded the region from START to END."
@@ -1223,36 +1216,57 @@ abcdefghijklmnopqrstuvwxyz\
   (interactive
     (list (region-beginning) (region-end)
           (read-file-name "Write decoded region to file: ")))
-  (let ((coding-system-for-write 'mel-ccl-b-rev))
+  (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)
 
-;;; @ quoted-printable
-;;;
-
-(unless (and (boundp 'ccl-encoder-eof-block-is-broken)
-	     ccl-encoder-eof-block-is-broken)
+(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)))
 
-(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))
+;;; @ quoted-printable
+;;;
 
-(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 ((start (point)) end
-	(coding-system-for-read 'mel-ccl-quoted-printable-lf-lf-rev))
-    (insert-file-contents filename)))
-
-)
+(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."
@@ -1275,6 +1289,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
 ;;;
@@ -1292,10 +1316,32 @@ MODE allows `text', `comment', `phrase' or nil.  Default value is
 
 (defun q-encoding-ccl-decode-string (string)
   "Decode Q encoded STRING and return the result."
-  (string-as-unibyte
-   (encode-coding-string
-    string
-    'mel-ccl-uq-rev)))
+  (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
@@ -1303,73 +1349,4 @@ MODE allows `text', `comment', `phrase' or nil.  Default value is
 
 (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