Ignore warning 3 about String.set (for OCaml 4.02).

[guestfs-browser.git] / filetree_markup.ml

diff --git a/filetree_markup.ml b/filetree_markup.ml
index a890cca..b5f3b48 100644 (file)
--- a/filetree_markup.ml
+++ b/filetree_markup.ml
@@ -18,15 +18,15 @@
 
 open ExtString
 open ExtList
-open CamomileLibrary
-open Default.Camomile
 open Unix
 
 open Utils
-open Filetree_type
+open Slave_types
 
 open Printf
 
+module CL = CalendarLib
+
 (* Base colours. XXX Should be configurable somewhere. *)
 let file_color = 0x20, 0x20, 0xff  (* regular file *)
 let dir_color = 0x80, 0x80, 0x20   (* directory *)
@@ -47,15 +47,15 @@ let other_color = file_color       (* anything not one of the above *)
  * http://library.gnome.org/devel/pango/stable/PangoMarkupFormat.html
  *)
 let rec markup_of_name ?(visited = false) direntry =
-  let name = direntry.Slave.dent_name in
-  let mode = direntry.Slave.dent_stat.Guestfs.mode in
+  let name = direntry.dent_name in
+  let mode = direntry.dent_stat.Guestfs.mode in
   if is_directory mode then (           (* directory *)
     let fg = if not visited then normal dir_color else darken dir_color in
     sprintf "<span weight=\"bold\" fgcolor=\"%s\">%s</span>"
       fg (markup_escape name)
   )
   else if is_symlink mode then (        (* symlink *)
-    let link = direntry.Slave.dent_link in
+    let link = direntry.dent_link in
     let fg =
       if not visited then normal symlink_color else darken symlink_color in
     sprintf "<span style=\"italic\" fgcolor=\"%s\">%s</span> %s <span style=\"italic\" fgcolor=\"%s\">%s</span>"
@@ -115,32 +115,7 @@ and darken (r, g, b) =
 
 (* Mark up mode. *)
 let markup_of_mode mode =
-  let c =
-    if is_socket mode then 's'
-    else if is_symlink mode then 'l'
-    else if is_regular_file mode then '-'
-    else if is_block mode then 'b'
-    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 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 = 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';
-
+  let str = file_permissions_string mode in
   "<span color=\"#222222\" size=\"small\">" ^ str ^ "</span>"
 
 (* Mark up dates. *)
@@ -151,10 +126,10 @@ let markup_of_date t =
   let t = Int64.to_float t in
 
   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
+    let cal = CL.Calendar.from_unixfloat t in
+    let cal = CL.Calendar.convert cal CL.Time_Zone.UTC CL.Time_Zone.Local in
+    CL.Printer.Calendar.sprint
+      "<span color=\"#222222\" size=\"small\">%F %T</span>" cal
   in
 
   (* How long ago? *)
@@ -200,30 +175,3 @@ let markup_of_regvaluetype h value =
 let markup_of_regvaluesize h value =
   let _, len = Hivex.value_type h value in
   sprintf "%d" len
-
-(* This is a bit of a hack.  Ideally just setting 'visited' would
- * darken the colour when the cell was re-rendered.  However that would
- * mean we couldn't store other stuff in the name column.  Therefore,
- * repopulate the name column.
- *)
-let set_visited ({ model = model; name_col = name_col } as t) row =
-  let hdata = get_hdata t row in
-  if hdata.visited = false then (
-    hdata.visited <- true;
-    match hdata.content with
-    | Directory direntry | File direntry ->
-        debug "set_visited %s" direntry.Slave.dent_name;
-        model#set ~row ~column:name_col
-          (markup_of_name ~visited:true direntry)
-    | RegKey node ->
-        debug "set_visited RegKey";
-        let h = Option.get hdata.hiveh in
-        model#set ~row ~column:name_col
-          (markup_of_regkey ~visited:true h node)
-    | RegValue value ->
-        debug "set_visited RegValue";
-        let h = Option.get hdata.hiveh in
-        model#set ~row ~column:name_col
-          (markup_of_regvalue ~visited:true h value)
-    | Loading | ErrorMessage _ | Info _ | Top _ | TopWinReg _ -> ()
-  )