aboutsummaryrefslogtreecommitdiff
path: root/Ada95/src
diff options
context:
space:
mode:
authorEd Schouten <ed@FreeBSD.org>2011-04-30 10:55:14 +0000
committerEd Schouten <ed@FreeBSD.org>2011-04-30 10:55:14 +0000
commit0294a182a1629b1d854b84906e73487d6cb75fba (patch)
treee563e21bcc0164ba11452983316bda26eebb1d3c /Ada95/src
parent22b11c4db16996bf8d4878fab98762c348676df3 (diff)
downloadsrc-0294a182a1629b1d854b84906e73487d6cb75fba.tar.gz
src-0294a182a1629b1d854b84906e73487d6cb75fba.zip
Import a stock copy of ncurses 5.8 into the vendor space.vendor/ncurses/5.8-20110226
It seems both local changes we made to 5.7 have already been fixed upstream properly, so there is no need to preserve the changes. Also, with SVN we import full source trees. Unlike CVS, where we removed unneeded cruft.
Notes
Notes: svn path=/vendor/ncurses/dist/; revision=221243 svn path=/vendor/ncurses/5.8-20110226/; revision=221244; tag=vendor/ncurses/5.8-20110226
Diffstat (limited to 'Ada95/src')
-rw-r--r--Ada95/src/Makefile.in304
-rw-r--r--Ada95/src/library.gpr55
-rw-r--r--Ada95/src/modules70
-rw-r--r--Ada95/src/terminal_interface-curses-aux.adb116
-rw-r--r--Ada95/src/terminal_interface-curses-forms-field_types-alpha.adb66
-rw-r--r--Ada95/src/terminal_interface-curses-forms-field_types-alpha.ads53
-rw-r--r--Ada95/src/terminal_interface-curses-forms-field_types-alphanumeric.adb66
-rw-r--r--Ada95/src/terminal_interface-curses-forms-field_types-alphanumeric.ads54
-rw-r--r--Ada95/src/terminal_interface-curses-forms-field_types-enumeration-ada.adb81
-rw-r--r--Ada95/src/terminal_interface-curses-forms-field_types-enumeration-ada.ads59
-rw-r--r--Ada95/src/terminal_interface-curses-forms-field_types-enumeration.adb119
-rw-r--r--Ada95/src/terminal_interface-curses-forms-field_types-enumeration.ads98
-rw-r--r--Ada95/src/terminal_interface-curses-forms-field_types-intfield.adb70
-rw-r--r--Ada95/src/terminal_interface-curses-forms-field_types-intfield.ads55
-rw-r--r--Ada95/src/terminal_interface-curses-forms-field_types-ipv4_address.adb66
-rw-r--r--Ada95/src/terminal_interface-curses-forms-field_types-ipv4_address.ads51
-rw-r--r--Ada95/src/terminal_interface-curses-forms-field_types-numeric.adb73
-rw-r--r--Ada95/src/terminal_interface-curses-forms-field_types-numeric.ads55
-rw-r--r--Ada95/src/terminal_interface-curses-forms-field_types-regexp.adb71
-rw-r--r--Ada95/src/terminal_interface-curses-forms-field_types-regexp.ads55
-rw-r--r--Ada95/src/terminal_interface-curses-forms-field_types-user-choice.adb110
-rw-r--r--Ada95/src/terminal_interface-curses-forms-field_types-user-choice.ads94
-rw-r--r--Ada95/src/terminal_interface-curses-forms-field_types-user.adb133
-rw-r--r--Ada95/src/terminal_interface-curses-forms-field_types-user.ads95
-rw-r--r--Ada95/src/terminal_interface-curses-forms-field_types.adb296
-rw-r--r--Ada95/src/terminal_interface-curses-forms-field_user_data.adb85
-rw-r--r--Ada95/src/terminal_interface-curses-forms-form_user_data.adb86
-rw-r--r--Ada95/src/terminal_interface-curses-forms.adb1161
-rw-r--r--Ada95/src/terminal_interface-curses-menus-item_user_data.adb77
-rw-r--r--Ada95/src/terminal_interface-curses-menus-menu_user_data.adb76
-rw-r--r--Ada95/src/terminal_interface-curses-menus.adb1022
-rw-r--r--Ada95/src/terminal_interface-curses-mouse.adb217
-rw-r--r--Ada95/src/terminal_interface-curses-panels-user_data.adb78
-rw-r--r--Ada95/src/terminal_interface-curses-panels.adb165
-rw-r--r--Ada95/src/terminal_interface-curses-putwin.adb77
-rw-r--r--Ada95/src/terminal_interface-curses-putwin.ads50
-rw-r--r--Ada95/src/terminal_interface-curses-termcap.adb163
-rw-r--r--Ada95/src/terminal_interface-curses-termcap.ads80
-rw-r--r--Ada95/src/terminal_interface-curses-terminfo.adb161
-rw-r--r--Ada95/src/terminal_interface-curses-terminfo.ads81
-rw-r--r--Ada95/src/terminal_interface-curses-text_io-aux.adb128
-rw-r--r--Ada95/src/terminal_interface-curses-text_io-aux.ads55
-rw-r--r--Ada95/src/terminal_interface-curses-text_io-complex_io.adb73
-rw-r--r--Ada95/src/terminal_interface-curses-text_io-complex_io.ads70
-rw-r--r--Ada95/src/terminal_interface-curses-text_io-decimal_io.adb75
-rw-r--r--Ada95/src/terminal_interface-curses-text_io-decimal_io.ads66
-rw-r--r--Ada95/src/terminal_interface-curses-text_io-enumeration_io.adb80
-rw-r--r--Ada95/src/terminal_interface-curses-text_io-enumeration_io.ads63
-rw-r--r--Ada95/src/terminal_interface-curses-text_io-fixed_io.adb75
-rw-r--r--Ada95/src/terminal_interface-curses-text_io-fixed_io.ads66
-rw-r--r--Ada95/src/terminal_interface-curses-text_io-float_io.adb76
-rw-r--r--Ada95/src/terminal_interface-curses-text_io-float_io.ads66
-rw-r--r--Ada95/src/terminal_interface-curses-text_io-integer_io.adb70
-rw-r--r--Ada95/src/terminal_interface-curses-text_io-integer_io.ads63
-rw-r--r--Ada95/src/terminal_interface-curses-text_io-modular_io.adb70
-rw-r--r--Ada95/src/terminal_interface-curses-text_io-modular_io.ads63
-rw-r--r--Ada95/src/terminal_interface-curses-text_io.adb337
-rw-r--r--Ada95/src/terminal_interface-curses-text_io.ads136
-rw-r--r--Ada95/src/terminal_interface-curses-trace.adb_p97
-rw-r--r--Ada95/src/terminal_interface.ads47
60 files changed, 7720 insertions, 0 deletions
diff --git a/Ada95/src/Makefile.in b/Ada95/src/Makefile.in
new file mode 100644
index 000000000000..4a599acb8927
--- /dev/null
+++ b/Ada95/src/Makefile.in
@@ -0,0 +1,304 @@
+##############################################################################
+# Copyright (c) 1998-2009,2010 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: Juergen Pfeifer, 1996
+#
+# $Id: Makefile.in,v 1.53 2010/11/27 22:14:16 tom Exp $
+#
+.SUFFIXES:
+
+SHELL = /bin/sh
+VPATH = @srcdir@
+THIS = Makefile
+
+MODEL = ../../@DFT_OBJ_SUBDIR@
+
+DESTDIR = @DESTDIR@
+
+top_srcdir = @top_srcdir@
+srcdir = @srcdir@
+prefix = @prefix@
+exec_prefix = @exec_prefix@
+libdir = ${exec_prefix}/lib
+
+LIBDIR = $(DESTDIR)$(libdir)
+ADA_INCLUDE = $(DESTDIR)@ADA_INCLUDE@
+ADA_OBJECTS = $(DESTDIR)@ADA_OBJECTS@
+
+INSTALL = @INSTALL@
+INSTALL_LIB = @INSTALL@ @INSTALL_LIB@
+
+AR = @AR@
+ARFLAGS = @ARFLAGS@
+AWK = @AWK@
+LN_S = @LN_S@
+
+CC = @CC@
+CFLAGS = @CFLAGS@
+
+CPPFLAGS = @ACPPFLAGS@ \
+ -DHAVE_CONFIG_H -I$(srcdir)
+
+CCFLAGS = $(CPPFLAGS) $(CFLAGS)
+
+CFLAGS_NORMAL = $(CCFLAGS)
+CFLAGS_DEBUG = $(CCFLAGS) @CC_G_OPT@ -DTRACE
+CFLAGS_PROFILE = $(CCFLAGS) -pg
+CFLAGS_SHARED = $(CCFLAGS) @CC_SHARED_OPTS@
+
+CFLAGS_DEFAULT = $(CFLAGS_@DFT_UPR_MODEL@)
+
+LINK = $(CC)
+LDFLAGS = @LDFLAGS@ @LD_MODEL@ @LIBS@
+
+RANLIB = @RANLIB@
+
+################################################################################
+ADA = @cf_ada_compiler@
+ADAPREP = gnatprep
+ADAFLAGS = @ADAFLAGS@ -I. -I$(srcdir)
+
+LIB_NAME = AdaCurses
+SONAME = @ADA_SHAREDLIB@
+
+GNAT_PROJECT = $(srcdir)/library.gpr
+
+# build/source are the Ada95 tree
+BUILD_DIR = ..
+SOURCE_DIR = ..
+
+BUILD_DIR_LIB = $(BUILD_DIR)/lib
+SOURCE_DIR_SRC = $(SOURCE_DIR)/src
+
+ADAMAKE = @cf_ada_make@
+ADAMAKEFLAGS = \
+ -P$(GNAT_PROJECT) \
+ -XBUILD_DIR=`cd $(BUILD_DIR);pwd` \
+ -XSOURCE_DIR=`cd $(SOURCE_DIR);pwd` \
+ -XSOURCE_DIR2=`cd $(srcdir);pwd` \
+ -XLIB_NAME=$(LIB_NAME) \
+ -XSONAME=$(SONAME)
+
+CARGS = -cargs $(ADAFLAGS)
+LARGS =
+
+STATIC_LIBNAME = lib$(LIB_NAME).a
+SHARED_LIBNAME = $(SONAME)
+SHARED_SYMLINK = lib$(LIB_NAME).so
+
+ALIB = @cf_ada_package@
+ABASE = $(ALIB)-curses
+################################################################################
+GENERATED_SOURCES=$(ABASE).ads \
+ $(ABASE).adb \
+ $(ABASE)-aux.ads \
+ $(ABASE)-trace.ads \
+ $(ABASE)-menus.ads \
+ $(ABASE)-forms.ads \
+ $(ABASE)-mouse.ads \
+ $(ABASE)-panels.ads \
+ $(ABASE)-menus-menu_user_data.ads \
+ $(ABASE)-menus-item_user_data.ads \
+ $(ABASE)-forms-form_user_data.ads \
+ $(ABASE)-forms-field_types.ads \
+ $(ABASE)-forms-field_user_data.ads \
+ $(ABASE)-panels-user_data.ads
+################################################################################
+LIBOBJS=$(ALIB).o \
+ $(ABASE)-aux.o \
+ $(ABASE).o \
+ $(ABASE)-terminfo.o \
+ $(ABASE)-termcap.o \
+ $(ABASE)-putwin.o \
+ $(ABASE)-trace.o \
+ $(ABASE)-mouse.o \
+ $(ABASE)-panels.o \
+ $(ABASE)-menus.o \
+ $(ABASE)-forms.o \
+ $(ABASE)-forms-field_types.o \
+ $(ABASE)-forms-field_types-alpha.o \
+ $(ABASE)-forms-field_types-alphanumeric.o \
+ $(ABASE)-forms-field_types-intfield.o \
+ $(ABASE)-forms-field_types-numeric.o \
+ $(ABASE)-forms-field_types-regexp.o \
+ $(ABASE)-forms-field_types-enumeration.o \
+ $(ABASE)-forms-field_types-ipv4_address.o \
+ $(ABASE)-forms-field_types-user.o \
+ $(ABASE)-forms-field_types-user-choice.o \
+ $(ABASE)-text_io.o \
+ $(ABASE)-text_io-aux.o
+
+# Ada object files for generic packages. Since gnat 3.10 they are
+# also compiled
+GENOBJS=$(ABASE)-menus-menu_user_data.o \
+ $(ABASE)-menus-item_user_data.o \
+ $(ABASE)-forms-form_user_data.o \
+ $(ABASE)-forms-field_user_data.o \
+ $(ABASE)-forms-field_types-enumeration-ada.o \
+ $(ABASE)-panels-user_data.o \
+ $(ABASE)-text_io-integer_io.o \
+ $(ABASE)-text_io-float_io.o \
+ $(ABASE)-text_io-fixed_io.o \
+ $(ABASE)-text_io-decimal_io.o \
+ $(ABASE)-text_io-enumeration_io.o \
+ $(ABASE)-text_io-modular_io.o \
+ $(ABASE)-text_io-complex_io.o
+
+all :: $(BUILD_DIR_LIB)/$(STATIC_LIBNAME)
+ @echo done
+
+$(ADA_INCLUDE) \
+$(ADA_OBJECTS) \
+$(LIBDIR) \
+$(BUILD_DIR_LIB) :
+ mkdir -p $@
+
+sources :
+ @echo made $@
+
+libs \
+install \
+install.libs :: \
+ $(BUILD_DIR_LIB)/$(STATIC_LIBNAME)
+ @echo made $(STATIC_LIBNAME)
+
+install \
+install.libs :: \
+ $(BUILD_DIR_LIB)/$(STATIC_LIBNAME) \
+ $(ADA_OBJECTS)
+ @$(INSTALL_LIB) \
+ $(BUILD_DIR_LIB)/$(STATIC_LIBNAME) \
+ $(ADA_OBJECTS)
+
+uninstall \
+uninstall.libs ::
+ @rm -f $(ADA_OBJECTS)/$(STATIC_LIBNAME)
+
+mostlyclean ::
+ rm -f *.o *.ali b_t*.* *.s $(PROGS) a.out core b_*_test.c *.xr[bs] *.a
+
+clean :: mostlyclean
+ rm -f $(ABASE)-trace.adb
+
+distclean :: clean
+ rm -f Makefile
+
+realclean :: distclean
+
+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 $@
+
+###############################################################################
+
+@USE_OLD_MAKERULES@$(BUILD_DIR_LIB)/$(STATIC_LIBNAME) :: \
+@USE_OLD_MAKERULES@ $(BUILD_DIR_LIB) \
+@USE_OLD_MAKERULES@ $(LIBOBJS) @cf_generic_objects@
+@USE_OLD_MAKERULES@ $(AR) $(ARFLAGS) $@ $(LIBOBJS) @cf_generic_objects@
+
+$(BUILD_DIR)/static-ali : ; mkdir -p $@
+$(BUILD_DIR)/static-obj : ; mkdir -p $@
+
+STATIC_DIRS = \
+ $(BUILD_DIR_LIB) \
+ $(BUILD_DIR)/static-ali \
+ $(BUILD_DIR)/static-obj
+
+@USE_GNAT_PROJECTS@$(BUILD_DIR_LIB)/$(STATIC_LIBNAME) :: \
+@USE_GNAT_PROJECTS@ $(ABASE)-trace.adb \
+@USE_GNAT_PROJECTS@ $(STATIC_DIRS)
+@USE_GNAT_PROJECTS@ $(ADAMAKE) $(ADAMAKEFLAGS) -XLIB_KIND=static
+@USE_GNAT_PROJECTS@
+@USE_GNAT_PROJECTS@install \
+@USE_GNAT_PROJECTS@install.libs :: \
+@USE_GNAT_PROJECTS@ $(ADA_OBJECTS)
+@USE_GNAT_PROJECTS@ $(INSTALL_LIB) \
+@USE_GNAT_PROJECTS@ $(BUILD_DIR)/static-ali/*.ali \
+@USE_GNAT_PROJECTS@ $(ADA_OBJECTS)
+
+uninstall \
+uninstall.libs ::
+ @rm -f $(ADA_OBJECTS)/$(STATIC_LIBNAME)
+
+@USE_GNAT_PROJECTS@uninstall \
+@USE_GNAT_PROJECTS@uninstall.libs ::
+@USE_GNAT_PROJECTS@ @$(SHELL) -c 'for name in $(BUILD_DIR)/static-ali/*.ali ; do rm -f $(ADA_OBJECTS)/`basename $$name`; done'
+
+$(BUILD_DIR)/dynamic-ali : ; mkdir -p $@
+$(BUILD_DIR)/dynamic-obj : ; mkdir -p $@
+
+SHARED_DIRS = \
+ $(BUILD_DIR_LIB) \
+ $(BUILD_DIR)/dynamic-ali \
+ $(BUILD_DIR)/dynamic-obj
+
+@MAKE_ADA_SHAREDLIB@all \
+@MAKE_ADA_SHAREDLIB@$(BUILD_DIR_LIB)/$(SHARED_LIBNAME) :: $(ABASE)-trace.adb $(SHARED_DIRS)
+@MAKE_ADA_SHAREDLIB@ $(ADAMAKE) $(ADAMAKEFLAGS) -XLIB_KIND=dynamic
+
+install \
+install.libs :: $(ADA_INCLUDE)
+ $(INSTALL_LIB) \
+ $(SOURCE_DIR_SRC)/*.ad[sb] \
+ $(ADA_INCLUDE)
+
+install \
+install.libs :: $(ADA_INCLUDE)
+ $(INSTALL_LIB) \
+ $(GENERATED_SOURCES) \
+ $(ADA_INCLUDE)
+
+uninstall \
+uninstall.libs ::
+ $(SHELL) -c 'for name in $(SOURCE_DIR_SRC)/*.ad[sb] $(GENERATED_SOURCES); do rm -f $(ADA_INCLUDE)/`basename $$name`; done'
+
+@MAKE_ADA_SHAREDLIB@install \
+@MAKE_ADA_SHAREDLIB@install.libs :: $(ADA_OBJECTS)
+@MAKE_ADA_SHAREDLIB@ $(INSTALL_LIB) \
+@MAKE_ADA_SHAREDLIB@ $(BUILD_DIR)/dynamic-ali/* \
+@MAKE_ADA_SHAREDLIB@ $(ADA_OBJECTS)
+@MAKE_ADA_SHAREDLIB@ $(INSTALL_LIB) \
+@MAKE_ADA_SHAREDLIB@ $(BUILD_DIR_LIB)/$(SHARED_LIBNAME) \
+@MAKE_ADA_SHAREDLIB@ $(LIBDIR)
+@MAKE_ADA_SHAREDLIB@ cd $(LIBDIR) && ln -s $(SHARED_LIBNAME) $(SHARED_SYMLINK)
+@MAKE_ADA_SHAREDLIB@
+@MAKE_ADA_SHAREDLIB@uninstall \
+@MAKE_ADA_SHAREDLIB@uninstall.libs ::
+@MAKE_ADA_SHAREDLIB@ $(SHELL) -c 'for name in $(BUILD_DIR)/dynamic-ali/* ; do rm -f $(ADA_OBJECTS)/`basename $$name`; done'
+@MAKE_ADA_SHAREDLIB@
+@MAKE_ADA_SHAREDLIB@uninstall \
+@MAKE_ADA_SHAREDLIB@uninstall.libs ::
+@MAKE_ADA_SHAREDLIB@ rm -f $(LIBDIR)/$(SHARED_SYMLINK)
+@MAKE_ADA_SHAREDLIB@ rm -f $(LIBDIR)/$(SHARED_LIBNAME)
+
+clean ::
+ rm -rf $(BUILD_DIR)/*-ali
+ rm -rf $(BUILD_DIR)/*-obj
+ rm -rf $(BUILD_DIR_LIB)
diff --git a/Ada95/src/library.gpr b/Ada95/src/library.gpr
new file mode 100644
index 000000000000..62d67702b9c8
--- /dev/null
+++ b/Ada95/src/library.gpr
@@ -0,0 +1,55 @@
+------------------------------------------------------------------------------
+-- Copyright (c) 2010 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.gpr,v 1.5 2010/11/27 22:15:04 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
+ Build_Dir := External ("BUILD_DIR");
+ Source_Dir := External ("SOURCE_DIR");
+ Source_Dir2 := External ("SOURCE_DIR2");
+ Kind := External ("LIB_KIND");
+ for Library_Name use External ("LIB_NAME");
+ for Library_Version use External ("SONAME");
+
+ for Library_Kind use Kind;
+ for Library_Dir use Build_Dir & "/lib";
+ for Object_Dir use Build_Dir & "/" & Kind & "-obj";
+ for Library_ALI_Dir use Build_Dir & "/" & Kind & "-ali";
+ for Source_Dirs use (Source_Dir & "/src",
+ Source_Dir2,
+ Build_Dir & "/src");
+ package Compiler is
+ for Default_Switches ("Ada") use
+ ("-g",
+ "-O2",
+ "-gnatafno",
+ "-gnatVa", -- All validity checks
+ "-gnatwa"); -- Activate all optional errors
+ end Compiler;
+
+end Library;
diff --git a/Ada95/src/modules b/Ada95/src/modules
new file mode 100644
index 000000000000..9f5e03038eb6
--- /dev/null
+++ b/Ada95/src/modules
@@ -0,0 +1,70 @@
+# $Id: modules,v 1.3 2010/06/26 23:33:14 tom Exp $
+##############################################################################
+# Copyright (c) 2010 Free Software Foundation, Inc. #
+# #
+# Permission is hereby granted, free of charge, to any person obtaining a #
+# copy of this software and associated documentation files (the "Software"), #
+# to deal in the Software without restriction, including without limitation #
+# the rights to use, copy, modify, merge, publish, distribute, distribute #
+# with modifications, sublicense, and/or sell copies of the Software, and to #
+# permit persons to whom the Software is furnished to do so, subject to the #
+# following conditions: #
+# #
+# The above copyright notice and this permission notice shall be included in #
+# all copies or substantial portions of the Software. #
+# #
+# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR #
+# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, #
+# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL #
+# THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER #
+# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING #
+# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER #
+# DEALINGS IN THE SOFTWARE. #
+# #
+# Except as contained in this notice, the name(s) of the above copyright #
+# holders shall not be used in advertising or otherwise to promote the sale, #
+# use or other dealings in this Software without prior written #
+# authorization. #
+##############################################################################
+#
+# Author: Thomas E. Dickey 2010
+#
+
+# Library objects
+# rootname depend-spec depend-body unit
+$(ALIB) $(srcdir) none spec
+$(ABASE)-aux none $(srcdir) body
+$(ABASE) none . body
+$(ABASE)-terminfo $(srcdir) $(srcdir) body
+$(ABASE)-termcap $(srcdir) $(srcdir) body
+$(ABASE)-putwin $(srcdir) $(srcdir) body
+$(ABASE)-trace . . body
+$(ABASE)-mouse . $(srcdir) body
+$(ABASE)-panels . $(srcdir) body
+$(ABASE)-menus . $(srcdir) body
+$(ABASE)-forms . $(srcdir) body
+$(ABASE)-forms-field_types . $(srcdir) body
+$(ABASE)-forms-field_types-alpha $(srcdir) $(srcdir) body
+$(ABASE)-forms-field_types-alphanumeric $(srcdir) $(srcdir) body
+$(ABASE)-forms-field_types-intfield $(srcdir) $(srcdir) body
+$(ABASE)-forms-field_types-numeric $(srcdir) $(srcdir) body
+$(ABASE)-forms-field_types-regexp $(srcdir) $(srcdir) body
+$(ABASE)-forms-field_types-enumeration $(srcdir) $(srcdir) body
+$(ABASE)-forms-field_types-ipv4_address $(srcdir) $(srcdir) body
+$(ABASE)-forms-field_types-user $(srcdir) $(srcdir) body
+$(ABASE)-forms-field_types-user-choice $(srcdir) $(srcdir) body
+$(ABASE)-text_io $(srcdir) $(srcdir) body
+$(ABASE)-text_io-aux $(srcdir) $(srcdir) body
+$(ABASE)-menus-menu_user_data . $(srcdir) body
+$(ABASE)-menus-item_user_data . $(srcdir) body
+$(ABASE)-forms-form_user_data . $(srcdir) body
+$(ABASE)-forms-field_user_data . $(srcdir) body
+$(ABASE)-forms-field_types-enumeration-ada $(srcdir) $(srcdir) body
+$(ABASE)-panels-user_data . $(srcdir) body
+$(ABASE)-text_io-integer_io $(srcdir) $(srcdir) body
+$(ABASE)-text_io-float_io $(srcdir) $(srcdir) body
+$(ABASE)-text_io-fixed_io $(srcdir) $(srcdir) body
+$(ABASE)-text_io-decimal_io $(srcdir) $(srcdir) body
+$(ABASE)-text_io-enumeration_io $(srcdir) $(srcdir) body
+$(ABASE)-text_io-modular_io $(srcdir) $(srcdir) body
+$(ABASE)-text_io-complex_io $(srcdir) $(srcdir) body
diff --git a/Ada95/src/terminal_interface-curses-aux.adb b/Ada95/src/terminal_interface-curses-aux.adb
new file mode 100644
index 000000000000..9c2f8cd38674
--- /dev/null
+++ b/Ada95/src/terminal_interface-curses-aux.adb
@@ -0,0 +1,116 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding --
+-- --
+-- Terminal_Interface.Curses.Aux --
+-- --
+-- B O D Y --
+-- --
+------------------------------------------------------------------------------
+-- Copyright (c) 1998-2003,2009 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: Juergen Pfeifer, 1996
+-- Version Control:
+-- $Revision: 1.11 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+package body Terminal_Interface.Curses.Aux is
+ --
+ -- Some helpers
+ procedure Fill_String (Cp : chars_ptr;
+ Str : out String)
+ is
+ -- Fill the string with the characters referenced by the
+ -- chars_ptr.
+ --
+ Len : Natural;
+ begin
+ if Cp /= Null_Ptr then
+ Len := Natural (Strlen (Cp));
+ if Str'Length < Len then
+ raise Constraint_Error;
+ end if;
+ declare
+ S : String (1 .. Len);
+ begin
+ S := Value (Cp);
+ Str (Str'First .. (Str'First + Len - 1)) := S (S'Range);
+ end;
+ else
+ Len := 0;
+ end if;
+
+ if Len < Str'Length then
+ Str ((Str'First + Len) .. Str'Last) := (others => ' ');
+ end if;
+
+ end Fill_String;
+
+ function Fill_String (Cp : chars_ptr) return String
+ is
+ Len : Natural;
+ begin
+ if Cp /= Null_Ptr then
+ Len := Natural (Strlen (Cp));
+ if Len = 0 then
+ return "";
+ else
+ declare
+ S : String (1 .. Len);
+ begin
+ Fill_String (Cp, S);
+ return S;
+ end;
+ end if;
+ else
+ return "";
+ end if;
+ end Fill_String;
+
+ procedure Eti_Exception (Code : Eti_Error)
+ is
+ begin
+ case Code is
+ when E_Ok => null;
+ when E_System_Error => raise Eti_System_Error;
+ when E_Bad_Argument => raise Eti_Bad_Argument;
+ when E_Posted => raise Eti_Posted;
+ when E_Connected => raise Eti_Connected;
+ when E_Bad_State => raise Eti_Bad_State;
+ when E_No_Room => raise Eti_No_Room;
+ when E_Not_Posted => raise Eti_Not_Posted;
+ when E_Unknown_Command => raise Eti_Unknown_Command;
+ when E_No_Match => raise Eti_No_Match;
+ when E_Not_Selectable => raise Eti_Not_Selectable;
+ when E_Not_Connected => raise Eti_Not_Connected;
+ when E_Request_Denied => raise Eti_Request_Denied;
+ when E_Invalid_Field => raise Eti_Invalid_Field;
+ when E_Current => raise Eti_Current;
+ end case;
+ end Eti_Exception;
+
+end Terminal_Interface.Curses.Aux;
diff --git a/Ada95/src/terminal_interface-curses-forms-field_types-alpha.adb b/Ada95/src/terminal_interface-curses-forms-field_types-alpha.adb
new file mode 100644
index 000000000000..8e9d71adaf44
--- /dev/null
+++ b/Ada95/src/terminal_interface-curses-forms-field_types-alpha.adb
@@ -0,0 +1,66 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding --
+-- --
+-- Terminal_Interface.Curses.Forms.Field_Types.Alpha --
+-- --
+-- B O D Y --
+-- --
+------------------------------------------------------------------------------
+-- Copyright (c) 1998-2008,2009 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: Juergen Pfeifer, 1996
+-- Version Control:
+-- $Revision: 1.10 $
+-- $Date: 2009/12/26 17:38:58 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux;
+
+package body Terminal_Interface.Curses.Forms.Field_Types.Alpha is
+
+ procedure Set_Field_Type (Fld : Field;
+ Typ : Alpha_Field)
+ is
+ C_Alpha_Field_Type : C_Field_Type;
+ pragma Import (C, C_Alpha_Field_Type, "TYPE_ALPHA");
+
+ function Set_Fld_Type (F : Field := Fld;
+ Cft : C_Field_Type := C_Alpha_Field_Type;
+ Arg1 : C_Int) return C_Int;
+ pragma Import (C, Set_Fld_Type, "set_field_type");
+
+ 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;
+ Wrap_Builtin (Fld, Typ);
+ end Set_Field_Type;
+
+end Terminal_Interface.Curses.Forms.Field_Types.Alpha;
diff --git a/Ada95/src/terminal_interface-curses-forms-field_types-alpha.ads b/Ada95/src/terminal_interface-curses-forms-field_types-alpha.ads
new file mode 100644
index 000000000000..7878f73b2b52
--- /dev/null
+++ b/Ada95/src/terminal_interface-curses-forms-field_types-alpha.ads
@@ -0,0 +1,53 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding --
+-- --
+-- Terminal_Interface.Curses.Forms.Field_Types.Alpha --
+-- --
+-- S P E C --
+-- --
+------------------------------------------------------------------------------
+-- Copyright (c) 1998-2003,2009 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: Juergen Pfeifer, 1996
+-- Version Control:
+-- $Revision: 1.12 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+package Terminal_Interface.Curses.Forms.Field_Types.Alpha is
+ pragma Preelaborate (Terminal_Interface.Curses.Forms.Field_Types.Alpha);
+
+ type Alpha_Field is new Field_Type
+ with record
+ Minimum_Field_Width : Natural := 0;
+ end record;
+
+ procedure Set_Field_Type (Fld : Field;
+ Typ : Alpha_Field);
+ pragma Inline (Set_Field_Type);
+
+end Terminal_Interface.Curses.Forms.Field_Types.Alpha;
diff --git a/Ada95/src/terminal_interface-curses-forms-field_types-alphanumeric.adb b/Ada95/src/terminal_interface-curses-forms-field_types-alphanumeric.adb
new file mode 100644
index 000000000000..4a2f76b83707
--- /dev/null
+++ b/Ada95/src/terminal_interface-curses-forms-field_types-alphanumeric.adb
@@ -0,0 +1,66 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding --
+-- --
+-- Terminal_Interface.Curses.Forms.Field_Types.AlphaNumeric --
+-- --
+-- B O D Y --
+-- --
+------------------------------------------------------------------------------
+-- Copyright (c) 1998-2008,2009 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: Juergen Pfeifer, 1996
+-- Version Control:
+-- $Revision: 1.10 $
+-- $Date: 2009/12/26 17:38:58 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux;
+
+package body Terminal_Interface.Curses.Forms.Field_Types.AlphaNumeric is
+
+ procedure Set_Field_Type (Fld : Field;
+ Typ : AlphaNumeric_Field)
+ is
+ C_AlphaNumeric_Field_Type : C_Field_Type;
+ pragma Import (C, C_AlphaNumeric_Field_Type, "TYPE_ALNUM");
+
+ function Set_Fld_Type (F : Field := Fld;
+ Cft : C_Field_Type := C_AlphaNumeric_Field_Type;
+ Arg1 : C_Int) return C_Int;
+ pragma Import (C, Set_Fld_Type, "set_field_type");
+
+ 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;
+ Wrap_Builtin (Fld, Typ);
+ end Set_Field_Type;
+
+end Terminal_Interface.Curses.Forms.Field_Types.AlphaNumeric;
diff --git a/Ada95/src/terminal_interface-curses-forms-field_types-alphanumeric.ads b/Ada95/src/terminal_interface-curses-forms-field_types-alphanumeric.ads
new file mode 100644
index 000000000000..c1009ac77adb
--- /dev/null
+++ b/Ada95/src/terminal_interface-curses-forms-field_types-alphanumeric.ads
@@ -0,0 +1,54 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding --
+-- --
+-- Terminal_Interface.Curses.Forms.Field_Types.AlphaNumeric --
+-- --
+-- S P E C --
+-- --
+------------------------------------------------------------------------------
+-- Copyright (c) 1998-2003,2009 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: Juergen Pfeifer, 1996
+-- Version Control:
+-- $Revision: 1.12 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+package Terminal_Interface.Curses.Forms.Field_Types.AlphaNumeric is
+ pragma Preelaborate
+ (Terminal_Interface.Curses.Forms.Field_Types.AlphaNumeric);
+
+ type AlphaNumeric_Field is new Field_Type
+ with record
+ Minimum_Field_Width : Natural := 0;
+ end record;
+
+ procedure Set_Field_Type (Fld : Field;
+ Typ : AlphaNumeric_Field);
+ pragma Inline (Set_Field_Type);
+
+end Terminal_Interface.Curses.Forms.Field_Types.AlphaNumeric;
diff --git a/Ada95/src/terminal_interface-curses-forms-field_types-enumeration-ada.adb b/Ada95/src/terminal_interface-curses-forms-field_types-enumeration-ada.adb
new file mode 100644
index 000000000000..b3eaf447ad88
--- /dev/null
+++ b/Ada95/src/terminal_interface-curses-forms-field_types-enumeration-ada.adb
@@ -0,0 +1,81 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding --
+-- --
+-- Terminal_Interface.Curses.Forms.Field_Types.Enumeration.Ada --
+-- --
+-- B O D Y --
+-- --
+------------------------------------------------------------------------------
+-- Copyright (c) 1998,2004 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: Juergen Pfeifer, 1996
+-- Version Control:
+-- $Revision: 1.10 $
+-- $Date: 2004/08/21 21:37:00 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+with Ada.Characters.Handling; use Ada.Characters.Handling;
+
+package body Terminal_Interface.Curses.Forms.Field_Types.Enumeration.Ada is
+
+ function Create (Set : Type_Set := Mixed_Case;
+ Case_Sensitive : Boolean := False;
+ Must_Be_Unique : Boolean := False)
+ return Enumeration_Field
+ is
+ I : Enumeration_Info (T'Pos (T'Last) - T'Pos (T'First) + 1);
+ J : Positive := 1;
+ begin
+ I.Case_Sensitive := Case_Sensitive;
+ I.Match_Must_Be_Unique := Must_Be_Unique;
+
+ for E in T'Range loop
+ I.Names (J) := new String'(T'Image (E));
+ -- The Image attribute defaults to upper case, so we have to handle
+ -- only the other ones...
+ if Set /= Upper_Case then
+ I.Names (J).all := To_Lower (I.Names (J).all);
+ if Set = Mixed_Case then
+ I.Names (J)(I.Names (J).all'First) :=
+ To_Upper (I.Names (J)(I.Names (J).all'First));
+ end if;
+ end if;
+ J := J + 1;
+ end loop;
+
+ return Create (I, True);
+ end Create;
+
+ function Value (Fld : Field;
+ Buf : Buffer_Number := Buffer_Number'First) return T
+ is
+ begin
+ return T'Value (Get_Buffer (Fld, Buf));
+ end Value;
+
+end Terminal_Interface.Curses.Forms.Field_Types.Enumeration.Ada;
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
new file mode 100644
index 000000000000..48fad09c2f25
--- /dev/null
+++ b/Ada95/src/terminal_interface-curses-forms-field_types-enumeration-ada.ads
@@ -0,0 +1,59 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding --
+-- --
+-- Terminal_Interface.Curses.Forms.Field_Types.Enumeration.Ada --
+-- --
+-- S P E C --
+-- --
+------------------------------------------------------------------------------
+-- Copyright (c) 1998 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: Juergen Pfeifer, 1996
+-- Version Control:
+-- $Revision: 1.10 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+generic
+ type T is (<>);
+
+package Terminal_Interface.Curses.Forms.Field_Types.Enumeration.Ada is
+ pragma Preelaborate
+ (Terminal_Interface.Curses.Forms.Field_Types.Enumeration.Ada);
+
+ function Create (Set : Type_Set := Mixed_Case;
+ Case_Sensitive : Boolean := False;
+ Must_Be_Unique : Boolean := False)
+ return Enumeration_Field;
+
+ function Value (Fld : Field;
+ Buf : Buffer_Number := Buffer_Number'First) return T;
+ -- Translate the content of the fields buffer - indicated by the
+ -- buffer number - into an enumeration value. If the buffer is empty
+ -- or the content is invalid, a Constraint_Error is raises.
+
+end Terminal_Interface.Curses.Forms.Field_Types.Enumeration.Ada;
diff --git a/Ada95/src/terminal_interface-curses-forms-field_types-enumeration.adb b/Ada95/src/terminal_interface-curses-forms-field_types-enumeration.adb
new file mode 100644
index 000000000000..8c7815f6611b
--- /dev/null
+++ b/Ada95/src/terminal_interface-curses-forms-field_types-enumeration.adb
@@ -0,0 +1,119 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding --
+-- --
+-- Terminal_Interface.Curses.Forms.Field_Types.Enumeration --
+-- --
+-- B O D Y --
+-- --
+------------------------------------------------------------------------------
+-- Copyright (c) 1998-2003,2009 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: Juergen Pfeifer, 1996
+-- Version Control:
+-- $Revision: 1.8 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+with Ada.Unchecked_Deallocation;
+with Interfaces.C; use Interfaces.C;
+with Interfaces.C.Strings; use Interfaces.C.Strings;
+with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux;
+
+package body Terminal_Interface.Curses.Forms.Field_Types.Enumeration is
+
+ function Create (Info : Enumeration_Info;
+ Auto_Release_Names : Boolean := False)
+ return Enumeration_Field
+ is
+ procedure Release_String is
+ new Ada.Unchecked_Deallocation (String,
+ String_Access);
+ E : Enumeration_Field;
+ L : constant size_t := 1 + size_t (Info.C);
+ S : String_Access;
+ begin
+ E.Case_Sensitive := Info.Case_Sensitive;
+ E.Match_Must_Be_Unique := Info.Match_Must_Be_Unique;
+ E.Arr := new chars_ptr_array (size_t (1) .. L);
+ for I in 1 .. Positive (L - 1) loop
+ if Info.Names (I) = null then
+ raise Form_Exception;
+ end if;
+ E.Arr (size_t (I)) := New_String (Info.Names (I).all);
+ if Auto_Release_Names then
+ S := Info.Names (I);
+ Release_String (S);
+ end if;
+ end loop;
+ E.Arr (L) := Null_Ptr;
+ return E;
+ end Create;
+
+ procedure Release (Enum : in out Enumeration_Field)
+ is
+ I : size_t := 0;
+ P : chars_ptr;
+ begin
+ loop
+ P := Enum.Arr (I);
+ exit when P = Null_Ptr;
+ Free (P);
+ Enum.Arr (I) := Null_Ptr;
+ I := I + 1;
+ end loop;
+ Enum.Arr := null;
+ end Release;
+
+ procedure Set_Field_Type (Fld : Field;
+ Typ : Enumeration_Field)
+ is
+ C_Enum_Type : C_Field_Type;
+ pragma Import (C, C_Enum_Type, "TYPE_ENUM");
+
+ function Set_Fld_Type (F : Field := Fld;
+ Cft : C_Field_Type := C_Enum_Type;
+ Arg1 : chars_ptr_array;
+ Arg2 : C_Int;
+ Arg3 : C_Int) return C_Int;
+ pragma Import (C, Set_Fld_Type, "set_field_type");
+
+ 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;
+ Wrap_Builtin (Fld, Typ, C_Choice_Router);
+ end Set_Field_Type;
+
+end Terminal_Interface.Curses.Forms.Field_Types.Enumeration;
diff --git a/Ada95/src/terminal_interface-curses-forms-field_types-enumeration.ads b/Ada95/src/terminal_interface-curses-forms-field_types-enumeration.ads
new file mode 100644
index 000000000000..e6924f6b19f9
--- /dev/null
+++ b/Ada95/src/terminal_interface-curses-forms-field_types-enumeration.ads
@@ -0,0 +1,98 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding --
+-- --
+-- Terminal_Interface.Curses.Forms.Field_Types.Enumeration --
+-- --
+-- S P E C --
+-- --
+------------------------------------------------------------------------------
+-- Copyright (c) 1998-2003,2009 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: Juergen Pfeifer, 1996
+-- Version Control:
+-- $Revision: 1.12 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+with Interfaces.C.Strings;
+
+package Terminal_Interface.Curses.Forms.Field_Types.Enumeration is
+ pragma Preelaborate
+ (Terminal_Interface.Curses.Forms.Field_Types.Enumeration);
+
+ type String_Access is access String;
+
+ -- Type_Set is used by the child package Ada
+ type Type_Set is (Lower_Case, Upper_Case, Mixed_Case);
+
+ type Enum_Array is array (Positive range <>)
+ of String_Access;
+
+ type Enumeration_Info (C : Positive) is
+ record
+ Names : Enum_Array (1 .. C);
+ Case_Sensitive : Boolean := False;
+ Match_Must_Be_Unique : Boolean := False;
+ end record;
+
+ type Enumeration_Field is new Field_Type with private;
+
+ function Create (Info : Enumeration_Info;
+ Auto_Release_Names : Boolean := False)
+ return Enumeration_Field;
+ -- Make an fieldtype from the info. Enumerations are special, because
+ -- they normally don't copy the enum values into a private store, so
+ -- we have to care for the lifetime of the info we provide.
+ -- The Auto_Release_Names flag may be used to automatically releases
+ -- the strings in the Names array of the Enumeration_Info.
+
+ function Make_Enumeration_Type (Info : Enumeration_Info;
+ Auto_Release_Names : Boolean := False)
+ return Enumeration_Field renames Create;
+
+ procedure Release (Enum : in out Enumeration_Field);
+ -- 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
+ -- not available in other curses implementations.
+
+ procedure Set_Field_Type (Fld : Field;
+ Typ : Enumeration_Field);
+ pragma Inline (Set_Field_Type);
+
+private
+ type CPA_Access is access Interfaces.C.Strings.chars_ptr_array;
+
+ type Enumeration_Field is new Field_Type with
+ record
+ Case_Sensitive : Boolean := False;
+ Match_Must_Be_Unique : Boolean := False;
+ Arr : CPA_Access := null;
+ end record;
+
+end Terminal_Interface.Curses.Forms.Field_Types.Enumeration;
diff --git a/Ada95/src/terminal_interface-curses-forms-field_types-intfield.adb b/Ada95/src/terminal_interface-curses-forms-field_types-intfield.adb
new file mode 100644
index 000000000000..8b934d08955b
--- /dev/null
+++ b/Ada95/src/terminal_interface-curses-forms-field_types-intfield.adb
@@ -0,0 +1,70 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding --
+-- --
+-- Terminal_Interface.Curses.Forms.Field_Types.IntField --
+-- --
+-- B O D Y --
+-- --
+------------------------------------------------------------------------------
+-- Copyright (c) 1998-2008,2009 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: Juergen Pfeifer, 1996
+-- Version Control:
+-- $Revision: 1.10 $
+-- $Date: 2009/12/26 17:38:58 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux;
+
+package body Terminal_Interface.Curses.Forms.Field_Types.IntField is
+
+ procedure Set_Field_Type (Fld : Field;
+ Typ : Integer_Field)
+ is
+ C_Integer_Field_Type : C_Field_Type;
+ pragma Import (C, C_Integer_Field_Type, "TYPE_INTEGER");
+
+ function Set_Fld_Type (F : Field := Fld;
+ Cft : C_Field_Type := C_Integer_Field_Type;
+ Arg1 : C_Int;
+ Arg2 : C_Long_Int;
+ Arg3 : C_Long_Int) return C_Int;
+ pragma Import (C, Set_Fld_Type, "set_field_type");
+
+ 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;
+ Wrap_Builtin (Fld, Typ);
+ end Set_Field_Type;
+
+end Terminal_Interface.Curses.Forms.Field_Types.IntField;
diff --git a/Ada95/src/terminal_interface-curses-forms-field_types-intfield.ads b/Ada95/src/terminal_interface-curses-forms-field_types-intfield.ads
new file mode 100644
index 000000000000..e90f0d06f174
--- /dev/null
+++ b/Ada95/src/terminal_interface-curses-forms-field_types-intfield.ads
@@ -0,0 +1,55 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding --
+-- --
+-- Terminal_Interface.Curses.Forms.Field_Types.IntField --
+-- --
+-- S P E C --
+-- --
+------------------------------------------------------------------------------
+-- Copyright (c) 1998-2003,2009 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: Juergen Pfeifer, 1996
+-- Version Control:
+-- $Revision: 1.12 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+package Terminal_Interface.Curses.Forms.Field_Types.IntField is
+ pragma Preelaborate (Terminal_Interface.Curses.Forms.Field_Types.IntField);
+
+ type Integer_Field is new Field_Type with
+ record
+ Precision : Natural;
+ Lower_Limit : Integer;
+ Upper_Limit : Integer;
+ end record;
+
+ procedure Set_Field_Type (Fld : Field;
+ Typ : Integer_Field);
+ pragma Inline (Set_Field_Type);
+
+end Terminal_Interface.Curses.Forms.Field_Types.IntField;
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
new file mode 100644
index 000000000000..2328f4ed0c0f
--- /dev/null
+++ b/Ada95/src/terminal_interface-curses-forms-field_types-ipv4_address.adb
@@ -0,0 +1,66 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding --
+-- --
+-- Terminal_Interface.Curses.Forms.Field_Types.IPV4_Address --
+-- --
+-- B O D Y --
+-- --
+------------------------------------------------------------------------------
+-- Copyright (c) 1998-2008,2009 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: Juergen Pfeifer, 1996
+-- Version Control:
+-- $Revision: 1.10 $
+-- $Date: 2009/12/26 17:38:58 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux;
+
+package body Terminal_Interface.Curses.Forms.Field_Types.IPV4_Address is
+
+ procedure Set_Field_Type (Fld : Field;
+ Typ : Internet_V4_Address_Field)
+ is
+ C_IPV4_Field_Type : C_Field_Type;
+ pragma Import (C, C_IPV4_Field_Type, "TYPE_IPV4");
+
+ function Set_Fld_Type (F : Field := Fld;
+ Cft : C_Field_Type := C_IPV4_Field_Type)
+ return C_Int;
+ pragma Import (C, Set_Fld_Type, "set_field_type");
+
+ Res : Eti_Error;
+ begin
+ Res := Set_Fld_Type;
+ if Res /= E_Ok then
+ Eti_Exception (Res);
+ end if;
+ Wrap_Builtin (Fld, Typ);
+ end Set_Field_Type;
+
+end Terminal_Interface.Curses.Forms.Field_Types.IPV4_Address;
diff --git a/Ada95/src/terminal_interface-curses-forms-field_types-ipv4_address.ads b/Ada95/src/terminal_interface-curses-forms-field_types-ipv4_address.ads
new file mode 100644
index 000000000000..af367e7e5ab2
--- /dev/null
+++ b/Ada95/src/terminal_interface-curses-forms-field_types-ipv4_address.ads
@@ -0,0 +1,51 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding --
+-- --
+-- Terminal_Interface.Curses.Forms.Field_Types.IPV4_Address --
+-- --
+-- S P E C --
+-- --
+------------------------------------------------------------------------------
+-- Copyright (c) 1998-2003,2009 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: Juergen Pfeifer, 1996
+-- Version Control:
+-- $Revision: 1.12 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+package Terminal_Interface.Curses.Forms.Field_Types.IPV4_Address is
+ pragma Preelaborate
+ (Terminal_Interface.Curses.Forms.Field_Types.IPV4_Address);
+
+ type Internet_V4_Address_Field is new Field_Type with null record;
+
+ procedure Set_Field_Type (Fld : Field;
+ Typ : Internet_V4_Address_Field);
+ pragma Inline (Set_Field_Type);
+
+end Terminal_Interface.Curses.Forms.Field_Types.IPV4_Address;
diff --git a/Ada95/src/terminal_interface-curses-forms-field_types-numeric.adb b/Ada95/src/terminal_interface-curses-forms-field_types-numeric.adb
new file mode 100644
index 000000000000..7151bb8b9937
--- /dev/null
+++ b/Ada95/src/terminal_interface-curses-forms-field_types-numeric.adb
@@ -0,0 +1,73 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding --
+-- --
+-- Terminal_Interface.Curses.Forms.Field_Types.Numeric --
+-- --
+-- B O D Y --
+-- --
+------------------------------------------------------------------------------
+-- Copyright (c) 1998-2008,2009 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: Juergen Pfeifer, 1996
+-- Version Control:
+-- $Revision: 1.11 $
+-- $Date: 2009/12/26 17:38:58 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+with Interfaces.C;
+with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux;
+
+package body Terminal_Interface.Curses.Forms.Field_Types.Numeric is
+
+ procedure Set_Field_Type (Fld : Field;
+ Typ : Numeric_Field)
+ is
+ type Double is new Interfaces.C.double;
+
+ C_Numeric_Field_Type : C_Field_Type;
+ pragma Import (C, C_Numeric_Field_Type, "TYPE_NUMERIC");
+
+ function Set_Fld_Type (F : Field := Fld;
+ Cft : C_Field_Type := C_Numeric_Field_Type;
+ Arg1 : C_Int;
+ Arg2 : Double;
+ Arg3 : Double) return C_Int;
+ pragma Import (C, Set_Fld_Type, "set_field_type");
+
+ 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;
+ Wrap_Builtin (Fld, Typ);
+ end Set_Field_Type;
+
+end Terminal_Interface.Curses.Forms.Field_Types.Numeric;
diff --git a/Ada95/src/terminal_interface-curses-forms-field_types-numeric.ads b/Ada95/src/terminal_interface-curses-forms-field_types-numeric.ads
new file mode 100644
index 000000000000..7c6f9fa15cef
--- /dev/null
+++ b/Ada95/src/terminal_interface-curses-forms-field_types-numeric.ads
@@ -0,0 +1,55 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding --
+-- --
+-- Terminal_Interface.Curses.Forms.Field_Types.Numeric --
+-- --
+-- S P E C --
+-- --
+------------------------------------------------------------------------------
+-- Copyright (c) 1998-2003,2009 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: Juergen Pfeifer, 1996
+-- Version Control:
+-- $Revision: 1.12 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+package Terminal_Interface.Curses.Forms.Field_Types.Numeric is
+ pragma Preelaborate (Terminal_Interface.Curses.Forms.Field_Types.Numeric);
+
+ type Numeric_Field is new Field_Type with
+ record
+ Precision : Natural;
+ Lower_Limit : Float;
+ Upper_Limit : Float;
+ end record;
+
+ procedure Set_Field_Type (Fld : Field;
+ Typ : Numeric_Field);
+ pragma Inline (Set_Field_Type);
+
+end Terminal_Interface.Curses.Forms.Field_Types.Numeric;
diff --git a/Ada95/src/terminal_interface-curses-forms-field_types-regexp.adb b/Ada95/src/terminal_interface-curses-forms-field_types-regexp.adb
new file mode 100644
index 000000000000..f4c7c587ad93
--- /dev/null
+++ b/Ada95/src/terminal_interface-curses-forms-field_types-regexp.adb
@@ -0,0 +1,71 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding --
+-- --
+-- Terminal_Interface.Curses.Forms.Field_Types.RegExp --
+-- --
+-- B O D Y --
+-- --
+------------------------------------------------------------------------------
+-- Copyright (c) 1998-2003,2009 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: Juergen Pfeifer, 1996
+-- Version Control:
+-- $Revision: 1.9 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+with Interfaces.C; use Interfaces.C;
+with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux;
+
+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;
+
+ C_Regexp_Field_Type : C_Field_Type;
+ pragma Import (C, C_Regexp_Field_Type, "TYPE_REGEXP");
+
+ function Set_Ftyp (F : Field := Fld;
+ Cft : C_Field_Type := C_Regexp_Field_Type;
+ Arg1 : Char_Ptr) return C_Int;
+ pragma Import (C, Set_Ftyp, "set_field_type");
+
+ 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;
+ Wrap_Builtin (Fld, Typ);
+ end Set_Field_Type;
+
+end Terminal_Interface.Curses.Forms.Field_Types.RegExp;
diff --git a/Ada95/src/terminal_interface-curses-forms-field_types-regexp.ads b/Ada95/src/terminal_interface-curses-forms-field_types-regexp.ads
new file mode 100644
index 000000000000..26841382dcb8
--- /dev/null
+++ b/Ada95/src/terminal_interface-curses-forms-field_types-regexp.ads
@@ -0,0 +1,55 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding --
+-- --
+-- Terminal_Interface.Curses.Forms.Field_Types.RegExp --
+-- --
+-- S P E C --
+-- --
+------------------------------------------------------------------------------
+-- Copyright (c) 1998-2003,2009 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: Juergen Pfeifer, 1996
+-- Version Control:
+-- $Revision: 1.12 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+package Terminal_Interface.Curses.Forms.Field_Types.RegExp is
+ pragma Preelaborate (Terminal_Interface.Curses.Forms.Field_Types.RegExp);
+
+ type String_Access is access String;
+
+ type Regular_Expression_Field is new Field_Type with
+ record
+ Regular_Expression : String_Access;
+ end record;
+
+ procedure Set_Field_Type (Fld : Field;
+ Typ : Regular_Expression_Field);
+ pragma Inline (Set_Field_Type);
+
+end Terminal_Interface.Curses.Forms.Field_Types.RegExp;
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
new file mode 100644
index 000000000000..f26a42cdca12
--- /dev/null
+++ b/Ada95/src/terminal_interface-curses-forms-field_types-user-choice.adb
@@ -0,0 +1,110 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding --
+-- --
+-- Terminal_Interface.Curses.Forms.Field_Types.User.Choice --
+-- --
+-- B O D Y --
+-- --
+------------------------------------------------------------------------------
+-- Copyright (c) 1998-2006,2008 Free Software Foundation, Inc. --
+-- --
+-- Permission is hereby granted, free of charge, to any person obtaining a --
+-- copy of this software and associated documentation files (the --
+-- "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: Juergen Pfeifer, 1996
+-- Version Control:
+-- $Revision: 1.15 $
+-- $Date: 2008/07/26 18:48:58 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+with Ada.Unchecked_Conversion;
+with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux;
+
+package body Terminal_Interface.Curses.Forms.Field_Types.User.Choice is
+
+ pragma Warnings (Off);
+ function To_Argument_Access is new Ada.Unchecked_Conversion
+ (System.Address, Argument_Access);
+ pragma Warnings (On);
+
+ function Generic_Next (Fld : Field;
+ Usr : System.Address) return C_Int
+ is
+ Result : Boolean;
+ Udf : constant User_Defined_Field_Type_With_Choice_Access :=
+ User_Defined_Field_Type_With_Choice_Access
+ (To_Argument_Access (Usr).Typ);
+ begin
+ Result := Next (Fld, Udf.all);
+ return C_Int (Boolean'Pos (Result));
+ end Generic_Next;
+
+ function Generic_Prev (Fld : Field;
+ Usr : System.Address) return C_Int
+ is
+ Result : Boolean;
+ Udf : constant User_Defined_Field_Type_With_Choice_Access :=
+ User_Defined_Field_Type_With_Choice_Access
+ (To_Argument_Access (Usr).Typ);
+ begin
+ Result := Previous (Fld, Udf.all);
+ return C_Int (Boolean'Pos (Result));
+ end Generic_Prev;
+
+ -- -----------------------------------------------------------------------
+ --
+ function C_Generic_Choice return C_Field_Type
+ is
+ Res : Eti_Error;
+ T : C_Field_Type;
+ begin
+ if M_Generic_Choice = Null_Field_Type then
+ T := New_Fieldtype (Generic_Field_Check'Access,
+ Generic_Char_Check'Access);
+ if T = Null_Field_Type then
+ 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;
+
+ Res := Set_Fieldtype_Choice (T,
+ Generic_Next'Access,
+ Generic_Prev'Access);
+ if Res /= E_Ok then
+ Eti_Exception (Res);
+ end if;
+ end if;
+ M_Generic_Choice := T;
+ end if;
+ pragma Assert (M_Generic_Choice /= Null_Field_Type);
+ return M_Generic_Choice;
+ end C_Generic_Choice;
+
+end Terminal_Interface.Curses.Forms.Field_Types.User.Choice;
diff --git a/Ada95/src/terminal_interface-curses-forms-field_types-user-choice.ads b/Ada95/src/terminal_interface-curses-forms-field_types-user-choice.ads
new file mode 100644
index 000000000000..1e69f43a915f
--- /dev/null
+++ b/Ada95/src/terminal_interface-curses-forms-field_types-user-choice.ads
@@ -0,0 +1,94 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding --
+-- --
+-- Terminal_Interface.Curses.Forms.Field_Types.User.Choice --
+-- --
+-- S P E C --
+-- --
+------------------------------------------------------------------------------
+-- Copyright (c) 1998,2008 Free Software Foundation, Inc. --
+-- --
+-- Permission is hereby granted, free of charge, to any person obtaining a --
+-- copy of this software and associated documentation files (the --
+-- "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: Juergen Pfeifer, 1996
+-- Version Control:
+-- $Revision: 1.12 $
+-- $Date: 2008/07/26 18:49:20 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+with Interfaces.C;
+
+package Terminal_Interface.Curses.Forms.Field_Types.User.Choice is
+ pragma Preelaborate
+ (Terminal_Interface.Curses.Forms.Field_Types.User.Choice);
+
+ subtype C_Int is Interfaces.C.int;
+
+ type User_Defined_Field_Type_With_Choice is abstract new
+ User_Defined_Field_Type with null record;
+ -- This is the root of the mechanism we use to create field types in
+ -- Ada95 that allow the prev/next mechanism. You should your own type
+ -- derive from this one and implement the Field_Check, Character_Check
+ -- Next and Previous functions for your own type.
+
+ type User_Defined_Field_Type_With_Choice_Access is access all
+ User_Defined_Field_Type_With_Choice'Class;
+
+ function Next
+ (Fld : Field;
+ Typ : User_Defined_Field_Type_With_Choice) return Boolean
+ is abstract;
+ -- If True is returned, the function successfully generated a next
+ -- value into the fields buffer.
+
+ function Previous
+ (Fld : Field;
+ Typ : User_Defined_Field_Type_With_Choice) return Boolean
+ is abstract;
+ -- If True is returned, the function successfully generated a previous
+ -- value into the fields buffer.
+
+ -- +----------------------------------------------------------------------
+ -- | Private Part.
+ -- |
+private
+ function C_Generic_Choice return C_Field_Type;
+
+ function Generic_Next (Fld : Field;
+ Usr : System.Address) return C_Int;
+ pragma Convention (C, Generic_Next);
+ -- This is the generic next Choice_Function for the low-level fieldtype
+ -- representing all the User_Defined_Field_Type derivates. It routes
+ -- the call to the Next implementation for the type.
+
+ function Generic_Prev (Fld : Field;
+ Usr : System.Address) return C_Int;
+ pragma Convention (C, Generic_Prev);
+ -- This is the generic prev Choice_Function for the low-level fieldtype
+ -- representing all the User_Defined_Field_Type derivates. It routes
+ -- the call to the Previous implementation for the type.
+
+end Terminal_Interface.Curses.Forms.Field_Types.User.Choice;
diff --git a/Ada95/src/terminal_interface-curses-forms-field_types-user.adb b/Ada95/src/terminal_interface-curses-forms-field_types-user.adb
new file mode 100644
index 000000000000..695f91971932
--- /dev/null
+++ b/Ada95/src/terminal_interface-curses-forms-field_types-user.adb
@@ -0,0 +1,133 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding --
+-- --
+-- Terminal_Interface.Curses.Forms.Field_Types.User --
+-- --
+-- B O D Y --
+-- --
+------------------------------------------------------------------------------
+-- Copyright (c) 1998-2008,2009 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: Juergen Pfeifer, 1996
+-- Version Control:
+-- $Revision: 1.16 $
+-- $Date: 2009/12/26 17:38:58 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+with Ada.Unchecked_Conversion;
+with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux;
+
+package body Terminal_Interface.Curses.Forms.Field_Types.User is
+
+ procedure Set_Field_Type (Fld : Field;
+ Typ : User_Defined_Field_Type)
+ is
+ function Allocate_Arg (T : User_Defined_Field_Type'Class)
+ return Argument_Access;
+
+ function Set_Fld_Type (F : Field := Fld;
+ Cft : C_Field_Type := C_Generic_Type;
+ Arg1 : Argument_Access)
+ return C_Int;
+ pragma Import (C, Set_Fld_Type, "set_field_type");
+
+ Res : Eti_Error;
+
+ function Allocate_Arg (T : User_Defined_Field_Type'Class)
+ return Argument_Access
+ is
+ Ptr : constant Field_Type_Access
+ := new User_Defined_Field_Type'Class'(T);
+ begin
+ return new Argument'(Usr => System.Null_Address,
+ Typ => Ptr,
+ Cft => Null_Field_Type);
+ end Allocate_Arg;
+
+ begin
+ Res := Set_Fld_Type (Arg1 => Allocate_Arg (Typ));
+ if Res /= E_Ok then
+ Eti_Exception (Res);
+ end if;
+ end Set_Field_Type;
+
+ pragma Warnings (Off);
+ function To_Argument_Access is new Ada.Unchecked_Conversion
+ (System.Address, Argument_Access);
+ pragma Warnings (On);
+
+ function Generic_Field_Check (Fld : Field;
+ Usr : System.Address) return C_Int
+ is
+ Result : Boolean;
+ Udf : constant User_Defined_Field_Type_Access :=
+ User_Defined_Field_Type_Access (To_Argument_Access (Usr).Typ);
+ begin
+ Result := Field_Check (Fld, Udf.all);
+ return C_Int (Boolean'Pos (Result));
+ end Generic_Field_Check;
+
+ function Generic_Char_Check (Ch : C_Int;
+ Usr : System.Address) return C_Int
+ is
+ Result : Boolean;
+ Udf : constant User_Defined_Field_Type_Access :=
+ User_Defined_Field_Type_Access (To_Argument_Access (Usr).Typ);
+ begin
+ Result := Character_Check (Character'Val (Ch), Udf.all);
+ return C_Int (Boolean'Pos (Result));
+ end Generic_Char_Check;
+
+ -- -----------------------------------------------------------------------
+ --
+ function C_Generic_Type return C_Field_Type
+ is
+ Res : Eti_Error;
+ T : C_Field_Type;
+ begin
+ if M_Generic_Type = Null_Field_Type then
+ T := New_Fieldtype (Generic_Field_Check'Access,
+ Generic_Char_Check'Access);
+ if T = Null_Field_Type then
+ raise Form_Exception;
+ else
+ Res := Set_Fieldtype_Arg (T,
+ Make_Arg'Access,
+ Copy_Arg'Access,
+ Free_Arg'Access);
+ if Res /= E_Ok then
+ Eti_Exception (Res);
+ end if;
+ end if;
+ M_Generic_Type := T;
+ end if;
+ pragma Assert (M_Generic_Type /= Null_Field_Type);
+ return M_Generic_Type;
+ end C_Generic_Type;
+
+end Terminal_Interface.Curses.Forms.Field_Types.User;
diff --git a/Ada95/src/terminal_interface-curses-forms-field_types-user.ads b/Ada95/src/terminal_interface-curses-forms-field_types-user.ads
new file mode 100644
index 000000000000..af45fab49228
--- /dev/null
+++ b/Ada95/src/terminal_interface-curses-forms-field_types-user.ads
@@ -0,0 +1,95 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding --
+-- --
+-- Terminal_Interface.Curses.Forms.Field_Types.User --
+-- --
+-- S P E C --
+-- --
+------------------------------------------------------------------------------
+-- Copyright (c) 1998-2008,2009 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: Juergen Pfeifer, 1996
+-- Version Control:
+-- $Revision: 1.13 $
+-- $Date: 2009/12/26 17:38:58 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+with Interfaces.C;
+
+package Terminal_Interface.Curses.Forms.Field_Types.User is
+ pragma Preelaborate (Terminal_Interface.Curses.Forms.Field_Types.User);
+ subtype C_Int is Interfaces.C.int;
+
+ type User_Defined_Field_Type is abstract new Field_Type with null record;
+ -- This is the root of the mechanism we use to create field types in
+ -- Ada95. You should your own type derive from this one and implement
+ -- the Field_Check and Character_Check functions for your own type.
+
+ type User_Defined_Field_Type_Access is access all
+ User_Defined_Field_Type'Class;
+
+ function Field_Check
+ (Fld : Field;
+ Typ : User_Defined_Field_Type) return Boolean
+ is abstract;
+ -- If True is returned, the field is considered valid, otherwise it is
+ -- invalid.
+
+ function Character_Check
+ (Ch : Character;
+ Typ : User_Defined_Field_Type) return Boolean
+ is abstract;
+ -- If True is returned, the character is considered as valid for the
+ -- field, otherwise as invalid.
+
+ procedure Set_Field_Type (Fld : Field;
+ Typ : User_Defined_Field_Type);
+ -- This should work for all types derived from User_Defined_Field_Type.
+ -- No need to reimplement it for your derived type.
+
+ -- +----------------------------------------------------------------------
+ -- | Private Part.
+ -- | Used by the Choice child package.
+private
+ function C_Generic_Type return C_Field_Type;
+
+ function Generic_Field_Check (Fld : Field;
+ Usr : System.Address) return C_Int;
+ pragma Convention (C, Generic_Field_Check);
+ -- This is the generic Field_Check_Function for the low-level fieldtype
+ -- representing all the User_Defined_Field_Type derivates. It routes
+ -- the call to the Field_Check implementation for the type.
+
+ function Generic_Char_Check (Ch : C_Int;
+ Usr : System.Address) return C_Int;
+ pragma Convention (C, Generic_Char_Check);
+ -- This is the generic Char_Check_Function for the low-level fieldtype
+ -- representing all the User_Defined_Field_Type derivates. It routes
+ -- the call to the Character_Check implementation for the type.
+
+end Terminal_Interface.Curses.Forms.Field_Types.User;
diff --git a/Ada95/src/terminal_interface-curses-forms-field_types.adb b/Ada95/src/terminal_interface-curses-forms-field_types.adb
new file mode 100644
index 000000000000..aef5d3c8a389
--- /dev/null
+++ b/Ada95/src/terminal_interface-curses-forms-field_types.adb
@@ -0,0 +1,296 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding --
+-- --
+-- Terminal_Interface.Curses.Forms.Field_Types --
+-- --
+-- B O D Y --
+-- --
+------------------------------------------------------------------------------
+-- Copyright (c) 1998-2008,2009 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: Juergen Pfeifer, 1996
+-- Version Control:
+-- $Revision: 1.21 $
+-- $Date: 2009/12/26 17:38:58 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux;
+with Ada.Unchecked_Deallocation;
+with Ada.Unchecked_Conversion;
+-- |
+-- |=====================================================================
+-- | man page form_fieldtype.3x
+-- |=====================================================================
+-- |
+package body Terminal_Interface.Curses.Forms.Field_Types is
+
+ use type System.Address;
+
+ pragma Warnings (Off);
+ function To_Argument_Access is new Ada.Unchecked_Conversion
+ (System.Address, Argument_Access);
+ pragma Warnings (On);
+
+ function Get_Fieldtype (F : Field) return C_Field_Type;
+ pragma Import (C, Get_Fieldtype, "field_type");
+
+ function Get_Arg (F : Field) return System.Address;
+ pragma Import (C, Get_Arg, "field_arg");
+ -- |
+ -- |=====================================================================
+ -- | man page form_field_validation.3x
+ -- |=====================================================================
+ -- |
+ -- |
+ -- |
+ function Get_Type (Fld : Field) return Field_Type_Access
+ is
+ Low_Level : constant C_Field_Type := Get_Fieldtype (Fld);
+ Arg : Argument_Access;
+ begin
+ if Low_Level = Null_Field_Type then
+ 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
+ Arg := To_Argument_Access (Get_Arg (Fld));
+ if Arg = null then
+ raise Form_Exception;
+ else
+ return Arg.Typ;
+ end if;
+ else
+ raise Form_Exception;
+ end if;
+ end if;
+ end Get_Type;
+
+ function Make_Arg (Args : System.Address) return System.Address
+ is
+ -- Actually args is a double indirected pointer to the arguments
+ -- of a C variable argument list. In theory it is now quite
+ -- complicated to write portable routine that reads the arguments,
+ -- because one has to know the growth direction of the stack and
+ -- the sizes of the individual arguments.
+ -- Fortunately we are only interested in the first argument (#0),
+ -- we know its size and for the first arg we don't care about
+ -- into which stack direction we have to proceed. We simply
+ -- resolve the double indirection and thats it.
+ type V is access all System.Address;
+ function To_Access is new Ada.Unchecked_Conversion (System.Address,
+ V);
+ begin
+ return To_Access (To_Access (Args).all).all;
+ end Make_Arg;
+
+ function Copy_Arg (Usr : System.Address) return System.Address
+ is
+ begin
+ return Usr;
+ end Copy_Arg;
+
+ procedure Free_Arg (Usr : System.Address)
+ is
+ procedure Free_Type is new Ada.Unchecked_Deallocation
+ (Field_Type'Class, Field_Type_Access);
+ procedure Freeargs is new Ada.Unchecked_Deallocation
+ (Argument, Argument_Access);
+
+ To_Be_Free : Argument_Access := To_Argument_Access (Usr);
+ Low_Level : C_Field_Type;
+ begin
+ if To_Be_Free /= null then
+ if To_Be_Free.Usr /= System.Null_Address then
+ Low_Level := To_Be_Free.Cft;
+ if Low_Level.Freearg /= null then
+ Low_Level.Freearg (To_Be_Free.Usr);
+ end if;
+ end if;
+ if To_Be_Free.Typ /= null then
+ Free_Type (To_Be_Free.Typ);
+ end if;
+ Freeargs (To_Be_Free);
+ end if;
+ end Free_Arg;
+
+ procedure Wrap_Builtin (Fld : Field;
+ Typ : Field_Type'Class;
+ Cft : C_Field_Type := C_Builtin_Router)
+ 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;
+ pragma Import (C, Set_Fld_Type, "set_field_type");
+
+ begin
+ pragma Assert (Low_Level /= Null_Field_Type);
+ if Cft /= C_Builtin_Router and then Cft /= C_Choice_Router then
+ raise Form_Exception;
+ else
+ Arg := new Argument'(Usr => System.Null_Address,
+ Typ => new Field_Type'Class'(Typ),
+ Cft => Get_Fieldtype (Fld));
+ if Usr_Arg /= System.Null_Address then
+ if Low_Level.Copyarg /= null then
+ Arg.Usr := Low_Level.Copyarg (Usr_Arg);
+ else
+ Arg.Usr := Usr_Arg;
+ end if;
+ end if;
+
+ Res := Set_Fld_Type (Arg1 => Arg);
+ if Res /= E_Ok then
+ Eti_Exception (Res);
+ end if;
+ end if;
+ end Wrap_Builtin;
+
+ function Field_Check_Router (Fld : Field;
+ Usr : System.Address) return C_Int
+ is
+ Arg : constant Argument_Access := To_Argument_Access (Usr);
+ begin
+ pragma Assert (Arg /= null and then Arg.Cft /= Null_Field_Type
+ and then Arg.Typ /= null);
+ if Arg.Cft.Fcheck /= null then
+ return Arg.Cft.Fcheck (Fld, Arg.Usr);
+ else
+ return 1;
+ end if;
+ end Field_Check_Router;
+
+ function Char_Check_Router (Ch : C_Int;
+ Usr : System.Address) return C_Int
+ is
+ Arg : constant Argument_Access := To_Argument_Access (Usr);
+ begin
+ pragma Assert (Arg /= null and then Arg.Cft /= Null_Field_Type
+ and then Arg.Typ /= null);
+ if Arg.Cft.Ccheck /= null then
+ return Arg.Cft.Ccheck (Ch, Arg.Usr);
+ else
+ return 1;
+ end if;
+ end Char_Check_Router;
+
+ function Next_Router (Fld : Field;
+ Usr : System.Address) return C_Int
+ is
+ Arg : constant Argument_Access := To_Argument_Access (Usr);
+ begin
+ pragma Assert (Arg /= null and then Arg.Cft /= Null_Field_Type
+ and then Arg.Typ /= null);
+ if Arg.Cft.Next /= null then
+ return Arg.Cft.Next (Fld, Arg.Usr);
+ else
+ return 1;
+ end if;
+ end Next_Router;
+
+ function Prev_Router (Fld : Field;
+ Usr : System.Address) return C_Int
+ is
+ Arg : constant Argument_Access := To_Argument_Access (Usr);
+ begin
+ pragma Assert (Arg /= null and then Arg.Cft /= Null_Field_Type
+ and then Arg.Typ /= null);
+ if Arg.Cft.Prev /= null then
+ return Arg.Cft.Prev (Fld, Arg.Usr);
+ else
+ return 1;
+ end if;
+ end Prev_Router;
+
+ -- -----------------------------------------------------------------------
+ --
+ 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
+ T := New_Fieldtype (Field_Check_Router'Access,
+ Char_Check_Router'Access);
+ 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;
+ end if;
+ M_Builtin_Router := T;
+ end if;
+ pragma Assert (M_Builtin_Router /= Null_Field_Type);
+ return M_Builtin_Router;
+ end C_Builtin_Router;
+
+ -- -----------------------------------------------------------------------
+ --
+ 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
+ T := New_Fieldtype (Field_Check_Router'Access,
+ Char_Check_Router'Access);
+ 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;
+
+ Res := Set_Fieldtype_Choice (T,
+ Next_Router'Access,
+ Prev_Router'Access);
+ if Res /= E_Ok then
+ Eti_Exception (Res);
+ end if;
+ end if;
+ M_Choice_Router := T;
+ end if;
+ pragma Assert (M_Choice_Router /= Null_Field_Type);
+ return M_Choice_Router;
+ end C_Choice_Router;
+
+end Terminal_Interface.Curses.Forms.Field_Types;
diff --git a/Ada95/src/terminal_interface-curses-forms-field_user_data.adb b/Ada95/src/terminal_interface-curses-forms-field_user_data.adb
new file mode 100644
index 000000000000..96178d8a9349
--- /dev/null
+++ b/Ada95/src/terminal_interface-curses-forms-field_user_data.adb
@@ -0,0 +1,85 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding --
+-- --
+-- Terminal_Interface.Curses.Forms.Field_User_Data --
+-- --
+-- B O D Y --
+-- --
+------------------------------------------------------------------------------
+-- Copyright (c) 1998-2003,2009 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: Juergen Pfeifer, 1996
+-- Version Control:
+-- $Revision: 1.13 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux;
+
+-- |
+-- |=====================================================================
+-- | man page form_field_userptr.3x
+-- |=====================================================================
+-- |
+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;
+ 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;
+ end Set_User_Data;
+ -- |
+ -- |
+ -- |
+ function Get_User_Data (Fld : Field) return User_Access
+ is
+ function Field_Userptr (Fld : Field) return User_Access;
+ pragma Import (C, Field_Userptr, "field_userptr");
+ begin
+ return Field_Userptr (Fld);
+ end Get_User_Data;
+
+ procedure Get_User_Data (Fld : Field;
+ Data : out User_Access)
+ is
+ begin
+ Data := Get_User_Data (Fld);
+ end Get_User_Data;
+
+end Terminal_Interface.Curses.Forms.Field_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
new file mode 100644
index 000000000000..84353eb55700
--- /dev/null
+++ b/Ada95/src/terminal_interface-curses-forms-form_user_data.adb
@@ -0,0 +1,86 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding --
+-- --
+-- Terminal_Interface.Curses.Forms.Form_User_Data --
+-- --
+-- B O D Y --
+-- --
+------------------------------------------------------------------------------
+-- Copyright (c) 1998-2003,2009 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: Juergen Pfeifer, 1996
+-- Version Control:
+-- $Revision: 1.13 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+-- |
+-- |=====================================================================
+-- | man page form__userptr.3x
+-- |=====================================================================
+-- |
+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;
+
+ -- |
+ -- |
+ -- |
+ procedure Set_User_Data (Frm : Form;
+ Data : User_Access)
+ is
+ function Set_Form_Userptr (Frm : Form;
+ Data : User_Access) return C_Int;
+ 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;
+ end Set_User_Data;
+ -- |
+ -- |
+ -- |
+ function Get_User_Data (Frm : Form) return User_Access
+ is
+ function Form_Userptr (Frm : Form) return User_Access;
+ pragma Import (C, Form_Userptr, "form_userptr");
+ begin
+ return Form_Userptr (Frm);
+ end Get_User_Data;
+
+ procedure Get_User_Data (Frm : Form;
+ Data : out User_Access)
+ is
+ begin
+ Data := Get_User_Data (Frm);
+ end Get_User_Data;
+
+end Terminal_Interface.Curses.Forms.Form_User_Data;
diff --git a/Ada95/src/terminal_interface-curses-forms.adb b/Ada95/src/terminal_interface-curses-forms.adb
new file mode 100644
index 000000000000..68825fc3dfbd
--- /dev/null
+++ b/Ada95/src/terminal_interface-curses-forms.adb
@@ -0,0 +1,1161 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding --
+-- --
+-- Terminal_Interface.Curses.Forms --
+-- --
+-- B O D Y --
+-- --
+------------------------------------------------------------------------------
+-- Copyright (c) 1998-2008,2009 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: Juergen Pfeifer, 1996
+-- Version Control:
+-- $Revision: 1.27 $
+-- $Date: 2009/12/26 17:38:58 $
+-- 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;
+with Interfaces.C.Pointers;
+
+with Terminal_Interface.Curses.Aux;
+
+package body Terminal_Interface.Curses.Forms is
+
+ use Terminal_Interface.Curses.Aux;
+
+ type C_Field_Array is array (Natural range <>) of aliased Field;
+ package F_Array is new
+ Interfaces.C.Pointers (Natural, Field, C_Field_Array, Null_Field);
+
+------------------------------------------------------------------------------
+ -- |
+ -- |
+ -- |
+ -- 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
+ function Form_Request_Name (Key : C_Int) return chars_ptr;
+ pragma Import (C, Form_Request_Name, "form_request_name");
+ begin
+ Fill_String (Form_Request_Name (C_Int (Key)), Name);
+ end Request_Name;
+
+ function Request_Name (Key : Form_Request_Code) return String
+ is
+ function Form_Request_Name (Key : C_Int) return chars_ptr;
+ pragma Import (C, Form_Request_Name, "form_request_name");
+ begin
+ return Fill_String (Form_Request_Name (C_Int (Key)));
+ end Request_Name;
+------------------------------------------------------------------------------
+ -- |
+ -- |
+ -- |
+ -- |
+ -- |=====================================================================
+ -- | man page form_field_new.3x
+ -- |=====================================================================
+ -- |
+ -- |
+ -- |
+ function Create (Height : Line_Count;
+ Width : Column_Count;
+ Top : Line_Position;
+ Left : Column_Position;
+ Off_Screen : Natural := 0;
+ More_Buffers : Buffer_Number := Buffer_Number'First)
+ return Field
+ is
+ function Newfield (H, W, T, L, O, M : C_Int) return Field;
+ pragma Import (C, Newfield, "new_field");
+ Fld : constant Field := Newfield (C_Int (Height), C_Int (Width),
+ C_Int (Top), C_Int (Left),
+ C_Int (Off_Screen),
+ C_Int (More_Buffers));
+ begin
+ if Fld = Null_Field then
+ raise Form_Exception;
+ end if;
+ return Fld;
+ end Create;
+-- |
+-- |
+-- |
+ procedure Delete (Fld : in out Field)
+ is
+ function Free_Field (Fld : Field) return C_Int;
+ 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;
+ Fld := Null_Field;
+ end Delete;
+ -- |
+ -- |
+ -- |
+ function Duplicate (Fld : Field;
+ Top : Line_Position;
+ Left : Column_Position) return Field
+ is
+ function Dup_Field (Fld : Field;
+ Top : C_Int;
+ Left : C_Int) return Field;
+ pragma Import (C, Dup_Field, "dup_field");
+
+ F : constant Field := Dup_Field (Fld,
+ C_Int (Top),
+ C_Int (Left));
+ begin
+ if F = Null_Field then
+ raise Form_Exception;
+ end if;
+ return F;
+ end Duplicate;
+ -- |
+ -- |
+ -- |
+ function Link (Fld : Field;
+ Top : Line_Position;
+ Left : Column_Position) return Field
+ is
+ function Lnk_Field (Fld : Field;
+ Top : C_Int;
+ Left : C_Int) return Field;
+ pragma Import (C, Lnk_Field, "link_field");
+
+ F : constant Field := Lnk_Field (Fld,
+ C_Int (Top),
+ C_Int (Left));
+ begin
+ if F = Null_Field then
+ raise Form_Exception;
+ end if;
+ return F;
+ end Link;
+ -- |
+ -- |=====================================================================
+ -- | man page form_field_just.3x
+ -- |=====================================================================
+ -- |
+ -- |
+ -- |
+ procedure Set_Justification (Fld : Field;
+ Just : Field_Justification := None)
+ is
+ function Set_Field_Just (Fld : Field;
+ Just : C_Int) return C_Int;
+ 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;
+ end Set_Justification;
+ -- |
+ -- |
+ -- |
+ function Get_Justification (Fld : Field) return Field_Justification
+ is
+ function Field_Just (Fld : Field) return C_Int;
+ pragma Import (C, Field_Just, "field_just");
+ begin
+ return Field_Justification'Val (Field_Just (Fld));
+ end Get_Justification;
+ -- |
+ -- |=====================================================================
+ -- | man page form_field_buffer.3x
+ -- |=====================================================================
+ -- |
+ -- |
+ -- |
+ procedure Set_Buffer
+ (Fld : Field;
+ 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;
+ 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;
+ end Set_Buffer;
+ -- |
+ -- |
+ -- |
+ procedure Get_Buffer
+ (Fld : Field;
+ Buffer : Buffer_Number := Buffer_Number'First;
+ Str : out String)
+ is
+ function Field_Buffer (Fld : Field;
+ B : C_Int) return chars_ptr;
+ pragma Import (C, Field_Buffer, "field_buffer");
+ begin
+ Fill_String (Field_Buffer (Fld, C_Int (Buffer)), Str);
+ end Get_Buffer;
+
+ function Get_Buffer
+ (Fld : Field;
+ Buffer : Buffer_Number := Buffer_Number'First) return String
+ is
+ function Field_Buffer (Fld : Field;
+ B : C_Int) return chars_ptr;
+ pragma Import (C, Field_Buffer, "field_buffer");
+ begin
+ return Fill_String (Field_Buffer (Fld, C_Int (Buffer)));
+ end Get_Buffer;
+ -- |
+ -- |
+ -- |
+ procedure Set_Status (Fld : Field;
+ Status : Boolean := True)
+ is
+ function Set_Fld_Status (Fld : Field;
+ St : C_Int) return C_Int;
+ 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
+ raise Form_Exception;
+ end if;
+ end Set_Status;
+ -- |
+ -- |
+ -- |
+ function Changed (Fld : Field) return Boolean
+ is
+ function Field_Status (Fld : Field) return C_Int;
+ pragma Import (C, Field_Status, "field_status");
+
+ Res : constant C_Int := Field_Status (Fld);
+ begin
+ if Res = Curses_False then
+ return False;
+ else
+ return True;
+ end if;
+ end Changed;
+ -- |
+ -- |
+ -- |
+ procedure Set_Maximum_Size (Fld : Field;
+ Max : Natural := 0)
+ is
+ function Set_Field_Max (Fld : Field;
+ M : C_Int) return C_Int;
+ 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;
+ end Set_Maximum_Size;
+ -- |
+ -- |=====================================================================
+ -- | man page form_field_opts.3x
+ -- |=====================================================================
+ -- |
+ -- |
+ -- |
+ procedure Set_Options (Fld : Field;
+ Options : Field_Option_Set)
+ is
+ function Set_Field_Opts (Fld : Field;
+ Opt : C_Int) return C_Int;
+ 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;
+ end Set_Options;
+ -- |
+ -- |
+ -- |
+ procedure Switch_Options (Fld : Field;
+ Options : Field_Option_Set;
+ On : Boolean := True)
+ is
+ function Field_Opts_On (Fld : Field;
+ Opt : C_Int) return C_Int;
+ pragma Import (C, Field_Opts_On, "field_opts_on");
+ function Field_Opts_Off (Fld : Field;
+ Opt : C_Int) return C_Int;
+ 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);
+ else
+ Err := Field_Opts_Off (Fld, Opt);
+ end if;
+ if Err /= E_Ok then
+ Eti_Exception (Err);
+ end if;
+ end Switch_Options;
+ -- |
+ -- |
+ -- |
+ procedure Get_Options (Fld : Field;
+ Options : out Field_Option_Set)
+ is
+ function Field_Opts (Fld : Field) return C_Int;
+ pragma Import (C, Field_Opts, "field_opts");
+
+ Res : constant C_Int := Field_Opts (Fld);
+ begin
+ Options := CInt_2_FOS (Res);
+ end Get_Options;
+ -- |
+ -- |
+ -- |
+ function Get_Options (Fld : Field := Null_Field)
+ return Field_Option_Set
+ is
+ Fos : Field_Option_Set;
+ begin
+ Get_Options (Fld, Fos);
+ return Fos;
+ end Get_Options;
+ -- |
+ -- |=====================================================================
+ -- | man page form_field_attributes.3x
+ -- |=====================================================================
+ -- |
+ -- |
+ -- |
+ procedure Set_Foreground
+ (Fld : Field;
+ Fore : Character_Attribute_Set := Normal_Video;
+ Color : Color_Pair := Color_Pair'First)
+ is
+ function Set_Field_Fore (Fld : Field;
+ Attr : C_Chtype) return C_Int;
+ 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;
+ end Set_Foreground;
+ -- |
+ -- |
+ -- |
+ procedure Foreground (Fld : Field;
+ Fore : out Character_Attribute_Set)
+ is
+ function Field_Fore (Fld : Field) return C_Chtype;
+ pragma Import (C, Field_Fore, "field_fore");
+ begin
+ Fore := Chtype_To_AttrChar (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;
+ pragma Import (C, Field_Fore, "field_fore");
+ begin
+ Fore := Chtype_To_AttrChar (Field_Fore (Fld)).Attr;
+ Color := Chtype_To_AttrChar (Field_Fore (Fld)).Color;
+ end Foreground;
+ -- |
+ -- |
+ -- |
+ procedure Set_Background
+ (Fld : Field;
+ Back : Character_Attribute_Set := Normal_Video;
+ Color : Color_Pair := Color_Pair'First)
+ is
+ function Set_Field_Back (Fld : Field;
+ Attr : C_Chtype) return C_Int;
+ 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;
+ end Set_Background;
+ -- |
+ -- |
+ -- |
+ procedure Background (Fld : Field;
+ Back : out Character_Attribute_Set)
+ is
+ function Field_Back (Fld : Field) return C_Chtype;
+ pragma Import (C, Field_Back, "field_back");
+ begin
+ Back := Chtype_To_AttrChar (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;
+ pragma Import (C, Field_Back, "field_back");
+ begin
+ Back := Chtype_To_AttrChar (Field_Back (Fld)).Attr;
+ Color := Chtype_To_AttrChar (Field_Back (Fld)).Color;
+ end Background;
+ -- |
+ -- |
+ -- |
+ procedure Set_Pad_Character (Fld : Field;
+ Pad : Character := Space)
+ is
+ function Set_Field_Pad (Fld : Field;
+ Ch : C_Int) return C_Int;
+ 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;
+ end Set_Pad_Character;
+ -- |
+ -- |
+ -- |
+ procedure Pad_Character (Fld : Field;
+ Pad : out Character)
+ is
+ function Field_Pad (Fld : Field) return C_Int;
+ pragma Import (C, Field_Pad, "field_pad");
+ begin
+ Pad := Character'Val (Field_Pad (Fld));
+ end Pad_Character;
+ -- |
+ -- |=====================================================================
+ -- | man page form_field_info.3x
+ -- |=====================================================================
+ -- |
+ -- |
+ -- |
+ procedure Info (Fld : Field;
+ Lines : out Line_Count;
+ Columns : out Column_Count;
+ First_Row : out Line_Position;
+ First_Column : out Column_Position;
+ Off_Screen : out Natural;
+ Additional_Buffers : out Buffer_Number)
+ 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;
+ 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;
+ end Info;
+-- |
+-- |
+-- |
+ procedure Dynamic_Info (Fld : Field;
+ Lines : out Line_Count;
+ Columns : out Column_Count;
+ 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;
+ 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;
+ end Dynamic_Info;
+ -- |
+ -- |=====================================================================
+ -- | man page form_win.3x
+ -- |=====================================================================
+ -- |
+ -- |
+ -- |
+ procedure Set_Window (Frm : Form;
+ Win : Window)
+ is
+ function Set_Form_Win (Frm : Form;
+ Win : Window) return C_Int;
+ 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;
+ end Set_Window;
+ -- |
+ -- |
+ -- |
+ function Get_Window (Frm : Form) return Window
+ is
+ function Form_Win (Frm : Form) return Window;
+ pragma Import (C, Form_Win, "form_win");
+
+ W : constant Window := Form_Win (Frm);
+ begin
+ return W;
+ end Get_Window;
+ -- |
+ -- |
+ -- |
+ procedure Set_Sub_Window (Frm : Form;
+ Win : Window)
+ is
+ function Set_Form_Sub (Frm : Form;
+ Win : Window) return C_Int;
+ 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;
+ end Set_Sub_Window;
+ -- |
+ -- |
+ -- |
+ function Get_Sub_Window (Frm : Form) return Window
+ is
+ function Form_Sub (Frm : Form) return Window;
+ pragma Import (C, Form_Sub, "form_sub");
+
+ W : constant Window := Form_Sub (Frm);
+ begin
+ return W;
+ end Get_Sub_Window;
+ -- |
+ -- |
+ -- |
+ procedure Scale (Frm : Form;
+ Lines : out Line_Count;
+ 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;
+ 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);
+ Columns := Column_Count (X);
+ end Scale;
+ -- |
+ -- |=====================================================================
+ -- | man page menu_hook.3x
+ -- |=====================================================================
+ -- |
+ -- |
+ -- |
+ procedure Set_Field_Init_Hook (Frm : Form;
+ Proc : Form_Hook_Function)
+ is
+ function Set_Field_Init (Frm : Form;
+ Proc : Form_Hook_Function) return C_Int;
+ 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;
+ end Set_Field_Init_Hook;
+ -- |
+ -- |
+ -- |
+ procedure Set_Field_Term_Hook (Frm : Form;
+ Proc : Form_Hook_Function)
+ is
+ function Set_Field_Term (Frm : Form;
+ Proc : Form_Hook_Function) return C_Int;
+ 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;
+ end Set_Field_Term_Hook;
+ -- |
+ -- |
+ -- |
+ procedure Set_Form_Init_Hook (Frm : Form;
+ Proc : Form_Hook_Function)
+ is
+ function Set_Form_Init (Frm : Form;
+ Proc : Form_Hook_Function) return C_Int;
+ 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;
+ end Set_Form_Init_Hook;
+ -- |
+ -- |
+ -- |
+ procedure Set_Form_Term_Hook (Frm : Form;
+ Proc : Form_Hook_Function)
+ is
+ function Set_Form_Term (Frm : Form;
+ Proc : Form_Hook_Function) return C_Int;
+ 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;
+ end Set_Form_Term_Hook;
+ -- |
+ -- |=====================================================================
+ -- | man page form_fields.3x
+ -- |=====================================================================
+ -- |
+ -- |
+ -- |
+ procedure Redefine (Frm : Form;
+ Flds : Field_Array_Access)
+ is
+ function Set_Frm_Fields (Frm : Form;
+ Items : System.Address) return C_Int;
+ pragma Import (C, Set_Frm_Fields, "set_form_fields");
+
+ Res : Eti_Error;
+ begin
+ pragma Assert (Flds (Flds'Last) = Null_Field);
+ if Flds (Flds'Last) /= Null_Field then
+ raise Form_Exception;
+ else
+ Res := Set_Frm_Fields (Frm, Flds (Flds'First)'Address);
+ if Res /= E_Ok then
+ Eti_Exception (Res);
+ end if;
+ end if;
+ end Redefine;
+ -- |
+ -- |
+ -- |
+ function Fields (Frm : Form;
+ Index : Positive) return Field
+ is
+ use F_Array;
+
+ function C_Fields (Frm : Form) return Pointer;
+ pragma Import (C, C_Fields, "form_fields");
+
+ P : Pointer := C_Fields (Frm);
+ begin
+ if P = null or else Index > Field_Count (Frm) then
+ raise Form_Exception;
+ else
+ P := P + ptrdiff_t (C_Int (Index) - 1);
+ return P.all;
+ end if;
+ end Fields;
+ -- |
+ -- |
+ -- |
+ function Field_Count (Frm : Form) return Natural
+ is
+ function Count (Frm : Form) return C_Int;
+ pragma Import (C, Count, "field_count");
+ begin
+ return Natural (Count (Frm));
+ end Field_Count;
+ -- |
+ -- |
+ -- |
+ procedure Move (Fld : Field;
+ Line : Line_Position;
+ Column : Column_Position)
+ is
+ function Move (Fld : Field; L, C : C_Int) return C_Int;
+ 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;
+ end Move;
+ -- |
+ -- |=====================================================================
+ -- | man page form_new.3x
+ -- |=====================================================================
+ -- |
+ -- |
+ -- |
+ function Create (Fields : Field_Array_Access) return Form
+ is
+ function NewForm (Fields : System.Address) return Form;
+ pragma Import (C, NewForm, "new_form");
+
+ M : Form;
+ begin
+ pragma Assert (Fields (Fields'Last) = Null_Field);
+ if Fields (Fields'Last) /= Null_Field then
+ raise Form_Exception;
+ else
+ M := NewForm (Fields (Fields'First)'Address);
+ if M = Null_Form then
+ raise Form_Exception;
+ end if;
+ return M;
+ end if;
+ end Create;
+ -- |
+ -- |
+ -- |
+ procedure Delete (Frm : in out Form)
+ is
+ function Free (Frm : Form) return C_Int;
+ pragma Import (C, Free, "free_form");
+
+ Res : constant Eti_Error := Free (Frm);
+ begin
+ if Res /= E_Ok then
+ Eti_Exception (Res);
+ end if;
+ Frm := Null_Form;
+ end Delete;
+ -- |
+ -- |=====================================================================
+ -- | man page form_opts.3x
+ -- |=====================================================================
+ -- |
+ -- |
+ -- |
+ procedure Set_Options (Frm : Form;
+ Options : Form_Option_Set)
+ is
+ function Set_Form_Opts (Frm : Form;
+ Opt : C_Int) return C_Int;
+ 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;
+ end Set_Options;
+ -- |
+ -- |
+ -- |
+ procedure Switch_Options (Frm : Form;
+ Options : Form_Option_Set;
+ On : Boolean := True)
+ is
+ function Form_Opts_On (Frm : Form;
+ Opt : C_Int) return C_Int;
+ pragma Import (C, Form_Opts_On, "form_opts_on");
+ function Form_Opts_Off (Frm : Form;
+ Opt : C_Int) return C_Int;
+ 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);
+ else
+ Err := Form_Opts_Off (Frm, Opt);
+ end if;
+ if Err /= E_Ok then
+ Eti_Exception (Err);
+ end if;
+ end Switch_Options;
+ -- |
+ -- |
+ -- |
+ procedure Get_Options (Frm : Form;
+ Options : out Form_Option_Set)
+ is
+ function Form_Opts (Frm : Form) return C_Int;
+ pragma Import (C, Form_Opts, "form_opts");
+
+ Res : constant C_Int := Form_Opts (Frm);
+ begin
+ Options := CInt_2_FrmOS (Res);
+ end Get_Options;
+ -- |
+ -- |
+ -- |
+ function Get_Options (Frm : Form := Null_Form) return Form_Option_Set
+ is
+ Fos : Form_Option_Set;
+ begin
+ Get_Options (Frm, Fos);
+ return Fos;
+ end Get_Options;
+ -- |
+ -- |=====================================================================
+ -- | man page form_post.3x
+ -- |=====================================================================
+ -- |
+ -- |
+ -- |
+ procedure Post (Frm : Form;
+ Post : Boolean := True)
+ is
+ function M_Post (Frm : Form) return C_Int;
+ pragma Import (C, M_Post, "post_form");
+ function M_Unpost (Frm : Form) return C_Int;
+ pragma Import (C, M_Unpost, "unpost_form");
+
+ Res : Eti_Error;
+ begin
+ if Post then
+ Res := M_Post (Frm);
+ else
+ Res := M_Unpost (Frm);
+ end if;
+ if Res /= E_Ok then
+ Eti_Exception (Res);
+ end if;
+ end Post;
+ -- |
+ -- |=====================================================================
+ -- | man page form_cursor.3x
+ -- |=====================================================================
+ -- |
+ -- |
+ -- |
+ procedure Position_Cursor (Frm : Form)
+ is
+ function Pos_Form_Cursor (Frm : Form) return C_Int;
+ 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;
+ end Position_Cursor;
+ -- |
+ -- |=====================================================================
+ -- | man page form_data.3x
+ -- |=====================================================================
+ -- |
+ -- |
+ -- |
+ function Data_Ahead (Frm : Form) return Boolean
+ is
+ function Ahead (Frm : Form) return C_Int;
+ pragma Import (C, Ahead, "data_ahead");
+
+ Res : constant C_Int := Ahead (Frm);
+ begin
+ if Res = Curses_False then
+ return False;
+ else
+ return True;
+ end if;
+ end Data_Ahead;
+ -- |
+ -- |
+ -- |
+ function Data_Behind (Frm : Form) return Boolean
+ is
+ function Behind (Frm : Form) return C_Int;
+ pragma Import (C, Behind, "data_behind");
+
+ Res : constant C_Int := Behind (Frm);
+ begin
+ if Res = Curses_False then
+ return False;
+ else
+ return True;
+ end if;
+ end Data_Behind;
+ -- |
+ -- |=====================================================================
+ -- | man page form_driver.3x
+ -- |=====================================================================
+ -- |
+ -- |
+ -- |
+ function Driver (Frm : Form;
+ Key : Key_Code) return Driver_Result
+ is
+ function Frm_Driver (Frm : Form; Key : C_Int) return C_Int;
+ 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
+ return Unknown_Request;
+ elsif R = E_Invalid_Field then
+ return Invalid_Field;
+ elsif R = E_Request_Denied then
+ return Request_Denied;
+ else
+ Eti_Exception (R);
+ return Form_Ok;
+ end if;
+ else
+ return Form_Ok;
+ end if;
+ end Driver;
+ -- |
+ -- |=====================================================================
+ -- | man page form_page.3x
+ -- |=====================================================================
+ -- |
+ -- |
+ -- |
+ procedure Set_Current (Frm : Form;
+ Fld : Field)
+ is
+ function Set_Current_Fld (Frm : Form; Fld : Field) return C_Int;
+ 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;
+ end Set_Current;
+ -- |
+ -- |
+ -- |
+ function Current (Frm : Form) return Field
+ is
+ function Current_Fld (Frm : Form) return Field;
+ pragma Import (C, Current_Fld, "current_field");
+
+ Fld : constant Field := Current_Fld (Frm);
+ begin
+ if Fld = Null_Field then
+ raise Form_Exception;
+ end if;
+ return Fld;
+ end Current;
+ -- |
+ -- |
+ -- |
+ procedure Set_Page (Frm : Form;
+ Page : Page_Number := Page_Number'First)
+ is
+ function Set_Frm_Page (Frm : Form; Pg : C_Int) return C_Int;
+ 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;
+ end Set_Page;
+ -- |
+ -- |
+ -- |
+ function Page (Frm : Form) return Page_Number
+ is
+ function Get_Page (Frm : Form) return C_Int;
+ pragma Import (C, Get_Page, "form_page");
+
+ P : constant C_Int := Get_Page (Frm);
+ begin
+ if P < 0 then
+ raise Form_Exception;
+ else
+ return Page_Number (P);
+ end if;
+ end Page;
+
+ function Get_Index (Fld : Field) return Positive
+ is
+ function Get_Fieldindex (Fld : Field) return C_Int;
+ pragma Import (C, Get_Fieldindex, "field_index");
+
+ Res : constant C_Int := Get_Fieldindex (Fld);
+ begin
+ if Res = Curses_Err then
+ raise Form_Exception;
+ end if;
+ return Positive (Natural (Res) + Positive'First);
+ end Get_Index;
+
+ -- |
+ -- |=====================================================================
+ -- | man page form_new_page.3x
+ -- |=====================================================================
+ -- |
+ -- |
+ -- |
+ procedure Set_New_Page (Fld : Field;
+ New_Page : Boolean := True)
+ is
+ function Set_Page (Fld : Field; Flg : C_Int) return C_Int;
+ 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;
+ end Set_New_Page;
+ -- |
+ -- |
+ -- |
+ function Is_New_Page (Fld : Field) return Boolean
+ is
+ function Is_New (Fld : Field) return C_Int;
+ pragma Import (C, Is_New, "new_page");
+
+ Res : constant C_Int := Is_New (Fld);
+ begin
+ if Res = Curses_False then
+ return False;
+ else
+ return True;
+ end if;
+ end Is_New_Page;
+
+ procedure Free (FA : in out Field_Array_Access;
+ Free_Fields : Boolean := False)
+ is
+ procedure Release is new Ada.Unchecked_Deallocation
+ (Field_Array, Field_Array_Access);
+ begin
+ if FA /= null and then Free_Fields then
+ for I in FA'First .. (FA'Last - 1) loop
+ if FA (I) /= Null_Field then
+ Delete (FA (I));
+ end if;
+ end loop;
+ end if;
+ Release (FA);
+ end Free;
+
+ -- |=====================================================================
+
+ function Default_Field_Options return Field_Option_Set
+ is
+ begin
+ return Get_Options (Null_Field);
+ end Default_Field_Options;
+
+ function Default_Form_Options return Form_Option_Set
+ is
+ begin
+ return Get_Options (Null_Form);
+ end Default_Form_Options;
+
+end Terminal_Interface.Curses.Forms;
diff --git a/Ada95/src/terminal_interface-curses-menus-item_user_data.adb b/Ada95/src/terminal_interface-curses-menus-item_user_data.adb
new file mode 100644
index 000000000000..eb06d096dfb2
--- /dev/null
+++ b/Ada95/src/terminal_interface-curses-menus-item_user_data.adb
@@ -0,0 +1,77 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding --
+-- --
+-- Terminal_Interface.Curses.Menus.Item_User_Data --
+-- --
+-- B O D Y --
+-- --
+------------------------------------------------------------------------------
+-- Copyright (c) 1998-2003,2009 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: Juergen Pfeifer, 1996
+-- Version Control:
+-- $Revision: 1.12 $
+-- 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;
+ 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;
+ end Set_User_Data;
+
+ function Get_User_Data (Itm : Item) return User_Access
+ is
+ function Item_Userptr (Itm : Item) return User_Access;
+ pragma Import (C, Item_Userptr, "item_userptr");
+ begin
+ return Item_Userptr (Itm);
+ end Get_User_Data;
+
+ procedure Get_User_Data (Itm : Item;
+ Data : out User_Access)
+ is
+ begin
+ Data := Get_User_Data (Itm);
+ end Get_User_Data;
+
+end Terminal_Interface.Curses.Menus.Item_User_Data;
diff --git a/Ada95/src/terminal_interface-curses-menus-menu_user_data.adb b/Ada95/src/terminal_interface-curses-menus-menu_user_data.adb
new file mode 100644
index 000000000000..7d66a8c052ee
--- /dev/null
+++ b/Ada95/src/terminal_interface-curses-menus-menu_user_data.adb
@@ -0,0 +1,76 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding --
+-- --
+-- Terminal_Interface.Curses.Menus.Menu_User_Data --
+-- --
+-- B O D Y --
+-- --
+------------------------------------------------------------------------------
+-- Copyright (c) 1998-2003,2009 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: Juergen Pfeifer, 1996
+-- Version Control:
+-- $Revision: 1.13 $
+-- 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;
+ 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;
+ end Set_User_Data;
+
+ function Get_User_Data (Men : Menu) return User_Access
+ is
+ function Menu_Userptr (Men : Menu) return User_Access;
+ pragma Import (C, Menu_Userptr, "menu_userptr");
+ begin
+ return Menu_Userptr (Men);
+ end Get_User_Data;
+
+ procedure Get_User_Data (Men : Menu;
+ Data : out User_Access)
+ is
+ begin
+ Data := Get_User_Data (Men);
+ end Get_User_Data;
+
+end Terminal_Interface.Curses.Menus.Menu_User_Data;
diff --git a/Ada95/src/terminal_interface-curses-menus.adb b/Ada95/src/terminal_interface-curses-menus.adb
new file mode 100644
index 000000000000..9fce6de6d9fa
--- /dev/null
+++ b/Ada95/src/terminal_interface-curses-menus.adb
@@ -0,0 +1,1022 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding --
+-- --
+-- Terminal_Interface.Curses.Menus --
+-- --
+-- B O D Y --
+-- --
+------------------------------------------------------------------------------
+-- Copyright (c) 1998-2008,2009 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: Juergen Pfeifer, 1996
+-- Version Control:
+-- $Revision: 1.27 $
+-- $Date: 2009/12/26 17:38:58 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+with Ada.Unchecked_Deallocation;
+with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux;
+
+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)
+ is
+ function Request_Name (Key : C_Int) return chars_ptr;
+ pragma Import (C, Request_Name, "menu_request_name");
+ begin
+ Fill_String (Request_Name (C_Int (Key)), Name);
+ end Request_Name;
+
+ function Request_Name (Key : Menu_Request_Code) return String
+ is
+ function Request_Name (Key : C_Int) return chars_ptr;
+ pragma Import (C, Request_Name, "menu_request_name");
+ begin
+ return Fill_String (Request_Name (C_Int (Key)));
+ end Request_Name;
+
+ function Create (Name : String;
+ Description : String := "") return Item
+ is
+ type Char_Ptr is access all Interfaces.C.char;
+ function Newitem (Name, Desc : Char_Ptr) return Item;
+ pragma Import (C, Newitem, "new_item");
+
+ type Name_String is new char_array (0 .. Name'Length);
+ type Name_String_Ptr is access Name_String;
+ pragma Controlled (Name_String_Ptr);
+
+ type Desc_String is new char_array (0 .. Description'Length);
+ type Desc_String_Ptr is access Desc_String;
+ pragma Controlled (Desc_String_Ptr);
+
+ Name_Str : constant Name_String_Ptr := new Name_String;
+ Desc_Str : constant Desc_String_Ptr := new Desc_String;
+ Name_Len, Desc_Len : size_t;
+ Result : Item;
+ begin
+ To_C (Name, Name_Str.all, Name_Len);
+ To_C (Description, Desc_Str.all, Desc_Len);
+ Result := Newitem (Name_Str.all (Name_Str.all'First)'Access,
+ Desc_Str.all (Desc_Str.all'First)'Access);
+ if Result = Null_Item then
+ raise Eti_System_Error;
+ end if;
+ return Result;
+ end Create;
+
+ procedure Delete (Itm : in out Item)
+ is
+ function Descname (Itm : Item) return chars_ptr;
+ pragma Import (C, Descname, "item_description");
+ function Itemname (Itm : Item) return chars_ptr;
+ pragma Import (C, Itemname, "item_name");
+
+ function Freeitem (Itm : Item) return C_Int;
+ pragma Import (C, Freeitem, "free_item");
+
+ Res : Eti_Error;
+ Ptr : chars_ptr;
+ begin
+ Ptr := Descname (Itm);
+ if Ptr /= Null_Ptr then
+ Interfaces.C.Strings.Free (Ptr);
+ end if;
+ Ptr := Itemname (Itm);
+ 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;
+ Itm := Null_Item;
+ end Delete;
+-------------------------------------------------------------------------------
+ procedure Set_Value (Itm : Item;
+ Value : Boolean := True)
+ is
+ function Set_Item_Val (Itm : Item;
+ Val : C_Int) return C_Int;
+ 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;
+ end Set_Value;
+
+ function Value (Itm : Item) return Boolean
+ is
+ function Item_Val (Itm : Item) return C_Int;
+ pragma Import (C, Item_Val, "item_value");
+ begin
+ if Item_Val (Itm) = Curses_False then
+ return False;
+ else
+ return True;
+ end if;
+ end Value;
+
+-------------------------------------------------------------------------------
+ function Visible (Itm : Item) return Boolean
+ is
+ function Item_Vis (Itm : Item) return C_Int;
+ pragma Import (C, Item_Vis, "item_visible");
+ begin
+ if Item_Vis (Itm) = Curses_False then
+ return False;
+ else
+ return True;
+ end if;
+ end Visible;
+-------------------------------------------------------------------------------
+ procedure Set_Options (Itm : Item;
+ Options : Item_Option_Set)
+ is
+ function Set_Item_Opts (Itm : Item;
+ Opt : C_Int) return C_Int;
+ 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;
+ end Set_Options;
+
+ procedure Switch_Options (Itm : Item;
+ Options : Item_Option_Set;
+ On : Boolean := True)
+ is
+ function Item_Opts_On (Itm : Item;
+ Opt : C_Int) return C_Int;
+ pragma Import (C, Item_Opts_On, "item_opts_on");
+ function Item_Opts_Off (Itm : Item;
+ Opt : C_Int) return C_Int;
+ 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);
+ else
+ Err := Item_Opts_Off (Itm, Opt);
+ end if;
+ if Err /= E_Ok then
+ Eti_Exception (Err);
+ end if;
+ end Switch_Options;
+
+ procedure Get_Options (Itm : Item;
+ Options : out Item_Option_Set)
+ is
+ function Item_Opts (Itm : Item) return C_Int;
+ pragma Import (C, Item_Opts, "item_opts");
+
+ Res : constant C_Int := Item_Opts (Itm);
+ begin
+ Options := CInt_2_IOS (Res);
+ end Get_Options;
+
+ function Get_Options (Itm : Item := Null_Item) return Item_Option_Set
+ is
+ Ios : Item_Option_Set;
+ begin
+ Get_Options (Itm, Ios);
+ return Ios;
+ end Get_Options;
+-------------------------------------------------------------------------------
+ procedure Name (Itm : Item;
+ Name : out String)
+ is
+ function Itemname (Itm : Item) return chars_ptr;
+ pragma Import (C, Itemname, "item_name");
+ begin
+ Fill_String (Itemname (Itm), Name);
+ end Name;
+
+ function Name (Itm : Item) return String
+ is
+ function Itemname (Itm : Item) return chars_ptr;
+ pragma Import (C, Itemname, "item_name");
+ begin
+ return Fill_String (Itemname (Itm));
+ end Name;
+
+ procedure Description (Itm : Item;
+ Description : out String)
+ is
+ function Descname (Itm : Item) return chars_ptr;
+ pragma Import (C, Descname, "item_description");
+ begin
+ Fill_String (Descname (Itm), Description);
+ end Description;
+
+ function Description (Itm : Item) return String
+ is
+ function Descname (Itm : Item) return chars_ptr;
+ pragma Import (C, Descname, "item_description");
+ begin
+ return Fill_String (Descname (Itm));
+ end Description;
+-------------------------------------------------------------------------------
+ procedure Set_Current (Men : Menu;
+ Itm : Item)
+ is
+ function Set_Curr_Item (Men : Menu;
+ Itm : Item) return C_Int;
+ 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;
+ end Set_Current;
+
+ function Current (Men : Menu) return Item
+ is
+ function Curr_Item (Men : Menu) return Item;
+ pragma Import (C, Curr_Item, "current_item");
+
+ Res : constant Item := Curr_Item (Men);
+ begin
+ if Res = Null_Item then
+ raise Menu_Exception;
+ end if;
+ return Res;
+ end Current;
+
+ procedure Set_Top_Row (Men : Menu;
+ Line : Line_Position)
+ is
+ function Set_Toprow (Men : Menu;
+ Line : C_Int) return C_Int;
+ 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;
+ end Set_Top_Row;
+
+ function Top_Row (Men : Menu) return Line_Position
+ is
+ function Toprow (Men : Menu) return C_Int;
+ pragma Import (C, Toprow, "top_row");
+
+ Res : constant C_Int := Toprow (Men);
+ begin
+ if Res = Curses_Err then
+ raise Menu_Exception;
+ end if;
+ return Line_Position (Res);
+ end Top_Row;
+
+ function Get_Index (Itm : Item) return Positive
+ is
+ function Get_Itemindex (Itm : Item) return C_Int;
+ pragma Import (C, Get_Itemindex, "item_index");
+
+ Res : constant C_Int := Get_Itemindex (Itm);
+ begin
+ if Res = Curses_Err then
+ raise Menu_Exception;
+ end if;
+ return Positive (Natural (Res) + Positive'First);
+ end Get_Index;
+-------------------------------------------------------------------------------
+ procedure Post (Men : Menu;
+ Post : Boolean := True)
+ is
+ function M_Post (Men : Menu) return C_Int;
+ pragma Import (C, M_Post, "post_menu");
+ function M_Unpost (Men : Menu) return C_Int;
+ pragma Import (C, M_Unpost, "unpost_menu");
+
+ Res : Eti_Error;
+ begin
+ if Post then
+ Res := M_Post (Men);
+ else
+ Res := M_Unpost (Men);
+ end if;
+ if Res /= E_Ok then
+ Eti_Exception (Res);
+ end if;
+ end Post;
+-------------------------------------------------------------------------------
+ procedure Set_Options (Men : Menu;
+ Options : Menu_Option_Set)
+ is
+ function Set_Menu_Opts (Men : Menu;
+ Opt : C_Int) return C_Int;
+ 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;
+ end Set_Options;
+
+ procedure Switch_Options (Men : Menu;
+ Options : Menu_Option_Set;
+ On : Boolean := True)
+ is
+ function Menu_Opts_On (Men : Menu;
+ Opt : C_Int) return C_Int;
+ pragma Import (C, Menu_Opts_On, "menu_opts_on");
+ function Menu_Opts_Off (Men : Menu;
+ Opt : C_Int) return C_Int;
+ 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);
+ else
+ Err := Menu_Opts_Off (Men, Opt);
+ end if;
+ if Err /= E_Ok then
+ Eti_Exception (Err);
+ end if;
+ end Switch_Options;
+
+ procedure Get_Options (Men : Menu;
+ Options : out Menu_Option_Set)
+ is
+ function Menu_Opts (Men : Menu) return C_Int;
+ pragma Import (C, Menu_Opts, "menu_opts");
+
+ Res : constant C_Int := Menu_Opts (Men);
+ begin
+ Options := CInt_2_MOS (Res);
+ end Get_Options;
+
+ function Get_Options (Men : Menu := Null_Menu) return Menu_Option_Set
+ is
+ Mos : Menu_Option_Set;
+ begin
+ Get_Options (Men, Mos);
+ return Mos;
+ end Get_Options;
+-------------------------------------------------------------------------------
+ procedure Set_Window (Men : Menu;
+ Win : Window)
+ is
+ function Set_Menu_Win (Men : Menu;
+ Win : Window) return C_Int;
+ 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;
+ end Set_Window;
+
+ function Get_Window (Men : Menu) return Window
+ is
+ function Menu_Win (Men : Menu) return Window;
+ pragma Import (C, Menu_Win, "menu_win");
+
+ W : constant Window := Menu_Win (Men);
+ begin
+ return W;
+ end Get_Window;
+
+ procedure Set_Sub_Window (Men : Menu;
+ Win : Window)
+ is
+ function Set_Menu_Sub (Men : Menu;
+ Win : Window) return C_Int;
+ 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;
+ end Set_Sub_Window;
+
+ function Get_Sub_Window (Men : Menu) return Window
+ is
+ function Menu_Sub (Men : Menu) return Window;
+ pragma Import (C, Menu_Sub, "menu_sub");
+
+ W : constant Window := Menu_Sub (Men);
+ begin
+ return W;
+ end Get_Sub_Window;
+
+ procedure Scale (Men : Menu;
+ Lines : out Line_Count;
+ Columns : out Column_Count)
+ is
+ type C_Int_Access is access all C_Int;
+ function M_Scale (Men : Menu;
+ Yp, Xp : C_Int_Access) return C_Int;
+ 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;
+ 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;
+ 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;
+ end Position_Cursor;
+
+-------------------------------------------------------------------------------
+ procedure Set_Mark (Men : Menu;
+ Mark : String)
+ is
+ type Char_Ptr is access all Interfaces.C.char;
+ function Set_Mark (Men : Menu;
+ Mark : Char_Ptr) return C_Int;
+ 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;
+ end Set_Mark;
+
+ procedure Mark (Men : Menu;
+ Mark : out String)
+ is
+ function Get_Menu_Mark (Men : Menu) return chars_ptr;
+ pragma Import (C, Get_Menu_Mark, "menu_mark");
+ begin
+ Fill_String (Get_Menu_Mark (Men), Mark);
+ end Mark;
+
+ function Mark (Men : Menu) return String
+ is
+ function Get_Menu_Mark (Men : Menu) return chars_ptr;
+ pragma Import (C, Get_Menu_Mark, "menu_mark");
+ begin
+ return Fill_String (Get_Menu_Mark (Men));
+ end Mark;
+
+-------------------------------------------------------------------------------
+ procedure Set_Foreground
+ (Men : Menu;
+ Fore : Character_Attribute_Set := Normal_Video;
+ Color : Color_Pair := Color_Pair'First)
+ is
+ function Set_Menu_Fore (Men : Menu;
+ Attr : C_Chtype) return C_Int;
+ 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;
+ end Set_Foreground;
+
+ procedure Foreground (Men : Menu;
+ Fore : out Character_Attribute_Set)
+ is
+ function Menu_Fore (Men : Menu) return C_Chtype;
+ pragma Import (C, Menu_Fore, "menu_fore");
+ begin
+ Fore := Chtype_To_AttrChar (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;
+ pragma Import (C, Menu_Fore, "menu_fore");
+ begin
+ Fore := Chtype_To_AttrChar (Menu_Fore (Men)).Attr;
+ Color := Chtype_To_AttrChar (Menu_Fore (Men)).Color;
+ end Foreground;
+
+ procedure Set_Background
+ (Men : Menu;
+ Back : Character_Attribute_Set := Normal_Video;
+ Color : Color_Pair := Color_Pair'First)
+ is
+ function Set_Menu_Back (Men : Menu;
+ Attr : C_Chtype) return C_Int;
+ 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;
+ end Set_Background;
+
+ procedure Background (Men : Menu;
+ Back : out Character_Attribute_Set)
+ is
+ function Menu_Back (Men : Menu) return C_Chtype;
+ pragma Import (C, Menu_Back, "menu_back");
+ begin
+ Back := Chtype_To_AttrChar (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;
+ pragma Import (C, Menu_Back, "menu_back");
+ begin
+ Back := Chtype_To_AttrChar (Menu_Back (Men)).Attr;
+ Color := Chtype_To_AttrChar (Menu_Back (Men)).Color;
+ end Background;
+
+ procedure Set_Grey (Men : Menu;
+ Grey : Character_Attribute_Set := Normal_Video;
+ Color : Color_Pair := Color_Pair'First)
+ is
+ function Set_Menu_Grey (Men : Menu;
+ Attr : C_Chtype) return C_Int;
+ 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;
+ end Set_Grey;
+
+ procedure Grey (Men : Menu;
+ Grey : out Character_Attribute_Set)
+ is
+ function Menu_Grey (Men : Menu) return C_Chtype;
+ pragma Import (C, Menu_Grey, "menu_grey");
+ begin
+ Grey := Chtype_To_AttrChar (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;
+ pragma Import (C, Menu_Grey, "menu_grey");
+ begin
+ Grey := Chtype_To_AttrChar (Menu_Grey (Men)).Attr;
+ Color := Chtype_To_AttrChar (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;
+ 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;
+ end Set_Pad_Character;
+
+ procedure Pad_Character (Men : Menu;
+ Pad : out Character)
+ is
+ function Menu_Pad (Men : Menu) return C_Int;
+ pragma Import (C, Menu_Pad, "menu_pad");
+ begin
+ Pad := Character'Val (Menu_Pad (Men));
+ end Pad_Character;
+-------------------------------------------------------------------------------
+ procedure Set_Spacing (Men : Menu;
+ Descr : Column_Position := 0;
+ Row : Line_Position := 0;
+ Col : Column_Position := 0)
+ is
+ function Set_Spacing (Men : Menu;
+ D, R, C : C_Int) return C_Int;
+ 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;
+ end Set_Spacing;
+
+ procedure Spacing (Men : Menu;
+ Descr : out Column_Position;
+ Row : out Line_Position;
+ Col : out Column_Position)
+ is
+ type C_Int_Access is access all C_Int;
+ function Get_Spacing (Men : Menu;
+ D, R, C : C_Int_Access) return C_Int;
+ 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;
+ end Spacing;
+-------------------------------------------------------------------------------
+ function Set_Pattern (Men : Menu;
+ Text : String) return Boolean
+ is
+ type Char_Ptr is access all Interfaces.C.char;
+ function Set_Pattern (Men : Menu;
+ Pattern : Char_Ptr) return C_Int;
+ pragma Import (C, Set_Pattern, "set_menu_pattern");
+
+ S : char_array (0 .. Text'Length);
+ L : size_t;
+ Res : Eti_Error;
+ begin
+ 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 others =>
+ Eti_Exception (Res);
+ return False;
+ end case;
+ end Set_Pattern;
+
+ procedure Pattern (Men : Menu;
+ Text : out String)
+ is
+ function Get_Pattern (Men : Menu) return chars_ptr;
+ pragma Import (C, Get_Pattern, "menu_pattern");
+ begin
+ Fill_String (Get_Pattern (Men), Text);
+ end Pattern;
+-------------------------------------------------------------------------------
+ procedure Set_Format (Men : Menu;
+ Lines : Line_Count;
+ Columns : Column_Count)
+ is
+ function Set_Menu_Fmt (Men : Menu;
+ Lin : C_Int;
+ Col : C_Int) return C_Int;
+ 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;
+ end Set_Format;
+
+ procedure Format (Men : Menu;
+ Lines : out Line_Count;
+ Columns : out Column_Count)
+ is
+ type C_Int_Access is access all C_Int;
+ function Menu_Fmt (Men : Menu;
+ Y, X : C_Int_Access) return C_Int;
+ 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;
+ 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;
+ 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;
+ 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;
+ 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;
+ 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;
+ 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;
+ 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;
+ 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;
+ end Set_Menu_Term_Hook;
+
+ function Get_Item_Init_Hook (Men : Menu) return Menu_Hook_Function
+ is
+ function Item_Init (Men : Menu) return Menu_Hook_Function;
+ pragma Import (C, Item_Init, "item_init");
+ begin
+ return Item_Init (Men);
+ end Get_Item_Init_Hook;
+
+ function Get_Item_Term_Hook (Men : Menu) return Menu_Hook_Function
+ is
+ function Item_Term (Men : Menu) return Menu_Hook_Function;
+ pragma Import (C, Item_Term, "item_term");
+ begin
+ return Item_Term (Men);
+ end Get_Item_Term_Hook;
+
+ function Get_Menu_Init_Hook (Men : Menu) return Menu_Hook_Function
+ is
+ function Menu_Init (Men : Menu) return Menu_Hook_Function;
+ pragma Import (C, Menu_Init, "menu_init");
+ begin
+ return Menu_Init (Men);
+ end Get_Menu_Init_Hook;
+
+ function Get_Menu_Term_Hook (Men : Menu) return Menu_Hook_Function
+ is
+ function Menu_Term (Men : Menu) return Menu_Hook_Function;
+ pragma Import (C, Menu_Term, "menu_term");
+ begin
+ return Menu_Term (Men);
+ end Get_Menu_Term_Hook;
+-------------------------------------------------------------------------------
+ procedure Redefine (Men : Menu;
+ Items : Item_Array_Access)
+ is
+ function Set_Items (Men : Menu;
+ Items : System.Address) return C_Int;
+ pragma Import (C, Set_Items, "set_menu_items");
+
+ Res : Eti_Error;
+ begin
+ pragma Assert (Items (Items'Last) = Null_Item);
+ if Items (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;
+ end if;
+ end Redefine;
+
+ function Item_Count (Men : Menu) return Natural
+ is
+ function Count (Men : Menu) return C_Int;
+ pragma Import (C, Count, "item_count");
+ begin
+ return Natural (Count (Men));
+ end Item_Count;
+
+ function Items (Men : Menu;
+ Index : Positive) return Item
+ is
+ use I_Array;
+
+ function C_Mitems (Men : Menu) return Pointer;
+ pragma Import (C, C_Mitems, "menu_items");
+
+ P : Pointer := C_Mitems (Men);
+ begin
+ if P = null or else Index > Item_Count (Men) then
+ raise Menu_Exception;
+ else
+ P := P + ptrdiff_t (C_Int (Index) - 1);
+ return P.all;
+ end if;
+ end Items;
+
+-------------------------------------------------------------------------------
+ function Create (Items : Item_Array_Access) return Menu
+ is
+ function Newmenu (Items : System.Address) return Menu;
+ pragma Import (C, Newmenu, "new_menu");
+
+ M : Menu;
+ begin
+ pragma Assert (Items (Items'Last) = Null_Item);
+ if Items (Items'Last) /= Null_Item then
+ raise Menu_Exception;
+ else
+ M := Newmenu (Items.all'Address);
+ if M = Null_Menu then
+ raise Menu_Exception;
+ end if;
+ return M;
+ end if;
+ end Create;
+
+ procedure Delete (Men : in out Menu)
+ is
+ function Free (Men : Menu) return C_Int;
+ pragma Import (C, Free, "free_menu");
+
+ Res : constant Eti_Error := Free (Men);
+ begin
+ if Res /= E_Ok then
+ Eti_Exception (Res);
+ end if;
+ Men := Null_Menu;
+ end Delete;
+
+------------------------------------------------------------------------------
+ function Driver (Men : Menu;
+ Key : Key_Code) return Driver_Result
+ is
+ function Driver (Men : Menu;
+ Key : C_Int) return C_Int;
+ 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;
+ end Driver;
+
+ procedure Free (IA : in out Item_Array_Access;
+ Free_Items : Boolean := False)
+ is
+ procedure Release is new Ada.Unchecked_Deallocation
+ (Item_Array, Item_Array_Access);
+ begin
+ if IA /= null and then Free_Items then
+ for I in IA'First .. (IA'Last - 1) loop
+ if IA (I) /= Null_Item then
+ Delete (IA (I));
+ end if;
+ end loop;
+ end if;
+ Release (IA);
+ end Free;
+
+-------------------------------------------------------------------------------
+ function Default_Menu_Options return Menu_Option_Set
+ is
+ begin
+ return Get_Options (Null_Menu);
+ end Default_Menu_Options;
+
+ function Default_Item_Options return Item_Option_Set
+ is
+ begin
+ return Get_Options (Null_Item);
+ end Default_Item_Options;
+-------------------------------------------------------------------------------
+
+end Terminal_Interface.Curses.Menus;
diff --git a/Ada95/src/terminal_interface-curses-mouse.adb b/Ada95/src/terminal_interface-curses-mouse.adb
new file mode 100644
index 000000000000..9b4032639308
--- /dev/null
+++ b/Ada95/src/terminal_interface-curses-mouse.adb
@@ -0,0 +1,217 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding --
+-- --
+-- Terminal_Interface.Curses.Mouse --
+-- --
+-- B O D Y --
+-- --
+------------------------------------------------------------------------------
+-- Copyright (c) 1998-2008,2009 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: Juergen Pfeifer, 1996
+-- Version Control:
+-- $Revision: 1.24 $
+-- $Date: 2009/12/26 17:38:58 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux;
+with Interfaces.C; use Interfaces.C;
+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;
+ pragma Import (C, Mouse_Avail, "has_mouse");
+ begin
+ if Has_Key (Key_Mouse) or else Mouse_Avail /= 0 then
+ return True;
+ else
+ return False;
+ end if;
+ end Has_Mouse;
+
+ function Get_Mouse return Mouse_Event
+ is
+ type Event_Access is access all Mouse_Event;
+
+ function Getmouse (Ev : Event_Access) return C_Int;
+ pragma Import (C, Getmouse, "getmouse");
+
+ Event : aliased Mouse_Event;
+ begin
+ if Getmouse (Event'Access) = Curses_Err then
+ raise Curses_Exception;
+ end if;
+ return Event;
+ end Get_Mouse;
+
+ procedure Register_Reportable_Event (Button : Mouse_Button;
+ State : Button_State;
+ Mask : in out Event_Mask)
+ is
+ Button_Nr : constant Natural := Mouse_Button'Pos (Button);
+ State_Nr : constant Natural := Button_State'Pos (State);
+ begin
+ if Button in Modifier_Keys and then State /= Pressed then
+ raise Curses_Exception;
+ else
+ if Button in Real_Buttons then
+ Mask := Mask or ((2 ** (6 * Button_Nr)) ** State_Nr);
+ else
+ Mask := Mask or (BUTTON_CTRL ** (Button_Nr - 4));
+ end if;
+ end if;
+ end Register_Reportable_Event;
+
+ procedure Register_Reportable_Events (Button : Mouse_Button;
+ State : Button_States;
+ Mask : in out Event_Mask)
+ is
+ begin
+ for S in Button_States'Range loop
+ if State (S) then
+ Register_Reportable_Event (Button, S, Mask);
+ end if;
+ end loop;
+ end Register_Reportable_Events;
+
+ function Start_Mouse (Mask : Event_Mask := All_Events)
+ return Event_Mask
+ is
+ function MMask (M : Event_Mask;
+ O : access Event_Mask) return Event_Mask;
+ pragma Import (C, MMask, "mousemask");
+ R : Event_Mask;
+ Old : aliased Event_Mask;
+ begin
+ R := MMask (Mask, Old'Access);
+ if R = No_Events then
+ Beep;
+ end if;
+ return Old;
+ end Start_Mouse;
+
+ procedure End_Mouse (Mask : Event_Mask := No_Events)
+ is
+ begin
+ if Mask /= No_Events then
+ Beep;
+ end if;
+ end End_Mouse;
+
+ procedure Dispatch_Event (Mask : Event_Mask;
+ Button : out Mouse_Button;
+ State : out Button_State);
+
+ procedure Dispatch_Event (Mask : Event_Mask;
+ Button : out Mouse_Button;
+ State : out Button_State) is
+ L : Event_Mask;
+ begin
+ Button := Alt; -- preset to non real button;
+ if (Mask and BUTTON1_EVENTS) /= 0 then
+ Button := Left;
+ elsif (Mask and BUTTON2_EVENTS) /= 0 then
+ Button := Middle;
+ elsif (Mask and BUTTON3_EVENTS) /= 0 then
+ Button := Right;
+ elsif (Mask and BUTTON4_EVENTS) /= 0 then
+ Button := Button4;
+ end if;
+ if Button in Real_Buttons then
+ L := 2 ** (6 * Mouse_Button'Pos (Button));
+ for I in Button_State'Range loop
+ if (Mask and L) /= 0 then
+ State := I;
+ exit;
+ end if;
+ L := 2 * L;
+ end loop;
+ else
+ State := Pressed;
+ if (Mask and BUTTON_CTRL) /= 0 then
+ Button := Control;
+ elsif (Mask and BUTTON_SHIFT) /= 0 then
+ Button := Shift;
+ elsif (Mask and BUTTON_ALT) /= 0 then
+ Button := Alt;
+ end if;
+ end if;
+ end Dispatch_Event;
+
+ procedure Get_Event (Event : Mouse_Event;
+ Y : out Line_Position;
+ X : out Column_Position;
+ Button : out Mouse_Button;
+ State : out Button_State)
+ is
+ Mask : constant Event_Mask := Event.Bstate;
+ begin
+ X := Column_Position (Event.X);
+ Y := Line_Position (Event.Y);
+ Dispatch_Event (Mask, Button, State);
+ end Get_Event;
+
+ procedure Unget_Mouse (Event : Mouse_Event)
+ is
+ function Ungetmouse (Ev : Mouse_Event) return C_Int;
+ pragma Import (C, Ungetmouse, "ungetmouse");
+ begin
+ if Ungetmouse (Event) = Curses_Err then
+ raise Curses_Exception;
+ end if;
+ end Unget_Mouse;
+
+ function Enclosed_In_Window (Win : Window := Standard_Window;
+ Event : Mouse_Event) return Boolean
+ is
+ function Wenclose (Win : Window; Y : C_Int; X : C_Int)
+ return Curses_Bool;
+ pragma Import (C, Wenclose, "wenclose");
+ begin
+ if Wenclose (Win, C_Int (Event.Y), C_Int (Event.X))
+ = Curses_Bool_False then
+ return False;
+ else
+ return True;
+ end if;
+ end Enclosed_In_Window;
+
+ function Mouse_Interval (Msec : Natural := 200) return Natural
+ is
+ function Mouseinterval (Msec : C_Int) return C_Int;
+ pragma Import (C, Mouseinterval, "mouseinterval");
+ begin
+ return Natural (Mouseinterval (C_Int (Msec)));
+ end Mouse_Interval;
+
+end Terminal_Interface.Curses.Mouse;
diff --git a/Ada95/src/terminal_interface-curses-panels-user_data.adb b/Ada95/src/terminal_interface-curses-panels-user_data.adb
new file mode 100644
index 000000000000..d855f5423c72
--- /dev/null
+++ b/Ada95/src/terminal_interface-curses-panels-user_data.adb
@@ -0,0 +1,78 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding --
+-- --
+-- Terminal_Interface.Curses.Panels.User_Data --
+-- --
+-- B O D Y --
+-- --
+------------------------------------------------------------------------------
+-- Copyright (c) 1998-2003,2009 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: Juergen Pfeifer, 1996
+-- Version Control:
+-- $Revision: 1.12 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+with Interfaces.C;
+with Terminal_Interface.Curses.Aux;
+use Terminal_Interface.Curses.Aux;
+with Terminal_Interface.Curses.Panels;
+use Terminal_Interface.Curses.Panels;
+
+package body Terminal_Interface.Curses.Panels.User_Data is
+
+ use type Interfaces.C.int;
+
+ procedure Set_User_Data (Pan : Panel;
+ Data : User_Access)
+ is
+ function Set_Panel_Userptr (Pan : Panel;
+ Addr : User_Access) return C_Int;
+ pragma Import (C, Set_Panel_Userptr, "set_panel_userptr");
+ begin
+ if Set_Panel_Userptr (Pan, Data) = Curses_Err then
+ raise Panel_Exception;
+ end if;
+ end Set_User_Data;
+
+ function Get_User_Data (Pan : Panel) return User_Access
+ is
+ function Panel_Userptr (Pan : Panel) return User_Access;
+ pragma Import (C, Panel_Userptr, "panel_userptr");
+ begin
+ return Panel_Userptr (Pan);
+ end Get_User_Data;
+
+ procedure Get_User_Data (Pan : Panel;
+ Data : out User_Access)
+ is
+ begin
+ Data := Get_User_Data (Pan);
+ end Get_User_Data;
+
+end Terminal_Interface.Curses.Panels.User_Data;
diff --git a/Ada95/src/terminal_interface-curses-panels.adb b/Ada95/src/terminal_interface-curses-panels.adb
new file mode 100644
index 000000000000..84e29e519c2d
--- /dev/null
+++ b/Ada95/src/terminal_interface-curses-panels.adb
@@ -0,0 +1,165 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding --
+-- --
+-- Terminal_Interface.Curses.Panels --
+-- --
+-- B O D Y --
+-- --
+------------------------------------------------------------------------------
+-- Copyright (c) 1998-2004,2009 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: Juergen Pfeifer, 1996
+-- Version Control:
+-- $Revision: 1.14 $
+-- $Date: 2009/12/26 17:38:58 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux;
+with Interfaces.C;
+
+package body Terminal_Interface.Curses.Panels is
+
+ use type Interfaces.C.int;
+
+ function Create (Win : Window) return Panel
+ is
+ function Newpanel (Win : Window) return Panel;
+ pragma Import (C, Newpanel, "new_panel");
+
+ Pan : Panel;
+ begin
+ Pan := Newpanel (Win);
+ if Pan = Null_Panel then
+ raise Panel_Exception;
+ end if;
+ return Pan;
+ end Create;
+
+ procedure Bottom (Pan : Panel)
+ is
+ function Bottompanel (Pan : Panel) return C_Int;
+ pragma Import (C, Bottompanel, "bottom_panel");
+ begin
+ if Bottompanel (Pan) = Curses_Err then
+ raise Panel_Exception;
+ end if;
+ end Bottom;
+
+ procedure Top (Pan : Panel)
+ is
+ function Toppanel (Pan : Panel) return C_Int;
+ pragma Import (C, Toppanel, "top_panel");
+ begin
+ if Toppanel (Pan) = Curses_Err then
+ raise Panel_Exception;
+ end if;
+ end Top;
+
+ procedure Show (Pan : Panel)
+ is
+ function Showpanel (Pan : Panel) return C_Int;
+ pragma Import (C, Showpanel, "show_panel");
+ begin
+ if Showpanel (Pan) = Curses_Err then
+ raise Panel_Exception;
+ end if;
+ end Show;
+
+ procedure Hide (Pan : Panel)
+ is
+ function Hidepanel (Pan : Panel) return C_Int;
+ pragma Import (C, Hidepanel, "hide_panel");
+ begin
+ if Hidepanel (Pan) = Curses_Err then
+ raise Panel_Exception;
+ end if;
+ end Hide;
+
+ function Get_Window (Pan : Panel) return Window
+ is
+ function Panel_Win (Pan : Panel) return Window;
+ pragma Import (C, Panel_Win, "panel_window");
+
+ Win : constant Window := Panel_Win (Pan);
+ begin
+ if Win = Null_Window then
+ raise Panel_Exception;
+ end if;
+ return Win;
+ end Get_Window;
+
+ procedure Replace (Pan : Panel;
+ Win : Window)
+ is
+ function Replace_Pan (Pan : Panel;
+ Win : Window) return C_Int;
+ pragma Import (C, Replace_Pan, "replace_panel");
+ begin
+ if Replace_Pan (Pan, Win) = Curses_Err then
+ raise Panel_Exception;
+ end if;
+ end Replace;
+
+ procedure Move (Pan : Panel;
+ Line : Line_Position;
+ Column : Column_Position)
+ is
+ function Move (Pan : Panel;
+ Line : C_Int;
+ Column : C_Int) return C_Int;
+ pragma Import (C, Move, "move_panel");
+ begin
+ if Move (Pan, C_Int (Line), C_Int (Column)) = Curses_Err then
+ raise Panel_Exception;
+ end if;
+ end Move;
+
+ function Is_Hidden (Pan : Panel) return Boolean
+ is
+ function Panel_Hidden (Pan : Panel) return C_Int;
+ pragma Import (C, Panel_Hidden, "panel_hidden");
+ begin
+ if Panel_Hidden (Pan) = Curses_False then
+ return False;
+ else
+ return True;
+ end if;
+ end Is_Hidden;
+
+ procedure Delete (Pan : in out Panel)
+ is
+ function Del_Panel (Pan : Panel) return C_Int;
+ pragma Import (C, Del_Panel, "del_panel");
+ begin
+ if Del_Panel (Pan) = Curses_Err then
+ raise Panel_Exception;
+ end if;
+ Pan := Null_Panel;
+ end Delete;
+
+end Terminal_Interface.Curses.Panels;
diff --git a/Ada95/src/terminal_interface-curses-putwin.adb b/Ada95/src/terminal_interface-curses-putwin.adb
new file mode 100644
index 000000000000..986cd6b9bd6c
--- /dev/null
+++ b/Ada95/src/terminal_interface-curses-putwin.adb
@@ -0,0 +1,77 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding --
+-- --
+-- Terminal_Interface.Curses.PutWin --
+-- --
+-- B O D Y --
+-- --
+------------------------------------------------------------------------------
+-- Copyright (c) 2000 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: Juergen Pfeifer, 1996
+-- Version Control:
+-- $Revision: 1.3 $
+-- Binding Version 01.00
+
+with Ada.Streams.Stream_IO.C_Streams;
+with Interfaces.C_Streams;
+with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux;
+
+package body Terminal_Interface.Curses.PutWin is
+
+ package ICS renames Interfaces.C_Streams;
+ package ACS renames Ada.Streams.Stream_IO.C_Streams;
+ use type C_Int;
+
+ procedure Put_Window (Win : Window;
+ File : Ada.Streams.Stream_IO.File_Type) is
+ function putwin (Win : Window; f : ICS.FILEs) return C_Int;
+ pragma Import (C, putwin, "putwin");
+
+ R : constant C_Int := putwin (Win, ACS.C_Stream (File));
+ begin
+ if R /= Curses_Ok then
+ raise Curses_Exception;
+ end if;
+ end Put_Window;
+
+ function Get_Window (File : Ada.Streams.Stream_IO.File_Type)
+ return Window is
+ function getwin (f : ICS.FILEs) return Window;
+ pragma Import (C, getwin, "getwin");
+
+ W : constant Window := getwin (ACS.C_Stream (File));
+ begin
+ if W = Null_Window then
+ raise Curses_Exception;
+ else
+ return W;
+ end if;
+ end Get_Window;
+
+end Terminal_Interface.Curses.PutWin;
diff --git a/Ada95/src/terminal_interface-curses-putwin.ads b/Ada95/src/terminal_interface-curses-putwin.ads
new file mode 100644
index 000000000000..d302bdcec452
--- /dev/null
+++ b/Ada95/src/terminal_interface-curses-putwin.ads
@@ -0,0 +1,50 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding --
+-- --
+-- Terminal_Interface.Curses.PutWin --
+-- --
+-- S P E C --
+-- --
+------------------------------------------------------------------------------
+-- Copyright (c) 2000 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: Juergen Pfeifer, 1996
+-- Version Control:
+-- $Revision: 1.3 $
+-- Binding Version 01.00
+
+with Ada.Streams.Stream_IO;
+
+package Terminal_Interface.Curses.PutWin is
+
+ procedure Put_Window (Win : Window;
+ File : Ada.Streams.Stream_IO.File_Type);
+
+ function Get_Window (File : Ada.Streams.Stream_IO.File_Type) return Window;
+
+end Terminal_Interface.Curses.PutWin;
diff --git a/Ada95/src/terminal_interface-curses-termcap.adb b/Ada95/src/terminal_interface-curses-termcap.adb
new file mode 100644
index 000000000000..643865781fd3
--- /dev/null
+++ b/Ada95/src/terminal_interface-curses-termcap.adb
@@ -0,0 +1,163 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding --
+-- --
+-- Terminal_Interface.Curses.Termcap --
+-- --
+-- B O D Y --
+-- --
+------------------------------------------------------------------------------
+-- Copyright (c) 2000-2006,2009 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: Juergen Pfeifer, 1996
+-- Version Control:
+-- $Revision: 1.12 $
+-- $Date: 2009/12/26 17:38:58 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+
+with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux;
+with Interfaces.C; use Interfaces.C;
+with Interfaces.C.Strings; use Interfaces.C.Strings;
+
+package body Terminal_Interface.Curses.Termcap is
+
+ function Get_Entry (Name : String) return Boolean
+ is
+ function tgetent (name : char_array; val : char_array)
+ return C_Int;
+ pragma Import (C, tgetent, "tgetent");
+ NameTxt : char_array (0 .. Name'Length);
+ Length : size_t;
+ ignored : constant char_array (0 .. 0) := (0 => nul);
+ result : C_Int;
+ begin
+ To_C (Name, NameTxt, Length);
+ result := tgetent (char_array (ignored), NameTxt);
+ if result = -1 then
+ raise Curses_Exception;
+ else
+ return Boolean'Val (result);
+ end if;
+ end Get_Entry;
+
+------------------------------------------------------------------------------
+ function Get_Flag (Name : String) return Boolean
+ is
+ function tgetflag (id : char_array) return C_Int;
+ pragma Import (C, tgetflag, "tgetflag");
+ Txt : char_array (0 .. Name'Length);
+ Length : size_t;
+ begin
+ To_C (Name, Txt, Length);
+ if tgetflag (Txt) = 0 then
+ return False;
+ else
+ return True;
+ end if;
+ end Get_Flag;
+
+------------------------------------------------------------------------------
+ procedure Get_Number (Name : String;
+ Value : out Integer;
+ Result : out Boolean)
+ is
+ function tgetnum (id : char_array) return C_Int;
+ pragma Import (C, tgetnum, "tgetnum");
+ Txt : char_array (0 .. Name'Length);
+ Length : size_t;
+ begin
+ To_C (Name, Txt, Length);
+ Value := Integer (tgetnum (Txt));
+ if Value = -1 then
+ Result := False;
+ else
+ Result := True;
+ end if;
+ end Get_Number;
+
+------------------------------------------------------------------------------
+ procedure Get_String (Name : String;
+ Value : out String;
+ Result : out Boolean)
+ is
+ function tgetstr (id : char_array;
+ buf : char_array) return chars_ptr;
+ pragma Import (C, tgetstr, "tgetstr");
+ Txt : char_array (0 .. Name'Length);
+ Length : size_t;
+ Txt2 : chars_ptr;
+ type t is new char_array (0 .. 1024); -- does it need to be 1024?
+ Return_Buffer : constant t := (others => nul);
+ begin
+ To_C (Name, Txt, Length);
+ Txt2 := tgetstr (Txt, char_array (Return_Buffer));
+ if Txt2 = Null_Ptr then
+ Result := False;
+ else
+ Value := Fill_String (Txt2);
+ Result := True;
+ end if;
+ end Get_String;
+
+ function Get_String (Name : String) return Boolean
+ is
+ function tgetstr (Id : char_array;
+ buf : char_array) return chars_ptr;
+ pragma Import (C, tgetstr, "tgetstr");
+ Txt : char_array (0 .. Name'Length);
+ Length : size_t;
+ Txt2 : chars_ptr;
+ type t is new char_array (0 .. 1024); -- does it need to be 1024?
+ Phony_Txt : constant t := (others => nul);
+ begin
+ To_C (Name, Txt, Length);
+ Txt2 := tgetstr (Txt, char_array (Phony_Txt));
+ if Txt2 = Null_Ptr then
+ return False;
+ else
+ return True;
+ end if;
+ end Get_String;
+
+------------------------------------------------------------------------------
+ function TGoto (Cap : String;
+ Col : Column_Position;
+ Row : Line_Position) return Termcap_String is
+ function tgoto (cap : char_array;
+ col : C_Int;
+ row : C_Int) return chars_ptr;
+ pragma Import (C, tgoto);
+ Txt : char_array (0 .. Cap'Length);
+ Length : size_t;
+ begin
+ To_C (Cap, Txt, Length);
+ return Termcap_String (Fill_String
+ (tgoto (Txt, C_Int (Col), C_Int (Row))));
+ end TGoto;
+
+end Terminal_Interface.Curses.Termcap;
diff --git a/Ada95/src/terminal_interface-curses-termcap.ads b/Ada95/src/terminal_interface-curses-termcap.ads
new file mode 100644
index 000000000000..dd01396e8b0b
--- /dev/null
+++ b/Ada95/src/terminal_interface-curses-termcap.ads
@@ -0,0 +1,80 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding --
+-- --
+-- Terminal_Interface.Curses.Termcap --
+-- --
+-- S P E C --
+-- --
+------------------------------------------------------------------------------
+-- Copyright (c) 2000 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: Juergen Pfeifer, 1996
+-- Version Control:
+-- $Revision: 1.3 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+
+package Terminal_Interface.Curses.Termcap is
+ pragma Preelaborate (Terminal_Interface.Curses.Termcap);
+
+ -- |=====================================================================
+ -- | Man page curs_termcap.3x
+ -- |=====================================================================
+ -- Not implemented: tputs (see curs_terminfo)
+
+ type Termcap_String is new String;
+
+ -- |
+ function TGoto (Cap : String;
+ Col : Column_Position;
+ Row : Line_Position) return Termcap_String;
+ -- AKA: tgoto()
+
+ -- |
+ function Get_Entry (Name : String) return Boolean;
+ -- AKA: tgetent()
+
+ -- |
+ function Get_Flag (Name : String) return Boolean;
+ -- AKA: tgetflag()
+
+ -- |
+ procedure Get_Number (Name : String;
+ Value : out Integer;
+ Result : out Boolean);
+ -- AKA: tgetnum()
+
+ -- |
+ procedure Get_String (Name : String;
+ Value : out String;
+ Result : out Boolean);
+ function Get_String (Name : String) return Boolean;
+ -- Returns True if the string is found.
+ -- AKA: tgetstr()
+
+end Terminal_Interface.Curses.Termcap;
diff --git a/Ada95/src/terminal_interface-curses-terminfo.adb b/Ada95/src/terminal_interface-curses-terminfo.adb
new file mode 100644
index 000000000000..9b3c9d56b330
--- /dev/null
+++ b/Ada95/src/terminal_interface-curses-terminfo.adb
@@ -0,0 +1,161 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding --
+-- --
+-- Terminal_Interface.Curses.Terminfo --
+-- --
+-- B O D Y --
+-- --
+------------------------------------------------------------------------------
+-- Copyright (c) 1998-2006,2009 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: Juergen Pfeifer, 1996
+-- Version Control:
+-- $Revision: 1.6 $
+-- $Date: 2009/12/26 17:38:58 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+
+with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux;
+with Interfaces.C; use Interfaces.C;
+with Interfaces.C.Strings; use Interfaces.C.Strings;
+with Ada.Unchecked_Conversion;
+
+package body Terminal_Interface.Curses.Terminfo is
+
+ function Is_MinusOne_Pointer (P : chars_ptr) return Boolean;
+
+ function Is_MinusOne_Pointer (P : chars_ptr) return Boolean is
+ type Weird_Address is new System.Storage_Elements.Integer_Address;
+ Invalid_Pointer : constant Weird_Address := -1;
+ function To_Weird is new Ada.Unchecked_Conversion
+ (Source => chars_ptr, Target => Weird_Address);
+ begin
+ if To_Weird (P) = Invalid_Pointer then
+ return True;
+ else
+ return False;
+ end if;
+ end Is_MinusOne_Pointer;
+ pragma Inline (Is_MinusOne_Pointer);
+
+------------------------------------------------------------------------------
+ function Get_Flag (Name : String) return Boolean
+ is
+ function tigetflag (id : char_array) return Curses_Bool;
+ pragma Import (C, tigetflag);
+ Txt : char_array (0 .. Name'Length);
+ Length : size_t;
+ begin
+ To_C (Name, Txt, Length);
+ if tigetflag (Txt) = Curses_Bool (Curses_True) then
+ return True;
+ else
+ return False;
+ end if;
+ end Get_Flag;
+
+------------------------------------------------------------------------------
+ procedure Get_String (Name : String;
+ Value : out Terminfo_String;
+ Result : out Boolean)
+ is
+ function tigetstr (id : char_array) return chars_ptr;
+ pragma Import (C, tigetstr, "tigetstr");
+ Txt : char_array (0 .. Name'Length);
+ Length : size_t;
+ Txt2 : chars_ptr;
+ begin
+ To_C (Name, Txt, Length);
+ Txt2 := tigetstr (Txt);
+ if Txt2 = Null_Ptr then
+ Result := False;
+ elsif Is_MinusOne_Pointer (Txt2) then
+ raise Curses_Exception;
+ else
+ Value := Terminfo_String (Fill_String (Txt2));
+ Result := True;
+ end if;
+ end Get_String;
+
+------------------------------------------------------------------------------
+ function Has_String (Name : String) return Boolean
+ is
+ function tigetstr (id : char_array) return chars_ptr;
+ pragma Import (C, tigetstr, "tigetstr");
+ Txt : char_array (0 .. Name'Length);
+ Length : size_t;
+ Txt2 : chars_ptr;
+ begin
+ To_C (Name, Txt, Length);
+ Txt2 := tigetstr (Txt);
+ if Txt2 = Null_Ptr then
+ return False;
+ elsif Is_MinusOne_Pointer (Txt2) then
+ raise Curses_Exception;
+ else
+ return True;
+ end if;
+ end Has_String;
+
+------------------------------------------------------------------------------
+ function Get_Number (Name : String) return Integer is
+ function tigetstr (s : char_array) return C_Int;
+ pragma Import (C, tigetstr);
+ Txt : char_array (0 .. Name'Length);
+ Length : size_t;
+ begin
+ To_C (Name, Txt, Length);
+ return Integer (tigetstr (Txt));
+ end Get_Number;
+
+------------------------------------------------------------------------------
+ procedure Put_String (Str : Terminfo_String;
+ affcnt : Natural := 1;
+ putc : putctype := null) is
+ function tputs (str : char_array;
+ affcnt : C_Int;
+ putc : putctype) return C_Int;
+ function putp (str : char_array) return C_Int;
+ pragma Import (C, tputs);
+ pragma Import (C, putp);
+ Txt : char_array (0 .. Str'Length);
+ Length : size_t;
+ Err : C_Int;
+ begin
+ To_C (String (Str), Txt, Length);
+ if putc = null then
+ Err := putp (Txt);
+ else
+ Err := tputs (Txt, C_Int (affcnt), putc);
+ end if;
+ if Err = Curses_Err then
+ raise Curses_Exception;
+ end if;
+ end Put_String;
+
+end Terminal_Interface.Curses.Terminfo;
diff --git a/Ada95/src/terminal_interface-curses-terminfo.ads b/Ada95/src/terminal_interface-curses-terminfo.ads
new file mode 100644
index 000000000000..fb39bf1ed6f1
--- /dev/null
+++ b/Ada95/src/terminal_interface-curses-terminfo.ads
@@ -0,0 +1,81 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding --
+-- --
+-- Terminal_Interface.Curses.Terminfo --
+-- --
+-- S P E C --
+-- --
+------------------------------------------------------------------------------
+-- Copyright (c) 2000 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: Juergen Pfeifer, 1996
+-- Version Control:
+-- $Revision: 1.3 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+
+with Interfaces.C;
+
+package Terminal_Interface.Curses.Terminfo is
+ pragma Preelaborate (Terminal_Interface.Curses.Terminfo);
+
+ -- |=====================================================================
+ -- | Man page curs_terminfo.3x
+ -- |=====================================================================
+ -- Not implemented: setupterm, setterm, set_curterm, del_curterm,
+ -- restartterm, tparm, putp, vidputs, vidattr,
+ -- mvcur
+
+ type Terminfo_String is new String;
+
+ -- |
+ procedure Get_String (Name : String;
+ Value : out Terminfo_String;
+ Result : out Boolean);
+ function Has_String (Name : String) return Boolean;
+ -- AKA: tigetstr()
+
+ -- |
+ function Get_Flag (Name : String) return Boolean;
+ -- AKA: tigetflag()
+
+ -- |
+ function Get_Number (Name : String) return Integer;
+ -- AKA: tigetnum()
+
+ type putctype is access function (c : Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Convention (C, putctype);
+
+ -- |
+ procedure Put_String (Str : Terminfo_String;
+ affcnt : Natural := 1;
+ putc : putctype := null);
+ -- AKA: tputs()
+
+end Terminal_Interface.Curses.Terminfo;
diff --git a/Ada95/src/terminal_interface-curses-text_io-aux.adb b/Ada95/src/terminal_interface-curses-text_io-aux.adb
new file mode 100644
index 000000000000..50a4e4461baa
--- /dev/null
+++ b/Ada95/src/terminal_interface-curses-text_io-aux.adb
@@ -0,0 +1,128 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding --
+-- --
+-- Terminal_Interface.Curses.Text_IO.Aux --
+-- --
+-- B O D Y --
+-- --
+------------------------------------------------------------------------------
+-- Copyright (c) 1998-2006,2009 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: Juergen Pfeifer, 1996
+-- Version Control:
+-- $Revision: 1.13 $
+-- $Date: 2009/12/26 17:38:58 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+package body Terminal_Interface.Curses.Text_IO.Aux is
+
+ procedure Put_Buf
+ (Win : Window;
+ Buf : String;
+ Width : Field;
+ Signal : Boolean := True;
+ Ljust : Boolean := False)
+ is
+ L : Field;
+ Len : Field;
+ W : Field := Width;
+ LC : Line_Count;
+ CC : Column_Count;
+ Y : Line_Position;
+ X : Column_Position;
+
+ procedure Output (From, To : Field);
+
+ procedure Output (From, To : Field)
+ is
+ begin
+ if Len > 0 then
+ if W = 0 then
+ W := Len;
+ end if;
+ if Len > W then
+ -- LRM A10.6 (7) says this
+ W := Len;
+ end if;
+
+ pragma Assert (Len <= W);
+ Get_Size (Win, LC, CC);
+ if Column_Count (Len) > CC then
+ if Signal then
+ raise Layout_Error;
+ else
+ return;
+ end if;
+ else
+ if Len < W and then not Ljust then
+ declare
+ Filler : constant String (1 .. (W - Len))
+ := (others => ' ');
+ begin
+ Put (Win, Filler);
+ end;
+ end if;
+ Get_Cursor_Position (Win, Y, X);
+ if (X + Column_Position (Len)) > CC then
+ New_Line (Win);
+ end if;
+ Put (Win, Buf (From .. To));
+ if Len < W and then Ljust then
+ declare
+ Filler : constant String (1 .. (W - Len))
+ := (others => ' ');
+ begin
+ Put (Win, Filler);
+ end;
+ end if;
+ end if;
+ end if;
+ end Output;
+
+ begin
+ pragma Assert (Win /= Null_Window);
+ if Ljust then
+ L := 1;
+ for I in 1 .. Buf'Length loop
+ exit when Buf (L) = ' ';
+ L := L + 1;
+ end loop;
+ Len := L - 1;
+ Output (1, Len);
+ else -- input buffer is not left justified
+ L := Buf'Length;
+ for I in 1 .. Buf'Length loop
+ exit when Buf (L) = ' ';
+ L := L - 1;
+ end loop;
+ Len := Buf'Length - L;
+ Output (L + 1, Buf'Length);
+ end if;
+ end Put_Buf;
+
+end Terminal_Interface.Curses.Text_IO.Aux;
diff --git a/Ada95/src/terminal_interface-curses-text_io-aux.ads b/Ada95/src/terminal_interface-curses-text_io-aux.ads
new file mode 100644
index 000000000000..6b50b3395063
--- /dev/null
+++ b/Ada95/src/terminal_interface-curses-text_io-aux.ads
@@ -0,0 +1,55 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding --
+-- --
+-- Terminal_Interface.Curses.Text_IO.Aux --
+-- --
+-- S P E C --
+-- --
+------------------------------------------------------------------------------
+-- Copyright (c) 1998-2006,2009 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: Juergen Pfeifer, 1996
+-- Version Control:
+-- $Revision: 1.14 $
+-- $Date: 2009/12/26 17:38:58 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+private package Terminal_Interface.Curses.Text_IO.Aux is
+ -- pragma Preelaborate (Aux);
+
+ -- This routine is called from the Text_IO output routines for numeric
+ -- and enumeration types.
+ --
+ procedure Put_Buf
+ (Win : Window; -- The output window
+ Buf : String; -- The buffer containing the text
+ Width : Field; -- The width of the output field
+ Signal : Boolean := True; -- If true, we raise Layout_Error
+ Ljust : Boolean := False); -- The Buf is left justified
+
+end Terminal_Interface.Curses.Text_IO.Aux;
diff --git a/Ada95/src/terminal_interface-curses-text_io-complex_io.adb b/Ada95/src/terminal_interface-curses-text_io-complex_io.adb
new file mode 100644
index 000000000000..6c2e144eb37c
--- /dev/null
+++ b/Ada95/src/terminal_interface-curses-text_io-complex_io.adb
@@ -0,0 +1,73 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding --
+-- --
+-- Terminal_Interface.Curses.Text_IO.Complex_IO --
+-- --
+-- B O D Y --
+-- --
+------------------------------------------------------------------------------
+-- Copyright (c) 1998-2003,2009 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: Juergen Pfeifer, 1996
+-- Version Control:
+-- $Revision: 1.11 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+with Terminal_Interface.Curses.Text_IO.Float_IO;
+
+package body Terminal_Interface.Curses.Text_IO.Complex_IO is
+
+ package FIO is new
+ Terminal_Interface.Curses.Text_IO.Float_IO (Complex_Types.Real'Base);
+
+ procedure Put
+ (Win : Window;
+ Item : Complex;
+ Fore : Field := Default_Fore;
+ Aft : Field := Default_Aft;
+ Exp : Field := Default_Exp)
+ is
+ begin
+ Put (Win, '(');
+ FIO.Put (Win, Item.Re, Fore, Aft, Exp);
+ Put (Win, ',');
+ FIO.Put (Win, Item.Im, Fore, Aft, Exp);
+ Put (Win, ')');
+ end Put;
+
+ procedure Put
+ (Item : Complex;
+ Fore : Field := Default_Fore;
+ Aft : Field := Default_Aft;
+ Exp : Field := Default_Exp)
+ is
+ begin
+ Put (Get_Window, Item, Fore, Aft, Exp);
+ end Put;
+
+end Terminal_Interface.Curses.Text_IO.Complex_IO;
diff --git a/Ada95/src/terminal_interface-curses-text_io-complex_io.ads b/Ada95/src/terminal_interface-curses-text_io-complex_io.ads
new file mode 100644
index 000000000000..e61345895d1e
--- /dev/null
+++ b/Ada95/src/terminal_interface-curses-text_io-complex_io.ads
@@ -0,0 +1,70 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding --
+-- --
+-- Terminal_Interface.Curses.Text_IO.Complex_IO --
+-- --
+-- S P E C --
+-- --
+------------------------------------------------------------------------------
+-- Copyright (c) 1998-2003,2009 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: Juergen Pfeifer, 1996
+-- Version Control:
+-- $Revision: 1.11 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+with Ada.Numerics.Generic_Complex_Types;
+
+generic
+ with package Complex_Types is new Ada.Numerics.Generic_Complex_Types (<>);
+
+package Terminal_Interface.Curses.Text_IO.Complex_IO is
+
+ use Complex_Types;
+
+ Default_Fore : Field := 2;
+ Default_Aft : Field := Real'Digits - 1;
+ Default_Exp : Field := 3;
+
+ procedure Put
+ (Win : Window;
+ Item : Complex;
+ Fore : Field := Default_Fore;
+ Aft : Field := Default_Aft;
+ Exp : Field := Default_Exp);
+
+ procedure Put
+ (Item : Complex;
+ Fore : Field := Default_Fore;
+ Aft : Field := Default_Aft;
+ Exp : Field := Default_Exp);
+
+private
+ pragma Inline (Put);
+
+end Terminal_Interface.Curses.Text_IO.Complex_IO;
diff --git a/Ada95/src/terminal_interface-curses-text_io-decimal_io.adb b/Ada95/src/terminal_interface-curses-text_io-decimal_io.adb
new file mode 100644
index 000000000000..1b1ad8cbf2e8
--- /dev/null
+++ b/Ada95/src/terminal_interface-curses-text_io-decimal_io.adb
@@ -0,0 +1,75 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding --
+-- --
+-- Terminal_Interface.Curses.Text_IO.Decimal_IO --
+-- --
+-- B O D Y --
+-- --
+------------------------------------------------------------------------------
+-- Copyright (c) 1998-2003,2009 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: Juergen Pfeifer, 1996
+-- Version Control:
+-- $Revision: 1.11 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+with Ada.Text_IO;
+with Terminal_Interface.Curses.Text_IO.Aux;
+
+package body Terminal_Interface.Curses.Text_IO.Decimal_IO is
+
+ package Aux renames Terminal_Interface.Curses.Text_IO.Aux;
+ package DIO is new Ada.Text_IO.Decimal_IO (Num);
+
+ procedure Put
+ (Win : Window;
+ Item : Num;
+ Fore : Field := Default_Fore;
+ Aft : Field := Default_Aft;
+ Exp : Field := Default_Exp)
+ is
+ Buf : String (1 .. Field'Last);
+ Len : Field := Fore + 1 + Aft;
+ begin
+ if Exp > 0 then
+ Len := Len + 1 + Exp;
+ end if;
+ DIO.Put (Buf, Item, Aft, Exp);
+ Aux.Put_Buf (Win, Buf, Len, False);
+ end Put;
+
+ procedure Put
+ (Item : Num;
+ Fore : Field := Default_Fore;
+ Aft : Field := Default_Aft;
+ Exp : Field := Default_Exp) is
+ begin
+ Put (Get_Window, Item, Fore, Aft, Exp);
+ end Put;
+
+end Terminal_Interface.Curses.Text_IO.Decimal_IO;
diff --git a/Ada95/src/terminal_interface-curses-text_io-decimal_io.ads b/Ada95/src/terminal_interface-curses-text_io-decimal_io.ads
new file mode 100644
index 000000000000..1590127451ea
--- /dev/null
+++ b/Ada95/src/terminal_interface-curses-text_io-decimal_io.ads
@@ -0,0 +1,66 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding --
+-- --
+-- Terminal_Interface.Curses.Text_IO.Decimal_IO --
+-- --
+-- S P E C --
+-- --
+------------------------------------------------------------------------------
+-- Copyright (c) 1998-2003,2009 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: Juergen Pfeifer, 1996
+-- Version Control:
+-- $Revision: 1.12 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+generic
+ type Num is delta <> digits <>;
+
+package Terminal_Interface.Curses.Text_IO.Decimal_IO is
+
+ Default_Fore : Field := Num'Fore;
+ Default_Aft : Field := Num'Aft;
+ Default_Exp : Field := 0;
+
+ procedure Put
+ (Win : Window;
+ Item : Num;
+ Fore : Field := Default_Fore;
+ Aft : Field := Default_Aft;
+ Exp : Field := Default_Exp);
+
+ procedure Put
+ (Item : Num;
+ Fore : Field := Default_Fore;
+ Aft : Field := Default_Aft;
+ Exp : Field := Default_Exp);
+
+private
+ pragma Inline (Put);
+
+end Terminal_Interface.Curses.Text_IO.Decimal_IO;
diff --git a/Ada95/src/terminal_interface-curses-text_io-enumeration_io.adb b/Ada95/src/terminal_interface-curses-text_io-enumeration_io.adb
new file mode 100644
index 000000000000..53f3e55ec837
--- /dev/null
+++ b/Ada95/src/terminal_interface-curses-text_io-enumeration_io.adb
@@ -0,0 +1,80 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding --
+-- --
+-- Terminal_Interface.Curses.Text_IO.Enumeration_IO --
+-- --
+-- B O D Y --
+-- --
+------------------------------------------------------------------------------
+-- Copyright (c) 1998-2003,2009 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: Juergen Pfeifer, 1996
+-- Version Control:
+-- $Revision: 1.11 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+with Ada.Text_IO;
+with Ada.Characters.Handling; use Ada.Characters.Handling;
+with Terminal_Interface.Curses.Text_IO.Aux;
+
+package body Terminal_Interface.Curses.Text_IO.Enumeration_IO is
+
+ package Aux renames Terminal_Interface.Curses.Text_IO.Aux;
+ package EIO is new Ada.Text_IO.Enumeration_IO (Enum);
+
+ procedure Put
+ (Win : Window;
+ Item : Enum;
+ Width : Field := Default_Width;
+ Set : Type_Set := Default_Setting)
+ is
+ Buf : String (1 .. Field'Last);
+ Tset : Ada.Text_IO.Type_Set;
+ begin
+ if Set /= Mixed_Case then
+ Tset := Ada.Text_IO.Type_Set'Val (Type_Set'Pos (Set));
+ else
+ Tset := Ada.Text_IO.Lower_Case;
+ end if;
+ EIO.Put (Buf, Item, Tset);
+ if Set = Mixed_Case then
+ Buf (Buf'First) := To_Upper (Buf (Buf'First));
+ end if;
+ Aux.Put_Buf (Win, Buf, Width, True, True);
+ end Put;
+
+ procedure Put
+ (Item : Enum;
+ Width : Field := Default_Width;
+ Set : Type_Set := Default_Setting)
+ is
+ begin
+ Put (Get_Window, Item, Width, Set);
+ end Put;
+
+end Terminal_Interface.Curses.Text_IO.Enumeration_IO;
diff --git a/Ada95/src/terminal_interface-curses-text_io-enumeration_io.ads b/Ada95/src/terminal_interface-curses-text_io-enumeration_io.ads
new file mode 100644
index 000000000000..a981f0ebc579
--- /dev/null
+++ b/Ada95/src/terminal_interface-curses-text_io-enumeration_io.ads
@@ -0,0 +1,63 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding --
+-- --
+-- Terminal_Interface.Curses.Text_IO.Enumeration_IO --
+-- --
+-- S P E C --
+-- --
+------------------------------------------------------------------------------
+-- Copyright (c) 1998-2003,2009 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: Juergen Pfeifer, 1996
+-- Version Control:
+-- $Revision: 1.12 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+generic
+ type Enum is (<>);
+
+package Terminal_Interface.Curses.Text_IO.Enumeration_IO is
+
+ Default_Width : Field := 0;
+ Default_Setting : Type_Set := Mixed_Case;
+
+ procedure Put
+ (Win : Window;
+ Item : Enum;
+ Width : Field := Default_Width;
+ Set : Type_Set := Default_Setting);
+
+ procedure Put
+ (Item : Enum;
+ Width : Field := Default_Width;
+ Set : Type_Set := Default_Setting);
+
+private
+ pragma Inline (Put);
+
+end Terminal_Interface.Curses.Text_IO.Enumeration_IO;
diff --git a/Ada95/src/terminal_interface-curses-text_io-fixed_io.adb b/Ada95/src/terminal_interface-curses-text_io-fixed_io.adb
new file mode 100644
index 000000000000..13a34202389e
--- /dev/null
+++ b/Ada95/src/terminal_interface-curses-text_io-fixed_io.adb
@@ -0,0 +1,75 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding --
+-- --
+-- Terminal_Interface.Curses.Text_IO.Fixed_IO --
+-- --
+-- B O D Y --
+-- --
+------------------------------------------------------------------------------
+-- Copyright (c) 1998-2003,2009 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: Juergen Pfeifer, 1996
+-- Version Control:
+-- $Revision: 1.11 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+with Ada.Text_IO;
+with Terminal_Interface.Curses.Text_IO.Aux;
+
+package body Terminal_Interface.Curses.Text_IO.Fixed_IO is
+
+ package Aux renames Terminal_Interface.Curses.Text_IO.Aux;
+ package FIXIO is new Ada.Text_IO.Fixed_IO (Num);
+
+ procedure Put
+ (Win : Window;
+ Item : Num;
+ Fore : Field := Default_Fore;
+ Aft : Field := Default_Aft;
+ Exp : Field := Default_Exp)
+ is
+ Buf : String (1 .. Field'Last);
+ Len : Field := Fore + 1 + Aft;
+ begin
+ if Exp > 0 then
+ Len := Len + 1 + Exp;
+ end if;
+ FIXIO.Put (Buf, Item, Aft, Exp);
+ Aux.Put_Buf (Win, Buf, Len, False);
+ end Put;
+
+ procedure Put
+ (Item : Num;
+ Fore : Field := Default_Fore;
+ Aft : Field := Default_Aft;
+ Exp : Field := Default_Exp) is
+ begin
+ Put (Get_Window, Item, Fore, Aft, Exp);
+ end Put;
+
+end Terminal_Interface.Curses.Text_IO.Fixed_IO;
diff --git a/Ada95/src/terminal_interface-curses-text_io-fixed_io.ads b/Ada95/src/terminal_interface-curses-text_io-fixed_io.ads
new file mode 100644
index 000000000000..3c22a01479ca
--- /dev/null
+++ b/Ada95/src/terminal_interface-curses-text_io-fixed_io.ads
@@ -0,0 +1,66 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding --
+-- --
+-- Terminal_Interface.Curses.Text_IO.Fixed_IO --
+-- --
+-- S P E C --
+-- --
+------------------------------------------------------------------------------
+-- Copyright (c) 1998-2003,2009 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: Juergen Pfeifer, 1996
+-- Version Control:
+-- $Revision: 1.12 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+generic
+ type Num is delta <>;
+
+package Terminal_Interface.Curses.Text_IO.Fixed_IO is
+
+ Default_Fore : Field := Num'Fore;
+ Default_Aft : Field := Num'Aft;
+ Default_Exp : Field := 0;
+
+ procedure Put
+ (Win : Window;
+ Item : Num;
+ Fore : Field := Default_Fore;
+ Aft : Field := Default_Aft;
+ Exp : Field := Default_Exp);
+
+ procedure Put
+ (Item : Num;
+ Fore : Field := Default_Fore;
+ Aft : Field := Default_Aft;
+ Exp : Field := Default_Exp);
+
+private
+ pragma Inline (Put);
+
+end Terminal_Interface.Curses.Text_IO.Fixed_IO;
diff --git a/Ada95/src/terminal_interface-curses-text_io-float_io.adb b/Ada95/src/terminal_interface-curses-text_io-float_io.adb
new file mode 100644
index 000000000000..af667b4cd175
--- /dev/null
+++ b/Ada95/src/terminal_interface-curses-text_io-float_io.adb
@@ -0,0 +1,76 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding --
+-- --
+-- Terminal_Interface.Curses.Text_IO.Float_IO --
+-- --
+-- B O D Y --
+-- --
+------------------------------------------------------------------------------
+-- Copyright (c) 1998-2003,2009 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: Juergen Pfeifer, 1996
+-- Version Control:
+-- $Revision: 1.11 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+with Ada.Text_IO;
+with Terminal_Interface.Curses.Text_IO.Aux;
+
+package body Terminal_Interface.Curses.Text_IO.Float_IO is
+
+ package Aux renames Terminal_Interface.Curses.Text_IO.Aux;
+ package FIO is new Ada.Text_IO.Float_IO (Num);
+
+ procedure Put
+ (Win : Window;
+ Item : Num;
+ Fore : Field := Default_Fore;
+ Aft : Field := Default_Aft;
+ Exp : Field := Default_Exp)
+ is
+ Buf : String (1 .. Field'Last);
+ Len : Field := Fore + 1 + Aft;
+ begin
+ if Exp > 0 then
+ Len := Len + 1 + Exp;
+ end if;
+ FIO.Put (Buf, Item, Aft, Exp);
+ Aux.Put_Buf (Win, Buf, Len, False);
+ end Put;
+
+ procedure Put
+ (Item : Num;
+ Fore : Field := Default_Fore;
+ Aft : Field := Default_Aft;
+ Exp : Field := Default_Exp)
+ is
+ begin
+ Put (Get_Window, Item, Fore, Aft, Exp);
+ end Put;
+
+end Terminal_Interface.Curses.Text_IO.Float_IO;
diff --git a/Ada95/src/terminal_interface-curses-text_io-float_io.ads b/Ada95/src/terminal_interface-curses-text_io-float_io.ads
new file mode 100644
index 000000000000..b0a68d029eb4
--- /dev/null
+++ b/Ada95/src/terminal_interface-curses-text_io-float_io.ads
@@ -0,0 +1,66 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding --
+-- --
+-- Terminal_Interface.Curses.Text_IO.Float_IO --
+-- --
+-- S P E C --
+-- --
+------------------------------------------------------------------------------
+-- Copyright (c) 1998-2003,2009 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: Juergen Pfeifer, 1996
+-- Version Control:
+-- $Revision: 1.12 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+generic
+ type Num is digits <>;
+
+package Terminal_Interface.Curses.Text_IO.Float_IO is
+
+ Default_Fore : Field := 2;
+ Default_Aft : Field := Num'Digits - 1;
+ Default_Exp : Field := 3;
+
+ procedure Put
+ (Win : Window;
+ Item : Num;
+ Fore : Field := Default_Fore;
+ Aft : Field := Default_Aft;
+ Exp : Field := Default_Exp);
+
+ procedure Put
+ (Item : Num;
+ Fore : Field := Default_Fore;
+ Aft : Field := Default_Aft;
+ Exp : Field := Default_Exp);
+
+private
+ pragma Inline (Put);
+
+end Terminal_Interface.Curses.Text_IO.Float_IO;
diff --git a/Ada95/src/terminal_interface-curses-text_io-integer_io.adb b/Ada95/src/terminal_interface-curses-text_io-integer_io.adb
new file mode 100644
index 000000000000..4d19c42e883f
--- /dev/null
+++ b/Ada95/src/terminal_interface-curses-text_io-integer_io.adb
@@ -0,0 +1,70 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding --
+-- --
+-- Terminal_Interface.Curses.Text_IO.Integer_IO --
+-- --
+-- B O D Y --
+-- --
+------------------------------------------------------------------------------
+-- Copyright (c) 1998-2003,2009 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: Juergen Pfeifer, 1996
+-- Version Control:
+-- $Revision: 1.11 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+with Ada.Text_IO;
+with Terminal_Interface.Curses.Text_IO.Aux;
+
+package body Terminal_Interface.Curses.Text_IO.Integer_IO is
+
+ package Aux renames Terminal_Interface.Curses.Text_IO.Aux;
+ package IIO is new Ada.Text_IO.Integer_IO (Num);
+
+ procedure Put
+ (Win : Window;
+ Item : Num;
+ Width : Field := Default_Width;
+ Base : Number_Base := Default_Base)
+ is
+ Buf : String (1 .. Field'Last);
+ begin
+ IIO.Put (Buf, Item, Base);
+ Aux.Put_Buf (Win, Buf, Width);
+ end Put;
+
+ procedure Put
+ (Item : Num;
+ Width : Field := Default_Width;
+ Base : Number_Base := Default_Base)
+ is
+ begin
+ Put (Get_Window, Item, Width, Base);
+ end Put;
+
+end Terminal_Interface.Curses.Text_IO.Integer_IO;
diff --git a/Ada95/src/terminal_interface-curses-text_io-integer_io.ads b/Ada95/src/terminal_interface-curses-text_io-integer_io.ads
new file mode 100644
index 000000000000..9ffe1e018164
--- /dev/null
+++ b/Ada95/src/terminal_interface-curses-text_io-integer_io.ads
@@ -0,0 +1,63 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding --
+-- --
+-- Terminal_Interface.Curses.Text_IO.Integer_IO --
+-- --
+-- S P E C --
+-- --
+------------------------------------------------------------------------------
+-- Copyright (c) 1998-2003,2009 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: Juergen Pfeifer, 1996
+-- Version Control:
+-- $Revision: 1.12 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+generic
+ type Num is range <>;
+
+package Terminal_Interface.Curses.Text_IO.Integer_IO is
+
+ Default_Width : Field := Num'Width;
+ Default_Base : Number_Base := 10;
+
+ procedure Put
+ (Win : Window;
+ Item : Num;
+ Width : Field := Default_Width;
+ Base : Number_Base := Default_Base);
+
+ procedure Put
+ (Item : Num;
+ Width : Field := Default_Width;
+ Base : Number_Base := Default_Base);
+
+private
+ pragma Inline (Put);
+
+end Terminal_Interface.Curses.Text_IO.Integer_IO;
diff --git a/Ada95/src/terminal_interface-curses-text_io-modular_io.adb b/Ada95/src/terminal_interface-curses-text_io-modular_io.adb
new file mode 100644
index 000000000000..fe8a6d0b1556
--- /dev/null
+++ b/Ada95/src/terminal_interface-curses-text_io-modular_io.adb
@@ -0,0 +1,70 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding --
+-- --
+-- Terminal_Interface.Curses.Text_IO.Modular_IO --
+-- --
+-- B O D Y --
+-- --
+------------------------------------------------------------------------------
+-- Copyright (c) 1998-2003,2009 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: Juergen Pfeifer, 1996
+-- Version Control:
+-- $Revision: 1.11 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+with Ada.Text_IO;
+with Terminal_Interface.Curses.Text_IO.Aux;
+
+package body Terminal_Interface.Curses.Text_IO.Modular_IO is
+
+ package Aux renames Terminal_Interface.Curses.Text_IO.Aux;
+ package MIO is new Ada.Text_IO.Modular_IO (Num);
+
+ procedure Put
+ (Win : Window;
+ Item : Num;
+ Width : Field := Default_Width;
+ Base : Number_Base := Default_Base)
+ is
+ Buf : String (1 .. Field'Last);
+ begin
+ MIO.Put (Buf, Item, Base);
+ Aux.Put_Buf (Win, Buf, Width);
+ end Put;
+
+ procedure Put
+ (Item : Num;
+ Width : Field := Default_Width;
+ Base : Number_Base := Default_Base)
+ is
+ begin
+ Put (Get_Window, Item, Width, Base);
+ end Put;
+
+end Terminal_Interface.Curses.Text_IO.Modular_IO;
diff --git a/Ada95/src/terminal_interface-curses-text_io-modular_io.ads b/Ada95/src/terminal_interface-curses-text_io-modular_io.ads
new file mode 100644
index 000000000000..68e70e556bf0
--- /dev/null
+++ b/Ada95/src/terminal_interface-curses-text_io-modular_io.ads
@@ -0,0 +1,63 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding --
+-- --
+-- Terminal_Interface.Curses.Text_IO.Modular_IO --
+-- --
+-- S P E C --
+-- --
+------------------------------------------------------------------------------
+-- Copyright (c) 1998-2003,2009 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: Juergen Pfeifer, 1996
+-- Version Control:
+-- $Revision: 1.12 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+generic
+ type Num is mod <>;
+
+package Terminal_Interface.Curses.Text_IO.Modular_IO is
+
+ Default_Width : Field := Num'Width;
+ Default_Base : Number_Base := 10;
+
+ procedure Put
+ (Win : Window;
+ Item : Num;
+ Width : Field := Default_Width;
+ Base : Number_Base := Default_Base);
+
+ procedure Put
+ (Item : Num;
+ Width : Field := Default_Width;
+ Base : Number_Base := Default_Base);
+
+private
+ pragma Inline (Put);
+
+end Terminal_Interface.Curses.Text_IO.Modular_IO;
diff --git a/Ada95/src/terminal_interface-curses-text_io.adb b/Ada95/src/terminal_interface-curses-text_io.adb
new file mode 100644
index 000000000000..4b29514efbf2
--- /dev/null
+++ b/Ada95/src/terminal_interface-curses-text_io.adb
@@ -0,0 +1,337 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding --
+-- --
+-- Terminal_Interface.Curses.Text_IO --
+-- --
+-- B O D Y --
+-- --
+------------------------------------------------------------------------------
+-- Copyright (c) 1998-2006,2009 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: Juergen Pfeifer, 1996
+-- Version Control:
+-- $Revision: 1.19 $
+-- $Date: 2009/12/26 17:40:46 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+package body Terminal_Interface.Curses.Text_IO is
+
+ Default_Window : Window := Null_Window;
+
+ procedure Set_Window (Win : Window)
+ is
+ begin
+ Default_Window := Win;
+ end Set_Window;
+
+ function Get_Window return Window
+ is
+ begin
+ if Default_Window = Null_Window then
+ return Standard_Window;
+ else
+ return Default_Window;
+ end if;
+ end Get_Window;
+ pragma Inline (Get_Window);
+
+ procedure Flush (Win : Window)
+ is
+ begin
+ Refresh (Win);
+ end Flush;
+
+ procedure Flush
+ is
+ begin
+ Flush (Get_Window);
+ end Flush;
+
+ --------------------------------------------
+ -- Specification of line and page lengths --
+ --------------------------------------------
+
+ -- There are no set routines in this package. I assume, that you allocate
+ -- the window with an appropriate size.
+ -- A scroll-window is interpreted as an page with unbounded page length,
+ -- i.e. it returns the conventional 0 as page length.
+
+ function Line_Length (Win : Window) return Count
+ is
+ N_Lines : Line_Count;
+ N_Cols : Column_Count;
+ begin
+ Get_Size (Win, N_Lines, N_Cols);
+ -- if Natural (N_Cols) > Natural (Count'Last) then
+ -- raise Layout_Error;
+ -- end if;
+ return Count (N_Cols);
+ end Line_Length;
+
+ function Line_Length return Count
+ is
+ begin
+ return Line_Length (Get_Window);
+ end Line_Length;
+
+ function Page_Length (Win : Window) return Count
+ is
+ N_Lines : Line_Count;
+ N_Cols : Column_Count;
+ begin
+ if Scrolling_Allowed (Win) then
+ return 0;
+ else
+ Get_Size (Win, N_Lines, N_Cols);
+ -- if Natural (N_Lines) > Natural (Count'Last) then
+ -- raise Layout_Error;
+ -- end if;
+ return Count (N_Lines);
+ end if;
+ end Page_Length;
+
+ function Page_Length return Count
+ is
+ begin
+ return Page_Length (Get_Window);
+ end Page_Length;
+
+ ------------------------------------
+ -- Column, Line, and Page Control --
+ ------------------------------------
+ procedure New_Line (Win : Window; Spacing : Positive_Count := 1)
+ is
+ P_Size : constant Count := Page_Length (Win);
+ begin
+ if not Spacing'Valid then
+ raise Constraint_Error;
+ end if;
+
+ for I in 1 .. Spacing loop
+ if P_Size > 0 and then Line (Win) >= P_Size then
+ New_Page (Win);
+ else
+ Add (Win, ASCII.LF);
+ end if;
+ end loop;
+ end New_Line;
+
+ procedure New_Line (Spacing : Positive_Count := 1)
+ is
+ begin
+ New_Line (Get_Window, Spacing);
+ end New_Line;
+
+ procedure New_Page (Win : Window)
+ is
+ begin
+ Clear (Win);
+ end New_Page;
+
+ procedure New_Page
+ is
+ begin
+ New_Page (Get_Window);
+ end New_Page;
+
+ procedure Set_Col (Win : Window; To : Positive_Count)
+ is
+ Y : Line_Position;
+ X1 : Column_Position;
+ X2 : Column_Position;
+ N : Natural;
+ begin
+ if not To'Valid then
+ raise Constraint_Error;
+ end if;
+
+ Get_Cursor_Position (Win, Y, X1);
+ N := Natural (To); N := N - 1;
+ X2 := Column_Position (N);
+ if X1 > X2 then
+ New_Line (Win, 1);
+ X1 := 0;
+ end if;
+ if X1 < X2 then
+ declare
+ Filler : constant String (Integer (X1) .. (Integer (X2) - 1))
+ := (others => ' ');
+ begin
+ Put (Win, Filler);
+ end;
+ end if;
+ end Set_Col;
+
+ procedure Set_Col (To : Positive_Count)
+ is
+ begin
+ Set_Col (Get_Window, To);
+ end Set_Col;
+
+ procedure Set_Line (Win : Window; To : Positive_Count)
+ is
+ Y1 : Line_Position;
+ Y2 : Line_Position;
+ X : Column_Position;
+ N : Natural;
+ begin
+ if not To'Valid then
+ raise Constraint_Error;
+ end if;
+
+ Get_Cursor_Position (Win, Y1, X);
+ N := Natural (To); N := N - 1;
+ Y2 := Line_Position (N);
+ if Y2 < Y1 then
+ New_Page (Win);
+ Y1 := 0;
+ end if;
+ if Y1 < Y2 then
+ New_Line (Win, Positive_Count (Y2 - Y1));
+ end if;
+ end Set_Line;
+
+ procedure Set_Line (To : Positive_Count)
+ is
+ begin
+ Set_Line (Get_Window, To);
+ end Set_Line;
+
+ function Col (Win : Window) return Positive_Count
+ is
+ Y : Line_Position;
+ X : Column_Position;
+ N : Natural;
+ begin
+ Get_Cursor_Position (Win, Y, X);
+ N := Natural (X); N := N + 1;
+ -- if N > Natural (Count'Last) then
+ -- raise Layout_Error;
+ -- end if;
+ return Positive_Count (N);
+ end Col;
+
+ function Col return Positive_Count
+ is
+ begin
+ return Col (Get_Window);
+ end Col;
+
+ function Line (Win : Window) return Positive_Count
+ is
+ Y : Line_Position;
+ X : Column_Position;
+ N : Natural;
+ begin
+ Get_Cursor_Position (Win, Y, X);
+ N := Natural (Y); N := N + 1;
+ -- if N > Natural (Count'Last) then
+ -- raise Layout_Error;
+ -- end if;
+ return Positive_Count (N);
+ end Line;
+
+ function Line return Positive_Count
+ is
+ begin
+ return Line (Get_Window);
+ end Line;
+
+ -----------------------
+ -- Characters Output --
+ -----------------------
+
+ procedure Put (Win : Window; Item : Character)
+ is
+ P_Size : constant Count := Page_Length (Win);
+ Y : Line_Position;
+ X : Column_Position;
+ L : Line_Count;
+ C : Column_Count;
+ begin
+ if P_Size > 0 then
+ Get_Cursor_Position (Win, Y, X);
+ Get_Size (Win, L, C);
+ if (Y + 1) = L and then (X + 1) = C then
+ New_Page (Win);
+ end if;
+ end if;
+ Add (Win, Item);
+ end Put;
+
+ procedure Put (Item : Character)
+ is
+ begin
+ Put (Get_Window, Item);
+ end Put;
+
+ --------------------
+ -- Strings-Output --
+ --------------------
+
+ procedure Put (Win : Window; Item : String)
+ is
+ P_Size : constant Count := Page_Length (Win);
+ Y : Line_Position;
+ X : Column_Position;
+ L : Line_Count;
+ C : Column_Count;
+ begin
+ if P_Size > 0 then
+ Get_Cursor_Position (Win, Y, X);
+ Get_Size (Win, L, C);
+ if (Y + 1) = L and then (X + 1 + Item'Length) >= C then
+ New_Page (Win);
+ end if;
+ end if;
+ Add (Win, Item);
+ end Put;
+
+ procedure Put (Item : String)
+ is
+ begin
+ Put (Get_Window, Item);
+ end Put;
+
+ procedure Put_Line
+ (Win : Window;
+ Item : String)
+ is
+ begin
+ Put (Win, Item);
+ New_Line (Win, 1);
+ end Put_Line;
+
+ procedure Put_Line
+ (Item : String)
+ is
+ begin
+ Put_Line (Get_Window, Item);
+ end Put_Line;
+
+end Terminal_Interface.Curses.Text_IO;
diff --git a/Ada95/src/terminal_interface-curses-text_io.ads b/Ada95/src/terminal_interface-curses-text_io.ads
new file mode 100644
index 000000000000..9c40329ff4bd
--- /dev/null
+++ b/Ada95/src/terminal_interface-curses-text_io.ads
@@ -0,0 +1,136 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding --
+-- --
+-- Terminal_Interface.Curses.Text_IO --
+-- --
+-- S P E C --
+-- --
+------------------------------------------------------------------------------
+-- Copyright (c) 1998-2003,2009 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: Juergen Pfeifer, 1996
+-- Version Control:
+-- $Revision: 1.14 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+with Ada.Text_IO;
+with Ada.IO_Exceptions;
+
+package Terminal_Interface.Curses.Text_IO is
+
+ use type Ada.Text_IO.Count;
+ subtype Count is Ada.Text_IO.Count;
+ subtype Positive_Count is Count range 1 .. Count'Last;
+
+ subtype Field is Ada.Text_IO.Field;
+ subtype Number_Base is Integer range 2 .. 16;
+
+ type Type_Set is (Lower_Case, Upper_Case, Mixed_Case);
+
+ -- For most of the routines you will see a version without a Window
+ -- type parameter. They will operate on a default window, which can
+ -- be set by the user. It is initially equal to Standard_Window.
+
+ procedure Set_Window (Win : Window);
+ -- Set Win as the default window
+
+ function Get_Window return Window;
+ -- Get the current default window
+
+ procedure Flush (Win : Window);
+ procedure Flush;
+
+ --------------------------------------------
+ -- Specification of line and page lengths --
+ --------------------------------------------
+
+ -- There are no set routines in this package. I assume, that you allocate
+ -- the window with an appropriate size.
+ -- A scroll-window is interpreted as an page with unbounded page length,
+ -- i.e. it returns the conventional 0 as page length.
+
+ function Line_Length (Win : Window) return Count;
+ function Line_Length return Count;
+
+ function Page_Length (Win : Window) return Count;
+ function Page_Length return Count;
+
+ ------------------------------------
+ -- Column, Line, and Page Control --
+ ------------------------------------
+ procedure New_Line (Win : Window; Spacing : Positive_Count := 1);
+ procedure New_Line (Spacing : Positive_Count := 1);
+
+ procedure New_Page (Win : Window);
+ procedure New_Page;
+
+ procedure Set_Col (Win : Window; To : Positive_Count);
+ procedure Set_Col (To : Positive_Count);
+
+ procedure Set_Line (Win : Window; To : Positive_Count);
+ procedure Set_Line (To : Positive_Count);
+
+ function Col (Win : Window) return Positive_Count;
+ function Col return Positive_Count;
+
+ function Line (Win : Window) return Positive_Count;
+ function Line return Positive_Count;
+
+ -----------------------
+ -- Characters-Output --
+ -----------------------
+
+ procedure Put (Win : Window; Item : Character);
+ procedure Put (Item : Character);
+
+ --------------------
+ -- Strings-Output --
+ --------------------
+
+ procedure Put (Win : Window; Item : String);
+ procedure Put (Item : String);
+
+ procedure Put_Line
+ (Win : Window;
+ Item : String);
+
+ procedure Put_Line
+ (Item : String);
+
+ -- Exceptions
+
+ Status_Error : exception renames Ada.IO_Exceptions.Status_Error;
+ Mode_Error : exception renames Ada.IO_Exceptions.Mode_Error;
+ Name_Error : exception renames Ada.IO_Exceptions.Name_Error;
+ Use_Error : exception renames Ada.IO_Exceptions.Use_Error;
+ Device_Error : exception renames Ada.IO_Exceptions.Device_Error;
+ End_Error : exception renames Ada.IO_Exceptions.End_Error;
+ Data_Error : exception renames Ada.IO_Exceptions.Data_Error;
+ Layout_Error : exception renames Ada.IO_Exceptions.Layout_Error;
+
+end Terminal_Interface.Curses.Text_IO;
diff --git a/Ada95/src/terminal_interface-curses-trace.adb_p b/Ada95/src/terminal_interface-curses-trace.adb_p
new file mode 100644
index 000000000000..f40d8bf31230
--- /dev/null
+++ b/Ada95/src/terminal_interface-curses-trace.adb_p
@@ -0,0 +1,97 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding --
+-- --
+-- Terminal_Interface.Curses.Trace --
+-- --
+-- B O D Y --
+-- --
+------------------------------------------------------------------------------
+-- Copyright (c) 2000-2004,2009 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: Juergen Pfeifer, 1996
+-- Version Control:
+-- $Revision: 1.6 $
+-- 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);
+ pragma Import (C, traceC, "trace");
+ begin
+ traceC (TraceAda_To_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, "_tracef");
+ Txt : char_array (0 .. str'Length);
+ Length : size_t;
+ formatstr : constant String := "%s" & ASCII.NUL;
+ formattxt : char_array (0 .. formatstr'Length);
+ begin
+ To_C (formatstr, formattxt, Length);
+ To_C (str, Txt, Length);
+ tracef (formattxt, Txt);
+ end Trace_Put;
+#else
+ procedure Trace_On (x : Trace_Attribute_Set) is
+#if PRAGMA_UNREF
+ pragma Unreferenced (x);
+#end if;
+ begin
+ null;
+ end Trace_On;
+
+ procedure Trace_Put (str : String) is
+#if PRAGMA_UNREF
+ pragma Unreferenced (str);
+#end if;
+ begin
+ null;
+ end Trace_Put;
+#end if;
+
+end Terminal_Interface.Curses.Trace;
diff --git a/Ada95/src/terminal_interface.ads b/Ada95/src/terminal_interface.ads
new file mode 100644
index 000000000000..fdaaf9fe7270
--- /dev/null
+++ b/Ada95/src/terminal_interface.ads
@@ -0,0 +1,47 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT ncurses Binding --
+-- --
+-- Terminal_Interface --
+-- --
+-- S P E C --
+-- --
+------------------------------------------------------------------------------
+-- Copyright (c) 1998,2006 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: Juergen Pfeifer, 1996
+-- Version Control:
+-- $Revision: 1.14 $
+-- $Date: 2006/06/25 14:30:22 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+package Terminal_Interface is
+ pragma Pure (Terminal_Interface);
+--
+-- Everything is in the child units
+--
+end Terminal_Interface;