X-Git-Url: https://ncurses.scripts.mit.edu/?p=ncurses.git;a=blobdiff_plain;f=doc%2Fhtml%2Fada%2Fterminal_interface-curses-forms-field_types-user-choice__adb.htm;h=170de3c88836f957fc7ed8ed332ccf8b4f81a72a;hp=1a84c5f68304b59cb46916d7c2685590da285993;hb=f6718d80c998008de6cfe8e6296bee3958ff86d7;hpb=55ccd2b959766810cf7db8d1c4462f338ce0afc8 diff --git a/doc/html/ada/terminal_interface-curses-forms-field_types-user-choice__adb.htm b/doc/html/ada/terminal_interface-curses-forms-field_types-user-choice__adb.htm index 1a84c5f6..170de3c8 100644 --- a/doc/html/ada/terminal_interface-curses-forms-field_types-user-choice__adb.htm +++ b/doc/html/ada/terminal_interface-curses-forms-field_types-user-choice__adb.htm @@ -12,7 +12,7 @@ -- B O D Y -- -- -- ------------------------------------------------------------------------------ --- Copyright (c) 1998,2004 Free Software Foundation, Inc. -- +-- Copyright (c) 1998-2006,2008 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 -- @@ -40,78 +40,77 @@ ------------------------------------------------------------------------------ -- Author: Juergen Pfeifer, 1996 -- Version Control: --- @Revision: 1.13 @ --- @Date: 2004/08/21 21:37:00 @ +-- @Revision: 1.15 @ +-- @Date: 2008/07/26 18:48:58 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ with Ada.Unchecked_Conversion; -with Interfaces.C; -with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; +with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; -package body Terminal_Interface.Curses.Forms.Field_Types.User.Choice is +package body Terminal_Interface.Curses.Forms.Field_Types.User.Choice is - use type Interfaces.C.int; - - function To_Argument_Access is new Ada.Unchecked_Conversion + pragma Warnings (Off); + function To_Argument_Access is new Ada.Unchecked_Conversion (System.Address, Argument_Access); + pragma Warnings (On); - function Generic_Next (Fld : Field; - Usr : System.Address) return C_Int + function Generic_Next (Fld : Field; + Usr : System.Address) return C_Int is - Result : Boolean; - Udf : constant User_Defined_Field_Type_With_Choice_Access := + Result : Boolean; + Udf : constant User_Defined_Field_Type_With_Choice_Access := User_Defined_Field_Type_With_Choice_Access - (To_Argument_Access (Usr).Typ); + (To_Argument_Access (Usr).Typ); begin - Result := Next (Fld, Udf.all); - return C_Int (Boolean'Pos (Result)); - end Generic_Next; + Result := Next (Fld, Udf.all); + return C_Int (Boolean'Pos (Result)); + end Generic_Next; - function Generic_Prev (Fld : Field; - Usr : System.Address) return C_Int + function Generic_Prev (Fld : Field; + Usr : System.Address) return C_Int is - Result : Boolean; - Udf : constant User_Defined_Field_Type_With_Choice_Access := + Result : Boolean; + Udf : constant User_Defined_Field_Type_With_Choice_Access := User_Defined_Field_Type_With_Choice_Access - (To_Argument_Access (Usr).Typ); + (To_Argument_Access (Usr).Typ); begin - Result := Previous (Fld, Udf.all); - return C_Int (Boolean'Pos (Result)); - end Generic_Prev; + Result := Previous (Fld, Udf.all); + return C_Int (Boolean'Pos (Result)); + end Generic_Prev; -- ----------------------------------------------------------------------- -- - function C_Generic_Choice return C_Field_Type + function C_Generic_Choice return C_Field_Type is - Res : Eti_Error; - T : C_Field_Type; + Res : Eti_Error; + T : C_Field_Type; begin if M_Generic_Choice = Null_Field_Type then - T := New_Fieldtype (Generic_Field_Check'Access, - Generic_Char_Check'Access); - if T = Null_Field_Type then + T := New_Fieldtype (Generic_Field_Check'Access, + Generic_Char_Check'Access); + if T = Null_Field_Type then raise Form_Exception; else - Res := Set_Fieldtype_Arg (T, + Res := Set_Fieldtype_Arg (T, Make_Arg'Access, Copy_Arg'Access, Free_Arg'Access); - if Res /= E_Ok then - Eti_Exception (Res); + if Res /= E_Ok then + Eti_Exception (Res); end if; - Res := Set_Fieldtype_Choice (T, - Generic_Next'Access, - Generic_Prev'Access); - if Res /= E_Ok then - Eti_Exception (Res); + Res := Set_Fieldtype_Choice (T, + Generic_Next'Access, + Generic_Prev'Access); + if Res /= E_Ok then + Eti_Exception (Res); end if; end if; - M_Generic_Choice := T; + M_Generic_Choice := T; end if; pragma Assert (M_Generic_Choice /= Null_Field_Type); return M_Generic_Choice; - end C_Generic_Choice; + end C_Generic_Choice; -end Terminal_Interface.Curses.Forms.Field_Types.User.Choice; +end Terminal_Interface.Curses.Forms.Field_Types.User.Choice;