-and connect_dialog ds () =
- debug "connect menu";
- (*ds.clear_notebook ();*)
- (*Slave.discard_command_queue ();*)
- (* XXX NOT IMPL XXX *)
- ()
-
-(* Open the disk images dialog. *)
-and open_dialog ds () =
- debug "open menu";
- (*ds.clear_notebook ();*)
- (*Slave.discard_command_queue ();*)
- (* XXX NOT IMPL XXX *)
- ()
+and connect_uri_dialog ds () =
+ debug "connect_uri_dialog";
+ let title = "Choose a libvirt URI" in
+ let ok = "Connect to libvirt" in
+ let text = "NB: Remote storage cannot be accessed, so entering
+a libvirt remote URI here will probably not work." in
+ let uri = GToolbox.input_string ~title ~ok text in
+ match uri with
+ | None -> debug "connect_uri_dialog cancelled"; ()
+ | Some "" -> debug "connect to default"; connect ds None
+ | (Some s) as uri -> debug "connect to %s" s; connect ds uri
+
+(* Open the disk images dialog.
+ * XXX This can only deal with a single disk image at the moment, but
+ * underlying code can deal with multiple.
+ *)
+and open_image_dialog ds () =
+ let title = "Choose a disk image" in
+ let dlg = GWindow.file_chooser_dialog ~action:`OPEN ~title ~modal:true () in
+ dlg#add_button "Open disk image" `OPEN_IMAGE;
+ dlg#add_button "Close" `DELETE_EVENT;
+
+ let callback = function
+ | `DELETE_EVENT -> debug "DELETE_EVENT response"; dlg#destroy ()
+ | `OPEN_IMAGE ->
+ match dlg#filename with
+ | None -> () (* nothing selected in dialog, keep dialog open *)
+ | Some filename ->
+ debug "OPEN_IMAGE response, filename = %s" filename;
+ dlg#destroy ();
+ open_images ds [filename]
+ in
+ ignore (dlg#connect#response ~callback);
+
+ dlg#show ()