1 ------------------------------------------------------------------------------
3 -- GNAT ncurses Binding --
5 -- Terminal_Interface.Curses.Forms.Field_Types --
11 -- The ncurses Ada95 binding is copyrighted 1996 by --
12 -- Juergen Pfeifer, Email: Juergen.Pfeifer@T-Online.de --
14 -- Permission is hereby granted to reproduce and distribute this --
15 -- binding by any means and for any fee, whether alone or as part --
16 -- of a larger distribution, in source or in binary form, PROVIDED --
17 -- this notice is included with any such distribution, and is not --
18 -- removed from any of its header files. Mention of ncurses and the --
19 -- author of this binding in any applications linked with it is --
20 -- highly appreciated. --
22 -- This binding comes AS IS with no warranty, implied or expressed. --
23 ------------------------------------------------------------------------------
26 ------------------------------------------------------------------------------
28 with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux;
29 with Unchecked_Deallocation;
32 -- |=====================================================================
33 -- | man page form_fieldtype.3x
34 -- |=====================================================================
36 package body Terminal_Interface.Curses.Forms.Field_Types is
38 use type Interfaces.C.int;
40 type F_Check is access
41 function (Fld : Field; Info : User_Access) return C_Int;
42 pragma Convention (C, F_Check);
44 type C_Check is access
45 function (Ch : Character; Info : User_Access) return C_Int;
46 pragma Convention (C, C_Check);
49 Unchecked_Deallocation (User, User_Access);
52 procedure Register_Field_Type;
53 procedure Unregister_Field_Type;
55 procedure Initialize (Obj : in out Tracker)
61 procedure Finalize (Obj : in out Tracker)
64 Unregister_Field_Type;
67 function Fc (Fld : Field; Info : User_Access) return C_Int;
68 pragma Convention (C, Fc);
70 function Cc (Ch : Character; Info : User_Access) return C_Int;
71 pragma Convention (C, Cc);
73 function Make_Arg (U : User_Access) return User_Access;
74 pragma Convention (C, Make_Arg);
76 function Copy_Arg (U : User_Access) return User_Access;
77 pragma Convention (C, Copy_Arg);
79 procedure Free_Arg (U : User_Access);
80 pragma Convention (C, Free_Arg);
82 function New_Fieldtype (Fc : F_Check;
83 Cc : C_Check) return C_Field_Type;
84 pragma Import (C, New_Fieldtype, "new_fieldtype");
86 function Fc (Fld : Field; Info : User_Access) return C_Int
89 return C_Int (Boolean'Pos (Field_Check (Fld, Info)));
92 function Cc (Ch : Character; Info : User_Access) return C_Int
95 return C_Int (Boolean'Pos (Character_Check (Ch, Info)));
98 function Make_Arg (U : User_Access) return User_Access
100 function Fixme (U : User_Access) return User_Access;
101 pragma Import (C, Fixme, "_nc_ada_getvarg");
102 V : constant User_Access := Fixme (U);
103 I : constant User_Access := new User'(V.all);
108 function Copy_Arg (U : User_Access) return User_Access
110 I : constant User_Access := new User'(U.all);
115 procedure Free_Arg (U : User_Access)
121 type M_Arg is access function (U : User_Access) return User_Access;
122 pragma Convention (C, M_Arg);
124 type C_Arg is access function (U : User_Access) return User_Access;
125 pragma Convention (C, C_Arg);
127 type F_Arg is access procedure (U : User_Access);
128 pragma Convention (C, F_Arg);
130 function Set_Fieldtype_Arg (Typ : C_Field_Type;
133 Fa : F_Arg) return C_Int;
134 pragma Import (C, Set_Fieldtype_Arg, "set_fieldtype_arg");
139 procedure Register_Field_Type
143 P : User_Access := new User;
144 -- we need an instance to call
145 -- the Register_Type procedure
147 Cft := New_Fieldtype (Fc'Access,
149 if Cft = Null_Field_Type then
150 raise Form_Exception;
152 Res := Set_Fieldtype_Arg (Cft,
160 Register_Type (P.all, Cft);
162 end Register_Field_Type;
166 procedure Unregister_Field_Type
168 P : User_Access := new User;
169 -- we need an instance to call
170 -- the Unregister_Type procedure
172 Unregister_Type (P.all);
174 end Unregister_Field_Type;
177 end Terminal_Interface.Curses.Forms.Field_Types;