diff options
| -rw-r--r-- | README | 1 | ||||
| -rw-r--r-- | virt-ctrl/.depend | 10 | ||||
| -rw-r--r-- | virt-ctrl/Makefile.in | 1 | ||||
| -rw-r--r-- | virt-ctrl/vc_connection_dlg.ml | 29 | ||||
| -rw-r--r-- | virt-ctrl/vc_connection_dlg.mli | 23 | ||||
| -rw-r--r-- | virt-ctrl/vc_mainwindow.ml | 17 |
6 files changed, 64 insertions, 17 deletions
@@ -58,6 +58,7 @@ the packages below if you want to build from source. lablgtk2 | | | | R | O | | | | | ocaml-dbus | | | | O | + | | | | >= 0.04 | --------------+----------+---------+---------+----------+--------- NSIS | | | | | O --------------+----------+---------+---------+----------+--------- diff --git a/virt-ctrl/.depend b/virt-ctrl/.depend index fbef2c5..83e8f30 100644 --- a/virt-ctrl/.depend +++ b/virt-ctrl/.depend @@ -2,6 +2,8 @@ vc_connections.cmi: ../libvirt/libvirt.cmi vc_domain_ops.cmi: vc_connections.cmi vc_helpers.cmi: ../libvirt/libvirt.cmi vc_mainwindow.cmi: vc_domain_ops.cmi +vc_connection_dlg.cmo: vc_connections.cmi vc_connection_dlg.cmi +vc_connection_dlg.cmx: vc_connections.cmx vc_connection_dlg.cmi vc_connections.cmo: vc_helpers.cmi ../libvirt/libvirt.cmi vc_connections.cmi vc_connections.cmx: vc_helpers.cmx ../libvirt/libvirt.cmx vc_connections.cmi vc_domain_ops.cmo: vc_connections.cmi ../libvirt/libvirt.cmi \ @@ -10,9 +12,9 @@ vc_domain_ops.cmx: vc_connections.cmx ../libvirt/libvirt.cmx \ vc_domain_ops.cmi vc_helpers.cmo: ../libvirt/libvirt.cmi vc_helpers.cmi vc_helpers.cmx: ../libvirt/libvirt.cmx vc_helpers.cmi -vc_mainwindow.cmo: vc_connections.cmi ../libvirt/libvirt.cmi \ - vc_mainwindow.cmi -vc_mainwindow.cmx: vc_connections.cmx ../libvirt/libvirt.cmx \ - vc_mainwindow.cmi +vc_mainwindow.cmo: vc_connections.cmi vc_connection_dlg.cmi \ + ../libvirt/libvirt.cmi vc_mainwindow.cmi +vc_mainwindow.cmx: vc_connections.cmx vc_connection_dlg.cmx \ + ../libvirt/libvirt.cmx vc_mainwindow.cmi virt_ctrl.cmo: vc_mainwindow.cmi vc_domain_ops.cmi virt_ctrl.cmx: vc_mainwindow.cmx vc_domain_ops.cmx diff --git a/virt-ctrl/Makefile.in b/virt-ctrl/Makefile.in index 5ef6362..6d68437 100644 --- a/virt-ctrl/Makefile.in +++ b/virt-ctrl/Makefile.in @@ -29,6 +29,7 @@ OBJS := \ vc_helpers.cmo \ vc_connections.cmo \ vc_domain_ops.cmo \ + vc_connection_dlg.cmo \ vc_mainwindow.cmo ifneq ($(OCAMLFIND),) diff --git a/virt-ctrl/vc_connection_dlg.ml b/virt-ctrl/vc_connection_dlg.ml new file mode 100644 index 0000000..9ba95a7 --- /dev/null +++ b/virt-ctrl/vc_connection_dlg.ml @@ -0,0 +1,29 @@ +(* virt-ctrl: A graphical management tool. + (C) Copyright 2007 Richard W.M. Jones, Red Hat Inc. + http://libvirt.org/ + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. +*) + +(* Open connection dialog. + * This should be a lot more sophisticated. XXX + *) +let open_connection () = + let title = "Open connection to hypervisor" in + let uri = + GToolbox.input_string ~title ~text:"xen:///" ~ok:"Open" "Connection:" in + match uri with + | None -> () + | Some uri -> Vc_connections.open_connection uri diff --git a/virt-ctrl/vc_connection_dlg.mli b/virt-ctrl/vc_connection_dlg.mli new file mode 100644 index 0000000..bfd7ba4 --- /dev/null +++ b/virt-ctrl/vc_connection_dlg.mli @@ -0,0 +1,23 @@ +(* virt-ctrl: A graphical management tool. + (C) Copyright 2007 Richard W.M. Jones, Red Hat Inc. + http://libvirt.org/ + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + + Make the main window. +*) + +(** The connection dialog. *) +val open_connection : unit -> unit diff --git a/virt-ctrl/vc_mainwindow.ml b/virt-ctrl/vc_mainwindow.ml index 3ae9d7c..f859d10 100644 --- a/virt-ctrl/vc_mainwindow.ml +++ b/virt-ctrl/vc_mainwindow.ml @@ -60,17 +60,6 @@ let () = icon#set_icon_size `DIALOG; GToolbox.message_box ~title ~icon label -(* Open connection dialog. - * This should be a lot more sophisticated. XXX - *) -let open_connection () = - let title = "Open connection to hypervisor" in - let uri = - GToolbox.input_string ~title ~text:"xen:///" ~ok:"Open" "Connection:" in - match uri with - | None -> () - | Some uri -> Vc_connections.open_connection uri - let make ~start_domain ~pause_domain ~resume_domain ~shutdown_domain ~open_domain_details = @@ -92,7 +81,8 @@ let make ignore (factory#add_separator ()); let quit_item = factory#add_item "Quit" ~key:GdkKeysyms._Q in - ignore (open_item#connect#activate ~callback:open_connection); + ignore (open_item#connect#activate + ~callback:Vc_connection_dlg.open_connection); (* Help menu. *) let factory = new GMenu.factory help_menu ~accel_group in @@ -130,7 +120,8 @@ let make ~packing:(vbox#pack ~expand:true ~fill:true) () in (* Set callbacks for the buttons. *) - ignore (connect_button#connect#clicked ~callback:open_connection); + ignore (connect_button#connect#clicked + ~callback:Vc_connection_dlg.open_connection); ignore (open_button#connect#clicked ~callback:(open_domain_details tree model columns)); ignore (start_button#connect#clicked |