[gambit-list] handling of macros

[Bradley Lucier]

On Aug 8, 2005, at 11:00 AM, Christian wrote:

> - why are DSSSL style argument declarations not allowed in
> define-macro?

You can do this by embedding a procedure that takes DSSSL-style 
argument declarations inside the macro, like this code from my html 
library:

(##define-macro (define-tag . args)
   (let ((internal-define-tag
	 (lambda (tag-name
		  #!key
		  (allow-core-attributes? #t)
		  (end-tag? #t)
		  (start-newline? #f)
		  (end-tag-start-newline? #f)
		  (attributes '())
		  (single-attributes '()))
	   (let ((core-attributes '(class
				    dir
				    id
				    lang
				    onclick
				    ondblclick
				    onkeydown
				    onkeypress
				    onkeyup
				    onmousedown
				    onmousemove
				    onmouseout
				    onmouseover
				    onmouseup
				    style
				    title)))
	     ;; the maps here are done at compile time, so they are the system 
map.

	     (let* ((attributes (if allow-core-attributes? (append attributes 
core-attributes) attributes))
		    (attribute-strings (map (lambda (x) (symbol->string x)) 
attributes))
		    (attribute-keywords (map (lambda (x) (string->keyword x)) 
attribute-strings))
		    (attribute-alist (cons 'list (map (lambda (keyword name)
							`(cons ,keyword (make-attribute ,name #t #f)))
						      attribute-keywords
						      attribute-strings)))
		    (single-attribute-strings (map (lambda (x) (symbol->string x)) 
single-attributes))
		    (single-attribute-keywords (map (lambda (x) (string->keyword x)) 
single-attribute-strings))
		    (single-attribute-alist (cons 'list (map (lambda (keyword name)
							       `(cons ,keyword (make-attribute ,name #f #f)))
							     single-attribute-keywords
							     single-attribute-strings)))
		    (form-name (string->symbol (string-append "<" (symbol->string 
tag-name) ">"))))
	       `(define (,form-name . args)
		  (let ((attribute-alist
			 ,(if (null? attribute-keywords)
			      ''()
			      attribute-alist))
			(single-attribute-alist
			 ,(if (null? single-attribute-keywords)
			      ''()
			      single-attribute-alist)))
		    (let ((args (html-parse-args ,(list 'quote form-name) ,end-tag? 
attribute-alist single-attribute-alist args)))
		      (html-build-form ,(symbol->string tag-name)
				       attribute-alist
				       single-attribute-alist
				       args
				       ,start-newline?
				       ,end-tag-start-newline?
				       ,end-tag?)))))))))

     (apply internal-define-tag args)))

Brad