X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=lml.cl;h=c3542bb423a88a28dc3ee5d481484b80a138f826;hb=f3088cd6e99688e7bc3d37bb6c5a58e08c958611;hp=4f73fdb071206b0b592053669da37c8f35f64ca5;hpb=ce89c31a4ce6e52280e1a1f32ec9192c8b2bc9a2;p=lml.git diff --git a/lml.cl b/lml.cl index 4f73fdb..c3542bb 100644 --- a/lml.cl +++ b/lml.cl @@ -7,7 +7,7 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Aug 2002 ;;;; -;;;; $Id: lml.cl,v 1.6 2002/09/16 09:36:27 kevin Exp $ +;;;; $Id: lml.cl,v 1.13 2002/09/16 10:18:19 kevin Exp $ ;;;; ;;;; This file, part of LML, is Copyright (c) 2002 by Kevin M. Rosenberg ;;;; @@ -23,7 +23,7 @@ "") (defun xml-prologue-string () - "version=\"1.0\" encoding=\"iso-8859-1\" standalone=\"yes\"?>") + "") (defun xhtml-prologue-string () "") @@ -201,10 +201,15 @@ (html :xmlns "http://www.w3.org/1999/xhtml" ,@body))) +(defun new-string () + (make-array 1024 :fill-pointer 0 :adjustable t :element-type 'character)) + (set-macro-character #\[ #'(lambda (stream char) (declare (ignore char)) - (let ((curr-string (make-array 1024 :fill-pointer 0 :adjustable t :element-type 'character)) + (let ((forms '()) + (curr-string (new-string)) + (paren-level 0) (got-comma nil)) (do ((ch (read-char stream t nil t) (read-char stream t nil t))) ((eql ch #\])) @@ -212,19 +217,30 @@ (if (eql ch #\() ;; Starting top-level ,( (progn - (princ curr-string) - (setf (fill-pointer curr-string) 0) + (push `(lml-print ,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))) - ((eql ch #\))) + ((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) - (princ (eval (read-from-string curr-string))) - (setf (fill-pointer curr-string) 0)) + (let ((eval-string (read-from-string curr-string)) + (res (gensym))) + (push + `(let ((,res ,eval-string)) + (when ,res + (lml-print ,res))) + forms)) + (setq curr-string (new-string))) ;; read comma, then non #\( char (progn (unless (eql ch #\,) @@ -237,7 +253,7 @@ (progn (setq got-comma nil) (vector-push-extend ch curr-string))))) - (princ curr-string)) - t)) + (push `(lml-print ,curr-string) forms) + `(progn ,@(nreverse forms)))))