diff lisp/w3/base64.el @ 14:9ee227acff29 r19-15b90

Import from CVS: tag r19-15b90
author cvs
date Mon, 13 Aug 2007 08:48:42 +0200
parents
children 0293115a14e9
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/w3/base64.el	Mon Aug 13 08:48:42 2007 +0200
@@ -0,0 +1,193 @@
+;;; base64.el,v --- Base64 encoding functions
+;; Author: wmperry
+;; Created: 1996/04/22 15:08:08
+;; Version: 1.7
+;; Keywords: extensions
+
+;;; LCD Archive Entry:
+;;; base64.el|William M. Perry|wmperry@cs.indiana.edu|
+;;; Package for encoding/decoding base64 data (MIME)|
+;;; 1996/04/22 15:08:08|1.7|Location Undetermined
+;;;
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Copyright (c) 1996 Free Software Foundation, Inc.
+;;; Copyright (c) 1995, 1996 by William M. Perry (wmperry@cs.indiana.edu)
+;;;
+;;; This file is not part of GNU Emacs, but the same permissions apply.
+;;;
+;;; GNU Emacs 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.
+;;;
+;;; GNU Emacs 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.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Base 64 encoding functions
+;;; This code was converted to lisp code by me from the C code in
+;;; ftp://cs.utk.edu/pub/MIME/b64encode.c
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defvar base64-code-string
+  "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
+  "Character set used for base64 decoding")
+
+(defvar base64-decode-vector
+  (let ((vec (make-vector 256 nil))
+	(i 0)
+	(case-fold-search nil))
+    (while (< i 256)
+      (aset vec i (string-match (regexp-quote (char-to-string i))
+				base64-code-string))
+      (setq i (1+ i)))
+    vec))
+
+(defvar base64-max-line-length 64)
+
+;(defun b0 (x) (aref base64-code-string (logand (lsh x -18) 63)))
+;(defun b1 (x) (aref base64-code-string (logand (lsh x -12) 63)))
+;(defun b2 (x) (aref base64-code-string (logand (lsh x -6) 63)))
+;(defun b3 (x) (aref base64-code-string (logand x 63)))
+
+(defmacro b0 (x) (` (aref base64-code-string (logand (lsh (, x) -18) 63))))
+(defmacro b1 (x) (` (aref base64-code-string (logand (lsh (, x) -12) 63))))
+(defmacro b2 (x) (` (aref base64-code-string (logand (lsh (, x) -6) 63))))
+(defmacro b3 (x) (` (aref base64-code-string (logand (, x) 63))))
+
+(defun base64-encode (str)
+  "Do base64 encoding on string STR and return the encoded string.
+This code was converted to lisp code by me from the C code in
+ftp://cs.utk.edu/pub/MIME/b64encode.c.  Returns a string that is
+broken into `base64-max-line-length' byte lines."
+  (or str (setq str (buffer-string)))
+  (let ((x (base64-encode-internal str))
+	(y ""))
+    (while (> (length x) base64-max-line-length)
+      (setq y (concat y (substring x 0 base64-max-line-length) "\n")
+	    x (substring x base64-max-line-length nil)))
+    (setq y (concat y x))
+    y))
+
+(defun base64-encode-internal (str)
+  "Do base64 encoding on string STR and return the encoded string.
+This code was converted to lisp code by me from the C code in
+ftp://cs.utk.edu/pub/MIME/b64encode.c.  Returns the entire string,
+not broken up into `base64-max-line-length' byte lines."
+  (let (
+	(word 0)			; The word to translate
+	w1 w2 w3
+	)
+    (cond
+     ((> (length str) 3)
+      (concat
+       (base64-encode-internal (substring str 0 3))
+       (base64-encode-internal (substring str 3 nil))))
+     ((= (length str) 3)
+      (setq w1 (aref str 0)
+	    w2 (aref str 1)
+	    w3 (aref str 2)
+	    word (logior
+		  (lsh (logand w1 255) 16)
+		  (lsh (logand w2 255) 8)
+		  (logand w3 255)))
+      (format "%c%c%c%c" (b0 word) (b1 word) (b2 word) (b3 word)))
+     ((= (length str) 2)
+      (setq w1 (aref str 0)
+	    w2 (aref str 1)
+	    word (logior
+		  (lsh (logand w1 255) 16)
+		  (lsh (logand w2 255) 8)
+		  0))
+      (format "%c%c%c=" (b0 word) (b1 word) (b2 word)))
+     ((= (length str) 1)
+      (setq w1 (aref str 0)
+	    word (logior
+		  (lsh (logand w1 255) 16)
+		  0))
+      (format "%c%c==" (b0 word) (b1 word)))
+     (t ""))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Base64 decoding functions
+;;; Most of the decoding code is courtesy Francesco Potorti`
+;;; <F.Potorti@cnuce.cnr.it>
+;;; this is much faster than my original code - thanks!
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defun base64-decode-region (beg end)
+  (interactive "r")
+  (barf-if-buffer-read-only)
+  (let
+      ((exchange (= (point) beg))
+       (endchars 0)
+       (list) (code))
+    (goto-char beg)
+    (while (< (point) end)
+      (setq list (mapcar
+		  (function
+		   (lambda (c)
+		     (cond
+		      ((aref base64-decode-vector c))
+		      ((char-equal c ?=)
+		       (setq endchars (1+ endchars))
+		       0)
+		      (nil
+		       (error
+			"Character %c does not match Mime base64 coding" c)))))
+		  (buffer-substring (point) (+ (point) 4))))
+      (setq code (+ (nth 3 list) (lsh (nth 2 list) 6)
+		    (lsh (nth 1 list) 12) (lsh (car list) 18)))
+      (delete-char 4)
+      (cond
+       ((zerop endchars)
+	(insert (% (lsh code -16) 256) (% (lsh code -8) 256) (% code 256)))
+       ((= endchars 1)
+	(insert (% (lsh code -16) 256) (% (lsh code -8) 256))
+	(setq end (point)))
+       ((= endchars 2)
+	(insert (% (lsh code -16) 256))
+	(setq end (point))))
+      (if (char-equal (following-char) ?\n)
+	  (progn (delete-char 1)
+		 (setq end (- end 2)))
+	(setq end (1- end))))
+    ))
+;    (if exchange
+;	(exchange-point-and-mark))))
+
+(defun base64-decode (st &optional nd)
+  "Do base64 decoding on string STR and return the original string.
+If given buffer positions, destructively decodes that area of the
+current buffer."
+  (let ((replace-p nil)
+	(retval nil))
+    (if (stringp st)
+	nil
+      (setq st (prog1
+		   (buffer-substring st (or nd (point-max)))
+		 (delete-region st (or nd (point-max))))
+	    replace-p t))
+    (setq retval
+	  (save-excursion
+	    (set-buffer (get-buffer-create " *b64decode*"))
+	    (erase-buffer)
+	    (insert st)
+	    (goto-char (point-min))
+	    (while (re-search-forward "\r*\n" nil t)
+	      (replace-match ""))
+	    (goto-char (point-min))
+	    (base64-decode-region (point-min) (point-max))
+	    (buffer-string)))
+    (if replace-p (insert retval))
+    retval))
+
+(provide 'base64)