From bd3cf8adc97c7c40859b136a2cedafb989dab298 Mon Sep 17 00:00:00 2001 From: morioka Date: Sat, 19 Sep 1998 17:46:22 +0000 Subject: [PATCH] (mel-encoding-module-alist): New variable. (mel-use-module): New function. (mel-find-function): New function. (mel-define-service): New macro. (mime-encode-region): Use `mel-find-function'; abolish variable `mime-encoding-method-alist'. (mime-decode-region): Use `mel-find-function'; abolish variable `mime-decoding-method-alist'. (mime-decode-string): Use `mel-find-function'; abolish variable `mime-string-decoding-method-alist'. (encoded-text-encode-string): New function. (encoded-text-decode-string): New function. (base64-encoded-length): New function (moved from mel-b.el and mel-dl.el). (Q-encoding-printable-char-p): New function (moved from mel-q.el, and renamed from `q-encoding-printable-char-p'). (Q-encoded-text-length): New function (moved from mel-q.el, and renamed from `q-encoding-encoded-length'). (mime-insert-encoded-file): Use `mel-find-function'; abolish variable `mime-file-encoding-method-alist'. (mime-write-decoded-region): Use `mel-find-function'; abolish variable `mime-file-decoding-method-alist'. --- mel.el | 318 ++++++++++++++++++++++++++++------------------------------------ 1 file changed, 139 insertions(+), 179 deletions(-) diff --git a/mel.el b/mel.el index 2ed43a4..b9d9f76 100644 --- a/mel.el +++ b/mel.el @@ -27,9 +27,46 @@ ;;; Code: (require 'emu) +(require 'mime-def) +(defvar mel-encoding-module-alist nil) -;;; @ variable +(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) + (let* ((oba (symbol-value (intern (format "%s-obarray" service)))) + (f (intern-soft encoding oba))) + (or f + (let ((rest (cdr (assoc encoding mel-encoding-module-alist)))) + (while (and rest + (progn + (require (car rest)) + (null (setq f (intern-soft encoding oba))) + )) + (setq rest (cdr rest)) + ) + f)))) + +(defmacro mel-define-service (name args &rest rest) + `(progn + (defvar ,(intern (format "%s-obarray" name)) [nil]) + (defun ,name ,args + ,@rest + (funcall (mel-find-function ',name ,(car (last args))) + ,@(mm-arglist-to-arguments (butlast args))) + ))) + +(put 'mel-define-service 'lisp-indent-function 'defun) + + +;;; @ setting for modules ;;; (defvar base64-dl-module @@ -39,114 +76,57 @@ path)))) -;;; @ autoload -;;; - -(cond (base64-dl-module - (autoload 'base64-encode-string "mel-dl" - "Encode STRING to base64, and return the result.") - (autoload 'base64-decode-string "mel-dl" - "Decode STRING which is encoded in base64, and return the result.") - (autoload 'base64-encode-region "mel-dl" - "Encode current region by base64." t) - (autoload 'base64-decode-region "mel-dl" - "Decode current region by base64." t) - (autoload 'base64-insert-encoded-file "mel-dl" - "Encode contents of file to base64, and insert the result." t) - (autoload 'base64-write-decoded-region "mel-dl" - "Decode and write current region encoded by base64 into FILENAME." t) - ;; for encoded-word - (autoload 'base64-encoded-length "mel-dl") - ) - (t - (autoload 'base64-encode-string "mel-b" - "Encode STRING to base64, and return the result.") - (autoload 'base64-decode-string "mel-b" - "Decode STRING which is encoded in base64, and return the result.") - (autoload 'base64-encode-region "mel-b" - "Encode current region by base64." t) - (autoload 'base64-decode-region "mel-b" - "Decode current region by base64." t) - (autoload 'base64-insert-encoded-file "mel-b" - "Encode contents of file to base64, and insert the result." t) - (autoload 'base64-write-decoded-region "mel-b" - "Decode and write current region encoded by base64 into FILENAME." t) - ;; for encoded-word - (autoload 'base64-encoded-length "mel-b") - )) - -(autoload 'quoted-printable-encode-string "mel-q" - "Encode STRING to quoted-printable, and return the result.") -(autoload 'quoted-printable-decode-string "mel-q" - "Decode STRING which is encoded in quoted-printable, and return the result.") -(autoload 'quoted-printable-encode-region "mel-q" - "Encode current region by Quoted-Printable." t) -(autoload 'quoted-printable-decode-region "mel-q" - "Decode current region by Quoted-Printable." t) -(autoload 'quoted-printable-insert-encoded-file "mel-q" - "Encode contents of file to quoted-printable, and insert the result." t) -(autoload 'quoted-printable-write-decoded-region "mel-q" - "Decode and write current region encoded by quoted-printable into FILENAME." - t) -;; for encoded-word -(autoload 'q-encoding-encode-string "mel-q" - "Encode STRING to Q-encoding of encoded-word, and return the result.") -(autoload 'q-encoding-decode-string "mel-q" - "Decode STRING which is encoded in Q-encoding and return the result.") -(autoload 'q-encoding-encoded-length "mel-q") - -(autoload 'uuencode-encode-region "mel-u" - "Encode current region by unofficial uuencode format." t) -(autoload 'uuencode-decode-region "mel-u" - "Decode current region by unofficial uuencode format." t) -(autoload 'uuencode-insert-encoded-file "mel-u" - "Insert file encoded by unofficial uuencode format." t) -(autoload 'uuencode-write-decoded-region "mel-u" - "Decode and write current region encoded by uuencode into FILENAME." t) - -(autoload 'gzip64-encode-region "mel-g" - "Encode current region by unofficial x-gzip64 format." t) -(autoload 'gzip64-decode-region "mel-g" - "Decode current region by unofficial x-gzip64 format." t) -(autoload 'gzip64-insert-encoded-file "mel-g" - "Insert file encoded by unofficial gzip64 format." t) -(autoload 'gzip64-write-decoded-region "mel-g" - "Decode and write current region encoded by gzip64 into FILENAME." t) +(mel-use-module 'mel-b '("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")) + +(if base64-dl-module + (mel-use-module 'mel-dl '("base64" "B")) + ) + + +(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-method-function (mime-encode-string string (nil "8bit")) + 'identity) +(mel-define-method-function (mime-decode-string string (nil "8bit")) + 'identity) +(mel-define-method mime-encode-region (start end (nil "8bit"))) +(mel-define-method mime-decode-region (start end (nil "8bit"))) +(mel-define-method-function (mime-insert-encoded-file filename (nil "8bit")) + 'insert-file-contents-as-binary) +(mel-define-method-function (mime-write-decoded-region + start end filename (nil "8bit")) + 'write-region-as-binary) + +(mel-define-method-function (mime-encode-string string (nil "binary")) + 'identity) +(mel-define-method-function (mime-decode-string string (nil "binary")) + 'identity) +(mel-define-method mime-encode-region (start end (nil "binary"))) +(mel-define-method mime-decode-region (start end (nil "binary"))) +(mel-define-method-function (mime-insert-encoded-file filename (nil "binary")) + 'insert-file-contents-as-binary) +(mel-define-method-function (mime-write-decoded-region + start end filename (nil "binary")) + 'write-region-as-binary) ;;; @ region ;;; ;;;###autoload -(defvar mime-encoding-method-alist - '(("base64" . base64-encode-region) - ("quoted-printable" . quoted-printable-encode-region) - ;; Not standard, their use is DISCOURAGED. - ;; ("x-uue" . uuencode-encode-region) - ;; ("x-gzip64" . gzip64-encode-region) - ("7bit") - ("8bit") - ("binary") - ) - "Alist of encoding vs. corresponding method to encode region. -Each element looks like (STRING . FUNCTION) or (STRING . nil). -STRING is content-transfer-encoding. -FUNCTION is region encoder and nil means not to encode.") - -;;;###autoload -(defvar mime-decoding-method-alist - '(("base64" . base64-decode-region) - ("quoted-printable" . quoted-printable-decode-region) - ("x-uue" . uuencode-decode-region) - ("x-uuencode" . uuencode-decode-region) - ("x-gzip64" . gzip64-decode-region) - ) - "Alist of encoding vs. corresponding method to decode region. -Each element looks like (STRING . FUNCTION). -STRING is content-transfer-encoding. -FUNCTION is region decoder.") - -;;;###autoload (defun mime-encode-region (start end encoding) "Encode region START to END of current buffer using ENCODING. ENCODING must be string. If ENCODING is found in @@ -155,13 +135,12 @@ region by its value." (interactive (list (region-beginning) (region-end) (completing-read "encoding: " - mime-encoding-method-alist - nil t "base64")) - ) - (let ((f (cdr (assoc encoding mime-encoding-method-alist)))) - (if f - (funcall f start end) - ))) + mel-encoding-module-alist + nil t "base64"))) + (funcall (mel-find-function 'mime-encode-region (or encoding "7bit")) + start end) + ) + ;;;###autoload (defun mime-decode-region (start end encoding) @@ -172,94 +151,77 @@ region by its value." (interactive (list (region-beginning) (region-end) (completing-read "encoding: " - mime-decoding-method-alist - nil t "base64")) - ) - (let ((f (cdr (assoc encoding mime-decoding-method-alist)))) - (if f - (funcall f start end) - ))) + mel-encoding-module-alist + nil t "base64"))) + (funcall (mel-find-function 'mime-decode-region encoding) + start end)) ;;; @ string ;;; ;;;###autoload -(defvar mime-string-decoding-method-alist - '(("base64" . base64-decode-string) - ("quoted-printable" . quoted-printable-decode-string) - ("7bit" . identity) - ("8bit" . identity) - ("binary" . identity) - ) - "Alist of encoding vs. corresponding method to decode string. -Each element looks like (STRING . FUNCTION). -STRING is content-transfer-encoding. -FUNCTION is string decoder.") - -;;;###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." - (let ((f (cdr (assoc encoding mime-string-decoding-method-alist)))) - (if f - (funcall f string) - (with-temp-buffer - (insert string) - (mime-decode-region (point-min)(point-max) encoding) - (buffer-string) - )))) + (funcall (mel-find-function 'mime-decode-string encoding) + string)) + + +(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) + (let ((len (length string))) + (* (+ (/ len 3) + (if (= (mod len 3) 0) 0 1) + ) 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 -(defvar mime-file-encoding-method-alist - '(("base64" . base64-insert-encoded-file) - ("quoted-printable" . quoted-printable-insert-encoded-file) - ;; Not standard, their use is DISCOURAGED. - ;; ("x-uue" . uuencode-insert-encoded-file) - ;; ("x-gzip64" . gzip64-insert-encoded-file) - ("7bit" . insert-file-contents-as-binary) - ("8bit" . insert-file-contents-as-binary) - ("binary" . insert-file-contents-as-binary) - ) - "Alist of encoding vs. corresponding method to insert encoded file. -Each element looks like (STRING . FUNCTION). -STRING is content-transfer-encoding. -FUNCTION is function to insert encoded file.") - -;;;###autoload -(defvar mime-file-decoding-method-alist - '(("base64" . base64-write-decoded-region) - ("quoted-printable" . quoted-printable-write-decoded-region) - ("x-uue" . uuencode-write-decoded-region) - ("x-gzip64" . gzip64-write-decoded-region) - ("7bit" . write-region-as-binary) - ("8bit" . write-region-as-binary) - ("binary" . write-region-as-binary) - ) - "Alist of encoding vs. corresponding method to write decoded region to file. -Each element looks like (STRING . FUNCTION). -STRING is content-transfer-encoding. -FUNCTION is function to write decoded region to 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-method-alist - nil t "base64")) - ) - (let ((f (cdr (assoc encoding mime-file-encoding-method-alist)))) - (if f - (funcall f filename) - ))) + nil t "base64"))) + (funcall (mel-find-function 'mime-insert-encoded-file encoding) + filename)) + ;;;###autoload (defun mime-write-decoded-region (start end filename encoding) @@ -271,10 +233,8 @@ START and END are buffer positions." (completing-read "encoding: " mime-file-decoding-method-alist nil t "base64"))) - (let ((f (cdr (assoc encoding mime-file-decoding-method-alist)))) - (if f - (funcall f start end filename) - ))) + (funcall (mel-find-function 'mime-insert-encoded-file encoding) + start end filename)) ;;; @ end -- 1.7.10.4