r5005: *** empty log message ***

[lml.git] / base.lisp

diff --git a/base.lisp b/base.lisp
index 3e59034436a5132777e9a8c54449ef325915ffec..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.10 2003/02/10 19:49:18 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
 ;;;;
@@ -49,7 +49,7 @@
   (format *html-output* "~A~%" s))
 
 (defun lml-write-char (char)
-  (write-char char *html-output))
+  (write-char char *html-output*))
 
 (defun lml-print-date (date)
   (lml-princ (date-string date)))
@@ -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"
@@ -201,11 +201,11 @@
 (defmacro input (&rest args)
   `(with-no-endtag input ,@args))
 
-(defmacro meta (name content)
-  `(with meta :name ,name :content ,content))
+(defmacro link (&rest args)
+  `(with-no-endtag link ,@args))
 
-(defmacro meta-key (&key name content http-equiv)
-  `(with meta :name ,name :content ,content :http-equiv ,http-equiv))
+(defmacro meta (&rest args)
+  `(with-no-endtag meta ,@args))
 
 (defmacro br (&rest args)
   `(with-no-endtag br ,@args))
@@ -229,8 +229,8 @@
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (defparameter *macro-list*
     '(a div span h1 h2 h3 h4 h5 h6 i b p li ul ol table tbody td th tr body head
-         html title pre tt u dl dt dd kbd code form textarea link))
-  (export '(alink alink-c br hr img input meta meta-key))
+         html title pre tt u dl dt dd kbd code form textarea))
+  (export '(alink alink br hr img input meta link meta-key))
   (export *macro-list*))
 
 (loop for i in *macro-list*
@@ -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)))))
+