X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;f=op_inspection_dialog.ml;h=b04fd0d1a70f1a77bb5df1380900aada50c75f3e;hb=70130a670e3e76fb72e61b94610cbe7f97fff172;hp=f1b17da9c34e847c0c64fbadd8e249904ca50cc7;hpb=674ec31578216d728c4ab9c0a8a297e47c81c492;p=guestfs-browser.git

diff --git a/op_inspection_dialog.ml b/op_inspection_dialog.ml
index f1b17da..b04fd0d 100644
--- a/op_inspection_dialog.ml
+++ b/op_inspection_dialog.ml
@@ -19,19 +19,195 @@
 open Printf
 
 open Utils
+open Slave_types
 
-let inspection_dialog (tree : Filetree.tree) os =
+module G = Guestfs
+
+let rec inspection_dialog tree os =
   debug "inspection dialog";
-  let title = "Inspection data" in
-  let dlg = GWindow.dialog ~title () 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
+
+  (* Fill in the basic information. *)
+  let vbox = tab "Basic information" nb in
+  let tbl = GPack.table ~columns:4 ~rows:1 ~packing:vbox#add () in
+  tbl#set_col_spacings 8;
+  tbl#set_row_spacings 8;
+
+  wide tbl 0 "Product name: " os.insp_product_name;
+  wide tbl 1 "Hostname: " os.insp_hostname;
+
+  simple tbl 2 0 "OS type: " os.insp_type;
+  simple tbl 3 0 "Distro: " os.insp_distro;
+  simple tbl 4 0 "Version: "
+    (sprintf "%d.%d"
+       os.insp_major_version
+       os.insp_minor_version);
+  simple tbl 5 0 "Product variant: " os.insp_product_variant;
+
+  simple tbl 2 2 "Root: " os.insp_root;
+  simple tbl 3 2 "Arch: " os.insp_arch;
+  simple tbl 4 2 "Package mgr: " os.insp_package_management;
+  simple tbl 5 2 "Package fmt: " os.insp_package_format;
+
+  (match os.insp_windows_systemroot with
+   | None -> ()
+   | Some systemroot ->
+       simple tbl 6 0 "%systemroot%: " systemroot
+  );
+  (match os.insp_windows_current_control_set with
+   | None -> ()
+   | Some ccs ->
+       simple tbl 6 2 "CurrentControlSet: " ccs
+  );
+
+  (* Applications. *)
+  let vbox = tab "Applications" nb in
+  applications_view ~packing:vbox#add os;
+
+  (* Mountpoints. *)
+  let vbox = tab "Mount points" nb in
+  two_column_view ~title1:"Mount" ~title2:"Filesystem"
+    ~packing:vbox#add os.insp_mountpoints;
 
-  dlg#show ();
+  (* Filesystems. *)
+  let vbox = tab "Filesystems" nb in
+  one_column_view  ~title:"Filesystem" ~packing:vbox#add
+    (Array.to_list os.insp_filesystems);
+
+  (* Drive mappings. *)
+  (match os.insp_drive_mappings with
+   | [] -> ()
+   | mappings ->
+       let vbox = tab "Drive letters" nb in
+       two_column_view ~title1:"Drive letter" ~title2:"Filesystem"
+         ~packing:vbox#add mappings
+  );
 
   (* Make sure dialog is destroyed when the tree is cleared. *)
-  ignore (
+  let sigid =
     tree#clear_tree ~callback:(
       fun () ->
         debug "inspection clear_tree -> destroy dialog";
-        dlg#destroy ()
-    )
-  )
+        d#destroy ()
+    ) in
+
+  let destroy_dialog () =
+    tree#disconnect sigid;
+    d#destroy ()
+  in
+
+  (* Add a close button. *)
+  let close_button = GButton.button ~label:"Close"
+    ~packing:d#action_area#add () in
+  ignore (close_button#connect#clicked ~callback:destroy_dialog);
+
+  (* Destroy dialog when WM close button is pressed. *)
+  ignore (d#connect#destroy ~callback:destroy_dialog);
+
+  d#show ()
+
+(* Helper functions. *)
+and tab text nb =
+  let vbox = GPack.vbox ~border_width:8 () in
+  let tab_label = (GMisc.label ~text () :> GObj.widget) in
+  ignore (nb#append_page ~tab_label (vbox :> GObj.widget));
+  vbox
+
+and simple tbl top left label text =
+  let markup = sprintf "<b>%s</b>" (markup_escape text) in
+  ignore (GMisc.label ~xalign:1. ~text:label
+            ~packing:(tbl#attach ~top ~left) ());
+  let left = left + 1 in
+  ignore (GMisc.label ~xalign:0. ~markup ~packing:(tbl#attach ~top ~left) ());
+
+and wide tbl top label text =
+  let markup = sprintf "<b>%s</b>" (markup_escape text) in
+  ignore (GMisc.label ~xalign:1.
+            ~text:label ~packing:(tbl#attach ~top ~left:0) ());
+  ignore (GMisc.label ~xalign:0.
+            ~markup ~packing:(tbl#attach ~top ~left:1 ~right:4) ());
+
+and one_column_view ~title ?packing data =
+  let data = List.sort compare data in
+  let model, c1 = GTree.store_of_list Gobject.Data.string data in
+
+  let sw =
+    GBin.scrolled_window ?packing ~hpolicy:`AUTOMATIC ~vpolicy:`AUTOMATIC () in
+
+  let view = GTree.view ~model ~packing:sw#add () in
+  view#selection#set_mode `NONE;
+
+  let renderer = GTree.cell_renderer_text [], ["text", c1] in
+  let vc = GTree.view_column ~title ~renderer () in
+  vc#set_resizable true;
+  ignore (view#append_column vc)
+
+and two_column_view ~title1 ~title2 ?packing data =
+  let data = List.sort compare data in
+
+  let cols = new GTree.column_list in
+  let c1 = cols#add Gobject.Data.string in
+  let c2 = cols#add Gobject.Data.string in
+
+  let model = GTree.list_store cols in
+  List.iter (
+    fun (d1, d2) ->
+      let row = model#append () in
+      model#set ~row ~column:c1 d1;
+      model#set ~row ~column:c2 d2
+  ) data;
+
+  let sw =
+    GBin.scrolled_window ?packing ~hpolicy:`AUTOMATIC ~vpolicy:`AUTOMATIC () in
+
+  let view = GTree.view ~model ~packing:sw#add () in
+  view#selection#set_mode `NONE;
+
+  let renderer = GTree.cell_renderer_text [], ["text", c1] in
+  let vc = GTree.view_column ~title:title1 ~renderer () in
+  vc#set_resizable true;
+  ignore (view#append_column vc);
+  let renderer = GTree.cell_renderer_text [], ["text", c2] in
+  let vc = GTree.view_column ~title:title2 ~renderer () in
+  vc#set_resizable true;
+  ignore (view#append_column vc)
+
+(* Applications view: populated after a round-trip to the slave thread. *)
+and applications_view ?packing os =
+  let cols = new GTree.column_list in
+  let name_col = cols#add Gobject.Data.string in
+  let version_col = cols#add Gobject.Data.string in
+
+  let model = GTree.list_store cols in
+
+  let sw =
+    GBin.scrolled_window ?packing ~hpolicy:`AUTOMATIC ~vpolicy:`ALWAYS () in
+
+  let view = GTree.view ~model ~packing:sw#add () in
+  view#selection#set_mode `NONE;
+
+  let renderer = GTree.cell_renderer_text [], ["text", name_col] in
+  let vc = GTree.view_column ~title:"Name" ~renderer () in
+  vc#set_resizable true;
+  ignore (view#append_column vc);
+  let renderer = GTree.cell_renderer_text [], ["text", version_col] in
+  let vc = GTree.view_column ~title:"Version" ~renderer () in
+  vc#set_resizable true;
+  ignore (view#append_column vc);
+
+  Slave.list_applications os
+    (when_applications_loaded model name_col version_col)
+
+and when_applications_loaded model name_col version_col apps =
+  Array.iter (
+    fun { G.app_name = name; app_display_name = display_name;
+          app_version = version; app_release = release } ->
+      let name = if display_name <> "" then display_name else name in
+      let version = version ^ if release <> "" then "-"^release else "" in
+      let row = model#append () in
+      model#set ~row ~column:name_col name;
+      model#set ~row ~column:version_col version
+  ) apps