1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126 | ------------------------------------------------------------------------------
-- --
-- Copyright (C) 1998-2000 E. Briot, J. Brobecker and A. Charlet --
-- Copyright (C) 2000-2022, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or modify it --
-- under terms of the GNU General Public License as published by the Free --
-- Software Foundation; either version 3, 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 MERCHAN- --
-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception, --
-- version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
------------------------------------------------------------------------------
pragma Style_Checks (Off);
pragma Warnings (Off, "*is already use-visible*");
with Ada.Unchecked_Conversion;
package body Glib.Action_Map is
function From_Object_Free (B : access GAction_Entry) return GAction_Entry is
Result : constant GAction_Entry := B.all;
begin
Glib.g_free (B.all'Address);
return Result;
end From_Object_Free;
function Convert is new Ada.Unchecked_Conversion
(Activate_Callback, System.Address);
function Convert is new Ada.Unchecked_Conversion
(Change_State_Callback, System.Address);
function Build
(Name : String;
Activate : Activate_Callback := null;
Parameter_Type : String := "";
State : String := "";
Change_State : Change_State_Callback := null)
return GAction_Entry
is
P, S : chars_ptr := null_ptr;
begin
if Parameter_Type /= "" then
P := New_String (Parameter_Type);
end if;
if State /= "" then
S := New_String (State);
end if;
return GAction_Entry'
(Name => New_String (Name),
Activate => Convert (Activate),
Parameter_Type => P,
State => S,
Change_State => Convert (Change_State),
Padding => <>);
end Build;
------------------------
-- Add_Action_Entries --
------------------------
procedure Add_Action_Entries
(Self : Gaction_Map;
Entries : GAction_Entry_Array;
User_Data : System.Address := System.Null_Address)
is
procedure Internal
(Self : Gaction_Map;
Entries : GAction_Entry_Array;
N_Entries : Glib.Gint;
User_Data : System.Address);
pragma Import (C, Internal, "g_action_map_add_action_entries");
begin
Internal (Self, Entries, Entries'Length, User_Data);
end Add_Action_Entries;
-------------------
-- Lookup_Action --
-------------------
function Lookup_Action
(Self : Gaction_Map;
Action_Name : UTF8_String) return Glib.Action.Gaction
is
function Internal
(Self : Gaction_Map;
Action_Name : Gtkada.Types.Chars_Ptr) return Glib.Action.Gaction;
pragma Import (C, Internal, "g_action_map_lookup_action");
Tmp_Action_Name : Gtkada.Types.Chars_Ptr := New_String (Action_Name);
Tmp_Return : Glib.Action.Gaction;
begin
Tmp_Return := Internal (Self, Tmp_Action_Name);
Free (Tmp_Action_Name);
return Tmp_Return;
end Lookup_Action;
-------------------
-- Remove_Action --
-------------------
procedure Remove_Action (Self : Gaction_Map; Action_Name : UTF8_String) is
procedure Internal
(Self : Gaction_Map;
Action_Name : Gtkada.Types.Chars_Ptr);
pragma Import (C, Internal, "g_action_map_remove_action");
Tmp_Action_Name : Gtkada.Types.Chars_Ptr := New_String (Action_Name);
begin
Internal (Self, Tmp_Action_Name);
Free (Tmp_Action_Name);
end Remove_Action;
function "+" (W : Gaction_Map) return Gaction_Map is
begin
return W;
end "+";
end Glib.Action_Map;
|