File: gtk-marshallers.ads

package info (click to toggle)
libgtkada2 2.8.1-6lenny3
  • links: PTS, VCS
  • area: main
  • in suites: lenny
  • size: 13,496 kB
  • ctags: 3,886
  • sloc: ada: 103,189; ansic: 45,411; perl: 5,500; sh: 2,812; makefile: 1,169; xml: 19
file content (541 lines) | stat: -rw-r--r-- 20,342 bytes parent folder | download | duplicates (2)
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
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
-----------------------------------------------------------------------
--               GtkAda - Ada95 binding for Gtk+/Gnome               --
--                                                                   --
--   Copyright (C) 1998-2000 E. Briot, J. Brobecker and A. Charlet   --
--                Copyright (C) 2000-2006 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.                                       --
--                                                                   --
-----------------------------------------------------------------------

--  <description>
--  This package provides a set of generic packages to easily create
--  some Marshallers. Although this package has been designed to be
--  easily reusable, its primary aim is to simplify the use of callbacks.
--
--  Note that most users don't need to understand or even look at this
--  package, since the main functions are also renamed in the Gtk.Handlers
--  package (They are called To_Marshaller). This package is rather
--  complex (generic packages inside generic packages), and thus you should
--  understand correctly how Gtk.Handlers work before looking at this one.
--
--  To understand the paradigm used in this package, some definitions
--  are necessary:
--
--     A Handler, or Callback, is a subprogram provided by the user.
--     This handler, when attached to a particular object, will be
--     called when certain events happen during the life of this
--     object. All handlers take as a first argument an access to
--     the object they were attached to. Depending on the signal, this
--     handler can also have some extra parameters; most of the time,
--     only one extra parameter will be used. For more information about
--     Handlers, refer to the package Gtk.Handlers, where this notion is
--     explained in more details.
--
--     A General_Handler is an access to any Handler. Note that this is
--     a type used internally, most users should *not* be using it. It is
--     publicly declared so that users can create new marshallers that
--     would not be already provided here.
--
--     A Handler_Proxy is a subprogram that calls its associated
--     handler with the appropriate arguments (from an array of arguments
--     stored in Glib.Values.GValues)
--
--     A Marshaller is the association of a General_Handler and a
--     Handler_Proxy.
--
--  This package is divided in four generic packages. Each package has
--  been designed to cover a certain kind of callback by providing the
--  associated marshallers. There are two primary factors that describe
--  a callback, and that decide which marshaller to use: Does the
--  callback have access to some user data?  Does the callback return
--  some value?
--
--  Depending on that, the appropriate generic package should be chosen.
--  For example, if the callback returns a value, but does not expect
--  user data, then the "Return_Marshallers" package should be used.
--  More details about the usage of each package is provided individually
--  below.
--
--  Each of these packages is in turn divided into three generic
--  sub-packages.  The organization of these subpackages is always the
--  same :
--     o The type "Handler" is defined. It describes the profile of the
--       Handler covered in this generic package.
--     o a "To_Marshaller" function is provided to build a Marshaller
--       from any Handler.
--     o A "Emit_By_Name" procedure is also provided to allow the user
--       to "emit" a signal. This service is explained in more details in
--       Gtk.Handlers.
--     o A private function "Call" is also defined. This is the actual
--       Handler_Proxy that will be used when creating Marshallers with
--       the "To_Marshaller" service.
--
--  Once again, selecting the right generic sub-package depends on the
--  callback. For instance, the first sub-package, always called
--  "Generic_Marshaller", is to be used when the handler has one extra
--  argument which is a simple non-tagged type. More details about the
--  usage of each sub-package is also provided individually.
--
--  Although most of the cases are covered by the packages below, some
--  unusual cases may appear. This is the case for example when the
--  callback accepts several extra parameters. In such cases, two options
--  are available: The first option is to use the "standard" callback
--  mechanism with one parameter, this parameter being an array of
--  arguments that you will parse yourself. The second option is to
--  create a new Marshaller package. This is more interesting if more
--  than one callback will follow the same pattern. The body of this
--  package can be used as a good model to build such new marshallers.
--  See also the example in the GtkAda distribution for how to create your
--  own marshallers.
--
--  </description>
--  <group>Signal handling</group>
--  <c_version>2.8.17</c_version>

with Glib.Object;
with Gtk.Widget;
with Glib.Values;

package Gtk.Marshallers is

   --  <doc_ignore>Do not create automatic documentation for this package

   type General_Handler is access procedure;

   --------------------------------------------------------------
   --  Return Marshallers: Return a value, don't have user data
   --------------------------------------------------------------

   generic
      type Widget_Type is new Glib.Object.GObject_Record with private;
      type Return_Type is (<>);
   package Return_Marshallers is

      type Handler_Proxy is access function
        (Widget  : access Widget_Type'Class;
         Params  : Glib.Values.GValues;
         Cb      : General_Handler) return Return_Type;

      type Marshaller is record
         Func  : General_Handler;   --  User callback
         Proxy : Handler_Proxy;     --  Handler_Proxy for this callback
      end record;

      --  Basic Marshaller
      generic
         type Base_Type is private;
         with function Conversion
           (Value : Glib.Values.GValue) return Base_Type;

      package Generic_Marshaller is
         type Handler is access function
           (Widget : access Widget_Type'Class;
            Param  : Base_Type) return Return_Type;

         function To_Marshaller (Cb : Handler) return Marshaller;

         function Emit_By_Name
           (Object : access Widget_Type'Class;
            Name   : String;
            Param  : Base_Type) return Return_Type;
         --  The function above should be used when Base_Type can be passed
         --  as is to C.

         generic
            with function Conversion (Param : Base_Type) return System.Address;
         function Emit_By_Name_Generic
           (Object : access Widget_Type'Class;
            Name   : String;
            Param  : Base_Type) return Return_Type;
         --  Provide an explicit conversion function for PARAM.

      private
         function Call
           (Widget : access Widget_Type'Class;
            Params : Glib.Values.GValues;
            Cb     : General_Handler) return Return_Type;

         Call_Access : constant Handler_Proxy := Call'Access;
      end Generic_Marshaller;

      --  Widget Marshaller
      generic
         type Base_Type is new Gtk.Widget.Gtk_Widget_Record with private;
         type Access_Type is access all Base_Type'Class;
      package Generic_Widget_Marshaller is
         type Handler is access function
           (Widget : access Widget_Type'Class;
            Param  : access Base_Type'Class) return Return_Type;

         function To_Marshaller (Cb : Handler) return Marshaller;

         function Emit_By_Name
           (Object : access Widget_Type'Class;
            Name   : String;
            Param  : access Base_Type'Class) return Return_Type;

      private
         function Call
           (Widget : access Widget_Type'Class;
            Params : Glib.Values.GValues;
            Cb     : General_Handler) return Return_Type;

         Call_Access : constant Handler_Proxy := Call'Access;
      end Generic_Widget_Marshaller;

      --  Void Marshaller
      package Void_Marshaller is
         type Handler is access function
           (Widget : access Widget_Type'Class) return Return_Type;

         function To_Marshaller (Cb : Handler) return Marshaller;

         function Emit_By_Name
           (Object : access Widget_Type'Class;
            Name   : String) return Return_Type;

      private
         function Call
           (Widget : access Widget_Type'Class;
            Params : Glib.Values.GValues;
            Cb     : General_Handler) return Return_Type;

         Call_Access : constant Handler_Proxy := Call'Access;
      end Void_Marshaller;
   end Return_Marshallers;

   --------------------------------------------------------------
   --  User_Return_Marshallers: Return a value, have a user data
   --------------------------------------------------------------

   generic
      type Widget_Type is new Glib.Object.GObject_Record with private;
      type Return_Type is (<>);
      type User_Type (<>) is private;
   package User_Return_Marshallers is

      type Handler_Proxy is access function
        (Widget    : access Widget_Type'Class;
         Params    : Glib.Values.GValues;
         Cb        : General_Handler;
         User_Data : User_Type) return Return_Type;

      type Marshaller is record
         Func  : General_Handler;
         Proxy : Handler_Proxy;
      end record;

      --  Basic Marshaller
      generic
         type Base_Type is private;
         with function Conversion
           (Value : Glib.Values.GValue) return Base_Type;

      package Generic_Marshaller is
         type Handler is access function
           (Widget    : access Widget_Type'Class;
            Param     : Base_Type;
            User_Data : User_Type) return Return_Type;
         function To_Marshaller (Cb : Handler) return Marshaller;

         function Emit_By_Name
           (Object : access Widget_Type'Class;
            Name   : String;
            Param  : Base_Type) return Return_Type;
         --  The function above should be used when BASE_TYPE can be passed
         --  as is to C.

         generic
            with function Conversion (Param : Base_Type) return System.Address;
         function Emit_By_Name_Generic
           (Object : access Widget_Type'Class;
            Name   : String;
            Param  : Base_Type) return Return_Type;
         --  Provide an explicit conversion function for PARAM.
      private
         function Call
           (Widget    : access Widget_Type'Class;
            Params    : Glib.Values.GValues;
            Cb        : General_Handler;
            User_Data : User_Type) return Return_Type;

         Call_Access : constant Handler_Proxy := Call'Access;
      end Generic_Marshaller;

      --  Widget Marshaller
      generic
         type Base_Type is new Gtk.Widget.Gtk_Widget_Record with private;
         type Access_Type is access all Base_Type'Class;
      package Generic_Widget_Marshaller is
         type Handler is access function
           (Widget    : access Widget_Type'Class;
            Param     : access Base_Type'Class;
            User_Data : User_Type) return Return_Type;

         function To_Marshaller (Cb : Handler) return Marshaller;

         function Emit_By_Name
           (Object : access Widget_Type'Class;
            Name   : String;
            Param  : access Base_Type'Class) return Return_Type;

      private
         function Call
           (Widget    : access Widget_Type'Class;
            Params    : Glib.Values.GValues;
            Cb        : General_Handler;
            User_Data : User_Type) return Return_Type;

         Call_Access : constant Handler_Proxy := Call'Access;
      end Generic_Widget_Marshaller;

      --  Void Marshaller
      package Void_Marshaller is
         type Handler is access function
           (Widget    : access Widget_Type'Class;
            User_Data : User_Type) return Return_Type;

         function To_Marshaller (Cb : Handler) return Marshaller;

         function Emit_By_Name
           (Object : access Widget_Type'Class;
            Name   : String) return Return_Type;

      private
         function Call
           (Widget    : access Widget_Type'Class;
            Params    : Glib.Values.GValues;
            Cb        : General_Handler;
            User_Data : User_Type) return Return_Type;

         Call_Access : constant Handler_Proxy := Call'Access;
      end Void_Marshaller;

   end User_Return_Marshallers;

   -----------------
   --  Callback_Marshallers: Do not return a value, no user data
   -----------------

   generic
      type Widget_Type is new Glib.Object.GObject_Record with private;
   package Void_Marshallers is

      type Handler_Proxy is access procedure
        (Widget : access Widget_Type'Class;
         Params : Glib.Values.GValues;
         Cb     : General_Handler);

      type Marshaller is record
         Func  : General_Handler;
         Proxy : Handler_Proxy;
      end record;

      --  Basic Marshaller
      generic
         type Base_Type is private;
         with function Conversion
           (Value : Glib.Values.GValue) return Base_Type;

      package Generic_Marshaller is
         type Handler is access procedure
           (Widget : access Widget_Type'Class;
            Param  : Base_Type);

         function To_Marshaller (Cb : Handler) return Marshaller;

         procedure Emit_By_Name
           (Object : access Widget_Type'Class;
            Name   : String;
            Param  : Base_Type);
         --  The function above should be used when BASE_TYPE can be passed
         --  as is to C.

         generic
            with function Conversion (Param : Base_Type) return System.Address;
         procedure Emit_By_Name_Generic
           (Object : access Widget_Type'Class;
            Name   : String;
            Param  : Base_Type);
         --  Provide an explicit conversion function for PARAM.

      private
         procedure Call
           (Widget : access Widget_Type'Class;
            Params : Glib.Values.GValues;
            Cb     : General_Handler);

         Call_Access : constant Handler_Proxy := Call'Access;
      end Generic_Marshaller;

      --  Widget Marshaller
      generic
         type Base_Type is new Gtk.Widget.Gtk_Widget_Record with private;
         type Access_Type is access all Base_Type'Class;
      package Generic_Widget_Marshaller is
         type Handler is access procedure
           (Widget : access Widget_Type'Class;
            Param  : access Base_Type'Class);

         function To_Marshaller (Cb : Handler) return Marshaller;

         procedure Emit_By_Name
           (Object : access Widget_Type'Class;
            Name   : String;
            Param  : access Base_Type'Class);

      private
         procedure Call
           (Widget : access Widget_Type'Class;
            Params : Glib.Values.GValues;
            Cb     : General_Handler);

         Call_Access : constant Handler_Proxy := Call'Access;
      end Generic_Widget_Marshaller;

      --  Void Marshaller
      package Void_Marshaller is
         type Handler is access procedure (Widget : access Widget_Type'Class);

         function To_Marshaller (Cb : Handler) return Marshaller;

         procedure Emit_By_Name
           (Object : access Widget_Type'Class;
            Name   : String);

      private
         procedure Call
           (Widget : access Widget_Type'Class;
            Params : Glib.Values.GValues;
            Cb     : General_Handler);

         Call_Access : constant Handler_Proxy := Call'Access;
      end Void_Marshaller;

   end Void_Marshallers;

   ----------------------------------------------------------------------
   --  User_Callback_Marshallers: Do not return a value, have user data
   ----------------------------------------------------------------------

   generic
      type Widget_Type is new Glib.Object.GObject_Record with private;
      type User_Type (<>) is private;
   package User_Void_Marshallers is
      type Handler_Proxy is access procedure
        (Widget    : access Widget_Type'Class;
         Params    : Glib.Values.GValues;
         Cb        : General_Handler;
         User_Data : User_Type);

      type Marshaller is record
         Func  : General_Handler;
         Proxy : Handler_Proxy;
      end record;

      --  Basic Marshaller
      generic
         type Base_Type is private;
         with function Conversion
           (Value : Glib.Values.GValue) return Base_Type;

      package Generic_Marshaller is
         type Handler is access procedure
           (Widget    : access Widget_Type'Class;
            Param     : Base_Type;
            User_Data : User_Type);

         function To_Marshaller (Cb : Handler) return Marshaller;

         procedure Emit_By_Name
           (Object : access Widget_Type'Class;
            Name   : String;
            Param  : Base_Type);
         --  The function above should be used when BASE_TYPE can be passed
         --  as is to C.

         generic
            with function Conversion (Param : Base_Type) return System.Address;
         procedure Emit_By_Name_Generic
           (Object : access Widget_Type'Class;
            Name   : String;
            Param  : Base_Type);
         --  Provide an explicit conversion function for PARAM.

      private
         procedure Call
           (Widget    : access Widget_Type'Class;
            Params    : Glib.Values.GValues;
            Cb        : General_Handler;
            User_Data : User_Type);

         Call_Access : constant Handler_Proxy := Call'Access;
      end Generic_Marshaller;

      --  Widget Marshaller
      generic
         type Base_Type is new Gtk.Widget.Gtk_Widget_Record with private;
         type Access_Type is access all Base_Type'Class;
      package Generic_Widget_Marshaller is
         type Handler is access procedure
           (Widget    : access Widget_Type'Class;
            Param     : access Base_Type'Class;
            User_Data : User_Type);

         function To_Marshaller (Cb : Handler) return Marshaller;

         procedure Emit_By_Name
           (Object : access Widget_Type'Class;
            Name   : String;
            Param  : access Base_Type'Class);

      private
         procedure Call
           (Widget    : access Widget_Type'Class;
            Params    : Glib.Values.GValues;
            Cb        : General_Handler;
            User_Data : User_Type);

         Call_Access : constant Handler_Proxy := Call'Access;
      end Generic_Widget_Marshaller;

      --  Void Marshaller
      package Void_Marshaller is
         type Handler is access procedure
           (Widget    : access Widget_Type'Class;
            User_Data : User_Type);

         function To_Marshaller (Cb : Handler) return Marshaller;

         procedure Emit_By_Name
           (Object : access Widget_Type'Class;
            Name   : String);

      private
         procedure Call
           (Widget    : access Widget_Type'Class;
            Params    : Glib.Values.GValues;
            Cb        : General_Handler;
            User_Data : User_Type);

         Call_Access : constant Handler_Proxy := Call'Access;
      end Void_Marshaller;

   end User_Void_Marshallers;

   --  </doc_ignore>
end Gtk.Marshallers;