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)
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
(* 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 *)
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
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
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
*)
method stateChange new_state =
-(*CSC: per farlo compilare
- mainWindow#hintsCList#clear ();
-*)
+ mainWindow#hintsSmartCList#clear ();
hints <- [];
self#sendReq
~msg:(State_change (myOwnId, new_state))
| 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
(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
(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 *)
projects / helm.git / commitdiff