X-Git-Url: https://ncurses.scripts.mit.edu/?p=ncurses.git;a=blobdiff_plain;f=Ada95%2Fsrc%2Fterminal_interface-curses-forms-field_types-user-choice.adb;h=913cec0553f4aea737c3324a711c32ab6728ef5e;hp=8d2f6c4cd67a69037c25b7d8f802393c0e7e7a23;hb=47d2fb4537d9ad5bb14f4810561a327930ca4280;hpb=55ccd2b959766810cf7db8d1c4462f338ce0afc8 diff --git a/Ada95/src/terminal_interface-curses-forms-field_types-user-choice.adb b/Ada95/src/terminal_interface-curses-forms-field_types-user-choice.adb index 8d2f6c4c..913cec05 100644 --- a/Ada95/src/terminal_interface-curses-forms-field_types-user-choice.adb +++ b/Ada95/src/terminal_interface-curses-forms-field_types-user-choice.adb @@ -7,7 +7,8 @@ -- B O D Y -- -- -- ------------------------------------------------------------------------------ --- Copyright (c) 1998,2004 Free Software Foundation, Inc. -- +-- Copyright 2020 Thomas E. Dickey -- +-- Copyright 1999-2011,2014 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,43 +36,40 @@ ------------------------------------------------------------------------------ -- Author: Juergen Pfeifer, 1996 -- Version Control: --- $Revision: 1.13 $ --- $Date: 2004/08/21 21:37:00 $ +-- $Revision: 1.21 $ +-- $Date: 2020/02/02 23:34:34 $ -- Binding Version 01.00 ------------------------------------------------------------------------------ -with Ada.Unchecked_Conversion; -with Interfaces.C; +with System.Address_To_Access_Conversions; with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; 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 - (System.Address, Argument_Access); + package Argument_Conversions is + new System.Address_To_Access_Conversions (Argument); function Generic_Next (Fld : Field; - Usr : System.Address) return C_Int + Usr : System.Address) return Curses_Bool is Result : Boolean; Udf : constant User_Defined_Field_Type_With_Choice_Access := User_Defined_Field_Type_With_Choice_Access - (To_Argument_Access (Usr).Typ); + (Argument_Access (Argument_Conversions.To_Pointer (Usr)).all.Typ); begin Result := Next (Fld, Udf.all); - return C_Int (Boolean'Pos (Result)); + return Curses_Bool (Boolean'Pos (Result)); end Generic_Next; function Generic_Prev (Fld : Field; - Usr : System.Address) return C_Int + Usr : System.Address) return Curses_Bool is Result : Boolean; Udf : constant User_Defined_Field_Type_With_Choice_Access := User_Defined_Field_Type_With_Choice_Access - (To_Argument_Access (Usr).Typ); + (Argument_Access (Argument_Conversions.To_Pointer (Usr)).all.Typ); begin Result := Previous (Fld, Udf.all); - return C_Int (Boolean'Pos (Result)); + return Curses_Bool (Boolean'Pos (Result)); end Generic_Prev; -- ----------------------------------------------------------------------- @@ -91,16 +89,12 @@ package body Terminal_Interface.Curses.Forms.Field_Types.User.Choice is Make_Arg'Access, Copy_Arg'Access, Free_Arg'Access); - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Res); Res := Set_Fieldtype_Choice (T, Generic_Next'Access, Generic_Prev'Access); - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Res); end if; M_Generic_Choice := T; end if;