4 (* HTML simulator (first in its kind) *)
12 type html_msg = [ `Error of html_tag | `Msg of html_tag ]
14 let string_of_html_msg =
15 let rec string_of_html_tag = function
17 | `L msgs -> String.concat "" (List.map string_of_html_tag msgs)
21 | `Error tag -> "Error: " ^ string_of_html_tag tag
22 | `Msg tag -> string_of_html_tag tag
24 class html_logger ?width ?height ?packing ?show () =
25 let scrolled_window = GBin.scrolled_window ?packing ?show () in
26 let vadj = scrolled_window#vadjustment in
28 GText.view ~editable:false ~cursor_visible:false
29 ?width ?height ~packing:(scrolled_window#add) ()
33 [`FOREGROUND_SET true ;
35 (Gdk.Color.alloc (Gdk.Color.get_system_colormap ()) (`NAME "green"))]
39 [`FOREGROUND_SET true ;
41 (Gdk.Color.alloc (Gdk.Color.get_system_colormap ()) (`NAME "red"))]
45 method log ?(append_NL = true)
46 (m : [`Msg of html_tag | `Error of html_tag])
48 let process_msg tags =
51 `T s -> tv#buffer#insert ~tags s
52 | `L l -> List.iter aux l
53 | `BR -> tv#buffer#insert ~tags "\n"
58 | `Msg m -> process_msg [green] m
59 | `Error m -> process_msg [red] m);
62 vadj#set_value (vadj#upper)
64 val mutable cic_indent_level = 0
66 method log_cic_msg ?(append_NL = true) (cic_msg: CicLogger.msg) =
67 let get_indent () = String.make cic_indent_level ' ' in
68 let incr () = cic_indent_level <- cic_indent_level + 1 in
69 let decr () = cic_indent_level <- cic_indent_level - 1 in
73 | `Start_type_checking uri ->
75 sprintf "Type checking of %s started" (UriManager.string_of_uri uri)
76 | `Type_checking_completed uri ->
78 sprintf "Type checking of %s completed"
79 (UriManager.string_of_uri uri)
81 sprintf "%s is trusted" (UriManager.string_of_uri uri))
83 self#log ~append_NL (`Msg (`T msg))