filetree_type.ml

   1 (* Guestfs Browser.
   2  * Copyright (C) 2010 Red Hat Inc.
   3  *
   4  * This program is free software; you can redistribute it and/or modify
   5  * it under the terms of the GNU General Public License as published by
   6  * the Free Software Foundation; either version 2 of the License, or
   7  * (at your option) any later version.
   8  *
   9  * This program is distributed in the hope that it will be useful,
  10  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  11  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12  * GNU General Public License for more details.
  13  *
  14  * You should have received a copy of the GNU General Public License along
  15  * with this program; if not, write to the Free Software Foundation, Inc.,
  16  * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  17  *)
  18
  19 open Utils
  20
  21 type t = {
  22   view : GTree.view;
  23   model : GTree.tree_store;
  24   hash : (int, hdata) Hashtbl.t;    (* hash from index_col -> hdata *)
  25   index_col : int GTree.column;
  26   mode_col : string GTree.column;
  27   name_col : string GTree.column;
  28   size_col : int64 GTree.column;
  29   date_col : string GTree.column;
  30   link_col : string GTree.column;
  31 }
  32
  33 and hdata = state_t * content_t
  34
  35 (* The type of the hidden column used to implement on-demand loading.
  36  * All rows are classified as either nodes or leafs (eg. a "node" might
  37  * be a directory, or a top-level operating system, or anything else
  38  * which the user could open and look inside).
  39  *)
  40 and state_t =
  41   | IsLeaf           (* there are no children *)
  42   | NodeNotStarted   (* user has not tried to open this *)
  43   | NodeLoading      (* user tried to open it, still loading *)
  44   | IsNode           (* we've loaded the children of this directory *)
  45
  46 (* The actual content of a row. *)
  47 and content_t =
  48   | Loading                          (* special "loading ..." node *)
  49   | ErrorMessage of string           (* error message node *)
  50   | Info of string                   (* information node (eg. disk usage) *)
  51   | Top of Slave.source              (* top level OS or volume node *)
  52   | Directory of Slave.direntry      (* a directory *)
  53   | File of Slave.direntry           (* a file inc. special files *)
  54
  55 (* Store hdata into a row. *)
  56 let store_hdata {model = model; hash = hash; index_col = index_col} row hdata =
  57   let index = unique () in
  58   Hashtbl.add hash index hdata;
  59   model#set ~row ~column:index_col index
  60
  61 (* Retrieve previously stored hdata from a row. *)
  62 let get_hdata { model = model; hash = hash; index_col = index_col } row =
  63   let index = model#get ~row ~column:index_col in
  64   try Hashtbl.find hash index
  65   with Not_found -> assert false
  66
  67 (* Iterate over children of node, looking for matching hdata. *)
  68 let find_child_node_by_hdata ({ model = model } as t) row hdata =
  69   let rec loop row =
  70     if hdata = get_hdata t row then
  71       row
  72     else if model#iter_next row then
  73       loop row
  74     else
  75       raise Not_found
  76   in
  77
  78   if not (model#iter_has_child row) then
  79     raise Not_found;
  80
  81   let first_child = model#iter_children (Some row) in
  82   loop first_child
  83
  84 (* Search up to the top of the tree so we know if this directory
  85  * comes from an OS or a volume, and the full path to here.
  86  *
  87  * The path up the tree will always look something like:
  88  *     Top
  89  *       \_ Directory
  90  *            \_ Directory
  91  *                 \_ Loading    <--- you are here
  92  *)
  93 let rec get_pathname ({ model = model } as t) row =
  94   let hdata = get_hdata t row in
  95   let parent = model#iter_parent row in
  96
  97   match hdata, parent with
  98   | (IsLeaf, (Loading|ErrorMessage _|Info _)), Some parent ->
  99       get_pathname t parent
 100   | (IsLeaf, (Loading|ErrorMessage _|Info _)), None ->
 101       assert false
 102   | (_, Directory { Slave.dent_name = name }), Some parent
 103   | (_, File { Slave.dent_name = name }), Some parent ->
 104       let src, parent_name = get_pathname t parent in
 105       let path =
 106         if parent_name = "/" then "/" ^ name
 107         else parent_name ^ "/" ^ name in
 108       src, path
 109   | (_, Top src), _ -> src, "/"
 110   | (_, Directory _), None -> assert false
 111   | (_, File _), None -> assert false
 112   | (_, Loading), _ -> assert false
 113   | (_, ErrorMessage _), _ -> assert false
 114   | (_, Info _), _ -> assert false