X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=base.lisp;h=5c2f88737630cb196207619d59747789e59b088f;hb=859b1e7b0f6e92f3a555b79289ce806106a72804;hp=85a59117fc1b81e94cf59e178e1a86de1011a5da;hpb=9c9a88110167cb4727f04677192fd7afd4c8b00f;p=lml.git

diff --git a/base.lisp b/base.lisp
index 85a5911..5c2f887 100644
--- 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)