X-Git-Url: http://git.kpe.io/?p=cl-base64.git;a=blobdiff_plain;f=package.lisp;h=71524cf05565f68162387e854ccd93592aff2c4e;hp=fca5cd21baa25b1b30412b7ba6c02a92efc69989;hb=ecff5c5549684a5636a0436961b879177dc1039f;hpb=016124a5823f8dd681956e02510fc0bf485b1aaf

diff --git a/package.lisp b/package.lisp
index fca5cd2..71524cf 100644
--- a/package.lisp
+++ b/package.lisp
@@ -7,43 +7,47 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Dec 2002
 ;;;;
-;;;; $Id: package.lisp,v 1.4 2003/04/15 16:05:39 kevin Exp $
+;;;; $Id$
 ;;;;
 ;;;; *************************************************************************
 
-(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
-
 (defpackage #:cl-base64
   (:nicknames #:base64)
   (:use #:cl)
   (:export #:base64-stream-to-integer
-	   #:base64-string-to-integer
-	   #:base64-string-to-string
-	   #:base64-stream-to-string
-	   #:base64-string-to-stream
-	   #:base64-stream-to-stream
-	   #:base64-string-to-usb8-array
-	   #:base64-stream-to-usb8-array
-	   #:string-to-base64-string
-	   #:string-to-base64-stream
-	   #:usb8-array-to-base64-string
-	   #:usb8-array-to-base64-stream
-	   #:stream-to-base64-string
-	   #:stream-to-base64-stream
-	   #:integer-to-base64-string
-	   #:integer-to-base64-stream
+           #:base64-stream-to-string
+           #:base64-stream-to-stream
+           #:base64-stream-to-usb8-array
+           #:base64-string-to-integer
+           #:base64-string-to-string
+           #:base64-string-to-stream
+           #:base64-string-to-usb8-array
+           #:string-to-base64-string
+           #:string-to-base64-stream
+           #:usb8-array-to-base64-string
+           #:usb8-array-to-base64-stream
+           #:stream-to-base64-string
+           #:stream-to-base64-stream
+           #:integer-to-base64-string
+           #:integer-to-base64-stream
 
-	   ;; For creating custom encode/decode tables
-	   #:*uri-encode-table*
-	   #:*uri-decode-table*
-	   #:make-decode-table
+           ;; Conditions.
+           #:base64-error
+           #:bad-base64-character
+           #:incomplete-base64-data
 
-	   #:test-base64
-	   ))
+           ;; For creating custom encode/decode tables.
+           #:make-decode-table
+           #:+decode-table+
+           #:+uri-decode-table+
+           ;; What's the point of exporting these?
+           #:*uri-encode-table*
+           #:*uri-decode-table*
+           ))
 
 (in-package #:cl-base64)
 
-
+(eval-when (:compile-toplevel :load-toplevel :execute)
 (defvar *encode-table*
   "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/")
 (declaim (type simple-string *encode-table*))
@@ -52,22 +56,38 @@
   "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_")
 (declaim (type simple-string *uri-encode-table*))
 
-(deftype decode-table () '(simple-array fixnum (256)))
-
-(defun make-decode-table (encode-table)
-  (let ((dt (make-array 256 :adjustable nil :fill-pointer nil
-			:element-type 'fixnum
-			:initial-element -1)))
-    (declare (type decode-table dt))
-    (loop for char of-type character across encode-table
-       for index of-type fixnum from 0 below 64
-       do (setf (aref dt (the fixnum (char-code char))) index))
-    dt))
-    
-(defvar *decode-table* (make-decode-table *encode-table*))
-  
-(defvar *uri-decode-table* (make-decode-table *uri-encode-table*))
-  
 (defvar *pad-char* #\=)
 (defvar *uri-pad-char* #\.)
 (declaim (type character *pad-char* *uri-pad-char*))
+
+  (deftype decode-table () '(simple-array (signed-byte 8) (128)))
+  (defun make-decode-table (encode-table pad-char
+                            &key (whitespace-chars
+                                  '(#\Linefeed #\Return #\Space #\Tab)))
+    (assert (< (length encode-table) 128)
+            (encode-table)
+            "Encode table too big: ~S" encode-table)
+    (let ((dt (make-array 128 :element-type '(signed-byte 8)
+                              :initial-element -1)))
+      (declare (type decode-table dt))
+      (loop for char across encode-table
+            for index upfrom 0
+            do (setf (aref dt (char-code char)) index))
+      (setf (aref dt (char-code pad-char)) -2)
+      (loop for char in whitespace-chars
+            do (setf (aref dt (char-code char)) -3))
+      dt)))
+
+(defconstant +decode-table+
+  (if (boundp '+decode-table+)
+      (symbol-value '+decode-table+)
+      (make-decode-table *encode-table* *pad-char*)))
+(defvar *decode-table* +decode-table+ "Deprecated.")
+(declaim (type decode-table +decode-table+ *decode-table*))
+
+(defconstant +uri-decode-table+
+  (if (boundp '+uri-decode-table+)
+      (symbol-value '+uri-decode-table+)
+      (make-decode-table *uri-encode-table* *uri-pad-char*)))
+(defvar *uri-decode-table* +uri-decode-table+ "Deprecated.")
+(declaim (type decode-table +uri-decode-table+ *uri-decode-table*))