From 63a46255032f6cb25666c40205a23409677eb757 Mon Sep 17 00:00:00 2001
From: "Kevin M. Rosenberg" <kevin@rosenberg.net>
Date: Tue, 14 Jan 2003 08:41:22 +0000
Subject: [PATCH 1/1] r3763: add

---
 base.lisp        | 72 ++++++++++++++++++++++++++++++------------------
 debian/changelog |  7 +++++
 2 files changed, 52 insertions(+), 27 deletions(-)

diff --git a/base.lisp b/base.lisp
index 5c2f887..feca6b1 100644
--- a/base.lisp
+++ b/base.lisp
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Aug 2002
 ;;;;
-;;;; $Id: base.lisp,v 1.3 2003/01/04 20:42:02 kevin Exp $
+;;;; $Id: base.lisp,v 1.4 2003/01/14 08:41:22 kevin Exp $
 ;;;;
 ;;;; This file, part of LML, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;
@@ -76,6 +76,14 @@
      (decf *indent*)
      (lml-print "</~(~A~)>" ',tag))))
 
+(defmacro with-no-endtag-attr-string (tag attr-string)
+  (let ((attr (gensym)))
+  `(let ((,attr ,attr-string))
+     (lml-print "<~(~A~)~A />" ',tag
+	      (if (and (stringp ,attr) (plusp (length ,attr)))
+		  (format nil "~A" ,attr)
+		"")))))
+
 (defun one-keyarg-string (key value)
   "Return attribute string for keys"
   (format nil "~(~A~)=\"~A\"" key
@@ -97,6 +105,16 @@
 	   (push (one-keyarg-string (car ,kv) it) ,attr)))
        (with-attr-string ,tag (list-to-spaced-string (nreverse ,attr)) ,@body)))))
 
+(defmacro with-no-endtag-keyargs (tag keyargs)
+  (let ((attr (gensym))
+	(kv (gensym)))
+  `(progn
+     (let ((,attr '()))
+       (dolist (,kv ,keyargs)
+	 (awhen (cdr ,kv)
+	   (push (one-keyarg-string (car ,kv) it) ,attr)))
+       (with-no-endtag-attr-string ,tag (list-to-spaced-string (nreverse ,attr)))))))
+
 (defmacro bind-one-keyarg (keyarg)
   `(list ,(car keyarg) ,(cdr keyarg)))
 
@@ -140,18 +158,25 @@
     (setq keyargs (nreverse keyargs))
     (setq body (nreverse body))
     `(let ((,bound-keyargs ,(macroexpand `(bind-all-keyargs ,keyargs))))
-      ,(macroexpand `(with-keyargs ,tag ,bound-keyargs ,@body)))))
+       ,(macroexpand `(with-keyargs ,tag ,bound-keyargs ,@body)))))
 
-
-(defmacro keyargs-string (&rest args)
-  "Returns a string of attributes and values. Result contains a leading space."
-  (let ((keyarg-list '()))
-    (loop for ( name val ) on args by #'cddr
-	  do
-	  (when val
-	    (push (one-keyarg-string name val) keyarg-list)))
-    (list-to-spaced-string (nreverse keyarg-list))))
-  
+(defmacro with-no-endtag (tag &rest args)
+  "Return a list of keyargs body of LML form"
+  (let ((keyargs '())
+	(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)))
+      (push (cons arg value) keyargs))
+    (setq keyargs (nreverse keyargs))
+    `(let ((,bound-keyargs ,(macroexpand `(bind-all-keyargs ,keyargs))))
+      ,(macroexpand `(with-no-endtag-keyargs ,tag ,bound-keyargs)))))
 
 (defmacro xhtml-prologue ()
   `(progn
@@ -164,18 +189,11 @@
 (defmacro link-c (class dest &body body)
   `(with a :href ,dest :class (quote ,class) ,@body))
 
-(defmacro img (dest &key class id alt style width height align)
-  (let ((attr
-	 (eval `(keyargs-string :class ,class :id ,id :alt ,alt :style ,style
-			     :width ,width :height ,height :align ,align))))
-    `(lml-print ,(format nil "<img src=\"~A\"~A />" dest attr))))
+(defmacro img (dest &rest args)
+  `(with-no-endtag :src ,dest ,@args))
 
-(defmacro input (&key name class id type style size maxlength value checked)
-  (let ((attr
-	 (eval `(keyargs-string :name ,name :class ,class :id ,id :style ,style
-			     :size ,size :maxlength ,maxlength :value ,value
-			     :type ,type :checked ,checked))))
-    `(lml-print ,(format nil "<input~A />" attr))))
+(defmacro input (&rest args)
+  `(with-no-endtag input ,@args))
 
 (defmacro meta (name content)
   `(with meta :name ,name :content ,content))
@@ -183,11 +201,11 @@
 (defmacro meta-key (&key name content http-equiv)
   `(with meta :name ,name :content ,content :http-equiv ,http-equiv))
 
-(defmacro br ()
-  `(lml-print "<br />"))
+(defmacro br (&rest args)
+  `(with-no-endtag br ,@args))
 
-(defmacro hr ()
-  `(lml-print "<hr />"))
+(defmacro hr (&rest args)
+  `(with-no-endtag hr ,@args))
 
 (defmacro lml-tag-macro (tag)
   `(progn
diff --git a/debian/changelog b/debian/changelog
index 1757e72..c3c391e 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,3 +1,10 @@
+cl-lml (2.1.0-1) unstable; urgency=low
+
+  * Rework tags that don't have endtags (such as BR and HR) to evaluate
+  keyword arguments
+
+ -- Kevin M. Rosenberg <kmr@debian.org>  Tue, 14 Jan 2003 01:38:52 -0700
+
 cl-lml (2.0.2-1) unstable; urgency=low
 
   * Fix with-dir to properly evaluate parameters (Thanks Matthew Danish)
-- 
2.34.1