This commit was manufactured by cvs2svn to create branch 'doodle'.
[elisp/flim.git] / mel-b.el
index 8a5f79b..ad34a37 100644 (file)
--- a/mel-b.el
+++ b/mel-b.el
 ;;; Code:
 
 (require 'emu)
+(require 'mime-def)
 
 
 ;;; @ variables
 ;;;
 
-(defvar base64-external-encoder '("mmencode")
-  "*list of base64 encoder program name and its arguments.")
+(defgroup base64 nil
+  "Base64 encoder/decoder"
+  :group 'mime)
 
-(defvar base64-external-decoder '("mmencode" "-u")
-  "*list of base64 decoder program name and its arguments.")
+(defcustom base64-external-encoder '("mmencode")
+  "*list of base64 encoder program name and its arguments."
+  :group 'base64
+  :type '(cons (file :tag "Command")(repeat :tag "Arguments" string)))
 
-(defvar base64-external-decoder-option-to-specify-file '("-o")
-  "*list of options of base64 decoder program to specify file.")
+(defcustom base64-external-decoder '("mmencode" "-u")
+  "*list of base64 decoder program name and its arguments."
+  :group 'base64
+  :type '(cons (file :tag "Command")(repeat :tag "Arguments" string)))
 
-(defvar base64-internal-encoding-limit 1000
+(defcustom base64-external-decoder-option-to-specify-file '("-o")
+  "*list of options of base64 decoder program to specify file."
+  :group 'base64
+  :type '(repeat :tag "Arguments" string))
+
+(defcustom base64-internal-encoding-limit 1000
   "*limit size to use internal base64 encoder.
 If size of input to encode is larger than this limit,
-external encoder is called.")
-
-(defvar base64-internal-decoding-limit 1000
+external encoder is called."
+  :group 'base64
+  :type '(choice (const :tag "Always use internal encoder" nil)
+                (integer :tag "Size")))
+
+(defcustom base64-internal-decoding-limit (if (and (featurep 'xemacs)
+                                                  (featurep 'mule))
+                                             1000
+                                           7600)
   "*limit size to use internal base64 decoder.
 If size of input to decode is larger than this limit,
-external decoder is called.")
-
-
-;;; @ internal base64 decoder
-;;;
-
-(defun base64-char-to-num (c)
-  (cond ((and (<= ?A c) (<= c ?Z)) (- c ?A))
-       ((and (<= ?a c) (<= c ?z)) (+ (- c ?a) 26))
-       ((and (<= ?0 c) (<= c ?9)) (+ (- c ?0) 52))
-       ((= c ?+) 62)
-       ((= c ?/) 63)
-       ((= c ?=) nil)
-       (t (error "not a base64 character %c" c))))
-
-(defun base64-internal-decode-string (string)
-  (let* ((len (length string))
-        (i 0)
-        (dest (make-string len 0))
-        (j 0))
-    (catch 'tag
-      (while (< i len)
-       (let ((c (aref string i)))
-         (setq i (1+ i))
-         (unless (memq c '(?\x0d ?\x0a))
-           (let ((v1 (base64-char-to-num c))
-                 (v2 (base64-char-to-num (aref string (prog1 i
-                                                        (setq i (1+ i))))))
-                 (v3 (base64-char-to-num (aref string (prog1 i
-                                                        (setq i (1+ i)))))))
-             (aset dest j (logior (lsh v1 2)(lsh v2 -4)))
-             (setq j (1+ j))
-             (if v3
-                 (let ((v4 (base64-char-to-num (aref string i))))
-                   (setq i (1+ i))
-                   (aset dest j (logior (lsh (logand v2 15) 4)(lsh v3 -2)))
-                   (setq j (1+ j))
-                   (if v4
-                       (aset dest (prog1 j (setq j (1+ j)))
-                             (logior (logand (lsh (logand v3 15) 6) 255)
-                                     v4))
-                     (throw 'tag nil)
-                     ))
-               (throw 'tag nil)
-               ))))))
-    (substring dest 0 j)
-    ))
-
-(defun base64-internal-decode-region (beg end)
-  (save-excursion
-    (let ((str (buffer-substring beg end)))
-      (delete-region beg end)
-      (goto-char beg)
-      (insert (base64-internal-decode-string str)))))
+external decoder is called."
+  :group 'base64
+  :type '(choice (const :tag "Always use internal decoder" nil)
+                (integer :tag "Size")))
 
 
 ;;; @ internal base64 encoder
 ;;;    based on base64 decoder by Enami Tsugutomo
 
-(defun base64-num-to-char (n)
-  (cond ((eq n nil) ?=)
-       ((< n 26) (+ ?A n))
-       ((< n 52) (+ ?a (- n 26)))
-       ((< n 62) (+ ?0 (- n 52)))
-       ((= n 62) ?+)
-       ((= n 63) ?/)
-       (t (error "not a base64 integer %d" n))))
+(eval-and-compile
+  (defconst base64-characters
+    "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/")
+  )
+
+(defmacro base64-num-to-char (n)
+  `(aref base64-characters ,n))
 
 (defun base64-encode-1 (pack)
   (let ((a (car pack))
@@ -182,7 +148,82 @@ external decoder is called.")
       )))
 
 
-;;; @ base64 encoder/decoder for region
+;;; @ internal base64 decoder
+;;;
+
+(defconst base64-numbers
+  (eval-when-compile
+    (let ((len (length base64-characters))
+         (vec (make-vector 123 nil))
+         (i 0))
+      (while (< i len)
+       (aset vec (aref base64-characters i) i)
+       (setq i (1+ i)))
+      vec)))
+
+(defmacro base64-char-to-num (c)
+  `(aref base64-numbers ,c))
+
+(defsubst base64-internal-decode (string buffer)
+  (let* ((len (length string))
+        (i 0)
+        (j 0)
+        v1 v2 v3)
+    (catch 'tag
+      (while (< i len)
+       (when (prog1 (setq v1 (base64-char-to-num (aref string i)))
+               (setq i (1+ i)))
+         (setq v2 (base64-char-to-num (aref string i))
+               i (1+ i)
+               v3 (base64-char-to-num (aref string i))
+               i (1+ i))
+         (aset buffer j (logior (lsh v1 2)(lsh v2 -4)))
+         (setq j (1+ j))
+         (if v3
+             (let ((v4 (base64-char-to-num (aref string i))))
+               (setq i (1+ i))
+               (aset buffer j (logior (lsh (logand v2 15) 4)(lsh v3 -2)))
+               (setq j (1+ j))
+               (if v4
+                   (aset buffer (prog1 j (setq j (1+ j)))
+                         (logior (lsh (logand v3 3) 6) v4))
+                 (throw 'tag nil)
+                 ))
+           (throw 'tag nil)
+           ))))
+    (substring buffer 0 j)
+    ))
+
+(defun base64-internal-decode-string (string)
+  (base64-internal-decode string (make-string (length string) 0)))
+
+;; (defsubst base64-decode-string! (string)
+;;   (setq string (string-as-unibyte string))
+;;   (base64-internal-decode string string))
+
+(defun base64-internal-decode-region (beg end)
+  (save-excursion
+    (let ((str (string-as-unibyte (buffer-substring beg end))))
+      (delete-region beg end)
+      (goto-char beg)
+      (insert (base64-internal-decode str str)))))
+
+;; (defun base64-internal-decode-region2 (beg end)
+;;   (save-excursion
+;;     (let ((str (buffer-substring beg end)))
+;;       (delete-region beg end)
+;;       (goto-char beg)
+;;       (insert (base64-decode-string! str)))))
+
+;; (defun base64-internal-decode-region3 (beg end)
+;;   (save-excursion
+;;     (let ((str (buffer-substring beg end)))
+;;       (delete-region beg end)
+;;       (goto-char beg)
+;;       (insert (base64-internal-decode-string str)))))
+
+
+;;; @ external encoder/decoder
 ;;;
 
 (defun base64-external-encode-region (beg end)
@@ -219,6 +260,9 @@ external decoder is called.")
     (buffer-string)))
 
 
+;;; @ application interfaces
+;;;
+
 (defun base64-encode-region (start end)
   "Encode current region by base64.
 START and END are buffer positions.
@@ -261,8 +305,23 @@ metamail or XEmacs package)."
     (base64-internal-decode-string string)))
 
 
-;;; @ base64 encoder/decoder for file
-;;;
+(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-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)))
 
 (defun base64-insert-encoded-file (filename)
   "Encode contents of file FILENAME to base64, and insert the result.
@@ -278,12 +337,16 @@ mmencode included in metamail or XEmacs package)."
     (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 (mime-insert-encoded-file filename (nil "base64"))
+                           'base64-insert-encoded-file)
+
 (defun base64-write-decoded-region (start end filename)
   "Decode and write current region encoded by base64 into FILENAME.
 START and END are buffer positions."
@@ -302,18 +365,17 @@ START and END are buffer positions."
     (let ((str (buffer-substring start end)))
       (with-temp-buffer
        (insert (base64-internal-decode-string str))
-       (write-region-as-binary (point-min) (point-max) filename)))))
+       (write-region-as-binary (point-min) (point-max) filename)
+       ))))
+
+(mel-define-method-function
+ (mime-write-decoded-region start end filename (nil "base64"))
+ 'base64-write-decoded-region)
+
        
 ;;; @ etc
 ;;;
 
-(defun base64-encoded-length (string)
-  (let ((len (length string)))
-    (* (+ (/ len 3)
-         (if (= (mod len 3) 0) 0 1)
-         ) 4)
-    ))
-
 (defun pack-sequence (seq size)
   "Split sequence SEQ into SIZE elements packs,
 and return list of packs. [mel-b; tl-seq function]"