;; 6.891 Problem Set 1 -- Nelson Elhage ;; ;; ps1.scm -- the primary file for the problem set code ;; ;; Web page for the problemset can be found online at ;; http://web.mit.edu/nelhage/Public/6.891/ps1/ ;; Load initial code (load "simple-xhtml.scm") ;;Load some useful utility functions (load "util.scm") ;;;Problem 1.1 (define x-html (wrap-content "html")) (define x-head (wrap-content "head")) (define x-title (wrap-content "title")) (define x-header-1 (wrap-content "h1")) #| ;;Example usage to create a simple document (display (x-html (x-head (x-title "Sample HTML Page")) (x-body (x-header-1 "Scheme XHTML utilities") (x-paragraph "This is some sample XHTML generated by 6.891's PSET 1's XHTML tools")))) Sample HTML Page

Scheme XHTML utilities

This is some sample XHTML generated by 6.891's PSET 1's XHTML tools

|# ;;;Problem 1.2 (define x-strong (wrap-content "strong")) (define x-emphasis (wrap-content "em")) #| (define highlighted-keywords '(cond if define let lambda)) (define (highlight-syntax form) (cond ((list? form) (flatten-append "(" (map (lambda (f) (flatten-append (highlight-syntax f) " ")) form) ")")) ((symbol? form) (if (memq form highlighted-keywords) (x-strong (symbol->string form)) (symbol->string form))) ((string? form) (x-emphasis "\"" form "\"")) ((number? form) (number->string form)))) (display (x-html (x-head (x-title "Some Interesting XHTML")) (x-body (x-header-1 "A factorial function") (x-paragraph (highlight-syntax '(define (factorial n) (if (= n 0) 1 (* n (factorial - n 1))))))))) Some Interesting XHTML

A factorial function

( define (factorial n ) ( if (= n 0 ) 1 (* n (factorial - n 1 ) ) ) )

This would need a lot of work to look good, but it's a demonstration of the possibilities. Ideally, it would hook into pp somehow to take advantage of the existing pretty indentation code, wrap the block of code in a

 block, as well as doing
the styling with stylesheets and classes.

|#


;;;Problem 1.3

;;Redefine wrap-content to do what we want with attributes
(define ((wrap-content key) . content)
  (flatten-append "\n"
                  "<" key
                  (alist-to-attributes (car content))
                  ">"
                  (cdr content)
                  ""))

(define ((empty-element key) attrs)
  (flatten-append "\n" "<" key (alist-to-attributes attrs) "/>"))

;;Convert an alist of attributes into a string containing name="value"
;;pairs for each.
(define (alist-to-attributes atts)
  (define (attrs->string atts)
    (if (null? atts) '()
        (let ((attr (car atts))
              (others (cdr atts)))
          (cons
           (list (car attr) "=\"" (cadr attr) "\"" (if (null? others) "" " "))
           (attrs->string others)))))
  (cond ((list? atts)
         (apply flatten-append " "
                (attrs->string atts)))
        ((not atts) "")
        (else (error "Unknown attribute list type: alist-to-attributes"
                     atts))))

;Make flatten-append handle symbols
(define (flatten-append . pieces)
  (apply string-append
	 (map (lambda (piece)
		(cond ((string? piece) piece)
		      ((number? piece) (number->string piece))
		      ((list? piece) (apply flatten-append piece))
              ((symbol? piece) (symbol->string piece))
		      (else
		       (error "Unknown piece type: flatten-append"
			      piece))))
	      pieces)))

;;Redefine the elements we've defined so far
(define x-body (wrap-content "body"))
(define x-paragraph (wrap-content "p"))
(define x-html (wrap-content "html"))
(define x-head (wrap-content "head"))
(define x-title (wrap-content "title"))
(define x-header-1 (wrap-content "h1"))
(define x-break (empty-element "br"))
(define x-horizontal-rule (empty-element "hr"))
(define x-strong (wrap-content "strong"))
(define x-strong (wrap-content "strong"))
(define x-emphasis (wrap-content "em"))
(define x-code (wrap-content "code"))

;;Demonstration:
(define x-anchor (wrap-content "a"))

#|
(display (x-html #f
          (x-head #f (x-title #f "Search engines"))
          (x-body #f
           (map (lambda (engine)
                  (x-paragraph #f
                   (x-anchor `((href ,(cadr engine)))
                             (car engine))))
                '(("Google" "http://google.com")
                  ("Yahoo" "http://yahoo.com")
                  ("Altavista" "http://www.altavista.com/"))))))



Search engines


Google

Yahoo

Altavista
|#


;;;Problem 1.4
(define x-table (wrap-content "table"))
(define x-tr (wrap-content "tr"))
(define x-th (wrap-content "th"))
(define x-td (wrap-content "td"))

#|
;;Example usage

(display
 (x-paragraph #f "Multiplication table"
              (x-table '((border 1))
                       (map (lambda (n) (x-th #f n)) (iota 12 1))
                       (map (lambda (n)
                              (x-tr #f
                                    (cons (x-th #f n)
                                          (map (lambda (m) (x-td #f (* n m)))
                                               (iota 12 1)))))
                            (iota 12 1)))))
|#


;;;Problem 1.5

(load "tables.scm")


;;;Problem 1.6
(define (x-html-document . args)
  (flatten-append
   (xml-declaration)
   (xhtml-doctype)
   (x-html '((xmlns "http://www.w3.org/1999/xhtml")
             (xml:lang "en")
             (lang "en"))
           args)))

(define (xml-declaration)
  "")

(define (xhtml-doctype)
  "")


#|

Example: (from the assignment)

(display (x-html-document
          (x-head #f (x-title #f "A table"))
          (x-body #f
           (x-arrange (t-row
                       (t-column "A" (t-row "B" "C"))
                       (t-column "D" "E" "F")
                       "G")))))



A table



A
D
G

E

B
C

F
|#


(define x-header-2 (wrap-content "h2"))
(define x-unordered-list (wrap-content "ul"))
(define x-list-item (wrap-content "li"))
(define x-image (empty-element "img"))

;;See genpage.scm for code to generate a webpage for the problem set