X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;f=filetree.ml;h=f252f2a4d2e09ae657d2699457ad4339ffed9223;hb=refs%2Ftags%2F0.1.1;hp=c4f62ab48e296328e4d3eda049fbd5e61dd58a44;hpb=7b37dd1b4b0de25b1450ef08e4bf7ea37798b602;p=guestfs-browser.git diff --git a/filetree.ml b/filetree.ml index c4f62ab..f252f2a 100644 --- a/filetree.ml +++ b/filetree.ml @@ -18,6 +18,7 @@ open ExtString open ExtList +open Unix open Printf open Utils @@ -52,40 +53,40 @@ let rec create ~packing () = (* 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. *) @@ -138,8 +139,8 @@ and button_press ({ model = model; view = view } as t) ev = 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 @@ -175,7 +176,7 @@ and make_context_menu t paths = 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 @@ -194,13 +195,9 @@ and make_context_menu t paths = 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 @@ -213,20 +210,20 @@ and make_context_menu t paths = (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 @@ -237,25 +234,8 @@ and make_context_menu t paths = 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' @@ -264,46 +244,59 @@ and markup_of_mode mode = 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'; "" ^ str ^ "" -(* 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 "%04d-%02d-%02d %02d:%02d:%02d" + (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 "%04d-%02d-%02d %02d:%02d:%02d" - (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 + "now" + else if ago < 60. *. 60. then + sprintf "%.0f minutes ago" (ago /. 60.) + else if ago < 60. *. 60. *. 24. then + sprintf "%.0f hours ago" (ago /. 60. /. 60.) + else if ago < 60. *. 60. *. 24. *. 28. then + sprintf "%.0f days ago" (ago /. 60. /. 60. /. 24.) + else + show_full_date () + +(* Mark up file sizes. *) +let markup_of_size bytes = + sprintf "%s" (human_size bytes) let clear { model = model; hash = hash } = model#clear (); @@ -358,31 +351,30 @@ and add_top_level_vol ({ model = model; hash = hash } as t) name dev = (* 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 "Loading ..."; 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 @@ -390,12 +382,11 @@ and expand_row ({ model = model; hash = hash } as t) row _ = 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 @@ -405,13 +396,14 @@ and expand_row ({ model = model; hash = hash } as t) row _ = 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 = @@ -429,19 +421,17 @@ 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 -> () ); @@ -449,9 +439,9 @@ and when_read_directory ({ model = model } as t) path entries = (* 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 @@ -465,7 +455,7 @@ and when_read_directory_fail ({ model = model } as t) path exn = 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)