(use srfi-13) (use extras) ;Returns the length of a list (define (len lst) (define (len-help lst count) (cond ((not (eq? lst '())) (len-help (cdr lst) (+ count 1))) (else count))) (len-help lst 0)) (define (const-l fil len) ;makes a constant list of symbol fil len times (cond ((> len 0) (cons fil (const-l fil (- len 1)))) (else '()))) ;makes a string out of a list of tag attribute strings (define (make-attribute-string tag-atribs) (cond ((eq? tag-atribs '()) "") (else (string-join tag-atribs " ")))) (define (indent num) (string-join (const-l " " num) "")) (define (tag-name tag) (car tag)) (define (tag-atribs tag) (cadr tag)) (define (tag-elems tag) (caddr tag)) (define (print-tag tag close ind) (cond ((eq? close #f) (cond ((attributes? tag) (printf "~A<~A ~A>" (indent ind) (tag-name tag) (make-attribute-string (tag-atribs tag)))) (else (printf "~A<~A>" (indent ind) (tag-name tag))))) ((eq? close #t) (printf "~A<~A/>" (indent ind)(tag-name tag))))) (define (children? tag) (not (eq? (tag-elems tag) '()))) (define (attributes? tag) (not (eq? (tag-atribs tag) '()))) (define (display-xml tag) (define (recursive-display tag ind) (cond ((list? tag) (print-tag tag #f ind) (cond ((children? tag) (newline) (map (lambda (tg) (recursive-display tg (+ ind 1))) (tag-elems tag)) (newline) (print-tag tag #t ind)) (else (print-tag tag #t 0) (newline)))) (else (printf "~A~A" (indent ind) tag)))) (recursive-display tag 0)) (define tag1 (list 'html '() (list (list 'body '() (list (list 'h1 '() '(name)) (list 'p '() '(place))))))) (define tag2 (list 'html '() (list (list 'body '() (list (list 'h1 '() '()) (list 'p '() '())))))) (define tag3 '(html () ( (body () ( (h1 () (name)) (p () (place)) )) ))) (write "with list notation, notice the

tag is on the wrong line") (newline) (display-xml tag1) (newline)(newline) (write "with list notation and the text removed the

tag is on the correct line") (newline) (display-xml tag2) (newline)(newline) (write "using a quote for more succinct notation as a test") (newline) (display-xml tag3)