2 * Copyright (C) 2011 Red Hat Inc.
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.
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.
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.
21 let rec download_dir_tarball tree (format, path) =
22 let model = tree#model in
23 let row = model#get_iter path in
24 let src, pathname = tree#get_pathname row in
25 debug "download_dir_tarball %s: showing dialog" pathname;
27 (* Put up the dialog. *)
28 let title = "Download directory to tar file" in
29 let dlg = GWindow.file_chooser_dialog ~action:`SAVE ~title ~modal:true () in
30 dlg#add_button_stock `CANCEL `CANCEL;
31 dlg#add_select_button_stock `SAVE `SAVE;
33 let extension = match format with
34 | Slave_types.Tar -> ".tar"
35 | Slave_types.TGZ -> ".tar.gz"
36 | Slave_types.TXZ -> ".tar.xz"
38 dlg#set_current_name (basename pathname ^ extension);
41 | `DELETE_EVENT | `CANCEL ->
44 match dlg#filename with
49 (* Download the directory. *)
50 Slave.download_dir_tarball src pathname format localfile
51 (when_downloaded_dir_tarball tree path)
53 and when_downloaded_dir_tarball tree path () =
54 let model = tree#model in
55 let row = model#get_iter path in