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

Add a preliminary online editor and embedded compiler.

parent 913ed99b
......@@ -4,6 +4,8 @@ build_flags
cduce*_js_runtime*
tests/js/*.js
!tests/js/cducetop_js_runtime.js
!tests/js/cduceeditor_js_runtime.js
!tests/js/cduceeditor_config.js
*.o
*.cmo
*.cdo
......
......@@ -283,6 +283,7 @@ CDUCE = $(OBJECTS) driver/start.cmo
ALL_OBJECTS = $(OBJECTS_NO_MLIFACE) \
driver/cduce_js_runtime.cmo \
driver/cducetop_js_runtime.cmo \
driver/cduceeditor_js_runtime.cmo \
driver/start.cmo driver/examples.cmo \
driver/webiface.cmo driver/evaluator.cmo \
tools/validate.cmo \
......@@ -322,8 +323,11 @@ dtd2cduce: tools/dtd2cduce.ml
@echo "Build $@"
$(HIDE)$(OCAMLFIND) $(CAML) -o $@ -package "$(PXP_PACK) netcgi2" -linkpkg $^
##TODO factor the code below.
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
CDUCEEDITOR_JS_RUNTIME = $(OBJECTS) runtime/cduce_js.cmo driver/cduceeditor_js_runtime.cmo
cduce_js_runtime: $(CDUCE_JS_RUNTIME)
@echo "Build $@"
$(HIDE)$(CAMLC) -custom -linkpkg camlp4lib.cma $(INCLUDES) -o $@ $^ $(EXTRA_LINK_OPTS)
......@@ -351,6 +355,19 @@ cducetop_js_runtime.js:
$(HIDE) js_of_ocaml --extern-fs -I . $(STDLIB_CDO:%=--file=%) \
+nat.js +weak.js +toplevel.js cducetop_js_runtime
cduceeditor_js_runtime: $(CDUCEEDITOR_JS_RUNTIME)
@echo "Build $@"
$(HIDE) $(MAKE) stdlib
$(HIDE)$(CAMLC) -custom -linkpkg camlp4lib.cma $(INCLUDES) -o $@ $^ $(EXTRA_LINK_OPTS)
cduceeditor_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 STD_LIBDIR=/static/stdlib/ \
cduceeditor_js_runtime
$(HIDE) js_of_ocaml --extern-fs -I . $(STDLIB_CDO:%=--file=%) \
+nat.js +weak.js +toplevel.js cduceeditor_js_runtime
.PHONY: compute_depend cduce_js_runtime.bytecode
......
......@@ -247,9 +247,11 @@ runtime/print_xml.cmx : runtime/value.cmx types/sequence.cmx \
schema/schema_builtin.cmx misc/ns.cmx types/intervals.cmx misc/imap.cmx \
types/ident.cmx misc/encodings.cmx types/atoms.cmx runtime/print_xml.cmi
compile/operators.cmo : runtime/value.cmi types/types.cmi typing/typer.cmi \
runtime/eval.cmi parser/cduce_loc.cmi compile/operators.cmi
misc/ns.cmi types/ident.cmo runtime/eval.cmi parser/cduce_loc.cmi \
compile/operators.cmi
compile/operators.cmx : runtime/value.cmx types/types.cmx typing/typer.cmx \
runtime/eval.cmx parser/cduce_loc.cmx compile/operators.cmi
misc/ns.cmx types/ident.cmx runtime/eval.cmx parser/cduce_loc.cmx \
compile/operators.cmi
types/builtin.cmo : runtime/value.cmi types/types.cmi typing/typer.cmi \
types/sequence.cmi runtime/print_xml.cmi compile/operators.cmi \
misc/ns.cmi runtime/load_xml.cmi types/intervals.cmi types/ident.cmo \
......@@ -313,11 +315,13 @@ 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
misc/ns.cmi driver/librarian.cmi types/ident.cmo misc/html.cmi \
parser/cduce_loc.cmi driver/cduce_config.cmi driver/cduce.cmi \
types/builtin.cmi
driver/run.cmx : runtime/value.cmx parser/ulexer.cmx misc/stats.cmx \
driver/librarian.cmx types/ident.cmx misc/html.cmx parser/cduce_loc.cmx \
driver/cduce_config.cmx driver/cduce.cmx types/builtin.cmx
misc/ns.cmx driver/librarian.cmx types/ident.cmx misc/html.cmx \
parser/cduce_loc.cmx driver/cduce_config.cmx driver/cduce.cmx \
types/builtin.cmx
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 \
......@@ -326,6 +330,10 @@ 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/cduceeditor_js_runtime.cmo : driver/librarian.cmi \
runtime/cduce_js.cmi driver/cduce_config.cmi driver/cduce.cmi
driver/cduceeditor_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 :
......@@ -379,7 +387,7 @@ types/compunit.cmi :
types/sortedList.cmi : misc/custom.cmo
types/var.cmi : types/sortedList.cmi misc/custom.cmo
types/bool.cmi : types/var.cmi misc/custom.cmo
types/intervals.cmi : misc/custom.cmo types/bool.cmi
types/intervals.cmi : misc/hBig_int.cmi types/bool.cmi
types/chars.cmi : misc/custom.cmo types/bool.cmi
types/atoms.cmi : misc/ns.cmi misc/encodings.cmi misc/custom.cmo \
types/bool.cmi
......@@ -432,7 +440,7 @@ compile/compile.cmi : runtime/value.cmi types/types.cmi typing/typer.cmi \
schema/schema_parser.cmi : schema/schema_types.cmi
runtime/load_xml.cmi : runtime/value.cmi misc/ns.cmi
runtime/print_xml.cmi : runtime/value.cmi misc/ns.cmi
compile/operators.cmi : runtime/value.cmi types/types.cmi \
compile/operators.cmi : runtime/value.cmi types/types.cmi misc/ns.cmi \
parser/cduce_loc.cmi
types/builtin.cmi : runtime/value.cmi typing/typer.cmi
driver/librarian.cmi : runtime/value.cmi types/types.cmi typing/typer.cmi \
......
......@@ -377,7 +377,7 @@ let compile_run src =
then raise (InvalidInputFilename src)
else Filename.chop_suffix (Filename.basename src) ".cd" in
let name = U.mk_latin1 name in
Librarian.compile_run !verbose name src;
Librarian.compile_run !verbose name (`File src);
with exn -> catch_exn Format.err_formatter exn; exit 1
let run obj =
......
......@@ -131,14 +131,21 @@ let set_hash c =
(* This invalidates all hash tables on types ! *)
let rec compile verbose name src =
let rec compile verbose name (src : [< `File of string | `String of string ]) =
protect_op "Compile external file";
let ic =
if src = "" then (Cduce_loc.push_source `Stream; stdin)
else
try Cduce_loc.push_source (`File src); open_in src
with Sys_error _ -> raise (CannotOpen src) in
let input = Stream.of_channel ic in
let input, finalize =
match src with
`File name ->
let ic, finalize =
if name = "" then (Cduce_loc.push_source `Stream; stdin, ignore)
else
try Cduce_loc.push_source (`File name); let ic = open_in name in (ic, fun () -> close_in ic)
with Sys_error _ -> raise (CannotOpen name)
in Stream.of_channel ic, finalize
| `String code ->
Cduce_loc.push_source (`String code);
Stream.of_string code, ignore
in
let p =
try Parser.prog input
with
......@@ -146,7 +153,7 @@ let rec compile verbose name src =
| Ulexer.Loc.Exc_located ((i,j), e) ->
raise_loc i j e
in
if src <> "" then close_in ic;
finalize ();
let show =
if verbose
......@@ -166,7 +173,7 @@ let rec compile verbose name src =
with Location (loc, _, Typer.UnboundCompUnit (name2)) when !depends ->
Compunit.leave ();
let src2 = find_obj ~ext:".cd" name2 in
let c, deps = compile verbose name2 src2 in
let c, deps = compile verbose name2 (`File src2) in
set_hash c;
let pools = Value.extract_all () in
assert (c.digest == None);
......@@ -175,6 +182,7 @@ let rec compile verbose name src =
register c;
Tbl.add tbl name2 c;
`Depends ((c, pools, src2 ^ "o")::deps)
| e -> Compunit.leave (); raise e
end
with
`Principal (descr, cu) -> descr, cu, deps
......@@ -190,7 +198,7 @@ let rec compile verbose name src =
let compile_save verbose name src out =
protect_op "Save compilation unit";
let c, deps = compile verbose name src in
let c, deps = compile verbose name (`File src) in
set_hash c;
let pools = Value.extract_all () in
let deps = deps @ [ (c, pools, out) ] in
......@@ -223,10 +231,11 @@ let rec run c =
("Librarian.run. Already running:" ^ (U.to_string c.name))
| `Evaluated -> ()
let compile_run verbose name src =
let compile_run ?(unload=false) verbose name src =
let c,_ = compile verbose name src in
register c;
run c
run c;
if unload then CTbl.remove ctbl c.descr
let load_run name = reg_types := false; run (load name)
......
......@@ -10,7 +10,8 @@ val run_loaded: bool ref
val depends: bool ref
val compile_save: bool -> U.t -> string -> string -> unit
val compile_run: bool -> U.t -> string -> unit
val compile_run: ?unload:bool -> bool -> U.t -> [ `File of string | `String of string ] -> unit
val load_run: U.t -> unit
val run: Compunit.t -> unit
......
......@@ -3,10 +3,16 @@ let null_js_str s =
(fun () -> "")
Js.to_string
let main_document = ref None
let get_document () =
match !main_document with
None -> assert false (* should be initialized by the call to init () below *)
| Some d -> d
let load_from_dom start_e end_e text_e id =
(* find the node in the current page with id *)
let elem = Dom_html.document ## getElementById (Js.string id) in
let elem = (get_document ()) ## getElementById (Js.string id) in
match Js.Opt.to_option elem with
None -> Value.failwith' ("No element with id : " ^ id)
| Some elem ->
......@@ -54,7 +60,7 @@ let load_from_dom start_e end_e text_e id =
let replace_inner id str =
(* replace content of id by str *)
let elem = Dom_html.document ## getElementById (Js.string id) in
let elem = (get_document ()) ## getElementById (Js.string id) in
match Js.Opt.to_option elem with
None -> Value.failwith' ("No element with id : " ^ id)
| Some elem -> elem ## innerHTML <- (Js.string str)
......@@ -62,7 +68,7 @@ let replace_inner id str =
let replace_outer id str =
(* replace id by str *)
let elem = Dom_html.document ## getElementById (Js.string id) in
let elem = (get_document ()) ## getElementById (Js.string id) in
match Js.Opt.to_option elem with
None -> Value.failwith' ("No element with id : " ^ id)
| Some elem -> elem ## outerHTML <- (Js.string str)
......@@ -100,7 +106,7 @@ let register_event id event handler =
(* add an event with handler to id *)
let mlid = Value.cduce2ocaml_string id in
let mlevent = Value.cduce2ocaml_string event in
let elem = Dom_html.document ## getElementById (Js.string mlid) in
let elem = (get_document ()) ## getElementById (Js.string mlid) in
let event = Js.string ("on" ^ mlevent) in
match Js.Opt.to_option elem with
None -> Value.failwith' ("No element with id : " ^ mlid)
......@@ -135,5 +141,6 @@ let use () =
Print_xml.replace_inner := replace_inner;
Print_xml.replace_outer := replace_outer;
Print_xml.register_event := register_event;
main_document := Some (Dom_html.document);
define_prims()
val use : unit -> unit
val main_document : Dom_html.document Js.t option ref
var editor = ace.edit("editor");
editor.setTheme("ace/theme/monokai");
editor.getSession().setMode("ace/mode/ocaml");
var Range = ace.require("ace/range").Range;
var selectedRange = null;
var marker = null;
editor.$blockScrolling = Infinity;
var highlightError = function (a,b,c,d)
{
selectedRange = new Range (a,b,c,d);
marker = editor.session.addMarker(selectedRange, "error", "text");
}
editor.on("focus",
function () {
if (selectedRange)
editor.selection.setSelectionRange(selectedRange);
if (marker) {
setTimeout(function() {
editor.session.removeMarker(marker);
marker = null;
}, 5000);
}
return false;
});
var fileName = "";
var file = document.getElementById("file_selector");
file.addEventListener("change", function (ev) {
var f = ev.target.files[0];
if (f) {
var r = new FileReader();
r.onload = function(e) {
var contents = e.target.result;
editor.setValue(contents,-1);
};
r.readAsText(f);
};
fileName = this.value;
this.value = null;
}, false);
document.getElementById("clear_buffer_button").addEventListener("click",
function () { editor.setValue("",-1); }, false);
document.getElementById("clear_console_button").addEventListener("click",
function () { document.getElementById("output_area").innerHTML=""; }, false);
var saveData = (function () {
var a = document.createElement("a");
document.body.appendChild(a);
a.style = "display: none";
return function () {
var blob = new Blob([ editor.getValue() ], {type: "text/plain"});
var url = window.URL.createObjectURL(blob);
a.href = url;
a.download = fileName;
a.click();
window.URL.revokeObjectURL(url);
};
}());
document.getElementById("save_button").addEventListener("click", saveData, false);
../../cduceeditor_js_runtime.js
\ No newline at end of file
<html xmlns="http://www.w3.org/1999/xhtml">
<head>
<title>CDuce online editor</title>
<style>
.stdout { color : #bbccff; }
.stderr { color : #ffcccc ; }
#main_area {
position:relative;
}
#top_panel {
display:block;
width: 100%;
vertical-align:top;
height:50%;
position:relative;
}
#output_area {
white-space: pre-wrap;
background: #000000;
font-family: monospace;
height: 30ex;
width:75%;
}
.error {
position:absolute;
background:rgba(200,100,100,0.5);
z-index:40;
}
#editor {
display:inline-block;
width:75%;
height:50ex;
}
#button_container {
display:inline-block;
width:20%;
height:50%;
vertical-align:top;
}
.btn { width:88px;
}
#file_selector {
width: 89px;
}
</style>
</head>
<body >
<div id="main_area">
<div id="top_panel">
<div id="editor">(* CDuce code here: *) </div>
<div id="button_container">
<input type="file" id="file_selector" />
<button class="btn" id="save_button">Save file</button>
<button class="btn" id="compile_button">Compile &amp; Run</button>
<button class="btn" id="clear_buffer_button">Clear Buffer</button>
<button class="btn" id="clear_console_button">Clear Console</button>
</div>
</div>
<div id="output_area"></div>
</div>
<script src="ace-builds/src-noconflict/ace.js" type="text/javascript" charset="utf-8"></script>
<script type="text/javascript" src="cduceeditor_config.js" ></script>
<script type="text/javascript" src="cduceeditor_js_runtime.js" > </script>
</body>
</html>
<html xmlns="http://www.w3.org/1999/xhtml">
<head>
<title>Sandbox</title>
</head>
<body>
<div id="content">
</div>
</body>
</html>
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