X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;f=filetree.ml;fp=filetree.ml;h=0737820c4011ed9b640d01542e09888b95d03b3d;hb=b9e8c84588873568b7fdfaeb9beb85466e84c8fa;hp=797c3df17288ce349fb164f8d13d86b221d947f4;hpb=eb6af058b088b3230b021cb2064b699c9bc30735;p=guestfs-browser.git

diff --git a/filetree.ml b/filetree.ml
index 797c3df..0737820 100644
--- a/filetree.ml
+++ b/filetree.ml
@@ -16,45 +16,67 @@
  * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  *)
 
-open ExtList
 open ExtString
 open Printf
 
 open Utils
+open DeviceSet
 
 module G = Guestfs
 
+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;
+}
+
+and hdata = state_t * content_t
+
 (* The type of the hidden column used to implement on-demand loading.
- * We are going to store these in the model as simple ints because that
- * is easier on the GC.  Don't change these numbers!
+ * 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).
  *)
-let isFile = 0           (* it's not a directory, there are no children *)
-let dirNotStarted = 1    (* user has not tried to open this *)
-let dirLoading = 2       (* user tried to open it, still loading *)
-let isDir = 3            (* we've loaded the children of this directory *)
-let loading = 4          (* this row contains the "Loading ..." message *)
-
-let rec filetree dev rw =
-  let view = GTree.view () in
+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 *)
+  | Loading          (* special row contains the "Loading ..." message *)
+
+(* The actual content of a row. *)
+and content_t =
+  | NoContent
+  | 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 *)
+
+let loading_msg = "<i>Loading ...</i>"
+
+let create ~packing () =
+  let view = GTree.view ~packing () in
   (*view#set_rules_hint true;*)
   view#selection#set_mode `MULTIPLE;
 
-  (* Hash of index numbers -> other data.  We do this because it's
-   * more efficient for the GC compared to storing OCaml objects
-   * directly in the rows.
+  (* Hash of index numbers -> hdata.  We do this because it's more
+   * efficient for the GC compared to storing OCaml objects directly in
+   * the rows.
    *)
   let hash = Hashtbl.create 1023 in
 
-  (* The columns stored in each row.  The hidden [state_col] column
-   * stores the current state of the row, and is used to implement
-   * on-demand loading.  The hidden [index_col] column is an index into
-   * the hash table that records everything else about this row
-   * (filename, file stat, etc).  The other display columns, eg.
+  (* The columns stored in each row.  The hidden [index_col] column is
+   * an index into the hash table that records everything else about
+   * this row (see hdata above).  The other display columns, eg.
    * [name_col] contain Pango markup and thus have to be escaped.
    *)
   let cols = new GTree.column_list in
   (* Hidden: *)
-  let state_col = cols#add Gobject.Data.int in
   let index_col = cols#add Gobject.Data.int in
   (* Displayed: *)
   let mode_col = cols#add Gobject.Data.string in
@@ -63,6 +85,7 @@ let rec filetree dev rw =
   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
   view#set_model (Some (model :> GTree.model));
 
@@ -72,6 +95,7 @@ let rec filetree dev rw =
 
   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 400 (*pixels?!?*);
   ignore (view#append_column name_view);
 
   let renderer = GTree.cell_renderer_text [], ["text", size_col] in
@@ -86,148 +110,17 @@ let rec filetree dev rw =
   let link_view = GTree.view_column ~title:"Link" ~renderer () in
   ignore (view#append_column link_view);
 
-  let tree =
-    model, view, hash, dev, rw,
-    (state_col, index_col, mode_col, name_col, size_col, date_col,
-     link_col) in
-
-  (* Create the root directory entry, then expand it which will force
-   * it to be loaded (asynchronously).
-   * XXX Should stat "/"
-   *)
-  let root = model#append () in
-  add_directory_row tree root "/" None;
-  view#expand_row (model#get_path root);
-
-  ignore (view#event#connect#button_press ~callback:(button_press tree));
-  (*ignore (view#event#connect#popup_menu ~callback);*)
-
-  view
-
-(* Add an "embryonic" directory to the tree store.  This contains a
- * dummy entry (as explained
- * http://mail.gnome.org/archives/gtk-app-devel-list/2003-May/msg00241.html)
- * and when the user opens it, it triggers the real directory to be
- * read.
- *)
-and add_directory_row tree row filename direntry =
-  let model, view, hash, _, _,
-    (state_col, index_col, mode_col, name_col, size_col, date_col,
-     link_col)
-    = tree in
-
-  model#set ~row ~column:state_col dirNotStarted;
-  model#set ~row ~column:index_col (-1);
-  model#set ~row ~column:name_col (markup_of_name filename);
-  (match direntry with
-   | None -> ()
-   | Some direntry ->
-       let index = unique () in
-       Hashtbl.add hash index direntry;
-       model#set ~row ~column:index_col index;
-       let stat = direntry.Slave.dent_stat in
-       model#set ~row ~column:mode_col (markup_of_mode stat.G.mode);
-       model#set ~row ~column:size_col stat.G.size;
-       model#set ~row ~column:date_col (markup_of_date stat.G.mtime));
-
-  let placeholder = model#append ~parent:row () in
-  model#set ~row:placeholder ~column:state_col loading;
-  model#set ~row:placeholder ~column:index_col (-1);
-  model#set ~row:placeholder ~column:name_col "<i>Loading ...</i>";
-  ignore (view#connect#row_expanded ~callback:(expand_row tree))
-
-(* This is called when the user expands the [directory] row. *)
-and expand_row tree row _ =
-  let model, _, _, dev, _, (state_col, _, _, _, _, _, _) = tree in
-
-  match model#get ~row ~column:state_col with
-  | 1 (* dirNotStarted *) -> (* Kick off a directory read. *)
-      (* Get a stable path for this row so we can use it inside
-       * the callback, which may happen a lot later.
-       *)
-      let path = model#get_path row in
-
-      (* Now invoke libguestfs in the slave thread. *)
-      Slave.read_directory
-        dev (get_pathname tree row) (read_directory_cb tree path);
-
-      (* Mark this row as now loading, so we don't start another
-       * directory read if the user expands it again.
-       *)
-      model#set ~row ~column:state_col dirLoading
-
-  | 0 (* isFile *) | 2 (* dirLoading *) | 3 (* isDir *) -> ()
-  | 4 (* loading *) -> assert false
-  | _ -> assert false
-
-and read_directory_cb tree path entries =
-  let model, _, hash, _, _,
-    (state_col, index_col, mode_col, name_col, size_col, date_col,
-     link_col)
-    = tree in
-
-  let row = model#get_iter path in
-
-  (* Add the entries. *)
-  List.iter (
-    fun direntry ->
-      let { Slave.dent_name = name; dent_stat = stat; dent_link = link } =
-        direntry in
-      let row = model#append ~parent:row () in
-      if is_directory stat.G.mode then
-        add_directory_row tree row name (Some direntry)
-      else (
-        let index = unique () in
-        Hashtbl.add hash index direntry;
-        model#set ~row ~column:state_col isFile;
-        model#set ~row ~column:index_col index;
-        model#set ~row ~column:name_col (markup_of_name name);
-        model#set ~row ~column:mode_col (markup_of_mode stat.G.mode);
-        model#set ~row ~column:size_col stat.G.size;
-        model#set ~row ~column:date_col (markup_of_date stat.G.mtime);
-        model#set ~row ~column:link_col (markup_of_link link)
-      )
-  ) entries;
-
-  (* Remove the placeholder entry.  NB. Must be done AFTER adding
-   * the other entries, or else Gtk will unexpand the row.
-   *)
-  (try
-     let placeholder = model#iter_children ~nth:0 (Some row) in
-     ignore (model#remove placeholder)
-   with Invalid_argument _ -> ());
+  { 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 }
 
-  (* The original directory entry has now been loaded, so
-   * update its state.
-   *)
-  model#set ~row ~column:state_col isDir
-
-(* Get the actual full pathname of a row. *)
-and get_pathname tree row =
-  let model, _, _, _, _, _ = tree in
-
-  match model#iter_parent row with
-  | None -> "/"
-  | Some parent ->
-      match get_direntry_of_row tree row with
-      | Some { Slave.dent_name = name } ->
-          let pname = get_pathname tree parent in
-          if pname = "/" then "/" ^ name else pname ^ "/" ^ name
-      | None ->
-          assert false
-
-(* Get the directory entry from a row (contains the stat(2) results etc).
- * Some rows don't have the required information (eg. placeholder rows
- * and currently the root directory) and for them we return [None].
- *)
-and get_direntry_of_row tree row =
-  let model, _, hash, _, _, (_, index_col, _, _, _, _, _) = tree in
-  let index = model#get ~row ~column:index_col in
-  try Some (Hashtbl.find hash index)
-  with Not_found -> None
+let clear { model = model; hash = hash } =
+  model#clear ();
+  Hashtbl.clear hash
 
 (* XXX No binding for g_markup_escape in lablgtk2. *)
-and markup_escape name =
+let markup_escape name =
   let f = function
     | '&' -> "&amp;" | '<' -> "&lt;" | '>' -> "&gt;"
     | c -> String.make 1 c
@@ -235,10 +128,8 @@ and markup_escape name =
   String.replace_chars f name
 
 (* Mark up a filename for the name_col column. *)
-and markup_of_name name =
-  (* First, protect against any markup in the name. *)
-  let name = markup_escape name in
-  name
+let rec markup_of_name name =
+  markup_escape name
 
 (* Mark up symbolic links. *)
 and markup_of_link link =
@@ -296,249 +187,177 @@ and markup_of_date time =
     (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
 
-(* Handle mouse button press on the selected row.  This opens the
- * pop-up context menu.
- * http://scentric.net/tutorial/sec-selections-context-menus.html
- *)
-and button_press tree ev =
-  let button = GdkEvent.Button.button ev in
-  let x = int_of_float (GdkEvent.Button.x ev) in
-  let y = int_of_float (GdkEvent.Button.y ev) in
-  let time = GdkEvent.Button.time ev in
-
-  (* Right button for opening the context menu. *)
-  if button = 3 then (
-    let model, view, hash, _, _, (_, index_col, _, _, _, _, _) = tree in
-
-    (* If no row is selected, select the row under the mouse. *)
-    let paths =
-      let sel = view#selection in
-      if sel#count_selected_rows < 1 then (
-        match view#get_path_at_pos ~x ~y with
-        | None -> []
-        | Some (path, _, _, _) ->
-            sel#unselect_all ();
-            sel#select_path path;
-            [path]
-      ) else
-        sel#get_selected_rows (* actually returns paths *) in
-
-    (* Ignore paths that don't contain index fields, and get the
-     * direntry for the others.  Currently this causes the root
-     * directory to be ignored because we don't have stat information
-     * for it (XXX).
-     *)
-    let paths =
-      List.filter_map (
-        fun path ->
-          let row = model#get_iter path in
-          match get_direntry_of_row tree row with
-          | None -> None
-          | Some direntry -> Some (path, direntry)
-      ) paths in
-
-    (* Choose the menu and menu options according to the number of
-     * selected rows and what is selected.
-     *)
-    let menu =
-      try
-        (match paths with
-         | [] -> None
-         | [path, direntry] ->          (* Single selection. *)
-             (* What object is selected? *)
-             let stat = direntry.Slave.dent_stat in
-             let mode = stat.G.mode in
-             if is_directory mode then
-               Some (make_context_menu tree ~dir:true ~file:false paths)
-             else if is_regular_file mode then
-               Some (make_context_menu tree ~dir:false ~file:true paths)
-             else (* not directory, not regular file *)
-               Some (make_context_menu tree ~dir:false ~file:false paths)
-         | paths ->                        (* Multiple selection. *)
-             let dir = List.for_all (
-               fun (_, { Slave.dent_stat = stat }) ->
-                 is_directory stat.G.mode
-             ) paths in
-             let file = List.for_all (
-               fun (_, { Slave.dent_stat = stat }) ->
-                 is_regular_file stat.G.mode
-             ) paths in
-             Some (make_context_menu tree ~dir ~file paths)
-        )
-      with Not_found -> None
-    in
-    (match menu with
-     | None -> ()
-     | Some menu ->
-         menu#popup ~button ~time;
-    );
-
-    (* Return true so no other handler will run. *)
-    true
-  ) else
-    (* Defer to other handlers. *)
-    false
-
-(* Make a context menu for file(s) and directory(s).  ~file is true is
- * they are all regular files, ~dir is true if they are all
- * directories.  If neither is set, then it can be a single selection
- * of a non-file non-directory, or it can be a mixed multiple
- * selection.
- *)
-and make_context_menu tree ~dir ~file paths =
-  let _, _, _, _, rw, _ = tree in
-  let n = List.length paths in
-  assert (n > 0);                      (* calling code ensures this *)
-  let path0 = List.hd paths in
-
-  let menu = GMenu.menu () in
-  let factory = new GMenu.factory menu in
-
-  (* Open appears first, and unconditionally.  This is just to catch
-   * the case where nothing below matches, and we want to display
-   * _something_.  Open is not necessarily useful ...
+(* 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
+
+let rec add ({ model = model; hash = hash } as t) name data =
+  clear t;
+
+  (* Populate the top level of the filetree.  If there are operating
+   * systems from inspection, these have their own top level entries
+   * followed by only unreferenced filesystems.  If we didn't get
+   * anything from inspection, then at the top level we just show
+   * filesystems.
    *)
-  ignore (factory#add_item "Open");
-  ignore (factory#add_separator ());
-
-  if dir && n = 1 then (
-    let item = factory#add_item "Disk _usage ..." in
-    ignore (item#connect#activate ~callback:(disk_usage_dialog tree path0));
-    let item = factory#add_item "_Export as an archive (tar etc) ..." in
-    ignore (item#connect#activate ~callback:(export_archive_dialog tree path0));
-    let item = factory#add_item "Export _checksums ..." in
-    ignore (item#connect#activate
-              ~callback:(export_checksums_dialog tree path0));
-    let item = factory#add_item "Export as a _list of files ..." in
-    ignore (item#connect#activate ~callback:(export_list_dialog tree path0));
-  );
+  let other_filesystems =
+    DeviceSet.of_list (List.map fst data.Slave.insp_all_filesystems) in
+  let other_filesystems =
+    List.fold_left (fun set { Slave.insp_filesystems = fses } ->
+                      DeviceSet.subtract set (DeviceSet.of_array fses))
+      other_filesystems data.Slave.insp_oses in
+
+  (* Add top level operating systems. *)
+  List.iter (add_top_level_os t name) data.Slave.insp_oses;
+
+  (* Add top level left-over filesystems. *)
+  DeviceSet.iter (add_top_level_vol t name) other_filesystems
+
+and add_top_level_os ({ model = model; hash = hash } as t) name os =
+  let markup =
+    sprintf "<b>%s</b>: %s (%s)"
+      (markup_of_name name) (markup_of_name os.Slave.insp_hostname)
+      (markup_of_name os.Slave.insp_product_name) in
+
+  let row = model#append () in
+  make_node t row (Top (Slave.OS os));
+  model#set ~row ~column:t.name_col markup
+
+and add_top_level_vol ({ model = model; hash = hash } as t) name dev =
+  let markup =
+    sprintf "<b>%s</b>: %s" (markup_of_name name) (markup_of_name dev) in
+
+  let row = model#append () in
+  make_node t row (Top (Slave.Volume dev));
+  model#set ~row ~column:t.name_col markup
+
+(* 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
+  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 = Loading, NoContent in
+  store_hdata t placeholder hdata;
+  model#set ~row:placeholder ~column:t.name_col loading_msg;
+  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
+  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 ->
+      (* 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;
+
+      (* Get a stable path for this row. *)
+      let path = model#get_path row in
 
-  if file then
-    ignore (factory#add_item "Determine file type ...");
+      Slave.read_directory src "/" (when_read_directory t path)
 
-  if n = 1 then
-    ignore (factory#add_item "View permissions ...");
+  | NodeNotStarted, Directory direntry ->
+      (* User has opened a filesystem directory not previously opened. *)
 
-  (* Write operations go below the separator. *)
-  (match rw with
-   | Slave.RO -> ()
-   | Slave.RW ->
-       ignore (factory#add_separator ());
+      (* Mark this row as loading. *)
+      let hdata = NodeLoading, Directory direntry in
+      store_hdata t row hdata;
 
-       if dir && n = 1 then (
-         ignore (factory#add_item "New file ...");
-         ignore (factory#add_item "New subdirectory ...");
-         ignore (factory#add_item "Import an archive here ...");
-       );
+      (* Get a stable path for this row. *)
+      let path = model#get_path row in
 
-       if file then (
-         ignore (factory#add_item "Touch file");
-         ignore (factory#add_item "Edit file");
-       );
+      let src, pathname = get_pathname t row in
 
-       if n = 1 then
-         ignore (factory#add_item "Edit permissions ...");
+      Slave.read_directory src pathname (when_read_directory t path)
 
-       ignore (factory#add_item "Delete")
-  );
+  | NodeLoading, _ | IsNode, _ -> ()
+
+  (* These are not nodes so it should never be possible to open them. *)
+  | _, File _ | IsLeaf, _ | Loading, _ -> assert false
+
+  (* Should not exist in the tree. *)
+  | NodeNotStarted, NoContent -> 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
+ *)
+and 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
+  | (Loading, NoContent), Some parent ->
+      get_pathname t parent
+  | (Loading, NoContent), 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 | (_, File _), None -> assert false
+  | (_, NoContent), _ -> 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 =
+  debug "when_read_directory";
 
-  menu
+  let row = model#get_iter path in
 
-(* The disk usage dialog. *)
-and disk_usage_dialog tree path0 () =
-  let model, _, _, dev, _,_ = tree in
-  let row = model#get_iter (fst path0) in
-  let dir = get_pathname tree row in
+  (* Add the entries. *)
+  List.iter (
+    fun direntry ->
+      let { Slave.dent_name = name; dent_stat = stat; dent_link = link } =
+        direntry in
+      let row = model#append ~parent:row () in
+      if is_directory stat.G.mode then
+        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.mode_col (markup_of_mode stat.G.mode);
+      model#set ~row ~column:t.size_col 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;
 
-  (* We can't use GWindow.message_dialog since lablgtk2 doesn't expose
-   * the label field.  It wouldn't help very much anyway.
+  (* Remove the placeholder entry.  NB. Must be done AFTER adding
+   * the other entries, or else Gtk will unexpand the row.
    *)
-  let title = "Calculating disk usage ..." in
-  let dlg = GWindow.dialog ~title ~modal:true () in
-  let text =
-    sprintf "Calculating disk usage of %s ...  This may take a moment." dir in
-  let label = GMisc.label ~text ~packing:dlg#vbox#pack () in
-  dlg#add_button "Stop" `STOP;
-  dlg#add_button "Close" `DELETE_EVENT;
-  let close_button, stop_button =
-    match dlg#action_area#children with
-    | c::s::_ -> c, s
-    | _ -> assert false in
-  close_button#misc#set_sensitive false;
-
-  let callback = function
-    | `STOP -> debug "STOP response" (* XXX NOT IMPL XXX *)
-    | `DELETE_EVENT -> debug "DELETE_EVENT response"; dlg#destroy ()
-  in
-  ignore (dlg#connect#response ~callback);
-
-  Slave.disk_usage dev dir (
-    fun kbytes -> (* Called when operation has finished. *)
-      dlg#set_title "Disk usage";
-      label#set_text (sprintf "Disk usage of %s: %Ld KB" dir kbytes);
-      close_button#misc#set_sensitive true;
-      stop_button#misc#set_sensitive false
+  (try
+     let placeholder = model#iter_children ~nth:0 (Some row) in
+     ignore (model#remove placeholder)
+   with Invalid_argument _ -> ()
   );
 
-  (* NB. We cannot use dlg#run.  See:
-   * http://www.math.nagoya-u.ac.jp/~garrigue/soft/olabl/lablgtk-list/600.txt
-   * Therefore this function just exits back to the ordinary main loop.
+  (* The original directory entry has now been loaded, so
+   * update its state.
    *)
-  dlg#show ()
-
-and export_archive_dialog tree path0 () =
-  (* XXX NOT IMPL XXX *)
-(*  let model, _, _, dev, _,_ = tree in
-  let row = model#get_iter (fst path0) in
-  let dir = get_pathname tree row in*)
-
-  let title = "Choose output file" in
-  let dlg = GWindow.file_chooser_dialog ~action:`SAVE ~title ~modal:true () in
-
-  (* Allow the user to select the output format. *)
-  let strings = ["tar.gz (compressed)"; "tar (uncompressed)"] in
-  let combo, _ = GEdit.combo_box_text ~strings ~active:0 () in
-  dlg#set_extra_widget (combo :> GObj.widget);
-
-  dlg#show ()
-
-and export_checksums_dialog tree path0 () =
-  (* XXX NOT IMPL XXX *)
-(*  let model, _, _, dev, _,_ = tree in
-  let row = model#get_iter (fst path0) in
-  let dir = get_pathname tree row in*)
-
-  let title = "Choose output file" in
-  let dlg = GWindow.file_chooser_dialog ~action:`SAVE ~title ~modal:true () in
-
-  (* Allow the user to select the output algorithm. *)
-  let strings =
-    ["crc"; "md5"; "sha1"; "sha224"; "sha256"; "sha384"; "sha512"] in
-  let combo, _ = GEdit.combo_box_text ~strings ~active:1 () in
-  dlg#set_extra_widget (combo :> GObj.widget);
-
-  dlg#show ()
-
-and export_list_dialog tree path0 () =
-  (* XXX NOT IMPL XXX *)
-(*  let model, _, _, dev, _,_ = tree in
-  let row = model#get_iter (fst path0) in
-  let dir = get_pathname tree row in*)
-
-  let title = "Choose output file" in
-  let dlg = GWindow.file_chooser_dialog ~action:`SAVE ~title ~modal:true () in
-
-  (* Notify that the list of strings is \0 separated. *)
-  let hbox =
-    let hbox = GPack.hbox () in
-    ignore (GMisc.image ~stock:`INFO ~packing:hbox#pack ());
-    let label = GMisc.label ~text:"The list of filenames is saved to a file with zero byte separators, to allow the full range of characters to be used in the names themselves." ~packing:hbox#pack () in
-    label#set_line_wrap true;
-    hbox in
-  dlg#set_extra_widget (hbox :> GObj.widget);
-
-  dlg#show ()
-
-and do_export_dialog tree path0 t =
-  (* XXX NOT IMPL XXX *)
-  ()
+  let state, content = get_hdata t row in
+  let hdata = IsNode, content in
+  store_hdata t row hdata