projects
/
lml.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
r2835: *** empty log message ***
[lml.git]
/
lml.cl
diff --git
a/lml.cl
b/lml.cl
index ebf813af7c5e26c3ea2ffee3b15454ad4c21f17c..c3542bb423a88a28dc3ee5d481484b80a138f826 100644
(file)
--- a/
lml.cl
+++ b/
lml.cl
@@
-7,7
+7,7
@@
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Aug 2002
;;;;
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Aug 2002
;;;;
-;;;; $Id: lml.cl,v 1.
9 2002/09/16 09:58:57
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
;;;;
;;;;
;;;; This file, part of LML, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;;
@@
-23,7
+23,7
@@
"<!DOCTYPE HTML PUBLIC \"-//IETF//DTD HTML//EN\">")
(defun xml-prologue-string ()
"<!DOCTYPE HTML PUBLIC \"-//IETF//DTD HTML//EN\">")
(defun xml-prologue-string ()
- "version=\"1.0\" encoding=\"iso-8859-1\" standalone=\"yes\"?>")
+ "
<?xml
version=\"1.0\" encoding=\"iso-8859-1\" standalone=\"yes\"?>")
(defun xhtml-prologue-string ()
"<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">")
(defun xhtml-prologue-string ()
"<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">")
@@
-201,11
+201,15
@@
(html :xmlns "http://www.w3.org/1999/xhtml"
,@body)))
(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 ((forms '())
(set-macro-character #\[
#'(lambda (stream char)
(declare (ignore char))
(let ((forms '())
- (curr-string (make-array 1024 :fill-pointer 0 :adjustable t :element-type 'character))
+ (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 #\]))
(got-comma nil))
(do ((ch (read-char stream t nil t) (read-char stream t nil t)))
((eql ch #\]))
@@
-214,24
+218,29
@@
;; Starting top-level ,(
(progn
(push `(lml-print ,curr-string) forms)
;; Starting top-level ,(
(progn
(push `(lml-print ,curr-string) forms)
- (set
f (fill-pointer curr-string) 0
)
+ (set
q 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)))
(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))
(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))
(vector-push-extend ch curr-string))
(vector-push-extend #\) curr-string)
(let ((eval-string (read-from-string curr-string))
- (res
ult
(gensym)))
+ (res (gensym)))
(push
`(let ((,res ,eval-string))
(when ,res
(lml-print ,res)))
forms))
(push
`(let ((,res ,eval-string))
(when ,res
(lml-print ,res)))
forms))
- (set
f (fill-pointer curr-string) 0
))
+ (set
q curr-string (new-string)
))
;; read comma, then non #\( char
(progn
(unless (eql ch #\,)
;; read comma, then non #\( char
(progn
(unless (eql ch #\,)
@@
-245,6
+254,6
@@
(setq got-comma nil)
(vector-push-extend ch curr-string)))))
(push `(lml-print ,curr-string) forms)
(setq got-comma nil)
(vector-push-extend ch curr-string)))))
(push `(lml-print ,curr-string) forms)
- `(progn ,(nreverse forms)))))
+ `(progn ,
@
(nreverse forms)))))