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.
26 let rec inspection_dialog tree os =
27 debug "inspection dialog";
28 let title = "Operating system information" in
29 let d = GWindow.dialog ~width:500 ~height:600 ~title () in
31 let nb = GPack.notebook ~packing:d#vbox#add () in
33 (* Fill in the basic information. *)
34 let vbox = tab "Basic information" nb in
35 let tbl = GPack.table ~columns:4 ~rows:1 ~packing:vbox#add () in
36 tbl#set_col_spacings 8;
37 tbl#set_row_spacings 8;
39 wide tbl 0 "Product name: " os.insp_product_name;
40 wide tbl 1 "Hostname: " os.insp_hostname;
42 simple tbl 2 0 "OS type: " os.insp_type;
43 simple tbl 3 0 "Distro: " os.insp_distro;
44 simple tbl 4 0 "Version: "
47 os.insp_minor_version);
48 simple tbl 5 0 "Product variant: " os.insp_product_variant;
50 simple tbl 2 2 "Root: " os.insp_root;
51 simple tbl 3 2 "Arch: " os.insp_arch;
52 simple tbl 4 2 "Package mgr: " os.insp_package_management;
53 simple tbl 5 2 "Package fmt: " os.insp_package_format;
55 (match os.insp_windows_systemroot with
58 simple tbl 6 0 "%systemroot%: " systemroot
60 (match os.insp_windows_current_control_set with
63 simple tbl 6 2 "CurrentControlSet: " ccs
67 let vbox = tab "Applications" nb in
68 applications_view ~packing:vbox#add os;
71 let vbox = tab "Mount points" nb in
72 two_column_view ~title1:"Mount" ~title2:"Filesystem"
73 ~packing:vbox#add os.insp_mountpoints;
76 let vbox = tab "Filesystems" nb in
77 one_column_view ~title:"Filesystem" ~packing:vbox#add
78 (Array.to_list os.insp_filesystems);
81 (match os.insp_drive_mappings with
84 let vbox = tab "Drive letters" nb in
85 two_column_view ~title1:"Drive letter" ~title2:"Filesystem"
86 ~packing:vbox#add mappings
89 (* Make sure dialog is destroyed when the tree is cleared. *)
91 tree#clear_tree ~callback:(
93 debug "inspection clear_tree -> destroy dialog";
97 let destroy_dialog () =
98 tree#disconnect sigid;
102 (* Add a close button. *)
103 let close_button = GButton.button ~label:"Close"
104 ~packing:d#action_area#add () in
105 ignore (close_button#connect#clicked ~callback:destroy_dialog);
107 (* Destroy dialog when WM close button is pressed. *)
108 ignore (d#connect#destroy ~callback:destroy_dialog);
112 (* Helper functions. *)
114 let vbox = GPack.vbox ~border_width:8 () in
115 let tab_label = (GMisc.label ~text () :> GObj.widget) in
116 ignore (nb#append_page ~tab_label (vbox :> GObj.widget));
119 and simple tbl top left label text =
120 let markup = sprintf "<b>%s</b>" (markup_escape text) in
121 ignore (GMisc.label ~xalign:1. ~text:label
122 ~packing:(tbl#attach ~top ~left) ());
123 let left = left + 1 in
124 ignore (GMisc.label ~xalign:0. ~markup ~packing:(tbl#attach ~top ~left) ());
126 and wide tbl top label text =
127 let markup = sprintf "<b>%s</b>" (markup_escape text) in
128 ignore (GMisc.label ~xalign:1.
129 ~text:label ~packing:(tbl#attach ~top ~left:0) ());
130 ignore (GMisc.label ~xalign:0.
131 ~markup ~packing:(tbl#attach ~top ~left:1 ~right:4) ());
133 and one_column_view ~title ?packing data =
134 let data = List.sort compare data in
135 let model, c1 = GTree.store_of_list Gobject.Data.string data in
138 GBin.scrolled_window ?packing ~hpolicy:`AUTOMATIC ~vpolicy:`AUTOMATIC () in
140 let view = GTree.view ~model ~packing:sw#add () in
141 view#selection#set_mode `NONE;
143 let renderer = GTree.cell_renderer_text [], ["text", c1] in
144 let vc = GTree.view_column ~title ~renderer () in
145 vc#set_resizable true;
146 ignore (view#append_column vc)
148 and two_column_view ~title1 ~title2 ?packing data =
149 let data = List.sort compare data in
151 let cols = new GTree.column_list in
152 let c1 = cols#add Gobject.Data.string in
153 let c2 = cols#add Gobject.Data.string in
155 let model = GTree.list_store cols in
158 let row = model#append () in
159 model#set ~row ~column:c1 d1;
160 model#set ~row ~column:c2 d2
164 GBin.scrolled_window ?packing ~hpolicy:`AUTOMATIC ~vpolicy:`AUTOMATIC () in
166 let view = GTree.view ~model ~packing:sw#add () in
167 view#selection#set_mode `NONE;
169 let renderer = GTree.cell_renderer_text [], ["text", c1] in
170 let vc = GTree.view_column ~title:title1 ~renderer () in
171 vc#set_resizable true;
172 ignore (view#append_column vc);
173 let renderer = GTree.cell_renderer_text [], ["text", c2] in
174 let vc = GTree.view_column ~title:title2 ~renderer () in
175 vc#set_resizable true;
176 ignore (view#append_column vc)
178 (* Applications view: populated after a round-trip to the slave thread. *)
179 and applications_view ?packing os =
180 let cols = new GTree.column_list in
181 let name_col = cols#add Gobject.Data.string in
182 let version_col = cols#add Gobject.Data.string in
184 let model = GTree.list_store cols in
187 GBin.scrolled_window ?packing ~hpolicy:`AUTOMATIC ~vpolicy:`ALWAYS () in
189 let view = GTree.view ~model ~packing:sw#add () in
190 view#selection#set_mode `NONE;
192 let renderer = GTree.cell_renderer_text [], ["text", name_col] in
193 let vc = GTree.view_column ~title:"Name" ~renderer () in
194 vc#set_resizable true;
195 ignore (view#append_column vc);
196 let renderer = GTree.cell_renderer_text [], ["text", version_col] in
197 let vc = GTree.view_column ~title:"Version" ~renderer () in
198 vc#set_resizable true;
199 ignore (view#append_column vc);
201 Slave.list_applications os
202 (when_applications_loaded model name_col version_col)
204 and when_applications_loaded model name_col version_col apps =
206 fun { G.app_name = name; app_display_name = display_name;
207 app_version = version; app_release = release } ->
208 let name = if display_name <> "" then display_name else name in
209 let version = version ^ if release <> "" then "-"^release else "" in
210 let row = model#append () in
211 model#set ~row ~column:name_col name;
212 model#set ~row ~column:version_col version