X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=mel-ccl.el;h=12b18e1fdf5887558b09dc34835544bad0d0946b;hb=f3b90515038974fbb46f00b7cd5a687fb19cd160;hp=549dd9e247c76a1b531e59c2fc9cba34f5d36bd8;hpb=e17a84ed9de67e00a87d2fefc1e37b234a6e23d0;p=elisp%2Fflim.git diff --git a/mel-ccl.el b/mel-ccl.el index 549dd9e..12b18e1 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) @@ -1142,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-decoding-some (defun base64-ccl-encode-string (string) "Encode STRING with base64 encoding." @@ -1157,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) @@ -1176,15 +1216,29 @@ abcdefghijklmnopqrstuvwxyz\ (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." @@ -1193,8 +1247,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)) @@ -1204,6 +1257,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) @@ -1227,6 +1289,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 ;;; @@ -1248,7 +1320,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) @@ -1262,78 +1334,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