exported hbugsClient class so that it can be used from outside

diff --git a/helm/hbugs/client/Makefile b/helm/hbugs/client/Makefile
index e96695dbe3e54f3efc916c59ad83ddbc8cb3782b..70ffca88afa3c1ec20bb9467964a53855b393c65 100644 (file)
--- 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 c7df9e10780838bb09172b62864a46809f3cf5ea..f4fb94dd40ec820053031c00a33fce1176e7fefc 100644 (file)
--- 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 (file)
index 0000000..edf0127
--- /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
+