From 58cc9aa288286beb79f78ce4546d5a4bebde54e5 Mon Sep 17 00:00:00 2001 From: Stefano Zacchiroli Date: Fri, 24 Jan 2003 15:32:44 +0000 Subject: [PATCH] exported hbugsClient class so that it can be used from outside --- helm/hbugs/client/Makefile | 17 +++++-- helm/hbugs/client/hbugs_client.ml | 74 +++++++++++++++--------------- helm/hbugs/client/hbugs_client.mli | 21 +++++++++ 3 files changed, 71 insertions(+), 41 deletions(-) create mode 100644 helm/hbugs/client/hbugs_client.mli diff --git a/helm/hbugs/client/Makefile b/helm/hbugs/client/Makefile index e96695dbe..70ffca88a 100644 --- a/helm/hbugs/client/Makefile +++ b/helm/hbugs/client/Makefile @@ -11,16 +11,23 @@ world: byte opt byte: $(NAME) opt: $(NAME).opt -gui.ml: hbugs_gui.glade - lablgladecc $< > $@ +# gui.ml: hbugs_gui.glade +# lablgladecc $< > $@ gui.cmo: gui.ml $(OCAMLC) -c $< gui.cmx: gui.ml $(OCAMLOPT) -c $< -$(NAME): gui.cmo $(NAME).ml +hbugs_client.cmi: hbugs_client.mli + $(OCAMLC) -c $< +hbugs_client.cmo: hbugs_client.ml hbugs_client.cmi + $(OCAMLC) -c $< +hbugs_client.cmx: hbugs_client.ml hbugs_client.cmi + $(OCAMLOPT) -c $< +$(NAME): gui.cmo $(NAME).cmo $(OCAMLC) -thread -package threads -linkpkg -o $@ $^ -$(NAME).opt: gui.cmx $(NAME).ml +$(NAME).opt: gui.cmx $(NAME).cmx $(OCAMLOPT) -thread -package threads -linkpkg -o $@ $^ clean: - rm -f *.cm[aixo] *.cmxa *.[oa] $(NAME){,.opt} gui.ml +# rm -f *.cm[aixo] *.cmxa *.[oa] $(NAME){,.opt} gui.ml + rm -f *.cm[aixo] *.cmxa *.[oa] $(NAME){,.opt} .PHONY: all world byte opt clean diff --git a/helm/hbugs/client/hbugs_client.ml b/helm/hbugs/client/hbugs_client.ml index c7df9e107..f4fb94dd4 100644 --- a/helm/hbugs/client/hbugs_client.ml +++ b/helm/hbugs/client/hbugs_client.ml @@ -45,8 +45,7 @@ class hbugsClient = object (self) - inherit Gui.hbugsMainWindow () - + val mainWindow = new Gui.hbugsMainWindow () val subscribeWindow = new Gui.subscribeWindow () val messageDialog = new Gui.messageDialog () val myOwnId = Hbugs_id_generator.new_client_id () @@ -59,7 +58,6 @@ class hbugsClient = val mutable debug = false (* enable/disable debugging buttons *) initializer -(* self#setDebug global_debug; *) self#initGui; self#startLocalHttpDaemon (); self#testLocalHttpDaemon (); @@ -67,57 +65,62 @@ class hbugsClient = self#registerClient (); self#reconfigDebuggingButtons - method debugButtons = + method show = mainWindow#hbugsMainWindow#show + method hide = mainWindow#hbugsMainWindow#misc#hide + + method private debugButtons = List.map (fun (b: GButton.button) -> new GObj.misc_ops b#as_widget) - [ self#startLocalHttpDaemonButton; self#testLocalHttpDaemonButton; - self#testBrokerButton; self#registerClientButton; - self#unregisterClientButton ] + [ mainWindow#startLocalHttpDaemonButton; + mainWindow#testLocalHttpDaemonButton; mainWindow#testBrokerButton; + mainWindow#registerClientButton; mainWindow#unregisterClientButton ] method private initGui = (* GUI: main window *) - ignore (self#hbugsMainWindow#connect#destroy self#quit); + ignore (mainWindow#hbugsMainWindow#connect#destroy self#quit); (* GUI main window's menu *) - self#toggleDebuggingMenuItem#set_active debug; - ignore (self#toggleDebuggingMenuItem#connect#toggled self#toggleDebug); + mainWindow#toggleDebuggingMenuItem#set_active debug; + ignore (mainWindow#toggleDebuggingMenuItem#connect#toggled + self#toggleDebug); (* GUI: local HTTP daemon settings *) - ignore (self#clientUrlEntry#connect#changed - (fun _ -> myOwnUrl <- self#clientUrlEntry#text)); - self#clientUrlEntry#set_text myOwnUrl; - ignore (self#startLocalHttpDaemonButton#connect#clicked + ignore (mainWindow#clientUrlEntry#connect#changed + (fun _ -> myOwnUrl <- mainWindow#clientUrlEntry#text)); + mainWindow#clientUrlEntry#set_text myOwnUrl; + ignore (mainWindow#startLocalHttpDaemonButton#connect#clicked self#startLocalHttpDaemon); - ignore (self#testLocalHttpDaemonButton#connect#clicked + ignore (mainWindow#testLocalHttpDaemonButton#connect#clicked self#testLocalHttpDaemon); (* GUI: broker choice *) - ignore (self#brokerUrlEntry#connect#changed - (fun _ -> brokerUrl <- self#brokerUrlEntry#text)); - self#brokerUrlEntry#set_text brokerUrl; - ignore (self#testBrokerButton#connect#clicked self#testBroker); - self#clientIdLabel#set_text myOwnId; + ignore (mainWindow#brokerUrlEntry#connect#changed + (fun _ -> brokerUrl <- mainWindow#brokerUrlEntry#text)); + mainWindow#brokerUrlEntry#set_text brokerUrl; + ignore (mainWindow#testBrokerButton#connect#clicked self#testBroker); + mainWindow#clientIdLabel#set_text myOwnId; (* GUI: client registration *) - ignore (self#registerClientButton#connect#clicked self#registerClient); - ignore (self#unregisterClientButton#connect#clicked + ignore (mainWindow#registerClientButton#connect#clicked + self#registerClient); + ignore (mainWindow#unregisterClientButton#connect#clicked self#unregisterClient); (* GUI: subscriptions *) - ignore (self#showSubscriptionWindowButton#connect#clicked + ignore (mainWindow#showSubscriptionWindowButton#connect#clicked (fun () -> self#listTutors (); subscribeWindow#subscribeWindow#show ())); (* GUI: DEBUG state change *) - ignore (self#stateChangeButton#connect#clicked self#stateChange); + ignore (mainWindow#stateChangeButton#connect#clicked self#stateChange); (* GUI: hints list *) - ignore (self#useHintButton#connect#clicked self#useHint); + ignore (mainWindow#useHintButton#connect#clicked self#useHint); (* GUI: main status bar *) - let ctxt = self#mainWindowStatusBar#new_context "0" in + let ctxt = mainWindow#mainWindowStatusBar#new_context "0" in statusContext <- Some ctxt; ignore (ctxt#push "Ready"); @@ -198,7 +201,7 @@ Error: %s" (Usage "Local Http Daemon up and running!") outchan | Hint (broker_id, hint) -> if self#isAuthenticated broker_id then - ignore (self#hintsCList#append [hint]) + ignore (mainWindow#hintsCList#append [hint]) else Hbugs_messages.respond_exc "forbidden" broker_id outchan | msg -> @@ -279,12 +282,12 @@ Error: %s" method stateChange () = let state = (* TODO fill with a real state representation! *) - self#stateText#get_chars 0 (self#stateText#length) + mainWindow#stateText#get_chars 0 (mainWindow#stateText#length) in self#sendReq ~msg:(State_change (myOwnId, state)) self#showMsgInDialog - method listTutors () = + method private listTutors () = self#sendReq ~msg:(List_tutors myOwnId) (function | Tutor_list (_, descriptions) -> @@ -299,7 +302,7 @@ Error: %s" (sprintf "Can't list tutors, unexpected message:\n%s" (Hbugs_messages.string_of_msg unexpected_msg))) - method subscribe () = + method private subscribe () = let selectedTutors = List.sort compare selectedTutors in self#sendReq ~msg:(Subscribe (myOwnId, selectedTutors)) (function @@ -325,23 +328,22 @@ Error: %s" self#unregisterClient (); GMain.Main.quit () - (** enable/disable debugging buttons *) - method setDebug ?(force = false) value = - if (debug <> value) || force then - debug <- value + (** enable/disable debugging *) + method private setDebug value = debug <- value method private reconfigDebuggingButtons = List.iter (* debug value changed, reconfigure buttons *) (fun (b: GObj.misc_ops) -> if debug then b#show () else b#hide ()) self#debugButtons; - method toggleDebug () = + method private toggleDebug () = self#setDebug (not debug); self#reconfigDebuggingButtons end ;; -ignore (new hbugsClient); +let client = new hbugsClient in +client#show (); GtkThread.main () diff --git a/helm/hbugs/client/hbugs_client.mli b/helm/hbugs/client/hbugs_client.mli new file mode 100644 index 000000000..edf0127bd --- /dev/null +++ b/helm/hbugs/client/hbugs_client.mli @@ -0,0 +1,21 @@ + +exception Invalid_URL of string + +class hbugsClient : + object + + method show : unit -> unit + method hide : unit -> unit + + method startLocalHttpDaemon : unit -> unit + method testLocalHttpDaemon : unit -> unit + + method registerClient : unit -> unit + method unregisterClient : unit -> unit + method testBroker : unit -> unit + + method stateChange : unit -> unit + method useHint : unit -> unit + + end + -- 2.39.2