(module repl mzscheme
 
  (require (lib "servlet.ss" "web-server"))
  (provide interface-version timeout start)
 
  (define interface-version 'v1)
  (define timeout 10)
 
  ; start : request -> response
  (define (start initial-request)
    
    (define-values (read-pipe-input read-pipe-output) (make-pipe))
    (define-values (print-pipe-input print-pipe-output) (make-pipe))
    
    (define (get-print)
      (let loop ((acc (list)))
        (if (char-ready? print-pipe-input)
            (loop (cons (read-char print-pipe-input)
                        acc))
            (list->string (reverse acc)))))
    
    (thread
     (lambda ()
       (parameterize ([current-input-port read-pipe-input]
                      [current-output-port print-pipe-output]
                      [current-error-port print-pipe-output])
         (read-eval-print-loop))))
    
    (let* ((bindings (request-bindings
                      (send/forward
                       (lambda (k-url)
                         `(html
                           (head
                            (script ([type "text/javascript"])
"var xmlHttp;\n"
"function send()\n"
"{\n"
"  var str = document.getElementById(\"readtext\").value;\n"
"  if (str.length==0)\n"
"  {\n"
"      return;\n"
"  }\n"
"document.getElementById(\"readtext\").value = \"\";\n"
"  xmlHttp=GetXmlHttpObject();\n"
"  if (xmlHttp==null)\n"
"  {\n"
"      alert (\"Your browser does not support AJAX!\");\n"
"      return;\n"
"  }\n"
"  var url=\"" ,k-url "\";\n"
"  url=url+\"?i=\"+str;\n"
"  url=url+\"&sid=\"+Math.random();\n"
"  xmlHttp.onreadystatechange=stateChanged1;\n"
"  xmlHttp.open(\"GET\",url,true);\n"
"  xmlHttp.send(null);\n"
"}\n"
"function stateChanged1()\n"
"{\n"
"    if (xmlHttp.readyState==4)\n"
"    {\n"
;for test
"        alert (xmlHttp.responseText);\n"
"    }\n"
"}\n"
"function receive()\n"
"{\n"
"  xmlHttp=GetXmlHttpObject();\n"
"  if (xmlHttp==null)\n"
"  {\n"
"      alert (\"Your browser does not support AJAX!\");\n"
"      return;\n"
"  }\n"
"  var url=\"" ,k-url "\";\n"
"  url=url+\"&sid=\"+Math.random();\n"
"  xmlHttp.onreadystatechange=stateChanged2;\n"
"  xmlHttp.open(\"GET\",url,true);\n"
"  xmlHttp.send(null);\n"
"}\n"
"function stateChanged2()\n"
"{\n"
"    if (xmlHttp.readyState==4)\n"
"    {\n"
"        document.getElementById(\"printtext\").value = document.getElementById(\"printtext\").value + xmlHttp.responseText;\n"
"        receive();\n"
"    }\n"
"}\n"
"function GetXmlHttpObject()\n"
"{\n"
"var xmlHttp=null;\n"
"try\n"
"  {\n"
"  // Firefox, Opera 8.0+, Safari\n"
"  xmlHttp=new XMLHttpRequest();\n"
"  }\n"
"catch (e)\n"
"  {\n"
"  // Internet Explorer\n"
"  try\n"
"    {\n"
"    xmlHttp=new ActiveXObject(\"Msxml2.XMLHTTP\");\n"
"    }\n"
"  catch (e)\n"
"    {\n"
"    xmlHttp=new ActiveXObject(\"Microsoft.XMLHTTP\");\n"
"    }\n"
"  }\n"
"return xmlHttp;\n"
"}\n"
                                    ))
                           (body
                            (form
                             (p "Scheme REPL")
                             (p (textarea ([rows "15"]
                                           [cols "60"]
                                           [name "printtext"]
                                           [id "printtext"]
                                           [readonly "readonly"])
                                          "Welcome to MzScheme web interface\n"))
                             (p (textarea ([rows "5"]
                                           [cols "50"]
                                           [name "readtext"]
                                           [id "readtext"])
                                          "\n")
                                (input ([type "button"]
                                        [value "Send"]
                                        [onclick "send()"]))))
                            (script ([type "text/javascript"])
                                    "receive();")))))))
           (i (and (exists-binding? 'i bindings)
                   (extract-binding/single 'i bindings))))
      (if i
          (begin (write-string i print-pipe-output)
                 (newline print-pipe-output)
                 (write-string i read-pipe-output)
                 (newline read-pipe-output)
                 (make-response/full 200
                                     "Okay"
                                     (current-seconds)
                                     "text/plain"
                                     (list)
                                     (list "Chongkai")))
          (make-response/full 200
                              "Okay"
                              (current-seconds)
                              "text/plain"
                              (list)
                              (list (begin (sleep 1) (get-print))))))))