(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))))))))