X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;f=window.ml;h=baa63b2b78808ebb41e219ba26e4d08e78b3708a;hb=23a1eac79ffcbab1801b89430fc0354e44cf7599;hp=a43bf9c4966e1593ad85a90603dfc766644ac666;hpb=2ed92137182d4d479dddddeccaf6ad8dae967895;p=guestfs-browser.git diff --git a/window.ml b/window.ml index a43bf9c..baa63b2 100644 --- a/window.ml +++ b/window.ml @@ -23,6 +23,27 @@ open Slave_types module G = Guestfs +type connect_menu = { + connect_menu : GMenu.menu; + connect_kvm_item : GMenu.menu_item; + connect_xen_item : GMenu.menu_item; + connect_none_item : GMenu.menu_item; + connect_uri_item : GMenu.menu_item; + open_disk_item : GMenu.menu_item; + reopen_item : GMenu.menu_item; + quit_item : GMenu.menu_item; +} + +type guest_menu = { + guest_menu : GMenu.menu; + guest_inspection_item : GMenu.menu_item; +} + +type help_menu = { + help_menu : GMenu.menu; + about_item : GMenu.menu_item; +} + class window = (* Window. *) let title = "Guest Filesystem Browser" in @@ -33,31 +54,42 @@ class window = let menubar = GMenu.menu_bar ~packing:vbox#pack () in let factory = new GMenu.factory menubar in let accel_group = factory#accel_group in - let connect_menu = factory#add_submenu "_Connect" in - - let factory = new GMenu.factory connect_menu ~accel_group in - let connect_kvm_item = factory#add_item "Connect to local _KVM hypervisor" in - let connect_xen_item = factory#add_item "Connect to local _Xen hypervisor" in - let connect_none_item = factory#add_item "_Connect to default hypervisor" in - let connect_uri_item = factory#add_item "Connect to a _libvirt URI ..." in - let () = ignore (factory#add_separator ()) in - let _ = factory#add_item "_Open disk image ..." ~key:GdkKeysyms._O in - let () = ignore (factory#add_separator ()) in - let quit_item = factory#add_item "E_xit" ~key:GdkKeysyms._Q in - - (* Quit. *) - let quit _ = GMain.quit (); false in - let () = - ignore (window#connect#destroy ~callback:GMain.quit); - ignore (window#event#connect#delete ~callback:quit); - ignore (quit_item#connect#activate - ~callback:(fun () -> ignore (quit ()); ())); - window#add_accel_group accel_group in + let connect_menu = + let menu = factory#add_submenu "_Connect" in + let factory = new GMenu.factory menu ~accel_group in + let kvm = factory#add_item "Connect to local _KVM hypervisor" in + let xen = factory#add_item "Connect to local _Xen hypervisor" in + let none = factory#add_item "_Connect to default hypervisor" in + let uri = factory#add_item "Connect to a _libvirt URI ..." in + ignore (factory#add_separator ()); + let opend = factory#add_item "_Open disk image ..." ~key:GdkKeysyms._O in + ignore (factory#add_separator ()); + let reopen = factory#add_item "Reopen current guest" in + ignore (factory#add_separator ()); + let quit = factory#add_item "E_xit" ~key:GdkKeysyms._Q in + { connect_menu = menu; connect_kvm_item = kvm; + connect_xen_item = xen; connect_none_item = none; + connect_uri_item = uri; + open_disk_item = opend; reopen_item = reopen; quit_item = quit } in + + let guest_menu = + let menu = factory#add_submenu "_Guest" in + let factory = new GMenu.factory menu ~accel_group in + let inspection = factory#add_item "Operating system information ..." in + { guest_menu = menu; guest_inspection_item = inspection } in + + let help_menu = + let menu = factory#add_submenu "_Help" in + let factory = new GMenu.factory menu ~accel_group in + let about = factory#add_item "About guest filesystem browser ..." in + { help_menu = menu; about_item = about } in (* Top toolbar. *) - let hbox = GPack.hbox ~border_width:4 ~packing:vbox#pack () in - let () = hbox#pack (mklabel "Guest: ") in + let hbox = + let hbox = GPack.hbox ~border_width:4 ~packing:vbox#pack () in + hbox#pack (mklabel "Guest: "); + hbox in (* Combo box for displaying virtual machine names. *) let vmcombo = GEdit.combo_box_text ~packing:hbox#pack () in @@ -86,7 +118,7 @@ class window = ~packing:(vbox#pack ~expand:true ~fill:true) () in let tree = new Filetree.tree ~packing:sw#add () in - (* Status bar and progress bar. *) + (* Status bar and progress bar at the bottom. *) let hbox = GPack.hbox ~spacing:4 ~packing:vbox#pack () in let progress_bar = GRange.progress_bar ~packing:hbox#pack () in let statusbar = GMisc.statusbar ~packing:(hbox#pack ~expand:true) () in @@ -97,31 +129,61 @@ class window = let connect_xen_signal = new GUtil.signal () in let connect_none_signal = new GUtil.signal () in let connect_uri_signal = new GUtil.signal () in + let open_disk_signal = new GUtil.signal () in + let reopen_signal = new GUtil.signal () in + let inspection_signal = new GUtil.signal () in + let about_signal = new GUtil.signal () in object (self) inherit GUtil.ml_signals [connect_kvm_signal#disconnect; connect_xen_signal#disconnect; connect_none_signal#disconnect; - connect_uri_signal#disconnect] + connect_uri_signal#disconnect; + open_disk_signal#disconnect; + reopen_signal#disconnect; + inspection_signal#disconnect; + about_signal#disconnect] method connect_kvm_signal = connect_kvm_signal#connect ~after method connect_xen_signal = connect_xen_signal#connect ~after method connect_none_signal = connect_none_signal#connect ~after method connect_uri_signal = connect_uri_signal#connect ~after + method open_disk_signal = open_disk_signal#connect ~after + method reopen_signal = reopen_signal#connect ~after + method inspection_signal = inspection_signal#connect ~after + method about_signal = about_signal#connect ~after initializer ignore (statusbar_context#push title); window#show (); + (* Quit. *) + let quit _ = GMain.quit (); false in + ignore (window#connect#destroy ~callback:GMain.quit); + ignore (window#event#connect#delete ~callback:quit); + ignore (connect_menu.quit_item#connect#activate + ~callback:(fun () -> ignore (quit ()); ())); + + (* Accel_group. *) + window#add_accel_group accel_group; + (* Menu entries emit signals. *) - ignore (connect_kvm_item#connect#activate + ignore (connect_menu.connect_kvm_item#connect#activate ~callback:connect_kvm_signal#call); - ignore (connect_xen_item#connect#activate + ignore (connect_menu.connect_xen_item#connect#activate ~callback:connect_xen_signal#call); - ignore (connect_none_item#connect#activate + ignore (connect_menu.connect_none_item#connect#activate ~callback:connect_none_signal#call); - ignore (connect_uri_item#connect#activate + ignore (connect_menu.connect_uri_item#connect#activate ~callback:connect_uri_signal#call); + ignore (connect_menu.open_disk_item#connect#activate + ~callback:open_disk_signal#call); + ignore (connect_menu.reopen_item#connect#activate + ~callback:reopen_signal#call); + ignore (guest_menu.guest_inspection_item#connect#activate + ~callback:inspection_signal#call); + ignore (help_menu.about_item#connect#activate + ~callback:about_signal#call); (* VM combo box when changed by the user. * The refresh button acts like changing the VM combo too. @@ -186,7 +248,7 @@ object (self) self#when_opened_common name data (* When a set of disk images is selected by the user. *) - method private open_disk_images images = + method open_disk_images images = match images with | [] -> () | images -> @@ -202,6 +264,16 @@ object (self) debug "when_opened_disk_images callback"; self#when_opened_common image data + (* Called to reopen the handle. *) + method reopen () = + tree#clear (); + Slave.discard_command_queue (); + Slave.reopen self#when_reopened + + method private when_reopened data = + debug "when_reopened callback"; + self#when_opened_common "Reopened"(*XXX we lost the original name*) data + (* Common code for when_opened_domain/when_opened_disk_images. *) method private when_opened_common name data = (* Dump some of the inspection data in debug messages. *)