Add Guest -> Operating system information menu item.

Also some refactoring of the menu code.

diff --git a/filetree.ml b/filetree.ml
index c224a8d..7217c4e 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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