r4534: Auto commit for Debian build

[lml.git] / base.lisp

diff --git a/base.lisp b/base.lisp
index 20a1677c3abde47a40baef1df288c877d8208e8b..2939200cdbd79f5c16f6878744217e53397dfb6d 100644 (file)
--- a/base.lisp
+++ b/base.lisp
@@ -2,12 +2,12 @@
 ;;;; *************************************************************************
 ;;;; FILE IDENTIFICATION
 ;;;;
-;;;; Name:          lml.cl
+;;;; Name:          base.lisp
 ;;;; Purpose:       Lisp Markup Language functions
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Aug 2002
 ;;;;
-;;;; $Id: base.lisp,v 1.12 2003/03/05 04:25:09 kevin Exp $
+;;;; $Id: base.lisp,v 1.14 2003/04/19 03:50:12 kevin Exp $
 ;;;;
 ;;;; This file, part of LML, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;
@@ -85,10 +85,10 @@
 (defmacro with-no-endtag-attr-string (tag attr-string)
   (let ((attr (gensym)))
   `(let ((,attr ,attr-string))
-     (lml-format "<~(~A~) ~A />" ',tag
+     (lml-format "<~(~A~)~A />" ',tag
              (if (and (stringp ,attr) (plusp (length ,attr)))
-                 (format nil "~A" ,attr)
-               "")))))
+                 (format nil " ~A" ,attr)
+                 "")))))
 
 (defun one-keyarg-string (key value)
   "Return attribute string for keys"
@@ -256,64 +256,6 @@
 (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 '())
-           (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 `(lml-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
-                           (lml-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 `(lml-princ ,curr-string) forms)
-       `(progn ,@(nreverse forms)))))
+