← Back to branch summary

~ubuntu-branches/ubuntu/intrepid/libgtkada2/intrepid

« back to all changes in this revision

Viewing changes to src/gtk-widget.adb

  • Committer: Bazaar Package Importer
  • Author(s): Luca Falavigna
  • Date: 2008-08-11 09:46:51 UTC
  • mfrom: (6.1.1 squeeze)
  • Revision ID: james.westby@ubuntu.com-20080811094651-9mjd6acwa98ffw5c
Tags: 2.12.0-2ubuntu1
Add lpia to supported architectures.

Show diffs side-by-side

added added

removed removed

Lines of Context:
src/gtk-widget.adb
2
2
--               GtkAda - Ada95 binding for Gtk+/Gnome               --
3
3
--                                                                   --
4
4
--   Copyright (C) 1998-2000 E. Briot, J. Brobecker and A. Charlet   --
 
5
--                 Copyright (C) 2000-2008, AdaCore                  --
5
6
--                                                                   --
6
7
-- This library is free software; you can redistribute it and/or     --
7
8
-- modify it under the terms of the GNU General Public               --
21
21
--                                                                   --
22
22
-----------------------------------------------------------------------
23
23
 
 
24
with Ada.Unchecked_Conversion;
24
25
with Interfaces.C.Strings;        use Interfaces.C.Strings;
 
26
with System;                      use System;
 
27
 
25
28
with Glib.Values;                 use Glib.Values;
26
29
with Gdk.Color;                   use Gdk.Color;
27
30
with Gdk.Types;                   use Gdk.Types;
28
31
with Gdk.Visual;                  use Gdk.Visual;
29
 
with Ada.Unchecked_Conversion;
 
32
with Gtk.Enums;                   use Gtk.Enums;
 
33
with Gtk.Style;                   use Gtk.Style;
 
34
with Gtkada.Bindings;             use Gtkada.Bindings;
30
35
with Pango.Context;               use Pango.Context;
31
36
with Pango.Layout;                use Pango.Layout;
32
 
with Gtk.Enums;                   use Gtk.Enums;
33
 
with Gtk.Style;                   use Gtk.Style;
34
 
with System;                      use System;
 
37
 
 
38
with Glib.Type_Conversion_Hooks;
35
39
 
36
40
package body Gtk.Widget is
37
41
 
 
42
   package Type_Conversion is new Glib.Type_Conversion_Hooks.Hook_Registrator
 
43
     (Get_Type'Access, Gtk_Widget_Record);
 
44
   pragma Warnings (Off, Type_Conversion);
 
45
 
38
46
   --------------
39
47
   -- Activate --
40
48
   --------------
53
61
 
54
62
   procedure Add_Accelerator
55
63
     (Widget       : access Gtk_Widget_Record;
56
 
      Accel_Signal : String;
 
64
      Accel_Signal : Glib.Signal_Name;
57
65
      Accel_Group  : Gtk.Accel_Group.Gtk_Accel_Group;
58
66
      Accel_Key    : Gdk.Types.Gdk_Key_Type;
59
67
      Accel_Mods   : Gdk.Types.Gdk_Modifier_Type;
61
69
   is
62
70
      procedure Internal
63
71
        (Widget       : System.Address;
64
 
         Accel_Signal : String;
 
72
         Accel_Signal : Glib.Signal_Name;
65
73
         Accel_Group  : System.Address;
66
74
         Accel_Key    : Gdk.Types.Gdk_Key_Type;
67
75
         Accel_Mods   : Gdk.Types.Gdk_Modifier_Type;
134
142
   function Create_Pango_Context (Widget : access Gtk_Widget_Record)
135
143
      return Pango.Context.Pango_Context
136
144
   is
137
 
      function Internal (Widget : System.Address) return Pango_Context;
 
145
      function Internal (Widget : System.Address) return System.Address;
138
146
      pragma Import (C, Internal, "gtk_widget_create_pango_context");
 
147
      Stub : Pango_Context_Record;
139
148
   begin
140
 
      return Internal (Get_Object (Widget));
 
149
      return Pango_Context
 
150
        (Get_User_Data (Internal (Get_Object (Widget)), Stub));
141
151
   end Create_Pango_Context;
142
152
 
143
153
   -------------------------
348
358
      pragma Import (C, Internal, "gtk_widget_get_parent");
349
359
 
350
360
      S : System.Address;
351
 
      use type System.Address;
352
361
 
353
362
   begin
354
363
      S := Internal (Get_Object (Widget));
1016
1025
        (Get_User_Data (Internal (Get_Object (Widget)), Stub));
1017
1026
   end Get_Style;
1018
1027
 
1019
 
   ------------------------
1020
 
   -- Get_Modifier_Style --
1021
 
   ------------------------
1022
 
 
1023
 
   function Get_Modifier_Style
1024
 
     (Widget : access Gtk_Widget_Record) return Gtk.Style.Gtk_Style
1025
 
   is
1026
 
      function Internal (Widget : System.Address) return System.Address;
1027
 
      pragma Import (C, Internal, "gtk_widget_get_modifier_style");
1028
 
      Stub : Gtk.Style.Gtk_Style_Record;
1029
 
   begin
1030
 
      return Gtk.Style.Gtk_Style
1031
 
        (Get_User_Data (Internal (Get_Object (Widget)), Stub));
1032
 
   end Get_Modifier_Style;
1033
 
 
1034
1028
   ---------------
1035
1029
   -- Modify_Fg --
1036
1030
   ---------------
1046
1040
         Color  : System.Address);
1047
1041
      pragma Import (C, Internal, "gtk_widget_modify_fg");
1048
1042
 
1049
 
      use type Gdk.Color.Gdk_Color;
1050
1043
      Col     : aliased Gdk.Color.Gdk_Color := Color;
1051
1044
      Color_A : System.Address := Col'Address;
1052
1045
 
1073
1066
         Color  : System.Address);
1074
1067
      pragma Import (C, Internal, "gtk_widget_modify_bg");
1075
1068
 
1076
 
      use type Gdk.Color.Gdk_Color;
1077
1069
      Col     : aliased Gdk.Color.Gdk_Color := Color;
1078
1070
      Color_A : System.Address := Col'Address;
1079
1071
 
1100
1092
         Color  : System.Address);
1101
1093
      pragma Import (C, Internal, "gtk_widget_modify_text");
1102
1094
 
1103
 
      use type Gdk.Color.Gdk_Color;
1104
1095
      Col     : aliased Gdk.Color.Gdk_Color := Color;
1105
1096
      Color_A : System.Address := Col'Address;
1106
1097
 
1127
1118
         Color  : System.Address);
1128
1119
      pragma Import (C, Internal, "gtk_widget_modify_base");
1129
1120
 
1130
 
      use type Gdk.Color.Gdk_Color;
1131
1121
      Col     : aliased Gdk.Color.Gdk_Color := Color;
1132
1122
      Color_A : System.Address := Col'Address;
1133
1123
 
1183
1173
      pragma Import (C, Internal, "gtk_widget_get_ancestor");
1184
1174
 
1185
1175
      S : System.Address;
1186
 
      use type System.Address;
1187
1176
 
1188
1177
   begin
1189
1178
      S := Internal (Get_Object (Widget), Ancestor_Type);
1655
1644
         Group      : System.Address);
1656
1645
      pragma Import (C, Internal, "gtk_widget_set_accel_path");
1657
1646
 
1658
 
      S : Interfaces.C.Strings.chars_ptr;
 
1647
      S : Interfaces.C.Strings.chars_ptr := String_Or_Null (Accel_Path);
1659
1648
   begin
1660
 
      if Accel_Path = "" then
1661
 
         Internal (Get_Object (Widget), Null_Ptr, Get_Object (Group));
1662
 
      else
1663
 
         S := New_String (Accel_Path);
1664
 
         Internal (Get_Object (Widget), S, Get_Object (Group));
1665
 
         Free (S);
1666
 
      end if;
 
1649
      Internal (Get_Object (Widget), S, Get_Object (Group));
 
1650
      Free (S);
1667
1651
   end Set_Accel_Path;
1668
1652
 
1669
1653
   -----------------------
2166
2150
   function Class_List_Style_Properties
2167
2151
     (Klass : Glib.Object.GObject_Class) return Glib.Param_Spec_Array
2168
2152
   is
2169
 
      type Big_Pspec_Array is array (Positive) of Param_Spec;
2170
 
      type Big_Pspec is access all Big_Pspec_Array;
2171
 
      pragma Convention (C, Big_Pspec);
2172
 
 
 
2153
      use Pspec_Arrays;
2173
2154
      function Internal
2174
2155
        (Cclass       : GObject_Class;
2175
 
         N_Properties : access Guint) return Big_Pspec;
 
2156
         N_Properties : access Guint) return Unbounded_Array_Access;
2176
2157
      pragma Import (C, Internal, "gtk_widget_class_list_style_properties");
2177
2158
 
2178
2159
      Num     : aliased Guint;
2179
 
      C_Array : constant Big_Pspec := Internal (Klass, Num'Access);
 
2160
      C_Array : constant Unbounded_Array_Access :=
 
2161
        Internal (Klass, Num'Access);
 
2162
      Result  : constant Param_Spec_Array := To_Array (C_Array, Integer (Num));
2180
2163
 
2181
2164
   begin
2182
 
      --  Implementation is the same as
2183
 
      --  Gtk.Containers.Class_List_Child_Properties
2184
 
 
2185
 
      if C_Array = null then
2186
 
         return (1 .. 0 => null);
2187
 
      else
2188
 
         return Param_Spec_Array (C_Array (1 .. Natural (Num)));
2189
 
      end if;
 
2165
      --  Doc says we should free, but that results in double deallocation
 
2166
--      G_Free (C_Array);
 
2167
      return Result;
2190
2168
   end Class_List_Style_Properties;
2191
2169
 
2192
2170
   -----------------------