X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=ew-bq.el;h=ec0e8fe0a80e76b754d697d4914a2bd888d6fc34;hb=refs%2Fheads%2Fdoodle;hp=ae6cd420ed256ab02f84d8719e45672cecd6ac17;hpb=e3747e8f4ecbf39d106d117fb494506089cc5c2a;p=elisp%2Fflim.git

diff --git a/ew-bq.el b/ew-bq.el
index ae6cd42..ec0e8fe 100644
--- a/ew-bq.el
+++ b/ew-bq.el
@@ -1,477 +1,14 @@
-(require 'ccl)
 (require 'emu)
-
-(provide 'ew-bq)
-
-(eval-when-compile
-
-(defconst ew-ccl-4-table
-  '(  0   1   2   3))
-
-(defconst ew-ccl-16-table
-  '(  0   1   2   3   4   5   6   7   8   9  10  11  12  13  14  15))
-
-(defconst ew-ccl-64-table
-  '(  0   1   2   3   4   5   6   7   8   9  10  11  12  13  14  15
-     16  17  18  19  20  21  22  23  24  25  26  27  28  29  30  31
-     32  33  34  35  36  37  38  39  40  41  42  43  44  45  46  47
-     48  49  50  51  52  53  54  55  56  57  58  59  60  61  62  63))
-
-(defconst ew-ccl-256-table
-  '(  0   1   2   3   4   5   6   7   8   9  10  11  12  13  14  15
-     16  17  18  19  20  21  22  23  24  25  26  27  28  29  30  31
-     32  33  34  35  36  37  38  39  40  41  42  43  44  45  46  47
-     48  49  50  51  52  53  54  55  56  57  58  59  60  61  62  63
-     64  65  66  67  68  69  70  71  72  73  74  75  76  77  78  79
-     80  81  82  83  84  85  86  87  88  89  90  91  92  93  94  95
-     96  97  98  99 100 101 102 103 104 105 106 107 108 109 110 111
-    112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127
-    128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143
-    144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159
-    160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175
-    176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191
-    192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207
-    208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223
-    224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239
-    240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255))
-
-(defconst ew-ccl-256-to-16-table
-  '(nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
-    nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
-    nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
-      0   1   2   3   4   5   6   7   8   9 nil nil nil nil nil nil
-    nil  10  11  12  13  14  15 nil nil nil nil nil nil nil nil nil
-    nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
-    nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
-    nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
-    nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
-    nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
-    nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
-    nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
-    nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
-    nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
-    nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
-    nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil))
-
-(defconst ew-ccl-16-to-256-table
-  '(?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9 ?A ?B ?C ?D ?E ?F))
-
-(defconst ew-ccl-high-table
-  (vconcat
-   (mapcar
-    (lambda (v) (nth (lsh v -4) ew-ccl-16-to-256-table))
-    ew-ccl-256-table)))
-
-(defconst ew-ccl-low-table
-  (vconcat
-   (mapcar
-    (lambda (v) (nth (logand v 15) ew-ccl-16-to-256-table))
-    ew-ccl-256-table)))
-
-(defconst ew-ccl-u-raw
-  (append "!@#$%&'()*+,-./0123456789:;<>@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^`abcdefghijklmnopqrstuvwxyz{|}~" ()))
-
-(defconst ew-ccl-c-raw
-  (append "!@#$%&'*+,-./0123456789:;<>@ABCDEFGHIJKLMNOPQRSTUVWXYZ[]^`abcdefghijklmnopqrstuvwxyz{|}~" ()))
-
-(defconst ew-ccl-p-raw
-  (append "!*+-/0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" ()))
-
-(defconst ew-ccl-256-to-64-table
-  '(nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
-    nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
-    nil nil nil nil nil nil nil nil nil nil nil  62 nil nil nil  63
-     52  53  54  55  56  57  58  59  60  61 nil nil nil   t nil nil
-    nil   0   1   2   3   4   5   6   7   8   9  10  11  12  13  14
-     15  16  17  18  19  20  21  22  23  24  25 nil nil nil nil nil
-    nil  26  27  28  29  30  31  32  33  34  35  36  37  38  39  40
-     41  42  43  44  45  46  47  48  49  50  51 nil nil nil nil nil
-    nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
-    nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
-    nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
-    nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
-    nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
-    nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
-    nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
-    nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil))
-
-(defconst ew-ccl-64-to-256-table
-  '(?A ?B ?C ?D ?E ?F ?G ?H ?I ?J ?K ?L ?M ?N ?O ?P
-    ?Q ?R ?S ?T ?U ?V ?W ?X ?Y ?Z ?a ?b ?c ?d ?e ?f
-    ?g ?h ?i ?j ?k ?l ?m ?n ?o ?p ?q ?r ?s ?t ?u ?v
-    ?w ?x ?y ?z ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9 ?+ ?/))
-
-)
-
-(define-ccl-program ew-ccl-decode-q
-  (eval-when-compile
-    `(1
-      ((loop
-	(read-branch
-	 r0
-	 ,@(mapcar
-	    (lambda (r0)
-	      (cond
-	       ((= r0 ?_)
-		`(write-repeat ? ))
-	       ((= r0 ?=)
-		`((loop
-		   (read-branch
-		    r1
-		    ,@(mapcar
-		       (lambda (v)
-			 (if (integerp v)
-			     `((r0 = ,v) (break))
-			   '(repeat)))
-		       ew-ccl-256-to-16-table)))
-		  (loop
-		   (read-branch
-		    r1
-		    ,@(mapcar
-		       (lambda (v)
-			 (if (integerp v)
-			     `((write r0 ,(vconcat
-					   (mapcar
-					    (lambda (r0)
-					      (logior (lsh r0 4) v))
-					    ew-ccl-16-table)))
-			       (break))
-			   '(repeat)))
-		       ew-ccl-256-to-16-table)))
-		  (repeat)))
-	       (t
-		`(write-repeat ,r0))))
-	    ew-ccl-256-table)))))))
-
-(define-ccl-program ew-ccl-encode-uq
-  (eval-when-compile
-    `(3
-      (loop
-       (loop
-	(read-branch
-	 r0
-	 ,@(mapcar
-	    (lambda (r0)
-	      (cond
-	       ((= r0 32) `(write-repeat ?_))
-	       ((member r0 ew-ccl-u-raw) `(write-repeat ,r0))
-	       (t '(break))))
-	    ew-ccl-256-table)))
-       (write ?=)
-       (write r0 ,ew-ccl-high-table)
-       (write r0 ,ew-ccl-low-table)
-       (repeat)))))
-
-(define-ccl-program ew-ccl-encode-cq
-  (eval-when-compile
-    `(3
-      (loop
-       (loop
-	(read-branch
-	 r0
-	 ,@(mapcar
-	    (lambda (r0)
-	      (cond
-	       ((= r0 32) `(write-repeat ?_))
-	       ((member r0 ew-ccl-c-raw) `(write-repeat ,r0))
-	       (t '(break))))
-	    ew-ccl-256-table)))
-       (write ?=)
-       (write r0 ,ew-ccl-high-table)
-       (write r0 ,ew-ccl-low-table)
-       (repeat)))))
-
-(define-ccl-program ew-ccl-encode-pq
-  (eval-when-compile
-    `(3
-      (loop
-       (loop
-	(read-branch
-	 r0
-	 ,@(mapcar
-	    (lambda (r0)
-	      (cond
-	       ((= r0 32) `(write-repeat ?_))
-	       ((member r0 ew-ccl-p-raw) `(write-repeat ,r0))
-	       (t '(break))))
-	    ew-ccl-256-table)))
-       (write ?=)
-       (write r0 ,ew-ccl-high-table)
-       (write r0 ,ew-ccl-low-table)
-       (repeat)))))
-
-(define-ccl-program ew-ccl-decode-b
-  (eval-when-compile
-    `(1
-      (loop
-       (loop
-	(read-branch
-	 r1
-	 ,@(mapcar
-	    (lambda (v)
-	      (cond
-	       ((or (eq v nil) (eq v t)) '(repeat))
-	       (t `((r0 = ,(lsh v 2)) (break)))))
-	    ew-ccl-256-to-64-table)))
-       (loop
-	(read-branch
-	 r1
-	 ,@(mapcar
-	    (lambda (v)
-	      (cond
-	       ((or (eq v nil) (eq v t)) '(repeat))
-	       ((= (lsh v -4) 0) `((write r0) (r0 = ,(lsh (logand v 15) 4)) (break)))
-	       (t `((write (r0 | ,(lsh v -4))) (r0 = ,(lsh (logand v 15) 4)) (break)))))
-	    ew-ccl-256-to-64-table)))
-       (loop
-	(read-branch
-	 r1
-	 ,@(mapcar
-	    (lambda (v)
-	      (cond
-	       ((eq v nil) '(repeat))
-	       ((eq v t) '(end))
-	       ((= (lsh v -2) 0) `((write r0) (r0 = ,(lsh (logand v 3) 6)) (break)))
-	       (t `((write (r0 | ,(lsh v -2))) (r0 = ,(lsh (logand v 3) 6)) (break)))))
-	    ew-ccl-256-to-64-table)))
-       (loop
-	(read-branch
-	 r1
-	 ,@(mapcar
-	    (lambda (v)
-	      (cond
-	       ((eq v nil) '(repeat))
-	       ((eq v t) '(end))
-	       (t `((write (r0 | ,v)) (break)))))
-	    ew-ccl-256-to-64-table)))
-       (repeat)))))
-
-(eval-and-compile
-
-;; ew-ccl-encode-b works only 20.3 or later because CCL_EOF_BLOCK
-;; is not executed on 20.2 (or former?).
-(define-ccl-program ew-ccl-encode-b
-  (eval-when-compile
-    `(2
-      (loop
-       (r2 = 0)
-       (read-branch
-	r1
-	,@(mapcar
-	   (lambda (r1)
-	     `((write ,(nth (lsh r1 -2) ew-ccl-64-to-256-table))
-	       (r0 = ,(logand r1 3))))
-	   ew-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))
-				   ew-ccl-64-to-256-table))
-			    ew-ccl-4-table)))
-	       (r0 = ,(logand r1 15))))
-	   ew-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))
-				   ew-ccl-64-to-256-table))
-			    ew-ccl-16-table)))))
-	   ew-ccl-256-table))
-       (r1 &= 63)
-       (write r1 ,(vconcat
-		   (mapcar
-		    (lambda (r1)
-		      (nth r1 ew-ccl-64-to-256-table))
-		    ew-ccl-64-table)))
-       (repeat))
-      (branch
-       r2
-       (end)
-       ((write r0 ,(vconcat
-		    (mapcar
-		     (lambda (r0)
-		       (nth (lsh r0 4) ew-ccl-64-to-256-table))
-		     ew-ccl-4-table)))
-	(write "=="))
-       ((write r0 ,(vconcat
-		    (mapcar
-		     (lambda (r0)
-		       (nth (lsh r0 2) ew-ccl-64-to-256-table))
-		     ew-ccl-16-table)))
-	(write ?=)))
-      )))
-
-)
-
-;;;
-
-;; ew-ccl-encode-base64 does not works on 20.2 by same reason of ew-ccl-encode-b
-(define-ccl-program ew-ccl-encode-base64
-  (eval-when-compile
-    `(2
-      ((r3 = 0)
-       (loop
-	(r2 = 0)
-	(read-branch
-	 r1
-	 ,@(mapcar
-	    (lambda (r1)
-	      `((write ,(nth (lsh r1 -2) ew-ccl-64-to-256-table))
-		(r0 = ,(logand r1 3))))
-	    ew-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))
-				    ew-ccl-64-to-256-table))
-			     ew-ccl-4-table)))
-		(r0 = ,(logand r1 15))))
-	    ew-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))
-				    ew-ccl-64-to-256-table))
-			     ew-ccl-16-table)))))
-	    ew-ccl-256-table))
-	(r1 &= 63)
-	(write r1 ,(vconcat
-		    (mapcar
-		     (lambda (r1)
-		       (nth r1 ew-ccl-64-to-256-table))
-		     ew-ccl-64-table)))
-	(r3 += 1)
-	(if (r3 == 19) ; 4 * 19 = 76 --> line break.
-	    ((write "\r\n")
-	     (r3 = 0)))
-	(repeat)))
-      (branch
-       r2
-       (if (r0 > 0) (write "\r\n"))
-       ((write r0 ,(vconcat
-		    (mapcar
-		     (lambda (r0)
-		       (nth (lsh r0 4) ew-ccl-64-to-256-table))
-		     ew-ccl-4-table)))
-	(write "==\r\n"))
-       ((write r0 ,(vconcat
-		    (mapcar
-		     (lambda (r0)
-		       (nth (lsh r0 2) ew-ccl-64-to-256-table))
-		     ew-ccl-16-table)))
-	(write "=\r\n")))
-      )))
-
-;;;
-
-(make-coding-system 'ew-ccl-uq 4 ?Q "MIME Q-encoding in unstructured field"
-		    (cons ew-ccl-decode-q ew-ccl-encode-uq))
-
-(make-coding-system 'ew-ccl-cq 4 ?Q "MIME Q-encoding in comment"
-		    (cons ew-ccl-decode-q ew-ccl-encode-cq))
-
-(make-coding-system 'ew-ccl-pq 4 ?Q "MIME Q-encoding in phrase"
-		    (cons ew-ccl-decode-q ew-ccl-encode-pq))
-
-(make-coding-system 'ew-ccl-b 4 ?B "MIME B-encoding"
-		    (cons ew-ccl-decode-b ew-ccl-encode-b))
-
-(make-coding-system 'ew-ccl-base64 4 ?B "MIME Base64-encoding"
-		    (cons ew-ccl-decode-b ew-ccl-encode-base64))
-
-;;;
-
-(eval-and-compile
-
-(defconst ew-ccl-encode-b-is-broken
-  (eval-when-compile
-    (not (string= (ccl-execute-on-string ew-ccl-encode-b (make-vector 9 nil) "a")
-		  "YQ=="))))
-)
-
-;;;
-
-(defun ew-encode-uq (str)
-  (encode-coding-string (string-as-unibyte str) 'ew-ccl-uq))
-
-(defun ew-encode-cq (str)
-  (encode-coding-string (string-as-unibyte str) 'ew-ccl-cq))
-
-(defun ew-encode-pq (str)
-  (encode-coding-string (string-as-unibyte str) 'ew-ccl-pq))
-
-(defun ew-decode-q (str)
-  (string-as-unibyte (decode-coding-string str 'ew-ccl-uq)))
-
 (require 'mel)
-(if (or base64-dl-module ew-ccl-encode-b-is-broken)
-    (defalias 'ew-encode-b 'base64-encode-string)
-  (defun ew-encode-b (str)
-    (encode-coding-string (string-as-unibyte str) 'ew-ccl-b)))
-
-(if base64-dl-module
-    (defalias 'ew-decode-b 'base64-decode-string)
-  (defun ew-decode-b (str)
-    (string-as-unibyte (decode-coding-string str 'ew-ccl-b))))
-
-'(
 
-(ew-encode-uq "\000\037 !\"#$%&'()*+,-./09:;<=>?@AZ[\\]^_`az{|}~\177\200\377")
-(ew-encode-cq "\000\037 !\"#$%&'()*+,-./09:;<=>?@AZ[\\]^_`az{|}~\177\200\377")
-(ew-encode-pq "\000\037 !\"#$%&'()*+,-./09:;<=>?@AZ[\\]^_`az{|}~\177\200\377")
-(ew-encode-b "\000\037 !\"#$%&'()*+,-./09:;<=>?@AZ[\\]^_`az{|}~\177\200\377")
+(defun ew-decode-q (string)
+  (if (equal string "")
+    ""
+    (encoded-text-decode-string string "Q")))
 
-(ew-decode-q "a_b=20c")
-(ew-decode-q "=92=A4=A2")
-(ew-decode-b "SWYgeW91IGNhbiByZWFkIHRoaXMgeW8=")
+(defun ew-decode-b (string)
+  (if (equal string "")
+    ""
+    (encoded-text-decode-string string "B")))
 
-(let ((i 1000))
-  (while (< 0 i)
-    (setq i (1- i))
-    (ew-decode-b
-     "AB8gISIjJCUmJygpKissLS4vMDk6Ozw9Pj9AQVpbXF1eX2Bhent8fX5/gP8=")))
-
-(let ((i 1000))
-  (while (< 0 i)
-    (setq i (1- i))
-    (ew-decode-q
-     "=00=1F_!=22#$%&'=28=29*+,-./09:;<=3D>=3F@AZ[=5C]^=5F`az{|}~=7F=80=FF")))
-
-(require 'mel)
-
-(let ((i 1000))
-  (while (< 0 i)
-    (setq i (1- i))
-    (base64-decode-string
-     "AB8gISIjJCUmJygpKissLS4vMDk6Ozw9Pj9AQVpbXF1eX2Bhent8fX5/gP8=")))
-
-(let ((i 1000))
-  (while (< 0 i)
-    (setq i (1- i))
-    (q-encoding-decode-string
-     "=00=1F_!=22#$%&'=28=29*+,-./09:;<=3D>=3F@AZ[=5C]^=5F`az{|}~=7F=80=FF")))
-)
+(provide 'ew-bq)