Update to ncurses-6.0
Change-Id: I98ab2ea8a5e13cca9f8b7cf6277b9b14a4da4299
diff --git a/Ada95/src/Makefile.in b/Ada95/src/Makefile.in
index 1c072bf..b0e80de 100644
--- a/Ada95/src/Makefile.in
+++ b/Ada95/src/Makefile.in
@@ -1,5 +1,5 @@
##############################################################################
-# Copyright (c) 1998-2003,2004 Free Software Foundation, Inc. #
+# Copyright (c) 1998-2014,2015 Free Software Foundation, Inc. #
# #
# Permission is hereby granted, free of charge, to any person obtaining a #
# copy of this software and associated documentation files (the "Software"), #
@@ -28,32 +28,41 @@
#
# Author: Juergen Pfeifer, 1996
#
-# $Id: Makefile.in,v 1.31 2007/09/15 18:22:24 tom Exp $
+# $Id: Makefile.in,v 1.71 2015/08/05 23:15:41 tom Exp $
#
.SUFFIXES:
-SHELL = /bin/sh
+SHELL = @SHELL@
+VPATH = @srcdir@
THIS = Makefile
MODEL = ../../@DFT_OBJ_SUBDIR@
+
DESTDIR = @DESTDIR@
+
+top_srcdir = @top_srcdir@
srcdir = @srcdir@
prefix = @prefix@
exec_prefix = @exec_prefix@
-ADA_INCLUDE = @ADA_INCLUDE@
+includedir = @includedir@
+libdir = @libdir@
+
+LIBDIR = $(DESTDIR)$(libdir)
+ADA_INCLUDE = $(DESTDIR)@ADA_INCLUDE@
+ADA_OBJECTS = $(DESTDIR)@ADA_OBJECTS@
INSTALL = @INSTALL@
-INSTALL_DATA = @INSTALL_DATA@
+INSTALL_LIB = @INSTALL@ @INSTALL_LIB@
AR = @AR@
-AR_OPTS = @AR_OPTS@
+ARFLAGS = @ARFLAGS@
AWK = @AWK@
LN_S = @LN_S@
CC = @CC@
CFLAGS = @CFLAGS@
-CPPFLAGS = @ACPPFLAGS@ \
+CPPFLAGS = @ACPPFLAGS@ @CPPFLAGS@ \
-DHAVE_CONFIG_H -I$(srcdir)
CCFLAGS = $(CPPFLAGS) $(CFLAGS)
@@ -69,60 +78,58 @@
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 =
+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
-
-LIBALIS=$(ALIB).ali \
- $(ABASE)-aux.ali \
- $(ABASE).ali \
- $(ABASE)-terminfo.ali \
- $(ABASE)-termcap.ali \
- $(ABASE)-putwin.ali \
- $(ABASE)-trace.ali \
- $(ABASE)-mouse.ali \
- $(ABASE)-panels.ali \
- $(ABASE)-menus.ali \
- $(ABASE)-forms.ali \
- $(ABASE)-forms-field_types.ali \
- $(ABASE)-forms-field_types-alpha.ali \
- $(ABASE)-forms-field_types-alphanumeric.ali \
- $(ABASE)-forms-field_types-intfield.ali \
- $(ABASE)-forms-field_types-numeric.ali \
- $(ABASE)-forms-field_types-regexp.ali \
- $(ABASE)-forms-field_types-enumeration.ali \
- $(ABASE)-forms-field_types-ipv4_address.ali \
- $(ABASE)-forms-field_types-user.ali \
- $(ABASE)-forms-field_types-user-choice.ali \
- $(ABASE)-text_io.ali \
- $(ABASE)-text_io-aux.ali
-
-# Ada Library files for generic packages. Since gnat 3.10 they are
-# also compiled
-GENALIS=$(ABASE)-menus-menu_user_data.ali \
- $(ABASE)-menus-item_user_data.ali \
- $(ABASE)-forms-form_user_data.ali \
- $(ABASE)-forms-field_user_data.ali \
- $(ABASE)-forms-field_types-enumeration-ada.ali \
- $(ABASE)-panels-user_data.ali \
- $(ABASE)-text_io-integer_io.ali \
- $(ABASE)-text_io-float_io.ali \
- $(ABASE)-text_io-fixed_io.ali \
- $(ABASE)-text_io-decimal_io.ali \
- $(ABASE)-text_io-enumeration_io.ali \
- $(ABASE)-text_io-modular_io.ali \
- $(ABASE)-text_io-complex_io.ali
-
+################################################################################
+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 \
@@ -163,34 +170,41 @@
$(ABASE)-text_io-modular_io.o \
$(ABASE)-text_io-complex_io.o
-
-all :: libAdaCurses.a
+all :: $(BUILD_DIR_LIB)/$(STATIC_LIBNAME)
@echo done
-libAdaCurses.a :: dotouch $(LIBOBJS) @cf_generic_objects@
- $(AR) $(AR_OPTS) $@ $(LIBOBJS) @cf_generic_objects@
-
-dotouch :
- @sh -c 'for f in $(LIBALIS) $(GENALIS); do test -f $$f || touch $$f; done'
+$(ADA_INCLUDE) \
+$(ADA_OBJECTS) \
+$(LIBDIR) \
+$(BUILD_DIR_LIB) :
+ mkdir -p $@
sources :
@echo made $@
libs \
install \
-install.libs \
+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 ::
- @echo made $@
-
-generics: $(GENALIS)
- @echo made $@
+ @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 $(LIBALIS) $(GENALIS) $(LIBOBJS) $(GENOBJS) $(ABASE)-trace.adb
+ rm -f $(ABASE)-trace.adb
distclean :: clean
rm -f Makefile
@@ -199,190 +213,127 @@
BASEDEPS=$(ABASE).ads $(ABASE)-aux.ads $(ABASE).adb
-$(ALIB).o: $(srcdir)/$(ALIB).ads
- $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ALIB).ads
-
-
-$(ABASE)-aux.o: $(srcdir)/$(ABASE)-aux.adb $(BASEDEPS)
- $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-aux.adb
-
-
-$(ABASE).o: $(ABASE).adb $(BASEDEPS)
- $(ADA) $(ADAFLAGS) -c -o $@ $(ABASE).adb
-
-
-$(ABASE)-terminfo.o: \
- $(srcdir)/$(ABASE)-terminfo.ads \
- $(srcdir)/$(ABASE)-terminfo.adb $(BASEDEPS)
- $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-terminfo.adb
-
-
-$(ABASE)-termcap.o: \
- $(srcdir)/$(ABASE)-termcap.ads \
- $(srcdir)/$(ABASE)-termcap.adb $(BASEDEPS)
- $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-termcap.adb
-
-
-$(ABASE)-putwin.o: \
- $(srcdir)/$(ABASE)-putwin.ads \
- $(srcdir)/$(ABASE)-putwin.adb $(BASEDEPS)
- $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-putwin.adb
-
-
$(ABASE)-trace.adb : $(srcdir)/$(ABASE)-trace.adb_p
rm -f $@
- $(ADAPREP) -DADA_TRACE=@ADA_TRACE@ -DPRAGMA_UNREF=@PRAGMA_UNREF@ $(srcdir)/$(ABASE)-trace.adb_p $@
+ $(ADAPREP) -DADA_TRACE=@ADA_TRACE@ @GNATPREP_OPTS@ $(srcdir)/$(ABASE)-trace.adb_p $@
-$(ABASE)-trace.o: \
- $(ABASE)-trace.ads \
- $(ABASE)-trace.adb $(BASEDEPS)
- $(ADA) $(ADAFLAGS) -c -o $@ $(ABASE)-trace.adb
+###############################################################################
+# Use these definitions when building a shared library.
+SHARED_C_OBJS = c_varargs_to_ada.o c_threaded_variables.o ncurses_compat.o
+SHARED_OBJS = $(SHARED_C_OBJS) @USE_OLD_MAKERULES@$(LIBOBJS) @cf_generic_objects@
+c_varargs_to_ada.o : $(srcdir)/c_varargs_to_ada.c
+ $(CC) $(CFLAGS_DEFAULT) -c -o $@ $(srcdir)/c_varargs_to_ada.c
-$(ABASE)-mouse.o: \
- $(ABASE)-mouse.ads \
- $(srcdir)/$(ABASE)-mouse.adb $(BASEDEPS)
- $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-mouse.adb
+c_threaded_variables.o : $(srcdir)/c_threaded_variables.c
+ $(CC) $(CFLAGS_DEFAULT) -c -o $@ $(srcdir)/c_threaded_variables.c
+ncurses_compat.o : $(srcdir)/ncurses_compat.c
+ $(CC) $(CFLAGS_DEFAULT) -c -o $@ $(srcdir)/ncurses_compat.c
-$(ABASE)-panels.o: \
- $(ABASE)-panels.ads \
- $(srcdir)/$(ABASE)-panels.adb $(BASEDEPS)
- $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-panels.adb
+###############################################################################
+# Use these definitions when building a static library.
+STATIC_C_OBJS = static_c_varargs_to_ada.o static_c_threaded_variables.o static_ncurses_compat.o
+STATIC_OBJS = $(STATIC_C_OBJS) @USE_OLD_MAKERULES@$(LIBOBJS) @cf_generic_objects@
+static_c_varargs_to_ada.o : $(srcdir)/c_varargs_to_ada.c
+ $(CC) $(CFLAGS_NORMAL) -c -o $@ $(srcdir)/c_varargs_to_ada.c
-$(ABASE)-menus.o: \
- $(ABASE)-menus.ads \
- $(srcdir)/$(ABASE)-menus.adb $(BASEDEPS)
- $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-menus.adb
+static_c_threaded_variables.o : $(srcdir)/c_threaded_variables.c
+ $(CC) $(CFLAGS_NORMAL) -c -o $@ $(srcdir)/c_threaded_variables.c
+static_ncurses_compat.o : $(srcdir)/ncurses_compat.c
+ $(CC) $(CFLAGS_NORMAL) -c -o $@ $(srcdir)/ncurses_compat.c
-$(ABASE)-forms.o: \
- $(ABASE)-forms.ads \
- $(srcdir)/$(ABASE)-forms.adb $(BASEDEPS)
- $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-forms.adb
+###############################################################################
-$(ABASE)-forms-field_types.o: \
- $(ABASE)-forms-field_types.ads \
- $(srcdir)/$(ABASE)-forms-field_types.adb $(BASEDEPS)
- $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-forms-field_types.adb
+@USE_OLD_MAKERULES@$(BUILD_DIR_LIB)/$(STATIC_LIBNAME) :: \
+@USE_OLD_MAKERULES@ $(BUILD_DIR_LIB) \
+@USE_OLD_MAKERULES@ $(STATIC_OBJS)
+@USE_OLD_MAKERULES@ $(AR) $(ARFLAGS) $@ $(STATIC_OBJS)
-$(ABASE)-forms-field_types-alpha.o: \
- $(srcdir)/$(ABASE)-forms-field_types-alpha.ads \
- $(srcdir)/$(ABASE)-forms-field_types-alpha.adb $(BASEDEPS)
- $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-forms-field_types-alpha.adb
+$(BUILD_DIR)/static-ali : ; mkdir -p $@
+$(BUILD_DIR)/static-obj : ; mkdir -p $@
-$(ABASE)-forms-field_types-alphanumeric.o: \
- $(srcdir)/$(ABASE)-forms-field_types-alphanumeric.ads \
- $(srcdir)/$(ABASE)-forms-field_types-alphanumeric.adb $(BASEDEPS)
- $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-forms-field_types-alphanumeric.adb
+STATIC_DIRS = \
+ $(BUILD_DIR_LIB) \
+ $(BUILD_DIR)/static-ali \
+ $(BUILD_DIR)/static-obj
-$(ABASE)-forms-field_types-intfield.o: \
- $(srcdir)/$(ABASE)-forms-field_types-intfield.ads \
- $(srcdir)/$(ABASE)-forms-field_types-intfield.adb $(BASEDEPS)
- $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-forms-field_types-intfield.adb
+@USE_GNAT_PROJECTS@$(BUILD_DIR_LIB)/$(STATIC_LIBNAME) :: \
+@USE_GNAT_PROJECTS@ $(ABASE)-trace.adb \
+@USE_GNAT_PROJECTS@ $(STATIC_C_OBJS) \
+@USE_GNAT_PROJECTS@ $(STATIC_DIRS)
+@USE_GNAT_PROJECTS@ $(ADAMAKE) $(ADAMAKEFLAGS) -XLIB_KIND=static
+@USE_GNAT_PROJECTS@ $(AR) $(ARFLAGS) $@ $(STATIC_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)
-$(ABASE)-forms-field_types-numeric.o: \
- $(srcdir)/$(ABASE)-forms-field_types-numeric.ads \
- $(srcdir)/$(ABASE)-forms-field_types-numeric.adb $(BASEDEPS)
- $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-forms-field_types-numeric.adb
+uninstall \
+uninstall.libs ::
+ @rm -f $(ADA_OBJECTS)/$(STATIC_LIBNAME)
-$(ABASE)-forms-field_types-regexp.o: \
- $(srcdir)/$(ABASE)-forms-field_types-regexp.ads \
- $(srcdir)/$(ABASE)-forms-field_types-regexp.adb $(BASEDEPS)
- $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-forms-field_types-regexp.adb
+@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'
-$(ABASE)-forms-field_types-enumeration.o: \
- $(srcdir)/$(ABASE)-forms-field_types-enumeration.ads \
- $(srcdir)/$(ABASE)-forms-field_types-enumeration.adb $(BASEDEPS)
- $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-forms-field_types-enumeration.adb
+$(BUILD_DIR)/dynamic-ali : ; mkdir -p $@
+$(BUILD_DIR)/dynamic-obj : ; mkdir -p $@
-$(ABASE)-forms-field_types-ipv4_address.o: \
- $(srcdir)/$(ABASE)-forms-field_types-ipv4_address.ads \
- $(srcdir)/$(ABASE)-forms-field_types-ipv4_address.adb $(BASEDEPS)
- $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-forms-field_types-ipv4_address.adb
+SHARED_DIRS = \
+ $(BUILD_DIR_LIB) \
+ $(BUILD_DIR)/dynamic-ali \
+ $(BUILD_DIR)/dynamic-obj
-$(ABASE)-forms-field_types-user.o: \
- $(srcdir)/$(ABASE)-forms-field_types-user.ads \
- $(srcdir)/$(ABASE)-forms-field_types-user.adb $(BASEDEPS)
- $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-forms-field_types-user.adb
+@MAKE_ADA_SHAREDLIB@all :: $(BUILD_DIR_LIB)/$(SHARED_LIBNAME)
+@MAKE_ADA_SHAREDLIB@$(BUILD_DIR_LIB)/$(SHARED_LIBNAME) :: \
+@MAKE_ADA_SHAREDLIB@ $(ABASE)-trace.adb \
+@MAKE_ADA_SHAREDLIB@ $(SHARED_DIRS) \
+@MAKE_ADA_SHAREDLIB@ $(SHARED_OBJS)
+@MAKE_ADA_SHAREDLIB@ cp $(SHARED_OBJS) $(BUILD_DIR)/dynamic-obj/
+@MAKE_ADA_SHAREDLIB@ $(ADAMAKE) $(ADAMAKEFLAGS) -XLIB_KIND=dynamic
-$(ABASE)-forms-field_types-user-choice.o: \
- $(srcdir)/$(ABASE)-forms-field_types-user-choice.ads \
- $(srcdir)/$(ABASE)-forms-field_types-user-choice.adb $(BASEDEPS)
- $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-forms-field_types-user-choice.adb
+install \
+install.libs :: $(ADA_INCLUDE)
+ $(INSTALL_LIB) \
+ $(SOURCE_DIR_SRC)/*.ad[sb] \
+ $(ADA_INCLUDE)
-$(ABASE)-text_io.o: \
- $(srcdir)/$(ABASE)-text_io.ads \
- $(srcdir)/$(ABASE)-text_io.adb $(BASEDEPS)
- $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-text_io.adb
+install \
+install.libs :: $(ADA_INCLUDE)
+ $(INSTALL_LIB) \
+ $(GENERATED_SOURCES) \
+ $(ADA_INCLUDE)
-$(ABASE)-text_io-aux.o: \
- $(srcdir)/$(ABASE)-text_io-aux.ads \
- $(srcdir)/$(ABASE)-text_io-aux.adb $(BASEDEPS)
- $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-text_io-aux.adb
+uninstall \
+uninstall.libs ::
+ $(SHELL) -c 'for name in $(SOURCE_DIR_SRC)/*.ad[sb] $(GENERATED_SOURCES); do rm -f $(ADA_INCLUDE)/`basename $$name`; done'
-$(ABASE)-menus-menu_user_data.o: \
- $(ABASE)-menus-menu_user_data.ads \
- $(srcdir)/$(ABASE)-menus-menu_user_data.adb $(BASEDEPS)
- $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-menus-menu_user_data.adb
+@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)
-$(ABASE)-menus-item_user_data.o: \
- $(ABASE)-menus-item_user_data.ads \
- $(srcdir)/$(ABASE)-menus-item_user_data.adb $(BASEDEPS)
- $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-menus-item_user_data.adb
-
-$(ABASE)-forms-form_user_data.o: \
- $(ABASE)-forms-form_user_data.ads \
- $(srcdir)/$(ABASE)-forms-form_user_data.adb $(BASEDEPS)
- $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-forms-form_user_data.adb
-
-$(ABASE)-forms-field_user_data.o: \
- $(ABASE)-forms-field_user_data.ads \
- $(srcdir)/$(ABASE)-forms-field_user_data.adb $(BASEDEPS)
- $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-forms-field_user_data.adb
-
-$(ABASE)-forms-field_types-enumeration-ada.o: \
- $(srcdir)/$(ABASE)-forms-field_types-enumeration-ada.ads \
- $(srcdir)/$(ABASE)-forms-field_types-enumeration-ada.adb $(BASEDEPS)
- $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-forms-field_types-enumeration-ada.adb
-
-$(ABASE)-panels-user_data.o: \
- $(ABASE)-panels-user_data.ads \
- $(srcdir)/$(ABASE)-panels-user_data.adb $(BASEDEPS)
- $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-panels-user_data.adb
-
-$(ABASE)-text_io-integer_io.o: \
- $(srcdir)/$(ABASE)-text_io-integer_io.ads \
- $(srcdir)/$(ABASE)-text_io-integer_io.adb $(BASEDEPS)
- $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-text_io-integer_io.adb
-
-$(ABASE)-text_io-float_io.o: \
- $(srcdir)/$(ABASE)-text_io-float_io.ads \
- $(srcdir)/$(ABASE)-text_io-float_io.adb $(BASEDEPS)
- $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-text_io-float_io.adb
-
-$(ABASE)-text_io-fixed_io.o: \
- $(srcdir)/$(ABASE)-text_io-fixed_io.ads \
- $(srcdir)/$(ABASE)-text_io-fixed_io.adb $(BASEDEPS)
- $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-text_io-fixed_io.adb
-
-$(ABASE)-text_io-decimal_io.o: \
- $(srcdir)/$(ABASE)-text_io-decimal_io.ads \
- $(srcdir)/$(ABASE)-text_io-decimal_io.adb $(BASEDEPS)
- $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-text_io-decimal_io.adb
-
-$(ABASE)-text_io-enumeration_io.o: \
- $(srcdir)/$(ABASE)-text_io-enumeration_io.ads \
- $(srcdir)/$(ABASE)-text_io-enumeration_io.adb $(BASEDEPS)
- $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-text_io-enumeration_io.adb
-
-$(ABASE)-text_io-modular_io.o: \
- $(srcdir)/$(ABASE)-text_io-modular_io.ads \
- $(srcdir)/$(ABASE)-text_io-modular_io.adb $(BASEDEPS)
- $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-text_io-modular_io.adb
-
-$(ABASE)-text_io-complex_io.o: \
- $(srcdir)/$(ABASE)-text_io-complex_io.ads \
- $(srcdir)/$(ABASE)-text_io-complex_io.adb $(BASEDEPS)
- $(ADA) $(ADAFLAGS) -c -o $@ $(srcdir)/$(ABASE)-text_io-complex_io.adb
+clean ::
+ rm -rf $(BUILD_DIR)/*-ali
+ rm -rf $(BUILD_DIR)/*-obj
+ rm -rf $(BUILD_DIR_LIB)
diff --git a/Ada95/src/c_threaded_variables.c b/Ada95/src/c_threaded_variables.c
new file mode 100644
index 0000000..bc58c46
--- /dev/null
+++ b/Ada95/src/c_threaded_variables.c
@@ -0,0 +1,56 @@
+/****************************************************************************
+ * Copyright (c) 2011,2014 Free Software Foundation, Inc. *
+ * *
+ * Permission is hereby granted, free of charge, to any person obtaining a *
+ * copy of this software and associated documentation files (the *
+ * "Software"), to deal in the Software without restriction, including *
+ * without limitation the rights to use, copy, modify, merge, publish, *
+ * distribute, distribute with modifications, sublicense, and/or sell *
+ * copies of the Software, and to permit persons to whom the Software is *
+ * furnished to do so, subject to the following conditions: *
+ * *
+ * The above copyright notice and this permission notice shall be included *
+ * in all copies or substantial portions of the Software. *
+ * *
+ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS *
+ * OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF *
+ * MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. *
+ * IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, *
+ * DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR *
+ * OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR *
+ * THE USE OR OTHER DEALINGS IN THE SOFTWARE. *
+ * *
+ * Except as contained in this notice, the name(s) of the above copyright *
+ * holders shall not be used in advertising or otherwise to promote the *
+ * sale, use or other dealings in this Software without prior written *
+ * authorization. *
+ ****************************************************************************/
+
+/****************************************************************************
+ * Author: Nicolas Boulenguez, 2011 *
+ ****************************************************************************/
+
+#include "c_threaded_variables.h"
+
+#define WRAP(type, name) \
+ type \
+ name ## _as_function () \
+ { \
+ return name; \
+ }
+/* *INDENT-OFF* */
+WRAP(WINDOW *, stdscr)
+WRAP(WINDOW *, curscr)
+
+WRAP(int, LINES)
+WRAP(int, COLS)
+WRAP(int, TABSIZE)
+WRAP(int, COLORS)
+WRAP(int, COLOR_PAIRS)
+
+chtype
+acs_map_as_function(char inx)
+{
+ return acs_map[(unsigned char) inx];
+}
+/* *INDENT-ON* */
diff --git a/Ada95/src/c_threaded_variables.h b/Ada95/src/c_threaded_variables.h
new file mode 100644
index 0000000..5f0f62f
--- /dev/null
+++ b/Ada95/src/c_threaded_variables.h
@@ -0,0 +1,58 @@
+/****************************************************************************
+ * Copyright (c) 2011-2014,2015 Free Software Foundation, Inc. *
+ * *
+ * Permission is hereby granted, free of charge, to any person obtaining a *
+ * copy of this software and associated documentation files (the *
+ * "Software"), to deal in the Software without restriction, including *
+ * without limitation the rights to use, copy, modify, merge, publish, *
+ * distribute, distribute with modifications, sublicense, and/or sell *
+ * copies of the Software, and to permit persons to whom the Software is *
+ * furnished to do so, subject to the following conditions: *
+ * *
+ * The above copyright notice and this permission notice shall be included *
+ * in all copies or substantial portions of the Software. *
+ * *
+ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS *
+ * OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF *
+ * MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. *
+ * IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, *
+ * DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR *
+ * OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR *
+ * THE USE OR OTHER DEALINGS IN THE SOFTWARE. *
+ * *
+ * Except as contained in this notice, the name(s) of the above copyright *
+ * holders shall not be used in advertising or otherwise to promote the *
+ * sale, use or other dealings in this Software without prior written *
+ * authorization. *
+ ****************************************************************************/
+
+/* $Id: c_threaded_variables.h,v 1.3 2015/08/06 23:09:47 tom Exp $ */
+
+#ifndef __C_THREADED_VARIABLES_H
+#define __C_THREADED_VARIABLES_H
+
+#include <ncurses_cfg.h>
+
+#if HAVE_INTTYPES_H
+# include <inttypes.h>
+#else
+# if HAVE_STDINT_H
+# include <stdint.h>
+# endif
+#endif
+
+#include <curses.h>
+
+extern WINDOW *stdscr_as_function(void);
+extern WINDOW *curscr_as_function(void);
+
+extern int LINES_as_function(void);
+extern int LINES_as_function(void);
+extern int COLS_as_function(void);
+extern int TABSIZE_as_function(void);
+extern int COLORS_as_function(void);
+extern int COLOR_PAIRS_as_function(void);
+
+extern chtype acs_map_as_function(char /* index */ );
+
+#endif /* __C_THREADED_VARIABLES_H */
diff --git a/Ada95/src/c_varargs_to_ada.c b/Ada95/src/c_varargs_to_ada.c
new file mode 100644
index 0000000..f0b1bbe
--- /dev/null
+++ b/Ada95/src/c_varargs_to_ada.c
@@ -0,0 +1,117 @@
+/****************************************************************************
+ * Copyright (c) 2011,2014 Free Software Foundation, Inc. *
+ * *
+ * Permission is hereby granted, free of charge, to any person obtaining a *
+ * copy of this software and associated documentation files (the *
+ * "Software"), to deal in the Software without restriction, including *
+ * without limitation the rights to use, copy, modify, merge, publish, *
+ * distribute, distribute with modifications, sublicense, and/or sell *
+ * copies of the Software, and to permit persons to whom the Software is *
+ * furnished to do so, subject to the following conditions: *
+ * *
+ * The above copyright notice and this permission notice shall be included *
+ * in all copies or substantial portions of the Software. *
+ * *
+ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS *
+ * OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF *
+ * MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. *
+ * IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, *
+ * DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR *
+ * OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR *
+ * THE USE OR OTHER DEALINGS IN THE SOFTWARE. *
+ * *
+ * Except as contained in this notice, the name(s) of the above copyright *
+ * holders shall not be used in advertising or otherwise to promote the *
+ * sale, use or other dealings in this Software without prior written *
+ * authorization. *
+ ****************************************************************************/
+
+/****************************************************************************
+ * Author: Nicolas Boulenguez, 2011 *
+ ****************************************************************************/
+
+/*
+ Version Control
+ $Id: c_varargs_to_ada.c,v 1.6 2014/05/24 21:32:18 tom Exp $
+ --------------------------------------------------------------------------*/
+/*
+ */
+
+#include "c_varargs_to_ada.h"
+
+int
+set_field_type_alnum(FIELD *field,
+ int minimum_width)
+{
+ return set_field_type(field, TYPE_ALNUM, minimum_width);
+}
+
+int
+set_field_type_alpha(FIELD *field,
+ int minimum_width)
+{
+ return set_field_type(field, TYPE_ALPHA, minimum_width);
+}
+
+int
+set_field_type_enum(FIELD *field,
+ char **value_list,
+ int case_sensitive,
+ int unique_match)
+{
+ return set_field_type(field, TYPE_ENUM, value_list, case_sensitive,
+ unique_match);
+}
+
+int
+set_field_type_integer(FIELD *field,
+ int precision,
+ long minimum,
+ long maximum)
+{
+ return set_field_type(field, TYPE_INTEGER, precision, minimum, maximum);
+}
+
+int
+set_field_type_numeric(FIELD *field,
+ int precision,
+ double minimum,
+ double maximum)
+{
+ return set_field_type(field, TYPE_NUMERIC, precision, minimum, maximum);
+}
+
+int
+set_field_type_regexp(FIELD *field,
+ char *regular_expression)
+{
+ return set_field_type(field, TYPE_REGEXP, regular_expression);
+}
+
+int
+set_field_type_ipv4(FIELD *field)
+{
+ return set_field_type(field, TYPE_IPV4);
+}
+
+int
+set_field_type_user(FIELD *field,
+ FIELDTYPE *fieldtype,
+ void *arg)
+{
+ return set_field_type(field, fieldtype, arg);
+}
+
+void *
+void_star_make_arg(va_list *list)
+{
+ return va_arg(*list, void *);
+}
+
+#ifdef TRACE
+void
+_traces(const char *fmt, char *arg)
+{
+ _tracef(fmt, arg);
+}
+#endif
diff --git a/Ada95/src/c_varargs_to_ada.h b/Ada95/src/c_varargs_to_ada.h
new file mode 100644
index 0000000..f269705
--- /dev/null
+++ b/Ada95/src/c_varargs_to_ada.h
@@ -0,0 +1,81 @@
+/****************************************************************************
+ * Copyright (c) 2011,2015 Free Software Foundation, Inc. *
+ * *
+ * Permission is hereby granted, free of charge, to any person obtaining a *
+ * copy of this software and associated documentation files (the *
+ * "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.4 2015/08/06 23:08:47 tom Exp $ */
+
+#ifndef __C_VARARGS_TO_ADA_H
+#define __C_VARARGS_TO_ADA_H
+
+#ifdef HAVE_CONFIG_H
+#include <ncurses_cfg.h>
+#else
+#include <ncurses.h>
+#endif
+
+#include <stdlib.h>
+
+#include <form.h>
+
+extern int set_field_type_alnum(FIELD * /* field */ ,
+ 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
new file mode 100644
index 0000000..e7380f0
--- /dev/null
+++ b/Ada95/src/library.gpr
@@ -0,0 +1,56 @@
+------------------------------------------------------------------------------
+-- Copyright (c) 2010-2011,2014 Free Software Foundation, Inc. --
+-- --
+-- Permission is hereby granted, free of charge, to any person obtaining a --
+-- copy of this software and associated documentation files (the --
+-- "Software"), to deal in the Software without restriction, including --
+-- without limitation the rights to use, copy, modify, merge, publish, --
+-- distribute, distribute with modifications, sublicense, and/or sell --
+-- copies of the Software, and to permit persons to whom the Software is --
+-- furnished to do so, subject to the following conditions: --
+-- --
+-- The above copyright notice and this permission notice shall be included --
+-- in all copies or substantial portions of the Software. --
+-- --
+-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
+-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
+-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
+-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
+-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
+-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
+-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
+-- --
+-- Except as contained in this notice, the name(s) of the above copyright --
+-- holders shall not be used in advertising or otherwise to promote the --
+-- sale, use or other dealings in this Software without prior written --
+-- authorization. --
+------------------------------------------------------------------------------
+-- $Id: library.gpr,v 1.9 2014/06/01 01:13:09 tom Exp $
+-- http://gcc.gnu.org/onlinedocs/gnat_ugn_unw/Library-Projects.html
+-- http://www.adaworld.com/debian/debian-ada-policy.html
+project Library is
+ Build_Dir := External ("BUILD_DIR");
+ Source_Dir := External ("SOURCE_DIR");
+ Source_Dir2 := External ("SOURCE_DIR2");
+ Kind := External ("LIB_KIND");
+ for Library_Name use External ("LIB_NAME");
+ for Library_Version use External ("SONAME");
+
+ for Library_Kind use Kind;
+ for Library_Dir use Build_Dir & "/lib";
+ for Object_Dir use Build_Dir & "/" & Kind & "-obj";
+ for Library_ALI_Dir use Build_Dir & "/" & Kind & "-ali";
+ for Source_Dirs use (Source_Dir & "/src",
+ Source_Dir2,
+ Build_Dir & "/src");
+ 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
new file mode 100644
index 0000000..9f5e030
--- /dev/null
+++ b/Ada95/src/modules
@@ -0,0 +1,70 @@
+# $Id: modules,v 1.3 2010/06/26 23:33:14 tom Exp $
+##############################################################################
+# Copyright (c) 2010 Free Software Foundation, Inc. #
+# #
+# Permission is hereby granted, free of charge, to any person obtaining a #
+# copy of this software and associated documentation files (the "Software"), #
+# to deal in the Software without restriction, including without limitation #
+# the rights to use, copy, modify, merge, publish, distribute, distribute #
+# with modifications, sublicense, and/or sell copies of the Software, and to #
+# permit persons to whom the Software is furnished to do so, subject to the #
+# following conditions: #
+# #
+# The above copyright notice and this permission notice shall be included in #
+# all copies or substantial portions of the Software. #
+# #
+# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR #
+# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, #
+# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL #
+# THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER #
+# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING #
+# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER #
+# DEALINGS IN THE SOFTWARE. #
+# #
+# Except as contained in this notice, the name(s) of the above copyright #
+# holders shall not be used in advertising or otherwise to promote the sale, #
+# use or other dealings in this Software without prior written #
+# authorization. #
+##############################################################################
+#
+# Author: Thomas E. Dickey 2010
+#
+
+# Library objects
+# rootname depend-spec depend-body unit
+$(ALIB) $(srcdir) none spec
+$(ABASE)-aux none $(srcdir) body
+$(ABASE) none . body
+$(ABASE)-terminfo $(srcdir) $(srcdir) body
+$(ABASE)-termcap $(srcdir) $(srcdir) body
+$(ABASE)-putwin $(srcdir) $(srcdir) body
+$(ABASE)-trace . . body
+$(ABASE)-mouse . $(srcdir) body
+$(ABASE)-panels . $(srcdir) body
+$(ABASE)-menus . $(srcdir) body
+$(ABASE)-forms . $(srcdir) body
+$(ABASE)-forms-field_types . $(srcdir) body
+$(ABASE)-forms-field_types-alpha $(srcdir) $(srcdir) body
+$(ABASE)-forms-field_types-alphanumeric $(srcdir) $(srcdir) body
+$(ABASE)-forms-field_types-intfield $(srcdir) $(srcdir) body
+$(ABASE)-forms-field_types-numeric $(srcdir) $(srcdir) body
+$(ABASE)-forms-field_types-regexp $(srcdir) $(srcdir) body
+$(ABASE)-forms-field_types-enumeration $(srcdir) $(srcdir) body
+$(ABASE)-forms-field_types-ipv4_address $(srcdir) $(srcdir) body
+$(ABASE)-forms-field_types-user $(srcdir) $(srcdir) body
+$(ABASE)-forms-field_types-user-choice $(srcdir) $(srcdir) body
+$(ABASE)-text_io $(srcdir) $(srcdir) body
+$(ABASE)-text_io-aux $(srcdir) $(srcdir) body
+$(ABASE)-menus-menu_user_data . $(srcdir) body
+$(ABASE)-menus-item_user_data . $(srcdir) body
+$(ABASE)-forms-form_user_data . $(srcdir) body
+$(ABASE)-forms-field_user_data . $(srcdir) body
+$(ABASE)-forms-field_types-enumeration-ada $(srcdir) $(srcdir) body
+$(ABASE)-panels-user_data . $(srcdir) body
+$(ABASE)-text_io-integer_io $(srcdir) $(srcdir) body
+$(ABASE)-text_io-float_io $(srcdir) $(srcdir) body
+$(ABASE)-text_io-fixed_io $(srcdir) $(srcdir) body
+$(ABASE)-text_io-decimal_io $(srcdir) $(srcdir) body
+$(ABASE)-text_io-enumeration_io $(srcdir) $(srcdir) body
+$(ABASE)-text_io-modular_io $(srcdir) $(srcdir) body
+$(ABASE)-text_io-complex_io $(srcdir) $(srcdir) body
diff --git a/Ada95/src/ncurses_compat.c b/Ada95/src/ncurses_compat.c
new file mode 100644
index 0000000..e44f3d0
--- /dev/null
+++ b/Ada95/src/ncurses_compat.c
@@ -0,0 +1,145 @@
+/****************************************************************************
+ * Copyright (c) 2011,2015 Free Software Foundation, Inc. *
+ * *
+ * Permission is hereby granted, free of charge, to any person obtaining a *
+ * copy of this software and associated documentation files (the *
+ * "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.3 2015/08/06 23:09:10 tom Exp $
+ --------------------------------------------------------------------------*/
+
+/*
+ * Provide compatibility with older versions of ncurses.
+ */
+#include <ncurses_cfg.h>
+
+#if HAVE_INTTYPES_H
+# include <inttypes.h>
+#else
+# if HAVE_STDINT_H
+# include <stdint.h>
+# endif
+#endif
+
+#include <curses.h>
+
+#if defined(NCURSES_VERSION_PATCH)
+
+#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
index 812e8cc..9c2f8cd 100644
--- a/Ada95/src/terminal_interface-curses-aux.adb
+++ b/Ada95/src/terminal_interface-curses-aux.adb
@@ -7,7 +7,7 @@
-- B O D Y --
-- --
------------------------------------------------------------------------------
--- Copyright (c) 1998 Free Software Foundation, Inc. --
+-- 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 --
@@ -35,13 +35,13 @@
------------------------------------------------------------------------------
-- Author: Juergen Pfeifer, 1996
-- Version Control:
--- $Revision: 1.10 $
+-- $Revision: 1.11 $
-- Binding Version 01.00
------------------------------------------------------------------------------
package body Terminal_Interface.Curses.Aux is
--
-- Some helpers
- procedure Fill_String (Cp : in chars_ptr;
+ procedure Fill_String (Cp : chars_ptr;
Str : out String)
is
-- Fill the string with the characters referenced by the
diff --git a/Ada95/src/terminal_interface-curses-forms-field_types-alpha.adb b/Ada95/src/terminal_interface-curses-forms-field_types-alpha.adb
index f437ce6..9c614ca 100644
--- a/Ada95/src/terminal_interface-curses-forms-field_types-alpha.adb
+++ b/Ada95/src/terminal_interface-curses-forms-field_types-alpha.adb
@@ -7,7 +7,7 @@
-- B O D Y --
-- --
------------------------------------------------------------------------------
--- Copyright (c) 1998,2008 Free Software Foundation, Inc. --
+-- Copyright (c) 1998-2011,2014 Free Software Foundation, Inc. --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files (the --
@@ -35,31 +35,23 @@
------------------------------------------------------------------------------
-- Author: Juergen Pfeifer, 1996
-- Version Control:
--- $Revision: 1.9 $
--- $Date: 2008/07/26 18:50:25 $
+-- $Revision: 1.13 $
+-- $Date: 2014/05/24 21:31:05 $
-- Binding Version 01.00
------------------------------------------------------------------------------
with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux;
package body Terminal_Interface.Curses.Forms.Field_Types.Alpha is
- procedure Set_Field_Type (Fld : in Field;
- Typ : in Alpha_Field)
+ procedure Set_Field_Type (Fld : Field;
+ Typ : Alpha_Field)
is
- C_Alpha_Field_Type : C_Field_Type;
- pragma Import (C, C_Alpha_Field_Type, "TYPE_ALPHA");
-
function Set_Fld_Type (F : Field := Fld;
- Cft : C_Field_Type := C_Alpha_Field_Type;
- Arg1 : C_Int) return C_Int;
- pragma Import (C, Set_Fld_Type, "set_field_type");
+ Arg1 : C_Int) return Eti_Error;
+ pragma Import (C, Set_Fld_Type, "set_field_type_alpha");
- Res : Eti_Error;
begin
- Res := Set_Fld_Type (Arg1 => C_Int (Typ.Minimum_Field_Width));
- if Res /= E_Ok then
- Eti_Exception (Res);
- end if;
+ Eti_Exception (Set_Fld_Type (Arg1 => C_Int (Typ.Minimum_Field_Width)));
Wrap_Builtin (Fld, Typ);
end Set_Field_Type;
diff --git a/Ada95/src/terminal_interface-curses-forms-field_types-alpha.ads b/Ada95/src/terminal_interface-curses-forms-field_types-alpha.ads
index 6f0b79d..7878f73 100644
--- a/Ada95/src/terminal_interface-curses-forms-field_types-alpha.ads
+++ b/Ada95/src/terminal_interface-curses-forms-field_types-alpha.ads
@@ -7,7 +7,7 @@
-- S P E C --
-- --
------------------------------------------------------------------------------
--- Copyright (c) 1998 Free Software Foundation, Inc. --
+-- 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 --
@@ -35,7 +35,7 @@
------------------------------------------------------------------------------
-- Author: Juergen Pfeifer, 1996
-- Version Control:
--- $Revision: 1.11 $
+-- $Revision: 1.12 $
-- Binding Version 01.00
------------------------------------------------------------------------------
package Terminal_Interface.Curses.Forms.Field_Types.Alpha is
@@ -46,8 +46,8 @@
Minimum_Field_Width : Natural := 0;
end record;
- procedure Set_Field_Type (Fld : in Field;
- Typ : in Alpha_Field);
+ 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
index 0c3ca29..270906d 100644
--- a/Ada95/src/terminal_interface-curses-forms-field_types-alphanumeric.adb
+++ b/Ada95/src/terminal_interface-curses-forms-field_types-alphanumeric.adb
@@ -7,7 +7,7 @@
-- B O D Y --
-- --
------------------------------------------------------------------------------
--- Copyright (c) 1998,2008 Free Software Foundation, Inc. --
+-- Copyright (c) 1998-2011,2014 Free Software Foundation, Inc. --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files (the --
@@ -35,31 +35,23 @@
------------------------------------------------------------------------------
-- Author: Juergen Pfeifer, 1996
-- Version Control:
--- $Revision: 1.9 $
--- $Date: 2008/07/26 18:50:15 $
+-- $Revision: 1.13 $
+-- $Date: 2014/05/24 21:31:05 $
-- Binding Version 01.00
------------------------------------------------------------------------------
with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux;
package body Terminal_Interface.Curses.Forms.Field_Types.AlphaNumeric is
- procedure Set_Field_Type (Fld : in Field;
- Typ : in AlphaNumeric_Field)
+ procedure Set_Field_Type (Fld : Field;
+ Typ : AlphaNumeric_Field)
is
- C_AlphaNumeric_Field_Type : C_Field_Type;
- pragma Import (C, C_AlphaNumeric_Field_Type, "TYPE_ALNUM");
-
function Set_Fld_Type (F : Field := Fld;
- Cft : C_Field_Type := C_AlphaNumeric_Field_Type;
- Arg1 : C_Int) return C_Int;
- pragma Import (C, Set_Fld_Type, "set_field_type");
+ Arg1 : C_Int) return Eti_Error;
+ pragma Import (C, Set_Fld_Type, "set_field_type_alnum");
- Res : Eti_Error;
begin
- Res := Set_Fld_Type (Arg1 => C_Int (Typ.Minimum_Field_Width));
- if Res /= E_Ok then
- Eti_Exception (Res);
- end if;
+ Eti_Exception (Set_Fld_Type (Arg1 => C_Int (Typ.Minimum_Field_Width)));
Wrap_Builtin (Fld, Typ);
end Set_Field_Type;
diff --git a/Ada95/src/terminal_interface-curses-forms-field_types-alphanumeric.ads b/Ada95/src/terminal_interface-curses-forms-field_types-alphanumeric.ads
index 1f21950..c1009ac 100644
--- a/Ada95/src/terminal_interface-curses-forms-field_types-alphanumeric.ads
+++ b/Ada95/src/terminal_interface-curses-forms-field_types-alphanumeric.ads
@@ -7,7 +7,7 @@
-- S P E C --
-- --
------------------------------------------------------------------------------
--- Copyright (c) 1998 Free Software Foundation, Inc. --
+-- 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 --
@@ -35,7 +35,7 @@
------------------------------------------------------------------------------
-- Author: Juergen Pfeifer, 1996
-- Version Control:
--- $Revision: 1.11 $
+-- $Revision: 1.12 $
-- Binding Version 01.00
------------------------------------------------------------------------------
package Terminal_Interface.Curses.Forms.Field_Types.AlphaNumeric is
@@ -47,8 +47,8 @@
Minimum_Field_Width : Natural := 0;
end record;
- procedure Set_Field_Type (Fld : in Field;
- Typ : in AlphaNumeric_Field);
+ 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
index b3eaf44..d38e062 100644
--- a/Ada95/src/terminal_interface-curses-forms-field_types-enumeration-ada.adb
+++ b/Ada95/src/terminal_interface-curses-forms-field_types-enumeration-ada.adb
@@ -7,7 +7,7 @@
-- B O D Y --
-- --
------------------------------------------------------------------------------
--- Copyright (c) 1998,2004 Free Software Foundation, Inc. --
+-- Copyright (c) 1998-2004,2011 Free Software Foundation, Inc. --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files (the --
@@ -35,8 +35,8 @@
------------------------------------------------------------------------------
-- Author: Juergen Pfeifer, 1996
-- Version Control:
--- $Revision: 1.10 $
--- $Date: 2004/08/21 21:37:00 $
+-- $Revision: 1.11 $
+-- $Date: 2011/03/22 23:36:20 $
-- Binding Version 01.00
------------------------------------------------------------------------------
with Ada.Characters.Handling; use Ada.Characters.Handling;
@@ -61,8 +61,8 @@
if Set /= Upper_Case then
I.Names (J).all := To_Lower (I.Names (J).all);
if Set = Mixed_Case then
- I.Names (J)(I.Names (J).all'First) :=
- To_Upper (I.Names (J)(I.Names (J).all'First));
+ I.Names (J).all (I.Names (J).all'First) :=
+ To_Upper (I.Names (J).all (I.Names (J).all'First));
end if;
end if;
J := J + 1;
diff --git a/Ada95/src/terminal_interface-curses-forms-field_types-enumeration.adb b/Ada95/src/terminal_interface-curses-forms-field_types-enumeration.adb
index 8be20f2..8d4c9ce 100644
--- a/Ada95/src/terminal_interface-curses-forms-field_types-enumeration.adb
+++ b/Ada95/src/terminal_interface-curses-forms-field_types-enumeration.adb
@@ -7,7 +7,7 @@
-- B O D Y --
-- --
------------------------------------------------------------------------------
--- Copyright (c) 1998 Free Software Foundation, Inc. --
+-- Copyright (c) 1998-2011,2014 Free Software Foundation, Inc. --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files (the --
@@ -35,7 +35,7 @@
------------------------------------------------------------------------------
-- Author: Juergen Pfeifer, 1996
-- Version Control:
--- $Revision: 1.7 $
+-- $Revision: 1.12 $
-- Binding Version 01.00
------------------------------------------------------------------------------
with Ada.Unchecked_Deallocation;
@@ -63,13 +63,13 @@
if Info.Names (I) = null then
raise Form_Exception;
end if;
- E.Arr (size_t (I)) := New_String (Info.Names (I).all);
+ E.Arr.all (size_t (I)) := New_String (Info.Names (I).all);
if Auto_Release_Names then
S := Info.Names (I);
Release_String (S);
end if;
end loop;
- E.Arr (L) := Null_Ptr;
+ E.Arr.all (L) := Null_Ptr;
return E;
end Create;
@@ -79,40 +79,33 @@
P : chars_ptr;
begin
loop
- P := Enum.Arr (I);
+ P := Enum.Arr.all (I);
exit when P = Null_Ptr;
Free (P);
- Enum.Arr (I) := Null_Ptr;
+ Enum.Arr.all (I) := Null_Ptr;
I := I + 1;
end loop;
Enum.Arr := null;
end Release;
- procedure Set_Field_Type (Fld : in Field;
- Typ : in Enumeration_Field)
+ procedure Set_Field_Type (Fld : Field;
+ Typ : Enumeration_Field)
is
- C_Enum_Type : C_Field_Type;
- pragma Import (C, C_Enum_Type, "TYPE_ENUM");
-
function Set_Fld_Type (F : Field := Fld;
- Cft : C_Field_Type := C_Enum_Type;
Arg1 : chars_ptr_array;
Arg2 : C_Int;
- Arg3 : C_Int) return C_Int;
- pragma Import (C, Set_Fld_Type, "set_field_type");
+ Arg3 : C_Int) return Eti_Error;
+ pragma Import (C, Set_Fld_Type, "set_field_type_enum");
- Res : Eti_Error;
begin
if Typ.Arr = null then
raise Form_Exception;
end if;
- Res := Set_Fld_Type (Arg1 => Typ.Arr.all,
- Arg2 => C_Int (Boolean'Pos (Typ.Case_Sensitive)),
- Arg3 => C_Int (Boolean'Pos
- (Typ.Match_Must_Be_Unique)));
- if Res /= E_Ok then
- Eti_Exception (Res);
- end if;
+ Eti_Exception
+ (Set_Fld_Type
+ (Arg1 => Typ.Arr.all,
+ Arg2 => C_Int (Boolean'Pos (Typ.Case_Sensitive)),
+ Arg3 => C_Int (Boolean'Pos (Typ.Match_Must_Be_Unique))));
Wrap_Builtin (Fld, Typ, C_Choice_Router);
end Set_Field_Type;
diff --git a/Ada95/src/terminal_interface-curses-forms-field_types-enumeration.ads b/Ada95/src/terminal_interface-curses-forms-field_types-enumeration.ads
index 5a7e411..e6924f6 100644
--- a/Ada95/src/terminal_interface-curses-forms-field_types-enumeration.ads
+++ b/Ada95/src/terminal_interface-curses-forms-field_types-enumeration.ads
@@ -7,7 +7,7 @@
-- S P E C --
-- --
------------------------------------------------------------------------------
--- Copyright (c) 1998 Free Software Foundation, Inc. --
+-- 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 --
@@ -35,7 +35,7 @@
------------------------------------------------------------------------------
-- Author: Juergen Pfeifer, 1996
-- Version Control:
--- $Revision: 1.11 $
+-- $Revision: 1.12 $
-- Binding Version 01.00
------------------------------------------------------------------------------
with Interfaces.C.Strings;
@@ -81,8 +81,8 @@
-- The next type defintions are all ncurses extensions. They are typically
-- not available in other curses implementations.
- procedure Set_Field_Type (Fld : in Field;
- Typ : in Enumeration_Field);
+ procedure Set_Field_Type (Fld : Field;
+ Typ : Enumeration_Field);
pragma Inline (Set_Field_Type);
private
diff --git a/Ada95/src/terminal_interface-curses-forms-field_types-intfield.adb b/Ada95/src/terminal_interface-curses-forms-field_types-intfield.adb
index 61d66c4..5ec3305 100644
--- a/Ada95/src/terminal_interface-curses-forms-field_types-intfield.adb
+++ b/Ada95/src/terminal_interface-curses-forms-field_types-intfield.adb
@@ -7,7 +7,7 @@
-- B O D Y --
-- --
------------------------------------------------------------------------------
--- Copyright (c) 1998,2008 Free Software Foundation, Inc. --
+-- Copyright (c) 1998-2011,2014 Free Software Foundation, Inc. --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files (the --
@@ -35,35 +35,27 @@
------------------------------------------------------------------------------
-- Author: Juergen Pfeifer, 1996
-- Version Control:
--- $Revision: 1.9 $
--- $Date: 2008/07/26 18:50:06 $
+-- $Revision: 1.13 $
+-- $Date: 2014/05/24 21:31:05 $
-- Binding Version 01.00
------------------------------------------------------------------------------
with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux;
package body Terminal_Interface.Curses.Forms.Field_Types.IntField is
- procedure Set_Field_Type (Fld : in Field;
- Typ : in Integer_Field)
+ procedure Set_Field_Type (Fld : Field;
+ Typ : Integer_Field)
is
- C_Integer_Field_Type : C_Field_Type;
- pragma Import (C, C_Integer_Field_Type, "TYPE_INTEGER");
-
function Set_Fld_Type (F : Field := Fld;
- Cft : C_Field_Type := C_Integer_Field_Type;
Arg1 : C_Int;
Arg2 : C_Long_Int;
- Arg3 : C_Long_Int) return C_Int;
- pragma Import (C, Set_Fld_Type, "set_field_type");
+ Arg3 : C_Long_Int) return Eti_Error;
+ pragma Import (C, Set_Fld_Type, "set_field_type_integer");
- Res : Eti_Error;
begin
- Res := Set_Fld_Type (Arg1 => C_Int (Typ.Precision),
- Arg2 => C_Long_Int (Typ.Lower_Limit),
- Arg3 => C_Long_Int (Typ.Upper_Limit));
- if Res /= E_Ok then
- Eti_Exception (Res);
- end if;
+ Eti_Exception (Set_Fld_Type (Arg1 => C_Int (Typ.Precision),
+ Arg2 => C_Long_Int (Typ.Lower_Limit),
+ Arg3 => C_Long_Int (Typ.Upper_Limit)));
Wrap_Builtin (Fld, Typ);
end Set_Field_Type;
diff --git a/Ada95/src/terminal_interface-curses-forms-field_types-intfield.ads b/Ada95/src/terminal_interface-curses-forms-field_types-intfield.ads
index b285ca2..e90f0d0 100644
--- a/Ada95/src/terminal_interface-curses-forms-field_types-intfield.ads
+++ b/Ada95/src/terminal_interface-curses-forms-field_types-intfield.ads
@@ -7,7 +7,7 @@
-- S P E C --
-- --
------------------------------------------------------------------------------
--- Copyright (c) 1998 Free Software Foundation, Inc. --
+-- 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 --
@@ -35,7 +35,7 @@
------------------------------------------------------------------------------
-- Author: Juergen Pfeifer, 1996
-- Version Control:
--- $Revision: 1.11 $
+-- $Revision: 1.12 $
-- Binding Version 01.00
------------------------------------------------------------------------------
package Terminal_Interface.Curses.Forms.Field_Types.IntField is
@@ -48,8 +48,8 @@
Upper_Limit : Integer;
end record;
- procedure Set_Field_Type (Fld : in Field;
- Typ : in Integer_Field);
+ 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
index 3d7c5b5..978a47a 100644
--- a/Ada95/src/terminal_interface-curses-forms-field_types-ipv4_address.adb
+++ b/Ada95/src/terminal_interface-curses-forms-field_types-ipv4_address.adb
@@ -7,7 +7,7 @@
-- B O D Y --
-- --
------------------------------------------------------------------------------
--- Copyright (c) 1998,2008 Free Software Foundation, Inc. --
+-- Copyright (c) 1998-2011,2014 Free Software Foundation, Inc. --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files (the --
@@ -35,31 +35,23 @@
------------------------------------------------------------------------------
-- Author: Juergen Pfeifer, 1996
-- Version Control:
--- $Revision: 1.9 $
--- $Date: 2008/07/26 18:49:47 $
+-- $Revision: 1.13 $
+-- $Date: 2014/05/24 21:31:05 $
-- Binding Version 01.00
------------------------------------------------------------------------------
with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux;
package body Terminal_Interface.Curses.Forms.Field_Types.IPV4_Address is
- procedure Set_Field_Type (Fld : in Field;
- Typ : in Internet_V4_Address_Field)
+ procedure Set_Field_Type (Fld : Field;
+ Typ : Internet_V4_Address_Field)
is
- C_IPV4_Field_Type : C_Field_Type;
- pragma Import (C, C_IPV4_Field_Type, "TYPE_IPV4");
+ function Set_Fld_Type (F : Field := Fld)
+ return Eti_Error;
+ pragma Import (C, Set_Fld_Type, "set_field_type_ipv4");
- function Set_Fld_Type (F : Field := Fld;
- Cft : C_Field_Type := C_IPV4_Field_Type)
- return C_Int;
- pragma Import (C, Set_Fld_Type, "set_field_type");
-
- Res : Eti_Error;
begin
- Res := Set_Fld_Type;
- if Res /= E_Ok then
- Eti_Exception (Res);
- end if;
+ Eti_Exception (Set_Fld_Type);
Wrap_Builtin (Fld, Typ);
end Set_Field_Type;
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
index 6d0aef0..af367e7 100644
--- a/Ada95/src/terminal_interface-curses-forms-field_types-ipv4_address.ads
+++ b/Ada95/src/terminal_interface-curses-forms-field_types-ipv4_address.ads
@@ -7,7 +7,7 @@
-- S P E C --
-- --
------------------------------------------------------------------------------
--- Copyright (c) 1998 Free Software Foundation, Inc. --
+-- 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 --
@@ -35,7 +35,7 @@
------------------------------------------------------------------------------
-- Author: Juergen Pfeifer, 1996
-- Version Control:
--- $Revision: 1.11 $
+-- $Revision: 1.12 $
-- Binding Version 01.00
------------------------------------------------------------------------------
package Terminal_Interface.Curses.Forms.Field_Types.IPV4_Address is
@@ -44,8 +44,8 @@
type Internet_V4_Address_Field is new Field_Type with null record;
- procedure Set_Field_Type (Fld : in Field;
- Typ : in Internet_V4_Address_Field);
+ 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
index 79f8489..94e2aa7 100644
--- a/Ada95/src/terminal_interface-curses-forms-field_types-numeric.adb
+++ b/Ada95/src/terminal_interface-curses-forms-field_types-numeric.adb
@@ -7,7 +7,7 @@
-- B O D Y --
-- --
------------------------------------------------------------------------------
--- Copyright (c) 1998,2008 Free Software Foundation, Inc. --
+-- Copyright (c) 1998-2011,2014 Free Software Foundation, Inc. --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files (the --
@@ -35,8 +35,8 @@
------------------------------------------------------------------------------
-- Author: Juergen Pfeifer, 1996
-- Version Control:
--- $Revision: 1.10 $
--- $Date: 2008/07/26 18:49:57 $
+-- $Revision: 1.14 $
+-- $Date: 2014/05/24 21:31:05 $
-- Binding Version 01.00
------------------------------------------------------------------------------
with Interfaces.C;
@@ -44,29 +44,21 @@
package body Terminal_Interface.Curses.Forms.Field_Types.Numeric is
- procedure Set_Field_Type (Fld : in Field;
- Typ : in Numeric_Field)
+ procedure Set_Field_Type (Fld : Field;
+ Typ : Numeric_Field)
is
type Double is new Interfaces.C.double;
- C_Numeric_Field_Type : C_Field_Type;
- pragma Import (C, C_Numeric_Field_Type, "TYPE_NUMERIC");
-
function Set_Fld_Type (F : Field := Fld;
- Cft : C_Field_Type := C_Numeric_Field_Type;
Arg1 : C_Int;
Arg2 : Double;
- Arg3 : Double) return C_Int;
- pragma Import (C, Set_Fld_Type, "set_field_type");
+ Arg3 : Double) return Eti_Error;
+ pragma Import (C, Set_Fld_Type, "set_field_type_numeric");
- Res : Eti_Error;
begin
- Res := Set_Fld_Type (Arg1 => C_Int (Typ.Precision),
- Arg2 => Double (Typ.Lower_Limit),
- Arg3 => Double (Typ.Upper_Limit));
- if Res /= E_Ok then
- Eti_Exception (Res);
- end if;
+ Eti_Exception (Set_Fld_Type (Arg1 => C_Int (Typ.Precision),
+ Arg2 => Double (Typ.Lower_Limit),
+ Arg3 => Double (Typ.Upper_Limit)));
Wrap_Builtin (Fld, Typ);
end Set_Field_Type;
diff --git a/Ada95/src/terminal_interface-curses-forms-field_types-numeric.ads b/Ada95/src/terminal_interface-curses-forms-field_types-numeric.ads
index f211bc8..7c6f9fa 100644
--- a/Ada95/src/terminal_interface-curses-forms-field_types-numeric.ads
+++ b/Ada95/src/terminal_interface-curses-forms-field_types-numeric.ads
@@ -7,7 +7,7 @@
-- S P E C --
-- --
------------------------------------------------------------------------------
--- Copyright (c) 1998 Free Software Foundation, Inc. --
+-- 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 --
@@ -35,7 +35,7 @@
------------------------------------------------------------------------------
-- Author: Juergen Pfeifer, 1996
-- Version Control:
--- $Revision: 1.11 $
+-- $Revision: 1.12 $
-- Binding Version 01.00
------------------------------------------------------------------------------
package Terminal_Interface.Curses.Forms.Field_Types.Numeric is
@@ -48,8 +48,8 @@
Upper_Limit : Float;
end record;
- procedure Set_Field_Type (Fld : in Field;
- Typ : in Numeric_Field);
+ 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
index cbd9e2f..f5ea0db 100644
--- a/Ada95/src/terminal_interface-curses-forms-field_types-regexp.adb
+++ b/Ada95/src/terminal_interface-curses-forms-field_types-regexp.adb
@@ -7,7 +7,7 @@
-- B O D Y --
-- --
------------------------------------------------------------------------------
--- Copyright (c) 1998 Free Software Foundation, Inc. --
+-- Copyright (c) 1998-2011,2014 Free Software Foundation, Inc. --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files (the --
@@ -35,7 +35,7 @@
------------------------------------------------------------------------------
-- Author: Juergen Pfeifer, 1996
-- Version Control:
--- $Revision: 1.8 $
+-- $Revision: 1.12 $
-- Binding Version 01.00
------------------------------------------------------------------------------
with Interfaces.C; use Interfaces.C;
@@ -43,28 +43,15 @@
package body Terminal_Interface.Curses.Forms.Field_Types.RegExp is
- procedure Set_Field_Type (Fld : in Field;
- Typ : in Regular_Expression_Field)
+ procedure Set_Field_Type (Fld : Field;
+ Typ : Regular_Expression_Field)
is
- type Char_Ptr is access all Interfaces.C.char;
-
- C_Regexp_Field_Type : C_Field_Type;
- pragma Import (C, C_Regexp_Field_Type, "TYPE_REGEXP");
-
function Set_Ftyp (F : Field := Fld;
- Cft : C_Field_Type := C_Regexp_Field_Type;
- Arg1 : Char_Ptr) return C_Int;
- pragma Import (C, Set_Ftyp, "set_field_type");
+ Arg1 : char_array) return Eti_Error;
+ pragma Import (C, Set_Ftyp, "set_field_type_regexp");
- Txt : char_array (0 .. Typ.Regular_Expression.all'Length);
- Len : size_t;
- Res : Eti_Error;
begin
- To_C (Typ.Regular_Expression.all, Txt, Len);
- Res := Set_Ftyp (Arg1 => Txt (Txt'First)'Access);
- if Res /= E_Ok then
- Eti_Exception (Res);
- end if;
+ Eti_Exception (Set_Ftyp (Arg1 => To_C (Typ.Regular_Expression.all)));
Wrap_Builtin (Fld, Typ);
end Set_Field_Type;
diff --git a/Ada95/src/terminal_interface-curses-forms-field_types-regexp.ads b/Ada95/src/terminal_interface-curses-forms-field_types-regexp.ads
index 1e451ab..2684138 100644
--- a/Ada95/src/terminal_interface-curses-forms-field_types-regexp.ads
+++ b/Ada95/src/terminal_interface-curses-forms-field_types-regexp.ads
@@ -7,7 +7,7 @@
-- S P E C --
-- --
------------------------------------------------------------------------------
--- Copyright (c) 1998 Free Software Foundation, Inc. --
+-- 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 --
@@ -35,7 +35,7 @@
------------------------------------------------------------------------------
-- Author: Juergen Pfeifer, 1996
-- Version Control:
--- $Revision: 1.11 $
+-- $Revision: 1.12 $
-- Binding Version 01.00
------------------------------------------------------------------------------
package Terminal_Interface.Curses.Forms.Field_Types.RegExp is
@@ -48,8 +48,8 @@
Regular_Expression : String_Access;
end record;
- procedure Set_Field_Type (Fld : in Field;
- Typ : in Regular_Expression_Field);
+ 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
index f26a42c..8414cd0 100644
--- a/Ada95/src/terminal_interface-curses-forms-field_types-user-choice.adb
+++ b/Ada95/src/terminal_interface-curses-forms-field_types-user-choice.adb
@@ -7,7 +7,7 @@
-- B O D Y --
-- --
------------------------------------------------------------------------------
--- Copyright (c) 1998-2006,2008 Free Software Foundation, Inc. --
+-- Copyright (c) 1998-2011,2014 Free Software Foundation, Inc. --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files (the --
@@ -35,42 +35,40 @@
------------------------------------------------------------------------------
-- Author: Juergen Pfeifer, 1996
-- Version Control:
--- $Revision: 1.15 $
--- $Date: 2008/07/26 18:48:58 $
+-- $Revision: 1.20 $
+-- $Date: 2014/05/24 21:31:05 $
-- Binding Version 01.00
------------------------------------------------------------------------------
-with Ada.Unchecked_Conversion;
+with System.Address_To_Access_Conversions;
with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux;
package body Terminal_Interface.Curses.Forms.Field_Types.User.Choice is
- pragma Warnings (Off);
- function To_Argument_Access is new Ada.Unchecked_Conversion
- (System.Address, Argument_Access);
- pragma Warnings (On);
+ package Argument_Conversions is
+ new System.Address_To_Access_Conversions (Argument);
function Generic_Next (Fld : Field;
- Usr : System.Address) return C_Int
+ Usr : System.Address) return Curses_Bool
is
Result : Boolean;
Udf : constant User_Defined_Field_Type_With_Choice_Access :=
User_Defined_Field_Type_With_Choice_Access
- (To_Argument_Access (Usr).Typ);
+ (Argument_Access (Argument_Conversions.To_Pointer (Usr)).all.Typ);
begin
Result := Next (Fld, Udf.all);
- return C_Int (Boolean'Pos (Result));
+ return Curses_Bool (Boolean'Pos (Result));
end Generic_Next;
function Generic_Prev (Fld : Field;
- Usr : System.Address) return C_Int
+ Usr : System.Address) return Curses_Bool
is
Result : Boolean;
Udf : constant User_Defined_Field_Type_With_Choice_Access :=
User_Defined_Field_Type_With_Choice_Access
- (To_Argument_Access (Usr).Typ);
+ (Argument_Access (Argument_Conversions.To_Pointer (Usr)).all.Typ);
begin
Result := Previous (Fld, Udf.all);
- return C_Int (Boolean'Pos (Result));
+ return Curses_Bool (Boolean'Pos (Result));
end Generic_Prev;
-- -----------------------------------------------------------------------
@@ -90,16 +88,12 @@
Make_Arg'Access,
Copy_Arg'Access,
Free_Arg'Access);
- if Res /= E_Ok then
- Eti_Exception (Res);
- end if;
+ Eti_Exception (Res);
Res := Set_Fieldtype_Choice (T,
Generic_Next'Access,
Generic_Prev'Access);
- if Res /= E_Ok then
- Eti_Exception (Res);
- end if;
+ Eti_Exception (Res);
end if;
M_Generic_Choice := T;
end if;
diff --git a/Ada95/src/terminal_interface-curses-forms-field_types-user-choice.ads b/Ada95/src/terminal_interface-curses-forms-field_types-user-choice.ads
index 1e69f43..5b132c9 100644
--- a/Ada95/src/terminal_interface-curses-forms-field_types-user-choice.ads
+++ b/Ada95/src/terminal_interface-curses-forms-field_types-user-choice.ads
@@ -7,7 +7,7 @@
-- S P E C --
-- --
------------------------------------------------------------------------------
--- Copyright (c) 1998,2008 Free Software Foundation, Inc. --
+-- Copyright (c) 1998-2008,2011 Free Software Foundation, Inc. --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files (the --
@@ -35,8 +35,8 @@
------------------------------------------------------------------------------
-- Author: Juergen Pfeifer, 1996
-- Version Control:
--- $Revision: 1.12 $
--- $Date: 2008/07/26 18:49:20 $
+-- $Revision: 1.14 $
+-- $Date: 2011/03/19 12:27:47 $
-- Binding Version 01.00
------------------------------------------------------------------------------
with Interfaces.C;
@@ -78,17 +78,17 @@
function C_Generic_Choice return C_Field_Type;
function Generic_Next (Fld : Field;
- Usr : System.Address) return C_Int;
+ Usr : System.Address) return Curses_Bool;
pragma Convention (C, Generic_Next);
-- This is the generic next Choice_Function for the low-level fieldtype
- -- representing all the User_Defined_Field_Type derivates. It routes
+ -- representing all the User_Defined_Field_Type derivatives. It routes
-- the call to the Next implementation for the type.
function Generic_Prev (Fld : Field;
- Usr : System.Address) return C_Int;
+ Usr : System.Address) return Curses_Bool;
pragma Convention (C, Generic_Prev);
-- This is the generic prev Choice_Function for the low-level fieldtype
- -- representing all the User_Defined_Field_Type derivates. It routes
+ -- representing all the User_Defined_Field_Type derivatives. It routes
-- the call to the Previous implementation for the type.
end Terminal_Interface.Curses.Forms.Field_Types.User.Choice;
diff --git a/Ada95/src/terminal_interface-curses-forms-field_types-user.adb b/Ada95/src/terminal_interface-curses-forms-field_types-user.adb
index 0b4c136..98bcd24 100644
--- a/Ada95/src/terminal_interface-curses-forms-field_types-user.adb
+++ b/Ada95/src/terminal_interface-curses-forms-field_types-user.adb
@@ -7,7 +7,7 @@
-- B O D Y --
-- --
------------------------------------------------------------------------------
--- Copyright (c) 1998-2006,2008 Free Software Foundation, Inc. --
+-- Copyright (c) 1998-2011,2014 Free Software Foundation, Inc. --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files (the --
@@ -35,17 +35,17 @@
------------------------------------------------------------------------------
-- Author: Juergen Pfeifer, 1996
-- Version Control:
--- $Revision: 1.15 $
--- $Date: 2008/07/26 18:49:28 $
+-- $Revision: 1.23 $
+-- $Date: 2014/05/24 21:31:05 $
-- Binding Version 01.00
------------------------------------------------------------------------------
-with Ada.Unchecked_Conversion;
+with System.Address_To_Access_Conversions;
with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux;
package body Terminal_Interface.Curses.Forms.Field_Types.User is
- procedure Set_Field_Type (Fld : in Field;
- Typ : in User_Defined_Field_Type)
+ procedure Set_Field_Type (Fld : Field;
+ Typ : User_Defined_Field_Type)
is
function Allocate_Arg (T : User_Defined_Field_Type'Class)
return Argument_Access;
@@ -53,10 +53,8 @@
function Set_Fld_Type (F : Field := Fld;
Cft : C_Field_Type := C_Generic_Type;
Arg1 : Argument_Access)
- return C_Int;
- pragma Import (C, Set_Fld_Type, "set_field_type");
-
- Res : Eti_Error;
+ return Eti_Error;
+ pragma Import (C, Set_Fld_Type, "set_field_type_user");
function Allocate_Arg (T : User_Defined_Field_Type'Class)
return Argument_Access
@@ -70,37 +68,34 @@
end Allocate_Arg;
begin
- Res := Set_Fld_Type (Arg1 => Allocate_Arg (Typ));
- if Res /= E_Ok then
- Eti_Exception (Res);
- end if;
+ Eti_Exception (Set_Fld_Type (Arg1 => Allocate_Arg (Typ)));
end Set_Field_Type;
- pragma Warnings (Off);
- function To_Argument_Access is new Ada.Unchecked_Conversion
- (System.Address, Argument_Access);
- pragma Warnings (On);
+ package Argument_Conversions is
+ new System.Address_To_Access_Conversions (Argument);
function Generic_Field_Check (Fld : Field;
- Usr : System.Address) return C_Int
+ Usr : System.Address) return Curses_Bool
is
Result : Boolean;
Udf : constant User_Defined_Field_Type_Access :=
- User_Defined_Field_Type_Access (To_Argument_Access (Usr).Typ);
+ User_Defined_Field_Type_Access
+ (Argument_Access (Argument_Conversions.To_Pointer (Usr)).all.Typ);
begin
Result := Field_Check (Fld, Udf.all);
- return C_Int (Boolean'Pos (Result));
+ return Curses_Bool (Boolean'Pos (Result));
end Generic_Field_Check;
function Generic_Char_Check (Ch : C_Int;
- Usr : System.Address) return C_Int
+ Usr : System.Address) return Curses_Bool
is
Result : Boolean;
Udf : constant User_Defined_Field_Type_Access :=
- User_Defined_Field_Type_Access (To_Argument_Access (Usr).Typ);
+ User_Defined_Field_Type_Access
+ (Argument_Access (Argument_Conversions.To_Pointer (Usr)).all.Typ);
begin
Result := Character_Check (Character'Val (Ch), Udf.all);
- return C_Int (Boolean'Pos (Result));
+ return Curses_Bool (Boolean'Pos (Result));
end Generic_Char_Check;
-- -----------------------------------------------------------------------
@@ -120,9 +115,7 @@
Make_Arg'Access,
Copy_Arg'Access,
Free_Arg'Access);
- if Res /= E_Ok then
- Eti_Exception (Res);
- end if;
+ Eti_Exception (Res);
end if;
M_Generic_Type := T;
end if;
diff --git a/Ada95/src/terminal_interface-curses-forms-field_types-user.ads b/Ada95/src/terminal_interface-curses-forms-field_types-user.ads
index acec636..7000fce 100644
--- a/Ada95/src/terminal_interface-curses-forms-field_types-user.ads
+++ b/Ada95/src/terminal_interface-curses-forms-field_types-user.ads
@@ -7,7 +7,7 @@
-- S P E C --
-- --
------------------------------------------------------------------------------
--- Copyright (c) 1998,2008 Free Software Foundation, Inc. --
+-- Copyright (c) 1998-2009,2011 Free Software Foundation, Inc. --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files (the --
@@ -35,8 +35,8 @@
------------------------------------------------------------------------------
-- Author: Juergen Pfeifer, 1996
-- Version Control:
--- $Revision: 1.12 $
--- $Date: 2008/07/26 18:49:38 $
+-- $Revision: 1.15 $
+-- $Date: 2011/03/19 12:27:21 $
-- Binding Version 01.00
------------------------------------------------------------------------------
with Interfaces.C;
@@ -67,8 +67,8 @@
-- If True is returned, the character is considered as valid for the
-- field, otherwise as invalid.
- procedure Set_Field_Type (Fld : in Field;
- Typ : in User_Defined_Field_Type);
+ 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.
@@ -79,17 +79,17 @@
function C_Generic_Type return C_Field_Type;
function Generic_Field_Check (Fld : Field;
- Usr : System.Address) return C_Int;
+ Usr : System.Address) return Curses_Bool;
pragma Convention (C, Generic_Field_Check);
-- This is the generic Field_Check_Function for the low-level fieldtype
- -- representing all the User_Defined_Field_Type derivates. It routes
+ -- representing all the User_Defined_Field_Type derivatives. It routes
-- the call to the Field_Check implementation for the type.
function Generic_Char_Check (Ch : C_Int;
- Usr : System.Address) return C_Int;
+ Usr : System.Address) return Curses_Bool;
pragma Convention (C, Generic_Char_Check);
-- This is the generic Char_Check_Function for the low-level fieldtype
- -- representing all the User_Defined_Field_Type derivates. It routes
+ -- representing all the User_Defined_Field_Type derivatives. It routes
-- the call to the Character_Check implementation for the type.
end Terminal_Interface.Curses.Forms.Field_Types.User;
diff --git a/Ada95/src/terminal_interface-curses-forms-field_types.adb b/Ada95/src/terminal_interface-curses-forms-field_types.adb
index c681c80..bda6e51 100644
--- a/Ada95/src/terminal_interface-curses-forms-field_types.adb
+++ b/Ada95/src/terminal_interface-curses-forms-field_types.adb
@@ -7,7 +7,7 @@
-- B O D Y --
-- --
------------------------------------------------------------------------------
--- Copyright (c) 1998-2006,2008 Free Software Foundation, Inc. --
+-- Copyright (c) 1998-2011,2014 Free Software Foundation, Inc. --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files (the --
@@ -35,13 +35,14 @@
------------------------------------------------------------------------------
-- Author: Juergen Pfeifer, 1996
-- Version Control:
--- $Revision: 1.20 $
--- $Date: 2008/07/26 18:50:33 $
+-- $Revision: 1.28 $
+-- $Date: 2014/09/13 19:00:47 $
-- Binding Version 01.00
------------------------------------------------------------------------------
with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux;
with Ada.Unchecked_Deallocation;
-with Ada.Unchecked_Conversion;
+with System.Address_To_Access_Conversions;
+
-- |
-- |=====================================================================
-- | man page form_fieldtype.3x
@@ -51,10 +52,8 @@
use type System.Address;
- pragma Warnings (Off);
- function To_Argument_Access is new Ada.Unchecked_Conversion
- (System.Address, Argument_Access);
- pragma Warnings (On);
+ package Argument_Conversions is
+ new System.Address_To_Access_Conversions (Argument);
function Get_Fieldtype (F : Field) return C_Field_Type;
pragma Import (C, Get_Fieldtype, "field_type");
@@ -68,7 +67,7 @@
-- |
-- |
-- |
- function Get_Type (Fld : in Field) return Field_Type_Access
+ function Get_Type (Fld : Field) return Field_Type_Access
is
Low_Level : constant C_Field_Type := Get_Fieldtype (Fld);
Arg : Argument_Access;
@@ -77,14 +76,16 @@
return null;
else
if Low_Level = M_Builtin_Router or else
- Low_Level = M_Generic_Type or else
- Low_Level = M_Choice_Router or else
- Low_Level = M_Generic_Choice then
- Arg := To_Argument_Access (Get_Arg (Fld));
+ 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.Typ;
+ return Arg.all.Typ;
end if;
else
raise Form_Exception;
@@ -92,49 +93,32 @@
end if;
end Get_Type;
- function Make_Arg (Args : System.Address) return System.Address
- is
- -- Actually args is a double indirected pointer to the arguments
- -- of a C variable argument list. In theory it is now quite
- -- complicated to write portable routine that reads the arguments,
- -- because one has to know the growth direction of the stack and
- -- the sizes of the individual arguments.
- -- Fortunately we are only interested in the first argument (#0),
- -- we know its size and for the first arg we don't care about
- -- into which stack direction we have to proceed. We simply
- -- resolve the double indirection and thats it.
- type V is access all System.Address;
- function To_Access is new Ada.Unchecked_Conversion (System.Address,
- V);
- begin
- return To_Access (To_Access (Args).all).all;
- end Make_Arg;
-
function Copy_Arg (Usr : System.Address) return System.Address
is
begin
return Usr;
end Copy_Arg;
- procedure Free_Arg (Usr : in System.Address)
+ procedure Free_Arg (Usr : System.Address)
is
procedure Free_Type is new Ada.Unchecked_Deallocation
(Field_Type'Class, Field_Type_Access);
procedure Freeargs is new Ada.Unchecked_Deallocation
(Argument, Argument_Access);
- To_Be_Free : Argument_Access := To_Argument_Access (Usr);
+ To_Be_Free : Argument_Access
+ := Argument_Access (Argument_Conversions.To_Pointer (Usr));
Low_Level : C_Field_Type;
begin
if To_Be_Free /= null then
- if To_Be_Free.Usr /= System.Null_Address then
- Low_Level := To_Be_Free.Cft;
- if Low_Level.Freearg /= null then
- Low_Level.Freearg (To_Be_Free.Usr);
+ if To_Be_Free.all.Usr /= System.Null_Address then
+ Low_Level := To_Be_Free.all.Cft;
+ if Low_Level.all.Freearg /= null then
+ Low_Level.all.Freearg (To_Be_Free.all.Usr);
end if;
end if;
- if To_Be_Free.Typ /= null then
- Free_Type (To_Be_Free.Typ);
+ if To_Be_Free.all.Typ /= null then
+ Free_Type (To_Be_Free.all.Typ);
end if;
Freeargs (To_Be_Free);
end if;
@@ -147,11 +131,10 @@
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");
+ Arg1 : Argument_Access) return Eti_Error;
+ pragma Import (C, Set_Fld_Type, "set_field_type_user");
begin
pragma Assert (Low_Level /= Null_Field_Type);
@@ -162,71 +145,72 @@
Typ => new Field_Type'Class'(Typ),
Cft => Get_Fieldtype (Fld));
if Usr_Arg /= System.Null_Address then
- if Low_Level.Copyarg /= null then
- Arg.Usr := Low_Level.Copyarg (Usr_Arg);
+ if Low_Level.all.Copyarg /= null then
+ Arg.all.Usr := Low_Level.all.Copyarg (Usr_Arg);
else
- Arg.Usr := Usr_Arg;
+ Arg.all.Usr := Usr_Arg;
end if;
end if;
- Res := Set_Fld_Type (Arg1 => Arg);
- if Res /= E_Ok then
- Eti_Exception (Res);
- end if;
+ Eti_Exception (Set_Fld_Type (Arg1 => Arg));
end if;
end Wrap_Builtin;
function Field_Check_Router (Fld : Field;
- Usr : System.Address) return C_Int
+ Usr : System.Address) return Curses_Bool
is
- Arg : constant Argument_Access := To_Argument_Access (Usr);
+ Arg : constant Argument_Access
+ := Argument_Access (Argument_Conversions.To_Pointer (Usr));
begin
- pragma Assert (Arg /= null and then Arg.Cft /= Null_Field_Type
- and then Arg.Typ /= null);
- if Arg.Cft.Fcheck /= null then
- return Arg.Cft.Fcheck (Fld, Arg.Usr);
+ pragma Assert (Arg /= null and then Arg.all.Cft /= Null_Field_Type
+ and then Arg.all.Typ /= null);
+ if Arg.all.Cft.all.Fcheck /= null then
+ return Arg.all.Cft.all.Fcheck (Fld, Arg.all.Usr);
else
return 1;
end if;
end Field_Check_Router;
function Char_Check_Router (Ch : C_Int;
- Usr : System.Address) return C_Int
+ Usr : System.Address) return Curses_Bool
is
- Arg : constant Argument_Access := To_Argument_Access (Usr);
+ Arg : constant Argument_Access
+ := Argument_Access (Argument_Conversions.To_Pointer (Usr));
begin
- pragma Assert (Arg /= null and then Arg.Cft /= Null_Field_Type
- and then Arg.Typ /= null);
- if Arg.Cft.Ccheck /= null then
- return Arg.Cft.Ccheck (Ch, Arg.Usr);
+ pragma Assert (Arg /= null and then Arg.all.Cft /= Null_Field_Type
+ and then Arg.all.Typ /= null);
+ if Arg.all.Cft.all.Ccheck /= null then
+ return Arg.all.Cft.all.Ccheck (Ch, Arg.all.Usr);
else
return 1;
end if;
end Char_Check_Router;
function Next_Router (Fld : Field;
- Usr : System.Address) return C_Int
+ Usr : System.Address) return Curses_Bool
is
- Arg : constant Argument_Access := To_Argument_Access (Usr);
+ Arg : constant Argument_Access
+ := Argument_Access (Argument_Conversions.To_Pointer (Usr));
begin
- pragma Assert (Arg /= null and then Arg.Cft /= Null_Field_Type
- and then Arg.Typ /= null);
- if Arg.Cft.Next /= null then
- return Arg.Cft.Next (Fld, Arg.Usr);
+ pragma Assert (Arg /= null and then Arg.all.Cft /= Null_Field_Type
+ and then Arg.all.Typ /= null);
+ if Arg.all.Cft.all.Next /= null then
+ return Arg.all.Cft.all.Next (Fld, Arg.all.Usr);
else
return 1;
end if;
end Next_Router;
function Prev_Router (Fld : Field;
- Usr : System.Address) return C_Int
+ Usr : System.Address) return Curses_Bool
is
- Arg : constant Argument_Access := To_Argument_Access (Usr);
+ Arg : constant Argument_Access :=
+ Argument_Access (Argument_Conversions.To_Pointer (Usr));
begin
- pragma Assert (Arg /= null and then Arg.Cft /= Null_Field_Type
- and then Arg.Typ /= null);
- if Arg.Cft.Prev /= null then
- return Arg.Cft.Prev (Fld, Arg.Usr);
+ pragma Assert (Arg /= null and then Arg.all.Cft /= Null_Field_Type
+ and then Arg.all.Typ /= null);
+ if Arg.all.Cft.all.Prev /= null then
+ return Arg.all.Cft.all.Prev (Fld, Arg.all.Usr);
else
return 1;
end if;
@@ -236,7 +220,6 @@
--
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
@@ -245,13 +228,10 @@
if T = Null_Field_Type then
raise Form_Exception;
else
- Res := Set_Fieldtype_Arg (T,
- Make_Arg'Access,
- Copy_Arg'Access,
- Free_Arg'Access);
- if Res /= E_Ok then
- Eti_Exception (Res);
- end if;
+ Eti_Exception (Set_Fieldtype_Arg (T,
+ Make_Arg'Access,
+ Copy_Arg'Access,
+ Free_Arg'Access));
end if;
M_Builtin_Router := T;
end if;
@@ -263,7 +243,6 @@
--
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
@@ -272,20 +251,14 @@
if T = Null_Field_Type then
raise Form_Exception;
else
- Res := Set_Fieldtype_Arg (T,
- Make_Arg'Access,
- Copy_Arg'Access,
- Free_Arg'Access);
- if Res /= E_Ok then
- Eti_Exception (Res);
- end if;
+ Eti_Exception (Set_Fieldtype_Arg (T,
+ Make_Arg'Access,
+ Copy_Arg'Access,
+ Free_Arg'Access));
- Res := Set_Fieldtype_Choice (T,
- Next_Router'Access,
- Prev_Router'Access);
- if Res /= E_Ok then
- Eti_Exception (Res);
- end if;
+ Eti_Exception (Set_Fieldtype_Choice (T,
+ Next_Router'Access,
+ Prev_Router'Access));
end if;
M_Choice_Router := T;
end if;
diff --git a/Ada95/src/terminal_interface-curses-forms-field_user_data.adb b/Ada95/src/terminal_interface-curses-forms-field_user_data.adb
index 817ebe5..2497614 100644
--- a/Ada95/src/terminal_interface-curses-forms-field_user_data.adb
+++ b/Ada95/src/terminal_interface-curses-forms-field_user_data.adb
@@ -7,7 +7,7 @@
-- B O D Y --
-- --
------------------------------------------------------------------------------
--- Copyright (c) 1998 Free Software Foundation, Inc. --
+-- Copyright (c) 1998-2009,2014 Free Software Foundation, Inc. --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files (the --
@@ -35,7 +35,7 @@
------------------------------------------------------------------------------
-- Author: Juergen Pfeifer, 1996
-- Version Control:
--- $Revision: 1.12 $
+-- $Revision: 1.15 $
-- Binding Version 01.00
------------------------------------------------------------------------------
with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux;
@@ -51,23 +51,20 @@
-- |
use type Interfaces.C.int;
- procedure Set_User_Data (Fld : in Field;
- Data : in User_Access)
+ procedure Set_User_Data (Fld : Field;
+ Data : User_Access)
is
function Set_Field_Userptr (Fld : Field;
- Usr : User_Access) return C_Int;
+ Usr : User_Access) return Eti_Error;
pragma Import (C, Set_Field_Userptr, "set_field_userptr");
- Res : constant Eti_Error := Set_Field_Userptr (Fld, Data);
begin
- if Res /= E_Ok then
- Eti_Exception (Res);
- end if;
+ Eti_Exception (Set_Field_Userptr (Fld, Data));
end Set_User_Data;
-- |
-- |
-- |
- function Get_User_Data (Fld : in Field) return User_Access
+ 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");
@@ -75,7 +72,7 @@
return Field_Userptr (Fld);
end Get_User_Data;
- procedure Get_User_Data (Fld : in Field;
+ procedure Get_User_Data (Fld : Field;
Data : out User_Access)
is
begin
diff --git a/Ada95/src/terminal_interface-curses-forms-form_user_data.adb b/Ada95/src/terminal_interface-curses-forms-form_user_data.adb
index 50c6708..a8b7464 100644
--- a/Ada95/src/terminal_interface-curses-forms-form_user_data.adb
+++ b/Ada95/src/terminal_interface-curses-forms-form_user_data.adb
@@ -7,7 +7,7 @@
-- B O D Y --
-- --
------------------------------------------------------------------------------
--- Copyright (c) 1998 Free Software Foundation, Inc. --
+-- Copyright (c) 1998-2009,2014 Free Software Foundation, Inc. --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files (the --
@@ -35,7 +35,7 @@
------------------------------------------------------------------------------
-- Author: Juergen Pfeifer, 1996
-- Version Control:
--- $Revision: 1.12 $
+-- $Revision: 1.15 $
-- Binding Version 01.00
------------------------------------------------------------------------------
-- |
@@ -52,23 +52,20 @@
-- |
-- |
-- |
- procedure Set_User_Data (Frm : in Form;
- Data : in User_Access)
+ procedure Set_User_Data (Frm : Form;
+ Data : User_Access)
is
function Set_Form_Userptr (Frm : Form;
- Data : User_Access) return C_Int;
+ Data : User_Access) return Eti_Error;
pragma Import (C, Set_Form_Userptr, "set_form_userptr");
- Res : constant Eti_Error := Set_Form_Userptr (Frm, Data);
begin
- if Res /= E_Ok then
- Eti_Exception (Res);
- end if;
+ Eti_Exception (Set_Form_Userptr (Frm, Data));
end Set_User_Data;
-- |
-- |
-- |
- function Get_User_Data (Frm : in Form) return User_Access
+ 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");
@@ -76,7 +73,7 @@
return Form_Userptr (Frm);
end Get_User_Data;
- procedure Get_User_Data (Frm : in Form;
+ procedure Get_User_Data (Frm : Form;
Data : out User_Access)
is
begin
diff --git a/Ada95/src/terminal_interface-curses-forms.adb b/Ada95/src/terminal_interface-curses-forms.adb
index 8b01e16..3ed053a 100644
--- a/Ada95/src/terminal_interface-curses-forms.adb
+++ b/Ada95/src/terminal_interface-curses-forms.adb
@@ -7,7 +7,7 @@
-- B O D Y --
-- --
------------------------------------------------------------------------------
--- Copyright (c) 1998-2004,2008 Free Software Foundation, Inc. --
+-- Copyright (c) 1998-2011,2014 Free Software Foundation, Inc. --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files (the --
@@ -35,12 +35,11 @@
------------------------------------------------------------------------------
-- Author: Juergen Pfeifer, 1996
-- Version Control:
--- $Revision: 1.26 $
--- $Date: 2008/07/26 18:50:44 $
+-- $Revision: 1.32 $
+-- $Date: 2014/05/24 21:31:05 $
-- Binding Version 01.00
------------------------------------------------------------------------------
with Ada.Unchecked_Deallocation;
-with Ada.Unchecked_Conversion;
with Interfaces.C; use Interfaces.C;
with Interfaces.C.Strings; use Interfaces.C.Strings;
@@ -62,23 +61,7 @@
-- |
-- subtype chars_ptr is Interfaces.C.Strings.chars_ptr;
- function FOS_2_CInt is new
- Ada.Unchecked_Conversion (Field_Option_Set,
- C_Int);
-
- function CInt_2_FOS is new
- Ada.Unchecked_Conversion (C_Int,
- Field_Option_Set);
-
- function FrmOS_2_CInt is new
- Ada.Unchecked_Conversion (Form_Option_Set,
- C_Int);
-
- function CInt_2_FrmOS is new
- Ada.Unchecked_Conversion (C_Int,
- Form_Option_Set);
-
- procedure Request_Name (Key : in Form_Request_Code;
+ procedure Request_Name (Key : Form_Request_Code;
Name : out String)
is
function Form_Request_Name (Key : C_Int) return chars_ptr;
@@ -130,15 +113,11 @@
-- |
procedure Delete (Fld : in out Field)
is
- function Free_Field (Fld : Field) return C_Int;
+ function Free_Field (Fld : Field) return Eti_Error;
pragma Import (C, Free_Field, "free_field");
- Res : Eti_Error;
begin
- Res := Free_Field (Fld);
- if Res /= E_Ok then
- Eti_Exception (Res);
- end if;
+ Eti_Exception (Free_Field (Fld));
Fld := Null_Field;
end Delete;
-- |
@@ -190,20 +169,16 @@
-- |
-- |
-- |
- procedure Set_Justification (Fld : in Field;
- Just : in Field_Justification := None)
+ procedure Set_Justification (Fld : Field;
+ Just : Field_Justification := None)
is
function Set_Field_Just (Fld : Field;
- Just : C_Int) return C_Int;
+ Just : C_Int) return Eti_Error;
pragma Import (C, Set_Field_Just, "set_field_just");
- Res : constant Eti_Error :=
- Set_Field_Just (Fld,
- C_Int (Field_Justification'Pos (Just)));
begin
- if Res /= E_Ok then
- Eti_Exception (Res);
- end if;
+ Eti_Exception (Set_Field_Just (Fld,
+ C_Int (Field_Justification'Pos (Just))));
end Set_Justification;
-- |
-- |
@@ -223,33 +198,25 @@
-- |
-- |
procedure Set_Buffer
- (Fld : in Field;
- Buffer : in Buffer_Number := Buffer_Number'First;
- Str : in String)
+ (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;
+ S : char_array)
+ return Eti_Error;
pragma Import (C, Set_Fld_Buffer, "set_field_buffer");
- Txt : char_array (0 .. Str'Length);
- Len : size_t;
- Res : Eti_Error;
begin
- To_C (Str, Txt, Len);
- Res := Set_Fld_Buffer (Fld, C_Int (Buffer), Txt (Txt'First)'Access);
- if Res /= E_Ok then
- Eti_Exception (Res);
- end if;
+ Eti_Exception (Set_Fld_Buffer (Fld, C_Int (Buffer), To_C (Str)));
end Set_Buffer;
-- |
-- |
-- |
procedure Get_Buffer
- (Fld : in Field;
- Buffer : in Buffer_Number := Buffer_Number'First;
+ (Fld : Field;
+ Buffer : Buffer_Number := Buffer_Number'First;
Str : out String)
is
function Field_Buffer (Fld : Field;
@@ -260,8 +227,8 @@
end Get_Buffer;
function Get_Buffer
- (Fld : in Field;
- Buffer : in Buffer_Number := Buffer_Number'First) return String
+ (Fld : Field;
+ Buffer : Buffer_Number := Buffer_Number'First) return String
is
function Field_Buffer (Fld : Field;
B : C_Int) return chars_ptr;
@@ -272,16 +239,15 @@
-- |
-- |
-- |
- procedure Set_Status (Fld : in Field;
- Status : in Boolean := True)
+ procedure Set_Status (Fld : Field;
+ Status : Boolean := True)
is
function Set_Fld_Status (Fld : Field;
- St : C_Int) return C_Int;
+ St : C_Int) return Eti_Error;
pragma Import (C, Set_Fld_Status, "set_field_status");
- Res : constant Eti_Error := Set_Fld_Status (Fld, Boolean'Pos (Status));
begin
- if Res /= E_Ok then
+ if Set_Fld_Status (Fld, Boolean'Pos (Status)) /= E_Ok then
raise Form_Exception;
end if;
end Set_Status;
@@ -304,18 +270,15 @@
-- |
-- |
-- |
- procedure Set_Maximum_Size (Fld : in Field;
- Max : in Natural := 0)
+ procedure Set_Maximum_Size (Fld : Field;
+ Max : Natural := 0)
is
function Set_Field_Max (Fld : Field;
- M : C_Int) return C_Int;
+ M : C_Int) return Eti_Error;
pragma Import (C, Set_Field_Max, "set_max_field");
- Res : constant Eti_Error := Set_Field_Max (Fld, C_Int (Max));
begin
- if Res /= E_Ok then
- Eti_Exception (Res);
- end if;
+ Eti_Exception (Set_Field_Max (Fld, C_Int (Max)));
end Set_Maximum_Size;
-- |
-- |=====================================================================
@@ -324,59 +287,48 @@
-- |
-- |
-- |
- procedure Set_Options (Fld : in Field;
- Options : in Field_Option_Set)
+ procedure Set_Options (Fld : Field;
+ Options : Field_Option_Set)
is
function Set_Field_Opts (Fld : Field;
- Opt : C_Int) return C_Int;
+ Opt : Field_Option_Set) return Eti_Error;
pragma Import (C, Set_Field_Opts, "set_field_opts");
- Opt : constant C_Int := FOS_2_CInt (Options);
- Res : Eti_Error;
begin
- Res := Set_Field_Opts (Fld, Opt);
- if Res /= E_Ok then
- Eti_Exception (Res);
- end if;
+ Eti_Exception (Set_Field_Opts (Fld, Options));
end Set_Options;
-- |
-- |
-- |
- procedure Switch_Options (Fld : in Field;
- Options : in Field_Option_Set;
+ 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;
+ Opt : Field_Option_Set) return Eti_Error;
pragma Import (C, Field_Opts_On, "field_opts_on");
function Field_Opts_Off (Fld : Field;
- Opt : C_Int) return C_Int;
+ Opt : Field_Option_Set) return Eti_Error;
pragma Import (C, Field_Opts_Off, "field_opts_off");
- Err : Eti_Error;
- Opt : constant C_Int := FOS_2_CInt (Options);
begin
if On then
- Err := Field_Opts_On (Fld, Opt);
+ Eti_Exception (Field_Opts_On (Fld, Options));
else
- Err := Field_Opts_Off (Fld, Opt);
- end if;
- if Err /= E_Ok then
- Eti_Exception (Err);
+ Eti_Exception (Field_Opts_Off (Fld, Options));
end if;
end Switch_Options;
-- |
-- |
-- |
- procedure Get_Options (Fld : in Field;
+ procedure Get_Options (Fld : Field;
Options : out Field_Option_Set)
is
- function Field_Opts (Fld : Field) return C_Int;
+ function Field_Opts (Fld : Field) return Field_Option_Set;
pragma Import (C, Field_Opts, "field_opts");
- Res : constant C_Int := Field_Opts (Fld);
begin
- Options := CInt_2_FOS (Res);
+ Options := Field_Opts (Fld);
end Get_Options;
-- |
-- |
@@ -397,111 +349,98 @@
-- |
-- |
procedure Set_Foreground
- (Fld : in Field;
- Fore : in Character_Attribute_Set := Normal_Video;
- Color : in Color_Pair := Color_Pair'First)
+ (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;
+ Attr : Attributed_Character) return Eti_Error;
pragma Import (C, Set_Field_Fore, "set_field_fore");
- Ch : constant Attributed_Character := (Ch => Character'First,
- Color => Color,
- Attr => Fore);
- Res : constant Eti_Error :=
- Set_Field_Fore (Fld, AttrChar_To_Chtype (Ch));
begin
- if Res /= E_Ok then
- Eti_Exception (Res);
- end if;
+ Eti_Exception (Set_Field_Fore (Fld, (Ch => Character'First,
+ Color => Color,
+ Attr => Fore)));
end Set_Foreground;
-- |
-- |
-- |
- procedure Foreground (Fld : in Field;
+ procedure Foreground (Fld : Field;
Fore : out Character_Attribute_Set)
is
- function Field_Fore (Fld : Field) return C_Chtype;
+ function Field_Fore (Fld : Field) return Attributed_Character;
pragma Import (C, Field_Fore, "field_fore");
begin
- Fore := Chtype_To_AttrChar (Field_Fore (Fld)).Attr;
+ Fore := Field_Fore (Fld).Attr;
end Foreground;
- procedure Foreground (Fld : in Field;
+ procedure Foreground (Fld : Field;
Fore : out Character_Attribute_Set;
Color : out Color_Pair)
is
- function Field_Fore (Fld : Field) return C_Chtype;
+ function Field_Fore (Fld : Field) return Attributed_Character;
pragma Import (C, Field_Fore, "field_fore");
begin
- Fore := Chtype_To_AttrChar (Field_Fore (Fld)).Attr;
- Color := Chtype_To_AttrChar (Field_Fore (Fld)).Color;
+ Fore := Field_Fore (Fld).Attr;
+ Color := Field_Fore (Fld).Color;
end Foreground;
-- |
-- |
-- |
procedure Set_Background
- (Fld : in Field;
- Back : in Character_Attribute_Set := Normal_Video;
- Color : in Color_Pair := Color_Pair'First)
+ (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;
+ Attr : Attributed_Character) return Eti_Error;
pragma Import (C, Set_Field_Back, "set_field_back");
- Ch : constant Attributed_Character := (Ch => Character'First,
- Color => Color,
- Attr => Back);
- Res : constant Eti_Error :=
- Set_Field_Back (Fld, AttrChar_To_Chtype (Ch));
begin
- if Res /= E_Ok then
- Eti_Exception (Res);
- end if;
+ Eti_Exception (Set_Field_Back (Fld, (Ch => Character'First,
+ Color => Color,
+ Attr => Back)));
end Set_Background;
-- |
-- |
-- |
- procedure Background (Fld : in Field;
+ procedure Background (Fld : Field;
Back : out Character_Attribute_Set)
is
- function Field_Back (Fld : Field) return C_Chtype;
+ function Field_Back (Fld : Field) return Attributed_Character;
pragma Import (C, Field_Back, "field_back");
begin
- Back := Chtype_To_AttrChar (Field_Back (Fld)).Attr;
+ Back := Field_Back (Fld).Attr;
end Background;
- procedure Background (Fld : in Field;
+ procedure Background (Fld : Field;
Back : out Character_Attribute_Set;
Color : out Color_Pair)
is
- function Field_Back (Fld : Field) return C_Chtype;
+ function Field_Back (Fld : Field) return Attributed_Character;
pragma Import (C, Field_Back, "field_back");
begin
- Back := Chtype_To_AttrChar (Field_Back (Fld)).Attr;
- Color := Chtype_To_AttrChar (Field_Back (Fld)).Color;
+ Back := Field_Back (Fld).Attr;
+ Color := Field_Back (Fld).Color;
end Background;
-- |
-- |
-- |
- procedure Set_Pad_Character (Fld : in Field;
- Pad : in Character := Space)
+ procedure Set_Pad_Character (Fld : Field;
+ Pad : Character := Space)
is
function Set_Field_Pad (Fld : Field;
- Ch : C_Int) return C_Int;
+ Ch : C_Int) return Eti_Error;
pragma Import (C, Set_Field_Pad, "set_field_pad");
- Res : constant Eti_Error := Set_Field_Pad (Fld,
- C_Int (Character'Pos (Pad)));
begin
- if Res /= E_Ok then
- Eti_Exception (Res);
- end if;
+ Eti_Exception (Set_Field_Pad (Fld,
+ C_Int (Character'Pos (Pad))));
end Set_Pad_Character;
-- |
-- |
-- |
- procedure Pad_Character (Fld : in Field;
+ procedure Pad_Character (Fld : Field;
Pad : out Character)
is
function Field_Pad (Fld : Field) return C_Int;
@@ -516,7 +455,7 @@
-- |
-- |
-- |
- procedure Info (Fld : in Field;
+ procedure Info (Fld : Field;
Lines : out Line_Count;
Columns : out Column_Count;
First_Row : out Line_Position;
@@ -527,50 +466,42 @@
type C_Int_Access is access all C_Int;
function Fld_Info (Fld : Field;
L, C, Fr, Fc, Os, Ab : C_Int_Access)
- return C_Int;
+ return Eti_Error;
pragma Import (C, Fld_Info, "field_info");
L, C, Fr, Fc, Os, Ab : aliased C_Int;
- Res : constant Eti_Error := Fld_Info (Fld,
- L'Access, C'Access,
- Fr'Access, Fc'Access,
- Os'Access, Ab'Access);
begin
- if Res /= E_Ok then
- Eti_Exception (Res);
- else
- Lines := Line_Count (L);
- Columns := Column_Count (C);
- First_Row := Line_Position (Fr);
- First_Column := Column_Position (Fc);
- Off_Screen := Natural (Os);
- Additional_Buffers := Buffer_Number (Ab);
- end if;
+ Eti_Exception (Fld_Info (Fld,
+ L'Access, C'Access,
+ Fr'Access, Fc'Access,
+ Os'Access, Ab'Access));
+ Lines := Line_Count (L);
+ Columns := Column_Count (C);
+ First_Row := Line_Position (Fr);
+ First_Column := Column_Position (Fc);
+ Off_Screen := Natural (Os);
+ Additional_Buffers := Buffer_Number (Ab);
end Info;
-- |
-- |
-- |
- procedure Dynamic_Info (Fld : in Field;
+ 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;
+ function Dyn_Info (Fld : Field; L, C, M : C_Int_Access) return Eti_Error;
pragma Import (C, Dyn_Info, "dynamic_field_info");
L, C, M : aliased C_Int;
- Res : constant Eti_Error := Dyn_Info (Fld,
- L'Access, C'Access,
- M'Access);
begin
- if Res /= E_Ok then
- Eti_Exception (Res);
- else
- Lines := Line_Count (L);
- Columns := Column_Count (C);
- Max := Natural (M);
- end if;
+ Eti_Exception (Dyn_Info (Fld,
+ L'Access, C'Access,
+ M'Access));
+ Lines := Line_Count (L);
+ Columns := Column_Count (C);
+ Max := Natural (M);
end Dynamic_Info;
-- |
-- |=====================================================================
@@ -579,18 +510,15 @@
-- |
-- |
-- |
- procedure Set_Window (Frm : in Form;
- Win : in Window)
+ procedure Set_Window (Frm : Form;
+ Win : Window)
is
function Set_Form_Win (Frm : Form;
- Win : Window) return C_Int;
+ Win : Window) return Eti_Error;
pragma Import (C, Set_Form_Win, "set_form_win");
- Res : constant Eti_Error := Set_Form_Win (Frm, Win);
begin
- if Res /= E_Ok then
- Eti_Exception (Res);
- end if;
+ Eti_Exception (Set_Form_Win (Frm, Win));
end Set_Window;
-- |
-- |
@@ -607,18 +535,15 @@
-- |
-- |
-- |
- procedure Set_Sub_Window (Frm : in Form;
- Win : in Window)
+ procedure Set_Sub_Window (Frm : Form;
+ Win : Window)
is
function Set_Form_Sub (Frm : Form;
- Win : Window) return C_Int;
+ Win : Window) return Eti_Error;
pragma Import (C, Set_Form_Sub, "set_form_sub");
- Res : constant Eti_Error := Set_Form_Sub (Frm, Win);
begin
- if Res /= E_Ok then
- Eti_Exception (Res);
- end if;
+ Eti_Exception (Set_Form_Sub (Frm, Win));
end Set_Sub_Window;
-- |
-- |
@@ -635,21 +560,18 @@
-- |
-- |
-- |
- procedure Scale (Frm : in Form;
+ 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;
+ function M_Scale (Frm : Form; Yp, Xp : C_Int_Access) return Eti_Error;
pragma Import (C, M_Scale, "scale_form");
X, Y : aliased C_Int;
- Res : constant Eti_Error := M_Scale (Frm, Y'Access, X'Access);
begin
- if Res /= E_Ok then
- Eti_Exception (Res);
- end if;
- Lines := Line_Count (Y);
+ Eti_Exception (M_Scale (Frm, Y'Access, X'Access));
+ Lines := Line_Count (Y);
Columns := Column_Count (X);
end Scale;
-- |
@@ -659,66 +581,54 @@
-- |
-- |
-- |
- procedure Set_Field_Init_Hook (Frm : in Form;
- Proc : in Form_Hook_Function)
+ 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;
+ Proc : Form_Hook_Function) return Eti_Error;
pragma Import (C, Set_Field_Init, "set_field_init");
- Res : constant Eti_Error := Set_Field_Init (Frm, Proc);
begin
- if Res /= E_Ok then
- Eti_Exception (Res);
- end if;
+ Eti_Exception (Set_Field_Init (Frm, Proc));
end Set_Field_Init_Hook;
-- |
-- |
-- |
- procedure Set_Field_Term_Hook (Frm : in Form;
- Proc : in Form_Hook_Function)
+ 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;
+ Proc : Form_Hook_Function) return Eti_Error;
pragma Import (C, Set_Field_Term, "set_field_term");
- Res : constant Eti_Error := Set_Field_Term (Frm, Proc);
begin
- if Res /= E_Ok then
- Eti_Exception (Res);
- end if;
+ Eti_Exception (Set_Field_Term (Frm, Proc));
end Set_Field_Term_Hook;
-- |
-- |
-- |
- procedure Set_Form_Init_Hook (Frm : in Form;
- Proc : in Form_Hook_Function)
+ 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;
+ Proc : Form_Hook_Function) return Eti_Error;
pragma Import (C, Set_Form_Init, "set_form_init");
- Res : constant Eti_Error := Set_Form_Init (Frm, Proc);
begin
- if Res /= E_Ok then
- Eti_Exception (Res);
- end if;
+ Eti_Exception (Set_Form_Init (Frm, Proc));
end Set_Form_Init_Hook;
-- |
-- |
-- |
- procedure Set_Form_Term_Hook (Frm : in Form;
- Proc : in Form_Hook_Function)
+ 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;
+ Proc : Form_Hook_Function) return Eti_Error;
pragma Import (C, Set_Form_Term, "set_form_term");
- Res : constant Eti_Error := Set_Form_Term (Frm, Proc);
begin
- if Res /= E_Ok then
- Eti_Exception (Res);
- end if;
+ Eti_Exception (Set_Form_Term (Frm, Proc));
end Set_Form_Term_Hook;
-- |
-- |=====================================================================
@@ -727,23 +637,19 @@
-- |
-- |
-- |
- procedure Redefine (Frm : in Form;
- Flds : in Field_Array_Access)
+ procedure Redefine (Frm : Form;
+ Flds : Field_Array_Access)
is
function Set_Frm_Fields (Frm : Form;
- Items : System.Address) return C_Int;
+ Items : System.Address) return Eti_Error;
pragma Import (C, Set_Frm_Fields, "set_form_fields");
- Res : Eti_Error;
begin
- pragma Assert (Flds (Flds'Last) = Null_Field);
- if Flds (Flds'Last) /= Null_Field then
+ pragma Assert (Flds.all (Flds'Last) = Null_Field);
+ if Flds.all (Flds'Last) /= Null_Field then
raise Form_Exception;
else
- Res := Set_Frm_Fields (Frm, Flds (Flds'First)'Address);
- if Res /= E_Ok then
- Eti_Exception (Res);
- end if;
+ Eti_Exception (Set_Frm_Fields (Frm, Flds.all (Flds'First)'Address));
end if;
end Redefine;
-- |
@@ -779,18 +685,15 @@
-- |
-- |
-- |
- procedure Move (Fld : in Field;
- Line : in Line_Position;
- Column : in Column_Position)
+ procedure Move (Fld : Field;
+ Line : Line_Position;
+ Column : Column_Position)
is
- function Move (Fld : Field; L, C : C_Int) return C_Int;
+ function Move (Fld : Field; L, C : C_Int) return Eti_Error;
pragma Import (C, Move, "move_field");
- Res : constant Eti_Error := Move (Fld, C_Int (Line), C_Int (Column));
begin
- if Res /= E_Ok then
- Eti_Exception (Res);
- end if;
+ Eti_Exception (Move (Fld, C_Int (Line), C_Int (Column)));
end Move;
-- |
-- |=====================================================================
@@ -806,11 +709,11 @@
M : Form;
begin
- pragma Assert (Fields (Fields'Last) = Null_Field);
- if Fields (Fields'Last) /= Null_Field then
+ pragma Assert (Fields.all (Fields'Last) = Null_Field);
+ if Fields.all (Fields'Last) /= Null_Field then
raise Form_Exception;
else
- M := NewForm (Fields (Fields'First)'Address);
+ M := NewForm (Fields.all (Fields'First)'Address);
if M = Null_Form then
raise Form_Exception;
end if;
@@ -822,14 +725,11 @@
-- |
procedure Delete (Frm : in out Form)
is
- function Free (Frm : Form) return C_Int;
+ function Free (Frm : Form) return Eti_Error;
pragma Import (C, Free, "free_form");
- Res : constant Eti_Error := Free (Frm);
begin
- if Res /= E_Ok then
- Eti_Exception (Res);
- end if;
+ Eti_Exception (Free (Frm));
Frm := Null_Form;
end Delete;
-- |
@@ -839,59 +739,48 @@
-- |
-- |
-- |
- procedure Set_Options (Frm : in Form;
- Options : in Form_Option_Set)
+ procedure Set_Options (Frm : Form;
+ Options : Form_Option_Set)
is
function Set_Form_Opts (Frm : Form;
- Opt : C_Int) return C_Int;
+ Opt : Form_Option_Set) return Eti_Error;
pragma Import (C, Set_Form_Opts, "set_form_opts");
- Opt : constant C_Int := FrmOS_2_CInt (Options);
- Res : Eti_Error;
begin
- Res := Set_Form_Opts (Frm, Opt);
- if Res /= E_Ok then
- Eti_Exception (Res);
- end if;
+ Eti_Exception (Set_Form_Opts (Frm, Options));
end Set_Options;
-- |
-- |
-- |
- procedure Switch_Options (Frm : in Form;
- Options : in Form_Option_Set;
+ 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;
+ Opt : Form_Option_Set) return Eti_Error;
pragma Import (C, Form_Opts_On, "form_opts_on");
function Form_Opts_Off (Frm : Form;
- Opt : C_Int) return C_Int;
+ Opt : Form_Option_Set) return Eti_Error;
pragma Import (C, Form_Opts_Off, "form_opts_off");
- Err : Eti_Error;
- Opt : constant C_Int := FrmOS_2_CInt (Options);
begin
if On then
- Err := Form_Opts_On (Frm, Opt);
+ Eti_Exception (Form_Opts_On (Frm, Options));
else
- Err := Form_Opts_Off (Frm, Opt);
- end if;
- if Err /= E_Ok then
- Eti_Exception (Err);
+ Eti_Exception (Form_Opts_Off (Frm, Options));
end if;
end Switch_Options;
-- |
-- |
-- |
- procedure Get_Options (Frm : in Form;
+ procedure Get_Options (Frm : Form;
Options : out Form_Option_Set)
is
- function Form_Opts (Frm : Form) return C_Int;
+ function Form_Opts (Frm : Form) return Form_Option_Set;
pragma Import (C, Form_Opts, "form_opts");
- Res : constant C_Int := Form_Opts (Frm);
begin
- Options := CInt_2_FrmOS (Res);
+ Options := Form_Opts (Frm);
end Get_Options;
-- |
-- |
@@ -910,23 +799,19 @@
-- |
-- |
-- |
- procedure Post (Frm : in Form;
- Post : in Boolean := True)
+ procedure Post (Frm : Form;
+ Post : Boolean := True)
is
- function M_Post (Frm : Form) return C_Int;
+ function M_Post (Frm : Form) return Eti_Error;
pragma Import (C, M_Post, "post_form");
- function M_Unpost (Frm : Form) return C_Int;
+ function M_Unpost (Frm : Form) return Eti_Error;
pragma Import (C, M_Unpost, "unpost_form");
- Res : Eti_Error;
begin
if Post then
- Res := M_Post (Frm);
+ Eti_Exception (M_Post (Frm));
else
- Res := M_Unpost (Frm);
- end if;
- if Res /= E_Ok then
- Eti_Exception (Res);
+ Eti_Exception (M_Unpost (Frm));
end if;
end Post;
-- |
@@ -938,14 +823,11 @@
-- |
procedure Position_Cursor (Frm : Form)
is
- function Pos_Form_Cursor (Frm : Form) return C_Int;
+ function Pos_Form_Cursor (Frm : Form) return Eti_Error;
pragma Import (C, Pos_Form_Cursor, "pos_form_cursor");
- Res : constant Eti_Error := Pos_Form_Cursor (Frm);
begin
- if Res /= E_Ok then
- Eti_Exception (Res);
- end if;
+ Eti_Exception (Pos_Form_Cursor (Frm));
end Position_Cursor;
-- |
-- |=====================================================================
@@ -993,25 +875,22 @@
function Driver (Frm : Form;
Key : Key_Code) return Driver_Result
is
- function Frm_Driver (Frm : Form; Key : C_Int) return C_Int;
+ function Frm_Driver (Frm : Form; Key : C_Int) return Eti_Error;
pragma Import (C, Frm_Driver, "form_driver");
R : constant Eti_Error := Frm_Driver (Frm, C_Int (Key));
begin
- if R /= E_Ok then
- if R = E_Unknown_Command then
+ case R is
+ when E_Unknown_Command =>
return Unknown_Request;
- elsif R = E_Invalid_Field then
+ when E_Invalid_Field =>
return Invalid_Field;
- elsif R = E_Request_Denied then
+ when E_Request_Denied =>
return Request_Denied;
- else
+ when others =>
Eti_Exception (R);
return Form_Ok;
- end if;
- else
- return Form_Ok;
- end if;
+ end case;
end Driver;
-- |
-- |=====================================================================
@@ -1020,22 +899,19 @@
-- |
-- |
-- |
- procedure Set_Current (Frm : in Form;
- Fld : in Field)
+ procedure Set_Current (Frm : Form;
+ Fld : Field)
is
- function Set_Current_Fld (Frm : Form; Fld : Field) return C_Int;
+ function Set_Current_Fld (Frm : Form; Fld : Field) return Eti_Error;
pragma Import (C, Set_Current_Fld, "set_current_field");
- Res : constant Eti_Error := Set_Current_Fld (Frm, Fld);
begin
- if Res /= E_Ok then
- Eti_Exception (Res);
- end if;
+ Eti_Exception (Set_Current_Fld (Frm, Fld));
end Set_Current;
-- |
-- |
-- |
- function Current (Frm : in Form) return Field
+ function Current (Frm : Form) return Field
is
function Current_Fld (Frm : Form) return Field;
pragma Import (C, Current_Fld, "current_field");
@@ -1050,17 +926,14 @@
-- |
-- |
-- |
- procedure Set_Page (Frm : in Form;
- Page : in Page_Number := Page_Number'First)
+ procedure Set_Page (Frm : Form;
+ Page : Page_Number := Page_Number'First)
is
- function Set_Frm_Page (Frm : Form; Pg : C_Int) return C_Int;
+ function Set_Frm_Page (Frm : Form; Pg : C_Int) return Eti_Error;
pragma Import (C, Set_Frm_Page, "set_form_page");
- Res : constant Eti_Error := Set_Frm_Page (Frm, C_Int (Page));
begin
- if Res /= E_Ok then
- Eti_Exception (Res);
- end if;
+ Eti_Exception (Set_Frm_Page (Frm, C_Int (Page)));
end Set_Page;
-- |
-- |
@@ -1099,17 +972,14 @@
-- |
-- |
-- |
- procedure Set_New_Page (Fld : in Field;
- New_Page : in Boolean := True)
+ procedure Set_New_Page (Fld : Field;
+ New_Page : Boolean := True)
is
- function Set_Page (Fld : Field; Flg : C_Int) return C_Int;
+ function Set_Page (Fld : Field; Flg : C_Int) return Eti_Error;
pragma Import (C, Set_Page, "set_new_page");
- Res : constant Eti_Error := Set_Page (Fld, Boolean'Pos (New_Page));
begin
- if Res /= E_Ok then
- Eti_Exception (Res);
- end if;
+ Eti_Exception (Set_Page (Fld, Boolean'Pos (New_Page)));
end Set_New_Page;
-- |
-- |
@@ -1129,15 +999,15 @@
end Is_New_Page;
procedure Free (FA : in out Field_Array_Access;
- Free_Fields : in Boolean := False)
+ Free_Fields : Boolean := False)
is
procedure Release is new Ada.Unchecked_Deallocation
(Field_Array, Field_Array_Access);
begin
if FA /= null and then Free_Fields then
for I in FA'First .. (FA'Last - 1) loop
- if FA (I) /= Null_Field then
- Delete (FA (I));
+ if FA.all (I) /= Null_Field then
+ Delete (FA.all (I));
end if;
end loop;
end if;
diff --git a/Ada95/src/terminal_interface-curses-menus-item_user_data.adb b/Ada95/src/terminal_interface-curses-menus-item_user_data.adb
index 6c35d33..da26f80 100644
--- a/Ada95/src/terminal_interface-curses-menus-item_user_data.adb
+++ b/Ada95/src/terminal_interface-curses-menus-item_user_data.adb
@@ -7,7 +7,7 @@
-- B O D Y --
-- --
------------------------------------------------------------------------------
--- Copyright (c) 1998 Free Software Foundation, Inc. --
+-- Copyright (c) 1998-2009,2014 Free Software Foundation, Inc. --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files (the --
@@ -35,7 +35,7 @@
------------------------------------------------------------------------------
-- Author: Juergen Pfeifer, 1996
-- Version Control:
--- $Revision: 1.11 $
+-- $Revision: 1.14 $
-- Binding Version 01.00
------------------------------------------------------------------------------
with Interfaces.C;
@@ -45,21 +45,18 @@
use type Interfaces.C.int;
- procedure Set_User_Data (Itm : in Item;
- Data : in User_Access)
+ procedure Set_User_Data (Itm : Item;
+ Data : User_Access)
is
function Set_Item_Userptr (Itm : Item;
- Addr : User_Access) return C_Int;
+ Addr : User_Access) return Eti_Error;
pragma Import (C, Set_Item_Userptr, "set_item_userptr");
- Res : constant Eti_Error := Set_Item_Userptr (Itm, Data);
begin
- if Res /= E_Ok then
- Eti_Exception (Res);
- end if;
+ Eti_Exception (Set_Item_Userptr (Itm, Data));
end Set_User_Data;
- function Get_User_Data (Itm : in Item) return User_Access
+ 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");
@@ -67,7 +64,7 @@
return Item_Userptr (Itm);
end Get_User_Data;
- procedure Get_User_Data (Itm : in Item;
+ procedure Get_User_Data (Itm : Item;
Data : out User_Access)
is
begin
diff --git a/Ada95/src/terminal_interface-curses-menus-menu_user_data.adb b/Ada95/src/terminal_interface-curses-menus-menu_user_data.adb
index 20b9e86..746e7b4 100644
--- a/Ada95/src/terminal_interface-curses-menus-menu_user_data.adb
+++ b/Ada95/src/terminal_interface-curses-menus-menu_user_data.adb
@@ -7,7 +7,7 @@
-- B O D Y --
-- --
------------------------------------------------------------------------------
--- Copyright (c) 1998 Free Software Foundation, Inc. --
+-- Copyright (c) 1998-2009,2014 Free Software Foundation, Inc. --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files (the --
@@ -35,7 +35,7 @@
------------------------------------------------------------------------------
-- Author: Juergen Pfeifer, 1996
-- Version Control:
--- $Revision: 1.12 $
+-- $Revision: 1.15 $
-- Binding Version 01.00
------------------------------------------------------------------------------
with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux;
@@ -44,21 +44,19 @@
use type Interfaces.C.int;
- procedure Set_User_Data (Men : in Menu;
- Data : in User_Access)
+ procedure Set_User_Data (Men : Menu;
+ Data : User_Access)
is
function Set_Menu_Userptr (Men : Menu;
- Data : User_Access) return C_Int;
+ Data : User_Access) return Eti_Error;
pragma Import (C, Set_Menu_Userptr, "set_menu_userptr");
- Res : constant Eti_Error := Set_Menu_Userptr (Men, Data);
begin
- if Res /= E_Ok then
- Eti_Exception (Res);
- end if;
+ Eti_Exception (Set_Menu_Userptr (Men, Data));
+
end Set_User_Data;
- function Get_User_Data (Men : in Menu) return User_Access
+ 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");
@@ -66,7 +64,7 @@
return Menu_Userptr (Men);
end Get_User_Data;
- procedure Get_User_Data (Men : in Menu;
+ procedure Get_User_Data (Men : Menu;
Data : out User_Access)
is
begin
diff --git a/Ada95/src/terminal_interface-curses-menus.adb b/Ada95/src/terminal_interface-curses-menus.adb
index 0b24c74..ef3a0d3 100644
--- a/Ada95/src/terminal_interface-curses-menus.adb
+++ b/Ada95/src/terminal_interface-curses-menus.adb
@@ -7,7 +7,7 @@
-- B O D Y --
-- --
------------------------------------------------------------------------------
--- Copyright (c) 1998-2004,2008 Free Software Foundation, Inc. --
+-- Copyright (c) 1998-2011,2014 Free Software Foundation, Inc. --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files (the --
@@ -35,8 +35,8 @@
------------------------------------------------------------------------------
-- Author: Juergen Pfeifer, 1996
-- Version Control:
--- $Revision: 1.26 $
--- $Date: 2008/07/26 18:50:58 $
+-- $Revision: 1.32 $
+-- $Date: 2014/05/24 21:31:05 $
-- Binding Version 01.00
------------------------------------------------------------------------------
with Ada.Unchecked_Deallocation;
@@ -46,8 +46,6 @@
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;
@@ -57,24 +55,8 @@
use type System.Bit_Order;
subtype chars_ptr is Interfaces.C.Strings.chars_ptr;
- function MOS_2_CInt is new
- Ada.Unchecked_Conversion (Menu_Option_Set,
- C_Int);
-
- function CInt_2_MOS is new
- Ada.Unchecked_Conversion (C_Int,
- Menu_Option_Set);
-
- function IOS_2_CInt is new
- Ada.Unchecked_Conversion (Item_Option_Set,
- C_Int);
-
- function CInt_2_IOS is new
- Ada.Unchecked_Conversion (C_Int,
- Item_Option_Set);
-
------------------------------------------------------------------------------
- procedure Request_Name (Key : in Menu_Request_Code;
+ procedure Request_Name (Key : Menu_Request_Code;
Name : out String)
is
function Request_Name (Key : C_Int) return chars_ptr;
@@ -128,10 +110,9 @@
function Itemname (Itm : Item) return chars_ptr;
pragma Import (C, Itemname, "item_name");
- function Freeitem (Itm : Item) return C_Int;
+ function Freeitem (Itm : Item) return Eti_Error;
pragma Import (C, Freeitem, "free_item");
- Res : Eti_Error;
Ptr : chars_ptr;
begin
Ptr := Descname (Itm);
@@ -142,25 +123,19 @@
if Ptr /= Null_Ptr then
Interfaces.C.Strings.Free (Ptr);
end if;
- Res := Freeitem (Itm);
- if Res /= E_Ok then
- Eti_Exception (Res);
- end if;
+ Eti_Exception (Freeitem (Itm));
Itm := Null_Item;
end Delete;
-------------------------------------------------------------------------------
- procedure Set_Value (Itm : in Item;
- Value : in Boolean := True)
+ procedure Set_Value (Itm : Item;
+ Value : Boolean := True)
is
function Set_Item_Val (Itm : Item;
- Val : C_Int) return C_Int;
+ Val : C_Int) return Eti_Error;
pragma Import (C, Set_Item_Val, "set_item_value");
- Res : constant Eti_Error := Set_Item_Val (Itm, Boolean'Pos (Value));
begin
- if Res /= E_Ok then
- Eti_Exception (Res);
- end if;
+ Eti_Exception (Set_Item_Val (Itm, Boolean'Pos (Value)));
end Set_Value;
function Value (Itm : Item) return Boolean
@@ -188,55 +163,44 @@
end if;
end Visible;
-------------------------------------------------------------------------------
- procedure Set_Options (Itm : in Item;
- Options : in Item_Option_Set)
+ procedure Set_Options (Itm : Item;
+ Options : Item_Option_Set)
is
function Set_Item_Opts (Itm : Item;
- Opt : C_Int) return C_Int;
+ Opt : Item_Option_Set) return Eti_Error;
pragma Import (C, Set_Item_Opts, "set_item_opts");
- Opt : constant C_Int := IOS_2_CInt (Options);
- Res : Eti_Error;
begin
- Res := Set_Item_Opts (Itm, Opt);
- if Res /= E_Ok then
- Eti_Exception (Res);
- end if;
+ Eti_Exception (Set_Item_Opts (Itm, Options));
end Set_Options;
- procedure Switch_Options (Itm : in Item;
- Options : in Item_Option_Set;
+ 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;
+ Opt : Item_Option_Set) return Eti_Error;
pragma Import (C, Item_Opts_On, "item_opts_on");
function Item_Opts_Off (Itm : Item;
- Opt : C_Int) return C_Int;
+ Opt : Item_Option_Set) return Eti_Error;
pragma Import (C, Item_Opts_Off, "item_opts_off");
- Opt : constant C_Int := IOS_2_CInt (Options);
- Err : Eti_Error;
begin
if On then
- Err := Item_Opts_On (Itm, Opt);
+ Eti_Exception (Item_Opts_On (Itm, Options));
else
- Err := Item_Opts_Off (Itm, Opt);
- end if;
- if Err /= E_Ok then
- Eti_Exception (Err);
+ Eti_Exception (Item_Opts_Off (Itm, Options));
end if;
end Switch_Options;
- procedure Get_Options (Itm : in Item;
+ procedure Get_Options (Itm : Item;
Options : out Item_Option_Set)
is
- function Item_Opts (Itm : Item) return C_Int;
+ function Item_Opts (Itm : Item) return Item_Option_Set;
pragma Import (C, Item_Opts, "item_opts");
- Res : constant C_Int := Item_Opts (Itm);
begin
- Options := CInt_2_IOS (Res);
+ Options := Item_Opts (Itm);
end Get_Options;
function Get_Options (Itm : Item := Null_Item) return Item_Option_Set
@@ -247,7 +211,7 @@
return Ios;
end Get_Options;
-------------------------------------------------------------------------------
- procedure Name (Itm : in Item;
+ procedure Name (Itm : Item;
Name : out String)
is
function Itemname (Itm : Item) return chars_ptr;
@@ -256,7 +220,7 @@
Fill_String (Itemname (Itm), Name);
end Name;
- function Name (Itm : in Item) return String
+ function Name (Itm : Item) return String
is
function Itemname (Itm : Item) return chars_ptr;
pragma Import (C, Itemname, "item_name");
@@ -264,7 +228,7 @@
return Fill_String (Itemname (Itm));
end Name;
- procedure Description (Itm : in Item;
+ procedure Description (Itm : Item;
Description : out String)
is
function Descname (Itm : Item) return chars_ptr;
@@ -273,7 +237,7 @@
Fill_String (Descname (Itm), Description);
end Description;
- function Description (Itm : in Item) return String
+ function Description (Itm : Item) return String
is
function Descname (Itm : Item) return chars_ptr;
pragma Import (C, Descname, "item_description");
@@ -281,18 +245,15 @@
return Fill_String (Descname (Itm));
end Description;
-------------------------------------------------------------------------------
- procedure Set_Current (Men : in Menu;
- Itm : in Item)
+ procedure Set_Current (Men : Menu;
+ Itm : Item)
is
function Set_Curr_Item (Men : Menu;
- Itm : Item) return C_Int;
+ Itm : Item) return Eti_Error;
pragma Import (C, Set_Curr_Item, "set_current_item");
- Res : constant Eti_Error := Set_Curr_Item (Men, Itm);
begin
- if Res /= E_Ok then
- Eti_Exception (Res);
- end if;
+ Eti_Exception (Set_Curr_Item (Men, Itm));
end Set_Current;
function Current (Men : Menu) return Item
@@ -308,18 +269,15 @@
return Res;
end Current;
- procedure Set_Top_Row (Men : in Menu;
- Line : in Line_Position)
+ procedure Set_Top_Row (Men : Menu;
+ Line : Line_Position)
is
function Set_Toprow (Men : Menu;
- Line : C_Int) return C_Int;
+ Line : C_Int) return Eti_Error;
pragma Import (C, Set_Toprow, "set_top_row");
- Res : constant Eti_Error := Set_Toprow (Men, C_Int (Line));
begin
- if Res /= E_Ok then
- Eti_Exception (Res);
- end if;
+ Eti_Exception (Set_Toprow (Men, C_Int (Line)));
end Set_Top_Row;
function Top_Row (Men : Menu) return Line_Position
@@ -348,75 +306,60 @@
return Positive (Natural (Res) + Positive'First);
end Get_Index;
-------------------------------------------------------------------------------
- procedure Post (Men : in Menu;
- Post : in Boolean := True)
+ procedure Post (Men : Menu;
+ Post : Boolean := True)
is
- function M_Post (Men : Menu) return C_Int;
+ function M_Post (Men : Menu) return Eti_Error;
pragma Import (C, M_Post, "post_menu");
- function M_Unpost (Men : Menu) return C_Int;
+ function M_Unpost (Men : Menu) return Eti_Error;
pragma Import (C, M_Unpost, "unpost_menu");
- Res : Eti_Error;
begin
if Post then
- Res := M_Post (Men);
+ Eti_Exception (M_Post (Men));
else
- Res := M_Unpost (Men);
- end if;
- if Res /= E_Ok then
- Eti_Exception (Res);
+ Eti_Exception (M_Unpost (Men));
end if;
end Post;
-------------------------------------------------------------------------------
- procedure Set_Options (Men : in Menu;
- Options : in Menu_Option_Set)
+ procedure Set_Options (Men : Menu;
+ Options : Menu_Option_Set)
is
function Set_Menu_Opts (Men : Menu;
- Opt : C_Int) return C_Int;
+ Opt : Menu_Option_Set) return Eti_Error;
pragma Import (C, Set_Menu_Opts, "set_menu_opts");
- Opt : constant C_Int := MOS_2_CInt (Options);
- Res : Eti_Error;
begin
- Res := Set_Menu_Opts (Men, Opt);
- if Res /= E_Ok then
- Eti_Exception (Res);
- end if;
+ Eti_Exception (Set_Menu_Opts (Men, Options));
end Set_Options;
- procedure Switch_Options (Men : in Menu;
- Options : in Menu_Option_Set;
- On : in Boolean := True)
+ 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;
+ Opt : Menu_Option_Set) return Eti_Error;
pragma Import (C, Menu_Opts_On, "menu_opts_on");
function Menu_Opts_Off (Men : Menu;
- Opt : C_Int) return C_Int;
+ Opt : Menu_Option_Set) return Eti_Error;
pragma Import (C, Menu_Opts_Off, "menu_opts_off");
- Opt : constant C_Int := MOS_2_CInt (Options);
- Err : Eti_Error;
begin
if On then
- Err := Menu_Opts_On (Men, Opt);
+ Eti_Exception (Menu_Opts_On (Men, Options));
else
- Err := Menu_Opts_Off (Men, Opt);
- end if;
- if Err /= E_Ok then
- Eti_Exception (Err);
+ Eti_Exception (Menu_Opts_Off (Men, Options));
end if;
end Switch_Options;
- procedure Get_Options (Men : in Menu;
- Options : out Menu_Option_Set)
+ procedure Get_Options (Men : Menu;
+ Options : out Menu_Option_Set)
is
- function Menu_Opts (Men : Menu) return C_Int;
+ function Menu_Opts (Men : Menu) return Menu_Option_Set;
pragma Import (C, Menu_Opts, "menu_opts");
- Res : constant C_Int := Menu_Opts (Men);
begin
- Options := CInt_2_MOS (Res);
+ Options := Menu_Opts (Men);
end Get_Options;
function Get_Options (Men : Menu := Null_Menu) return Menu_Option_Set
@@ -427,18 +370,15 @@
return Mos;
end Get_Options;
-------------------------------------------------------------------------------
- procedure Set_Window (Men : in Menu;
- Win : in Window)
+ procedure Set_Window (Men : Menu;
+ Win : Window)
is
function Set_Menu_Win (Men : Menu;
- Win : Window) return C_Int;
+ Win : Window) return Eti_Error;
pragma Import (C, Set_Menu_Win, "set_menu_win");
- Res : constant Eti_Error := Set_Menu_Win (Men, Win);
begin
- if Res /= E_Ok then
- Eti_Exception (Res);
- end if;
+ Eti_Exception (Set_Menu_Win (Men, Win));
end Set_Window;
function Get_Window (Men : Menu) return Window
@@ -451,18 +391,15 @@
return W;
end Get_Window;
- procedure Set_Sub_Window (Men : in Menu;
- Win : in Window)
+ procedure Set_Sub_Window (Men : Menu;
+ Win : Window)
is
function Set_Menu_Sub (Men : Menu;
- Win : Window) return C_Int;
+ Win : Window) return Eti_Error;
pragma Import (C, Set_Menu_Sub, "set_menu_sub");
- Res : constant Eti_Error := Set_Menu_Sub (Men, Win);
begin
- if Res /= E_Ok then
- Eti_Exception (Res);
- end if;
+ Eti_Exception (Set_Menu_Sub (Men, Win));
end Set_Sub_Window;
function Get_Sub_Window (Men : Menu) return Window
@@ -475,58 +412,48 @@
return W;
end Get_Sub_Window;
- procedure Scale (Men : in Menu;
+ 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;
+ Yp, Xp : C_Int_Access) return Eti_Error;
pragma Import (C, M_Scale, "scale_menu");
X, Y : aliased C_Int;
- Res : constant Eti_Error := M_Scale (Men, Y'Access, X'Access);
begin
- if Res /= E_Ok then
- Eti_Exception (Res);
- end if;
+ Eti_Exception (M_Scale (Men, Y'Access, X'Access));
Lines := Line_Count (Y);
Columns := Column_Count (X);
end Scale;
-------------------------------------------------------------------------------
procedure Position_Cursor (Men : Menu)
is
- function Pos_Menu_Cursor (Men : Menu) return C_Int;
+ function Pos_Menu_Cursor (Men : Menu) return Eti_Error;
pragma Import (C, Pos_Menu_Cursor, "pos_menu_cursor");
- Res : constant Eti_Error := Pos_Menu_Cursor (Men);
begin
- if Res /= E_Ok then
- Eti_Exception (Res);
- end if;
+ Eti_Exception (Pos_Menu_Cursor (Men));
end Position_Cursor;
-------------------------------------------------------------------------------
- procedure Set_Mark (Men : in Menu;
- Mark : in String)
+ 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;
+ Mark : Char_Ptr) return Eti_Error;
pragma Import (C, Set_Mark, "set_menu_mark");
Txt : char_array (0 .. Mark'Length);
Len : size_t;
- Res : Eti_Error;
begin
To_C (Mark, Txt, Len);
- Res := Set_Mark (Men, Txt (Txt'First)'Access);
- if Res /= E_Ok then
- Eti_Exception (Res);
- end if;
+ Eti_Exception (Set_Mark (Men, Txt (Txt'First)'Access));
end Set_Mark;
- procedure Mark (Men : in Menu;
+ procedure Mark (Men : Menu;
Mark : out String)
is
function Get_Menu_Mark (Men : Menu) return chars_ptr;
@@ -545,138 +472,125 @@
-------------------------------------------------------------------------------
procedure Set_Foreground
- (Men : in Menu;
- Fore : in Character_Attribute_Set := Normal_Video;
- Color : in Color_Pair := Color_Pair'First)
+ (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;
+ Attr : Attributed_Character) return Eti_Error;
pragma Import (C, Set_Menu_Fore, "set_menu_fore");
Ch : constant Attributed_Character := (Ch => Character'First,
Color => Color,
Attr => Fore);
- Res : constant Eti_Error := Set_Menu_Fore (Men, AttrChar_To_Chtype (Ch));
begin
- if Res /= E_Ok then
- Eti_Exception (Res);
- end if;
+ Eti_Exception (Set_Menu_Fore (Men, Ch));
end Set_Foreground;
- procedure Foreground (Men : in Menu;
+ procedure Foreground (Men : Menu;
Fore : out Character_Attribute_Set)
is
- function Menu_Fore (Men : Menu) return C_Chtype;
+ function Menu_Fore (Men : Menu) return Attributed_Character;
pragma Import (C, Menu_Fore, "menu_fore");
begin
- Fore := Chtype_To_AttrChar (Menu_Fore (Men)).Attr;
+ Fore := Menu_Fore (Men).Attr;
end Foreground;
- procedure Foreground (Men : in Menu;
+ procedure Foreground (Men : Menu;
Fore : out Character_Attribute_Set;
Color : out Color_Pair)
is
- function Menu_Fore (Men : Menu) return C_Chtype;
+ function Menu_Fore (Men : Menu) return Attributed_Character;
pragma Import (C, Menu_Fore, "menu_fore");
begin
- Fore := Chtype_To_AttrChar (Menu_Fore (Men)).Attr;
- Color := Chtype_To_AttrChar (Menu_Fore (Men)).Color;
+ Fore := Menu_Fore (Men).Attr;
+ Color := Menu_Fore (Men).Color;
end Foreground;
procedure Set_Background
- (Men : in Menu;
- Back : in Character_Attribute_Set := Normal_Video;
- Color : in Color_Pair := Color_Pair'First)
+ (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;
+ Attr : Attributed_Character) return Eti_Error;
pragma Import (C, Set_Menu_Back, "set_menu_back");
Ch : constant Attributed_Character := (Ch => Character'First,
Color => Color,
Attr => Back);
- Res : constant Eti_Error := Set_Menu_Back (Men, AttrChar_To_Chtype (Ch));
begin
- if Res /= E_Ok then
- Eti_Exception (Res);
- end if;
+ Eti_Exception (Set_Menu_Back (Men, Ch));
end Set_Background;
- procedure Background (Men : in Menu;
+ procedure Background (Men : Menu;
Back : out Character_Attribute_Set)
is
- function Menu_Back (Men : Menu) return C_Chtype;
+ function Menu_Back (Men : Menu) return Attributed_Character;
pragma Import (C, Menu_Back, "menu_back");
begin
- Back := Chtype_To_AttrChar (Menu_Back (Men)).Attr;
+ Back := Menu_Back (Men).Attr;
end Background;
- procedure Background (Men : in Menu;
+ procedure Background (Men : Menu;
Back : out Character_Attribute_Set;
Color : out Color_Pair)
is
- function Menu_Back (Men : Menu) return C_Chtype;
+ function Menu_Back (Men : Menu) return Attributed_Character;
pragma Import (C, Menu_Back, "menu_back");
begin
- Back := Chtype_To_AttrChar (Menu_Back (Men)).Attr;
- Color := Chtype_To_AttrChar (Menu_Back (Men)).Color;
+ Back := Menu_Back (Men).Attr;
+ Color := Menu_Back (Men).Color;
end Background;
- procedure Set_Grey (Men : in Menu;
- Grey : in Character_Attribute_Set := Normal_Video;
- Color : in Color_Pair := Color_Pair'First)
+ 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;
+ Attr : Attributed_Character) return Eti_Error;
pragma Import (C, Set_Menu_Grey, "set_menu_grey");
Ch : constant Attributed_Character := (Ch => Character'First,
Color => Color,
Attr => Grey);
- Res : constant Eti_Error := Set_Menu_Grey (Men, AttrChar_To_Chtype (Ch));
begin
- if Res /= E_Ok then
- Eti_Exception (Res);
- end if;
+ Eti_Exception (Set_Menu_Grey (Men, Ch));
end Set_Grey;
- procedure Grey (Men : in Menu;
+ procedure Grey (Men : Menu;
Grey : out Character_Attribute_Set)
is
- function Menu_Grey (Men : Menu) return C_Chtype;
+ function Menu_Grey (Men : Menu) return Attributed_Character;
pragma Import (C, Menu_Grey, "menu_grey");
begin
- Grey := Chtype_To_AttrChar (Menu_Grey (Men)).Attr;
+ Grey := Menu_Grey (Men).Attr;
end Grey;
- procedure Grey (Men : in Menu;
+ procedure Grey (Men : Menu;
Grey : out Character_Attribute_Set;
Color : out Color_Pair)
is
- function Menu_Grey (Men : Menu) return C_Chtype;
+ function Menu_Grey (Men : Menu) return Attributed_Character;
pragma Import (C, Menu_Grey, "menu_grey");
begin
- Grey := Chtype_To_AttrChar (Menu_Grey (Men)).Attr;
- Color := Chtype_To_AttrChar (Menu_Grey (Men)).Color;
+ Grey := Menu_Grey (Men).Attr;
+ Color := Menu_Grey (Men).Color;
end Grey;
- procedure Set_Pad_Character (Men : in Menu;
- Pad : in Character := Space)
+ procedure Set_Pad_Character (Men : Menu;
+ Pad : Character := Space)
is
function Set_Menu_Pad (Men : Menu;
- Ch : C_Int) return C_Int;
+ Ch : C_Int) return Eti_Error;
pragma Import (C, Set_Menu_Pad, "set_menu_pad");
- Res : constant Eti_Error := Set_Menu_Pad (Men,
- C_Int (Character'Pos (Pad)));
begin
- if Res /= E_Ok then
- Eti_Exception (Res);
- end if;
+ Eti_Exception (Set_Menu_Pad (Men, C_Int (Character'Pos (Pad))));
end Set_Pad_Character;
- procedure Pad_Character (Men : in Menu;
+ procedure Pad_Character (Men : Menu;
Pad : out Character)
is
function Menu_Pad (Men : Menu) return C_Int;
@@ -685,48 +599,41 @@
Pad := Character'Val (Menu_Pad (Men));
end Pad_Character;
-------------------------------------------------------------------------------
- procedure Set_Spacing (Men : in Menu;
- Descr : in Column_Position := 0;
- Row : in Line_Position := 0;
- Col : in Column_Position := 0)
+ 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;
+ D, R, C : C_Int) return Eti_Error;
pragma Import (C, Set_Spacing, "set_menu_spacing");
- Res : constant Eti_Error := Set_Spacing (Men,
- C_Int (Descr),
- C_Int (Row),
- C_Int (Col));
begin
- if Res /= E_Ok then
- Eti_Exception (Res);
- end if;
+ Eti_Exception (Set_Spacing (Men,
+ C_Int (Descr),
+ C_Int (Row),
+ C_Int (Col)));
end Set_Spacing;
- procedure Spacing (Men : in Menu;
+ 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;
+ D, R, C : C_Int_Access) return Eti_Error;
pragma Import (C, Get_Spacing, "menu_spacing");
D, R, C : aliased C_Int;
- Res : constant Eti_Error := Get_Spacing (Men,
- D'Access,
- R'Access,
- C'Access);
begin
- if Res /= E_Ok then
- Eti_Exception (Res);
- else
- Descr := Column_Position (D);
- Row := Line_Position (R);
- Col := Column_Position (C);
- end if;
+ Eti_Exception (Get_Spacing (Men,
+ D'Access,
+ R'Access,
+ C'Access));
+ Descr := Column_Position (D);
+ Row := Line_Position (R);
+ Col := Column_Position (C);
end Spacing;
-------------------------------------------------------------------------------
function Set_Pattern (Men : Menu;
@@ -734,7 +641,7 @@
is
type Char_Ptr is access all Interfaces.C.char;
function Set_Pattern (Men : Menu;
- Pattern : Char_Ptr) return C_Int;
+ Pattern : Char_Ptr) return Eti_Error;
pragma Import (C, Set_Pattern, "set_menu_pattern");
S : char_array (0 .. Text'Length);
@@ -744,15 +651,15 @@
To_C (Text, S, L);
Res := Set_Pattern (Men, S (S'First)'Access);
case Res is
- when E_No_Match => return False;
- when E_Ok => return True;
+ when E_No_Match =>
+ return False;
when others =>
Eti_Exception (Res);
- return False;
+ return True;
end case;
end Set_Pattern;
- procedure Pattern (Men : in Menu;
+ procedure Pattern (Men : Menu;
Text : out String)
is
function Get_Pattern (Men : Menu) return chars_ptr;
@@ -761,98 +668,80 @@
Fill_String (Get_Pattern (Men), Text);
end Pattern;
-------------------------------------------------------------------------------
- procedure Set_Format (Men : in Menu;
- Lines : in Line_Count;
- Columns : in Column_Count)
+ 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;
+ Col : C_Int) return Eti_Error;
pragma Import (C, Set_Menu_Fmt, "set_menu_format");
- Res : constant Eti_Error := Set_Menu_Fmt (Men,
- C_Int (Lines),
- C_Int (Columns));
begin
- if Res /= E_Ok then
- Eti_Exception (Res);
- end if;
+ Eti_Exception (Set_Menu_Fmt (Men,
+ C_Int (Lines),
+ C_Int (Columns)));
+
end Set_Format;
- procedure Format (Men : in Menu;
+ 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;
+ Y, X : C_Int_Access) return Eti_Error;
pragma Import (C, Menu_Fmt, "menu_format");
L, C : aliased C_Int;
- Res : constant Eti_Error := Menu_Fmt (Men, L'Access, C'Access);
begin
- if Res /= E_Ok then
- Eti_Exception (Res);
- else
- Lines := Line_Count (L);
- Columns := Column_Count (C);
- end if;
+ Eti_Exception (Menu_Fmt (Men, L'Access, C'Access));
+ Lines := Line_Count (L);
+ Columns := Column_Count (C);
end Format;
-------------------------------------------------------------------------------
- procedure Set_Item_Init_Hook (Men : in Menu;
- Proc : in Menu_Hook_Function)
+ procedure Set_Item_Init_Hook (Men : Menu;
+ Proc : Menu_Hook_Function)
is
function Set_Item_Init (Men : Menu;
- Proc : Menu_Hook_Function) return C_Int;
+ Proc : Menu_Hook_Function) return Eti_Error;
pragma Import (C, Set_Item_Init, "set_item_init");
- Res : constant Eti_Error := Set_Item_Init (Men, Proc);
begin
- if Res /= E_Ok then
- Eti_Exception (Res);
- end if;
+ Eti_Exception (Set_Item_Init (Men, Proc));
end Set_Item_Init_Hook;
- procedure Set_Item_Term_Hook (Men : in Menu;
- Proc : in Menu_Hook_Function)
+ procedure Set_Item_Term_Hook (Men : Menu;
+ Proc : Menu_Hook_Function)
is
function Set_Item_Term (Men : Menu;
- Proc : Menu_Hook_Function) return C_Int;
+ Proc : Menu_Hook_Function) return Eti_Error;
pragma Import (C, Set_Item_Term, "set_item_term");
- Res : constant Eti_Error := Set_Item_Term (Men, Proc);
begin
- if Res /= E_Ok then
- Eti_Exception (Res);
- end if;
+ Eti_Exception (Set_Item_Term (Men, Proc));
end Set_Item_Term_Hook;
- procedure Set_Menu_Init_Hook (Men : in Menu;
- Proc : in Menu_Hook_Function)
+ procedure Set_Menu_Init_Hook (Men : Menu;
+ Proc : Menu_Hook_Function)
is
function Set_Menu_Init (Men : Menu;
- Proc : Menu_Hook_Function) return C_Int;
+ Proc : Menu_Hook_Function) return Eti_Error;
pragma Import (C, Set_Menu_Init, "set_menu_init");
- Res : constant Eti_Error := Set_Menu_Init (Men, Proc);
begin
- if Res /= E_Ok then
- Eti_Exception (Res);
- end if;
+ Eti_Exception (Set_Menu_Init (Men, Proc));
end Set_Menu_Init_Hook;
- procedure Set_Menu_Term_Hook (Men : in Menu;
- Proc : in Menu_Hook_Function)
+ procedure Set_Menu_Term_Hook (Men : Menu;
+ Proc : Menu_Hook_Function)
is
function Set_Menu_Term (Men : Menu;
- Proc : Menu_Hook_Function) return C_Int;
+ Proc : Menu_Hook_Function) return Eti_Error;
pragma Import (C, Set_Menu_Term, "set_menu_term");
- Res : constant Eti_Error := Set_Menu_Term (Men, Proc);
begin
- if Res /= E_Ok then
- Eti_Exception (Res);
- end if;
+ Eti_Exception (Set_Menu_Term (Men, Proc));
end Set_Menu_Term_Hook;
function Get_Item_Init_Hook (Men : Menu) return Menu_Hook_Function
@@ -887,23 +776,19 @@
return Menu_Term (Men);
end Get_Menu_Term_Hook;
-------------------------------------------------------------------------------
- procedure Redefine (Men : in Menu;
- Items : in Item_Array_Access)
+ procedure Redefine (Men : Menu;
+ Items : Item_Array_Access)
is
function Set_Items (Men : Menu;
- Items : System.Address) return C_Int;
+ Items : System.Address) return Eti_Error;
pragma Import (C, Set_Items, "set_menu_items");
- Res : Eti_Error;
begin
- pragma Assert (Items (Items'Last) = Null_Item);
- if Items (Items'Last) /= Null_Item then
+ pragma Assert (Items.all (Items'Last) = Null_Item);
+ if Items.all (Items'Last) /= Null_Item then
raise Menu_Exception;
else
- Res := Set_Items (Men, Items.all'Address);
- if Res /= E_Ok then
- Eti_Exception (Res);
- end if;
+ Eti_Exception (Set_Items (Men, Items.all'Address));
end if;
end Redefine;
@@ -941,8 +826,8 @@
M : Menu;
begin
- pragma Assert (Items (Items'Last) = Null_Item);
- if Items (Items'Last) /= Null_Item then
+ pragma Assert (Items.all (Items'Last) = Null_Item);
+ if Items.all (Items'Last) /= Null_Item then
raise Menu_Exception;
else
M := Newmenu (Items.all'Address);
@@ -955,14 +840,11 @@
procedure Delete (Men : in out Menu)
is
- function Free (Men : Menu) return C_Int;
+ function Free (Men : Menu) return Eti_Error;
pragma Import (C, Free, "free_menu");
- Res : constant Eti_Error := Free (Men);
begin
- if Res /= E_Ok then
- Eti_Exception (Res);
- end if;
+ Eti_Exception (Free (Men));
Men := Null_Menu;
end Delete;
@@ -971,34 +853,34 @@
Key : Key_Code) return Driver_Result
is
function Driver (Men : Menu;
- Key : C_Int) return C_Int;
+ Key : C_Int) return Eti_Error;
pragma Import (C, Driver, "menu_driver");
R : constant Eti_Error := Driver (Men, C_Int (Key));
begin
- if R /= E_Ok then
- case R is
- when E_Unknown_Command => return Unknown_Request;
- when E_No_Match => return No_Match;
- when E_Request_Denied |
- E_Not_Selectable => return Request_Denied;
- when others =>
- Eti_Exception (R);
- end case;
- end if;
- return Menu_Ok;
+ case R is
+ when E_Unknown_Command =>
+ return Unknown_Request;
+ when E_No_Match =>
+ return No_Match;
+ when E_Request_Denied | E_Not_Selectable =>
+ return Request_Denied;
+ when others =>
+ Eti_Exception (R);
+ return Menu_Ok;
+ end case;
end Driver;
procedure Free (IA : in out Item_Array_Access;
- Free_Items : in Boolean := False)
+ Free_Items : Boolean := False)
is
procedure Release is new Ada.Unchecked_Deallocation
(Item_Array, Item_Array_Access);
begin
if IA /= null and then Free_Items then
for I in IA'First .. (IA'Last - 1) loop
- if IA (I) /= Null_Item then
- Delete (IA (I));
+ if IA.all (I) /= Null_Item then
+ Delete (IA.all (I));
end if;
end loop;
end if;
diff --git a/Ada95/src/terminal_interface-curses-mouse.adb b/Ada95/src/terminal_interface-curses-mouse.adb
index fa4c69d..7a6075c 100644
--- a/Ada95/src/terminal_interface-curses-mouse.adb
+++ b/Ada95/src/terminal_interface-curses-mouse.adb
@@ -7,7 +7,7 @@
-- B O D Y --
-- --
------------------------------------------------------------------------------
--- Copyright (c) 1998-2004,2008 Free Software Foundation, Inc. --
+-- Copyright (c) 1998-2009,2014 Free Software Foundation, Inc. --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files (the --
@@ -35,8 +35,8 @@
------------------------------------------------------------------------------
-- Author: Juergen Pfeifer, 1996
-- Version Control:
--- $Revision: 1.22 $
--- $Date: 2008/07/26 18:51:11 $
+-- $Revision: 1.25 $
+-- $Date: 2014/09/13 19:10:18 $
-- Binding Version 01.00
------------------------------------------------------------------------------
with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux;
@@ -50,7 +50,7 @@
function Has_Mouse return Boolean
is
function Mouse_Avail return C_Int;
- pragma Import (C, Mouse_Avail, "_nc_has_mouse");
+ pragma Import (C, Mouse_Avail, "has_mouse");
begin
if Has_Key (Key_Mouse) or else Mouse_Avail /= 0 then
return True;
@@ -74,8 +74,8 @@
return Event;
end Get_Mouse;
- procedure Register_Reportable_Event (Button : in Mouse_Button;
- State : in Button_State;
+ procedure Register_Reportable_Event (Button : Mouse_Button;
+ State : Button_State;
Mask : in out Event_Mask)
is
Button_Nr : constant Natural := Mouse_Button'Pos (Button);
@@ -92,8 +92,8 @@
end if;
end Register_Reportable_Event;
- procedure Register_Reportable_Events (Button : in Mouse_Button;
- State : in Button_States;
+ procedure Register_Reportable_Events (Button : Mouse_Button;
+ State : Button_States;
Mask : in out Event_Mask)
is
begin
@@ -120,7 +120,7 @@
return Old;
end Start_Mouse;
- procedure End_Mouse (Mask : in Event_Mask := No_Events)
+ procedure End_Mouse (Mask : Event_Mask := No_Events)
is
begin
if Mask /= No_Events then
@@ -128,11 +128,11 @@
end if;
end End_Mouse;
- procedure Dispatch_Event (Mask : in Event_Mask;
+ procedure Dispatch_Event (Mask : Event_Mask;
Button : out Mouse_Button;
State : out Button_State);
- procedure Dispatch_Event (Mask : in Event_Mask;
+ procedure Dispatch_Event (Mask : Event_Mask;
Button : out Mouse_Button;
State : out Button_State) is
L : Event_Mask;
@@ -168,7 +168,7 @@
end if;
end Dispatch_Event;
- procedure Get_Event (Event : in Mouse_Event;
+ procedure Get_Event (Event : Mouse_Event;
Y : out Line_Position;
X : out Column_Position;
Button : out Mouse_Button;
@@ -181,7 +181,7 @@
Dispatch_Event (Mask, Button, State);
end Get_Event;
- procedure Unget_Mouse (Event : in Mouse_Event)
+ procedure Unget_Mouse (Event : Mouse_Event)
is
function Ungetmouse (Ev : Mouse_Event) return C_Int;
pragma Import (C, Ungetmouse, "ungetmouse");
@@ -199,7 +199,8 @@
pragma Import (C, Wenclose, "wenclose");
begin
if Wenclose (Win, C_Int (Event.Y), C_Int (Event.X))
- = Curses_Bool_False then
+ = Curses_Bool_False
+ then
return False;
else
return True;
diff --git a/Ada95/src/terminal_interface-curses-panels-user_data.adb b/Ada95/src/terminal_interface-curses-panels-user_data.adb
index 231efae..d855f54 100644
--- a/Ada95/src/terminal_interface-curses-panels-user_data.adb
+++ b/Ada95/src/terminal_interface-curses-panels-user_data.adb
@@ -7,7 +7,7 @@
-- B O D Y --
-- --
------------------------------------------------------------------------------
--- Copyright (c) 1998 Free Software Foundation, Inc. --
+-- 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 --
@@ -35,7 +35,7 @@
------------------------------------------------------------------------------
-- Author: Juergen Pfeifer, 1996
-- Version Control:
--- $Revision: 1.11 $
+-- $Revision: 1.12 $
-- Binding Version 01.00
------------------------------------------------------------------------------
with Interfaces.C;
@@ -48,8 +48,8 @@
use type Interfaces.C.int;
- procedure Set_User_Data (Pan : in Panel;
- Data : in User_Access)
+ procedure Set_User_Data (Pan : Panel;
+ Data : User_Access)
is
function Set_Panel_Userptr (Pan : Panel;
Addr : User_Access) return C_Int;
@@ -60,7 +60,7 @@
end if;
end Set_User_Data;
- function Get_User_Data (Pan : in Panel) return User_Access
+ 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");
@@ -68,7 +68,7 @@
return Panel_Userptr (Pan);
end Get_User_Data;
- procedure Get_User_Data (Pan : in Panel;
+ procedure Get_User_Data (Pan : Panel;
Data : out User_Access)
is
begin
diff --git a/Ada95/src/terminal_interface-curses-panels.adb b/Ada95/src/terminal_interface-curses-panels.adb
index d7e18fa..84e29e5 100644
--- a/Ada95/src/terminal_interface-curses-panels.adb
+++ b/Ada95/src/terminal_interface-curses-panels.adb
@@ -7,7 +7,7 @@
-- B O D Y --
-- --
------------------------------------------------------------------------------
--- Copyright (c) 1998,2004 Free Software Foundation, Inc. --
+-- 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 --
@@ -35,8 +35,8 @@
------------------------------------------------------------------------------
-- Author: Juergen Pfeifer, 1996
-- Version Control:
--- $Revision: 1.13 $
--- $Date: 2004/08/21 21:37:00 $
+-- $Revision: 1.14 $
+-- $Date: 2009/12/26 17:38:58 $
-- Binding Version 01.00
------------------------------------------------------------------------------
with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux;
@@ -60,7 +60,7 @@
return Pan;
end Create;
- procedure Bottom (Pan : in Panel)
+ procedure Bottom (Pan : Panel)
is
function Bottompanel (Pan : Panel) return C_Int;
pragma Import (C, Bottompanel, "bottom_panel");
@@ -70,7 +70,7 @@
end if;
end Bottom;
- procedure Top (Pan : in Panel)
+ procedure Top (Pan : Panel)
is
function Toppanel (Pan : Panel) return C_Int;
pragma Import (C, Toppanel, "top_panel");
@@ -80,7 +80,7 @@
end if;
end Top;
- procedure Show (Pan : in Panel)
+ procedure Show (Pan : Panel)
is
function Showpanel (Pan : Panel) return C_Int;
pragma Import (C, Showpanel, "show_panel");
@@ -90,7 +90,7 @@
end if;
end Show;
- procedure Hide (Pan : in Panel)
+ procedure Hide (Pan : Panel)
is
function Hidepanel (Pan : Panel) return C_Int;
pragma Import (C, Hidepanel, "hide_panel");
@@ -113,8 +113,8 @@
return Win;
end Get_Window;
- procedure Replace (Pan : in Panel;
- Win : in Window)
+ procedure Replace (Pan : Panel;
+ Win : Window)
is
function Replace_Pan (Pan : Panel;
Win : Window) return C_Int;
@@ -125,9 +125,9 @@
end if;
end Replace;
- procedure Move (Pan : in Panel;
- Line : in Line_Position;
- Column : in Column_Position)
+ procedure Move (Pan : Panel;
+ Line : Line_Position;
+ Column : Column_Position)
is
function Move (Pan : Panel;
Line : C_Int;
diff --git a/Ada95/src/terminal_interface-curses-termcap.adb b/Ada95/src/terminal_interface-curses-termcap.adb
index fd3c646..6438657 100644
--- a/Ada95/src/terminal_interface-curses-termcap.adb
+++ b/Ada95/src/terminal_interface-curses-termcap.adb
@@ -7,7 +7,7 @@
-- B O D Y --
-- --
------------------------------------------------------------------------------
--- Copyright (c) 2000-2004,2006 Free Software Foundation, Inc. --
+-- 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 --
@@ -35,8 +35,8 @@
------------------------------------------------------------------------------
-- Author: Juergen Pfeifer, 1996
-- Version Control:
--- $Revision: 1.11 $
--- $Date: 2006/06/25 14:30:22 $
+-- $Revision: 1.12 $
+-- $Date: 2009/12/26 17:38:58 $
-- Binding Version 01.00
------------------------------------------------------------------------------
@@ -82,7 +82,7 @@
end Get_Flag;
------------------------------------------------------------------------------
- procedure Get_Number (Name : in String;
+ procedure Get_Number (Name : String;
Value : out Integer;
Result : out Boolean)
is
diff --git a/Ada95/src/terminal_interface-curses-terminfo.adb b/Ada95/src/terminal_interface-curses-terminfo.adb
index a3fbe25..9b3c9d5 100644
--- a/Ada95/src/terminal_interface-curses-terminfo.adb
+++ b/Ada95/src/terminal_interface-curses-terminfo.adb
@@ -7,7 +7,7 @@
-- B O D Y --
-- --
------------------------------------------------------------------------------
--- Copyright (c) 1998-2000,2006 Free Software Foundation, Inc. --
+-- 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 --
@@ -35,8 +35,8 @@
------------------------------------------------------------------------------
-- Author: Juergen Pfeifer, 1996
-- Version Control:
--- $Revision: 1.5 $
--- $Date: 2006/06/25 14:30:22 $
+-- $Revision: 1.6 $
+-- $Date: 2009/12/26 17:38:58 $
-- Binding Version 01.00
------------------------------------------------------------------------------
@@ -47,9 +47,9 @@
package body Terminal_Interface.Curses.Terminfo is
- function Is_MinusOne_Pointer (P : in chars_ptr) return Boolean;
+ function Is_MinusOne_Pointer (P : chars_ptr) return Boolean;
- function Is_MinusOne_Pointer (P : in chars_ptr) return Boolean is
+ 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
diff --git a/Ada95/src/terminal_interface-curses-text_io-aux.adb b/Ada95/src/terminal_interface-curses-text_io-aux.adb
index 06b4876..50a4e44 100644
--- a/Ada95/src/terminal_interface-curses-text_io-aux.adb
+++ b/Ada95/src/terminal_interface-curses-text_io-aux.adb
@@ -7,7 +7,7 @@
-- B O D Y --
-- --
------------------------------------------------------------------------------
--- Copyright (c) 1998,2006 Free Software Foundation, Inc. --
+-- 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 --
@@ -35,18 +35,18 @@
------------------------------------------------------------------------------
-- Author: Juergen Pfeifer, 1996
-- Version Control:
--- $Revision: 1.12 $
--- $Date: 2006/06/25 14:24:40 $
+-- $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 : in Window;
- Buf : in String;
- Width : in Field;
- Signal : in Boolean := True;
- Ljust : in Boolean := False)
+ (Win : Window;
+ Buf : String;
+ Width : Field;
+ Signal : Boolean := True;
+ Ljust : Boolean := False)
is
L : Field;
Len : Field;
diff --git a/Ada95/src/terminal_interface-curses-text_io-aux.ads b/Ada95/src/terminal_interface-curses-text_io-aux.ads
index df8a9bd..6b50b33 100644
--- a/Ada95/src/terminal_interface-curses-text_io-aux.ads
+++ b/Ada95/src/terminal_interface-curses-text_io-aux.ads
@@ -7,7 +7,7 @@
-- S P E C --
-- --
------------------------------------------------------------------------------
--- Copyright (c) 1998,2006 Free Software Foundation, Inc. --
+-- 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 --
@@ -35,8 +35,8 @@
------------------------------------------------------------------------------
-- Author: Juergen Pfeifer, 1996
-- Version Control:
--- $Revision: 1.13 $
--- $Date: 2006/06/25 14:24:40 $
+-- $Revision: 1.14 $
+-- $Date: 2009/12/26 17:38:58 $
-- Binding Version 01.00
------------------------------------------------------------------------------
private package Terminal_Interface.Curses.Text_IO.Aux is
@@ -46,10 +46,10 @@
-- and enumeration types.
--
procedure Put_Buf
- (Win : in Window; -- The output window
- Buf : in String; -- The buffer containing the text
- Width : in Field; -- The width of the output field
- Signal : in Boolean := True; -- If true, we raise Layout_Error
- Ljust : in Boolean := False); -- The Buf is left justified
+ (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
index 3b5871e..6c2e144 100644
--- a/Ada95/src/terminal_interface-curses-text_io-complex_io.adb
+++ b/Ada95/src/terminal_interface-curses-text_io-complex_io.adb
@@ -7,7 +7,7 @@
-- B O D Y --
-- --
------------------------------------------------------------------------------
--- Copyright (c) 1998 Free Software Foundation, Inc. --
+-- 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 --
@@ -35,7 +35,7 @@
------------------------------------------------------------------------------
-- Author: Juergen Pfeifer, 1996
-- Version Control:
--- $Revision: 1.10 $
+-- $Revision: 1.11 $
-- Binding Version 01.00
------------------------------------------------------------------------------
with Terminal_Interface.Curses.Text_IO.Float_IO;
@@ -46,11 +46,11 @@
Terminal_Interface.Curses.Text_IO.Float_IO (Complex_Types.Real'Base);
procedure Put
- (Win : in Window;
- Item : in Complex;
- Fore : in Field := Default_Fore;
- Aft : in Field := Default_Aft;
- Exp : in Field := Default_Exp)
+ (Win : Window;
+ Item : Complex;
+ Fore : Field := Default_Fore;
+ Aft : Field := Default_Aft;
+ Exp : Field := Default_Exp)
is
begin
Put (Win, '(');
@@ -61,10 +61,10 @@
end Put;
procedure Put
- (Item : in Complex;
- Fore : in Field := Default_Fore;
- Aft : in Field := Default_Aft;
- Exp : in Field := Default_Exp)
+ (Item : Complex;
+ Fore : Field := Default_Fore;
+ Aft : Field := Default_Aft;
+ Exp : Field := Default_Exp)
is
begin
Put (Get_Window, Item, Fore, Aft, Exp);
diff --git a/Ada95/src/terminal_interface-curses-text_io-complex_io.ads b/Ada95/src/terminal_interface-curses-text_io-complex_io.ads
index 233eb3c..e613458 100644
--- a/Ada95/src/terminal_interface-curses-text_io-complex_io.ads
+++ b/Ada95/src/terminal_interface-curses-text_io-complex_io.ads
@@ -7,7 +7,7 @@
-- S P E C --
-- --
------------------------------------------------------------------------------
--- Copyright (c) 1998 Free Software Foundation, Inc. --
+-- 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 --
@@ -35,7 +35,7 @@
------------------------------------------------------------------------------
-- Author: Juergen Pfeifer, 1996
-- Version Control:
--- $Revision: 1.10 $
+-- $Revision: 1.11 $
-- Binding Version 01.00
------------------------------------------------------------------------------
with Ada.Numerics.Generic_Complex_Types;
@@ -52,17 +52,17 @@
Default_Exp : Field := 3;
procedure Put
- (Win : in Window;
- Item : in Complex;
- Fore : in Field := Default_Fore;
- Aft : in Field := Default_Aft;
- Exp : in Field := Default_Exp);
+ (Win : Window;
+ Item : Complex;
+ Fore : Field := Default_Fore;
+ Aft : Field := Default_Aft;
+ Exp : Field := Default_Exp);
procedure Put
- (Item : in Complex;
- Fore : in Field := Default_Fore;
- Aft : in Field := Default_Aft;
- Exp : in Field := Default_Exp);
+ (Item : Complex;
+ Fore : Field := Default_Fore;
+ Aft : Field := Default_Aft;
+ Exp : Field := Default_Exp);
private
pragma Inline (Put);
diff --git a/Ada95/src/terminal_interface-curses-text_io-decimal_io.adb b/Ada95/src/terminal_interface-curses-text_io-decimal_io.adb
index 02068a0..1b1ad8c 100644
--- a/Ada95/src/terminal_interface-curses-text_io-decimal_io.adb
+++ b/Ada95/src/terminal_interface-curses-text_io-decimal_io.adb
@@ -7,7 +7,7 @@
-- B O D Y --
-- --
------------------------------------------------------------------------------
--- Copyright (c) 1998 Free Software Foundation, Inc. --
+-- 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 --
@@ -35,7 +35,7 @@
------------------------------------------------------------------------------
-- Author: Juergen Pfeifer, 1996
-- Version Control:
--- $Revision: 1.10 $
+-- $Revision: 1.11 $
-- Binding Version 01.00
------------------------------------------------------------------------------
with Ada.Text_IO;
@@ -47,11 +47,11 @@
package DIO is new Ada.Text_IO.Decimal_IO (Num);
procedure Put
- (Win : in Window;
- Item : in Num;
- Fore : in Field := Default_Fore;
- Aft : in Field := Default_Aft;
- Exp : in Field := Default_Exp)
+ (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;
@@ -64,10 +64,10 @@
end Put;
procedure Put
- (Item : in Num;
- Fore : in Field := Default_Fore;
- Aft : in Field := Default_Aft;
- Exp : in Field := Default_Exp) is
+ (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;
diff --git a/Ada95/src/terminal_interface-curses-text_io-decimal_io.ads b/Ada95/src/terminal_interface-curses-text_io-decimal_io.ads
index 6f6fe75..1590127 100644
--- a/Ada95/src/terminal_interface-curses-text_io-decimal_io.ads
+++ b/Ada95/src/terminal_interface-curses-text_io-decimal_io.ads
@@ -7,7 +7,7 @@
-- S P E C --
-- --
------------------------------------------------------------------------------
--- Copyright (c) 1998 Free Software Foundation, Inc. --
+-- 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 --
@@ -35,7 +35,7 @@
------------------------------------------------------------------------------
-- Author: Juergen Pfeifer, 1996
-- Version Control:
--- $Revision: 1.11 $
+-- $Revision: 1.12 $
-- Binding Version 01.00
------------------------------------------------------------------------------
generic
@@ -48,17 +48,17 @@
Default_Exp : Field := 0;
procedure Put
- (Win : in Window;
- Item : in Num;
- Fore : in Field := Default_Fore;
- Aft : in Field := Default_Aft;
- Exp : in Field := Default_Exp);
+ (Win : Window;
+ Item : Num;
+ Fore : Field := Default_Fore;
+ Aft : Field := Default_Aft;
+ Exp : Field := Default_Exp);
procedure Put
- (Item : in Num;
- Fore : in Field := Default_Fore;
- Aft : in Field := Default_Aft;
- Exp : in Field := Default_Exp);
+ (Item : Num;
+ Fore : Field := Default_Fore;
+ Aft : Field := Default_Aft;
+ Exp : Field := Default_Exp);
private
pragma Inline (Put);
diff --git a/Ada95/src/terminal_interface-curses-text_io-enumeration_io.adb b/Ada95/src/terminal_interface-curses-text_io-enumeration_io.adb
index 528873a..53f3e55 100644
--- a/Ada95/src/terminal_interface-curses-text_io-enumeration_io.adb
+++ b/Ada95/src/terminal_interface-curses-text_io-enumeration_io.adb
@@ -7,7 +7,7 @@
-- B O D Y --
-- --
------------------------------------------------------------------------------
--- Copyright (c) 1998 Free Software Foundation, Inc. --
+-- 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 --
@@ -35,7 +35,7 @@
------------------------------------------------------------------------------
-- Author: Juergen Pfeifer, 1996
-- Version Control:
--- $Revision: 1.10 $
+-- $Revision: 1.11 $
-- Binding Version 01.00
------------------------------------------------------------------------------
with Ada.Text_IO;
@@ -48,10 +48,10 @@
package EIO is new Ada.Text_IO.Enumeration_IO (Enum);
procedure Put
- (Win : in Window;
- Item : in Enum;
- Width : in Field := Default_Width;
- Set : in Type_Set := Default_Setting)
+ (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;
@@ -69,9 +69,9 @@
end Put;
procedure Put
- (Item : in Enum;
- Width : in Field := Default_Width;
- Set : in Type_Set := Default_Setting)
+ (Item : Enum;
+ Width : Field := Default_Width;
+ Set : Type_Set := Default_Setting)
is
begin
Put (Get_Window, Item, Width, Set);
diff --git a/Ada95/src/terminal_interface-curses-text_io-enumeration_io.ads b/Ada95/src/terminal_interface-curses-text_io-enumeration_io.ads
index b221d7f..a981f0e 100644
--- a/Ada95/src/terminal_interface-curses-text_io-enumeration_io.ads
+++ b/Ada95/src/terminal_interface-curses-text_io-enumeration_io.ads
@@ -7,7 +7,7 @@
-- S P E C --
-- --
------------------------------------------------------------------------------
--- Copyright (c) 1998 Free Software Foundation, Inc. --
+-- 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 --
@@ -35,7 +35,7 @@
------------------------------------------------------------------------------
-- Author: Juergen Pfeifer, 1996
-- Version Control:
--- $Revision: 1.11 $
+-- $Revision: 1.12 $
-- Binding Version 01.00
------------------------------------------------------------------------------
generic
@@ -47,15 +47,15 @@
Default_Setting : Type_Set := Mixed_Case;
procedure Put
- (Win : in Window;
- Item : in Enum;
- Width : in Field := Default_Width;
- Set : in Type_Set := Default_Setting);
+ (Win : Window;
+ Item : Enum;
+ Width : Field := Default_Width;
+ Set : Type_Set := Default_Setting);
procedure Put
- (Item : in Enum;
- Width : in Field := Default_Width;
- Set : in Type_Set := Default_Setting);
+ (Item : Enum;
+ Width : Field := Default_Width;
+ Set : Type_Set := Default_Setting);
private
pragma Inline (Put);
diff --git a/Ada95/src/terminal_interface-curses-text_io-fixed_io.adb b/Ada95/src/terminal_interface-curses-text_io-fixed_io.adb
index e74f148..13a3420 100644
--- a/Ada95/src/terminal_interface-curses-text_io-fixed_io.adb
+++ b/Ada95/src/terminal_interface-curses-text_io-fixed_io.adb
@@ -7,7 +7,7 @@
-- B O D Y --
-- --
------------------------------------------------------------------------------
--- Copyright (c) 1998 Free Software Foundation, Inc. --
+-- 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 --
@@ -35,7 +35,7 @@
------------------------------------------------------------------------------
-- Author: Juergen Pfeifer, 1996
-- Version Control:
--- $Revision: 1.10 $
+-- $Revision: 1.11 $
-- Binding Version 01.00
------------------------------------------------------------------------------
with Ada.Text_IO;
@@ -47,11 +47,11 @@
package FIXIO is new Ada.Text_IO.Fixed_IO (Num);
procedure Put
- (Win : in Window;
- Item : in Num;
- Fore : in Field := Default_Fore;
- Aft : in Field := Default_Aft;
- Exp : in Field := Default_Exp)
+ (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;
@@ -64,10 +64,10 @@
end Put;
procedure Put
- (Item : in Num;
- Fore : in Field := Default_Fore;
- Aft : in Field := Default_Aft;
- Exp : in Field := Default_Exp) is
+ (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;
diff --git a/Ada95/src/terminal_interface-curses-text_io-fixed_io.ads b/Ada95/src/terminal_interface-curses-text_io-fixed_io.ads
index 4b8b136..3c22a01 100644
--- a/Ada95/src/terminal_interface-curses-text_io-fixed_io.ads
+++ b/Ada95/src/terminal_interface-curses-text_io-fixed_io.ads
@@ -7,7 +7,7 @@
-- S P E C --
-- --
------------------------------------------------------------------------------
--- Copyright (c) 1998 Free Software Foundation, Inc. --
+-- 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 --
@@ -35,7 +35,7 @@
------------------------------------------------------------------------------
-- Author: Juergen Pfeifer, 1996
-- Version Control:
--- $Revision: 1.11 $
+-- $Revision: 1.12 $
-- Binding Version 01.00
------------------------------------------------------------------------------
generic
@@ -48,17 +48,17 @@
Default_Exp : Field := 0;
procedure Put
- (Win : in Window;
- Item : in Num;
- Fore : in Field := Default_Fore;
- Aft : in Field := Default_Aft;
- Exp : in Field := Default_Exp);
+ (Win : Window;
+ Item : Num;
+ Fore : Field := Default_Fore;
+ Aft : Field := Default_Aft;
+ Exp : Field := Default_Exp);
procedure Put
- (Item : in Num;
- Fore : in Field := Default_Fore;
- Aft : in Field := Default_Aft;
- Exp : in Field := Default_Exp);
+ (Item : Num;
+ Fore : Field := Default_Fore;
+ Aft : Field := Default_Aft;
+ Exp : Field := Default_Exp);
private
pragma Inline (Put);
diff --git a/Ada95/src/terminal_interface-curses-text_io-float_io.adb b/Ada95/src/terminal_interface-curses-text_io-float_io.adb
index 19d261b..af667b4 100644
--- a/Ada95/src/terminal_interface-curses-text_io-float_io.adb
+++ b/Ada95/src/terminal_interface-curses-text_io-float_io.adb
@@ -7,7 +7,7 @@
-- B O D Y --
-- --
------------------------------------------------------------------------------
--- Copyright (c) 1998 Free Software Foundation, Inc. --
+-- 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 --
@@ -35,7 +35,7 @@
------------------------------------------------------------------------------
-- Author: Juergen Pfeifer, 1996
-- Version Control:
--- $Revision: 1.10 $
+-- $Revision: 1.11 $
-- Binding Version 01.00
------------------------------------------------------------------------------
with Ada.Text_IO;
@@ -47,11 +47,11 @@
package FIO is new Ada.Text_IO.Float_IO (Num);
procedure Put
- (Win : in Window;
- Item : in Num;
- Fore : in Field := Default_Fore;
- Aft : in Field := Default_Aft;
- Exp : in Field := Default_Exp)
+ (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;
@@ -64,10 +64,10 @@
end Put;
procedure Put
- (Item : in Num;
- Fore : in Field := Default_Fore;
- Aft : in Field := Default_Aft;
- Exp : in Field := Default_Exp)
+ (Item : Num;
+ Fore : Field := Default_Fore;
+ Aft : Field := Default_Aft;
+ Exp : Field := Default_Exp)
is
begin
Put (Get_Window, Item, Fore, Aft, Exp);
diff --git a/Ada95/src/terminal_interface-curses-text_io-float_io.ads b/Ada95/src/terminal_interface-curses-text_io-float_io.ads
index 0856523..b0a68d0 100644
--- a/Ada95/src/terminal_interface-curses-text_io-float_io.ads
+++ b/Ada95/src/terminal_interface-curses-text_io-float_io.ads
@@ -7,7 +7,7 @@
-- S P E C --
-- --
------------------------------------------------------------------------------
--- Copyright (c) 1998 Free Software Foundation, Inc. --
+-- 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 --
@@ -35,7 +35,7 @@
------------------------------------------------------------------------------
-- Author: Juergen Pfeifer, 1996
-- Version Control:
--- $Revision: 1.11 $
+-- $Revision: 1.12 $
-- Binding Version 01.00
------------------------------------------------------------------------------
generic
@@ -48,17 +48,17 @@
Default_Exp : Field := 3;
procedure Put
- (Win : in Window;
- Item : in Num;
- Fore : in Field := Default_Fore;
- Aft : in Field := Default_Aft;
- Exp : in Field := Default_Exp);
+ (Win : Window;
+ Item : Num;
+ Fore : Field := Default_Fore;
+ Aft : Field := Default_Aft;
+ Exp : Field := Default_Exp);
procedure Put
- (Item : in Num;
- Fore : in Field := Default_Fore;
- Aft : in Field := Default_Aft;
- Exp : in Field := Default_Exp);
+ (Item : Num;
+ Fore : Field := Default_Fore;
+ Aft : Field := Default_Aft;
+ Exp : Field := Default_Exp);
private
pragma Inline (Put);
diff --git a/Ada95/src/terminal_interface-curses-text_io-integer_io.adb b/Ada95/src/terminal_interface-curses-text_io-integer_io.adb
index e694e08..4d19c42 100644
--- a/Ada95/src/terminal_interface-curses-text_io-integer_io.adb
+++ b/Ada95/src/terminal_interface-curses-text_io-integer_io.adb
@@ -7,7 +7,7 @@
-- B O D Y --
-- --
------------------------------------------------------------------------------
--- Copyright (c) 1998 Free Software Foundation, Inc. --
+-- 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 --
@@ -35,7 +35,7 @@
------------------------------------------------------------------------------
-- Author: Juergen Pfeifer, 1996
-- Version Control:
--- $Revision: 1.10 $
+-- $Revision: 1.11 $
-- Binding Version 01.00
------------------------------------------------------------------------------
with Ada.Text_IO;
@@ -47,10 +47,10 @@
package IIO is new Ada.Text_IO.Integer_IO (Num);
procedure Put
- (Win : in Window;
- Item : in Num;
- Width : in Field := Default_Width;
- Base : in Number_Base := Default_Base)
+ (Win : Window;
+ Item : Num;
+ Width : Field := Default_Width;
+ Base : Number_Base := Default_Base)
is
Buf : String (1 .. Field'Last);
begin
@@ -59,9 +59,9 @@
end Put;
procedure Put
- (Item : in Num;
- Width : in Field := Default_Width;
- Base : in Number_Base := Default_Base)
+ (Item : Num;
+ Width : Field := Default_Width;
+ Base : Number_Base := Default_Base)
is
begin
Put (Get_Window, Item, Width, Base);
diff --git a/Ada95/src/terminal_interface-curses-text_io-integer_io.ads b/Ada95/src/terminal_interface-curses-text_io-integer_io.ads
index d8b169a..9ffe1e0 100644
--- a/Ada95/src/terminal_interface-curses-text_io-integer_io.ads
+++ b/Ada95/src/terminal_interface-curses-text_io-integer_io.ads
@@ -7,7 +7,7 @@
-- S P E C --
-- --
------------------------------------------------------------------------------
--- Copyright (c) 1998 Free Software Foundation, Inc. --
+-- 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 --
@@ -35,7 +35,7 @@
------------------------------------------------------------------------------
-- Author: Juergen Pfeifer, 1996
-- Version Control:
--- $Revision: 1.11 $
+-- $Revision: 1.12 $
-- Binding Version 01.00
------------------------------------------------------------------------------
generic
@@ -47,15 +47,15 @@
Default_Base : Number_Base := 10;
procedure Put
- (Win : in Window;
- Item : in Num;
- Width : in Field := Default_Width;
- Base : in Number_Base := Default_Base);
+ (Win : Window;
+ Item : Num;
+ Width : Field := Default_Width;
+ Base : Number_Base := Default_Base);
procedure Put
- (Item : in Num;
- Width : in Field := Default_Width;
- Base : in Number_Base := Default_Base);
+ (Item : Num;
+ Width : Field := Default_Width;
+ Base : Number_Base := Default_Base);
private
pragma Inline (Put);
diff --git a/Ada95/src/terminal_interface-curses-text_io-modular_io.adb b/Ada95/src/terminal_interface-curses-text_io-modular_io.adb
index 8cc1d4a..fe8a6d0 100644
--- a/Ada95/src/terminal_interface-curses-text_io-modular_io.adb
+++ b/Ada95/src/terminal_interface-curses-text_io-modular_io.adb
@@ -7,7 +7,7 @@
-- B O D Y --
-- --
------------------------------------------------------------------------------
--- Copyright (c) 1998 Free Software Foundation, Inc. --
+-- 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 --
@@ -35,7 +35,7 @@
------------------------------------------------------------------------------
-- Author: Juergen Pfeifer, 1996
-- Version Control:
--- $Revision: 1.10 $
+-- $Revision: 1.11 $
-- Binding Version 01.00
------------------------------------------------------------------------------
with Ada.Text_IO;
@@ -47,10 +47,10 @@
package MIO is new Ada.Text_IO.Modular_IO (Num);
procedure Put
- (Win : in Window;
- Item : in Num;
- Width : in Field := Default_Width;
- Base : in Number_Base := Default_Base)
+ (Win : Window;
+ Item : Num;
+ Width : Field := Default_Width;
+ Base : Number_Base := Default_Base)
is
Buf : String (1 .. Field'Last);
begin
@@ -59,9 +59,9 @@
end Put;
procedure Put
- (Item : in Num;
- Width : in Field := Default_Width;
- Base : in Number_Base := Default_Base)
+ (Item : Num;
+ Width : Field := Default_Width;
+ Base : Number_Base := Default_Base)
is
begin
Put (Get_Window, Item, Width, Base);
diff --git a/Ada95/src/terminal_interface-curses-text_io-modular_io.ads b/Ada95/src/terminal_interface-curses-text_io-modular_io.ads
index 618706f..68e70e5 100644
--- a/Ada95/src/terminal_interface-curses-text_io-modular_io.ads
+++ b/Ada95/src/terminal_interface-curses-text_io-modular_io.ads
@@ -7,7 +7,7 @@
-- S P E C --
-- --
------------------------------------------------------------------------------
--- Copyright (c) 1998 Free Software Foundation, Inc. --
+-- 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 --
@@ -35,7 +35,7 @@
------------------------------------------------------------------------------
-- Author: Juergen Pfeifer, 1996
-- Version Control:
--- $Revision: 1.11 $
+-- $Revision: 1.12 $
-- Binding Version 01.00
------------------------------------------------------------------------------
generic
@@ -47,15 +47,15 @@
Default_Base : Number_Base := 10;
procedure Put
- (Win : in Window;
- Item : in Num;
- Width : in Field := Default_Width;
- Base : in Number_Base := Default_Base);
+ (Win : Window;
+ Item : Num;
+ Width : Field := Default_Width;
+ Base : Number_Base := Default_Base);
procedure Put
- (Item : in Num;
- Width : in Field := Default_Width;
- Base : in Number_Base := Default_Base);
+ (Item : Num;
+ Width : Field := Default_Width;
+ Base : Number_Base := Default_Base);
private
pragma Inline (Put);
diff --git a/Ada95/src/terminal_interface-curses-text_io.adb b/Ada95/src/terminal_interface-curses-text_io.adb
index 255b123..85a4f44 100644
--- a/Ada95/src/terminal_interface-curses-text_io.adb
+++ b/Ada95/src/terminal_interface-curses-text_io.adb
@@ -7,7 +7,7 @@
-- B O D Y --
-- --
------------------------------------------------------------------------------
--- Copyright (c) 1998-2004,2006 Free Software Foundation, Inc. --
+-- Copyright (c) 1998-2011,2014 Free Software Foundation, Inc. --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files (the --
@@ -35,15 +35,15 @@
------------------------------------------------------------------------------
-- Author: Juergen Pfeifer, 1996
-- Version Control:
--- $Revision: 1.18 $
--- $Date: 2006/06/25 14:24:40 $
+-- $Revision: 1.22 $
+-- $Date: 2014/05/24 21:32:18 $
-- Binding Version 01.00
------------------------------------------------------------------------------
package body Terminal_Interface.Curses.Text_IO is
Default_Window : Window := Null_Window;
- procedure Set_Window (Win : in Window)
+ procedure Set_Window (Win : Window)
is
begin
Default_Window := Win;
@@ -60,7 +60,7 @@
end Get_Window;
pragma Inline (Get_Window);
- procedure Flush (Win : in Window)
+ procedure Flush (Win : Window)
is
begin
Refresh (Win);
@@ -81,7 +81,7 @@
-- A scroll-window is interpreted as an page with unbounded page length,
-- i.e. it returns the conventional 0 as page length.
- function Line_Length (Win : in Window) return Count
+ function Line_Length (Win : Window) return Count
is
N_Lines : Line_Count;
N_Cols : Column_Count;
@@ -99,7 +99,7 @@
return Line_Length (Get_Window);
end Line_Length;
- function Page_Length (Win : in Window) return Count
+ function Page_Length (Win : Window) return Count
is
N_Lines : Line_Count;
N_Cols : Column_Count;
@@ -124,7 +124,7 @@
------------------------------------
-- Column, Line, and Page Control --
------------------------------------
- procedure New_Line (Win : in Window; Spacing : in Positive_Count := 1)
+ procedure New_Line (Win : Window; Spacing : Positive_Count := 1)
is
P_Size : constant Count := Page_Length (Win);
begin
@@ -141,13 +141,13 @@
end loop;
end New_Line;
- procedure New_Line (Spacing : in Positive_Count := 1)
+ procedure New_Line (Spacing : Positive_Count := 1)
is
begin
New_Line (Get_Window, Spacing);
end New_Line;
- procedure New_Page (Win : in Window)
+ procedure New_Page (Win : Window)
is
begin
Clear (Win);
@@ -159,7 +159,7 @@
New_Page (Get_Window);
end New_Page;
- procedure Set_Col (Win : in Window; To : in Positive_Count)
+ procedure Set_Col (Win : Window; To : Positive_Count)
is
Y : Line_Position;
X1 : Column_Position;
@@ -187,13 +187,13 @@
end if;
end Set_Col;
- procedure Set_Col (To : in Positive_Count)
+ procedure Set_Col (To : Positive_Count)
is
begin
Set_Col (Get_Window, To);
end Set_Col;
- procedure Set_Line (Win : in Window; To : in Positive_Count)
+ procedure Set_Line (Win : Window; To : Positive_Count)
is
Y1 : Line_Position;
Y2 : Line_Position;
@@ -205,6 +205,7 @@
end if;
Get_Cursor_Position (Win, Y1, X);
+ pragma Warnings (Off, X); -- unreferenced
N := Natural (To); N := N - 1;
Y2 := Line_Position (N);
if Y2 < Y1 then
@@ -216,13 +217,13 @@
end if;
end Set_Line;
- procedure Set_Line (To : in Positive_Count)
+ procedure Set_Line (To : Positive_Count)
is
begin
Set_Line (Get_Window, To);
end Set_Line;
- function Col (Win : in Window) return Positive_Count
+ function Col (Win : Window) return Positive_Count
is
Y : Line_Position;
X : Column_Position;
@@ -242,7 +243,7 @@
return Col (Get_Window);
end Col;
- function Line (Win : in Window) return Positive_Count
+ function Line (Win : Window) return Positive_Count
is
Y : Line_Position;
X : Column_Position;
@@ -266,7 +267,7 @@
-- Characters Output --
-----------------------
- procedure Put (Win : in Window; Item : in Character)
+ procedure Put (Win : Window; Item : Character)
is
P_Size : constant Count := Page_Length (Win);
Y : Line_Position;
@@ -284,7 +285,7 @@
Add (Win, Item);
end Put;
- procedure Put (Item : in Character)
+ procedure Put (Item : Character)
is
begin
Put (Get_Window, Item);
@@ -294,7 +295,7 @@
-- Strings-Output --
--------------------
- procedure Put (Win : in Window; Item : in String)
+ procedure Put (Win : Window; Item : String)
is
P_Size : constant Count := Page_Length (Win);
Y : Line_Position;
@@ -312,15 +313,15 @@
Add (Win, Item);
end Put;
- procedure Put (Item : in String)
+ procedure Put (Item : String)
is
begin
Put (Get_Window, Item);
end Put;
procedure Put_Line
- (Win : in Window;
- Item : in String)
+ (Win : Window;
+ Item : String)
is
begin
Put (Win, Item);
@@ -328,7 +329,7 @@
end Put_Line;
procedure Put_Line
- (Item : in String)
+ (Item : String)
is
begin
Put_Line (Get_Window, Item);
diff --git a/Ada95/src/terminal_interface-curses-text_io.ads b/Ada95/src/terminal_interface-curses-text_io.ads
index 2f6c48a..9c40329 100644
--- a/Ada95/src/terminal_interface-curses-text_io.ads
+++ b/Ada95/src/terminal_interface-curses-text_io.ads
@@ -7,7 +7,7 @@
-- S P E C --
-- --
------------------------------------------------------------------------------
--- Copyright (c) 1998 Free Software Foundation, Inc. --
+-- 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 --
@@ -35,7 +35,7 @@
------------------------------------------------------------------------------
-- Author: Juergen Pfeifer, 1996
-- Version Control:
--- $Revision: 1.13 $
+-- $Revision: 1.14 $
-- Binding Version 01.00
------------------------------------------------------------------------------
with Ada.Text_IO;
@@ -56,13 +56,13 @@
-- type parameter. They will operate on a default window, which can
-- be set by the user. It is initially equal to Standard_Window.
- procedure Set_Window (Win : in Window);
+ procedure Set_Window (Win : Window);
-- Set Win as the default window
function Get_Window return Window;
-- Get the current default window
- procedure Flush (Win : in Window);
+ procedure Flush (Win : Window);
procedure Flush;
--------------------------------------------
@@ -74,53 +74,53 @@
-- A scroll-window is interpreted as an page with unbounded page length,
-- i.e. it returns the conventional 0 as page length.
- function Line_Length (Win : in Window) return Count;
+ function Line_Length (Win : Window) return Count;
function Line_Length return Count;
- function Page_Length (Win : in Window) return Count;
+ function Page_Length (Win : Window) return Count;
function Page_Length return Count;
------------------------------------
-- Column, Line, and Page Control --
------------------------------------
- procedure New_Line (Win : in Window; Spacing : in Positive_Count := 1);
- procedure New_Line (Spacing : in Positive_Count := 1);
+ procedure New_Line (Win : Window; Spacing : Positive_Count := 1);
+ procedure New_Line (Spacing : Positive_Count := 1);
- procedure New_Page (Win : in Window);
+ procedure New_Page (Win : Window);
procedure New_Page;
- procedure Set_Col (Win : in Window; To : in Positive_Count);
- procedure Set_Col (To : in Positive_Count);
+ procedure Set_Col (Win : Window; To : Positive_Count);
+ procedure Set_Col (To : Positive_Count);
- procedure Set_Line (Win : in Window; To : in Positive_Count);
- procedure Set_Line (To : in Positive_Count);
+ procedure Set_Line (Win : Window; To : Positive_Count);
+ procedure Set_Line (To : Positive_Count);
- function Col (Win : in Window) return Positive_Count;
+ function Col (Win : Window) return Positive_Count;
function Col return Positive_Count;
- function Line (Win : in Window) return Positive_Count;
+ function Line (Win : Window) return Positive_Count;
function Line return Positive_Count;
-----------------------
-- Characters-Output --
-----------------------
- procedure Put (Win : in Window; Item : in Character);
- procedure Put (Item : in Character);
+ procedure Put (Win : Window; Item : Character);
+ procedure Put (Item : Character);
--------------------
-- Strings-Output --
--------------------
- procedure Put (Win : in Window; Item : in String);
- procedure Put (Item : in String);
+ procedure Put (Win : Window; Item : String);
+ procedure Put (Item : String);
procedure Put_Line
- (Win : in Window;
- Item : in String);
+ (Win : Window;
+ Item : String);
procedure Put_Line
- (Item : in String);
+ (Item : String);
-- Exceptions
diff --git a/Ada95/src/terminal_interface-curses-trace.adb_p b/Ada95/src/terminal_interface-curses-trace.adb_p
index 747454a..0dead37 100644
--- a/Ada95/src/terminal_interface-curses-trace.adb_p
+++ b/Ada95/src/terminal_interface-curses-trace.adb_p
@@ -7,7 +7,7 @@
-- B O D Y --
-- --
------------------------------------------------------------------------------
--- Copyright (c) 2000,2004 Free Software Foundation, Inc. --
+-- Copyright (c) 2000-2009,2014 Free Software Foundation, Inc. --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files (the --
@@ -35,60 +35,39 @@
------------------------------------------------------------------------------
-- Author: Juergen Pfeifer, 1996
-- Version Control:
--- $Revision: 1.5 $
+-- $Revision: 1.11 $
-- Binding Version 01.00
------------------------------------------------------------------------------
#if ADA_TRACE then
with Interfaces.C; use Interfaces.C;
-with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux;
-with Ada.Unchecked_Conversion;
#end if;
package body Terminal_Interface.Curses.Trace is
#if ADA_TRACE then
- type C_TraceType is new C_UInt;
-
- function TraceAda_To_TraceC is new
- Ada.Unchecked_Conversion (Source => Trace_Attribute_Set,
- Target => C_TraceType);
-
procedure Trace_On (x : Trace_Attribute_Set) is
- procedure traceC (y : C_TraceType);
+ procedure traceC (y : Trace_Attribute_Set);
pragma Import (C, traceC, "trace");
begin
- traceC (TraceAda_To_TraceC (x));
+ traceC (x);
end Trace_On;
- -- 75. (12) A C function that takes a variable number of arguments can
- -- correspond to several Ada subprograms, taking various specific
- -- numbers and types of parameters.
-
procedure Trace_Put (str : String) is
procedure tracef (format : char_array; s : char_array);
- pragma Import (C, tracef, "_tracef");
- Txt : char_array (0 .. str'Length);
- Length : size_t;
- formatstr : constant String := "%s" & ASCII.Nul;
- formattxt : char_array (0 .. formatstr'Length);
+ pragma Import (C, tracef, "_traces");
+ -- _traces() is defined in c_varargs_to_ada.h
begin
- To_C (formatstr, formattxt, Length);
- To_C (str, Txt, Length);
- tracef (formattxt, Txt);
+ tracef (To_C ("%s"), To_C (str));
end Trace_Put;
#else
procedure Trace_On (x : Trace_Attribute_Set) is
-#if PRAGMA_UNREF
- pragma Unreferenced (x);
-#end if;
+ pragma Warnings (Off, x); -- unreferenced
begin
null;
end Trace_On;
procedure Trace_Put (str : String) is
-#if PRAGMA_UNREF
- pragma Unreferenced (str);
-#end if;
+ pragma Warnings (Off, str); -- unreferenced
begin
null;
end Trace_Put;