X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;f=filetree.ml;h=797c3df17288ce349fb164f8d13d86b221d947f4;hb=b1f139b00447a99e84b6801154371ba7cc094ede;hp=1969cc76939db8fd76a99269754a4e407193f9bb;hpb=b07102fda0034da5840a9f33bd6d404a195b8cc9;p=guestfs-browser.git

diff --git a/filetree.ml b/filetree.ml
index 1969cc7..797c3df 100644
--- a/filetree.ml
+++ b/filetree.ml
@@ -24,8 +24,6 @@ open Utils
 
 module G = Guestfs
 
-let unique = let i = ref 0 in fun () -> incr i; !i
-
 (* 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!
@@ -390,8 +388,8 @@ and button_press tree ev =
 and make_context_menu tree ~dir ~file paths =
   let _, _, _, _, rw, _ = tree in
   let n = List.length paths in
-
-  debug "make_context_menu dir %b file %b n %d" dir file n;
+  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
@@ -404,10 +402,15 @@ and make_context_menu tree ~dir ~file paths =
   ignore (factory#add_separator ());
 
   if dir && n = 1 then (
-    ignore (factory#add_item "Disk usage ...");
-    ignore (factory#add_item "Export as an archive (tar etc) ...");
-    ignore (factory#add_item "Export checksums ...");
-    ignore (factory#add_item "Export as a list of files ...");
+    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));
   );
 
   if file then
@@ -440,3 +443,102 @@ and make_context_menu tree ~dir ~file paths =
   );
 
   menu
+
+(* 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
+
+  (* We can't use GWindow.message_dialog since lablgtk2 doesn't expose
+   * the label field.  It wouldn't help very much anyway.
+   *)
+  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
+  );
+
+  (* 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.
+   *)
+  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 *)
+  ()