From: morioka <morioka>
Date: Sat, 19 Sep 1998 17:46:22 +0000 (+0000)
Subject: (mel-encoding-module-alist): New variable.
X-Git-Tag: chao-1_9-2-199811302358~26
X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=bd3cf8adc97c7c40859b136a2cedafb989dab298;p=elisp%2Fflim.git

(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'.
---

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