PLaneT Package Repository : Home > dherman > xhtml.plt

Home > dherman > xhtml.plt > package version 1.1
xhtml.ss
(module xhtml mzscheme
  (require (lib "servlet.ss" "web-server"))
  (require (lib "response.ss" "web-server"))
  (require (lib "xml.ss" "xml"))
  (require (lib "etc.ss"))
  (require (lib "string.ss"))
  (require (lib "contract.ss"))

  ;; accepted-mime-types : request -> (listof string)
  (define (accepted-mime-types request)
    (with-handlers ([exn? (lambda (exn) null)])
      (let ([header (extract-binding/single 'accept (request-headers request))])
        (regexp-split #rx",[ \t\r\n]*"
                      (if (bytes? header)
                          (bytes->string/latin-1 header)
                          header)))))

  ;; xhtml-mime-type : (optional request) -> bytes
  (define (xhtml-mime-type request)
    (if (and request (member "application/xhtml+xml" (accepted-mime-types request)))
        #"application/xhtml+xml"
        #"text/html"))

  (define (make-doctype name path)
    (format "<!DOCTYPE html PUBLIC \"-//W3C//DTD ~a//EN\" \"http://www.w3.org~a\">\n"
            name
            path))

  (define xhtml1-transitional
    (make-doctype "XHTML 1.0 Transitional"
                  "/TR/xhtml1/DTD/xhtml1-transitional.dtd"))
  (define xhtml1-strict
    (make-doctype "XHTML 1.0 Strict"
                  "/TR/xhtml1/DTD/xhtml1-strict.dtd"))
  (define xhtml1-frameset
    (make-doctype "XHTML 1.0 Frameset"
                  "/TR/xhtml1/DTD/xhtml1-frameset.dtd"))
  (define xhtml1.1
    (make-doctype "XHTML 1.1"
                  "/TR/xhtml11/DTD/xhtml11.dtd"))
  (define xhtml2.0
    (make-doctype "XHTML 2.0"
                  "/MarkUp/DTD/xhtml2.dtd"))

  (define make-response/xhtml
    (opt-lambda (xexpr [doctype xhtml1-transitional] [request #f])
      (make-response/full
       200
       "Okay"
       (current-seconds)
       (xhtml-mime-type request)
       null
       (list doctype (xexpr->string xexpr)))))

  (provide/contract
    [xhtml-mime-type (request? . -> . bytes?)]
    [make-response/xhtml ((xexpr?) (string? request?) . opt-> . response?)]
    [xhtml1-transitional string?]
    [xhtml1-strict string?]
    [xhtml1-frameset string?]
    [xhtml1.1 string?]
    [xhtml2.0 string?]))