ws.statusbar_context#pop ();
ignore (ws.statusbar_context#push msg)
-let clear_statusbar ws = set_statusbar ws ""
-
(* Clear the filetree. *)
let clear_view ws =
Filetree.clear ws.view
(* Callback from Connect -> ... menu items. *)
let rec connect_to ws uri =
- (match uri with
- | None -> set_statusbar ws "Connecting to default libvirt ..."
- | Some uri -> set_statusbar ws (sprintf "Connecting to %s ..." uri)
- );
clear_view ws;
Slave.discard_command_queue ();
Slave.connect uri (when_connected ws uri)
(* Called back when connected to a new hypervisor. *)
and when_connected ws uri doms =
- (match uri with
- | None -> set_statusbar ws "Connected to default libvirt"
- | Some uri -> set_statusbar ws (sprintf "Connected to %s" uri)
- );
populate_vmcombo ws doms
and populate_vmcombo ws doms =
(* When a new domain is selected by the user, eg through vmcombo. *)
let rec open_domain ws name =
- set_statusbar ws (sprintf "Opening %s ..." name);
clear_view ws;
Slave.discard_command_queue ();
Slave.open_domain name (when_opened_domain ws name)
(* Called back when domain was opened successfully. *)
and when_opened_domain ws name data =
debug "when_opened_domain callback";
- set_statusbar ws (sprintf "Opened %s" name);
when_opened_common ws name data
(* When a set of disk images is selected by the user. *)
match images with
| [] -> ()
| images ->
- set_statusbar ws "Opening disks ...";
clear_view ws;
Slave.discard_command_queue ();
Slave.open_images images (when_opened_disk_images ws images)
| [] -> ()
| (image, _) :: _ ->
debug "when_opened_disk_images callback";
- set_statusbar ws "Opened disk";
when_opened_common ws image data
(* Common code for when_opened_domain/when_opened_disk_images. *)
)
);
- Filetree.set_status_fn view (set_statusbar ws);
-
(* Return the window_state struct. *)
ws