Daily check-in.

[guestfs-browser.git] / filetree_type.ml

diff --git a/filetree_type.ml b/filetree_type.ml
new file mode 100644 (file)
index 0000000..9c80e97
--- /dev/null
+++ b/filetree_type.ml
@@ -0,0 +1,102 @@
+(* Guestfs Browser.
+ * Copyright (C) 2010 Red Hat Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License along
+ * with this program; if not, write to the Free Software Foundation, Inc.,
+ * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ *)
+
+open Utils
+
+type t = {
+  view : GTree.view;
+  model : GTree.tree_store;
+  hash : (int, hdata) Hashtbl.t;    (* hash from index_col -> hdata *)
+  index_col : int GTree.column;
+  mode_col : string GTree.column;
+  name_col : string GTree.column;
+  size_col : int64 GTree.column;
+  date_col : string GTree.column;
+  link_col : string GTree.column;
+  mutable status : (string -> unit) option;
+}
+
+and hdata = state_t * content_t
+
+(* The type of the hidden column used to implement on-demand loading.
+ * All rows are classified as either nodes or leafs (eg. a "node" might
+ * be a directory, or a top-level operating system, or anything else
+ * which the user could open and look inside).
+ *)
+and state_t =
+  | IsLeaf           (* there are no children *)
+  | NodeNotStarted   (* user has not tried to open this *)
+  | NodeLoading      (* user tried to open it, still loading *)
+  | IsNode           (* we've loaded the children of this directory *)
+
+(* The actual content of a row. *)
+and content_t =
+  | Loading                          (* special "loading ..." node *)
+  | ErrorMessage of string           (* error message node *)
+  | Top of Slave.source              (* top level OS or volume node *)
+  | Directory of Slave.direntry      (* a directory *)
+  | File of Slave.direntry           (* a file inc. special files *)
+
+(* Store hdata into a row. *)
+let store_hdata {model = model; hash = hash; index_col = index_col} row hdata =
+  let index = unique () in
+  Hashtbl.add hash index hdata;
+  model#set ~row ~column:index_col index
+
+(* Retrieve previously stored hdata from a row. *)
+let get_hdata { model = model; hash = hash; index_col = index_col } row =
+  let index = model#get ~row ~column:index_col in
+  try Hashtbl.find hash index
+  with Not_found -> assert false
+
+(* Search up to the top of the tree so we know if this directory
+ * comes from an OS or a volume, and the full path to here.
+ *
+ * The path up the tree will always look something like:
+ *     Top
+ *       \_ Directory
+ *            \_ Directory
+ *                 \_ Loading    <--- you are here
+ *)
+let rec get_pathname ({ model = model } as t) row =
+  let hdata = get_hdata t row in
+  let parent = model#iter_parent row in
+
+  match hdata, parent with
+  | (IsLeaf, Loading), Some parent ->
+      get_pathname t parent
+  | (IsLeaf, Loading), None ->
+      assert false
+  | (_, Directory { Slave.dent_name = name }), Some parent
+  | (_, File { Slave.dent_name = name }), Some parent ->
+      let src, parent_name = get_pathname t parent in
+      let path =
+        if parent_name = "/" then "/" ^ name
+        else parent_name ^ "/" ^ name in
+      src, path
+  | (_, Top src), _ -> src, "/"
+  | (_, Directory _), None -> assert false
+  | (_, File _), None -> assert false
+  | (_, Loading), _ -> assert false
+  | (_, ErrorMessage _), _ -> assert false
+
+(* Update the status bar. *)
+let update_status { status = f } msg =
+  match f with
+  | None -> () (* user didn't give us a [status] function to call *)
+  | Some f -> f msg