X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=mel.el;h=ccfc07279288ae926967cdbd87d39ae7e476d70a;hb=f7230fcb61e32630f6bcf87e6eb8b35c564dd06c;hp=1f7fbf939ac7f21862098253ebadc848767da75b;hpb=83dbd1a8eca87310a8b745e9132a51c22478d003;p=elisp%2Fflim.git diff --git a/mel.el b/mel.el index 1f7fbf9..ccfc072 100644 --- a/mel.el +++ b/mel.el @@ -1,103 +1,276 @@ -;;; ;;; mel.el : a MIME encoding/decoding library -;;; -;;; Copyright (C) 1995 Free Software Foundation, Inc. -;;; Copyright (C) 1995,1996 MORIOKA Tomohiko -;;; -;;; Author: MORIOKA Tomohiko -;;; Maintainer: MORIOKA Tomohiko -;;; Created: 1995/6/25 -;;; Version: -;;; $Id: mel.el,v 3.3 1996/01/09 18:31:08 morioka Exp $ -;;; Keywords: MIME, Quoted-Printable -;;; -;;; This file is part of MEL (MIME Encoding Library). -;;; -;;; 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 This program. If not, write to the Free Software -;;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. -;;; + +;; Copyright (C) 1995,1996,1997,1998 Free Software Foundation, Inc. + +;; Author: MORIOKA Tomohiko +;; Created: 1995/6/25 +;; Keywords: MIME, Base64, Quoted-Printable, uuencode, gzip64 + +;; 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: -(autoload 'base64-encode-region "mel-b" nil t) -(autoload 'base64-decode-region "mel-b" nil t) -(autoload 'base64-encode-string "mel-b") -(autoload 'base64-decode-string "mel-b") -(autoload 'base64-encoded-length "mel-b") - -(autoload 'quoted-printable-encode-region "mel-q" nil t) -(autoload 'quoted-printable-decode-region "mel-q" nil t) - -(autoload 'q-encoding-encode-string-for-text "mel-q") -(autoload 'q-encoding-encode-string-for-comment "mel-q") -(autoload 'q-encoding-encode-string-for-phrase "mel-q") -(autoload 'q-encoding-encode-string "mel-q") -(autoload 'q-encoding-decode-string "mel-q") -(autoload 'q-encoding-encoded-length "mel-q") - -(autoload 'uuencode-encode-region "mel-u" nil t) -(autoload 'uuencode-decode-region "mel-u" nil t) - -(defvar mime-encoding-method-alist - '(("base64" . base64-encode-region) - ("quoted-printable" . quoted-printable-encode-region) - ("x-uue" . uuencode-encode-region) - ("7bit") - ("8bit") - ("binary") - )) - -(defvar mime-decoding-method-alist - '(("base64" . base64-decode-region) - ("quoted-printable" . quoted-printable-decode-region) - ("x-uue" . uuencode-decode-region) - )) +(require 'mime-def) +(require 'poem) + +(defcustom mime-encoding-list + '("7bit" "8bit" "binary" "base64" "quoted-printable") + "List of Content-Transfer-Encoding. Each encoding must be string." + :group 'mime + :type '(repeat string)) + +(defun mime-encoding-list (&optional service) + "Return list of Content-Transfer-Encoding. +If SERVICE is specified, it returns available list of +Content-Transfer-Encoding for it." + (if service + (let (dest) + (mapatoms (lambda (sym) + (or (eq sym nil) + (setq dest (cons (symbol-name sym) dest))) + ) + (symbol-value (intern (format "%s-obarray" service)))) + (let ((rest mel-encoding-module-alist) + pair) + (while (setq pair (car rest)) + (let ((key (car pair))) + (or (member key dest) + (<= (length key) 1) + (setq dest (cons key dest)))) + (setq rest (cdr rest))) + ) + dest) + mime-encoding-list)) + +(defun mime-encoding-alist (&optional service) + "Return table of Content-Transfer-Encoding for completion." + (mapcar #'list (mime-encoding-list service)) + ) + +(defsubst mel-use-module (name encodings) + (let (encoding) + (while (setq encoding (car encodings)) + (set-alist 'mel-encoding-module-alist + encoding + (cons name (cdr (assoc encoding mel-encoding-module-alist)))) + (setq encodings (cdr encodings)) + ))) + +(defsubst mel-find-function (service encoding) + (mel-find-function-from-obarray + (symbol-value (intern (format "%s-obarray" service))) encoding)) + + +;;; @ setting for modules +;;; + +(mel-define-backend "7bit") +(mel-define-method-function (mime-encode-string string (nil "7bit")) + 'identity) +(mel-define-method-function (mime-decode-string string (nil "7bit")) + 'identity) +(mel-define-method mime-encode-region (start end (nil "7bit"))) +(mel-define-method mime-decode-region (start end (nil "7bit"))) +(mel-define-method-function (mime-insert-encoded-file filename (nil "7bit")) + 'insert-file-contents-as-binary) +(mel-define-method-function (mime-write-decoded-region + start end filename (nil "7bit")) + 'write-region-as-binary) + +(mel-define-backend "8bit" ("7bit")) + +(mel-define-backend "binary" ("8bit")) + +(when (and (fboundp 'base64-encode-string) + (subrp (symbol-function 'base64-encode-string))) + (mel-define-backend "base64") + (mel-define-method-function (mime-encode-string string (nil "base64")) + 'base64-encode-string) + (mel-define-method-function (mime-decode-string string (nil "base64")) + 'base64-decode-string) + (mel-define-method-function (mime-encode-region start end (nil "base64")) + 'base64-encode-region) + (mel-define-method-function (mime-decode-region start end (nil "base64")) + 'base64-decode-region) + (mel-define-method mime-insert-encoded-file (filename (nil "base64")) + "Encode contents of file FILENAME to base64, and insert the result. +It calls external base64 encoder specified by +`base64-external-encoder'. So you must install the program (maybe +mmencode included in metamail or XEmacs package)." + (interactive (list (read-file-name "Insert encoded file: "))) + (insert (base64-encode-string + (with-temp-buffer + (set-buffer-multibyte nil) + (insert-file-contents-as-binary filename) + (buffer-string)))) + (or (bolp) + (insert "\n")) + ) + + (mel-define-method-function (encoded-text-encode-string string (nil "B")) + 'base64-encode-string) + (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-decode-string string) + (error "Invalid encoded-text %s" string))) + ) + +(mel-use-module 'mel-b-el '("base64" "B")) +(mel-use-module 'mel-q '("quoted-printable" "Q")) +(mel-use-module 'mel-g '("x-gzip64")) +(mel-use-module 'mel-u '("x-uue" "x-uuencode")) + +(defvar mel-b-ccl-module + (and (featurep 'mule) + (progn + (require 'path-util) + (module-installed-p 'mel-b-ccl) + ))) + +(defvar mel-q-ccl-module + (and (featurep 'mule) + (progn + (require 'path-util) + (module-installed-p 'mel-q-ccl) + ))) + +(if mel-b-ccl-module + (mel-use-module 'mel-b-ccl '("base64" "B")) + ) + +(if mel-q-ccl-module + (mel-use-module 'mel-q-ccl '("quoted-printable" "Q")) + ) + +(if base64-dl-module + (mel-use-module 'mel-b-dl '("base64" "B")) + ) ;;; @ region ;;; -(defun mime/encode-region (encoding beg end) - "Encode region BEG to END of current buffer using ENCODING. [mel.el]" +;;;###autoload +(defun mime-encode-region (start end encoding) + "Encode region START to END of current buffer using ENCODING. +ENCODING must be string." (interactive - (list (completing-read "encoding: " - mime-encoding-method-alist - nil t "base64") - (region-beginning) (region-end)) - ) - (let ((f (cdr (assoc encoding mime-encoding-method-alist)))) - (if f - (funcall f beg end) - ))) + (list (region-beginning) (region-end) + (completing-read "encoding: " + (mime-encoding-alist) + nil t "base64"))) + (funcall (mel-find-function 'mime-encode-region encoding) start end) + ) -(defun mime/decode-region (encoding beg end) - "Decode region BEG to END of current buffer using ENCODING. [mel.el]" + +;;;###autoload +(defun mime-decode-region (start end encoding) + "Decode region START to END of current buffer using ENCODING. +ENCODING must be string." (interactive - (list (completing-read "encoding: " - mime-decoding-method-alist - nil t "base64") - (region-beginning) (region-end)) - ) - (let ((f (cdr (assoc encoding mime-decoding-method-alist)))) - (if f - (funcall f beg end) - ))) + (list (region-beginning) (region-end) + (completing-read "encoding: " + (mime-encoding-alist 'mime-decode-region) + nil t "base64"))) + (funcall (mel-find-function 'mime-decode-region encoding) + start end)) + + +;;; @ string +;;; + +;;;###autoload +(defun mime-decode-string (string encoding) + "Decode STRING using ENCODING. +ENCODING must be string. If ENCODING is found in +`mime-string-decoding-method-alist' as its key, this function decodes +the STRING by its value." + (funcall (mel-find-function 'mime-decode-string encoding) + string)) + -(defalias 'mime-encode-region 'mime/encode-region) -(defalias 'mime-decode-region 'mime/decode-region) +(mel-define-service encoded-text-encode-string (string encoding) + "Encode STRING as encoded-text using ENCODING. +ENCODING must be string.") + +(mel-define-service encoded-text-decode-string (string encoding) + "Decode STRING as encoded-text using ENCODING. +ENCODING must be string.") + +(defun base64-encoded-length (string) + (* (/ (+ (length string) 2) 3) 4)) + +(defsubst Q-encoding-printable-char-p (chr mode) + (and (not (memq chr '(?= ?? ?_))) + (<= ?\ chr)(<= chr ?~) + (cond ((eq mode 'text) t) + ((eq mode 'comment) + (not (memq chr '(?\( ?\) ?\\))) + ) + (t + (string-match "[A-Za-z0-9!*+/=_---]" (char-to-string chr)) + )))) + +(defun Q-encoded-text-length (string &optional mode) + (let ((l 0)(i 0)(len (length string)) chr) + (while (< i len) + (setq chr (elt string i)) + (if (Q-encoding-printable-char-p chr mode) + (setq l (+ l 1)) + (setq l (+ l 3)) + ) + (setq i (+ i 1)) ) + l)) + + +;;; @ file +;;; + +;;;###autoload +(defun mime-insert-encoded-file (filename encoding) + "Insert file FILENAME encoded by ENCODING format." + (interactive + (list (read-file-name "Insert encoded file: ") + (completing-read "encoding: " + (mime-encoding-alist) + nil t "base64"))) + (funcall (mel-find-function 'mime-insert-encoded-file encoding) + filename)) + + +;;;###autoload +(defun mime-write-decoded-region (start end filename encoding) + "Decode and write current region encoded by ENCODING into FILENAME. +START and END are buffer positions." + (interactive + (list (region-beginning) (region-end) + (read-file-name "Write decoded region to file: ") + (completing-read "encoding: " + (mime-encoding-alist 'mime-write-decoded-region) + nil t "base64"))) + (funcall (mel-find-function 'mime-write-decoded-region encoding) + start end filename)) ;;; @ end ;;; (provide 'mel) + +;;; mel.el ends here.