open ExtString
open ExtList
+open Unix
open Printf
open Utils
(* Displayed: *)
let mode_col = cols#add Gobject.Data.string in
let name_col = cols#add Gobject.Data.string in
- let size_col = cols#add Gobject.Data.int64 in
+ let size_col = cols#add Gobject.Data.string in
let date_col = cols#add Gobject.Data.string in
- let link_col = cols#add Gobject.Data.string in
(* Create the model. *)
let model = GTree.tree_store cols in
+
+ (* Create the view. *)
view#set_model (Some (model :> GTree.model));
let renderer = GTree.cell_renderer_text [], ["markup", mode_col] in
let mode_view = GTree.view_column ~title:"Permissions" ~renderer () in
+ mode_view#set_resizable true;
ignore (view#append_column mode_view);
let renderer = GTree.cell_renderer_text [], ["markup", name_col] in
let name_view = GTree.view_column ~title:"Filename" ~renderer () in
- name_view#set_max_width 300 (*pixels?!?*);
+ name_view#set_resizable true;
ignore (view#append_column name_view);
- let renderer = GTree.cell_renderer_text [], ["text", size_col] in
+ let renderer = GTree.cell_renderer_text [`XALIGN 1.], ["markup", size_col] in
let size_view = GTree.view_column ~title:"Size" ~renderer () in
+ size_view#set_resizable true;
ignore (view#append_column size_view);
- let renderer = GTree.cell_renderer_text [], ["markup", date_col] in
+ let renderer = GTree.cell_renderer_text [`XALIGN 1.], ["markup", date_col] in
let date_view = GTree.view_column ~title:"Date" ~renderer () in
+ date_view#set_resizable true;
ignore (view#append_column date_view);
- let renderer = GTree.cell_renderer_text [], ["markup", link_col] in
- let link_view = GTree.view_column ~title:"Link" ~renderer () in
- ignore (view#append_column link_view);
-
let t = {
view = view; model = model; hash = hash;
index_col = index_col;
mode_col = mode_col; name_col = name_col; size_col = size_col;
- date_col = date_col; link_col = link_col;
+ date_col = date_col;
} in
(* Open a context menu when a button is pressed. *)
let row = model#get_iter path in
let hdata = get_hdata t row in
match hdata with
- | _, (Loading | ErrorMessage _ | Info _) -> None
- | _, (Top _ | Directory _ | File _) -> Some (path, hdata)
+ | { content=(Loading | ErrorMessage _ | Info _) } -> None
+ | { content=(Top _ | Directory _ | File _) } -> Some (path, hdata)
) paths in
(* Based on number of selected rows and what is selected, construct
and add_directory_items path =
let item = factory#add_item "Directory information" in
item#misc#set_sensitive false;
- let item = factory#add_item "Space used by directory" in
+ let item = factory#add_item "Calculate disk usage" in
ignore (item#connect#activate ~callback:(disk_usage t path));
ignore (factory#add_separator ());
let item = factory#add_item "Download ..." in
and add_os_items path =
let item = factory#add_item "Operating system information" in
- item#misc#set_sensitive false;
- let item = factory#add_item "Block device information" in
- item#misc#set_sensitive false;
- let item = factory#add_item "Filesystem used & free" in
- item#misc#set_sensitive false;
+ ignore (item#connect#activate ~callback:(display_inspection_data t path));
ignore (factory#add_separator ());
- add_directory_items path
+ add_volume_items path
and add_volume_items path =
let item = factory#add_item "Filesystem used & free" in
(match paths with
(* single selection *)
- | [path, (_, Top (Slave.OS os))] -> (* top level operating system *)
+ | [path, { content=Top (Slave.OS os)} ] -> (* top level operating system *)
add_os_items path
- | [path, (_, Top (Slave.Volume dev))] -> (* top level volume *)
+ | [path, { content=Top (Slave.Volume dev) }] -> (* top level volume *)
add_volume_items path
- | [path, (_, Directory direntry)] -> (* directory *)
+ | [path, { content=Directory direntry }] -> (* directory *)
add_directory_items path
- | [path, (_, File direntry)] -> (* file *)
+ | [path, { content=File direntry }] -> (* file *)
add_file_items path
- | [_, (_, Loading)]
- | [_, (_, ErrorMessage _)] -> ()
+ | [_, { content=Loading }]
+ | [_, { content=ErrorMessage _ }] -> ()
| _ ->
(* At the moment multiple selection is disabled. When/if we
menu
-(* XXX No binding for g_markup_escape in lablgtk2. *)
-let markup_escape name =
- let f = function
- | '&' -> "&" | '<' -> "<" | '>' -> ">"
- | c -> String.make 1 c
- in
- String.replace_chars f name
-
-(* Mark up a filename for the name_col column. *)
-let rec markup_of_name name =
- markup_escape name
-
-(* Mark up symbolic links. *)
-and markup_of_link link =
- let link = markup_escape link in
- if link <> "" then utf8_rarrow ^ " " ^ link else ""
-
(* Mark up mode. *)
-and markup_of_mode mode =
+let markup_of_mode mode =
let c =
if is_socket mode then 's'
else if is_symlink mode then 'l'
else if is_directory mode then 'd'
else if is_char mode then 'c'
else if is_fifo mode then 'p' else '?' in
- let ru = if test_bit 0o400L mode then 'r' else '-' in
- let wu = if test_bit 0o200L mode then 'w' else '-' in
- let xu = if test_bit 0o100L mode then 'x' else '-' in
- let rg = if test_bit 0o40L mode then 'r' else '-' in
- let wg = if test_bit 0o20L mode then 'w' else '-' in
- let xg = if test_bit 0o10L mode then 'x' else '-' in
- let ro = if test_bit 0o4L mode then 'r' else '-' in
- let wo = if test_bit 0o2L mode then 'w' else '-' in
- let xo = if test_bit 0o1L mode then 'x' else '-' in
+ let ru = if is_ru mode then 'r' else '-' in
+ let wu = if is_wu mode then 'w' else '-' in
+ let xu = if is_xu mode then 'x' else '-' in
+ let rg = if is_rg mode then 'r' else '-' in
+ let wg = if is_wg mode then 'w' else '-' in
+ let xg = if is_xg mode then 'x' else '-' in
+ let ro = if is_ro mode then 'r' else '-' in
+ let wo = if is_wo mode then 'w' else '-' in
+ let xo = if is_xo mode then 'x' else '-' in
let str = sprintf "%c%c%c%c%c%c%c%c%c%c" c ru wu xu rg wg xg ro wo xo in
- let suid = test_bit 0o4000L mode in
- let sgid = test_bit 0o2000L mode in
- let svtx = test_bit 0o1000L mode in
+ let suid = is_suid mode in
+ let sgid = is_sgid mode in
+ let svtx = is_svtx mode in
if suid then str.[3] <- 's';
if sgid then str.[6] <- 's';
if svtx then str.[9] <- 't';
"<span color=\"#222222\" size=\"small\">" ^ str ^ "</span>"
-(* File type tests. *)
-and file_type mask mode = Int64.logand mode 0o170000L = mask
-
-and is_socket mode = file_type 0o140000L mode
-and is_symlink mode = file_type 0o120000L mode
-and is_regular_file mode = file_type 0o100000L mode
-and is_block mode = file_type 0o060000L mode
-and is_directory mode = file_type 0o040000L mode
-and is_char mode = file_type 0o020000L mode
-and is_fifo mode = file_type 0o010000L mode
+(* Mark up dates. *)
+let markup_of_date t =
+ (* Guestfs gives us int64's, we want float which is OCaml's
+ * equivalent of time_t.
+ *)
+ let t = Int64.to_float t in
-and test_bit mask mode = Int64.logand mode mask = mask
+ let show_full_date () =
+ let tm = localtime t in
+ sprintf "<span color=\"#222222\" size=\"small\">%04d-%02d-%02d %02d:%02d:%02d</span>"
+ (tm.tm_year + 1900) (tm.tm_mon + 1) tm.tm_mday
+ tm.tm_hour tm.tm_min tm.tm_sec
+ in
-(* Mark up dates. *)
-and markup_of_date time =
- let time = Int64.to_float time in
- let tm = Unix.localtime time in
- sprintf "<span color=\"#222222\" size=\"small\">%04d-%02d-%02d %02d:%02d:%02d</span>"
- (tm.Unix.tm_year + 1900) (tm.Unix.tm_mon + 1) tm.Unix.tm_mday
- tm.Unix.tm_hour tm.Unix.tm_min tm.Unix.tm_sec
+ (* How long ago? *)
+ let now = time () in
+ let ago = now -. t in
+ if ago < 0. then (* future *)
+ show_full_date ()
+ else if ago < 60. then
+ "<small>now</small>"
+ else if ago < 60. *. 60. then
+ sprintf "<small>%.0f minutes ago</small>" (ago /. 60.)
+ else if ago < 60. *. 60. *. 24. then
+ sprintf "<small>%.0f hours ago</small>" (ago /. 60. /. 60.)
+ else if ago < 60. *. 60. *. 24. *. 28. then
+ sprintf "<small>%.0f days ago</small>" (ago /. 60. /. 60. /. 24.)
+ else
+ show_full_date ()
+
+(* Mark up file sizes. *)
+let markup_of_size bytes =
+ sprintf "<small>%s</small>" (human_size bytes)
let clear { model = model; hash = hash } =
model#clear ();
(* Generic function to make an openable node to the tree. *)
and make_node ({ model = model; hash = hash } as t) row content =
- let hdata = NodeNotStarted, content in
+ let hdata = { state=NodeNotStarted; content=content; visited=false } in
store_hdata t row hdata;
(* Create a placeholder "loading ..." row underneath this node so
* the user has something to expand.
*)
let placeholder = model#append ~parent:row () in
- let hdata = IsLeaf, Loading in
+ let hdata = { state=IsLeaf; content=Loading; visited=false } in
store_hdata t placeholder hdata;
model#set ~row:placeholder ~column:t.name_col "<i>Loading ...</i>";
ignore (t.view#connect#row_expanded ~callback:(expand_row t))
and make_leaf ({ model = model; hash = hash } as t) row content =
- let hdata = IsLeaf, content in
+ let hdata = { state=IsLeaf; content=content; visited=false } in
store_hdata t row hdata
(* This is called when the user expands a row. *)
and expand_row ({ model = model; hash = hash } as t) row _ =
match get_hdata t row with
- | NodeNotStarted, Top src ->
+ | { state=NodeNotStarted; content=Top src } as hdata ->
(* User has opened a top level node that was not previously opened. *)
(* Mark this row as loading, so we don't try to open it again. *)
- let hdata = NodeLoading, Top src in
- store_hdata t row hdata;
+ hdata.state <- NodeLoading;
(* Get a stable path for this row. *)
let path = model#get_path row in
Slave.read_directory ~fail:(when_read_directory_fail t path)
src "/" (when_read_directory t path)
- | NodeNotStarted, Directory direntry ->
+ | { state=NodeNotStarted; content=Directory direntry } as hdata ->
(* User has opened a filesystem directory not previously opened. *)
(* Mark this row as loading. *)
- let hdata = NodeLoading, Directory direntry in
- store_hdata t row hdata;
+ hdata.state <- NodeLoading;
(* Get a stable path for this row. *)
let path = model#get_path row in
Slave.read_directory ~fail:(when_read_directory_fail t path)
src pathname (when_read_directory t path)
- | NodeLoading, _ | IsNode, _ -> ()
+ | { state=(NodeLoading|IsNode) } -> ()
(* These are not nodes so it should never be possible to open them. *)
- | _, File _ | IsLeaf, _ -> assert false
+ | { content=File _ } | { state=IsLeaf } -> assert false
(* Node should not exist in the tree. *)
- | NodeNotStarted, (Loading | ErrorMessage _ | Info _) -> assert false
+ | { state=NodeNotStarted; content=(Loading | ErrorMessage _ | Info _) } ->
+ assert false
(* This is the callback when the slave has read the directory for us. *)
and when_read_directory ({ model = model } as t) path entries =
make_node t row (Directory direntry)
else
make_leaf t row (File direntry);
- model#set ~row ~column:t.name_col (markup_of_name name);
+ model#set ~row ~column:t.name_col (markup_of_name direntry);
model#set ~row ~column:t.mode_col (markup_of_mode stat.G.mode);
- model#set ~row ~column:t.size_col stat.G.size;
+ model#set ~row ~column:t.size_col (markup_of_size stat.G.size);
model#set ~row ~column:t.date_col (markup_of_date stat.G.mtime);
- model#set ~row ~column:t.link_col (markup_of_link link)
) entries;
(* Remove the placeholder "Loading" entry. NB. Must be done AFTER
* adding the other entries, or else Gtk will unexpand the row.
*)
(try
- let hdata = IsLeaf, Loading in
- let row = find_child_node_by_hdata t row hdata in
+ let row = find_child_node_by_content t row Loading in
ignore (model#remove row)
with Invalid_argument _ | Not_found -> ()
);
(* The original directory entry has now been loaded, so
* update its state.
*)
- let state, content = get_hdata t row in
- let hdata = IsNode, content in
- store_hdata t row hdata
+ let hdata = get_hdata t row in
+ hdata.state <- IsNode;
+ set_visited t row
(* This is called instead of when_read_directory when the read directory
* (or mount etc) failed. Convert the "Loading" entry into the
let row = model#get_iter path in
let row = model#iter_children ~nth:0 (Some row) in
- let hdata = IsLeaf, ErrorMessage msg in
+ let hdata = { state=IsLeaf; content=ErrorMessage msg; visited=false } in
store_hdata t row hdata;
model#set ~row ~column:t.name_col (markup_escape msg)
git.annexia.org / guestfs-browser.git / blobdiff