r3734: *** empty log message ***

[lml.git] / base.lisp

diff --git a/base.lisp b/base.lisp
index 85a59117fc1b81e94cf59e178e1a86de1011a5da..5c2f88737630cb196207619d59747789e59b088f 100644 (file)
--- a/base.lisp
+++ b/base.lisp
@@ -1,4 +1,4 @@
-;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
 ;;;; *************************************************************************
 ;;;; FILE IDENTIFICATION
 ;;;;
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Aug 2002
 ;;;;
-;;;; $Id: base.lisp,v 1.1 2002/12/29 09:10:41 kevin Exp $
+;;;; $Id: base.lisp,v 1.3 2003/01/04 20:42:02 kevin Exp $
 ;;;;
 ;;;; This file, part of LML, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;
@@ -59,7 +59,7 @@
              `(lml-print "~D" ,form))
             (symbol
              (when form
-             `(lml-print (string-downcase (symbol-name ,form)))))
+             `(lml-print ,form)))
             (cons
              form)))
        forms)))
@@ -92,26 +92,55 @@
        (kv (gensym)))
   `(progn
      (let ((,attr '()))
-       (dolist (,kv ',keyargs)
-        (awhen (cadr ,kv)
+       (dolist (,kv ,keyargs)
+        (awhen (cdr ,kv)
           (push (one-keyarg-string (car ,kv) it) ,attr)))
        (with-attr-string ,tag (list-to-spaced-string (nreverse ,attr)) ,@body)))))
 
+(defmacro bind-one-keyarg (keyarg)
+  `(list ,(car keyarg) ,(cdr keyarg)))
+
+(defmacro bind-all-keyargs (keyargs)
+  "Convert a list of keyarg pairs and convert eval/bind arguments"
+  (let* ((npairs (length keyargs))
+        (syms (make-array npairs))
+        (ipair 0)
+        (ipair2 0))
+    (declare (dynamic-extent syms))
+    (dotimes (i npairs)
+      (setf (aref syms i) (gensym)))
+    `(let ,(mapcar #'(lambda (ka)
+                      (prog1
+                          (list (aref syms ipair) (cdr ka))
+                        (incf ipair)))
+                  keyargs)
+      (list ,@(mapcar #'(lambda (ka)
+                         (prog1
+                             `(cons ,(car ka) ,(aref syms ipair2))
+                           (incf ipair2)))
+                     keyargs)))))
+
 (defmacro with (tag &rest args)
+  "Return a list of keyargs and also the body of LML form"
   (let ((body '())
        (keyargs '())
-       (n (length args)))
-    (do ((i 0 (1+ i)))
-       ((> i (1- n)))
-      (let ((arg (nth i args))
-           (value (when (< (1+ i) n)
-                    (nth (1+ i) args))))
-       (if (keyword-symbol? arg)
-           (progn
-             (push (list arg value) keyargs)
-             (incf i))
-         (push arg body))))
-    `(with-keyargs ,tag ,keyargs ,@(nreverse body))))
+       (bound-keyargs (gensym)))
+    (do* ((n (length args))
+         (i 0 (+ 2 i))
+         (arg (nth i args) (nth i args))
+         (value (when (< (1+ i) n)
+                  (nth (1+ i) args))
+                (when (< (1+ i) n)
+                  (nth (1+ i) args))))
+        ((or (not (keyword-symbol? arg))
+             (>= i n))
+         (dotimes (j (- n i))
+           (push (nth (+ i j) args) body)))
+      (push (cons arg value) keyargs))
+    (setq keyargs (nreverse keyargs))
+    (setq body (nreverse body))
+    `(let ((,bound-keyargs ,(macroexpand `(bind-all-keyargs ,keyargs))))
+      ,(macroexpand `(with-keyargs ,tag ,bound-keyargs ,@body)))))
 
 
 (defmacro keyargs-string (&rest args)
@@ -133,7 +162,7 @@
   `(with a :href ,dest ,@body))
 
 (defmacro link-c (class dest &body body)
-  `(with a :href ,dest :class ,class ,@body))
+  `(with a :href ,dest :class (quote ,class) ,@body))
 
 (defmacro img (dest &key class id alt style width height align)
   (let ((attr
@@ -170,7 +199,7 @@
   (let ((name (intern (format nil "~A-~A" tag :c))))
     `(progn
        (defmacro ,name (&body body)
-        `(with ,',tag :class ,(car body) ,@(cdr body)))
+        `(with ,',tag :class (quote ,(car body)) ,@(cdr body)))
        (export ',name))))
 
 (eval-when (:compile-toplevel :load-toplevel :execute)