----------------------------------------------------------------------- -- GtkAda - Ada95 binding for the Gimp Toolkit -- -- -- -- Copyright (C) 2003 -- -- Emmanuel Briot, Joel Brobecker and Arnaud Charlet -- -- Copyright (C) 2004-2011, AdaCore -- -- -- -- This library 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 library 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 library; if not, write to the -- -- Free Software Foundation, Inc., 59 Temple Place - Suite 330, -- -- Boston, MA 02111-1307, USA. -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- ----------------------------------------------------------------------- with Gdk.Bitmap; use Gdk.Bitmap; with Gdk.Color; use Gdk.Color; with Gdk.Pixmap; use Gdk.Pixmap; with Glib.Xml_Int; use Glib.Xml_Int; with Gtk; use Gtk; with Gtk.Accel_Group; use Gtk.Accel_Group; with Gtk.Box; use Gtk.Box; with Gtk.Frame; use Gtk.Frame; with Gtk.Label; use Gtk.Label; with Gtk.Menu; use Gtk.Menu; with Gtk.Menu_Tool_Button; use Gtk.Menu_Tool_Button; with Gtk.Widget; use Gtk.Widget; with Gtkada.MDI; use Gtkada.MDI; with Gtk.Toolbar; use Gtk.Toolbar; with Gtkada.Handlers; use Gtkada.Handlers; with Gtk.Toggle_Tool_Button; use Gtk.Toggle_Tool_Button; with Gtk.Tool_Button; use Gtk.Tool_Button; with Gtk.Enums; use Gtk.Enums; with Gtk.Window; use Gtk.Window; with Gtk.Image; use Gtk.Image; package body Create_MDI is package Desktops is new Gtkada.MDI.Desktop (Integer); function Create_Child (Index : Natural) return MDI_Child; procedure On_Opaque (Button : access Gtk_Widget_Record'Class); procedure On_Snapshot (Button : access Gtk_Widget_Record'Class); procedure Do_Configure (MDI : access MDI_Window_Record'Class); procedure On_Save_Desktop (Button : access Gtk_Widget_Record'Class); procedure Load_Desktop; -- Load the desktop (and all known perspectives) from an external -- XML file. Or create that file from the current desktop. function Load_From_Desktop (MDI : MDI_Window; Node : Glib.Xml_Int.Node_Ptr; User : Integer) return MDI_Child; -- This function recreates a MDI_Child from its XML description as -- given in a desktop.xml file (see the documentation for package -- Desktop). function Save_To_Desktop (Widget : access Gtk.Widget.Gtk_Widget_Record'Class; User : Integer) return Glib.Xml_Int.Node_Ptr; -- This is the opposite of Load_From_Desktop, and saves an existing -- window into an XML node (with all information needed so that -- Load_From_Desktop can recreate it later). procedure Setup (Frame : access Gtk_Frame_Record'Class; Independent : Boolean); -- Create the demo, either in "Independent Perspectives" mode or not. type My_Window_Record is new Gtk_Box_Record with record Index : Natural; end record; type My_Window is access all My_Window_Record'Class; -- The type of windows this example is using. In practive, you would -- likely put trees, editors, and other kinds of complex windows. MDI : MDI_Window; Opaque : Boolean := False; My_Window_Name : constant String := "my_window_"; ---------- -- Help -- ---------- function Help return String is begin return "A Gtkada specific widget." & ASCII.LF & "This is based on the GtkAda multi panned widget. You should" & " try the corresponding demo to find out about other capabilities" & " like splitting windows or using fixed sizes." & ASCII.LF & "In the MDI, windows can be dragged around to be reorganized." & " The MDI also supports the notion of perspectives: when you" & " select another perspective, some of the windows (the ones in the" & " central area) will be preserved. All other windows will only" & " remain visible if they also are in the other perspective." & " This example loads the perspectives from an XML file, and you" & " can then switch between perspectives by using the menu" & " Perspectives. By default, the MDI includes a central area" & " whose content is preserved when you switch perspectives. For" & " instance, this could be used in an IDE so that the editors are" & " the same in the development and debugging perspectives. However," & " it can sometimes be confusing to users, so you can force" & " the perspectives to be independent. In such a case, no" & " window is preserved when switching perspectives." & ASCII.LF & "The MDI also provides the notion of desktop (the current layout" & " of your windows in all the perspectives). Such a desktop can be" & " saved to the disk, and restored when the application is" & " restarted (not shown in this demo). This is actually how" & " the default perspectives themselves can be defined initially" & " when you package your application." & ASCII.LF & "Windows can be @bfloated@B, ie put outside of the MDI, by" & " the user. This provides a convenient use for many users who" & " prefer having multiple windows. It is also a convenient way" & " to use multiple screens. You can either float a window" & " programmatically (and provide a menu to the user to do so)," & " or the user can drag a window outside of the MDI to float it" & ASCII.LF & "A contextual menu exists in the notebook tabs to close windows," & " or change the location of tabs."; end Help; ------------------ -- Do_Configure -- ------------------ procedure Do_Configure (MDI : access MDI_Window_Record'Class) is Bg_Color, Title_Color, Focus_Color : Gdk_Color; begin Bg_Color := Parse ("#8A8A8A"); Alloc (Get_Colormap (MDI), Bg_Color); Title_Color := Parse ("#7D7D7D"); Alloc (Get_Colormap (MDI), Title_Color); Focus_Color := Parse ("#5894FA"); Alloc (Get_Colormap (MDI), Focus_Color); Configure (MDI, Background_Color => Bg_Color, Title_Bar_Color => Title_Color, Focus_Title_Color => Focus_Color, Opaque_Resize => Opaque, Show_Tabs_Policy => Automatic, Tabs_Position => Gtk.Enums.Pos_Bottom, Draw_Title_Bars => Always); end Do_Configure; --------------- -- On_Opaque -- --------------- procedure On_Opaque (Button : access Gtk_Widget_Record'Class) is pragma Unreferenced (Button); begin Opaque := not Opaque; Do_Configure (MDI); end On_Opaque; ----------------- -- On_Snapshot -- ----------------- Iterator : Child_Iterator; procedure On_Snapshot (Button : access Gtk_Widget_Record'Class) is pragma Unreferenced (Button); Child : MDI_Child; Pixmap : Gdk_Pixmap; Window : Gtk_Window; Image : Gtk_Image; begin Child := Get (Iterator); if Child = null then Iterator := First_Child (MDI); Child := Get (Iterator); else Next (Iterator); end if; Pixmap := Get_Snapshot (Child, null); Gtk_New (Window); Set_Default_Size (Window, 800, 600); Gtk_New (Image, Pixmap, Null_Bitmap); Add (Window, Image); Show_All (Window); end On_Snapshot; --------------------- -- On_Save_Desktop -- --------------------- procedure On_Save_Desktop (Button : access Gtk_Widget_Record'Class) is pragma Unreferenced (Button); Perspectives, Central : Node_Ptr; begin Desktops.Save_Desktop (MDI, 0, Perspectives, Central); -- These could also be saved in the same XML file. We keep this -- example simpler by avoiding the extra XML manipulation this requires if Independent_Perspectives (MDI) then Print (Perspectives, "perspectives_indep.xml"); else Print (Perspectives, "perspectives.xml"); Print (Central, "central.xml"); end if; end On_Save_Desktop; ------------------ -- Load_Desktop -- ------------------ procedure Load_Desktop is Perspectives, Central : Node_Ptr; Success : Boolean; pragma Unreferenced (Success); begin if Independent_Perspectives (MDI) then Perspectives := Parse ("perspectives_indep.xml"); else Perspectives := Parse ("perspectives.xml"); Central := Parse ("central.xml"); end if; Success := Desktops.Restore_Desktop (MDI, Perspectives, Central, 0); end Load_Desktop; ------------------ -- Create_Child -- ------------------ function Create_Child (Index : Natural) return MDI_Child is Child : MDI_Child; Box : My_Window; Label : Gtk_Label; begin Box := new My_Window_Record; Box.Index := Index; Initialize_Vbox (Box); Gtk_New (Child, Box, Flags => All_Buttons, Group => Group_Default); Gtk_New (Label, "This is the" & Integer'Image (Index) & " window"); Pack_Start (Box, Label); Set_Title (Child, "Window" & Integer'Image (Index)); Show_All (Child); return Child; end Create_Child; --------------------- -- Save_To_Desktop -- --------------------- function Save_To_Desktop (Widget : access Gtk.Widget.Gtk_Widget_Record'Class; User : Integer) return Glib.Xml_Int.Node_Ptr is pragma Unreferenced (User); Box : constant My_Window := My_Window (Widget); Index : constant String := Box.Index'Img; N : Node_Ptr; begin -- We store the index directly in the XML tag, so that all windows -- appear to be different. N := new Node; N.Tag := new String' (My_Window_Name & Index (Index'First + 1 .. Index'Last)); return N; end Save_To_Desktop; ----------------------- -- Load_From_Desktop -- ----------------------- function Load_From_Desktop (MDI : MDI_Window; Node : Glib.Xml_Int.Node_Ptr; User : Integer) return MDI_Child is pragma Unreferenced (User); Child : MDI_Child; Index : constant Integer := Integer'Value (Node.Tag (Node.Tag'First + My_Window_Name'Length .. Node.Tag'Last)); begin Child := Create_Child (Index); Put (MDI, Child, Position_Automatic); return Child; end Load_From_Desktop; ----------- -- Setup -- ----------- procedure Setup (Frame : access Gtk_Frame_Record'Class; Independent : Boolean) is Bar : Gtk_Toolbar; Box : Gtk_Box; Toggle : Gtk_Toggle_Tool_Button; Button : Gtk_Tool_Button; Group : Gtk_Accel_Group; Menu : Gtk_Menu; Menu_Button : Gtk_Menu_Tool_Button; Success : Boolean; pragma Unreferenced (Success); begin Gtk_New_Vbox (Box, Homogeneous => False); Add (Frame, Box); Gtk_New (Bar); Pack_Start (Box, Bar, Expand => False); Gtk_New (Group); Gtk_New (MDI, Group => Group, Independent_Perspectives => Independent); Do_Configure (MDI); Pack_End (Box, MDI, Expand => True); Menu := Desktops.Create_Menu (MDI, User => 1); -- User irrelevant here Gtk_New (Toggle); Set_Label (Toggle, "Opaque Resizing"); Insert (Bar, Toggle); Widget_Callback.Connect (Toggle, "toggled", On_Opaque'Access); Gtk_New (Button, Label => "Save Desktop"); Insert (Bar, Button); Widget_Callback.Connect (Button, "clicked", On_Save_Desktop'Access); Gtk_New (Menu_Button, Label => "Menu"); Set_Menu (Menu_Button, Menu); Insert (Bar, Menu_Button); Gtk_New (Button, Label => "Snapshot"); Insert (Bar, Button); Widget_Callback.Connect (Button, "clicked", On_Snapshot'Access); -- Pressing "snapshot will cycle through the MDI children and take -- a pixmap of the MDI children. -- Load the desktop from external XML files Desktops.Register_Desktop_Functions (Save_To_Desktop'Access, Load_From_Desktop'Access); Load_Desktop; -- Put (MDI, Create_Child (1), Position_Automatic); -- Put (MDI, Create_Child (2), Position_Automatic); -- Put (MDI, Create_Child (3), Position_Automatic); Show_All (Frame); end Setup; --------- -- Run -- --------- procedure Run (Frame : access Gtk.Frame.Gtk_Frame_Record'Class) is begin Setup (Frame, Independent => False); end Run; --------------------- -- Run_Independent -- --------------------- procedure Run_Independent (Frame : access Gtk.Frame.Gtk_Frame_Record'Class) is begin Setup (Frame, Independent => True); end Run_Independent; end Create_MDI;