From a8f79e24d38d0868e2ab64428ed43ed7e52f459d Mon Sep 17 00:00:00 2001 From: Claudio Sacerdoti Coen Date: Fri, 7 Nov 2003 09:34:02 +0000 Subject: [PATCH] The hbugs client interface is almost working again. --- helm/hbugs/client/hbugs_client.ml | 184 ++++++++++++++++++++++-------- 1 file changed, 135 insertions(+), 49 deletions(-) diff --git a/helm/hbugs/client/hbugs_client.ml b/helm/hbugs/client/hbugs_client.ml index f15a6357b..8eac8a022 100644 --- a/helm/hbugs/client/hbugs_client.ml +++ b/helm/hbugs/client/hbugs_client.ml @@ -34,6 +34,101 @@ exception Invalid_URL of string;; let do_nothing _ = ();; +module SmartHbugs_client_gui = + struct + class ['a] oneColumnCList gtree_view ~column_type ~column_title + = + let obj = + ((Gobject.unsafe_cast gtree_view#as_widget) : Gtk.tree_view Gtk.obj) in + let columns = new GTree.column_list in + let col = columns#add column_type in + let vcol = GTree.view_column ~title:column_title () + ~renderer:(GTree.cell_renderer_text[], ["text",col]) in + let store = GTree.list_store columns in + object(self) + inherit GTree.view obj + method clear = store#clear + method append (v : 'a) = + let row = store#append () in + store#set ~row ~column:col v; + method column = col + initializer + self#set_model (Some (store :> GTree.model)) ; + ignore (self#append_column vcol) + end + + class ['a,'b] twoColumnsCList gtree_view ~column1_type ~column2_type + ~column1_title ~column2_title + = + let obj = + ((Gobject.unsafe_cast gtree_view#as_widget) : Gtk.tree_view Gtk.obj) in + let columns = new GTree.column_list in + let col1 = columns#add column1_type in + let vcol1 = GTree.view_column ~title:column1_title () + ~renderer:(GTree.cell_renderer_text[], ["text",col1]) in + let col2 = columns#add column2_type in + let vcol2 = GTree.view_column ~title:column2_title () + ~renderer:(GTree.cell_renderer_text[], ["text",col2]) in + let store = GTree.list_store columns in + object(self) + inherit GTree.view obj + method clear = store#clear + method append (v1 : 'a) (v2 : 'b) = + let row = store#append () in + store#set ~row ~column:col1 v1; + store#set ~row ~column:col2 v2 + method column1 = col1 + method column2 = col2 + initializer + self#set_model (Some (store :> GTree.model)) ; + ignore (self#append_column vcol1) ; + ignore (self#append_column vcol2) ; + end + + class subscribeWindow () = + object(self) + inherit Hbugs_client_gui.subscribeWindow () + val mutable tutorsSmartCList = None + method tutorsSmartCList = + match tutorsSmartCList with + None -> assert false + | Some w -> w + initializer + tutorsSmartCList <- + Some + (new twoColumnsCList self#tutorsCList + ~column1_type:Gobject.Data.string ~column2_type:Gobject.Data.string + ~column1_title:"Id" ~column2_title:"Description") + end + + class hbugsMainWindow () = + object(self) + inherit Hbugs_client_gui.hbugsMainWindow () + val mutable subscriptionSmartCList = None + val mutable hintsSmartCList = None + method subscriptionSmartCList = + match subscriptionSmartCList with + None -> assert false + | Some w -> w + method hintsSmartCList = + match hintsSmartCList with + None -> assert false + | Some w -> w + initializer + subscriptionSmartCList <- + Some + (new oneColumnCList self#subscriptionCList + ~column_type:Gobject.Data.string ~column_title:"Description") + initializer + hintsSmartCList <- + Some + (new oneColumnCList self#hintsCList + ~column_type:Gobject.Data.string ~column_title:"Description") + end + + end +;; + class hbugsClient ?(use_hint_callback: hint -> unit = do_nothing) ?(describe_hint_callback: hint -> unit = do_nothing) @@ -51,8 +146,8 @@ class hbugsClient object (self) - val mainWindow = new Hbugs_client_gui.hbugsMainWindow () - val subscribeWindow = new Hbugs_client_gui.subscribeWindow () + val mainWindow = new SmartHbugs_client_gui.hbugsMainWindow () + val subscribeWindow = new SmartHbugs_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 @@ -62,8 +157,6 @@ class hbugsClient (* all available tutors, saved last time a List_tutors message was sent to broker *) val mutable availableTutors: tutor_dsc list = [] - (* id of highlighted tutors in tutor subscription window *) - val mutable selectedTutors: tutor_id list = [] val mutable statusContext = None val mutable subscribeWindowStatusContext = None val mutable debug = false (* enable/disable debugging buttons *) @@ -133,16 +226,22 @@ class hbugsClient subscribeWindow#subscribeWindow#show ())); (* GUI: hints list *) -(*CSC: per farlo compilare - ignore (mainWindow#hintsCList#connect#select_row - (fun ~row ~column ~event -> - 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) - | _ -> ())); -*) + ignore (mainWindow#hintsCList#selection#set_select_function + (fun path already_selected -> + let row = +prerr_endline ("**** BEFORE CRASH: " ^ if already_selected then "yes" else "no") ; + match GTree.Path.get_indices path with + [|n|] -> n + | _ -> assert false + in +prerr_endline ("**** AFTER CRASH: " ^ string_of_int row) ; + (*CSC: there used to be an event whose type was checked against *) + (*CSC: `TWO_BUTTON_PRESS. This is just a bad approximation. *) + if already_selected then + use_hint_callback (self#hint row) + else + describe_hint_callback (self#hint row) ; + true)) ; (* GUI: main status bar *) let ctxt = mainWindow#mainWindowStatusBar#new_context "0" in @@ -150,22 +249,10 @@ class hbugsClient ignore (ctxt#push "Ready"); (* GUI: subscription window *) + subscribeWindow#tutorsCList#selection#set_mode `MULTIPLE; ignore (subscribeWindow#subscribeWindow#event#connect#delete (fun _ -> subscribeWindow#subscribeWindow#misc#hide (); true)); ignore (subscribeWindow#listTutorsButton#connect#clicked self#listTutors); - let tutor_id_of_row row = (*CSC: per farlo compilare subscribeWindow#tutorsCList#cell_text row 0*) "Kaboom" in -(*CSC: per farlo compilare - ignore (subscribeWindow#tutorsCList#connect#select_row - (fun ~row ~column ~event -> - 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 <- - List.filter ((<>) (tutor_id_of_row row)) selectedTutors)); -*) ignore (subscribeWindow#subscribeButton#connect#clicked self#subscribeSelected); ignore (subscribeWindow#subscribeAllButton#connect#clicked @@ -252,8 +339,7 @@ Error: %s" List.iter (fun h -> (match h with Hints _ -> assert false | _ -> ()); -(*CSC: per farlo compilare - ignore (mainWindow#hintsCList#append [string_of_hint h])*)) + ignore(mainWindow#hintsSmartCList#append(string_of_hint h))) received_hints; hints <- hints @ received_hints; Hbugs_messages.respond_msg (Wow myOwnId) outchan @@ -341,9 +427,7 @@ Error: %s" *) method stateChange new_state = -(*CSC: per farlo compilare - mainWindow#hintsCList#clear (); -*) + mainWindow#hintsSmartCList#clear (); hints <- []; self#sendReq ~msg:(State_change (myOwnId, new_state)) @@ -364,13 +448,10 @@ Error: %s" | Tutor_list (_, descriptions) -> availableTutors <- (* sort accordingly to tutor description *) List.sort (fun (a,b) (c,d) -> compare (b,a) (d,c)) descriptions; - selectedTutors <- []; -(*CSC: per farlo compilare - subscribeWindow#tutorsCList#clear (); -*) + subscribeWindow#tutorsSmartCList#clear (); List.iter (fun (id, dsc) -> - (*CSC: per farlo compilare ignore (subscribeWindow#tutorsCList#append [id; dsc])*)()) + ignore (subscribeWindow#tutorsSmartCList#append id dsc)) availableTutors | unexpected_msg -> self#showDialog @@ -383,17 +464,14 @@ Error: %s" (function | (Subscribed (_, subscribedTutors)) as msg -> let sort = List.sort compare in -(*CSC: per farlo compilare - mainWindow#subscriptionCList#clear (); -*) + mainWindow#subscriptionSmartCList#clear (); List.iter (fun tutor_id -> -(*CSC: per farlo compilare ignore - (mainWindow#subscriptionCList#append - [ try - List.assoc tutor_id availableTutors; - with Not_found -> assert false ])*)()) + (mainWindow#subscriptionSmartCList#append + ( try + List.assoc tutor_id availableTutors + with Not_found -> assert false ))) tutors_id; subscribeWindow#subscribeWindow#misc#hide (); if sort subscribedTutors <> sort tutors_id then @@ -401,14 +479,22 @@ Error: %s" (sprintf "Subscription mismatch\n: %s" (Hbugs_messages.string_of_msg msg)) | unexpected_msg -> -(*CSC: per farlo compilare - mainWindow#subscriptionCList#clear (); -*) + mainWindow#subscriptionSmartCList#clear (); self#showDialog (sprintf "Subscription FAILED, unexpected message:\n%s" (Hbugs_messages.string_of_msg unexpected_msg))) - method private subscribeSelected () = self#subscribe' selectedTutors + method private subscribeSelected () = + let tutorsSmartCList = subscribeWindow#tutorsSmartCList in + let selectedTutors = + List.map + (fun p -> + tutorsSmartCList#model#get + ~row:(tutorsSmartCList#model#get_iter p) + ~column:tutorsSmartCList#column1) + tutorsSmartCList#selection#get_selected_rows + in + self#subscribe' selectedTutors method subscribeAll () = self#listTutors (); (* this fills 'availableTutors' field *) -- 2.39.2