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 = 2)))
  27        status
  28        "")
  29       (aref status 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 (define-ccl-program ew-ccl-decode-base64
 271   (eval-when-compile
 272     `(1
 273       (loop
 274        (loop
 275         (read-branch
 276          r1
 277          ,@(mapcar
 278             (lambda (v)
 279               (cond
 280                ((or (eq v nil) (eq v t)) '(repeat))
 281                (t `((r0 = ,(lsh v 2)) (break)))))
 282             ew-ccl-256-to-64-table)))
 283        (loop
 284         (read-branch
 285          r1
 286          ,@(mapcar
 287             (lambda (v)
 288               (cond
 289                ((or (eq v nil) (eq v t)) '(repeat))
 290                ((= (lsh v -4) 0) `((write r0) (r0 = ,(lsh (logand v 15) 4)) (break)))
 291                (t `((write (r0 | ,(lsh v -4))) (r0 = ,(lsh (logand v 15) 4)) (break)))))
 292             ew-ccl-256-to-64-table)))
 293        (loop
 294         (read-branch
 295          r1
 296          ,@(mapcar
 297             (lambda (v)
 298               (cond
 299                ((eq v nil) '(repeat))
 300                ((eq v t) '(end))
 301                ((= (lsh v -2) 0) `((write r0) (r0 = ,(lsh (logand v 3) 6)) (break)))
 302                (t `((write (r0 | ,(lsh v -2))) (r0 = ,(lsh (logand v 3) 6)) (break)))))
 303             ew-ccl-256-to-64-table)))
 304        (loop
 305         (read-branch
 306          r1
 307          ,@(mapcar
 308             (lambda (v)
 309               (cond
 310                ((eq v nil) '(repeat))
 311                ((eq v t) '(end))
 312                (t `((write (r0 | ,v)) (break)))))
 313             ew-ccl-256-to-64-table)))
 314        (repeat)))))
 315
 316 ;; ew-ccl-encode-b works only 20.3 or later because CCL_EOF_BLOCK
 317 ;; is not executed on 20.2 (or former?).
 318 (define-ccl-program ew-ccl-encode-b
 319   (eval-when-compile
 320     `(2
 321       (loop
 322        (r2 = 0)
 323        (read-branch
 324         r1
 325         ,@(mapcar
 326            (lambda (r1)
 327              `((write ,(nth (lsh r1 -2) ew-ccl-64-to-256-table))
 328                (r0 = ,(logand r1 3))))
 329            ew-ccl-256-table))
 330        (r2 = 1)
 331        (read-branch
 332         r1
 333         ,@(mapcar
 334            (lambda (r1)
 335              `((write r0 ,(vconcat
 336                            (mapcar
 337                             (lambda (r0)
 338                               (nth (logior (lsh r0 4)
 339                                            (lsh r1 -4))
 340                                    ew-ccl-64-to-256-table))
 341                             ew-ccl-4-table)))
 342                (r0 = ,(logand r1 15))))
 343            ew-ccl-256-table))
 344        (r2 = 2)
 345        (read-branch
 346         r1
 347         ,@(mapcar
 348            (lambda (r1)
 349              `((write r0 ,(vconcat
 350                            (mapcar
 351                             (lambda (r0)
 352                               (nth (logior (lsh r0 2)
 353                                            (lsh r1 -6))
 354                                    ew-ccl-64-to-256-table))
 355                             ew-ccl-16-table)))))
 356            ew-ccl-256-table))
 357        (r1 &= 63)
 358        (write r1 ,(vconcat
 359                    (mapcar
 360                     (lambda (r1)
 361                       (nth r1 ew-ccl-64-to-256-table))
 362                     ew-ccl-64-table)))
 363        (repeat))
 364       (branch
 365        r2
 366        (end)
 367        ((write r0 ,(vconcat
 368                     (mapcar
 369                      (lambda (r0)
 370                        (nth (lsh r0 4) ew-ccl-64-to-256-table))
 371                      ew-ccl-4-table)))
 372         (write "=="))
 373        ((write r0 ,(vconcat
 374                     (mapcar
 375                      (lambda (r0)
 376                        (nth (lsh r0 2) ew-ccl-64-to-256-table))
 377                      ew-ccl-16-table)))
 378         (write ?=)))
 379       )))
 380
 381 ;;;
 382
 383 ;; ew-ccl-encode-base64 does not works on 20.2 by same reason of ew-ccl-encode-b
 384 (define-ccl-program ew-ccl-encode-base64
 385   (eval-when-compile
 386     `(2
 387       ((r3 = 0)
 388        (loop
 389         (r2 = 0)
 390         (read-branch
 391          r1
 392          ,@(mapcar
 393             (lambda (r1)
 394               `((write ,(nth (lsh r1 -2) ew-ccl-64-to-256-table))
 395                 (r0 = ,(logand r1 3))))
 396             ew-ccl-256-table))
 397         (r2 = 1)
 398         (read-branch
 399          r1
 400          ,@(mapcar
 401             (lambda (r1)
 402               `((write r0 ,(vconcat
 403                             (mapcar
 404                              (lambda (r0)
 405                                (nth (logior (lsh r0 4)
 406                                             (lsh r1 -4))
 407                                     ew-ccl-64-to-256-table))
 408                              ew-ccl-4-table)))
 409                 (r0 = ,(logand r1 15))))
 410             ew-ccl-256-table))
 411         (r2 = 2)
 412         (read-branch
 413          r1
 414          ,@(mapcar
 415             (lambda (r1)
 416               `((write r0 ,(vconcat
 417                             (mapcar
 418                              (lambda (r0)
 419                                (nth (logior (lsh r0 2)
 420                                             (lsh r1 -6))
 421                                     ew-ccl-64-to-256-table))
 422                              ew-ccl-16-table)))))
 423             ew-ccl-256-table))
 424         (r1 &= 63)
 425         (write r1 ,(vconcat
 426                     (mapcar
 427                      (lambda (r1)
 428                        (nth r1 ew-ccl-64-to-256-table))
 429                      ew-ccl-64-table)))
 430         (r3 += 1)
 431         (if (r3 == 19) ; 4 * 19 = 76 --> line break.
 432             ((write "\r\n")
 433              (r3 = 0)))
 434         (repeat)))
 435       (branch
 436        r2
 437        (if (r0 > 0) (write "\r\n"))
 438        ((write r0 ,(vconcat
 439                     (mapcar
 440                      (lambda (r0)
 441                        (nth (lsh r0 4) ew-ccl-64-to-256-table))
 442                      ew-ccl-4-table)))
 443         (write "==\r\n"))
 444        ((write r0 ,(vconcat
 445                     (mapcar
 446                      (lambda (r0)
 447                        (nth (lsh r0 2) ew-ccl-64-to-256-table))
 448                      ew-ccl-16-table)))
 449         (write "=\r\n")))
 450       )))
 451
 452 ;; ew-ccl-encode-quoted-printable does not works on 20.2 by same reason of ew-ccl-encode-b
 453 (define-ccl-program ew-ccl-encode-quoted-printable
 454   (eval-when-compile
 455     `(4
 456       ((r6 = 0) ; column
 457        (r5 = 0) ; previous character is white space
 458        (r4 = 0)
 459        (read r0)
 460        (loop ; r6 <= 75
 461         (loop
 462          (loop
 463           (branch
 464            r0
 465            ,@(mapcar
 466               (lambda (r0)
 467                 (let ((tmp (aref ew-ccl-qp-table r0)))
 468                   (cond
 469                    ((eq tmp 'raw) '((r3 = 0) (break))) ; RAW
 470                    ((eq tmp 'enc) '((r3 = 1) (break))) ; ENC
 471                    ((eq tmp 'wsp) '((r3 = 2) (break))) ; WSP
 472                    ((eq tmp 'cr) '((r3 = 3) (break))) ; CR
 473                    )))
 474               ew-ccl-256-table)))
 475          (branch
 476           r3
 477           ;; r0:r3=RAW
 478           (if (r6 < 75)
 479               ((r6 += 1)
 480                (r5 = 0)
 481                (r4 = 1)
 482                (write-read-repeat r0))
 483             (break))
 484           ;; r0:r3=ENC
 485           ((r5 = 0)
 486            (if (r6 < 73)
 487                ((r6 += 3)
 488                 (write "=")
 489                 (write r0 ,ew-ccl-high-table)
 490                 (r4 = 2)
 491                 (write-read-repeat r0 ,ew-ccl-low-table))
 492              (if (r6 > 73)
 493                  ((r6 = 3)
 494                   (write "=\r\n=")
 495                   (write r0 ,ew-ccl-high-table)
 496                   (r4 = 3)
 497                   (write-read-repeat r0 ,ew-ccl-low-table))
 498                (break))))
 499           ;; r0:r3=WSP
 500           ((r5 = 1)
 501            (if (r6 < 75)
 502                ((r6 += 1)
 503                 (r4 = 4)
 504                 (write-read-repeat r0))
 505              ((r6 = 1)
 506               (write "=\r\n")
 507               (r4 = 5)
 508               (write-read-repeat r0))))
 509           ;; r0:r3=CR
 510           ((if ((r6 > 73) & r5)
 511                ((r6 = 0)
 512                 (r5 = 0)
 513                 (write "=\r\n")))
 514            (break))))
 515         ;; r0:r3={RAW,ENC,CR}
 516         (loop
 517          (if (r0 == ?\r)
 518              ;; r0=\r:r3=CR
 519              ((r4 = 6)
 520               (read r0)
 521               ;; CR:r3=CR r0
 522               (if (r0 == ?\n)
 523                   ;; CR:r3=CR r0=LF
 524                   (if r5
 525                       ;; r5=WSP ; CR:r3=CR r0=LF
 526                       ((r6 = 0)
 527                        (r5 = 0)
 528                        (write "=\r\n\r\n")
 529                        (r4 = 7)
 530                        (read r0)
 531                        (break))
 532                     ;; r5=noWSP ; CR:r3=CR r0=LF
 533                     ((r6 = 0)
 534                      (r5 = 0)
 535                      (write "\r\n")
 536                      (r4 = 8)
 537                      (read r0)
 538                      (break)))
 539                 ;; CR:r3=CR r0=noLF
 540                 (if (r6 < 73)
 541                     ((r6 += 3)
 542                      (r5 = 0)
 543                      (write "=0D")
 544                      (break))
 545                   (if (r6 == 73)
 546                       (if (r0 == ?\r)
 547                           ;; CR:r3=CR r0=CR
 548                           ((r4 = 9)
 549                            (read r0)
 550                            ;; CR:r3=CR CR r0
 551                            (if (r0 == ?\n)
 552                                ;; CR:r3=CR CR LF
 553                                ((r6 = 0)
 554                                 (r5 = 0)
 555                                 (write "=0D\r\n")
 556                                 (r4 = 10)
 557                                 (read r0)
 558                                 (break))
 559                              ;; CR:r3=CR CR noLF
 560                              ((r6 = 6)
 561                               (r5 = 0)
 562                               (write "=\r\n=0D=0D")
 563                               (break))))
 564                         ;; CR:r3=CR r0=noLFnorCR
 565                         ((r6 = 3)
 566                          (r5 = 0)
 567                          (write "=\r\n=0D")
 568                          (break)))
 569                     ((r6 = 3)
 570                      (r5 = 0)
 571                      (write "=\r\n=0D")
 572                      (break))))))
 573            ;; r0:r3={RAW,ENC}
 574            ((r4 = 11)
 575             (read r1)
 576             ;; r0:r3={RAW,ENC} r1
 577             (if (r1 == ?\r)
 578                 ;; r0:r3={RAW,ENC} r1=CR
 579                 ((r4 = 12)
 580                  (read r1)
 581                  ;; r0:r3={RAW,ENC} CR r1
 582                  (if (r1 == ?\n)
 583                      ;; r0:r3={RAW,ENC} CR r1=LF
 584                      ((r6 = 0)
 585                       (r5 = 0)
 586                       (branch
 587                        r3
 588                        ;; r0:r3=RAW CR r1=LF
 589                        ((write r0)
 590                         (write "\r\n")
 591                         (r4 = 13)
 592                         (read r0)
 593                         (break))
 594                        ;; r0:r3=ENC CR r1=LF
 595                        ((write ?=)
 596                         (write r0 ,ew-ccl-high-table)
 597                         (write r0 ,ew-ccl-low-table)
 598                         (write "\r\n")
 599                         (r4 = 14)
 600                         (read r0)
 601                         (break))))
 602                    ;; r0:r3={RAW,ENC} CR r1=noLF
 603                    ((branch
 604                      r3
 605                      ;; r0:r3=RAW CR r1:noLF
 606                      ((r6 = 4)
 607                       (r5 = 0)
 608                       (write "=\r\n")
 609                       (write r0)
 610                       (write "=0D")
 611                       (r0 = r1)
 612                       (break))
 613                      ;; r0:r3=ENC CR r1:noLF
 614                      ((r6 = 6)
 615                       (r5 = 0)
 616                       (write "=\r\n=")
 617                       (write r0 ,ew-ccl-high-table)
 618                       (write r0 ,ew-ccl-low-table)
 619                       (write "=0D")
 620                       (r0 = r1)
 621                       (break))))
 622                    ))
 623               ;; r0:r3={RAW,ENC} r1:noCR
 624               ((branch
 625                 r3
 626                 ;; r0:r3=RAW r1:noCR
 627                 ((r6 = 1)
 628                  (r5 = 0)
 629                  (write "=\r\n")
 630                  (write r0)
 631                  (r0 = r1)
 632                  (break))
 633                 ;; r0:r3=ENC r1:noCR
 634                 ((r6 = 3)
 635                  (r5 = 0)
 636                  (write "=\r\n=")
 637                  (write r0 ,ew-ccl-high-table)
 638                  (write r0 ,ew-ccl-low-table)
 639                  (r0 = r1)
 640                  (break))))))))
 641         (repeat)))
 642       (;(write "[EOF:") (write r4 ,ew-ccl-high-table) (write r4 ,ew-ccl-low-table) (write "]")
 643        (branch
 644         r4
 645         ;; 0: (start) ;
 646         (end)
 647         ;; 1: RAW ;
 648         (end)
 649         ;; 2: r0:r3=ENC ;
 650         (end)
 651         ;; 3: SOFTBREAK r0:r3=ENC ;
 652         (end)
 653         ;; 4: r0:r3=WSP ;
 654         ((write "=\r\n") (end))
 655         ;; 5: SOFTBREAK r0:r3=WSP ;
 656         ((write "=\r\n") (end))
 657         ;; 6: ; r0=\r:r3=CR
 658         (if (r6 <= 73)
 659             ((write "=0D") (end))
 660            ((write "=\r\n=0D") (end)))
 661         ;; 7: r5=WSP SOFTBREAK CR:r3=CR r0=LF ;
 662         (end)
 663         ;; 8: r5=noWSP CR:r3=CR r0=LF ;
 664         (end)
 665         ;; 9: (r6=73) ; CR:r3=CR r0=CR
 666         ((write "=\r\n=0D=0D") (end))
 667         ;; 10: (r6=73) CR:r3=CR CR LF ;
 668         (end)
 669         ;; 11: ; r0:r3={RAW,ENC}
 670         (branch
 671          r3
 672          ((write r0) (end))
 673          ((write "=")
 674           (write r0 ,ew-ccl-high-table)
 675           (write r0 ,ew-ccl-low-table)
 676           (end)))
 677         ;; 12: ; r0:r3={RAW,ENC} r1=CR
 678         (branch
 679          r3
 680          ((write "=\r\n")
 681           (write r0)
 682           (write "=0D")
 683           (end))
 684          ((write "=\r\n=")
 685           (write r0 ,ew-ccl-high-table)
 686           (write r0 ,ew-ccl-low-table)
 687           (write "=0D")
 688           (end)))
 689         ;; 13: r0:r3=RAW CR LF ;
 690         (end)
 691         ;; 14: r0:r3=ENC CR LF ;
 692         (end)
 693         ))
 694       )))
 695
 696 (define-ccl-program ew-ccl-decode-quoted-printable
 697   (eval-when-compile
 698     `(1
 699       ((read r0)
 700        (loop
 701         (branch
 702          r0
 703          ,@(mapcar
 704             (lambda (r0)
 705               (let ((tmp (aref ew-ccl-qp-table r0)))
 706                 (cond
 707                  ((or (eq tmp 'raw) (eq tmp 'wsp)) `(write-read-repeat r0))
 708                  ((eq r0 ?=)
 709                   ;; r0='='
 710                   `((read r0)
 711                     ;; '=' r0
 712                     (r1 = (r0 == ?\t))
 713                     (if ((r0 == ? ) | r1)
 714                         ;; '=' r0:[\t ]
 715                         ;; Skip transport-padding.
 716                         ;; It should check CR LF after
 717                         ;; transport-padding.
 718                         (loop
 719                          (read-if (r0 == ?\t)
 720                                   (repeat)
 721                                   (if (r0 == ? )
 722                                       (repeat)
 723                                     (break)))))
 724                     ;; '=' [\t ]* r0:[^\t ]
 725                     (branch
 726                      r0
 727                      ,@(mapcar
 728                         (lambda (r0)
 729                           (cond
 730                            ((eq r0 ?\r)
 731                             ;; '=' [\t ]* r0='\r'
 732                             `((read r0)
 733                               ;; '=' [\t ]* '\r' r0
 734                               (if (r0 == ?\n)
 735                                   ;; '=' [\t ]* '\r' r0='\n'
 736                                   ;; soft line break found.
 737                                   ((read r0)
 738                                    (repeat))
 739                                 ;; '=' [\t ]* '\r' r0:[^\n]
 740                                 ;; invalid input ->
 741                                 ;; output "=\r" and rescan from r0.
 742                                 ((write "=\r")
 743                                  (repeat)))))
 744                            ((setq tmp (nth r0 ew-ccl-256-to-16-table))
 745                             ;; '=' [\t ]* r0:[0-9A-F]
 746                             `(r0 = ,tmp))
 747                            (t
 748                             ;; '=' [\t ]* r0:[^\r0-9A-F]
 749                             ;; invalid input ->
 750                             ;; output "=" and rescan from r0.
 751                             `((write ?=)
 752                               (repeat)))))
 753                         ew-ccl-256-table))
 754                     ;; '=' [\t ]* r0:[0-9A-F]
 755                     (read-branch
 756                      r1
 757                      ,@(mapcar
 758                         (lambda (r1)
 759                           (if (setq tmp (nth r1 ew-ccl-256-to-16-table))
 760                               ;; '=' [\t ]* [0-9A-F] r1:[0-9A-F]
 761                               `(write-read-repeat
 762                                 r0
 763                                 ,(vconcat
 764                                   (mapcar
 765                                    (lambda (r0)
 766                                      (logior (lsh r0 4) tmp))
 767                                    ew-ccl-16-table)))
 768                             ;; '=' [\t ]* [0-9A-F] r1:[^0-9A-F]
 769                             ;; invalid input
 770                             `(r2 = 0)   ; nop
 771                             ))
 772                         ew-ccl-256-table))
 773                     ;; '=' [\t ]* [0-9A-F] r1:[^0-9A-F]
 774                     ;; invalid input
 775                     (write ?=)
 776                     (write r0 ,(vconcat ew-ccl-16-to-256-table))
 777                     (write r1)
 778                     (read r0)
 779                     (repeat)))
 780                  ((eq tmp 'cr)
 781                   ;; r0='\r'
 782                   `((read r0)
 783                     ;; '\r' r0
 784                     (if (r0 == ?\n)
 785                         ;; '\r' r0='\n'
 786                         ;; hard line break found.
 787                         ((write ?\r)
 788                          (write-read-repeat r0))
 789                       ;; '\r' r0:[^\n]
 790                       ;; invalid control character (bare CR) found.
 791                       ;; -> ignore it and rescan from r0.
 792                       (repeat))))
 793                  (t
 794                   ;; r0:[^\t\r -~]
 795                   ;; invalid character found.
 796                   ;; -> ignore.
 797                   `((read r0)
 798                     (repeat))))))
 799             ew-ccl-256-table)))))))
 800
 801 ;;;
 802
 803 (ew-make-ccl-coding-system
 804  'ew-ccl-uq ?Q "MIME Q-encoding in unstructured field"
 805  'ew-ccl-decode-q 'ew-ccl-encode-uq)
 806
 807 (ew-make-ccl-coding-system
 808  'ew-ccl-cq ?Q "MIME Q-encoding in comment"
 809  'ew-ccl-decode-q 'ew-ccl-encode-cq)
 810
 811 (ew-make-ccl-coding-system
 812  'ew-ccl-pq ?Q "MIME Q-encoding in phrase"
 813  'ew-ccl-decode-q 'ew-ccl-encode-pq)
 814
 815 (ew-make-ccl-coding-system
 816  'ew-ccl-b ?B "MIME B-encoding"
 817  'ew-ccl-decode-base64 'ew-ccl-encode-b)
 818
 819 (ew-make-ccl-coding-system
 820  'ew-ccl-quoted-printable ?Q "MIME Quoted-Printable-encoding"
 821  'ew-ccl-decode-quoted-printable 'ew-ccl-encode-quoted-printable)
 822
 823 (ew-make-ccl-coding-system
 824  'ew-ccl-base64 ?B "MIME Base64-encoding"
 825  'ew-ccl-decode-base64 'ew-ccl-encode-base64)
 826
 827 ;;;
 828 (require 'mel)
 829 (defvar ew-bq-use-mel nil)
 830
 831 (defun ew-encode-uq (str)
 832   (encode-coding-string (string-as-unibyte str) 'ew-ccl-uq))
 833
 834 (defun ew-encode-cq (str)
 835   (encode-coding-string (string-as-unibyte str) 'ew-ccl-cq))
 836
 837 (defun ew-encode-pq (str)
 838   (encode-coding-string (string-as-unibyte str) 'ew-ccl-pq))
 839
 840 (if ew-bq-use-mel
 841     (defalias 'ew-decode-q 'q-encoding-decode-string)
 842   (defun ew-decode-q (str)
 843     (string-as-unibyte (decode-coding-string str 'ew-ccl-uq))))
 844
 845 (if (or ew-bq-use-mel base64-dl-module ew-ccl-untrusted-eof-block)
 846     (defalias 'ew-encode-b 'base64-encode-string)
 847   (defun ew-encode-b (str)
 848     (encode-coding-string (string-as-unibyte str) 'ew-ccl-b)))
 849
 850 (if (or ew-bq-use-mel base64-dl-module)
 851     (defalias 'ew-decode-b 'base64-decode-string)
 852   (defun ew-decode-b (str)
 853     (string-as-unibyte (decode-coding-string str 'ew-ccl-b))))
 854
 855 '(
 856
 857 (ew-encode-uq "\000\037 !\"#$%&'()*+,-./09:;<=>?@AZ[\\]^_`az{|}~\177\200\377")
 858 (ew-encode-cq "\000\037 !\"#$%&'()*+,-./09:;<=>?@AZ[\\]^_`az{|}~\177\200\377")
 859 (ew-encode-pq "\000\037 !\"#$%&'()*+,-./09:;<=>?@AZ[\\]^_`az{|}~\177\200\377")
 860 (ew-encode-b "\000\037 !\"#$%&'()*+,-./09:;<=>?@AZ[\\]^_`az{|}~\177\200\377")
 861
 862 (ew-decode-q "a_b=20c")
 863 (ew-decode-q "=92=A4=A2")
 864 (ew-decode-b "SWYgeW91IGNhbiByZWFkIHRoaXMgeW8=")
 865
 866 (let ((i 1000))
 867   (while (< 0 i)
 868     (setq i (1- i))
 869     (ew-decode-b
 870      "AB8gISIjJCUmJygpKissLS4vMDk6Ozw9Pj9AQVpbXF1eX2Bhent8fX5/gP8=")))
 871
 872 (let ((i 1000))
 873   (while (< 0 i)
 874     (setq i (1- i))
 875     (ew-decode-q
 876      "=00=1F_!=22#$%&'=28=29*+,-./09:;<=3D>=3F@AZ[=5C]^=5F`az{|}~=7F=80=FF")))
 877
 878 (require 'mel)
 879
 880 (let ((i 1000))
 881   (while (< 0 i)
 882     (setq i (1- i))
 883     (base64-decode-string
 884      "AB8gISIjJCUmJygpKissLS4vMDk6Ozw9Pj9AQVpbXF1eX2Bhent8fX5/gP8=")))
 885
 886 (let ((i 1000))
 887   (while (< 0 i)
 888     (setq i (1- i))
 889     (q-encoding-decode-string
 890      "=00=1F_!=22#$%&'=28=29*+,-./09:;<=3D>=3F@AZ[=5C]^=5F`az{|}~=7F=80=FF")))
 891 )