;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Aug 2002
;;;;
-;;;; $Id: lml.cl,v 1.5 2002/09/16 08:16:49 kevin Exp $
+;;;; $Id: lml.cl,v 1.6 2002/09/16 09:36:27 kevin Exp $
;;;;
;;;; This file, part of LML, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;;
(xhtml-prologue)
(html :xmlns "http://www.w3.org/1999/xhtml"
,@body)))
+
+(set-macro-character #\[
+ #'(lambda (stream char)
+ (declare (ignore char))
+ (let ((curr-string (make-array 1024 :fill-pointer 0 :adjustable t :element-type 'character))
+ (got-comma nil))
+ (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
+ (princ curr-string)
+ (setf (fill-pointer curr-string) 0)
+ (setq got-comma nil)
+ (vector-push #\( curr-string)
+ (do ((ch (read-char stream t nil t) (Read-char stream t nil t)))
+ ((eql ch #\)))
+ (when (eql ch #\])
+ (format *trace-output* "Syntax error reading #\]")
+ (return nil))
+ (vector-push-extend ch curr-string))
+ (vector-push-extend #\) curr-string)
+ (princ (eval (read-from-string curr-string)))
+ (setf (fill-pointer curr-string) 0))
+ ;; 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)))))
+ (princ curr-string))
+ t))
+
+