diff options
Diffstat (limited to 'Ada95/src')
24 files changed, 470 insertions, 684 deletions
diff --git a/Ada95/src/Makefile.in b/Ada95/src/Makefile.in index f6c3e75..9726d43 100644 --- a/Ada95/src/Makefile.in +++ b/Ada95/src/Makefile.in @@ -1,5 +1,5 @@ ############################################################################## -# Copyright (c) 1998-2010,2011 Free Software Foundation, Inc. # +# Copyright (c) 1998-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 "Software"), # @@ -28,7 +28,7 @@ # # Author: Juergen Pfeifer, 1996 # -# $Id: Makefile.in,v 1.60 2011/03/31 09:46:16 tom Exp $ +# $Id: Makefile.in,v 1.70 2014/08/02 20:31:47 tom Exp $ # .SUFFIXES: @@ -215,25 +215,42 @@ BASEDEPS=$(ABASE).ads $(ABASE)-aux.ads $(ABASE).adb $(ABASE)-trace.adb : $(srcdir)/$(ABASE)-trace.adb_p rm -f $@ - $(ADAPREP) -DADA_TRACE=@ADA_TRACE@ -DPRAGMA_UNREF=@PRAGMA_UNREF@ $(srcdir)/$(ABASE)-trace.adb_p $@ + $(ADAPREP) -DADA_TRACE=@ADA_TRACE@ @GNATPREP_OPTS@ $(srcdir)/$(ABASE)-trace.adb_p $@ ############################################################################### -C_OBJS = c_varargs_to_ada.o ncurses_compat.o +# Use these definitions when building a shared library. +SHARED_C_OBJS = c_varargs_to_ada.o c_threaded_variables.o ncurses_compat.o +SHARED_OBJS = $(SHARED_C_OBJS) @USE_OLD_MAKERULES@$(LIBOBJS) @cf_generic_objects@ c_varargs_to_ada.o : $(srcdir)/c_varargs_to_ada.c $(CC) $(CFLAGS_DEFAULT) -c -o $@ $(srcdir)/c_varargs_to_ada.c +c_threaded_variables.o : $(srcdir)/c_threaded_variables.c + $(CC) $(CFLAGS_DEFAULT) -c -o $@ $(srcdir)/c_threaded_variables.c + ncurses_compat.o : $(srcdir)/ncurses_compat.c $(CC) $(CFLAGS_DEFAULT) -c -o $@ $(srcdir)/ncurses_compat.c ############################################################################### +# Use these definitions when building a static library. +STATIC_C_OBJS = static_c_varargs_to_ada.o static_c_threaded_variables.o static_ncurses_compat.o +STATIC_OBJS = $(STATIC_C_OBJS) @USE_OLD_MAKERULES@$(LIBOBJS) @cf_generic_objects@ + +static_c_varargs_to_ada.o : $(srcdir)/c_varargs_to_ada.c + $(CC) $(CFLAGS_NORMAL) -c -o $@ $(srcdir)/c_varargs_to_ada.c + +static_c_threaded_variables.o : $(srcdir)/c_threaded_variables.c + $(CC) $(CFLAGS_NORMAL) -c -o $@ $(srcdir)/c_threaded_variables.c -MIXED_OBJS = $(C_OBJS) @USE_OLD_MAKERULES@$(LIBOBJS) @cf_generic_objects@ +static_ncurses_compat.o : $(srcdir)/ncurses_compat.c + $(CC) $(CFLAGS_NORMAL) -c -o $@ $(srcdir)/ncurses_compat.c + +############################################################################### @USE_OLD_MAKERULES@$(BUILD_DIR_LIB)/$(STATIC_LIBNAME) :: \ @USE_OLD_MAKERULES@ $(BUILD_DIR_LIB) \ -@USE_OLD_MAKERULES@ $(MIXED_OBJS) -@USE_OLD_MAKERULES@ $(AR) $(ARFLAGS) $@ $(MIXED_OBJS) +@USE_OLD_MAKERULES@ $(STATIC_OBJS) +@USE_OLD_MAKERULES@ $(AR) $(ARFLAGS) $@ $(STATIC_OBJS) $(BUILD_DIR)/static-ali : ; mkdir -p $@ $(BUILD_DIR)/static-obj : ; mkdir -p $@ @@ -245,10 +262,10 @@ STATIC_DIRS = \ @USE_GNAT_PROJECTS@$(BUILD_DIR_LIB)/$(STATIC_LIBNAME) :: \ @USE_GNAT_PROJECTS@ $(ABASE)-trace.adb \ -@USE_GNAT_PROJECTS@ $(C_OBJS) \ +@USE_GNAT_PROJECTS@ $(STATIC_C_OBJS) \ @USE_GNAT_PROJECTS@ $(STATIC_DIRS) @USE_GNAT_PROJECTS@ $(ADAMAKE) $(ADAMAKEFLAGS) -XLIB_KIND=static -@USE_GNAT_PROJECTS@ $(AR) $(ARFLAGS) $@ $(C_OBJS) +@USE_GNAT_PROJECTS@ $(AR) $(ARFLAGS) $@ $(STATIC_C_OBJS) @USE_GNAT_PROJECTS@ @USE_GNAT_LIBRARIES@install \ @USE_GNAT_LIBRARIES@install.libs :: \ @@ -274,8 +291,11 @@ SHARED_DIRS = \ $(BUILD_DIR)/dynamic-obj @MAKE_ADA_SHAREDLIB@all :: $(BUILD_DIR_LIB)/$(SHARED_LIBNAME) -@MAKE_ADA_SHAREDLIB@$(BUILD_DIR_LIB)/$(SHARED_LIBNAME) :: $(ABASE)-trace.adb $(SHARED_DIRS) -@MAKE_ADA_SHAREDLIB@ cp $(MIXED_OBJS) $(BUILD_DIR)/dynamic-obj/ +@MAKE_ADA_SHAREDLIB@$(BUILD_DIR_LIB)/$(SHARED_LIBNAME) :: \ +@MAKE_ADA_SHAREDLIB@ $(ABASE)-trace.adb \ +@MAKE_ADA_SHAREDLIB@ $(SHARED_DIRS) \ +@MAKE_ADA_SHAREDLIB@ $(SHARED_OBJS) +@MAKE_ADA_SHAREDLIB@ cp $(SHARED_OBJS) $(BUILD_DIR)/dynamic-obj/ @MAKE_ADA_SHAREDLIB@ $(ADAMAKE) $(ADAMAKEFLAGS) -XLIB_KIND=dynamic install \ diff --git a/Ada95/src/c_threaded_variables.c b/Ada95/src/c_threaded_variables.c new file mode 100644 index 0000000..bc58c46 --- /dev/null +++ b/Ada95/src/c_threaded_variables.c @@ -0,0 +1,56 @@ +/**************************************************************************** + * Copyright (c) 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 * + * "Software"), to deal in the Software without restriction, including * + * without limitation the rights to use, copy, modify, merge, publish, * + * distribute, distribute with modifications, sublicense, and/or sell * + * copies of the Software, and to permit persons to whom the Software is * + * furnished to do so, subject to the following conditions: * + * * + * The above copyright notice and this permission notice shall be included * + * in all copies or substantial portions of the Software. * + * * + * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS * + * OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF * + * MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. * + * IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, * + * DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR * + * OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR * + * THE USE OR OTHER DEALINGS IN THE SOFTWARE. * + * * + * Except as contained in this notice, the name(s) of the above copyright * + * holders shall not be used in advertising or otherwise to promote the * + * sale, use or other dealings in this Software without prior written * + * authorization. * + ****************************************************************************/ + +/**************************************************************************** + * Author: Nicolas Boulenguez, 2011 * + ****************************************************************************/ + +#include "c_threaded_variables.h" + +#define WRAP(type, name) \ + type \ + name ## _as_function () \ + { \ + return name; \ + } +/* *INDENT-OFF* */ +WRAP(WINDOW *, stdscr) +WRAP(WINDOW *, curscr) + +WRAP(int, LINES) +WRAP(int, COLS) +WRAP(int, TABSIZE) +WRAP(int, COLORS) +WRAP(int, COLOR_PAIRS) + +chtype +acs_map_as_function(char inx) +{ + return acs_map[(unsigned char) inx]; +} +/* *INDENT-ON* */ diff --git a/Ada95/src/c_threaded_variables.h b/Ada95/src/c_threaded_variables.h new file mode 100644 index 0000000..eac3e1b --- /dev/null +++ b/Ada95/src/c_threaded_variables.h @@ -0,0 +1,46 @@ +/**************************************************************************** + * Copyright (c) 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 * + * "Software"), to deal in the Software without restriction, including * + * without limitation the rights to use, copy, modify, merge, publish, * + * distribute, distribute with modifications, sublicense, and/or sell * + * copies of the Software, and to permit persons to whom the Software is * + * furnished to do so, subject to the following conditions: * + * * + * The above copyright notice and this permission notice shall be included * + * in all copies or substantial portions of the Software. * + * * + * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS * + * OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF * + * MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. * + * IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, * + * DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR * + * OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR * + * THE USE OR OTHER DEALINGS IN THE SOFTWARE. * + * * + * Except as contained in this notice, the name(s) of the above copyright * + * holders shall not be used in advertising or otherwise to promote the * + * sale, use or other dealings in this Software without prior written * + * authorization. * + ****************************************************************************/ + +#ifndef __C_THREADED_VARIABLES_H +#define __C_THREADED_VARIABLES_H + +#include <curses.h> + +extern WINDOW *stdscr_as_function(void); +extern WINDOW *curscr_as_function(void); + +extern int LINES_as_function(void); +extern int LINES_as_function(void); +extern int COLS_as_function(void); +extern int TABSIZE_as_function(void); +extern int COLORS_as_function(void); +extern int COLOR_PAIRS_as_function(void); + +extern chtype acs_map_as_function(char /* index */ ); + +#endif /* __C_THREADED_VARIABLES_H */ diff --git a/Ada95/src/c_varargs_to_ada.c b/Ada95/src/c_varargs_to_ada.c index ed236dd..f0b1bbe 100644 --- a/Ada95/src/c_varargs_to_ada.c +++ b/Ada95/src/c_varargs_to_ada.c @@ -1,5 +1,5 @@ /**************************************************************************** - * Copyright (c) 2011 Free Software Foundation, Inc. * + * Copyright (c) 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 * @@ -32,12 +32,12 @@ /* Version Control - $Id: c_varargs_to_ada.c,v 1.4 2011/03/19 19:07:39 tom Exp $ + $Id: c_varargs_to_ada.c,v 1.6 2014/05/24 21:32:18 tom Exp $ --------------------------------------------------------------------------*/ /* */ -#include <c_varargs_to_ada.h> +#include "c_varargs_to_ada.h" int set_field_type_alnum(FIELD *field, diff --git a/Ada95/src/library.gpr b/Ada95/src/library.gpr index 33e4a3c..e7380f0 100644 --- a/Ada95/src/library.gpr +++ b/Ada95/src/library.gpr @@ -1,5 +1,5 @@ ------------------------------------------------------------------------------ --- Copyright (c) 2010,2011 Free Software Foundation, Inc. -- +-- Copyright (c) 2010-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 -- @@ -25,7 +25,7 @@ -- sale, use or other dealings in this Software without prior written -- -- authorization. -- ------------------------------------------------------------------------------ --- $Id: library.gpr,v 1.7 2011/03/18 23:10:28 Nicolas.Boulenguez Exp $ +-- $Id: library.gpr,v 1.9 2014/06/01 01:13:09 tom Exp $ -- http://gcc.gnu.org/onlinedocs/gnat_ugn_unw/Library-Projects.html -- http://www.adaworld.com/debian/debian-ada-policy.html project Library is diff --git a/Ada95/src/terminal_interface-curses-forms-field_types-alpha.adb b/Ada95/src/terminal_interface-curses-forms-field_types-alpha.adb index 9433620..9c614ca 100644 --- a/Ada95/src/terminal_interface-curses-forms-field_types-alpha.adb +++ b/Ada95/src/terminal_interface-curses-forms-field_types-alpha.adb @@ -7,7 +7,7 @@ -- B O D Y -- -- -- ------------------------------------------------------------------------------ --- Copyright (c) 1998-2009,2011 Free Software Foundation, Inc. -- +-- Copyright (c) 1998-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,8 +35,8 @@ ------------------------------------------------------------------------------ -- Author: Juergen Pfeifer, 1996 -- Version Control: --- $Revision: 1.11 $ --- $Date: 2011/03/19 00:45:37 $ +-- $Revision: 1.13 $ +-- $Date: 2014/05/24 21:31:05 $ -- Binding Version 01.00 ------------------------------------------------------------------------------ with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; @@ -47,15 +47,11 @@ package body Terminal_Interface.Curses.Forms.Field_Types.Alpha is Typ : Alpha_Field) is function Set_Fld_Type (F : Field := Fld; - Arg1 : C_Int) return C_Int; + Arg1 : C_Int) return Eti_Error; pragma Import (C, Set_Fld_Type, "set_field_type_alpha"); - Res : Eti_Error; begin - Res := Set_Fld_Type (Arg1 => C_Int (Typ.Minimum_Field_Width)); - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Fld_Type (Arg1 => C_Int (Typ.Minimum_Field_Width))); Wrap_Builtin (Fld, Typ); end Set_Field_Type; diff --git a/Ada95/src/terminal_interface-curses-forms-field_types-alphanumeric.adb b/Ada95/src/terminal_interface-curses-forms-field_types-alphanumeric.adb index 53f6680..270906d 100644 --- a/Ada95/src/terminal_interface-curses-forms-field_types-alphanumeric.adb +++ b/Ada95/src/terminal_interface-curses-forms-field_types-alphanumeric.adb @@ -7,7 +7,7 @@ -- B O D Y -- -- -- ------------------------------------------------------------------------------ --- Copyright (c) 1998-2009,2011 Free Software Foundation, Inc. -- +-- Copyright (c) 1998-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,8 +35,8 @@ ------------------------------------------------------------------------------ -- Author: Juergen Pfeifer, 1996 -- Version Control: --- $Revision: 1.11 $ --- $Date: 2011/03/19 00:45:37 $ +-- $Revision: 1.13 $ +-- $Date: 2014/05/24 21:31:05 $ -- Binding Version 01.00 ------------------------------------------------------------------------------ with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; @@ -47,15 +47,11 @@ package body Terminal_Interface.Curses.Forms.Field_Types.AlphaNumeric is Typ : AlphaNumeric_Field) is function Set_Fld_Type (F : Field := Fld; - Arg1 : C_Int) return C_Int; + Arg1 : C_Int) return Eti_Error; pragma Import (C, Set_Fld_Type, "set_field_type_alnum"); - Res : Eti_Error; begin - Res := Set_Fld_Type (Arg1 => C_Int (Typ.Minimum_Field_Width)); - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Fld_Type (Arg1 => C_Int (Typ.Minimum_Field_Width))); Wrap_Builtin (Fld, Typ); end Set_Field_Type; diff --git a/Ada95/src/terminal_interface-curses-forms-field_types-enumeration.adb b/Ada95/src/terminal_interface-curses-forms-field_types-enumeration.adb index 12648e5..8d4c9ce 100644 --- a/Ada95/src/terminal_interface-curses-forms-field_types-enumeration.adb +++ b/Ada95/src/terminal_interface-curses-forms-field_types-enumeration.adb @@ -7,7 +7,7 @@ -- B O D Y -- -- -- ------------------------------------------------------------------------------ --- Copyright (c) 1998-2009,2011 Free Software Foundation, Inc. -- +-- Copyright (c) 1998-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,7 +35,7 @@ ------------------------------------------------------------------------------ -- Author: Juergen Pfeifer, 1996 -- Version Control: --- $Revision: 1.10 $ +-- $Revision: 1.12 $ -- Binding Version 01.00 ------------------------------------------------------------------------------ with Ada.Unchecked_Deallocation; @@ -94,21 +94,18 @@ package body Terminal_Interface.Curses.Forms.Field_Types.Enumeration is function Set_Fld_Type (F : Field := Fld; Arg1 : chars_ptr_array; Arg2 : C_Int; - Arg3 : C_Int) return C_Int; + Arg3 : C_Int) return Eti_Error; pragma Import (C, Set_Fld_Type, "set_field_type_enum"); - Res : Eti_Error; begin if Typ.Arr = null then raise Form_Exception; end if; - Res := Set_Fld_Type (Arg1 => Typ.Arr.all, - Arg2 => C_Int (Boolean'Pos (Typ.Case_Sensitive)), - Arg3 => C_Int (Boolean'Pos - (Typ.Match_Must_Be_Unique))); - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception + (Set_Fld_Type + (Arg1 => Typ.Arr.all, + Arg2 => C_Int (Boolean'Pos (Typ.Case_Sensitive)), + Arg3 => C_Int (Boolean'Pos (Typ.Match_Must_Be_Unique)))); Wrap_Builtin (Fld, Typ, C_Choice_Router); end Set_Field_Type; diff --git a/Ada95/src/terminal_interface-curses-forms-field_types-intfield.adb b/Ada95/src/terminal_interface-curses-forms-field_types-intfield.adb index b6229be..5ec3305 100644 --- a/Ada95/src/terminal_interface-curses-forms-field_types-intfield.adb +++ b/Ada95/src/terminal_interface-curses-forms-field_types-intfield.adb @@ -7,7 +7,7 @@ -- B O D Y -- -- -- ------------------------------------------------------------------------------ --- Copyright (c) 1998-2009,2011 Free Software Foundation, Inc. -- +-- Copyright (c) 1998-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,8 +35,8 @@ ------------------------------------------------------------------------------ -- Author: Juergen Pfeifer, 1996 -- Version Control: --- $Revision: 1.11 $ --- $Date: 2011/03/19 00:45:37 $ +-- $Revision: 1.13 $ +-- $Date: 2014/05/24 21:31:05 $ -- Binding Version 01.00 ------------------------------------------------------------------------------ with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; @@ -49,17 +49,13 @@ package body Terminal_Interface.Curses.Forms.Field_Types.IntField is function Set_Fld_Type (F : Field := Fld; Arg1 : C_Int; Arg2 : C_Long_Int; - Arg3 : C_Long_Int) return C_Int; + Arg3 : C_Long_Int) return Eti_Error; pragma Import (C, Set_Fld_Type, "set_field_type_integer"); - Res : Eti_Error; begin - Res := Set_Fld_Type (Arg1 => C_Int (Typ.Precision), - Arg2 => C_Long_Int (Typ.Lower_Limit), - Arg3 => C_Long_Int (Typ.Upper_Limit)); - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Fld_Type (Arg1 => C_Int (Typ.Precision), + Arg2 => C_Long_Int (Typ.Lower_Limit), + Arg3 => C_Long_Int (Typ.Upper_Limit))); Wrap_Builtin (Fld, Typ); end Set_Field_Type; diff --git a/Ada95/src/terminal_interface-curses-forms-field_types-ipv4_address.adb b/Ada95/src/terminal_interface-curses-forms-field_types-ipv4_address.adb index 66e0529..978a47a 100644 --- a/Ada95/src/terminal_interface-curses-forms-field_types-ipv4_address.adb +++ b/Ada95/src/terminal_interface-curses-forms-field_types-ipv4_address.adb @@ -7,7 +7,7 @@ -- B O D Y -- -- -- ------------------------------------------------------------------------------ --- Copyright (c) 1998-2009,2011 Free Software Foundation, Inc. -- +-- Copyright (c) 1998-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,8 +35,8 @@ ------------------------------------------------------------------------------ -- Author: Juergen Pfeifer, 1996 -- Version Control: --- $Revision: 1.11 $ --- $Date: 2011/03/19 00:45:37 $ +-- $Revision: 1.13 $ +-- $Date: 2014/05/24 21:31:05 $ -- Binding Version 01.00 ------------------------------------------------------------------------------ with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; @@ -47,15 +47,11 @@ package body Terminal_Interface.Curses.Forms.Field_Types.IPV4_Address is Typ : Internet_V4_Address_Field) is function Set_Fld_Type (F : Field := Fld) - return C_Int; + return Eti_Error; pragma Import (C, Set_Fld_Type, "set_field_type_ipv4"); - Res : Eti_Error; begin - Res := Set_Fld_Type; - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Fld_Type); Wrap_Builtin (Fld, Typ); end Set_Field_Type; diff --git a/Ada95/src/terminal_interface-curses-forms-field_types-numeric.adb b/Ada95/src/terminal_interface-curses-forms-field_types-numeric.adb index b31dfa6..94e2aa7 100644 --- a/Ada95/src/terminal_interface-curses-forms-field_types-numeric.adb +++ b/Ada95/src/terminal_interface-curses-forms-field_types-numeric.adb @@ -7,7 +7,7 @@ -- B O D Y -- -- -- ------------------------------------------------------------------------------ --- Copyright (c) 1998-2009,2011 Free Software Foundation, Inc. -- +-- Copyright (c) 1998-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,8 +35,8 @@ ------------------------------------------------------------------------------ -- Author: Juergen Pfeifer, 1996 -- Version Control: --- $Revision: 1.12 $ --- $Date: 2011/03/19 00:45:37 $ +-- $Revision: 1.14 $ +-- $Date: 2014/05/24 21:31:05 $ -- Binding Version 01.00 ------------------------------------------------------------------------------ with Interfaces.C; @@ -52,17 +52,13 @@ package body Terminal_Interface.Curses.Forms.Field_Types.Numeric is function Set_Fld_Type (F : Field := Fld; Arg1 : C_Int; Arg2 : Double; - Arg3 : Double) return C_Int; + Arg3 : Double) return Eti_Error; pragma Import (C, Set_Fld_Type, "set_field_type_numeric"); - Res : Eti_Error; begin - Res := Set_Fld_Type (Arg1 => C_Int (Typ.Precision), - Arg2 => Double (Typ.Lower_Limit), - Arg3 => Double (Typ.Upper_Limit)); - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Fld_Type (Arg1 => C_Int (Typ.Precision), + Arg2 => Double (Typ.Lower_Limit), + Arg3 => Double (Typ.Upper_Limit))); Wrap_Builtin (Fld, Typ); end Set_Field_Type; diff --git a/Ada95/src/terminal_interface-curses-forms-field_types-regexp.adb b/Ada95/src/terminal_interface-curses-forms-field_types-regexp.adb index 55f0255..f5ea0db 100644 --- a/Ada95/src/terminal_interface-curses-forms-field_types-regexp.adb +++ b/Ada95/src/terminal_interface-curses-forms-field_types-regexp.adb @@ -7,7 +7,7 @@ -- B O D Y -- -- -- ------------------------------------------------------------------------------ --- Copyright (c) 1998-2009,2011 Free Software Foundation, Inc. -- +-- Copyright (c) 1998-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,7 +35,7 @@ ------------------------------------------------------------------------------ -- Author: Juergen Pfeifer, 1996 -- Version Control: --- $Revision: 1.10 $ +-- $Revision: 1.12 $ -- Binding Version 01.00 ------------------------------------------------------------------------------ with Interfaces.C; use Interfaces.C; @@ -46,21 +46,12 @@ package body Terminal_Interface.Curses.Forms.Field_Types.RegExp is procedure Set_Field_Type (Fld : Field; Typ : Regular_Expression_Field) is - type Char_Ptr is access all Interfaces.C.char; - function Set_Ftyp (F : Field := Fld; - Arg1 : Char_Ptr) return C_Int; + Arg1 : char_array) return Eti_Error; pragma Import (C, Set_Ftyp, "set_field_type_regexp"); - Txt : char_array (0 .. Typ.Regular_Expression.all'Length); - Len : size_t; - Res : Eti_Error; begin - To_C (Typ.Regular_Expression.all, Txt, Len); - Res := Set_Ftyp (Arg1 => Txt (Txt'First)'Access); - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Ftyp (Arg1 => To_C (Typ.Regular_Expression.all))); Wrap_Builtin (Fld, Typ); end Set_Field_Type; 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 3a7e6b5..8414cd0 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,7 @@ -- B O D Y -- -- -- ------------------------------------------------------------------------------ --- Copyright (c) 1998-2008,2011 Free Software Foundation, Inc. -- +-- Copyright (c) 1998-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,8 +35,8 @@ ------------------------------------------------------------------------------ -- Author: Juergen Pfeifer, 1996 -- Version Control: --- $Revision: 1.17 $ --- $Date: 2011/03/22 10:53:37 $ +-- $Revision: 1.20 $ +-- $Date: 2014/05/24 21:31:05 $ -- Binding Version 01.00 ------------------------------------------------------------------------------ with System.Address_To_Access_Conversions; @@ -53,7 +53,7 @@ package body Terminal_Interface.Curses.Forms.Field_Types.User.Choice is Result : Boolean; Udf : constant User_Defined_Field_Type_With_Choice_Access := User_Defined_Field_Type_With_Choice_Access - (Argument_Access (Argument_Conversions.To_Pointer (Usr)).Typ); + (Argument_Access (Argument_Conversions.To_Pointer (Usr)).all.Typ); begin Result := Next (Fld, Udf.all); return Curses_Bool (Boolean'Pos (Result)); @@ -65,7 +65,7 @@ package body Terminal_Interface.Curses.Forms.Field_Types.User.Choice is Result : Boolean; Udf : constant User_Defined_Field_Type_With_Choice_Access := User_Defined_Field_Type_With_Choice_Access - (Argument_Access (Argument_Conversions.To_Pointer (Usr)).Typ); + (Argument_Access (Argument_Conversions.To_Pointer (Usr)).all.Typ); begin Result := Previous (Fld, Udf.all); return Curses_Bool (Boolean'Pos (Result)); @@ -88,16 +88,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; diff --git a/Ada95/src/terminal_interface-curses-forms-field_types-user.adb b/Ada95/src/terminal_interface-curses-forms-field_types-user.adb index 2dd295d..98bcd24 100644 --- a/Ada95/src/terminal_interface-curses-forms-field_types-user.adb +++ b/Ada95/src/terminal_interface-curses-forms-field_types-user.adb @@ -7,7 +7,7 @@ -- B O D Y -- -- -- ------------------------------------------------------------------------------ --- Copyright (c) 1998-2009,2011 Free Software Foundation, Inc. -- +-- Copyright (c) 1998-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,8 +35,8 @@ ------------------------------------------------------------------------------ -- Author: Juergen Pfeifer, 1996 -- Version Control: --- $Revision: 1.21 $ --- $Date: 2011/03/23 00:44:58 $ +-- $Revision: 1.23 $ +-- $Date: 2014/05/24 21:31:05 $ -- Binding Version 01.00 ------------------------------------------------------------------------------ with System.Address_To_Access_Conversions; @@ -53,11 +53,9 @@ package body Terminal_Interface.Curses.Forms.Field_Types.User is function Set_Fld_Type (F : Field := Fld; Cft : C_Field_Type := C_Generic_Type; Arg1 : Argument_Access) - return C_Int; + return Eti_Error; pragma Import (C, Set_Fld_Type, "set_field_type_user"); - Res : Eti_Error; - function Allocate_Arg (T : User_Defined_Field_Type'Class) return Argument_Access is @@ -70,10 +68,7 @@ package body Terminal_Interface.Curses.Forms.Field_Types.User is end Allocate_Arg; begin - Res := Set_Fld_Type (Arg1 => Allocate_Arg (Typ)); - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Fld_Type (Arg1 => Allocate_Arg (Typ))); end Set_Field_Type; package Argument_Conversions is @@ -120,9 +115,7 @@ package body Terminal_Interface.Curses.Forms.Field_Types.User is Make_Arg'Access, Copy_Arg'Access, Free_Arg'Access); - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Res); end if; M_Generic_Type := T; end if; diff --git a/Ada95/src/terminal_interface-curses-forms-field_types.adb b/Ada95/src/terminal_interface-curses-forms-field_types.adb index 5195a20..bda6e51 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-2009,2011 Free Software Foundation, Inc. -- +-- Copyright (c) 1998-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,8 +35,8 @@ ------------------------------------------------------------------------------ -- Author: Juergen Pfeifer, 1996 -- Version Control: --- $Revision: 1.25 $ --- $Date: 2011/03/22 23:22:27 $ +-- $Revision: 1.28 $ +-- $Date: 2014/09/13 19:00:47 $ -- Binding Version 01.00 ------------------------------------------------------------------------------ with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; @@ -76,9 +76,10 @@ package body Terminal_Interface.Curses.Forms.Field_Types is return null; else if Low_Level = M_Builtin_Router or else - Low_Level = M_Generic_Type or else - Low_Level = M_Choice_Router or else - Low_Level = M_Generic_Choice then + Low_Level = M_Generic_Type or else + Low_Level = M_Choice_Router or else + Low_Level = M_Generic_Choice + then Arg := Argument_Access (Argument_Conversions.To_Pointer (Get_Arg (Fld))); if Arg = null then @@ -130,10 +131,9 @@ package body Terminal_Interface.Curses.Forms.Field_Types is Usr_Arg : constant System.Address := Get_Arg (Fld); Low_Level : constant C_Field_Type := Get_Fieldtype (Fld); Arg : Argument_Access; - Res : Eti_Error; function Set_Fld_Type (F : Field := Fld; Cf : C_Field_Type := Cft; - Arg1 : Argument_Access) return C_Int; + Arg1 : Argument_Access) return Eti_Error; pragma Import (C, Set_Fld_Type, "set_field_type_user"); begin @@ -152,10 +152,7 @@ package body Terminal_Interface.Curses.Forms.Field_Types is end if; end if; - Res := Set_Fld_Type (Arg1 => Arg); - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Fld_Type (Arg1 => Arg)); end if; end Wrap_Builtin; @@ -223,7 +220,6 @@ package body Terminal_Interface.Curses.Forms.Field_Types is -- function C_Builtin_Router return C_Field_Type is - Res : Eti_Error; T : C_Field_Type; begin if M_Builtin_Router = Null_Field_Type then @@ -232,13 +228,10 @@ package body Terminal_Interface.Curses.Forms.Field_Types is if T = Null_Field_Type then raise Form_Exception; else - Res := Set_Fieldtype_Arg (T, - Make_Arg'Access, - Copy_Arg'Access, - Free_Arg'Access); - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Fieldtype_Arg (T, + Make_Arg'Access, + Copy_Arg'Access, + Free_Arg'Access)); end if; M_Builtin_Router := T; end if; @@ -250,7 +243,6 @@ package body Terminal_Interface.Curses.Forms.Field_Types is -- function C_Choice_Router return C_Field_Type is - Res : Eti_Error; T : C_Field_Type; begin if M_Choice_Router = Null_Field_Type then @@ -259,20 +251,14 @@ package body Terminal_Interface.Curses.Forms.Field_Types is if T = Null_Field_Type then raise Form_Exception; else - Res := Set_Fieldtype_Arg (T, - Make_Arg'Access, - Copy_Arg'Access, - Free_Arg'Access); - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Fieldtype_Arg (T, + Make_Arg'Access, + Copy_Arg'Access, + Free_Arg'Access)); - Res := Set_Fieldtype_Choice (T, - Next_Router'Access, - Prev_Router'Access); - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Fieldtype_Choice (T, + Next_Router'Access, + Prev_Router'Access)); end if; M_Choice_Router := T; end if; diff --git a/Ada95/src/terminal_interface-curses-forms-field_user_data.adb b/Ada95/src/terminal_interface-curses-forms-field_user_data.adb index 96178d8..2497614 100644 --- a/Ada95/src/terminal_interface-curses-forms-field_user_data.adb +++ b/Ada95/src/terminal_interface-curses-forms-field_user_data.adb @@ -7,7 +7,7 @@ -- B O D Y -- -- -- ------------------------------------------------------------------------------ --- Copyright (c) 1998-2003,2009 Free Software Foundation, Inc. -- +-- Copyright (c) 1998-2009,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,7 +35,7 @@ ------------------------------------------------------------------------------ -- Author: Juergen Pfeifer, 1996 -- Version Control: --- $Revision: 1.13 $ +-- $Revision: 1.15 $ -- Binding Version 01.00 ------------------------------------------------------------------------------ with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; @@ -55,14 +55,11 @@ package body Terminal_Interface.Curses.Forms.Field_User_Data is Data : User_Access) is function Set_Field_Userptr (Fld : Field; - Usr : User_Access) return C_Int; + Usr : User_Access) return Eti_Error; pragma Import (C, Set_Field_Userptr, "set_field_userptr"); - Res : constant Eti_Error := Set_Field_Userptr (Fld, Data); begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Field_Userptr (Fld, Data)); end Set_User_Data; -- | -- | diff --git a/Ada95/src/terminal_interface-curses-forms-form_user_data.adb b/Ada95/src/terminal_interface-curses-forms-form_user_data.adb index 84353eb..a8b7464 100644 --- a/Ada95/src/terminal_interface-curses-forms-form_user_data.adb +++ b/Ada95/src/terminal_interface-curses-forms-form_user_data.adb @@ -7,7 +7,7 @@ -- B O D Y -- -- -- ------------------------------------------------------------------------------ --- Copyright (c) 1998-2003,2009 Free Software Foundation, Inc. -- +-- Copyright (c) 1998-2009,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,7 +35,7 @@ ------------------------------------------------------------------------------ -- Author: Juergen Pfeifer, 1996 -- Version Control: --- $Revision: 1.13 $ +-- $Revision: 1.15 $ -- Binding Version 01.00 ------------------------------------------------------------------------------ -- | @@ -56,14 +56,11 @@ package body Terminal_Interface.Curses.Forms.Form_User_Data is Data : User_Access) is function Set_Form_Userptr (Frm : Form; - Data : User_Access) return C_Int; + Data : User_Access) return Eti_Error; pragma Import (C, Set_Form_Userptr, "set_form_userptr"); - Res : constant Eti_Error := Set_Form_Userptr (Frm, Data); begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Form_Userptr (Frm, Data)); end Set_User_Data; -- | -- | diff --git a/Ada95/src/terminal_interface-curses-forms.adb b/Ada95/src/terminal_interface-curses-forms.adb index 915ed58..3ed053a 100644 --- a/Ada95/src/terminal_interface-curses-forms.adb +++ b/Ada95/src/terminal_interface-curses-forms.adb @@ -7,7 +7,7 @@ -- B O D Y -- -- -- ------------------------------------------------------------------------------ --- Copyright (c) 1998-2009,2011 Free Software Foundation, Inc. -- +-- Copyright (c) 1998-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,12 +35,11 @@ ------------------------------------------------------------------------------ -- Author: Juergen Pfeifer, 1996 -- Version Control: --- $Revision: 1.28 $ --- $Date: 2011/03/22 23:37:32 $ +-- $Revision: 1.32 $ +-- $Date: 2014/05/24 21:31:05 $ -- Binding Version 01.00 ------------------------------------------------------------------------------ with Ada.Unchecked_Deallocation; -with Ada.Unchecked_Conversion; with Interfaces.C; use Interfaces.C; with Interfaces.C.Strings; use Interfaces.C.Strings; @@ -62,22 +61,6 @@ package body Terminal_Interface.Curses.Forms is -- | -- subtype chars_ptr is Interfaces.C.Strings.chars_ptr; - function FOS_2_CInt is new - Ada.Unchecked_Conversion (Field_Option_Set, - C_Int); - - function CInt_2_FOS is new - Ada.Unchecked_Conversion (C_Int, - Field_Option_Set); - - function FrmOS_2_CInt is new - Ada.Unchecked_Conversion (Form_Option_Set, - C_Int); - - function CInt_2_FrmOS is new - Ada.Unchecked_Conversion (C_Int, - Form_Option_Set); - procedure Request_Name (Key : Form_Request_Code; Name : out String) is @@ -130,15 +113,11 @@ package body Terminal_Interface.Curses.Forms is -- | procedure Delete (Fld : in out Field) is - function Free_Field (Fld : Field) return C_Int; + function Free_Field (Fld : Field) return Eti_Error; pragma Import (C, Free_Field, "free_field"); - Res : Eti_Error; begin - Res := Free_Field (Fld); - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Free_Field (Fld)); Fld := Null_Field; end Delete; -- | @@ -194,16 +173,12 @@ package body Terminal_Interface.Curses.Forms is Just : Field_Justification := None) is function Set_Field_Just (Fld : Field; - Just : C_Int) return C_Int; + Just : C_Int) return Eti_Error; pragma Import (C, Set_Field_Just, "set_field_just"); - Res : constant Eti_Error := - Set_Field_Just (Fld, - C_Int (Field_Justification'Pos (Just))); begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Field_Just (Fld, + C_Int (Field_Justification'Pos (Just)))); end Set_Justification; -- | -- | @@ -227,22 +202,14 @@ package body Terminal_Interface.Curses.Forms is Buffer : Buffer_Number := Buffer_Number'First; Str : String) is - type Char_Ptr is access all Interfaces.C.char; function Set_Fld_Buffer (Fld : Field; Bufnum : C_Int; - S : Char_Ptr) - return C_Int; + S : char_array) + return Eti_Error; pragma Import (C, Set_Fld_Buffer, "set_field_buffer"); - Txt : char_array (0 .. Str'Length); - Len : size_t; - Res : Eti_Error; begin - To_C (Str, Txt, Len); - Res := Set_Fld_Buffer (Fld, C_Int (Buffer), Txt (Txt'First)'Access); - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Fld_Buffer (Fld, C_Int (Buffer), To_C (Str))); end Set_Buffer; -- | -- | @@ -276,12 +243,11 @@ package body Terminal_Interface.Curses.Forms is Status : Boolean := True) is function Set_Fld_Status (Fld : Field; - St : C_Int) return C_Int; + St : C_Int) return Eti_Error; pragma Import (C, Set_Fld_Status, "set_field_status"); - Res : constant Eti_Error := Set_Fld_Status (Fld, Boolean'Pos (Status)); begin - if Res /= E_Ok then + if Set_Fld_Status (Fld, Boolean'Pos (Status)) /= E_Ok then raise Form_Exception; end if; end Set_Status; @@ -308,14 +274,11 @@ package body Terminal_Interface.Curses.Forms is Max : Natural := 0) is function Set_Field_Max (Fld : Field; - M : C_Int) return C_Int; + M : C_Int) return Eti_Error; pragma Import (C, Set_Field_Max, "set_max_field"); - Res : constant Eti_Error := Set_Field_Max (Fld, C_Int (Max)); begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Field_Max (Fld, C_Int (Max))); end Set_Maximum_Size; -- | -- |===================================================================== @@ -328,16 +291,11 @@ package body Terminal_Interface.Curses.Forms is Options : Field_Option_Set) is function Set_Field_Opts (Fld : Field; - Opt : C_Int) return C_Int; + Opt : Field_Option_Set) return Eti_Error; pragma Import (C, Set_Field_Opts, "set_field_opts"); - Opt : constant C_Int := FOS_2_CInt (Options); - Res : Eti_Error; begin - Res := Set_Field_Opts (Fld, Opt); - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Field_Opts (Fld, Options)); end Set_Options; -- | -- | @@ -347,22 +305,17 @@ package body Terminal_Interface.Curses.Forms is On : Boolean := True) is function Field_Opts_On (Fld : Field; - Opt : C_Int) return C_Int; + Opt : Field_Option_Set) return Eti_Error; pragma Import (C, Field_Opts_On, "field_opts_on"); function Field_Opts_Off (Fld : Field; - Opt : C_Int) return C_Int; + Opt : Field_Option_Set) return Eti_Error; pragma Import (C, Field_Opts_Off, "field_opts_off"); - Err : Eti_Error; - Opt : constant C_Int := FOS_2_CInt (Options); begin if On then - Err := Field_Opts_On (Fld, Opt); + Eti_Exception (Field_Opts_On (Fld, Options)); else - Err := Field_Opts_Off (Fld, Opt); - end if; - if Err /= E_Ok then - Eti_Exception (Err); + Eti_Exception (Field_Opts_Off (Fld, Options)); end if; end Switch_Options; -- | @@ -371,12 +324,11 @@ package body Terminal_Interface.Curses.Forms is procedure Get_Options (Fld : Field; Options : out Field_Option_Set) is - function Field_Opts (Fld : Field) return C_Int; + function Field_Opts (Fld : Field) return Field_Option_Set; pragma Import (C, Field_Opts, "field_opts"); - Res : constant C_Int := Field_Opts (Fld); begin - Options := CInt_2_FOS (Res); + Options := Field_Opts (Fld); end Get_Options; -- | -- | @@ -402,18 +354,13 @@ package body Terminal_Interface.Curses.Forms is Color : Color_Pair := Color_Pair'First) is function Set_Field_Fore (Fld : Field; - Attr : C_Chtype) return C_Int; + Attr : Attributed_Character) return Eti_Error; pragma Import (C, Set_Field_Fore, "set_field_fore"); - Ch : constant Attributed_Character := (Ch => Character'First, - Color => Color, - Attr => Fore); - Res : constant Eti_Error := - Set_Field_Fore (Fld, AttrChar_To_Chtype (Ch)); begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Field_Fore (Fld, (Ch => Character'First, + Color => Color, + Attr => Fore))); end Set_Foreground; -- | -- | @@ -421,21 +368,21 @@ package body Terminal_Interface.Curses.Forms is procedure Foreground (Fld : Field; Fore : out Character_Attribute_Set) is - function Field_Fore (Fld : Field) return C_Chtype; + function Field_Fore (Fld : Field) return Attributed_Character; pragma Import (C, Field_Fore, "field_fore"); begin - Fore := Chtype_To_AttrChar (Field_Fore (Fld)).Attr; + Fore := Field_Fore (Fld).Attr; end Foreground; procedure Foreground (Fld : Field; Fore : out Character_Attribute_Set; Color : out Color_Pair) is - function Field_Fore (Fld : Field) return C_Chtype; + function Field_Fore (Fld : Field) return Attributed_Character; pragma Import (C, Field_Fore, "field_fore"); begin - Fore := Chtype_To_AttrChar (Field_Fore (Fld)).Attr; - Color := Chtype_To_AttrChar (Field_Fore (Fld)).Color; + Fore := Field_Fore (Fld).Attr; + Color := Field_Fore (Fld).Color; end Foreground; -- | -- | @@ -446,18 +393,13 @@ package body Terminal_Interface.Curses.Forms is Color : Color_Pair := Color_Pair'First) is function Set_Field_Back (Fld : Field; - Attr : C_Chtype) return C_Int; + Attr : Attributed_Character) return Eti_Error; pragma Import (C, Set_Field_Back, "set_field_back"); - Ch : constant Attributed_Character := (Ch => Character'First, - Color => Color, - Attr => Back); - Res : constant Eti_Error := - Set_Field_Back (Fld, AttrChar_To_Chtype (Ch)); begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Field_Back (Fld, (Ch => Character'First, + Color => Color, + Attr => Back))); end Set_Background; -- | -- | @@ -465,21 +407,21 @@ package body Terminal_Interface.Curses.Forms is procedure Background (Fld : Field; Back : out Character_Attribute_Set) is - function Field_Back (Fld : Field) return C_Chtype; + function Field_Back (Fld : Field) return Attributed_Character; pragma Import (C, Field_Back, "field_back"); begin - Back := Chtype_To_AttrChar (Field_Back (Fld)).Attr; + Back := Field_Back (Fld).Attr; end Background; procedure Background (Fld : Field; Back : out Character_Attribute_Set; Color : out Color_Pair) is - function Field_Back (Fld : Field) return C_Chtype; + function Field_Back (Fld : Field) return Attributed_Character; pragma Import (C, Field_Back, "field_back"); begin - Back := Chtype_To_AttrChar (Field_Back (Fld)).Attr; - Color := Chtype_To_AttrChar (Field_Back (Fld)).Color; + Back := Field_Back (Fld).Attr; + Color := Field_Back (Fld).Color; end Background; -- | -- | @@ -488,15 +430,12 @@ package body Terminal_Interface.Curses.Forms is Pad : Character := Space) is function Set_Field_Pad (Fld : Field; - Ch : C_Int) return C_Int; + Ch : C_Int) return Eti_Error; pragma Import (C, Set_Field_Pad, "set_field_pad"); - Res : constant Eti_Error := Set_Field_Pad (Fld, - C_Int (Character'Pos (Pad))); begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Field_Pad (Fld, + C_Int (Character'Pos (Pad)))); end Set_Pad_Character; -- | -- | @@ -527,25 +466,21 @@ package body Terminal_Interface.Curses.Forms is type C_Int_Access is access all C_Int; function Fld_Info (Fld : Field; L, C, Fr, Fc, Os, Ab : C_Int_Access) - return C_Int; + return Eti_Error; pragma Import (C, Fld_Info, "field_info"); L, C, Fr, Fc, Os, Ab : aliased C_Int; - Res : constant Eti_Error := Fld_Info (Fld, - L'Access, C'Access, - Fr'Access, Fc'Access, - Os'Access, Ab'Access); begin - if Res /= E_Ok then - Eti_Exception (Res); - else - Lines := Line_Count (L); - Columns := Column_Count (C); - First_Row := Line_Position (Fr); - First_Column := Column_Position (Fc); - Off_Screen := Natural (Os); - Additional_Buffers := Buffer_Number (Ab); - end if; + Eti_Exception (Fld_Info (Fld, + L'Access, C'Access, + Fr'Access, Fc'Access, + Os'Access, Ab'Access)); + Lines := Line_Count (L); + Columns := Column_Count (C); + First_Row := Line_Position (Fr); + First_Column := Column_Position (Fc); + Off_Screen := Natural (Os); + Additional_Buffers := Buffer_Number (Ab); end Info; -- | -- | @@ -556,21 +491,17 @@ package body Terminal_Interface.Curses.Forms is Max : out Natural) is type C_Int_Access is access all C_Int; - function Dyn_Info (Fld : Field; L, C, M : C_Int_Access) return C_Int; + function Dyn_Info (Fld : Field; L, C, M : C_Int_Access) return Eti_Error; pragma Import (C, Dyn_Info, "dynamic_field_info"); L, C, M : aliased C_Int; - Res : constant Eti_Error := Dyn_Info (Fld, - L'Access, C'Access, - M'Access); begin - if Res /= E_Ok then - Eti_Exception (Res); - else - Lines := Line_Count (L); - Columns := Column_Count (C); - Max := Natural (M); - end if; + Eti_Exception (Dyn_Info (Fld, + L'Access, C'Access, + M'Access)); + Lines := Line_Count (L); + Columns := Column_Count (C); + Max := Natural (M); end Dynamic_Info; -- | -- |===================================================================== @@ -583,14 +514,11 @@ package body Terminal_Interface.Curses.Forms is Win : Window) is function Set_Form_Win (Frm : Form; - Win : Window) return C_Int; + Win : Window) return Eti_Error; pragma Import (C, Set_Form_Win, "set_form_win"); - Res : constant Eti_Error := Set_Form_Win (Frm, Win); begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Form_Win (Frm, Win)); end Set_Window; -- | -- | @@ -611,14 +539,11 @@ package body Terminal_Interface.Curses.Forms is Win : Window) is function Set_Form_Sub (Frm : Form; - Win : Window) return C_Int; + Win : Window) return Eti_Error; pragma Import (C, Set_Form_Sub, "set_form_sub"); - Res : constant Eti_Error := Set_Form_Sub (Frm, Win); begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Form_Sub (Frm, Win)); end Set_Sub_Window; -- | -- | @@ -640,16 +565,13 @@ package body Terminal_Interface.Curses.Forms is Columns : out Column_Count) is type C_Int_Access is access all C_Int; - function M_Scale (Frm : Form; Yp, Xp : C_Int_Access) return C_Int; + function M_Scale (Frm : Form; Yp, Xp : C_Int_Access) return Eti_Error; pragma Import (C, M_Scale, "scale_form"); X, Y : aliased C_Int; - Res : constant Eti_Error := M_Scale (Frm, Y'Access, X'Access); begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; - Lines := Line_Count (Y); + Eti_Exception (M_Scale (Frm, Y'Access, X'Access)); + Lines := Line_Count (Y); Columns := Column_Count (X); end Scale; -- | @@ -663,14 +585,11 @@ package body Terminal_Interface.Curses.Forms is Proc : Form_Hook_Function) is function Set_Field_Init (Frm : Form; - Proc : Form_Hook_Function) return C_Int; + Proc : Form_Hook_Function) return Eti_Error; pragma Import (C, Set_Field_Init, "set_field_init"); - Res : constant Eti_Error := Set_Field_Init (Frm, Proc); begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Field_Init (Frm, Proc)); end Set_Field_Init_Hook; -- | -- | @@ -679,14 +598,11 @@ package body Terminal_Interface.Curses.Forms is Proc : Form_Hook_Function) is function Set_Field_Term (Frm : Form; - Proc : Form_Hook_Function) return C_Int; + Proc : Form_Hook_Function) return Eti_Error; pragma Import (C, Set_Field_Term, "set_field_term"); - Res : constant Eti_Error := Set_Field_Term (Frm, Proc); begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Field_Term (Frm, Proc)); end Set_Field_Term_Hook; -- | -- | @@ -695,14 +611,11 @@ package body Terminal_Interface.Curses.Forms is Proc : Form_Hook_Function) is function Set_Form_Init (Frm : Form; - Proc : Form_Hook_Function) return C_Int; + Proc : Form_Hook_Function) return Eti_Error; pragma Import (C, Set_Form_Init, "set_form_init"); - Res : constant Eti_Error := Set_Form_Init (Frm, Proc); begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Form_Init (Frm, Proc)); end Set_Form_Init_Hook; -- | -- | @@ -711,14 +624,11 @@ package body Terminal_Interface.Curses.Forms is Proc : Form_Hook_Function) is function Set_Form_Term (Frm : Form; - Proc : Form_Hook_Function) return C_Int; + Proc : Form_Hook_Function) return Eti_Error; pragma Import (C, Set_Form_Term, "set_form_term"); - Res : constant Eti_Error := Set_Form_Term (Frm, Proc); begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Form_Term (Frm, Proc)); end Set_Form_Term_Hook; -- | -- |===================================================================== @@ -731,19 +641,15 @@ package body Terminal_Interface.Curses.Forms is Flds : Field_Array_Access) is function Set_Frm_Fields (Frm : Form; - Items : System.Address) return C_Int; + Items : System.Address) return Eti_Error; pragma Import (C, Set_Frm_Fields, "set_form_fields"); - Res : Eti_Error; begin pragma Assert (Flds.all (Flds'Last) = Null_Field); if Flds.all (Flds'Last) /= Null_Field then raise Form_Exception; else - Res := Set_Frm_Fields (Frm, Flds.all (Flds'First)'Address); - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Frm_Fields (Frm, Flds.all (Flds'First)'Address)); end if; end Redefine; -- | @@ -783,14 +689,11 @@ package body Terminal_Interface.Curses.Forms is Line : Line_Position; Column : Column_Position) is - function Move (Fld : Field; L, C : C_Int) return C_Int; + function Move (Fld : Field; L, C : C_Int) return Eti_Error; pragma Import (C, Move, "move_field"); - Res : constant Eti_Error := Move (Fld, C_Int (Line), C_Int (Column)); begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Move (Fld, C_Int (Line), C_Int (Column))); end Move; -- | -- |===================================================================== @@ -822,14 +725,11 @@ package body Terminal_Interface.Curses.Forms is -- | procedure Delete (Frm : in out Form) is - function Free (Frm : Form) return C_Int; + function Free (Frm : Form) return Eti_Error; pragma Import (C, Free, "free_form"); - Res : constant Eti_Error := Free (Frm); begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Free (Frm)); Frm := Null_Form; end Delete; -- | @@ -843,16 +743,11 @@ package body Terminal_Interface.Curses.Forms is Options : Form_Option_Set) is function Set_Form_Opts (Frm : Form; - Opt : C_Int) return C_Int; + Opt : Form_Option_Set) return Eti_Error; pragma Import (C, Set_Form_Opts, "set_form_opts"); - Opt : constant C_Int := FrmOS_2_CInt (Options); - Res : Eti_Error; begin - Res := Set_Form_Opts (Frm, Opt); - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Form_Opts (Frm, Options)); end Set_Options; -- | -- | @@ -862,22 +757,17 @@ package body Terminal_Interface.Curses.Forms is On : Boolean := True) is function Form_Opts_On (Frm : Form; - Opt : C_Int) return C_Int; + Opt : Form_Option_Set) return Eti_Error; pragma Import (C, Form_Opts_On, "form_opts_on"); function Form_Opts_Off (Frm : Form; - Opt : C_Int) return C_Int; + Opt : Form_Option_Set) return Eti_Error; pragma Import (C, Form_Opts_Off, "form_opts_off"); - Err : Eti_Error; - Opt : constant C_Int := FrmOS_2_CInt (Options); begin if On then - Err := Form_Opts_On (Frm, Opt); + Eti_Exception (Form_Opts_On (Frm, Options)); else - Err := Form_Opts_Off (Frm, Opt); - end if; - if Err /= E_Ok then - Eti_Exception (Err); + Eti_Exception (Form_Opts_Off (Frm, Options)); end if; end Switch_Options; -- | @@ -886,12 +776,11 @@ package body Terminal_Interface.Curses.Forms is procedure Get_Options (Frm : Form; Options : out Form_Option_Set) is - function Form_Opts (Frm : Form) return C_Int; + function Form_Opts (Frm : Form) return Form_Option_Set; pragma Import (C, Form_Opts, "form_opts"); - Res : constant C_Int := Form_Opts (Frm); begin - Options := CInt_2_FrmOS (Res); + Options := Form_Opts (Frm); end Get_Options; -- | -- | @@ -913,20 +802,16 @@ package body Terminal_Interface.Curses.Forms is procedure Post (Frm : Form; Post : Boolean := True) is - function M_Post (Frm : Form) return C_Int; + function M_Post (Frm : Form) return Eti_Error; pragma Import (C, M_Post, "post_form"); - function M_Unpost (Frm : Form) return C_Int; + function M_Unpost (Frm : Form) return Eti_Error; pragma Import (C, M_Unpost, "unpost_form"); - Res : Eti_Error; begin if Post then - Res := M_Post (Frm); + Eti_Exception (M_Post (Frm)); else - Res := M_Unpost (Frm); - end if; - if Res /= E_Ok then - Eti_Exception (Res); + Eti_Exception (M_Unpost (Frm)); end if; end Post; -- | @@ -938,14 +823,11 @@ package body Terminal_Interface.Curses.Forms is -- | procedure Position_Cursor (Frm : Form) is - function Pos_Form_Cursor (Frm : Form) return C_Int; + function Pos_Form_Cursor (Frm : Form) return Eti_Error; pragma Import (C, Pos_Form_Cursor, "pos_form_cursor"); - Res : constant Eti_Error := Pos_Form_Cursor (Frm); begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Pos_Form_Cursor (Frm)); end Position_Cursor; -- | -- |===================================================================== @@ -993,25 +875,22 @@ package body Terminal_Interface.Curses.Forms is function Driver (Frm : Form; Key : Key_Code) return Driver_Result is - function Frm_Driver (Frm : Form; Key : C_Int) return C_Int; + function Frm_Driver (Frm : Form; Key : C_Int) return Eti_Error; pragma Import (C, Frm_Driver, "form_driver"); R : constant Eti_Error := Frm_Driver (Frm, C_Int (Key)); begin - if R /= E_Ok then - if R = E_Unknown_Command then + case R is + when E_Unknown_Command => return Unknown_Request; - elsif R = E_Invalid_Field then + when E_Invalid_Field => return Invalid_Field; - elsif R = E_Request_Denied then + when E_Request_Denied => return Request_Denied; - else + when others => Eti_Exception (R); return Form_Ok; - end if; - else - return Form_Ok; - end if; + end case; end Driver; -- | -- |===================================================================== @@ -1023,14 +902,11 @@ package body Terminal_Interface.Curses.Forms is procedure Set_Current (Frm : Form; Fld : Field) is - function Set_Current_Fld (Frm : Form; Fld : Field) return C_Int; + function Set_Current_Fld (Frm : Form; Fld : Field) return Eti_Error; pragma Import (C, Set_Current_Fld, "set_current_field"); - Res : constant Eti_Error := Set_Current_Fld (Frm, Fld); begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Current_Fld (Frm, Fld)); end Set_Current; -- | -- | @@ -1053,14 +929,11 @@ package body Terminal_Interface.Curses.Forms is procedure Set_Page (Frm : Form; Page : Page_Number := Page_Number'First) is - function Set_Frm_Page (Frm : Form; Pg : C_Int) return C_Int; + function Set_Frm_Page (Frm : Form; Pg : C_Int) return Eti_Error; pragma Import (C, Set_Frm_Page, "set_form_page"); - Res : constant Eti_Error := Set_Frm_Page (Frm, C_Int (Page)); begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Frm_Page (Frm, C_Int (Page))); end Set_Page; -- | -- | @@ -1102,14 +975,11 @@ package body Terminal_Interface.Curses.Forms is procedure Set_New_Page (Fld : Field; New_Page : Boolean := True) is - function Set_Page (Fld : Field; Flg : C_Int) return C_Int; + function Set_Page (Fld : Field; Flg : C_Int) return Eti_Error; pragma Import (C, Set_Page, "set_new_page"); - Res : constant Eti_Error := Set_Page (Fld, Boolean'Pos (New_Page)); begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Page (Fld, Boolean'Pos (New_Page))); end Set_New_Page; -- | -- | diff --git a/Ada95/src/terminal_interface-curses-menus-item_user_data.adb b/Ada95/src/terminal_interface-curses-menus-item_user_data.adb index eb06d09..da26f80 100644 --- a/Ada95/src/terminal_interface-curses-menus-item_user_data.adb +++ b/Ada95/src/terminal_interface-curses-menus-item_user_data.adb @@ -7,7 +7,7 @@ -- B O D Y -- -- -- ------------------------------------------------------------------------------ --- Copyright (c) 1998-2003,2009 Free Software Foundation, Inc. -- +-- Copyright (c) 1998-2009,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,7 +35,7 @@ ------------------------------------------------------------------------------ -- Author: Juergen Pfeifer, 1996 -- Version Control: --- $Revision: 1.12 $ +-- $Revision: 1.14 $ -- Binding Version 01.00 ------------------------------------------------------------------------------ with Interfaces.C; @@ -49,14 +49,11 @@ package body Terminal_Interface.Curses.Menus.Item_User_Data is Data : User_Access) is function Set_Item_Userptr (Itm : Item; - Addr : User_Access) return C_Int; + Addr : User_Access) return Eti_Error; pragma Import (C, Set_Item_Userptr, "set_item_userptr"); - Res : constant Eti_Error := Set_Item_Userptr (Itm, Data); begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Item_Userptr (Itm, Data)); end Set_User_Data; function Get_User_Data (Itm : Item) return User_Access diff --git a/Ada95/src/terminal_interface-curses-menus-menu_user_data.adb b/Ada95/src/terminal_interface-curses-menus-menu_user_data.adb index 7d66a8c..746e7b4 100644 --- a/Ada95/src/terminal_interface-curses-menus-menu_user_data.adb +++ b/Ada95/src/terminal_interface-curses-menus-menu_user_data.adb @@ -7,7 +7,7 @@ -- B O D Y -- -- -- ------------------------------------------------------------------------------ --- Copyright (c) 1998-2003,2009 Free Software Foundation, Inc. -- +-- Copyright (c) 1998-2009,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,7 +35,7 @@ ------------------------------------------------------------------------------ -- Author: Juergen Pfeifer, 1996 -- Version Control: --- $Revision: 1.13 $ +-- $Revision: 1.15 $ -- Binding Version 01.00 ------------------------------------------------------------------------------ with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; @@ -48,14 +48,12 @@ package body Terminal_Interface.Curses.Menus.Menu_User_Data is Data : User_Access) is function Set_Menu_Userptr (Men : Menu; - Data : User_Access) return C_Int; + Data : User_Access) return Eti_Error; pragma Import (C, Set_Menu_Userptr, "set_menu_userptr"); - Res : constant Eti_Error := Set_Menu_Userptr (Men, Data); begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Menu_Userptr (Men, Data)); + end Set_User_Data; function Get_User_Data (Men : Menu) return User_Access diff --git a/Ada95/src/terminal_interface-curses-menus.adb b/Ada95/src/terminal_interface-curses-menus.adb index a7dca07..ef3a0d3 100644 --- a/Ada95/src/terminal_interface-curses-menus.adb +++ b/Ada95/src/terminal_interface-curses-menus.adb @@ -7,7 +7,7 @@ -- B O D Y -- -- -- ------------------------------------------------------------------------------ --- Copyright (c) 1998-2009,2011 Free Software Foundation, Inc. -- +-- Copyright (c) 1998-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,8 +35,8 @@ ------------------------------------------------------------------------------ -- Author: Juergen Pfeifer, 1996 -- Version Control: --- $Revision: 1.28 $ --- $Date: 2011/03/22 23:38:12 $ +-- $Revision: 1.32 $ +-- $Date: 2014/05/24 21:31:05 $ -- Binding Version 01.00 ------------------------------------------------------------------------------ with Ada.Unchecked_Deallocation; @@ -46,8 +46,6 @@ with Interfaces.C; use Interfaces.C; with Interfaces.C.Strings; use Interfaces.C.Strings; with Interfaces.C.Pointers; -with Ada.Unchecked_Conversion; - package body Terminal_Interface.Curses.Menus is type C_Item_Array is array (Natural range <>) of aliased Item; @@ -57,22 +55,6 @@ package body Terminal_Interface.Curses.Menus is use type System.Bit_Order; subtype chars_ptr is Interfaces.C.Strings.chars_ptr; - function MOS_2_CInt is new - Ada.Unchecked_Conversion (Menu_Option_Set, - C_Int); - - function CInt_2_MOS is new - Ada.Unchecked_Conversion (C_Int, - Menu_Option_Set); - - function IOS_2_CInt is new - Ada.Unchecked_Conversion (Item_Option_Set, - C_Int); - - function CInt_2_IOS is new - Ada.Unchecked_Conversion (C_Int, - Item_Option_Set); - ------------------------------------------------------------------------------ procedure Request_Name (Key : Menu_Request_Code; Name : out String) @@ -128,10 +110,9 @@ package body Terminal_Interface.Curses.Menus is function Itemname (Itm : Item) return chars_ptr; pragma Import (C, Itemname, "item_name"); - function Freeitem (Itm : Item) return C_Int; + function Freeitem (Itm : Item) return Eti_Error; pragma Import (C, Freeitem, "free_item"); - Res : Eti_Error; Ptr : chars_ptr; begin Ptr := Descname (Itm); @@ -142,10 +123,7 @@ package body Terminal_Interface.Curses.Menus is if Ptr /= Null_Ptr then Interfaces.C.Strings.Free (Ptr); end if; - Res := Freeitem (Itm); - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Freeitem (Itm)); Itm := Null_Item; end Delete; ------------------------------------------------------------------------------- @@ -153,14 +131,11 @@ package body Terminal_Interface.Curses.Menus is Value : Boolean := True) is function Set_Item_Val (Itm : Item; - Val : C_Int) return C_Int; + Val : C_Int) return Eti_Error; pragma Import (C, Set_Item_Val, "set_item_value"); - Res : constant Eti_Error := Set_Item_Val (Itm, Boolean'Pos (Value)); begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Item_Val (Itm, Boolean'Pos (Value))); end Set_Value; function Value (Itm : Item) return Boolean @@ -192,16 +167,11 @@ package body Terminal_Interface.Curses.Menus is Options : Item_Option_Set) is function Set_Item_Opts (Itm : Item; - Opt : C_Int) return C_Int; + Opt : Item_Option_Set) return Eti_Error; pragma Import (C, Set_Item_Opts, "set_item_opts"); - Opt : constant C_Int := IOS_2_CInt (Options); - Res : Eti_Error; begin - Res := Set_Item_Opts (Itm, Opt); - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Item_Opts (Itm, Options)); end Set_Options; procedure Switch_Options (Itm : Item; @@ -209,34 +179,28 @@ package body Terminal_Interface.Curses.Menus is On : Boolean := True) is function Item_Opts_On (Itm : Item; - Opt : C_Int) return C_Int; + Opt : Item_Option_Set) return Eti_Error; pragma Import (C, Item_Opts_On, "item_opts_on"); function Item_Opts_Off (Itm : Item; - Opt : C_Int) return C_Int; + Opt : Item_Option_Set) return Eti_Error; pragma Import (C, Item_Opts_Off, "item_opts_off"); - Opt : constant C_Int := IOS_2_CInt (Options); - Err : Eti_Error; begin if On then - Err := Item_Opts_On (Itm, Opt); + Eti_Exception (Item_Opts_On (Itm, Options)); else - Err := Item_Opts_Off (Itm, Opt); - end if; - if Err /= E_Ok then - Eti_Exception (Err); + Eti_Exception (Item_Opts_Off (Itm, Options)); end if; end Switch_Options; procedure Get_Options (Itm : Item; Options : out Item_Option_Set) is - function Item_Opts (Itm : Item) return C_Int; + function Item_Opts (Itm : Item) return Item_Option_Set; pragma Import (C, Item_Opts, "item_opts"); - Res : constant C_Int := Item_Opts (Itm); begin - Options := CInt_2_IOS (Res); + Options := Item_Opts (Itm); end Get_Options; function Get_Options (Itm : Item := Null_Item) return Item_Option_Set @@ -285,14 +249,11 @@ package body Terminal_Interface.Curses.Menus is Itm : Item) is function Set_Curr_Item (Men : Menu; - Itm : Item) return C_Int; + Itm : Item) return Eti_Error; pragma Import (C, Set_Curr_Item, "set_current_item"); - Res : constant Eti_Error := Set_Curr_Item (Men, Itm); begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Curr_Item (Men, Itm)); end Set_Current; function Current (Men : Menu) return Item @@ -312,14 +273,11 @@ package body Terminal_Interface.Curses.Menus is Line : Line_Position) is function Set_Toprow (Men : Menu; - Line : C_Int) return C_Int; + Line : C_Int) return Eti_Error; pragma Import (C, Set_Toprow, "set_top_row"); - Res : constant Eti_Error := Set_Toprow (Men, C_Int (Line)); begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Toprow (Men, C_Int (Line))); end Set_Top_Row; function Top_Row (Men : Menu) return Line_Position @@ -351,20 +309,16 @@ package body Terminal_Interface.Curses.Menus is procedure Post (Men : Menu; Post : Boolean := True) is - function M_Post (Men : Menu) return C_Int; + function M_Post (Men : Menu) return Eti_Error; pragma Import (C, M_Post, "post_menu"); - function M_Unpost (Men : Menu) return C_Int; + function M_Unpost (Men : Menu) return Eti_Error; pragma Import (C, M_Unpost, "unpost_menu"); - Res : Eti_Error; begin if Post then - Res := M_Post (Men); + Eti_Exception (M_Post (Men)); else - Res := M_Unpost (Men); - end if; - if Res /= E_Ok then - Eti_Exception (Res); + Eti_Exception (M_Unpost (Men)); end if; end Post; ------------------------------------------------------------------------------- @@ -372,16 +326,11 @@ package body Terminal_Interface.Curses.Menus is Options : Menu_Option_Set) is function Set_Menu_Opts (Men : Menu; - Opt : C_Int) return C_Int; + Opt : Menu_Option_Set) return Eti_Error; pragma Import (C, Set_Menu_Opts, "set_menu_opts"); - Opt : constant C_Int := MOS_2_CInt (Options); - Res : Eti_Error; begin - Res := Set_Menu_Opts (Men, Opt); - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Menu_Opts (Men, Options)); end Set_Options; procedure Switch_Options (Men : Menu; @@ -389,34 +338,28 @@ package body Terminal_Interface.Curses.Menus is On : Boolean := True) is function Menu_Opts_On (Men : Menu; - Opt : C_Int) return C_Int; + Opt : Menu_Option_Set) return Eti_Error; pragma Import (C, Menu_Opts_On, "menu_opts_on"); function Menu_Opts_Off (Men : Menu; - Opt : C_Int) return C_Int; + Opt : Menu_Option_Set) return Eti_Error; pragma Import (C, Menu_Opts_Off, "menu_opts_off"); - Opt : constant C_Int := MOS_2_CInt (Options); - Err : Eti_Error; begin if On then - Err := Menu_Opts_On (Men, Opt); + Eti_Exception (Menu_Opts_On (Men, Options)); else - Err := Menu_Opts_Off (Men, Opt); - end if; - if Err /= E_Ok then - Eti_Exception (Err); + Eti_Exception (Menu_Opts_Off (Men, Options)); end if; end Switch_Options; procedure Get_Options (Men : Menu; Options : out Menu_Option_Set) is - function Menu_Opts (Men : Menu) return C_Int; + function Menu_Opts (Men : Menu) return Menu_Option_Set; pragma Import (C, Menu_Opts, "menu_opts"); - Res : constant C_Int := Menu_Opts (Men); begin - Options := CInt_2_MOS (Res); + Options := Menu_Opts (Men); end Get_Options; function Get_Options (Men : Menu := Null_Menu) return Menu_Option_Set @@ -431,14 +374,11 @@ package body Terminal_Interface.Curses.Menus is Win : Window) is function Set_Menu_Win (Men : Menu; - Win : Window) return C_Int; + Win : Window) return Eti_Error; pragma Import (C, Set_Menu_Win, "set_menu_win"); - Res : constant Eti_Error := Set_Menu_Win (Men, Win); begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Menu_Win (Men, Win)); end Set_Window; function Get_Window (Men : Menu) return Window @@ -455,14 +395,11 @@ package body Terminal_Interface.Curses.Menus is Win : Window) is function Set_Menu_Sub (Men : Menu; - Win : Window) return C_Int; + Win : Window) return Eti_Error; pragma Import (C, Set_Menu_Sub, "set_menu_sub"); - Res : constant Eti_Error := Set_Menu_Sub (Men, Win); begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Menu_Sub (Men, Win)); end Set_Sub_Window; function Get_Sub_Window (Men : Menu) return Window @@ -481,29 +418,23 @@ package body Terminal_Interface.Curses.Menus is is type C_Int_Access is access all C_Int; function M_Scale (Men : Menu; - Yp, Xp : C_Int_Access) return C_Int; + Yp, Xp : C_Int_Access) return Eti_Error; pragma Import (C, M_Scale, "scale_menu"); X, Y : aliased C_Int; - Res : constant Eti_Error := M_Scale (Men, Y'Access, X'Access); begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (M_Scale (Men, Y'Access, X'Access)); Lines := Line_Count (Y); Columns := Column_Count (X); end Scale; ------------------------------------------------------------------------------- procedure Position_Cursor (Men : Menu) is - function Pos_Menu_Cursor (Men : Menu) return C_Int; + function Pos_Menu_Cursor (Men : Menu) return Eti_Error; pragma Import (C, Pos_Menu_Cursor, "pos_menu_cursor"); - Res : constant Eti_Error := Pos_Menu_Cursor (Men); begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Pos_Menu_Cursor (Men)); end Position_Cursor; ------------------------------------------------------------------------------- @@ -512,18 +443,14 @@ package body Terminal_Interface.Curses.Menus is is type Char_Ptr is access all Interfaces.C.char; function Set_Mark (Men : Menu; - Mark : Char_Ptr) return C_Int; + Mark : Char_Ptr) return Eti_Error; pragma Import (C, Set_Mark, "set_menu_mark"); Txt : char_array (0 .. Mark'Length); Len : size_t; - Res : Eti_Error; begin To_C (Mark, Txt, Len); - Res := Set_Mark (Men, Txt (Txt'First)'Access); - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Mark (Men, Txt (Txt'First)'Access)); end Set_Mark; procedure Mark (Men : Menu; @@ -550,37 +477,34 @@ package body Terminal_Interface.Curses.Menus is Color : Color_Pair := Color_Pair'First) is function Set_Menu_Fore (Men : Menu; - Attr : C_Chtype) return C_Int; + Attr : Attributed_Character) return Eti_Error; pragma Import (C, Set_Menu_Fore, "set_menu_fore"); Ch : constant Attributed_Character := (Ch => Character'First, Color => Color, Attr => Fore); - Res : constant Eti_Error := Set_Menu_Fore (Men, AttrChar_To_Chtype (Ch)); begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Menu_Fore (Men, Ch)); end Set_Foreground; procedure Foreground (Men : Menu; Fore : out Character_Attribute_Set) is - function Menu_Fore (Men : Menu) return C_Chtype; + function Menu_Fore (Men : Menu) return Attributed_Character; pragma Import (C, Menu_Fore, "menu_fore"); begin - Fore := Chtype_To_AttrChar (Menu_Fore (Men)).Attr; + Fore := Menu_Fore (Men).Attr; end Foreground; procedure Foreground (Men : Menu; Fore : out Character_Attribute_Set; Color : out Color_Pair) is - function Menu_Fore (Men : Menu) return C_Chtype; + function Menu_Fore (Men : Menu) return Attributed_Character; pragma Import (C, Menu_Fore, "menu_fore"); begin - Fore := Chtype_To_AttrChar (Menu_Fore (Men)).Attr; - Color := Chtype_To_AttrChar (Menu_Fore (Men)).Color; + Fore := Menu_Fore (Men).Attr; + Color := Menu_Fore (Men).Color; end Foreground; procedure Set_Background @@ -589,37 +513,34 @@ package body Terminal_Interface.Curses.Menus is Color : Color_Pair := Color_Pair'First) is function Set_Menu_Back (Men : Menu; - Attr : C_Chtype) return C_Int; + Attr : Attributed_Character) return Eti_Error; pragma Import (C, Set_Menu_Back, "set_menu_back"); Ch : constant Attributed_Character := (Ch => Character'First, Color => Color, Attr => Back); - Res : constant Eti_Error := Set_Menu_Back (Men, AttrChar_To_Chtype (Ch)); begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Menu_Back (Men, Ch)); end Set_Background; procedure Background (Men : Menu; Back : out Character_Attribute_Set) is - function Menu_Back (Men : Menu) return C_Chtype; + function Menu_Back (Men : Menu) return Attributed_Character; pragma Import (C, Menu_Back, "menu_back"); begin - Back := Chtype_To_AttrChar (Menu_Back (Men)).Attr; + Back := Menu_Back (Men).Attr; end Background; procedure Background (Men : Menu; Back : out Character_Attribute_Set; Color : out Color_Pair) is - function Menu_Back (Men : Menu) return C_Chtype; + function Menu_Back (Men : Menu) return Attributed_Character; pragma Import (C, Menu_Back, "menu_back"); begin - Back := Chtype_To_AttrChar (Menu_Back (Men)).Attr; - Color := Chtype_To_AttrChar (Menu_Back (Men)).Color; + Back := Menu_Back (Men).Attr; + Color := Menu_Back (Men).Color; end Background; procedure Set_Grey (Men : Menu; @@ -627,53 +548,46 @@ package body Terminal_Interface.Curses.Menus is Color : Color_Pair := Color_Pair'First) is function Set_Menu_Grey (Men : Menu; - Attr : C_Chtype) return C_Int; + Attr : Attributed_Character) return Eti_Error; pragma Import (C, Set_Menu_Grey, "set_menu_grey"); Ch : constant Attributed_Character := (Ch => Character'First, Color => Color, Attr => Grey); - Res : constant Eti_Error := Set_Menu_Grey (Men, AttrChar_To_Chtype (Ch)); begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Menu_Grey (Men, Ch)); end Set_Grey; procedure Grey (Men : Menu; Grey : out Character_Attribute_Set) is - function Menu_Grey (Men : Menu) return C_Chtype; + function Menu_Grey (Men : Menu) return Attributed_Character; pragma Import (C, Menu_Grey, "menu_grey"); begin - Grey := Chtype_To_AttrChar (Menu_Grey (Men)).Attr; + Grey := Menu_Grey (Men).Attr; end Grey; procedure Grey (Men : Menu; Grey : out Character_Attribute_Set; Color : out Color_Pair) is - function Menu_Grey (Men : Menu) return C_Chtype; + function Menu_Grey (Men : Menu) return Attributed_Character; pragma Import (C, Menu_Grey, "menu_grey"); begin - Grey := Chtype_To_AttrChar (Menu_Grey (Men)).Attr; - Color := Chtype_To_AttrChar (Menu_Grey (Men)).Color; + Grey := Menu_Grey (Men).Attr; + Color := Menu_Grey (Men).Color; end Grey; procedure Set_Pad_Character (Men : Menu; Pad : Character := Space) is function Set_Menu_Pad (Men : Menu; - Ch : C_Int) return C_Int; + Ch : C_Int) return Eti_Error; pragma Import (C, Set_Menu_Pad, "set_menu_pad"); - Res : constant Eti_Error := Set_Menu_Pad (Men, - C_Int (Character'Pos (Pad))); begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Menu_Pad (Men, C_Int (Character'Pos (Pad)))); end Set_Pad_Character; procedure Pad_Character (Men : Menu; @@ -691,17 +605,14 @@ package body Terminal_Interface.Curses.Menus is Col : Column_Position := 0) is function Set_Spacing (Men : Menu; - D, R, C : C_Int) return C_Int; + D, R, C : C_Int) return Eti_Error; pragma Import (C, Set_Spacing, "set_menu_spacing"); - Res : constant Eti_Error := Set_Spacing (Men, - C_Int (Descr), - C_Int (Row), - C_Int (Col)); begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Spacing (Men, + C_Int (Descr), + C_Int (Row), + C_Int (Col))); end Set_Spacing; procedure Spacing (Men : Menu; @@ -711,22 +622,18 @@ package body Terminal_Interface.Curses.Menus is is type C_Int_Access is access all C_Int; function Get_Spacing (Men : Menu; - D, R, C : C_Int_Access) return C_Int; + D, R, C : C_Int_Access) return Eti_Error; pragma Import (C, Get_Spacing, "menu_spacing"); D, R, C : aliased C_Int; - Res : constant Eti_Error := Get_Spacing (Men, - D'Access, - R'Access, - C'Access); begin - if Res /= E_Ok then - Eti_Exception (Res); - else - Descr := Column_Position (D); - Row := Line_Position (R); - Col := Column_Position (C); - end if; + Eti_Exception (Get_Spacing (Men, + D'Access, + R'Access, + C'Access)); + Descr := Column_Position (D); + Row := Line_Position (R); + Col := Column_Position (C); end Spacing; ------------------------------------------------------------------------------- function Set_Pattern (Men : Menu; @@ -734,7 +641,7 @@ package body Terminal_Interface.Curses.Menus is is type Char_Ptr is access all Interfaces.C.char; function Set_Pattern (Men : Menu; - Pattern : Char_Ptr) return C_Int; + Pattern : Char_Ptr) return Eti_Error; pragma Import (C, Set_Pattern, "set_menu_pattern"); S : char_array (0 .. Text'Length); @@ -744,11 +651,11 @@ package body Terminal_Interface.Curses.Menus is To_C (Text, S, L); Res := Set_Pattern (Men, S (S'First)'Access); case Res is - when E_No_Match => return False; - when E_Ok => return True; + when E_No_Match => + return False; when others => Eti_Exception (Res); - return False; + return True; end case; end Set_Pattern; @@ -767,16 +674,14 @@ package body Terminal_Interface.Curses.Menus is is function Set_Menu_Fmt (Men : Menu; Lin : C_Int; - Col : C_Int) return C_Int; + Col : C_Int) return Eti_Error; pragma Import (C, Set_Menu_Fmt, "set_menu_format"); - Res : constant Eti_Error := Set_Menu_Fmt (Men, - C_Int (Lines), - C_Int (Columns)); begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Menu_Fmt (Men, + C_Int (Lines), + C_Int (Columns))); + end Set_Format; procedure Format (Men : Menu; @@ -785,74 +690,58 @@ package body Terminal_Interface.Curses.Menus is is type C_Int_Access is access all C_Int; function Menu_Fmt (Men : Menu; - Y, X : C_Int_Access) return C_Int; + Y, X : C_Int_Access) return Eti_Error; pragma Import (C, Menu_Fmt, "menu_format"); L, C : aliased C_Int; - Res : constant Eti_Error := Menu_Fmt (Men, L'Access, C'Access); begin - if Res /= E_Ok then - Eti_Exception (Res); - else - Lines := Line_Count (L); - Columns := Column_Count (C); - end if; + Eti_Exception (Menu_Fmt (Men, L'Access, C'Access)); + Lines := Line_Count (L); + Columns := Column_Count (C); end Format; ------------------------------------------------------------------------------- procedure Set_Item_Init_Hook (Men : Menu; Proc : Menu_Hook_Function) is function Set_Item_Init (Men : Menu; - Proc : Menu_Hook_Function) return C_Int; + Proc : Menu_Hook_Function) return Eti_Error; pragma Import (C, Set_Item_Init, "set_item_init"); - Res : constant Eti_Error := Set_Item_Init (Men, Proc); begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Item_Init (Men, Proc)); end Set_Item_Init_Hook; procedure Set_Item_Term_Hook (Men : Menu; Proc : Menu_Hook_Function) is function Set_Item_Term (Men : Menu; - Proc : Menu_Hook_Function) return C_Int; + Proc : Menu_Hook_Function) return Eti_Error; pragma Import (C, Set_Item_Term, "set_item_term"); - Res : constant Eti_Error := Set_Item_Term (Men, Proc); begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Item_Term (Men, Proc)); end Set_Item_Term_Hook; procedure Set_Menu_Init_Hook (Men : Menu; Proc : Menu_Hook_Function) is function Set_Menu_Init (Men : Menu; - Proc : Menu_Hook_Function) return C_Int; + Proc : Menu_Hook_Function) return Eti_Error; pragma Import (C, Set_Menu_Init, "set_menu_init"); - Res : constant Eti_Error := Set_Menu_Init (Men, Proc); begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Menu_Init (Men, Proc)); end Set_Menu_Init_Hook; procedure Set_Menu_Term_Hook (Men : Menu; Proc : Menu_Hook_Function) is function Set_Menu_Term (Men : Menu; - Proc : Menu_Hook_Function) return C_Int; + Proc : Menu_Hook_Function) return Eti_Error; pragma Import (C, Set_Menu_Term, "set_menu_term"); - Res : constant Eti_Error := Set_Menu_Term (Men, Proc); begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Menu_Term (Men, Proc)); end Set_Menu_Term_Hook; function Get_Item_Init_Hook (Men : Menu) return Menu_Hook_Function @@ -891,19 +780,15 @@ package body Terminal_Interface.Curses.Menus is Items : Item_Array_Access) is function Set_Items (Men : Menu; - Items : System.Address) return C_Int; + Items : System.Address) return Eti_Error; pragma Import (C, Set_Items, "set_menu_items"); - Res : Eti_Error; begin pragma Assert (Items.all (Items'Last) = Null_Item); if Items.all (Items'Last) /= Null_Item then raise Menu_Exception; else - Res := Set_Items (Men, Items.all'Address); - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Items (Men, Items.all'Address)); end if; end Redefine; @@ -955,14 +840,11 @@ package body Terminal_Interface.Curses.Menus is procedure Delete (Men : in out Menu) is - function Free (Men : Menu) return C_Int; + function Free (Men : Menu) return Eti_Error; pragma Import (C, Free, "free_menu"); - Res : constant Eti_Error := Free (Men); begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Free (Men)); Men := Null_Menu; end Delete; @@ -971,22 +853,22 @@ package body Terminal_Interface.Curses.Menus is Key : Key_Code) return Driver_Result is function Driver (Men : Menu; - Key : C_Int) return C_Int; + Key : C_Int) return Eti_Error; pragma Import (C, Driver, "menu_driver"); R : constant Eti_Error := Driver (Men, C_Int (Key)); begin - if R /= E_Ok then - case R is - when E_Unknown_Command => return Unknown_Request; - when E_No_Match => return No_Match; - when E_Request_Denied | - E_Not_Selectable => return Request_Denied; - when others => - Eti_Exception (R); - end case; - end if; - return Menu_Ok; + case R is + when E_Unknown_Command => + return Unknown_Request; + when E_No_Match => + return No_Match; + when E_Request_Denied | E_Not_Selectable => + return Request_Denied; + when others => + Eti_Exception (R); + return Menu_Ok; + end case; end Driver; procedure Free (IA : in out Item_Array_Access; diff --git a/Ada95/src/terminal_interface-curses-mouse.adb b/Ada95/src/terminal_interface-curses-mouse.adb index 9b40326..7a6075c 100644 --- a/Ada95/src/terminal_interface-curses-mouse.adb +++ b/Ada95/src/terminal_interface-curses-mouse.adb @@ -7,7 +7,7 @@ -- B O D Y -- -- -- ------------------------------------------------------------------------------ --- Copyright (c) 1998-2008,2009 Free Software Foundation, Inc. -- +-- Copyright (c) 1998-2009,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,8 +35,8 @@ ------------------------------------------------------------------------------ -- Author: Juergen Pfeifer, 1996 -- Version Control: --- $Revision: 1.24 $ --- $Date: 2009/12/26 17:38:58 $ +-- $Revision: 1.25 $ +-- $Date: 2014/09/13 19:10:18 $ -- Binding Version 01.00 ------------------------------------------------------------------------------ with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; @@ -199,7 +199,8 @@ package body Terminal_Interface.Curses.Mouse is pragma Import (C, Wenclose, "wenclose"); begin if Wenclose (Win, C_Int (Event.Y), C_Int (Event.X)) - = Curses_Bool_False then + = Curses_Bool_False + then return False; else return True; diff --git a/Ada95/src/terminal_interface-curses-text_io.adb b/Ada95/src/terminal_interface-curses-text_io.adb index e2ca27f..85a4f44 100644 --- a/Ada95/src/terminal_interface-curses-text_io.adb +++ b/Ada95/src/terminal_interface-curses-text_io.adb @@ -7,7 +7,7 @@ -- B O D Y -- -- -- ------------------------------------------------------------------------------ --- Copyright (c) 1998-2009,2011 Free Software Foundation, Inc. -- +-- Copyright (c) 1998-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,8 +35,8 @@ ------------------------------------------------------------------------------ -- Author: Juergen Pfeifer, 1996 -- Version Control: --- $Revision: 1.20 $ --- $Date: 2011/03/22 23:38:49 $ +-- $Revision: 1.22 $ +-- $Date: 2014/05/24 21:32:18 $ -- Binding Version 01.00 ------------------------------------------------------------------------------ package body Terminal_Interface.Curses.Text_IO is @@ -205,7 +205,7 @@ package body Terminal_Interface.Curses.Text_IO is end if; Get_Cursor_Position (Win, Y1, X); - pragma Unreferenced (X); + pragma Warnings (Off, X); -- unreferenced N := Natural (To); N := N - 1; Y2 := Line_Position (N); if Y2 < Y1 then diff --git a/Ada95/src/terminal_interface-curses-trace.adb_p b/Ada95/src/terminal_interface-curses-trace.adb_p index d2117a4..0dead37 100644 --- a/Ada95/src/terminal_interface-curses-trace.adb_p +++ b/Ada95/src/terminal_interface-curses-trace.adb_p @@ -7,7 +7,7 @@ -- B O D Y -- -- -- ------------------------------------------------------------------------------ --- Copyright (c) 2000-2004,2009 Free Software Foundation, Inc. -- +-- Copyright (c) 2000-2009,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,60 +35,39 @@ ------------------------------------------------------------------------------ -- Author: Juergen Pfeifer, 1996 -- Version Control: --- $Revision: 1.7 $ +-- $Revision: 1.11 $ -- Binding Version 01.00 ------------------------------------------------------------------------------ #if ADA_TRACE then with Interfaces.C; use Interfaces.C; -with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; -with Ada.Unchecked_Conversion; #end if; package body Terminal_Interface.Curses.Trace is #if ADA_TRACE then - type C_TraceType is new C_UInt; - - function TraceAda_To_TraceC is new - Ada.Unchecked_Conversion (Source => Trace_Attribute_Set, - Target => C_TraceType); - procedure Trace_On (x : Trace_Attribute_Set) is - procedure traceC (y : C_TraceType); + procedure traceC (y : Trace_Attribute_Set); pragma Import (C, traceC, "trace"); begin - traceC (TraceAda_To_TraceC (x)); + traceC (x); end Trace_On; - -- 75. (12) A C function that takes a variable number of arguments can - -- correspond to several Ada subprograms, taking various specific - -- numbers and types of parameters. - procedure Trace_Put (str : String) is procedure tracef (format : char_array; s : char_array); pragma Import (C, tracef, "_traces"); - Txt : char_array (0 .. str'Length); - Length : size_t; - formatstr : constant String := "%s" & ASCII.NUL; - formattxt : char_array (0 .. formatstr'Length); + -- _traces() is defined in c_varargs_to_ada.h begin - To_C (formatstr, formattxt, Length); - To_C (str, Txt, Length); - tracef (formattxt, Txt); + tracef (To_C ("%s"), To_C (str)); end Trace_Put; #else procedure Trace_On (x : Trace_Attribute_Set) is -#if PRAGMA_UNREF - pragma Unreferenced (x); -#end if; + pragma Warnings (Off, x); -- unreferenced begin null; end Trace_On; procedure Trace_Put (str : String) is -#if PRAGMA_UNREF - pragma Unreferenced (str); -#end if; + pragma Warnings (Off, str); -- unreferenced begin null; end Trace_Put; |