cducetop_js_runtime.ml 3.93 KB
Newer Older
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
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)

50
51
52
53
54
55
56
57
58
59
type history = {
    mutable undo : string list;
    mutable redo : string list
  }

let topinput inputarea outputarea fmt fmt_err =
  let history = { undo = [];
		  redo = []
		}
  in
60
61
  let handler =
    Dom.handler (fun ev ->
62
63
64
		 let ctrl = Js.to_bool (ev ## ctrlKey) in
		 match ev ## keyCode with
		   13 (* enter *) ->
65
66
67
68
69
70
71
		   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 *)
72
73
74
75
		       history.undo <- List.rev_append history.redo history.undo;
		       history.redo <- [];
		       if Cduce.topinput fmt fmt_err (Stream.of_string s) then
			 history.undo <- s :: history.undo;
76
77
78
79
80
81
82
83
		       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

84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
		 | 38 (* ctrl-up *) when ctrl && history.undo <> [] ->
		    let s = List.hd history.undo in
		    inputarea ## value <- Js.string s;
		    history.undo <- List.tl history.undo;
		    history.redo <- s :: history.redo;
		    Js._false

		 | 40 (* ctrl-down *) when ctrl && history.redo <> [] ->
		    let s = List.hd history.redo in
		    inputarea ## value <- Js.string s;
		    history.redo <- List.tl history.redo;
		    history.undo <- s :: history.undo;
		    Js._false
		 | 76 (* ctrl-l *) when ctrl ->
		    Format.pp_print_flush fmt ();
		    Format.pp_print_flush fmt_err ();
		    outputarea ## innerHTML <- Js.string "";
		    Format.fprintf fmt "        CDuce version %s\n@." <:symbol<cduce_version>>;
		    Js._false

		 | 68 when ctrl -> exit 0
		 | _ -> Js._true
106
107
108
109
110
111
112
113
114
115
		)

  in
  inputarea ## onkeydown <- handler

let get_opt o =
  Js.Opt.get o (fun () -> assert false)

let () =
    Cduce_config.init_all ();
116
    Jsoo_plugin.use ();
117
118
119
120
121
122
123
124
125
126
127
128
    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
129
      topinput inputarea outputdiv fmt fmt_err
130
131
132
133
134
135
    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 ();
      ()