(define (generate-double-tag-function tag-name) (lambda (contents . attributes) (double-tag tag-name contents attributes))) (define (generate-single-tag-function tag-name) (lambda attributes (single-tag tag-name attributes))) (define (single-tag name attributes) (start-tag name attributes)) (define (double-tag name contents attributes) (string-append (start-tag name attributes) (as-string contents) (end-tag name))) (define (start-tag kind attributes) (if (null? attributes) (string-append "<" kind ">") (let ((html-attributes (linearize-attributes attributes))) (string-append "<" kind " " html-attributes " >")))) (define (end-tag kind) (string-append "")) (define (linearize-attributes attr-list) (string-append (linearize-attributes-1 (reverse attr-list) "" (length attr-list)))) (define (linearize-attributes-1 attr-list res-string lgt) (cond ((null? attr-list) res-string) ((>= lgt 2) (linearize-attributes-1 (cddr attr-list) (string-append (linearize-attribute-pair (car attr-list) (cadr attr-list)) " " res-string) (- lgt 2))) ((< lgt 2) (error "The attribute list must have even length")))) (define (linearize-attribute-pair val attr) (string-append (as-string attr) " = " (string-it (as-string val)))) (define (map-concat f lst) (apply string-append (map f lst)))