X-Git-Url: https://ncurses.scripts.mit.edu/?p=ncurses.git;a=blobdiff_plain;f=Ada95%2Fsrc%2Fterminal_interface-curses-forms-field_types.adb;h=cff398a97dc668e731142ff40f58f696b2eabba9;hp=c681c80242b3ea682db3875afd8621c7b2795717;hb=9776951416d7fb862b9dca1f4c9f8031a5c9059b;hpb=4c309ad3b124eff80aa6b54018b5cc9f1e3d116d diff --git a/Ada95/src/terminal_interface-curses-forms-field_types.adb b/Ada95/src/terminal_interface-curses-forms-field_types.adb index c681c802..cff398a9 100644 --- a/Ada95/src/terminal_interface-curses-forms-field_types.adb +++ b/Ada95/src/terminal_interface-curses-forms-field_types.adb @@ -7,7 +7,7 @@ -- B O D Y -- -- -- ------------------------------------------------------------------------------ --- Copyright (c) 1998-2006,2008 Free Software Foundation, Inc. -- +-- Copyright (c) 1998-2009,2011 Free Software Foundation, Inc. -- -- -- -- Permission is hereby granted, free of charge, to any person obtaining a -- -- copy of this software and associated documentation files (the -- @@ -35,8 +35,8 @@ ------------------------------------------------------------------------------ -- Author: Juergen Pfeifer, 1996 -- Version Control: --- $Revision: 1.20 $ --- $Date: 2008/07/26 18:50:33 $ +-- $Revision: 1.22 $ +-- $Date: 2011/03/08 01:16:49 $ -- Binding Version 01.00 ------------------------------------------------------------------------------ with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; @@ -68,7 +68,7 @@ package body Terminal_Interface.Curses.Forms.Field_Types is -- | -- | -- | - function Get_Type (Fld : in Field) return Field_Type_Access + function Get_Type (Fld : Field) return Field_Type_Access is Low_Level : constant C_Field_Type := Get_Fieldtype (Fld); Arg : Argument_Access; @@ -92,31 +92,13 @@ package body Terminal_Interface.Curses.Forms.Field_Types is end if; end Get_Type; - function Make_Arg (Args : System.Address) return System.Address - is - -- Actually args is a double indirected pointer to the arguments - -- of a C variable argument list. In theory it is now quite - -- complicated to write portable routine that reads the arguments, - -- because one has to know the growth direction of the stack and - -- the sizes of the individual arguments. - -- Fortunately we are only interested in the first argument (#0), - -- we know its size and for the first arg we don't care about - -- into which stack direction we have to proceed. We simply - -- resolve the double indirection and thats it. - type V is access all System.Address; - function To_Access is new Ada.Unchecked_Conversion (System.Address, - V); - begin - return To_Access (To_Access (Args).all).all; - end Make_Arg; - function Copy_Arg (Usr : System.Address) return System.Address is begin return Usr; end Copy_Arg; - procedure Free_Arg (Usr : in System.Address) + procedure Free_Arg (Usr : System.Address) is procedure Free_Type is new Ada.Unchecked_Deallocation (Field_Type'Class, Field_Type_Access); @@ -151,7 +133,7 @@ package body Terminal_Interface.Curses.Forms.Field_Types is function Set_Fld_Type (F : Field := Fld; Cf : C_Field_Type := Cft; Arg1 : Argument_Access) return C_Int; - pragma Import (C, Set_Fld_Type, "set_field_type"); + pragma Import (C, Set_Fld_Type, "set_field_type_user"); begin pragma Assert (Low_Level /= Null_Field_Type); @@ -177,7 +159,7 @@ package body Terminal_Interface.Curses.Forms.Field_Types is end Wrap_Builtin; function Field_Check_Router (Fld : Field; - Usr : System.Address) return C_Int + Usr : System.Address) return Curses_Bool is Arg : constant Argument_Access := To_Argument_Access (Usr); begin @@ -191,7 +173,7 @@ package body Terminal_Interface.Curses.Forms.Field_Types is end Field_Check_Router; function Char_Check_Router (Ch : C_Int; - Usr : System.Address) return C_Int + Usr : System.Address) return Curses_Bool is Arg : constant Argument_Access := To_Argument_Access (Usr); begin @@ -205,7 +187,7 @@ package body Terminal_Interface.Curses.Forms.Field_Types is end Char_Check_Router; function Next_Router (Fld : Field; - Usr : System.Address) return C_Int + Usr : System.Address) return Curses_Bool is Arg : constant Argument_Access := To_Argument_Access (Usr); begin @@ -219,7 +201,7 @@ package body Terminal_Interface.Curses.Forms.Field_Types is end Next_Router; function Prev_Router (Fld : Field; - Usr : System.Address) return C_Int + Usr : System.Address) return Curses_Bool is Arg : constant Argument_Access := To_Argument_Access (Usr); begin