X-Git-Url: http://git.kpe.io/?p=cl-base64.git;a=blobdiff_plain;f=encode.lisp;h=dcddc1ad4bef1f2a1c11af08f4cd8f5468e3b068;hp=f5276a885faff2e81da6f5dee272818d36a02aa4;hb=c5cbb82b14acd50e5869053157dab7b4d0bcc954;hpb=7061e145805504275b192c0a50723090b518a16a

diff --git a/encode.lisp b/encode.lisp
index f5276a8..dcddc1a 100644
--- a/encode.lisp
+++ b/encode.lisp
@@ -33,174 +33,174 @@
 (defun round-next-multiple (x n)
   "Round x up to the next highest multiple of n."
   (declare (fixnum n)
-	   (optimize (speed 3) (safety 0) (space 0)))
+           (optimize (speed 3) (safety 0) (space 0)))
   (let ((remainder (mod x n)))
     (declare (fixnum remainder))
     (if (zerop remainder)
-	x
-	(the fixnum (+ x (the fixnum (- n remainder)))))))
+        x
+        (the fixnum (+ x (the fixnum (- n remainder)))))))
 
 (defmacro def-*-to-base64-* (input-type output-type)
   `(defun ,(intern (concatenate 'string (symbol-name input-type)
-				(symbol-name :-to-base64-)
-				(symbol-name output-type)))
+                                (symbol-name :-to-base64-)
+                                (symbol-name output-type)))
     (input
-	,@(when (eq output-type :stream)
-		'(output))
-	&key (uri nil) (columns 0))
+        ,@(when (eq output-type :stream)
+                '(output))
+        &key (uri nil) (columns 0))
      "Encode a string array to base64. If columns is > 0, designates
 maximum number of columns in a line and the string will be terminated
 with a #\Newline."
      (declare ,@(case input-type
-		      (:string
-		       '((string input)))
-		      (:usb8-array
-		       '((type (array (unsigned-byte 8) (*)) input))))
-	      (fixnum columns)
-	      (optimize (speed 3) (safety 0) (space 0)))
+                      (:string
+                       '((string input)))
+                      (:usb8-array
+                       '((type (array (unsigned-byte 8) (*)) input))))
+              (fixnum columns)
+              (optimize (speed 3) (safety 0) (space 0)))
      (let ((pad (if uri *uri-pad-char* *pad-char*))
-	   (encode-table (if uri *uri-encode-table* *encode-table*)))
+           (encode-table (if uri *uri-encode-table* *encode-table*)))
        (declare (simple-string encode-table)
-		(character pad))
+                (character pad))
        (let* ((string-length (length input))
-	      (complete-group-count (truncate string-length 3))
-	      (remainder (nth-value 1 (truncate string-length 3)))
-	      (padded-length (* 4 (truncate (+ string-length 2) 3)))
-	      ,@(when (eq output-type :string)
-		      '((num-lines (if (plusp columns)
-				       (truncate (+ padded-length (1- columns)) columns)
-				       0))
-			(num-breaks (if (plusp num-lines)
-					(1- num-lines)
-					0))
-			(strlen (+ padded-length num-breaks))
-			(result (make-string strlen))
-			(ioutput 0)))
-	      (col (if (plusp columns)
-		       0
-		       (the fixnum (1+ padded-length)))))
-	 (declare (fixnum string-length padded-length col
-			  ,@(when (eq output-type :string)
-				  '(ioutput)))
-		  ,@(when (eq output-type :string)
-			  '((simple-string result))))
-	 (labels ((output-char (ch)
-		    (if (= col columns)
-			(progn
-			  ,@(case output-type
-				  (:stream
-				   '((write-char #\Newline output)))
-				 (:string
-				  '((setf (schar result ioutput) #\Newline)
-				    (incf ioutput))))
-			  (setq col 1))
-		     (incf col))
-		 ,@(case output-type
-			 (:stream
-			  '((write-char ch output)))
-			 (:string
-			  '((setf (schar result ioutput) ch)
-			    (incf ioutput)))))
-	       (output-group (svalue chars)
-		 (declare (fixnum svalue chars))
-		 (output-char
-		  (schar encode-table
-			 (the fixnum
-			   (logand #x3f
-				   (the fixnum (ash svalue -18))))))
-		 (output-char
-		  (schar encode-table
-			 (the fixnum
-			   (logand #x3f
-					(the fixnum (ash svalue -12))))))
-		 (if (> chars 2)
-		     (output-char
-		      (schar encode-table
-			     (the fixnum
-			       (logand #x3f
-				       (the fixnum (ash svalue -6))))))
-		     (output-char pad))
-		   (if (> chars 3)
-		       (output-char
-			(schar encode-table
-			       (the fixnum
-				 (logand #x3f svalue))))
-		       (output-char pad))))
-	(do ((igroup 0 (the fixnum (1+ igroup)))
-	     (isource 0 (the fixnum (+ isource 3))))
-	    ((= igroup complete-group-count)
-	     (cond
-	       ((= remainder 2)
-		(output-group
-		 (the fixnum
-		     (+
-		      (the fixnum
-			(ash
-			 ,(case input-type
-				(:string
-				 '(char-code (the character (char input isource))))
-				(:usb8-array
-				 '(the fixnum (aref input isource))))
-			 16))
-		      (the fixnum
-			(ash
-			 ,(case input-type
-				(:string
-				 '(char-code (the character (char input
-								  (the fixnum (1+ isource))))))
-				(:usb8-array
-				 '(the fixnum (aref input (the fixnum
-							    (1+ isource))))))
-			 8))))
-		 3))
-	       ((= remainder 1)
-		(output-group
-		 (the fixnum
-		   (ash
-		    ,(case input-type
-			   (:string
-			    '(char-code (the character (char input isource))))
-			   (:usb8-array
-			    '(the fixnum (aref input isource))))
-		    16))
-		 2)))
-	     ,(case output-type
-		    (:string
-		     'result)
-		    (:stream
-		     'output)))
-	  (declare (fixnum igroup isource))
-	  (output-group 
-	   (the fixnum
-	     (+
-	      (the fixnum
-		(ash
-		 (the fixnum
-		 ,(case input-type
-			(:string
-			 '(char-code (the character (char input isource))))
-			(:usb8-array
-			 '(aref input isource))))
-		 16))
-	      (the fixnum
-		(ash
-		 (the fixnum
-		   ,(case input-type
-			  (:string
-			   '(char-code (the character (char input
-							    (the fixnum (1+ isource))))))
-			(:usb8-array
-			 '(aref input (1+ isource)))))
-		 8))
-	      (the fixnum
-		,(case input-type
-		       (:string
-			'(char-code (the character (char input
-							 (the fixnum (+ 2 isource))))))
-		       (:usb8-array
-			'(aref input (+ 2 isource))))
-		)))
-	   4)))))))
+              (complete-group-count (truncate string-length 3))
+              (remainder (nth-value 1 (truncate string-length 3)))
+              (padded-length (* 4 (truncate (+ string-length 2) 3)))
+              ,@(when (eq output-type :string)
+                      '((num-lines (if (plusp columns)
+                                       (truncate (+ padded-length (1- columns)) columns)
+                                       0))
+                        (num-breaks (if (plusp num-lines)
+                                        (1- num-lines)
+                                        0))
+                        (strlen (+ padded-length num-breaks))
+                        (result (make-string strlen))
+                        (ioutput 0)))
+              (col (if (plusp columns)
+                       0
+                       (the fixnum (1+ padded-length)))))
+         (declare (fixnum string-length padded-length col
+                          ,@(when (eq output-type :string)
+                                  '(ioutput)))
+                  ,@(when (eq output-type :string)
+                          '((simple-string result))))
+         (labels ((output-char (ch)
+                    (if (= col columns)
+                        (progn
+                          ,@(case output-type
+                                  (:stream
+                                   '((write-char #\Newline output)))
+                                 (:string
+                                  '((setf (schar result ioutput) #\Newline)
+                                    (incf ioutput))))
+                          (setq col 1))
+                     (incf col))
+                 ,@(case output-type
+                         (:stream
+                          '((write-char ch output)))
+                         (:string
+                          '((setf (schar result ioutput) ch)
+                            (incf ioutput)))))
+               (output-group (svalue chars)
+                 (declare (fixnum svalue chars))
+                 (output-char
+                  (schar encode-table
+                         (the fixnum
+                           (logand #x3f
+                                   (the fixnum (ash svalue -18))))))
+                 (output-char
+                  (schar encode-table
+                         (the fixnum
+                           (logand #x3f
+                                        (the fixnum (ash svalue -12))))))
+                 (if (> chars 2)
+                     (output-char
+                      (schar encode-table
+                             (the fixnum
+                               (logand #x3f
+                                       (the fixnum (ash svalue -6))))))
+                     (output-char pad))
+                   (if (> chars 3)
+                       (output-char
+                        (schar encode-table
+                               (the fixnum
+                                 (logand #x3f svalue))))
+                       (output-char pad))))
+        (do ((igroup 0 (the fixnum (1+ igroup)))
+             (isource 0 (the fixnum (+ isource 3))))
+            ((= igroup complete-group-count)
+             (cond
+               ((= remainder 2)
+                (output-group
+                 (the fixnum
+                     (+
+                      (the fixnum
+                        (ash
+                         ,(case input-type
+                                (:string
+                                 '(char-code (the character (char input isource))))
+                                (:usb8-array
+                                 '(the fixnum (aref input isource))))
+                         16))
+                      (the fixnum
+                        (ash
+                         ,(case input-type
+                                (:string
+                                 '(char-code (the character (char input
+                                                                  (the fixnum (1+ isource))))))
+                                (:usb8-array
+                                 '(the fixnum (aref input (the fixnum
+                                                            (1+ isource))))))
+                         8))))
+                 3))
+               ((= remainder 1)
+                (output-group
+                 (the fixnum
+                   (ash
+                    ,(case input-type
+                           (:string
+                            '(char-code (the character (char input isource))))
+                           (:usb8-array
+                            '(the fixnum (aref input isource))))
+                    16))
+                 2)))
+             ,(case output-type
+                    (:string
+                     'result)
+                    (:stream
+                     'output)))
+          (declare (fixnum igroup isource))
+          (output-group
+           (the fixnum
+             (+
+              (the fixnum
+                (ash
+                 (the fixnum
+                 ,(case input-type
+                        (:string
+                         '(char-code (the character (char input isource))))
+                        (:usb8-array
+                         '(aref input isource))))
+                 16))
+              (the fixnum
+                (ash
+                 (the fixnum
+                   ,(case input-type
+                          (:string
+                           '(char-code (the character (char input
+                                                            (the fixnum (1+ isource))))))
+                        (:usb8-array
+                         '(aref input (1+ isource)))))
+                 8))
+              (the fixnum
+                ,(case input-type
+                       (:string
+                        '(char-code (the character (char input
+                                                         (the fixnum (+ 2 isource))))))
+                       (:usb8-array
+                        '(aref input (+ 2 isource))))
+                )))
+           4)))))))
 
 (def-*-to-base64-* :string :string)
 (def-*-to-base64-* :string :stream)
@@ -211,112 +211,112 @@ with a #\Newline."
 (defun integer-to-base64-string (input &key (uri nil) (columns 0))
   "Encode an integer to base64 format."
   (declare (integer input)
-	   (fixnum columns)
-	   (optimize (speed 3) (space 0) (safety 0)))
+           (fixnum columns)
+           (optimize (speed 3) (space 0) (safety 0)))
   (let ((pad (if uri *uri-pad-char* *pad-char*))
-	(encode-table (if uri *uri-encode-table* *encode-table*)))
+        (encode-table (if uri *uri-encode-table* *encode-table*)))
     (declare (simple-string encode-table)
-	     (character pad))
+             (character pad))
     (let* ((input-bits (integer-length input))
-	   (byte-bits (round-next-multiple input-bits 8))
-	   (padded-bits (round-next-multiple byte-bits 6))
-	   (remainder-padding (mod padded-bits 24))
-	   (padding-bits (if (zerop remainder-padding)
-			     0
-			     (- 24 remainder-padding)))
-	   (padding-chars (/ padding-bits 6))
-	   (padded-length (/ (+ padded-bits padding-bits) 6))
-	   (last-line-len (if (plusp columns)
-			      (- padded-length (* columns
-						  (truncate
-						   padded-length columns)))
-			      0))
-	   (num-lines (if (plusp columns)
-			  (truncate (+ padded-length (1- columns)) columns)
-			  0))
-	   (num-breaks (if (plusp num-lines)
-			   (1- num-lines)
-			   0))
-	   (strlen (+ padded-length num-breaks))
-	   (last-char (1- strlen))
-	   (str (make-string strlen))
-	   (col (if (zerop last-line-len)
-		     columns
-		    last-line-len)))
+           (byte-bits (round-next-multiple input-bits 8))
+           (padded-bits (round-next-multiple byte-bits 6))
+           (remainder-padding (mod padded-bits 24))
+           (padding-bits (if (zerop remainder-padding)
+                             0
+                             (- 24 remainder-padding)))
+           (padding-chars (/ padding-bits 6))
+           (padded-length (/ (+ padded-bits padding-bits) 6))
+           (last-line-len (if (plusp columns)
+                              (- padded-length (* columns
+                                                  (truncate
+                                                   padded-length columns)))
+                              0))
+           (num-lines (if (plusp columns)
+                          (truncate (+ padded-length (1- columns)) columns)
+                          0))
+           (num-breaks (if (plusp num-lines)
+                           (1- num-lines)
+                           0))
+           (strlen (+ padded-length num-breaks))
+           (last-char (1- strlen))
+           (str (make-string strlen))
+           (col (if (zerop last-line-len)
+                     columns
+                    last-line-len)))
       (declare (fixnum padded-length num-lines col last-char
-		       padding-chars last-line-len))
+                       padding-chars last-line-len))
       (unless (plusp columns)
-	(setq col -1)) ;; set to flag to optimize in loop
-      
+        (setq col -1)) ;; set to flag to optimize in loop
+
       (dotimes (i padding-chars)
-	(declare (fixnum i))
-	(setf (schar str (the fixnum (- last-char i))) pad))
+        (declare (fixnum i))
+        (setf (schar str (the fixnum (- last-char i))) pad))
 
       (do* ((strpos (- last-char padding-chars) (1- strpos))
-	    (int (ash input (/ padding-bits 3))))
-	   ((minusp strpos)
-	    str)
-	(declare (fixnum strpos) (integer int))
-	(cond
-	  ((zerop col)
-	   (setf (schar str strpos) #\Newline)
-	   (setq col columns))
-	  (t
-	   (setf (schar str strpos)
-		 (schar encode-table (the fixnum (logand int #x3f))))
-	   (setq int (ash int -6))
-	   (decf col)))))))
+            (int (ash input (/ padding-bits 3))))
+           ((minusp strpos)
+            str)
+        (declare (fixnum strpos) (integer int))
+        (cond
+          ((zerop col)
+           (setf (schar str strpos) #\Newline)
+           (setq col columns))
+          (t
+           (setf (schar str strpos)
+                 (schar encode-table (the fixnum (logand int #x3f))))
+           (setq int (ash int -6))
+           (decf col)))))))
 
 (defun integer-to-base64-stream (input stream &key (uri nil) (columns 0))
   "Encode an integer to base64 format."
   (declare (integer input)
-	   (fixnum columns)
-	   (optimize (speed 3) (space 0) (safety 0)))
+           (fixnum columns)
+           (optimize (speed 3) (space 0) (safety 0)))
   (let ((pad (if uri *uri-pad-char* *pad-char*))
-	(encode-table (if uri *uri-encode-table* *encode-table*)))
+        (encode-table (if uri *uri-encode-table* *encode-table*)))
     (declare (simple-string encode-table)
-	     (character pad))
+             (character pad))
     (let* ((input-bits (integer-length input))
-	   (byte-bits (round-next-multiple input-bits 8))
-	   (padded-bits (round-next-multiple byte-bits 6))
-	   (remainder-padding (mod padded-bits 24))
-	   (padding-bits (if (zerop remainder-padding)
-			     0
-			     (- 24 remainder-padding)))
-	   (padding-chars (/ padding-bits 6))
-	   (padded-length (/ (+ padded-bits padding-bits) 6))
-	   (strlen padded-length)
-	   (nonpad-chars (- strlen padding-chars))
-	   (last-nonpad-char (1- nonpad-chars))
-	   (str (make-string strlen)))
+           (byte-bits (round-next-multiple input-bits 8))
+           (padded-bits (round-next-multiple byte-bits 6))
+           (remainder-padding (mod padded-bits 24))
+           (padding-bits (if (zerop remainder-padding)
+                             0
+                             (- 24 remainder-padding)))
+           (padding-chars (/ padding-bits 6))
+           (padded-length (/ (+ padded-bits padding-bits) 6))
+           (strlen padded-length)
+           (nonpad-chars (- strlen padding-chars))
+           (last-nonpad-char (1- nonpad-chars))
+           (str (make-string strlen)))
       (declare (fixnum padded-length last-nonpad-char))
       (do* ((strpos 0 (the fixnum (1+ strpos)))
-	    (int (ash input (/ padding-bits 3)) (ash int -6))
-	    (6bit-value (the fixnum (logand int #x3f))
-			(the fixnum (logand int #x3f))))
-	   ((= strpos nonpad-chars)
-	    (let ((col 0))
-	      (declare (fixnum col))
-	      (dotimes (i nonpad-chars)
-		(declare (fixnum i))
-		(write-char (schar str i) stream)
-		(when (plusp columns)
-		  (incf col)
-		  (when (= col columns)
-		    (write-char #\Newline stream)
-		    (setq col 0))))
-	      (dotimes (ipad padding-chars)
-		(declare (fixnum ipad))
-		(write-char pad stream)
-		(when (plusp columns)
-		  (incf col)
-		  (when (= col columns)
-		    (write-char #\Newline stream)
-		    (setq col 0)))))
-	    stream)
-	(declare (fixnum 6bit-value strpos)
-		 (integer int))
-	(setf (schar str (- last-nonpad-char strpos))
-	      (schar encode-table 6bit-value))
-	))))
+            (int (ash input (/ padding-bits 3)) (ash int -6))
+            (6bit-value (the fixnum (logand int #x3f))
+                        (the fixnum (logand int #x3f))))
+           ((= strpos nonpad-chars)
+            (let ((col 0))
+              (declare (fixnum col))
+              (dotimes (i nonpad-chars)
+                (declare (fixnum i))
+                (write-char (schar str i) stream)
+                (when (plusp columns)
+                  (incf col)
+                  (when (= col columns)
+                    (write-char #\Newline stream)
+                    (setq col 0))))
+              (dotimes (ipad padding-chars)
+                (declare (fixnum ipad))
+                (write-char pad stream)
+                (when (plusp columns)
+                  (incf col)
+                  (when (= col columns)
+                    (write-char #\Newline stream)
+                    (setq col 0)))))
+            stream)
+        (declare (fixnum 6bit-value strpos)
+                 (integer int))
+        (setf (schar str (- last-nonpad-char strpos))
+              (schar encode-table 6bit-value))
+        ))))