+ (* Status bar and progress bar at the bottom. *)
+ let hbox = GPack.hbox ~spacing:4 ~packing:vbox#pack () in
+ let progress_bar = GRange.progress_bar ~packing:hbox#pack () in
+ let statusbar = GMisc.statusbar ~packing:(hbox#pack ~expand:true) () in
+ let statusbar_context = statusbar#new_context ~name:"Standard" in
+
+ (* Signals. *)
+ let connect_kvm_signal = new GUtil.signal () in
+ let connect_xen_signal = new GUtil.signal () in
+ let connect_none_signal = new GUtil.signal () in
+ let connect_uri_signal = new GUtil.signal () in
+ let open_disk_signal = new GUtil.signal () in
+ let reopen_signal = new GUtil.signal () in
+ let inspection_signal = new GUtil.signal () in
+ let about_signal = new GUtil.signal () in
+
+object (self)
+ inherit GUtil.ml_signals [connect_kvm_signal#disconnect;
+ connect_xen_signal#disconnect;
+ connect_none_signal#disconnect;
+ connect_uri_signal#disconnect;
+ open_disk_signal#disconnect;
+ reopen_signal#disconnect;
+ inspection_signal#disconnect;
+ about_signal#disconnect]
+
+ method connect_kvm_signal = connect_kvm_signal#connect ~after
+ method connect_xen_signal = connect_xen_signal#connect ~after
+ method connect_none_signal = connect_none_signal#connect ~after
+ method connect_uri_signal = connect_uri_signal#connect ~after
+ method open_disk_signal = open_disk_signal#connect ~after
+ method reopen_signal = reopen_signal#connect ~after
+ method inspection_signal = inspection_signal#connect ~after
+ method about_signal = about_signal#connect ~after
+
+ initializer
+ ignore (statusbar_context#push title);
+ window#show ();
+
+ (* Quit. *)
+ let quit _ = GMain.quit (); false in
+ ignore (window#connect#destroy ~callback:GMain.quit);
+ ignore (window#event#connect#delete ~callback:quit);
+ ignore (connect_menu.quit_item#connect#activate
+ ~callback:(fun () -> ignore (quit ()); ()));
+
+ (* Accel_group. *)
+ window#add_accel_group accel_group;
+
+ (* Menu entries emit signals. *)
+ ignore (connect_menu.connect_kvm_item#connect#activate
+ ~callback:connect_kvm_signal#call);
+ ignore (connect_menu.connect_xen_item#connect#activate
+ ~callback:connect_xen_signal#call);
+ ignore (connect_menu.connect_none_item#connect#activate
+ ~callback:connect_none_signal#call);
+ ignore (connect_menu.connect_uri_item#connect#activate
+ ~callback:connect_uri_signal#call);
+ ignore (connect_menu.open_disk_item#connect#activate
+ ~callback:open_disk_signal#call);
+ ignore (connect_menu.reopen_item#connect#activate
+ ~callback:reopen_signal#call);
+ ignore (guest_menu.guest_inspection_item#connect#activate
+ ~callback:inspection_signal#call);
+ ignore (help_menu.about_item#connect#activate
+ ~callback:about_signal#call);
+
+ (* VM combo box when changed by the user.
+ * The refresh button acts like changing the VM combo too.
+ *)
+ let combo, (model, column) = vmcombo in
+ ignore (
+ combo#connect#changed
+ ~callback:(
+ fun () ->
+ match combo#active_iter with
+ | None -> () (* nothing selected *)
+ | Some row -> self#open_domain (model#get ~row ~column)
+ )
+ );
+ ignore (
+ refresh_button#connect#clicked
+ ~callback:(
+ fun () ->
+ match combo#active_iter with
+ | None -> () (* nothing selected *)
+ | Some row -> self#open_domain (model#get ~row ~column)
+ )
+ )
+
+ (* Set the statusbar text. *)
+ method set_statusbar msg =
+ statusbar_context#pop ();
+ ignore (statusbar_context#push msg)
+
+ (* Return the filetree. *)
+ method tree = tree
+
+ (* Connect to the given URI. *)
+ method connect_to uri () =
+ tree#clear ();
+ Slave.discard_command_queue ();
+ Slave.connect uri (self#when_connected uri)
+
+ (* Called back when connected to a new hypervisor. *)
+ method private when_connected uri doms =
+ self#populate_vmcombo doms