X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=mel-ccl.el;h=e50ad5ffdf322fb357d177de97a0480c3ffef262;hb=733c8dc5119f2b5df1fb571d0882c5f4350f21d5;hp=0dfe2b8484af571a3d1bdf8ededffc38774102f6;hpb=4d9c85cce61c5f3a0e1746a885b57b667f3843d8;p=elisp%2Fflim.git diff --git a/mel-ccl.el b/mel-ccl.el index 0dfe2b8..e50ad5f 100644 --- a/mel-ccl.el +++ b/mel-ccl.el @@ -1,5 +1,34 @@ +;;; mel-ccl.el: CCL based encoder/decoder of Base64, Quoted-Printable +;;; and Q-encoding + +;; Copyright (C) 1998 Tanaka Akira + +;; Author: Tanaka Akira +;; 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 @@ -352,17 +381,19 @@ abcdefghijklmnopqrstuvwxyz\ (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) @@ -463,6 +494,17 @@ abcdefghijklmnopqrstuvwxyz\ (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) @@ -480,6 +522,45 @@ abcdefghijklmnopqrstuvwxyz\ (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 @@ -540,11 +621,13 @@ abcdefghijklmnopqrstuvwxyz\ (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} @@ -759,6 +842,24 @@ abcdefghijklmnopqrstuvwxyz\ ;; 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) )) )) @@ -1072,8 +1173,7 @@ abcdefghijklmnopqrstuvwxyz\ ;;; @ B ;;; -(unless (and (boundp 'ccl-encoder-eof-block-is-broken) - ccl-encoder-eof-block-is-broken) +(unless-broken ccl-execute-eof-block-on-encoding-some (defun base64-ccl-encode-string (string) "Encode STRING with base64 encoding." @@ -1087,9 +1187,19 @@ abcdefghijklmnopqrstuvwxyz\ (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) @@ -1109,12 +1219,25 @@ abcdefghijklmnopqrstuvwxyz\ (let ((coding-system-for-write 'mel-ccl-b-rev)) (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-encoding-some (defun quoted-printable-ccl-encode-string (string) "Encode STRING with quoted-printable encoding." @@ -1123,8 +1246,7 @@ abcdefghijklmnopqrstuvwxyz\ '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)) @@ -1134,6 +1256,15 @@ encoding." (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) @@ -1157,6 +1288,16 @@ encoding." (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 ;;; @@ -1178,11 +1319,8 @@ MODE allows `text', `comment', `phrase' or nil. Default value is 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 @@ -1195,78 +1333,19 @@ MODE allows `text', `comment', `phrase' or nil. Default value is (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