diff options
| author | Ed Schouten <ed@FreeBSD.org> | 2011-04-30 10:59:17 +0000 |
|---|---|---|
| committer | Ed Schouten <ed@FreeBSD.org> | 2011-04-30 10:59:17 +0000 |
| commit | e07762606a5bf651a501cb095c98cba90e4a8fe2 (patch) | |
| tree | cfae23e686b177255a6fb3304d166f1ce5cd7ca1 /Ada95/src | |
| parent | 0294a182a1629b1d854b84906e73487d6cb75fba (diff) | |
| download | src-e07762606a5bf651a501cb095c98cba90e4a8fe2.tar.gz src-e07762606a5bf651a501cb095c98cba90e4a8fe2.zip | |
Import ncurses 5.9.vendor/ncurses/5.9-20110405
Notes
Notes:
svn path=/vendor/ncurses/dist/; revision=221245
svn path=/vendor/ncurses/5.9-20110405/; revision=221246; tag=vendor/ncurses/5.9-20110405
Diffstat (limited to 'Ada95/src')
22 files changed, 515 insertions, 216 deletions
diff --git a/Ada95/src/Makefile.in b/Ada95/src/Makefile.in index 4a599acb8927..f6c3e75673bc 100644 --- a/Ada95/src/Makefile.in +++ b/Ada95/src/Makefile.in @@ -1,5 +1,5 @@ ############################################################################## -# Copyright (c) 1998-2009,2010 Free Software Foundation, Inc. # +# Copyright (c) 1998-2010,2011 Free Software Foundation, Inc. # # # # Permission is hereby granted, free of charge, to any person obtaining a # # copy of this software and associated documentation files (the "Software"), # @@ -28,7 +28,7 @@ # # Author: Juergen Pfeifer, 1996 # -# $Id: Makefile.in,v 1.53 2010/11/27 22:14:16 tom Exp $ +# $Id: Makefile.in,v 1.60 2011/03/31 09:46:16 tom Exp $ # .SUFFIXES: @@ -44,7 +44,8 @@ top_srcdir = @top_srcdir@ srcdir = @srcdir@ prefix = @prefix@ exec_prefix = @exec_prefix@ -libdir = ${exec_prefix}/lib +includedir = @includedir@ +libdir = @libdir@ LIBDIR = $(DESTDIR)$(libdir) ADA_INCLUDE = $(DESTDIR)@ADA_INCLUDE@ @@ -61,7 +62,7 @@ LN_S = @LN_S@ CC = @CC@ CFLAGS = @CFLAGS@ -CPPFLAGS = @ACPPFLAGS@ \ +CPPFLAGS = @ACPPFLAGS@ @CPPFLAGS@ \ -DHAVE_CONFIG_H -I$(srcdir) CCFLAGS = $(CPPFLAGS) $(CFLAGS) @@ -217,11 +218,22 @@ $(ABASE)-trace.adb : $(srcdir)/$(ABASE)-trace.adb_p $(ADAPREP) -DADA_TRACE=@ADA_TRACE@ -DPRAGMA_UNREF=@PRAGMA_UNREF@ $(srcdir)/$(ABASE)-trace.adb_p $@ ############################################################################### +C_OBJS = c_varargs_to_ada.o ncurses_compat.o + +c_varargs_to_ada.o : $(srcdir)/c_varargs_to_ada.c + $(CC) $(CFLAGS_DEFAULT) -c -o $@ $(srcdir)/c_varargs_to_ada.c + +ncurses_compat.o : $(srcdir)/ncurses_compat.c + $(CC) $(CFLAGS_DEFAULT) -c -o $@ $(srcdir)/ncurses_compat.c + +############################################################################### + +MIXED_OBJS = $(C_OBJS) @USE_OLD_MAKERULES@$(LIBOBJS) @cf_generic_objects@ @USE_OLD_MAKERULES@$(BUILD_DIR_LIB)/$(STATIC_LIBNAME) :: \ @USE_OLD_MAKERULES@ $(BUILD_DIR_LIB) \ -@USE_OLD_MAKERULES@ $(LIBOBJS) @cf_generic_objects@ -@USE_OLD_MAKERULES@ $(AR) $(ARFLAGS) $@ $(LIBOBJS) @cf_generic_objects@ +@USE_OLD_MAKERULES@ $(MIXED_OBJS) +@USE_OLD_MAKERULES@ $(AR) $(ARFLAGS) $@ $(MIXED_OBJS) $(BUILD_DIR)/static-ali : ; mkdir -p $@ $(BUILD_DIR)/static-obj : ; mkdir -p $@ @@ -233,23 +245,25 @@ 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_DIRS) @USE_GNAT_PROJECTS@ $(ADAMAKE) $(ADAMAKEFLAGS) -XLIB_KIND=static +@USE_GNAT_PROJECTS@ $(AR) $(ARFLAGS) $@ $(C_OBJS) @USE_GNAT_PROJECTS@ -@USE_GNAT_PROJECTS@install \ -@USE_GNAT_PROJECTS@install.libs :: \ -@USE_GNAT_PROJECTS@ $(ADA_OBJECTS) -@USE_GNAT_PROJECTS@ $(INSTALL_LIB) \ -@USE_GNAT_PROJECTS@ $(BUILD_DIR)/static-ali/*.ali \ -@USE_GNAT_PROJECTS@ $(ADA_OBJECTS) +@USE_GNAT_LIBRARIES@install \ +@USE_GNAT_LIBRARIES@install.libs :: \ +@USE_GNAT_LIBRARIES@ $(ADA_OBJECTS) +@USE_GNAT_LIBRARIES@ $(INSTALL_LIB) \ +@USE_GNAT_LIBRARIES@ $(BUILD_DIR)/static-ali/*.ali \ +@USE_GNAT_LIBRARIES@ $(ADA_OBJECTS) uninstall \ uninstall.libs :: @rm -f $(ADA_OBJECTS)/$(STATIC_LIBNAME) -@USE_GNAT_PROJECTS@uninstall \ -@USE_GNAT_PROJECTS@uninstall.libs :: -@USE_GNAT_PROJECTS@ @$(SHELL) -c 'for name in $(BUILD_DIR)/static-ali/*.ali ; do rm -f $(ADA_OBJECTS)/`basename $$name`; done' +@USE_GNAT_LIBRARIES@uninstall \ +@USE_GNAT_LIBRARIES@uninstall.libs :: +@USE_GNAT_LIBRARIES@ @$(SHELL) -c 'for name in $(BUILD_DIR)/static-ali/*.ali ; do rm -f $(ADA_OBJECTS)/`basename $$name`; done' $(BUILD_DIR)/dynamic-ali : ; mkdir -p $@ $(BUILD_DIR)/dynamic-obj : ; mkdir -p $@ @@ -259,8 +273,9 @@ SHARED_DIRS = \ $(BUILD_DIR)/dynamic-ali \ $(BUILD_DIR)/dynamic-obj -@MAKE_ADA_SHAREDLIB@all \ +@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@ $(ADAMAKE) $(ADAMAKEFLAGS) -XLIB_KIND=dynamic install \ @@ -280,14 +295,14 @@ uninstall.libs :: $(SHELL) -c 'for name in $(SOURCE_DIR_SRC)/*.ad[sb] $(GENERATED_SOURCES); do rm -f $(ADA_INCLUDE)/`basename $$name`; done' @MAKE_ADA_SHAREDLIB@install \ -@MAKE_ADA_SHAREDLIB@install.libs :: $(ADA_OBJECTS) +@MAKE_ADA_SHAREDLIB@install.libs :: $(ADA_OBJECTS) $(LIBDIR) @MAKE_ADA_SHAREDLIB@ $(INSTALL_LIB) \ @MAKE_ADA_SHAREDLIB@ $(BUILD_DIR)/dynamic-ali/* \ @MAKE_ADA_SHAREDLIB@ $(ADA_OBJECTS) @MAKE_ADA_SHAREDLIB@ $(INSTALL_LIB) \ @MAKE_ADA_SHAREDLIB@ $(BUILD_DIR_LIB)/$(SHARED_LIBNAME) \ @MAKE_ADA_SHAREDLIB@ $(LIBDIR) -@MAKE_ADA_SHAREDLIB@ cd $(LIBDIR) && ln -s $(SHARED_LIBNAME) $(SHARED_SYMLINK) +@MAKE_ADA_SHAREDLIB@ cd $(LIBDIR) && $(LN_S) $(SHARED_LIBNAME) $(SHARED_SYMLINK) @MAKE_ADA_SHAREDLIB@ @MAKE_ADA_SHAREDLIB@uninstall \ @MAKE_ADA_SHAREDLIB@uninstall.libs :: diff --git a/Ada95/src/c_varargs_to_ada.c b/Ada95/src/c_varargs_to_ada.c new file mode 100644 index 000000000000..ed236ddc90da --- /dev/null +++ b/Ada95/src/c_varargs_to_ada.c @@ -0,0 +1,117 @@ +/**************************************************************************** + * Copyright (c) 2011 Free Software Foundation, Inc. * + * * + * Permission is hereby granted, free of charge, to any person obtaining a * + * copy of this software and associated documentation files (the * + * "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 * + ****************************************************************************/ + +/* + Version Control + $Id: c_varargs_to_ada.c,v 1.4 2011/03/19 19:07:39 tom Exp $ + --------------------------------------------------------------------------*/ +/* + */ + +#include <c_varargs_to_ada.h> + +int +set_field_type_alnum(FIELD *field, + int minimum_width) +{ + return set_field_type(field, TYPE_ALNUM, minimum_width); +} + +int +set_field_type_alpha(FIELD *field, + int minimum_width) +{ + return set_field_type(field, TYPE_ALPHA, minimum_width); +} + +int +set_field_type_enum(FIELD *field, + char **value_list, + int case_sensitive, + int unique_match) +{ + return set_field_type(field, TYPE_ENUM, value_list, case_sensitive, + unique_match); +} + +int +set_field_type_integer(FIELD *field, + int precision, + long minimum, + long maximum) +{ + return set_field_type(field, TYPE_INTEGER, precision, minimum, maximum); +} + +int +set_field_type_numeric(FIELD *field, + int precision, + double minimum, + double maximum) +{ + return set_field_type(field, TYPE_NUMERIC, precision, minimum, maximum); +} + +int +set_field_type_regexp(FIELD *field, + char *regular_expression) +{ + return set_field_type(field, TYPE_REGEXP, regular_expression); +} + +int +set_field_type_ipv4(FIELD *field) +{ + return set_field_type(field, TYPE_IPV4); +} + +int +set_field_type_user(FIELD *field, + FIELDTYPE *fieldtype, + void *arg) +{ + return set_field_type(field, fieldtype, arg); +} + +void * +void_star_make_arg(va_list *list) +{ + return va_arg(*list, void *); +} + +#ifdef TRACE +void +_traces(const char *fmt, char *arg) +{ + _tracef(fmt, arg); +} +#endif diff --git a/Ada95/src/c_varargs_to_ada.h b/Ada95/src/c_varargs_to_ada.h new file mode 100644 index 000000000000..ee6a7a7c1eb9 --- /dev/null +++ b/Ada95/src/c_varargs_to_ada.h @@ -0,0 +1,73 @@ +/**************************************************************************** + * Copyright (c) 2011 Free Software Foundation, Inc. * + * * + * Permission is hereby granted, free of charge, to any person obtaining a * + * copy of this software and associated documentation files (the * + * "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. * + ****************************************************************************/ + +/* $Id: c_varargs_to_ada.h,v 1.3 2011/03/19 19:07:41 tom Exp $ */ + +#ifndef __C_VARARGS_TO_ADA_H +#define __C_VARARGS_TO_ADA_H + +#include <form.h> + +extern int set_field_type_alnum(FIELD * /* field */ , + int /* minimum_width */ ); + +extern int set_field_type_alpha(FIELD * /* field */ , + int /* minimum_width */ ); + +extern int set_field_type_enum(FIELD * /* field */ , + char ** /* value_list */ , + int /* case_sensitive */ , + int /* unique_match */ ); + +extern int set_field_type_integer(FIELD * /* field */ , + int /* precision */ , + long /* minimum */ , + long /* maximum */ ); + +extern int set_field_type_numeric(FIELD * /* field */ , + int /* precision */ , + double /* minimum */ , + double /* maximum */ ); + +extern int set_field_type_regexp(FIELD * /* field */ , + char * /* regular_expression */ ); + +extern int set_field_type_ipv4(FIELD * /* field */ ); + +extern int set_field_type_user(FIELD * /* field */ , + FIELDTYPE * /* fieldtype */ , + void * /* arg */ ); + +extern void *void_star_make_arg(va_list * /* list */ ); + +#ifdef TRACE +extern void _traces(const char * /* fmt */ + ,char * /* arg */ ); +#endif + +#endif /* __C_VARARGS_TO_ADA_H */ diff --git a/Ada95/src/library.gpr b/Ada95/src/library.gpr index 62d67702b9c8..33e4a3c7d7e2 100644 --- a/Ada95/src/library.gpr +++ b/Ada95/src/library.gpr @@ -1,5 +1,5 @@ ------------------------------------------------------------------------------ --- Copyright (c) 2010 Free Software Foundation, Inc. -- +-- Copyright (c) 2010,2011 Free Software Foundation, Inc. -- -- -- -- Permission is hereby granted, free of charge, to any person obtaining a -- -- copy of this software and associated documentation files (the -- @@ -25,7 +25,7 @@ -- sale, use or other dealings in this Software without prior written -- -- authorization. -- ------------------------------------------------------------------------------ --- $Id: library.gpr,v 1.5 2010/11/27 22:15:04 tom Exp $ +-- $Id: library.gpr,v 1.7 2011/03/18 23:10:28 Nicolas.Boulenguez Exp $ -- http://gcc.gnu.org/onlinedocs/gnat_ugn_unw/Library-Projects.html -- http://www.adaworld.com/debian/debian-ada-policy.html project Library is @@ -43,6 +43,7 @@ project Library is for Source_Dirs use (Source_Dir & "/src", Source_Dir2, Build_Dir & "/src"); + for Library_Options use ("-lncurses", "-lpanel", "-lmenu", "-lform"); package Compiler is for Default_Switches ("Ada") use ("-g", @@ -51,5 +52,5 @@ project Library is "-gnatVa", -- All validity checks "-gnatwa"); -- Activate all optional errors end Compiler; - + for Languages use ("C", "Ada"); end Library; diff --git a/Ada95/src/ncurses_compat.c b/Ada95/src/ncurses_compat.c new file mode 100644 index 000000000000..b3d0607a5ff2 --- /dev/null +++ b/Ada95/src/ncurses_compat.c @@ -0,0 +1,135 @@ +/**************************************************************************** + * Copyright (c) 2011 Free Software Foundation, Inc. * + * * + * Permission is hereby granted, free of charge, to any person obtaining a * + * copy of this software and associated documentation files (the * + * "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: Thomas E. Dickey, 2011 * + ****************************************************************************/ + +/* + Version Control + $Id: ncurses_compat.c,v 1.2 2011/03/28 00:29:04 tom Exp $ + --------------------------------------------------------------------------*/ + +/* + * Provide compatibility with older versions of ncurses. + */ +#include <curses.h> + +#if defined(NCURSES_VERSION_PATCH) + +#if NCURSES_VERSION_PATCH < 20081122 +extern bool has_mouse(void); +extern int _nc_has_mouse(void); + +bool +has_mouse(void) +{ + return (bool) _nc_has_mouse(); +} +#endif + +/* + * These are provided by lib_gen.c: + */ +#if NCURSES_VERSION_PATCH < 20070331 +extern bool (is_keypad) (const WINDOW *); +extern bool (is_scrollok) (const WINDOW *); + +bool +is_keypad(const WINDOW *win) +{ + return ((win)->_use_keypad); +} + +bool + (is_scrollok) (const WINDOW *win) +{ + return ((win)->_scroll); +} +#endif + +#if NCURSES_VERSION_PATCH < 20060107 +extern int (getbegx) (WINDOW *); +extern int (getbegy) (WINDOW *); +extern int (getcurx) (WINDOW *); +extern int (getcury) (WINDOW *); +extern int (getmaxx) (WINDOW *); +extern int (getmaxy) (WINDOW *); +extern int (getparx) (WINDOW *); +extern int (getpary) (WINDOW *); + +int + (getbegy) (WINDOW *win) +{ + return ((win) ? (win)->_begy : ERR); +} + +int + (getbegx) (WINDOW *win) +{ + return ((win) ? (win)->_begx : ERR); +} + +int + (getcury) (WINDOW *win) +{ + return ((win) ? (win)->_cury : ERR); +} + +int + (getcurx) (WINDOW *win) +{ + return ((win) ? (win)->_curx : ERR); +} + +int + (getmaxy) (WINDOW *win) +{ + return ((win) ? ((win)->_maxy + 1) : ERR); +} + +int + (getmaxx) (WINDOW *win) +{ + return ((win) ? ((win)->_maxx + 1) : ERR); +} + +int + (getpary) (WINDOW *win) +{ + return ((win) ? (win)->_pary : ERR); +} + +int + (getparx) (WINDOW *win) +{ + return ((win) ? (win)->_parx : ERR); +} +#endif + +#endif 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 8e9d71adaf44..943362012394 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-2008,2009 Free Software Foundation, Inc. -- +-- Copyright (c) 1998-2009,2011 Free Software Foundation, Inc. -- -- -- -- Permission is hereby granted, free of charge, to any person obtaining a -- -- copy of this software and associated documentation files (the -- @@ -35,8 +35,8 @@ ------------------------------------------------------------------------------ -- Author: Juergen Pfeifer, 1996 -- Version Control: --- $Revision: 1.10 $ --- $Date: 2009/12/26 17:38:58 $ +-- $Revision: 1.11 $ +-- $Date: 2011/03/19 00:45:37 $ -- Binding Version 01.00 ------------------------------------------------------------------------------ with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; @@ -46,13 +46,9 @@ package body Terminal_Interface.Curses.Forms.Field_Types.Alpha is procedure Set_Field_Type (Fld : Field; Typ : Alpha_Field) is - C_Alpha_Field_Type : C_Field_Type; - pragma Import (C, C_Alpha_Field_Type, "TYPE_ALPHA"); - function Set_Fld_Type (F : Field := Fld; - Cft : C_Field_Type := C_Alpha_Field_Type; Arg1 : C_Int) return C_Int; - pragma Import (C, Set_Fld_Type, "set_field_type"); + pragma Import (C, Set_Fld_Type, "set_field_type_alpha"); Res : Eti_Error; begin 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 4a2f76b83707..53f66801e917 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-2008,2009 Free Software Foundation, Inc. -- +-- Copyright (c) 1998-2009,2011 Free Software Foundation, Inc. -- -- -- -- Permission is hereby granted, free of charge, to any person obtaining a -- -- copy of this software and associated documentation files (the -- @@ -35,8 +35,8 @@ ------------------------------------------------------------------------------ -- Author: Juergen Pfeifer, 1996 -- Version Control: --- $Revision: 1.10 $ --- $Date: 2009/12/26 17:38:58 $ +-- $Revision: 1.11 $ +-- $Date: 2011/03/19 00:45:37 $ -- Binding Version 01.00 ------------------------------------------------------------------------------ with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; @@ -46,13 +46,9 @@ package body Terminal_Interface.Curses.Forms.Field_Types.AlphaNumeric is procedure Set_Field_Type (Fld : Field; Typ : AlphaNumeric_Field) is - C_AlphaNumeric_Field_Type : C_Field_Type; - pragma Import (C, C_AlphaNumeric_Field_Type, "TYPE_ALNUM"); - function Set_Fld_Type (F : Field := Fld; - Cft : C_Field_Type := C_AlphaNumeric_Field_Type; Arg1 : C_Int) return C_Int; - pragma Import (C, Set_Fld_Type, "set_field_type"); + pragma Import (C, Set_Fld_Type, "set_field_type_alnum"); Res : Eti_Error; begin diff --git a/Ada95/src/terminal_interface-curses-forms-field_types-enumeration-ada.adb b/Ada95/src/terminal_interface-curses-forms-field_types-enumeration-ada.adb index b3eaf447ad88..d38e062aa5eb 100644 --- a/Ada95/src/terminal_interface-curses-forms-field_types-enumeration-ada.adb +++ b/Ada95/src/terminal_interface-curses-forms-field_types-enumeration-ada.adb @@ -7,7 +7,7 @@ -- B O D Y -- -- -- ------------------------------------------------------------------------------ --- Copyright (c) 1998,2004 Free Software Foundation, Inc. -- +-- Copyright (c) 1998-2004,2011 Free Software Foundation, Inc. -- -- -- -- Permission is hereby granted, free of charge, to any person obtaining a -- -- copy of this software and associated documentation files (the -- @@ -35,8 +35,8 @@ ------------------------------------------------------------------------------ -- Author: Juergen Pfeifer, 1996 -- Version Control: --- $Revision: 1.10 $ --- $Date: 2004/08/21 21:37:00 $ +-- $Revision: 1.11 $ +-- $Date: 2011/03/22 23:36:20 $ -- Binding Version 01.00 ------------------------------------------------------------------------------ with Ada.Characters.Handling; use Ada.Characters.Handling; @@ -61,8 +61,8 @@ package body Terminal_Interface.Curses.Forms.Field_Types.Enumeration.Ada is if Set /= Upper_Case then I.Names (J).all := To_Lower (I.Names (J).all); if Set = Mixed_Case then - I.Names (J)(I.Names (J).all'First) := - To_Upper (I.Names (J)(I.Names (J).all'First)); + I.Names (J).all (I.Names (J).all'First) := + To_Upper (I.Names (J).all (I.Names (J).all'First)); end if; end if; J := J + 1; 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 8c7815f6611b..12648e5a1dcc 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-2003,2009 Free Software Foundation, Inc. -- +-- Copyright (c) 1998-2009,2011 Free Software Foundation, Inc. -- -- -- -- Permission is hereby granted, free of charge, to any person obtaining a -- -- copy of this software and associated documentation files (the -- @@ -35,7 +35,7 @@ ------------------------------------------------------------------------------ -- Author: Juergen Pfeifer, 1996 -- Version Control: --- $Revision: 1.8 $ +-- $Revision: 1.10 $ -- Binding Version 01.00 ------------------------------------------------------------------------------ with Ada.Unchecked_Deallocation; @@ -63,13 +63,13 @@ package body Terminal_Interface.Curses.Forms.Field_Types.Enumeration is if Info.Names (I) = null then raise Form_Exception; end if; - E.Arr (size_t (I)) := New_String (Info.Names (I).all); + E.Arr.all (size_t (I)) := New_String (Info.Names (I).all); if Auto_Release_Names then S := Info.Names (I); Release_String (S); end if; end loop; - E.Arr (L) := Null_Ptr; + E.Arr.all (L) := Null_Ptr; return E; end Create; @@ -79,10 +79,10 @@ package body Terminal_Interface.Curses.Forms.Field_Types.Enumeration is P : chars_ptr; begin loop - P := Enum.Arr (I); + P := Enum.Arr.all (I); exit when P = Null_Ptr; Free (P); - Enum.Arr (I) := Null_Ptr; + Enum.Arr.all (I) := Null_Ptr; I := I + 1; end loop; Enum.Arr := null; @@ -91,15 +91,11 @@ package body Terminal_Interface.Curses.Forms.Field_Types.Enumeration is procedure Set_Field_Type (Fld : Field; Typ : Enumeration_Field) is - C_Enum_Type : C_Field_Type; - pragma Import (C, C_Enum_Type, "TYPE_ENUM"); - function Set_Fld_Type (F : Field := Fld; - Cft : C_Field_Type := C_Enum_Type; Arg1 : chars_ptr_array; Arg2 : C_Int; Arg3 : C_Int) return C_Int; - pragma Import (C, Set_Fld_Type, "set_field_type"); + pragma Import (C, Set_Fld_Type, "set_field_type_enum"); Res : Eti_Error; begin 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 8b934d08955b..b6229becefb9 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-2008,2009 Free Software Foundation, Inc. -- +-- Copyright (c) 1998-2009,2011 Free Software Foundation, Inc. -- -- -- -- Permission is hereby granted, free of charge, to any person obtaining a -- -- copy of this software and associated documentation files (the -- @@ -35,8 +35,8 @@ ------------------------------------------------------------------------------ -- Author: Juergen Pfeifer, 1996 -- Version Control: --- $Revision: 1.10 $ --- $Date: 2009/12/26 17:38:58 $ +-- $Revision: 1.11 $ +-- $Date: 2011/03/19 00:45:37 $ -- Binding Version 01.00 ------------------------------------------------------------------------------ with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; @@ -46,15 +46,11 @@ package body Terminal_Interface.Curses.Forms.Field_Types.IntField is procedure Set_Field_Type (Fld : Field; Typ : Integer_Field) is - C_Integer_Field_Type : C_Field_Type; - pragma Import (C, C_Integer_Field_Type, "TYPE_INTEGER"); - function Set_Fld_Type (F : Field := Fld; - Cft : C_Field_Type := C_Integer_Field_Type; Arg1 : C_Int; Arg2 : C_Long_Int; Arg3 : C_Long_Int) return C_Int; - pragma Import (C, Set_Fld_Type, "set_field_type"); + pragma Import (C, Set_Fld_Type, "set_field_type_integer"); Res : Eti_Error; begin 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 2328f4ed0c0f..66e052942d37 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-2008,2009 Free Software Foundation, Inc. -- +-- Copyright (c) 1998-2009,2011 Free Software Foundation, Inc. -- -- -- -- Permission is hereby granted, free of charge, to any person obtaining a -- -- copy of this software and associated documentation files (the -- @@ -35,8 +35,8 @@ ------------------------------------------------------------------------------ -- Author: Juergen Pfeifer, 1996 -- Version Control: --- $Revision: 1.10 $ --- $Date: 2009/12/26 17:38:58 $ +-- $Revision: 1.11 $ +-- $Date: 2011/03/19 00:45:37 $ -- Binding Version 01.00 ------------------------------------------------------------------------------ with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; @@ -46,13 +46,9 @@ package body Terminal_Interface.Curses.Forms.Field_Types.IPV4_Address is procedure Set_Field_Type (Fld : Field; Typ : Internet_V4_Address_Field) is - C_IPV4_Field_Type : C_Field_Type; - pragma Import (C, C_IPV4_Field_Type, "TYPE_IPV4"); - - function Set_Fld_Type (F : Field := Fld; - Cft : C_Field_Type := C_IPV4_Field_Type) + function Set_Fld_Type (F : Field := Fld) return C_Int; - pragma Import (C, Set_Fld_Type, "set_field_type"); + pragma Import (C, Set_Fld_Type, "set_field_type_ipv4"); Res : Eti_Error; begin 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 7151bb8b9937..b31dfa657a59 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-2008,2009 Free Software Foundation, Inc. -- +-- Copyright (c) 1998-2009,2011 Free Software Foundation, Inc. -- -- -- -- Permission is hereby granted, free of charge, to any person obtaining a -- -- copy of this software and associated documentation files (the -- @@ -35,8 +35,8 @@ ------------------------------------------------------------------------------ -- Author: Juergen Pfeifer, 1996 -- Version Control: --- $Revision: 1.11 $ --- $Date: 2009/12/26 17:38:58 $ +-- $Revision: 1.12 $ +-- $Date: 2011/03/19 00:45:37 $ -- Binding Version 01.00 ------------------------------------------------------------------------------ with Interfaces.C; @@ -49,15 +49,11 @@ package body Terminal_Interface.Curses.Forms.Field_Types.Numeric is is type Double is new Interfaces.C.double; - C_Numeric_Field_Type : C_Field_Type; - pragma Import (C, C_Numeric_Field_Type, "TYPE_NUMERIC"); - function Set_Fld_Type (F : Field := Fld; - Cft : C_Field_Type := C_Numeric_Field_Type; Arg1 : C_Int; Arg2 : Double; Arg3 : Double) return C_Int; - pragma Import (C, Set_Fld_Type, "set_field_type"); + pragma Import (C, Set_Fld_Type, "set_field_type_numeric"); Res : Eti_Error; begin 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 f4c7c587ad93..55f0255071ab 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-2003,2009 Free Software Foundation, Inc. -- +-- Copyright (c) 1998-2009,2011 Free Software Foundation, Inc. -- -- -- -- Permission is hereby granted, free of charge, to any person obtaining a -- -- copy of this software and associated documentation files (the -- @@ -35,7 +35,7 @@ ------------------------------------------------------------------------------ -- Author: Juergen Pfeifer, 1996 -- Version Control: --- $Revision: 1.9 $ +-- $Revision: 1.10 $ -- Binding Version 01.00 ------------------------------------------------------------------------------ with Interfaces.C; use Interfaces.C; @@ -48,13 +48,9 @@ package body Terminal_Interface.Curses.Forms.Field_Types.RegExp is is type Char_Ptr is access all Interfaces.C.char; - C_Regexp_Field_Type : C_Field_Type; - pragma Import (C, C_Regexp_Field_Type, "TYPE_REGEXP"); - function Set_Ftyp (F : Field := Fld; - Cft : C_Field_Type := C_Regexp_Field_Type; Arg1 : Char_Ptr) return C_Int; - pragma Import (C, Set_Ftyp, "set_field_type"); + pragma Import (C, Set_Ftyp, "set_field_type_regexp"); Txt : char_array (0 .. Typ.Regular_Expression.all'Length); Len : size_t; 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 f26a42cdca12..3a7e6b5aeb2e 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-2006,2008 Free Software Foundation, Inc. -- +-- Copyright (c) 1998-2008,2011 Free Software Foundation, Inc. -- -- -- -- Permission is hereby granted, free of charge, to any person obtaining a -- -- copy of this software and associated documentation files (the -- @@ -35,42 +35,40 @@ ------------------------------------------------------------------------------ -- Author: Juergen Pfeifer, 1996 -- Version Control: --- $Revision: 1.15 $ --- $Date: 2008/07/26 18:48:58 $ +-- $Revision: 1.17 $ +-- $Date: 2011/03/22 10:53:37 $ -- Binding Version 01.00 ------------------------------------------------------------------------------ -with Ada.Unchecked_Conversion; +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 - pragma Warnings (Off); - function To_Argument_Access is new Ada.Unchecked_Conversion - (System.Address, Argument_Access); - pragma Warnings (On); + 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)).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)).Typ); begin Result := Previous (Fld, Udf.all); - return C_Int (Boolean'Pos (Result)); + return Curses_Bool (Boolean'Pos (Result)); end Generic_Prev; -- ----------------------------------------------------------------------- diff --git a/Ada95/src/terminal_interface-curses-forms-field_types-user-choice.ads b/Ada95/src/terminal_interface-curses-forms-field_types-user-choice.ads index 1e69f43a915f..5b132c9192b8 100644 --- a/Ada95/src/terminal_interface-curses-forms-field_types-user-choice.ads +++ b/Ada95/src/terminal_interface-curses-forms-field_types-user-choice.ads @@ -7,7 +7,7 @@ -- S P E C -- -- -- ------------------------------------------------------------------------------ --- Copyright (c) 1998,2008 Free Software Foundation, Inc. -- +-- Copyright (c) 1998-2008,2011 Free Software Foundation, Inc. -- -- -- -- Permission is hereby granted, free of charge, to any person obtaining a -- -- copy of this software and associated documentation files (the -- @@ -35,8 +35,8 @@ ------------------------------------------------------------------------------ -- Author: Juergen Pfeifer, 1996 -- Version Control: --- $Revision: 1.12 $ --- $Date: 2008/07/26 18:49:20 $ +-- $Revision: 1.14 $ +-- $Date: 2011/03/19 12:27:47 $ -- Binding Version 01.00 ------------------------------------------------------------------------------ with Interfaces.C; @@ -78,17 +78,17 @@ private function C_Generic_Choice return C_Field_Type; function Generic_Next (Fld : Field; - Usr : System.Address) return C_Int; + Usr : System.Address) return Curses_Bool; pragma Convention (C, Generic_Next); -- This is the generic next Choice_Function for the low-level fieldtype - -- representing all the User_Defined_Field_Type derivates. It routes + -- representing all the User_Defined_Field_Type derivatives. It routes -- the call to the Next implementation for the type. function Generic_Prev (Fld : Field; - Usr : System.Address) return C_Int; + Usr : System.Address) return Curses_Bool; pragma Convention (C, Generic_Prev); -- This is the generic prev Choice_Function for the low-level fieldtype - -- representing all the User_Defined_Field_Type derivates. It routes + -- representing all the User_Defined_Field_Type derivatives. It routes -- the call to the Previous implementation for the type. end Terminal_Interface.Curses.Forms.Field_Types.User.Choice; 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 695f91971932..2dd295db7e76 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-2008,2009 Free Software Foundation, Inc. -- +-- Copyright (c) 1998-2009,2011 Free Software Foundation, Inc. -- -- -- -- Permission is hereby granted, free of charge, to any person obtaining a -- -- copy of this software and associated documentation files (the -- @@ -35,11 +35,11 @@ ------------------------------------------------------------------------------ -- Author: Juergen Pfeifer, 1996 -- Version Control: --- $Revision: 1.16 $ --- $Date: 2009/12/26 17:38:58 $ +-- $Revision: 1.21 $ +-- $Date: 2011/03/23 00:44:58 $ -- Binding Version 01.00 ------------------------------------------------------------------------------ -with Ada.Unchecked_Conversion; +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 is @@ -54,7 +54,7 @@ package body Terminal_Interface.Curses.Forms.Field_Types.User is Cft : C_Field_Type := C_Generic_Type; Arg1 : Argument_Access) return C_Int; - pragma Import (C, Set_Fld_Type, "set_field_type"); + pragma Import (C, Set_Fld_Type, "set_field_type_user"); Res : Eti_Error; @@ -76,31 +76,31 @@ package body Terminal_Interface.Curses.Forms.Field_Types.User is end if; end Set_Field_Type; - pragma Warnings (Off); - function To_Argument_Access is new Ada.Unchecked_Conversion - (System.Address, Argument_Access); - pragma Warnings (On); + package Argument_Conversions is + new System.Address_To_Access_Conversions (Argument); function Generic_Field_Check (Fld : Field; - Usr : System.Address) return C_Int + Usr : System.Address) return Curses_Bool is Result : Boolean; Udf : constant User_Defined_Field_Type_Access := - User_Defined_Field_Type_Access (To_Argument_Access (Usr).Typ); + User_Defined_Field_Type_Access + (Argument_Access (Argument_Conversions.To_Pointer (Usr)).all.Typ); begin Result := Field_Check (Fld, Udf.all); - return C_Int (Boolean'Pos (Result)); + return Curses_Bool (Boolean'Pos (Result)); end Generic_Field_Check; function Generic_Char_Check (Ch : C_Int; - Usr : System.Address) return C_Int + Usr : System.Address) return Curses_Bool is Result : Boolean; Udf : constant User_Defined_Field_Type_Access := - User_Defined_Field_Type_Access (To_Argument_Access (Usr).Typ); + User_Defined_Field_Type_Access + (Argument_Access (Argument_Conversions.To_Pointer (Usr)).all.Typ); begin Result := Character_Check (Character'Val (Ch), Udf.all); - return C_Int (Boolean'Pos (Result)); + return Curses_Bool (Boolean'Pos (Result)); end Generic_Char_Check; -- ----------------------------------------------------------------------- diff --git a/Ada95/src/terminal_interface-curses-forms-field_types-user.ads b/Ada95/src/terminal_interface-curses-forms-field_types-user.ads index af45fab49228..7000fce23dec 100644 --- a/Ada95/src/terminal_interface-curses-forms-field_types-user.ads +++ b/Ada95/src/terminal_interface-curses-forms-field_types-user.ads @@ -7,7 +7,7 @@ -- S P E C -- -- -- ------------------------------------------------------------------------------ --- Copyright (c) 1998-2008,2009 Free Software Foundation, Inc. -- +-- Copyright (c) 1998-2009,2011 Free Software Foundation, Inc. -- -- -- -- Permission is hereby granted, free of charge, to any person obtaining a -- -- copy of this software and associated documentation files (the -- @@ -35,8 +35,8 @@ ------------------------------------------------------------------------------ -- Author: Juergen Pfeifer, 1996 -- Version Control: --- $Revision: 1.13 $ --- $Date: 2009/12/26 17:38:58 $ +-- $Revision: 1.15 $ +-- $Date: 2011/03/19 12:27:21 $ -- Binding Version 01.00 ------------------------------------------------------------------------------ with Interfaces.C; @@ -79,17 +79,17 @@ private function C_Generic_Type return C_Field_Type; function Generic_Field_Check (Fld : Field; - Usr : System.Address) return C_Int; + Usr : System.Address) return Curses_Bool; pragma Convention (C, Generic_Field_Check); -- This is the generic Field_Check_Function for the low-level fieldtype - -- representing all the User_Defined_Field_Type derivates. It routes + -- representing all the User_Defined_Field_Type derivatives. It routes -- the call to the Field_Check implementation for the type. function Generic_Char_Check (Ch : C_Int; - Usr : System.Address) return C_Int; + Usr : System.Address) return Curses_Bool; pragma Convention (C, Generic_Char_Check); -- This is the generic Char_Check_Function for the low-level fieldtype - -- representing all the User_Defined_Field_Type derivates. It routes + -- representing all the User_Defined_Field_Type derivatives. It routes -- the call to the Character_Check implementation for the type. end Terminal_Interface.Curses.Forms.Field_Types.User; diff --git a/Ada95/src/terminal_interface-curses-forms-field_types.adb b/Ada95/src/terminal_interface-curses-forms-field_types.adb index aef5d3c8a389..5195a20a499c 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-2008,2009 Free Software Foundation, Inc. -- +-- Copyright (c) 1998-2009,2011 Free Software Foundation, Inc. -- -- -- -- Permission is hereby granted, free of charge, to any person obtaining a -- -- copy of this software and associated documentation files (the -- @@ -35,13 +35,14 @@ ------------------------------------------------------------------------------ -- Author: Juergen Pfeifer, 1996 -- Version Control: --- $Revision: 1.21 $ --- $Date: 2009/12/26 17:38:58 $ +-- $Revision: 1.25 $ +-- $Date: 2011/03/22 23:22:27 $ -- Binding Version 01.00 ------------------------------------------------------------------------------ with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; with Ada.Unchecked_Deallocation; -with Ada.Unchecked_Conversion; +with System.Address_To_Access_Conversions; + -- | -- |===================================================================== -- | man page form_fieldtype.3x @@ -51,10 +52,8 @@ package body Terminal_Interface.Curses.Forms.Field_Types is use type System.Address; - pragma Warnings (Off); - function To_Argument_Access is new Ada.Unchecked_Conversion - (System.Address, Argument_Access); - pragma Warnings (On); + package Argument_Conversions is + new System.Address_To_Access_Conversions (Argument); function Get_Fieldtype (F : Field) return C_Field_Type; pragma Import (C, Get_Fieldtype, "field_type"); @@ -80,11 +79,12 @@ package body Terminal_Interface.Curses.Forms.Field_Types is Low_Level = M_Generic_Type or else Low_Level = M_Choice_Router or else Low_Level = M_Generic_Choice then - Arg := To_Argument_Access (Get_Arg (Fld)); + Arg := Argument_Access + (Argument_Conversions.To_Pointer (Get_Arg (Fld))); if Arg = null then raise Form_Exception; else - return Arg.Typ; + return Arg.all.Typ; end if; else raise Form_Exception; @@ -92,24 +92,6 @@ package body Terminal_Interface.Curses.Forms.Field_Types is end if; end Get_Type; - function Make_Arg (Args : System.Address) return System.Address - is - -- Actually args is a double indirected pointer to the arguments - -- of a C variable argument list. In theory it is now quite - -- complicated to write portable routine that reads the arguments, - -- because one has to know the growth direction of the stack and - -- the sizes of the individual arguments. - -- Fortunately we are only interested in the first argument (#0), - -- we know its size and for the first arg we don't care about - -- into which stack direction we have to proceed. We simply - -- resolve the double indirection and thats it. - type V is access all System.Address; - function To_Access is new Ada.Unchecked_Conversion (System.Address, - V); - begin - return To_Access (To_Access (Args).all).all; - end Make_Arg; - function Copy_Arg (Usr : System.Address) return System.Address is begin @@ -123,18 +105,19 @@ package body Terminal_Interface.Curses.Forms.Field_Types is procedure Freeargs is new Ada.Unchecked_Deallocation (Argument, Argument_Access); - To_Be_Free : Argument_Access := To_Argument_Access (Usr); + To_Be_Free : Argument_Access + := Argument_Access (Argument_Conversions.To_Pointer (Usr)); Low_Level : C_Field_Type; begin if To_Be_Free /= null then - if To_Be_Free.Usr /= System.Null_Address then - Low_Level := To_Be_Free.Cft; - if Low_Level.Freearg /= null then - Low_Level.Freearg (To_Be_Free.Usr); + if To_Be_Free.all.Usr /= System.Null_Address then + Low_Level := To_Be_Free.all.Cft; + if Low_Level.all.Freearg /= null then + Low_Level.all.Freearg (To_Be_Free.all.Usr); end if; end if; - if To_Be_Free.Typ /= null then - Free_Type (To_Be_Free.Typ); + if To_Be_Free.all.Typ /= null then + Free_Type (To_Be_Free.all.Typ); end if; Freeargs (To_Be_Free); end if; @@ -151,7 +134,7 @@ package body Terminal_Interface.Curses.Forms.Field_Types is function Set_Fld_Type (F : Field := Fld; Cf : C_Field_Type := Cft; Arg1 : Argument_Access) return C_Int; - pragma Import (C, Set_Fld_Type, "set_field_type"); + pragma Import (C, Set_Fld_Type, "set_field_type_user"); begin pragma Assert (Low_Level /= Null_Field_Type); @@ -162,10 +145,10 @@ package body Terminal_Interface.Curses.Forms.Field_Types is Typ => new Field_Type'Class'(Typ), Cft => Get_Fieldtype (Fld)); if Usr_Arg /= System.Null_Address then - if Low_Level.Copyarg /= null then - Arg.Usr := Low_Level.Copyarg (Usr_Arg); + if Low_Level.all.Copyarg /= null then + Arg.all.Usr := Low_Level.all.Copyarg (Usr_Arg); else - Arg.Usr := Usr_Arg; + Arg.all.Usr := Usr_Arg; end if; end if; @@ -177,56 +160,60 @@ package body Terminal_Interface.Curses.Forms.Field_Types is end Wrap_Builtin; function Field_Check_Router (Fld : Field; - Usr : System.Address) return C_Int + Usr : System.Address) return Curses_Bool is - Arg : constant Argument_Access := To_Argument_Access (Usr); + Arg : constant Argument_Access + := Argument_Access (Argument_Conversions.To_Pointer (Usr)); begin - pragma Assert (Arg /= null and then Arg.Cft /= Null_Field_Type - and then Arg.Typ /= null); - if Arg.Cft.Fcheck /= null then - return Arg.Cft.Fcheck (Fld, Arg.Usr); + pragma Assert (Arg /= null and then Arg.all.Cft /= Null_Field_Type + and then Arg.all.Typ /= null); + if Arg.all.Cft.all.Fcheck /= null then + return Arg.all.Cft.all.Fcheck (Fld, Arg.all.Usr); else return 1; end if; end Field_Check_Router; function Char_Check_Router (Ch : C_Int; - Usr : System.Address) return C_Int + Usr : System.Address) return Curses_Bool is - Arg : constant Argument_Access := To_Argument_Access (Usr); + Arg : constant Argument_Access + := Argument_Access (Argument_Conversions.To_Pointer (Usr)); begin - pragma Assert (Arg /= null and then Arg.Cft /= Null_Field_Type - and then Arg.Typ /= null); - if Arg.Cft.Ccheck /= null then - return Arg.Cft.Ccheck (Ch, Arg.Usr); + pragma Assert (Arg /= null and then Arg.all.Cft /= Null_Field_Type + and then Arg.all.Typ /= null); + if Arg.all.Cft.all.Ccheck /= null then + return Arg.all.Cft.all.Ccheck (Ch, Arg.all.Usr); else return 1; end if; end Char_Check_Router; function Next_Router (Fld : Field; - Usr : System.Address) return C_Int + Usr : System.Address) return Curses_Bool is - Arg : constant Argument_Access := To_Argument_Access (Usr); + Arg : constant Argument_Access + := Argument_Access (Argument_Conversions.To_Pointer (Usr)); begin - pragma Assert (Arg /= null and then Arg.Cft /= Null_Field_Type - and then Arg.Typ /= null); - if Arg.Cft.Next /= null then - return Arg.Cft.Next (Fld, Arg.Usr); + pragma Assert (Arg /= null and then Arg.all.Cft /= Null_Field_Type + and then Arg.all.Typ /= null); + if Arg.all.Cft.all.Next /= null then + return Arg.all.Cft.all.Next (Fld, Arg.all.Usr); else return 1; end if; end Next_Router; function Prev_Router (Fld : Field; - Usr : System.Address) return C_Int + Usr : System.Address) return Curses_Bool is - Arg : constant Argument_Access := To_Argument_Access (Usr); + Arg : constant Argument_Access := + Argument_Access (Argument_Conversions.To_Pointer (Usr)); begin - pragma Assert (Arg /= null and then Arg.Cft /= Null_Field_Type - and then Arg.Typ /= null); - if Arg.Cft.Prev /= null then - return Arg.Cft.Prev (Fld, Arg.Usr); + pragma Assert (Arg /= null and then Arg.all.Cft /= Null_Field_Type + and then Arg.all.Typ /= null); + if Arg.all.Cft.all.Prev /= null then + return Arg.all.Cft.all.Prev (Fld, Arg.all.Usr); else return 1; end if; diff --git a/Ada95/src/terminal_interface-curses-forms.adb b/Ada95/src/terminal_interface-curses-forms.adb index 68825fc3dfbd..915ed58418e0 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-2008,2009 Free Software Foundation, Inc. -- +-- Copyright (c) 1998-2009,2011 Free Software Foundation, Inc. -- -- -- -- Permission is hereby granted, free of charge, to any person obtaining a -- -- copy of this software and associated documentation files (the -- @@ -35,8 +35,8 @@ ------------------------------------------------------------------------------ -- Author: Juergen Pfeifer, 1996 -- Version Control: --- $Revision: 1.27 $ --- $Date: 2009/12/26 17:38:58 $ +-- $Revision: 1.28 $ +-- $Date: 2011/03/22 23:37:32 $ -- Binding Version 01.00 ------------------------------------------------------------------------------ with Ada.Unchecked_Deallocation; @@ -736,11 +736,11 @@ package body Terminal_Interface.Curses.Forms is Res : Eti_Error; begin - pragma Assert (Flds (Flds'Last) = Null_Field); - if Flds (Flds'Last) /= Null_Field then + 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 (Flds'First)'Address); + Res := Set_Frm_Fields (Frm, Flds.all (Flds'First)'Address); if Res /= E_Ok then Eti_Exception (Res); end if; @@ -806,11 +806,11 @@ package body Terminal_Interface.Curses.Forms is M : Form; begin - pragma Assert (Fields (Fields'Last) = Null_Field); - if Fields (Fields'Last) /= Null_Field then + pragma Assert (Fields.all (Fields'Last) = Null_Field); + if Fields.all (Fields'Last) /= Null_Field then raise Form_Exception; else - M := NewForm (Fields (Fields'First)'Address); + M := NewForm (Fields.all (Fields'First)'Address); if M = Null_Form then raise Form_Exception; end if; @@ -1136,8 +1136,8 @@ package body Terminal_Interface.Curses.Forms is begin if FA /= null and then Free_Fields then for I in FA'First .. (FA'Last - 1) loop - if FA (I) /= Null_Field then - Delete (FA (I)); + if FA.all (I) /= Null_Field then + Delete (FA.all (I)); end if; end loop; end if; diff --git a/Ada95/src/terminal_interface-curses-menus.adb b/Ada95/src/terminal_interface-curses-menus.adb index 9fce6de6d9fa..a7dca07c2876 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-2008,2009 Free Software Foundation, Inc. -- +-- Copyright (c) 1998-2009,2011 Free Software Foundation, Inc. -- -- -- -- Permission is hereby granted, free of charge, to any person obtaining a -- -- copy of this software and associated documentation files (the -- @@ -35,8 +35,8 @@ ------------------------------------------------------------------------------ -- Author: Juergen Pfeifer, 1996 -- Version Control: --- $Revision: 1.27 $ --- $Date: 2009/12/26 17:38:58 $ +-- $Revision: 1.28 $ +-- $Date: 2011/03/22 23:38:12 $ -- Binding Version 01.00 ------------------------------------------------------------------------------ with Ada.Unchecked_Deallocation; @@ -896,8 +896,8 @@ package body Terminal_Interface.Curses.Menus is Res : Eti_Error; begin - pragma Assert (Items (Items'Last) = Null_Item); - if Items (Items'Last) /= Null_Item then + 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); @@ -941,8 +941,8 @@ package body Terminal_Interface.Curses.Menus is M : Menu; begin - pragma Assert (Items (Items'Last) = Null_Item); - if Items (Items'Last) /= Null_Item then + pragma Assert (Items.all (Items'Last) = Null_Item); + if Items.all (Items'Last) /= Null_Item then raise Menu_Exception; else M := Newmenu (Items.all'Address); @@ -997,8 +997,8 @@ package body Terminal_Interface.Curses.Menus is begin if IA /= null and then Free_Items then for I in IA'First .. (IA'Last - 1) loop - if IA (I) /= Null_Item then - Delete (IA (I)); + if IA.all (I) /= Null_Item then + Delete (IA.all (I)); end if; end loop; end if; diff --git a/Ada95/src/terminal_interface-curses-text_io.adb b/Ada95/src/terminal_interface-curses-text_io.adb index 4b29514efbf2..e2ca27f208e7 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-2006,2009 Free Software Foundation, Inc. -- +-- Copyright (c) 1998-2009,2011 Free Software Foundation, Inc. -- -- -- -- Permission is hereby granted, free of charge, to any person obtaining a -- -- copy of this software and associated documentation files (the -- @@ -35,8 +35,8 @@ ------------------------------------------------------------------------------ -- Author: Juergen Pfeifer, 1996 -- Version Control: --- $Revision: 1.19 $ --- $Date: 2009/12/26 17:40:46 $ +-- $Revision: 1.20 $ +-- $Date: 2011/03/22 23:38:49 $ -- Binding Version 01.00 ------------------------------------------------------------------------------ package body Terminal_Interface.Curses.Text_IO is @@ -205,6 +205,7 @@ package body Terminal_Interface.Curses.Text_IO is end if; Get_Cursor_Position (Win, Y1, X); + pragma Unreferenced (X); 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 f40d8bf31230..d2117a4cef17 100644 --- a/Ada95/src/terminal_interface-curses-trace.adb_p +++ b/Ada95/src/terminal_interface-curses-trace.adb_p @@ -35,7 +35,7 @@ ------------------------------------------------------------------------------ -- Author: Juergen Pfeifer, 1996 -- Version Control: --- $Revision: 1.6 $ +-- $Revision: 1.7 $ -- Binding Version 01.00 ------------------------------------------------------------------------------ #if ADA_TRACE then @@ -66,7 +66,7 @@ package body Terminal_Interface.Curses.Trace is procedure Trace_Put (str : String) is procedure tracef (format : char_array; s : char_array); - pragma Import (C, tracef, "_tracef"); + pragma Import (C, tracef, "_traces"); Txt : char_array (0 .. str'Length); Length : size_t; formatstr : constant String := "%s" & ASCII.NUL; |