diff lisp/url/base64.el @ 0:376386a54a3c r19-14

Import from CVS: tag r19-14
author cvs
date Mon, 13 Aug 2007 08:45:50 +0200
parents
children
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/url/base64.el	Mon Aug 13 08:45:50 2007 +0200
@@ -0,0 +1,171 @@
+;;; 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@spry.com|
+;;; Package for encoding/decoding base64 data (MIME)|
+;;; 1996/04/22 15:08:08|1.7|Location Undetermined
+;;;
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; 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)