exception Invalid_URL of string;;
-let global_debug = true;;
-
- (**
- @param on_use_hint function invoked when an hint is used, argumnet is the hint
- to use
- @param on_exit function invoked when client is exiting (e.g. window is
- destroyed, if it's None "self#quit" is invoked
- *)
+let do_nothing _ = ();;
+
class hbugsClient
- ?(use_hint_callback: hint -> unit = (fun _ -> ()))
+ ?(use_hint_callback: hint -> unit = do_nothing)
+ ?(describe_hint_callback: hint -> unit = do_nothing)
+ ?(destroy_callback: unit -> unit = do_nothing)
()
=
List.map
(fun (b: GButton.button) -> new GObj.misc_ops b#as_widget)
[ mainWindow#startLocalHttpDaemonButton;
- mainWindow#testLocalHttpDaemonButton; mainWindow#testBrokerButton;
- mainWindow#registerClientButton; mainWindow#unregisterClientButton ]
+ mainWindow#testLocalHttpDaemonButton; mainWindow#testBrokerButton ]
method private initGui =
(* GUI: main window *)
- let on_exit = fun () -> self#quit (); false 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;
(* GUI: client registration *)
ignore (mainWindow#registerClientButton#connect#clicked
self#registerToBroker);
- ignore (mainWindow#unregisterClientButton#connect#clicked
- self#unregisterFromBroker);
(* GUI: subscriptions *)
ignore (mainWindow#showSubscriptionWindowButton#connect#clicked
match event with
| Some event when GdkEvent.get_type event = `TWO_BUTTON_PRESS ->
use_hint_callback (self#hint row)
+ | Some event ->
+ describe_hint_callback (self#hint row)
| _ -> ()));
(* GUI: main status bar *)
let tutor_id_of_row row = subscribeWindow#tutorsCList#cell_text row 0 in
ignore (subscribeWindow#tutorsCList#connect#select_row
(fun ~row ~column ~event ->
- selectedTutors <- tutor_id_of_row row :: selectedTutors));
+ let new_id = tutor_id_of_row row in
+ match selectedTutors with
+ | hd :: _ when hd = new_id -> () (* avoid double select events *)
+ | _ -> selectedTutors <- tutor_id_of_row row :: selectedTutors));
ignore (subscribeWindow#tutorsCList#connect#unselect_row
(fun ~row ~column ~event ->
selectedTutors <-
self#subscribeSelected);
ignore (subscribeWindow#subscribeAllButton#connect#clicked
self#subscribeAll);
+ subscribeWindow#tutorsCList#set_column ~visibility:false 0;
let ctxt = subscribeWindow#subscribeWindowStatusBar#new_context "0" in
subscribeWindowStatusContext <- Some ctxt;
ignore (ctxt#push "Ready");
(Hbugs_messages.string_of_msg unexpected_msg)))
method registerToBroker () =
+ (match brokerId with (* undo previous registration, if any *)
+ | Some id -> self#unregisterFromBroker ()
+ | _ -> ());
self#sendReq ~msg:(Register_client (myOwnId, myOwnUrl))
(function
- | Client_registered broker_id ->
- brokerId <- Some broker_id;
-(*
- self#showDialog
- (sprintf "Client %s registered @ broker %s" myOwnId broker_id)
-*)
+ | Client_registered broker_id -> (brokerId <- Some broker_id)
| unexpected_msg ->
self#showDialog
(sprintf "Client NOT registered, unexpected message:\n%s"
method unregisterFromBroker () =
self#sendReq ~wait:true ~msg:(Unregister_client myOwnId)
- self#showMsgInDialog
+ (function
+ | Client_unregistered _ -> (brokerId <- None)
+ | unexpected_msg -> ())
+(*
+ self#showDialog
+ (sprintf "Client NOT unregistered, unexpected message:\n%s"
+ (Hbugs_messages.string_of_msg unexpected_msg)))
+*)
method stateChange new_state =
+ mainWindow#hintsCList#clear ();
+ hints <- [];
self#sendReq
~msg:(State_change (myOwnId, new_state))
(function
- | State_accepted _ ->
- mainWindow#hintsCList#clear ();
- hints <- []
+ | State_accepted _ -> ()
| unexpected_msg ->
self#showDialog
(sprintf "State NOT accepted by Hbugs, unexpected message:\n%s"
method private quit () =
self#unregisterFromBroker ();
- GMain.Main.quit ()
+ destroy_callback ()
(** enable/disable debugging *)
method private setDebug value = debug <- value