Commit bc6d14f3 authored by Kim Nguyễn's avatar Kim Nguyễn
Browse files

Add a javascript version of the toplevel.

parent a4c492f2
......@@ -279,6 +279,7 @@ CDUCE = $(OBJECTS) driver/start.cmo
ALL_OBJECTS = $(OBJECTS_NO_MLIFACE) \
driver/cduce_js_runtime.cmo \
driver/cducetop_js_runtime.cmo \
driver/start.cmo driver/examples.cmo \
driver/webiface.cmo driver/evaluator.cmo \
tools/validate.cmo \
......@@ -319,6 +320,7 @@ dtd2cduce: tools/dtd2cduce.ml
$(HIDE)$(OCAMLFIND) $(CAML) -o $@ -package "$(PXP_PACK) netcgi2" -linkpkg $^
CDUCE_JS_RUNTIME = $(OBJECTS) runtime/cduce_js.cmo driver/cduce_js_runtime.cmo
CDUCETOP_JS_RUNTIME = $(OBJECTS) runtime/cduce_js.cmo driver/cducetop_js_runtime.cmo
cduce_js_runtime: $(CDUCE_JS_RUNTIME)
@echo "Build $@"
$(HIDE)$(CAMLC) -custom -linkpkg camlp4lib.cma $(INCLUDES) -o $@ $^ $(EXTRA_LINK_OPTS)
......@@ -332,6 +334,18 @@ cduce_js_runtime.bytecode:
$(HIDE) cp cduce_js_runtime cduce_js_runtime.bytecode
#js_of_ocaml +nat.js +weak.js +toplevel.js cduce_js_runtime
cducetop_js_runtime: $(CDUCETOPJS_RUNTIME)
@echo "Build $@"
$(HIDE)$(CAMLC) -custom -linkpkg camlp4lib.cma $(INCLUDES) -o $@ $^ $(EXTRA_LINK_OPTS)
cducetop_js_runtime.js:
@echo "Build $@"
$(HIDE) $(MAKE) NATIVE=false ML_INTERFACE=false PXP=false EXPAT=false \
CURL=false NETCLIENT=false NETCLIENT4=false NETSTRING=false \
CGI=false PXP_WLEX=false \
cducetop_js_runtime
$(HIDE) js_of_ocaml +nat.js +weak.js +toplevel.js cducetop_js_runtime
.PHONY: compute_depend cduce_js_runtime.bytecode
......@@ -357,7 +371,7 @@ clean:
$(HIDE) rm -f `find . -name "*~"`
$(HIDE) rm -f *.cmi *.cmo *.cma *.cmx *.a *.cmxa *.cmt *.cmti *.o *~ META
$(HIDE) rm -f cduce$(EXE) ocamlprof.dump
$(HIDE) rm -f cduce_js_runtime cduce_js_runtime.js cduce_js_runtime.bytecode
$(HIDE) rm -f cduce*js_runtime*
$(HIDE) rm -f dtd2cduce$(EXE) webiface$(EXE) evaluator$(EXE)
$(HIDE) rm -Rf prepro package
$(HIDE) rm -f web/www/*.html web/*~
......
......@@ -288,9 +288,9 @@ driver/cduce.cmx : runtime/value.cmx parser/ulexer.cmx types/types.cmx \
compile/lambda.cmx types/ident.cmx runtime/eval.cmx compile/compile.cmx \
parser/cduce_loc.cmx types/builtin_defs.cmx types/builtin.cmx \
compile/auto_pat.cmx types/atoms.cmx parser/ast.cmx driver/cduce.cmi
parser/cduce_netclient.cmo : runtime/value.cmi parser/cduce_url.cmi \
parser/cduce_curl.cmo : runtime/value.cmi parser/cduce_url.cmi \
driver/cduce_config.cmi
parser/cduce_netclient.cmx : runtime/value.cmx parser/cduce_url.cmx \
parser/cduce_curl.cmx : runtime/value.cmx parser/cduce_url.cmx \
driver/cduce_config.cmx
runtime/cduce_pxp.cmo : runtime/value.cmi schema/schema_xml.cmi \
runtime/load_xml.cmi parser/cduce_url.cmi driver/cduce_config.cmi \
......@@ -304,6 +304,12 @@ runtime/cduce_pxp.cmo : runtime/value.cmi schema/schema_xml.cmi \
runtime/cduce_pxp.cmx : runtime/value.cmx schema/schema_xml.cmx \
runtime/load_xml.cmx parser/cduce_url.cmx driver/cduce_config.cmx \
runtime/cduce_pxp.cmi
runtime/cduce_expat.cmo : runtime/value.cmi schema/schema_xml.cmi \
runtime/load_xml.cmi parser/cduce_url.cmi driver/cduce_config.cmi \
runtime/cduce_expat.cmi
runtime/cduce_expat.cmx : runtime/value.cmx schema/schema_xml.cmx \
runtime/load_xml.cmx parser/cduce_url.cmx driver/cduce_config.cmx \
runtime/cduce_expat.cmi
driver/run.cmo : runtime/value.cmi parser/ulexer.cmi misc/stats.cmi \
driver/librarian.cmi types/ident.cmo misc/html.cmi parser/cduce_loc.cmi \
driver/cduce_config.cmi driver/cduce.cmi types/builtin.cmi
......@@ -314,6 +320,10 @@ driver/cduce_js_runtime.cmo : runtime/cduce_js.cmi driver/cduce_config.cmi \
driver/cduce.cmi
driver/cduce_js_runtime.cmx : runtime/cduce_js.cmx driver/cduce_config.cmx \
driver/cduce.cmx
driver/cducetop_js_runtime.cmo : driver/librarian.cmi runtime/cduce_js.cmi \
driver/cduce_config.cmi driver/cduce.cmi
driver/cducetop_js_runtime.cmx : driver/librarian.cmx runtime/cduce_js.cmx \
driver/cduce_config.cmx driver/cduce.cmx
driver/start.cmo : driver/run.cmo
driver/start.cmx : driver/run.cmx
driver/examples.cmo :
......@@ -350,9 +360,9 @@ runtime/cduce_pxp.cmo : runtime/value.cmi schema/schema_xml.cmi \
runtime/cduce_pxp.cmx : runtime/value.cmx schema/schema_xml.cmx \
runtime/load_xml.cmx parser/cduce_url.cmx driver/cduce_config.cmx \
runtime/cduce_pxp.cmi
runtime/cduce_js.cmo : runtime/value.cmi runtime/print_xml.cmi \
runtime/cduce_js.cmo : runtime/value.cmi runtime/print_xml.cmi misc/ns.cmi \
runtime/load_xml.cmi runtime/cduce_js.cmi
runtime/cduce_js.cmx : runtime/value.cmx runtime/print_xml.cmx \
runtime/cduce_js.cmx : runtime/value.cmx runtime/print_xml.cmx misc/ns.cmx \
runtime/load_xml.cmx runtime/cduce_js.cmi
driver/cduce_config.cmi :
misc/stats.cmi :
......@@ -430,6 +440,7 @@ driver/cduce.cmi : runtime/value.cmi types/atoms.cmi
runtime/cduce_pxp.cmi :
runtime/cduce_pxp.cmi :
runtime/cduce_expat.cmi :
runtime/cduce_expat.cmi :
runtime/cduce_pxp.cmi :
runtime/cduce_js.cmi :
schema/schema_types.cmi : runtime/value.cmi misc/ns.cmi misc/encodings.cmi \
......
let log s =
Firebug.console ## log (Js.string s)
let output buff c =
match c with
'<' -> Buffer.add_string buff "&lt;"
| '>' -> Buffer.add_string buff "&gt;"
| '\'' -> Buffer.add_string buff "&apos;"
| '"' -> Buffer.add_string buff "&quot;"
| '&' -> Buffer.add_string buff "&apos;"
| _ -> Buffer.add_char buff c
let output_str buff str idx len =
for i = idx to idx + len - 1 do
output buff str.[i]
done
let make_ppf elem style =
let otag = ref false in
let buff = Buffer.create 256 in
let output str idx len =
if not !otag then begin
Buffer.add_string buff "<span class='";
Buffer.add_string buff style;
Buffer.add_string buff "'>";
otag:=true
end;
output_str buff str idx len
in
let flush () =
if !otag then begin
Buffer.add_string buff "</span>";
otag := false
end;
let s = Buffer.contents buff in
Buffer.clear buff;
elem ## innerHTML <- ((elem ## innerHTML) ## concat (Js.string s))
in
Format.make_formatter output flush
let find_eol s =
let rec loop i =
if i <= 0 then -1 else
if s.[i] == ';' && s.[i-1] == ';' then i
else if s.[i] == ' ' || s.[i] == '\n' || s.[i] == '\t' then loop (i-1)
else -1
in
loop (String.length s - 1)
let topinput inputarea fmt fmt_err =
let handler =
Dom.handler (fun ev ->
match ev ## keyCode, Js.to_bool (ev ## ctrlKey) with
13, _ (* enter *) ->
let s = Js.to_string (inputarea ## value) in
let idx = find_eol s in
if idx > 0 then begin
(* copy the phrase to the output *)
let s = String.sub s 0 (idx + 1) in
Format.fprintf fmt " > %s@\n # %!" s;
(* evaluate *)
ignore (Cduce.topinput fmt fmt_err (Stream.of_string s));
Format.pp_print_flush fmt ();
Format.pp_print_flush fmt_err ();
(* clear the text area *)
inputarea ## value <- (Js.string "");
Js._false
end
else Js._true
| 38, true (* ctrl-up *) -> assert false
| 40, true (* ctrl-down *) -> assert false
| c, _ -> Js._true
)
in
inputarea ## onkeydown <- handler
let get_opt o =
Js.Opt.get o (fun () -> assert false)
let () =
Cduce_config.init_all ();
Cduce_js.use ();
let inputarea = get_opt (Dom_html.document ## getElementById (Js.string "inputarea")) in
let inputarea = match Dom_html.tagged inputarea with
Dom_html.Textarea e -> e
| _ -> assert false
in
let outputdiv = get_opt (Dom_html.document ## getElementById (Js.string "outputarea")) in
let fmt = make_ppf outputdiv "stdout" in
let fmt_err = make_ppf outputdiv "stderr" in
Cduce.toplevel := true;
Librarian.run_loaded := true;
Format.fprintf fmt " CDuce version %s\n@." <:symbol<cduce_version>>;
try
topinput inputarea fmt fmt_err
with
Invalid_argument "Function 'exit' not implemented" ->
Format.fprintf fmt_err "Top-level exited. Please reload the page@\n%!";
Format.pp_print_flush fmt ();
Format.pp_print_flush fmt_err ();
()
<html xmlns="http://www.w3.org/1999/xhtml">
<head>
<title>Test js_of_ocaml</title>
<style>
.stdout { color : bbbbff; }
.stderr { color : ffcccc ; }
#mainarea { width: 72ex;
background:black;
color:white;
font-family: monospace;
font-size: large;
padding:1ex;
}
#outputarea { width: 100%;
color:black;
white-space: pre }
#inputarea {
width: 90%;
color:white;
background:black;
border: none;
vertical-align:top;
resize:none;
}
</style>
<!-- automatically resize the text area -->
<script type="text/javascript">
var observe;
if (window.attachEvent) {
observe = function (element, event, handler) {
element.attachEvent('on'+event, handler);
};
}
else {
observe = function (element, event, handler) {
element.addEventListener(event, handler, false);
};
}
function init () {
var text = document.getElementById('inputarea');
function resize () {
text.style.height = 'auto';
text.style.height = text.scrollHeight+'px';
}
/* 0-timeout to get the already changed text */
function delayedResize () {
window.setTimeout(resize, 0);
}
observe(text, 'change', resize);
observe(text, 'cut', delayedResize);
observe(text, 'paste', delayedResize);
observe(text, 'drop', delayedResize);
observe(text, 'keydown', delayedResize);
text.focus();
text.select();
resize();
}
</script>
</head>
<body onload='init()'>
<div id="mainarea">
<div id="outputarea"></div>
&nbsp;&gt;&nbsp;<textarea id="inputarea" rows='1'></textarea>
</div>
<script type="text/javascript" src="../../cducetop_js_runtime.js" > </script>
</body>
</html>
......@@ -41,7 +41,7 @@ module V = struct
let is_internal x = x.kind == Internal
let ident x = Ident.U.get_str x.name
let print ppf x = Format.fprintf ppf "'%a_%i_%a" Ident.U.print x.name x.id print_kind x.kind
let print ppf x = Format.fprintf ppf "'%a" Ident.U.print x.name
end
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment