Base version of ncurses-5.7 library
diff --git a/Ada95/src/Makefile.in b/Ada95/src/Makefile.in
new file mode 100644
index 0000000..1c072bf
--- /dev/null
+++ b/Ada95/src/Makefile.in
@@ -0,0 +1,388 @@
+##############################################################################
+# Copyright (c) 1998-2003,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
+#
+# $Id: Makefile.in,v 1.31 2007/09/15 18:22:24 tom Exp $
+#
+.SUFFIXES:
+
+SHELL = /bin/sh
+THIS = Makefile
+
+MODEL = ../../@DFT_OBJ_SUBDIR@
+DESTDIR = @DESTDIR@
+srcdir = @srcdir@
+prefix = @prefix@
+exec_prefix = @exec_prefix@
+ADA_INCLUDE = @ADA_INCLUDE@
+
+INSTALL = @INSTALL@
+INSTALL_DATA = @INSTALL_DATA@
+
+AR = @AR@
+AR_OPTS = @AR_OPTS@
+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)
+
+ADAMAKE = @cf_ada_make@
+ADAMAKEFLAGS =
+
+CARGS = -cargs $(ADAFLAGS)
+LARGS =
+
+ALIB = @cf_ada_package@
+ABASE = $(ALIB)-curses
+
+LIBALIS=$(ALIB).ali \
+ $(ABASE)-aux.ali \
+ $(ABASE).ali \
+ $(ABASE)-terminfo.ali \
+ $(ABASE)-termcap.ali \
+ $(ABASE)-putwin.ali \
+ $(ABASE)-trace.ali \
+ $(ABASE)-mouse.ali \
+ $(ABASE)-panels.ali \
+ $(ABASE)-menus.ali \
+ $(ABASE)-forms.ali \
+ $(ABASE)-forms-field_types.ali \
+ $(ABASE)-forms-field_types-alpha.ali \
+ $(ABASE)-forms-field_types-alphanumeric.ali \
+ $(ABASE)-forms-field_types-intfield.ali \
+ $(ABASE)-forms-field_types-numeric.ali \
+ $(ABASE)-forms-field_types-regexp.ali \
+ $(ABASE)-forms-field_types-enumeration.ali \
+ $(ABASE)-forms-field_types-ipv4_address.ali \
+ $(ABASE)-forms-field_types-user.ali \
+ $(ABASE)-forms-field_types-user-choice.ali \
+ $(ABASE)-text_io.ali \
+ $(ABASE)-text_io-aux.ali
+
+# Ada Library files for generic packages. Since gnat 3.10 they are
+# also compiled
+GENALIS=$(ABASE)-menus-menu_user_data.ali \
+ $(ABASE)-menus-item_user_data.ali \
+ $(ABASE)-forms-form_user_data.ali \
+ $(ABASE)-forms-field_user_data.ali \
+ $(ABASE)-forms-field_types-enumeration-ada.ali \
+ $(ABASE)-panels-user_data.ali \
+ $(ABASE)-text_io-integer_io.ali \
+ $(ABASE)-text_io-float_io.ali \
+ $(ABASE)-text_io-fixed_io.ali \
+ $(ABASE)-text_io-decimal_io.ali \
+ $(ABASE)-text_io-enumeration_io.ali \
+ $(ABASE)-text_io-modular_io.ali \
+ $(ABASE)-text_io-complex_io.ali
+
+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 :: libAdaCurses.a
+ @echo done
+
+libAdaCurses.a :: dotouch $(LIBOBJS) @cf_generic_objects@
+ $(AR) $(AR_OPTS) $@ $(LIBOBJS) @cf_generic_objects@
+
+dotouch :
+ @sh -c 'for f in $(LIBALIS) $(GENALIS); do test -f $$f || touch $$f; done'
+
+sources :
+ @echo made $@
+
+libs \
+install \
+install.libs \
+uninstall \
+uninstall.libs ::
+ @echo made $@
+
+generics: $(GENALIS)
+ @echo made $@
+
+mostlyclean ::
+ rm -f *.o *.ali b_t*.* *.s $(PROGS) a.out core b_*_test.c *.xr[bs] *.a
+
+clean :: mostlyclean
+ rm -f $(LIBALIS) $(GENALIS) $(LIBOBJS) $(GENOBJS) $(ABASE)-trace.adb
+
+distclean :: clean
+ rm -f Makefile
+
+realclean :: distclean
+
+BASEDEPS=$(ABASE).ads $(ABASE)-aux.ads $(ABASE).adb
+
+$(ALIB).o: $(srcdir)/$(ALIB).ads
+ $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ALIB).ads
+
+
+$(ABASE)-aux.o: $(srcdir)/$(ABASE)-aux.adb $(BASEDEPS)
+ $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-aux.adb
+
+
+$(ABASE).o: $(ABASE).adb $(BASEDEPS)
+ $(ADA) $(ADAFLAGS) -c -o $@ $(ABASE).adb
+
+
+$(ABASE)-terminfo.o: \
+ $(srcdir)/$(ABASE)-terminfo.ads \
+ $(srcdir)/$(ABASE)-terminfo.adb $(BASEDEPS)
+ $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-terminfo.adb
+
+
+$(ABASE)-termcap.o: \
+ $(srcdir)/$(ABASE)-termcap.ads \
+ $(srcdir)/$(ABASE)-termcap.adb $(BASEDEPS)
+ $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-termcap.adb
+
+
+$(ABASE)-putwin.o: \
+ $(srcdir)/$(ABASE)-putwin.ads \
+ $(srcdir)/$(ABASE)-putwin.adb $(BASEDEPS)
+ $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-putwin.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 $@
+
+$(ABASE)-trace.o: \
+ $(ABASE)-trace.ads \
+ $(ABASE)-trace.adb $(BASEDEPS)
+ $(ADA) $(ADAFLAGS) -c -o $@ $(ABASE)-trace.adb
+
+
+$(ABASE)-mouse.o: \
+ $(ABASE)-mouse.ads \
+ $(srcdir)/$(ABASE)-mouse.adb $(BASEDEPS)
+ $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-mouse.adb
+
+
+$(ABASE)-panels.o: \
+ $(ABASE)-panels.ads \
+ $(srcdir)/$(ABASE)-panels.adb $(BASEDEPS)
+ $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-panels.adb
+
+
+$(ABASE)-menus.o: \
+ $(ABASE)-menus.ads \
+ $(srcdir)/$(ABASE)-menus.adb $(BASEDEPS)
+ $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-menus.adb
+
+
+$(ABASE)-forms.o: \
+ $(ABASE)-forms.ads \
+ $(srcdir)/$(ABASE)-forms.adb $(BASEDEPS)
+ $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-forms.adb
+
+$(ABASE)-forms-field_types.o: \
+ $(ABASE)-forms-field_types.ads \
+ $(srcdir)/$(ABASE)-forms-field_types.adb $(BASEDEPS)
+ $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-forms-field_types.adb
+
+$(ABASE)-forms-field_types-alpha.o: \
+ $(srcdir)/$(ABASE)-forms-field_types-alpha.ads \
+ $(srcdir)/$(ABASE)-forms-field_types-alpha.adb $(BASEDEPS)
+ $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-forms-field_types-alpha.adb
+
+$(ABASE)-forms-field_types-alphanumeric.o: \
+ $(srcdir)/$(ABASE)-forms-field_types-alphanumeric.ads \
+ $(srcdir)/$(ABASE)-forms-field_types-alphanumeric.adb $(BASEDEPS)
+ $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-forms-field_types-alphanumeric.adb
+
+$(ABASE)-forms-field_types-intfield.o: \
+ $(srcdir)/$(ABASE)-forms-field_types-intfield.ads \
+ $(srcdir)/$(ABASE)-forms-field_types-intfield.adb $(BASEDEPS)
+ $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-forms-field_types-intfield.adb
+
+$(ABASE)-forms-field_types-numeric.o: \
+ $(srcdir)/$(ABASE)-forms-field_types-numeric.ads \
+ $(srcdir)/$(ABASE)-forms-field_types-numeric.adb $(BASEDEPS)
+ $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-forms-field_types-numeric.adb
+
+$(ABASE)-forms-field_types-regexp.o: \
+ $(srcdir)/$(ABASE)-forms-field_types-regexp.ads \
+ $(srcdir)/$(ABASE)-forms-field_types-regexp.adb $(BASEDEPS)
+ $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-forms-field_types-regexp.adb
+
+$(ABASE)-forms-field_types-enumeration.o: \
+ $(srcdir)/$(ABASE)-forms-field_types-enumeration.ads \
+ $(srcdir)/$(ABASE)-forms-field_types-enumeration.adb $(BASEDEPS)
+ $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-forms-field_types-enumeration.adb
+
+$(ABASE)-forms-field_types-ipv4_address.o: \
+ $(srcdir)/$(ABASE)-forms-field_types-ipv4_address.ads \
+ $(srcdir)/$(ABASE)-forms-field_types-ipv4_address.adb $(BASEDEPS)
+ $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-forms-field_types-ipv4_address.adb
+
+$(ABASE)-forms-field_types-user.o: \
+ $(srcdir)/$(ABASE)-forms-field_types-user.ads \
+ $(srcdir)/$(ABASE)-forms-field_types-user.adb $(BASEDEPS)
+ $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-forms-field_types-user.adb
+
+$(ABASE)-forms-field_types-user-choice.o: \
+ $(srcdir)/$(ABASE)-forms-field_types-user-choice.ads \
+ $(srcdir)/$(ABASE)-forms-field_types-user-choice.adb $(BASEDEPS)
+ $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-forms-field_types-user-choice.adb
+
+$(ABASE)-text_io.o: \
+ $(srcdir)/$(ABASE)-text_io.ads \
+ $(srcdir)/$(ABASE)-text_io.adb $(BASEDEPS)
+ $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-text_io.adb
+
+$(ABASE)-text_io-aux.o: \
+ $(srcdir)/$(ABASE)-text_io-aux.ads \
+ $(srcdir)/$(ABASE)-text_io-aux.adb $(BASEDEPS)
+ $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-text_io-aux.adb
+
+$(ABASE)-menus-menu_user_data.o: \
+ $(ABASE)-menus-menu_user_data.ads \
+ $(srcdir)/$(ABASE)-menus-menu_user_data.adb $(BASEDEPS)
+ $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-menus-menu_user_data.adb
+
+$(ABASE)-menus-item_user_data.o: \
+ $(ABASE)-menus-item_user_data.ads \
+ $(srcdir)/$(ABASE)-menus-item_user_data.adb $(BASEDEPS)
+ $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-menus-item_user_data.adb
+
+$(ABASE)-forms-form_user_data.o: \
+ $(ABASE)-forms-form_user_data.ads \
+ $(srcdir)/$(ABASE)-forms-form_user_data.adb $(BASEDEPS)
+ $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-forms-form_user_data.adb
+
+$(ABASE)-forms-field_user_data.o: \
+ $(ABASE)-forms-field_user_data.ads \
+ $(srcdir)/$(ABASE)-forms-field_user_data.adb $(BASEDEPS)
+ $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-forms-field_user_data.adb
+
+$(ABASE)-forms-field_types-enumeration-ada.o: \
+ $(srcdir)/$(ABASE)-forms-field_types-enumeration-ada.ads \
+ $(srcdir)/$(ABASE)-forms-field_types-enumeration-ada.adb $(BASEDEPS)
+ $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-forms-field_types-enumeration-ada.adb
+
+$(ABASE)-panels-user_data.o: \
+ $(ABASE)-panels-user_data.ads \
+ $(srcdir)/$(ABASE)-panels-user_data.adb $(BASEDEPS)
+ $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-panels-user_data.adb
+
+$(ABASE)-text_io-integer_io.o: \
+ $(srcdir)/$(ABASE)-text_io-integer_io.ads \
+ $(srcdir)/$(ABASE)-text_io-integer_io.adb $(BASEDEPS)
+ $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-text_io-integer_io.adb
+
+$(ABASE)-text_io-float_io.o: \
+ $(srcdir)/$(ABASE)-text_io-float_io.ads \
+ $(srcdir)/$(ABASE)-text_io-float_io.adb $(BASEDEPS)
+ $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-text_io-float_io.adb
+
+$(ABASE)-text_io-fixed_io.o: \
+ $(srcdir)/$(ABASE)-text_io-fixed_io.ads \
+ $(srcdir)/$(ABASE)-text_io-fixed_io.adb $(BASEDEPS)
+ $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-text_io-fixed_io.adb
+
+$(ABASE)-text_io-decimal_io.o: \
+ $(srcdir)/$(ABASE)-text_io-decimal_io.ads \
+ $(srcdir)/$(ABASE)-text_io-decimal_io.adb $(BASEDEPS)
+ $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-text_io-decimal_io.adb
+
+$(ABASE)-text_io-enumeration_io.o: \
+ $(srcdir)/$(ABASE)-text_io-enumeration_io.ads \
+ $(srcdir)/$(ABASE)-text_io-enumeration_io.adb $(BASEDEPS)
+ $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-text_io-enumeration_io.adb
+
+$(ABASE)-text_io-modular_io.o: \
+ $(srcdir)/$(ABASE)-text_io-modular_io.ads \
+ $(srcdir)/$(ABASE)-text_io-modular_io.adb $(BASEDEPS)
+ $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-text_io-modular_io.adb
+
+$(ABASE)-text_io-complex_io.o: \
+ $(srcdir)/$(ABASE)-text_io-complex_io.ads \
+ $(srcdir)/$(ABASE)-text_io-complex_io.adb $(BASEDEPS)
+ $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-text_io-complex_io.adb
diff --git a/Ada95/src/terminal_interface-curses-aux.adb b/Ada95/src/terminal_interface-curses-aux.adb
new file mode 100644
index 0000000..812e8cc
--- /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 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
+------------------------------------------------------------------------------
+package body Terminal_Interface.Curses.Aux is
+ --
+ -- Some helpers
+ procedure Fill_String (Cp : in 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 0000000..f437ce6
--- /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 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 $
+-- $Date: 2008/07/26 18:50:25 $
+-- 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 : in Field;
+ Typ : in 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 0000000..6f0b79d
--- /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 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 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 : in Field;
+ Typ : in 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 0000000..0c3ca29
--- /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 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 $
+-- $Date: 2008/07/26 18:50:15 $
+-- 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 : in Field;
+ Typ : in 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 0000000..1f21950
--- /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 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 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 : in Field;
+ Typ : in 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 0000000..b3eaf44
--- /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 0000000..48fad09
--- /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 0000000..8be20f2
--- /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 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.7 $
+-- 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 : in Field;
+ Typ : in 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 0000000..5a7e411
--- /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 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 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 : in Field;
+ Typ : in 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 0000000..61d66c4
--- /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 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 $
+-- $Date: 2008/07/26 18:50:06 $
+-- 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 : in Field;
+ Typ : in 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 0000000..b285ca2
--- /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 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 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 : in Field;
+ Typ : in 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 0000000..3d7c5b5
--- /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 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 $
+-- $Date: 2008/07/26 18:49:47 $
+-- 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 : in Field;
+ Typ : in 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 0000000..6d0aef0
--- /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 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 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 : in Field;
+ Typ : in 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 0000000..79f8489
--- /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 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: 2008/07/26 18:49:57 $
+-- 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 : in Field;
+ Typ : in 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 0000000..f211bc8
--- /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 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 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 : in Field;
+ Typ : in 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 0000000..cbd9e2f
--- /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 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 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 : in Field;
+ Typ : in 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 0000000..1e451ab
--- /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 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 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 : in Field;
+ Typ : in 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 0000000..f26a42c
--- /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 0000000..1e69f43
--- /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 0000000..0b4c136
--- /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-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:49:28 $
+-- 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 : in Field;
+ Typ : in 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 0000000..acec636
--- /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 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:38 $
+-- 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 : in Field;
+ Typ : in 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 0000000..c681c80
--- /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-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.20 $
+-- $Date: 2008/07/26 18:50:33 $
+-- 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 : in 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 : in 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 0000000..817ebe5
--- /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 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 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 : in Field;
+ Data : in 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 : in 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 : in 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 0000000..50c6708
--- /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 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
+------------------------------------------------------------------------------
+-- |
+-- |=====================================================================
+-- | 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 : in Form;
+ Data : in 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 : in 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 : in 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 0000000..8b01e16
--- /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-2004,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.26 $
+-- $Date: 2008/07/26 18:50:44 $
+-- 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 : in 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 : in Field;
+ Just : in 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 : in Field;
+ Buffer : in Buffer_Number := Buffer_Number'First;
+ Str : in 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 : in Field;
+ Buffer : in 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 : in Field;
+ Buffer : in 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 : in Field;
+ Status : in 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 : in Field;
+ Max : in 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 : in Field;
+ Options : in 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 : in Field;
+ Options : in 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 : in 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 : in Field;
+ Fore : in Character_Attribute_Set := Normal_Video;
+ Color : in 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 : in 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 : in 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 : in Field;
+ Back : in Character_Attribute_Set := Normal_Video;
+ Color : in 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 : in 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 : in 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 : in Field;
+ Pad : in 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 : in 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 : in 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 : in 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 : in Form;
+ Win : in 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 : in Form;
+ Win : in 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 : in 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 : in Form;
+ Proc : in 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 : in Form;
+ Proc : in 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 : in Form;
+ Proc : in 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 : in Form;
+ Proc : in 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 : in Form;
+ Flds : in 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 : in Field;
+ Line : in Line_Position;
+ Column : in 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 : in Form;
+ Options : in 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 : in Form;
+ Options : in 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 : in 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 : in Form;
+ Post : in 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 : in Form;
+ Fld : in 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 : in 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 : in Form;
+ Page : in 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 : in Field;
+ New_Page : in 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 : in 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 0000000..6c35d33
--- /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 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 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 : in Item;
+ Data : in 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 : in 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 : in 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 0000000..20b9e86
--- /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 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 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 : in Menu;
+ Data : in 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 : in 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 : in 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 0000000..0b24c74
--- /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-2004,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.26 $
+-- $Date: 2008/07/26 18:50: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 : in 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 : in Item;
+ Value : in 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 : in Item;
+ Options : in 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 : in Item;
+ Options : in 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 : in 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 : in 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 : in 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 : in 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 : in 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 : in Menu;
+ Itm : in 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 : in Menu;
+ Line : in 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 : in Menu;
+ Post : in 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 : in Menu;
+ Options : in 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 : in Menu;
+ Options : in Menu_Option_Set;
+ On : in 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 : in 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 : in Menu;
+ Win : in 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 : in Menu;
+ Win : in 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 : in 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 : in Menu;
+ Mark : in 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 : in 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 : in Menu;
+ Fore : in Character_Attribute_Set := Normal_Video;
+ Color : in 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 : in 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 : in 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 : in Menu;
+ Back : in Character_Attribute_Set := Normal_Video;
+ Color : in 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 : in 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 : in 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 : in Menu;
+ Grey : in Character_Attribute_Set := Normal_Video;
+ Color : in 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 : in 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 : in 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 : in Menu;
+ Pad : in 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 : in 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 : in Menu;
+ Descr : in Column_Position := 0;
+ Row : in Line_Position := 0;
+ Col : in 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 : in 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 : in 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 : in Menu;
+ Lines : in Line_Count;
+ Columns : in 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 : in 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 : in Menu;
+ Proc : in 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 : in Menu;
+ Proc : in 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 : in Menu;
+ Proc : in 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 : in Menu;
+ Proc : in 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 : in Menu;
+ Items : in 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 : in 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 0000000..fa4c69d
--- /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-2004,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.22 $
+-- $Date: 2008/07/26 18:51:11 $
+-- 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, "_nc_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 : in Mouse_Button;
+ State : in 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 : in Mouse_Button;
+ State : in 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 : in Event_Mask := No_Events)
+ is
+ begin
+ if Mask /= No_Events then
+ Beep;
+ end if;
+ end End_Mouse;
+
+ procedure Dispatch_Event (Mask : in Event_Mask;
+ Button : out Mouse_Button;
+ State : out Button_State);
+
+ procedure Dispatch_Event (Mask : in 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 : in 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 : in 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 0000000..231efae
--- /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 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 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 : in Panel;
+ Data : in 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 : in 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 : in 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 0000000..d7e18fa
--- /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 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: 2004/08/21 21:37:00 $
+-- 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 : in 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 : in 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 : in 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 : in 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 : in Panel;
+ Win : in 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 : in Panel;
+ Line : in Line_Position;
+ Column : in 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 0000000..986cd6b
--- /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 0000000..d302bdc
--- /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 0000000..fd3c646
--- /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-2004,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.11 $
+-- $Date: 2006/06/25 14:30:22 $
+-- 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 : in 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 0000000..dd01396
--- /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 0000000..a3fbe25
--- /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-2000,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.5 $
+-- $Date: 2006/06/25 14:30:22 $
+-- 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 : in chars_ptr) return Boolean;
+
+ function Is_MinusOne_Pointer (P : in 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 0000000..fb39bf1
--- /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 0000000..06b4876
--- /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 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: 2006/06/25 14:24:40 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+package body Terminal_Interface.Curses.Text_IO.Aux is
+
+ procedure Put_Buf
+ (Win : in Window;
+ Buf : in String;
+ Width : in Field;
+ Signal : in Boolean := True;
+ Ljust : in 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 0000000..df8a9bd
--- /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 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: 2006/06/25 14:24:40 $
+-- 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 : in Window; -- The output window
+ Buf : in String; -- The buffer containing the text
+ Width : in Field; -- The width of the output field
+ Signal : in Boolean := True; -- If true, we raise Layout_Error
+ Ljust : in 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 0000000..3b5871e
--- /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 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
+------------------------------------------------------------------------------
+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 : in Window;
+ Item : in Complex;
+ Fore : in Field := Default_Fore;
+ Aft : in Field := Default_Aft;
+ Exp : in 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 : in Complex;
+ Fore : in Field := Default_Fore;
+ Aft : in Field := Default_Aft;
+ Exp : in 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 0000000..233eb3c
--- /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 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
+------------------------------------------------------------------------------
+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 : in Window;
+ Item : in Complex;
+ Fore : in Field := Default_Fore;
+ Aft : in Field := Default_Aft;
+ Exp : in Field := Default_Exp);
+
+ procedure Put
+ (Item : in Complex;
+ Fore : in Field := Default_Fore;
+ Aft : in Field := Default_Aft;
+ Exp : in 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 0000000..02068a0
--- /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 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
+------------------------------------------------------------------------------
+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 : in Window;
+ Item : in Num;
+ Fore : in Field := Default_Fore;
+ Aft : in Field := Default_Aft;
+ Exp : in 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 : in Num;
+ Fore : in Field := Default_Fore;
+ Aft : in Field := Default_Aft;
+ Exp : in 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 0000000..6f6fe75
--- /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 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
+------------------------------------------------------------------------------
+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 : in Window;
+ Item : in Num;
+ Fore : in Field := Default_Fore;
+ Aft : in Field := Default_Aft;
+ Exp : in Field := Default_Exp);
+
+ procedure Put
+ (Item : in Num;
+ Fore : in Field := Default_Fore;
+ Aft : in Field := Default_Aft;
+ Exp : in 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 0000000..528873a
--- /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 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
+------------------------------------------------------------------------------
+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 : in Window;
+ Item : in Enum;
+ Width : in Field := Default_Width;
+ Set : in 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 : in Enum;
+ Width : in Field := Default_Width;
+ Set : in 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 0000000..b221d7f
--- /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 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
+------------------------------------------------------------------------------
+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 : in Window;
+ Item : in Enum;
+ Width : in Field := Default_Width;
+ Set : in Type_Set := Default_Setting);
+
+ procedure Put
+ (Item : in Enum;
+ Width : in Field := Default_Width;
+ Set : in 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 0000000..e74f148
--- /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 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
+------------------------------------------------------------------------------
+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 : in Window;
+ Item : in Num;
+ Fore : in Field := Default_Fore;
+ Aft : in Field := Default_Aft;
+ Exp : in 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 : in Num;
+ Fore : in Field := Default_Fore;
+ Aft : in Field := Default_Aft;
+ Exp : in 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 0000000..4b8b136
--- /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 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
+------------------------------------------------------------------------------
+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 : in Window;
+ Item : in Num;
+ Fore : in Field := Default_Fore;
+ Aft : in Field := Default_Aft;
+ Exp : in Field := Default_Exp);
+
+ procedure Put
+ (Item : in Num;
+ Fore : in Field := Default_Fore;
+ Aft : in Field := Default_Aft;
+ Exp : in 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 0000000..19d261b
--- /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 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
+------------------------------------------------------------------------------
+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 : in Window;
+ Item : in Num;
+ Fore : in Field := Default_Fore;
+ Aft : in Field := Default_Aft;
+ Exp : in 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 : in Num;
+ Fore : in Field := Default_Fore;
+ Aft : in Field := Default_Aft;
+ Exp : in 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 0000000..0856523
--- /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 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
+------------------------------------------------------------------------------
+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 : in Window;
+ Item : in Num;
+ Fore : in Field := Default_Fore;
+ Aft : in Field := Default_Aft;
+ Exp : in Field := Default_Exp);
+
+ procedure Put
+ (Item : in Num;
+ Fore : in Field := Default_Fore;
+ Aft : in Field := Default_Aft;
+ Exp : in 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 0000000..e694e08
--- /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 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
+------------------------------------------------------------------------------
+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 : in Window;
+ Item : in Num;
+ Width : in Field := Default_Width;
+ Base : in 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 : in Num;
+ Width : in Field := Default_Width;
+ Base : in 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 0000000..d8b169a
--- /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 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
+------------------------------------------------------------------------------
+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 : in Window;
+ Item : in Num;
+ Width : in Field := Default_Width;
+ Base : in Number_Base := Default_Base);
+
+ procedure Put
+ (Item : in Num;
+ Width : in Field := Default_Width;
+ Base : in 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 0000000..8cc1d4a
--- /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 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
+------------------------------------------------------------------------------
+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 : in Window;
+ Item : in Num;
+ Width : in Field := Default_Width;
+ Base : in 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 : in Num;
+ Width : in Field := Default_Width;
+ Base : in 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 0000000..618706f
--- /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 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
+------------------------------------------------------------------------------
+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 : in Window;
+ Item : in Num;
+ Width : in Field := Default_Width;
+ Base : in Number_Base := Default_Base);
+
+ procedure Put
+ (Item : in Num;
+ Width : in Field := Default_Width;
+ Base : in 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 0000000..255b123
--- /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-2004,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.18 $
+-- $Date: 2006/06/25 14:24:40 $
+-- Binding Version 01.00
+------------------------------------------------------------------------------
+package body Terminal_Interface.Curses.Text_IO is
+
+ Default_Window : Window := Null_Window;
+
+ procedure Set_Window (Win : in 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 : in 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 : in 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 : in 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 : in Window; Spacing : in 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 : in Positive_Count := 1)
+ is
+ begin
+ New_Line (Get_Window, Spacing);
+ end New_Line;
+
+ procedure New_Page (Win : in Window)
+ is
+ begin
+ Clear (Win);
+ end New_Page;
+
+ procedure New_Page
+ is
+ begin
+ New_Page (Get_Window);
+ end New_Page;
+
+ procedure Set_Col (Win : in Window; To : in 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 : in Positive_Count)
+ is
+ begin
+ Set_Col (Get_Window, To);
+ end Set_Col;
+
+ procedure Set_Line (Win : in Window; To : in 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 : in Positive_Count)
+ is
+ begin
+ Set_Line (Get_Window, To);
+ end Set_Line;
+
+ function Col (Win : in 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 : in 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 : in Window; Item : in 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 : in Character)
+ is
+ begin
+ Put (Get_Window, Item);
+ end Put;
+
+ --------------------
+ -- Strings-Output --
+ --------------------
+
+ procedure Put (Win : in Window; Item : in 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 : in String)
+ is
+ begin
+ Put (Get_Window, Item);
+ end Put;
+
+ procedure Put_Line
+ (Win : in Window;
+ Item : in String)
+ is
+ begin
+ Put (Win, Item);
+ New_Line (Win, 1);
+ end Put_Line;
+
+ procedure Put_Line
+ (Item : in 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 0000000..2f6c48a
--- /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 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 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 : in Window);
+ -- Set Win as the default window
+
+ function Get_Window return Window;
+ -- Get the current default window
+
+ procedure Flush (Win : in 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 : in Window) return Count;
+ function Line_Length return Count;
+
+ function Page_Length (Win : in Window) return Count;
+ function Page_Length return Count;
+
+ ------------------------------------
+ -- Column, Line, and Page Control --
+ ------------------------------------
+ procedure New_Line (Win : in Window; Spacing : in Positive_Count := 1);
+ procedure New_Line (Spacing : in Positive_Count := 1);
+
+ procedure New_Page (Win : in Window);
+ procedure New_Page;
+
+ procedure Set_Col (Win : in Window; To : in Positive_Count);
+ procedure Set_Col (To : in Positive_Count);
+
+ procedure Set_Line (Win : in Window; To : in Positive_Count);
+ procedure Set_Line (To : in Positive_Count);
+
+ function Col (Win : in Window) return Positive_Count;
+ function Col return Positive_Count;
+
+ function Line (Win : in Window) return Positive_Count;
+ function Line return Positive_Count;
+
+ -----------------------
+ -- Characters-Output --
+ -----------------------
+
+ procedure Put (Win : in Window; Item : in Character);
+ procedure Put (Item : in Character);
+
+ --------------------
+ -- Strings-Output --
+ --------------------
+
+ procedure Put (Win : in Window; Item : in String);
+ procedure Put (Item : in String);
+
+ procedure Put_Line
+ (Win : in Window;
+ Item : in String);
+
+ procedure Put_Line
+ (Item : in 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 0000000..747454a
--- /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 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.5 $
+-- 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 0000000..fdaaf9f
--- /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;