X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=mel-ccl.el;h=e50ad5ffdf322fb357d177de97a0480c3ffef262;hb=733c8dc5119f2b5df1fb571d0882c5f4350f21d5;hp=28df002f78bda7fbe7253c6d3b1b3cfc82499ca1;hpb=3a31f527f428ee1d41073b6c3bf0d08893463ea8;p=elisp%2Fflim.git diff --git a/mel-ccl.el b/mel-ccl.el index 28df002..e50ad5f 100644 --- a/mel-ccl.el +++ b/mel-ccl.el @@ -1,4 +1,5 @@ -;;; mel-ccl.el: Base64, Quoted-Printable and Q-encoding encoder/decoder for GNU Emacs +;;; mel-ccl.el: CCL based encoder/decoder of Base64, Quoted-Printable +;;; and Q-encoding ;; Copyright (C) 1998 Tanaka Akira @@ -6,7 +7,7 @@ ;; Created: 1998/9/17 ;; Keywords: MIME, Base64, Quoted-Printable, Q-encoding -;; This file is part of MEL (MIME Encoding Library). +;; 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 @@ -23,8 +24,11 @@ ;; 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 @@ -377,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) @@ -1167,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." @@ -1182,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) @@ -1204,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." @@ -1218,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)) @@ -1229,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) @@ -1252,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 ;;; @@ -1273,7 +1319,7 @@ 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) (let ((status [nil nil nil nil nil nil nil nil nil])) (fillarray status nil) @@ -1287,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