diff options
Diffstat (limited to 'Ada95/src')
63 files changed, 0 insertions, 8019 deletions
diff --git a/Ada95/src/Makefile.in b/Ada95/src/Makefile.in deleted file mode 100644 index f6c3e75673bc0..0000000000000 --- a/Ada95/src/Makefile.in +++ /dev/null @@ -1,319 +0,0 @@ -############################################################################## -# Copyright (c) 1998-2010,2011 Free Software Foundation, Inc. # -# # -# Permission is hereby granted, free of charge, to any person obtaining a # -# copy of this software and associated documentation files (the "Software"), # -# 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.60 2011/03/31 09:46:16 tom Exp $ -# -.SUFFIXES: - -SHELL = /bin/sh -VPATH = @srcdir@ -THIS = Makefile - -MODEL = ../../@DFT_OBJ_SUBDIR@ - -DESTDIR = @DESTDIR@ - -top_srcdir = @top_srcdir@ -srcdir = @srcdir@ -prefix = @prefix@ -exec_prefix = @exec_prefix@ -includedir = @includedir@ -libdir = @libdir@ - -LIBDIR = $(DESTDIR)$(libdir) -ADA_INCLUDE = $(DESTDIR)@ADA_INCLUDE@ -ADA_OBJECTS = $(DESTDIR)@ADA_OBJECTS@ - -INSTALL = @INSTALL@ -INSTALL_LIB = @INSTALL@ @INSTALL_LIB@ - -AR = @AR@ -ARFLAGS = @ARFLAGS@ -AWK = @AWK@ -LN_S = @LN_S@ - -CC = @CC@ -CFLAGS = @CFLAGS@ - -CPPFLAGS = @ACPPFLAGS@ @CPPFLAGS@ \ - -DHAVE_CONFIG_H -I$(srcdir) - -CCFLAGS = $(CPPFLAGS) $(CFLAGS) - -CFLAGS_NORMAL = $(CCFLAGS) -CFLAGS_DEBUG = $(CCFLAGS) @CC_G_OPT@ -DTRACE -CFLAGS_PROFILE = $(CCFLAGS) -pg -CFLAGS_SHARED = $(CCFLAGS) @CC_SHARED_OPTS@ - -CFLAGS_DEFAULT = $(CFLAGS_@DFT_UPR_MODEL@) - -LINK = $(CC) -LDFLAGS = @LDFLAGS@ @LD_MODEL@ @LIBS@ - -RANLIB = @RANLIB@ - -################################################################################ -ADA = @cf_ada_compiler@ -ADAPREP = gnatprep -ADAFLAGS = @ADAFLAGS@ -I. -I$(srcdir) - -LIB_NAME = AdaCurses -SONAME = @ADA_SHAREDLIB@ - -GNAT_PROJECT = $(srcdir)/library.gpr - -# build/source are the Ada95 tree -BUILD_DIR = .. -SOURCE_DIR = .. - -BUILD_DIR_LIB = $(BUILD_DIR)/lib -SOURCE_DIR_SRC = $(SOURCE_DIR)/src - -ADAMAKE = @cf_ada_make@ -ADAMAKEFLAGS = \ - -P$(GNAT_PROJECT) \ - -XBUILD_DIR=`cd $(BUILD_DIR);pwd` \ - -XSOURCE_DIR=`cd $(SOURCE_DIR);pwd` \ - -XSOURCE_DIR2=`cd $(srcdir);pwd` \ - -XLIB_NAME=$(LIB_NAME) \ - -XSONAME=$(SONAME) - -CARGS = -cargs $(ADAFLAGS) -LARGS = - -STATIC_LIBNAME = lib$(LIB_NAME).a -SHARED_LIBNAME = $(SONAME) -SHARED_SYMLINK = lib$(LIB_NAME).so - -ALIB = @cf_ada_package@ -ABASE = $(ALIB)-curses -################################################################################ -GENERATED_SOURCES=$(ABASE).ads \ - $(ABASE).adb \ - $(ABASE)-aux.ads \ - $(ABASE)-trace.ads \ - $(ABASE)-menus.ads \ - $(ABASE)-forms.ads \ - $(ABASE)-mouse.ads \ - $(ABASE)-panels.ads \ - $(ABASE)-menus-menu_user_data.ads \ - $(ABASE)-menus-item_user_data.ads \ - $(ABASE)-forms-form_user_data.ads \ - $(ABASE)-forms-field_types.ads \ - $(ABASE)-forms-field_user_data.ads \ - $(ABASE)-panels-user_data.ads -################################################################################ -LIBOBJS=$(ALIB).o \ - $(ABASE)-aux.o \ - $(ABASE).o \ - $(ABASE)-terminfo.o \ - $(ABASE)-termcap.o \ - $(ABASE)-putwin.o \ - $(ABASE)-trace.o \ - $(ABASE)-mouse.o \ - $(ABASE)-panels.o \ - $(ABASE)-menus.o \ - $(ABASE)-forms.o \ - $(ABASE)-forms-field_types.o \ - $(ABASE)-forms-field_types-alpha.o \ - $(ABASE)-forms-field_types-alphanumeric.o \ - $(ABASE)-forms-field_types-intfield.o \ - $(ABASE)-forms-field_types-numeric.o \ - $(ABASE)-forms-field_types-regexp.o \ - $(ABASE)-forms-field_types-enumeration.o \ - $(ABASE)-forms-field_types-ipv4_address.o \ - $(ABASE)-forms-field_types-user.o \ - $(ABASE)-forms-field_types-user-choice.o \ - $(ABASE)-text_io.o \ - $(ABASE)-text_io-aux.o - -# Ada object files for generic packages. Since gnat 3.10 they are -# also compiled -GENOBJS=$(ABASE)-menus-menu_user_data.o \ - $(ABASE)-menus-item_user_data.o \ - $(ABASE)-forms-form_user_data.o \ - $(ABASE)-forms-field_user_data.o \ - $(ABASE)-forms-field_types-enumeration-ada.o \ - $(ABASE)-panels-user_data.o \ - $(ABASE)-text_io-integer_io.o \ - $(ABASE)-text_io-float_io.o \ - $(ABASE)-text_io-fixed_io.o \ - $(ABASE)-text_io-decimal_io.o \ - $(ABASE)-text_io-enumeration_io.o \ - $(ABASE)-text_io-modular_io.o \ - $(ABASE)-text_io-complex_io.o - -all :: $(BUILD_DIR_LIB)/$(STATIC_LIBNAME) - @echo done - -$(ADA_INCLUDE) \ -$(ADA_OBJECTS) \ -$(LIBDIR) \ -$(BUILD_DIR_LIB) : - mkdir -p $@ - -sources : - @echo made $@ - -libs \ -install \ -install.libs :: \ - $(BUILD_DIR_LIB)/$(STATIC_LIBNAME) - @echo made $(STATIC_LIBNAME) - -install \ -install.libs :: \ - $(BUILD_DIR_LIB)/$(STATIC_LIBNAME) \ - $(ADA_OBJECTS) - @$(INSTALL_LIB) \ - $(BUILD_DIR_LIB)/$(STATIC_LIBNAME) \ - $(ADA_OBJECTS) - -uninstall \ -uninstall.libs :: - @rm -f $(ADA_OBJECTS)/$(STATIC_LIBNAME) - -mostlyclean :: - rm -f *.o *.ali b_t*.* *.s $(PROGS) a.out core b_*_test.c *.xr[bs] *.a - -clean :: mostlyclean - rm -f $(ABASE)-trace.adb - -distclean :: clean - rm -f Makefile - -realclean :: distclean - -BASEDEPS=$(ABASE).ads $(ABASE)-aux.ads $(ABASE).adb - -$(ABASE)-trace.adb : $(srcdir)/$(ABASE)-trace.adb_p - rm -f $@ - $(ADAPREP) -DADA_TRACE=@ADA_TRACE@ -DPRAGMA_UNREF=@PRAGMA_UNREF@ $(srcdir)/$(ABASE)-trace.adb_p $@ - -############################################################################### -C_OBJS = c_varargs_to_ada.o ncurses_compat.o - -c_varargs_to_ada.o : $(srcdir)/c_varargs_to_ada.c - $(CC) $(CFLAGS_DEFAULT) -c -o $@ $(srcdir)/c_varargs_to_ada.c - -ncurses_compat.o : $(srcdir)/ncurses_compat.c - $(CC) $(CFLAGS_DEFAULT) -c -o $@ $(srcdir)/ncurses_compat.c - -############################################################################### - -MIXED_OBJS = $(C_OBJS) @USE_OLD_MAKERULES@$(LIBOBJS) @cf_generic_objects@ - -@USE_OLD_MAKERULES@$(BUILD_DIR_LIB)/$(STATIC_LIBNAME) :: \ -@USE_OLD_MAKERULES@ $(BUILD_DIR_LIB) \ -@USE_OLD_MAKERULES@ $(MIXED_OBJS) -@USE_OLD_MAKERULES@ $(AR) $(ARFLAGS) $@ $(MIXED_OBJS) - -$(BUILD_DIR)/static-ali : ; mkdir -p $@ -$(BUILD_DIR)/static-obj : ; mkdir -p $@ - -STATIC_DIRS = \ - $(BUILD_DIR_LIB) \ - $(BUILD_DIR)/static-ali \ - $(BUILD_DIR)/static-obj - -@USE_GNAT_PROJECTS@$(BUILD_DIR_LIB)/$(STATIC_LIBNAME) :: \ -@USE_GNAT_PROJECTS@ $(ABASE)-trace.adb \ -@USE_GNAT_PROJECTS@ $(C_OBJS) \ -@USE_GNAT_PROJECTS@ $(STATIC_DIRS) -@USE_GNAT_PROJECTS@ $(ADAMAKE) $(ADAMAKEFLAGS) -XLIB_KIND=static -@USE_GNAT_PROJECTS@ $(AR) $(ARFLAGS) $@ $(C_OBJS) -@USE_GNAT_PROJECTS@ -@USE_GNAT_LIBRARIES@install \ -@USE_GNAT_LIBRARIES@install.libs :: \ -@USE_GNAT_LIBRARIES@ $(ADA_OBJECTS) -@USE_GNAT_LIBRARIES@ $(INSTALL_LIB) \ -@USE_GNAT_LIBRARIES@ $(BUILD_DIR)/static-ali/*.ali \ -@USE_GNAT_LIBRARIES@ $(ADA_OBJECTS) - -uninstall \ -uninstall.libs :: - @rm -f $(ADA_OBJECTS)/$(STATIC_LIBNAME) - -@USE_GNAT_LIBRARIES@uninstall \ -@USE_GNAT_LIBRARIES@uninstall.libs :: -@USE_GNAT_LIBRARIES@ @$(SHELL) -c 'for name in $(BUILD_DIR)/static-ali/*.ali ; do rm -f $(ADA_OBJECTS)/`basename $$name`; done' - -$(BUILD_DIR)/dynamic-ali : ; mkdir -p $@ -$(BUILD_DIR)/dynamic-obj : ; mkdir -p $@ - -SHARED_DIRS = \ - $(BUILD_DIR_LIB) \ - $(BUILD_DIR)/dynamic-ali \ - $(BUILD_DIR)/dynamic-obj - -@MAKE_ADA_SHAREDLIB@all :: $(BUILD_DIR_LIB)/$(SHARED_LIBNAME) -@MAKE_ADA_SHAREDLIB@$(BUILD_DIR_LIB)/$(SHARED_LIBNAME) :: $(ABASE)-trace.adb $(SHARED_DIRS) -@MAKE_ADA_SHAREDLIB@ cp $(MIXED_OBJS) $(BUILD_DIR)/dynamic-obj/ -@MAKE_ADA_SHAREDLIB@ $(ADAMAKE) $(ADAMAKEFLAGS) -XLIB_KIND=dynamic - -install \ -install.libs :: $(ADA_INCLUDE) - $(INSTALL_LIB) \ - $(SOURCE_DIR_SRC)/*.ad[sb] \ - $(ADA_INCLUDE) - -install \ -install.libs :: $(ADA_INCLUDE) - $(INSTALL_LIB) \ - $(GENERATED_SOURCES) \ - $(ADA_INCLUDE) - -uninstall \ -uninstall.libs :: - $(SHELL) -c 'for name in $(SOURCE_DIR_SRC)/*.ad[sb] $(GENERATED_SOURCES); do rm -f $(ADA_INCLUDE)/`basename $$name`; done' - -@MAKE_ADA_SHAREDLIB@install \ -@MAKE_ADA_SHAREDLIB@install.libs :: $(ADA_OBJECTS) $(LIBDIR) -@MAKE_ADA_SHAREDLIB@ $(INSTALL_LIB) \ -@MAKE_ADA_SHAREDLIB@ $(BUILD_DIR)/dynamic-ali/* \ -@MAKE_ADA_SHAREDLIB@ $(ADA_OBJECTS) -@MAKE_ADA_SHAREDLIB@ $(INSTALL_LIB) \ -@MAKE_ADA_SHAREDLIB@ $(BUILD_DIR_LIB)/$(SHARED_LIBNAME) \ -@MAKE_ADA_SHAREDLIB@ $(LIBDIR) -@MAKE_ADA_SHAREDLIB@ cd $(LIBDIR) && $(LN_S) $(SHARED_LIBNAME) $(SHARED_SYMLINK) -@MAKE_ADA_SHAREDLIB@ -@MAKE_ADA_SHAREDLIB@uninstall \ -@MAKE_ADA_SHAREDLIB@uninstall.libs :: -@MAKE_ADA_SHAREDLIB@ $(SHELL) -c 'for name in $(BUILD_DIR)/dynamic-ali/* ; do rm -f $(ADA_OBJECTS)/`basename $$name`; done' -@MAKE_ADA_SHAREDLIB@ -@MAKE_ADA_SHAREDLIB@uninstall \ -@MAKE_ADA_SHAREDLIB@uninstall.libs :: -@MAKE_ADA_SHAREDLIB@ rm -f $(LIBDIR)/$(SHARED_SYMLINK) -@MAKE_ADA_SHAREDLIB@ rm -f $(LIBDIR)/$(SHARED_LIBNAME) - -clean :: - rm -rf $(BUILD_DIR)/*-ali - rm -rf $(BUILD_DIR)/*-obj - rm -rf $(BUILD_DIR_LIB) diff --git a/Ada95/src/c_varargs_to_ada.c b/Ada95/src/c_varargs_to_ada.c deleted file mode 100644 index ed236ddc90da1..0000000000000 --- a/Ada95/src/c_varargs_to_ada.c +++ /dev/null @@ -1,117 +0,0 @@ -/**************************************************************************** - * Copyright (c) 2011 Free Software Foundation, Inc. * - * * - * Permission is hereby granted, free of charge, to any person obtaining a * - * copy of this software and associated documentation files (the * - * "Software"), to deal in the Software without restriction, including * - * without limitation the rights to use, copy, modify, merge, publish, * - * distribute, distribute with modifications, sublicense, and/or sell * - * copies of the Software, and to permit persons to whom the Software is * - * furnished to do so, subject to the following conditions: * - * * - * The above copyright notice and this permission notice shall be included * - * in all copies or substantial portions of the Software. * - * * - * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS * - * OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF * - * MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. * - * IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, * - * DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR * - * OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR * - * THE USE OR OTHER DEALINGS IN THE SOFTWARE. * - * * - * Except as contained in this notice, the name(s) of the above copyright * - * holders shall not be used in advertising or otherwise to promote the * - * sale, use or other dealings in this Software without prior written * - * authorization. * - ****************************************************************************/ - -/**************************************************************************** - * Author: Nicolas Boulenguez, 2011 * - ****************************************************************************/ - -/* - Version Control - $Id: c_varargs_to_ada.c,v 1.4 2011/03/19 19:07:39 tom Exp $ - --------------------------------------------------------------------------*/ -/* - */ - -#include <c_varargs_to_ada.h> - -int -set_field_type_alnum(FIELD *field, - int minimum_width) -{ - return set_field_type(field, TYPE_ALNUM, minimum_width); -} - -int -set_field_type_alpha(FIELD *field, - int minimum_width) -{ - return set_field_type(field, TYPE_ALPHA, minimum_width); -} - -int -set_field_type_enum(FIELD *field, - char **value_list, - int case_sensitive, - int unique_match) -{ - return set_field_type(field, TYPE_ENUM, value_list, case_sensitive, - unique_match); -} - -int -set_field_type_integer(FIELD *field, - int precision, - long minimum, - long maximum) -{ - return set_field_type(field, TYPE_INTEGER, precision, minimum, maximum); -} - -int -set_field_type_numeric(FIELD *field, - int precision, - double minimum, - double maximum) -{ - return set_field_type(field, TYPE_NUMERIC, precision, minimum, maximum); -} - -int -set_field_type_regexp(FIELD *field, - char *regular_expression) -{ - return set_field_type(field, TYPE_REGEXP, regular_expression); -} - -int -set_field_type_ipv4(FIELD *field) -{ - return set_field_type(field, TYPE_IPV4); -} - -int -set_field_type_user(FIELD *field, - FIELDTYPE *fieldtype, - void *arg) -{ - return set_field_type(field, fieldtype, arg); -} - -void * -void_star_make_arg(va_list *list) -{ - return va_arg(*list, void *); -} - -#ifdef TRACE -void -_traces(const char *fmt, char *arg) -{ - _tracef(fmt, arg); -} -#endif diff --git a/Ada95/src/c_varargs_to_ada.h b/Ada95/src/c_varargs_to_ada.h deleted file mode 100644 index ee6a7a7c1eb9e..0000000000000 --- a/Ada95/src/c_varargs_to_ada.h +++ /dev/null @@ -1,73 +0,0 @@ -/**************************************************************************** - * Copyright (c) 2011 Free Software Foundation, Inc. * - * * - * Permission is hereby granted, free of charge, to any person obtaining a * - * copy of this software and associated documentation files (the * - * "Software"), to deal in the Software without restriction, including * - * without limitation the rights to use, copy, modify, merge, publish, * - * distribute, distribute with modifications, sublicense, and/or sell * - * copies of the Software, and to permit persons to whom the Software is * - * furnished to do so, subject to the following conditions: * - * * - * The above copyright notice and this permission notice shall be included * - * in all copies or substantial portions of the Software. * - * * - * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS * - * OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF * - * MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. * - * IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, * - * DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR * - * OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR * - * THE USE OR OTHER DEALINGS IN THE SOFTWARE. * - * * - * Except as contained in this notice, the name(s) of the above copyright * - * holders shall not be used in advertising or otherwise to promote the * - * sale, use or other dealings in this Software without prior written * - * authorization. * - ****************************************************************************/ - -/* $Id: c_varargs_to_ada.h,v 1.3 2011/03/19 19:07:41 tom Exp $ */ - -#ifndef __C_VARARGS_TO_ADA_H -#define __C_VARARGS_TO_ADA_H - -#include <form.h> - -extern int set_field_type_alnum(FIELD * /* field */ , - int /* minimum_width */ ); - -extern int set_field_type_alpha(FIELD * /* field */ , - int /* minimum_width */ ); - -extern int set_field_type_enum(FIELD * /* field */ , - char ** /* value_list */ , - int /* case_sensitive */ , - int /* unique_match */ ); - -extern int set_field_type_integer(FIELD * /* field */ , - int /* precision */ , - long /* minimum */ , - long /* maximum */ ); - -extern int set_field_type_numeric(FIELD * /* field */ , - int /* precision */ , - double /* minimum */ , - double /* maximum */ ); - -extern int set_field_type_regexp(FIELD * /* field */ , - char * /* regular_expression */ ); - -extern int set_field_type_ipv4(FIELD * /* field */ ); - -extern int set_field_type_user(FIELD * /* field */ , - FIELDTYPE * /* fieldtype */ , - void * /* arg */ ); - -extern void *void_star_make_arg(va_list * /* list */ ); - -#ifdef TRACE -extern void _traces(const char * /* fmt */ - ,char * /* arg */ ); -#endif - -#endif /* __C_VARARGS_TO_ADA_H */ diff --git a/Ada95/src/library.gpr b/Ada95/src/library.gpr deleted file mode 100644 index 33e4a3c7d7e2e..0000000000000 --- a/Ada95/src/library.gpr +++ /dev/null @@ -1,56 +0,0 @@ ------------------------------------------------------------------------------- --- Copyright (c) 2010,2011 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "Software"), to deal in the Software without restriction, including -- --- without limitation the rights to use, copy, modify, merge, publish, -- --- distribute, distribute with modifications, sublicense, and/or sell -- --- copies of the Software, and to permit persons to whom the Software is -- --- furnished to do so, subject to the following conditions: -- --- -- --- The above copyright notice and this permission notice shall be included -- --- in all copies or substantial portions of the Software. -- --- -- --- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- --- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- --- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- --- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- --- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- --- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- --- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- --- -- --- Except as contained in this notice, the name(s) of the above copyright -- --- holders shall not be used in advertising or otherwise to promote the -- --- sale, use or other dealings in this Software without prior written -- --- authorization. -- ------------------------------------------------------------------------------- --- $Id: library.gpr,v 1.7 2011/03/18 23:10:28 Nicolas.Boulenguez Exp $ --- http://gcc.gnu.org/onlinedocs/gnat_ugn_unw/Library-Projects.html --- http://www.adaworld.com/debian/debian-ada-policy.html -project Library is - Build_Dir := External ("BUILD_DIR"); - Source_Dir := External ("SOURCE_DIR"); - Source_Dir2 := External ("SOURCE_DIR2"); - Kind := External ("LIB_KIND"); - for Library_Name use External ("LIB_NAME"); - for Library_Version use External ("SONAME"); - - for Library_Kind use Kind; - for Library_Dir use Build_Dir & "/lib"; - for Object_Dir use Build_Dir & "/" & Kind & "-obj"; - for Library_ALI_Dir use Build_Dir & "/" & Kind & "-ali"; - for Source_Dirs use (Source_Dir & "/src", - Source_Dir2, - Build_Dir & "/src"); - for Library_Options use ("-lncurses", "-lpanel", "-lmenu", "-lform"); - package Compiler is - for Default_Switches ("Ada") use - ("-g", - "-O2", - "-gnatafno", - "-gnatVa", -- All validity checks - "-gnatwa"); -- Activate all optional errors - end Compiler; - for Languages use ("C", "Ada"); -end Library; diff --git a/Ada95/src/modules b/Ada95/src/modules deleted file mode 100644 index 9f5e03038eb64..0000000000000 --- a/Ada95/src/modules +++ /dev/null @@ -1,70 +0,0 @@ -# $Id: modules,v 1.3 2010/06/26 23:33:14 tom Exp $ -############################################################################## -# Copyright (c) 2010 Free Software Foundation, Inc. # -# # -# Permission is hereby granted, free of charge, to any person obtaining a # -# copy of this software and associated documentation files (the "Software"), # -# to deal in the Software without restriction, including without limitation # -# the rights to use, copy, modify, merge, publish, distribute, distribute # -# with modifications, sublicense, and/or sell copies of the Software, and to # -# permit persons to whom the Software is furnished to do so, subject to the # -# following conditions: # -# # -# The above copyright notice and this permission notice shall be included in # -# all copies or substantial portions of the Software. # -# # -# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR # -# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, # -# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL # -# THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER # -# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING # -# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER # -# DEALINGS IN THE SOFTWARE. # -# # -# Except as contained in this notice, the name(s) of the above copyright # -# holders shall not be used in advertising or otherwise to promote the sale, # -# use or other dealings in this Software without prior written # -# authorization. # -############################################################################## -# -# Author: Thomas E. Dickey 2010 -# - -# Library objects -# rootname depend-spec depend-body unit -$(ALIB) $(srcdir) none spec -$(ABASE)-aux none $(srcdir) body -$(ABASE) none . body -$(ABASE)-terminfo $(srcdir) $(srcdir) body -$(ABASE)-termcap $(srcdir) $(srcdir) body -$(ABASE)-putwin $(srcdir) $(srcdir) body -$(ABASE)-trace . . body -$(ABASE)-mouse . $(srcdir) body -$(ABASE)-panels . $(srcdir) body -$(ABASE)-menus . $(srcdir) body -$(ABASE)-forms . $(srcdir) body -$(ABASE)-forms-field_types . $(srcdir) body -$(ABASE)-forms-field_types-alpha $(srcdir) $(srcdir) body -$(ABASE)-forms-field_types-alphanumeric $(srcdir) $(srcdir) body -$(ABASE)-forms-field_types-intfield $(srcdir) $(srcdir) body -$(ABASE)-forms-field_types-numeric $(srcdir) $(srcdir) body -$(ABASE)-forms-field_types-regexp $(srcdir) $(srcdir) body -$(ABASE)-forms-field_types-enumeration $(srcdir) $(srcdir) body -$(ABASE)-forms-field_types-ipv4_address $(srcdir) $(srcdir) body -$(ABASE)-forms-field_types-user $(srcdir) $(srcdir) body -$(ABASE)-forms-field_types-user-choice $(srcdir) $(srcdir) body -$(ABASE)-text_io $(srcdir) $(srcdir) body -$(ABASE)-text_io-aux $(srcdir) $(srcdir) body -$(ABASE)-menus-menu_user_data . $(srcdir) body -$(ABASE)-menus-item_user_data . $(srcdir) body -$(ABASE)-forms-form_user_data . $(srcdir) body -$(ABASE)-forms-field_user_data . $(srcdir) body -$(ABASE)-forms-field_types-enumeration-ada $(srcdir) $(srcdir) body -$(ABASE)-panels-user_data . $(srcdir) body -$(ABASE)-text_io-integer_io $(srcdir) $(srcdir) body -$(ABASE)-text_io-float_io $(srcdir) $(srcdir) body -$(ABASE)-text_io-fixed_io $(srcdir) $(srcdir) body -$(ABASE)-text_io-decimal_io $(srcdir) $(srcdir) body -$(ABASE)-text_io-enumeration_io $(srcdir) $(srcdir) body -$(ABASE)-text_io-modular_io $(srcdir) $(srcdir) body -$(ABASE)-text_io-complex_io $(srcdir) $(srcdir) body diff --git a/Ada95/src/ncurses_compat.c b/Ada95/src/ncurses_compat.c deleted file mode 100644 index b3d0607a5ff29..0000000000000 --- a/Ada95/src/ncurses_compat.c +++ /dev/null @@ -1,135 +0,0 @@ -/**************************************************************************** - * Copyright (c) 2011 Free Software Foundation, Inc. * - * * - * Permission is hereby granted, free of charge, to any person obtaining a * - * copy of this software and associated documentation files (the * - * "Software"), to deal in the Software without restriction, including * - * without limitation the rights to use, copy, modify, merge, publish, * - * distribute, distribute with modifications, sublicense, and/or sell * - * copies of the Software, and to permit persons to whom the Software is * - * furnished to do so, subject to the following conditions: * - * * - * The above copyright notice and this permission notice shall be included * - * in all copies or substantial portions of the Software. * - * * - * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS * - * OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF * - * MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. * - * IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, * - * DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR * - * OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR * - * THE USE OR OTHER DEALINGS IN THE SOFTWARE. * - * * - * Except as contained in this notice, the name(s) of the above copyright * - * holders shall not be used in advertising or otherwise to promote the * - * sale, use or other dealings in this Software without prior written * - * authorization. * - ****************************************************************************/ - -/**************************************************************************** - * Author: Thomas E. Dickey, 2011 * - ****************************************************************************/ - -/* - Version Control - $Id: ncurses_compat.c,v 1.2 2011/03/28 00:29:04 tom Exp $ - --------------------------------------------------------------------------*/ - -/* - * Provide compatibility with older versions of ncurses. - */ -#include <curses.h> - -#if defined(NCURSES_VERSION_PATCH) - -#if NCURSES_VERSION_PATCH < 20081122 -extern bool has_mouse(void); -extern int _nc_has_mouse(void); - -bool -has_mouse(void) -{ - return (bool) _nc_has_mouse(); -} -#endif - -/* - * These are provided by lib_gen.c: - */ -#if NCURSES_VERSION_PATCH < 20070331 -extern bool (is_keypad) (const WINDOW *); -extern bool (is_scrollok) (const WINDOW *); - -bool -is_keypad(const WINDOW *win) -{ - return ((win)->_use_keypad); -} - -bool - (is_scrollok) (const WINDOW *win) -{ - return ((win)->_scroll); -} -#endif - -#if NCURSES_VERSION_PATCH < 20060107 -extern int (getbegx) (WINDOW *); -extern int (getbegy) (WINDOW *); -extern int (getcurx) (WINDOW *); -extern int (getcury) (WINDOW *); -extern int (getmaxx) (WINDOW *); -extern int (getmaxy) (WINDOW *); -extern int (getparx) (WINDOW *); -extern int (getpary) (WINDOW *); - -int - (getbegy) (WINDOW *win) -{ - return ((win) ? (win)->_begy : ERR); -} - -int - (getbegx) (WINDOW *win) -{ - return ((win) ? (win)->_begx : ERR); -} - -int - (getcury) (WINDOW *win) -{ - return ((win) ? (win)->_cury : ERR); -} - -int - (getcurx) (WINDOW *win) -{ - return ((win) ? (win)->_curx : ERR); -} - -int - (getmaxy) (WINDOW *win) -{ - return ((win) ? ((win)->_maxy + 1) : ERR); -} - -int - (getmaxx) (WINDOW *win) -{ - return ((win) ? ((win)->_maxx + 1) : ERR); -} - -int - (getpary) (WINDOW *win) -{ - return ((win) ? (win)->_pary : ERR); -} - -int - (getparx) (WINDOW *win) -{ - return ((win) ? (win)->_parx : ERR); -} -#endif - -#endif diff --git a/Ada95/src/terminal_interface-curses-aux.adb b/Ada95/src/terminal_interface-curses-aux.adb deleted file mode 100644 index 9c2f8cd38674f..0000000000000 --- a/Ada95/src/terminal_interface-curses-aux.adb +++ /dev/null @@ -1,116 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding -- --- -- --- Terminal_Interface.Curses.Aux -- --- -- --- B O D Y -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 1998-2003,2009 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "Software"), to deal in the Software without restriction, including -- --- without limitation the rights to use, copy, modify, merge, publish, -- --- distribute, distribute with modifications, sublicense, and/or sell -- --- copies of the Software, and to permit persons to whom the Software is -- --- furnished to do so, subject to the following conditions: -- --- -- --- The above copyright notice and this permission notice shall be included -- --- in all copies or substantial portions of the Software. -- --- -- --- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- --- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- --- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- --- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- --- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- --- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- --- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- --- -- --- Except as contained in this notice, the name(s) of the above copyright -- --- holders shall not be used in advertising or otherwise to promote the -- --- sale, use or other dealings in this Software without prior written -- --- authorization. -- ------------------------------------------------------------------------------- --- Author: Juergen Pfeifer, 1996 --- Version Control: --- $Revision: 1.11 $ --- Binding Version 01.00 ------------------------------------------------------------------------------- -package body Terminal_Interface.Curses.Aux is - -- - -- Some helpers - procedure Fill_String (Cp : chars_ptr; - Str : out String) - is - -- Fill the string with the characters referenced by the - -- chars_ptr. - -- - Len : Natural; - begin - if Cp /= Null_Ptr then - Len := Natural (Strlen (Cp)); - if Str'Length < Len then - raise Constraint_Error; - end if; - declare - S : String (1 .. Len); - begin - S := Value (Cp); - Str (Str'First .. (Str'First + Len - 1)) := S (S'Range); - end; - else - Len := 0; - end if; - - if Len < Str'Length then - Str ((Str'First + Len) .. Str'Last) := (others => ' '); - end if; - - end Fill_String; - - function Fill_String (Cp : chars_ptr) return String - is - Len : Natural; - begin - if Cp /= Null_Ptr then - Len := Natural (Strlen (Cp)); - if Len = 0 then - return ""; - else - declare - S : String (1 .. Len); - begin - Fill_String (Cp, S); - return S; - end; - end if; - else - return ""; - end if; - end Fill_String; - - procedure Eti_Exception (Code : Eti_Error) - is - begin - case Code is - when E_Ok => null; - when E_System_Error => raise Eti_System_Error; - when E_Bad_Argument => raise Eti_Bad_Argument; - when E_Posted => raise Eti_Posted; - when E_Connected => raise Eti_Connected; - when E_Bad_State => raise Eti_Bad_State; - when E_No_Room => raise Eti_No_Room; - when E_Not_Posted => raise Eti_Not_Posted; - when E_Unknown_Command => raise Eti_Unknown_Command; - when E_No_Match => raise Eti_No_Match; - when E_Not_Selectable => raise Eti_Not_Selectable; - when E_Not_Connected => raise Eti_Not_Connected; - when E_Request_Denied => raise Eti_Request_Denied; - when E_Invalid_Field => raise Eti_Invalid_Field; - when E_Current => raise Eti_Current; - end case; - end Eti_Exception; - -end Terminal_Interface.Curses.Aux; diff --git a/Ada95/src/terminal_interface-curses-forms-field_types-alpha.adb b/Ada95/src/terminal_interface-curses-forms-field_types-alpha.adb deleted file mode 100644 index 943362012394b..0000000000000 --- a/Ada95/src/terminal_interface-curses-forms-field_types-alpha.adb +++ /dev/null @@ -1,62 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding -- --- -- --- Terminal_Interface.Curses.Forms.Field_Types.Alpha -- --- -- --- B O D Y -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 1998-2009,2011 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "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: 2011/03/19 00:45:37 $ --- Binding Version 01.00 ------------------------------------------------------------------------------- -with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; - -package body Terminal_Interface.Curses.Forms.Field_Types.Alpha is - - procedure Set_Field_Type (Fld : Field; - Typ : Alpha_Field) - is - function Set_Fld_Type (F : Field := Fld; - Arg1 : C_Int) return C_Int; - pragma Import (C, Set_Fld_Type, "set_field_type_alpha"); - - Res : Eti_Error; - begin - Res := Set_Fld_Type (Arg1 => C_Int (Typ.Minimum_Field_Width)); - if Res /= E_Ok then - Eti_Exception (Res); - end if; - 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 deleted file mode 100644 index 7878f73b2b52c..0000000000000 --- a/Ada95/src/terminal_interface-curses-forms-field_types-alpha.ads +++ /dev/null @@ -1,53 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding -- --- -- --- Terminal_Interface.Curses.Forms.Field_Types.Alpha -- --- -- --- S P E C -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 1998-2003,2009 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "Software"), to deal in the Software without restriction, including -- --- without limitation the rights to use, copy, modify, merge, publish, -- --- distribute, distribute with modifications, sublicense, and/or sell -- --- copies of the Software, and to permit persons to whom the Software is -- --- furnished to do so, subject to the following conditions: -- --- -- --- The above copyright notice and this permission notice shall be included -- --- in all copies or substantial portions of the Software. -- --- -- --- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- --- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- --- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- --- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- --- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- --- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- --- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- --- -- --- Except as contained in this notice, the name(s) of the above copyright -- --- holders shall not be used in advertising or otherwise to promote the -- --- sale, use or other dealings in this Software without prior written -- --- authorization. -- ------------------------------------------------------------------------------- --- Author: Juergen Pfeifer, 1996 --- Version Control: --- $Revision: 1.12 $ --- Binding Version 01.00 ------------------------------------------------------------------------------- -package Terminal_Interface.Curses.Forms.Field_Types.Alpha is - pragma Preelaborate (Terminal_Interface.Curses.Forms.Field_Types.Alpha); - - type Alpha_Field is new Field_Type - with record - Minimum_Field_Width : Natural := 0; - end record; - - procedure Set_Field_Type (Fld : Field; - Typ : Alpha_Field); - pragma Inline (Set_Field_Type); - -end Terminal_Interface.Curses.Forms.Field_Types.Alpha; diff --git a/Ada95/src/terminal_interface-curses-forms-field_types-alphanumeric.adb b/Ada95/src/terminal_interface-curses-forms-field_types-alphanumeric.adb deleted file mode 100644 index 53f66801e917d..0000000000000 --- a/Ada95/src/terminal_interface-curses-forms-field_types-alphanumeric.adb +++ /dev/null @@ -1,62 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding -- --- -- --- Terminal_Interface.Curses.Forms.Field_Types.AlphaNumeric -- --- -- --- B O D Y -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 1998-2009,2011 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "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: 2011/03/19 00:45:37 $ --- Binding Version 01.00 ------------------------------------------------------------------------------- -with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; - -package body Terminal_Interface.Curses.Forms.Field_Types.AlphaNumeric is - - procedure Set_Field_Type (Fld : Field; - Typ : AlphaNumeric_Field) - is - function Set_Fld_Type (F : Field := Fld; - Arg1 : C_Int) return C_Int; - pragma Import (C, Set_Fld_Type, "set_field_type_alnum"); - - Res : Eti_Error; - begin - Res := Set_Fld_Type (Arg1 => C_Int (Typ.Minimum_Field_Width)); - if Res /= E_Ok then - Eti_Exception (Res); - end if; - 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 deleted file mode 100644 index c1009ac77adb2..0000000000000 --- a/Ada95/src/terminal_interface-curses-forms-field_types-alphanumeric.ads +++ /dev/null @@ -1,54 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding -- --- -- --- Terminal_Interface.Curses.Forms.Field_Types.AlphaNumeric -- --- -- --- S P E C -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 1998-2003,2009 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "Software"), to deal in the Software without restriction, including -- --- without limitation the rights to use, copy, modify, merge, publish, -- --- distribute, distribute with modifications, sublicense, and/or sell -- --- copies of the Software, and to permit persons to whom the Software is -- --- furnished to do so, subject to the following conditions: -- --- -- --- The above copyright notice and this permission notice shall be included -- --- in all copies or substantial portions of the Software. -- --- -- --- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- --- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- --- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- --- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- --- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- --- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- --- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- --- -- --- Except as contained in this notice, the name(s) of the above copyright -- --- holders shall not be used in advertising or otherwise to promote the -- --- sale, use or other dealings in this Software without prior written -- --- authorization. -- ------------------------------------------------------------------------------- --- Author: Juergen Pfeifer, 1996 --- Version Control: --- $Revision: 1.12 $ --- Binding Version 01.00 ------------------------------------------------------------------------------- -package Terminal_Interface.Curses.Forms.Field_Types.AlphaNumeric is - pragma Preelaborate - (Terminal_Interface.Curses.Forms.Field_Types.AlphaNumeric); - - type AlphaNumeric_Field is new Field_Type - with record - Minimum_Field_Width : Natural := 0; - end record; - - procedure Set_Field_Type (Fld : Field; - Typ : AlphaNumeric_Field); - pragma Inline (Set_Field_Type); - -end Terminal_Interface.Curses.Forms.Field_Types.AlphaNumeric; diff --git a/Ada95/src/terminal_interface-curses-forms-field_types-enumeration-ada.adb b/Ada95/src/terminal_interface-curses-forms-field_types-enumeration-ada.adb deleted file mode 100644 index d38e062aa5eb5..0000000000000 --- a/Ada95/src/terminal_interface-curses-forms-field_types-enumeration-ada.adb +++ /dev/null @@ -1,81 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding -- --- -- --- Terminal_Interface.Curses.Forms.Field_Types.Enumeration.Ada -- --- -- --- B O D Y -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 1998-2004,2011 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "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: 2011/03/22 23:36:20 $ --- 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).all (I.Names (J).all'First) := - To_Upper (I.Names (J).all (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 deleted file mode 100644 index 48fad09c2f252..0000000000000 --- a/Ada95/src/terminal_interface-curses-forms-field_types-enumeration-ada.ads +++ /dev/null @@ -1,59 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- 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 deleted file mode 100644 index 12648e5a1dcc7..0000000000000 --- a/Ada95/src/terminal_interface-curses-forms-field_types-enumeration.adb +++ /dev/null @@ -1,115 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding -- --- -- --- Terminal_Interface.Curses.Forms.Field_Types.Enumeration -- --- -- --- B O D Y -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 1998-2009,2011 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "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.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.all (size_t (I)) := New_String (Info.Names (I).all); - if Auto_Release_Names then - S := Info.Names (I); - Release_String (S); - end if; - end loop; - E.Arr.all (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.all (I); - exit when P = Null_Ptr; - Free (P); - Enum.Arr.all (I) := Null_Ptr; - I := I + 1; - end loop; - Enum.Arr := null; - end Release; - - procedure Set_Field_Type (Fld : Field; - Typ : Enumeration_Field) - is - function Set_Fld_Type (F : Field := Fld; - Arg1 : chars_ptr_array; - Arg2 : C_Int; - Arg3 : C_Int) return C_Int; - pragma Import (C, Set_Fld_Type, "set_field_type_enum"); - - Res : Eti_Error; - begin - if Typ.Arr = null then - raise Form_Exception; - end if; - Res := Set_Fld_Type (Arg1 => Typ.Arr.all, - Arg2 => C_Int (Boolean'Pos (Typ.Case_Sensitive)), - Arg3 => C_Int (Boolean'Pos - (Typ.Match_Must_Be_Unique))); - if Res /= E_Ok then - Eti_Exception (Res); - end if; - 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 deleted file mode 100644 index e6924f6b19f9e..0000000000000 --- a/Ada95/src/terminal_interface-curses-forms-field_types-enumeration.ads +++ /dev/null @@ -1,98 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding -- --- -- --- Terminal_Interface.Curses.Forms.Field_Types.Enumeration -- --- -- --- S P E C -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 1998-2003,2009 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "Software"), to deal in the Software without restriction, including -- --- without limitation the rights to use, copy, modify, merge, publish, -- --- distribute, distribute with modifications, sublicense, and/or sell -- --- copies of the Software, and to permit persons to whom the Software is -- --- furnished to do so, subject to the following conditions: -- --- -- --- The above copyright notice and this permission notice shall be included -- --- in all copies or substantial portions of the Software. -- --- -- --- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- --- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- --- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- --- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- --- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- --- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- --- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- --- -- --- Except as contained in this notice, the name(s) of the above copyright -- --- holders shall not be used in advertising or otherwise to promote the -- --- sale, use or other dealings in this Software without prior written -- --- authorization. -- ------------------------------------------------------------------------------- --- Author: Juergen Pfeifer, 1996 --- Version Control: --- $Revision: 1.12 $ --- Binding Version 01.00 ------------------------------------------------------------------------------- -with Interfaces.C.Strings; - -package Terminal_Interface.Curses.Forms.Field_Types.Enumeration is - pragma Preelaborate - (Terminal_Interface.Curses.Forms.Field_Types.Enumeration); - - type String_Access is access String; - - -- Type_Set is used by the child package Ada - type Type_Set is (Lower_Case, Upper_Case, Mixed_Case); - - type Enum_Array is array (Positive range <>) - of String_Access; - - type Enumeration_Info (C : Positive) is - record - Names : Enum_Array (1 .. C); - Case_Sensitive : Boolean := False; - Match_Must_Be_Unique : Boolean := False; - end record; - - type Enumeration_Field is new Field_Type with private; - - function Create (Info : Enumeration_Info; - Auto_Release_Names : Boolean := False) - return Enumeration_Field; - -- Make an fieldtype from the info. Enumerations are special, because - -- they normally don't copy the enum values into a private store, so - -- we have to care for the lifetime of the info we provide. - -- The Auto_Release_Names flag may be used to automatically releases - -- the strings in the Names array of the Enumeration_Info. - - function Make_Enumeration_Type (Info : Enumeration_Info; - Auto_Release_Names : Boolean := False) - return Enumeration_Field renames Create; - - procedure Release (Enum : in out Enumeration_Field); - -- But we may want to release the field to release the memory allocated - -- by it internally. After that the Enumeration field is no longer usable. - - -- The next type defintions are all ncurses extensions. They are typically - -- not available in other curses implementations. - - procedure Set_Field_Type (Fld : Field; - Typ : Enumeration_Field); - pragma Inline (Set_Field_Type); - -private - type CPA_Access is access Interfaces.C.Strings.chars_ptr_array; - - type Enumeration_Field is new Field_Type with - record - Case_Sensitive : Boolean := False; - Match_Must_Be_Unique : Boolean := False; - Arr : CPA_Access := null; - end record; - -end Terminal_Interface.Curses.Forms.Field_Types.Enumeration; diff --git a/Ada95/src/terminal_interface-curses-forms-field_types-intfield.adb b/Ada95/src/terminal_interface-curses-forms-field_types-intfield.adb deleted file mode 100644 index b6229becefb9c..0000000000000 --- a/Ada95/src/terminal_interface-curses-forms-field_types-intfield.adb +++ /dev/null @@ -1,66 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding -- --- -- --- Terminal_Interface.Curses.Forms.Field_Types.IntField -- --- -- --- B O D Y -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 1998-2009,2011 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "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: 2011/03/19 00:45:37 $ --- Binding Version 01.00 ------------------------------------------------------------------------------- -with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; - -package body Terminal_Interface.Curses.Forms.Field_Types.IntField is - - procedure Set_Field_Type (Fld : Field; - Typ : Integer_Field) - is - function Set_Fld_Type (F : Field := Fld; - Arg1 : C_Int; - Arg2 : C_Long_Int; - Arg3 : C_Long_Int) return C_Int; - pragma Import (C, Set_Fld_Type, "set_field_type_integer"); - - Res : Eti_Error; - begin - Res := Set_Fld_Type (Arg1 => C_Int (Typ.Precision), - Arg2 => C_Long_Int (Typ.Lower_Limit), - Arg3 => C_Long_Int (Typ.Upper_Limit)); - if Res /= E_Ok then - Eti_Exception (Res); - end if; - 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 deleted file mode 100644 index e90f0d06f1746..0000000000000 --- a/Ada95/src/terminal_interface-curses-forms-field_types-intfield.ads +++ /dev/null @@ -1,55 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding -- --- -- --- Terminal_Interface.Curses.Forms.Field_Types.IntField -- --- -- --- S P E C -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 1998-2003,2009 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "Software"), to deal in the Software without restriction, including -- --- without limitation the rights to use, copy, modify, merge, publish, -- --- distribute, distribute with modifications, sublicense, and/or sell -- --- copies of the Software, and to permit persons to whom the Software is -- --- furnished to do so, subject to the following conditions: -- --- -- --- The above copyright notice and this permission notice shall be included -- --- in all copies or substantial portions of the Software. -- --- -- --- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- --- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- --- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- --- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- --- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- --- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- --- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- --- -- --- Except as contained in this notice, the name(s) of the above copyright -- --- holders shall not be used in advertising or otherwise to promote the -- --- sale, use or other dealings in this Software without prior written -- --- authorization. -- ------------------------------------------------------------------------------- --- Author: Juergen Pfeifer, 1996 --- Version Control: --- $Revision: 1.12 $ --- Binding Version 01.00 ------------------------------------------------------------------------------- -package Terminal_Interface.Curses.Forms.Field_Types.IntField is - pragma Preelaborate (Terminal_Interface.Curses.Forms.Field_Types.IntField); - - type Integer_Field is new Field_Type with - record - Precision : Natural; - Lower_Limit : Integer; - Upper_Limit : Integer; - end record; - - procedure Set_Field_Type (Fld : Field; - Typ : Integer_Field); - pragma Inline (Set_Field_Type); - -end Terminal_Interface.Curses.Forms.Field_Types.IntField; diff --git a/Ada95/src/terminal_interface-curses-forms-field_types-ipv4_address.adb b/Ada95/src/terminal_interface-curses-forms-field_types-ipv4_address.adb deleted file mode 100644 index 66e052942d374..0000000000000 --- a/Ada95/src/terminal_interface-curses-forms-field_types-ipv4_address.adb +++ /dev/null @@ -1,62 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding -- --- -- --- Terminal_Interface.Curses.Forms.Field_Types.IPV4_Address -- --- -- --- B O D Y -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 1998-2009,2011 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "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: 2011/03/19 00:45:37 $ --- Binding Version 01.00 ------------------------------------------------------------------------------- -with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; - -package body Terminal_Interface.Curses.Forms.Field_Types.IPV4_Address is - - procedure Set_Field_Type (Fld : Field; - Typ : Internet_V4_Address_Field) - is - function Set_Fld_Type (F : Field := Fld) - return C_Int; - pragma Import (C, Set_Fld_Type, "set_field_type_ipv4"); - - Res : Eti_Error; - begin - Res := Set_Fld_Type; - if Res /= E_Ok then - Eti_Exception (Res); - end if; - 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 deleted file mode 100644 index af367e7e5ab29..0000000000000 --- a/Ada95/src/terminal_interface-curses-forms-field_types-ipv4_address.ads +++ /dev/null @@ -1,51 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding -- --- -- --- Terminal_Interface.Curses.Forms.Field_Types.IPV4_Address -- --- -- --- S P E C -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 1998-2003,2009 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "Software"), to deal in the Software without restriction, including -- --- without limitation the rights to use, copy, modify, merge, publish, -- --- distribute, distribute with modifications, sublicense, and/or sell -- --- copies of the Software, and to permit persons to whom the Software is -- --- furnished to do so, subject to the following conditions: -- --- -- --- The above copyright notice and this permission notice shall be included -- --- in all copies or substantial portions of the Software. -- --- -- --- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- --- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- --- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- --- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- --- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- --- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- --- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- --- -- --- Except as contained in this notice, the name(s) of the above copyright -- --- holders shall not be used in advertising or otherwise to promote the -- --- sale, use or other dealings in this Software without prior written -- --- authorization. -- ------------------------------------------------------------------------------- --- Author: Juergen Pfeifer, 1996 --- Version Control: --- $Revision: 1.12 $ --- Binding Version 01.00 ------------------------------------------------------------------------------- -package Terminal_Interface.Curses.Forms.Field_Types.IPV4_Address is - pragma Preelaborate - (Terminal_Interface.Curses.Forms.Field_Types.IPV4_Address); - - type Internet_V4_Address_Field is new Field_Type with null record; - - procedure Set_Field_Type (Fld : Field; - Typ : Internet_V4_Address_Field); - pragma Inline (Set_Field_Type); - -end Terminal_Interface.Curses.Forms.Field_Types.IPV4_Address; diff --git a/Ada95/src/terminal_interface-curses-forms-field_types-numeric.adb b/Ada95/src/terminal_interface-curses-forms-field_types-numeric.adb deleted file mode 100644 index b31dfa657a595..0000000000000 --- a/Ada95/src/terminal_interface-curses-forms-field_types-numeric.adb +++ /dev/null @@ -1,69 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding -- --- -- --- Terminal_Interface.Curses.Forms.Field_Types.Numeric -- --- -- --- B O D Y -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 1998-2009,2011 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "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: 2011/03/19 00:45:37 $ --- Binding Version 01.00 ------------------------------------------------------------------------------- -with Interfaces.C; -with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; - -package body Terminal_Interface.Curses.Forms.Field_Types.Numeric is - - procedure Set_Field_Type (Fld : Field; - Typ : Numeric_Field) - is - type Double is new Interfaces.C.double; - - function Set_Fld_Type (F : Field := Fld; - Arg1 : C_Int; - Arg2 : Double; - Arg3 : Double) return C_Int; - pragma Import (C, Set_Fld_Type, "set_field_type_numeric"); - - Res : Eti_Error; - begin - Res := Set_Fld_Type (Arg1 => C_Int (Typ.Precision), - Arg2 => Double (Typ.Lower_Limit), - Arg3 => Double (Typ.Upper_Limit)); - if Res /= E_Ok then - Eti_Exception (Res); - end if; - 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 deleted file mode 100644 index 7c6f9fa15cef4..0000000000000 --- a/Ada95/src/terminal_interface-curses-forms-field_types-numeric.ads +++ /dev/null @@ -1,55 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding -- --- -- --- Terminal_Interface.Curses.Forms.Field_Types.Numeric -- --- -- --- S P E C -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 1998-2003,2009 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "Software"), to deal in the Software without restriction, including -- --- without limitation the rights to use, copy, modify, merge, publish, -- --- distribute, distribute with modifications, sublicense, and/or sell -- --- copies of the Software, and to permit persons to whom the Software is -- --- furnished to do so, subject to the following conditions: -- --- -- --- The above copyright notice and this permission notice shall be included -- --- in all copies or substantial portions of the Software. -- --- -- --- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- --- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- --- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- --- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- --- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- --- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- --- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- --- -- --- Except as contained in this notice, the name(s) of the above copyright -- --- holders shall not be used in advertising or otherwise to promote the -- --- sale, use or other dealings in this Software without prior written -- --- authorization. -- ------------------------------------------------------------------------------- --- Author: Juergen Pfeifer, 1996 --- Version Control: --- $Revision: 1.12 $ --- Binding Version 01.00 ------------------------------------------------------------------------------- -package Terminal_Interface.Curses.Forms.Field_Types.Numeric is - pragma Preelaborate (Terminal_Interface.Curses.Forms.Field_Types.Numeric); - - type Numeric_Field is new Field_Type with - record - Precision : Natural; - Lower_Limit : Float; - Upper_Limit : Float; - end record; - - procedure Set_Field_Type (Fld : Field; - Typ : Numeric_Field); - pragma Inline (Set_Field_Type); - -end Terminal_Interface.Curses.Forms.Field_Types.Numeric; diff --git a/Ada95/src/terminal_interface-curses-forms-field_types-regexp.adb b/Ada95/src/terminal_interface-curses-forms-field_types-regexp.adb deleted file mode 100644 index 55f0255071abc..0000000000000 --- a/Ada95/src/terminal_interface-curses-forms-field_types-regexp.adb +++ /dev/null @@ -1,67 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding -- --- -- --- Terminal_Interface.Curses.Forms.Field_Types.RegExp -- --- -- --- B O D Y -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 1998-2009,2011 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "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 Interfaces.C; use Interfaces.C; -with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; - -package body Terminal_Interface.Curses.Forms.Field_Types.RegExp is - - procedure Set_Field_Type (Fld : Field; - Typ : Regular_Expression_Field) - is - type Char_Ptr is access all Interfaces.C.char; - - function Set_Ftyp (F : Field := Fld; - Arg1 : Char_Ptr) return C_Int; - pragma Import (C, Set_Ftyp, "set_field_type_regexp"); - - Txt : char_array (0 .. Typ.Regular_Expression.all'Length); - Len : size_t; - Res : Eti_Error; - begin - To_C (Typ.Regular_Expression.all, Txt, Len); - Res := Set_Ftyp (Arg1 => Txt (Txt'First)'Access); - if Res /= E_Ok then - Eti_Exception (Res); - end if; - 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 deleted file mode 100644 index 26841382dcb8a..0000000000000 --- a/Ada95/src/terminal_interface-curses-forms-field_types-regexp.ads +++ /dev/null @@ -1,55 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding -- --- -- --- Terminal_Interface.Curses.Forms.Field_Types.RegExp -- --- -- --- S P E C -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 1998-2003,2009 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "Software"), to deal in the Software without restriction, including -- --- without limitation the rights to use, copy, modify, merge, publish, -- --- distribute, distribute with modifications, sublicense, and/or sell -- --- copies of the Software, and to permit persons to whom the Software is -- --- furnished to do so, subject to the following conditions: -- --- -- --- The above copyright notice and this permission notice shall be included -- --- in all copies or substantial portions of the Software. -- --- -- --- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- --- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- --- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- --- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- --- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- --- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- --- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- --- -- --- Except as contained in this notice, the name(s) of the above copyright -- --- holders shall not be used in advertising or otherwise to promote the -- --- sale, use or other dealings in this Software without prior written -- --- authorization. -- ------------------------------------------------------------------------------- --- Author: Juergen Pfeifer, 1996 --- Version Control: --- $Revision: 1.12 $ --- Binding Version 01.00 ------------------------------------------------------------------------------- -package Terminal_Interface.Curses.Forms.Field_Types.RegExp is - pragma Preelaborate (Terminal_Interface.Curses.Forms.Field_Types.RegExp); - - type String_Access is access String; - - type Regular_Expression_Field is new Field_Type with - record - Regular_Expression : String_Access; - end record; - - procedure Set_Field_Type (Fld : Field; - Typ : Regular_Expression_Field); - pragma Inline (Set_Field_Type); - -end Terminal_Interface.Curses.Forms.Field_Types.RegExp; diff --git a/Ada95/src/terminal_interface-curses-forms-field_types-user-choice.adb b/Ada95/src/terminal_interface-curses-forms-field_types-user-choice.adb deleted file mode 100644 index 3a7e6b5aeb2ed..0000000000000 --- a/Ada95/src/terminal_interface-curses-forms-field_types-user-choice.adb +++ /dev/null @@ -1,108 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding -- --- -- --- Terminal_Interface.Curses.Forms.Field_Types.User.Choice -- --- -- --- B O D Y -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 1998-2008,2011 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "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.17 $ --- $Date: 2011/03/22 10:53:37 $ --- Binding Version 01.00 ------------------------------------------------------------------------------- -with System.Address_To_Access_Conversions; -with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; - -package body Terminal_Interface.Curses.Forms.Field_Types.User.Choice is - - package Argument_Conversions is - new System.Address_To_Access_Conversions (Argument); - - function Generic_Next (Fld : Field; - Usr : System.Address) return Curses_Bool - is - Result : Boolean; - Udf : constant User_Defined_Field_Type_With_Choice_Access := - User_Defined_Field_Type_With_Choice_Access - (Argument_Access (Argument_Conversions.To_Pointer (Usr)).Typ); - begin - Result := Next (Fld, Udf.all); - return Curses_Bool (Boolean'Pos (Result)); - end Generic_Next; - - function Generic_Prev (Fld : Field; - Usr : System.Address) return Curses_Bool - is - Result : Boolean; - Udf : constant User_Defined_Field_Type_With_Choice_Access := - User_Defined_Field_Type_With_Choice_Access - (Argument_Access (Argument_Conversions.To_Pointer (Usr)).Typ); - begin - Result := Previous (Fld, Udf.all); - return Curses_Bool (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 deleted file mode 100644 index 5b132c9192b81..0000000000000 --- a/Ada95/src/terminal_interface-curses-forms-field_types-user-choice.ads +++ /dev/null @@ -1,94 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding -- --- -- --- Terminal_Interface.Curses.Forms.Field_Types.User.Choice -- --- -- --- S P E C -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 1998-2008,2011 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "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: 2011/03/19 12:27:47 $ --- 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 Curses_Bool; - pragma Convention (C, Generic_Next); - -- This is the generic next Choice_Function for the low-level fieldtype - -- representing all the User_Defined_Field_Type derivatives. It routes - -- the call to the Next implementation for the type. - - function Generic_Prev (Fld : Field; - Usr : System.Address) return Curses_Bool; - pragma Convention (C, Generic_Prev); - -- This is the generic prev Choice_Function for the low-level fieldtype - -- representing all the User_Defined_Field_Type derivatives. It routes - -- the call to the Previous implementation for the type. - -end Terminal_Interface.Curses.Forms.Field_Types.User.Choice; diff --git a/Ada95/src/terminal_interface-curses-forms-field_types-user.adb b/Ada95/src/terminal_interface-curses-forms-field_types-user.adb deleted file mode 100644 index 2dd295db7e76e..0000000000000 --- a/Ada95/src/terminal_interface-curses-forms-field_types-user.adb +++ /dev/null @@ -1,133 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding -- --- -- --- Terminal_Interface.Curses.Forms.Field_Types.User -- --- -- --- B O D Y -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 1998-2009,2011 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "Software"), to deal in the Software without restriction, including -- --- without limitation the rights to use, copy, modify, merge, publish, -- --- distribute, distribute with modifications, sublicense, and/or sell -- --- copies of the Software, and to permit persons to whom the Software is -- --- furnished to do so, subject to the following conditions: -- --- -- --- The above copyright notice and this permission notice shall be included -- --- in all copies or substantial portions of the Software. -- --- -- --- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- --- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- --- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- --- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- --- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- --- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- --- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- --- -- --- Except as contained in this notice, the name(s) of the above copyright -- --- holders shall not be used in advertising or otherwise to promote the -- --- sale, use or other dealings in this Software without prior written -- --- authorization. -- ------------------------------------------------------------------------------- --- Author: Juergen Pfeifer, 1996 --- Version Control: --- $Revision: 1.21 $ --- $Date: 2011/03/23 00:44:58 $ --- Binding Version 01.00 ------------------------------------------------------------------------------- -with System.Address_To_Access_Conversions; -with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; - -package body Terminal_Interface.Curses.Forms.Field_Types.User is - - procedure Set_Field_Type (Fld : Field; - Typ : User_Defined_Field_Type) - is - function Allocate_Arg (T : User_Defined_Field_Type'Class) - return Argument_Access; - - function Set_Fld_Type (F : Field := Fld; - Cft : C_Field_Type := C_Generic_Type; - Arg1 : Argument_Access) - return C_Int; - pragma Import (C, Set_Fld_Type, "set_field_type_user"); - - 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; - - package Argument_Conversions is - new System.Address_To_Access_Conversions (Argument); - - function Generic_Field_Check (Fld : Field; - Usr : System.Address) return Curses_Bool - is - Result : Boolean; - Udf : constant User_Defined_Field_Type_Access := - User_Defined_Field_Type_Access - (Argument_Access (Argument_Conversions.To_Pointer (Usr)).all.Typ); - begin - Result := Field_Check (Fld, Udf.all); - return Curses_Bool (Boolean'Pos (Result)); - end Generic_Field_Check; - - function Generic_Char_Check (Ch : C_Int; - Usr : System.Address) return Curses_Bool - is - Result : Boolean; - Udf : constant User_Defined_Field_Type_Access := - User_Defined_Field_Type_Access - (Argument_Access (Argument_Conversions.To_Pointer (Usr)).all.Typ); - begin - Result := Character_Check (Character'Val (Ch), Udf.all); - return Curses_Bool (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 deleted file mode 100644 index 7000fce23dec3..0000000000000 --- a/Ada95/src/terminal_interface-curses-forms-field_types-user.ads +++ /dev/null @@ -1,95 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding -- --- -- --- Terminal_Interface.Curses.Forms.Field_Types.User -- --- -- --- S P E C -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 1998-2009,2011 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "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: 2011/03/19 12:27:21 $ --- Binding Version 01.00 ------------------------------------------------------------------------------- -with Interfaces.C; - -package Terminal_Interface.Curses.Forms.Field_Types.User is - pragma Preelaborate (Terminal_Interface.Curses.Forms.Field_Types.User); - subtype C_Int is Interfaces.C.int; - - type User_Defined_Field_Type is abstract new Field_Type with null record; - -- This is the root of the mechanism we use to create field types in - -- Ada95. You should your own type derive from this one and implement - -- the Field_Check and Character_Check functions for your own type. - - type User_Defined_Field_Type_Access is access all - User_Defined_Field_Type'Class; - - function Field_Check - (Fld : Field; - Typ : User_Defined_Field_Type) return Boolean - is abstract; - -- If True is returned, the field is considered valid, otherwise it is - -- invalid. - - function Character_Check - (Ch : Character; - Typ : User_Defined_Field_Type) return Boolean - is abstract; - -- If True is returned, the character is considered as valid for the - -- field, otherwise as invalid. - - procedure Set_Field_Type (Fld : Field; - Typ : User_Defined_Field_Type); - -- This should work for all types derived from User_Defined_Field_Type. - -- No need to reimplement it for your derived type. - - -- +---------------------------------------------------------------------- - -- | Private Part. - -- | Used by the Choice child package. -private - function C_Generic_Type return C_Field_Type; - - function Generic_Field_Check (Fld : Field; - Usr : System.Address) return Curses_Bool; - pragma Convention (C, Generic_Field_Check); - -- This is the generic Field_Check_Function for the low-level fieldtype - -- representing all the User_Defined_Field_Type derivatives. It routes - -- the call to the Field_Check implementation for the type. - - function Generic_Char_Check (Ch : C_Int; - Usr : System.Address) return Curses_Bool; - pragma Convention (C, Generic_Char_Check); - -- This is the generic Char_Check_Function for the low-level fieldtype - -- representing all the User_Defined_Field_Type derivatives. It routes - -- the call to the Character_Check implementation for the type. - -end Terminal_Interface.Curses.Forms.Field_Types.User; diff --git a/Ada95/src/terminal_interface-curses-forms-field_types.adb b/Ada95/src/terminal_interface-curses-forms-field_types.adb deleted file mode 100644 index 5195a20a499c3..0000000000000 --- a/Ada95/src/terminal_interface-curses-forms-field_types.adb +++ /dev/null @@ -1,283 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding -- --- -- --- Terminal_Interface.Curses.Forms.Field_Types -- --- -- --- B O D Y -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 1998-2009,2011 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "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.25 $ --- $Date: 2011/03/22 23:22:27 $ --- Binding Version 01.00 ------------------------------------------------------------------------------- -with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; -with Ada.Unchecked_Deallocation; -with System.Address_To_Access_Conversions; - --- | --- |===================================================================== --- | man page form_fieldtype.3x --- |===================================================================== --- | -package body Terminal_Interface.Curses.Forms.Field_Types is - - use type System.Address; - - package Argument_Conversions is - new System.Address_To_Access_Conversions (Argument); - - function Get_Fieldtype (F : Field) return C_Field_Type; - pragma Import (C, Get_Fieldtype, "field_type"); - - function Get_Arg (F : Field) return System.Address; - pragma Import (C, Get_Arg, "field_arg"); - -- | - -- |===================================================================== - -- | man page form_field_validation.3x - -- |===================================================================== - -- | - -- | - -- | - function Get_Type (Fld : Field) return Field_Type_Access - is - Low_Level : constant C_Field_Type := Get_Fieldtype (Fld); - Arg : Argument_Access; - begin - if Low_Level = Null_Field_Type then - return null; - else - if Low_Level = M_Builtin_Router or else - Low_Level = M_Generic_Type or else - Low_Level = M_Choice_Router or else - Low_Level = M_Generic_Choice then - Arg := Argument_Access - (Argument_Conversions.To_Pointer (Get_Arg (Fld))); - if Arg = null then - raise Form_Exception; - else - return Arg.all.Typ; - end if; - else - raise Form_Exception; - end if; - end if; - end Get_Type; - - function Copy_Arg (Usr : System.Address) return System.Address - is - begin - return Usr; - end Copy_Arg; - - procedure Free_Arg (Usr : System.Address) - is - procedure Free_Type is new Ada.Unchecked_Deallocation - (Field_Type'Class, Field_Type_Access); - procedure Freeargs is new Ada.Unchecked_Deallocation - (Argument, Argument_Access); - - To_Be_Free : Argument_Access - := Argument_Access (Argument_Conversions.To_Pointer (Usr)); - Low_Level : C_Field_Type; - begin - if To_Be_Free /= null then - if To_Be_Free.all.Usr /= System.Null_Address then - Low_Level := To_Be_Free.all.Cft; - if Low_Level.all.Freearg /= null then - Low_Level.all.Freearg (To_Be_Free.all.Usr); - end if; - end if; - if To_Be_Free.all.Typ /= null then - Free_Type (To_Be_Free.all.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_user"); - - 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.all.Copyarg /= null then - Arg.all.Usr := Low_Level.all.Copyarg (Usr_Arg); - else - Arg.all.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 Curses_Bool - is - Arg : constant Argument_Access - := Argument_Access (Argument_Conversions.To_Pointer (Usr)); - begin - pragma Assert (Arg /= null and then Arg.all.Cft /= Null_Field_Type - and then Arg.all.Typ /= null); - if Arg.all.Cft.all.Fcheck /= null then - return Arg.all.Cft.all.Fcheck (Fld, Arg.all.Usr); - else - return 1; - end if; - end Field_Check_Router; - - function Char_Check_Router (Ch : C_Int; - Usr : System.Address) return Curses_Bool - is - Arg : constant Argument_Access - := Argument_Access (Argument_Conversions.To_Pointer (Usr)); - begin - pragma Assert (Arg /= null and then Arg.all.Cft /= Null_Field_Type - and then Arg.all.Typ /= null); - if Arg.all.Cft.all.Ccheck /= null then - return Arg.all.Cft.all.Ccheck (Ch, Arg.all.Usr); - else - return 1; - end if; - end Char_Check_Router; - - function Next_Router (Fld : Field; - Usr : System.Address) return Curses_Bool - is - Arg : constant Argument_Access - := Argument_Access (Argument_Conversions.To_Pointer (Usr)); - begin - pragma Assert (Arg /= null and then Arg.all.Cft /= Null_Field_Type - and then Arg.all.Typ /= null); - if Arg.all.Cft.all.Next /= null then - return Arg.all.Cft.all.Next (Fld, Arg.all.Usr); - else - return 1; - end if; - end Next_Router; - - function Prev_Router (Fld : Field; - Usr : System.Address) return Curses_Bool - is - Arg : constant Argument_Access := - Argument_Access (Argument_Conversions.To_Pointer (Usr)); - begin - pragma Assert (Arg /= null and then Arg.all.Cft /= Null_Field_Type - and then Arg.all.Typ /= null); - if Arg.all.Cft.all.Prev /= null then - return Arg.all.Cft.all.Prev (Fld, Arg.all.Usr); - else - return 1; - end if; - 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 deleted file mode 100644 index 96178d8a93495..0000000000000 --- a/Ada95/src/terminal_interface-curses-forms-field_user_data.adb +++ /dev/null @@ -1,85 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding -- --- -- --- Terminal_Interface.Curses.Forms.Field_User_Data -- --- -- --- B O D Y -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 1998-2003,2009 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "Software"), to deal in the Software without restriction, including -- --- without limitation the rights to use, copy, modify, merge, publish, -- --- distribute, distribute with modifications, sublicense, and/or sell -- --- copies of the Software, and to permit persons to whom the Software is -- --- furnished to do so, subject to the following conditions: -- --- -- --- The above copyright notice and this permission notice shall be included -- --- in all copies or substantial portions of the Software. -- --- -- --- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- --- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- --- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- --- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- --- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- --- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- --- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- --- -- --- Except as contained in this notice, the name(s) of the above copyright -- --- holders shall not be used in advertising or otherwise to promote the -- --- sale, use or other dealings in this Software without prior written -- --- authorization. -- ------------------------------------------------------------------------------- --- Author: Juergen Pfeifer, 1996 --- Version Control: --- $Revision: 1.13 $ --- Binding Version 01.00 ------------------------------------------------------------------------------- -with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; - --- | --- |===================================================================== --- | man page form_field_userptr.3x --- |===================================================================== --- | -package body Terminal_Interface.Curses.Forms.Field_User_Data is - -- | - -- | - -- | - use type Interfaces.C.int; - - procedure Set_User_Data (Fld : Field; - Data : User_Access) - is - function Set_Field_Userptr (Fld : Field; - Usr : User_Access) return C_Int; - pragma Import (C, Set_Field_Userptr, "set_field_userptr"); - - Res : constant Eti_Error := Set_Field_Userptr (Fld, Data); - begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; - end Set_User_Data; - -- | - -- | - -- | - function Get_User_Data (Fld : Field) return User_Access - is - function Field_Userptr (Fld : Field) return User_Access; - pragma Import (C, Field_Userptr, "field_userptr"); - begin - return Field_Userptr (Fld); - end Get_User_Data; - - procedure Get_User_Data (Fld : Field; - Data : out User_Access) - is - begin - Data := Get_User_Data (Fld); - end Get_User_Data; - -end Terminal_Interface.Curses.Forms.Field_User_Data; diff --git a/Ada95/src/terminal_interface-curses-forms-form_user_data.adb b/Ada95/src/terminal_interface-curses-forms-form_user_data.adb deleted file mode 100644 index 84353eb557006..0000000000000 --- a/Ada95/src/terminal_interface-curses-forms-form_user_data.adb +++ /dev/null @@ -1,86 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding -- --- -- --- Terminal_Interface.Curses.Forms.Form_User_Data -- --- -- --- B O D Y -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 1998-2003,2009 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "Software"), to deal in the Software without restriction, including -- --- without limitation the rights to use, copy, modify, merge, publish, -- --- distribute, distribute with modifications, sublicense, and/or sell -- --- copies of the Software, and to permit persons to whom the Software is -- --- furnished to do so, subject to the following conditions: -- --- -- --- The above copyright notice and this permission notice shall be included -- --- in all copies or substantial portions of the Software. -- --- -- --- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- --- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- --- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- --- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- --- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- --- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- --- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- --- -- --- Except as contained in this notice, the name(s) of the above copyright -- --- holders shall not be used in advertising or otherwise to promote the -- --- sale, use or other dealings in this Software without prior written -- --- authorization. -- ------------------------------------------------------------------------------- --- Author: Juergen Pfeifer, 1996 --- Version Control: --- $Revision: 1.13 $ --- Binding Version 01.00 ------------------------------------------------------------------------------- --- | --- |===================================================================== --- | man page form__userptr.3x --- |===================================================================== --- | -with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; - -package body Terminal_Interface.Curses.Forms.Form_User_Data is - - use type Interfaces.C.int; - - -- | - -- | - -- | - procedure Set_User_Data (Frm : Form; - Data : User_Access) - is - function Set_Form_Userptr (Frm : Form; - Data : User_Access) return C_Int; - pragma Import (C, Set_Form_Userptr, "set_form_userptr"); - - Res : constant Eti_Error := Set_Form_Userptr (Frm, Data); - begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; - end Set_User_Data; - -- | - -- | - -- | - function Get_User_Data (Frm : Form) return User_Access - is - function Form_Userptr (Frm : Form) return User_Access; - pragma Import (C, Form_Userptr, "form_userptr"); - begin - return Form_Userptr (Frm); - end Get_User_Data; - - procedure Get_User_Data (Frm : Form; - Data : out User_Access) - is - begin - Data := Get_User_Data (Frm); - end Get_User_Data; - -end Terminal_Interface.Curses.Forms.Form_User_Data; diff --git a/Ada95/src/terminal_interface-curses-forms.adb b/Ada95/src/terminal_interface-curses-forms.adb deleted file mode 100644 index 915ed58418e0b..0000000000000 --- a/Ada95/src/terminal_interface-curses-forms.adb +++ /dev/null @@ -1,1161 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding -- --- -- --- Terminal_Interface.Curses.Forms -- --- -- --- B O D Y -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 1998-2009,2011 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "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.28 $ --- $Date: 2011/03/22 23:37:32 $ --- Binding Version 01.00 ------------------------------------------------------------------------------- -with Ada.Unchecked_Deallocation; -with Ada.Unchecked_Conversion; - -with Interfaces.C; use Interfaces.C; -with Interfaces.C.Strings; use Interfaces.C.Strings; -with Interfaces.C.Pointers; - -with Terminal_Interface.Curses.Aux; - -package body Terminal_Interface.Curses.Forms is - - use Terminal_Interface.Curses.Aux; - - type C_Field_Array is array (Natural range <>) of aliased Field; - package F_Array is new - Interfaces.C.Pointers (Natural, Field, C_Field_Array, Null_Field); - ------------------------------------------------------------------------------- - -- | - -- | - -- | - -- subtype chars_ptr is Interfaces.C.Strings.chars_ptr; - - function FOS_2_CInt is new - Ada.Unchecked_Conversion (Field_Option_Set, - C_Int); - - function CInt_2_FOS is new - Ada.Unchecked_Conversion (C_Int, - Field_Option_Set); - - function FrmOS_2_CInt is new - Ada.Unchecked_Conversion (Form_Option_Set, - C_Int); - - function CInt_2_FrmOS is new - Ada.Unchecked_Conversion (C_Int, - Form_Option_Set); - - procedure Request_Name (Key : Form_Request_Code; - Name : out String) - is - function Form_Request_Name (Key : C_Int) return chars_ptr; - pragma Import (C, Form_Request_Name, "form_request_name"); - begin - Fill_String (Form_Request_Name (C_Int (Key)), Name); - end Request_Name; - - function Request_Name (Key : Form_Request_Code) return String - is - function Form_Request_Name (Key : C_Int) return chars_ptr; - pragma Import (C, Form_Request_Name, "form_request_name"); - begin - return Fill_String (Form_Request_Name (C_Int (Key))); - end Request_Name; ------------------------------------------------------------------------------- - -- | - -- | - -- | - -- | - -- |===================================================================== - -- | man page form_field_new.3x - -- |===================================================================== - -- | - -- | - -- | - function Create (Height : Line_Count; - Width : Column_Count; - Top : Line_Position; - Left : Column_Position; - Off_Screen : Natural := 0; - More_Buffers : Buffer_Number := Buffer_Number'First) - return Field - is - function Newfield (H, W, T, L, O, M : C_Int) return Field; - pragma Import (C, Newfield, "new_field"); - Fld : constant Field := Newfield (C_Int (Height), C_Int (Width), - C_Int (Top), C_Int (Left), - C_Int (Off_Screen), - C_Int (More_Buffers)); - begin - if Fld = Null_Field then - raise Form_Exception; - end if; - return Fld; - end Create; --- | --- | --- | - procedure Delete (Fld : in out Field) - is - function Free_Field (Fld : Field) return C_Int; - pragma Import (C, Free_Field, "free_field"); - - Res : Eti_Error; - begin - Res := Free_Field (Fld); - if Res /= E_Ok then - Eti_Exception (Res); - end if; - Fld := Null_Field; - end Delete; - -- | - -- | - -- | - function Duplicate (Fld : Field; - Top : Line_Position; - Left : Column_Position) return Field - is - function Dup_Field (Fld : Field; - Top : C_Int; - Left : C_Int) return Field; - pragma Import (C, Dup_Field, "dup_field"); - - F : constant Field := Dup_Field (Fld, - C_Int (Top), - C_Int (Left)); - begin - if F = Null_Field then - raise Form_Exception; - end if; - return F; - end Duplicate; - -- | - -- | - -- | - function Link (Fld : Field; - Top : Line_Position; - Left : Column_Position) return Field - is - function Lnk_Field (Fld : Field; - Top : C_Int; - Left : C_Int) return Field; - pragma Import (C, Lnk_Field, "link_field"); - - F : constant Field := Lnk_Field (Fld, - C_Int (Top), - C_Int (Left)); - begin - if F = Null_Field then - raise Form_Exception; - end if; - return F; - end Link; - -- | - -- |===================================================================== - -- | man page form_field_just.3x - -- |===================================================================== - -- | - -- | - -- | - procedure Set_Justification (Fld : Field; - Just : Field_Justification := None) - is - function Set_Field_Just (Fld : Field; - Just : C_Int) return C_Int; - pragma Import (C, Set_Field_Just, "set_field_just"); - - Res : constant Eti_Error := - Set_Field_Just (Fld, - C_Int (Field_Justification'Pos (Just))); - begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; - end Set_Justification; - -- | - -- | - -- | - function Get_Justification (Fld : Field) return Field_Justification - is - function Field_Just (Fld : Field) return C_Int; - pragma Import (C, Field_Just, "field_just"); - begin - return Field_Justification'Val (Field_Just (Fld)); - end Get_Justification; - -- | - -- |===================================================================== - -- | man page form_field_buffer.3x - -- |===================================================================== - -- | - -- | - -- | - procedure Set_Buffer - (Fld : Field; - Buffer : Buffer_Number := Buffer_Number'First; - Str : String) - is - type Char_Ptr is access all Interfaces.C.char; - function Set_Fld_Buffer (Fld : Field; - Bufnum : C_Int; - S : Char_Ptr) - return C_Int; - pragma Import (C, Set_Fld_Buffer, "set_field_buffer"); - - Txt : char_array (0 .. Str'Length); - Len : size_t; - Res : Eti_Error; - begin - To_C (Str, Txt, Len); - Res := Set_Fld_Buffer (Fld, C_Int (Buffer), Txt (Txt'First)'Access); - if Res /= E_Ok then - Eti_Exception (Res); - end if; - end Set_Buffer; - -- | - -- | - -- | - procedure Get_Buffer - (Fld : Field; - Buffer : Buffer_Number := Buffer_Number'First; - Str : out String) - is - function Field_Buffer (Fld : Field; - B : C_Int) return chars_ptr; - pragma Import (C, Field_Buffer, "field_buffer"); - begin - Fill_String (Field_Buffer (Fld, C_Int (Buffer)), Str); - end Get_Buffer; - - function Get_Buffer - (Fld : Field; - Buffer : Buffer_Number := Buffer_Number'First) return String - is - function Field_Buffer (Fld : Field; - B : C_Int) return chars_ptr; - pragma Import (C, Field_Buffer, "field_buffer"); - begin - return Fill_String (Field_Buffer (Fld, C_Int (Buffer))); - end Get_Buffer; - -- | - -- | - -- | - procedure Set_Status (Fld : Field; - Status : Boolean := True) - is - function Set_Fld_Status (Fld : Field; - St : C_Int) return C_Int; - pragma Import (C, Set_Fld_Status, "set_field_status"); - - Res : constant Eti_Error := Set_Fld_Status (Fld, Boolean'Pos (Status)); - begin - if Res /= E_Ok then - raise Form_Exception; - end if; - end Set_Status; - -- | - -- | - -- | - function Changed (Fld : Field) return Boolean - is - function Field_Status (Fld : Field) return C_Int; - pragma Import (C, Field_Status, "field_status"); - - Res : constant C_Int := Field_Status (Fld); - begin - if Res = Curses_False then - return False; - else - return True; - end if; - end Changed; - -- | - -- | - -- | - procedure Set_Maximum_Size (Fld : Field; - Max : Natural := 0) - is - function Set_Field_Max (Fld : Field; - M : C_Int) return C_Int; - pragma Import (C, Set_Field_Max, "set_max_field"); - - Res : constant Eti_Error := Set_Field_Max (Fld, C_Int (Max)); - begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; - end Set_Maximum_Size; - -- | - -- |===================================================================== - -- | man page form_field_opts.3x - -- |===================================================================== - -- | - -- | - -- | - procedure Set_Options (Fld : Field; - Options : Field_Option_Set) - is - function Set_Field_Opts (Fld : Field; - Opt : C_Int) return C_Int; - pragma Import (C, Set_Field_Opts, "set_field_opts"); - - Opt : constant C_Int := FOS_2_CInt (Options); - Res : Eti_Error; - begin - Res := Set_Field_Opts (Fld, Opt); - if Res /= E_Ok then - Eti_Exception (Res); - end if; - end Set_Options; - -- | - -- | - -- | - procedure Switch_Options (Fld : Field; - Options : Field_Option_Set; - On : Boolean := True) - is - function Field_Opts_On (Fld : Field; - Opt : C_Int) return C_Int; - pragma Import (C, Field_Opts_On, "field_opts_on"); - function Field_Opts_Off (Fld : Field; - Opt : C_Int) return C_Int; - pragma Import (C, Field_Opts_Off, "field_opts_off"); - - Err : Eti_Error; - Opt : constant C_Int := FOS_2_CInt (Options); - begin - if On then - Err := Field_Opts_On (Fld, Opt); - else - Err := Field_Opts_Off (Fld, Opt); - end if; - if Err /= E_Ok then - Eti_Exception (Err); - end if; - end Switch_Options; - -- | - -- | - -- | - procedure Get_Options (Fld : Field; - Options : out Field_Option_Set) - is - function Field_Opts (Fld : Field) return C_Int; - pragma Import (C, Field_Opts, "field_opts"); - - Res : constant C_Int := Field_Opts (Fld); - begin - Options := CInt_2_FOS (Res); - end Get_Options; - -- | - -- | - -- | - function Get_Options (Fld : Field := Null_Field) - return Field_Option_Set - is - Fos : Field_Option_Set; - begin - Get_Options (Fld, Fos); - return Fos; - end Get_Options; - -- | - -- |===================================================================== - -- | man page form_field_attributes.3x - -- |===================================================================== - -- | - -- | - -- | - procedure Set_Foreground - (Fld : Field; - Fore : Character_Attribute_Set := Normal_Video; - Color : Color_Pair := Color_Pair'First) - is - function Set_Field_Fore (Fld : Field; - Attr : C_Chtype) return C_Int; - pragma Import (C, Set_Field_Fore, "set_field_fore"); - - Ch : constant Attributed_Character := (Ch => Character'First, - Color => Color, - Attr => Fore); - Res : constant Eti_Error := - Set_Field_Fore (Fld, AttrChar_To_Chtype (Ch)); - begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; - end Set_Foreground; - -- | - -- | - -- | - procedure Foreground (Fld : Field; - Fore : out Character_Attribute_Set) - is - function Field_Fore (Fld : Field) return C_Chtype; - pragma Import (C, Field_Fore, "field_fore"); - begin - Fore := Chtype_To_AttrChar (Field_Fore (Fld)).Attr; - end Foreground; - - procedure Foreground (Fld : Field; - Fore : out Character_Attribute_Set; - Color : out Color_Pair) - is - function Field_Fore (Fld : Field) return C_Chtype; - pragma Import (C, Field_Fore, "field_fore"); - begin - Fore := Chtype_To_AttrChar (Field_Fore (Fld)).Attr; - Color := Chtype_To_AttrChar (Field_Fore (Fld)).Color; - end Foreground; - -- | - -- | - -- | - procedure Set_Background - (Fld : Field; - Back : Character_Attribute_Set := Normal_Video; - Color : Color_Pair := Color_Pair'First) - is - function Set_Field_Back (Fld : Field; - Attr : C_Chtype) return C_Int; - pragma Import (C, Set_Field_Back, "set_field_back"); - - Ch : constant Attributed_Character := (Ch => Character'First, - Color => Color, - Attr => Back); - Res : constant Eti_Error := - Set_Field_Back (Fld, AttrChar_To_Chtype (Ch)); - begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; - end Set_Background; - -- | - -- | - -- | - procedure Background (Fld : Field; - Back : out Character_Attribute_Set) - is - function Field_Back (Fld : Field) return C_Chtype; - pragma Import (C, Field_Back, "field_back"); - begin - Back := Chtype_To_AttrChar (Field_Back (Fld)).Attr; - end Background; - - procedure Background (Fld : Field; - Back : out Character_Attribute_Set; - Color : out Color_Pair) - is - function Field_Back (Fld : Field) return C_Chtype; - pragma Import (C, Field_Back, "field_back"); - begin - Back := Chtype_To_AttrChar (Field_Back (Fld)).Attr; - Color := Chtype_To_AttrChar (Field_Back (Fld)).Color; - end Background; - -- | - -- | - -- | - procedure Set_Pad_Character (Fld : Field; - Pad : Character := Space) - is - function Set_Field_Pad (Fld : Field; - Ch : C_Int) return C_Int; - pragma Import (C, Set_Field_Pad, "set_field_pad"); - - Res : constant Eti_Error := Set_Field_Pad (Fld, - C_Int (Character'Pos (Pad))); - begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; - end Set_Pad_Character; - -- | - -- | - -- | - procedure Pad_Character (Fld : Field; - Pad : out Character) - is - function Field_Pad (Fld : Field) return C_Int; - pragma Import (C, Field_Pad, "field_pad"); - begin - Pad := Character'Val (Field_Pad (Fld)); - end Pad_Character; - -- | - -- |===================================================================== - -- | man page form_field_info.3x - -- |===================================================================== - -- | - -- | - -- | - procedure Info (Fld : Field; - Lines : out Line_Count; - Columns : out Column_Count; - First_Row : out Line_Position; - First_Column : out Column_Position; - Off_Screen : out Natural; - Additional_Buffers : out Buffer_Number) - is - type C_Int_Access is access all C_Int; - function Fld_Info (Fld : Field; - L, C, Fr, Fc, Os, Ab : C_Int_Access) - return C_Int; - pragma Import (C, Fld_Info, "field_info"); - - L, C, Fr, Fc, Os, Ab : aliased C_Int; - Res : constant Eti_Error := Fld_Info (Fld, - L'Access, C'Access, - Fr'Access, Fc'Access, - Os'Access, Ab'Access); - begin - if Res /= E_Ok then - Eti_Exception (Res); - else - Lines := Line_Count (L); - Columns := Column_Count (C); - First_Row := Line_Position (Fr); - First_Column := Column_Position (Fc); - Off_Screen := Natural (Os); - Additional_Buffers := Buffer_Number (Ab); - end if; - end Info; --- | --- | --- | - procedure Dynamic_Info (Fld : Field; - Lines : out Line_Count; - Columns : out Column_Count; - Max : out Natural) - is - type C_Int_Access is access all C_Int; - function Dyn_Info (Fld : Field; L, C, M : C_Int_Access) return C_Int; - pragma Import (C, Dyn_Info, "dynamic_field_info"); - - L, C, M : aliased C_Int; - Res : constant Eti_Error := Dyn_Info (Fld, - L'Access, C'Access, - M'Access); - begin - if Res /= E_Ok then - Eti_Exception (Res); - else - Lines := Line_Count (L); - Columns := Column_Count (C); - Max := Natural (M); - end if; - end Dynamic_Info; - -- | - -- |===================================================================== - -- | man page form_win.3x - -- |===================================================================== - -- | - -- | - -- | - procedure Set_Window (Frm : Form; - Win : Window) - is - function Set_Form_Win (Frm : Form; - Win : Window) return C_Int; - pragma Import (C, Set_Form_Win, "set_form_win"); - - Res : constant Eti_Error := Set_Form_Win (Frm, Win); - begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; - end Set_Window; - -- | - -- | - -- | - function Get_Window (Frm : Form) return Window - is - function Form_Win (Frm : Form) return Window; - pragma Import (C, Form_Win, "form_win"); - - W : constant Window := Form_Win (Frm); - begin - return W; - end Get_Window; - -- | - -- | - -- | - procedure Set_Sub_Window (Frm : Form; - Win : Window) - is - function Set_Form_Sub (Frm : Form; - Win : Window) return C_Int; - pragma Import (C, Set_Form_Sub, "set_form_sub"); - - Res : constant Eti_Error := Set_Form_Sub (Frm, Win); - begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; - end Set_Sub_Window; - -- | - -- | - -- | - function Get_Sub_Window (Frm : Form) return Window - is - function Form_Sub (Frm : Form) return Window; - pragma Import (C, Form_Sub, "form_sub"); - - W : constant Window := Form_Sub (Frm); - begin - return W; - end Get_Sub_Window; - -- | - -- | - -- | - procedure Scale (Frm : Form; - Lines : out Line_Count; - Columns : out Column_Count) - is - type C_Int_Access is access all C_Int; - function M_Scale (Frm : Form; Yp, Xp : C_Int_Access) return C_Int; - pragma Import (C, M_Scale, "scale_form"); - - X, Y : aliased C_Int; - Res : constant Eti_Error := M_Scale (Frm, Y'Access, X'Access); - begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; - Lines := Line_Count (Y); - Columns := Column_Count (X); - end Scale; - -- | - -- |===================================================================== - -- | man page menu_hook.3x - -- |===================================================================== - -- | - -- | - -- | - procedure Set_Field_Init_Hook (Frm : Form; - Proc : Form_Hook_Function) - is - function Set_Field_Init (Frm : Form; - Proc : Form_Hook_Function) return C_Int; - pragma Import (C, Set_Field_Init, "set_field_init"); - - Res : constant Eti_Error := Set_Field_Init (Frm, Proc); - begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; - end Set_Field_Init_Hook; - -- | - -- | - -- | - procedure Set_Field_Term_Hook (Frm : Form; - Proc : Form_Hook_Function) - is - function Set_Field_Term (Frm : Form; - Proc : Form_Hook_Function) return C_Int; - pragma Import (C, Set_Field_Term, "set_field_term"); - - Res : constant Eti_Error := Set_Field_Term (Frm, Proc); - begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; - end Set_Field_Term_Hook; - -- | - -- | - -- | - procedure Set_Form_Init_Hook (Frm : Form; - Proc : Form_Hook_Function) - is - function Set_Form_Init (Frm : Form; - Proc : Form_Hook_Function) return C_Int; - pragma Import (C, Set_Form_Init, "set_form_init"); - - Res : constant Eti_Error := Set_Form_Init (Frm, Proc); - begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; - end Set_Form_Init_Hook; - -- | - -- | - -- | - procedure Set_Form_Term_Hook (Frm : Form; - Proc : Form_Hook_Function) - is - function Set_Form_Term (Frm : Form; - Proc : Form_Hook_Function) return C_Int; - pragma Import (C, Set_Form_Term, "set_form_term"); - - Res : constant Eti_Error := Set_Form_Term (Frm, Proc); - begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; - end Set_Form_Term_Hook; - -- | - -- |===================================================================== - -- | man page form_fields.3x - -- |===================================================================== - -- | - -- | - -- | - procedure Redefine (Frm : Form; - Flds : Field_Array_Access) - is - function Set_Frm_Fields (Frm : Form; - Items : System.Address) return C_Int; - pragma Import (C, Set_Frm_Fields, "set_form_fields"); - - Res : Eti_Error; - begin - pragma Assert (Flds.all (Flds'Last) = Null_Field); - if Flds.all (Flds'Last) /= Null_Field then - raise Form_Exception; - else - Res := Set_Frm_Fields (Frm, Flds.all (Flds'First)'Address); - if Res /= E_Ok then - Eti_Exception (Res); - end if; - end if; - end Redefine; - -- | - -- | - -- | - function Fields (Frm : Form; - Index : Positive) return Field - is - use F_Array; - - function C_Fields (Frm : Form) return Pointer; - pragma Import (C, C_Fields, "form_fields"); - - P : Pointer := C_Fields (Frm); - begin - if P = null or else Index > Field_Count (Frm) then - raise Form_Exception; - else - P := P + ptrdiff_t (C_Int (Index) - 1); - return P.all; - end if; - end Fields; - -- | - -- | - -- | - function Field_Count (Frm : Form) return Natural - is - function Count (Frm : Form) return C_Int; - pragma Import (C, Count, "field_count"); - begin - return Natural (Count (Frm)); - end Field_Count; - -- | - -- | - -- | - procedure Move (Fld : Field; - Line : Line_Position; - Column : Column_Position) - is - function Move (Fld : Field; L, C : C_Int) return C_Int; - pragma Import (C, Move, "move_field"); - - Res : constant Eti_Error := Move (Fld, C_Int (Line), C_Int (Column)); - begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; - end Move; - -- | - -- |===================================================================== - -- | man page form_new.3x - -- |===================================================================== - -- | - -- | - -- | - function Create (Fields : Field_Array_Access) return Form - is - function NewForm (Fields : System.Address) return Form; - pragma Import (C, NewForm, "new_form"); - - M : Form; - begin - pragma Assert (Fields.all (Fields'Last) = Null_Field); - if Fields.all (Fields'Last) /= Null_Field then - raise Form_Exception; - else - M := NewForm (Fields.all (Fields'First)'Address); - if M = Null_Form then - raise Form_Exception; - end if; - return M; - end if; - end Create; - -- | - -- | - -- | - procedure Delete (Frm : in out Form) - is - function Free (Frm : Form) return C_Int; - pragma Import (C, Free, "free_form"); - - Res : constant Eti_Error := Free (Frm); - begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; - Frm := Null_Form; - end Delete; - -- | - -- |===================================================================== - -- | man page form_opts.3x - -- |===================================================================== - -- | - -- | - -- | - procedure Set_Options (Frm : Form; - Options : Form_Option_Set) - is - function Set_Form_Opts (Frm : Form; - Opt : C_Int) return C_Int; - pragma Import (C, Set_Form_Opts, "set_form_opts"); - - Opt : constant C_Int := FrmOS_2_CInt (Options); - Res : Eti_Error; - begin - Res := Set_Form_Opts (Frm, Opt); - if Res /= E_Ok then - Eti_Exception (Res); - end if; - end Set_Options; - -- | - -- | - -- | - procedure Switch_Options (Frm : Form; - Options : Form_Option_Set; - On : Boolean := True) - is - function Form_Opts_On (Frm : Form; - Opt : C_Int) return C_Int; - pragma Import (C, Form_Opts_On, "form_opts_on"); - function Form_Opts_Off (Frm : Form; - Opt : C_Int) return C_Int; - pragma Import (C, Form_Opts_Off, "form_opts_off"); - - Err : Eti_Error; - Opt : constant C_Int := FrmOS_2_CInt (Options); - begin - if On then - Err := Form_Opts_On (Frm, Opt); - else - Err := Form_Opts_Off (Frm, Opt); - end if; - if Err /= E_Ok then - Eti_Exception (Err); - end if; - end Switch_Options; - -- | - -- | - -- | - procedure Get_Options (Frm : Form; - Options : out Form_Option_Set) - is - function Form_Opts (Frm : Form) return C_Int; - pragma Import (C, Form_Opts, "form_opts"); - - Res : constant C_Int := Form_Opts (Frm); - begin - Options := CInt_2_FrmOS (Res); - end Get_Options; - -- | - -- | - -- | - function Get_Options (Frm : Form := Null_Form) return Form_Option_Set - is - Fos : Form_Option_Set; - begin - Get_Options (Frm, Fos); - return Fos; - end Get_Options; - -- | - -- |===================================================================== - -- | man page form_post.3x - -- |===================================================================== - -- | - -- | - -- | - procedure Post (Frm : Form; - Post : Boolean := True) - is - function M_Post (Frm : Form) return C_Int; - pragma Import (C, M_Post, "post_form"); - function M_Unpost (Frm : Form) return C_Int; - pragma Import (C, M_Unpost, "unpost_form"); - - Res : Eti_Error; - begin - if Post then - Res := M_Post (Frm); - else - Res := M_Unpost (Frm); - end if; - if Res /= E_Ok then - Eti_Exception (Res); - end if; - end Post; - -- | - -- |===================================================================== - -- | man page form_cursor.3x - -- |===================================================================== - -- | - -- | - -- | - procedure Position_Cursor (Frm : Form) - is - function Pos_Form_Cursor (Frm : Form) return C_Int; - pragma Import (C, Pos_Form_Cursor, "pos_form_cursor"); - - Res : constant Eti_Error := Pos_Form_Cursor (Frm); - begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; - end Position_Cursor; - -- | - -- |===================================================================== - -- | man page form_data.3x - -- |===================================================================== - -- | - -- | - -- | - function Data_Ahead (Frm : Form) return Boolean - is - function Ahead (Frm : Form) return C_Int; - pragma Import (C, Ahead, "data_ahead"); - - Res : constant C_Int := Ahead (Frm); - begin - if Res = Curses_False then - return False; - else - return True; - end if; - end Data_Ahead; - -- | - -- | - -- | - function Data_Behind (Frm : Form) return Boolean - is - function Behind (Frm : Form) return C_Int; - pragma Import (C, Behind, "data_behind"); - - Res : constant C_Int := Behind (Frm); - begin - if Res = Curses_False then - return False; - else - return True; - end if; - end Data_Behind; - -- | - -- |===================================================================== - -- | man page form_driver.3x - -- |===================================================================== - -- | - -- | - -- | - function Driver (Frm : Form; - Key : Key_Code) return Driver_Result - is - function Frm_Driver (Frm : Form; Key : C_Int) return C_Int; - pragma Import (C, Frm_Driver, "form_driver"); - - R : constant Eti_Error := Frm_Driver (Frm, C_Int (Key)); - begin - if R /= E_Ok then - if R = E_Unknown_Command then - return Unknown_Request; - elsif R = E_Invalid_Field then - return Invalid_Field; - elsif R = E_Request_Denied then - return Request_Denied; - else - Eti_Exception (R); - return Form_Ok; - end if; - else - return Form_Ok; - end if; - end Driver; - -- | - -- |===================================================================== - -- | man page form_page.3x - -- |===================================================================== - -- | - -- | - -- | - procedure Set_Current (Frm : Form; - Fld : Field) - is - function Set_Current_Fld (Frm : Form; Fld : Field) return C_Int; - pragma Import (C, Set_Current_Fld, "set_current_field"); - - Res : constant Eti_Error := Set_Current_Fld (Frm, Fld); - begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; - end Set_Current; - -- | - -- | - -- | - function Current (Frm : Form) return Field - is - function Current_Fld (Frm : Form) return Field; - pragma Import (C, Current_Fld, "current_field"); - - Fld : constant Field := Current_Fld (Frm); - begin - if Fld = Null_Field then - raise Form_Exception; - end if; - return Fld; - end Current; - -- | - -- | - -- | - procedure Set_Page (Frm : Form; - Page : Page_Number := Page_Number'First) - is - function Set_Frm_Page (Frm : Form; Pg : C_Int) return C_Int; - pragma Import (C, Set_Frm_Page, "set_form_page"); - - Res : constant Eti_Error := Set_Frm_Page (Frm, C_Int (Page)); - begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; - end Set_Page; - -- | - -- | - -- | - function Page (Frm : Form) return Page_Number - is - function Get_Page (Frm : Form) return C_Int; - pragma Import (C, Get_Page, "form_page"); - - P : constant C_Int := Get_Page (Frm); - begin - if P < 0 then - raise Form_Exception; - else - return Page_Number (P); - end if; - end Page; - - function Get_Index (Fld : Field) return Positive - is - function Get_Fieldindex (Fld : Field) return C_Int; - pragma Import (C, Get_Fieldindex, "field_index"); - - Res : constant C_Int := Get_Fieldindex (Fld); - begin - if Res = Curses_Err then - raise Form_Exception; - end if; - return Positive (Natural (Res) + Positive'First); - end Get_Index; - - -- | - -- |===================================================================== - -- | man page form_new_page.3x - -- |===================================================================== - -- | - -- | - -- | - procedure Set_New_Page (Fld : Field; - New_Page : Boolean := True) - is - function Set_Page (Fld : Field; Flg : C_Int) return C_Int; - pragma Import (C, Set_Page, "set_new_page"); - - Res : constant Eti_Error := Set_Page (Fld, Boolean'Pos (New_Page)); - begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; - end Set_New_Page; - -- | - -- | - -- | - function Is_New_Page (Fld : Field) return Boolean - is - function Is_New (Fld : Field) return C_Int; - pragma Import (C, Is_New, "new_page"); - - Res : constant C_Int := Is_New (Fld); - begin - if Res = Curses_False then - return False; - else - return True; - end if; - end Is_New_Page; - - procedure Free (FA : in out Field_Array_Access; - Free_Fields : Boolean := False) - is - procedure Release is new Ada.Unchecked_Deallocation - (Field_Array, Field_Array_Access); - begin - if FA /= null and then Free_Fields then - for I in FA'First .. (FA'Last - 1) loop - if FA.all (I) /= Null_Field then - Delete (FA.all (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 deleted file mode 100644 index eb06d096dfb27..0000000000000 --- a/Ada95/src/terminal_interface-curses-menus-item_user_data.adb +++ /dev/null @@ -1,77 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding -- --- -- --- Terminal_Interface.Curses.Menus.Item_User_Data -- --- -- --- B O D Y -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 1998-2003,2009 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "Software"), to deal in the Software without restriction, including -- --- without limitation the rights to use, copy, modify, merge, publish, -- --- distribute, distribute with modifications, sublicense, and/or sell -- --- copies of the Software, and to permit persons to whom the Software is -- --- furnished to do so, subject to the following conditions: -- --- -- --- The above copyright notice and this permission notice shall be included -- --- in all copies or substantial portions of the Software. -- --- -- --- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- --- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- --- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- --- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- --- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- --- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- --- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- --- -- --- Except as contained in this notice, the name(s) of the above copyright -- --- holders shall not be used in advertising or otherwise to promote the -- --- sale, use or other dealings in this Software without prior written -- --- authorization. -- ------------------------------------------------------------------------------- --- Author: Juergen Pfeifer, 1996 --- Version Control: --- $Revision: 1.12 $ --- Binding Version 01.00 ------------------------------------------------------------------------------- -with Interfaces.C; -with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; - -package body Terminal_Interface.Curses.Menus.Item_User_Data is - - use type Interfaces.C.int; - - procedure Set_User_Data (Itm : Item; - Data : User_Access) - is - function Set_Item_Userptr (Itm : Item; - Addr : User_Access) return C_Int; - pragma Import (C, Set_Item_Userptr, "set_item_userptr"); - - Res : constant Eti_Error := Set_Item_Userptr (Itm, Data); - begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; - end Set_User_Data; - - function Get_User_Data (Itm : Item) return User_Access - is - function Item_Userptr (Itm : Item) return User_Access; - pragma Import (C, Item_Userptr, "item_userptr"); - begin - return Item_Userptr (Itm); - end Get_User_Data; - - procedure Get_User_Data (Itm : Item; - Data : out User_Access) - is - begin - Data := Get_User_Data (Itm); - end Get_User_Data; - -end Terminal_Interface.Curses.Menus.Item_User_Data; diff --git a/Ada95/src/terminal_interface-curses-menus-menu_user_data.adb b/Ada95/src/terminal_interface-curses-menus-menu_user_data.adb deleted file mode 100644 index 7d66a8c052eed..0000000000000 --- a/Ada95/src/terminal_interface-curses-menus-menu_user_data.adb +++ /dev/null @@ -1,76 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding -- --- -- --- Terminal_Interface.Curses.Menus.Menu_User_Data -- --- -- --- B O D Y -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 1998-2003,2009 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "Software"), to deal in the Software without restriction, including -- --- without limitation the rights to use, copy, modify, merge, publish, -- --- distribute, distribute with modifications, sublicense, and/or sell -- --- copies of the Software, and to permit persons to whom the Software is -- --- furnished to do so, subject to the following conditions: -- --- -- --- The above copyright notice and this permission notice shall be included -- --- in all copies or substantial portions of the Software. -- --- -- --- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- --- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- --- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- --- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- --- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- --- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- --- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- --- -- --- Except as contained in this notice, the name(s) of the above copyright -- --- holders shall not be used in advertising or otherwise to promote the -- --- sale, use or other dealings in this Software without prior written -- --- authorization. -- ------------------------------------------------------------------------------- --- Author: Juergen Pfeifer, 1996 --- Version Control: --- $Revision: 1.13 $ --- Binding Version 01.00 ------------------------------------------------------------------------------- -with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; - -package body Terminal_Interface.Curses.Menus.Menu_User_Data is - - use type Interfaces.C.int; - - procedure Set_User_Data (Men : Menu; - Data : User_Access) - is - function Set_Menu_Userptr (Men : Menu; - Data : User_Access) return C_Int; - pragma Import (C, Set_Menu_Userptr, "set_menu_userptr"); - - Res : constant Eti_Error := Set_Menu_Userptr (Men, Data); - begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; - end Set_User_Data; - - function Get_User_Data (Men : Menu) return User_Access - is - function Menu_Userptr (Men : Menu) return User_Access; - pragma Import (C, Menu_Userptr, "menu_userptr"); - begin - return Menu_Userptr (Men); - end Get_User_Data; - - procedure Get_User_Data (Men : Menu; - Data : out User_Access) - is - begin - Data := Get_User_Data (Men); - end Get_User_Data; - -end Terminal_Interface.Curses.Menus.Menu_User_Data; diff --git a/Ada95/src/terminal_interface-curses-menus.adb b/Ada95/src/terminal_interface-curses-menus.adb deleted file mode 100644 index a7dca07c28767..0000000000000 --- a/Ada95/src/terminal_interface-curses-menus.adb +++ /dev/null @@ -1,1022 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding -- --- -- --- Terminal_Interface.Curses.Menus -- --- -- --- B O D Y -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 1998-2009,2011 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "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.28 $ --- $Date: 2011/03/22 23:38:12 $ --- Binding Version 01.00 ------------------------------------------------------------------------------- -with Ada.Unchecked_Deallocation; -with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; - -with Interfaces.C; use Interfaces.C; -with Interfaces.C.Strings; use Interfaces.C.Strings; -with Interfaces.C.Pointers; - -with Ada.Unchecked_Conversion; - -package body Terminal_Interface.Curses.Menus is - - type C_Item_Array is array (Natural range <>) of aliased Item; - package I_Array is new - Interfaces.C.Pointers (Natural, Item, C_Item_Array, Null_Item); - - use type System.Bit_Order; - subtype chars_ptr is Interfaces.C.Strings.chars_ptr; - - function MOS_2_CInt is new - Ada.Unchecked_Conversion (Menu_Option_Set, - C_Int); - - function CInt_2_MOS is new - Ada.Unchecked_Conversion (C_Int, - Menu_Option_Set); - - function IOS_2_CInt is new - Ada.Unchecked_Conversion (Item_Option_Set, - C_Int); - - function CInt_2_IOS is new - Ada.Unchecked_Conversion (C_Int, - Item_Option_Set); - ------------------------------------------------------------------------------- - procedure Request_Name (Key : Menu_Request_Code; - Name : out String) - is - function Request_Name (Key : C_Int) return chars_ptr; - pragma Import (C, Request_Name, "menu_request_name"); - begin - Fill_String (Request_Name (C_Int (Key)), Name); - end Request_Name; - - function Request_Name (Key : Menu_Request_Code) return String - is - function Request_Name (Key : C_Int) return chars_ptr; - pragma Import (C, Request_Name, "menu_request_name"); - begin - return Fill_String (Request_Name (C_Int (Key))); - end Request_Name; - - function Create (Name : String; - Description : String := "") return Item - is - type Char_Ptr is access all Interfaces.C.char; - function Newitem (Name, Desc : Char_Ptr) return Item; - pragma Import (C, Newitem, "new_item"); - - type Name_String is new char_array (0 .. Name'Length); - type Name_String_Ptr is access Name_String; - pragma Controlled (Name_String_Ptr); - - type Desc_String is new char_array (0 .. Description'Length); - type Desc_String_Ptr is access Desc_String; - pragma Controlled (Desc_String_Ptr); - - Name_Str : constant Name_String_Ptr := new Name_String; - Desc_Str : constant Desc_String_Ptr := new Desc_String; - Name_Len, Desc_Len : size_t; - Result : Item; - begin - To_C (Name, Name_Str.all, Name_Len); - To_C (Description, Desc_Str.all, Desc_Len); - Result := Newitem (Name_Str.all (Name_Str.all'First)'Access, - Desc_Str.all (Desc_Str.all'First)'Access); - if Result = Null_Item then - raise Eti_System_Error; - end if; - return Result; - end Create; - - procedure Delete (Itm : in out Item) - is - function Descname (Itm : Item) return chars_ptr; - pragma Import (C, Descname, "item_description"); - function Itemname (Itm : Item) return chars_ptr; - pragma Import (C, Itemname, "item_name"); - - function Freeitem (Itm : Item) return C_Int; - pragma Import (C, Freeitem, "free_item"); - - Res : Eti_Error; - Ptr : chars_ptr; - begin - Ptr := Descname (Itm); - if Ptr /= Null_Ptr then - Interfaces.C.Strings.Free (Ptr); - end if; - Ptr := Itemname (Itm); - if Ptr /= Null_Ptr then - Interfaces.C.Strings.Free (Ptr); - end if; - Res := Freeitem (Itm); - if Res /= E_Ok then - Eti_Exception (Res); - end if; - Itm := Null_Item; - end Delete; -------------------------------------------------------------------------------- - procedure Set_Value (Itm : Item; - Value : Boolean := True) - is - function Set_Item_Val (Itm : Item; - Val : C_Int) return C_Int; - pragma Import (C, Set_Item_Val, "set_item_value"); - - Res : constant Eti_Error := Set_Item_Val (Itm, Boolean'Pos (Value)); - begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; - end Set_Value; - - function Value (Itm : Item) return Boolean - is - function Item_Val (Itm : Item) return C_Int; - pragma Import (C, Item_Val, "item_value"); - begin - if Item_Val (Itm) = Curses_False then - return False; - else - return True; - end if; - end Value; - -------------------------------------------------------------------------------- - function Visible (Itm : Item) return Boolean - is - function Item_Vis (Itm : Item) return C_Int; - pragma Import (C, Item_Vis, "item_visible"); - begin - if Item_Vis (Itm) = Curses_False then - return False; - else - return True; - end if; - end Visible; -------------------------------------------------------------------------------- - procedure Set_Options (Itm : Item; - Options : Item_Option_Set) - is - function Set_Item_Opts (Itm : Item; - Opt : C_Int) return C_Int; - pragma Import (C, Set_Item_Opts, "set_item_opts"); - - Opt : constant C_Int := IOS_2_CInt (Options); - Res : Eti_Error; - begin - Res := Set_Item_Opts (Itm, Opt); - if Res /= E_Ok then - Eti_Exception (Res); - end if; - end Set_Options; - - procedure Switch_Options (Itm : Item; - Options : Item_Option_Set; - On : Boolean := True) - is - function Item_Opts_On (Itm : Item; - Opt : C_Int) return C_Int; - pragma Import (C, Item_Opts_On, "item_opts_on"); - function Item_Opts_Off (Itm : Item; - Opt : C_Int) return C_Int; - pragma Import (C, Item_Opts_Off, "item_opts_off"); - - Opt : constant C_Int := IOS_2_CInt (Options); - Err : Eti_Error; - begin - if On then - Err := Item_Opts_On (Itm, Opt); - else - Err := Item_Opts_Off (Itm, Opt); - end if; - if Err /= E_Ok then - Eti_Exception (Err); - end if; - end Switch_Options; - - procedure Get_Options (Itm : Item; - Options : out Item_Option_Set) - is - function Item_Opts (Itm : Item) return C_Int; - pragma Import (C, Item_Opts, "item_opts"); - - Res : constant C_Int := Item_Opts (Itm); - begin - Options := CInt_2_IOS (Res); - end Get_Options; - - function Get_Options (Itm : Item := Null_Item) return Item_Option_Set - is - Ios : Item_Option_Set; - begin - Get_Options (Itm, Ios); - return Ios; - end Get_Options; -------------------------------------------------------------------------------- - procedure Name (Itm : Item; - Name : out String) - is - function Itemname (Itm : Item) return chars_ptr; - pragma Import (C, Itemname, "item_name"); - begin - Fill_String (Itemname (Itm), Name); - end Name; - - function Name (Itm : Item) return String - is - function Itemname (Itm : Item) return chars_ptr; - pragma Import (C, Itemname, "item_name"); - begin - return Fill_String (Itemname (Itm)); - end Name; - - procedure Description (Itm : Item; - Description : out String) - is - function Descname (Itm : Item) return chars_ptr; - pragma Import (C, Descname, "item_description"); - begin - Fill_String (Descname (Itm), Description); - end Description; - - function Description (Itm : Item) return String - is - function Descname (Itm : Item) return chars_ptr; - pragma Import (C, Descname, "item_description"); - begin - return Fill_String (Descname (Itm)); - end Description; -------------------------------------------------------------------------------- - procedure Set_Current (Men : Menu; - Itm : Item) - is - function Set_Curr_Item (Men : Menu; - Itm : Item) return C_Int; - pragma Import (C, Set_Curr_Item, "set_current_item"); - - Res : constant Eti_Error := Set_Curr_Item (Men, Itm); - begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; - end Set_Current; - - function Current (Men : Menu) return Item - is - function Curr_Item (Men : Menu) return Item; - pragma Import (C, Curr_Item, "current_item"); - - Res : constant Item := Curr_Item (Men); - begin - if Res = Null_Item then - raise Menu_Exception; - end if; - return Res; - end Current; - - procedure Set_Top_Row (Men : Menu; - Line : Line_Position) - is - function Set_Toprow (Men : Menu; - Line : C_Int) return C_Int; - pragma Import (C, Set_Toprow, "set_top_row"); - - Res : constant Eti_Error := Set_Toprow (Men, C_Int (Line)); - begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; - end Set_Top_Row; - - function Top_Row (Men : Menu) return Line_Position - is - function Toprow (Men : Menu) return C_Int; - pragma Import (C, Toprow, "top_row"); - - Res : constant C_Int := Toprow (Men); - begin - if Res = Curses_Err then - raise Menu_Exception; - end if; - return Line_Position (Res); - end Top_Row; - - function Get_Index (Itm : Item) return Positive - is - function Get_Itemindex (Itm : Item) return C_Int; - pragma Import (C, Get_Itemindex, "item_index"); - - Res : constant C_Int := Get_Itemindex (Itm); - begin - if Res = Curses_Err then - raise Menu_Exception; - end if; - return Positive (Natural (Res) + Positive'First); - end Get_Index; -------------------------------------------------------------------------------- - procedure Post (Men : Menu; - Post : Boolean := True) - is - function M_Post (Men : Menu) return C_Int; - pragma Import (C, M_Post, "post_menu"); - function M_Unpost (Men : Menu) return C_Int; - pragma Import (C, M_Unpost, "unpost_menu"); - - Res : Eti_Error; - begin - if Post then - Res := M_Post (Men); - else - Res := M_Unpost (Men); - end if; - if Res /= E_Ok then - Eti_Exception (Res); - end if; - end Post; -------------------------------------------------------------------------------- - procedure Set_Options (Men : Menu; - Options : Menu_Option_Set) - is - function Set_Menu_Opts (Men : Menu; - Opt : C_Int) return C_Int; - pragma Import (C, Set_Menu_Opts, "set_menu_opts"); - - Opt : constant C_Int := MOS_2_CInt (Options); - Res : Eti_Error; - begin - Res := Set_Menu_Opts (Men, Opt); - if Res /= E_Ok then - Eti_Exception (Res); - end if; - end Set_Options; - - procedure Switch_Options (Men : Menu; - Options : Menu_Option_Set; - On : Boolean := True) - is - function Menu_Opts_On (Men : Menu; - Opt : C_Int) return C_Int; - pragma Import (C, Menu_Opts_On, "menu_opts_on"); - function Menu_Opts_Off (Men : Menu; - Opt : C_Int) return C_Int; - pragma Import (C, Menu_Opts_Off, "menu_opts_off"); - - Opt : constant C_Int := MOS_2_CInt (Options); - Err : Eti_Error; - begin - if On then - Err := Menu_Opts_On (Men, Opt); - else - Err := Menu_Opts_Off (Men, Opt); - end if; - if Err /= E_Ok then - Eti_Exception (Err); - end if; - end Switch_Options; - - procedure Get_Options (Men : Menu; - Options : out Menu_Option_Set) - is - function Menu_Opts (Men : Menu) return C_Int; - pragma Import (C, Menu_Opts, "menu_opts"); - - Res : constant C_Int := Menu_Opts (Men); - begin - Options := CInt_2_MOS (Res); - end Get_Options; - - function Get_Options (Men : Menu := Null_Menu) return Menu_Option_Set - is - Mos : Menu_Option_Set; - begin - Get_Options (Men, Mos); - return Mos; - end Get_Options; -------------------------------------------------------------------------------- - procedure Set_Window (Men : Menu; - Win : Window) - is - function Set_Menu_Win (Men : Menu; - Win : Window) return C_Int; - pragma Import (C, Set_Menu_Win, "set_menu_win"); - - Res : constant Eti_Error := Set_Menu_Win (Men, Win); - begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; - end Set_Window; - - function Get_Window (Men : Menu) return Window - is - function Menu_Win (Men : Menu) return Window; - pragma Import (C, Menu_Win, "menu_win"); - - W : constant Window := Menu_Win (Men); - begin - return W; - end Get_Window; - - procedure Set_Sub_Window (Men : Menu; - Win : Window) - is - function Set_Menu_Sub (Men : Menu; - Win : Window) return C_Int; - pragma Import (C, Set_Menu_Sub, "set_menu_sub"); - - Res : constant Eti_Error := Set_Menu_Sub (Men, Win); - begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; - end Set_Sub_Window; - - function Get_Sub_Window (Men : Menu) return Window - is - function Menu_Sub (Men : Menu) return Window; - pragma Import (C, Menu_Sub, "menu_sub"); - - W : constant Window := Menu_Sub (Men); - begin - return W; - end Get_Sub_Window; - - procedure Scale (Men : Menu; - Lines : out Line_Count; - Columns : out Column_Count) - is - type C_Int_Access is access all C_Int; - function M_Scale (Men : Menu; - Yp, Xp : C_Int_Access) return C_Int; - pragma Import (C, M_Scale, "scale_menu"); - - X, Y : aliased C_Int; - Res : constant Eti_Error := M_Scale (Men, Y'Access, X'Access); - begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; - Lines := Line_Count (Y); - Columns := Column_Count (X); - end Scale; -------------------------------------------------------------------------------- - procedure Position_Cursor (Men : Menu) - is - function Pos_Menu_Cursor (Men : Menu) return C_Int; - pragma Import (C, Pos_Menu_Cursor, "pos_menu_cursor"); - - Res : constant Eti_Error := Pos_Menu_Cursor (Men); - begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; - end Position_Cursor; - -------------------------------------------------------------------------------- - procedure Set_Mark (Men : Menu; - Mark : String) - is - type Char_Ptr is access all Interfaces.C.char; - function Set_Mark (Men : Menu; - Mark : Char_Ptr) return C_Int; - pragma Import (C, Set_Mark, "set_menu_mark"); - - Txt : char_array (0 .. Mark'Length); - Len : size_t; - Res : Eti_Error; - begin - To_C (Mark, Txt, Len); - Res := Set_Mark (Men, Txt (Txt'First)'Access); - if Res /= E_Ok then - Eti_Exception (Res); - end if; - end Set_Mark; - - procedure Mark (Men : Menu; - Mark : out String) - is - function Get_Menu_Mark (Men : Menu) return chars_ptr; - pragma Import (C, Get_Menu_Mark, "menu_mark"); - begin - Fill_String (Get_Menu_Mark (Men), Mark); - end Mark; - - function Mark (Men : Menu) return String - is - function Get_Menu_Mark (Men : Menu) return chars_ptr; - pragma Import (C, Get_Menu_Mark, "menu_mark"); - begin - return Fill_String (Get_Menu_Mark (Men)); - end Mark; - -------------------------------------------------------------------------------- - procedure Set_Foreground - (Men : Menu; - Fore : Character_Attribute_Set := Normal_Video; - Color : Color_Pair := Color_Pair'First) - is - function Set_Menu_Fore (Men : Menu; - Attr : C_Chtype) return C_Int; - pragma Import (C, Set_Menu_Fore, "set_menu_fore"); - - Ch : constant Attributed_Character := (Ch => Character'First, - Color => Color, - Attr => Fore); - Res : constant Eti_Error := Set_Menu_Fore (Men, AttrChar_To_Chtype (Ch)); - begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; - end Set_Foreground; - - procedure Foreground (Men : Menu; - Fore : out Character_Attribute_Set) - is - function Menu_Fore (Men : Menu) return C_Chtype; - pragma Import (C, Menu_Fore, "menu_fore"); - begin - Fore := Chtype_To_AttrChar (Menu_Fore (Men)).Attr; - end Foreground; - - procedure Foreground (Men : Menu; - Fore : out Character_Attribute_Set; - Color : out Color_Pair) - is - function Menu_Fore (Men : Menu) return C_Chtype; - pragma Import (C, Menu_Fore, "menu_fore"); - begin - Fore := Chtype_To_AttrChar (Menu_Fore (Men)).Attr; - Color := Chtype_To_AttrChar (Menu_Fore (Men)).Color; - end Foreground; - - procedure Set_Background - (Men : Menu; - Back : Character_Attribute_Set := Normal_Video; - Color : Color_Pair := Color_Pair'First) - is - function Set_Menu_Back (Men : Menu; - Attr : C_Chtype) return C_Int; - pragma Import (C, Set_Menu_Back, "set_menu_back"); - - Ch : constant Attributed_Character := (Ch => Character'First, - Color => Color, - Attr => Back); - Res : constant Eti_Error := Set_Menu_Back (Men, AttrChar_To_Chtype (Ch)); - begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; - end Set_Background; - - procedure Background (Men : Menu; - Back : out Character_Attribute_Set) - is - function Menu_Back (Men : Menu) return C_Chtype; - pragma Import (C, Menu_Back, "menu_back"); - begin - Back := Chtype_To_AttrChar (Menu_Back (Men)).Attr; - end Background; - - procedure Background (Men : Menu; - Back : out Character_Attribute_Set; - Color : out Color_Pair) - is - function Menu_Back (Men : Menu) return C_Chtype; - pragma Import (C, Menu_Back, "menu_back"); - begin - Back := Chtype_To_AttrChar (Menu_Back (Men)).Attr; - Color := Chtype_To_AttrChar (Menu_Back (Men)).Color; - end Background; - - procedure Set_Grey (Men : Menu; - Grey : Character_Attribute_Set := Normal_Video; - Color : Color_Pair := Color_Pair'First) - is - function Set_Menu_Grey (Men : Menu; - Attr : C_Chtype) return C_Int; - pragma Import (C, Set_Menu_Grey, "set_menu_grey"); - - Ch : constant Attributed_Character := (Ch => Character'First, - Color => Color, - Attr => Grey); - - Res : constant Eti_Error := Set_Menu_Grey (Men, AttrChar_To_Chtype (Ch)); - begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; - end Set_Grey; - - procedure Grey (Men : Menu; - Grey : out Character_Attribute_Set) - is - function Menu_Grey (Men : Menu) return C_Chtype; - pragma Import (C, Menu_Grey, "menu_grey"); - begin - Grey := Chtype_To_AttrChar (Menu_Grey (Men)).Attr; - end Grey; - - procedure Grey (Men : Menu; - Grey : out Character_Attribute_Set; - Color : out Color_Pair) - is - function Menu_Grey (Men : Menu) return C_Chtype; - pragma Import (C, Menu_Grey, "menu_grey"); - begin - Grey := Chtype_To_AttrChar (Menu_Grey (Men)).Attr; - Color := Chtype_To_AttrChar (Menu_Grey (Men)).Color; - end Grey; - - procedure Set_Pad_Character (Men : Menu; - Pad : Character := Space) - is - function Set_Menu_Pad (Men : Menu; - Ch : C_Int) return C_Int; - pragma Import (C, Set_Menu_Pad, "set_menu_pad"); - - Res : constant Eti_Error := Set_Menu_Pad (Men, - C_Int (Character'Pos (Pad))); - begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; - end Set_Pad_Character; - - procedure Pad_Character (Men : Menu; - Pad : out Character) - is - function Menu_Pad (Men : Menu) return C_Int; - pragma Import (C, Menu_Pad, "menu_pad"); - begin - Pad := Character'Val (Menu_Pad (Men)); - end Pad_Character; -------------------------------------------------------------------------------- - procedure Set_Spacing (Men : Menu; - Descr : Column_Position := 0; - Row : Line_Position := 0; - Col : Column_Position := 0) - is - function Set_Spacing (Men : Menu; - D, R, C : C_Int) return C_Int; - pragma Import (C, Set_Spacing, "set_menu_spacing"); - - Res : constant Eti_Error := Set_Spacing (Men, - C_Int (Descr), - C_Int (Row), - C_Int (Col)); - begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; - end Set_Spacing; - - procedure Spacing (Men : Menu; - Descr : out Column_Position; - Row : out Line_Position; - Col : out Column_Position) - is - type C_Int_Access is access all C_Int; - function Get_Spacing (Men : Menu; - D, R, C : C_Int_Access) return C_Int; - pragma Import (C, Get_Spacing, "menu_spacing"); - - D, R, C : aliased C_Int; - Res : constant Eti_Error := Get_Spacing (Men, - D'Access, - R'Access, - C'Access); - begin - if Res /= E_Ok then - Eti_Exception (Res); - else - Descr := Column_Position (D); - Row := Line_Position (R); - Col := Column_Position (C); - end if; - end Spacing; -------------------------------------------------------------------------------- - function Set_Pattern (Men : Menu; - Text : String) return Boolean - is - type Char_Ptr is access all Interfaces.C.char; - function Set_Pattern (Men : Menu; - Pattern : Char_Ptr) return C_Int; - pragma Import (C, Set_Pattern, "set_menu_pattern"); - - S : char_array (0 .. Text'Length); - L : size_t; - Res : Eti_Error; - begin - To_C (Text, S, L); - Res := Set_Pattern (Men, S (S'First)'Access); - case Res is - when E_No_Match => return False; - when E_Ok => return True; - when others => - Eti_Exception (Res); - return False; - end case; - end Set_Pattern; - - procedure Pattern (Men : Menu; - Text : out String) - is - function Get_Pattern (Men : Menu) return chars_ptr; - pragma Import (C, Get_Pattern, "menu_pattern"); - begin - Fill_String (Get_Pattern (Men), Text); - end Pattern; -------------------------------------------------------------------------------- - procedure Set_Format (Men : Menu; - Lines : Line_Count; - Columns : Column_Count) - is - function Set_Menu_Fmt (Men : Menu; - Lin : C_Int; - Col : C_Int) return C_Int; - pragma Import (C, Set_Menu_Fmt, "set_menu_format"); - - Res : constant Eti_Error := Set_Menu_Fmt (Men, - C_Int (Lines), - C_Int (Columns)); - begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; - end Set_Format; - - procedure Format (Men : Menu; - Lines : out Line_Count; - Columns : out Column_Count) - is - type C_Int_Access is access all C_Int; - function Menu_Fmt (Men : Menu; - Y, X : C_Int_Access) return C_Int; - pragma Import (C, Menu_Fmt, "menu_format"); - - L, C : aliased C_Int; - Res : constant Eti_Error := Menu_Fmt (Men, L'Access, C'Access); - begin - if Res /= E_Ok then - Eti_Exception (Res); - else - Lines := Line_Count (L); - Columns := Column_Count (C); - end if; - end Format; -------------------------------------------------------------------------------- - procedure Set_Item_Init_Hook (Men : Menu; - Proc : Menu_Hook_Function) - is - function Set_Item_Init (Men : Menu; - Proc : Menu_Hook_Function) return C_Int; - pragma Import (C, Set_Item_Init, "set_item_init"); - - Res : constant Eti_Error := Set_Item_Init (Men, Proc); - begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; - end Set_Item_Init_Hook; - - procedure Set_Item_Term_Hook (Men : Menu; - Proc : Menu_Hook_Function) - is - function Set_Item_Term (Men : Menu; - Proc : Menu_Hook_Function) return C_Int; - pragma Import (C, Set_Item_Term, "set_item_term"); - - Res : constant Eti_Error := Set_Item_Term (Men, Proc); - begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; - end Set_Item_Term_Hook; - - procedure Set_Menu_Init_Hook (Men : Menu; - Proc : Menu_Hook_Function) - is - function Set_Menu_Init (Men : Menu; - Proc : Menu_Hook_Function) return C_Int; - pragma Import (C, Set_Menu_Init, "set_menu_init"); - - Res : constant Eti_Error := Set_Menu_Init (Men, Proc); - begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; - end Set_Menu_Init_Hook; - - procedure Set_Menu_Term_Hook (Men : Menu; - Proc : Menu_Hook_Function) - is - function Set_Menu_Term (Men : Menu; - Proc : Menu_Hook_Function) return C_Int; - pragma Import (C, Set_Menu_Term, "set_menu_term"); - - Res : constant Eti_Error := Set_Menu_Term (Men, Proc); - begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; - end Set_Menu_Term_Hook; - - function Get_Item_Init_Hook (Men : Menu) return Menu_Hook_Function - is - function Item_Init (Men : Menu) return Menu_Hook_Function; - pragma Import (C, Item_Init, "item_init"); - begin - return Item_Init (Men); - end Get_Item_Init_Hook; - - function Get_Item_Term_Hook (Men : Menu) return Menu_Hook_Function - is - function Item_Term (Men : Menu) return Menu_Hook_Function; - pragma Import (C, Item_Term, "item_term"); - begin - return Item_Term (Men); - end Get_Item_Term_Hook; - - function Get_Menu_Init_Hook (Men : Menu) return Menu_Hook_Function - is - function Menu_Init (Men : Menu) return Menu_Hook_Function; - pragma Import (C, Menu_Init, "menu_init"); - begin - return Menu_Init (Men); - end Get_Menu_Init_Hook; - - function Get_Menu_Term_Hook (Men : Menu) return Menu_Hook_Function - is - function Menu_Term (Men : Menu) return Menu_Hook_Function; - pragma Import (C, Menu_Term, "menu_term"); - begin - return Menu_Term (Men); - end Get_Menu_Term_Hook; -------------------------------------------------------------------------------- - procedure Redefine (Men : Menu; - Items : Item_Array_Access) - is - function Set_Items (Men : Menu; - Items : System.Address) return C_Int; - pragma Import (C, Set_Items, "set_menu_items"); - - Res : Eti_Error; - begin - pragma Assert (Items.all (Items'Last) = Null_Item); - if Items.all (Items'Last) /= Null_Item then - raise Menu_Exception; - else - Res := Set_Items (Men, Items.all'Address); - if Res /= E_Ok then - Eti_Exception (Res); - end if; - 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.all (Items'Last) = Null_Item); - if Items.all (Items'Last) /= Null_Item then - raise Menu_Exception; - else - M := Newmenu (Items.all'Address); - if M = Null_Menu then - raise Menu_Exception; - end if; - return M; - end if; - end Create; - - procedure Delete (Men : in out Menu) - is - function Free (Men : Menu) return C_Int; - pragma Import (C, Free, "free_menu"); - - Res : constant Eti_Error := Free (Men); - begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; - Men := Null_Menu; - end Delete; - ------------------------------------------------------------------------------- - function Driver (Men : Menu; - Key : Key_Code) return Driver_Result - is - function Driver (Men : Menu; - Key : C_Int) return C_Int; - pragma Import (C, Driver, "menu_driver"); - - R : constant Eti_Error := Driver (Men, C_Int (Key)); - begin - if R /= E_Ok then - case R is - when E_Unknown_Command => return Unknown_Request; - when E_No_Match => return No_Match; - when E_Request_Denied | - E_Not_Selectable => return Request_Denied; - when others => - Eti_Exception (R); - end case; - end if; - return Menu_Ok; - end Driver; - - procedure Free (IA : in out Item_Array_Access; - Free_Items : Boolean := False) - is - procedure Release is new Ada.Unchecked_Deallocation - (Item_Array, Item_Array_Access); - begin - if IA /= null and then Free_Items then - for I in IA'First .. (IA'Last - 1) loop - if IA.all (I) /= Null_Item then - Delete (IA.all (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 deleted file mode 100644 index 9b4032639308e..0000000000000 --- a/Ada95/src/terminal_interface-curses-mouse.adb +++ /dev/null @@ -1,217 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding -- --- -- --- Terminal_Interface.Curses.Mouse -- --- -- --- B O D Y -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 1998-2008,2009 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "Software"), to deal in the Software without restriction, including -- --- without limitation the rights to use, copy, modify, merge, publish, -- --- distribute, distribute with modifications, sublicense, and/or sell -- --- copies of the Software, and to permit persons to whom the Software is -- --- furnished to do so, subject to the following conditions: -- --- -- --- The above copyright notice and this permission notice shall be included -- --- in all copies or substantial portions of the Software. -- --- -- --- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- --- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- --- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- --- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- --- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- --- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- --- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- --- -- --- Except as contained in this notice, the name(s) of the above copyright -- --- holders shall not be used in advertising or otherwise to promote the -- --- sale, use or other dealings in this Software without prior written -- --- authorization. -- ------------------------------------------------------------------------------- --- Author: Juergen Pfeifer, 1996 --- Version Control: --- $Revision: 1.24 $ --- $Date: 2009/12/26 17:38:58 $ --- Binding Version 01.00 ------------------------------------------------------------------------------- -with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; -with Interfaces.C; use Interfaces.C; -use Interfaces; - -package body Terminal_Interface.Curses.Mouse is - - use type System.Bit_Order; - - function Has_Mouse return Boolean - is - function Mouse_Avail return C_Int; - pragma Import (C, Mouse_Avail, "has_mouse"); - begin - if Has_Key (Key_Mouse) or else Mouse_Avail /= 0 then - return True; - else - return False; - end if; - end Has_Mouse; - - function Get_Mouse return Mouse_Event - is - type Event_Access is access all Mouse_Event; - - function Getmouse (Ev : Event_Access) return C_Int; - pragma Import (C, Getmouse, "getmouse"); - - Event : aliased Mouse_Event; - begin - if Getmouse (Event'Access) = Curses_Err then - raise Curses_Exception; - end if; - return Event; - end Get_Mouse; - - procedure Register_Reportable_Event (Button : Mouse_Button; - State : Button_State; - Mask : in out Event_Mask) - is - Button_Nr : constant Natural := Mouse_Button'Pos (Button); - State_Nr : constant Natural := Button_State'Pos (State); - begin - if Button in Modifier_Keys and then State /= Pressed then - raise Curses_Exception; - else - if Button in Real_Buttons then - Mask := Mask or ((2 ** (6 * Button_Nr)) ** State_Nr); - else - Mask := Mask or (BUTTON_CTRL ** (Button_Nr - 4)); - end if; - end if; - end Register_Reportable_Event; - - procedure Register_Reportable_Events (Button : Mouse_Button; - State : Button_States; - Mask : in out Event_Mask) - is - begin - for S in Button_States'Range loop - if State (S) then - Register_Reportable_Event (Button, S, Mask); - end if; - end loop; - end Register_Reportable_Events; - - function Start_Mouse (Mask : Event_Mask := All_Events) - return Event_Mask - is - function MMask (M : Event_Mask; - O : access Event_Mask) return Event_Mask; - pragma Import (C, MMask, "mousemask"); - R : Event_Mask; - Old : aliased Event_Mask; - begin - R := MMask (Mask, Old'Access); - if R = No_Events then - Beep; - end if; - return Old; - end Start_Mouse; - - procedure End_Mouse (Mask : Event_Mask := No_Events) - is - begin - if Mask /= No_Events then - Beep; - end if; - end End_Mouse; - - procedure Dispatch_Event (Mask : Event_Mask; - Button : out Mouse_Button; - State : out Button_State); - - procedure Dispatch_Event (Mask : Event_Mask; - Button : out Mouse_Button; - State : out Button_State) is - L : Event_Mask; - begin - Button := Alt; -- preset to non real button; - if (Mask and BUTTON1_EVENTS) /= 0 then - Button := Left; - elsif (Mask and BUTTON2_EVENTS) /= 0 then - Button := Middle; - elsif (Mask and BUTTON3_EVENTS) /= 0 then - Button := Right; - elsif (Mask and BUTTON4_EVENTS) /= 0 then - Button := Button4; - end if; - if Button in Real_Buttons then - L := 2 ** (6 * Mouse_Button'Pos (Button)); - for I in Button_State'Range loop - if (Mask and L) /= 0 then - State := I; - exit; - end if; - L := 2 * L; - end loop; - else - State := Pressed; - if (Mask and BUTTON_CTRL) /= 0 then - Button := Control; - elsif (Mask and BUTTON_SHIFT) /= 0 then - Button := Shift; - elsif (Mask and BUTTON_ALT) /= 0 then - Button := Alt; - end if; - end if; - end Dispatch_Event; - - procedure Get_Event (Event : Mouse_Event; - Y : out Line_Position; - X : out Column_Position; - Button : out Mouse_Button; - State : out Button_State) - is - Mask : constant Event_Mask := Event.Bstate; - begin - X := Column_Position (Event.X); - Y := Line_Position (Event.Y); - Dispatch_Event (Mask, Button, State); - end Get_Event; - - procedure Unget_Mouse (Event : Mouse_Event) - is - function Ungetmouse (Ev : Mouse_Event) return C_Int; - pragma Import (C, Ungetmouse, "ungetmouse"); - begin - if Ungetmouse (Event) = Curses_Err then - raise Curses_Exception; - end if; - end Unget_Mouse; - - function Enclosed_In_Window (Win : Window := Standard_Window; - Event : Mouse_Event) return Boolean - is - function Wenclose (Win : Window; Y : C_Int; X : C_Int) - return Curses_Bool; - pragma Import (C, Wenclose, "wenclose"); - begin - if Wenclose (Win, C_Int (Event.Y), C_Int (Event.X)) - = Curses_Bool_False then - return False; - else - return True; - end if; - end Enclosed_In_Window; - - function Mouse_Interval (Msec : Natural := 200) return Natural - is - function Mouseinterval (Msec : C_Int) return C_Int; - pragma Import (C, Mouseinterval, "mouseinterval"); - begin - return Natural (Mouseinterval (C_Int (Msec))); - end Mouse_Interval; - -end Terminal_Interface.Curses.Mouse; diff --git a/Ada95/src/terminal_interface-curses-panels-user_data.adb b/Ada95/src/terminal_interface-curses-panels-user_data.adb deleted file mode 100644 index d855f5423c722..0000000000000 --- a/Ada95/src/terminal_interface-curses-panels-user_data.adb +++ /dev/null @@ -1,78 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding -- --- -- --- Terminal_Interface.Curses.Panels.User_Data -- --- -- --- B O D Y -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 1998-2003,2009 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "Software"), to deal in the Software without restriction, including -- --- without limitation the rights to use, copy, modify, merge, publish, -- --- distribute, distribute with modifications, sublicense, and/or sell -- --- copies of the Software, and to permit persons to whom the Software is -- --- furnished to do so, subject to the following conditions: -- --- -- --- The above copyright notice and this permission notice shall be included -- --- in all copies or substantial portions of the Software. -- --- -- --- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- --- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- --- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- --- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- --- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- --- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- --- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- --- -- --- Except as contained in this notice, the name(s) of the above copyright -- --- holders shall not be used in advertising or otherwise to promote the -- --- sale, use or other dealings in this Software without prior written -- --- authorization. -- ------------------------------------------------------------------------------- --- Author: Juergen Pfeifer, 1996 --- Version Control: --- $Revision: 1.12 $ --- Binding Version 01.00 ------------------------------------------------------------------------------- -with Interfaces.C; -with Terminal_Interface.Curses.Aux; -use Terminal_Interface.Curses.Aux; -with Terminal_Interface.Curses.Panels; -use Terminal_Interface.Curses.Panels; - -package body Terminal_Interface.Curses.Panels.User_Data is - - use type Interfaces.C.int; - - procedure Set_User_Data (Pan : Panel; - Data : User_Access) - is - function Set_Panel_Userptr (Pan : Panel; - Addr : User_Access) return C_Int; - pragma Import (C, Set_Panel_Userptr, "set_panel_userptr"); - begin - if Set_Panel_Userptr (Pan, Data) = Curses_Err then - raise Panel_Exception; - end if; - end Set_User_Data; - - function Get_User_Data (Pan : Panel) return User_Access - is - function Panel_Userptr (Pan : Panel) return User_Access; - pragma Import (C, Panel_Userptr, "panel_userptr"); - begin - return Panel_Userptr (Pan); - end Get_User_Data; - - procedure Get_User_Data (Pan : Panel; - Data : out User_Access) - is - begin - Data := Get_User_Data (Pan); - end Get_User_Data; - -end Terminal_Interface.Curses.Panels.User_Data; diff --git a/Ada95/src/terminal_interface-curses-panels.adb b/Ada95/src/terminal_interface-curses-panels.adb deleted file mode 100644 index 84e29e519c2d1..0000000000000 --- a/Ada95/src/terminal_interface-curses-panels.adb +++ /dev/null @@ -1,165 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding -- --- -- --- Terminal_Interface.Curses.Panels -- --- -- --- B O D Y -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 1998-2004,2009 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "Software"), to deal in the Software without restriction, including -- --- without limitation the rights to use, copy, modify, merge, publish, -- --- distribute, distribute with modifications, sublicense, and/or sell -- --- copies of the Software, and to permit persons to whom the Software is -- --- furnished to do so, subject to the following conditions: -- --- -- --- The above copyright notice and this permission notice shall be included -- --- in all copies or substantial portions of the Software. -- --- -- --- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- --- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- --- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- --- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- --- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- --- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- --- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- --- -- --- Except as contained in this notice, the name(s) of the above copyright -- --- holders shall not be used in advertising or otherwise to promote the -- --- sale, use or other dealings in this Software without prior written -- --- authorization. -- ------------------------------------------------------------------------------- --- Author: Juergen Pfeifer, 1996 --- Version Control: --- $Revision: 1.14 $ --- $Date: 2009/12/26 17:38:58 $ --- Binding Version 01.00 ------------------------------------------------------------------------------- -with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; -with Interfaces.C; - -package body Terminal_Interface.Curses.Panels is - - use type Interfaces.C.int; - - function Create (Win : Window) return Panel - is - function Newpanel (Win : Window) return Panel; - pragma Import (C, Newpanel, "new_panel"); - - Pan : Panel; - begin - Pan := Newpanel (Win); - if Pan = Null_Panel then - raise Panel_Exception; - end if; - return Pan; - end Create; - - procedure Bottom (Pan : Panel) - is - function Bottompanel (Pan : Panel) return C_Int; - pragma Import (C, Bottompanel, "bottom_panel"); - begin - if Bottompanel (Pan) = Curses_Err then - raise Panel_Exception; - end if; - end Bottom; - - procedure Top (Pan : Panel) - is - function Toppanel (Pan : Panel) return C_Int; - pragma Import (C, Toppanel, "top_panel"); - begin - if Toppanel (Pan) = Curses_Err then - raise Panel_Exception; - end if; - end Top; - - procedure Show (Pan : Panel) - is - function Showpanel (Pan : Panel) return C_Int; - pragma Import (C, Showpanel, "show_panel"); - begin - if Showpanel (Pan) = Curses_Err then - raise Panel_Exception; - end if; - end Show; - - procedure Hide (Pan : Panel) - is - function Hidepanel (Pan : Panel) return C_Int; - pragma Import (C, Hidepanel, "hide_panel"); - begin - if Hidepanel (Pan) = Curses_Err then - raise Panel_Exception; - end if; - end Hide; - - function Get_Window (Pan : Panel) return Window - is - function Panel_Win (Pan : Panel) return Window; - pragma Import (C, Panel_Win, "panel_window"); - - Win : constant Window := Panel_Win (Pan); - begin - if Win = Null_Window then - raise Panel_Exception; - end if; - return Win; - end Get_Window; - - procedure Replace (Pan : Panel; - Win : Window) - is - function Replace_Pan (Pan : Panel; - Win : Window) return C_Int; - pragma Import (C, Replace_Pan, "replace_panel"); - begin - if Replace_Pan (Pan, Win) = Curses_Err then - raise Panel_Exception; - end if; - end Replace; - - procedure Move (Pan : Panel; - Line : Line_Position; - Column : Column_Position) - is - function Move (Pan : Panel; - Line : C_Int; - Column : C_Int) return C_Int; - pragma Import (C, Move, "move_panel"); - begin - if Move (Pan, C_Int (Line), C_Int (Column)) = Curses_Err then - raise Panel_Exception; - end if; - end Move; - - function Is_Hidden (Pan : Panel) return Boolean - is - function Panel_Hidden (Pan : Panel) return C_Int; - pragma Import (C, Panel_Hidden, "panel_hidden"); - begin - if Panel_Hidden (Pan) = Curses_False then - return False; - else - return True; - end if; - end Is_Hidden; - - procedure Delete (Pan : in out Panel) - is - function Del_Panel (Pan : Panel) return C_Int; - pragma Import (C, Del_Panel, "del_panel"); - begin - if Del_Panel (Pan) = Curses_Err then - raise Panel_Exception; - end if; - Pan := Null_Panel; - end Delete; - -end Terminal_Interface.Curses.Panels; diff --git a/Ada95/src/terminal_interface-curses-putwin.adb b/Ada95/src/terminal_interface-curses-putwin.adb deleted file mode 100644 index 986cd6b9bd6ca..0000000000000 --- a/Ada95/src/terminal_interface-curses-putwin.adb +++ /dev/null @@ -1,77 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- 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 deleted file mode 100644 index d302bdcec4524..0000000000000 --- a/Ada95/src/terminal_interface-curses-putwin.ads +++ /dev/null @@ -1,50 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- 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 deleted file mode 100644 index 643865781fd3e..0000000000000 --- a/Ada95/src/terminal_interface-curses-termcap.adb +++ /dev/null @@ -1,163 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding -- --- -- --- Terminal_Interface.Curses.Termcap -- --- -- --- B O D Y -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 2000-2006,2009 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "Software"), to deal in the Software without restriction, including -- --- without limitation the rights to use, copy, modify, merge, publish, -- --- distribute, distribute with modifications, sublicense, and/or sell -- --- copies of the Software, and to permit persons to whom the Software is -- --- furnished to do so, subject to the following conditions: -- --- -- --- The above copyright notice and this permission notice shall be included -- --- in all copies or substantial portions of the Software. -- --- -- --- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- --- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- --- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- --- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- --- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- --- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- --- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- --- -- --- Except as contained in this notice, the name(s) of the above copyright -- --- holders shall not be used in advertising or otherwise to promote the -- --- sale, use or other dealings in this Software without prior written -- --- authorization. -- ------------------------------------------------------------------------------- --- Author: Juergen Pfeifer, 1996 --- Version Control: --- $Revision: 1.12 $ --- $Date: 2009/12/26 17:38:58 $ --- Binding Version 01.00 ------------------------------------------------------------------------------- - -with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; -with Interfaces.C; use Interfaces.C; -with Interfaces.C.Strings; use Interfaces.C.Strings; - -package body Terminal_Interface.Curses.Termcap is - - function Get_Entry (Name : String) return Boolean - is - function tgetent (name : char_array; val : char_array) - return C_Int; - pragma Import (C, tgetent, "tgetent"); - NameTxt : char_array (0 .. Name'Length); - Length : size_t; - ignored : constant char_array (0 .. 0) := (0 => nul); - result : C_Int; - begin - To_C (Name, NameTxt, Length); - result := tgetent (char_array (ignored), NameTxt); - if result = -1 then - raise Curses_Exception; - else - return Boolean'Val (result); - end if; - end Get_Entry; - ------------------------------------------------------------------------------- - function Get_Flag (Name : String) return Boolean - is - function tgetflag (id : char_array) return C_Int; - pragma Import (C, tgetflag, "tgetflag"); - Txt : char_array (0 .. Name'Length); - Length : size_t; - begin - To_C (Name, Txt, Length); - if tgetflag (Txt) = 0 then - return False; - else - return True; - end if; - end Get_Flag; - ------------------------------------------------------------------------------- - procedure Get_Number (Name : String; - Value : out Integer; - Result : out Boolean) - is - function tgetnum (id : char_array) return C_Int; - pragma Import (C, tgetnum, "tgetnum"); - Txt : char_array (0 .. Name'Length); - Length : size_t; - begin - To_C (Name, Txt, Length); - Value := Integer (tgetnum (Txt)); - if Value = -1 then - Result := False; - else - Result := True; - end if; - end Get_Number; - ------------------------------------------------------------------------------- - procedure Get_String (Name : String; - Value : out String; - Result : out Boolean) - is - function tgetstr (id : char_array; - buf : char_array) return chars_ptr; - pragma Import (C, tgetstr, "tgetstr"); - Txt : char_array (0 .. Name'Length); - Length : size_t; - Txt2 : chars_ptr; - type t is new char_array (0 .. 1024); -- does it need to be 1024? - Return_Buffer : constant t := (others => nul); - begin - To_C (Name, Txt, Length); - Txt2 := tgetstr (Txt, char_array (Return_Buffer)); - if Txt2 = Null_Ptr then - Result := False; - else - Value := Fill_String (Txt2); - Result := True; - end if; - end Get_String; - - function Get_String (Name : String) return Boolean - is - function tgetstr (Id : char_array; - buf : char_array) return chars_ptr; - pragma Import (C, tgetstr, "tgetstr"); - Txt : char_array (0 .. Name'Length); - Length : size_t; - Txt2 : chars_ptr; - type t is new char_array (0 .. 1024); -- does it need to be 1024? - Phony_Txt : constant t := (others => nul); - begin - To_C (Name, Txt, Length); - Txt2 := tgetstr (Txt, char_array (Phony_Txt)); - if Txt2 = Null_Ptr then - return False; - else - return True; - end if; - end Get_String; - ------------------------------------------------------------------------------- - function TGoto (Cap : String; - Col : Column_Position; - Row : Line_Position) return Termcap_String is - function tgoto (cap : char_array; - col : C_Int; - row : C_Int) return chars_ptr; - pragma Import (C, tgoto); - Txt : char_array (0 .. Cap'Length); - Length : size_t; - begin - To_C (Cap, Txt, Length); - return Termcap_String (Fill_String - (tgoto (Txt, C_Int (Col), C_Int (Row)))); - end TGoto; - -end Terminal_Interface.Curses.Termcap; diff --git a/Ada95/src/terminal_interface-curses-termcap.ads b/Ada95/src/terminal_interface-curses-termcap.ads deleted file mode 100644 index dd01396e8b0b1..0000000000000 --- a/Ada95/src/terminal_interface-curses-termcap.ads +++ /dev/null @@ -1,80 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- 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 deleted file mode 100644 index 9b3c9d56b3305..0000000000000 --- a/Ada95/src/terminal_interface-curses-terminfo.adb +++ /dev/null @@ -1,161 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding -- --- -- --- Terminal_Interface.Curses.Terminfo -- --- -- --- B O D Y -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 1998-2006,2009 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "Software"), to deal in the Software without restriction, including -- --- without limitation the rights to use, copy, modify, merge, publish, -- --- distribute, distribute with modifications, sublicense, and/or sell -- --- copies of the Software, and to permit persons to whom the Software is -- --- furnished to do so, subject to the following conditions: -- --- -- --- The above copyright notice and this permission notice shall be included -- --- in all copies or substantial portions of the Software. -- --- -- --- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- --- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- --- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- --- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- --- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- --- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- --- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- --- -- --- Except as contained in this notice, the name(s) of the above copyright -- --- holders shall not be used in advertising or otherwise to promote the -- --- sale, use or other dealings in this Software without prior written -- --- authorization. -- ------------------------------------------------------------------------------- --- Author: Juergen Pfeifer, 1996 --- Version Control: --- $Revision: 1.6 $ --- $Date: 2009/12/26 17:38:58 $ --- Binding Version 01.00 ------------------------------------------------------------------------------- - -with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; -with Interfaces.C; use Interfaces.C; -with Interfaces.C.Strings; use Interfaces.C.Strings; -with Ada.Unchecked_Conversion; - -package body Terminal_Interface.Curses.Terminfo is - - function Is_MinusOne_Pointer (P : chars_ptr) return Boolean; - - function Is_MinusOne_Pointer (P : chars_ptr) return Boolean is - type Weird_Address is new System.Storage_Elements.Integer_Address; - Invalid_Pointer : constant Weird_Address := -1; - function To_Weird is new Ada.Unchecked_Conversion - (Source => chars_ptr, Target => Weird_Address); - begin - if To_Weird (P) = Invalid_Pointer then - return True; - else - return False; - end if; - end Is_MinusOne_Pointer; - pragma Inline (Is_MinusOne_Pointer); - ------------------------------------------------------------------------------- - function Get_Flag (Name : String) return Boolean - is - function tigetflag (id : char_array) return Curses_Bool; - pragma Import (C, tigetflag); - Txt : char_array (0 .. Name'Length); - Length : size_t; - begin - To_C (Name, Txt, Length); - if tigetflag (Txt) = Curses_Bool (Curses_True) then - return True; - else - return False; - end if; - end Get_Flag; - ------------------------------------------------------------------------------- - procedure Get_String (Name : String; - Value : out Terminfo_String; - Result : out Boolean) - is - function tigetstr (id : char_array) return chars_ptr; - pragma Import (C, tigetstr, "tigetstr"); - Txt : char_array (0 .. Name'Length); - Length : size_t; - Txt2 : chars_ptr; - begin - To_C (Name, Txt, Length); - Txt2 := tigetstr (Txt); - if Txt2 = Null_Ptr then - Result := False; - elsif Is_MinusOne_Pointer (Txt2) then - raise Curses_Exception; - else - Value := Terminfo_String (Fill_String (Txt2)); - Result := True; - end if; - end Get_String; - ------------------------------------------------------------------------------- - function Has_String (Name : String) return Boolean - is - function tigetstr (id : char_array) return chars_ptr; - pragma Import (C, tigetstr, "tigetstr"); - Txt : char_array (0 .. Name'Length); - Length : size_t; - Txt2 : chars_ptr; - begin - To_C (Name, Txt, Length); - Txt2 := tigetstr (Txt); - if Txt2 = Null_Ptr then - return False; - elsif Is_MinusOne_Pointer (Txt2) then - raise Curses_Exception; - else - return True; - end if; - end Has_String; - ------------------------------------------------------------------------------- - function Get_Number (Name : String) return Integer is - function tigetstr (s : char_array) return C_Int; - pragma Import (C, tigetstr); - Txt : char_array (0 .. Name'Length); - Length : size_t; - begin - To_C (Name, Txt, Length); - return Integer (tigetstr (Txt)); - end Get_Number; - ------------------------------------------------------------------------------- - procedure Put_String (Str : Terminfo_String; - affcnt : Natural := 1; - putc : putctype := null) is - function tputs (str : char_array; - affcnt : C_Int; - putc : putctype) return C_Int; - function putp (str : char_array) return C_Int; - pragma Import (C, tputs); - pragma Import (C, putp); - Txt : char_array (0 .. Str'Length); - Length : size_t; - Err : C_Int; - begin - To_C (String (Str), Txt, Length); - if putc = null then - Err := putp (Txt); - else - Err := tputs (Txt, C_Int (affcnt), putc); - end if; - if Err = Curses_Err then - raise Curses_Exception; - end if; - end Put_String; - -end Terminal_Interface.Curses.Terminfo; diff --git a/Ada95/src/terminal_interface-curses-terminfo.ads b/Ada95/src/terminal_interface-curses-terminfo.ads deleted file mode 100644 index fb39bf1ed6f18..0000000000000 --- a/Ada95/src/terminal_interface-curses-terminfo.ads +++ /dev/null @@ -1,81 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- 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 deleted file mode 100644 index 50a4e4461baa4..0000000000000 --- a/Ada95/src/terminal_interface-curses-text_io-aux.adb +++ /dev/null @@ -1,128 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding -- --- -- --- Terminal_Interface.Curses.Text_IO.Aux -- --- -- --- B O D Y -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 1998-2006,2009 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "Software"), to deal in the Software without restriction, including -- --- without limitation the rights to use, copy, modify, merge, publish, -- --- distribute, distribute with modifications, sublicense, and/or sell -- --- copies of the Software, and to permit persons to whom the Software is -- --- furnished to do so, subject to the following conditions: -- --- -- --- The above copyright notice and this permission notice shall be included -- --- in all copies or substantial portions of the Software. -- --- -- --- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- --- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- --- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- --- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- --- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- --- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- --- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- --- -- --- Except as contained in this notice, the name(s) of the above copyright -- --- holders shall not be used in advertising or otherwise to promote the -- --- sale, use or other dealings in this Software without prior written -- --- authorization. -- ------------------------------------------------------------------------------- --- Author: Juergen Pfeifer, 1996 --- Version Control: --- $Revision: 1.13 $ --- $Date: 2009/12/26 17:38:58 $ --- Binding Version 01.00 ------------------------------------------------------------------------------- -package body Terminal_Interface.Curses.Text_IO.Aux is - - procedure Put_Buf - (Win : Window; - Buf : String; - Width : Field; - Signal : Boolean := True; - Ljust : Boolean := False) - is - L : Field; - Len : Field; - W : Field := Width; - LC : Line_Count; - CC : Column_Count; - Y : Line_Position; - X : Column_Position; - - procedure Output (From, To : Field); - - procedure Output (From, To : Field) - is - begin - if Len > 0 then - if W = 0 then - W := Len; - end if; - if Len > W then - -- LRM A10.6 (7) says this - W := Len; - end if; - - pragma Assert (Len <= W); - Get_Size (Win, LC, CC); - if Column_Count (Len) > CC then - if Signal then - raise Layout_Error; - else - return; - end if; - else - if Len < W and then not Ljust then - declare - Filler : constant String (1 .. (W - Len)) - := (others => ' '); - begin - Put (Win, Filler); - end; - end if; - Get_Cursor_Position (Win, Y, X); - if (X + Column_Position (Len)) > CC then - New_Line (Win); - end if; - Put (Win, Buf (From .. To)); - if Len < W and then Ljust then - declare - Filler : constant String (1 .. (W - Len)) - := (others => ' '); - begin - Put (Win, Filler); - end; - end if; - end if; - end if; - end Output; - - begin - pragma Assert (Win /= Null_Window); - if Ljust then - L := 1; - for I in 1 .. Buf'Length loop - exit when Buf (L) = ' '; - L := L + 1; - end loop; - Len := L - 1; - Output (1, Len); - else -- input buffer is not left justified - L := Buf'Length; - for I in 1 .. Buf'Length loop - exit when Buf (L) = ' '; - L := L - 1; - end loop; - Len := Buf'Length - L; - Output (L + 1, Buf'Length); - end if; - end Put_Buf; - -end Terminal_Interface.Curses.Text_IO.Aux; diff --git a/Ada95/src/terminal_interface-curses-text_io-aux.ads b/Ada95/src/terminal_interface-curses-text_io-aux.ads deleted file mode 100644 index 6b50b3395063b..0000000000000 --- a/Ada95/src/terminal_interface-curses-text_io-aux.ads +++ /dev/null @@ -1,55 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding -- --- -- --- Terminal_Interface.Curses.Text_IO.Aux -- --- -- --- S P E C -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 1998-2006,2009 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "Software"), to deal in the Software without restriction, including -- --- without limitation the rights to use, copy, modify, merge, publish, -- --- distribute, distribute with modifications, sublicense, and/or sell -- --- copies of the Software, and to permit persons to whom the Software is -- --- furnished to do so, subject to the following conditions: -- --- -- --- The above copyright notice and this permission notice shall be included -- --- in all copies or substantial portions of the Software. -- --- -- --- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- --- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- --- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- --- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- --- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- --- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- --- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- --- -- --- Except as contained in this notice, the name(s) of the above copyright -- --- holders shall not be used in advertising or otherwise to promote the -- --- sale, use or other dealings in this Software without prior written -- --- authorization. -- ------------------------------------------------------------------------------- --- Author: Juergen Pfeifer, 1996 --- Version Control: --- $Revision: 1.14 $ --- $Date: 2009/12/26 17:38:58 $ --- Binding Version 01.00 ------------------------------------------------------------------------------- -private package Terminal_Interface.Curses.Text_IO.Aux is - -- pragma Preelaborate (Aux); - - -- This routine is called from the Text_IO output routines for numeric - -- and enumeration types. - -- - procedure Put_Buf - (Win : Window; -- The output window - Buf : String; -- The buffer containing the text - Width : Field; -- The width of the output field - Signal : Boolean := True; -- If true, we raise Layout_Error - Ljust : Boolean := False); -- The Buf is left justified - -end Terminal_Interface.Curses.Text_IO.Aux; diff --git a/Ada95/src/terminal_interface-curses-text_io-complex_io.adb b/Ada95/src/terminal_interface-curses-text_io-complex_io.adb deleted file mode 100644 index 6c2e144eb37c9..0000000000000 --- a/Ada95/src/terminal_interface-curses-text_io-complex_io.adb +++ /dev/null @@ -1,73 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding -- --- -- --- Terminal_Interface.Curses.Text_IO.Complex_IO -- --- -- --- B O D Y -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 1998-2003,2009 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "Software"), to deal in the Software without restriction, including -- --- without limitation the rights to use, copy, modify, merge, publish, -- --- distribute, distribute with modifications, sublicense, and/or sell -- --- copies of the Software, and to permit persons to whom the Software is -- --- furnished to do so, subject to the following conditions: -- --- -- --- The above copyright notice and this permission notice shall be included -- --- in all copies or substantial portions of the Software. -- --- -- --- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- --- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- --- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- --- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- --- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- --- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- --- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- --- -- --- Except as contained in this notice, the name(s) of the above copyright -- --- holders shall not be used in advertising or otherwise to promote the -- --- sale, use or other dealings in this Software without prior written -- --- authorization. -- ------------------------------------------------------------------------------- --- Author: Juergen Pfeifer, 1996 --- Version Control: --- $Revision: 1.11 $ --- Binding Version 01.00 ------------------------------------------------------------------------------- -with Terminal_Interface.Curses.Text_IO.Float_IO; - -package body Terminal_Interface.Curses.Text_IO.Complex_IO is - - package FIO is new - Terminal_Interface.Curses.Text_IO.Float_IO (Complex_Types.Real'Base); - - procedure Put - (Win : Window; - Item : Complex; - Fore : Field := Default_Fore; - Aft : Field := Default_Aft; - Exp : Field := Default_Exp) - is - begin - Put (Win, '('); - FIO.Put (Win, Item.Re, Fore, Aft, Exp); - Put (Win, ','); - FIO.Put (Win, Item.Im, Fore, Aft, Exp); - Put (Win, ')'); - end Put; - - procedure Put - (Item : Complex; - Fore : Field := Default_Fore; - Aft : Field := Default_Aft; - Exp : Field := Default_Exp) - is - begin - Put (Get_Window, Item, Fore, Aft, Exp); - end Put; - -end Terminal_Interface.Curses.Text_IO.Complex_IO; diff --git a/Ada95/src/terminal_interface-curses-text_io-complex_io.ads b/Ada95/src/terminal_interface-curses-text_io-complex_io.ads deleted file mode 100644 index e61345895d1e3..0000000000000 --- a/Ada95/src/terminal_interface-curses-text_io-complex_io.ads +++ /dev/null @@ -1,70 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding -- --- -- --- Terminal_Interface.Curses.Text_IO.Complex_IO -- --- -- --- S P E C -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 1998-2003,2009 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "Software"), to deal in the Software without restriction, including -- --- without limitation the rights to use, copy, modify, merge, publish, -- --- distribute, distribute with modifications, sublicense, and/or sell -- --- copies of the Software, and to permit persons to whom the Software is -- --- furnished to do so, subject to the following conditions: -- --- -- --- The above copyright notice and this permission notice shall be included -- --- in all copies or substantial portions of the Software. -- --- -- --- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- --- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- --- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- --- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- --- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- --- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- --- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- --- -- --- Except as contained in this notice, the name(s) of the above copyright -- --- holders shall not be used in advertising or otherwise to promote the -- --- sale, use or other dealings in this Software without prior written -- --- authorization. -- ------------------------------------------------------------------------------- --- Author: Juergen Pfeifer, 1996 --- Version Control: --- $Revision: 1.11 $ --- Binding Version 01.00 ------------------------------------------------------------------------------- -with Ada.Numerics.Generic_Complex_Types; - -generic - with package Complex_Types is new Ada.Numerics.Generic_Complex_Types (<>); - -package Terminal_Interface.Curses.Text_IO.Complex_IO is - - use Complex_Types; - - Default_Fore : Field := 2; - Default_Aft : Field := Real'Digits - 1; - Default_Exp : Field := 3; - - procedure Put - (Win : Window; - Item : Complex; - Fore : Field := Default_Fore; - Aft : Field := Default_Aft; - Exp : Field := Default_Exp); - - procedure Put - (Item : Complex; - Fore : Field := Default_Fore; - Aft : Field := Default_Aft; - Exp : Field := Default_Exp); - -private - pragma Inline (Put); - -end Terminal_Interface.Curses.Text_IO.Complex_IO; diff --git a/Ada95/src/terminal_interface-curses-text_io-decimal_io.adb b/Ada95/src/terminal_interface-curses-text_io-decimal_io.adb deleted file mode 100644 index 1b1ad8cbf2e87..0000000000000 --- a/Ada95/src/terminal_interface-curses-text_io-decimal_io.adb +++ /dev/null @@ -1,75 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding -- --- -- --- Terminal_Interface.Curses.Text_IO.Decimal_IO -- --- -- --- B O D Y -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 1998-2003,2009 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "Software"), to deal in the Software without restriction, including -- --- without limitation the rights to use, copy, modify, merge, publish, -- --- distribute, distribute with modifications, sublicense, and/or sell -- --- copies of the Software, and to permit persons to whom the Software is -- --- furnished to do so, subject to the following conditions: -- --- -- --- The above copyright notice and this permission notice shall be included -- --- in all copies or substantial portions of the Software. -- --- -- --- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- --- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- --- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- --- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- --- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- --- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- --- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- --- -- --- Except as contained in this notice, the name(s) of the above copyright -- --- holders shall not be used in advertising or otherwise to promote the -- --- sale, use or other dealings in this Software without prior written -- --- authorization. -- ------------------------------------------------------------------------------- --- Author: Juergen Pfeifer, 1996 --- Version Control: --- $Revision: 1.11 $ --- Binding Version 01.00 ------------------------------------------------------------------------------- -with Ada.Text_IO; -with Terminal_Interface.Curses.Text_IO.Aux; - -package body Terminal_Interface.Curses.Text_IO.Decimal_IO is - - package Aux renames Terminal_Interface.Curses.Text_IO.Aux; - package DIO is new Ada.Text_IO.Decimal_IO (Num); - - procedure Put - (Win : Window; - Item : Num; - Fore : Field := Default_Fore; - Aft : Field := Default_Aft; - Exp : Field := Default_Exp) - is - Buf : String (1 .. Field'Last); - Len : Field := Fore + 1 + Aft; - begin - if Exp > 0 then - Len := Len + 1 + Exp; - end if; - DIO.Put (Buf, Item, Aft, Exp); - Aux.Put_Buf (Win, Buf, Len, False); - end Put; - - procedure Put - (Item : Num; - Fore : Field := Default_Fore; - Aft : Field := Default_Aft; - Exp : Field := Default_Exp) is - begin - Put (Get_Window, Item, Fore, Aft, Exp); - end Put; - -end Terminal_Interface.Curses.Text_IO.Decimal_IO; diff --git a/Ada95/src/terminal_interface-curses-text_io-decimal_io.ads b/Ada95/src/terminal_interface-curses-text_io-decimal_io.ads deleted file mode 100644 index 1590127451ea4..0000000000000 --- a/Ada95/src/terminal_interface-curses-text_io-decimal_io.ads +++ /dev/null @@ -1,66 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding -- --- -- --- Terminal_Interface.Curses.Text_IO.Decimal_IO -- --- -- --- S P E C -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 1998-2003,2009 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "Software"), to deal in the Software without restriction, including -- --- without limitation the rights to use, copy, modify, merge, publish, -- --- distribute, distribute with modifications, sublicense, and/or sell -- --- copies of the Software, and to permit persons to whom the Software is -- --- furnished to do so, subject to the following conditions: -- --- -- --- The above copyright notice and this permission notice shall be included -- --- in all copies or substantial portions of the Software. -- --- -- --- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- --- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- --- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- --- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- --- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- --- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- --- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- --- -- --- Except as contained in this notice, the name(s) of the above copyright -- --- holders shall not be used in advertising or otherwise to promote the -- --- sale, use or other dealings in this Software without prior written -- --- authorization. -- ------------------------------------------------------------------------------- --- Author: Juergen Pfeifer, 1996 --- Version Control: --- $Revision: 1.12 $ --- Binding Version 01.00 ------------------------------------------------------------------------------- -generic - type Num is delta <> digits <>; - -package Terminal_Interface.Curses.Text_IO.Decimal_IO is - - Default_Fore : Field := Num'Fore; - Default_Aft : Field := Num'Aft; - Default_Exp : Field := 0; - - procedure Put - (Win : Window; - Item : Num; - Fore : Field := Default_Fore; - Aft : Field := Default_Aft; - Exp : Field := Default_Exp); - - procedure Put - (Item : Num; - Fore : Field := Default_Fore; - Aft : Field := Default_Aft; - Exp : Field := Default_Exp); - -private - pragma Inline (Put); - -end Terminal_Interface.Curses.Text_IO.Decimal_IO; diff --git a/Ada95/src/terminal_interface-curses-text_io-enumeration_io.adb b/Ada95/src/terminal_interface-curses-text_io-enumeration_io.adb deleted file mode 100644 index 53f3e55ec8372..0000000000000 --- a/Ada95/src/terminal_interface-curses-text_io-enumeration_io.adb +++ /dev/null @@ -1,80 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding -- --- -- --- Terminal_Interface.Curses.Text_IO.Enumeration_IO -- --- -- --- B O D Y -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 1998-2003,2009 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "Software"), to deal in the Software without restriction, including -- --- without limitation the rights to use, copy, modify, merge, publish, -- --- distribute, distribute with modifications, sublicense, and/or sell -- --- copies of the Software, and to permit persons to whom the Software is -- --- furnished to do so, subject to the following conditions: -- --- -- --- The above copyright notice and this permission notice shall be included -- --- in all copies or substantial portions of the Software. -- --- -- --- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- --- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- --- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- --- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- --- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- --- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- --- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- --- -- --- Except as contained in this notice, the name(s) of the above copyright -- --- holders shall not be used in advertising or otherwise to promote the -- --- sale, use or other dealings in this Software without prior written -- --- authorization. -- ------------------------------------------------------------------------------- --- Author: Juergen Pfeifer, 1996 --- Version Control: --- $Revision: 1.11 $ --- Binding Version 01.00 ------------------------------------------------------------------------------- -with Ada.Text_IO; -with Ada.Characters.Handling; use Ada.Characters.Handling; -with Terminal_Interface.Curses.Text_IO.Aux; - -package body Terminal_Interface.Curses.Text_IO.Enumeration_IO is - - package Aux renames Terminal_Interface.Curses.Text_IO.Aux; - package EIO is new Ada.Text_IO.Enumeration_IO (Enum); - - procedure Put - (Win : Window; - Item : Enum; - Width : Field := Default_Width; - Set : Type_Set := Default_Setting) - is - Buf : String (1 .. Field'Last); - Tset : Ada.Text_IO.Type_Set; - begin - if Set /= Mixed_Case then - Tset := Ada.Text_IO.Type_Set'Val (Type_Set'Pos (Set)); - else - Tset := Ada.Text_IO.Lower_Case; - end if; - EIO.Put (Buf, Item, Tset); - if Set = Mixed_Case then - Buf (Buf'First) := To_Upper (Buf (Buf'First)); - end if; - Aux.Put_Buf (Win, Buf, Width, True, True); - end Put; - - procedure Put - (Item : Enum; - Width : Field := Default_Width; - Set : Type_Set := Default_Setting) - is - begin - Put (Get_Window, Item, Width, Set); - end Put; - -end Terminal_Interface.Curses.Text_IO.Enumeration_IO; diff --git a/Ada95/src/terminal_interface-curses-text_io-enumeration_io.ads b/Ada95/src/terminal_interface-curses-text_io-enumeration_io.ads deleted file mode 100644 index a981f0ebc5799..0000000000000 --- a/Ada95/src/terminal_interface-curses-text_io-enumeration_io.ads +++ /dev/null @@ -1,63 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding -- --- -- --- Terminal_Interface.Curses.Text_IO.Enumeration_IO -- --- -- --- S P E C -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 1998-2003,2009 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "Software"), to deal in the Software without restriction, including -- --- without limitation the rights to use, copy, modify, merge, publish, -- --- distribute, distribute with modifications, sublicense, and/or sell -- --- copies of the Software, and to permit persons to whom the Software is -- --- furnished to do so, subject to the following conditions: -- --- -- --- The above copyright notice and this permission notice shall be included -- --- in all copies or substantial portions of the Software. -- --- -- --- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- --- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- --- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- --- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- --- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- --- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- --- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- --- -- --- Except as contained in this notice, the name(s) of the above copyright -- --- holders shall not be used in advertising or otherwise to promote the -- --- sale, use or other dealings in this Software without prior written -- --- authorization. -- ------------------------------------------------------------------------------- --- Author: Juergen Pfeifer, 1996 --- Version Control: --- $Revision: 1.12 $ --- Binding Version 01.00 ------------------------------------------------------------------------------- -generic - type Enum is (<>); - -package Terminal_Interface.Curses.Text_IO.Enumeration_IO is - - Default_Width : Field := 0; - Default_Setting : Type_Set := Mixed_Case; - - procedure Put - (Win : Window; - Item : Enum; - Width : Field := Default_Width; - Set : Type_Set := Default_Setting); - - procedure Put - (Item : Enum; - Width : Field := Default_Width; - Set : Type_Set := Default_Setting); - -private - pragma Inline (Put); - -end Terminal_Interface.Curses.Text_IO.Enumeration_IO; diff --git a/Ada95/src/terminal_interface-curses-text_io-fixed_io.adb b/Ada95/src/terminal_interface-curses-text_io-fixed_io.adb deleted file mode 100644 index 13a34202389ed..0000000000000 --- a/Ada95/src/terminal_interface-curses-text_io-fixed_io.adb +++ /dev/null @@ -1,75 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding -- --- -- --- Terminal_Interface.Curses.Text_IO.Fixed_IO -- --- -- --- B O D Y -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 1998-2003,2009 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "Software"), to deal in the Software without restriction, including -- --- without limitation the rights to use, copy, modify, merge, publish, -- --- distribute, distribute with modifications, sublicense, and/or sell -- --- copies of the Software, and to permit persons to whom the Software is -- --- furnished to do so, subject to the following conditions: -- --- -- --- The above copyright notice and this permission notice shall be included -- --- in all copies or substantial portions of the Software. -- --- -- --- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- --- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- --- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- --- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- --- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- --- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- --- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- --- -- --- Except as contained in this notice, the name(s) of the above copyright -- --- holders shall not be used in advertising or otherwise to promote the -- --- sale, use or other dealings in this Software without prior written -- --- authorization. -- ------------------------------------------------------------------------------- --- Author: Juergen Pfeifer, 1996 --- Version Control: --- $Revision: 1.11 $ --- Binding Version 01.00 ------------------------------------------------------------------------------- -with Ada.Text_IO; -with Terminal_Interface.Curses.Text_IO.Aux; - -package body Terminal_Interface.Curses.Text_IO.Fixed_IO is - - package Aux renames Terminal_Interface.Curses.Text_IO.Aux; - package FIXIO is new Ada.Text_IO.Fixed_IO (Num); - - procedure Put - (Win : Window; - Item : Num; - Fore : Field := Default_Fore; - Aft : Field := Default_Aft; - Exp : Field := Default_Exp) - is - Buf : String (1 .. Field'Last); - Len : Field := Fore + 1 + Aft; - begin - if Exp > 0 then - Len := Len + 1 + Exp; - end if; - FIXIO.Put (Buf, Item, Aft, Exp); - Aux.Put_Buf (Win, Buf, Len, False); - end Put; - - procedure Put - (Item : Num; - Fore : Field := Default_Fore; - Aft : Field := Default_Aft; - Exp : Field := Default_Exp) is - begin - Put (Get_Window, Item, Fore, Aft, Exp); - end Put; - -end Terminal_Interface.Curses.Text_IO.Fixed_IO; diff --git a/Ada95/src/terminal_interface-curses-text_io-fixed_io.ads b/Ada95/src/terminal_interface-curses-text_io-fixed_io.ads deleted file mode 100644 index 3c22a01479ca3..0000000000000 --- a/Ada95/src/terminal_interface-curses-text_io-fixed_io.ads +++ /dev/null @@ -1,66 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding -- --- -- --- Terminal_Interface.Curses.Text_IO.Fixed_IO -- --- -- --- S P E C -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 1998-2003,2009 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "Software"), to deal in the Software without restriction, including -- --- without limitation the rights to use, copy, modify, merge, publish, -- --- distribute, distribute with modifications, sublicense, and/or sell -- --- copies of the Software, and to permit persons to whom the Software is -- --- furnished to do so, subject to the following conditions: -- --- -- --- The above copyright notice and this permission notice shall be included -- --- in all copies or substantial portions of the Software. -- --- -- --- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- --- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- --- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- --- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- --- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- --- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- --- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- --- -- --- Except as contained in this notice, the name(s) of the above copyright -- --- holders shall not be used in advertising or otherwise to promote the -- --- sale, use or other dealings in this Software without prior written -- --- authorization. -- ------------------------------------------------------------------------------- --- Author: Juergen Pfeifer, 1996 --- Version Control: --- $Revision: 1.12 $ --- Binding Version 01.00 ------------------------------------------------------------------------------- -generic - type Num is delta <>; - -package Terminal_Interface.Curses.Text_IO.Fixed_IO is - - Default_Fore : Field := Num'Fore; - Default_Aft : Field := Num'Aft; - Default_Exp : Field := 0; - - procedure Put - (Win : Window; - Item : Num; - Fore : Field := Default_Fore; - Aft : Field := Default_Aft; - Exp : Field := Default_Exp); - - procedure Put - (Item : Num; - Fore : Field := Default_Fore; - Aft : Field := Default_Aft; - Exp : Field := Default_Exp); - -private - pragma Inline (Put); - -end Terminal_Interface.Curses.Text_IO.Fixed_IO; diff --git a/Ada95/src/terminal_interface-curses-text_io-float_io.adb b/Ada95/src/terminal_interface-curses-text_io-float_io.adb deleted file mode 100644 index af667b4cd1755..0000000000000 --- a/Ada95/src/terminal_interface-curses-text_io-float_io.adb +++ /dev/null @@ -1,76 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding -- --- -- --- Terminal_Interface.Curses.Text_IO.Float_IO -- --- -- --- B O D Y -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 1998-2003,2009 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "Software"), to deal in the Software without restriction, including -- --- without limitation the rights to use, copy, modify, merge, publish, -- --- distribute, distribute with modifications, sublicense, and/or sell -- --- copies of the Software, and to permit persons to whom the Software is -- --- furnished to do so, subject to the following conditions: -- --- -- --- The above copyright notice and this permission notice shall be included -- --- in all copies or substantial portions of the Software. -- --- -- --- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- --- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- --- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- --- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- --- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- --- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- --- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- --- -- --- Except as contained in this notice, the name(s) of the above copyright -- --- holders shall not be used in advertising or otherwise to promote the -- --- sale, use or other dealings in this Software without prior written -- --- authorization. -- ------------------------------------------------------------------------------- --- Author: Juergen Pfeifer, 1996 --- Version Control: --- $Revision: 1.11 $ --- Binding Version 01.00 ------------------------------------------------------------------------------- -with Ada.Text_IO; -with Terminal_Interface.Curses.Text_IO.Aux; - -package body Terminal_Interface.Curses.Text_IO.Float_IO is - - package Aux renames Terminal_Interface.Curses.Text_IO.Aux; - package FIO is new Ada.Text_IO.Float_IO (Num); - - procedure Put - (Win : Window; - Item : Num; - Fore : Field := Default_Fore; - Aft : Field := Default_Aft; - Exp : Field := Default_Exp) - is - Buf : String (1 .. Field'Last); - Len : Field := Fore + 1 + Aft; - begin - if Exp > 0 then - Len := Len + 1 + Exp; - end if; - FIO.Put (Buf, Item, Aft, Exp); - Aux.Put_Buf (Win, Buf, Len, False); - end Put; - - procedure Put - (Item : Num; - Fore : Field := Default_Fore; - Aft : Field := Default_Aft; - Exp : Field := Default_Exp) - is - begin - Put (Get_Window, Item, Fore, Aft, Exp); - end Put; - -end Terminal_Interface.Curses.Text_IO.Float_IO; diff --git a/Ada95/src/terminal_interface-curses-text_io-float_io.ads b/Ada95/src/terminal_interface-curses-text_io-float_io.ads deleted file mode 100644 index b0a68d029eb48..0000000000000 --- a/Ada95/src/terminal_interface-curses-text_io-float_io.ads +++ /dev/null @@ -1,66 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding -- --- -- --- Terminal_Interface.Curses.Text_IO.Float_IO -- --- -- --- S P E C -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 1998-2003,2009 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "Software"), to deal in the Software without restriction, including -- --- without limitation the rights to use, copy, modify, merge, publish, -- --- distribute, distribute with modifications, sublicense, and/or sell -- --- copies of the Software, and to permit persons to whom the Software is -- --- furnished to do so, subject to the following conditions: -- --- -- --- The above copyright notice and this permission notice shall be included -- --- in all copies or substantial portions of the Software. -- --- -- --- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- --- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- --- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- --- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- --- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- --- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- --- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- --- -- --- Except as contained in this notice, the name(s) of the above copyright -- --- holders shall not be used in advertising or otherwise to promote the -- --- sale, use or other dealings in this Software without prior written -- --- authorization. -- ------------------------------------------------------------------------------- --- Author: Juergen Pfeifer, 1996 --- Version Control: --- $Revision: 1.12 $ --- Binding Version 01.00 ------------------------------------------------------------------------------- -generic - type Num is digits <>; - -package Terminal_Interface.Curses.Text_IO.Float_IO is - - Default_Fore : Field := 2; - Default_Aft : Field := Num'Digits - 1; - Default_Exp : Field := 3; - - procedure Put - (Win : Window; - Item : Num; - Fore : Field := Default_Fore; - Aft : Field := Default_Aft; - Exp : Field := Default_Exp); - - procedure Put - (Item : Num; - Fore : Field := Default_Fore; - Aft : Field := Default_Aft; - Exp : Field := Default_Exp); - -private - pragma Inline (Put); - -end Terminal_Interface.Curses.Text_IO.Float_IO; diff --git a/Ada95/src/terminal_interface-curses-text_io-integer_io.adb b/Ada95/src/terminal_interface-curses-text_io-integer_io.adb deleted file mode 100644 index 4d19c42e883f5..0000000000000 --- a/Ada95/src/terminal_interface-curses-text_io-integer_io.adb +++ /dev/null @@ -1,70 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding -- --- -- --- Terminal_Interface.Curses.Text_IO.Integer_IO -- --- -- --- B O D Y -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 1998-2003,2009 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "Software"), to deal in the Software without restriction, including -- --- without limitation the rights to use, copy, modify, merge, publish, -- --- distribute, distribute with modifications, sublicense, and/or sell -- --- copies of the Software, and to permit persons to whom the Software is -- --- furnished to do so, subject to the following conditions: -- --- -- --- The above copyright notice and this permission notice shall be included -- --- in all copies or substantial portions of the Software. -- --- -- --- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- --- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- --- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- --- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- --- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- --- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- --- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- --- -- --- Except as contained in this notice, the name(s) of the above copyright -- --- holders shall not be used in advertising or otherwise to promote the -- --- sale, use or other dealings in this Software without prior written -- --- authorization. -- ------------------------------------------------------------------------------- --- Author: Juergen Pfeifer, 1996 --- Version Control: --- $Revision: 1.11 $ --- Binding Version 01.00 ------------------------------------------------------------------------------- -with Ada.Text_IO; -with Terminal_Interface.Curses.Text_IO.Aux; - -package body Terminal_Interface.Curses.Text_IO.Integer_IO is - - package Aux renames Terminal_Interface.Curses.Text_IO.Aux; - package IIO is new Ada.Text_IO.Integer_IO (Num); - - procedure Put - (Win : Window; - Item : Num; - Width : Field := Default_Width; - Base : Number_Base := Default_Base) - is - Buf : String (1 .. Field'Last); - begin - IIO.Put (Buf, Item, Base); - Aux.Put_Buf (Win, Buf, Width); - end Put; - - procedure Put - (Item : Num; - Width : Field := Default_Width; - Base : Number_Base := Default_Base) - is - begin - Put (Get_Window, Item, Width, Base); - end Put; - -end Terminal_Interface.Curses.Text_IO.Integer_IO; diff --git a/Ada95/src/terminal_interface-curses-text_io-integer_io.ads b/Ada95/src/terminal_interface-curses-text_io-integer_io.ads deleted file mode 100644 index 9ffe1e018164d..0000000000000 --- a/Ada95/src/terminal_interface-curses-text_io-integer_io.ads +++ /dev/null @@ -1,63 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding -- --- -- --- Terminal_Interface.Curses.Text_IO.Integer_IO -- --- -- --- S P E C -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 1998-2003,2009 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "Software"), to deal in the Software without restriction, including -- --- without limitation the rights to use, copy, modify, merge, publish, -- --- distribute, distribute with modifications, sublicense, and/or sell -- --- copies of the Software, and to permit persons to whom the Software is -- --- furnished to do so, subject to the following conditions: -- --- -- --- The above copyright notice and this permission notice shall be included -- --- in all copies or substantial portions of the Software. -- --- -- --- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- --- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- --- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- --- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- --- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- --- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- --- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- --- -- --- Except as contained in this notice, the name(s) of the above copyright -- --- holders shall not be used in advertising or otherwise to promote the -- --- sale, use or other dealings in this Software without prior written -- --- authorization. -- ------------------------------------------------------------------------------- --- Author: Juergen Pfeifer, 1996 --- Version Control: --- $Revision: 1.12 $ --- Binding Version 01.00 ------------------------------------------------------------------------------- -generic - type Num is range <>; - -package Terminal_Interface.Curses.Text_IO.Integer_IO is - - Default_Width : Field := Num'Width; - Default_Base : Number_Base := 10; - - procedure Put - (Win : Window; - Item : Num; - Width : Field := Default_Width; - Base : Number_Base := Default_Base); - - procedure Put - (Item : Num; - Width : Field := Default_Width; - Base : Number_Base := Default_Base); - -private - pragma Inline (Put); - -end Terminal_Interface.Curses.Text_IO.Integer_IO; diff --git a/Ada95/src/terminal_interface-curses-text_io-modular_io.adb b/Ada95/src/terminal_interface-curses-text_io-modular_io.adb deleted file mode 100644 index fe8a6d0b15565..0000000000000 --- a/Ada95/src/terminal_interface-curses-text_io-modular_io.adb +++ /dev/null @@ -1,70 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding -- --- -- --- Terminal_Interface.Curses.Text_IO.Modular_IO -- --- -- --- B O D Y -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 1998-2003,2009 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "Software"), to deal in the Software without restriction, including -- --- without limitation the rights to use, copy, modify, merge, publish, -- --- distribute, distribute with modifications, sublicense, and/or sell -- --- copies of the Software, and to permit persons to whom the Software is -- --- furnished to do so, subject to the following conditions: -- --- -- --- The above copyright notice and this permission notice shall be included -- --- in all copies or substantial portions of the Software. -- --- -- --- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- --- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- --- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- --- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- --- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- --- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- --- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- --- -- --- Except as contained in this notice, the name(s) of the above copyright -- --- holders shall not be used in advertising or otherwise to promote the -- --- sale, use or other dealings in this Software without prior written -- --- authorization. -- ------------------------------------------------------------------------------- --- Author: Juergen Pfeifer, 1996 --- Version Control: --- $Revision: 1.11 $ --- Binding Version 01.00 ------------------------------------------------------------------------------- -with Ada.Text_IO; -with Terminal_Interface.Curses.Text_IO.Aux; - -package body Terminal_Interface.Curses.Text_IO.Modular_IO is - - package Aux renames Terminal_Interface.Curses.Text_IO.Aux; - package MIO is new Ada.Text_IO.Modular_IO (Num); - - procedure Put - (Win : Window; - Item : Num; - Width : Field := Default_Width; - Base : Number_Base := Default_Base) - is - Buf : String (1 .. Field'Last); - begin - MIO.Put (Buf, Item, Base); - Aux.Put_Buf (Win, Buf, Width); - end Put; - - procedure Put - (Item : Num; - Width : Field := Default_Width; - Base : Number_Base := Default_Base) - is - begin - Put (Get_Window, Item, Width, Base); - end Put; - -end Terminal_Interface.Curses.Text_IO.Modular_IO; diff --git a/Ada95/src/terminal_interface-curses-text_io-modular_io.ads b/Ada95/src/terminal_interface-curses-text_io-modular_io.ads deleted file mode 100644 index 68e70e556bf0d..0000000000000 --- a/Ada95/src/terminal_interface-curses-text_io-modular_io.ads +++ /dev/null @@ -1,63 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding -- --- -- --- Terminal_Interface.Curses.Text_IO.Modular_IO -- --- -- --- S P E C -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 1998-2003,2009 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "Software"), to deal in the Software without restriction, including -- --- without limitation the rights to use, copy, modify, merge, publish, -- --- distribute, distribute with modifications, sublicense, and/or sell -- --- copies of the Software, and to permit persons to whom the Software is -- --- furnished to do so, subject to the following conditions: -- --- -- --- The above copyright notice and this permission notice shall be included -- --- in all copies or substantial portions of the Software. -- --- -- --- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- --- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- --- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- --- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- --- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- --- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- --- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- --- -- --- Except as contained in this notice, the name(s) of the above copyright -- --- holders shall not be used in advertising or otherwise to promote the -- --- sale, use or other dealings in this Software without prior written -- --- authorization. -- ------------------------------------------------------------------------------- --- Author: Juergen Pfeifer, 1996 --- Version Control: --- $Revision: 1.12 $ --- Binding Version 01.00 ------------------------------------------------------------------------------- -generic - type Num is mod <>; - -package Terminal_Interface.Curses.Text_IO.Modular_IO is - - Default_Width : Field := Num'Width; - Default_Base : Number_Base := 10; - - procedure Put - (Win : Window; - Item : Num; - Width : Field := Default_Width; - Base : Number_Base := Default_Base); - - procedure Put - (Item : Num; - Width : Field := Default_Width; - Base : Number_Base := Default_Base); - -private - pragma Inline (Put); - -end Terminal_Interface.Curses.Text_IO.Modular_IO; diff --git a/Ada95/src/terminal_interface-curses-text_io.adb b/Ada95/src/terminal_interface-curses-text_io.adb deleted file mode 100644 index e2ca27f208e74..0000000000000 --- a/Ada95/src/terminal_interface-curses-text_io.adb +++ /dev/null @@ -1,338 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding -- --- -- --- Terminal_Interface.Curses.Text_IO -- --- -- --- B O D Y -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 1998-2009,2011 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "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: 2011/03/22 23:38:49 $ --- Binding Version 01.00 ------------------------------------------------------------------------------- -package body Terminal_Interface.Curses.Text_IO is - - Default_Window : Window := Null_Window; - - procedure Set_Window (Win : Window) - is - begin - Default_Window := Win; - end Set_Window; - - function Get_Window return Window - is - begin - if Default_Window = Null_Window then - return Standard_Window; - else - return Default_Window; - end if; - end Get_Window; - pragma Inline (Get_Window); - - procedure Flush (Win : Window) - is - begin - Refresh (Win); - end Flush; - - procedure Flush - is - begin - Flush (Get_Window); - end Flush; - - -------------------------------------------- - -- Specification of line and page lengths -- - -------------------------------------------- - - -- There are no set routines in this package. I assume, that you allocate - -- the window with an appropriate size. - -- A scroll-window is interpreted as an page with unbounded page length, - -- i.e. it returns the conventional 0 as page length. - - function Line_Length (Win : Window) return Count - is - N_Lines : Line_Count; - N_Cols : Column_Count; - begin - Get_Size (Win, N_Lines, N_Cols); - -- if Natural (N_Cols) > Natural (Count'Last) then - -- raise Layout_Error; - -- end if; - return Count (N_Cols); - end Line_Length; - - function Line_Length return Count - is - begin - return Line_Length (Get_Window); - end Line_Length; - - function Page_Length (Win : Window) return Count - is - N_Lines : Line_Count; - N_Cols : Column_Count; - begin - if Scrolling_Allowed (Win) then - return 0; - else - Get_Size (Win, N_Lines, N_Cols); - -- if Natural (N_Lines) > Natural (Count'Last) then - -- raise Layout_Error; - -- end if; - return Count (N_Lines); - end if; - end Page_Length; - - function Page_Length return Count - is - begin - return Page_Length (Get_Window); - end Page_Length; - - ------------------------------------ - -- Column, Line, and Page Control -- - ------------------------------------ - procedure New_Line (Win : Window; Spacing : Positive_Count := 1) - is - P_Size : constant Count := Page_Length (Win); - begin - if not Spacing'Valid then - raise Constraint_Error; - end if; - - for I in 1 .. Spacing loop - if P_Size > 0 and then Line (Win) >= P_Size then - New_Page (Win); - else - Add (Win, ASCII.LF); - end if; - end loop; - end New_Line; - - procedure New_Line (Spacing : Positive_Count := 1) - is - begin - New_Line (Get_Window, Spacing); - end New_Line; - - procedure New_Page (Win : Window) - is - begin - Clear (Win); - end New_Page; - - procedure New_Page - is - begin - New_Page (Get_Window); - end New_Page; - - procedure Set_Col (Win : Window; To : Positive_Count) - is - Y : Line_Position; - X1 : Column_Position; - X2 : Column_Position; - N : Natural; - begin - if not To'Valid then - raise Constraint_Error; - end if; - - Get_Cursor_Position (Win, Y, X1); - N := Natural (To); N := N - 1; - X2 := Column_Position (N); - if X1 > X2 then - New_Line (Win, 1); - X1 := 0; - end if; - if X1 < X2 then - declare - Filler : constant String (Integer (X1) .. (Integer (X2) - 1)) - := (others => ' '); - begin - Put (Win, Filler); - end; - end if; - end Set_Col; - - procedure Set_Col (To : Positive_Count) - is - begin - Set_Col (Get_Window, To); - end Set_Col; - - procedure Set_Line (Win : Window; To : Positive_Count) - is - Y1 : Line_Position; - Y2 : Line_Position; - X : Column_Position; - N : Natural; - begin - if not To'Valid then - raise Constraint_Error; - end if; - - Get_Cursor_Position (Win, Y1, X); - pragma Unreferenced (X); - N := Natural (To); N := N - 1; - Y2 := Line_Position (N); - if Y2 < Y1 then - New_Page (Win); - Y1 := 0; - end if; - if Y1 < Y2 then - New_Line (Win, Positive_Count (Y2 - Y1)); - end if; - end Set_Line; - - procedure Set_Line (To : Positive_Count) - is - begin - Set_Line (Get_Window, To); - end Set_Line; - - function Col (Win : Window) return Positive_Count - is - Y : Line_Position; - X : Column_Position; - N : Natural; - begin - Get_Cursor_Position (Win, Y, X); - N := Natural (X); N := N + 1; - -- if N > Natural (Count'Last) then - -- raise Layout_Error; - -- end if; - return Positive_Count (N); - end Col; - - function Col return Positive_Count - is - begin - return Col (Get_Window); - end Col; - - function Line (Win : Window) return Positive_Count - is - Y : Line_Position; - X : Column_Position; - N : Natural; - begin - Get_Cursor_Position (Win, Y, X); - N := Natural (Y); N := N + 1; - -- if N > Natural (Count'Last) then - -- raise Layout_Error; - -- end if; - return Positive_Count (N); - end Line; - - function Line return Positive_Count - is - begin - return Line (Get_Window); - end Line; - - ----------------------- - -- Characters Output -- - ----------------------- - - procedure Put (Win : Window; Item : Character) - is - P_Size : constant Count := Page_Length (Win); - Y : Line_Position; - X : Column_Position; - L : Line_Count; - C : Column_Count; - begin - if P_Size > 0 then - Get_Cursor_Position (Win, Y, X); - Get_Size (Win, L, C); - if (Y + 1) = L and then (X + 1) = C then - New_Page (Win); - end if; - end if; - Add (Win, Item); - end Put; - - procedure Put (Item : Character) - is - begin - Put (Get_Window, Item); - end Put; - - -------------------- - -- Strings-Output -- - -------------------- - - procedure Put (Win : Window; Item : String) - is - P_Size : constant Count := Page_Length (Win); - Y : Line_Position; - X : Column_Position; - L : Line_Count; - C : Column_Count; - begin - if P_Size > 0 then - Get_Cursor_Position (Win, Y, X); - Get_Size (Win, L, C); - if (Y + 1) = L and then (X + 1 + Item'Length) >= C then - New_Page (Win); - end if; - end if; - Add (Win, Item); - end Put; - - procedure Put (Item : String) - is - begin - Put (Get_Window, Item); - end Put; - - procedure Put_Line - (Win : Window; - Item : String) - is - begin - Put (Win, Item); - New_Line (Win, 1); - end Put_Line; - - procedure Put_Line - (Item : String) - is - begin - Put_Line (Get_Window, Item); - end Put_Line; - -end Terminal_Interface.Curses.Text_IO; diff --git a/Ada95/src/terminal_interface-curses-text_io.ads b/Ada95/src/terminal_interface-curses-text_io.ads deleted file mode 100644 index 9c40329ff4bdb..0000000000000 --- a/Ada95/src/terminal_interface-curses-text_io.ads +++ /dev/null @@ -1,136 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding -- --- -- --- Terminal_Interface.Curses.Text_IO -- --- -- --- S P E C -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 1998-2003,2009 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "Software"), to deal in the Software without restriction, including -- --- without limitation the rights to use, copy, modify, merge, publish, -- --- distribute, distribute with modifications, sublicense, and/or sell -- --- copies of the Software, and to permit persons to whom the Software is -- --- furnished to do so, subject to the following conditions: -- --- -- --- The above copyright notice and this permission notice shall be included -- --- in all copies or substantial portions of the Software. -- --- -- --- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- --- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- --- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- --- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- --- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- --- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- --- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- --- -- --- Except as contained in this notice, the name(s) of the above copyright -- --- holders shall not be used in advertising or otherwise to promote the -- --- sale, use or other dealings in this Software without prior written -- --- authorization. -- ------------------------------------------------------------------------------- --- Author: Juergen Pfeifer, 1996 --- Version Control: --- $Revision: 1.14 $ --- Binding Version 01.00 ------------------------------------------------------------------------------- -with Ada.Text_IO; -with Ada.IO_Exceptions; - -package Terminal_Interface.Curses.Text_IO is - - use type Ada.Text_IO.Count; - subtype Count is Ada.Text_IO.Count; - subtype Positive_Count is Count range 1 .. Count'Last; - - subtype Field is Ada.Text_IO.Field; - subtype Number_Base is Integer range 2 .. 16; - - type Type_Set is (Lower_Case, Upper_Case, Mixed_Case); - - -- For most of the routines you will see a version without a Window - -- type parameter. They will operate on a default window, which can - -- be set by the user. It is initially equal to Standard_Window. - - procedure Set_Window (Win : Window); - -- Set Win as the default window - - function Get_Window return Window; - -- Get the current default window - - procedure Flush (Win : Window); - procedure Flush; - - -------------------------------------------- - -- Specification of line and page lengths -- - -------------------------------------------- - - -- There are no set routines in this package. I assume, that you allocate - -- the window with an appropriate size. - -- A scroll-window is interpreted as an page with unbounded page length, - -- i.e. it returns the conventional 0 as page length. - - function Line_Length (Win : Window) return Count; - function Line_Length return Count; - - function Page_Length (Win : Window) return Count; - function Page_Length return Count; - - ------------------------------------ - -- Column, Line, and Page Control -- - ------------------------------------ - procedure New_Line (Win : Window; Spacing : Positive_Count := 1); - procedure New_Line (Spacing : Positive_Count := 1); - - procedure New_Page (Win : Window); - procedure New_Page; - - procedure Set_Col (Win : Window; To : Positive_Count); - procedure Set_Col (To : Positive_Count); - - procedure Set_Line (Win : Window; To : Positive_Count); - procedure Set_Line (To : Positive_Count); - - function Col (Win : Window) return Positive_Count; - function Col return Positive_Count; - - function Line (Win : Window) return Positive_Count; - function Line return Positive_Count; - - ----------------------- - -- Characters-Output -- - ----------------------- - - procedure Put (Win : Window; Item : Character); - procedure Put (Item : Character); - - -------------------- - -- Strings-Output -- - -------------------- - - procedure Put (Win : Window; Item : String); - procedure Put (Item : String); - - procedure Put_Line - (Win : Window; - Item : String); - - procedure Put_Line - (Item : String); - - -- Exceptions - - Status_Error : exception renames Ada.IO_Exceptions.Status_Error; - Mode_Error : exception renames Ada.IO_Exceptions.Mode_Error; - Name_Error : exception renames Ada.IO_Exceptions.Name_Error; - Use_Error : exception renames Ada.IO_Exceptions.Use_Error; - Device_Error : exception renames Ada.IO_Exceptions.Device_Error; - End_Error : exception renames Ada.IO_Exceptions.End_Error; - Data_Error : exception renames Ada.IO_Exceptions.Data_Error; - Layout_Error : exception renames Ada.IO_Exceptions.Layout_Error; - -end Terminal_Interface.Curses.Text_IO; diff --git a/Ada95/src/terminal_interface-curses-trace.adb_p b/Ada95/src/terminal_interface-curses-trace.adb_p deleted file mode 100644 index d2117a4cef17d..0000000000000 --- a/Ada95/src/terminal_interface-curses-trace.adb_p +++ /dev/null @@ -1,97 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding -- --- -- --- Terminal_Interface.Curses.Trace -- --- -- --- B O D Y -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 2000-2004,2009 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "Software"), to deal in the Software without restriction, including -- --- without limitation the rights to use, copy, modify, merge, publish, -- --- distribute, distribute with modifications, sublicense, and/or sell -- --- copies of the Software, and to permit persons to whom the Software is -- --- furnished to do so, subject to the following conditions: -- --- -- --- The above copyright notice and this permission notice shall be included -- --- in all copies or substantial portions of the Software. -- --- -- --- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- --- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- --- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- --- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- --- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- --- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- --- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- --- -- --- Except as contained in this notice, the name(s) of the above copyright -- --- holders shall not be used in advertising or otherwise to promote the -- --- sale, use or other dealings in this Software without prior written -- --- authorization. -- ------------------------------------------------------------------------------- --- Author: Juergen Pfeifer, 1996 --- Version Control: --- $Revision: 1.7 $ --- 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, "_traces"); - 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 deleted file mode 100644 index fdaaf9fe72700..0000000000000 --- a/Ada95/src/terminal_interface.ads +++ /dev/null @@ -1,47 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- 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; |