ew-bq.el

   1 (require 'ccl)
   2 (require 'emu)
   3
   4 (provide 'ew-bq)
   5
   6 ;;;
   7
   8 (defvar ew-ccl-use-symbol
   9   (eval-when-compile
  10     (define-ccl-program ew-ccl-identity
  11       '(1 ((read r0) (loop (write-read-repeat r0)))))
  12     (condition-case nil
  13         (progn
  14           (make-coding-system
  15            'ew-ccl-identity 4 ?I
  16            "Identity coding system for byte-compile time checking"
  17            '(ew-ccl-identity . ew-ccl-identity))
  18           t)
  19       (error nil))))
  20
  21 (defvar ew-ccl-untrusted-eof-block
  22   (eval-when-compile
  23     (let ((status (make-vector 9 nil)))
  24       (ccl-execute-on-string
  25        (ccl-compile
  26         '(0 (read r0) (r0 = 1)))
  27        status
  28        "")
  29       (= (aref status 0) 0))))
  30
  31 (defun ew-make-ccl-coding-system (coding-system mnemonic doc-string decoder encoder)
  32   (make-coding-system
  33    coding-system 4 mnemonic doc-string
  34    (if ew-ccl-use-symbol
  35        (cons decoder encoder)
  36      (cons (symbol-value decoder) (symbol-value encoder)))))
  37
  38 ;;;
  39
  40 (eval-when-compile
  41
  42 (defconst ew-ccl-4-table
  43   '(  0   1   2   3))
  44
  45 (defconst ew-ccl-16-table
  46   '(  0   1   2   3   4   5   6   7   8   9  10  11  12  13  14  15))
  47
  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))
  53
  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))
  71
  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))
  89
  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))
  92
  93 (defconst ew-ccl-high-table
  94   (vconcat
  95    (mapcar
  96     (lambda (v) (nth (lsh v -4) ew-ccl-16-to-256-table))
  97     ew-ccl-256-table)))
  98
  99 (defconst ew-ccl-low-table
 100   (vconcat
 101    (mapcar
 102     (lambda (v) (nth (logand v 15) ew-ccl-16-to-256-table))
 103     ew-ccl-256-table)))
 104
 105 (defconst ew-ccl-u-raw
 106   (append
 107    "0123456789"
 108    "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
 109    "abcdefghijklmnopqrstuvwxyz"
 110    "!@#$%&'()*+,-./:;<>@[\\]^`{|}~"
 111    ()))
 112
 113 (defconst ew-ccl-c-raw
 114   (append
 115    "0123456789"
 116    "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
 117    "abcdefghijklmnopqrstuvwxyz"
 118    "!@#$%&'*+,-./:;<>@[]^`{|}~"
 119    ()))
 120
 121 (defconst ew-ccl-p-raw
 122   (append
 123    "0123456789"
 124    "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
 125    "abcdefghijklmnopqrstuvwxyz"
 126    "!*+-/"
 127    ()))
 128
 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))
 146
 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 ?+ ?/))
 152
 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])
 170
 171 )
 172
 173 (define-ccl-program ew-ccl-decode-q
 174   (eval-when-compile
 175     `(1
 176       ((loop
 177         (read-branch
 178          r0
 179          ,@(mapcar
 180             (lambda (r0)
 181               (cond
 182                ((= r0 ?_)
 183                 `(write-repeat ? ))
 184                ((= r0 ?=)
 185                 `((loop
 186                    (read-branch
 187                     r1
 188                     ,@(mapcar
 189                        (lambda (v)
 190                          (if (integerp v)
 191                              `((r0 = ,v) (break))
 192                            '(repeat)))
 193                        ew-ccl-256-to-16-table)))
 194                   (loop
 195                    (read-branch
 196                     r1
 197                     ,@(mapcar
 198                        (lambda (v)
 199                          (if (integerp v)
 200                              `((write r0 ,(vconcat
 201                                            (mapcar
 202                                             (lambda (r0)
 203                                               (logior (lsh r0 4) v))
 204                                             ew-ccl-16-table)))
 205                                (break))
 206                            '(repeat)))
 207                        ew-ccl-256-to-16-table)))
 208                   (repeat)))
 209                (t
 210                 `(write-repeat ,r0))))
 211             ew-ccl-256-table)))))))
 212
 213 (define-ccl-program ew-ccl-encode-uq
 214   (eval-when-compile
 215     `(3
 216       (loop
 217        (loop
 218         (read-branch
 219          r0
 220          ,@(mapcar
 221             (lambda (r0)
 222               (cond
 223                ((= r0 32) `(write-repeat ?_))
 224                ((member r0 ew-ccl-u-raw) `(write-repeat ,r0))
 225                (t '(break))))
 226             ew-ccl-256-table)))
 227        (write ?=)
 228        (write r0 ,ew-ccl-high-table)
 229        (write r0 ,ew-ccl-low-table)
 230        (repeat)))))
 231
 232 (define-ccl-program ew-ccl-encode-cq
 233   (eval-when-compile
 234     `(3
 235       (loop
 236        (loop
 237         (read-branch
 238          r0
 239          ,@(mapcar
 240             (lambda (r0)
 241               (cond
 242                ((= r0 32) `(write-repeat ?_))
 243                ((member r0 ew-ccl-c-raw) `(write-repeat ,r0))
 244                (t '(break))))
 245             ew-ccl-256-table)))
 246        (write ?=)
 247        (write r0 ,ew-ccl-high-table)
 248        (write r0 ,ew-ccl-low-table)
 249        (repeat)))))
 250
 251 (define-ccl-program ew-ccl-encode-pq
 252   (eval-when-compile
 253     `(3
 254       (loop
 255        (loop
 256         (read-branch
 257          r0
 258          ,@(mapcar
 259             (lambda (r0)
 260               (cond
 261                ((= r0 32) `(write-repeat ?_))
 262                ((member r0 ew-ccl-p-raw) `(write-repeat ,r0))
 263                (t '(break))))
 264             ew-ccl-256-table)))
 265        (write ?=)
 266        (write r0 ,ew-ccl-high-table)
 267        (write r0 ,ew-ccl-low-table)
 268        (repeat)))))
 269
 270 (eval-when-compile
 271 (defun ew-ccl-decode-b-bit-ex (v)
 272   (logior
 273    (lsh (logand v (lsh 255 16)) -16)
 274    (logand v (lsh 255 8))
 275    (lsh (logand v 255) 16)))
 276
 277 (defconst ew-ccl-decode-b-0-table
 278   (vconcat
 279    (mapcar
 280     (lambda (v)
 281       (cond
 282        ((eq v t) (lsh 1 24))
 283        (v (ew-ccl-decode-b-bit-ex (lsh v 18)))
 284        (t (lsh 1 24))))
 285     ew-ccl-256-to-64-table)))
 286
 287 (defconst ew-ccl-decode-b-1-table
 288   (vconcat
 289    (mapcar
 290     (lambda (v)
 291       (cond
 292        ((eq v t) (lsh 1 25))
 293        (v (ew-ccl-decode-b-bit-ex (lsh v 12)))
 294        (t (lsh 1 25))))
 295     ew-ccl-256-to-64-table)))
 296
 297 (defconst ew-ccl-decode-b-2-table
 298   (vconcat
 299    (mapcar
 300     (lambda (v)
 301       (cond
 302        ((eq v t) (lsh 1 26))
 303        (v (ew-ccl-decode-b-bit-ex (lsh v 6)))
 304        (t (lsh 1 26))))
 305     ew-ccl-256-to-64-table)))
 306
 307 (defconst ew-ccl-decode-b-3-table
 308   (vconcat
 309    (mapcar
 310     (lambda (v)
 311       (cond
 312        ((eq v t) (lsh 1 27))
 313        (v (ew-ccl-decode-b-bit-ex v))
 314        (t (lsh 1 27))))
 315     ew-ccl-256-to-64-table)))
 316 )
 317
 318 (define-ccl-program ew-ccl-decode-b
 319   `(1
 320     (loop
 321      (read r0 r1 r2 r3)
 322      (r4 = r0 ,ew-ccl-decode-b-0-table)
 323      (r5 = r1 ,ew-ccl-decode-b-1-table)
 324      (r4 |= r5)
 325      (r5 = r2 ,ew-ccl-decode-b-2-table)
 326      (r4 |= r5)
 327      (r5 = r3 ,ew-ccl-decode-b-3-table)
 328      (r4 |= r5)
 329      (if (r4 & ,(lognot (1- (lsh 1 24))))
 330          ((loop
 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)
 335                 (r4 |= r5)
 336                 (repeat))
 337              (break)))
 338           (loop
 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)
 343                 (r4 |= r5)
 344                 (repeat))
 345              (break)))
 346           (loop
 347            (if (r2 != ?=)
 348                (if (r4 & ,(lsh 1 26))
 349                    ((r2 = r3) (read r3)
 350                     (r4 >>= 1) (r4 &= ,(logior (lsh 7 24)))
 351                     (r5 = r3 ,ew-ccl-decode-b-3-table)
 352                     (r4 |= r5)
 353                     (repeat))
 354                  ((r6 = 0)
 355                   (break)))
 356              ((r6 = 1)
 357               (break))))
 358           (loop
 359            (if (r3 != ?=)
 360                (if (r4 & ,(lsh 1 27))
 361                    ((read r3)
 362                     (r4 = r3 ,ew-ccl-decode-b-3-table)
 363                     (repeat))
 364                  (break))
 365              ((r6 |= 2)
 366               (break))))
 367           (r4 = r0 ,ew-ccl-decode-b-0-table)
 368           (r5 = r1 ,ew-ccl-decode-b-1-table)
 369           (r4 |= r5)
 370           (branch
 371            r6
 372            ;; BBBB
 373            ((r5 = r2 ,ew-ccl-decode-b-2-table)
 374             (r4 |= r5)
 375             (r5 = r3 ,ew-ccl-decode-b-3-table)
 376             (r4 |= r5)
 377             (r4 >8= 0)
 378             (write r7)
 379             (r4 >8= 0)
 380             (write r7)
 381             (r4 >8= 0)
 382             (write-repeat r7))
 383            ;; error: BB=B
 384            ((r4 >8= 0)
 385             (write r7)
 386             (end))
 387            ;; BBB=
 388            ((r5 = r2 ,ew-ccl-decode-b-2-table)
 389             (r4 |= r5)
 390             (r4 >8= 0)
 391             (write r7)
 392             (r4 >8= 0)
 393             (write r7)
 394             (end))
 395            ;; BB==
 396            ((r4 >8= 0)
 397             (write r7)
 398             (end))))
 399        ((r4 >8= 0)
 400         (write r7)
 401         (r4 >8= 0)
 402         (write r7)
 403         (r4 >8= 0)
 404         (write-repeat r7))))))
 405
 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
 409   (eval-when-compile
 410     `(2
 411       (loop
 412        (r2 = 0)
 413        (read-branch
 414         r1
 415         ,@(mapcar
 416            (lambda (r1)
 417              `((write ,(nth (lsh r1 -2) ew-ccl-64-to-256-table))
 418                (r0 = ,(logand r1 3))))
 419            ew-ccl-256-table))
 420        (r2 = 1)
 421        (read-branch
 422         r1
 423         ,@(mapcar
 424            (lambda (r1)
 425              `((write r0 ,(vconcat
 426                            (mapcar
 427                             (lambda (r0)
 428                               (nth (logior (lsh r0 4)
 429                                            (lsh r1 -4))
 430                                    ew-ccl-64-to-256-table))
 431                             ew-ccl-4-table)))
 432                (r0 = ,(logand r1 15))))
 433            ew-ccl-256-table))
 434        (r2 = 2)
 435        (read-branch
 436         r1
 437         ,@(mapcar
 438            (lambda (r1)
 439              `((write r0 ,(vconcat
 440                            (mapcar
 441                             (lambda (r0)
 442                               (nth (logior (lsh r0 2)
 443                                            (lsh r1 -6))
 444                                    ew-ccl-64-to-256-table))
 445                             ew-ccl-16-table)))))
 446            ew-ccl-256-table))
 447        (r1 &= 63)
 448        (write r1 ,(vconcat
 449                    (mapcar
 450                     (lambda (r1)
 451                       (nth r1 ew-ccl-64-to-256-table))
 452                     ew-ccl-64-table)))
 453        (repeat))
 454       (branch
 455        r2
 456        (end)
 457        ((write r0 ,(vconcat
 458                     (mapcar
 459                      (lambda (r0)
 460                        (nth (lsh r0 4) ew-ccl-64-to-256-table))
 461                      ew-ccl-4-table)))
 462         (write "=="))
 463        ((write r0 ,(vconcat
 464                     (mapcar
 465                      (lambda (r0)
 466                        (nth (lsh r0 2) ew-ccl-64-to-256-table))
 467                      ew-ccl-16-table)))
 468         (write ?=)))
 469       )))
 470
 471 ;;;
 472
 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
 475   (eval-when-compile
 476     `(2
 477       ((r3 = 0)
 478        (loop
 479         (r2 = 0)
 480         (read-branch
 481          r1
 482          ,@(mapcar
 483             (lambda (r1)
 484               `((write ,(nth (lsh r1 -2) ew-ccl-64-to-256-table))
 485                 (r0 = ,(logand r1 3))))
 486             ew-ccl-256-table))
 487         (r2 = 1)
 488         (read-branch
 489          r1
 490          ,@(mapcar
 491             (lambda (r1)
 492               `((write r0 ,(vconcat
 493                             (mapcar
 494                              (lambda (r0)
 495                                (nth (logior (lsh r0 4)
 496                                             (lsh r1 -4))
 497                                     ew-ccl-64-to-256-table))
 498                              ew-ccl-4-table)))
 499                 (r0 = ,(logand r1 15))))
 500             ew-ccl-256-table))
 501         (r2 = 2)
 502         (read-branch
 503          r1
 504          ,@(mapcar
 505             (lambda (r1)
 506               `((write r0 ,(vconcat
 507                             (mapcar
 508                              (lambda (r0)
 509                                (nth (logior (lsh r0 2)
 510                                             (lsh r1 -6))
 511                                     ew-ccl-64-to-256-table))
 512                              ew-ccl-16-table)))))
 513             ew-ccl-256-table))
 514         (r1 &= 63)
 515         (write r1 ,(vconcat
 516                     (mapcar
 517                      (lambda (r1)
 518                        (nth r1 ew-ccl-64-to-256-table))
 519                      ew-ccl-64-table)))
 520         (r3 += 1)
 521         (if (r3 == 19) ; 4 * 19 = 76 --> line break.
 522             ((write "\r\n")
 523              (r3 = 0)))
 524         (repeat)))
 525       (branch
 526        r2
 527        (if (r0 > 0) (write "\r\n"))
 528        ((write r0 ,(vconcat
 529                     (mapcar
 530                      (lambda (r0)
 531                        (nth (lsh r0 4) ew-ccl-64-to-256-table))
 532                      ew-ccl-4-table)))
 533         (write "==\r\n"))
 534        ((write r0 ,(vconcat
 535                     (mapcar
 536                      (lambda (r0)
 537                        (nth (lsh r0 2) ew-ccl-64-to-256-table))
 538                      ew-ccl-16-table)))
 539         (write "=\r\n")))
 540       )))
 541
 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
 544   (eval-when-compile
 545     `(4
 546       ((r6 = 0) ; column
 547        (r5 = 0) ; previous character is white space
 548        (r4 = 0)
 549        (read r0)
 550        (loop ; r6 <= 75
 551         (loop
 552          (loop
 553           (branch
 554            r0
 555            ,@(mapcar
 556               (lambda (r0)
 557                 (let ((tmp (aref ew-ccl-qp-table r0)))
 558                   (cond
 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
 563                    )))
 564               ew-ccl-256-table)))
 565          (branch
 566           r3
 567           ;; r0:r3=RAW
 568           (if (r6 < 75)
 569               ((r6 += 1)
 570                (r5 = 0)
 571                (r4 = 1)
 572                (write-read-repeat r0))
 573             (break))
 574           ;; r0:r3=ENC
 575           ((r5 = 0)
 576            (if (r6 < 73)
 577                ((r6 += 3)
 578                 (write "=")
 579                 (write r0 ,ew-ccl-high-table)
 580                 (r4 = 2)
 581                 (write-read-repeat r0 ,ew-ccl-low-table))
 582              (if (r6 > 73)
 583                  ((r6 = 3)
 584                   (write "=\r\n=")
 585                   (write r0 ,ew-ccl-high-table)
 586                   (r4 = 3)
 587                   (write-read-repeat r0 ,ew-ccl-low-table))
 588                (break))))
 589           ;; r0:r3=WSP
 590           ((r5 = 1)
 591            (if (r6 < 75)
 592                ((r6 += 1)
 593                 (r4 = 4)
 594                 (write-read-repeat r0))
 595              ((r6 = 1)
 596               (write "=\r\n")
 597               (r4 = 5)
 598               (write-read-repeat r0))))
 599           ;; r0:r3=CR
 600           ((if ((r6 > 73) & r5)
 601                ((r6 = 0)
 602                 (r5 = 0)
 603                 (write "=\r\n")))
 604            (break))))
 605         ;; r0:r3={RAW,ENC,CR}
 606         (loop
 607          (if (r0 == ?\r)
 608              ;; r0=\r:r3=CR
 609              ((r4 = 6)
 610               (read r0)
 611               ;; CR:r3=CR r0
 612               (if (r0 == ?\n)
 613                   ;; CR:r3=CR r0=LF
 614                   (if r5
 615                       ;; r5=WSP ; CR:r3=CR r0=LF
 616                       ((r6 = 0)
 617                        (r5 = 0)
 618                        (write "=\r\n\r\n")
 619                        (r4 = 7)
 620                        (read r0)
 621                        (break))
 622                     ;; r5=noWSP ; CR:r3=CR r0=LF
 623                     ((r6 = 0)
 624                      (r5 = 0)
 625                      (write "\r\n")
 626                      (r4 = 8)
 627                      (read r0)
 628                      (break)))
 629                 ;; CR:r3=CR r0=noLF
 630                 (if (r6 < 73)
 631                     ((r6 += 3)
 632                      (r5 = 0)
 633                      (write "=0D")
 634                      (break))
 635                   (if (r6 == 73)
 636                       (if (r0 == ?\r)
 637                           ;; CR:r3=CR r0=CR
 638                           ((r4 = 9)
 639                            (read r0)
 640                            ;; CR:r3=CR CR r0
 641                            (if (r0 == ?\n)
 642                                ;; CR:r3=CR CR LF
 643                                ((r6 = 0)
 644                                 (r5 = 0)
 645                                 (write "=0D\r\n")
 646                                 (r4 = 10)
 647                                 (read r0)
 648                                 (break))
 649                              ;; CR:r3=CR CR noLF
 650                              ((r6 = 6)
 651                               (r5 = 0)
 652                               (write "=\r\n=0D=0D")
 653                               (break))))
 654                         ;; CR:r3=CR r0=noLFnorCR
 655                         ((r6 = 3)
 656                          (r5 = 0)
 657                          (write "=\r\n=0D")
 658                          (break)))
 659                     ((r6 = 3)
 660                      (r5 = 0)
 661                      (write "=\r\n=0D")
 662                      (break))))))
 663            ;; r0:r3={RAW,ENC}
 664            ((r4 = 11)
 665             (read r1)
 666             ;; r0:r3={RAW,ENC} r1
 667             (if (r1 == ?\r)
 668                 ;; r0:r3={RAW,ENC} r1=CR
 669                 ((r4 = 12)
 670                  (read r1)
 671                  ;; r0:r3={RAW,ENC} CR r1
 672                  (if (r1 == ?\n)
 673                      ;; r0:r3={RAW,ENC} CR r1=LF
 674                      ((r6 = 0)
 675                       (r5 = 0)
 676                       (branch
 677                        r3
 678                        ;; r0:r3=RAW CR r1=LF
 679                        ((write r0)
 680                         (write "\r\n")
 681                         (r4 = 13)
 682                         (read r0)
 683                         (break))
 684                        ;; r0:r3=ENC CR r1=LF
 685                        ((write ?=)
 686                         (write r0 ,ew-ccl-high-table)
 687                         (write r0 ,ew-ccl-low-table)
 688                         (write "\r\n")
 689                         (r4 = 14)
 690                         (read r0)
 691                         (break))))
 692                    ;; r0:r3={RAW,ENC} CR r1=noLF
 693                    ((branch
 694                      r3
 695                      ;; r0:r3=RAW CR r1:noLF
 696                      ((r6 = 4)
 697                       (r5 = 0)
 698                       (write "=\r\n")
 699                       (write r0)
 700                       (write "=0D")
 701                       (r0 = r1)
 702                       (break))
 703                      ;; r0:r3=ENC CR r1:noLF
 704                      ((r6 = 6)
 705                       (r5 = 0)
 706                       (write "=\r\n=")
 707                       (write r0 ,ew-ccl-high-table)
 708                       (write r0 ,ew-ccl-low-table)
 709                       (write "=0D")
 710                       (r0 = r1)
 711                       (break))))
 712                    ))
 713               ;; r0:r3={RAW,ENC} r1:noCR
 714               ((branch
 715                 r3
 716                 ;; r0:r3=RAW r1:noCR
 717                 ((r6 = 1)
 718                  (r5 = 0)
 719                  (write "=\r\n")
 720                  (write r0)
 721                  (r0 = r1)
 722                  (break))
 723                 ;; r0:r3=ENC r1:noCR
 724                 ((r6 = 3)
 725                  (r5 = 0)
 726                  (write "=\r\n=")
 727                  (write r0 ,ew-ccl-high-table)
 728                  (write r0 ,ew-ccl-low-table)
 729                  (r0 = r1)
 730                  (break))))))))
 731         (repeat)))
 732       (;(write "[EOF:") (write r4 ,ew-ccl-high-table) (write r4 ,ew-ccl-low-table) (write "]")
 733        (branch
 734         r4
 735         ;; 0: (start) ;
 736         (end)
 737         ;; 1: RAW ;
 738         (end)
 739         ;; 2: r0:r3=ENC ;
 740         (end)
 741         ;; 3: SOFTBREAK r0:r3=ENC ;
 742         (end)
 743         ;; 4: r0:r3=WSP ;
 744         ((write "=\r\n") (end))
 745         ;; 5: SOFTBREAK r0:r3=WSP ;
 746         ((write "=\r\n") (end))
 747         ;; 6: ; r0=\r:r3=CR
 748         (if (r6 <= 73)
 749             ((write "=0D") (end))
 750            ((write "=\r\n=0D") (end)))
 751         ;; 7: r5=WSP SOFTBREAK CR:r3=CR r0=LF ;
 752         (end)
 753         ;; 8: r5=noWSP CR:r3=CR r0=LF ;
 754         (end)
 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 ;
 758         (end)
 759         ;; 11: ; r0:r3={RAW,ENC}
 760         (branch
 761          r3
 762          ((write r0) (end))
 763          ((write "=")
 764           (write r0 ,ew-ccl-high-table)
 765           (write r0 ,ew-ccl-low-table)
 766           (end)))
 767         ;; 12: ; r0:r3={RAW,ENC} r1=CR
 768         (branch
 769          r3
 770          ((write "=\r\n")
 771           (write r0)
 772           (write "=0D")
 773           (end))
 774          ((write "=\r\n=")
 775           (write r0 ,ew-ccl-high-table)
 776           (write r0 ,ew-ccl-low-table)
 777           (write "=0D")
 778           (end)))
 779         ;; 13: r0:r3=RAW CR LF ;
 780         (end)
 781         ;; 14: r0:r3=ENC CR LF ;
 782         (end)
 783         ))
 784       )))
 785
 786 (define-ccl-program ew-ccl-decode-quoted-printable
 787   (eval-when-compile
 788     `(1
 789       ((read r0)
 790        (loop
 791         (branch
 792          r0
 793          ,@(mapcar
 794             (lambda (r0)
 795               (let ((tmp (aref ew-ccl-qp-table r0)))
 796                 (cond
 797                  ((or (eq tmp 'raw) (eq tmp 'wsp)) `(write-read-repeat r0))
 798                  ((eq r0 ?=)
 799                   ;; r0='='
 800                   `((read r0)
 801                     ;; '=' r0
 802                     (r1 = (r0 == ?\t))
 803                     (if ((r0 == ? ) | r1)
 804                         ;; '=' r0:[\t ]
 805                         ;; Skip transport-padding.
 806                         ;; It should check CR LF after
 807                         ;; transport-padding.
 808                         (loop
 809                          (read-if (r0 == ?\t)
 810                                   (repeat)
 811                                   (if (r0 == ? )
 812                                       (repeat)
 813                                     (break)))))
 814                     ;; '=' [\t ]* r0:[^\t ]
 815                     (branch
 816                      r0
 817                      ,@(mapcar
 818                         (lambda (r0)
 819                           (cond
 820                            ((eq r0 ?\r)
 821                             ;; '=' [\t ]* r0='\r'
 822                             `((read r0)
 823                               ;; '=' [\t ]* '\r' r0
 824                               (if (r0 == ?\n)
 825                                   ;; '=' [\t ]* '\r' r0='\n'
 826                                   ;; soft line break found.
 827                                   ((read r0)
 828                                    (repeat))
 829                                 ;; '=' [\t ]* '\r' r0:[^\n]
 830                                 ;; invalid input ->
 831                                 ;; output "=\r" and rescan from r0.
 832                                 ((write "=\r")
 833                                  (repeat)))))
 834                            ((setq tmp (nth r0 ew-ccl-256-to-16-table))
 835                             ;; '=' [\t ]* r0:[0-9A-F]
 836                             `(r0 = ,tmp))
 837                            (t
 838                             ;; '=' [\t ]* r0:[^\r0-9A-F]
 839                             ;; invalid input ->
 840                             ;; output "=" and rescan from r0.
 841                             `((write ?=)
 842                               (repeat)))))
 843                         ew-ccl-256-table))
 844                     ;; '=' [\t ]* r0:[0-9A-F]
 845                     (read-branch
 846                      r1
 847                      ,@(mapcar
 848                         (lambda (r1)
 849                           (if (setq tmp (nth r1 ew-ccl-256-to-16-table))
 850                               ;; '=' [\t ]* [0-9A-F] r1:[0-9A-F]
 851                               `(write-read-repeat
 852                                 r0
 853                                 ,(vconcat
 854                                   (mapcar
 855                                    (lambda (r0)
 856                                      (logior (lsh r0 4) tmp))
 857                                    ew-ccl-16-table)))
 858                             ;; '=' [\t ]* [0-9A-F] r1:[^0-9A-F]
 859                             ;; invalid input
 860                             `(r2 = 0)   ; nop
 861                             ))
 862                         ew-ccl-256-table))
 863                     ;; '=' [\t ]* [0-9A-F] r1:[^0-9A-F]
 864                     ;; invalid input
 865                     (write ?=)
 866                     (write r0 ,(vconcat ew-ccl-16-to-256-table))
 867                     (write r1)
 868                     (read r0)
 869                     (repeat)))
 870                  ((eq tmp 'cr)
 871                   ;; r0='\r'
 872                   `((read r0)
 873                     ;; '\r' r0
 874                     (if (r0 == ?\n)
 875                         ;; '\r' r0='\n'
 876                         ;; hard line break found.
 877                         ((write ?\r)
 878                          (write-read-repeat r0))
 879                       ;; '\r' r0:[^\n]
 880                       ;; invalid control character (bare CR) found.
 881                       ;; -> ignore it and rescan from r0.
 882                       (repeat))))
 883                  (t
 884                   ;; r0:[^\t\r -~]
 885                   ;; invalid character found.
 886                   ;; -> ignore.
 887                   `((read r0)
 888                     (repeat))))))
 889             ew-ccl-256-table)))))))
 890
 891 ;;;
 892
 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)
 896
 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)
 900
 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)
 904
 905 (ew-make-ccl-coding-system
 906  'ew-ccl-b ?B "MIME B-encoding"
 907  'ew-ccl-decode-b 'ew-ccl-encode-b)
 908
 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)
 912
 913 (ew-make-ccl-coding-system
 914  'ew-ccl-base64 ?B "MIME Base64-encoding"
 915  'ew-ccl-decode-b 'ew-ccl-encode-base64)
 916
 917 ;;;
 918 (require 'mel)
 919 (defvar ew-bq-use-mel nil)
 920
 921 (defun ew-encode-uq (str)
 922   (encode-coding-string (string-as-unibyte str) 'ew-ccl-uq))
 923
 924 (defun ew-encode-cq (str)
 925   (encode-coding-string (string-as-unibyte str) 'ew-ccl-cq))
 926
 927 (defun ew-encode-pq (str)
 928   (encode-coding-string (string-as-unibyte str) 'ew-ccl-pq))
 929
 930 (if ew-bq-use-mel
 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))))
 934
 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)))
 939
 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))))
 944
 945 '(
 946
 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")
 951
 952 (ew-decode-q "a_b=20c")
 953 (ew-decode-q "=92=A4=A2")
 954 (ew-decode-b "SWYgeW91IGNhbiByZWFkIHRoaXMgeW8=")
 955
 956 (let ((i 1000))
 957   (while (< 0 i)
 958     (setq i (1- i))
 959     (ew-decode-b
 960      "AB8gISIjJCUmJygpKissLS4vMDk6Ozw9Pj9AQVpbXF1eX2Bhent8fX5/gP8=")))
 961
 962 (let ((i 1000))
 963   (while (< 0 i)
 964     (setq i (1- i))
 965     (ew-decode-q
 966      "=00=1F_!=22#$%&'=28=29*+,-./09:;<=3D>=3F@AZ[=5C]^=5F`az{|}~=7F=80=FF")))
 967
 968 (require 'mel)
 969
 970 (let ((i 1000))
 971   (while (< 0 i)
 972     (setq i (1- i))
 973     (base64-decode-string
 974      "AB8gISIjJCUmJygpKissLS4vMDk6Ozw9Pj9AQVpbXF1eX2Bhent8fX5/gP8=")))
 975
 976 (let ((i 1000))
 977   (while (< 0 i)
 978     (setq i (1- i))
 979     (q-encoding-decode-string
 980      "=00=1F_!=22#$%&'=28=29*+,-./09:;<=3D>=3F@AZ[=5C]^=5F`az{|}~=7F=80=FF")))
 981
 982 (let (a b) ; CCL
 983   (setq a (current-time))
 984   (let ((i 1000))
 985     (while (< 0 i)
 986       (setq i (1- i))
 987       (ew-decode-b
 988        "AB8gISIjJCUmJygpKissLS4vMDk6Ozw9Pj9AQVpbXF1eX2Bhent8fX5/gP8=")))
 989   (setq b (current-time))
 990   (elp-elapsed-time a b))
 991
 992 (let (a b) ; Emacs Lisp
 993   (setq a (current-time))
 994   (let ((i 1000))
 995     (while (< 0 i)
 996       (setq i (1- i))
 997       (base64-decode-string
 998        "AB8gISIjJCUmJygpKissLS4vMDk6Ozw9Pj9AQVpbXF1eX2Bhent8fX5/gP8=")))
 999   (setq b (current-time))
1000   (elp-elapsed-time a b))
1001
1002 (let (a b) ; DL
1003   (setq a (current-time))
1004   (let ((i 1000))
1005     (while (< 0 i)
1006       (setq i (1- i))
1007       (decode-base64-string
1008        "AB8gISIjJCUmJygpKissLS4vMDk6Ozw9Pj9AQVpbXF1eX2Bhent8fX5/gP8=")))
1009   (setq b (current-time))
1010   (elp-elapsed-time a b))
1011
1012
1013 )