Welcome to the CHICKEN Scheme pasting service
xml added by phasers_to_stun on Thu Jan 14 07:00:39 2016
(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 <p> tag is on the wrong line") (newline) (display-xml tag1) (newline)(newline) (write "with list notation and the text removed the <p> 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)