aboutsummaryrefslogtreecommitdiff
path: root/Ada95/src
diff options
context:
space:
mode:
authorBaptiste Daroussin <bapt@FreeBSD.org>2020-02-07 08:36:41 +0000
committerBaptiste Daroussin <bapt@FreeBSD.org>2020-02-07 08:36:41 +0000
commitf0179cb6083cc92e5947ae56e6a0a5c5328aead0 (patch)
treebcee0ba9c2149b71f0bfc036df1e61e3105bf980 /Ada95/src
parentcea297eb34d2361e79529034397465068ae34ecd (diff)
downloadsrc-f0179cb6083cc92e5947ae56e6a0a5c5328aead0.tar.gz
src-f0179cb6083cc92e5947ae56e6a0a5c5328aead0.zip
Vendor import ncurses 6.1-20200118vendor/ncurses/6.1-20200118
Notes
Notes: svn path=/vendor/ncurses/dist/; revision=357645 svn path=/vendor/ncurses/6.1-20200118/; revision=357646; tag=vendor/ncurses/6.1-20200118
Diffstat (limited to 'Ada95/src')
-rw-r--r--Ada95/src/Makefile.in61
-rw-r--r--Ada95/src/c_threaded_variables.c56
-rw-r--r--Ada95/src/c_threaded_variables.h58
-rw-r--r--Ada95/src/c_varargs_to_ada.c6
-rw-r--r--Ada95/src/c_varargs_to_ada.h12
-rwxr-xr-xAda95/src/library-cfg.sh72
-rw-r--r--Ada95/src/library.gpr.in (renamed from Ada95/src/library.gpr)11
-rw-r--r--Ada95/src/ncurses_compat.c16
-rw-r--r--Ada95/src/terminal_interface-curses-forms-field_types-alpha.adb14
-rw-r--r--Ada95/src/terminal_interface-curses-forms-field_types-alphanumeric.adb14
-rw-r--r--Ada95/src/terminal_interface-curses-forms-field_types-enumeration-ada.ads4
-rw-r--r--Ada95/src/terminal_interface-curses-forms-field_types-enumeration.adb19
-rw-r--r--Ada95/src/terminal_interface-curses-forms-field_types-enumeration.ads8
-rw-r--r--Ada95/src/terminal_interface-curses-forms-field_types-intfield.adb18
-rw-r--r--Ada95/src/terminal_interface-curses-forms-field_types-ipv4_address.adb14
-rw-r--r--Ada95/src/terminal_interface-curses-forms-field_types-numeric.adb18
-rw-r--r--Ada95/src/terminal_interface-curses-forms-field_types-regexp.adb17
-rw-r--r--Ada95/src/terminal_interface-curses-forms-field_types-user-choice.adb18
-rw-r--r--Ada95/src/terminal_interface-curses-forms-field_types-user.adb19
-rw-r--r--Ada95/src/terminal_interface-curses-forms-field_types.adb54
-rw-r--r--Ada95/src/terminal_interface-curses-forms-field_user_data.adb13
-rw-r--r--Ada95/src/terminal_interface-curses-forms-form_user_data.adb13
-rw-r--r--Ada95/src/terminal_interface-curses-forms.adb350
-rw-r--r--Ada95/src/terminal_interface-curses-menus-item_user_data.adb14
-rw-r--r--Ada95/src/terminal_interface-curses-menus-menu_user_data.adb14
-rw-r--r--Ada95/src/terminal_interface-curses-menus.adb347
-rw-r--r--Ada95/src/terminal_interface-curses-mouse.adb11
-rw-r--r--Ada95/src/terminal_interface-curses-putwin.adb4
-rw-r--r--Ada95/src/terminal_interface-curses-putwin.ads4
-rw-r--r--Ada95/src/terminal_interface-curses-termcap.ads4
-rw-r--r--Ada95/src/terminal_interface-curses-terminfo.ads4
-rw-r--r--Ada95/src/terminal_interface-curses-text_io.adb8
-rw-r--r--Ada95/src/terminal_interface-curses-trace.adb_p37
33 files changed, 607 insertions, 725 deletions
diff --git a/Ada95/src/Makefile.in b/Ada95/src/Makefile.in
index 9962859ba4b1..bdfe0a81e5e7 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-2018,2019 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,14 +28,17 @@
#
# Author: Juergen Pfeifer, 1996
#
-# $Id: Makefile.in,v 1.62 2011/04/30 22:24:45 tom Exp $
+# $Id: Makefile.in,v 1.87 2019/09/07 20:53:06 tom Exp $
#
.SUFFIXES:
-SHELL = /bin/sh
+SHELL = @SHELL@
VPATH = @srcdir@
THIS = Makefile
+ADA_MFLAGS = @cf_cv_makeflags@
+@SET_MAKE@
+
MODEL = ../../@DFT_OBJ_SUBDIR@
DESTDIR = @DESTDIR@
@@ -51,7 +54,7 @@ LIBDIR = $(DESTDIR)$(libdir)
ADA_INCLUDE = $(DESTDIR)@ADA_INCLUDE@
ADA_OBJECTS = $(DESTDIR)@ADA_OBJECTS@
-INSTALL = @INSTALL@
+INSTALL = @INSTALL@ @INSTALL_OPT_O@
INSTALL_LIB = @INSTALL@ @INSTALL_LIB@
AR = @AR@
@@ -80,14 +83,14 @@ LDFLAGS = @LDFLAGS@ @LD_MODEL@ @LIBS@
RANLIB = @RANLIB@
################################################################################
-ADA = @cf_ada_compiler@
+ADA = @cf_ada_compiler@
ADAPREP = gnatprep
-ADAFLAGS = @ADAFLAGS@ -I. -I$(srcdir)
+ADAFLAGS = @ADAFLAGS@ -I. -I$(srcdir)
-LIB_NAME = AdaCurses
+LIB_NAME = @ADA_LIBNAME@
SONAME = @ADA_SHAREDLIB@
-GNAT_PROJECT = $(srcdir)/library.gpr
+GNAT_PROJECT = @ADA_LIBNAME@.gpr
# build/source are the Ada95 tree
BUILD_DIR = ..
@@ -96,8 +99,8 @@ SOURCE_DIR = ..
BUILD_DIR_LIB = $(BUILD_DIR)/lib
SOURCE_DIR_SRC = $(SOURCE_DIR)/src
-ADAMAKE = @cf_ada_make@
-ADAMAKEFLAGS = \
+ADAMAKE = @cf_ada_make@
+ADAMAKEFLAGS = \
-P$(GNAT_PROJECT) \
-XBUILD_DIR=`cd $(BUILD_DIR);pwd` \
-XSOURCE_DIR=`cd $(SOURCE_DIR);pwd` \
@@ -179,7 +182,10 @@ $(LIBDIR) \
$(BUILD_DIR_LIB) :
mkdir -p $@
-sources :
+$(GENERATED_SOURCES) :
+ cd ../gen; $(MAKE) $(ADA_MFLAGS)
+
+sources : $(GENERATED_SOURCES)
@echo made $@
libs \
@@ -207,7 +213,7 @@ clean :: mostlyclean
rm -f $(ABASE)-trace.adb
distclean :: clean
- rm -f Makefile
+ rm -f Makefile library.gpr
realclean :: distclean
@@ -215,27 +221,33 @@ 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 $@
###############################################################################
# Use these definitions when building a shared library.
-SHARED_C_OBJS = c_varargs_to_ada.o ncurses_compat.o
+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_ncurses_compat.o
+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
+
static_ncurses_compat.o : $(srcdir)/ncurses_compat.c
$(CC) $(CFLAGS_NORMAL) -c -o $@ $(srcdir)/ncurses_compat.c
@@ -258,8 +270,14 @@ STATIC_DIRS = \
@USE_GNAT_PROJECTS@ $(ABASE)-trace.adb \
@USE_GNAT_PROJECTS@ $(STATIC_C_OBJS) \
@USE_GNAT_PROJECTS@ $(STATIC_DIRS)
+@USE_GNAT_PROJECTS@ @cf_ada_config@gprconfig --batch --config=Ada --config=C,,,,@cf_ada_config_C@
+@USE_GNAT_PROJECTS@ -rm -f $(GNAT_PROJECT)
+@USE_GNAT_PROJECTS@ $(SHELL) $(srcdir)/library-cfg.sh static $(srcdir)/library.gpr $(CFLAGS_NORMAL) >$(GNAT_PROJECT)
+@USE_GNAT_PROJECTS@ @echo "Using GNAT Project:"
+@USE_GNAT_PROJECTS@ @-$(SHELL) -c "diff -u $(srcdir)/library.gpr $(GNAT_PROJECT); exit 0"
@USE_GNAT_PROJECTS@ $(ADAMAKE) $(ADAMAKEFLAGS) -XLIB_KIND=static
@USE_GNAT_PROJECTS@ $(AR) $(ARFLAGS) $@ $(STATIC_C_OBJS)
+@USE_GNAT_PROJECTS@ -rm -f $(GNAT_PROJECT)
@USE_GNAT_PROJECTS@
@USE_GNAT_LIBRARIES@install \
@USE_GNAT_LIBRARIES@install.libs :: \
@@ -290,7 +308,13 @@ SHARED_DIRS = \
@MAKE_ADA_SHAREDLIB@ $(SHARED_DIRS) \
@MAKE_ADA_SHAREDLIB@ $(SHARED_OBJS)
@MAKE_ADA_SHAREDLIB@ cp $(SHARED_OBJS) $(BUILD_DIR)/dynamic-obj/
+@MAKE_ADA_SHAREDLIB@ @cf_ada_config@gprconfig --batch --config=Ada --config=C,,,,@cf_ada_config_C@
+@MAKE_ADA_SHAREDLIB@ -rm -f $(GNAT_PROJECT)
+@MAKE_ADA_SHAREDLIB@ $(SHELL) $(srcdir)/library-cfg.sh dynamic $(srcdir)/library.gpr $(CFLAGS_SHARED) >$(GNAT_PROJECT)
+@MAKE_ADA_SHAREDLIB@ @echo "Making Ada shared-lib:"
+@MAKE_ADA_SHAREDLIB@ @-$(SHELL) -c "diff -u $(srcdir)/library.gpr $(GNAT_PROJECT); exit 0"
@MAKE_ADA_SHAREDLIB@ $(ADAMAKE) $(ADAMAKEFLAGS) -XLIB_KIND=dynamic
+@MAKE_ADA_SHAREDLIB@ -rm -f $(GNAT_PROJECT)
install \
install.libs :: $(ADA_INCLUDE)
@@ -328,6 +352,7 @@ uninstall.libs ::
@MAKE_ADA_SHAREDLIB@ rm -f $(LIBDIR)/$(SHARED_LIBNAME)
clean ::
- rm -rf $(BUILD_DIR)/*-ali
- rm -rf $(BUILD_DIR)/*-obj
- rm -rf $(BUILD_DIR_LIB)
+ -rm -f default.cgpr
+ -rm -rf $(BUILD_DIR)/*-ali
+ -rm -rf $(BUILD_DIR)/*-obj
+ -rm -rf $(BUILD_DIR_LIB)
diff --git a/Ada95/src/c_threaded_variables.c b/Ada95/src/c_threaded_variables.c
new file mode 100644
index 000000000000..bc58c46abefe
--- /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 000000000000..5f0f62f16333
--- /dev/null
+++ b/Ada95/src/c_threaded_variables.h
@@ -0,0 +1,58 @@
+/****************************************************************************
+ * Copyright (c) 2011-2014,2015 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_threaded_variables.h,v 1.3 2015/08/06 23:09:47 tom Exp $ */
+
+#ifndef __C_THREADED_VARIABLES_H
+#define __C_THREADED_VARIABLES_H
+
+#include <ncurses_cfg.h>
+
+#if HAVE_INTTYPES_H
+# include <inttypes.h>
+#else
+# if HAVE_STDINT_H
+# include <stdint.h>
+# endif
+#endif
+
+#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 ed236ddc90da..f0b1bbef01ff 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/c_varargs_to_ada.h b/Ada95/src/c_varargs_to_ada.h
index ee6a7a7c1eb9..f2697058493e 100644
--- a/Ada95/src/c_varargs_to_ada.h
+++ b/Ada95/src/c_varargs_to_ada.h
@@ -1,5 +1,5 @@
/****************************************************************************
- * Copyright (c) 2011 Free Software Foundation, Inc. *
+ * Copyright (c) 2011,2015 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 *
@@ -26,11 +26,19 @@
* authorization. *
****************************************************************************/
-/* $Id: c_varargs_to_ada.h,v 1.3 2011/03/19 19:07:41 tom Exp $ */
+/* $Id: c_varargs_to_ada.h,v 1.4 2015/08/06 23:08:47 tom Exp $ */
#ifndef __C_VARARGS_TO_ADA_H
#define __C_VARARGS_TO_ADA_H
+#ifdef HAVE_CONFIG_H
+#include <ncurses_cfg.h>
+#else
+#include <ncurses.h>
+#endif
+
+#include <stdlib.h>
+
#include <form.h>
extern int set_field_type_alnum(FIELD * /* field */ ,
diff --git a/Ada95/src/library-cfg.sh b/Ada95/src/library-cfg.sh
new file mode 100755
index 000000000000..005979f44467
--- /dev/null
+++ b/Ada95/src/library-cfg.sh
@@ -0,0 +1,72 @@
+#!/bin/sh
+##############################################################################
+# Copyright (c) 2016-2018,2019 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: library-cfg.sh,v 1.6 2019/09/07 20:27:26 tom Exp $
+#
+# Work around incompatible behavior introduced with gnat6, which causes
+# gnatmake to attempt to compile all of the C objects which might be part of
+# the project. This can only work if we provide the compiler flags (done here
+# by making a copy of the project file with that information filled in).
+model=$1
+shift 1
+input=$1
+shift 1
+param=
+while test $# != 0
+do
+ case "x$1" in
+ *-[OgDIWf]*)
+ test -n "$param" && param="$param,"
+ param="$param\"$1\""
+ ;;
+ *)
+ echo "${0##*/}: ignored option $1" >&2
+ ;;
+ esac
+ shift 1
+done
+
+SHARE="-- "
+test "x$model" = "xdynamic" && SHARE=
+
+SCRIPT=library-cfg.tmp
+cat >$SCRIPT <<EOF
+/for Library_Options use /{
+ s,-- ,$SHARE,
+}
+/for Default_Switches ("C") use/{
+ s,-- ,,
+ s% use .*% use($param);%
+}
+EOF
+
+sed -f $SCRIPT $input
+rc=$?
+rm -f $SCRIPT
+exit $?
diff --git a/Ada95/src/library.gpr b/Ada95/src/library.gpr.in
index 33e4a3c7d7e2..aeee4e2c8215 100644
--- a/Ada95/src/library.gpr
+++ b/Ada95/src/library.gpr.in
@@ -1,5 +1,5 @@
------------------------------------------------------------------------------
--- Copyright (c) 2010,2011 Free Software Foundation, Inc. --
+-- Copyright (c) 2010-2018,2019 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,10 +25,10 @@
-- 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.in,v 1.1 2019/09/07 20:29:02 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
+project AdaCurses is
Build_Dir := External ("BUILD_DIR");
Source_Dir := External ("SOURCE_DIR");
Source_Dir2 := External ("SOURCE_DIR2");
@@ -43,7 +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");
+ -- for Library_Options use ("-lncurses@USE_LIB_SUFFIX@", "-lpanel@USE_LIB_SUFFIX@", "-lmenu@USE_LIB_SUFFIX@", "-lform@USE_LIB_SUFFIX@");
package Compiler is
for Default_Switches ("Ada") use
("-g",
@@ -51,6 +51,7 @@ project Library is
"-gnatafno",
"-gnatVa", -- All validity checks
"-gnatwa"); -- Activate all optional errors
+ -- for Default_Switches ("C") use (CFLAGS)
end Compiler;
for Languages use ("C", "Ada");
-end Library;
+end AdaCurses;
diff --git a/Ada95/src/ncurses_compat.c b/Ada95/src/ncurses_compat.c
index b3d0607a5ff2..e44f3d0fe39b 100644
--- a/Ada95/src/ncurses_compat.c
+++ b/Ada95/src/ncurses_compat.c
@@ -1,5 +1,5 @@
/****************************************************************************
- * Copyright (c) 2011 Free Software Foundation, Inc. *
+ * Copyright (c) 2011,2015 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,22 @@
/*
Version Control
- $Id: ncurses_compat.c,v 1.2 2011/03/28 00:29:04 tom Exp $
+ $Id: ncurses_compat.c,v 1.3 2015/08/06 23:09:10 tom Exp $
--------------------------------------------------------------------------*/
/*
* Provide compatibility with older versions of ncurses.
*/
+#include <ncurses_cfg.h>
+
+#if HAVE_INTTYPES_H
+# include <inttypes.h>
+#else
+# if HAVE_STDINT_H
+# include <stdint.h>
+# endif
+#endif
+
#include <curses.h>
#if defined(NCURSES_VERSION_PATCH)
@@ -49,7 +59,7 @@ extern int _nc_has_mouse(void);
bool
has_mouse(void)
{
- return (bool) _nc_has_mouse();
+ return (bool)_nc_has_mouse();
}
#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 943362012394..9c614cacb800 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 53f66801e917..270906d40120 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-ada.ads b/Ada95/src/terminal_interface-curses-forms-field_types-enumeration-ada.ads
index 48fad09c2f25..198071cf01c5 100644
--- a/Ada95/src/terminal_interface-curses-forms-field_types-enumeration-ada.ads
+++ b/Ada95/src/terminal_interface-curses-forms-field_types-enumeration-ada.ads
@@ -7,7 +7,7 @@
-- S P E C --
-- --
------------------------------------------------------------------------------
--- Copyright (c) 1998 Free Software Foundation, Inc. --
+-- Copyright (c) 1998,2003 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.11 $
-- Binding Version 01.00
------------------------------------------------------------------------------
generic
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 12648e5a1dcc..8d4c9cee49b7 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-enumeration.ads b/Ada95/src/terminal_interface-curses-forms-field_types-enumeration.ads
index e6924f6b19f9..52a35caa07b6 100644
--- a/Ada95/src/terminal_interface-curses-forms-field_types-enumeration.ads
+++ b/Ada95/src/terminal_interface-curses-forms-field_types-enumeration.ads
@@ -7,7 +7,7 @@
-- S P E C --
-- --
------------------------------------------------------------------------------
--- Copyright (c) 1998-2003,2009 Free Software Foundation, Inc. --
+-- Copyright (c) 1998-2018,2020 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.Strings;
@@ -54,9 +54,9 @@ package Terminal_Interface.Curses.Forms.Field_Types.Enumeration is
type Enumeration_Info (C : Positive) is
record
- Names : Enum_Array (1 .. C);
Case_Sensitive : Boolean := False;
Match_Must_Be_Unique : Boolean := False;
+ Names : Enum_Array (1 .. C);
end record;
type Enumeration_Field is new Field_Type with private;
@@ -78,7 +78,7 @@ package Terminal_Interface.Curses.Forms.Field_Types.Enumeration is
-- But we may want to release the field to release the memory allocated
-- by it internally. After that the Enumeration field is no longer usable.
- -- The next type defintions are all ncurses extensions. They are typically
+ -- The next type definitions are all ncurses extensions. They are typically
-- not available in other curses implementations.
procedure Set_Field_Type (Fld : Field;
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 b6229becefb9..5ec330535994 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 66e052942d37..978a47a1f0c7 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 b31dfa657a59..94e2aa702c41 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 55f0255071ab..f5ea0db2b11c 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 3a7e6b5aeb2e..8414cd0385c7 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 2dd295db7e76..98bcd2442d43 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 5195a20a499c..bda6e51b088f 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 96178d8a9349..fc710b694646 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-2014,2018 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.16 $
-- Binding Version 01.00
------------------------------------------------------------------------------
with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux;
@@ -49,20 +49,15 @@ package body Terminal_Interface.Curses.Forms.Field_User_Data is
-- |
-- |
-- |
- use type Interfaces.C.int;
-
procedure Set_User_Data (Fld : Field;
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 84353eb55700..500ec130086f 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-2014,2018 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.16 $
-- Binding Version 01.00
------------------------------------------------------------------------------
-- |
@@ -47,8 +47,6 @@ with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux;
package body Terminal_Interface.Curses.Forms.Form_User_Data is
- use type Interfaces.C.int;
-
-- |
-- |
-- |
@@ -56,14 +54,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 915ed58418e0..3ed053ae1b68 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 eb06d096dfb2..5135c20d7fce 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-2014,2018 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,28 +35,22 @@
------------------------------------------------------------------------------
-- Author: Juergen Pfeifer, 1996
-- Version Control:
--- $Revision: 1.12 $
+-- $Revision: 1.15 $
-- Binding Version 01.00
------------------------------------------------------------------------------
-with Interfaces.C;
with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux;
package body Terminal_Interface.Curses.Menus.Item_User_Data is
- use type Interfaces.C.int;
-
procedure Set_User_Data (Itm : Item;
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 7d66a8c052ee..e8e297ee915b 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-2014,2018 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,27 +35,23 @@
------------------------------------------------------------------------------
-- Author: Juergen Pfeifer, 1996
-- Version Control:
--- $Revision: 1.13 $
+-- $Revision: 1.16 $
-- Binding Version 01.00
------------------------------------------------------------------------------
with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux;
package body Terminal_Interface.Curses.Menus.Menu_User_Data is
- use type Interfaces.C.int;
-
procedure Set_User_Data (Men : Menu;
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 a7dca07c2876..fc840e2a978f 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-2014,2018 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.33 $
+-- $Date: 2018/07/07 23:36:44 $
-- Binding Version 01.00
------------------------------------------------------------------------------
with Ada.Unchecked_Deallocation;
@@ -46,33 +46,14 @@ 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;
package I_Array is new
Interfaces.C.Pointers (Natural, Item, C_Item_Array, Null_Item);
- 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 +109,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 +122,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 +130,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 +166,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 +178,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 +248,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 +272,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 +308,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 +325,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 +337,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 +373,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 +394,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 +417,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 +442,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 +476,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 +512,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 +547,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 +604,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 +621,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 +640,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 +650,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 +673,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 +689,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 +779,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 +839,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 +852,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 9b4032639308..49a440e64909 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-2014,2018 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.26 $
+-- $Date: 2018/07/07 23:35:05 $
-- Binding Version 01.00
------------------------------------------------------------------------------
with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux;
@@ -45,8 +45,6 @@ use Interfaces;
package body Terminal_Interface.Curses.Mouse is
- use type System.Bit_Order;
-
function Has_Mouse return Boolean
is
function Mouse_Avail return C_Int;
@@ -199,7 +197,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-putwin.adb b/Ada95/src/terminal_interface-curses-putwin.adb
index 986cd6b9bd6c..c5724d118705 100644
--- a/Ada95/src/terminal_interface-curses-putwin.adb
+++ b/Ada95/src/terminal_interface-curses-putwin.adb
@@ -7,7 +7,7 @@
-- B O D Y --
-- --
------------------------------------------------------------------------------
--- Copyright (c) 2000 Free Software Foundation, Inc. --
+-- Copyright (c) 2000,2003 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.3 $
+-- $Revision: 1.4 $
-- Binding Version 01.00
with Ada.Streams.Stream_IO.C_Streams;
diff --git a/Ada95/src/terminal_interface-curses-putwin.ads b/Ada95/src/terminal_interface-curses-putwin.ads
index d302bdcec452..24d05063e1cd 100644
--- a/Ada95/src/terminal_interface-curses-putwin.ads
+++ b/Ada95/src/terminal_interface-curses-putwin.ads
@@ -7,7 +7,7 @@
-- S P E C --
-- --
------------------------------------------------------------------------------
--- Copyright (c) 2000 Free Software Foundation, Inc. --
+-- Copyright (c) 2000,2003 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.3 $
+-- $Revision: 1.4 $
-- Binding Version 01.00
with Ada.Streams.Stream_IO;
diff --git a/Ada95/src/terminal_interface-curses-termcap.ads b/Ada95/src/terminal_interface-curses-termcap.ads
index dd01396e8b0b..e5f19f658e5d 100644
--- a/Ada95/src/terminal_interface-curses-termcap.ads
+++ b/Ada95/src/terminal_interface-curses-termcap.ads
@@ -7,7 +7,7 @@
-- S P E C --
-- --
------------------------------------------------------------------------------
--- Copyright (c) 2000 Free Software Foundation, Inc. --
+-- Copyright (c) 2000,2003 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.3 $
+-- $Revision: 1.4 $
-- Binding Version 01.00
------------------------------------------------------------------------------
diff --git a/Ada95/src/terminal_interface-curses-terminfo.ads b/Ada95/src/terminal_interface-curses-terminfo.ads
index fb39bf1ed6f1..67f951d08f55 100644
--- a/Ada95/src/terminal_interface-curses-terminfo.ads
+++ b/Ada95/src/terminal_interface-curses-terminfo.ads
@@ -7,7 +7,7 @@
-- S P E C --
-- --
------------------------------------------------------------------------------
--- Copyright (c) 2000 Free Software Foundation, Inc. --
+-- Copyright (c) 2000,2003 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.3 $
+-- $Revision: 1.4 $
-- Binding Version 01.00
------------------------------------------------------------------------------
diff --git a/Ada95/src/terminal_interface-curses-text_io.adb b/Ada95/src/terminal_interface-curses-text_io.adb
index e2ca27f208e7..85a4f44b637a 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 d2117a4cef17..0dead37675ff 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;