mel-ccl.el

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