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.
24 (* I'd like to open CalendarLib but unfortunately it contains a
25 * submodule also called Utils, which clashes with our module.
27 module CL = CalendarLib
30 let rec file_properties tree path =
31 let model = tree#model in
32 let row = model#get_iter path in
33 let src, pathname = tree#get_pathname row in
35 debug "file properties dialog %s" pathname;
37 let title = "File properties" in
38 let d = GWindow.dialog ~width:400 ~height:600 ~title () in
39 let nb = GPack.notebook ~packing:d#vbox#add () in
41 let dent = tree#get_direntry row in
42 let stat = dent.dent_stat in
43 let mode = stat.G.mode in
46 if is_socket mode then "Socket"
47 else if is_symlink mode then "Symbolic link"
48 else if is_regular_file mode then "File"
49 else if is_block mode then "Block device"
50 else if is_directory mode then "Directory"
51 else if is_char mode then "Character device"
52 else if is_fifo mode then "Pipe"
55 (* Fill in the basic information. *)
56 let vbox = tab filetype nb in
57 let tbl = GPack.table ~columns:4 ~rows:1 ~packing:vbox#add () in
58 tbl#set_col_spacings 8;
59 tbl#set_row_spacings 8;
61 wide tbl 0 "Name: " dent.dent_name;
62 wide tbl 1 "" pathname;
63 wide tbl 2 "Size: " (sprintf "%Ld bytes" stat.G.size);
64 wide tbl 3 "" (human_size stat.G.size);
65 simple tbl 4 0 "Type: " filetype;
66 if is_block mode || is_char mode then
67 simple tbl 4 2 "Device: " (sprintf "0x%Lx" stat.G.rdev)
68 else if is_symlink mode then
69 simple tbl 4 2 "Link: " dent.dent_link;
70 simple tbl 5 0 "UID: " (Int64.to_string stat.G.uid);
71 simple tbl 5 2 "GID: " (Int64.to_string stat.G.gid);
73 wide tbl 6 "" (file_permissions_string mode);
75 simple tbl 7 0 "Perms: " (sprintf "0%Lo" (mode &^ 0o777L));
76 simple tbl 7 2 "Sticky bit: " (if is_svtx mode then "yes" else "no");
77 simple tbl 8 0 "Setuid bit: " (if is_suid mode then "yes" else "no");
78 simple tbl 8 2 "Setgid bit: " (if is_sgid mode then "yes" else "no");
80 wide2 tbl 9 "Last access: " (display_time stat.G.atime);
81 wide2 tbl 10 "Last modification: " (display_time stat.G.mtime);
82 wide2 tbl 11 "Last status change: " (display_time stat.G.ctime);
85 let vbox = tab "Extended attrs" nb in
86 xattrs_view ~packing:vbox#add src pathname;
88 (* Make sure dialog is destroyed when the tree is cleared. *)
90 tree#clear_tree ~callback:(
92 debug "inspection clear_tree -> destroy dialog";
96 let destroy_dialog () =
97 tree#disconnect sigid;
101 (* Add a close button. *)
102 let close_button = GButton.button ~label:"Close"
103 ~packing:d#action_area#add () in
104 ignore (close_button#connect#clicked ~callback:destroy_dialog);
106 (* Destroy dialog when WM close button is pressed. *)
107 ignore (d#connect#destroy ~callback:destroy_dialog);
111 (* Helper functions. *)
113 let vbox = GPack.vbox ~border_width:8 () in
114 let tab_label = (GMisc.label ~text () :> GObj.widget) in
115 ignore (nb#append_page ~tab_label (vbox :> GObj.widget));
118 and simple tbl top left label text =
119 let markup = sprintf "<b>%s</b>" (markup_escape text) in
120 ignore (GMisc.label ~xalign:1. ~text:label
121 ~packing:(tbl#attach ~top ~left) ());
122 let left = left + 1 in
123 ignore (GMisc.label ~xalign:0. ~markup ~packing:(tbl#attach ~top ~left) ());
125 and wide tbl top label text =
126 let markup = sprintf "<b>%s</b>" (markup_escape text) in
127 ignore (GMisc.label ~xalign:1.
128 ~text:label ~packing:(tbl#attach ~top ~left:0) ());
129 ignore (GMisc.label ~xalign:0.
130 ~markup ~packing:(tbl#attach ~top ~left:1 ~right:4) ());
132 and wide2 tbl top label text =
133 let markup = sprintf "<b>%s</b>" (markup_escape text) in
134 ignore (GMisc.label ~xalign:1.
135 ~text:label ~packing:(tbl#attach ~top ~left:0 ~right:2) ());
136 ignore (GMisc.label ~xalign:0.
137 ~markup ~packing:(tbl#attach ~top ~left:2 ~right:4) ());
140 let t = Int64.to_float t in
141 let cal = CL.Calendar.from_unixfloat t in
142 let cal = CL.Calendar.convert cal CL.Time_Zone.UTC CL.Time_Zone.Local in
143 CL.Printer.Calendar.to_string cal
145 (* Extended attrs: loaded on demand. *)
146 and xattrs_view ?packing src pathname =
147 let cols = new GTree.column_list in
148 let name_col = cols#add Gobject.Data.string in
149 let value_col = cols#add Gobject.Data.string in
151 let model = GTree.list_store cols in
154 GBin.scrolled_window ?packing ~hpolicy:`AUTOMATIC ~vpolicy:`ALWAYS () in
156 let view = GTree.view ~model ~packing:sw#add () in
157 view#selection#set_mode `NONE;
159 let renderer = GTree.cell_renderer_text [], ["text", name_col] in
160 let vc = GTree.view_column ~title:"Name" ~renderer () in
161 vc#set_resizable true;
162 ignore (view#append_column vc);
163 let renderer = GTree.cell_renderer_text [], ["text", value_col] in
164 let vc = GTree.view_column ~title:"Value" ~renderer () in
165 vc#set_resizable true;
166 ignore (view#append_column vc);
168 Slave.file_xattrs src pathname
169 (when_xattrs_loaded model name_col value_col)
171 and when_xattrs_loaded model name_col value_col xattrs =
173 fun { G.attrname = name; attrval = value } ->
174 let value = sprintf "%S" value in (* OCaml string escaping *)
175 let row = model#append () in
176 model#set ~row ~column:name_col name;
177 model#set ~row ~column:value_col value