* mime-def.el (mime-library-version-string): bump up to 1.9.1.
[elisp/flim.git] / mel-b.el
index 1ea0cb4..e9a382a 100644 (file)
--- a/mel-b.el
+++ b/mel-b.el
@@ -1,12 +1,10 @@
 ;;; mel-b.el: Base64 encoder/decoder for GNU Emacs
 
-;; Copyright (C) 1992,1995,1996,1997 Free Software Foundation, Inc.
+;; Copyright (C) 1992,1995,1996,1997,1998 Free Software Foundation, Inc.
 
 ;; Author: ENAMI Tsugutomo <enami@sys.ptg.sony.co.jp>
 ;;         MORIOKA Tomohiko <morioka@jaist.ac.jp>
-;; Maintainer: MORIOKA Tomohiko <morioka@jaist.ac.jp>
 ;; Created: 1995/6/24
-;; Version: $Id: mel-b.el,v 6.3 1997/04/30 17:17:42 morioka Exp $
 ;; Keywords: MIME, Base64
 
 ;; This file is part of MEL (MIME Encoding Library).
@@ -40,6 +38,9 @@
 (defvar base64-external-decoder '("mmencode" "-u")
   "*list of base64 decoder program name and its arguments.")
 
+(defvar base64-external-decoder-option-to-specify-file '("-o")
+  "*list of options of base64 decoder program to specify file.")
+
 (defvar base64-internal-encoding-limit 1000
   "*limit size to use internal base64 encoder.
 If size of input to encode is larger than this limit,
@@ -102,18 +103,19 @@ external decoder is called.")
                (base64-num-to-char (ash (logand a 3) 4))) "==")
        ))))
 
-(defun base64-decode-1 (pack)
-  (let ((a (base64-char-to-num (car pack)))
-       (b (base64-char-to-num (nth 1 pack)))
-       (c (nth 2 pack))
-       (d (nth 3 pack)))
-    (concat (char-to-string (logior (ash a 2) (ash b -4)))
-           (if (and c (setq c (base64-char-to-num c)))
-               (concat (char-to-string
-                        (logior (ash (logand b 15) 4) (ash c -2)))
-                       (if (and d (setq d (base64-char-to-num d)))
-                           (char-to-string (logior (ash (logand c 3) 6) d))
-                         ))))))
+(defun base64-decode-unit (a b &optional c d)
+  (condition-case err
+      (concat
+       (char-to-string (logior (ash (base64-char-to-num a) 2)
+                              (ash (setq b (base64-char-to-num b)) -4)))
+       (if (and c (setq c (base64-char-to-num c)))
+          (concat (char-to-string
+                   (logior (ash (logand b 15) 4) (ash c -2)))
+                  (if (and d (setq d (base64-char-to-num d)))
+                      (char-to-string (logior (ash (logand c 3) 6) d))
+                    ))))
+    (error (message (nth 1 err))
+          "")))
 
 
 ;;; @@ base64 encoder/decoder for string
@@ -147,11 +149,43 @@ external decoder is called.")
                            ))
       )))
 
-(defun base64-decode-string (string)
-  "Decode STRING which is encoded in base64, and return the result."
-  (mapconcat (function base64-decode-1)
-            (pack-sequence string 4)
-            ""))
+(defun base64-internal-decode-string (string)
+  (let ((len (length string))
+       (i 0)
+       dest)
+    (while (< i len)
+      (let ((a (aref string i)))
+       (setq i (1+ i))
+       (unless (eq a ?\n)
+         (let ((b (aref string i)))
+           (setq i (1+ i))
+           (cond
+            ((eq b ?\n)
+             ;; invalid
+             )
+            ((>= i len)
+             (setq dest (concat dest (base64-decode-unit a b) ))
+             )
+            (t
+             (let ((c (aref string i)))
+               (setq i (1+ i))
+               (cond
+                ((eq c ?\n)
+                 (setq dest (concat dest (base64-decode-unit a b)))
+                 )
+                ((>= i len)
+                 (setq dest (concat dest (base64-decode-unit a b c)))
+                 )
+                (t
+                 (let ((d (aref string i)))
+                   (setq i (1+ i))
+                   (setq dest
+                         (concat dest
+                                 (if (eq c ?\n)
+                                     (base64-decode-unit a b c)
+                                   (base64-decode-unit a b c d))))
+                   ))))))))))
+    dest))
 
 
 ;;; @ base64 encoder/decoder for region
@@ -172,31 +206,10 @@ external decoder is called.")
 
 (defun base64-internal-decode-region (beg end)
   (save-excursion
-    (save-restriction
-      (narrow-to-region beg end)
-      (goto-char (point-min))
-      (while (looking-at ".*\n")
-       (condition-case err
-           (replace-match
-            (base64-decode-string
-             (buffer-substring (match-beginning 0) (1- (match-end 0))))
-            t t)
-         (error
-          (prog1
-              (message (nth 1 err))
-            (replace-match "")))))
-      (if (looking-at ".*$")
-         (condition-case err
-             (replace-match
-              (base64-decode-string
-               (buffer-substring (match-beginning 0) (match-end 0)))
-              t t)
-           (error
-            (prog1
-                (message (nth 1 err))
-              (replace-match "")))
-           ))
-      )))
+    (let ((str (buffer-substring beg end)))
+      (delete-region beg end)
+      (goto-char beg)
+      (insert (base64-internal-decode-string str)))))
 
 (defun base64-external-encode-region (beg end)
   (save-excursion
@@ -221,6 +234,17 @@ external decoder is called.")
                              t t nil (cdr base64-external-decoder))
                       )))
 
+(defun base64-external-decode-string (string)
+  (with-temp-buffer
+    (insert string)
+    (as-binary-process (apply (function call-process-region)
+                             (point-min) (point-max)
+                             (car base64-external-decoder)
+                             t t nil (cdr base64-external-decoder))
+                      )
+    (buffer-string)))
+
+
 (defun base64-encode-region (start end)
   "Encode current region by base64.
 START and END are buffer positions.
@@ -251,6 +275,20 @@ metamail or XEmacs package)."
     (base64-internal-decode-region start end)
     ))
 
+(defun base64-decode-string (string)
+  "Decode STRING which is encoded in base64, and return the result.
+This function calls internal base64 decoder if size of STRING is
+smaller than `base64-internal-decoding-limit', otherwise it calls
+external base64 decoder specified by `base64-external-decoder'.  In
+this case, you must install the program (maybe mmencode included in
+metamail or XEmacs package)."
+  (interactive "r")
+  (if (and base64-internal-decoding-limit
+          (> (length string) base64-internal-decoding-limit))
+      (base64-external-decode-string string)
+    (base64-internal-decode-string string)
+    ))
+
 
 ;;; @ base64 encoder/decoder for file
 ;;;
@@ -265,6 +303,21 @@ mmencode included in metamail or XEmacs package)."
         filename t nil (cdr base64-external-encoder))
   )
 
+(defun base64-write-decoded-region (start end filename)
+  "Decode and write current region encoded by base64 into FILENAME.
+START and END are buffer positions."
+  (interactive
+   (list (region-beginning) (region-end)
+        (read-file-name "Write decoded region to file: ")))
+  (as-binary-process
+   (apply (function call-process-region)
+         start end (car base64-external-decoder)
+         nil nil nil
+         (append (cdr base64-external-decoder)
+                 base64-external-decoder-option-to-specify-file
+                 (list filename))
+         )))
+
 
 ;;; @ etc
 ;;;