X-Git-Url: http://git.kpe.io/?p=lml2.git;a=blobdiff_plain;f=read-macro.lisp;h=0e173ebdbbb66547d757907ba59f7b3e55ce26a5;hp=16dc05d177108606514388506208fda94794420d;hb=c995e5549929046c8133e920fa022bce324042e4;hpb=a5621a5bf235313916f437a55d9998418ee26f5a

diff --git a/read-macro.lisp b/read-macro.lisp
index 16dc05d..0e173eb 100644
--- a/read-macro.lisp
+++ b/read-macro.lisp
@@ -7,13 +7,11 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Aug 2002
 ;;;;
-;;;; $Id: read-macro.lisp,v 1.1 2003/06/20 04:12:29 kevin Exp $
+;;;; $Id$
 ;;;;
-;;;; This file, part of LML2, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;; This file, part of LML2, is Copyright (c) 2000-2003 by Kevin Rosenberg.
+;;;; Rights of modification and redistribution are in the LICENSE file.
 ;;;;
-;;;; LML2 users are granted the rights to distribute and use this software
-;;;; as governed by the terms of the GNU General Public License v2
-;;;; (http://www.gnu.org/licenses/gpl.html)
 ;;;; *************************************************************************
 
 (in-package #:lml2)
@@ -25,58 +23,58 @@
   #'(lambda (stream char)
       (declare (ignore char))
       (let ((forms '())
-	    (curr-string (new-string))
-	    (paren-level 0)
-	    (got-comma nil))
-	(declare (type fixnum paren-level))
-	(do ((ch (read-char stream t nil t) (read-char stream t nil t)))
-	    ((eql ch #\]))
-	  (if got-comma
-	      (if (eql ch #\()
-		  ;; Starting top-level ,(
-		  (progn
-		    #+cmu
-		    (setf curr-string (coerce curr-string `(simple-array character (*))))
-	
-		    (push `(lml2-princ ,curr-string) forms)
-		    (setq curr-string (new-string))
-		    (setq got-comma nil)
-		    (vector-push #\( curr-string)
-		    (do ((ch (read-char stream t nil t) (read-char stream t nil t)))
-			((and (eql ch #\)) (zerop paren-level)))
-		      (when (eql ch #\])
-			(format *trace-output* "Syntax error reading #\]")
-			(return nil))
-		      (case ch
-			(#\(
-			 (incf paren-level))
-			(#\)
-			 (decf paren-level)))
-		      (vector-push-extend ch curr-string))
-		    (vector-push-extend #\) curr-string)
-		    (let ((eval-string (read-from-string curr-string))
-			  (res (gensym)))
-		      (push
-		       `(let ((,res ,eval-string))
-			  (when ,res
-			    (lml2-princ ,res)))
-		       forms))
-		    (setq curr-string (new-string)))
-		;; read comma, then non #\( char
-		(progn
-		  (unless (eql ch #\,)
-		    (setq got-comma nil))
-		  (vector-push-extend #\, curr-string) ;; push previous command
-		  (vector-push-extend ch curr-string)))
-	    ;; previous character is not a comma
-	    (if (eql ch #\,)
-		(setq got-comma t)
-	      (progn
-		(setq got-comma nil)
-		(vector-push-extend ch curr-string)))))
+            (curr-string (new-string))
+            (paren-level 0)
+            (got-comma nil))
+        (declare (type fixnum paren-level))
+        (do ((ch (read-char stream t nil t) (read-char stream t nil t)))
+            ((eql ch #\]))
+          (if got-comma
+              (if (eql ch #\()
+                  ;; Starting top-level ,(
+                  (progn
+                    #+cmu
+                    (setf curr-string (coerce curr-string `(simple-array character (*))))
 
-	#+cmu
-	(setf curr-string (coerce curr-string `(simple-array character (*))))
-	
-	(push `(lml2-princ ,curr-string) forms)
-	`(progn ,@(nreverse forms)))))
+                    (push `(lml2-princ ,curr-string) forms)
+                    (setq curr-string (new-string))
+                    (setq got-comma nil)
+                    (vector-push #\( curr-string)
+                    (do ((ch (read-char stream t nil t) (read-char stream t nil t)))
+                        ((and (eql ch #\)) (zerop paren-level)))
+                      (when (eql ch #\])
+                        (format *trace-output* "Syntax error reading #\]")
+                        (return nil))
+                      (case ch
+                        (#\(
+                         (incf paren-level))
+                        (#\)
+                         (decf paren-level)))
+                      (vector-push-extend ch curr-string))
+                    (vector-push-extend #\) curr-string)
+                    (let ((eval-string (read-from-string curr-string))
+                          (res (gensym)))
+                      (push
+                       `(let ((,res ,eval-string))
+                          (when ,res
+                            (lml2-princ ,res)))
+                       forms))
+                    (setq curr-string (new-string)))
+                ;; read comma, then non #\( char
+                (progn
+                  (unless (eql ch #\,)
+                    (setq got-comma nil))
+                  (vector-push-extend #\, curr-string) ;; push previous command
+                  (vector-push-extend ch curr-string)))
+            ;; previous character is not a comma
+            (if (eql ch #\,)
+                (setq got-comma t)
+              (progn
+                (setq got-comma nil)
+                (vector-push-extend ch curr-string)))))
+
+        #+cmu
+        (setf curr-string (coerce curr-string `(simple-array character (*))))
+
+        (push `(lml2-princ ,curr-string) forms)
+        `(progn ,@(nreverse forms)))))