X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;ds=sidebyside;f=mel-b.el;h=dd59d7e6a05165d339db2e435e56b2aedb258a11;hb=cea3b3e3aebf6721624f40f3d23bfb56f299848b;hp=e8fcabad10380cfc91a29594b50804ebe6e7b838;hpb=d45720e98a56a7646e60dd7a098c7fcc0334f195;p=elisp%2Fflim.git

diff --git a/mel-b.el b/mel-b.el
index e8fcaba..dd59d7e 100644
--- a/mel-b.el
+++ b/mel-b.el
@@ -1,6 +1,33 @@
-;;;
-;;; $Id: mel-b.el,v 3.0 1995/11/02 04:14:51 morioka Exp $
-;;;
+;;; mel-b.el: Base64 encoder/decoder for GNU Emacs
+
+;; 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>
+;; Created: 1995/6/24
+;; Keywords: MIME, Base64
+
+;; 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 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:
+
+(require 'emu)
+
 
 ;;; @ variables
 ;;;
@@ -11,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,
@@ -50,39 +80,49 @@ external decoder is called.")
 ;;; @@ encode/decode one base64 unit
 ;;;
 
-(defun base64-mask (i n) (logand i (1- (ash 1 n))))
-
-(defun base64-encode-1 (a &optional b &optional c)
-  (cons (ash a -2)
-	(cons (logior (ash (base64-mask a 2) (- 6 2))
-		      (if b (ash b -4) 0))
-	      (if b
-		  (cons (logior (ash (base64-mask b 4) (- 6 4))
-				(if c (ash c -6) 0))
-			(if c
-			    (cons (base64-mask c (- 6 0))
-				  nil)))))))
-
-(defun base64-decode-1 (a b &optional c &optional d)
-  (cons (logior (ash a 2) (ash b (- 2 6)))
-	(if c (cons (logior (ash (base64-mask b 4) 4)
-			    (base64-mask (ash c (- 4 6)) 4))
-		    (if d (cons (logior (ash (base64-mask c 2) 6) d)
-				nil))))))
-
-(defun base64-encode-chars (a &optional b &optional c)
-  (mapcar (function base64-num-to-char) (base64-encode-1 a b c)))
-
-(defun base64-decode-chars (&rest args)
-  (apply (function base64-decode-1)
-	 (mapcar (function base64-char-to-num) args)
-	 ))
-
-
-;;; @@ encode/decode base64 string
+(defun base64-encode-1 (pack)
+  (let ((a (car pack))
+	(b (nth 1 pack))
+	(c (nth 2 pack)))
+    (concat
+     (char-to-string (base64-num-to-char (ash a -2)))
+     (if b
+	 (concat
+	  (char-to-string
+	   (base64-num-to-char (logior (ash (logand a 3) 4) (ash b -4))))
+	  (if c
+	      (concat
+	       (char-to-string
+		(base64-num-to-char (logior (ash (logand b 15) 2) (ash c -6))))
+	       (char-to-string (base64-num-to-char (logand c 63)))
+	       )
+	    (concat (char-to-string
+		     (base64-num-to-char (ash (logand b 15) 2))) "=")
+	    ))
+       (concat (char-to-string
+		(base64-num-to-char (ash (logand a 3) 4))) "==")
+       ))))
+
+(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
 ;;;
 
 (defun base64-encode-string (string)
+  "Encode STRING to base64, and return the result."
   (let ((len (length string))
 	(b 0)(e 57)
 	dest)
@@ -90,12 +130,7 @@ external decoder is called.")
       (setq dest
 	    (concat dest
 		    (mapconcat
-		     (function
-		      (lambda (pack)
-			(mapconcat (function char-to-string)
-				   (apply (function base64-encode-chars) pack)
-				   "")
-			))
+		     (function base64-encode-1)
 		     (pack-sequence (substring string b e) 3)
 		     "")
 		    "\n"))
@@ -104,12 +139,7 @@ external decoder is called.")
 	    )
       )
     (let* ((es (mapconcat
-		(function
-		 (lambda (pack)
-		   (mapconcat (function char-to-string)
-			      (apply (function base64-encode-chars) pack)
-			      "")
-		   ))
+		(function base64-encode-1)
 		(pack-sequence (substring string b) 3)
 		""))
 	   (m (mod (length es) 4))
@@ -119,18 +149,49 @@ external decoder is called.")
 			    ))
       )))
 
-(defun base64-decode-string (string)
-  (mapconcat (function
-	      (lambda (pack)
-		(mapconcat (function char-to-string)
-			   (apply (function base64-decode-chars) pack)
-			   "")
-		))
-	     (pack-sequence string 4)
-	     ""))
-
-
-;;; @ encode/decode base64 region
+(defun base64-internal-decode-string (string)
+  "Decode STRING which is encoded in base64, and return the result."
+  (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))
+
+(defalias 'base64-decode-string 'base64-internal-decode-string)
+
+
+;;; @ base64 encoder/decoder for region
 ;;;
 
 (defun base64-internal-encode-region (beg end)
@@ -148,41 +209,19 @@ 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 (search-forward "\n" nil t)
-	(replace-match "")
-	)
-      (let ((str (buffer-substring (point-min)(point-max))))
-	(delete-region (point-min)(point-max))
-	(insert (base64-decode-string str))
-	))))
-
-(cond ((boundp 'MULE)
-       (define-program-coding-system
-	 nil (car base64-external-encoder) *noconv*)
-       (define-program-coding-system
-	 nil (car base64-external-decoder) *noconv*)
-       )
-      ((boundp 'NEMACS)
-       (define-program-kanji-code
-	 nil (car base64-external-encoder) 0)
-       (define-program-kanji-code
-	 nil (car base64-external-decoder) 0)
-       ))
+    (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
     (save-restriction
       (narrow-to-region beg end)
-      (let ((selective-display nil) ;Disable ^M to nl translation.
-	    (mc-flag nil)      ;Mule
-	    (kanji-flag nil))  ;NEmacs
-	(apply (function call-process-region)
-	       beg end (car base64-external-encoder)
-	       t t nil (cdr base64-external-encoder))
-	)
+      (as-binary-process (apply (function call-process-region)
+				beg end (car base64-external-encoder)
+				t t nil (cdr base64-external-encoder))
+			 )
       ;; for OS/2
       ;;   regularize line break code
       (goto-char (point-min))
@@ -193,31 +232,71 @@ external decoder is called.")
 
 (defun base64-external-decode-region (beg end)
   (save-excursion
-    (let ((selective-display nil) ;Disable ^M to nl translation.
-	  (mc-flag nil)      ;Mule
-	  (kanji-flag nil))  ;NEmacs
-      (apply (function call-process-region)
-	     beg end (car base64-external-decoder)
-	     t t nil (cdr base64-external-decoder))
-      )))
-
-(defun base64-encode-region (beg end)
+    (as-binary-process (apply (function call-process-region)
+			      beg end (car base64-external-decoder)
+			      t t nil (cdr base64-external-decoder))
+		       )))
+
+(defun base64-encode-region (start end)
+  "Encode current region by base64.
+START and END are buffer positions.
+This function calls internal base64 encoder if size of region is
+smaller than `base64-internal-encoding-limit', otherwise it calls
+external base64 encoder specified by `base64-external-encoder'.  In
+this case, you must install the program (maybe mmencode included in
+metamail or XEmacs package)."
   (interactive "r")
   (if (and base64-internal-encoding-limit
-	   (> (- end beg) base64-internal-encoding-limit))
-      (base64-external-encode-region beg end)
-    (base64-internal-encode-region beg end)
+	   (> (- end start) base64-internal-encoding-limit))
+      (base64-external-encode-region start end)
+    (base64-internal-encode-region start end)
     ))
 
-(defun base64-decode-region (beg end)
+(defun base64-decode-region (start end)
+  "Decode current region by base64.
+START and END are buffer positions.
+This function calls internal base64 decoder if size of region 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
-	   (> (- end beg) base64-internal-decoding-limit))
-      (base64-external-decode-region beg end)
-    (base64-internal-decode-region beg end)
+	   (> (- end start) base64-internal-decoding-limit))
+      (base64-external-decode-region start end)
+    (base64-internal-decode-region start end)
     ))
 
 
+;;; @ base64 encoder/decoder for file
+;;;
+
+(defun base64-insert-encoded-file (filename)
+  "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: ")))
+  (apply (function call-process) (car base64-external-encoder)
+	 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
 ;;;
 
@@ -252,4 +331,10 @@ and return list of packs. [mel-b; tl-seq function]"
     (reverse dest)
     ))
 
+
+;;; @ end
+;;;
+
 (provide 'mel-b)
+
+;;; mel-b.el ends here.