let global_debug = true;;
+let do_nothing _ = ();;
+
(**
@param on_use_hint function invoked when an hint is used, argumnet is the hint
to use
destroyed, if it's None "self#quit" is invoked
*)
class hbugsClient
- ~(on_use_hint: hint -> unit)
- ?(on_exit: (unit -> unit) option)
+ ?(use_hint_callback: hint -> unit = do_nothing)
+ ?(destroy_callback: unit -> unit = do_nothing)
()
=
val subscribeWindow = new Hbugs_client_gui.subscribeWindow ()
val messageDialog = new Hbugs_client_gui.messageDialog ()
val myOwnId = Hbugs_id_generator.new_client_id ()
+ val mutable use_hint_callback = use_hint_callback
val mutable myOwnUrl = "localhost:49082"
val mutable brokerUrl = "localhost:49081"
val mutable brokerId: broker_id option = None
method show = mainWindow#hbugsMainWindow#show
method hide = mainWindow#hbugsMainWindow#misc#hide
+ method setUseHintCallback callback =
+ use_hint_callback <- callback
+
method private debugButtons =
List.map
(fun (b: GButton.button) -> new GObj.misc_ops b#as_widget)
method private initGui =
(* GUI: main window *)
- let on_exit =
- match on_exit with
- | None -> (fun () -> self#quit (); false)
- | Some f -> (fun () -> f (); true)
- in
+
+ (* ignore delete events so that hbugs window is closable only using
+ menu; on destroy (e.g. while quitting gTopLevel) self#quit is invoked
+ *)
+
+ ignore (mainWindow#hbugsMainWindow#event#connect#delete (fun _ -> true));
ignore (mainWindow#hbugsMainWindow#event#connect#destroy
- (fun _ -> on_exit ()));
- ignore (mainWindow#hbugsMainWindow#event#connect#delete
- (fun _ -> on_exit ()));
+ (fun _ -> self#quit (); false));
(* GUI main window's menu *)
mainWindow#toggleDebuggingMenuItem#set_active debug;
(fun ~row ~column ~event ->
match event with
| Some event when GdkEvent.get_type event = `TWO_BUTTON_PRESS ->
- on_use_hint (self#hint row)
+ use_hint_callback (self#hint row)
| _ -> ()));
(* GUI: main status bar *)
method private quit () =
self#unregisterFromBroker ();
- GMain.Main.quit ()
+ destroy_callback ()
(** enable/disable debugging *)
method private setDebug value = debug <- value