2 * Copyright (C) 2011 Red Hat Inc.
4 * This program is free software; you can redistribute it and/or modify
5 * it under the terms of the GNU General Public License as published by
6 * the Free Software Foundation; either version 2 of the License, or
7 * (at your option) any later version.
9 * This program is distributed in the hope that it will be useful,
10 * but WITHOUT ANY WARRANTY; without even the implied warranty of
11 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12 * GNU General Public License for more details.
14 * You should have received a copy of the GNU General Public License along
15 * with this program; if not, write to the Free Software Foundation, Inc.,
16 * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
25 let rec inspection_dialog tree os =
26 debug "inspection dialog";
27 let title = "Inspection data" in
28 let d = GWindow.dialog ~title () in
30 (* Fill in the basic information. *)
31 let packing : GObj.widget -> unit = d#vbox#add in
32 let vbox = frame ~label:"Basic information" ~packing () in
33 let tbl = GPack.table ~columns:4 ~rows:1 ~packing:vbox#add () in
34 tbl#set_col_spacings 8;
35 tbl#set_row_spacings 8;
37 wide tbl 0 "Product name: " os.Slave_types.insp_product_name;
38 wide tbl 1 "Hostname: " os.Slave_types.insp_hostname;
40 simple tbl 2 0 "OS type: " os.Slave_types.insp_type;
41 simple tbl 3 0 "Distro: " os.Slave_types.insp_distro;
42 simple tbl 4 0 "Version: "
44 os.Slave_types.insp_major_version
45 os.Slave_types.insp_minor_version);
46 simple tbl 5 0 "Product variant: " os.Slave_types.insp_product_variant;
48 simple tbl 2 2 "Root: " os.Slave_types.insp_root;
49 simple tbl 3 2 "Arch: " os.Slave_types.insp_arch;
50 simple tbl 4 2 "Package mgr: " os.Slave_types.insp_package_management;
51 simple tbl 5 2 "Package fmt: " os.Slave_types.insp_package_format;
53 (match os.Slave_types.insp_windows_systemroot with
56 simple tbl 6 0 "%systemroot%: " systemroot
58 (match os.Slave_types.insp_windows_current_control_set with
61 simple tbl 6 2 "CurrentControlSet: " ccs
65 let vbox = frame ~label:"Applications" ~packing:d#vbox#add () in
66 applications_view ~packing:vbox#add os;
69 let vbox = frame ~label:"Mount points" ~packing:d#vbox#add () in
70 two_column_view ~title1:"Mount" ~title2:"Filesystem"
71 ~packing:vbox#add os.Slave_types.insp_mountpoints;
74 let vbox = frame ~label:"Filesystems" ~packing:d#vbox#add () in
75 one_column_view ~title:"Filesystem" ~packing:vbox#add
76 (Array.to_list os.Slave_types.insp_filesystems);
79 (match os.Slave_types.insp_drive_mappings with
82 let vbox = frame ~label:"Drives" ~packing:d#vbox#add () in
83 two_column_view ~title1:"Drive letter" ~title2:"Filesystem"
84 ~packing:vbox#add mappings
87 (* Make sure dialog is destroyed when the tree is cleared. *)
89 tree#clear_tree ~callback:(
91 debug "inspection clear_tree -> destroy dialog";
95 let destroy_dialog () =
96 tree#disconnect sigid;
100 (* Add a close button. *)
101 let close_button = GButton.button ~label:"Close"
102 ~packing:d#action_area#add () in
103 ignore (close_button#connect#clicked ~callback:destroy_dialog);
105 (* Destroy dialog when WM close button is pressed. *)
106 ignore (d#connect#destroy ~callback:destroy_dialog);
110 (* Helper functions. *)
111 and frame ?label ?packing () =
112 let frame = GBin.frame ?label ?packing () in
113 GPack.vbox ~border_width:8 ~packing:frame#add ()
115 and simple tbl top left label text =
116 let markup = sprintf "<b>%s</b>" (markup_escape text) in
117 ignore (GMisc.label ~xalign:1. ~text:label
118 ~packing:(tbl#attach ~top ~left) ());
119 let left = left + 1 in
120 ignore (GMisc.label ~xalign:0. ~markup ~packing:(tbl#attach ~top ~left) ());
122 and wide tbl top label text =
123 let markup = sprintf "<b>%s</b>" (markup_escape text) in
124 ignore (GMisc.label ~xalign:1.
125 ~text:label ~packing:(tbl#attach ~top ~left:0) ());
126 ignore (GMisc.label ~xalign:0.
127 ~markup ~packing:(tbl#attach ~top ~left:1 ~right:4) ());
129 and one_column_view ~title ?packing data =
130 let model, c1 = GTree.store_of_list Gobject.Data.string data in
133 GBin.scrolled_window ?packing ~hpolicy:`AUTOMATIC ~vpolicy:`AUTOMATIC () in
135 let view = GTree.view ~model ~packing:sw#add () in
136 view#selection#set_mode `NONE;
138 let renderer = GTree.cell_renderer_text [], ["text", c1] in
139 let vc = GTree.view_column ~title ~renderer () in
140 vc#set_resizable true;
141 ignore (view#append_column vc)
143 and two_column_view ~title1 ~title2 ?packing data =
144 let cols = new GTree.column_list in
145 let c1 = cols#add Gobject.Data.string in
146 let c2 = cols#add Gobject.Data.string in
148 let model = GTree.list_store cols in
151 let row = model#append () in
152 model#set ~row ~column:c1 d1;
153 model#set ~row ~column:c2 d2
157 GBin.scrolled_window ?packing ~hpolicy:`AUTOMATIC ~vpolicy:`AUTOMATIC () in
159 let view = GTree.view ~model ~packing:sw#add () in
160 view#selection#set_mode `NONE;
162 let renderer = GTree.cell_renderer_text [], ["text", c1] in
163 let vc = GTree.view_column ~title:title1 ~renderer () in
164 vc#set_resizable true;
165 ignore (view#append_column vc);
166 let renderer = GTree.cell_renderer_text [], ["text", c2] in
167 let vc = GTree.view_column ~title:title2 ~renderer () in
168 vc#set_resizable true;
169 ignore (view#append_column vc)
171 (* Applications view: populated after a round-trip to the slave thread. *)
172 and applications_view ?packing os =
173 let cols = new GTree.column_list in
174 let name_col = cols#add Gobject.Data.string in
175 let version_col = cols#add Gobject.Data.string in
177 let model = GTree.list_store cols in
180 GBin.scrolled_window ?packing ~hpolicy:`AUTOMATIC ~vpolicy:`ALWAYS () in
182 let view = GTree.view ~model ~height:150 ~packing:sw#add () in
183 view#selection#set_mode `NONE;
185 let renderer = GTree.cell_renderer_text [], ["text", name_col] in
186 let vc = GTree.view_column ~title:"Name" ~renderer () in
187 vc#set_resizable true;
188 ignore (view#append_column vc);
189 let renderer = GTree.cell_renderer_text [], ["text", version_col] in
190 let vc = GTree.view_column ~title:"Version" ~renderer () in
191 vc#set_resizable true;
192 ignore (view#append_column vc);
194 Slave.list_applications os
195 (when_applications_loaded model name_col version_col)
197 and when_applications_loaded model name_col version_col apps =
199 fun { G.app_name = name; app_display_name = display_name;
200 app_version = version; app_release = release } ->
201 let name = if display_name <> "" then display_name else name in
202 let version = version ^ if release <> "" then "-"^release else "" in
203 let row = model#append () in
204 model#set ~row ~column:name_col name;
205 model#set ~row ~column:version_col version