Version 0.1.2.

[guestfs-browser.git] / filetree_type.ml

diff --git a/filetree_type.ml b/filetree_type.ml
index 4b70b76..f39137e 100644 (file)
--- a/filetree_type.ml
+++ b/filetree_type.ml
@@ -17,7 +17,6 @@
  *)
 
 open Utils
-open Printf
 
 (* See struct/field description in .mli file. *)
 type t = {
@@ -35,6 +34,7 @@ and hdata = {
   mutable state : state_t;
   content : content_t;
   mutable visited : bool;
+  mutable hiveh : Hivex.t option;
 }
 
 and state_t =
@@ -48,8 +48,11 @@ and content_t =
   | ErrorMessage of string
   | Info of string
   | Top of Slave.source
+  | TopWinReg of Slave.source * string * string * string
   | Directory of Slave.direntry
   | File of Slave.direntry
+  | RegKey of Hivex.node
+  | RegValue of Hivex.value
 
 (* Store hdata into a row. *)
 let store_hdata {model = model; hash = hash; index_col = index_col} row hdata =
@@ -88,6 +91,8 @@ let find_child_node_by_content ({ model = model } as t) row c =
  *       \_ Directory
  *            \_ Directory
  *                 \_ Loading    <--- you are here
+ *
+ * Note this function cannot be called on registry keys.
  *)
 let rec get_pathname ({ model = model } as t) row =
   let hdata = get_hdata t row in
@@ -106,92 +111,11 @@ let rec get_pathname ({ model = model } as t) row =
         else parent_name ^ "/" ^ name in
       src, path
   | { content=Top src }, _ -> src, "/"
-  | { content=Directory _}, None -> assert false
-  | { content=File _}, None -> assert false
+  | { content=Directory _ }, None -> assert false
+  | { content=File _ }, None -> assert false
   | { content=Loading }, _ -> assert false
-  | { content=ErrorMessage _}, _ -> assert false
-  | { content=Info _}, _ -> assert false
-
-(* Base colours. XXX Should be configurable somewhere. *)
-let file_color = 0x20, 0x20, 0xff  (* regular file *)
-let dir_color = 0x80, 0x80, 0x20   (* directory *)
-let symlink_color = file_color     (* symlink *)
-let suid_color = 0x20, 0x20, 0x80  (* setuid bit set on regular file *)
-let suid_bgcolor = 0xff, 0xc0, 0xc0
-let sgid_color = suid_color        (* setgid bit set on regular file *)
-let sgid_bgcolor = suid_bgcolor
-let block_color = 0x00, 0x60, 0x60 (* block device *)
-let char_color = block_color       (* char device *)
-let fifo_color = 0x60, 0x00, 0x60  (* fifo *)
-let socket_color = fifo_color      (* socket *)
-let other_color = file_color       (* anything not one of the above *)
-
-(* Mark up a filename for the name_col column.
- * 
- * XXX This shouldn't be in Filetree_type module, but we have to have
- * it here because set_visited is here.
- * 
- * See also
- * 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
-  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 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>"
-      fg (markup_escape name) utf8_rarrow fg (markup_escape link)
-  )
-  else (                                (* not directory, not symlink *)
-    let fg, bg =
-      if is_regular_file mode then (
-        if is_suid mode then suid_color, Some suid_bgcolor
-        else if is_sgid mode then sgid_color, Some sgid_bgcolor
-        else file_color, None
-      )
-      else if is_block mode then block_color, None
-      else if is_char mode then char_color, None
-      else if is_fifo mode then fifo_color, None
-      else if is_socket mode then socket_color, None
-      else other_color, None in
-    let fg = if not visited then normal fg else darken fg in
-    let bg =
-      match bg with
-      | Some bg -> sprintf " bgcolor=\"%s\"" (normal bg)
-      | None -> "" in
-    sprintf "<span fgcolor=\"%s\"%s>%s</span>"
-      fg bg (markup_escape name)
-  )
-
-and normal (r, g, b) =
-  let r = if r < 0 then 0 else if r > 255 then 255 else r in
-  let g = if g < 0 then 0 else if g > 255 then 255 else g in
-  let b = if b < 0 then 0 else if b > 255 then 255 else b in
-  sprintf "#%02x%02x%02x" r g b
-
-and darken (r, g, b) =
-  normal (r * 4 / 10, g * 4 / 10, b * 4 / 10)
-
-(* 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)
-    | Loading | ErrorMessage _ | Info _ | Top _ -> ()
-  )
+  | { content=ErrorMessage _ }, _ -> assert false
+  | { content=Info _ }, _ -> assert false
+  | { content=TopWinReg _ }, _ -> assert false
+  | { content=RegKey _ }, _ -> assert false
+  | { content=RegValue _ }, _ -> assert false