mel-ccl.el

   1 (require 'ccl)
   2 (require 'emu)
   3
   4
   5 ;;; @ constants
   6 ;;;
   7
   8 (eval-when-compile
   9
  10 (defconst mel-ccl-4-table
  11   '(  0   1   2   3))
  12
  13 (defconst mel-ccl-16-table
  14   '(  0   1   2   3   4   5   6   7   8   9  10  11  12  13  14  15))
  15
  16 (defconst mel-ccl-28-table
  17   '(  0   1   2   3   4   5   6   7   8   9  10  11  12  13  14  15
  18      16  17  18  19  20  21  22  23  24  25  26  27))
  19
  20 (defconst mel-ccl-64-table
  21   '(  0   1   2   3   4   5   6   7   8   9  10  11  12  13  14  15
  22      16  17  18  19  20  21  22  23  24  25  26  27  28  29  30  31
  23      32  33  34  35  36  37  38  39  40  41  42  43  44  45  46  47
  24      48  49  50  51  52  53  54  55  56  57  58  59  60  61  62  63))
  25
  26 (defconst mel-ccl-256-table
  27   '(  0   1   2   3   4   5   6   7   8   9  10  11  12  13  14  15
  28      16  17  18  19  20  21  22  23  24  25  26  27  28  29  30  31
  29      32  33  34  35  36  37  38  39  40  41  42  43  44  45  46  47
  30      48  49  50  51  52  53  54  55  56  57  58  59  60  61  62  63
  31      64  65  66  67  68  69  70  71  72  73  74  75  76  77  78  79
  32      80  81  82  83  84  85  86  87  88  89  90  91  92  93  94  95
  33      96  97  98  99 100 101 102 103 104 105 106 107 108 109 110 111
  34     112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127
  35     128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143
  36     144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159
  37     160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175
  38     176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191
  39     192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207
  40     208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223
  41     224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239
  42     240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255))
  43
  44 (defconst mel-ccl-256-to-16-table
  45   '(nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
  46     nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
  47     nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
  48       0   1   2   3   4   5   6   7   8   9 nil nil nil nil nil nil
  49     nil  10  11  12  13  14  15 nil nil nil nil nil nil nil nil nil
  50     nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
  51     nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
  52     nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
  53     nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
  54     nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
  55     nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
  56     nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
  57     nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
  58     nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
  59     nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
  60     nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil))
  61
  62 (defconst mel-ccl-16-to-256-table
  63   (mapcar 'char-int "0123456789ABCDEF"))
  64
  65 (defconst mel-ccl-high-table
  66   (vconcat
  67    (mapcar
  68     (lambda (v) (nth (lsh v -4) mel-ccl-16-to-256-table))
  69     mel-ccl-256-table)))
  70
  71 (defconst mel-ccl-low-table
  72   (vconcat
  73    (mapcar
  74     (lambda (v) (nth (logand v 15) mel-ccl-16-to-256-table))
  75     mel-ccl-256-table)))
  76
  77 (defconst mel-ccl-u-raw
  78   (mapcar
  79    'char-int
  80    "0123456789\
  81 ABCDEFGHIJKLMNOPQRSTUVWXYZ\
  82 abcdefghijklmnopqrstuvwxyz\
  83 !@#$%&'()*+,-./:;<>@[\\]^`{|}~"))
  84
  85 (defconst mel-ccl-c-raw
  86   (mapcar
  87    'char-int
  88    "0123456789\
  89 ABCDEFGHIJKLMNOPQRSTUVWXYZ\
  90 abcdefghijklmnopqrstuvwxyz\
  91 !@#$%&'*+,-./:;<>@[]^`{|}~"))
  92
  93 (defconst mel-ccl-p-raw
  94   (mapcar
  95    'char-int
  96    "0123456789\
  97 ABCDEFGHIJKLMNOPQRSTUVWXYZ\
  98 abcdefghijklmnopqrstuvwxyz\
  99 !*+-/"))
 100
 101 (defconst mel-ccl-256-to-64-table
 102   '(nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
 103     nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
 104     nil nil nil nil nil nil nil nil nil nil nil  62 nil nil nil  63
 105      52  53  54  55  56  57  58  59  60  61 nil nil nil   t nil nil
 106     nil   0   1   2   3   4   5   6   7   8   9  10  11  12  13  14
 107      15  16  17  18  19  20  21  22  23  24  25 nil nil nil nil nil
 108     nil  26  27  28  29  30  31  32  33  34  35  36  37  38  39  40
 109      41  42  43  44  45  46  47  48  49  50  51 nil nil nil nil nil
 110     nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
 111     nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
 112     nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
 113     nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
 114     nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
 115     nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
 116     nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
 117     nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil))
 118
 119 (defconst mel-ccl-64-to-256-table
 120   (mapcar
 121    'char-int
 122    "ABCDEFGHIJKLMNOPQRSTUVWXYZ\
 123 abcdefghijklmnopqrstuvwxyz\
 124 0123456789\
 125 +/"))
 126
 127 (defconst mel-ccl-qp-table
 128   [enc enc enc enc enc enc enc enc enc wsp lf  enc enc cr  enc enc
 129    enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc
 130    wsp raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw
 131    raw raw raw raw raw raw raw raw raw raw raw raw raw enc raw raw
 132    raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw
 133    raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw
 134    raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw
 135    raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw enc
 136    enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc
 137    enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc
 138    enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc
 139    enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc
 140    enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc
 141    enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc
 142    enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc
 143    enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc])
 144
 145 )
 146
 147
 148 ;;; @ CCL programs
 149 ;;;
 150
 151 ;;; Q
 152
 153 (define-ccl-program mel-ccl-decode-q
 154   `(1
 155     ((loop
 156       (read-branch
 157        r0
 158        ,@(mapcar
 159           (lambda (r0)
 160             (cond
 161              ((= r0 (char-int ?_))
 162               `(write-repeat ? ))
 163              ((= r0 (char-int ?=))
 164               `((loop
 165                  (read-branch
 166                   r1
 167                   ,@(mapcar
 168                      (lambda (v)
 169                        (if (integerp v)
 170                            `((r0 = ,v) (break))
 171                          '(repeat)))
 172                      mel-ccl-256-to-16-table)))
 173                 (loop
 174                  (read-branch
 175                   r1
 176                   ,@(mapcar
 177                      (lambda (v)
 178                        (if (integerp v)
 179                            `((write r0 ,(vconcat
 180                                          (mapcar
 181                                           (lambda (r0)
 182                                             (logior (lsh r0 4) v))
 183                                           mel-ccl-16-table)))
 184                              (break))
 185                          '(repeat)))
 186                      mel-ccl-256-to-16-table)))
 187                 (repeat)))
 188              (t
 189               `(write-repeat ,r0))))
 190           mel-ccl-256-table))))))
 191
 192 (define-ccl-program mel-ccl-encode-uq
 193   `(3
 194     (loop
 195      (loop
 196       (read-branch
 197        r0
 198        ,@(mapcar
 199           (lambda (r0)
 200             (cond
 201              ((= r0 32) `(write-repeat ?_))
 202              ((member r0 mel-ccl-u-raw) `(write-repeat ,r0))
 203              (t '(break))))
 204           mel-ccl-256-table)))
 205      (write ?=)
 206      (write r0 ,mel-ccl-high-table)
 207      (write r0 ,mel-ccl-low-table)
 208      (repeat))))
 209
 210 (define-ccl-program mel-ccl-encode-cq
 211   `(3
 212     (loop
 213      (loop
 214       (read-branch
 215        r0
 216        ,@(mapcar
 217           (lambda (r0)
 218             (cond
 219              ((= r0 32) `(write-repeat ?_))
 220              ((member r0 mel-ccl-c-raw) `(write-repeat ,r0))
 221              (t '(break))))
 222           mel-ccl-256-table)))
 223      (write ?=)
 224      (write r0 ,mel-ccl-high-table)
 225      (write r0 ,mel-ccl-low-table)
 226      (repeat))))
 227
 228 (define-ccl-program mel-ccl-encode-pq
 229   `(3
 230     (loop
 231      (loop
 232       (read-branch
 233        r0
 234        ,@(mapcar
 235           (lambda (r0)
 236             (cond
 237              ((= r0 32) `(write-repeat ?_))
 238              ((member r0 mel-ccl-p-raw) `(write-repeat ,r0))
 239              (t '(break))))
 240           mel-ccl-256-table)))
 241      (write ?=)
 242      (write r0 ,mel-ccl-high-table)
 243      (write r0 ,mel-ccl-low-table)
 244      (repeat))))
 245
 246 ;;; B/Base64
 247
 248 (eval-when-compile
 249 (defun mel-ccl-decode-b-bit-ex (v)
 250   (logior
 251    (lsh (logand v (lsh 255 16)) -16)
 252    (logand v (lsh 255 8))
 253    (lsh (logand v 255) 16)))
 254
 255 (defconst mel-ccl-decode-b-0-table
 256   (vconcat
 257    (mapcar
 258     (lambda (v)
 259       (if (integerp v)
 260           (mel-ccl-decode-b-bit-ex (lsh v 18))
 261         (lsh 1 24)))
 262     mel-ccl-256-to-64-table)))
 263
 264 (defconst mel-ccl-decode-b-1-table
 265   (vconcat
 266    (mapcar
 267     (lambda (v)
 268       (if (integerp v)
 269           (mel-ccl-decode-b-bit-ex (lsh v 12))
 270         (lsh 1 25)))
 271     mel-ccl-256-to-64-table)))
 272
 273 (defconst mel-ccl-decode-b-2-table
 274   (vconcat
 275    (mapcar
 276     (lambda (v)
 277       (if (integerp v)
 278           (mel-ccl-decode-b-bit-ex (lsh v 6))
 279         (lsh 1 26)))
 280     mel-ccl-256-to-64-table)))
 281
 282 (defconst mel-ccl-decode-b-3-table
 283   (vconcat
 284    (mapcar
 285     (lambda (v)
 286       (if (integerp v)
 287           (mel-ccl-decode-b-bit-ex v)
 288         (lsh 1 27)))
 289     mel-ccl-256-to-64-table)))
 290
 291 )
 292
 293 (define-ccl-program mel-ccl-decode-b
 294   `(1
 295     (loop
 296      (read r0 r1 r2 r3)
 297      (r4 = r0 ,mel-ccl-decode-b-0-table)
 298      (r5 = r1 ,mel-ccl-decode-b-1-table)
 299      (r4 |= r5)
 300      (r5 = r2 ,mel-ccl-decode-b-2-table)
 301      (r4 |= r5)
 302      (r5 = r3 ,mel-ccl-decode-b-3-table)
 303      (r4 |= r5)
 304      (if (r4 & ,(lognot (1- (lsh 1 24))))
 305          ((loop
 306            (if (r4 & ,(lsh 1 24))
 307                ((r0 = r1) (r1 = r2) (r2 = r3) (read r3)
 308                 (r4 >>= 1) (r4 &= ,(logior (lsh 7 24)))
 309                 (r5 = r3 ,mel-ccl-decode-b-3-table)
 310                 (r4 |= r5)
 311                 (repeat))
 312              (break)))
 313           (loop
 314            (if (r4 & ,(lsh 1 25))
 315                ((r1 = r2) (r2 = r3) (read r3)
 316                 (r4 >>= 1) (r4 &= ,(logior (lsh 7 24)))
 317                 (r5 = r3 ,mel-ccl-decode-b-3-table)
 318                 (r4 |= r5)
 319                 (repeat))
 320              (break)))
 321           (loop
 322            (if (r2 != ?=)
 323                (if (r4 & ,(lsh 1 26))
 324                    ((r2 = r3) (read r3)
 325                     (r4 >>= 1) (r4 &= ,(logior (lsh 7 24)))
 326                     (r5 = r3 ,mel-ccl-decode-b-3-table)
 327                     (r4 |= r5)
 328                     (repeat))
 329                  ((r6 = 0)
 330                   (break)))
 331              ((r6 = 1)
 332               (break))))
 333           (loop
 334            (if (r3 != ?=)
 335                (if (r4 & ,(lsh 1 27))
 336                    ((read r3)
 337                     (r4 = r3 ,mel-ccl-decode-b-3-table)
 338                     (repeat))
 339                  (break))
 340              ((r6 |= 2)
 341               (break))))
 342           (r4 = r0 ,mel-ccl-decode-b-0-table)
 343           (r5 = r1 ,mel-ccl-decode-b-1-table)
 344           (r4 |= r5)
 345           (branch
 346            r6
 347            ;; BBBB
 348            ((r5 = r2 ,mel-ccl-decode-b-2-table)
 349             (r4 |= r5)
 350             (r5 = r3 ,mel-ccl-decode-b-3-table)
 351             (r4 |= r5)
 352             (r4 >8= 0)
 353             (write r7)
 354             (r4 >8= 0)
 355             (write r7)
 356             (write-repeat r4))
 357            ;; error: BB=B
 358            ((write r4)
 359             (end))
 360            ;; BBB=
 361            ((r5 = r2 ,mel-ccl-decode-b-2-table)
 362             (r4 |= r5)
 363             (r4 >8= 0)
 364             (write r7)
 365             (write r4)
 366             (end))
 367            ;; BB==
 368            ((write r4)
 369             (end))))
 370        ((r4 >8= 0)
 371         (write r7)
 372         (r4 >8= 0)
 373         (write r7)
 374         (write-repeat r4))))))
 375
 376 ;;; B
 377
 378 ;; mel-ccl-encode-b works only 20.3 or later because CCL_EOF_BLOCK
 379 ;; is not executed on 20.2 (or former?).
 380 (define-ccl-program mel-ccl-encode-b
 381   `(2
 382     (loop
 383      (r2 = 0)
 384      (read-branch
 385       r1
 386       ,@(mapcar
 387          (lambda (r1)
 388            `((write ,(nth (lsh r1 -2) mel-ccl-64-to-256-table))
 389              (r0 = ,(logand r1 3))))
 390          mel-ccl-256-table))
 391      (r2 = 1)
 392      (read-branch
 393       r1
 394       ,@(mapcar
 395          (lambda (r1)
 396            `((write r0 ,(vconcat
 397                          (mapcar
 398                           (lambda (r0)
 399                             (nth (logior (lsh r0 4)
 400                                          (lsh r1 -4))
 401                                  mel-ccl-64-to-256-table))
 402                           mel-ccl-4-table)))
 403              (r0 = ,(logand r1 15))))
 404          mel-ccl-256-table))
 405      (r2 = 2)
 406      (read-branch
 407       r1
 408       ,@(mapcar
 409          (lambda (r1)
 410            `((write r0 ,(vconcat
 411                          (mapcar
 412                           (lambda (r0)
 413                             (nth (logior (lsh r0 2)
 414                                          (lsh r1 -6))
 415                                  mel-ccl-64-to-256-table))
 416                           mel-ccl-16-table)))))
 417          mel-ccl-256-table))
 418      (r1 &= 63)
 419      (write r1 ,(vconcat
 420                  (mapcar
 421                   (lambda (r1)
 422                     (nth r1 mel-ccl-64-to-256-table))
 423                   mel-ccl-64-table)))
 424      (repeat))
 425     (branch
 426      r2
 427      (end)
 428      ((write r0 ,(vconcat
 429                   (mapcar
 430                    (lambda (r0)
 431                      (nth (lsh r0 4) mel-ccl-64-to-256-table))
 432                    mel-ccl-4-table)))
 433       (write "=="))
 434      ((write r0 ,(vconcat
 435                   (mapcar
 436                    (lambda (r0)
 437                      (nth (lsh r0 2) mel-ccl-64-to-256-table))
 438                    mel-ccl-16-table)))
 439       (write ?=)))
 440     ))
 441
 442 ;;; Base64
 443
 444 ;; mel-ccl-encode-base64 does not works on 20.2 by same reason of mel-ccl-encode-b
 445 (define-ccl-program mel-ccl-encode-base64-crlf-crlf
 446   `(2
 447     ((r3 = 0)
 448      (loop
 449       (r2 = 0)
 450       (read-branch
 451        r1
 452        ,@(mapcar
 453           (lambda (r1)
 454             `((write ,(nth (lsh r1 -2) mel-ccl-64-to-256-table))
 455               (r0 = ,(logand r1 3))))
 456           mel-ccl-256-table))
 457       (r2 = 1)
 458       (read-branch
 459        r1
 460        ,@(mapcar
 461           (lambda (r1)
 462             `((write r0 ,(vconcat
 463                           (mapcar
 464                            (lambda (r0)
 465                              (nth (logior (lsh r0 4)
 466                                           (lsh r1 -4))
 467                                   mel-ccl-64-to-256-table))
 468                            mel-ccl-4-table)))
 469               (r0 = ,(logand r1 15))))
 470           mel-ccl-256-table))
 471       (r2 = 2)
 472       (read-branch
 473        r1
 474        ,@(mapcar
 475           (lambda (r1)
 476             `((write r0 ,(vconcat
 477                           (mapcar
 478                            (lambda (r0)
 479                              (nth (logior (lsh r0 2)
 480                                           (lsh r1 -6))
 481                                   mel-ccl-64-to-256-table))
 482                            mel-ccl-16-table)))))
 483           mel-ccl-256-table))
 484       (r1 &= 63)
 485       (write r1 ,(vconcat
 486                   (mapcar
 487                    (lambda (r1)
 488                      (nth r1 mel-ccl-64-to-256-table))
 489                    mel-ccl-64-table)))
 490       (r3 += 1)
 491       (if (r3 == 19) ; 4 * 19 = 76 --> line break.
 492           ((write "\r\n")
 493            (r3 = 0)))
 494       (repeat)))
 495     (branch
 496      r2
 497      (if (r0 > 0) (write "\r\n"))
 498      ((write r0 ,(vconcat
 499                   (mapcar
 500                    (lambda (r0)
 501                      (nth (lsh r0 4) mel-ccl-64-to-256-table))
 502                    mel-ccl-4-table)))
 503       (write "==\r\n"))
 504      ((write r0 ,(vconcat
 505                   (mapcar
 506                    (lambda (r0)
 507                      (nth (lsh r0 2) mel-ccl-64-to-256-table))
 508                    mel-ccl-16-table)))
 509       (write "=\r\n")))
 510     ))
 511
 512 ;; produce newline as LF instead of CRLF.
 513 (define-ccl-program mel-ccl-encode-base64-crlf-lf
 514   `(2
 515     ((r3 = 0)
 516      (loop
 517       (r2 = 0)
 518       (read-branch
 519        r1
 520        ,@(mapcar
 521           (lambda (r1)
 522             `((write ,(nth (lsh r1 -2) mel-ccl-64-to-256-table))
 523               (r0 = ,(logand r1 3))))
 524           mel-ccl-256-table))
 525       (r2 = 1)
 526       (read-branch
 527        r1
 528        ,@(mapcar
 529           (lambda (r1)
 530             `((write r0 ,(vconcat
 531                           (mapcar
 532                            (lambda (r0)
 533                              (nth (logior (lsh r0 4)
 534                                           (lsh r1 -4))
 535                                   mel-ccl-64-to-256-table))
 536                            mel-ccl-4-table)))
 537               (r0 = ,(logand r1 15))))
 538           mel-ccl-256-table))
 539       (r2 = 2)
 540       (read-branch
 541        r1
 542        ,@(mapcar
 543           (lambda (r1)
 544             `((write r0 ,(vconcat
 545                           (mapcar
 546                            (lambda (r0)
 547                              (nth (logior (lsh r0 2)
 548                                           (lsh r1 -6))
 549                                   mel-ccl-64-to-256-table))
 550                            mel-ccl-16-table)))))
 551           mel-ccl-256-table))
 552       (r1 &= 63)
 553       (write r1 ,(vconcat
 554                   (mapcar
 555                    (lambda (r1)
 556                      (nth r1 mel-ccl-64-to-256-table))
 557                    mel-ccl-64-table)))
 558       (r3 += 1)
 559       (if (r3 == 19) ; 4 * 19 = 76 --> line break.
 560           ((write "\n")
 561            (r3 = 0)))
 562       (repeat)))
 563     (branch
 564      r2
 565      (if (r0 > 0) (write "\n"))
 566      ((write r0 ,(vconcat
 567                   (mapcar
 568                    (lambda (r0)
 569                      (nth (lsh r0 4) mel-ccl-64-to-256-table))
 570                    mel-ccl-4-table)))
 571       (write "==\n"))
 572      ((write r0 ,(vconcat
 573                   (mapcar
 574                    (lambda (r0)
 575                      (nth (lsh r0 2) mel-ccl-64-to-256-table))
 576                    mel-ccl-16-table)))
 577       (write "=\n")))
 578     ))
 579
 580 ;; Quoted-Printable
 581
 582 (eval-when-compile
 583
 584 ;; mel-ccl-encode-quoted-printable does not works on 20.2 by same reason of mel-ccl-encode-b
 585 (defun mel-ccl-encode-quoted-printable-generic (input-crlf output-crlf)
 586   `(4
 587     ((r6 = 0)                           ; column
 588      (r5 = 0)                           ; previous character is white space
 589      (r4 = 0)
 590      (read r0)
 591      (loop                              ; r6 <= 75
 592       (loop
 593        (loop
 594         (branch
 595          r0
 596          ,@(mapcar
 597             (lambda (r0)
 598               (let ((tmp (aref mel-ccl-qp-table r0)))
 599                 (cond
 600                  ((eq tmp 'raw) '((r3 = 0) (break))) ; RAW
 601                  ((eq tmp 'enc) '((r3 = 1) (break))) ; ENC
 602                  ((eq tmp 'wsp) '((r3 = 2) (break))) ; WSP
 603                  ((eq tmp 'cr) (if input-crlf
 604                                    '((r3 = 3) (break)) ; CR
 605                                  '((r3 = 1) (break)))) ; ENC
 606                  ((eq tmp 'lf) (if input-crlf
 607                                    '((r3 = 1) (break)) ; ENC
 608                                  '((r3 = 3) (break)))) ; CRLF
 609                  )))
 610             mel-ccl-256-table)))
 611        (branch
 612         r3
 613         ;; r0:r3=RAW
 614         (if (r6 < 75)
 615             ((r6 += 1)
 616              (r5 = 0)
 617              (r4 = 1)
 618              (write-read-repeat r0))
 619           (break))
 620         ;; r0:r3=ENC
 621         ((r5 = 0)
 622          (if (r6 < 73)
 623              ((r6 += 3)
 624               (write "=")
 625               (write r0 ,mel-ccl-high-table)
 626               (r4 = 2)
 627               (write-read-repeat r0 ,mel-ccl-low-table))
 628            (if (r6 > 73)
 629                ((r6 = 3)
 630                 (write ,(if output-crlf "=\r\n=" "=\n="))
 631                 (write r0 ,mel-ccl-high-table)
 632                 (r4 = 3)
 633                 (write-read-repeat r0 ,mel-ccl-low-table))
 634              (break))))
 635         ;; r0:r3=WSP
 636         ((r5 = 1)
 637          (if (r6 < 75)
 638              ((r6 += 1)
 639               (r4 = 4)
 640               (write-read-repeat r0))
 641            ((r6 = 1)
 642             (write ,(if output-crlf "=\r\n" "=\n"))
 643             (r4 = 5)
 644             (write-read-repeat r0))))
 645         ;; r0:r3=CR/CRLF
 646         ,(if input-crlf
 647              ;; r0:r3=CR
 648              `((if ((r6 > 73) & r5)
 649                    ((r6 = 0)
 650                     (r5 = 0)
 651                     (write ,(if output-crlf "=\r\n" "=\n"))))
 652                (break))
 653            ;; r0:r3=CRLF
 654            `(if r5
 655                 ;; WSP ; r0:r3=CRLF
 656                 ((r5 = 0)
 657                  (r6 = 0)
 658                  (write ,(if output-crlf "=\r\n" "=\n"))
 659                  ,@(if output-crlf '((write ?\r)) '())
 660                  (write-read-repeat r0))
 661               ;; noWSP ; r0:r3=CRLF
 662               ((r5 = 0)
 663                (r6 = 0)
 664                ,@(if output-crlf '((write ?\r)) '())
 665                (write-read-repeat r0)))
 666            )))
 667       ;; r0:r3={RAW,ENC,CR}
 668       (loop
 669        ,(funcall
 670          (lambda (after-cr after-raw-enc)
 671            (if input-crlf
 672                `(if (r0 == ?\r)
 673                     ,after-cr
 674                   ,after-raw-enc)
 675              after-raw-enc))
 676          ;; r0=\r:r3=CR
 677          `((r4 = 6)
 678            (read r0)
 679            ;; CR:r3=CR r0
 680            (if (r0 == ?\n)
 681                ;; CR:r3=CR r0=LF
 682                (if r5
 683                    ;; r5=WSP ; CR:r3=CR r0=LF
 684                    ((r6 = 0)
 685                     (r5 = 0)
 686                     (write ,(if output-crlf "=\r\n\r\n" "=\n\n"))
 687                     (r4 = 7)
 688                     (read r0)
 689                     (break))
 690                  ;; r5=noWSP ; CR:r3=CR r0=LF
 691                  ((r6 = 0)
 692                   (r5 = 0)
 693                   (write ,(if output-crlf "\r\n" "\n"))
 694                   (r4 = 8)
 695                   (read r0)
 696                   (break)))
 697              ;; CR:r3=CR r0=noLF
 698              (if (r6 < 73)
 699                  ((r6 += 3)
 700                   (r5 = 0)
 701                   (write "=0D")
 702                   (break))
 703                (if (r6 == 73)
 704                    (if (r0 == ?\r)
 705                        ;; CR:r3=CR r0=CR
 706                        ((r4 = 9)
 707                         (read r0)
 708                         ;; CR:r3=CR CR r0
 709                         (if (r0 == ?\n)
 710                             ;; CR:r3=CR CR LF
 711                             ((r6 = 0)
 712                              (r5 = 0)
 713                              (write ,(if output-crlf "=0D\r\n" "=0D\n"))
 714                              (r4 = 10)
 715                              (read r0)
 716                              (break))
 717                           ;; CR:r3=CR CR noLF
 718                           ((r6 = 6)
 719                            (r5 = 0)
 720                            (write ,(if output-crlf "=\r\n=0D=0D" "=\n=0D=0D"))
 721                            (break))))
 722                      ;; CR:r3=CR r0=noLFnorCR
 723                      ((r6 = 3)
 724                       (r5 = 0)
 725                       (write ,(if output-crlf "=\r\n=0D" "=\n=0D"))
 726                       (break)))
 727                  ((r6 = 3)
 728                   (r5 = 0)
 729                   (write ,(if output-crlf "=\r\n=0D" "=\n=0D"))
 730                   (break))))))
 731          (funcall
 732           (lambda (after-newline after-cr-nolf after-nonewline)
 733             (if input-crlf
 734                 ;; r0:r3={RAW,ENC}
 735                 `((r4 = 11)
 736                   (read r1)
 737                   ;; r0:r3={RAW,ENC} r1
 738                   (if (r1 == ?\r)
 739                       ;; r0:r3={RAW,ENC} r1=CR
 740                       ((r4 = 12)
 741                        (read r1)
 742                        ;; r0:r3={RAW,ENC} CR r1
 743                        (if (r1 == ?\n)
 744                            ;; r0:r3=RAW CR r1=LF
 745                            ,after-newline
 746                          ;; r0:r3=RAW CR r1=noLF
 747                          ,after-cr-nolf))
 748                     ;; r0:r3={RAW,ENC} r1:noCR
 749                     ,after-nonewline))
 750               ;; r0:r3={RAW,ENC}
 751               `((r4 = 11)
 752                 (read r1)
 753                 ;; r0:r3={RAW,ENC} r1
 754                 (if (r1 == ?\n)
 755                     ;; r0:r3={RAW,ENC} r1=CRLF
 756                     ,after-newline
 757                   ;; r0:r3={RAW,ENC} r1:noCRLF
 758                   ,after-nonewline))))
 759           ;; r0:r3={RAW,ENC} CR r1=LF
 760           ;; r0:r3={RAW,ENC} r1=CRLF
 761           `((r6 = 0)
 762             (r5 = 0)
 763             (branch
 764              r3
 765              ;; r0:r3=RAW CR r1=LF
 766              ;; r0:r3=RAW r1=CRLF
 767              ((write r0)
 768               (write ,(if output-crlf "\r\n" "\n"))
 769               (r4 = 13)
 770               (read r0)
 771               (break))
 772              ;; r0:r3=ENC CR r1=LF
 773              ;; r0:r3=ENC r1=CRLF
 774              ((write ?=)
 775               (write r0 ,mel-ccl-high-table)
 776               (write r0 ,mel-ccl-low-table)
 777               (write ,(if output-crlf "\r\n" "\n"))
 778               (r4 = 14)
 779               (read r0)
 780               (break))))
 781           ;; r0:r3={RAW,ENC} CR r1=noLF
 782           `((branch
 783              r3
 784              ;; r0:r3=RAW CR r1:noLF
 785              ((r6 = 4)
 786               (r5 = 0)
 787               (write ,(if output-crlf "=\r\n" "=\n"))
 788               (write r0)
 789               (write "=0D")
 790               (r0 = r1)
 791               (break))
 792              ;; r0:r3=ENC CR r1:noLF
 793              ((r6 = 6)
 794               (r5 = 0)
 795               (write ,(if output-crlf "=\r\n=" "=\n="))
 796               (write r0 ,mel-ccl-high-table)
 797               (write r0 ,mel-ccl-low-table)
 798               (write "=0D")
 799               (r0 = r1)
 800               (break))))
 801           ;; r0:r3={RAW,ENC} r1:noCR
 802           ;; r0:r3={RAW,ENC} r1:noCRLF
 803           `((branch
 804              r3
 805              ;; r0:r3=RAW r1:noCR
 806              ;; r0:r3=RAW r1:noCRLF
 807              ((r6 = 1)
 808               (r5 = 0)
 809               (write ,(if output-crlf "=\r\n" "=\n"))
 810               (write r0)
 811               (r0 = r1)
 812               (break))
 813              ;; r0:r3=ENC r1:noCR
 814              ;; r0:r3=ENC r1:noCRLF
 815              ((r6 = 3)
 816               (r5 = 0)
 817               (write ,(if output-crlf "=\r\n=" "=\n="))
 818               (write r0 ,mel-ccl-high-table)
 819               (write r0 ,mel-ccl-low-table)
 820               (r0 = r1)
 821               (break)))))))
 822       (repeat)))
 823     ;; EOF
 824     (                                   ;(write "[EOF:") (write r4 ,mel-ccl-high-table) (write r4 ,mel-ccl-low-table) (write "]")
 825      (branch
 826       r4
 827       ;; 0: (start) ;
 828       (end)
 829       ;; 1: RAW ;
 830       (end)
 831       ;; 2: r0:r3=ENC ;
 832       (end)
 833       ;; 3: SOFTBREAK r0:r3=ENC ;
 834       (end)
 835       ;; 4: r0:r3=WSP ;
 836       ((write ,(if output-crlf "=\r\n" "=\n")) (end))
 837       ;; 5: SOFTBREAK r0:r3=WSP ;
 838       ((write ,(if output-crlf "=\r\n" "=\n")) (end))
 839       ;; 6: ; r0=\r:r3=CR
 840       (if (r6 <= 73)
 841           ((write "=0D") (end))
 842         ((write ,(if output-crlf "=\r\n=0D" "=\n=0D")) (end)))
 843       ;; 7: r5=WSP SOFTBREAK CR:r3=CR r0=LF ;
 844       (end)
 845       ;; 8: r5=noWSP CR:r3=CR r0=LF ;
 846       (end)
 847       ;; 9: (r6=73) ; CR:r3=CR r0=CR
 848       ((write ,(if output-crlf "=\r\n=0D=0D" "=\n=0D=0D")) (end))
 849       ;; 10: (r6=73) CR:r3=CR CR LF ;
 850       (end)
 851       ;; 11: ; r0:r3={RAW,ENC}
 852       (branch
 853        r3
 854        ((write r0) (end))
 855        ((write "=")
 856         (write r0 ,mel-ccl-high-table)
 857         (write r0 ,mel-ccl-low-table)
 858         (end)))
 859       ;; 12: ; r0:r3={RAW,ENC} r1=CR
 860       (branch
 861        r3
 862        ;; ; r0:r3=RAW r1=CR
 863        ((write ,(if output-crlf "=\r\n" "=\n"))
 864         (write r0)
 865         (write "=0D")
 866         (end))
 867        ;; ; r0:r3=ENC r1=CR
 868        ((write ,(if output-crlf "=\r\n=" "=\n="))
 869         (write r0 ,mel-ccl-high-table)
 870         (write r0 ,mel-ccl-low-table)
 871         (write "=0D")
 872         (end)))
 873       ;; 13: r0:r3=RAW CR LF ;
 874       ;; 13: r0:r3=RAW CRLF ;
 875       (end)
 876       ;; 14: r0:r3=ENC CR LF ;
 877       ;; 14: r0:r3=ENC CRLF ;
 878       (end)
 879       ))
 880     ))
 881
 882 (defun mel-ccl-decode-quoted-printable-generic (input-crlf output-crlf)
 883   `(1
 884     ((read r0)
 885      (loop
 886       (branch
 887        r0
 888        ,@(mapcar
 889           (lambda (r0)
 890             (let ((tmp (aref mel-ccl-qp-table r0)))
 891               (cond
 892                ((eq tmp 'raw) `(write-read-repeat r0))
 893                ((eq tmp 'wsp) (if (eq r0 (char-int ? ))
 894                                   `(r1 = 1)
 895                                 `(r1 = 0)))
 896                ((eq tmp 'cr)
 897                 (if input-crlf
 898                     ;; r0='\r'
 899                     `((read r0)
 900                       ;; '\r' r0
 901                       (if (r0 == ?\n)
 902                           ;; '\r' r0='\n'
 903                           ;; hard line break found.
 904                           ,(if output-crlf
 905                                '((write ?\r)
 906                                  (write-read-repeat r0))
 907                              '(write-read-repeat r0))
 908                         ;; '\r' r0:[^\n]
 909                         ;; invalid control character (bare CR) found.
 910                         ;; -> ignore it and rescan from r0.
 911                         (repeat)))
 912                   ;; r0='\r'
 913                   ;; invalid character (bare CR) found.
 914                   ;; -> ignore.
 915                   `((read r0)
 916                     (repeat))))
 917                ((eq tmp 'lf)
 918                 (if input-crlf
 919                     ;; r0='\n'
 920                     ;; invalid character (bare LF) found.
 921                     ;; -> ignore.
 922                     `((read r0)
 923                       (repeat))
 924                   ;; r0='\r\n'
 925                   ;; hard line break found.
 926                   (if output-crlf
 927                       '((write ?\r)
 928                         (write-read-repeat r0))
 929                     '(write-read-repeat r0))))
 930                ((eq r0 (char-int ?=))
 931                 ;; r0='='
 932                 `((read r0)
 933                   ;; '=' r0
 934                   (r1 = (r0 == ?\t))
 935                   (if ((r0 == ? ) | r1)
 936                       ;; '=' r0:[\t ]
 937                       ;; Skip transport-padding.
 938                       ;; It should check CR LF after
 939                       ;; transport-padding.
 940                       (loop
 941                        (read-if (r0 == ?\t)
 942                                 (repeat)
 943                                 (if (r0 == ? )
 944                                     (repeat)
 945                                   (break)))))
 946                   ;; '=' [\t ]* r0:[^\t ]
 947                   (branch
 948                    r0
 949                    ,@(mapcar
 950                       (lambda (r0)
 951                         (cond
 952                          ((eq r0 (char-int ?\r))
 953                           (if input-crlf
 954                               ;; '=' [\t ]* r0='\r'
 955                               `((read r0)
 956                                 ;; '=' [\t ]* '\r' r0
 957                                 (if (r0 == ?\n)
 958                                     ;; '=' [\t ]* '\r' r0='\n'
 959                                     ;; soft line break found.
 960                                     ((read r0)
 961                                      (repeat))
 962                                   ;; '=' [\t ]* '\r' r0:[^\n]
 963                                   ;; invalid input ->
 964                                   ;; output "=" and rescan from r0.
 965                                   ((write "=")
 966                                    (repeat))))
 967                             ;; '=' [\t ]* r0='\r'
 968                             ;; invalid input (bare CR found) ->
 969                             ;; output "=" and rescan from next.
 970                             `((write ?=)
 971                               (read r0)
 972                               (repeat))))
 973                          ((eq r0 (char-int ?\n))
 974                           (if input-crlf
 975                               ;; '=' [\t ]* r0='\n'
 976                               ;; invalid input (bare LF found) ->
 977                               ;; output "=" and rescan from next.
 978                               `((write ?=)
 979                                 (read r0)
 980                                 (repeat))
 981                             ;; '=' [\t ]* r0='\r\n'
 982                             ;; soft line break found.
 983                             `((read r0)
 984                               (repeat))))
 985                          ((setq tmp (nth r0 mel-ccl-256-to-16-table))
 986                           ;; '=' [\t ]* r0:[0-9A-F]
 987                           ;; upper nibble of hexadecimal digit found.
 988                           `((r1 = r0)
 989                             (r0 = ,tmp)))
 990                          (t
 991                           ;; '=' [\t ]* r0:[^\r0-9A-F]
 992                           ;; invalid input ->
 993                           ;; output "=" and rescan from r0.
 994                           `((write ?=)
 995                             (repeat)))))
 996                       mel-ccl-256-table))
 997                   ;; '=' [\t ]* r1:r0:[0-9A-F]
 998                   (read-branch
 999                    r2
1000                    ,@(mapcar
1001                       (lambda (r2)
1002                         (if (setq tmp (nth r2 mel-ccl-256-to-16-table))
1003                             ;; '=' [\t ]* r1:r0:[0-9A-F] r2:[0-9A-F]
1004                             `(write-read-repeat
1005                               r0
1006                               ,(vconcat
1007                                 (mapcar
1008                                  (lambda (r0)
1009                                    (logior (lsh r0 4) tmp))
1010                                  mel-ccl-16-table)))
1011                           ;; '=' [\t ]* r1:r0:[0-9A-F] r2:[^0-9A-F]
1012                           ;; invalid input
1013                           `(r3 = 0)     ; nop
1014                           ))
1015                       mel-ccl-256-table))
1016                   ;; '=' [\t ]* r1:r0:[0-9A-F] r2:[^0-9A-F]
1017                   ;; invalid input ->
1018                   ;; output "=" with hex digit and rescan from r2.
1019                   (write ?=)
1020                   (r0 = r2)
1021                   (write-repeat r1)))
1022                (t
1023                 ;; r0:[^\t\r -~]
1024                 ;; invalid character found.
1025                 ;; -> ignore.
1026                 `((read r0)
1027                   (repeat))))))
1028           mel-ccl-256-table))
1029       ;; r1[0]:[\t ]
1030       (loop
1031        ,@(apply
1032           'append
1033           (mapcar
1034            (lambda (regnum)
1035              (let ((reg (aref [r1 r2 r3 r4 r5] regnum)))
1036                (apply
1037                 'append
1038                 (mapcar
1039                  (lambda (bit)
1040                    (if (= bit 0)
1041                        (if (= regnum 0)
1042                            nil
1043                          `((read r0)
1044                            (if (r0 == ?\t)
1045                                (,reg = 0)
1046                              (if (r0 == ?\ )
1047                                  (,reg = 1)
1048                                ((r6 = ,(+ (* regnum 28) bit))
1049                                 (break))))))
1050                      `((read r0)
1051                        (if (r0 == ?\ )
1052                            (,reg |= ,(lsh 1 bit))
1053                          (if (r0 != ?\t)
1054                              ((r6 = ,(+ (* regnum 28) bit))
1055                               (break)))))))
1056                  mel-ccl-28-table))))
1057            '(0 1 2 3 4)))
1058        ;; white space buffer exhaust.
1059        ;; error: line length limit (76bytes) violation.
1060        ;; -> ignore these white spaces.
1061        (repeat))
1062       ,(if input-crlf
1063            `(if (r0 == ?\r)
1064                 ((read r0)
1065                  (if (r0 == ?\n)
1066                      ;; trailing white spaces found.
1067                      ;; -> ignore these white spacs.
1068                      ((write ,(if output-crlf "\r\n" "\n"))
1069                       (read r0)
1070                       (repeat))
1071                    ;; [\t ]* \r r0:[^\n]
1072                    ;; error: bare CR found.
1073                    ;; -> output white spaces and ignore bare CR.
1074                    ))
1075               ;; [\t ]* r0:[^\r]
1076               ;; middle white spaces found.
1077               )
1078          `(if (r0 == ?\n)
1079               ;; trailing white spaces found.
1080               ;; -> ignore these white spacs.
1081               ((write ,(if output-crlf "\r\n" "\n"))
1082                (read r0)
1083                (repeat))
1084             ;; [\t ]* r0:[^\n]
1085             ;; middle white spaces found.
1086             ))
1087       ,@(apply
1088          'append
1089          (mapcar
1090           (lambda (regnum)
1091             (let ((reg (aref [r1 r2 r3 r4 r5] regnum)))
1092               (apply
1093                'append
1094                (mapcar
1095                 (lambda (bit)
1096                   `((if (,reg & ,(lsh 1 bit))
1097                         (write ?\ )
1098                       (write ?\t))
1099                     (if (r6 == ,(+ (* regnum 28) bit 1))
1100                         (repeat))))
1101                 mel-ccl-28-table))))
1102           '(0 1 2 3 4)))
1103       (repeat)
1104       ))))
1105
1106 )
1107
1108 (define-ccl-program mel-ccl-encode-quoted-printable-crlf-crlf
1109   (mel-ccl-encode-quoted-printable-generic t t))
1110
1111 (define-ccl-program mel-ccl-encode-quoted-printable-crlf-lf
1112   (mel-ccl-encode-quoted-printable-generic t nil))
1113
1114 (define-ccl-program mel-ccl-encode-quoted-printable-lf-crlf
1115   (mel-ccl-encode-quoted-printable-generic nil t))
1116
1117 (define-ccl-program mel-ccl-encode-quoted-printable-lf-lf
1118   (mel-ccl-encode-quoted-printable-generic nil nil))
1119
1120 (define-ccl-program mel-ccl-decode-quoted-printable-crlf-crlf
1121   (mel-ccl-decode-quoted-printable-generic t t))
1122
1123 (define-ccl-program mel-ccl-decode-quoted-printable-crlf-lf
1124   (mel-ccl-decode-quoted-printable-generic t nil))
1125
1126 (define-ccl-program mel-ccl-decode-quoted-printable-lf-crlf
1127   (mel-ccl-decode-quoted-printable-generic nil t))
1128
1129 (define-ccl-program mel-ccl-decode-quoted-printable-lf-lf
1130   (mel-ccl-decode-quoted-printable-generic nil nil))
1131
1132
1133 ;;; @ coding system
1134 ;;;
1135
1136 (make-ccl-coding-system
1137  'mel-ccl-uq-rev ?Q "MIME Q-encoding in unstructured field (reversed)"
1138  'mel-ccl-encode-uq 'mel-ccl-decode-q)
1139
1140 (make-ccl-coding-system
1141  'mel-ccl-cq-rev ?Q "MIME Q-encoding in comment (reversed)"
1142  'mel-ccl-encode-cq 'mel-ccl-decode-q)
1143
1144 (make-ccl-coding-system
1145  'mel-ccl-pq-rev ?Q "MIME Q-encoding in phrase (reversed)"
1146  'mel-ccl-encode-pq 'mel-ccl-decode-q)
1147
1148 (make-ccl-coding-system
1149  'mel-ccl-b-rev ?B "MIME B-encoding (reversed)"
1150  'mel-ccl-encode-b 'mel-ccl-decode-b)
1151
1152 (make-ccl-coding-system
1153  'mel-ccl-quoted-printable-crlf-crlf-rev
1154  ?Q "MIME Quoted-Printable-encoding (reversed)"
1155  'mel-ccl-encode-quoted-printable-crlf-crlf
1156  'mel-ccl-decode-quoted-printable-crlf-crlf)
1157
1158 (make-ccl-coding-system
1159  'mel-ccl-quoted-printable-lf-crlf-rev
1160  ?Q "MIME Quoted-Printable-encoding (LF encoding) (reversed)"
1161  'mel-ccl-encode-quoted-printable-crlf-lf
1162  'mel-ccl-decode-quoted-printable-lf-crlf)
1163
1164 (make-ccl-coding-system
1165  'mel-ccl-quoted-printable-crlf-lf-rev
1166  ?Q "MIME Quoted-Printable-encoding (LF internal) (reversed)"
1167  'mel-ccl-encode-quoted-printable-lf-crlf
1168  'mel-ccl-decode-quoted-printable-crlf-lf)
1169
1170 (make-ccl-coding-system
1171  'mel-ccl-quoted-printable-lf-lf-rev
1172  ?Q "MIME Quoted-Printable-encoding (LF encoding) (LF internal) (reversed)"
1173  'mel-ccl-encode-quoted-printable-lf-lf
1174  'mel-ccl-decode-quoted-printable-lf-lf)
1175
1176 (make-ccl-coding-system
1177  'mel-ccl-base64-crlf-rev
1178  ?B "MIME Base64-encoding (reversed)"
1179  'mel-ccl-encode-base64-crlf-crlf
1180  'mel-ccl-decode-b)
1181
1182 (make-ccl-coding-system
1183  'mel-ccl-base64-lf-rev
1184  ?B "MIME Base64-encoding (LF encoding) (reversed)"
1185  'mel-ccl-encode-base64-crlf-lf
1186  'mel-ccl-decode-b)
1187
1188
1189 ;;; @ B
1190 ;;;
1191
1192 (unless (and (boundp 'ccl-encoder-eof-block-is-broken)
1193              ccl-encoder-eof-block-is-broken)
1194
1195 (defun base64-ccl-encode-string (string)
1196   "Encode STRING with base64 encoding."
1197   (decode-coding-string string 'mel-ccl-b-rev))
1198
1199 (defun base64-ccl-encode-region (start end)
1200   "Encode region from START to END with base64 encoding."
1201   (interactive "r")
1202   (decode-coding-region start end 'mel-ccl-b-rev))
1203
1204 (defun base64-ccl-insert-encoded-file (filename)
1205   "Encode contents of file FILENAME to base64, and insert the result."
1206   (interactive (list (read-file-name "Insert encoded file: ")))
1207   (let ((coding-system-for-read 'mel-ccl-b-rev))
1208     (insert-file-contents filename)))
1209
1210 )
1211
1212 (defun base64-ccl-decode-string (string)
1213   "Decode base64 encoded STRING"
1214   (string-as-unibyte (encode-coding-string string 'mel-ccl-b-rev)))
1215
1216 (defun base64-ccl-decode-region (start end)
1217   "Decode base64 encoded the region from START to END."
1218   (interactive "r")
1219   (encode-coding-region start end 'mel-ccl-b-rev))
1220
1221 (defun base64-ccl-write-decoded-region (start end filename)
1222   "Decode the region from START to END and write out to FILENAME."
1223   (interactive
1224     (list (region-beginning) (region-end)
1225           (read-file-name "Write decoded region to file: ")))
1226   (let ((coding-system-for-write 'mel-ccl-b-rev))
1227     (write-region start end filename)))
1228
1229
1230 ;;; @ quoted-printable
1231 ;;;
1232
1233 (unless (and (boundp 'ccl-encoder-eof-block-is-broken)
1234              ccl-encoder-eof-block-is-broken)
1235
1236 (defun quoted-printable-ccl-encode-string (string)
1237   "Encode STRING with quoted-printable encoding."
1238   (decode-coding-string
1239    string
1240    'mel-ccl-quoted-printable-lf-lf-rev))
1241
1242 (defun quoted-printable-ccl-encode-region (start end)
1243   "Encode the region from START to END with quoted-printable
1244 encoding."
1245   (interactive "r")
1246   (decode-coding-region start end 'mel-ccl-quoted-printable-lf-lf-rev))
1247
1248 (defun quoted-printable-ccl-insert-encoded-file (filename)
1249   "Encode contents of the file named as FILENAME, and insert it."
1250   (interactive (list (read-file-name "Insert encoded file: ")))
1251   (let ((start (point)) end
1252         (coding-system-for-read 'mel-ccl-quoted-printable-lf-lf-rev))
1253     (insert-file-contents filename)))
1254
1255 )
1256
1257 (defun quoted-printable-ccl-decode-string (string)
1258   "Decode quoted-printable encoded STRING."
1259   (encode-coding-string
1260    string
1261    'mel-ccl-quoted-printable-lf-lf-rev))
1262
1263 (defun quoted-printable-ccl-decode-region (start end)
1264   "Decode the region from START to END with quoted-printable
1265 encoding."
1266   (interactive "r")
1267   (encode-coding-region start end 'mel-ccl-quoted-printable-lf-lf-rev))
1268
1269 (defun quoted-printable-ccl-write-decoded-region
1270   (start end filename)
1271   "Decode quoted-printable encoded current region and write out to FILENAME."
1272   (interactive
1273    (list (region-beginning) (region-end)
1274          (read-file-name "Write decoded region to file: ")))
1275   (let ((coding-system-for-write 'mel-ccl-quoted-printable-lf-lf-rev))
1276     (write-region start end filename)))
1277
1278
1279 ;;; @ Q
1280 ;;;
1281
1282 (defun q-encoding-ccl-encode-string (string &optional mode)
1283   "Encode STRING to Q-encoding of encoded-word, and return the result.
1284 MODE allows `text', `comment', `phrase' or nil.  Default value is
1285 `phrase'."
1286   (decode-coding-string
1287    string
1288    (cond
1289     ((eq mode 'text) 'mel-ccl-uq-rev)
1290     ((eq mode 'comment) 'mel-ccl-cq-rev)
1291     (t 'mel-ccl-pq-rev))))
1292
1293 (defun q-encoding-ccl-decode-string (string)
1294   "Decode Q encoded STRING and return the result."
1295   (string-as-unibyte
1296    (encode-coding-string
1297     string
1298     'mel-ccl-uq-rev)))
1299
1300
1301 ;;; @ end
1302 ;;;
1303
1304 (provide 'mel-ccl)
1305
1306 '(
1307 (let ((str0 "a\f \t\r
1308 aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa\r
1309 aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa\r
1310 aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa\r
1311 aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa\f\r
1312 aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa\f\r
1313 aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa\f\r
1314                                                                           \r
1315                                                                            \r
1316                                                                             \r
1317 aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa \r
1318 aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa \r
1319 aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa \r
1320 aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa \r
1321 bbb \r
1322 bbbb\r
1323 cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc\rccc\r
1324 ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc\r\r\nccc\r
1325 ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc\r\rccc\r
1326 cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc\rccc\r
1327 dddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddd\r\neee\r
1328 dddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddd\reee\r
1329 ddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddeee\r
1330 ")
1331       str1 encoded decoded)
1332   (setq str1 (ew-crlf-to-lf str0)
1333         encoded
1334         (list
1335          (decode-coding-string
1336           str0
1337           'mel-ccl-quoted-printable-crlf-crlf-rev)
1338          (decode-coding-string
1339           str0
1340           'mel-ccl-quoted-printable-lf-crlf-rev)
1341          (decode-coding-string
1342           str1
1343           'mel-ccl-quoted-printable-crlf-lf-rev)
1344          (decode-coding-string
1345           str1
1346           'mel-ccl-quoted-printable-lf-lf-rev))
1347         decoded
1348         (list
1349          (encode-coding-string
1350           (nth 0 encoded)
1351           'mel-ccl-quoted-printable-crlf-crlf-rev)
1352          (encode-coding-string
1353           (nth 1 encoded)
1354           'mel-ccl-quoted-printable-lf-crlf-rev)
1355          (encode-coding-string
1356           (nth 2 encoded)
1357           'mel-ccl-quoted-printable-crlf-lf-rev)
1358          (encode-coding-string
1359           (nth 3 encoded)
1360           'mel-ccl-quoted-printable-lf-lf-rev)))
1361   (list
1362    (string= str0 (nth 0 decoded))
1363    (string= str0 (nth 1 decoded))
1364    (string= str1 (nth 2 decoded))
1365    (string= str1 (nth 3 decoded))))
1366
1367 ;; for xemacs
1368 (defun make-ccl-coding-system (name mnemonic doc-string decoder encoder)
1369   (make-coding-system
1370    name 'ccl doc-string
1371    (list 'mnemonic (char-to-string mnemonic)
1372          'decode (symbol-value decoder)
1373          'encode (symbol-value encoder))))
1374
1375 )