From c21ba5da9a0319c172ef7759dc4771f07d3f72e9 Mon Sep 17 00:00:00 2001 From: "Richard W.M. Jones" Date: Fri, 29 Jul 2011 10:51:54 +0100 Subject: [PATCH] Add Guest -> Operating system information menu item. Also some refactoring of the menu code. --- filetree.ml | 30 ++++++++++++++++- filetree.mli | 6 ++++ main.ml | 12 +++++++ op_inspection_dialog.ml | 2 +- window.ml | 89 +++++++++++++++++++++++++++++++++---------------- window.mli | 1 + 6 files changed, 110 insertions(+), 30 deletions(-) diff --git a/filetree.ml b/filetree.ml index c224a8d..7217c4e 100644 --- a/filetree.ml +++ b/filetree.ml @@ -500,6 +500,34 @@ object (self) hdata.state <- IsNode; self#set_visited row + (* Return os(es) in the tree, if any. The root directory of the + * tree looks like this: + * + * \ Top (OS ...) # usually only one, but there can be zero or > 1 + * \ Top (OS ...) + * \ Top (Volume ...) + * \ TopWinReg + * \ TopWinReg + * + * This returns only the Top (OS ...) entries. See also #add_top_level_os + * method. + *) + method oses = + match model#get_iter_first with + | None -> [] + | Some row -> + let rec loop acc = + let acc = + match (self#get_hdata row).content with + | Top (OS os) -> os :: acc + | _ -> acc in + if model#iter_next row then + loop acc + else + List.rev acc + in + loop [] + (* Signals. *) method clear_tree : callback:(unit -> unit) -> GtkSignal.id = clear_tree#connect ~after @@ -629,7 +657,7 @@ object (self) ~callback:(fun () -> op_download_dir_find0#call path)); and add_top_os_items os path = - let item = factory#add_item "Operating system information" in + let item = factory#add_item "Operating system information ..." in ignore (item#connect#activate ~callback:(fun () -> op_inspection_dialog#call os)); ignore (factory#add_separator ()); diff --git a/filetree.mli b/filetree.mli index b6af8ce..a805540 100644 --- a/filetree.mli +++ b/filetree.mli @@ -46,6 +46,12 @@ object ('a) not any untrusted string from the guest; usually we pass the name of the guest from libvirt here. *) + method oses : Slave_types.inspection_os list + (** If operating system root(s) are currently loaded into the + filetree widget, this returns a list of them. If none are + loaded (empty, or could be just a pile of filesystems), then this + returns an empty list. *) + method get_pathname : Gtk.tree_iter -> Slave_types.source * string (** Use [get_pathname row] on a [row] representing a file or directory. It searches back up the tree to get the source diff --git a/main.ml b/main.ml index c908bbc..439033d 100644 --- a/main.ml +++ b/main.ml @@ -77,6 +77,18 @@ let () = ~callback:(w#connect_to (Some "xen:///"))); ignore (w#connect_none_signal ~callback:(w#connect_to None)); + ignore ( + w#inspection_signal + ~callback:( + fun () -> + match tree#oses with + | [] -> () + | os :: _ -> + (* Note the menu entry only shows data for the first OS, + (for multiboot). *) + Op_inspection_dialog.inspection_dialog tree os + ) + ); (* What did the user request on the command line? *) w#run_cli_request cli_request; diff --git a/op_inspection_dialog.ml b/op_inspection_dialog.ml index 2189e11..b04fd0d 100644 --- a/op_inspection_dialog.ml +++ b/op_inspection_dialog.ml @@ -25,7 +25,7 @@ module G = Guestfs let rec inspection_dialog tree os = debug "inspection dialog"; - let title = "Inspection data" in + let title = "Operating system information" in let d = GWindow.dialog ~width:500 ~height:600 ~title () in let nb = GPack.notebook ~packing:d#vbox#add () in diff --git a/window.ml b/window.ml index a43bf9c..d9dd7a6 100644 --- a/window.ml +++ b/window.ml @@ -23,6 +23,21 @@ open Slave_types module G = Guestfs +type connect_menu = { + connect_menu : GMenu.menu; + connect_kvm_item : GMenu.menu_item; + connect_xen_item : GMenu.menu_item; + connect_none_item : GMenu.menu_item; + connect_uri_item : GMenu.menu_item; + open_disk_item : GMenu.menu_item; + quit_item : GMenu.menu_item; +} + +type guest_menu = { + guest_menu : GMenu.menu; + guest_inspection_item : GMenu.menu_item; +} + class window = (* Window. *) let title = "Guest Filesystem Browser" in @@ -33,31 +48,34 @@ class window = let menubar = GMenu.menu_bar ~packing:vbox#pack () in let factory = new GMenu.factory menubar in let accel_group = factory#accel_group in - let connect_menu = factory#add_submenu "_Connect" in - - let factory = new GMenu.factory connect_menu ~accel_group in - let connect_kvm_item = factory#add_item "Connect to local _KVM hypervisor" in - let connect_xen_item = factory#add_item "Connect to local _Xen hypervisor" in - let connect_none_item = factory#add_item "_Connect to default hypervisor" in - let connect_uri_item = factory#add_item "Connect to a _libvirt URI ..." in - let () = ignore (factory#add_separator ()) in - let _ = factory#add_item "_Open disk image ..." ~key:GdkKeysyms._O in - let () = ignore (factory#add_separator ()) in - let quit_item = factory#add_item "E_xit" ~key:GdkKeysyms._Q in - - (* Quit. *) - let quit _ = GMain.quit (); false in - let () = - ignore (window#connect#destroy ~callback:GMain.quit); - ignore (window#event#connect#delete ~callback:quit); - ignore (quit_item#connect#activate - ~callback:(fun () -> ignore (quit ()); ())); - window#add_accel_group accel_group in + let connect_menu = + let menu = factory#add_submenu "_Connect" in + let factory = new GMenu.factory menu ~accel_group in + let kvm = factory#add_item "Connect to local _KVM hypervisor" in + let xen = factory#add_item "Connect to local _Xen hypervisor" in + let none = factory#add_item "_Connect to default hypervisor" in + let uri = factory#add_item "Connect to a _libvirt URI ..." in + ignore (factory#add_separator ()); + let opend = + factory#add_item "_Open disk image ..." ~key:GdkKeysyms._O in + ignore (factory#add_separator ()); + let quit = factory#add_item "E_xit" ~key:GdkKeysyms._Q in + { connect_menu = menu; connect_kvm_item = kvm; + connect_xen_item = xen; connect_none_item = none; + connect_uri_item = uri; open_disk_item = opend; quit_item = quit } in + + let guest_menu = + let menu = factory#add_submenu "_Guest" in + let factory = new GMenu.factory menu ~accel_group in + let inspection = factory#add_item "Operating system information ..." in + { guest_menu = menu; guest_inspection_item = inspection } in (* Top toolbar. *) - let hbox = GPack.hbox ~border_width:4 ~packing:vbox#pack () in - let () = hbox#pack (mklabel "Guest: ") in + let hbox = + let hbox = GPack.hbox ~border_width:4 ~packing:vbox#pack () in + hbox#pack (mklabel "Guest: "); + hbox in (* Combo box for displaying virtual machine names. *) let vmcombo = GEdit.combo_box_text ~packing:hbox#pack () in @@ -86,7 +104,7 @@ class window = ~packing:(vbox#pack ~expand:true ~fill:true) () in let tree = new Filetree.tree ~packing:sw#add () in - (* Status bar and progress bar. *) + (* 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 @@ -97,31 +115,46 @@ class window = 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 inspection_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] + connect_uri_signal#disconnect; + inspection_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 inspection_signal = inspection_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_kvm_item#connect#activate + ignore (connect_menu.connect_kvm_item#connect#activate ~callback:connect_kvm_signal#call); - ignore (connect_xen_item#connect#activate + ignore (connect_menu.connect_xen_item#connect#activate ~callback:connect_xen_signal#call); - ignore (connect_none_item#connect#activate + ignore (connect_menu.connect_none_item#connect#activate ~callback:connect_none_signal#call); - ignore (connect_uri_item#connect#activate + ignore (connect_menu.connect_uri_item#connect#activate ~callback:connect_uri_signal#call); + ignore (guest_menu.guest_inspection_item#connect#activate + ~callback:inspection_signal#call); (* VM combo box when changed by the user. * The refresh button acts like changing the VM combo too. diff --git a/window.mli b/window.mli index ba44e5e..d0c6c43 100644 --- a/window.mli +++ b/window.mli @@ -29,6 +29,7 @@ object ('a) method connect_xen_signal : callback:(unit -> unit) -> GtkSignal.id method connect_none_signal : callback:(unit -> unit) -> GtkSignal.id method connect_uri_signal : callback:(unit -> unit) -> GtkSignal.id + method inspection_signal : callback:(unit -> unit) -> GtkSignal.id method failure : exn -> unit (** This is the global error handling function. It is invoked in -- 1.8.3.1