← Back to branch summary

~ubuntu-branches/ubuntu/precise/gnat-gps/precise

« back to all changes in this revision

Viewing changes to .pc/libgtkada2.24.0-dev-part1.patch/gvd/gvd/items-records.ads

  • Committer: Package Import Robot
  • Author(s): Ludovic Brenta
  • Date: 2012-01-15 15:42:21 UTC
  • mfrom: (10.1.10 sid)
  • Revision ID: package-import@ubuntu.com-20120115154221-ccysuzvh02pkhuwq
Tags: 5.0-6
Rebuild against libgtkada 2.24.1.

Show diffs side-by-side

added added

removed removed

Lines of Context:
.pc/libgtkada2.24.0-dev-part1.patch/gvd/gvd/items-records.ads
 
1
-----------------------------------------------------------------------
 
2
--                               G P S                               --
 
3
--                                                                   --
 
4
--                    Copyright (C) 2000-2008, AdaCore               --
 
5
--                                                                   --
 
6
-- GPS is free  software;  you can redistribute it and/or modify  it --
 
7
-- under the terms of the GNU General Public License as published by --
 
8
-- the Free Software Foundation; either version 2 of the License, or --
 
9
-- (at your option) any later version.                               --
 
10
--                                                                   --
 
11
-- This program is  distributed in the hope that it will be  useful, --
 
12
-- but  WITHOUT ANY WARRANTY;  without even the  implied warranty of --
 
13
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU --
 
14
-- General Public License for more details. You should have received --
 
15
-- a copy of the GNU General Public License along with this library; --
 
16
-- if not,  write to the  Free Software Foundation, Inc.,  59 Temple --
 
17
-- Place - Suite 330, Boston, MA 02111-1307, USA.                    --
 
18
-----------------------------------------------------------------------
 
19
 
 
20
--  Items used for record types.
 
21
--  See the package Items for more information on all the private subprograms.
 
22
 
 
23
with Ada.Unchecked_Deallocation;
 
24
 
 
25
package Items.Records is
 
26
 
 
27
   -------------
 
28
   -- Records --
 
29
   -------------
 
30
 
 
31
   type Record_Type (<>) is new Generic_Type with private;
 
32
   type Record_Type_Access is access all Record_Type'Class;
 
33
   --  A record type (or struct in C).
 
34
 
 
35
   function New_Record_Type (Num_Fields : Natural) return Generic_Type_Access;
 
36
   --  Create a new record type with a specific number of fields.
 
37
   --  Num_Fields can be null for a 'null record'.
 
38
 
 
39
   function Num_Fields (Item : Record_Type) return Natural;
 
40
   --  Return the number of fields in the record, or 0 for a null record.
 
41
 
 
42
   procedure Set_Field_Name
 
43
     (Item          : in out Record_Type;
 
44
      Index         : Positive;
 
45
      Name          : String;
 
46
      Variant_Parts : Natural := 0);
 
47
   --  Set the name of the Index-nth field in the record.
 
48
   --  If Variant_Parts is not 0, then the field in the record is considered
 
49
   --  as a field with a variant_part (ie whose value depends on another field
 
50
   --  in the record (Name)).
 
51
 
 
52
   function Get_Variant_Parts
 
53
     (Item  : Record_Type;
 
54
      Field : Positive) return Natural;
 
55
   --  Get the number of variant parts for a specific field in the record.
 
56
 
 
57
   function Get_Field_Name
 
58
     (Item  : Record_Type;
 
59
      Index : Positive) return GNAT.Strings.String_Access;
 
60
   --  Return the name of the Index-th field in Item.
 
61
 
 
62
   function Find_Variant_Part
 
63
     (Item     : Record_Type;
 
64
      Field    : Positive;
 
65
      Contains : String) return Items.Generic_Type_Access;
 
66
   --  Return the variant part of the field-th of Item, whose first field is
 
67
   --  Contains.
 
68
   --  null is returned if no such part is found.
 
69
   --  All variant parts become invalid, except for the one that is returned.
 
70
   --  If Contains is the empty string, this returns the first variant part
 
71
   --  that has a "null" component
 
72
 
 
73
   procedure Set_Variant_Field
 
74
     (Item          : in out Record_Type;
 
75
      Index         : Positive;
 
76
      Variant_Index : Positive;
 
77
      Value         : access Record_Type'Class);
 
78
   --  Set the Variant_Index-nth part of the Index-nth element in the array.
 
79
   --  Nothing is done if the Index-nth field in Item does not have any
 
80
   --  variant part.
 
81
 
 
82
   procedure Set_Value
 
83
     (Item  : in out Record_Type;
 
84
      Value : access Generic_Type'Class;
 
85
      Field : String);
 
86
   --  Set the value of a specific field in the record.
 
87
   --  Value is not duplicated, we simply keep a pointer to it.
 
88
 
 
89
   procedure Set_Value
 
90
     (Item  : in out Record_Type;
 
91
      Value : access Generic_Type'Class;
 
92
      Field : Positive);
 
93
   --  Same as above, for a specific field index.
 
94
 
 
95
   function Get_Value
 
96
     (Item  : Record_Type;
 
97
      Field : String) return Generic_Type_Access;
 
98
   --  Get the value of a specific field.
 
99
 
 
100
   function Get_Value
 
101
     (Item  : Record_Type;
 
102
      Field : Positive) return Generic_Type_Access;
 
103
   --  Same as above, but for a specific field index.
 
104
 
 
105
   procedure Propagate_Width
 
106
     (Item  : access Record_Type;
 
107
      Width : Glib.Gint);
 
108
 
 
109
   procedure Draw_Border
 
110
     (Item : access Record_Type;
 
111
      Draw : Boolean := True);
 
112
   --  If Draw is True (the default for new items), a border is drawn around
 
113
   --  the item when it is displayed on the screen.
 
114
 
 
115
   ------------
 
116
   -- Unions --
 
117
   ------------
 
118
 
 
119
   type Union_Type (<>) is new Record_Type with private;
 
120
   type Union_Type_Access is access all Union_Type'Class;
 
121
   --  A union type, ie a set of fields that are stored at the same address in
 
122
   --  memory.
 
123
 
 
124
   function New_Union_Type (Num_Fields : Positive) return Generic_Type_Access;
 
125
   --  Create a new union type with a specific number of fields.
 
126
 
 
127
private
 
128
 
 
129
   type Record_Type_Array;
 
130
   type Record_Type_Array_Access is access Record_Type_Array;
 
131
 
 
132
   type Record_Field is record
 
133
      Name         : GNAT.Strings.String_Access := null;
 
134
      Value        : Items.Generic_Type_Access := null;
 
135
      Variant_Part : Record_Type_Array_Access := null;
 
136
   end record;
 
137
   type Record_Field_Array is array (Natural range <>) of Record_Field;
 
138
   --  One of the fields in a record.
 
139
   --
 
140
   --  For a record with a variant part, a single item is created for that
 
141
   --  part. Its Name is the name of the variable that selects one of the
 
142
   --  alternatives. Value is null.
 
143
   --  This is the only case where Variant_Part is not null and contains the
 
144
   --  list of all alternatives.
 
145
 
 
146
   type Record_Type (Num_Fields : Natural) is new Generic_Type with record
 
147
      Gui_Fields_Width : Glib.Gint := 0;
 
148
      --  Width allocated for the field names column when drawing the item
 
149
      --  on a pixmap. This is calculated once when Size_Request is called.
 
150
 
 
151
      Type_Height      : Glib.Gint := 0;
 
152
      --  Height of the first line used to display the type of the item.
 
153
 
 
154
      Border_Spacing   : Glib.Gint := Items.Border_Spacing;
 
155
      --  Size to leave on each size between the border and the actual
 
156
      --  display of the item. If this is set to 0, then no border is drawn.
 
157
 
 
158
      Fields           : Record_Field_Array (1 .. Num_Fields);
 
159
   end record;
 
160
   --  Num_Fields can be 0 in case of a 'null record'. Thus, it has to be
 
161
   --  a Natural.
 
162
 
 
163
   type Record_Type_Array is array (Positive range <>) of Record_Type_Access;
 
164
   procedure Free is new Ada.Unchecked_Deallocation
 
165
     (Record_Type_Array, Record_Type_Array_Access);
 
166
 
 
167
   overriding procedure Print (Value : Record_Type; Indent : Natural := 0);
 
168
   overriding procedure Free
 
169
     (Item : access Record_Type;
 
170
      Only_Value : Boolean := False);
 
171
   overriding procedure Clone_Dispatching
 
172
     (Item  : Record_Type;
 
173
      Clone : in out Generic_Type_Access);
 
174
   overriding procedure Paint
 
175
     (Item    : in out Record_Type;
 
176
      Context : Drawing_Context;
 
177
      Pixmap  : Gdk.Pixmap.Gdk_Pixmap;
 
178
      Lang    : Language.Language_Access;
 
179
      Mode    : Display_Mode;
 
180
      X, Y    : Glib.Gint := 0);
 
181
   overriding procedure Size_Request
 
182
     (Item           : in out Record_Type;
 
183
      Context        : Drawing_Context;
 
184
      Lang           : Language.Language_Access;
 
185
      Mode           : Display_Mode;
 
186
      Hide_Big_Items : Boolean := False);
 
187
   overriding function Get_Component_Name
 
188
     (Item : access Record_Type;
 
189
      Lang : access Language.Language_Root'Class;
 
190
      Name : String;
 
191
      X, Y : Glib.Gint) return String;
 
192
   overriding function Get_Component_Name
 
193
     (Item : access Record_Type;
 
194
      Lang : access Language.Language_Root'Class;
 
195
      Name : String;
 
196
      Comp : Generic_Type_Access) return String;
 
197
   overriding function Get_Component
 
198
     (Item : access Record_Type;
 
199
      X, Y : Glib.Gint) return Generic_Type_Access;
 
200
   overriding function Replace
 
201
     (Parent       : access Record_Type;
 
202
      Current      : access Generic_Type'Class;
 
203
      Replace_With : access Generic_Type'Class) return Generic_Type_Access;
 
204
   overriding function Structurally_Equivalent
 
205
     (Item1 : access Record_Type; Item2 : access Generic_Type'Class)
 
206
     return Boolean;
 
207
 
 
208
   type Record_Iterator is new Generic_Iterator with record
 
209
      Item  : Record_Type_Access;
 
210
      Field : Natural;
 
211
      Variant : Natural;
 
212
   end record;
 
213
   overriding function Start
 
214
     (Item : access Record_Type) return Generic_Iterator'Class;
 
215
   overriding procedure Next (Iter : in out Record_Iterator);
 
216
   overriding function At_End (Iter : Record_Iterator) return Boolean;
 
217
   overriding function Data
 
218
     (Iter : Record_Iterator) return Generic_Type_Access;
 
219
 
 
220
   type Union_Type (Num_Fields : Natural) is new Record_Type (Num_Fields)
 
221
     with null record;
 
222
   overriding procedure Print (Value : Union_Type; Indent : Natural := 0);
 
223
   --  Free is inherited from Record_Type.
 
224
 
 
225
end Items.Records;