PLaneT Package Repository : Home > untyped > delirium.plt

Home > untyped > delirium.plt > package version 1.0
delirium.ss
(module delirium mzscheme
  
  (require (lib "contract.ss")
           (lib "etc.ss")
           (lib "cut.ss" "srfi" "26")
           (lib "servlet.ss" "web-server"))
  
  (require (file "base.ss")
           (file "accessor.ss")
           (file "command.ss")
           (file "core.ss")
           (file "selector.ss"))
  
  ; Procedures -----------------------------------
  
  ;; run-delirium : test-suite -> response
  (define run-delirium
    (opt-lambda (request test [run-tests test/text-ui/pause-on-fail])
      (send-test-page)
      (test/delirium request test run-tests)))
  
  ;; send-test-page : -> void
  (define (send-test-page)
    (send/suspend/dispatch
     (lambda (embed-url)
       (make-response/full
        200 
        "Okay"
        (current-milliseconds)
        #"text/html"
        null
        (list #<<ENDHTML
<html>
<head>
<script type="text/javascript" src="/scripts/delirium/lib/prototype/prototype.js"></script>
<script type="text/javascript" src="/scripts/delirium/core/delirium.js"></script>
<script type="text/javascript" src="/scripts/delirium/core/map.js"></script>
<script type="text/javascript" src="/scripts/delirium/core/protocol.js"></script>
<script type="text/javascript" src="/scripts/delirium/core/accessor.js"></script>
<script type="text/javascript" src="/scripts/delirium/core/command.js"></script>
<script type="text/javascript" src="/scripts/delirium/core/selector.js"></script>
<script type="text/javascript">
// <![CDATA[

ENDHTML
              (js (ignore ((dot Event observe)
                           window
                           "load"
                           (lambda ()
                             (ignore ((dot Delirium start)
                                      "target"
                                      ,(embed-url (lambda (request) request))))))))
              #<<ENDHTML

// ]]>
</script>
<style type="text/css">
body { background: #ccc url(/images/delirium/background.png) repeat-x fixed top left;
       margin: 0px; font-family: Trebuchet MS,Helvetica,sans-serif; }
table { border: none; margin: 0px; padding: 0px; border-collapse: collapse; }
tr#targetrow td { border: none; margin: 0px; padding: 8px; }
tr#titlerow { height: 1em; }
tr#titlerow th { font-weight: normal; margin: 0px; padding: 0px 8px 8px 8px; }
iframe { background: #fff; margin: 0px; padding: 0px; border: 1px solid #aaa; }
</style>
</head>
<body>
<table width="100%" height="100%">
<tbody>
<tr id="targetrow"><td>
<iframe id="target" width="100%" height="100%"></iframe>
</td></tr>
<tr id="titlerow"><th id="title">
Delirium by <a href="http://www.untyped.com">Untyped</a>
</th></tr>
</tbody>
</table>
</body>
</html>

ENDHTML
              )))))
    
  ; Provide statements ---------------------------
  
  (provide (all-from (file "accessor.ss"))
           (all-from (file "command.ss"))
           (all-from (file "selector.ss")))
  
  (provide schemeunit-test?
           javascript-expression?
           javascript-statement?
           test/text-ui/pause-on-fail)
  
  (provide/contract
   [run-delirium (opt-> (request? schemeunit-test?)
                        (procedure?)
                        response?)])
  
  )