8 (defvar ew-ccl-use-symbol
10 (define-ccl-program ew-ccl-identity
11 '(1 ((read r0) (loop (write-read-repeat r0)))))
16 "Identity coding system for byte-compile time checking"
17 '(ew-ccl-identity . ew-ccl-identity))
21 (defvar ew-ccl-untrusted-eof-block
23 (let ((status (make-vector 9 nil)))
24 (ccl-execute-on-string
26 '(0 (read r0) (r0 = 1)))
29 (= (aref status 0) 0))))
31 (defun ew-make-ccl-coding-system (coding-system mnemonic doc-string decoder encoder)
33 coding-system 4 mnemonic doc-string
35 (cons decoder encoder)
36 (cons (symbol-value decoder) (symbol-value encoder)))))
42 (defconst ew-ccl-4-table
45 (defconst ew-ccl-16-table
46 '( 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15))
48 (defconst ew-ccl-64-table
49 '( 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
50 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31
51 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47
52 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63))
54 (defconst ew-ccl-256-table
55 '( 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
56 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31
57 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47
58 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63
59 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79
60 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95
61 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111
62 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127
63 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143
64 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159
65 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175
66 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191
67 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207
68 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223
69 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239
70 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255))
72 (defconst ew-ccl-256-to-16-table
73 '(nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
74 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
75 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
76 0 1 2 3 4 5 6 7 8 9 nil nil nil nil nil nil
77 nil 10 11 12 13 14 15 nil nil nil nil nil nil nil nil nil
78 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
79 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
80 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
81 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
82 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
83 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
84 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
85 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
86 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
87 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
88 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil))
90 (defconst ew-ccl-16-to-256-table
91 '(?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9 ?A ?B ?C ?D ?E ?F))
93 (defconst ew-ccl-high-table
96 (lambda (v) (nth (lsh v -4) ew-ccl-16-to-256-table))
99 (defconst ew-ccl-low-table
102 (lambda (v) (nth (logand v 15) ew-ccl-16-to-256-table))
105 (defconst ew-ccl-u-raw
108 "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
109 "abcdefghijklmnopqrstuvwxyz"
110 "!@#$%&'()*+,-./:;<>@[\\]^`{|}~"
113 (defconst ew-ccl-c-raw
116 "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
117 "abcdefghijklmnopqrstuvwxyz"
118 "!@#$%&'*+,-./:;<>@[]^`{|}~"
121 (defconst ew-ccl-p-raw
124 "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
125 "abcdefghijklmnopqrstuvwxyz"
129 (defconst ew-ccl-256-to-64-table
130 '(nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
131 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
132 nil nil nil nil nil nil nil nil nil nil nil 62 nil nil nil 63
133 52 53 54 55 56 57 58 59 60 61 nil nil nil t nil nil
134 nil 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14
135 15 16 17 18 19 20 21 22 23 24 25 nil nil nil nil nil
136 nil 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40
137 41 42 43 44 45 46 47 48 49 50 51 nil nil nil nil nil
138 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
139 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
140 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
141 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
142 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
143 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
144 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
145 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil))
147 (defconst ew-ccl-64-to-256-table
148 '(?A ?B ?C ?D ?E ?F ?G ?H ?I ?J ?K ?L ?M ?N ?O ?P
149 ?Q ?R ?S ?T ?U ?V ?W ?X ?Y ?Z ?a ?b ?c ?d ?e ?f
150 ?g ?h ?i ?j ?k ?l ?m ?n ?o ?p ?q ?r ?s ?t ?u ?v
151 ?w ?x ?y ?z ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9 ?+ ?/))
153 (defconst ew-ccl-qp-table
154 [enc enc enc enc enc enc enc enc enc wsp enc enc enc cr enc enc
155 enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc
156 wsp raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw
157 raw raw raw raw raw raw raw raw raw raw raw raw raw enc raw raw
158 raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw
159 raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw
160 raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw
161 raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw enc
162 enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc
163 enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc
164 enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc
165 enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc
166 enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc
167 enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc
168 enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc
169 enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc])
173 (define-ccl-program ew-ccl-decode-q
193 ew-ccl-256-to-16-table)))
200 `((write r0 ,(vconcat
203 (logior (lsh r0 4) v))
207 ew-ccl-256-to-16-table)))
210 `(write-repeat ,r0))))
211 ew-ccl-256-table)))))))
213 (define-ccl-program ew-ccl-encode-uq
223 ((= r0 32) `(write-repeat ?_))
224 ((member r0 ew-ccl-u-raw) `(write-repeat ,r0))
228 (write r0 ,ew-ccl-high-table)
229 (write r0 ,ew-ccl-low-table)
232 (define-ccl-program ew-ccl-encode-cq
242 ((= r0 32) `(write-repeat ?_))
243 ((member r0 ew-ccl-c-raw) `(write-repeat ,r0))
247 (write r0 ,ew-ccl-high-table)
248 (write r0 ,ew-ccl-low-table)
251 (define-ccl-program ew-ccl-encode-pq
261 ((= r0 32) `(write-repeat ?_))
262 ((member r0 ew-ccl-p-raw) `(write-repeat ,r0))
266 (write r0 ,ew-ccl-high-table)
267 (write r0 ,ew-ccl-low-table)
271 (defun ew-ccl-decode-b-bit-ex (v)
273 (lsh (logand v (lsh 255 16)) -16)
274 (logand v (lsh 255 8))
275 (lsh (logand v 255) 16)))
277 (defconst ew-ccl-decode-b-0-table
282 ((eq v t) (lsh 1 24))
283 (v (ew-ccl-decode-b-bit-ex (lsh v 18)))
285 ew-ccl-256-to-64-table)))
287 (defconst ew-ccl-decode-b-1-table
292 ((eq v t) (lsh 1 25))
293 (v (ew-ccl-decode-b-bit-ex (lsh v 12)))
295 ew-ccl-256-to-64-table)))
297 (defconst ew-ccl-decode-b-2-table
302 ((eq v t) (lsh 1 26))
303 (v (ew-ccl-decode-b-bit-ex (lsh v 6)))
305 ew-ccl-256-to-64-table)))
307 (defconst ew-ccl-decode-b-3-table
312 ((eq v t) (lsh 1 27))
313 (v (ew-ccl-decode-b-bit-ex v))
315 ew-ccl-256-to-64-table)))
318 (define-ccl-program ew-ccl-decode-b
322 (r4 = r0 ,ew-ccl-decode-b-0-table)
323 (r5 = r1 ,ew-ccl-decode-b-1-table)
325 (r5 = r2 ,ew-ccl-decode-b-2-table)
327 (r5 = r3 ,ew-ccl-decode-b-3-table)
329 (if (r4 & ,(lognot (1- (lsh 1 24))))
331 (if (r4 & ,(lsh 1 24))
332 ((r0 = r1) (r1 = r2) (r2 = r3) (read r3)
333 (r4 >>= 1) (r4 &= ,(logior (lsh 7 24)))
334 (r5 = r3 ,ew-ccl-decode-b-3-table)
339 (if (r4 & ,(lsh 1 25))
340 ((r1 = r2) (r2 = r3) (read r3)
341 (r4 >>= 1) (r4 &= ,(logior (lsh 7 24)))
342 (r5 = r3 ,ew-ccl-decode-b-3-table)
348 (if (r4 & ,(lsh 1 26))
350 (r4 >>= 1) (r4 &= ,(logior (lsh 7 24)))
351 (r5 = r3 ,ew-ccl-decode-b-3-table)
360 (if (r4 & ,(lsh 1 27))
362 (r4 = r3 ,ew-ccl-decode-b-3-table)
367 (r4 = r0 ,ew-ccl-decode-b-0-table)
368 (r5 = r1 ,ew-ccl-decode-b-1-table)
373 ((r5 = r2 ,ew-ccl-decode-b-2-table)
375 (r5 = r3 ,ew-ccl-decode-b-3-table)
388 ((r5 = r2 ,ew-ccl-decode-b-2-table)
404 (write-repeat r7))))))
406 ;; ew-ccl-encode-b works only 20.3 or later because CCL_EOF_BLOCK
407 ;; is not executed on 20.2 (or former?).
408 (define-ccl-program ew-ccl-encode-b
417 `((write ,(nth (lsh r1 -2) ew-ccl-64-to-256-table))
418 (r0 = ,(logand r1 3))))
425 `((write r0 ,(vconcat
428 (nth (logior (lsh r0 4)
430 ew-ccl-64-to-256-table))
432 (r0 = ,(logand r1 15))))
439 `((write r0 ,(vconcat
442 (nth (logior (lsh r0 2)
444 ew-ccl-64-to-256-table))
451 (nth r1 ew-ccl-64-to-256-table))
460 (nth (lsh r0 4) ew-ccl-64-to-256-table))
466 (nth (lsh r0 2) ew-ccl-64-to-256-table))
473 ;; ew-ccl-encode-base64 does not works on 20.2 by same reason of ew-ccl-encode-b
474 (define-ccl-program ew-ccl-encode-base64
484 `((write ,(nth (lsh r1 -2) ew-ccl-64-to-256-table))
485 (r0 = ,(logand r1 3))))
492 `((write r0 ,(vconcat
495 (nth (logior (lsh r0 4)
497 ew-ccl-64-to-256-table))
499 (r0 = ,(logand r1 15))))
506 `((write r0 ,(vconcat
509 (nth (logior (lsh r0 2)
511 ew-ccl-64-to-256-table))
518 (nth r1 ew-ccl-64-to-256-table))
521 (if (r3 == 19) ; 4 * 19 = 76 --> line break.
527 (if (r0 > 0) (write "\r\n"))
531 (nth (lsh r0 4) ew-ccl-64-to-256-table))
537 (nth (lsh r0 2) ew-ccl-64-to-256-table))
542 ;; ew-ccl-encode-quoted-printable does not works on 20.2 by same reason of ew-ccl-encode-b
543 (define-ccl-program ew-ccl-encode-quoted-printable
547 (r5 = 0) ; previous character is white space
557 (let ((tmp (aref ew-ccl-qp-table r0)))
559 ((eq tmp 'raw) '((r3 = 0) (break))) ; RAW
560 ((eq tmp 'enc) '((r3 = 1) (break))) ; ENC
561 ((eq tmp 'wsp) '((r3 = 2) (break))) ; WSP
562 ((eq tmp 'cr) '((r3 = 3) (break))) ; CR
572 (write-read-repeat r0))
579 (write r0 ,ew-ccl-high-table)
581 (write-read-repeat r0 ,ew-ccl-low-table))
585 (write r0 ,ew-ccl-high-table)
587 (write-read-repeat r0 ,ew-ccl-low-table))
594 (write-read-repeat r0))
598 (write-read-repeat r0))))
600 ((if ((r6 > 73) & r5)
605 ;; r0:r3={RAW,ENC,CR}
615 ;; r5=WSP ; CR:r3=CR r0=LF
622 ;; r5=noWSP ; CR:r3=CR r0=LF
652 (write "=\r\n=0D=0D")
654 ;; CR:r3=CR r0=noLFnorCR
666 ;; r0:r3={RAW,ENC} r1
668 ;; r0:r3={RAW,ENC} r1=CR
671 ;; r0:r3={RAW,ENC} CR r1
673 ;; r0:r3={RAW,ENC} CR r1=LF
678 ;; r0:r3=RAW CR r1=LF
684 ;; r0:r3=ENC CR r1=LF
686 (write r0 ,ew-ccl-high-table)
687 (write r0 ,ew-ccl-low-table)
692 ;; r0:r3={RAW,ENC} CR r1=noLF
695 ;; r0:r3=RAW CR r1:noLF
703 ;; r0:r3=ENC CR r1:noLF
707 (write r0 ,ew-ccl-high-table)
708 (write r0 ,ew-ccl-low-table)
713 ;; r0:r3={RAW,ENC} r1:noCR
727 (write r0 ,ew-ccl-high-table)
728 (write r0 ,ew-ccl-low-table)
732 (;(write "[EOF:") (write r4 ,ew-ccl-high-table) (write r4 ,ew-ccl-low-table) (write "]")
741 ;; 3: SOFTBREAK r0:r3=ENC ;
744 ((write "=\r\n") (end))
745 ;; 5: SOFTBREAK r0:r3=WSP ;
746 ((write "=\r\n") (end))
749 ((write "=0D") (end))
750 ((write "=\r\n=0D") (end)))
751 ;; 7: r5=WSP SOFTBREAK CR:r3=CR r0=LF ;
753 ;; 8: r5=noWSP CR:r3=CR r0=LF ;
755 ;; 9: (r6=73) ; CR:r3=CR r0=CR
756 ((write "=\r\n=0D=0D") (end))
757 ;; 10: (r6=73) CR:r3=CR CR LF ;
759 ;; 11: ; r0:r3={RAW,ENC}
764 (write r0 ,ew-ccl-high-table)
765 (write r0 ,ew-ccl-low-table)
767 ;; 12: ; r0:r3={RAW,ENC} r1=CR
775 (write r0 ,ew-ccl-high-table)
776 (write r0 ,ew-ccl-low-table)
779 ;; 13: r0:r3=RAW CR LF ;
781 ;; 14: r0:r3=ENC CR LF ;
786 (define-ccl-program ew-ccl-decode-quoted-printable
795 (let ((tmp (aref ew-ccl-qp-table r0)))
797 ((or (eq tmp 'raw) (eq tmp 'wsp)) `(write-read-repeat r0))
803 (if ((r0 == ? ) | r1)
805 ;; Skip transport-padding.
806 ;; It should check CR LF after
807 ;; transport-padding.
814 ;; '=' [\t ]* r0:[^\t ]
821 ;; '=' [\t ]* r0='\r'
823 ;; '=' [\t ]* '\r' r0
825 ;; '=' [\t ]* '\r' r0='\n'
826 ;; soft line break found.
829 ;; '=' [\t ]* '\r' r0:[^\n]
831 ;; output "=\r" and rescan from r0.
834 ((setq tmp (nth r0 ew-ccl-256-to-16-table))
835 ;; '=' [\t ]* r0:[0-9A-F]
838 ;; '=' [\t ]* r0:[^\r0-9A-F]
840 ;; output "=" and rescan from r0.
844 ;; '=' [\t ]* r0:[0-9A-F]
849 (if (setq tmp (nth r1 ew-ccl-256-to-16-table))
850 ;; '=' [\t ]* [0-9A-F] r1:[0-9A-F]
856 (logior (lsh r0 4) tmp))
858 ;; '=' [\t ]* [0-9A-F] r1:[^0-9A-F]
863 ;; '=' [\t ]* [0-9A-F] r1:[^0-9A-F]
866 (write r0 ,(vconcat ew-ccl-16-to-256-table))
876 ;; hard line break found.
878 (write-read-repeat r0))
880 ;; invalid control character (bare CR) found.
881 ;; -> ignore it and rescan from r0.
885 ;; invalid character found.
889 ew-ccl-256-table)))))))
893 (ew-make-ccl-coding-system
894 'ew-ccl-uq ?Q "MIME Q-encoding in unstructured field"
895 'ew-ccl-decode-q 'ew-ccl-encode-uq)
897 (ew-make-ccl-coding-system
898 'ew-ccl-cq ?Q "MIME Q-encoding in comment"
899 'ew-ccl-decode-q 'ew-ccl-encode-cq)
901 (ew-make-ccl-coding-system
902 'ew-ccl-pq ?Q "MIME Q-encoding in phrase"
903 'ew-ccl-decode-q 'ew-ccl-encode-pq)
905 (ew-make-ccl-coding-system
906 'ew-ccl-b ?B "MIME B-encoding"
907 'ew-ccl-decode-b 'ew-ccl-encode-b)
909 (ew-make-ccl-coding-system
910 'ew-ccl-quoted-printable ?Q "MIME Quoted-Printable-encoding"
911 'ew-ccl-decode-quoted-printable 'ew-ccl-encode-quoted-printable)
913 (ew-make-ccl-coding-system
914 'ew-ccl-base64 ?B "MIME Base64-encoding"
915 'ew-ccl-decode-b 'ew-ccl-encode-base64)
919 (defvar ew-bq-use-mel nil)
921 (defun ew-encode-uq (str)
922 (encode-coding-string (string-as-unibyte str) 'ew-ccl-uq))
924 (defun ew-encode-cq (str)
925 (encode-coding-string (string-as-unibyte str) 'ew-ccl-cq))
927 (defun ew-encode-pq (str)
928 (encode-coding-string (string-as-unibyte str) 'ew-ccl-pq))
931 (defalias 'ew-decode-q 'q-encoding-decode-string)
932 (defun ew-decode-q (str)
933 (string-as-unibyte (decode-coding-string str 'ew-ccl-uq))))
935 (if (or ew-bq-use-mel base64-dl-module ew-ccl-untrusted-eof-block)
936 (defalias 'ew-encode-b 'base64-encode-string)
937 (defun ew-encode-b (str)
938 (encode-coding-string (string-as-unibyte str) 'ew-ccl-b)))
940 (if (or ew-bq-use-mel base64-dl-module)
941 (defalias 'ew-decode-b 'base64-decode-string)
942 (defun ew-decode-b (str)
943 (string-as-unibyte (decode-coding-string str 'ew-ccl-b))))
947 (ew-encode-uq "\000\037 !\"#$%&'()*+,-./09:;<=>?@AZ[\\]^_`az{|}~\177\200\377")
948 (ew-encode-cq "\000\037 !\"#$%&'()*+,-./09:;<=>?@AZ[\\]^_`az{|}~\177\200\377")
949 (ew-encode-pq "\000\037 !\"#$%&'()*+,-./09:;<=>?@AZ[\\]^_`az{|}~\177\200\377")
950 (ew-encode-b "\000\037 !\"#$%&'()*+,-./09:;<=>?@AZ[\\]^_`az{|}~\177\200\377")
952 (ew-decode-q "a_b=20c")
953 (ew-decode-q "=92=A4=A2")
954 (ew-decode-b "SWYgeW91IGNhbiByZWFkIHRoaXMgeW8=")
960 "AB8gISIjJCUmJygpKissLS4vMDk6Ozw9Pj9AQVpbXF1eX2Bhent8fX5/gP8=")))
966 "=00=1F_!=22#$%&'=28=29*+,-./09:;<=3D>=3F@AZ[=5C]^=5F`az{|}~=7F=80=FF")))
973 (base64-decode-string
974 "AB8gISIjJCUmJygpKissLS4vMDk6Ozw9Pj9AQVpbXF1eX2Bhent8fX5/gP8=")))
979 (q-encoding-decode-string
980 "=00=1F_!=22#$%&'=28=29*+,-./09:;<=3D>=3F@AZ[=5C]^=5F`az{|}~=7F=80=FF")))
983 (setq a (current-time))
988 "AB8gISIjJCUmJygpKissLS4vMDk6Ozw9Pj9AQVpbXF1eX2Bhent8fX5/gP8=")))
989 (setq b (current-time))
990 (elp-elapsed-time a b))
992 (let (a b) ; Emacs Lisp
993 (setq a (current-time))
997 (base64-decode-string
998 "AB8gISIjJCUmJygpKissLS4vMDk6Ozw9Pj9AQVpbXF1eX2Bhent8fX5/gP8=")))
999 (setq b (current-time))
1000 (elp-elapsed-time a b))
1003 (setq a (current-time))
1007 (decode-base64-string
1008 "AB8gISIjJCUmJygpKissLS4vMDk6Ozw9Pj9AQVpbXF1eX2Bhent8fX5/gP8=")))
1009 (setq b (current-time))
1010 (elp-elapsed-time a b))