+;;; mel-ccl.el: CCL based encoder/decoder of Base64, Quoted-Printable
+;;; and Q-encoding
+
+;; Copyright (C) 1998 Tanaka Akira
+
+;; Author: Tanaka Akira <akr@jaist.ac.jp>
+;; Created: 1998/9/17
+;; Keywords: MIME, Base64, Quoted-Printable, Q-encoding
+
+;; This file is part of FLIM (Faithful Library about Internet Message).
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or (at
+;; your option) any later version.
+
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Code:
+
(require 'ccl)
-(require 'emu)
+(require 'pccl)
+(require 'mime-def)
;;; @ constants
(write r7)
(write-repeat r4))
;; error: BB=B
- ((write r4)
+ ((write (r4 & 255))
(end))
;; BBB=
((r5 = r2 ,mel-ccl-decode-b-2-table)
(r4 |= r5)
(r4 >8= 0)
(write r7)
- (write r4)
+ (write (r4 & 255))
+ (end) ; Excessive (end) is workaround for XEmacs 21.0.
+ ; Without this, "AAA=" is converted to "^@^@^@".
(end))
;; BB==
- ((write r4)
+ ((write (r4 & 255))
(end))))
((r4 >8= 0)
(write r7)
(eval-when-compile
+(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)
+ (if input-crlf
+ `((,eof-reg = ,cr-eof) (read-if (,reg == ?\r)
+ ((,eof-reg = ,lf-eof) (read-if (,reg == ?\n)
+ ,succ
+ ,fail-lf))
+ ,fail-cr))
+ `((,eof-reg = ,crlf-eof) (read-if (,reg == ?\n)
+ ,succ
+ ,fail-crlf))))
+
;; Generated CCL program works not properly on 20.2 because CCL_EOF_BLOCK
;; is not executed.
(defun mel-ccl-encode-quoted-printable-generic (input-crlf output-crlf)
(lambda (r0)
(let ((tmp (aref mel-ccl-qp-table r0)))
(cond
+ ((eq r0 (char-int ?F))
+ `(if (r6 == 0)
+ ((r4 = 15) (read-if (r0 == ?r)
+ ((r4 = 16) (read-if (r0 == ?o)
+ ((r4 = 17) (read-if (r0 == ?m)
+ ((r4 = 18) (read-if (r0 == ? )
+ ((r6 = 7)
+ (r5 = 1)
+ (write "=46rom ")
+ (r4 = 19)
+ (read r0)
+ (repeat))
+ ((r6 = 4)
+ (write-repeat "From"))))
+ ((r6 = 3)
+ (write-repeat "Fro"))))
+ ((r6 = 2)
+ (write-repeat "Fr"))))
+ ((r6 = 1)
+ (write-repeat "F"))))
+ ((r3 = 0) (break)) ; RAW
+ ))
+ ((eq r0 (char-int ?.))
+ `(if (r6 == 0)
+ ,(mel-ccl-try-to-read-crlf
+ input-crlf
+ 'r0 'r4 20 21 22
+ `((write ,(if output-crlf "=2E\r\n" "=2E\n"))
+ (r4 = 23)
+ (read r0)
+ (repeat))
+ '((r6 = 1)
+ (write-repeat "."))
+ '((r6 = 4)
+ (write-repeat ".=0D"))
+ '((r6 = 1)
+ (write-repeat ".")))
+ ((r3 = 0) (break)) ; RAW
+ ))
((eq tmp 'raw) '((r3 = 0) (break))) ; RAW
((eq tmp 'enc) '((r3 = 1) (break))) ; ENC
((eq tmp 'wsp) '((r3 = 2) (break))) ; WSP
(r6 = 0)
(write ,(if output-crlf "=\r\n" "=\n"))
,@(if output-crlf '((write ?\r)) '())
+ (r4 = 0)
(write-read-repeat r0))
;; noWSP ; r0:r3=CRLF
((r5 = 0)
(r6 = 0)
,@(if output-crlf '((write ?\r)) '())
+ (r4 = 0)
(write-read-repeat r0)))
)))
;; r0:r3={RAW,ENC,CR}
;; 14: r0:r3=ENC CR LF ;
;; 14: r0:r3=ENC CRLF ;
(end)
+ ;; 15: r6=0 ; "F"
+ ((write "F") (end))
+ ;; 16: r6=0 ; "Fr"
+ ((write "Fr") (end))
+ ;; 17: r6=0 ; "Fro"
+ ((write "Fro") (end))
+ ;; 18: r6=0 ; "From"
+ ((write "From") (end))
+ ;; 19: r6=0 "From " ;
+ (end)
+ ;; 20: r6=0 ; "."
+ ((write ".") (end))
+ ;; 21: r6=0 ; ".\r"
+ ((write ".=0D") (end))
+ ;; 22: r6=0 ; "."
+ ((write ".") (end))
+ ;; 23: r6=0 ".\r\n" ;
+ (end)
))
))
;;; @ B
;;;
-(unless (and (boundp 'ccl-encoder-eof-block-is-broken)
- ccl-encoder-eof-block-is-broken)
+(unless-broken ccl-execute-eof-block-on-decoding-some
(defun base64-ccl-encode-string (string)
"Encode STRING with base64 encoding."
(defun base64-ccl-insert-encoded-file (filename)
"Encode contents of file FILENAME to base64, and insert the result."
(interactive (list (read-file-name "Insert encoded file: ")))
- (let ((coding-system-for-read 'mel-ccl-b-rev))
+ (let ((coding-system-for-read 'mel-ccl-base64-lf-rev))
(insert-file-contents filename)))
+ (mel-define-method-function (mime-encode-string string (nil "base64"))
+ 'base64-ccl-encode-string)
+ (mel-define-method-function (mime-encode-region start end (nil "base64"))
+ 'base64-ccl-encode-region)
+ (mel-define-method-function
+ (mime-insert-encoded-file filename (nil "base64"))
+ 'base64-ccl-insert-encoded-file)
+
+ (mel-define-method-function (encoded-text-encode-string string (nil "B"))
+ 'base64-ccl-encode-string)
)
(defun base64-ccl-decode-string (string)
(interactive
(list (region-beginning) (region-end)
(read-file-name "Write decoded region to file: ")))
- (let ((coding-system-for-write 'mel-ccl-b-rev))
+ (let ((coding-system-for-write 'mel-ccl-b-rev)
+ jka-compr-compression-info-list)
(write-region start end filename)))
+(mel-define-method-function (mime-decode-string string (nil "base64"))
+ 'base64-ccl-decode-string)
+(mel-define-method-function (mime-decode-region start end (nil "base64"))
+ 'base64-ccl-decode-region)
+(mel-define-method-function
+ (mime-write-decoded-region start end filename (nil "base64"))
+ 'base64-ccl-write-decoded-region)
+
+(mel-define-method encoded-text-decode-string (string (nil "B"))
+ (if (and (string-match B-encoded-text-regexp string)
+ (string= string (match-string 0 string)))
+ (base64-ccl-decode-string string)
+ (error "Invalid encoded-text %s" string)))
+
;;; @ quoted-printable
;;;
-(unless (and (boundp 'ccl-encoder-eof-block-is-broken)
- ccl-encoder-eof-block-is-broken)
+(unless-broken ccl-execute-eof-block-on-decoding-some
(defun quoted-printable-ccl-encode-string (string)
"Encode STRING with quoted-printable encoding."
'mel-ccl-quoted-printable-lf-lf-rev))
(defun quoted-printable-ccl-encode-region (start end)
- "Encode the region from START to END with quoted-printable
-encoding."
+ "Encode the region from START to END with quoted-printable encoding."
(interactive "r")
(decode-coding-region start end 'mel-ccl-quoted-printable-lf-lf-rev))
(let ((coding-system-for-read 'mel-ccl-quoted-printable-lf-lf-rev))
(insert-file-contents filename)))
+ (mel-define-method-function
+ (mime-encode-string string (nil "quoted-printable"))
+ 'quoted-printable-ccl-encode-string)
+ (mel-define-method-function
+ (mime-encode-region start end (nil "quoted-printable"))
+ 'quoted-printable-ccl-encode-region)
+ (mel-define-method-function
+ (mime-insert-encoded-file filename (nil "quoted-printable"))
+ 'quoted-printable-ccl-insert-encoded-file)
)
(defun quoted-printable-ccl-decode-string (string)
(let ((coding-system-for-write 'mel-ccl-quoted-printable-lf-lf-rev))
(write-region start end filename)))
+(mel-define-method-function
+ (mime-decode-string string (nil "quoted-printable"))
+ 'quoted-printable-ccl-decode-string)
+(mel-define-method-function
+ (mime-decode-region start end (nil "quoted-printable"))
+ 'quoted-printable-ccl-decode-region)
+(mel-define-method-function
+ (mime-write-decoded-region start end filename (nil "quoted-printable"))
+ 'quoted-printable-ccl-write-decoded-region)
+
;;; @ Q
;;;
string
'mel-ccl-uq-rev))
-(unless running-xemacs
+(unless (featurep 'xemacs)
(defun q-encoding-ccl-encoded-length (string &optional mode)
- "Encode STRING to Q-encoding of encoded-word, and return the result.
-MODE allows `text', `comment', `phrase' or nil. Default value is
-`phrase'."
(let ((status [nil nil nil nil nil nil nil nil nil]))
(fillarray status nil)
(ccl-execute-on-string
(aref status 0)))
)
+(mel-define-method-function (encoded-text-encode-string string (nil "Q"))
+ 'q-encoding-ccl-encode-string)
+
+(mel-define-method encoded-text-decode-string (string (nil "Q"))
+ (if (and (string-match Q-encoded-text-regexp string)
+ (string= string (match-string 0 string)))
+ (q-encoding-ccl-decode-string string)
+ (error "Invalid encoded-text %s" string)))
+
+
;;; @ end
;;;
(provide 'mel-ccl)
-'(
-(let ((str0 "a\f \t\r
-aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa\r
-aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa\r
-aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa\r
-aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa\f\r
-aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa\f\r
-aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa\f\r
- \r
- \r
- \r
-aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa \r
-aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa \r
-aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa \r
-aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa \r
-bbb \r
-bbbb\r
-cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc\rccc\r
-ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc\r\r\nccc\r
-ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc\r\rccc\r
-cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc\rccc\r
-dddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddd\r\neee\r
-dddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddd\reee\r
-ddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddeee\r
-")
- str1 encoded decoded)
- (setq str1 (ew-crlf-to-lf str0)
- encoded
- (list
- (decode-coding-string
- str0
- 'mel-ccl-quoted-printable-crlf-crlf-rev)
- (decode-coding-string
- str0
- 'mel-ccl-quoted-printable-lf-crlf-rev)
- (decode-coding-string
- str1
- 'mel-ccl-quoted-printable-crlf-lf-rev)
- (decode-coding-string
- str1
- 'mel-ccl-quoted-printable-lf-lf-rev))
- decoded
- (list
- (encode-coding-string
- (nth 0 encoded)
- 'mel-ccl-quoted-printable-crlf-crlf-rev)
- (encode-coding-string
- (nth 1 encoded)
- 'mel-ccl-quoted-printable-lf-crlf-rev)
- (encode-coding-string
- (nth 2 encoded)
- 'mel-ccl-quoted-printable-crlf-lf-rev)
- (encode-coding-string
- (nth 3 encoded)
- 'mel-ccl-quoted-printable-lf-lf-rev)))
- (list
- (string= str0 (nth 0 decoded))
- (string= str0 (nth 1 decoded))
- (string= str1 (nth 2 decoded))
- (string= str1 (nth 3 decoded))))
-
-;; for xemacs
-(defun make-ccl-coding-system (name mnemonic doc-string decoder encoder)
- (make-coding-system
- name 'ccl doc-string
- (list 'mnemonic (char-to-string mnemonic)
- 'decode (symbol-value decoder)
- 'encode (symbol-value encoder))))
-
-)
+;;; mel-ccl.el ends here
projects / elisp / flim.git / blobdiff