# # patch "app.ml" # from [66ca42a7682768ef5390ebd179fe17542a32fa69] # to [6e417acb3dbf7417d39c4413bac06c3e31647508] # # patch "app.mli" # from [2e5bf23cbb20daae7194c707c757764bb768917f] # to [221b1797f90548892501681a900a80ee017d9359] # # patch "ui.ml" # from [da402d15b2968165c610a3bce77b3bc79eb626e0] # to [024aed654eb656daf8e2e287c986cd7f7076dfe4] # # patch "ui.mli" # from [709939bf726569572659c17fa1ac030f89e84c8b] # to [616701fcf70199bc40d48051187777b1f55e632d] # # patch "view.ml" # from [2efcf10cb926f58aa21e9c30c5eddaa806a2261e] # to [53b08cc8dfc3354affc6c03060a5d7676f8a29c1] # # patch "view.mli" # from [a035848f2c374e946742b4b07a465531e4ad1bd1] # to [fc58aa1b7db2d23c654b7c407ee1da2a2503ddcc] # ======================================================================== --- app.ml 66ca42a7682768ef5390ebd179fe17542a32fa69 +++ app.ml 6e417acb3dbf7417d39c4413bac06c3e31647508 @@ -40,6 +40,7 @@ method cert_popup : int -> unit method show_open : unit -> unit + method show_view : unit -> unit method show_search : unit -> unit method show_prefs : unit -> unit method show_diff : string -> string -> unit @@ -236,6 +237,10 @@ self#open_db (Ui.Open.show self#get_open_d) + method show_view () = + View.Branch_selector.present_dialog + view.View.selector + method show_search () = Query.show self#get_query @@ -263,9 +268,15 @@ let make w ~aa ~prefs = let b = GPack.vbox ~packing:w#add () in - let manager = Ui.make ~packing:b#pack in + let manager, menubar, toolbar = Ui.make () in + b#pack menubar ; + let hb = GPack.hbox ~packing:b#pack () in + hb#pack ~expand:true toolbar ; let status = new Ui.status_bar ~packing:(b#pack ~from:`END) in let status = Viz_misc.make_cache status in - let view = View.make ~aa ~packing:(b#pack ~expand:true) in + let view = + View.make + ~aa ~parent:w + ~pack_find_entry:(hb#pack ~from:`END) + ~pack_canvas:(b#pack ~expand:true) in new ctrl w ~prefs ~manager ~status ~view - ======================================================================== --- app.mli 2e5bf23cbb20daae7194c707c757764bb768917f +++ app.mli 221b1797f90548892501681a900a80ee017d9359 @@ -40,6 +40,7 @@ method cert_popup : int -> unit method show_open : unit -> unit + method show_view : unit -> unit method show_search : unit -> unit method show_prefs : unit -> unit method show_diff : string -> string -> unit ======================================================================== --- ui.ml da402d15b2968165c610a3bce77b3bc79eb626e0 +++ ui.ml 024aed654eb656daf8e2e287c986cd7f7076dfe4 @@ -295,15 +295,10 @@ let ui_info = "\ \ \ - \ - \ - \ - \ + \ \ \ \ - \ - \ \ \ \ @@ -325,6 +320,7 @@ \ \ \ + \ \ \ \ @@ -356,11 +352,12 @@ let add = GAction.add_action in let g_main = GAction.action_group ~name:"main" () in GAction.add_actions g_main [ + add "FileMenu" ~label:"_File" ; add "Open" ~stock:`OPEN ~tooltip:"Open a database" ; add "Close" ~stock:`CLOSE ~tooltip:"Close the database" ; add "Quit" ~stock:`QUIT ~tooltip:"Exit" ; - add "FileMenu" ~label:"_File" ; add "Prefs" ~stock:`PREFERENCES ~tooltip:"Edit Preferences" ; + add "New" ~stock:`NEW ~tooltip:"View a monotone ancestry graph" ; add "FindEntry" ~accel:"l" ] ; (g_main#get_action "Close")#set_sensitive false ; let g_popup = GAction.action_group ~name:"popup" () in @@ -375,7 +372,7 @@ let g_view = GAction.action_group ~name:"view" () in GAction.add_actions g_view [ add "ViewMenu" ~label:"_View" ; - add "Refresh" ~stock:`REFRESH ~tooltip:"Reload" ~accel:"R" ; + add "Refresh" ~stock:`REFRESH ~tooltip:"Redraw" ~accel:"R" ; add "Zoom_in" ~stock:`ZOOM_IN ~tooltip:"Zoom in" ~accel:"plus" ; add "Zoom_out" ~stock:`ZOOM_OUT ~tooltip:"Zoom out" ~accel:"minus" ; add "Query" ~stock:`FIND ~tooltip:"Search the database" ] ; @@ -396,19 +393,19 @@ clipboard2 = GData.clipboard Gdk.Atom.primary } -let make ~packing = +let make () = let m = GAction.ui_manager () in let (g_main, g_popup, g_view) = make_groups () in m#insert_action_group g_main 1 ; m#insert_action_group g_popup 2 ; m#insert_action_group g_view 3 ; ignore (m#add_ui_from_string ui_info) ; - packing (m#get_widget "/menubar") ; - packing (m#get_widget "/toolbar") ; + let menubar = m#get_widget "/menubar" in + let toolbar = m#get_widget "/toolbar" in { manager = m ; main_group = g_main; view_group = g_view ; popup_data = lazy (make_popup_data m g_popup) - } + }, menubar, toolbar let get_popup_data { popup_data = p } = Lazy.force p @@ -513,14 +510,15 @@ let action_connect name callback = ignore ((ui#get_action name)#connect#activate ~callback) in - action_connect "/toolbar/Close" ctrl#close_db ; - action_connect "/toolbar/Open" ctrl#show_open ; - action_connect "/toolbar/Quit" GMain.quit ; - action_connect "/toolbar/Zoom_in" ctrl#zoom_in ; - action_connect "/toolbar/Zoom_out" ctrl#zoom_out ; - action_connect "/toolbar/Refresh" ctrl#reload ; - action_connect "/toolbar/Prefs" ctrl#show_prefs ; - action_connect "/toolbar/Query" ctrl#show_search ; + action_connect "/menubar/FileMenu/Close" ctrl#close_db ; + action_connect "/menubar/FileMenu/Open" ctrl#show_open ; + action_connect "/menubar/FileMenu/Quit" GMain.quit ; + action_connect "/menubar/ViewMenu/Zoom_in" ctrl#zoom_in ; + action_connect "/menubar/ViewMenu/Zoom_out" ctrl#zoom_out ; + action_connect "/menubar/ViewMenu/Refresh" ctrl#reload ; + action_connect "/menubar/FileMenu/Prefs" ctrl#show_prefs ; + action_connect "/menubar/ViewMenu/Query" ctrl#show_search ; + action_connect "/menubar/ViewMenu/New" ctrl#show_view ; action_connect "/popup/Certs" (fun () -> ctrl#display_certs (get_popup_data m).popup_id) ; action_connect "/popup_cert/Copy_cert" @@ -532,10 +530,10 @@ let open_db m ctrl = - (m.manager#get_action "/toolbar/Close")#set_sensitive true + (m.manager#get_action "/menubar/FileMenu/Close")#set_sensitive true let close_db m ctrl = - (m.manager#get_action "/toolbar/Close")#set_sensitive false + (m.manager#get_action "/menubar/FileMenu/Close")#set_sensitive false let clear m = m.view_group#set_sensitive false ======================================================================== --- ui.mli 709939bf726569572659c17fa1ac030f89e84c8b +++ ui.mli 616701fcf70199bc40d48051187777b1f55e632d @@ -43,7 +43,7 @@ type manager -val make : packing:(GObj.widget -> 'a) -> manager +val make : unit -> manager * GObj.widget * GObj.widget val setup : manager -> #App.t -> unit val popup : ======================================================================== --- view.ml 2efcf10cb926f58aa21e9c30c5eddaa806a2261e +++ view.ml 53b08cc8dfc3354affc6c03060a5d7676f8a29c1 @@ -379,7 +379,6 @@ module Branch_selector = struct type t = { - button : GButton.button ; store : GTree.tree_store ; branch_column : string GTree.column ; in_view_column : bool GTree.column ; @@ -394,9 +393,7 @@ mutable limit_kind : int ; } - let make ~packing = - (* The button below the toolbar *) - let button = GButton.button ~label:"_New view" ~use_mnemonic:true ~packing () in + let make parent = (* The model containing branch names *) let cl = new GTree.column_list in let branch_column = cl#add Gobject.Data.string in @@ -407,7 +404,7 @@ (* The dialog, created now, only shown when one presses the button *) let w = GWindow.dialog - ?parent:(GWindow.toplevel button) + ~parent ~destroy_with_parent:true ~border_width:8 ~no_separator:true @@ -486,8 +483,7 @@ ignore (e1#connect#activate (fun () -> e2#misc#grab_focus ())) ; (button, e1, e2) in - { button = button ; - store = model ; + { store = model ; branch_column = branch_column ; in_view_column = in_view_column ; vis_column = vis_column ; @@ -622,11 +618,6 @@ s.store#set ~row ~column (not v) ; if s.selected_b <= 1 then adjust_view_button_sensitivity s)) ; - ignore (s.button#connect#clicked (fun () -> - expand_rows s ; - scroll s ; - s.w#set_default_response `VIEW ; - s.w#present ())) ; ignore (s.w#connect#after#close s.w#misc#hide) ; ignore (s.w#event#connect#delete (fun _ -> s.w#misc#hide () ; true)) ; ignore (s.w#connect#response (function @@ -806,7 +797,10 @@ (make_query ctrl ?id s) let present_dialog s = - s.button#clicked () + expand_rows s ; + scroll s ; + s.w#set_default_response `VIEW ; + s.w#present () end @@ -1452,16 +1446,13 @@ find : Find.t ; } -let make ~aa ~packing = - let b = GPack.vbox ~packing () in +let make ~aa ~parent ~pack_find_entry ~pack_canvas = + (* Branch selection *) + let selector = Branch_selector.make parent in + let find_box = Find.make ~packing:pack_find_entry in - (* Branches selection *) - let hb = GPack.hbox ~border_width:4 ~packing:b#pack () in - let selector = Branch_selector.make ~packing:hb#pack in - let find_box = Find.make ~packing:(hb#pack ~from:`END) in + let view_pane = GPack.paned `VERTICAL ~packing:pack_canvas () in - let view_pane = GPack.paned `VERTICAL ~packing:(b#pack ~expand:true) () in - (* Canvas *) let canvas = Canvas.make ~aa ======================================================================== --- view.mli a035848f2c374e946742b4b07a465531e4ad1bd1 +++ view.mli fc58aa1b7db2d23c654b7c407ee1da2a2503ddcc @@ -37,7 +37,11 @@ find : Find.t; } -val make : aa:bool -> packing:(GObj.widget -> unit) -> t +val make : + aa:bool -> + parent:#GWindow.window_skel -> + pack_find_entry:(GObj.widget -> unit) -> + pack_canvas:(GObj.widget -> unit) -> t val setup : t -> #App.t -> unit val clear : t -> #App.t -> unit