X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2FgTopLevel%2Fhbugs.ml;h=35937b9b98d0aa19ed4987008bff87802de2ca9a;hb=741b3e9014f940fbbd34bee7b606ff7e72170452;hp=833d11bfd9968e21ebba6db6021f97167e50763f;hpb=6bfd11a764024577d1a427d9b6e3074d66ff09fa;p=helm.git diff --git a/helm/gTopLevel/hbugs.ml b/helm/gTopLevel/hbugs.ml index 833d11bfd..35937b9b9 100644 --- a/helm/gTopLevel/hbugs.ml +++ b/helm/gTopLevel/hbugs.ml @@ -43,74 +43,76 @@ let describe_hint_callback = ref ignore let set_describe_hint_callback c = describe_hint_callback := c let quit () = - match !hbugs_client with - | Some c -> c#unregisterFromBroker () - | None -> () + match !hbugs_client with + | Some c -> c#unregisterFromBroker () + | None -> () let hbugs_enabled = ref false let get_hbugs_client () = - match !hbugs_client with - | Some c -> c - | None -> assert false + match !hbugs_client with + | Some c -> c + | None -> assert false let disable () = - match !hbugs_client with None -> () | Some c -> c#hide () + match !hbugs_client with None -> () | Some c -> c#hide () let notify () = - try - if !hbugs_enabled then begin - let client = get_hbugs_client () in - let goal = - match !ProofEngine.goal with - | Some g -> g - | None -> raise NoProofInProgress - in - let (type_string, body_string) = - let (type_xml, body_xml) = ProofEngine.get_current_status_as_xml () in - (Xml.pp_to_string type_xml, Xml.pp_to_string body_xml) - in - let new_state = - (Misc.strip_xml_headings type_string, - Misc.strip_xml_headings body_string, - goal) - in - client#stateChange (Some new_state) - end - with NoProofInProgress -> () + try + if !hbugs_enabled then begin + let client = get_hbugs_client () in + let goal = + match !ProofEngine.goal with + | Some g -> g + | None -> raise NoProofInProgress + in + let (type_string, body_string) = + let (type_xml, body_xml) = ProofEngine.get_current_status_as_xml () in + (Xml.pp_to_string type_xml, Xml.pp_to_string body_xml) + in + let new_state = + (Misc.strip_xml_headings type_string, + Misc.strip_xml_headings body_string, + goal) + in + client#stateChange (Some new_state) + end + with NoProofInProgress -> () let clear () = if !hbugs_enabled then begin - let client = get_hbugs_client () in - client#stateChange None + let client = get_hbugs_client () in + client#stateChange None end let rec enable () = - (match !hbugs_client with - | None -> (* create an hbugs client and show its window *) - hbugs_client := - (try - Some (new Hbugs_client.hbugsClient + (match !hbugs_client with + | None -> (* create an hbugs client and show its window *) + hbugs_client := + (try + Some (new Hbugs_client.hbugsClient ~use_hint_callback:!use_hint_callback ~describe_hint_callback:!describe_hint_callback ()) - with e -> - prerr_endline (sprintf "Can't start HBugs client: %s" - (Printexc.to_string e)); - None); - (match !hbugs_client with - |Some client -> - client#show (); - client#subscribeAll () - | None -> ()) - | Some c -> (* show hbugs client window *) - c#show ()) + with e -> + prerr_endline (sprintf "Can't start HBugs client: %s" + (Printexc.to_string e)); + None); + (match !hbugs_client with + |Some client -> + client#show (); + client#subscribeAll () + | None -> ()) + | Some c -> (* show hbugs client window *) + c#show ()) let toggle state = - if state <> !hbugs_enabled then (* status has been changed *) - (if state then enable () else disable ()); - hbugs_enabled := state + if state <> !hbugs_enabled then begin (* status has been changed *) + if state then enable () else disable (); + clear () + end; + hbugs_enabled := state module type Unit = sig end