- (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))))
-
-
-(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))))
-
+ (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 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)))))