----------------------------------------------------------------------- -- GtkAda - Ada95 binding for Gtk+/Gnome -- -- -- -- Copyright (C) 2000-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 Gtk; use Gtk; with Gnome.UI_Defs; use Gnome.UI_Defs; with Interfaces.C.Strings; with Unchecked_Conversion; package body Gnome.App_Helper is function New_String (Str : String) return Chars_Ptr renames Interfaces.C.Strings.New_String; function New_String (Str : String) return System.Address; function To_Gint is new Unchecked_Conversion (UI_Info_Configurable_Types, Gint); procedure First_Marshaller (Object : System.Address; User_Data : Data_Type_Access); pragma Convention (C, First_Marshaller); -- First level marshaller. This is the function that is actually -- called by Gnome. It then calls the Ada functions as required. ---------------------- -- First_Marshaller -- ---------------------- procedure First_Marshaller (Object : System.Address; User_Data : Data_Type_Access) is begin if User_Data.Func = null then return; end if; if User_Data.Object = null then User_Data.Func (Convert (Object)); else User_Data.Func (User_Data.Object); end if; end First_Marshaller; ---------------- -- New_String -- ---------------- function New_String (Str : String) return System.Address is function To_Address is new Unchecked_Conversion (Chars_Ptr, System.Address); begin return To_Address (New_String (Str)); end New_String; ------------------ -- Create_Menus -- ------------------ procedure Create_Menus (App : access Gnome_App_Record'Class; Info : UI_Info_Array_Access) is procedure Internal (App : System.Address; Info : System.Address); pragma Import (C, Internal, "gnome_app_create_menus"); begin Internal (Get_Object (App), Info.all'Address); end Create_Menus; -------------------- -- Create_Toolbar -- -------------------- procedure Create_Toolbar (App : access Gnome_App_Record'Class; Info : UI_Info_Array_Access) is procedure Internal (App : System.Address; Info : System.Address); pragma Import (C, Internal, "gnome_app_create_toolbar"); begin Internal (Get_Object (App), Info.all'Address); end Create_Toolbar; --------------- -- Fill_Menu -- --------------- procedure Fill_Menu (Menu_Shell : access Gtk_Menu_Shell_Record'Class; Info : UI_Info_Array_Access; Accel_Group : Gtk_Accel_Group := null; Uline_Accels : Boolean := False; Pos : Gint := 0; Object : Gtk_Widget := null) is procedure Internal (Menu_Shell : System.Address; Info : System.Address; Accel_Group : System.Address; Uline_Accels : Gint; Pos : Gint); pragma Import (C, Internal, "gnome_app_fill_menu"); type Flat_UI_Info_Array is new UI_Info_Array (Natural); type Flat_UI_Info_Array_Access is access all Flat_UI_Info_Array; function To_Flat is new Unchecked_Conversion (System.Address, Flat_UI_Info_Array_Access); procedure Fill_Object (Info : Flat_UI_Info_Array_Access; Object : Gtk_Widget); -- Fill the User_Data.Object field for each Info element, including -- elements inside other info arrays that are contained in Info. procedure Fill_Object (Info : Flat_UI_Info_Array_Access; Object : Gtk_Widget) is begin for J in Info'Range loop case Info (J).Item_Type is when UI_Endofinfo => exit; when UI_Item | UI_Toggleitem | UI_Item_Configurable => Info (J).User_Data.Object := Object; when UI_Subtree | UI_Subtree_Stock | UI_Radioitems => Fill_Object (To_Flat (Info (J).Moreinfo), Object); when UI_Separator | UI_Help | UI_Builder_Data => null; end case; end loop; end Fill_Object; begin if Object /= null then Fill_Object (To_Flat (Info.all'Address), Object); end if; Internal (Get_Object (Menu_Shell), Info.all'Address, Get_Object (Accel_Group), Boolean'Pos (Uline_Accels), Pos); end Fill_Menu; ------------------ -- Fill_Toolbar -- ------------------ procedure Fill_Toolbar (Toolbar : access Gtk_Toolbar_Record'Class; Info : UI_Info_Array_Access; Accel_Group : Gtk_Accel_Group := null) is procedure Internal (Toolbar : System.Address; Info : System.Address; Accel_Group : System.Address); pragma Import (C, Internal, "gnome_app_fill_toolbar"); begin Internal (Get_Object (Toolbar), Info.all'Address, Get_Object (Accel_Group)); end Fill_Toolbar; ------------------- -- Find_Menu_Pos -- ------------------- function Find_Menu_Pos (Parent : access Gtk_Widget_Record'Class; Path : String; Pos : Gint) return Gtk_Widget is function Internal (Parent : System.Address; Path : String; Pos : Gint) return System.Address; pragma Import (C, Internal, "gnome_app_find_menu_pos"); begin return Convert (Internal (Get_Object (Parent), Path & ASCII.NUL, Pos)); end Find_Menu_Pos; -------------------- -- Helper_Gettext -- -------------------- function Helper_Gettext (Str : String) return String is function Internal (Str : String) return Chars_Ptr; pragma Import (C, Internal, "gnome_app_helper_gettext"); begin return Interfaces.C.Strings.Value (Internal (Str & ASCII.NUL)); end Helper_Gettext; ------------------ -- Insert_Menus -- ------------------ procedure Insert_Menus (App : access Gnome_App_Record'Class; Path : String; Menu_Info : UI_Info_Array_Access) is procedure Internal (App : System.Address; Path : String; Menu_Info : System.Address); pragma Import (C, Internal, "gnome_app_fill_toolbar"); begin Internal (Get_Object (App), Path & ASCII.NUL, Menu_Info.all'Address); end Insert_Menus; ------------------------ -- Install_Menu_Hints -- ------------------------ procedure Install_Menu_Hints (App : Gnome_App; Info : UI_Info_Array_Access) is procedure Internal (App : System.Address; Info : System.Address); pragma Import (C, Internal, "gnome_app_install_menu_hints"); begin Internal (Get_Object (App), Info.all'Address); end Install_Menu_Hints; ---------------------------------- -- Install_Statusbar_Menu_Hints -- ---------------------------------- procedure Install_Statusbar_Menu_Hints (Bar : Gtk_Status_Bar; Info : UI_Info_Array_Access) is procedure Internal (Statusbar : System.Address; Info : System.Address); pragma Import (C, Internal, "gnome_app_install_statusbar_menu_hints"); begin Internal (Get_Object (Bar), Info.all'Address); end Install_Statusbar_Menu_Hints; ----------------------- -- Remove_Menu_Range -- ----------------------- procedure Remove_Menu_Range (App : access Gnome_App_Record'Class; Path : String; Start : Gint; Items : Gint) is procedure Internal (App : System.Address; Path : String; Start : Gint; Items : Gint); pragma Import (C, Internal, "gnome_app_remove_menu_range"); begin Internal (Get_Object (App), Path & ASCII.NUL, Start, Items); end Remove_Menu_Range; ------------------ -- Remove_Menus -- ------------------ procedure Remove_Menus (App : access Gnome_App_Record'Class; Path : String; Items : Gint) is procedure Internal (App : System.Address; Path : String; Items : Gint); pragma Import (C, Internal, "gnome_app_remove_menus"); begin Internal (Get_Object (App), Path & ASCII.NUL, Items); end Remove_Menus; ------------------ -- UI_Info_Help -- ------------------ function UI_Info_Help (App_Name : String) return UI_Info is begin return (UI_Help, Null_Ptr, Null_Ptr, New_String (App_Name), null, Null_Address, Pixmap_None, Null_Address, 0, 0, Null_Address); end UI_Info_Help; ------------------ -- UI_Info_Item -- ------------------ function UI_Info_Item (Label : String; Tooltip : String; Callback : Generic_Callback; Xpm_Data : Chars_Ptr_Array) return UI_Info is begin return (UI_Item, New_String (Label), New_String (Tooltip), First_Marshaller'Address, new Data_Type_Record'(Callback, null), Null_Address, Pixmap_Data, Xpm_Data'Address, 0, 0, Null_Address); end UI_Info_Item; ----------------------- -- UI_Info_Item_None -- ----------------------- function UI_Info_Item_None (Label : String; Tooltip : String; Callback : Generic_Callback) return UI_Info is begin return (UI_Item, New_String (Label), New_String (Tooltip), First_Marshaller'Address, new Data_Type_Record'(Callback, null), Null_Address, Pixmap_None, Null_Address, 0, 0, Null_Address); end UI_Info_Item_None; ------------------------ -- UI_Info_Item_Stock -- ------------------------ function UI_Info_Item_Stock (Label : String; Tooltip : String; Callback : Generic_Callback; Stock_Id : String) return UI_Info is begin return (UI_Item, New_String (Label), New_String (Tooltip), First_Marshaller'Address, new Data_Type_Record'(Callback, null), Null_Address, Pixmap_Stock, Stock_Id'Address, 0, 0, Null_Address); end UI_Info_Item_Stock; ----------------------------- -- UI_Info_Menu_About_Item -- ----------------------------- function UI_Info_Menu_About_Item (Callback : Generic_Callback) return UI_Info is begin return (UI_Item_Configurable, Null_Ptr, Null_Ptr, First_Marshaller'Address, new Data_Type_Record'(Callback, null), Null_Address, Pixmap_None, Null_Address, To_Gint (Configurable_Item_About), 0, Null_Address); end UI_Info_Menu_About_Item; ----------------------------- -- UI_Info_Menu_Clear_Item -- ----------------------------- function UI_Info_Menu_Clear_Item (Callback : Generic_Callback) return UI_Info is begin return (UI_Item_Configurable, Null_Ptr, Null_Ptr, First_Marshaller'Address, new Data_Type_Record'(Callback, null), Null_Address, Pixmap_None, Null_Address, To_Gint (Configurable_Item_Clear), 0, Null_Address); end UI_Info_Menu_Clear_Item; ----------------------------- -- UI_Info_Menu_Close_Item -- ----------------------------- function UI_Info_Menu_Close_Item (Callback : Generic_Callback) return UI_Info is begin return (UI_Item_Configurable, Null_Ptr, Null_Ptr, First_Marshaller'Address, new Data_Type_Record'(Callback, null), Null_Address, Pixmap_None, Null_Address, To_Gint (Configurable_Item_Close), 0, Null_Address); end UI_Info_Menu_Close_Item; ------------------------------------ -- UI_Info_Menu_Close_Window_Item -- ------------------------------------ function UI_Info_Menu_Close_Window_Item (Callback : Generic_Callback) return UI_Info is begin return (UI_Item_Configurable, Null_Ptr, Null_Ptr, First_Marshaller'Address, new Data_Type_Record'(Callback, null), Null_Address, Pixmap_None, Null_Address, To_Gint (Configurable_Item_Close_Window), 0, Null_Address); end UI_Info_Menu_Close_Window_Item; ---------------------------- -- UI_Info_Menu_Copy_Item -- ---------------------------- function UI_Info_Menu_Copy_Item (Callback : Generic_Callback) return UI_Info is begin return (UI_Item_Configurable, Null_Ptr, Null_Ptr, First_Marshaller'Address, new Data_Type_Record'(Callback, null), Null_Address, Pixmap_None, Null_Address, To_Gint (Configurable_Item_Copy), 0, Null_Address); end UI_Info_Menu_Copy_Item; --------------------------- -- UI_Info_Menu_Cut_Item -- --------------------------- function UI_Info_Menu_Cut_Item (Callback : Generic_Callback) return UI_Info is begin return (UI_Item_Configurable, Null_Ptr, Null_Ptr, First_Marshaller'Address, new Data_Type_Record'(Callback, null), Null_Address, Pixmap_None, Null_Address, To_Gint (Configurable_Item_Cut), 0, Null_Address); end UI_Info_Menu_Cut_Item; ---------------------------- -- UI_Info_Menu_Edit_Tree -- ---------------------------- function UI_Info_Menu_Edit_Tree (Tree : UI_Info_Array_Access) return UI_Info is begin return (UI_Subtree_Stock, New_String (-"_Edit"), Null_Ptr, Tree.all'Address, null, Null_Address, Pixmap_None, Null_Address, 0, 0, Null_Address); end UI_Info_Menu_Edit_Tree; -------------------------------- -- UI_Info_Menu_End_Game_Item -- -------------------------------- function UI_Info_Menu_End_Game_Item (Callback : Generic_Callback) return UI_Info is begin return (UI_Item_Configurable, Null_Ptr, Null_Ptr, First_Marshaller'Address, new Data_Type_Record'(Callback, null), Null_Address, Pixmap_None, Null_Address, To_Gint (Configurable_Item_End_Game), 0, Null_Address); end UI_Info_Menu_End_Game_Item; ---------------------------- -- UI_Info_Menu_Exit_Item -- ---------------------------- function UI_Info_Menu_Exit_Item (Callback : Generic_Callback) return UI_Info is begin return (UI_Item_Configurable, Null_Ptr, Null_Ptr, First_Marshaller'Address, new Data_Type_Record'(Callback, null), Null_Address, Pixmap_None, Null_Address, To_Gint (Configurable_Item_Exit), 0, Null_Address); end UI_Info_Menu_Exit_Item; ---------------------------- -- UI_Info_Menu_File_Tree -- ---------------------------- function UI_Info_Menu_File_Tree (Tree : UI_Info_Array_Access) return UI_Info is begin return (UI_Subtree_Stock, New_String (-"_File"), Null_Ptr, Tree.all'Address, null, Null_Address, Pixmap_None, Null_Address, 0, 0, Null_Address); end UI_Info_Menu_File_Tree; ----------------------------- -- UI_Info_Menu_Files_Tree -- ----------------------------- function UI_Info_Menu_Files_Tree (Tree : UI_Info_Array_Access) return UI_Info is begin return (UI_Subtree_Stock, New_String (-"Fi_les"), Null_Ptr, Tree.all'Address, null, Null_Address, Pixmap_None, Null_Address, 0, 0, Null_Address); end UI_Info_Menu_Files_Tree; ---------------------------------- -- UI_Info_Menu_Find_Again_Item -- ---------------------------------- function UI_Info_Menu_Find_Again_Item (Callback : Generic_Callback) return UI_Info is begin return (UI_Item_Configurable, Null_Ptr, Null_Ptr, First_Marshaller'Address, new Data_Type_Record'(Callback, null), Null_Address, Pixmap_None, Null_Address, To_Gint (Configurable_Item_Find_Again), 0, Null_Address); end UI_Info_Menu_Find_Again_Item; ---------------------------- -- UI_Info_Menu_Find_Item -- ---------------------------- function UI_Info_Menu_Find_Item (Callback : Generic_Callback) return UI_Info is begin return (UI_Item_Configurable, Null_Ptr, Null_Ptr, First_Marshaller'Address, new Data_Type_Record'(Callback, null), Null_Address, Pixmap_None, Null_Address, To_Gint (Configurable_Item_Find), 0, Null_Address); end UI_Info_Menu_Find_Item; ---------------------------- -- UI_Info_Menu_Game_Tree -- ---------------------------- function UI_Info_Menu_Game_Tree (Tree : UI_Info_Array_Access) return UI_Info is begin return (UI_Subtree_Stock, New_String (-"_Game"), Null_Ptr, Tree.all'Address, null, Null_Address, Pixmap_None, Null_Address, 0, 0, Null_Address); end UI_Info_Menu_Game_Tree; ---------------------------- -- UI_Info_Menu_Help_Tree -- ---------------------------- function UI_Info_Menu_Help_Tree (Tree : UI_Info_Array_Access) return UI_Info is begin return (UI_Subtree_Stock, New_String (-"_Help"), Null_Ptr, Tree.all'Address, null, Null_Address, Pixmap_None, Null_Address, 0, 0, Null_Address); end UI_Info_Menu_Help_Tree; ---------------------------- -- UI_Info_Menu_Hint_Item -- ---------------------------- function UI_Info_Menu_Hint_Item (Callback : Generic_Callback) return UI_Info is begin return (UI_Item_Configurable, Null_Ptr, Null_Ptr, First_Marshaller'Address, new Data_Type_Record'(Callback, null), Null_Address, Pixmap_None, Null_Address, To_Gint (Configurable_Item_Hint), 0, Null_Address); end UI_Info_Menu_Hint_Item; -------------------------------- -- UI_Info_Menu_New_Game_Item -- -------------------------------- function UI_Info_Menu_New_Game_Item (Callback : Generic_Callback) return UI_Info is begin return (UI_Item_Configurable, Null_Ptr, Null_Ptr, First_Marshaller'Address, new Data_Type_Record'(Callback, null), Null_Address, Pixmap_None, Null_Address, To_Gint (Configurable_Item_New_Game), 0, Null_Address); end UI_Info_Menu_New_Game_Item; --------------------------- -- UI_Info_Menu_New_Item -- --------------------------- function UI_Info_Menu_New_Item (Label : String; Tooltip : String; Callback : Generic_Callback) return UI_Info is begin return (UI_Item_Configurable, New_String (Label), New_String (Tooltip), First_Marshaller'Address, new Data_Type_Record'(Callback, null), Null_Address, Pixmap_None, Null_Address, To_Gint (Configurable_Item_New), 0, Null_Address); end UI_Info_Menu_New_Item; ------------------------------ -- UI_Info_Menu_New_Subtree -- ------------------------------ function UI_Info_Menu_New_Subtree (Tree : UI_Info_Array_Access) return UI_Info is begin return (UI_Subtree_Stock, New_String (-"_New"), Null_Ptr, Tree.all'Address, null, Null_Address, Pixmap_Stock, Menu_New_String'Address, Gint (Key_Name_New), Key_Mod_New, Null_Address); end UI_Info_Menu_New_Subtree; ---------------------------------- -- UI_Info_Menu_New_Window_Item -- ---------------------------------- function UI_Info_Menu_New_Window_Item (Callback : Generic_Callback) return UI_Info is begin return (UI_Item_Configurable, Null_Ptr, Null_Ptr, First_Marshaller'Address, new Data_Type_Record'(Callback, null), Null_Address, Pixmap_None, Null_Address, To_Gint (Configurable_Item_New_Window), 0, Null_Address); end UI_Info_Menu_New_Window_Item; ---------------------------- -- UI_Info_Menu_Open_Item -- ---------------------------- function UI_Info_Menu_Open_Item (Callback : Generic_Callback) return UI_Info is begin return (UI_Item_Configurable, Null_Ptr, Null_Ptr, First_Marshaller'Address, new Data_Type_Record'(Callback, null), Null_Address, Pixmap_None, Null_Address, To_Gint (Configurable_Item_Open), 0, Null_Address); end UI_Info_Menu_Open_Item; ----------------------------- -- UI_Info_Menu_Paste_Item -- ----------------------------- function UI_Info_Menu_Paste_Item (Callback : Generic_Callback) return UI_Info is begin return (UI_Item_Configurable, Null_Ptr, Null_Ptr, First_Marshaller'Address, new Data_Type_Record'(Callback, null), Null_Address, Pixmap_None, Null_Address, To_Gint (Configurable_Item_Paste), 0, Null_Address); end UI_Info_Menu_Paste_Item; ---------------------------------- -- UI_Info_Menu_Pause_Game_Item -- ---------------------------------- function UI_Info_Menu_Pause_Game_Item (Callback : Generic_Callback) return UI_Info is begin return (UI_Item_Configurable, Null_Ptr, Null_Ptr, First_Marshaller'Address, new Data_Type_Record'(Callback, null), Null_Address, Pixmap_None, Null_Address, To_Gint (Configurable_Item_Pause_Game), 0, Null_Address); end UI_Info_Menu_Pause_Game_Item; ----------------------------------- -- UI_Info_Menu_Preferences_Item -- ----------------------------------- function UI_Info_Menu_Preferences_Item (Callback : Generic_Callback) return UI_Info is begin return (UI_Item_Configurable, Null_Ptr, Null_Ptr, First_Marshaller'Address, new Data_Type_Record'(Callback, null), Null_Address, Pixmap_None, Null_Address, To_Gint (Configurable_Item_Preferences), 0, Null_Address); end UI_Info_Menu_Preferences_Item; ----------------------------- -- UI_Info_Menu_Print_Item -- ----------------------------- function UI_Info_Menu_Print_Item (Callback : Generic_Callback) return UI_Info is begin return (UI_Item_Configurable, Null_Ptr, Null_Ptr, First_Marshaller'Address, new Data_Type_Record'(Callback, null), Null_Address, Pixmap_None, Null_Address, To_Gint (Configurable_Item_Print), 0, Null_Address); end UI_Info_Menu_Print_Item; ----------------------------------- -- UI_Info_Menu_Print_Setup_Item -- ----------------------------------- function UI_Info_Menu_Print_Setup_Item (Callback : Generic_Callback) return UI_Info is begin return (UI_Item_Configurable, Null_Ptr, Null_Ptr, First_Marshaller'Address, new Data_Type_Record'(Callback, null), Null_Address, Pixmap_None, Null_Address, To_Gint (Configurable_Item_Print_Setup), 0, Null_Address); end UI_Info_Menu_Print_Setup_Item; ---------------------------------- -- UI_Info_Menu_Properties_Item -- ---------------------------------- function UI_Info_Menu_Properties_Item (Callback : Generic_Callback) return UI_Info is begin return (UI_Item_Configurable, Null_Ptr, Null_Ptr, First_Marshaller'Address, new Data_Type_Record'(Callback, null), Null_Address, Pixmap_None, Null_Address, To_Gint (Configurable_Item_Properties), 0, Null_Address); end UI_Info_Menu_Properties_Item; ---------------------------- -- UI_Info_Menu_Redo_Item -- ---------------------------- function UI_Info_Menu_Redo_Item (Callback : Generic_Callback) return UI_Info is begin return (UI_Item_Configurable, Null_Ptr, Null_Ptr, First_Marshaller'Address, new Data_Type_Record'(Callback, null), Null_Address, Pixmap_None, Null_Address, To_Gint (Configurable_Item_Redo), 0, Null_Address); end UI_Info_Menu_Redo_Item; --------------------------------- -- UI_Info_Menu_Redo_Move_Item -- --------------------------------- function UI_Info_Menu_Redo_Move_Item (Callback : Generic_Callback) return UI_Info is begin return (UI_Item_Configurable, Null_Ptr, Null_Ptr, First_Marshaller'Address, new Data_Type_Record'(Callback, null), Null_Address, Pixmap_None, Null_Address, To_Gint (Configurable_Item_Redo_Move), 0, Null_Address); end UI_Info_Menu_Redo_Move_Item; ------------------------------- -- UI_Info_Menu_Replace_Item -- ------------------------------- function UI_Info_Menu_Replace_Item (Callback : Generic_Callback) return UI_Info is begin return (UI_Item_Configurable, Null_Ptr, Null_Ptr, First_Marshaller'Address, new Data_Type_Record'(Callback, null), Null_Address, Pixmap_None, Null_Address, To_Gint (Configurable_Item_Replace), 0, Null_Address); end UI_Info_Menu_Replace_Item; ------------------------------------ -- UI_Info_Menu_Restart_Game_Item -- ------------------------------------ function UI_Info_Menu_Restart_Game_Item (Callback : Generic_Callback) return UI_Info is begin return (UI_Item_Configurable, Null_Ptr, Null_Ptr, First_Marshaller'Address, new Data_Type_Record'(Callback, null), Null_Address, Pixmap_None, Null_Address, To_Gint (Configurable_Item_Restart_Game), 0, Null_Address); end UI_Info_Menu_Restart_Game_Item; ------------------------------ -- UI_Info_Menu_Revert_Item -- ------------------------------ function UI_Info_Menu_Revert_Item (Callback : Generic_Callback) return UI_Info is begin return (UI_Item_Configurable, Null_Ptr, Null_Ptr, First_Marshaller'Address, new Data_Type_Record'(Callback, null), Null_Address, Pixmap_None, Null_Address, To_Gint (Configurable_Item_Revert), 0, Null_Address); end UI_Info_Menu_Revert_Item; ------------------------------- -- UI_Info_Menu_Save_As_Item -- ------------------------------- function UI_Info_Menu_Save_As_Item (Callback : Generic_Callback) return UI_Info is begin return (UI_Item_Configurable, Null_Ptr, Null_Ptr, First_Marshaller'Address, new Data_Type_Record'(Callback, null), Null_Address, Pixmap_None, Null_Address, To_Gint (Configurable_Item_Save_As), 0, Null_Address); end UI_Info_Menu_Save_As_Item; ---------------------------- -- UI_Info_Menu_Save_Item -- ---------------------------- function UI_Info_Menu_Save_Item (Callback : Generic_Callback) return UI_Info is begin return (UI_Item_Configurable, Null_Ptr, Null_Ptr, First_Marshaller'Address, new Data_Type_Record'(Callback, null), Null_Address, Pixmap_None, Null_Address, To_Gint (Configurable_Item_Save), 0, Null_Address); end UI_Info_Menu_Save_Item; ------------------------------ -- UI_Info_Menu_Scores_Item -- ------------------------------ function UI_Info_Menu_Scores_Item (Callback : Generic_Callback) return UI_Info is begin return (UI_Item_Configurable, Null_Ptr, Null_Ptr, First_Marshaller'Address, new Data_Type_Record'(Callback, null), Null_Address, Pixmap_None, Null_Address, To_Gint (Configurable_Item_Scores), 0, Null_Address); end UI_Info_Menu_Scores_Item; ---------------------------------- -- UI_Info_Menu_Select_All_Item -- ---------------------------------- function UI_Info_Menu_Select_All_Item (Callback : Generic_Callback) return UI_Info is begin return (UI_Item_Configurable, Null_Ptr, Null_Ptr, First_Marshaller'Address, new Data_Type_Record'(Callback, null), Null_Address, Pixmap_None, Null_Address, To_Gint (Configurable_Item_Select_All), 0, Null_Address); end UI_Info_Menu_Select_All_Item; -------------------------------- -- UI_Info_Menu_Settings_Tree -- -------------------------------- function UI_Info_Menu_Settings_Tree (Tree : UI_Info_Array_Access) return UI_Info is begin return (UI_Subtree_Stock, New_String (-"_Settings"), Null_Ptr, Tree.all'Address, null, Null_Address, Pixmap_None, Null_Address, 0, 0, Null_Address); end UI_Info_Menu_Settings_Tree; ---------------------------- -- UI_Info_Menu_Undo_Item -- ---------------------------- function UI_Info_Menu_Undo_Item (Callback : Generic_Callback) return UI_Info is begin return (UI_Item_Configurable, Null_Ptr, Null_Ptr, First_Marshaller'Address, new Data_Type_Record'(Callback, null), Null_Address, Pixmap_None, Null_Address, To_Gint (Configurable_Item_Undo), 0, Null_Address); end UI_Info_Menu_Undo_Item; --------------------------------- -- UI_Info_Menu_Undo_Move_Item -- --------------------------------- function UI_Info_Menu_Undo_Move_Item (Callback : Generic_Callback) return UI_Info is begin return (UI_Item_Configurable, Null_Ptr, Null_Ptr, First_Marshaller'Address, new Data_Type_Record'(Callback, null), Null_Address, Pixmap_None, Null_Address, To_Gint (Configurable_Item_Undo_Move), 0, Null_Address); end UI_Info_Menu_Undo_Move_Item; ---------------------------- -- UI_Info_Menu_View_Tree -- ---------------------------- function UI_Info_Menu_View_Tree (Tree : UI_Info_Array_Access) return UI_Info is begin return (UI_Subtree_Stock, New_String (-"_View"), Null_Ptr, Tree.all'Address, null, Null_Address, Pixmap_None, Null_Address, 0, 0, Null_Address); end UI_Info_Menu_View_Tree; ------------------------------- -- UI_Info_Menu_Windows_Tree -- ------------------------------- function UI_Info_Menu_Windows_Tree (Tree : UI_Info_Array_Access) return UI_Info is begin return (UI_Subtree_Stock, New_String (-"_Windows"), Null_Ptr, Tree.all'Address, null, Null_Address, Pixmap_None, Null_Address, 0, 0, Null_Address); end UI_Info_Menu_Windows_Tree; ----------------------- -- UI_Info_Radioitem -- ----------------------- function UI_Info_Radioitem (Label : String; Tooltip : String; Callback : Generic_Callback; Xpm_Data : Chars_Ptr_Array) return UI_Info is begin return (UI_Item, New_String (Label), New_String (Tooltip), First_Marshaller'Address, new Data_Type_Record'(Callback, null), Null_Address, Pixmap_Data, Xpm_Data'Address, 0, 0, Null_Address); end UI_Info_Radioitem; --------------------- -- UI_Info_Subtree -- --------------------- function UI_Info_Subtree (Label : String; Tree : UI_Info_Array_Access) return UI_Info is begin return (UI_Subtree, New_String (Label), Null_Ptr, Tree.all'Address, null, Null_Address, Pixmap_None, Null_Address, 0, 0, Null_Address); end UI_Info_Subtree; -------------------------- -- UI_Info_Subtree_Hint -- -------------------------- function UI_Info_Subtree_Hint (Label : String; Hint : String; Tree : UI_Info_Array_Access) return UI_Info is begin return (UI_Subtree, New_String (Label), New_String (Hint), Tree.all'Address, null, Null_Address, Pixmap_None, Null_Address, 0, 0, Null_Address); end UI_Info_Subtree_Hint; --------------------------- -- UI_Info_Subtree_Stock -- --------------------------- function UI_Info_Subtree_Stock (Label : String; Tree : UI_Info_Array_Access; Stock_Id : String) return UI_Info is begin return (UI_Subtree, New_String (Label), Null_Ptr, Tree.all'Address, null, Null_Address, Pixmap_Stock, Stock_Id'Address, 0, 0, Null_Address); end UI_Info_Subtree_Stock; ------------------------ -- UI_Info_Toggleitem -- ------------------------ function UI_Info_Toggleitem (Label : String; Tooltip : String; Callback : Generic_Callback; Xpm_Data : Chars_Ptr_Array) return UI_Info is begin return (UI_Toggleitem, New_String (Label), New_String (Tooltip), First_Marshaller'Address, new Data_Type_Record'(Callback, null), Null_Address, Pixmap_Data, Xpm_Data'Address, 0, 0, Null_Address); end UI_Info_Toggleitem; ----------------- -- UI_New_Item -- ----------------- function UI_New_Item (Label : String; Hint : String := ""; Callback : Generic_Callback := null; Pixmap_Type : UI_Pixmap_Type := Pixmap_None; Pixmap_Info : String := ""; Accelerator_Key : Gdk_Key_Type := 0; Ac_Mods : Gdk_Modifier_Type := 0) return UI_Info is The_Hint : Chars_Ptr; Info : aliased constant String := Pixmap_Info & ASCII.NUL; Pixmap : System.Address; begin if Hint'Length = 0 then The_Hint := Null_Ptr; else The_Hint := New_String (Hint); end if; if Pixmap_Info'Length = 0 then Pixmap := Null_Address; else Pixmap := Info'Address; end if; return (UI_Item, New_String (Label), The_Hint, First_Marshaller'Address, new Data_Type_Record'(Callback, null), Null_Address, Pixmap_Type, Pixmap, Gint (Accelerator_Key), Ac_Mods, Null_Address); end UI_New_Item; -------------------- -- UI_New_Subtree -- -------------------- function UI_New_Subtree (Label : String; Info : UI_Info_Array_Access; Pixmap_Type : UI_Pixmap_Type := Pixmap_None; Pixmap_Info : String := ""; Accelerator_Key : Gdk_Key_Type := 0; Ac_Mods : Gdk_Modifier_Type := 0) return UI_Info is Str : aliased constant String := Pixmap_Info & ASCII.NUL; Pixmap : System.Address; begin if Pixmap_Info'Length = 0 then Pixmap := Null_Address; else Pixmap := Str'Address; end if; return (UI_Subtree, New_String (Label), Null_Ptr, Info.all'Address, null, Null_Address, Pixmap_Type, Pixmap, Gint (Accelerator_Key), Ac_Mods, Null_Address); end UI_New_Subtree; end Gnome.App_Helper;