+ (* Open a context menu when a button is pressed. *)
+ ignore (view#event#connect#button_press ~callback:(button_press t));
+
+ t
+
+(* 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 ({ model = model; view = view } as t) 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 (
+(*
+ (* 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
+*)
+ (* Select the row under the mouse. *)
+ let paths =
+ let sel = view#selection in
+ match view#get_path_at_pos ~x ~y with
+ | None -> []
+ | Some (path, _, _, _) ->
+ sel#unselect_all ();
+ sel#select_path path;
+ [path] in
+
+ (* Get the hdata for all the paths. Filter out rows that it doesn't
+ * make sense to select.
+ *)
+ let paths =
+ List.filter_map (
+ fun path ->
+ let row = model#get_iter path in
+ let hdata = get_hdata t row in
+ match hdata with
+ | _, (Loading | ErrorMessage _) -> None
+ | _, (Top _ | Directory _ | File _) -> Some (path, hdata)
+ ) paths in
+
+ (* Based on number of selected rows and what is selected, construct
+ * the context menu.
+ *)
+ if paths <> [] then (
+ let menu = make_context_menu t paths in
+ menu#popup ~button ~time
+ );
+
+ (* Return true so no other handler will run. *)
+ true
+ )
+ (* We didn't handle this, defer to other handlers. *)
+ else false
+
+and make_context_menu t paths =
+ let menu = GMenu.menu () in
+ let factory = new GMenu.factory menu in
+
+ let item = factory#add_item "Open" in
+ item#misc#set_sensitive false;
+
+ let rec add_file_items path =
+ let item = factory#add_item "File information" in
+ item#misc#set_sensitive false;
+ let item = factory#add_item "Checksum" in
+ item#misc#set_sensitive false;
+ ignore (factory#add_separator ());
+ let item = factory#add_item "Download ..." in
+ ignore (item#connect#activate ~callback:(download_file t path));
+
+ and add_directory_items path =
+ let item = factory#add_item "Directory information" in
+ item#misc#set_sensitive false;
+ let item = factory#add_item "Space used by directory" in
+ item#misc#set_sensitive false;
+ ignore (factory#add_separator ());
+ let item = factory#add_item "Download ..." in
+ item#misc#set_sensitive false;
+ let item = factory#add_item "Download as .tar ..." in
+ ignore (item#connect#activate
+ ~callback:(download_dir_tarball t Slave.Tar path));
+ let item = factory#add_item "Download as .tar.gz ..." in
+ ignore (item#connect#activate
+ ~callback:(download_dir_tarball t Slave.TGZ path));
+ let item = factory#add_item "Download as .tar.xz ..." in
+ ignore (item#connect#activate
+ ~callback:(download_dir_tarball t Slave.TXZ path));
+ let item = factory#add_item "Download list of filenames ..." in
+ ignore (item#connect#activate ~callback:(download_dir_find0 t path));
+
+ and add_os_items path =
+ let item = factory#add_item "Operating system information" in
+ item#misc#set_sensitive false;
+ let item = factory#add_item "Block device information" in
+ item#misc#set_sensitive false;
+ let item = factory#add_item "Filesystem used & free" in
+ item#misc#set_sensitive false;
+ ignore (factory#add_separator ());
+ add_directory_items path
+
+ and add_volume_items path =
+ let item = factory#add_item "Filesystem used & free" in
+ item#misc#set_sensitive false;
+ let item = factory#add_item "Block device information" in
+ item#misc#set_sensitive false;
+ ignore (factory#add_separator ());
+ add_directory_items path
+ in
+
+ (match paths with
+ (* single selection *)
+ | [path, (_, Top (Slave.OS os))] -> (* top level operating system *)
+ add_os_items path
+
+ | [path, (_, Top (Slave.Volume dev))] -> (* top level volume *)
+ add_volume_items path
+
+ | [path, (_, Directory direntry)] -> (* directory *)
+ add_directory_items path
+
+ | [path, (_, File direntry)] -> (* file *)
+ add_file_items path
+
+ | [_, (_, Loading)]
+ | [_, (_, ErrorMessage _)] -> ()
+
+ | _ ->
+ (* At the moment multiple selection is disabled. When/if we
+ * enable it we should do something intelligent here. XXX
+ *)
+ ()
+ );
+
+ menu