From 34d602f272c394e9a980438e636e1ce4d355f83b Mon Sep 17 00:00:00 2001 From: "Thomas E. Dickey" Date: Sun, 25 May 2014 01:22:18 +0000 Subject: [PATCH] ncurses 5.9 - patch 20140524 + fix typo in ncurses manpage for the NCURSES_NO_MAGIC_COOKIE environment variable. + improve discussion of input-echoing in curs_getch.3x + clarify discussion in curs_addch.3x of wrapping. + modify parametrized.h to make fln non-padded. + correct several entries which had termcap-style padding used in terminfo: adm21, aj510, alto-h19, att605-pc, x820 -TD + correct syntax for padding in some entries: dg211, h19 -TD + correct ti924-8 which had confused padding versus octal escapes -TD + correct padding in sbi entry -TD + fix an old bug in the termcap emulation; "%i" was ignored in tparm() because the parameters to be incremented were already on the internal stack (report by Corinna Vinschen). + modify tic's "-c" option to take into account the "-C" option to activate additional checks which compare the results from running tparm() on the terminfo expressions versus the translated termcap expressions. + modify tic to allow it to read from FIFOs (report by Matthieu Fronton, cf: 20120324). > patches by Nicolas Boulenguez: + explicit dereferences to suppress some style warnings. + when c_varargs_to_ada.c includes its header, use double quotes instead of <>. + samples/ncurses2-util.adb: removed unused with clause. The warning was removed by an obsolete pragma. + replaced Unreferenced pragmas with Warnings (Off). The latter, available with older GNATs, needs no configure test. This also replaces 3 untested Unreferenced pragmas. + simplified To_C usage in trace handling. Using two parameters allows some basic formatting, and avoids a warning about security with some compiler flags. + for generated Ada sources, replace many snippets with one pure package. + removed C_Chtype and its conversions. + removed C_AttrType and its conversions. + removed conversions between int, Item_Option_Set, Menu_Option_Set. + removed int, Field_Option_Set, Item_Option_Set conversions. + removed C_TraceType, Attribute_Option_Set conversions. + replaced C.int with direct use of Eti_Error, now enumerated. As it was used in a case statement, values were tested by the Ada compiler to be consecutive anyway. + src/Makefile.in: remove duplicate stanza + only consider using a project for shared libraries. + style. Silent gnat-4.9 warning about misplaced "then". + generate shared library project to honor ADAFLAGS, LDFLAGS. --- Ada95/aclocal.m4 | 106 +- Ada95/configure | 274 +- Ada95/configure.in | 11 +- Ada95/gen/Makefile.in | 142 +- Ada95/gen/gen.c | 1818 +++------- .../gen/terminal_interface-curses-aux.ads.m4 | 73 +- ..._interface-curses-forms-field_types.ads.m4 | 9 +- .../terminal_interface-curses-forms.ads.m4 | 69 +- .../terminal_interface-curses-menus.ads.m4 | 54 +- .../terminal_interface-curses-mouse.ads.m4 | 44 +- .../terminal_interface-curses-panels.ads.m4 | 10 +- .../terminal_interface-curses-trace.ads.m4 | 54 +- Ada95/gen/terminal_interface-curses.adb.m4 | 281 +- Ada95/gen/terminal_interface-curses.ads.m4 | 507 ++- Ada95/samples/ncurses2-util.adb | 11 +- Ada95/src/Makefile.in | 90 +- Ada95/src/c_threaded_variables.c | 56 + Ada95/src/c_threaded_variables.h | 46 + Ada95/src/c_varargs_to_ada.c | 6 +- Ada95/src/{library.gpr => library.gpr.sed} | 28 +- ...terface-curses-forms-field_types-alpha.adb | 14 +- ...-curses-forms-field_types-alphanumeric.adb | 14 +- ...e-curses-forms-field_types-enumeration.adb | 19 +- ...face-curses-forms-field_types-intfield.adb | 18 +- ...-curses-forms-field_types-ipv4_address.adb | 14 +- ...rface-curses-forms-field_types-numeric.adb | 18 +- ...erface-curses-forms-field_types-regexp.adb | 17 +- ...e-curses-forms-field_types-user-choice.adb | 18 +- ...nterface-curses-forms-field_types-user.adb | 19 +- ...nal_interface-curses-forms-field_types.adb | 47 +- ...interface-curses-forms-field_user_data.adb | 11 +- ..._interface-curses-forms-form_user_data.adb | 11 +- Ada95/src/terminal_interface-curses-forms.adb | 350 +- ..._interface-curses-menus-item_user_data.adb | 11 +- ..._interface-curses-menus-menu_user_data.adb | 12 +- Ada95/src/terminal_interface-curses-menus.adb | 346 +- .../src/terminal_interface-curses-text_io.adb | 8 +- .../src/terminal_interface-curses-trace.adb_p | 37 +- MANIFEST | 7 +- NEWS | 67 +- aclocal.m4 | 110 +- configure | 394 +-- configure.in | 9 +- dist.mk | 4 +- doc/html/ada/files/T.htm | 1 + doc/html/ada/funcs/A.htm | 33 +- doc/html/ada/funcs/B.htm | 26 +- doc/html/ada/funcs/C.htm | 81 +- doc/html/ada/funcs/D.htm | 74 +- doc/html/ada/funcs/E.htm | 20 +- doc/html/ada/funcs/F.htm | 92 +- doc/html/ada/funcs/G.htm | 122 +- doc/html/ada/funcs/H.htm | 26 +- doc/html/ada/funcs/I.htm | 82 +- doc/html/ada/funcs/K.htm | 12 +- doc/html/ada/funcs/L.htm | 19 +- doc/html/ada/funcs/M.htm | 76 +- doc/html/ada/funcs/N.htm | 46 +- doc/html/ada/funcs/O.htm | 8 +- doc/html/ada/funcs/P.htm | 44 +- doc/html/ada/funcs/Q.htm | 2 +- doc/html/ada/funcs/R.htm | 60 +- doc/html/ada/funcs/S.htm | 298 +- doc/html/ada/funcs/T.htm | 33 +- doc/html/ada/funcs/U.htm | 28 +- doc/html/ada/funcs/V.htm | 6 +- doc/html/ada/funcs/W.htm | 82 +- doc/html/ada/main.htm | 1 + .../terminal_interface-curses-aux__adb.htm | 70 +- .../terminal_interface-curses-aux__ads.htm | 121 +- ...ce-curses-forms-field_types-alpha__adb.htm | 26 +- ...ce-curses-forms-field_types-alpha__ads.htm | 10 +- ...es-forms-field_types-alphanumeric__adb.htm | 26 +- ...es-forms-field_types-alphanumeric__ads.htm | 10 +- ...forms-field_types-enumeration-ada__adb.htm | 10 +- ...forms-field_types-enumeration-ada__ads.htm | 10 +- ...ses-forms-field_types-enumeration__adb.htm | 37 +- ...ses-forms-field_types-enumeration__ads.htm | 12 +- ...curses-forms-field_types-intfield__adb.htm | 34 +- ...curses-forms-field_types-intfield__ads.htm | 10 +- ...es-forms-field_types-ipv4_address__adb.htm | 26 +- ...es-forms-field_types-ipv4_address__ads.htm | 10 +- ...-curses-forms-field_types-numeric__adb.htm | 32 +- ...-curses-forms-field_types-numeric__ads.htm | 10 +- ...e-curses-forms-field_types-regexp__adb.htm | 29 +- ...e-curses-forms-field_types-regexp__ads.htm | 10 +- ...ses-forms-field_types-user-choice__adb.htm | 68 +- ...ses-forms-field_types-user-choice__ads.htm | 20 +- ...ace-curses-forms-field_types-user__adb.htm | 107 +- ...ace-curses-forms-field_types-user__ads.htm | 22 +- ...nterface-curses-forms-field_types__adb.htm | 271 +- ...nterface-curses-forms-field_types__ads.htm | 169 +- ...face-curses-forms-field_user_data__adb.htm | 31 +- ...face-curses-forms-field_user_data__ads.htm | 14 +- ...rface-curses-forms-form_user_data__adb.htm | 31 +- ...rface-curses-forms-form_user_data__ads.htm | 14 +- .../terminal_interface-curses-forms__adb.htm | 1050 +++--- .../terminal_interface-curses-forms__ads.htm | 769 ++-- ...rface-curses-menus-item_user_data__adb.htm | 31 +- ...rface-curses-menus-item_user_data__ads.htm | 14 +- ...rface-curses-menus-menu_user_data__adb.htm | 32 +- ...rface-curses-menus-menu_user_data__ads.htm | 14 +- .../terminal_interface-curses-menus__adb.htm | 1116 +++--- .../terminal_interface-curses-menus__ads.htm | 542 ++- .../terminal_interface-curses-mouse__adb.htm | 194 +- .../terminal_interface-curses-mouse__ads.htm | 216 +- ...interface-curses-panels-user_data__adb.htm | 28 +- ...interface-curses-panels-user_data__ads.htm | 12 +- .../terminal_interface-curses-panels__adb.htm | 124 +- .../terminal_interface-curses-panels__ads.htm | 77 +- .../terminal_interface-curses-putwin__adb.htm | 28 +- .../terminal_interface-curses-putwin__ads.htm | 8 +- ...terminal_interface-curses-termcap__adb.htm | 30 +- ...terminal_interface-curses-termcap__ads.htm | 10 +- ...erminal_interface-curses-terminfo__adb.htm | 32 +- ...erminal_interface-curses-terminfo__ads.htm | 6 +- ...inal_interface-curses-text_io-aux__adb.htm | 24 +- ...inal_interface-curses-text_io-aux__ads.htm | 6 +- ...terface-curses-text_io-complex_io__adb.htm | 10 +- ...terface-curses-text_io-complex_io__ads.htm | 6 +- ...terface-curses-text_io-decimal_io__adb.htm | 10 +- ...terface-curses-text_io-decimal_io__ads.htm | 6 +- ...ace-curses-text_io-enumeration_io__adb.htm | 10 +- ...ace-curses-text_io-enumeration_io__ads.htm | 6 +- ...interface-curses-text_io-fixed_io__adb.htm | 10 +- ...interface-curses-text_io-fixed_io__ads.htm | 6 +- ...interface-curses-text_io-float_io__adb.htm | 10 +- ...interface-curses-text_io-float_io__ads.htm | 6 +- ...terface-curses-text_io-integer_io__adb.htm | 10 +- ...terface-curses-text_io-integer_io__ads.htm | 6 +- ...terface-curses-text_io-modular_io__adb.htm | 10 +- ...terface-curses-text_io-modular_io__ads.htm | 6 +- ...terminal_interface-curses-text_io__adb.htm | 126 +- ...terminal_interface-curses-text_io__ads.htm | 32 +- .../terminal_interface-curses-trace__adb.htm | 45 +- .../terminal_interface-curses-trace__ads.htm | 113 +- .../ada/terminal_interface-curses__adb.htm | 3105 +++++++++-------- .../ada/terminal_interface-curses__ads.htm | 1982 ++++++----- ...rminal_interface-curses_constants__ads.htm | 405 +++ doc/html/man/adacurses-config.1.html | 2 +- doc/html/man/captoinfo.1m.html | 2 +- doc/html/man/clear.1.html | 2 +- doc/html/man/curs_addch.3x.html | 40 +- doc/html/man/curs_getch.3x.html | 36 +- doc/html/man/curs_initscr.3x.html | 73 +- doc/html/man/curs_opaque.3x.html | 8 +- doc/html/man/curs_threads.3x.html | 7 +- doc/html/man/curs_window.3x.html | 109 +- doc/html/man/form.3x.html | 2 +- doc/html/man/infocmp.1m.html | 10 +- doc/html/man/infotocap.1m.html | 2 +- doc/html/man/menu.3x.html | 2 +- doc/html/man/ncurses.3x.html | 48 +- doc/html/man/ncurses5-config.1.html | 2 +- doc/html/man/panel.3x.html | 2 +- doc/html/man/tabs.1.html | 2 +- doc/html/man/term_variables.3x.html | 2 +- doc/html/man/terminfo.5.html | 2 +- doc/html/man/tic.1m.html | 197 +- doc/html/man/toe.1m.html | 2 +- doc/html/man/tput.1.html | 2 +- doc/html/man/tset.1.html | 4 +- include/MKparametrized.sh | 15 +- man/curs_addch.3x | 27 +- man/curs_getch.3x | 22 +- man/ncurses.3x | 4 +- man/tic.1m | 23 +- misc/terminfo.src | 44 +- ncurses/tinfo/lib_tparm.c | 39 +- package/debian-mingw/changelog | 4 +- package/debian-mingw64/changelog | 4 +- package/debian/changelog | 4 +- package/mingw-ncurses.nsi | 4 +- package/mingw-ncurses.spec | 2 +- package/ncurses.spec | 2 +- progs/Makefile.in | 6 +- progs/modules | 9 +- progs/progs.priv.h | 9 +- progs/tic.c | 269 +- progs/tparm_type.c | 68 + progs/tparm_type.h | 52 + progs/tput.c | 47 +- 182 files changed, 9528 insertions(+), 9743 deletions(-) create mode 100644 Ada95/src/c_threaded_variables.c create mode 100644 Ada95/src/c_threaded_variables.h rename Ada95/src/{library.gpr => library.gpr.sed} (79%) create mode 100644 doc/html/ada/terminal_interface-curses_constants__ads.htm create mode 100644 progs/tparm_type.c create mode 100644 progs/tparm_type.h diff --git a/Ada95/aclocal.m4 b/Ada95/aclocal.m4 index c107052a..14d5188c 100644 --- a/Ada95/aclocal.m4 +++ b/Ada95/aclocal.m4 @@ -28,7 +28,7 @@ dnl*************************************************************************** dnl dnl Author: Thomas E. Dickey dnl -dnl $Id: aclocal.m4,v 1.80 2014/05/10 21:08:22 tom Exp $ +dnl $Id: aclocal.m4,v 1.82 2014/05/24 21:09:10 Nicolas.Boulenguez Exp $ dnl Macros used in NCURSES Ada95 auto-configuration script. dnl dnl These macros are maintained separately from NCURSES. The copyright on @@ -1207,35 +1207,6 @@ AC_SUBST(cf_compile_generics) AC_SUBST(cf_generic_objects) ])dnl dnl --------------------------------------------------------------------------- -dnl CF_GNAT_PRAGMA_UNREF version: 1 updated: 2010/06/19 15:22:18 -dnl -------------------- -dnl Check if the gnat pragma "Unreferenced" works. -AC_DEFUN([CF_GNAT_PRAGMA_UNREF],[ -AC_CACHE_CHECK(if GNAT pragma Unreferenced works,cf_cv_pragma_unreferenced,[ -CF_GNAT_TRY_LINK([procedure conftest;], -[with Text_IO; -with GNAT.OS_Lib; -procedure conftest is - test : Integer; - pragma Unreferenced (test); -begin - test := 1; - Text_IO.Put ("Hello World"); - Text_IO.New_Line; - GNAT.OS_Lib.OS_Exit (0); -end conftest;], - [cf_cv_pragma_unreferenced=yes], - [cf_cv_pragma_unreferenced=no])]) - -# if the pragma is supported, use it (needed in the Trace code). -if test $cf_cv_pragma_unreferenced = yes ; then - PRAGMA_UNREF=TRUE -else - PRAGMA_UNREF=FALSE -fi -AC_SUBST(PRAGMA_UNREF) -])dnl -dnl --------------------------------------------------------------------------- dnl CF_GNAT_PROJECTS version: 4 updated: 2013/09/07 14:05:46 dnl ---------------- dnl GNAT projects are configured with ".gpr" project files. @@ -1244,7 +1215,6 @@ AC_DEFUN([CF_GNAT_PROJECTS], [ AC_REQUIRE([CF_GNAT_VERSION]) -cf_gnat_libraries=no cf_gnat_projects=no AC_MSG_CHECKING(if GNAT supports project files) @@ -1256,28 +1226,17 @@ case $cf_gnat_version in #(vi cygwin*|msys*) #(vi ;; *) - mkdir conftest.src conftest.bin conftest.lib - cd conftest.src - rm -rf conftest* *~conftest* + mkdir conftest + cd conftest + mkdir lib obj cat >>library.gpr <>confpackage.ads <&AC_FD_CC 2>&1 ) ; then + if ( $cf_ada_make -Plibrary.gpr 1>&AC_FD_CC 2>&1 ); then cf_gnat_projects=yes fi cd .. - if test -f conftest.lib/confpackage.ali - then - cf_gnat_libraries=yes - fi - rm -rf conftest* *~conftest* + rm -rf conftest ;; esac ;; esac AC_MSG_RESULT($cf_gnat_projects) - -if test $cf_gnat_projects = yes -then - AC_MSG_CHECKING(if GNAT supports libraries) - AC_MSG_RESULT($cf_gnat_libraries) -fi - -if test "$cf_gnat_projects" = yes -then - USE_OLD_MAKERULES="#" - USE_GNAT_PROJECTS="" -else - USE_OLD_MAKERULES="" - USE_GNAT_PROJECTS="#" -fi - -if test "$cf_gnat_libraries" = yes -then - USE_GNAT_LIBRARIES="" -else - USE_GNAT_LIBRARIES="#" -fi - -AC_SUBST(USE_OLD_MAKERULES) -AC_SUBST(USE_GNAT_PROJECTS) -AC_SUBST(USE_GNAT_LIBRARIES) ])dnl dnl --------------------------------------------------------------------------- dnl CF_GNAT_SIGINT version: 1 updated: 2011/03/27 20:07:59 @@ -3519,9 +3442,10 @@ dnl --------------------- dnl Command-line option to specify if an Ada95 shared-library should be built, dnl and optionally what its soname should be. AC_DEFUN([CF_WITH_ADA_SHAREDLIB],[ +AC_REQUIRE([CF_GNAT_PROJECTS]) AC_MSG_CHECKING(if an Ada95 shared-library should be built) AC_ARG_WITH(ada-sharedlib, - [ --with-ada-sharedlib=XX build Ada95 shared-library], + [ --with-ada-sharedlib=soname build shared-library (requires GNAT projects)], [with_ada_sharedlib=$withval], [with_ada_sharedlib=no]) AC_MSG_RESULT($with_ada_sharedlib) @@ -3531,6 +3455,10 @@ MAKE_ADA_SHAREDLIB="#" if test "x$with_ada_sharedlib" != xno then + if test "$cf_gnat_projects" != yes + then + AC_MSG_ERROR(ada-sharedlib requires GNAT support for shared library projects,1) + fi MAKE_ADA_SHAREDLIB= if test "x$with_ada_sharedlib" != xyes then diff --git a/Ada95/configure b/Ada95/configure index a21bbc9f..4963f156 100644 --- a/Ada95/configure +++ b/Ada95/configure @@ -1,5 +1,5 @@ #! /bin/sh -# From configure.in Revision: 1.49 . +# From configure.in Revision: 1.51 . # Guess values for system-dependent variables and create Makefiles. # Generated by Autoconf 2.52.20121002. # @@ -698,7 +698,7 @@ Ada95 Binding Options: --with-ada-compiler=CMD specify Ada95 compiler command (default gnatmake) --with-ada-include=DIR Ada includes are in DIR (default: PREFIX/share/ada/adainclude) --with-ada-objects=DIR Ada objects are in DIR (default: PREFIX/lib/ada/adalib) - --with-ada-sharedlib=XX build Ada95 shared-library + --with-ada-sharedlib=soname build shared-library (requires GNAT projects) Some influential environment variables: CC C compiler command @@ -11553,146 +11553,7 @@ else USE_GNAT_SIGINT="#" fi -echo "$as_me:11556: checking if GNAT pragma Unreferenced works" >&5 -echo $ECHO_N "checking if GNAT pragma Unreferenced works... $ECHO_C" >&6 -if test "${cf_cv_pragma_unreferenced+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 -else - -rm -rf conftest* *~conftest* -cat >>conftest.ads <>conftest.adb <&5 2>&1 ) ; then - cf_cv_pragma_unreferenced=yes -else - cf_cv_pragma_unreferenced=no -fi -rm -rf conftest* *~conftest* - -fi -echo "$as_me:11587: result: $cf_cv_pragma_unreferenced" >&5 -echo "${ECHO_T}$cf_cv_pragma_unreferenced" >&6 - -# if the pragma is supported, use it (needed in the Trace code). -if test $cf_cv_pragma_unreferenced = yes ; then - PRAGMA_UNREF=TRUE -else - PRAGMA_UNREF=FALSE -fi - -cf_gnat_libraries=no -cf_gnat_projects=no - -echo "$as_me:11600: checking if GNAT supports project files" >&5 -echo $ECHO_N "checking if GNAT supports project files... $ECHO_C" >&6 -case $cf_gnat_version in #(vi -3.[0-9]*) #(vi - ;; -*) - case $cf_cv_system_name in #(vi - cygwin*|msys*) #(vi - ;; - *) - mkdir conftest.src conftest.bin conftest.lib - cd conftest.src - rm -rf conftest* *~conftest* - cat >>library.gpr <>confpackage.ads <>confpackage.adb <&5 2>&1 ) ; then - cf_gnat_projects=yes - fi - cd .. - if test -f conftest.lib/confpackage.ali - then - cf_gnat_libraries=yes - fi - rm -rf conftest* *~conftest* - ;; - esac - ;; -esac -echo "$as_me:11668: result: $cf_gnat_projects" >&5 -echo "${ECHO_T}$cf_gnat_projects" >&6 - -if test $cf_gnat_projects = yes -then - echo "$as_me:11673: checking if GNAT supports libraries" >&5 -echo $ECHO_N "checking if GNAT supports libraries... $ECHO_C" >&6 - echo "$as_me:11675: result: $cf_gnat_libraries" >&5 -echo "${ECHO_T}$cf_gnat_libraries" >&6 -fi - -if test "$cf_gnat_projects" = yes -then - USE_OLD_MAKERULES="#" - USE_GNAT_PROJECTS="" -else - USE_OLD_MAKERULES="" - USE_GNAT_PROJECTS="#" -fi - -if test "$cf_gnat_libraries" = yes -then - USE_GNAT_LIBRARIES="" -else - USE_GNAT_LIBRARIES="#" -fi - -echo "$as_me:11695: checking for ada-compiler" >&5 +echo "$as_me:11556: checking for ada-compiler" >&5 echo $ECHO_N "checking for ada-compiler... $ECHO_C" >&6 # Check whether --with-ada-compiler or --without-ada-compiler was given. @@ -11703,12 +11564,12 @@ else cf_ada_compiler=gnatmake fi; -echo "$as_me:11706: result: $cf_ada_compiler" >&5 +echo "$as_me:11567: result: $cf_ada_compiler" >&5 echo "${ECHO_T}$cf_ada_compiler" >&6 cf_ada_package=terminal_interface -echo "$as_me:11711: checking for ada-include" >&5 +echo "$as_me:11572: checking for ada-include" >&5 echo $ECHO_N "checking for ada-include... $ECHO_C" >&6 # Check whether --with-ada-include or --without-ada-include was given. @@ -11744,7 +11605,7 @@ case ".$withval" in #(vi withval=`echo $withval | sed -e s%NONE%$cf_path_syntax%` ;; *) - { { echo "$as_me:11747: error: expected a pathname, not \"$withval\"" >&5 + { { echo "$as_me:11608: error: expected a pathname, not \"$withval\"" >&5 echo "$as_me: error: expected a pathname, not \"$withval\"" >&2;} { (exit 1); exit 1; }; } ;; @@ -11753,10 +11614,10 @@ esac fi eval ADA_INCLUDE="$withval" -echo "$as_me:11756: result: $ADA_INCLUDE" >&5 +echo "$as_me:11617: result: $ADA_INCLUDE" >&5 echo "${ECHO_T}$ADA_INCLUDE" >&6 -echo "$as_me:11759: checking for ada-objects" >&5 +echo "$as_me:11620: checking for ada-objects" >&5 echo $ECHO_N "checking for ada-objects... $ECHO_C" >&6 # Check whether --with-ada-objects or --without-ada-objects was given. @@ -11792,7 +11653,7 @@ case ".$withval" in #(vi withval=`echo $withval | sed -e s%NONE%$cf_path_syntax%` ;; *) - { { echo "$as_me:11795: error: expected a pathname, not \"$withval\"" >&5 + { { echo "$as_me:11656: error: expected a pathname, not \"$withval\"" >&5 echo "$as_me: error: expected a pathname, not \"$withval\"" >&2;} { (exit 1); exit 1; }; } ;; @@ -11801,10 +11662,62 @@ esac fi eval ADA_OBJECTS="$withval" -echo "$as_me:11804: result: $ADA_OBJECTS" >&5 +echo "$as_me:11665: result: $ADA_OBJECTS" >&5 echo "${ECHO_T}$ADA_OBJECTS" >&6 -echo "$as_me:11807: checking if an Ada95 shared-library should be built" >&5 +cf_gnat_projects=no + +echo "$as_me:11670: checking if GNAT supports project files" >&5 +echo $ECHO_N "checking if GNAT supports project files... $ECHO_C" >&6 +case $cf_gnat_version in #(vi +3.[0-9]*) #(vi + ;; +*) + case $cf_cv_system_name in #(vi + cygwin*|msys*) #(vi + ;; + *) + mkdir conftest + cd conftest + mkdir lib obj + cat >>library.gpr <>confpackage.ads <>confpackage.adb <&5 2>&1 ); then + cf_gnat_projects=yes + fi + cd .. + rm -rf conftest + ;; + esac + ;; +esac +echo "$as_me:11717: result: $cf_gnat_projects" >&5 +echo "${ECHO_T}$cf_gnat_projects" >&6 + +echo "$as_me:11720: checking if an Ada95 shared-library should be built" >&5 echo $ECHO_N "checking if an Ada95 shared-library should be built... $ECHO_C" >&6 # Check whether --with-ada-sharedlib or --without-ada-sharedlib was given. @@ -11814,7 +11727,7 @@ if test "${with_ada_sharedlib+set}" = set; then else with_ada_sharedlib=no fi; -echo "$as_me:11817: result: $with_ada_sharedlib" >&5 +echo "$as_me:11730: result: $with_ada_sharedlib" >&5 echo "${ECHO_T}$with_ada_sharedlib" >&6 ADA_SHAREDLIB='lib$(LIB_NAME).so.1' @@ -11822,6 +11735,12 @@ MAKE_ADA_SHAREDLIB="#" if test "x$with_ada_sharedlib" != xno then + if test "$cf_gnat_projects" != yes + then + { { echo "$as_me:11740: error: ada-sharedlib requires GNAT support for shared library projects" >&5 +echo "$as_me: error: ada-sharedlib requires GNAT support for shared library projects" >&2;} + { (exit 1); exit 1; }; } + fi MAKE_ADA_SHAREDLIB= if test "x$with_ada_sharedlib" != xyes then @@ -11830,12 +11749,12 @@ then fi else - { { echo "$as_me:11833: error: No usable Ada compiler found" >&5 + { { echo "$as_me:11752: error: No usable Ada compiler found" >&5 echo "$as_me: error: No usable Ada compiler found" >&2;} { (exit 1); exit 1; }; } fi else - { { echo "$as_me:11838: error: The Ada compiler is needed for this package" >&5 + { { echo "$as_me:11757: error: The Ada compiler is needed for this package" >&5 echo "$as_me: error: The Ada compiler is needed for this package" >&2;} { (exit 1); exit 1; }; } fi @@ -11882,7 +11801,7 @@ elif test "$includedir" != "/usr/include"; then fi ### Build up pieces for makefile rules -echo "$as_me:11885: checking default library suffix" >&5 +echo "$as_me:11804: checking default library suffix" >&5 echo $ECHO_N "checking default library suffix... $ECHO_C" >&6 case $DFT_LWR_MODEL in @@ -11893,10 +11812,10 @@ echo $ECHO_N "checking default library suffix... $ECHO_C" >&6 shared) DFT_ARG_SUFFIX='' ;; esac test -n "$LIB_SUFFIX" && DFT_ARG_SUFFIX="${LIB_SUFFIX}${DFT_ARG_SUFFIX}" -echo "$as_me:11896: result: $DFT_ARG_SUFFIX" >&5 +echo "$as_me:11815: result: $DFT_ARG_SUFFIX" >&5 echo "${ECHO_T}$DFT_ARG_SUFFIX" >&6 -echo "$as_me:11899: checking default library-dependency suffix" >&5 +echo "$as_me:11818: checking default library-dependency suffix" >&5 echo $ECHO_N "checking default library-dependency suffix... $ECHO_C" >&6 case X$DFT_LWR_MODEL in #(vi @@ -11951,10 +11870,10 @@ echo $ECHO_N "checking default library-dependency suffix... $ECHO_C" >&6 esac test -n "$LIB_SUFFIX" && DFT_LIB_SUFFIX="${LIB_SUFFIX}${DFT_LIB_SUFFIX}" test -n "$LIB_SUFFIX" && DFT_DEP_SUFFIX="${LIB_SUFFIX}${DFT_DEP_SUFFIX}" -echo "$as_me:11954: result: $DFT_DEP_SUFFIX" >&5 +echo "$as_me:11873: result: $DFT_DEP_SUFFIX" >&5 echo "${ECHO_T}$DFT_DEP_SUFFIX" >&6 -echo "$as_me:11957: checking default object directory" >&5 +echo "$as_me:11876: checking default object directory" >&5 echo $ECHO_N "checking default object directory... $ECHO_C" >&6 case $DFT_LWR_MODEL in @@ -11970,7 +11889,7 @@ echo $ECHO_N "checking default object directory... $ECHO_C" >&6 DFT_OBJ_SUBDIR='obj_s' ;; esac esac -echo "$as_me:11973: result: $DFT_OBJ_SUBDIR" >&5 +echo "$as_me:11892: result: $DFT_OBJ_SUBDIR" >&5 echo "${ECHO_T}$DFT_OBJ_SUBDIR" >&6 ### Set up low-level terminfo dependencies for makefiles. @@ -12189,7 +12108,7 @@ DEFS=-DHAVE_CONFIG_H : ${CONFIG_STATUS=./config.status} ac_clean_files_save=$ac_clean_files ac_clean_files="$ac_clean_files $CONFIG_STATUS" -{ echo "$as_me:12192: creating $CONFIG_STATUS" >&5 +{ echo "$as_me:12111: creating $CONFIG_STATUS" >&5 echo "$as_me: creating $CONFIG_STATUS" >&6;} cat >$CONFIG_STATUS <<_ACEOF #! $SHELL @@ -12365,7 +12284,7 @@ cat >>$CONFIG_STATUS <<\EOF echo "$ac_cs_version"; exit 0 ;; --he | --h) # Conflict between --help and --header - { { echo "$as_me:12368: error: ambiguous option: $1 + { { echo "$as_me:12287: error: ambiguous option: $1 Try \`$0 --help' for more information." >&5 echo "$as_me: error: ambiguous option: $1 Try \`$0 --help' for more information." >&2;} @@ -12384,7 +12303,7 @@ Try \`$0 --help' for more information." >&2;} ac_need_defaults=false;; # This is an error. - -*) { { echo "$as_me:12387: error: unrecognized option: $1 + -*) { { echo "$as_me:12306: error: unrecognized option: $1 Try \`$0 --help' for more information." >&5 echo "$as_me: error: unrecognized option: $1 Try \`$0 --help' for more information." >&2;} @@ -12432,7 +12351,6 @@ LN_S="$LN_S" NCURSES_MAJOR="$NCURSES_MAJOR" NCURSES_MINOR="$NCURSES_MINOR" NCURSES_PATCH="$NCURSES_PATCH" -USE_OLD_MAKERULES="$USE_OLD_MAKERULES" cf_cv_abi_version="$cf_cv_abi_version" cf_cv_rel_version="$cf_cv_rel_version" cf_cv_rm_so_locs="$cf_cv_rm_so_locs" @@ -12455,7 +12373,7 @@ do "Makefile" ) CONFIG_FILES="$CONFIG_FILES Makefile" ;; "default" ) CONFIG_COMMANDS="$CONFIG_COMMANDS default" ;; "include/ncurses_cfg.h" ) CONFIG_HEADERS="$CONFIG_HEADERS include/ncurses_cfg.h:include/ncurses_cfg.hin" ;; - *) { { echo "$as_me:12458: error: invalid argument: $ac_config_target" >&5 + *) { { echo "$as_me:12376: error: invalid argument: $ac_config_target" >&5 echo "$as_me: error: invalid argument: $ac_config_target" >&2;} { (exit 1); exit 1; }; };; esac @@ -12641,10 +12559,6 @@ s,@cf_ada_make@,$cf_ada_make,;t t s,@cf_compile_generics@,$cf_compile_generics,;t t s,@cf_generic_objects@,$cf_generic_objects,;t t s,@USE_GNAT_SIGINT@,$USE_GNAT_SIGINT,;t t -s,@PRAGMA_UNREF@,$PRAGMA_UNREF,;t t -s,@USE_OLD_MAKERULES@,$USE_OLD_MAKERULES,;t t -s,@USE_GNAT_PROJECTS@,$USE_GNAT_PROJECTS,;t t -s,@USE_GNAT_LIBRARIES@,$USE_GNAT_LIBRARIES,;t t s,@cf_ada_compiler@,$cf_ada_compiler,;t t s,@cf_ada_package@,$cf_ada_package,;t t s,@ADA_INCLUDE@,$ADA_INCLUDE,;t t @@ -12780,7 +12694,7 @@ done; } esac if test x"$ac_file" != x-; then - { echo "$as_me:12783: creating $ac_file" >&5 + { echo "$as_me:12697: creating $ac_file" >&5 echo "$as_me: creating $ac_file" >&6;} rm -f "$ac_file" fi @@ -12798,7 +12712,7 @@ echo "$as_me: creating $ac_file" >&6;} -) echo $tmp/stdin ;; [\\/$]*) # Absolute (can't be DOS-style, as IFS=:) - test -f "$f" || { { echo "$as_me:12801: error: cannot find input file: $f" >&5 + test -f "$f" || { { echo "$as_me:12715: error: cannot find input file: $f" >&5 echo "$as_me: error: cannot find input file: $f" >&2;} { (exit 1); exit 1; }; } echo $f;; @@ -12811,7 +12725,7 @@ echo "$as_me: error: cannot find input file: $f" >&2;} echo $srcdir/$f else # /dev/null tree - { { echo "$as_me:12814: error: cannot find input file: $f" >&5 + { { echo "$as_me:12728: error: cannot find input file: $f" >&5 echo "$as_me: error: cannot find input file: $f" >&2;} { (exit 1); exit 1; }; } fi;; @@ -12827,7 +12741,7 @@ cat >>$CONFIG_STATUS <<\EOF if test -n "$ac_seen"; then ac_used=`grep '@datarootdir@' $ac_item` if test -z "$ac_used"; then - { echo "$as_me:12830: WARNING: datarootdir was used implicitly but not set: + { echo "$as_me:12744: WARNING: datarootdir was used implicitly but not set: $ac_seen" >&5 echo "$as_me: WARNING: datarootdir was used implicitly but not set: $ac_seen" >&2;} @@ -12836,7 +12750,7 @@ $ac_seen" >&2;} fi ac_seen=`grep '${datarootdir}' $ac_item` if test -n "$ac_seen"; then - { echo "$as_me:12839: WARNING: datarootdir was used explicitly but not set: + { echo "$as_me:12753: WARNING: datarootdir was used explicitly but not set: $ac_seen" >&5 echo "$as_me: WARNING: datarootdir was used explicitly but not set: $ac_seen" >&2;} @@ -12873,7 +12787,7 @@ s,@INSTALL@,$ac_INSTALL,;t t ac_init=`egrep '[ ]*'$ac_name'[ ]*=' $ac_file` if test -z "$ac_init"; then ac_seen=`echo "$ac_seen" |sed -e 's,^,'$ac_file':,'` - { echo "$as_me:12876: WARNING: Variable $ac_name is used but was not set: + { echo "$as_me:12790: WARNING: Variable $ac_name is used but was not set: $ac_seen" >&5 echo "$as_me: WARNING: Variable $ac_name is used but was not set: $ac_seen" >&2;} @@ -12884,7 +12798,7 @@ $ac_seen" >&2;} egrep -n '@[A-Z_][A-Z_0-9]+@' $ac_file >>$tmp/out if test -s $tmp/out; then ac_seen=`sed -e 's,^,'$ac_file':,' < $tmp/out` - { echo "$as_me:12887: WARNING: Some variables may not be substituted: + { echo "$as_me:12801: WARNING: Some variables may not be substituted: $ac_seen" >&5 echo "$as_me: WARNING: Some variables may not be substituted: $ac_seen" >&2;} @@ -12933,7 +12847,7 @@ for ac_file in : $CONFIG_HEADERS; do test "x$ac_file" = x: && continue * ) ac_file_in=$ac_file.in ;; esac - test x"$ac_file" != x- && { echo "$as_me:12936: creating $ac_file" >&5 + test x"$ac_file" != x- && { echo "$as_me:12850: creating $ac_file" >&5 echo "$as_me: creating $ac_file" >&6;} # First look for the input files in the build tree, otherwise in the @@ -12944,7 +12858,7 @@ echo "$as_me: creating $ac_file" >&6;} -) echo $tmp/stdin ;; [\\/$]*) # Absolute (can't be DOS-style, as IFS=:) - test -f "$f" || { { echo "$as_me:12947: error: cannot find input file: $f" >&5 + test -f "$f" || { { echo "$as_me:12861: error: cannot find input file: $f" >&5 echo "$as_me: error: cannot find input file: $f" >&2;} { (exit 1); exit 1; }; } echo $f;; @@ -12957,7 +12871,7 @@ echo "$as_me: error: cannot find input file: $f" >&2;} echo $srcdir/$f else # /dev/null tree - { { echo "$as_me:12960: error: cannot find input file: $f" >&5 + { { echo "$as_me:12874: error: cannot find input file: $f" >&5 echo "$as_me: error: cannot find input file: $f" >&2;} { (exit 1); exit 1; }; } fi;; @@ -13015,7 +12929,7 @@ cat >>$CONFIG_STATUS <<\EOF rm -f $tmp/in if test x"$ac_file" != x-; then if cmp -s $ac_file $tmp/config.h 2>/dev/null; then - { echo "$as_me:13018: $ac_file is unchanged" >&5 + { echo "$as_me:12932: $ac_file is unchanged" >&5 echo "$as_me: $ac_file is unchanged" >&6;} else ac_dir=`$as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ @@ -13066,9 +12980,7 @@ for ac_file in : $CONFIG_COMMANDS; do test "x$ac_file" = x: && continue case $ac_dest in default ) -if test -z "$USE_OLD_MAKERULES" ; then $AWK -f $srcdir/mk-1st.awk <$srcdir/src/modules >>src/Makefile -fi ;; esac done diff --git a/Ada95/configure.in b/Ada95/configure.in index 8d6e1013..e1281f46 100644 --- a/Ada95/configure.in +++ b/Ada95/configure.in @@ -1,5 +1,5 @@ dnl*************************************************************************** -dnl Copyright (c) 2010-2012,2013 Free Software Foundation, Inc. * +dnl Copyright (c) 2010-2013,2014 Free Software Foundation, Inc. * dnl * dnl Permission is hereby granted, free of charge, to any person obtaining a * dnl copy of this software and associated documentation files (the * @@ -28,14 +28,14 @@ dnl*************************************************************************** dnl dnl Author: Thomas E. Dickey dnl -dnl $Id: configure.in,v 1.49 2013/11/16 20:06:37 tom Exp $ +dnl $Id: configure.in,v 1.52 2014/05/24 21:31:05 tom Exp $ dnl Process this file with autoconf to produce a configure script. dnl dnl See http://invisible-island.net/autoconf/ for additional information. dnl dnl --------------------------------------------------------------------------- AC_PREREQ(2.52.20030208) -AC_REVISION($Revision: 1.49 $) +AC_REVISION($Revision: 1.52 $) AC_INIT(gen/gen.c) AC_CONFIG_HEADER(include/ncurses_cfg.h:include/ncurses_cfg.hin) @@ -478,8 +478,6 @@ if test "$cf_with_ada" != "no" ; then CF_GNAT_GENERICS CF_GNAT_SIGINT - CF_GNAT_PRAGMA_UNREF - CF_GNAT_PROJECTS CF_WITH_ADA_COMPILER @@ -594,9 +592,7 @@ AC_OUTPUT( \ $SUB_MAKEFILES \ doc/adacurses${DFT_ARG_SUFFIX}-config.1:doc/MKada_config.in \ Makefile,[ -if test -z "$USE_OLD_MAKERULES" ; then $AWK -f $srcdir/mk-1st.awk <$srcdir/src/modules >>src/Makefile -fi ],[ ### Special initialization commands, used to pass information from the ### configuration-run into config.status @@ -611,7 +607,6 @@ LN_S="$LN_S" NCURSES_MAJOR="$NCURSES_MAJOR" NCURSES_MINOR="$NCURSES_MINOR" NCURSES_PATCH="$NCURSES_PATCH" -USE_OLD_MAKERULES="$USE_OLD_MAKERULES" cf_cv_abi_version="$cf_cv_abi_version" cf_cv_rel_version="$cf_cv_rel_version" cf_cv_rm_so_locs="$cf_cv_rm_so_locs" diff --git a/Ada95/gen/Makefile.in b/Ada95/gen/Makefile.in index 302ad94f..f64c0f93 100644 --- a/Ada95/gen/Makefile.in +++ b/Ada95/gen/Makefile.in @@ -1,5 +1,5 @@ ############################################################################## -# Copyright (c) 1998-2011,2012 Free Software Foundation, Inc. # +# Copyright (c) 1998-2012,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"), # @@ -28,7 +28,7 @@ # # Author: Juergen Pfeifer, 1996 # -# $Id: Makefile.in,v 1.77 2012/10/06 18:58:48 tom Exp $ +# $Id: Makefile.in,v 1.80 2014/05/24 21:31:05 tom Exp $ # .SUFFIXES: @@ -97,39 +97,6 @@ ABASE = $(ALIB)-curses ADA_SRCDIR = ../src -GEN_FILES0 = Base_Defs - -GEN_FILES1 = ACS_Map \ - AC_Rep \ - Base_Defs \ - Character_Attribute_Set_Rep \ - Color_Defs \ - Key_Definitions \ - Linker_Options \ - Old_Keys \ - Public_Variables \ - Trace_Defs \ - Version_Info \ - Window_Offsets - -GEN_FILES2 = Menu_Opt_Rep \ - Menu_Base_Defs \ - Menu_Linker_Options \ - Item_Rep - -GEN_FILES3 = Form_Opt_Rep \ - Form_Base_Defs \ - Form_Linker_Options \ - Field_Rep - -GEN_FILES4 = Mouse_Base_Defs \ - Mouse_Event_Rep \ - Mouse_Events \ - Panel_Linker_Options - -GEN_FILES5 = Chtype_Def \ - Eti_Defs - GEN_TARGETS = $(ADA_SRCDIR)/$(ABASE).ads \ $(ADA_SRCDIR)/$(ABASE).adb \ $(ADA_SRCDIR)/$(ABASE)-aux.ads \ @@ -143,7 +110,8 @@ GEN_TARGETS = $(ADA_SRCDIR)/$(ABASE).ads \ $(ADA_SRCDIR)/$(ABASE)-forms-form_user_data.ads \ $(ADA_SRCDIR)/$(ABASE)-forms-field_types.ads \ $(ADA_SRCDIR)/$(ABASE)-forms-field_user_data.ads \ - $(ADA_SRCDIR)/$(ABASE)-panels-user_data.ads + $(ADA_SRCDIR)/$(ABASE)-panels-user_data.ads \ + $(ADA_SRCDIR)/$(ABASE)_constants.ads GEN_SRC = $(srcdir)/$(ABASE).ads.m4 \ $(srcdir)/$(ABASE).adb.m4 \ @@ -183,129 +151,53 @@ $(PROG_GENERATE): gen.o gen.o: $(srcdir)/gen.c $(HOST_CC) $(CFLAGS_NORMAL) -c -o $@ $(srcdir)/gen.c -################################################################################ -Character_Attribute_Set_Rep: $(PROG_GENERATE) - $(WRAPPER) "$(GENERATE) B A" >$@ - -Base_Defs: $(PROG_GENERATE) - $(WRAPPER) "$(GENERATE) B B" >$@ - -Color_Defs: $(PROG_GENERATE) - $(WRAPPER) "$(GENERATE) B C" >$@ - -Window_Offsets: $(PROG_GENERATE) - $(WRAPPER) "$(GENERATE) B D" >$@ - -Key_Definitions: $(PROG_GENERATE) - $(WRAPPER) "$(GENERATE) B K" >$@ - -Linker_Options: $(PROG_GENERATE) - $(WRAPPER) "$(GENERATE) B L" >$@ - -ACS_Map: $(PROG_GENERATE) - $(WRAPPER) "$(GENERATE) B M" >$@ - -Old_Keys: $(PROG_GENERATE) - $(WRAPPER) "$(GENERATE) B O" >$@ - -Public_Variables: $(PROG_GENERATE) - $(WRAPPER) "$(GENERATE) B P" >$@ - -AC_Rep: $(PROG_GENERATE) - $(WRAPPER) "$(GENERATE) B R" >$@ - -Version_Info: $(PROG_GENERATE) - $(WRAPPER) "$(GENERATE) B V" >$@ - -Trace_Defs: $(PROG_GENERATE) - $(WRAPPER) "$(GENERATE) B T" >$@ -################################################################################ -Menu_Opt_Rep: $(PROG_GENERATE) - $(WRAPPER) "$(GENERATE) M R" >$@ - -Menu_Base_Defs: $(PROG_GENERATE) - $(WRAPPER) "$(GENERATE) M B" >$@ - -Menu_Linker_Options: $(PROG_GENERATE) - $(WRAPPER) "$(GENERATE) M L" >$@ - -Item_Rep: $(PROG_GENERATE) - $(WRAPPER) "$(GENERATE) M I" >$@ -################################################################################ -Form_Opt_Rep: $(PROG_GENERATE) - $(WRAPPER) "$(GENERATE) F R" >$@ - -Form_Base_Defs: $(PROG_GENERATE) - $(WRAPPER) "$(GENERATE) F B" >$@ - -Form_Linker_Options: $(PROG_GENERATE) - $(WRAPPER) "$(GENERATE) F L" >$@ - -Field_Rep: $(PROG_GENERATE) - $(WRAPPER) "$(GENERATE) F I" >$@ -################################################################################ -Mouse_Base_Defs: $(PROG_GENERATE) - $(WRAPPER) "$(GENERATE) P B" >$@ - -Mouse_Event_Rep: $(PROG_GENERATE) - $(WRAPPER) "$(GENERATE) P M" >$@ - -Mouse_Events: $(PROG_GENERATE) - $(WRAPPER) "$(GENERATE) B E" >$@ - -Panel_Linker_Options: $(PROG_GENERATE) - $(WRAPPER) "$(GENERATE) P L" >$@ - -Chtype_Def: $(PROG_GENERATE) - $(WRAPPER) "$(GENERATE) E C" >$@ -Eti_Defs: $(PROG_GENERATE) - $(WRAPPER) "$(GENERATE) E E" >$@ +$(ADA_SRCDIR)/$(ABASE)_constants.ads: $(PROG_GENERATE) + $(WRAPPER) "$(GENERATE)" >$@ ################################################################################ $(ADA_SRCDIR)/$(ABASE).ads: $(srcdir)/$(ABASE).ads.m4 \ - $(GEN_FILES1) $(srcdir)/normal.m4 + $(srcdir)/normal.m4 $(M4) $(M4FLAGS) -DM4MACRO=$(srcdir)/normal.m4 \ $(srcdir)/$(ABASE).ads.m4 |\ $(DEL_ADAMODE) >$@ $(ADA_SRCDIR)/$(ABASE).adb: $(srcdir)/$(ABASE).adb.m4 \ - $(GEN_FILES1) $(srcdir)/normal.m4 + $(srcdir)/normal.m4 $(M4) $(M4FLAGS) -DM4MACRO=$(srcdir)/normal.m4 \ $(srcdir)/$(ABASE).adb.m4 |\ $(DEL_ADAMODE) >$@ $(ADA_SRCDIR)/$(ABASE)-aux.ads: $(srcdir)/$(ABASE)-aux.ads.m4 \ - $(GEN_FILES5) $(srcdir)/normal.m4 + $(srcdir)/normal.m4 $(M4) $(M4FLAGS) -DM4MACRO=$(srcdir)/normal.m4 \ $(srcdir)/$(ABASE)-aux.ads.m4 |\ $(DEL_ADAMODE) >$@ $(ADA_SRCDIR)/$(ABASE)-trace.ads: $(srcdir)/$(ABASE)-trace.ads.m4 \ - $(GEN_FILES5) $(srcdir)/normal.m4 + $(srcdir)/normal.m4 $(M4) $(M4FLAGS) -DM4MACRO=$(srcdir)/normal.m4 \ $(srcdir)/$(ABASE)-trace.ads.m4 |\ $(DEL_ADAMODE) >$@ $(ADA_SRCDIR)/$(ABASE)-menus.ads: $(srcdir)/$(ABASE)-menus.ads.m4 \ - $(GEN_FILES2) $(srcdir)/normal.m4 + $(srcdir)/normal.m4 $(M4) $(M4FLAGS) -DM4MACRO=$(srcdir)/normal.m4 \ $(srcdir)/$(ABASE)-menus.ads.m4 |\ $(DEL_ADAMODE) >$@ $(ADA_SRCDIR)/$(ABASE)-forms.ads: $(srcdir)/$(ABASE)-forms.ads.m4 \ - $(GEN_FILES3) $(srcdir)/normal.m4 + $(srcdir)/normal.m4 $(M4) $(M4FLAGS) -DM4MACRO=$(srcdir)/normal.m4 \ $(srcdir)/$(ABASE)-forms.ads.m4 |\ $(DEL_ADAMODE) >$@ $(ADA_SRCDIR)/$(ABASE)-mouse.ads: $(srcdir)/$(ABASE)-mouse.ads.m4 \ - $(GEN_FILES4) $(srcdir)/normal.m4 + $(srcdir)/normal.m4 $(M4) $(M4FLAGS) -DM4MACRO=$(srcdir)/normal.m4 \ $(srcdir)/$(ABASE)-mouse.ads.m4 |\ $(DEL_ADAMODE) >$@ $(ADA_SRCDIR)/$(ABASE)-panels.ads: $(srcdir)/$(ABASE)-panels.ads.m4 \ - $(GEN_FILES4) \ $(srcdir)/normal.m4 $(M4) $(M4FLAGS) -DM4MACRO=$(srcdir)/normal.m4 \ $(srcdir)/$(ABASE)-panels.ads.m4 |\ @@ -363,11 +255,6 @@ tags: mostlyclean :: -rm -f a.out core $(PROG_GENERATE) *.o - -rm -f $(GEN_FILES1) - -rm -f $(GEN_FILES2) - -rm -f $(GEN_FILES3) - -rm -f $(GEN_FILES4) - -rm -f $(GEN_FILES5) clean :: mostlyclean -rm -f $(GEN_TARGETS) instab.tmp *.ad[bs] *.html *.ali *.tmp @@ -410,8 +297,7 @@ adahtml: @find $(HTML_DIR) -type f -exec rm -f {} \; @mkdir -p $(HTML_DIR) cp -p ../src/*.ad[sb] . && chmod +w *.ad[sb] -@USE_OLD_MAKERULES@ ln -sf ../src/*.ali . -@USE_GNAT_PROJECTS@ ln -sf ../static-ali/*.ali . + ln -sf ../src/*.ali . @echo "Filtering generated files" @for f in $(GEN_SRC); do \ h=`basename $$f` ;\ diff --git a/Ada95/gen/gen.c b/Ada95/gen/gen.c index 082315b6..3d4596f7 100644 --- a/Ada95/gen/gen.c +++ b/Ada95/gen/gen.c @@ -32,48 +32,69 @@ /* Version Control - $Id: gen.c,v 1.64 2014/02/01 19:52:47 tom Exp $ + $Id: gen.c,v 1.68 2014/05/24 21:34:53 tom Exp $ --------------------------------------------------------------------------*/ /* - This program generates various record structures and constants from the - ncurses header file for the Ada95 packages. Essentially it produces - Ada95 source on stdout, which is then merged using m4 into a template - to produce the real source. - */ + This program prints on its standard output the source for the + Terminal_Interface.Curses_Constants Ada package specification. This pure + package only exports C constants to the Ada compiler. + */ #ifdef HAVE_CONFIG_H #include #else #include -#define HAVE_USE_DEFAULT_COLORS 1 #endif #include -#include #include -#include -#include #include #include #undef UCHAR #undef UINT -#define UChar(c) ((UCHAR)(c)) -#define RES_NAME "Reserved" typedef unsigned char UCHAR; typedef unsigned int UINT; -static const char *model = ""; -static int little_endian = 0; +/* These global variables will be set by main () */ +static int little_endian; +static const char *my_program_invocation_name = NULL; -typedef struct - { - const char *name; - unsigned long attr; - } -name_attribute_pair; +static void +my_error(const char *message) +{ + fprintf(stderr, "%s: %s\n", my_program_invocation_name, message); + exit(EXIT_FAILURE); +} + +static void +print_constant(const char *name, + long value) +{ + printf(" %-28s : constant := %ld;\n", name, value); +} + +#define PRINT_NAMED_CONSTANT(name) \ + print_constant (#name, name) + +static void +print_comment(const char *message) +{ + printf("\n -- %s\n\n", message); +} + +/* + * Make sure that KEY_MIN and KEY_MAX are defined. + * main () will protest if KEY_MIN == 256 + */ +#ifndef KEY_MAX +# define KEY_MAX 0777 +#endif +#ifndef KEY_MIN +# define KEY_MIN 0401 +#endif static UCHAR bit_is_set(const UCHAR * const data, @@ -114,1407 +135,400 @@ find_pos(const UCHAR * const data, return -1; } -/* - * This helper routine generates a representation clause for a - * record type defined in the binding. - * We are only dealing with record types which are of 32 or 16 - * bit size, i.e. they fit into an (u)int or a (u)short. - * Any pair with a 0 attr field will be ignored. - */ -static void -gen_reps( - const name_attribute_pair * nap, /* array of name_attribute_pair records */ - const char *name, /* name of the represented record type */ - const UINT len, /* size of the record in bytes */ - const UINT bias) -{ - const UINT len_bits = len << 3; - int i, l; - UINT low, high; - int width = strlen(RES_NAME) + 3; - - assert(nap != NULL); - - for (i = 0; nap[i].name != (char *)0; i++) - if (nap[i].attr) - { - l = (int)strlen(nap[i].name); - if (l > width) - width = l; - } - assert(width > 0); - - printf(" type %s is\n", name); - printf(" record\n"); - for (i = 0; nap[i].name != (char *)0; i++) - if (nap[i].attr) - { - printf(" %-*s : Boolean;\n", width, nap[i].name); - } - printf(" end record;\n"); - printf(" pragma Convention (C, %s);\n\n", name); - - printf(" for %s use\n", name); - printf(" record\n"); - - for (i = 0; nap[i].name != (char *)0; i++) - if (nap[i].attr) - { - if (find_pos((const UCHAR *)(&(nap[i].attr)) + bias, len, &low, &high)) - printf(" %-*s at 0 range %2d .. %2d;\n", width, nap[i].name, - low, high); - } - printf(" end record;\n"); - printf(" pragma Warnings (Off);"); - printf(" for %s'Size use %d;\n", name, len_bits); - printf(" pragma Warnings (On);\n"); - printf(" -- Please note: this rep. clause is generated and may be\n"); - printf(" -- different on your system."); -} - -static void -chtype_rep(const char *name, attr_t mask) -{ - attr_t x = (attr_t)-1; - attr_t t = x & mask; - UINT low, high; - - if (find_pos((const UCHAR *)(&t), sizeof(t), &low, &high)) - printf(" %-5s at 0 range %2d .. %2d;\n", name, low, high); -} - -static void -gen_chtype_rep(const char *name) -{ - printf(" for %s use\n record\n", name); - chtype_rep("Ch", A_CHARTEXT); - chtype_rep("Color", A_COLOR); - chtype_rep("Attr", (A_ATTRIBUTES & ~A_COLOR)); - printf(" end record;\n for %s'Size use %ld;\n", - name, (long)(8 * sizeof(chtype))); - - printf(" -- Please note: this rep. clause is generated and may be\n"); - printf(" -- different on your system.\n"); -} - -static void -mrep_rep(const char *name, void *rec) -{ - UINT low, high; - - if (find_pos((const UCHAR *)rec, sizeof(MEVENT), &low, &high)) - printf(" %-7s at 0 range %3d .. %3d;\n", name, low, high); -} - -static void -gen_mrep_rep(const char *name) -{ - MEVENT x; - - printf(" for %s use\n record\n", name); - - memset(&x, 0, sizeof(x)); - x.id = -1; - mrep_rep("Id", &x); - - memset(&x, 0, sizeof(x)); - x.x = -1; - mrep_rep("X", &x); - - memset(&x, 0, sizeof(x)); - x.y = -1; - mrep_rep("Y", &x); - - memset(&x, 0, sizeof(x)); - x.z = -1; - mrep_rep("Z", &x); - - memset(&x, 0, sizeof(x)); - x.bstate = (mmask_t) - 1; - mrep_rep("Bstate", &x); - - printf(" end record;\n"); - printf(" -- Please note: this rep. clause is generated and may be\n"); - printf(" -- different on your system.\n"); -} - -static void -gen_attr_set(const char *name) -{ - /* All of the A_xxx symbols are defined in ncurses, but not all are nonzero - * if "configure --enable-widec" is not specified. Originally (in - * 1999-2000), the ifdef's also were needed since the proposed bit-layout - * for wide characters allocated 16-bits for A_CHARTEXT, leaving too few - * bits for a few of the A_xxx symbols. - * Some preprocessors are not able to test the values because they - * now (2014) contain an explicit cast to chtype, so we avoid ifdef. - */ - static const name_attribute_pair nap[] = - { - {"Stand_Out", A_STANDOUT}, - {"Under_Line", A_UNDERLINE}, - {"Reverse_Video", A_REVERSE}, - {"Blink", A_BLINK}, - {"Dim_Character", A_DIM}, - {"Bold_Character", A_BOLD}, - {"Alternate_Character_Set", A_ALTCHARSET}, - {"Invisible_Character", A_INVIS}, - {"Protected_Character", A_PROTECT}, - {"Horizontal", A_HORIZONTAL}, - {"Left", A_LEFT}, - {"Low", A_LOW}, - {"Right", A_RIGHT}, - {"Top", A_TOP}, - {"Vertical", A_VERTICAL}, - {(char *)0, 0} - }; - chtype attr = A_ATTRIBUTES & ~A_COLOR; - int start = -1; - int len = 0; - int i; - chtype set; - for (i = 0; i < (int)(8 * sizeof(chtype)); i++) - - { - set = (attr & 1); - if (set) - { - if (start < 0) - start = i; - if (start >= 0) - { - len++; - } - } - attr = attr >> 1; - } - gen_reps(nap, name, - (UINT) ((len + 7) / 8), - (UINT) (little_endian ? start >> 3 : 0)); -} - -static void -gen_trace(const char *name) -{ - static const name_attribute_pair nap[] = - { - {"Times", TRACE_TIMES}, - {"Tputs", TRACE_TPUTS}, - {"Update", TRACE_UPDATE}, - {"Cursor_Move", TRACE_MOVE}, - {"Character_Output", TRACE_CHARPUT}, - {"Calls", TRACE_CALLS}, - {"Virtual_Puts", TRACE_VIRTPUT}, - {"Input_Events", TRACE_IEVENT}, - {"TTY_State", TRACE_BITS}, - {"Internal_Calls", TRACE_ICALLS}, - {"Character_Calls", TRACE_CCALLS}, - {"Termcap_TermInfo", TRACE_DATABASE}, - {"Attributes_And_Colors", TRACE_ATTRS}, - {(char *)0, 0} - }; +#define PRINT_BITMASK(c_type, ada_name, mask_macro) \ + { \ + UINT first, last; \ + c_type mask = (mask_macro); \ + if (!find_pos ((UCHAR *)&mask, sizeof (mask), &first, &last)) \ + my_error ("failed to locate " ada_name); \ + print_constant (ada_name "_First", first); \ + print_constant (ada_name "_Last", last); \ + } - gen_reps(nap, name, sizeof(UINT), - little_endian ? 0 : sizeof(nap[0].attr) - sizeof(UINT)); -} +#define PRINT_NAMED_BITMASK(c_type, mask_macro) \ + PRINT_BITMASK (c_type, #mask_macro, mask_macro) + +#define STRUCT_OFFSET(record, field) \ + { \ + UINT first, last; \ + record mask; \ + memset (&mask, 0, sizeof (mask)); \ + mask.field = -1; \ + if (!find_pos ((UCHAR *)&mask, sizeof (mask), &first, &last)) \ + my_error ("failed to locate" #record "_" #field); \ + print_constant (#record "_" #field "_First", first); \ + print_constant (#record "_" #field "_Last", last); \ + } -static void -gen_menu_opt_rep(const char *name) -{ - static const name_attribute_pair nap[] = - { -#ifdef O_ONEVALUE - {"One_Valued", O_ONEVALUE}, -#endif -#ifdef O_SHOWDESC - {"Show_Descriptions", O_SHOWDESC}, -#endif -#ifdef O_ROWMAJOR - {"Row_Major_Order", O_ROWMAJOR}, -#endif -#ifdef O_IGNORECASE - {"Ignore_Case", O_IGNORECASE}, -#endif -#ifdef O_SHOWMATCH - {"Show_Matches", O_SHOWMATCH}, -#endif -#ifdef O_NONCYCLIC - {"Non_Cyclic", O_NONCYCLIC}, -#endif - {(char *)0, 0} - }; +/*--------------------*/ +/* Start of main (). */ +/*--------------------*/ - gen_reps(nap, name, sizeof(Menu_Options), - little_endian ? 0 : sizeof(nap[0].attr) - sizeof(Menu_Options)); -} - -static void -gen_item_opt_rep(const char *name) +int +main(int argc, const char *argv[]) { - static const name_attribute_pair nap[] = - { -#ifdef O_SELECTABLE - {"Selectable", O_SELECTABLE}, -#endif - {(char *)0, 0} - }; - - gen_reps(nap, name, sizeof(Item_Options), - little_endian ? 0 : sizeof(nap[0].attr) - sizeof(Item_Options)); -} + const int x = 0x12345678; -static void -gen_form_opt_rep(const char *name) -{ - static const name_attribute_pair nap[] = - { -#ifdef O_NL_OVERLOAD - {"NL_Overload", O_NL_OVERLOAD}, -#endif -#ifdef O_BS_OVERLOAD - {"BS_Overload", O_BS_OVERLOAD}, -#endif - {(char *)0, 0} - }; + little_endian = (*((const char *)&x) == 0x78); - gen_reps(nap, name, sizeof(Form_Options), - little_endian ? 0 : sizeof(nap[0].attr) - sizeof(Form_Options)); -} + my_program_invocation_name = argv[0]; -/* - * Generate the representation clause for the Field_Option_Set record - */ -static void -gen_field_opt_rep(const char *name) -{ - static const name_attribute_pair nap[] = - { -#ifdef O_VISIBLE - {"Visible", O_VISIBLE}, -#endif -#ifdef O_ACTIVE - {"Active", O_ACTIVE}, -#endif -#ifdef O_PUBLIC - {"Public", O_PUBLIC}, -#endif -#ifdef O_EDIT - {"Edit", O_EDIT}, -#endif -#ifdef O_WRAP - {"Wrap", O_WRAP}, -#endif -#ifdef O_BLANK - {"Blank", O_BLANK}, -#endif -#ifdef O_AUTOSKIP - {"Auto_Skip", O_AUTOSKIP}, -#endif -#ifdef O_NULLOK - {"Null_Ok", O_NULLOK}, -#endif -#ifdef O_PASSOK - {"Pass_Ok", O_PASSOK}, -#endif -#ifdef O_STATIC - {"Static", O_STATIC}, -#endif - {(char *)0, 0} - }; + if (KEY_MIN == 256) + my_error("unexpected value for KEY_MIN: 256"); - gen_reps(nap, name, sizeof(Field_Options), - little_endian ? 0 : sizeof(nap[0].attr) - sizeof(Field_Options)); -} + if (argc != 2) + my_error("Only one argument expected (DFT_ARG_SUFFIX)"); -/* - * Generate a single key code constant definition. - */ -static void -keydef(const char *name, const char *old_name, int value, int mode) -{ - if (mode == 0) /* Generate the new name */ - printf(" %-30s : constant Special_Key_Code := 8#%3o#;\n", name, value); - else - { - const char *s = old_name; - const char *t = name; + printf("-- Generated by the C program %s (source " __FILE__ ").\n", + my_program_invocation_name); + printf("-- Do not edit this file directly.\n"); + printf("-- The values provided here may vary on your system.\n"); + printf("\n"); + printf("with System;\n"); + printf("package Terminal_Interface.Curses_Constants is\n"); + printf(" pragma Pure;\n"); + printf("\n"); - /* generate the old name, but only if it doesn't conflict with the old - * name (Ada95 isn't case sensitive!) - */ - while (*s && *t && (toupper(UChar(*s++)) == toupper(UChar(*t++)))); - if (*s || *t) - printf(" %-16s : Special_Key_Code renames %s;\n", old_name, name); - } -} + printf(" DFT_ARG_SUFFIX : constant String := \"%s\";\n", argv[1]); + printf(" Bit_Order : constant System.Bit_Order := System.%s_Order_First;\n", + little_endian ? "Low" : "High"); + print_constant("Sizeof_Bool", 8 * sizeof(bool)); -/* - * Generate constants for the key codes. When called with mode==0, a - * complete list with nice constant names in proper casing style will - * be generated. Otherwise a list of old (i.e. C-style) names will be - * generated, given that the name wasn't already defined in the "nice" - * list. - */ -static void -gen_keydefs(int mode) -{ - char buf[16]; - char obuf[16]; - int i; + PRINT_NAMED_CONSTANT(OK); + PRINT_NAMED_CONSTANT(ERR); + printf(" pragma Warnings (Off); -- redefinition of Standard.True and False\n"); + PRINT_NAMED_CONSTANT(TRUE); + PRINT_NAMED_CONSTANT(FALSE); + printf(" pragma Warnings (On);\n"); + print_comment("Version of the ncurses library from extensions(3NCURSES)"); + PRINT_NAMED_CONSTANT(NCURSES_VERSION_MAJOR); + PRINT_NAMED_CONSTANT(NCURSES_VERSION_MINOR); + printf(" Version : constant String := \"%d.%d\";\n", + NCURSES_VERSION_MAJOR, NCURSES_VERSION_MINOR); + + print_comment("Character non-color attributes from attr(3NCURSES)"); + printf(" -- attr_t and chtype may be signed in C.\n"); + printf(" type attr_t is mod 2 ** %lu;\n", (long unsigned)(8 * sizeof(attr_t))); + PRINT_NAMED_BITMASK(attr_t, A_CHARTEXT); + PRINT_NAMED_BITMASK(attr_t, A_COLOR); + PRINT_BITMASK(attr_t, "Attr", A_ATTRIBUTES & ~A_COLOR); + PRINT_NAMED_BITMASK(attr_t, A_STANDOUT); + PRINT_NAMED_BITMASK(attr_t, A_UNDERLINE); + PRINT_NAMED_BITMASK(attr_t, A_REVERSE); + PRINT_NAMED_BITMASK(attr_t, A_BLINK); + PRINT_NAMED_BITMASK(attr_t, A_DIM); + PRINT_NAMED_BITMASK(attr_t, A_BOLD); + PRINT_NAMED_BITMASK(attr_t, A_PROTECT); + PRINT_NAMED_BITMASK(attr_t, A_INVIS); + PRINT_NAMED_BITMASK(attr_t, A_ALTCHARSET); + PRINT_NAMED_BITMASK(attr_t, A_HORIZONTAL); + PRINT_NAMED_BITMASK(attr_t, A_LEFT); + PRINT_NAMED_BITMASK(attr_t, A_LOW); + PRINT_NAMED_BITMASK(attr_t, A_RIGHT); + PRINT_NAMED_BITMASK(attr_t, A_TOP); + PRINT_NAMED_BITMASK(attr_t, A_VERTICAL); + print_constant("chtype_Size", 8 * sizeof(chtype)); + + print_comment("predefined color numbers from color(3NCURSES)"); + PRINT_NAMED_CONSTANT(COLOR_BLACK); + PRINT_NAMED_CONSTANT(COLOR_RED); + PRINT_NAMED_CONSTANT(COLOR_GREEN); + PRINT_NAMED_CONSTANT(COLOR_YELLOW); + PRINT_NAMED_CONSTANT(COLOR_BLUE); + PRINT_NAMED_CONSTANT(COLOR_MAGENTA); + PRINT_NAMED_CONSTANT(COLOR_CYAN); + PRINT_NAMED_CONSTANT(COLOR_WHITE); + + print_comment("ETI return codes from ncurses.h"); + PRINT_NAMED_CONSTANT(E_OK); + PRINT_NAMED_CONSTANT(E_SYSTEM_ERROR); + PRINT_NAMED_CONSTANT(E_BAD_ARGUMENT); + PRINT_NAMED_CONSTANT(E_POSTED); + PRINT_NAMED_CONSTANT(E_CONNECTED); + PRINT_NAMED_CONSTANT(E_BAD_STATE); + PRINT_NAMED_CONSTANT(E_NO_ROOM); + PRINT_NAMED_CONSTANT(E_NOT_POSTED); + PRINT_NAMED_CONSTANT(E_UNKNOWN_COMMAND); + PRINT_NAMED_CONSTANT(E_NO_MATCH); + PRINT_NAMED_CONSTANT(E_NOT_SELECTABLE); + PRINT_NAMED_CONSTANT(E_NOT_CONNECTED); + PRINT_NAMED_CONSTANT(E_REQUEST_DENIED); + PRINT_NAMED_CONSTANT(E_INVALID_FIELD); + PRINT_NAMED_CONSTANT(E_CURRENT); + + print_comment("Input key codes not defined in any ncurses manpage"); + PRINT_NAMED_CONSTANT(KEY_MIN); + PRINT_NAMED_CONSTANT(KEY_MAX); #ifdef KEY_CODE_YES - keydef("Key_Code_Yes", "KEY_CODE_YES", KEY_CODE_YES, mode); -#endif -#ifdef KEY_MIN - keydef("Key_Min", "KEY_MIN", KEY_MIN, mode); -#endif -#ifdef KEY_BREAK - keydef("Key_Break", "KEY_BREAK", KEY_BREAK, mode); -#endif -#ifdef KEY_DOWN - keydef("Key_Cursor_Down", "KEY_DOWN", KEY_DOWN, mode); -#endif -#ifdef KEY_UP - keydef("Key_Cursor_Up", "KEY_UP", KEY_UP, mode); -#endif -#ifdef KEY_LEFT - keydef("Key_Cursor_Left", "KEY_LEFT", KEY_LEFT, mode); -#endif -#ifdef KEY_RIGHT - keydef("Key_Cursor_Right", "KEY_RIGHT", KEY_RIGHT, mode); -#endif -#ifdef KEY_HOME - keydef("Key_Home", "KEY_HOME", KEY_HOME, mode); -#endif -#ifdef KEY_BACKSPACE - keydef("Key_Backspace", "KEY_BACKSPACE", KEY_BACKSPACE, mode); -#endif -#ifdef KEY_F0 - keydef("Key_F0", "KEY_F0", KEY_F0, mode); -#endif -#ifdef KEY_F - for (i = 1; i <= 24; i++) - { - sprintf(buf, "Key_F%d", i); - sprintf(obuf, "KEY_F%d", i); - keydef(buf, obuf, KEY_F(i), mode); - } -#endif -#ifdef KEY_DL - keydef("Key_Delete_Line", "KEY_DL", KEY_DL, mode); -#endif -#ifdef KEY_IL - keydef("Key_Insert_Line", "KEY_IL", KEY_IL, mode); -#endif -#ifdef KEY_DC - keydef("Key_Delete_Char", "KEY_DC", KEY_DC, mode); -#endif -#ifdef KEY_IC - keydef("Key_Insert_Char", "KEY_IC", KEY_IC, mode); -#endif -#ifdef KEY_EIC - keydef("Key_Exit_Insert_Mode", "KEY_EIC", KEY_EIC, mode); -#endif -#ifdef KEY_CLEAR - keydef("Key_Clear_Screen", "KEY_CLEAR", KEY_CLEAR, mode); -#endif -#ifdef KEY_EOS - keydef("Key_Clear_End_Of_Screen", "KEY_EOS", KEY_EOS, mode); -#endif -#ifdef KEY_EOL - keydef("Key_Clear_End_Of_Line", "KEY_EOL", KEY_EOL, mode); -#endif -#ifdef KEY_SF - keydef("Key_Scroll_1_Forward", "KEY_SF", KEY_SF, mode); -#endif -#ifdef KEY_SR - keydef("Key_Scroll_1_Backward", "KEY_SR", KEY_SR, mode); -#endif -#ifdef KEY_NPAGE - keydef("Key_Next_Page", "KEY_NPAGE", KEY_NPAGE, mode); -#endif -#ifdef KEY_PPAGE - keydef("Key_Previous_Page", "KEY_PPAGE", KEY_PPAGE, mode); -#endif -#ifdef KEY_STAB - keydef("Key_Set_Tab", "KEY_STAB", KEY_STAB, mode); -#endif -#ifdef KEY_CTAB - keydef("Key_Clear_Tab", "KEY_CTAB", KEY_CTAB, mode); -#endif -#ifdef KEY_CATAB - keydef("Key_Clear_All_Tabs", "KEY_CATAB", KEY_CATAB, mode); -#endif -#ifdef KEY_ENTER - keydef("Key_Enter_Or_Send", "KEY_ENTER", KEY_ENTER, mode); -#endif -#ifdef KEY_SRESET - keydef("Key_Soft_Reset", "KEY_SRESET", KEY_SRESET, mode); -#endif -#ifdef KEY_RESET - keydef("Key_Reset", "KEY_RESET", KEY_RESET, mode); -#endif -#ifdef KEY_PRINT - keydef("Key_Print", "KEY_PRINT", KEY_PRINT, mode); -#endif -#ifdef KEY_LL - keydef("Key_Bottom", "KEY_LL", KEY_LL, mode); -#endif -#ifdef KEY_A1 - keydef("Key_Upper_Left_Of_Keypad", "KEY_A1", KEY_A1, mode); -#endif -#ifdef KEY_A3 - keydef("Key_Upper_Right_Of_Keypad", "KEY_A3", KEY_A3, mode); -#endif -#ifdef KEY_B2 - keydef("Key_Center_Of_Keypad", "KEY_B2", KEY_B2, mode); -#endif -#ifdef KEY_C1 - keydef("Key_Lower_Left_Of_Keypad", "KEY_C1", KEY_C1, mode); -#endif -#ifdef KEY_C3 - keydef("Key_Lower_Right_Of_Keypad", "KEY_C3", KEY_C3, mode); -#endif -#ifdef KEY_BTAB - keydef("Key_Back_Tab", "KEY_BTAB", KEY_BTAB, mode); -#endif -#ifdef KEY_BEG - keydef("Key_Beginning", "KEY_BEG", KEY_BEG, mode); -#endif -#ifdef KEY_CANCEL - keydef("Key_Cancel", "KEY_CANCEL", KEY_CANCEL, mode); -#endif -#ifdef KEY_CLOSE - keydef("Key_Close", "KEY_CLOSE", KEY_CLOSE, mode); -#endif -#ifdef KEY_COMMAND - keydef("Key_Command", "KEY_COMMAND", KEY_COMMAND, mode); -#endif -#ifdef KEY_COPY - keydef("Key_Copy", "KEY_COPY", KEY_COPY, mode); -#endif -#ifdef KEY_CREATE - keydef("Key_Create", "KEY_CREATE", KEY_CREATE, mode); -#endif -#ifdef KEY_END - keydef("Key_End", "KEY_END", KEY_END, mode); -#endif -#ifdef KEY_EXIT - keydef("Key_Exit", "KEY_EXIT", KEY_EXIT, mode); -#endif -#ifdef KEY_FIND - keydef("Key_Find", "KEY_FIND", KEY_FIND, mode); -#endif -#ifdef KEY_HELP - keydef("Key_Help", "KEY_HELP", KEY_HELP, mode); -#endif -#ifdef KEY_MARK - keydef("Key_Mark", "KEY_MARK", KEY_MARK, mode); -#endif -#ifdef KEY_MESSAGE - keydef("Key_Message", "KEY_MESSAGE", KEY_MESSAGE, mode); -#endif -#ifdef KEY_MOVE - keydef("Key_Move", "KEY_MOVE", KEY_MOVE, mode); -#endif -#ifdef KEY_NEXT - keydef("Key_Next", "KEY_NEXT", KEY_NEXT, mode); -#endif -#ifdef KEY_OPEN - keydef("Key_Open", "KEY_OPEN", KEY_OPEN, mode); -#endif -#ifdef KEY_OPTIONS - keydef("Key_Options", "KEY_OPTIONS", KEY_OPTIONS, mode); -#endif -#ifdef KEY_PREVIOUS - keydef("Key_Previous", "KEY_PREVIOUS", KEY_PREVIOUS, mode); -#endif -#ifdef KEY_REDO - keydef("Key_Redo", "KEY_REDO", KEY_REDO, mode); -#endif -#ifdef KEY_REFERENCE - keydef("Key_Reference", "KEY_REFERENCE", KEY_REFERENCE, mode); -#endif -#ifdef KEY_REFRESH - keydef("Key_Refresh", "KEY_REFRESH", KEY_REFRESH, mode); -#endif -#ifdef KEY_REPLACE - keydef("Key_Replace", "KEY_REPLACE", KEY_REPLACE, mode); -#endif -#ifdef KEY_RESTART - keydef("Key_Restart", "KEY_RESTART", KEY_RESTART, mode); -#endif -#ifdef KEY_RESUME - keydef("Key_Resume", "KEY_RESUME", KEY_RESUME, mode); -#endif -#ifdef KEY_SAVE - keydef("Key_Save", "KEY_SAVE", KEY_SAVE, mode); -#endif -#ifdef KEY_SBEG - keydef("Key_Shift_Begin", "KEY_SBEG", KEY_SBEG, mode); -#endif -#ifdef KEY_SCANCEL - keydef("Key_Shift_Cancel", "KEY_SCANCEL", KEY_SCANCEL, mode); -#endif -#ifdef KEY_SCOMMAND - keydef("Key_Shift_Command", "KEY_SCOMMAND", KEY_SCOMMAND, mode); -#endif -#ifdef KEY_SCOPY - keydef("Key_Shift_Copy", "KEY_SCOPY", KEY_SCOPY, mode); -#endif -#ifdef KEY_SCREATE - keydef("Key_Shift_Create", "KEY_SCREATE", KEY_SCREATE, mode); -#endif -#ifdef KEY_SDC - keydef("Key_Shift_Delete_Char", "KEY_SDC", KEY_SDC, mode); -#endif -#ifdef KEY_SDL - keydef("Key_Shift_Delete_Line", "KEY_SDL", KEY_SDL, mode); -#endif -#ifdef KEY_SELECT - keydef("Key_Select", "KEY_SELECT", KEY_SELECT, mode); -#endif -#ifdef KEY_SEND - keydef("Key_Shift_End", "KEY_SEND", KEY_SEND, mode); -#endif -#ifdef KEY_SEOL - keydef("Key_Shift_Clear_End_Of_Line", "KEY_SEOL", KEY_SEOL, mode); -#endif -#ifdef KEY_SEXIT - keydef("Key_Shift_Exit", "KEY_SEXIT", KEY_SEXIT, mode); -#endif -#ifdef KEY_SFIND - keydef("Key_Shift_Find", "KEY_SFIND", KEY_SFIND, mode); -#endif -#ifdef KEY_SHELP - keydef("Key_Shift_Help", "KEY_SHELP", KEY_SHELP, mode); -#endif -#ifdef KEY_SHOME - keydef("Key_Shift_Home", "KEY_SHOME", KEY_SHOME, mode); -#endif -#ifdef KEY_SIC - keydef("Key_Shift_Insert_Char", "KEY_SIC", KEY_SIC, mode); -#endif -#ifdef KEY_SLEFT - keydef("Key_Shift_Cursor_Left", "KEY_SLEFT", KEY_SLEFT, mode); -#endif -#ifdef KEY_SMESSAGE - keydef("Key_Shift_Message", "KEY_SMESSAGE", KEY_SMESSAGE, mode); -#endif -#ifdef KEY_SMOVE - keydef("Key_Shift_Move", "KEY_SMOVE", KEY_SMOVE, mode); -#endif -#ifdef KEY_SNEXT - keydef("Key_Shift_Next_Page", "KEY_SNEXT", KEY_SNEXT, mode); -#endif -#ifdef KEY_SOPTIONS - keydef("Key_Shift_Options", "KEY_SOPTIONS", KEY_SOPTIONS, mode); -#endif -#ifdef KEY_SPREVIOUS - keydef("Key_Shift_Previous_Page", "KEY_SPREVIOUS", KEY_SPREVIOUS, mode); -#endif -#ifdef KEY_SPRINT - keydef("Key_Shift_Print", "KEY_SPRINT", KEY_SPRINT, mode); -#endif -#ifdef KEY_SREDO - keydef("Key_Shift_Redo", "KEY_SREDO", KEY_SREDO, mode); -#endif -#ifdef KEY_SREPLACE - keydef("Key_Shift_Replace", "KEY_SREPLACE", KEY_SREPLACE, mode); -#endif -#ifdef KEY_SRIGHT - keydef("Key_Shift_Cursor_Right", "KEY_SRIGHT", KEY_SRIGHT, mode); -#endif -#ifdef KEY_SRSUME - keydef("Key_Shift_Resume", "KEY_SRSUME", KEY_SRSUME, mode); -#endif -#ifdef KEY_SSAVE - keydef("Key_Shift_Save", "KEY_SSAVE", KEY_SSAVE, mode); -#endif -#ifdef KEY_SSUSPEND - keydef("Key_Shift_Suspend", "KEY_SSUSPEND", KEY_SSUSPEND, mode); -#endif -#ifdef KEY_SUNDO - keydef("Key_Shift_Undo", "KEY_SUNDO", KEY_SUNDO, mode); -#endif -#ifdef KEY_SUSPEND - keydef("Key_Suspend", "KEY_SUSPEND", KEY_SUSPEND, mode); -#endif -#ifdef KEY_UNDO - keydef("Key_Undo", "KEY_UNDO", KEY_UNDO, mode); -#endif -#ifdef KEY_MOUSE - keydef("Key_Mouse", "KEY_MOUSE", KEY_MOUSE, mode); -#endif -#ifdef KEY_RESIZE - keydef("Key_Resize", "KEY_RESIZE", KEY_RESIZE, mode); -#endif -} - -/* - * Generate a constant with the given name. The second parameter - * is a reference to the ACS character in the acs_map[] array and - * will be translated into an index. - */ -static void -acs_def(const char *name, chtype *a) -{ - int c = (int)(a - &acs_map[0]); - - printf(" %-24s : constant Character := ", name); - if (isprint(UChar(c)) && (c != '`')) - printf("'%c';\n", c); - else - printf("Character'Val (%d);\n", c); -} - -/* - * Generate the constants for the ACS characters - */ -static void -gen_acs(void) -{ - printf(" type C_ACS_Map is array (Character'Val (0) .. Character'Val (127))\n"); - printf(" of Attributed_Character;\n"); -#if USE_REENTRANT || BROKEN_LINKER - printf(" type C_ACS_Ptr is access C_ACS_Map;\n"); - printf(" function ACS_Map return C_ACS_Ptr;\n"); - printf(" pragma Import (C, ACS_Map, \"" - NCURSES_WRAP_PREFIX - "acs_map\");\n"); -#else - printf(" ACS_Map : C_ACS_Map;\n"); - printf(" pragma Import (C, ACS_Map, \"acs_map\");\n"); -#endif - printf(" --\n"); - printf(" --\n"); - printf(" -- Constants for several characters from the Alternate Character Set\n"); - printf(" -- You must use these constants as indices into the ACS_Map array\n"); - printf(" -- to get the corresponding attributed character at runtime.\n"); - printf(" --\n"); - -#ifdef ACS_ULCORNER - acs_def("ACS_Upper_Left_Corner", &ACS_ULCORNER); -#endif -#ifdef ACS_LLCORNER - acs_def("ACS_Lower_Left_Corner", &ACS_LLCORNER); -#endif -#ifdef ACS_URCORNER - acs_def("ACS_Upper_Right_Corner", &ACS_URCORNER); -#endif -#ifdef ACS_LRCORNER - acs_def("ACS_Lower_Right_Corner", &ACS_LRCORNER); -#endif -#ifdef ACS_LTEE - acs_def("ACS_Left_Tee", &ACS_LTEE); -#endif -#ifdef ACS_RTEE - acs_def("ACS_Right_Tee", &ACS_RTEE); -#endif -#ifdef ACS_BTEE - acs_def("ACS_Bottom_Tee", &ACS_BTEE); -#endif -#ifdef ACS_TTEE - acs_def("ACS_Top_Tee", &ACS_TTEE); -#endif -#ifdef ACS_HLINE - acs_def("ACS_Horizontal_Line", &ACS_HLINE); -#endif -#ifdef ACS_VLINE - acs_def("ACS_Vertical_Line", &ACS_VLINE); -#endif -#ifdef ACS_PLUS - acs_def("ACS_Plus_Symbol", &ACS_PLUS); -#endif -#ifdef ACS_S1 - acs_def("ACS_Scan_Line_1", &ACS_S1); -#endif -#ifdef ACS_S9 - acs_def("ACS_Scan_Line_9", &ACS_S9); -#endif -#ifdef ACS_DIAMOND - acs_def("ACS_Diamond", &ACS_DIAMOND); -#endif -#ifdef ACS_CKBOARD - acs_def("ACS_Checker_Board", &ACS_CKBOARD); -#endif -#ifdef ACS_DEGREE - acs_def("ACS_Degree", &ACS_DEGREE); -#endif -#ifdef ACS_PLMINUS - acs_def("ACS_Plus_Minus", &ACS_PLMINUS); -#endif -#ifdef ACS_BULLET - acs_def("ACS_Bullet", &ACS_BULLET); -#endif -#ifdef ACS_LARROW - acs_def("ACS_Left_Arrow", &ACS_LARROW); -#endif -#ifdef ACS_RARROW - acs_def("ACS_Right_Arrow", &ACS_RARROW); -#endif -#ifdef ACS_DARROW - acs_def("ACS_Down_Arrow", &ACS_DARROW); -#endif -#ifdef ACS_UARROW - acs_def("ACS_Up_Arrow", &ACS_UARROW); -#endif -#ifdef ACS_BOARD - acs_def("ACS_Board_Of_Squares", &ACS_BOARD); -#endif -#ifdef ACS_LANTERN - acs_def("ACS_Lantern", &ACS_LANTERN); -#endif -#ifdef ACS_BLOCK - acs_def("ACS_Solid_Block", &ACS_BLOCK); -#endif -#ifdef ACS_S3 - acs_def("ACS_Scan_Line_3", &ACS_S3); -#endif -#ifdef ACS_S7 - acs_def("ACS_Scan_Line_7", &ACS_S7); -#endif -#ifdef ACS_LEQUAL - acs_def("ACS_Less_Or_Equal", &ACS_LEQUAL); -#endif -#ifdef ACS_GEQUAL - acs_def("ACS_Greater_Or_Equal", &ACS_GEQUAL); -#endif -#ifdef ACS_PI - acs_def("ACS_PI", &ACS_PI); -#endif -#ifdef ACS_NEQUAL - acs_def("ACS_Not_Equal", &ACS_NEQUAL); -#endif -#ifdef ACS_STERLING - acs_def("ACS_Sterling", &ACS_STERLING); -#endif -} - -#define GEN_EVENT(name,value) \ - printf(" %-25s : constant Event_Mask := 8#%011lo#;\n", \ - #name, value) - -#define GEN_MEVENT(name) \ - printf(" %-25s : constant Event_Mask := 8#%011lo#;\n", \ - #name, name) - -static void -gen_mouse_events(void) -{ - mmask_t all1 = 0; - mmask_t all2 = 0; - mmask_t all3 = 0; - mmask_t all4 = 0; - -#ifdef BUTTON1_RELEASED - GEN_MEVENT(BUTTON1_RELEASED); - all1 |= BUTTON1_RELEASED; -#endif -#ifdef BUTTON1_PRESSED - GEN_MEVENT(BUTTON1_PRESSED); - all1 |= BUTTON1_PRESSED; -#endif -#ifdef BUTTON1_CLICKED - GEN_MEVENT(BUTTON1_CLICKED); - all1 |= BUTTON1_CLICKED; -#endif -#ifdef BUTTON1_DOUBLE_CLICKED - GEN_MEVENT(BUTTON1_DOUBLE_CLICKED); - all1 |= BUTTON1_DOUBLE_CLICKED; -#endif -#ifdef BUTTON1_TRIPLE_CLICKED - GEN_MEVENT(BUTTON1_TRIPLE_CLICKED); - all1 |= BUTTON1_TRIPLE_CLICKED; -#endif + PRINT_NAMED_CONSTANT(KEY_CODE_YES); +#endif + + print_comment("Input key codes from getch(3NCURSES)"); + PRINT_NAMED_CONSTANT(KEY_BREAK); + PRINT_NAMED_CONSTANT(KEY_DOWN); + PRINT_NAMED_CONSTANT(KEY_UP); + PRINT_NAMED_CONSTANT(KEY_LEFT); + PRINT_NAMED_CONSTANT(KEY_RIGHT); + PRINT_NAMED_CONSTANT(KEY_HOME); + PRINT_NAMED_CONSTANT(KEY_BACKSPACE); + PRINT_NAMED_CONSTANT(KEY_F0); + print_constant("KEY_F1", KEY_F(1)); + print_constant("KEY_F2", KEY_F(2)); + print_constant("KEY_F3", KEY_F(3)); + print_constant("KEY_F4", KEY_F(4)); + print_constant("KEY_F5", KEY_F(5)); + print_constant("KEY_F6", KEY_F(6)); + print_constant("KEY_F7", KEY_F(7)); + print_constant("KEY_F8", KEY_F(8)); + print_constant("KEY_F9", KEY_F(9)); + print_constant("KEY_F10", KEY_F(10)); + print_constant("KEY_F11", KEY_F(11)); + print_constant("KEY_F12", KEY_F(12)); + print_constant("KEY_F13", KEY_F(13)); + print_constant("KEY_F14", KEY_F(14)); + print_constant("KEY_F15", KEY_F(15)); + print_constant("KEY_F16", KEY_F(16)); + print_constant("KEY_F17", KEY_F(17)); + print_constant("KEY_F18", KEY_F(18)); + print_constant("KEY_F19", KEY_F(19)); + print_constant("KEY_F20", KEY_F(20)); + print_constant("KEY_F21", KEY_F(21)); + print_constant("KEY_F22", KEY_F(22)); + print_constant("KEY_F23", KEY_F(23)); + print_constant("KEY_F24", KEY_F(24)); + PRINT_NAMED_CONSTANT(KEY_DL); + PRINT_NAMED_CONSTANT(KEY_IL); + PRINT_NAMED_CONSTANT(KEY_DC); + PRINT_NAMED_CONSTANT(KEY_IC); + PRINT_NAMED_CONSTANT(KEY_EIC); + PRINT_NAMED_CONSTANT(KEY_CLEAR); + PRINT_NAMED_CONSTANT(KEY_EOS); + PRINT_NAMED_CONSTANT(KEY_EOL); + PRINT_NAMED_CONSTANT(KEY_SF); + PRINT_NAMED_CONSTANT(KEY_SR); + PRINT_NAMED_CONSTANT(KEY_NPAGE); + PRINT_NAMED_CONSTANT(KEY_PPAGE); + PRINT_NAMED_CONSTANT(KEY_STAB); + PRINT_NAMED_CONSTANT(KEY_CTAB); + PRINT_NAMED_CONSTANT(KEY_CATAB); + PRINT_NAMED_CONSTANT(KEY_ENTER); + PRINT_NAMED_CONSTANT(KEY_SRESET); + PRINT_NAMED_CONSTANT(KEY_RESET); + PRINT_NAMED_CONSTANT(KEY_PRINT); + PRINT_NAMED_CONSTANT(KEY_LL); + PRINT_NAMED_CONSTANT(KEY_A1); + PRINT_NAMED_CONSTANT(KEY_A3); + PRINT_NAMED_CONSTANT(KEY_B2); + PRINT_NAMED_CONSTANT(KEY_C1); + PRINT_NAMED_CONSTANT(KEY_C3); + PRINT_NAMED_CONSTANT(KEY_BTAB); + PRINT_NAMED_CONSTANT(KEY_BEG); + PRINT_NAMED_CONSTANT(KEY_CANCEL); + PRINT_NAMED_CONSTANT(KEY_CLOSE); + PRINT_NAMED_CONSTANT(KEY_COMMAND); + PRINT_NAMED_CONSTANT(KEY_COPY); + PRINT_NAMED_CONSTANT(KEY_CREATE); + PRINT_NAMED_CONSTANT(KEY_END); + PRINT_NAMED_CONSTANT(KEY_EXIT); + PRINT_NAMED_CONSTANT(KEY_FIND); + PRINT_NAMED_CONSTANT(KEY_HELP); + PRINT_NAMED_CONSTANT(KEY_MARK); + PRINT_NAMED_CONSTANT(KEY_MESSAGE); + PRINT_NAMED_CONSTANT(KEY_MOVE); + PRINT_NAMED_CONSTANT(KEY_NEXT); + PRINT_NAMED_CONSTANT(KEY_OPEN); + PRINT_NAMED_CONSTANT(KEY_OPTIONS); + PRINT_NAMED_CONSTANT(KEY_PREVIOUS); + PRINT_NAMED_CONSTANT(KEY_REDO); + PRINT_NAMED_CONSTANT(KEY_REFERENCE); + PRINT_NAMED_CONSTANT(KEY_REFRESH); + PRINT_NAMED_CONSTANT(KEY_REPLACE); + PRINT_NAMED_CONSTANT(KEY_RESTART); + PRINT_NAMED_CONSTANT(KEY_RESUME); + PRINT_NAMED_CONSTANT(KEY_SAVE); + PRINT_NAMED_CONSTANT(KEY_SBEG); + PRINT_NAMED_CONSTANT(KEY_SCANCEL); + PRINT_NAMED_CONSTANT(KEY_SCOMMAND); + PRINT_NAMED_CONSTANT(KEY_SCOPY); + PRINT_NAMED_CONSTANT(KEY_SCREATE); + PRINT_NAMED_CONSTANT(KEY_SDC); + PRINT_NAMED_CONSTANT(KEY_SDL); + PRINT_NAMED_CONSTANT(KEY_SELECT); + PRINT_NAMED_CONSTANT(KEY_SEND); + PRINT_NAMED_CONSTANT(KEY_SEOL); + PRINT_NAMED_CONSTANT(KEY_SEXIT); + PRINT_NAMED_CONSTANT(KEY_SFIND); + PRINT_NAMED_CONSTANT(KEY_SHELP); + PRINT_NAMED_CONSTANT(KEY_SHOME); + PRINT_NAMED_CONSTANT(KEY_SIC); + PRINT_NAMED_CONSTANT(KEY_SLEFT); + PRINT_NAMED_CONSTANT(KEY_SMESSAGE); + PRINT_NAMED_CONSTANT(KEY_SMOVE); + PRINT_NAMED_CONSTANT(KEY_SNEXT); + PRINT_NAMED_CONSTANT(KEY_SOPTIONS); + PRINT_NAMED_CONSTANT(KEY_SPREVIOUS); + PRINT_NAMED_CONSTANT(KEY_SPRINT); + PRINT_NAMED_CONSTANT(KEY_SREDO); + PRINT_NAMED_CONSTANT(KEY_SREPLACE); + PRINT_NAMED_CONSTANT(KEY_SRIGHT); + PRINT_NAMED_CONSTANT(KEY_SRSUME); + PRINT_NAMED_CONSTANT(KEY_SSAVE); + PRINT_NAMED_CONSTANT(KEY_SSUSPEND); + PRINT_NAMED_CONSTANT(KEY_SUNDO); + PRINT_NAMED_CONSTANT(KEY_SUSPEND); + PRINT_NAMED_CONSTANT(KEY_UNDO); + PRINT_NAMED_CONSTANT(KEY_MOUSE); + PRINT_NAMED_CONSTANT(KEY_RESIZE); + + print_comment("alternate character codes (ACS) from addch(3NCURSES)"); +#define PRINT_ACS(name) print_constant (#name, &name - &acs_map[0]) + PRINT_ACS(ACS_ULCORNER); + PRINT_ACS(ACS_LLCORNER); + PRINT_ACS(ACS_URCORNER); + PRINT_ACS(ACS_LRCORNER); + PRINT_ACS(ACS_LTEE); + PRINT_ACS(ACS_RTEE); + PRINT_ACS(ACS_BTEE); + PRINT_ACS(ACS_TTEE); + PRINT_ACS(ACS_HLINE); + PRINT_ACS(ACS_VLINE); + PRINT_ACS(ACS_PLUS); + PRINT_ACS(ACS_S1); + PRINT_ACS(ACS_S9); + PRINT_ACS(ACS_DIAMOND); + PRINT_ACS(ACS_CKBOARD); + PRINT_ACS(ACS_DEGREE); + PRINT_ACS(ACS_PLMINUS); + PRINT_ACS(ACS_BULLET); + PRINT_ACS(ACS_LARROW); + PRINT_ACS(ACS_RARROW); + PRINT_ACS(ACS_DARROW); + PRINT_ACS(ACS_UARROW); + PRINT_ACS(ACS_BOARD); + PRINT_ACS(ACS_LANTERN); + PRINT_ACS(ACS_BLOCK); + PRINT_ACS(ACS_S3); + PRINT_ACS(ACS_S7); + PRINT_ACS(ACS_LEQUAL); + PRINT_ACS(ACS_GEQUAL); + PRINT_ACS(ACS_PI); + PRINT_ACS(ACS_NEQUAL); + PRINT_ACS(ACS_STERLING); + + print_comment("Menu_Options from opts(3MENU)"); + PRINT_NAMED_BITMASK(Menu_Options, O_ONEVALUE); + PRINT_NAMED_BITMASK(Menu_Options, O_SHOWDESC); + PRINT_NAMED_BITMASK(Menu_Options, O_ROWMAJOR); + PRINT_NAMED_BITMASK(Menu_Options, O_IGNORECASE); + PRINT_NAMED_BITMASK(Menu_Options, O_SHOWMATCH); + PRINT_NAMED_BITMASK(Menu_Options, O_NONCYCLIC); + print_constant("Menu_Options_Size", 8 * sizeof(Menu_Options)); + + print_comment("Item_Options from menu_opts(3MENU)"); + PRINT_NAMED_BITMASK(Item_Options, O_SELECTABLE); + print_constant("Item_Options_Size", 8 * sizeof(Item_Options)); + + print_comment("Field_Options from field_opts(3FORM)"); + PRINT_NAMED_BITMASK(Field_Options, O_VISIBLE); + PRINT_NAMED_BITMASK(Field_Options, O_ACTIVE); + PRINT_NAMED_BITMASK(Field_Options, O_PUBLIC); + PRINT_NAMED_BITMASK(Field_Options, O_EDIT); + PRINT_NAMED_BITMASK(Field_Options, O_WRAP); + PRINT_NAMED_BITMASK(Field_Options, O_BLANK); + PRINT_NAMED_BITMASK(Field_Options, O_AUTOSKIP); + PRINT_NAMED_BITMASK(Field_Options, O_NULLOK); + PRINT_NAMED_BITMASK(Field_Options, O_PASSOK); + PRINT_NAMED_BITMASK(Field_Options, O_STATIC); + print_constant("Field_Options_Size", 8 * sizeof(Field_Options)); + + print_comment("Field_Options from opts(3FORM)"); + PRINT_NAMED_BITMASK(Field_Options, O_NL_OVERLOAD); + PRINT_NAMED_BITMASK(Field_Options, O_BS_OVERLOAD); + /* Field_Options_Size is defined below */ + + print_comment("MEVENT structure from mouse(3NCURSES)"); + STRUCT_OFFSET(MEVENT, id); + STRUCT_OFFSET(MEVENT, x); + STRUCT_OFFSET(MEVENT, y); + STRUCT_OFFSET(MEVENT, z); + STRUCT_OFFSET(MEVENT, bstate); + print_constant("MEVENT_Size", 8 * sizeof(MEVENT)); + + print_comment("mouse events from mouse(3NCURSES)"); + { + mmask_t all_events; + +#define PRINT_MOUSE_EVENT(event) \ + print_constant (#event, event); \ + all_events |= event + + all_events = 0; + PRINT_MOUSE_EVENT(BUTTON1_RELEASED); + PRINT_MOUSE_EVENT(BUTTON1_PRESSED); + PRINT_MOUSE_EVENT(BUTTON1_CLICKED); + PRINT_MOUSE_EVENT(BUTTON1_DOUBLE_CLICKED); + PRINT_MOUSE_EVENT(BUTTON1_TRIPLE_CLICKED); #ifdef BUTTON1_RESERVED_EVENT - GEN_MEVENT(BUTTON1_RESERVED_EVENT); - all1 |= BUTTON1_RESERVED_EVENT; -#endif -#ifdef BUTTON2_RELEASED - GEN_MEVENT(BUTTON2_RELEASED); - all2 |= BUTTON2_RELEASED; -#endif -#ifdef BUTTON2_PRESSED - GEN_MEVENT(BUTTON2_PRESSED); - all2 |= BUTTON2_PRESSED; -#endif -#ifdef BUTTON2_CLICKED - GEN_MEVENT(BUTTON2_CLICKED); - all2 |= BUTTON2_CLICKED; -#endif -#ifdef BUTTON2_DOUBLE_CLICKED - GEN_MEVENT(BUTTON2_DOUBLE_CLICKED); - all2 |= BUTTON2_DOUBLE_CLICKED; -#endif -#ifdef BUTTON2_TRIPLE_CLICKED - GEN_MEVENT(BUTTON2_TRIPLE_CLICKED); - all2 |= BUTTON2_TRIPLE_CLICKED; -#endif -#ifdef BUTTON2_RESERVED_EVENT - GEN_MEVENT(BUTTON2_RESERVED_EVENT); - all2 |= BUTTON2_RESERVED_EVENT; -#endif -#ifdef BUTTON3_RELEASED - GEN_MEVENT(BUTTON3_RELEASED); - all3 |= BUTTON3_RELEASED; -#endif -#ifdef BUTTON3_PRESSED - GEN_MEVENT(BUTTON3_PRESSED); - all3 |= BUTTON3_PRESSED; -#endif -#ifdef BUTTON3_CLICKED - GEN_MEVENT(BUTTON3_CLICKED); - all3 |= BUTTON3_CLICKED; -#endif -#ifdef BUTTON3_DOUBLE_CLICKED - GEN_MEVENT(BUTTON3_DOUBLE_CLICKED); - all3 |= BUTTON3_DOUBLE_CLICKED; -#endif -#ifdef BUTTON3_TRIPLE_CLICKED - GEN_MEVENT(BUTTON3_TRIPLE_CLICKED); - all3 |= BUTTON3_TRIPLE_CLICKED; -#endif -#ifdef BUTTON3_RESERVED_EVENT - GEN_MEVENT(BUTTON3_RESERVED_EVENT); - all3 |= BUTTON3_RESERVED_EVENT; -#endif -#ifdef BUTTON4_RELEASED - GEN_MEVENT(BUTTON4_RELEASED); - all4 |= BUTTON4_RELEASED; -#endif -#ifdef BUTTON4_PRESSED - GEN_MEVENT(BUTTON4_PRESSED); - all4 |= BUTTON4_PRESSED; -#endif -#ifdef BUTTON4_CLICKED - GEN_MEVENT(BUTTON4_CLICKED); - all4 |= BUTTON4_CLICKED; -#endif -#ifdef BUTTON4_DOUBLE_CLICKED - GEN_MEVENT(BUTTON4_DOUBLE_CLICKED); - all4 |= BUTTON4_DOUBLE_CLICKED; -#endif -#ifdef BUTTON4_TRIPLE_CLICKED - GEN_MEVENT(BUTTON4_TRIPLE_CLICKED); - all4 |= BUTTON4_TRIPLE_CLICKED; -#endif -#ifdef BUTTON4_RESERVED_EVENT - GEN_MEVENT(BUTTON4_RESERVED_EVENT); - all4 |= BUTTON4_RESERVED_EVENT; -#endif -#ifdef BUTTON_CTRL - GEN_MEVENT(BUTTON_CTRL); -#endif -#ifdef BUTTON_SHIFT - GEN_MEVENT(BUTTON_SHIFT); -#endif -#ifdef BUTTON_ALT - GEN_MEVENT(BUTTON_ALT); + PRINT_MOUSE_EVENT(BUTTON1_RESERVED_EVENT); #endif -#ifdef REPORT_MOUSE_POSITION - GEN_MEVENT(REPORT_MOUSE_POSITION); -#endif -#ifdef ALL_MOUSE_EVENTS - GEN_MEVENT(ALL_MOUSE_EVENTS); -#endif - - GEN_EVENT(BUTTON1_EVENTS, all1); - GEN_EVENT(BUTTON2_EVENTS, all2); - GEN_EVENT(BUTTON3_EVENTS, all3); - GEN_EVENT(BUTTON4_EVENTS, all4); -} - -static void -wrap_one_var(const char *c_var, - const char *c_type, - const char *ada_func, - const char *ada_type) -{ -#if USE_REENTRANT - /* must wrap variables */ - printf("\n"); - printf(" function %s return %s\n", ada_func, ada_type); - printf(" is\n"); - printf(" function Result return %s;\n", c_type); - printf(" pragma Import (C, Result, \"" NCURSES_WRAP_PREFIX "%s\");\n", c_var); - printf(" begin\n"); - if (strcmp(c_type, ada_type)) - printf(" return %s (Result);\n", ada_type); - else - printf(" return Result;\n"); - printf(" end %s;\n", ada_func); -#else - /* global variables are really global */ - printf("\n"); - printf(" function %s return %s\n", ada_func, ada_type); - printf(" is\n"); - printf(" Result : %s;\n", c_type); - printf(" pragma Import (C, Result, \"%s\");\n", c_var); - printf(" begin\n"); - if (strcmp(c_type, ada_type)) - printf(" return %s (Result);\n", ada_type); - else - printf(" return Result;\n"); - printf(" end %s;\n", ada_func); -#endif -} - -#define GEN_PUBLIC_VAR(c_var, c_type, ada_func, ada_type) \ - wrap_one_var(#c_var, #c_type, #ada_func, #ada_type) - -static void -gen_public_vars(void) -{ - GEN_PUBLIC_VAR(stdscr, Window, Standard_Window, Window); - GEN_PUBLIC_VAR(curscr, Window, Current_Window, Window); - GEN_PUBLIC_VAR(LINES, C_Int, Lines, Line_Count); - GEN_PUBLIC_VAR(COLS, C_Int, Columns, Column_Count); - GEN_PUBLIC_VAR(TABSIZE, C_Int, Tab_Size, Natural); - GEN_PUBLIC_VAR(COLORS, C_Int, Number_Of_Colors, Natural); - GEN_PUBLIC_VAR(COLOR_PAIRS, C_Int, Number_Of_Color_Pairs, Natural); -} - -/* - * Output some comment lines indicating that the file is generated. - * The name parameter is the name of the facility to be used in - * the comment. - */ -static void -prologue(const char *name) -{ - printf("-- %s binding.\n", name); - printf("-- This module is generated. Please don't change it manually!\n"); - printf("-- Run the generator instead.\n-- |"); - - printf("define(`M4_BIT_ORDER',`%s_Order_First')", - little_endian ? "Low" : "High"); -} + print_constant("all_events_button_1", (long)all_events); -/* - * Write the prologue for the curses facility and make sure that - * KEY_MIN and KEY_MAX are defined for the rest of this source. - */ -static void -basedefs(void) -{ - prologue("curses"); -#ifndef KEY_MAX -# define KEY_MAX 0777 -#endif - printf("define(`M4_KEY_MAX',`8#%o#')", KEY_MAX); -#ifndef KEY_MIN -# define KEY_MIN 0401 + all_events = 0; + PRINT_MOUSE_EVENT(BUTTON2_RELEASED); + PRINT_MOUSE_EVENT(BUTTON2_PRESSED); + PRINT_MOUSE_EVENT(BUTTON2_CLICKED); + PRINT_MOUSE_EVENT(BUTTON2_DOUBLE_CLICKED); + PRINT_MOUSE_EVENT(BUTTON2_TRIPLE_CLICKED); +#ifdef BUTTON2_RESERVED_EVENT + PRINT_MOUSE_EVENT(BUTTON2_RESERVED_EVENT); #endif - if (KEY_MIN == 256) - { - fprintf(stderr, "Unexpected value for KEY_MIN: %d\n", KEY_MIN); - exit(1); - } - printf("define(`M4_SPECIAL_FIRST',`8#%o#')", KEY_MIN - 1); -} - -/* - * Write out the comment lines for the menu facility - */ -static void -menu_basedefs(void) -{ - prologue("menu"); -} - -/* - * Write out the comment lines for the form facility - */ -static void -form_basedefs(void) -{ - prologue("form"); -} - -/* - * Write out the comment lines for the mouse facility - */ -static void -mouse_basedefs(void) -{ - prologue("mouse"); -} + print_constant("all_events_button_2", (long)all_events); -/* - * Write the definition of a single color - */ -static void -color_def(const char *name, int value) -{ - printf(" %-16s : constant Color_Number := %d;\n", name, value); -} - -/* - * Generate all color definitions - */ -static void -gen_color(void) -{ -#if HAVE_USE_DEFAULT_COLORS - color_def("Default_Color", -1); -#endif -#ifdef COLOR_BLACK - color_def("Black", COLOR_BLACK); -#endif -#ifdef COLOR_RED - color_def("Red", COLOR_RED); -#endif -#ifdef COLOR_GREEN - color_def("Green", COLOR_GREEN); -#endif -#ifdef COLOR_YELLOW - color_def("Yellow", COLOR_YELLOW); -#endif -#ifdef COLOR_BLUE - color_def("Blue", COLOR_BLUE); -#endif -#ifdef COLOR_MAGENTA - color_def("Magenta", COLOR_MAGENTA); -#endif -#ifdef COLOR_CYAN - color_def("Cyan", COLOR_CYAN); -#endif -#ifdef COLOR_WHITE - color_def("White", COLOR_WHITE); + all_events = 0; + PRINT_MOUSE_EVENT(BUTTON3_RELEASED); + PRINT_MOUSE_EVENT(BUTTON3_PRESSED); + PRINT_MOUSE_EVENT(BUTTON3_CLICKED); + PRINT_MOUSE_EVENT(BUTTON3_DOUBLE_CLICKED); + PRINT_MOUSE_EVENT(BUTTON3_TRIPLE_CLICKED); +#ifdef BUTTON3_RESERVED_EVENT + PRINT_MOUSE_EVENT(BUTTON3_RESERVED_EVENT); #endif -} - -/* - * Generate the linker options for the base facility - */ -static void -gen_linkopts(void) -{ - printf(" pragma Linker_Options (\"-lncurses%s\");\n", model); -} + print_constant("all_events_button_3", (long)all_events); -/* - * Generate the linker options for the menu facility - */ -static void -gen_menu_linkopts(void) -{ - printf(" pragma Linker_Options (\"-lmenu%s\");\n", model); -} - -/* - * Generate the linker options for the form facility - */ -static void -gen_form_linkopts(void) -{ - printf(" pragma Linker_Options (\"-lform%s\");\n", model); -} - -/* - * Generate the linker options for the panel facility - */ -static void -gen_panel_linkopts(void) -{ - printf(" pragma Linker_Options (\"-lpanel%s\");\n", model); -} - -static void -gen_version_info(void) -{ - static const char *v1 = - " NC_Major_Version : constant := %d; -- Major version of the library\n"; - static const char *v2 = - " NC_Minor_Version : constant := %d; -- Minor version of the library\n"; - static const char *v3 = - " NC_Version : constant String := %c%d.%d%c; -- Version of library\n"; - - printf(v1, NCURSES_VERSION_MAJOR); - printf(v2, NCURSES_VERSION_MINOR); - printf(v3, '"', NCURSES_VERSION_MAJOR, NCURSES_VERSION_MINOR, '"'); -} - -static int -eti_gen(char *buf, int code, const char *name, int *etimin, int *etimax) -{ - sprintf(buf, " E_%-16s : constant Eti_Error := %d;\n", name, code); - if (code < *etimin) - *etimin = code; - if (code > *etimax) - *etimax = code; - return (int)strlen(buf); -} - -static void -gen_offsets(void) -{ - const char *s_bool = ""; - - if (sizeof(bool) == sizeof(char)) - { - s_bool = "char"; - } - else if (sizeof(bool) == sizeof(short)) - { - s_bool = "short"; - } - else if (sizeof(bool) == sizeof(int)) - { - s_bool = "int"; - } - printf(" Sizeof%-*s : constant Natural := %2ld; -- %s\n", - 12, "_bool", (long)sizeof(bool), "bool"); - - printf(" type Curses_Bool is mod 2 ** Interfaces.C.%s'Size;\n", s_bool); -} - -/* - * main() expects two arguments on the commandline, both single characters. - * The first character denotes the facility for which we generate output. - * Possible values are - * B - Base - * M - Menus - * F - Forms - * P - Pointer Device (Mouse) - * E - ETI base definitions - * - * The second character then denotes the specific output that should be - * generated for the selected facility. - */ -int -main(int argc, char *argv[]) -{ - int x = 0x12345678; - char *s = (char *)&x; - - if (*s == 0x78) - little_endian = 1; - - if (argc != 4) - exit(1); - model = *++argv; - - switch (argv[1][0]) - { - /* --------------------------------------------------------------- */ - case 'B': /* The Base facility */ - switch (argv[2][0]) - { - case 'A': /* chtype translation into Ada95 record type */ - gen_attr_set("Character_Attribute_Set"); - break; - case 'B': /* write some initial comment lines */ - basedefs(); - break; - case 'C': /* generate color constants */ - gen_color(); - break; - case 'D': /* generate displacements of fields in WINDOW struct. */ - gen_offsets(); - break; - case 'E': /* generate Mouse Event codes */ - gen_mouse_events(); - break; - case 'K': /* translation of keycodes */ - gen_keydefs(0); - break; - case 'L': /* generate the Linker_Options pragma */ - gen_linkopts(); - break; - case 'M': /* generate constants for the ACS characters */ - gen_acs(); - break; - case 'O': /* generate definitions of the old key code names */ - gen_keydefs(1); - break; - case 'P': /* generate definitions of the public variables */ - gen_public_vars(); - break; - case 'R': /* generate representation clause for Attributed character */ - gen_chtype_rep("Attributed_Character"); - break; - case 'T': /* generate the Trace info */ - gen_trace("Trace_Attribute_Set"); - break; - case 'V': /* generate version info */ - gen_version_info(); - break; - default: - break; - } - break; - /* --------------------------------------------------------------- */ - case 'M': /* The Menu facility */ - switch (argv[2][0]) - { - case 'R': /* generate representation clause for Menu_Option_Set */ - gen_menu_opt_rep("Menu_Option_Set"); - break; - case 'B': /* write some initial comment lines */ - menu_basedefs(); - break; - case 'L': /* generate the Linker_Options pragma */ - gen_menu_linkopts(); - break; - case 'I': /* generate representation clause for Item_Option_Set */ - gen_item_opt_rep("Item_Option_Set"); - break; - default: - break; - } - break; - /* --------------------------------------------------------------- */ - case 'F': /* The Form facility */ - switch (argv[2][0]) - { - case 'R': /* generate representation clause for Form_Option_Set */ - gen_form_opt_rep("Form_Option_Set"); - break; - case 'B': /* write some initial comment lines */ - form_basedefs(); - break; - case 'L': /* generate the Linker_Options pragma */ - gen_form_linkopts(); - break; - case 'I': /* generate representation clause for Field_Option_Set */ - gen_field_opt_rep("Field_Option_Set"); - break; - default: - break; - } - break; - /* --------------------------------------------------------------- */ - case 'P': /* The Pointer(=Mouse) facility */ - switch (argv[2][0]) - { - case 'B': /* write some initial comment lines */ - mouse_basedefs(); - break; - case 'M': /* generate representation clause for Mouse_Event */ - gen_mrep_rep("Mouse_Event"); - break; - case 'L': /* generate the Linker_Options pragma */ - gen_panel_linkopts(); - break; - default: - break; - } - break; - /* --------------------------------------------------------------- */ - case 'E': /* chtype size detection */ - switch (argv[2][0]) - { - case 'C': - { - const char *fmt = " type C_Chtype is new %s;\n"; - const char *afmt = " type C_AttrType is new %s;\n"; - - if (sizeof(chtype) == sizeof(int)) - { - if (sizeof(int) == sizeof(long)) - printf(fmt, "C_ULong"); - - else - printf(fmt, "C_UInt"); - } - else if (sizeof(chtype) == sizeof(long)) - { - printf(fmt, "C_ULong"); - } - else - printf("Error\n"); - - if (sizeof(attr_t) == sizeof(int)) - { - if (sizeof(int) == sizeof(long)) - printf(afmt, "C_ULong"); - - else - printf(afmt, "C_UInt"); - } - else if (sizeof(attr_t) == sizeof(long)) - { - printf(afmt, "C_ULong"); - } - else - printf("Error\n"); - - printf("define(`CF_CURSES_OK',`%d')", OK); - printf("define(`CF_CURSES_ERR',`%d')", ERR); - printf("define(`CF_CURSES_TRUE',`%d')", TRUE); - printf("define(`CF_CURSES_FALSE',`%d')", FALSE); - } - break; - case 'E': - { - char *buf = (char *)malloc(2048); - char *p = buf; - int etimin = E_OK; - int etimax = E_OK; - - if (p) - { - p += eti_gen(p, E_OK, "Ok", &etimin, &etimax); - p += eti_gen(p, E_SYSTEM_ERROR, "System_Error", &etimin, &etimax); - p += eti_gen(p, E_BAD_ARGUMENT, "Bad_Argument", &etimin, &etimax); - p += eti_gen(p, E_POSTED, "Posted", &etimin, &etimax); - p += eti_gen(p, E_CONNECTED, "Connected", &etimin, &etimax); - p += eti_gen(p, E_BAD_STATE, "Bad_State", &etimin, &etimax); - p += eti_gen(p, E_NO_ROOM, "No_Room", &etimin, &etimax); - p += eti_gen(p, E_NOT_POSTED, "Not_Posted", &etimin, &etimax); - p += eti_gen(p, E_UNKNOWN_COMMAND, - "Unknown_Command", &etimin, &etimax); - p += eti_gen(p, E_NO_MATCH, "No_Match", &etimin, &etimax); - p += eti_gen(p, E_NOT_SELECTABLE, - "Not_Selectable", &etimin, &etimax); - p += eti_gen(p, E_NOT_CONNECTED, - "Not_Connected", &etimin, &etimax); - p += eti_gen(p, E_REQUEST_DENIED, - "Request_Denied", &etimin, &etimax); - p += eti_gen(p, E_INVALID_FIELD, - "Invalid_Field", &etimin, &etimax); - p += eti_gen(p, E_CURRENT, - "Current", &etimin, &etimax); - } - printf(" subtype Eti_Error is C_Int range %d .. %d;\n\n", - etimin, etimax); - printf("%s", buf); - } - break; - default: - break; - } - break; - /* --------------------------------------------------------------- */ - case 'V': /* plain version dump */ - { - switch (argv[2][0]) - { - case '1': /* major version */ -#ifdef NCURSES_VERSION_MAJOR - printf("%d", NCURSES_VERSION_MAJOR); -#endif - break; - case '2': /* minor version */ -#ifdef NCURSES_VERSION_MINOR - printf("%d", NCURSES_VERSION_MINOR); -#endif - break; - case '3': /* patch level */ -#ifdef NCURSES_VERSION_PATCH - printf("%d", NCURSES_VERSION_PATCH); + all_events = 0; + PRINT_MOUSE_EVENT(BUTTON4_RELEASED); + PRINT_MOUSE_EVENT(BUTTON4_PRESSED); + PRINT_MOUSE_EVENT(BUTTON4_CLICKED); + PRINT_MOUSE_EVENT(BUTTON4_DOUBLE_CLICKED); + PRINT_MOUSE_EVENT(BUTTON4_TRIPLE_CLICKED); +#ifdef BUTTON4_RESERVED_EVENT + PRINT_MOUSE_EVENT(BUTTON4_RESERVED_EVENT); #endif - break; - default: - break; - } - } - break; - /* --------------------------------------------------------------- */ - default: - break; - } - return 0; + print_constant("all_events_button_4", (long)all_events); + } + PRINT_NAMED_CONSTANT(BUTTON_CTRL); + PRINT_NAMED_CONSTANT(BUTTON_SHIFT); + PRINT_NAMED_CONSTANT(BUTTON_ALT); + PRINT_NAMED_CONSTANT(REPORT_MOUSE_POSITION); + PRINT_NAMED_CONSTANT(ALL_MOUSE_EVENTS); + + print_comment("trace selection from trace(3NCURSES)"); + PRINT_NAMED_BITMASK(UINT, TRACE_TIMES); + PRINT_NAMED_BITMASK(UINT, TRACE_TPUTS); + PRINT_NAMED_BITMASK(UINT, TRACE_UPDATE); + PRINT_NAMED_BITMASK(UINT, TRACE_MOVE); + PRINT_NAMED_BITMASK(UINT, TRACE_CHARPUT); + PRINT_NAMED_BITMASK(UINT, TRACE_CALLS); + PRINT_NAMED_BITMASK(UINT, TRACE_VIRTPUT); + PRINT_NAMED_BITMASK(UINT, TRACE_IEVENT); + PRINT_NAMED_BITMASK(UINT, TRACE_BITS); + PRINT_NAMED_BITMASK(UINT, TRACE_ICALLS); + PRINT_NAMED_BITMASK(UINT, TRACE_CCALLS); + PRINT_NAMED_BITMASK(UINT, TRACE_DATABASE); + PRINT_NAMED_BITMASK(UINT, TRACE_ATTRS); + print_constant("Trace_Size", 8 * sizeof(UINT)); + + printf("end Terminal_Interface.Curses_Constants;\n"); + exit(EXIT_SUCCESS); } diff --git a/Ada95/gen/terminal_interface-curses-aux.ads.m4 b/Ada95/gen/terminal_interface-curses-aux.ads.m4 index 111ec698..b90b8dd6 100644 --- a/Ada95/gen/terminal_interface-curses-aux.ads.m4 +++ b/Ada95/gen/terminal_interface-curses-aux.ads.m4 @@ -10,7 +10,7 @@ include(M4MACRO)dnl -- S P E C -- -- -- ------------------------------------------------------------------------------ --- Copyright (c) 1998-2009,2011 Free Software Foundation, Inc. -- +-- Copyright (c) 1998-2011,2014 Free Software Foundation, Inc. -- -- -- -- Permission is hereby granted, free of charge, to any person obtaining a -- -- copy of this software and associated documentation files (the -- @@ -38,14 +38,12 @@ include(M4MACRO)dnl ------------------------------------------------------------------------------ -- Author: Juergen Pfeifer, 1996 -- Version Control: --- $Revision: 1.18 $ +-- $Revision: 1.23 $ -- Binding Version 01.00 ------------------------------------------------------------------------------ -include(`Base_Defs') with System; with Interfaces.C; with Interfaces.C.Strings; use Interfaces.C.Strings; -with Unchecked_Conversion; package Terminal_Interface.Curses.Aux is pragma Preelaborate (Terminal_Interface.Curses.Aux); @@ -60,39 +58,39 @@ package Terminal_Interface.Curses.Aux is subtype C_ULong is Interfaces.C.unsigned_long; subtype C_Char_Ptr is Interfaces.C.Strings.chars_ptr; type C_Void_Ptr is new System.Address; -include(`Chtype_Def') + -- This is how those constants are defined in ncurses. I see them also -- exactly like this in all ETI implementations I ever tested. So it -- could be that this is quite general, but please check with your curses. -- This is critical, because curses sometime mixes Boolean returns with -- returning an error status. - Curses_Ok : constant C_Int := CF_CURSES_OK; - Curses_Err : constant C_Int := CF_CURSES_ERR; + Curses_Ok : constant C_Int := Curses_Constants.OK; + Curses_Err : constant C_Int := Curses_Constants.ERR; - Curses_True : constant C_Int := CF_CURSES_TRUE; - Curses_False : constant C_Int := CF_CURSES_FALSE; + Curses_True : constant C_Int := Curses_Constants.TRUE; + Curses_False : constant C_Int := Curses_Constants.FALSE; -- Eti_Error: type for error codes returned by the menu and form subsystem -include(`Eti_Defs') - procedure Eti_Exception (Code : Eti_Error); - -- Dispatch the error code and raise the appropriate exception - -- - -- - -- Some helpers - function Chtype_To_AttrChar is new - Unchecked_Conversion (Source => C_Chtype, - Target => Attributed_Character); - function AttrChar_To_Chtype is new - Unchecked_Conversion (Source => Attributed_Character, - Target => C_Chtype); + type Eti_Error is + (E_Current, + E_Invalid_Field, + E_Request_Denied, + E_Not_Connected, + E_Not_Selectable, + E_No_Match, + E_Unknown_Command, + E_Not_Posted, + E_No_Room, + E_Bad_State, + E_Connected, + E_Posted, + E_Bad_Argument, + E_System_Error, + E_Ok); - function AttrChar_To_AttrType is new - Unchecked_Conversion (Source => Attributed_Character, - Target => C_AttrType); - - function AttrType_To_AttrChar is new - Unchecked_Conversion (Source => C_AttrType, - Target => Attributed_Character); + procedure Eti_Exception (Code : Eti_Error); + -- Do nothing if Code = E_Ok. + -- Else dispatch the error code and raise the appropriate exception. procedure Fill_String (Cp : chars_ptr; Str : out String); @@ -102,4 +100,23 @@ include(`Eti_Defs') function Fill_String (Cp : chars_ptr) return String; -- Same but as function. +private + for Eti_Error'Size use C_Int'Size; + pragma Convention (C, Eti_Error); + for Eti_Error use + (E_Current => Curses_Constants.E_CURRENT, + E_Invalid_Field => Curses_Constants.E_INVALID_FIELD, + E_Request_Denied => Curses_Constants.E_REQUEST_DENIED, + E_Not_Connected => Curses_Constants.E_NOT_CONNECTED, + E_Not_Selectable => Curses_Constants.E_NOT_SELECTABLE, + E_No_Match => Curses_Constants.E_NO_MATCH, + E_Unknown_Command => Curses_Constants.E_UNKNOWN_COMMAND, + E_Not_Posted => Curses_Constants.E_NOT_POSTED, + E_No_Room => Curses_Constants.E_NO_ROOM, + E_Bad_State => Curses_Constants.E_BAD_STATE, + E_Connected => Curses_Constants.E_CONNECTED, + E_Posted => Curses_Constants.E_POSTED, + E_Bad_Argument => Curses_Constants.E_BAD_ARGUMENT, + E_System_Error => Curses_Constants.E_SYSTEM_ERROR, + E_Ok => Curses_Constants.E_OK); end Terminal_Interface.Curses.Aux; diff --git a/Ada95/gen/terminal_interface-curses-forms-field_types.ads.m4 b/Ada95/gen/terminal_interface-curses-forms-field_types.ads.m4 index f9784007..51682cd7 100644 --- a/Ada95/gen/terminal_interface-curses-forms-field_types.ads.m4 +++ b/Ada95/gen/terminal_interface-curses-forms-field_types.ads.m4 @@ -10,7 +10,7 @@ include(M4MACRO)dnl -- S P E C -- -- -- ------------------------------------------------------------------------------ --- Copyright (c) 1998-2009,2011 Free Software Foundation, Inc. -- +-- Copyright (c) 1998-2011,2014 Free Software Foundation, Inc. -- -- -- -- Permission is hereby granted, free of charge, to any person obtaining a -- -- copy of this software and associated documentation files (the -- @@ -38,10 +38,11 @@ include(M4MACRO)dnl ------------------------------------------------------------------------------ -- Author: Juergen Pfeifer, 1996 -- Version Control: --- $Revision: 1.17 $ +-- $Revision: 1.19 $ -- Binding Version 01.00 ------------------------------------------------------------------------------ with Interfaces.C; +with Terminal_Interface.Curses.Aux; package Terminal_Interface.Curses.Forms.Field_Types is pragma Preelaborate (Terminal_Interface.Curses.Forms.Field_Types); @@ -227,12 +228,12 @@ private Mak : Makearg_Function := Make_Arg'Access; Cop : Copyarg_Function := Copy_Arg'Access; Fre : Freearg_Function := Free_Arg'Access) - return C_Int; + return Aux.Eti_Error; pragma Import (C, Set_Fieldtype_Arg, "set_fieldtype_arg"); function Set_Fieldtype_Choice (Cft : C_Field_Type; Next, Prev : Choice_Function) - return C_Int; + return Aux.Eti_Error; pragma Import (C, Set_Fieldtype_Choice, "set_fieldtype_choice"); end Terminal_Interface.Curses.Forms.Field_Types; diff --git a/Ada95/gen/terminal_interface-curses-forms.ads.m4 b/Ada95/gen/terminal_interface-curses-forms.ads.m4 index a4329ba9..b269f4c4 100644 --- a/Ada95/gen/terminal_interface-curses-forms.ads.m4 +++ b/Ada95/gen/terminal_interface-curses-forms.ads.m4 @@ -10,7 +10,7 @@ include(M4MACRO)dnl -- S P E C -- -- -- ------------------------------------------------------------------------------ --- Copyright (c) 1998-2006,2009 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 -- @@ -38,18 +38,17 @@ include(M4MACRO)dnl ------------------------------------------------------------------------------ -- Author: Juergen Pfeifer, 1996 -- Version Control: --- $Revision: 1.30 $ --- $Date: 2009/12/26 17:31:35 $ +-- $Revision: 1.33 $ +-- $Date: 2014/05/24 21:31:57 $ -- Binding Version 01.00 ------------------------------------------------------------------------------ -include(`Form_Base_Defs') with System; with Ada.Characters.Latin_1; package Terminal_Interface.Curses.Forms is pragma Preelaborate (Terminal_Interface.Curses.Forms); -include(`Form_Linker_Options')dnl -include(`Linker_Options') + pragma Linker_Options ("-lform" & Curses_Constants.DFT_ARG_SUFFIX); + Space : Character renames Ada.Characters.Latin_1.Space; type Field is private; @@ -63,18 +62,68 @@ include(`Linker_Options') Center, Right); + type Field_Option_Set is + record + Visible : Boolean; + Active : Boolean; + Public : Boolean; + Edit : Boolean; + Wrap : Boolean; + Blank : Boolean; + Auto_Skip : Boolean; + Null_Ok : Boolean; + Pass_Ok : Boolean; + Static : Boolean; + end record; + pragma Convention (C_Pass_By_Copy, Field_Option_Set); + + for Field_Option_Set use + record + Visible at 0 range Curses_Constants.O_VISIBLE_First + .. Curses_Constants.O_VISIBLE_Last; + Active at 0 range Curses_Constants.O_ACTIVE_First + .. Curses_Constants.O_ACTIVE_Last; + Public at 0 range Curses_Constants.O_PUBLIC_First + .. Curses_Constants.O_PUBLIC_Last; + Edit at 0 range Curses_Constants.O_EDIT_First + .. Curses_Constants.O_EDIT_Last; + Wrap at 0 range Curses_Constants.O_WRAP_First + .. Curses_Constants.O_WRAP_Last; + Blank at 0 range Curses_Constants.O_BLANK_First + .. Curses_Constants.O_BLANK_Last; + Auto_Skip at 0 range Curses_Constants.O_AUTOSKIP_First + .. Curses_Constants.O_AUTOSKIP_Last; + Null_Ok at 0 range Curses_Constants.O_NULLOK_First + .. Curses_Constants.O_NULLOK_Last; + Pass_Ok at 0 range Curses_Constants.O_PASSOK_First + .. Curses_Constants.O_PASSOK_Last; + Static at 0 range Curses_Constants.O_STATIC_First + .. Curses_Constants.O_STATIC_Last; + end record; pragma Warnings (Off); -include(`Field_Rep')Dnl - + for Field_Option_Set'Size use Curses_Constants.Field_Options_Size; pragma Warnings (On); function Default_Field_Options return Field_Option_Set; -- The initial defaults for the field options. pragma Inline (Default_Field_Options); + type Form_Option_Set is + record + NL_Overload : Boolean; + BS_Overload : Boolean; + end record; + pragma Convention (C_Pass_By_Copy, Form_Option_Set); + + for Form_Option_Set use + record + NL_Overload at 0 range Curses_Constants.O_NL_OVERLOAD_First + .. Curses_Constants.O_NL_OVERLOAD_Last; + BS_Overload at 0 range Curses_Constants.O_BS_OVERLOAD_First + .. Curses_Constants.O_BS_OVERLOAD_Last; + end record; pragma Warnings (Off); -include(`Form_Opt_Rep')Dnl - + for Form_Option_Set'Size use Curses_Constants.Field_Options_Size; pragma Warnings (On); function Default_Form_Options return Form_Option_Set; diff --git a/Ada95/gen/terminal_interface-curses-menus.ads.m4 b/Ada95/gen/terminal_interface-curses-menus.ads.m4 index 6274b6ed..0ad9c456 100644 --- a/Ada95/gen/terminal_interface-curses-menus.ads.m4 +++ b/Ada95/gen/terminal_interface-curses-menus.ads.m4 @@ -10,7 +10,7 @@ include(M4MACRO)dnl -- S P E C -- -- -- ------------------------------------------------------------------------------ --- Copyright (c) 1998-2007,2009 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 -- @@ -38,18 +38,17 @@ include(M4MACRO)dnl ------------------------------------------------------------------------------ -- Author: Juergen Pfeifer, 1996 -- Version Control: --- $Revision: 1.28 $ --- $Date: 2009/12/26 18:35:22 $ +-- $Revision: 1.31 $ +-- $Date: 2014/05/24 21:31:57 $ -- Binding Version 01.00 ------------------------------------------------------------------------------ -include(`Menu_Base_Defs') with System; with Ada.Characters.Latin_1; package Terminal_Interface.Curses.Menus is pragma Preelaborate (Terminal_Interface.Curses.Menus); -include(`Menu_Linker_Options')dnl -include(`Linker_Options') + pragma Linker_Options ("-lmenu" & Curses_Constants.DFT_ARG_SUFFIX); + Space : Character renames Ada.Characters.Latin_1.Space; type Item is private; @@ -116,9 +115,34 @@ include(`Linker_Options') -- -- Menu options -- + type Menu_Option_Set is + record + One_Valued : Boolean; + Show_Descriptions : Boolean; + Row_Major_Order : Boolean; + Ignore_Case : Boolean; + Show_Matches : Boolean; + Non_Cyclic : Boolean; + end record; + pragma Convention (C_Pass_By_Copy, Menu_Option_Set); + + for Menu_Option_Set use + record + One_Valued at 0 range Curses_Constants.O_ONEVALUE_First + .. Curses_Constants.O_ONEVALUE_Last; + Show_Descriptions at 0 range Curses_Constants.O_SHOWDESC_First + .. Curses_Constants.O_SHOWDESC_Last; + Row_Major_Order at 0 range Curses_Constants.O_ROWMAJOR_First + .. Curses_Constants.O_ROWMAJOR_Last; + Ignore_Case at 0 range Curses_Constants.O_IGNORECASE_First + .. Curses_Constants.O_IGNORECASE_Last; + Show_Matches at 0 range Curses_Constants.O_SHOWMATCH_First + .. Curses_Constants.O_SHOWMATCH_Last; + Non_Cyclic at 0 range Curses_Constants.O_NONCYCLIC_First + .. Curses_Constants.O_NONCYCLIC_Last; + end record; pragma Warnings (Off); -include(`Menu_Opt_Rep')dnl - + for Menu_Option_Set'Size use Curses_Constants.Menu_Options_Size; pragma Warnings (On); function Default_Menu_Options return Menu_Option_Set; @@ -127,9 +151,19 @@ include(`Menu_Opt_Rep')dnl -- -- Item options -- + type Item_Option_Set is + record + Selectable : Boolean; + end record; + pragma Convention (C_Pass_By_Copy, Item_Option_Set); + + for Item_Option_Set use + record + Selectable at 0 range Curses_Constants.O_SELECTABLE_First + .. Curses_Constants.O_SELECTABLE_Last; + end record; pragma Warnings (Off); -include(`Item_Rep')dnl - + for Item_Option_Set'Size use Curses_Constants.Item_Options_Size; pragma Warnings (On); function Default_Item_Options return Item_Option_Set; diff --git a/Ada95/gen/terminal_interface-curses-mouse.ads.m4 b/Ada95/gen/terminal_interface-curses-mouse.ads.m4 index a4fb661e..dd58421c 100644 --- a/Ada95/gen/terminal_interface-curses-mouse.ads.m4 +++ b/Ada95/gen/terminal_interface-curses-mouse.ads.m4 @@ -10,7 +10,7 @@ include(M4MACRO)dnl -- S P E C -- -- -- ------------------------------------------------------------------------------ --- Copyright (c) 1998-2009,2011 Free Software Foundation, Inc. -- +-- Copyright (c) 1998-2011,2014 Free Software Foundation, Inc. -- -- -- -- Permission is hereby granted, free of charge, to any person obtaining a -- -- copy of this software and associated documentation files (the -- @@ -38,11 +38,10 @@ include(M4MACRO)dnl ------------------------------------------------------------------------------ -- Author: Juergen Pfeifer, 1996 -- Version Control: --- $Revision: 1.29 $ --- $Date: 2011/03/19 12:35:58 $ +-- $Revision: 1.31 $ +-- $Date: 2014/05/24 21:31:57 $ -- Binding Version 01.00 ------------------------------------------------------------------------------ -include(`Mouse_Base_Defs') with System; package Terminal_Interface.Curses.Mouse is @@ -167,12 +166,35 @@ private end record; pragma Convention (C, Mouse_Event); -include(`Mouse_Event_Rep') - Generation_Bit_Order : constant System.Bit_Order := System.M4_BIT_ORDER; - -- This constant may be different on your system. - -include(`Mouse_Events') - No_Events : constant Event_Mask := 0; - All_Events : constant Event_Mask := ALL_MOUSE_EVENTS; + for Mouse_Event use + record + Id at 0 range Curses_Constants.MEVENT_id_First + .. Curses_Constants.MEVENT_id_Last; + X at 0 range Curses_Constants.MEVENT_x_First + .. Curses_Constants.MEVENT_x_Last; + Y at 0 range Curses_Constants.MEVENT_y_First + .. Curses_Constants.MEVENT_y_Last; + Z at 0 range Curses_Constants.MEVENT_z_First + .. Curses_Constants.MEVENT_z_Last; + Bstate at 0 range Curses_Constants.MEVENT_bstate_First + .. Curses_Constants.MEVENT_bstate_Last; + end record; + for Mouse_Event'Size use Curses_Constants.MEVENT_Size; + Generation_Bit_Order : System.Bit_Order renames Curses_Constants.Bit_Order; + + BUTTON_CTRL : constant Event_Mask := Curses_Constants.BUTTON_CTRL; + BUTTON_SHIFT : constant Event_Mask := Curses_Constants.BUTTON_SHIFT; + BUTTON_ALT : constant Event_Mask := Curses_Constants.BUTTON_ALT; + BUTTON1_EVENTS : constant Event_Mask + := Curses_Constants.all_events_button_1; + BUTTON2_EVENTS : constant Event_Mask + := Curses_Constants.all_events_button_2; + BUTTON3_EVENTS : constant Event_Mask + := Curses_Constants.all_events_button_3; + BUTTON4_EVENTS : constant Event_Mask + := Curses_Constants.all_events_button_4; + ALL_MOUSE_EVENTS : constant Event_Mask := Curses_Constants.ALL_MOUSE_EVENTS; + No_Events : constant Event_Mask := 0; + All_Events : constant Event_Mask := ALL_MOUSE_EVENTS; end Terminal_Interface.Curses.Mouse; diff --git a/Ada95/gen/terminal_interface-curses-panels.ads.m4 b/Ada95/gen/terminal_interface-curses-panels.ads.m4 index dc06fa42..b0eda4d4 100644 --- a/Ada95/gen/terminal_interface-curses-panels.ads.m4 +++ b/Ada95/gen/terminal_interface-curses-panels.ads.m4 @@ -10,7 +10,7 @@ include(M4MACRO)dnl -- S P E C -- -- -- ------------------------------------------------------------------------------ --- Copyright (c) 1998-2006,2009 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 -- @@ -38,16 +38,16 @@ include(M4MACRO)dnl ------------------------------------------------------------------------------ -- Author: Juergen Pfeifer, 1996 -- Version Control: --- $Revision: 1.20 $ --- $Date: 2009/12/26 17:38:58 $ +-- $Revision: 1.22 $ +-- $Date: 2014/05/24 21:31:57 $ -- Binding Version 01.00 ------------------------------------------------------------------------------ with System; package Terminal_Interface.Curses.Panels is pragma Preelaborate (Terminal_Interface.Curses.Panels); -include(`Panel_Linker_Options')dnl -include(`Linker_Options') + pragma Linker_Options ("-lpanel" & Curses_Constants.DFT_ARG_SUFFIX); + type Panel is private; --------------------------- diff --git a/Ada95/gen/terminal_interface-curses-trace.ads.m4 b/Ada95/gen/terminal_interface-curses-trace.ads.m4 index 546004fd..e2273435 100644 --- a/Ada95/gen/terminal_interface-curses-trace.ads.m4 +++ b/Ada95/gen/terminal_interface-curses-trace.ads.m4 @@ -9,7 +9,7 @@ include(M4MACRO)---------------------------------------------------------------- -- S P E C -- -- -- ------------------------------------------------------------------------------ --- Copyright (c) 2000 Free Software Foundation, Inc. -- +-- Copyright (c) 2000,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 -- @@ -37,16 +37,62 @@ include(M4MACRO)---------------------------------------------------------------- ------------------------------------------------------------------------------ -- Author: Eugene V. Melaragno 2000 -- Version Control: --- $Revision: 1.1 $ +-- $Revision: 1.4 $ -- Binding Version 01.00 ------------------------------------------------------------------------------ package Terminal_Interface.Curses.Trace is pragma Preelaborate (Terminal_Interface.Curses.Trace); - pragma Warnings (Off); -include(`Trace_Defs') + type Trace_Attribute_Set is + record + Times : Boolean; + Tputs : Boolean; + Update : Boolean; + Cursor_Move : Boolean; + Character_Output : Boolean; + Calls : Boolean; + Virtual_Puts : Boolean; + Input_Events : Boolean; + TTY_State : Boolean; + Internal_Calls : Boolean; + Character_Calls : Boolean; + Termcap_TermInfo : Boolean; + Attribute_Color : Boolean; + end record; + pragma Convention (C_Pass_By_Copy, Trace_Attribute_Set); + for Trace_Attribute_Set use + record + Times at 0 range Curses_Constants.TRACE_TIMES_First + .. Curses_Constants.TRACE_TIMES_Last; + Tputs at 0 range Curses_Constants.TRACE_TPUTS_First + .. Curses_Constants.TRACE_TPUTS_Last; + Update at 0 range Curses_Constants.TRACE_UPDATE_First + .. Curses_Constants.TRACE_UPDATE_Last; + Cursor_Move at 0 range Curses_Constants.TRACE_MOVE_First + .. Curses_Constants.TRACE_MOVE_Last; + Character_Output at 0 range Curses_Constants.TRACE_CHARPUT_First + .. Curses_Constants.TRACE_CHARPUT_Last; + Calls at 0 range Curses_Constants.TRACE_CALLS_First + .. Curses_Constants.TRACE_CALLS_Last; + Virtual_Puts at 0 range Curses_Constants.TRACE_VIRTPUT_First + .. Curses_Constants.TRACE_VIRTPUT_Last; + Input_Events at 0 range Curses_Constants.TRACE_IEVENT_First + .. Curses_Constants.TRACE_IEVENT_Last; + TTY_State at 0 range Curses_Constants.TRACE_BITS_First + .. Curses_Constants.TRACE_BITS_Last; + Internal_Calls at 0 range Curses_Constants.TRACE_ICALLS_First + .. Curses_Constants.TRACE_ICALLS_Last; + Character_Calls at 0 range Curses_Constants.TRACE_CCALLS_First + .. Curses_Constants.TRACE_CCALLS_Last; + Termcap_TermInfo at 0 range Curses_Constants.TRACE_DATABASE_First + .. Curses_Constants.TRACE_DATABASE_Last; + Attribute_Color at 0 range Curses_Constants.TRACE_ATTRS_First + .. Curses_Constants.TRACE_ATTRS_Last; + end record; + pragma Warnings (Off); + for Trace_Attribute_Set'Size use Curses_Constants.Trace_Size; pragma Warnings (On); Trace_Disable : constant Trace_Attribute_Set := (others => False); diff --git a/Ada95/gen/terminal_interface-curses.adb.m4 b/Ada95/gen/terminal_interface-curses.adb.m4 index 1f89a5a3..b98782ba 100644 --- a/Ada95/gen/terminal_interface-curses.adb.m4 +++ b/Ada95/gen/terminal_interface-curses.adb.m4 @@ -9,7 +9,7 @@ include(M4MACRO)---------------------------------------------------------------- -- B O D Y -- -- -- ------------------------------------------------------------------------------ --- Copyright (c) 1998-2009,2011 Free Software Foundation, Inc. -- +-- Copyright (c) 1998-2011,2014 Free Software Foundation, Inc. -- -- -- -- Permission is hereby granted, free of charge, to any person obtaining a -- -- copy of this software and associated documentation files (the -- @@ -37,8 +37,8 @@ include(M4MACRO)---------------------------------------------------------------- ------------------------------------------------------------------------------ -- Author: Juergen Pfeifer, 1996 -- Version Control: --- $Revision: 1.8 $ --- $Date: 2011/03/22 23:02:14 $ +-- $Revision: 1.14 $ +-- $Date: 2014/05/24 21:31:05 $ -- Binding Version 01.00 ------------------------------------------------------------------------------ with System; @@ -151,10 +151,10 @@ package body Terminal_Interface.Curses is Ch : Attributed_Character) is function Waddch (W : Window; - Ch : C_Chtype) return C_Int; + Ch : Attributed_Character) return C_Int; pragma Import (C, Waddch, "waddch"); begin - if Waddch (Win, AttrChar_To_Chtype (Ch)) = Curses_Err then + if Waddch (Win, Ch) = Curses_Err then raise Curses_Exception; end if; end Add; @@ -178,12 +178,13 @@ package body Terminal_Interface.Curses is function mvwaddch (W : Window; Y : C_Int; X : C_Int; - Ch : C_Chtype) return C_Int; + Ch : Attributed_Character) return C_Int; pragma Import (C, mvwaddch, "mvwaddch"); begin if mvwaddch (Win, C_Int (Line), C_Int (Column), - AttrChar_To_Chtype (Ch)) = Curses_Err then + Ch) = Curses_Err + then raise Curses_Exception; end if; end Add; @@ -208,10 +209,10 @@ package body Terminal_Interface.Curses is Ch : Attributed_Character) is function Wechochar (W : Window; - Ch : C_Chtype) return C_Int; + Ch : Attributed_Character) return C_Int; pragma Import (C, Wechochar, "wechochar"); begin - if Wechochar (Win, AttrChar_To_Chtype (Ch)) = Curses_Err then + if Wechochar (Win, Ch) = Curses_Err then raise Curses_Exception; end if; end Add_With_Immediate_Echo; @@ -419,7 +420,8 @@ package body Terminal_Interface.Curses is Txt (Str'Length) := Default_Character; if Waddchnstr (Win, Txt, - C_Int (Len)) = Curses_Err then + C_Int (Len)) = Curses_Err + then raise Curses_Exception; end if; end Add; @@ -448,26 +450,25 @@ package body Terminal_Interface.Curses is Lower_Right_Corner_Symbol : Attributed_Character := Default_Character) is function Wborder (W : Window; - LS : C_Chtype; - RS : C_Chtype; - TS : C_Chtype; - BS : C_Chtype; - ULC : C_Chtype; - URC : C_Chtype; - LLC : C_Chtype; - LRC : C_Chtype) return C_Int; + LS : Attributed_Character; + RS : Attributed_Character; + TS : Attributed_Character; + BS : Attributed_Character; + ULC : Attributed_Character; + URC : Attributed_Character; + LLC : Attributed_Character; + LRC : Attributed_Character) return C_Int; pragma Import (C, Wborder, "wborder"); begin if Wborder (Win, - AttrChar_To_Chtype (Left_Side_Symbol), - AttrChar_To_Chtype (Right_Side_Symbol), - AttrChar_To_Chtype (Top_Side_Symbol), - AttrChar_To_Chtype (Bottom_Side_Symbol), - AttrChar_To_Chtype (Upper_Left_Corner_Symbol), - AttrChar_To_Chtype (Upper_Right_Corner_Symbol), - AttrChar_To_Chtype (Lower_Left_Corner_Symbol), - AttrChar_To_Chtype (Lower_Right_Corner_Symbol) - ) = Curses_Err + Left_Side_Symbol, + Right_Side_Symbol, + Top_Side_Symbol, + Bottom_Side_Symbol, + Upper_Left_Corner_Symbol, + Upper_Right_Corner_Symbol, + Lower_Left_Corner_Symbol, + Lower_Right_Corner_Symbol) = Curses_Err then raise Curses_Exception; end if; @@ -490,13 +491,14 @@ package body Terminal_Interface.Curses is Line_Symbol : Attributed_Character := Default_Character) is function Whline (W : Window; - Ch : C_Chtype; + Ch : Attributed_Character; Len : C_Int) return C_Int; pragma Import (C, Whline, "whline"); begin if Whline (Win, - AttrChar_To_Chtype (Line_Symbol), - C_Int (Line_Size)) = Curses_Err then + Line_Symbol, + C_Int (Line_Size)) = Curses_Err + then raise Curses_Exception; end if; end Horizontal_Line; @@ -507,13 +509,14 @@ package body Terminal_Interface.Curses is Line_Symbol : Attributed_Character := Default_Character) is function Wvline (W : Window; - Ch : C_Chtype; + Ch : Attributed_Character; Len : C_Int) return C_Int; pragma Import (C, Wvline, "wvline"); begin if Wvline (Win, - AttrChar_To_Chtype (Line_Symbol), - C_Int (Line_Size)) = Curses_Err then + Line_Symbol, + C_Int (Line_Size)) = Curses_Err + then raise Curses_Exception; end if; end Vertical_Line; @@ -611,10 +614,10 @@ package body Terminal_Interface.Curses is On : Boolean := True) is function Wattron (Win : Window; - C_Attr : C_AttrType) return C_Int; + C_Attr : Attributed_Character) return C_Int; pragma Import (C, Wattron, "wattr_on"); function Wattroff (Win : Window; - C_Attr : C_AttrType) return C_Int; + C_Attr : Attributed_Character) return C_Int; pragma Import (C, Wattroff, "wattr_off"); -- In Ada we use the On Boolean to control whether or not we want to -- switch on or off the attributes in the set. @@ -624,9 +627,9 @@ package body Terminal_Interface.Curses is Attr => Attr); begin if On then - Err := Wattron (Win, AttrChar_To_AttrType (AC)); + Err := Wattron (Win, AC); else - Err := Wattroff (Win, AttrChar_To_AttrType (AC)); + Err := Wattroff (Win, AC); end if; if Err = Curses_Err then raise Curses_Exception; @@ -639,14 +642,13 @@ package body Terminal_Interface.Curses is Color : Color_Pair := Color_Pair'First) is function Wattrset (Win : Window; - C_Attr : C_AttrType) return C_Int; + C_Attr : Attributed_Character) return C_Int; pragma Import (C, Wattrset, "wattrset"); -- ??? wattr_set begin - if Wattrset (Win, - AttrChar_To_AttrType (Attributed_Character' - (Ch => Character'First, - Color => Color, - Attr => Attr))) = Curses_Err then + if Wattrset (Win, (Ch => Character'First, + Color => Color, + Attr => Attr)) = Curses_Err + then raise Curses_Exception; end if; end Set_Character_Attributes; @@ -655,20 +657,18 @@ package body Terminal_Interface.Curses is return Character_Attribute_Set is function Wattrget (Win : Window; - Atr : access C_AttrType; + Atr : access Attributed_Character; Col : access C_Short; Opt : System.Address) return C_Int; pragma Import (C, Wattrget, "wattr_get"); - Attr : aliased C_AttrType; + Attr : aliased Attributed_Character; Col : aliased C_Short; Res : constant C_Int := Wattrget (Win, Attr'Access, Col'Access, System.Null_Address); - Ch : Attributed_Character; begin if Res = Curses_Ok then - Ch := AttrType_To_AttrChar (Attr); - return Ch.Attr; + return Attr.Attr; else raise Curses_Exception; end if; @@ -678,20 +678,18 @@ package body Terminal_Interface.Curses is return Color_Pair is function Wattrget (Win : Window; - Atr : access C_AttrType; + Atr : access Attributed_Character; Col : access C_Short; Opt : System.Address) return C_Int; pragma Import (C, Wattrget, "wattr_get"); - Attr : aliased C_AttrType; + Attr : aliased Attributed_Character; Col : aliased C_Short; Res : constant C_Int := Wattrget (Win, Attr'Access, Col'Access, System.Null_Address); - Ch : Attributed_Character; begin if Res = Curses_Ok then - Ch := AttrType_To_AttrChar (Attr); - return Ch.Color; + return Attr.Color; else raise Curses_Exception; end if; @@ -707,7 +705,8 @@ package body Terminal_Interface.Curses is begin if Wset_Color (Win, C_Short (Pair), - C_Void_Ptr (System.Null_Address)) = Curses_Err then + C_Void_Ptr (System.Null_Address)) = Curses_Err + then raise Curses_Exception; end if; end Set_Color; @@ -720,17 +719,19 @@ package body Terminal_Interface.Curses is is function Wchgat (Win : Window; Cnt : C_Int; - Attr : C_AttrType; + Attr : Attributed_Character; Color : C_Short; Opts : System.Address := System.Null_Address) return C_Int; pragma Import (C, Wchgat, "wchgat"); - - Ch : constant Attributed_Character := - (Ch => Character'First, Color => Color_Pair'First, Attr => Attr); begin - if Wchgat (Win, C_Int (Count), AttrChar_To_AttrType (Ch), - C_Short (Color)) = Curses_Err then + if Wchgat (Win, + C_Int (Count), + (Ch => Character'First, + Color => Color_Pair'First, + Attr => Attr), + C_Short (Color)) = Curses_Err + then raise Curses_Exception; end if; end Change_Attributes; @@ -938,7 +939,8 @@ package body Terminal_Interface.Curses is pragma Import (C, Notimeout, "notimeout"); begin if Notimeout (Win, Curses_Bool (Boolean'Pos (Timer_Off))) - = Curses_Err then + = Curses_Err + then raise Curses_Exception; end if; end Set_Escape_Timer_Mode; @@ -1051,7 +1053,8 @@ package body Terminal_Interface.Curses is pragma Import (C, Wsetscrreg, "wsetscrreg"); begin if Wsetscrreg (Win, C_Int (Top_Line), C_Int (Bottom_Line)) - = Curses_Err then + = Curses_Err + then raise Curses_Exception; end if; end Set_Scroll_Region; @@ -1108,7 +1111,8 @@ package body Terminal_Interface.Curses is begin if Wredrawln (Win, C_Int (Begin_Line), - C_Int (Line_Count)) = Curses_Err then + C_Int (Line_Count)) = Curses_Err + then raise Curses_Exception; end if; end Redraw; @@ -1158,20 +1162,21 @@ package body Terminal_Interface.Curses is (Win : Window := Standard_Window; Ch : Attributed_Character) is - procedure WBackground (W : Window; Ch : C_Chtype); + procedure WBackground (W : Window; Ch : Attributed_Character); pragma Import (C, WBackground, "wbkgdset"); begin - WBackground (Win, AttrChar_To_Chtype (Ch)); + WBackground (Win, Ch); end Set_Background; procedure Change_Background (Win : Window := Standard_Window; Ch : Attributed_Character) is - function WChangeBkgd (W : Window; Ch : C_Chtype) return C_Int; + function WChangeBkgd (W : Window; Ch : Attributed_Character) + return C_Int; pragma Import (C, WChangeBkgd, "wbkgd"); begin - if WChangeBkgd (Win, AttrChar_To_Chtype (Ch)) = Curses_Err then + if WChangeBkgd (Win, Ch) = Curses_Err then raise Curses_Exception; end if; end Change_Background; @@ -1179,10 +1184,10 @@ package body Terminal_Interface.Curses is function Get_Background (Win : Window := Standard_Window) return Attributed_Character is - function Wgetbkgd (Win : Window) return C_Chtype; + function Wgetbkgd (Win : Window) return Attributed_Character; pragma Import (C, Wgetbkgd, "getbkgd"); begin - return Chtype_To_AttrChar (Wgetbkgd (Win)); + return Wgetbkgd (Win); end Get_Background; ------------------------------------------------------------------------------ procedure Change_Lines_Status (Win : Window := Standard_Window; @@ -1197,7 +1202,8 @@ package body Terminal_Interface.Curses is pragma Import (C, Wtouchln, "wtouchln"); begin if Wtouchln (Win, C_Int (Start), C_Int (Count), - C_Int (Boolean'Pos (State))) = Curses_Err then + C_Int (Boolean'Pos (State))) = Curses_Err + then raise Curses_Exception; end if; end Change_Lines_Status; @@ -1208,7 +1214,7 @@ package body Terminal_Interface.Curses is X : Column_Position; begin Get_Size (Win, Y, X); - pragma Unreferenced (X); + pragma Warnings (Off, X); -- unreferenced Change_Lines_Status (Win, 0, Positive (Y), True); end Touch; @@ -1218,7 +1224,7 @@ package body Terminal_Interface.Curses is X : Column_Position; begin Get_Size (Win, Y, X); - pragma Unreferenced (X); + pragma Warnings (Off, X); -- unreferenced Change_Lines_Status (Win, 0, Positive (Y), False); end Untouch; @@ -1288,7 +1294,8 @@ package body Terminal_Interface.Curses is C_Int (Destination_Bottom_Row), C_Int (Destination_Right_Column), Boolean'Pos (Non_Destructive_Mode) - ) = Curses_Err then + ) = Curses_Err + then raise Curses_Exception; end if; end Copy; @@ -1491,7 +1498,8 @@ package body Terminal_Interface.Curses is C_Int (Destination_Top_Row), C_Int (Destination_Left_Column), C_Int (Destination_Bottom_Row), - C_Int (Destination_Right_Column)) = Curses_Err then + C_Int (Destination_Right_Column)) = Curses_Err + then raise Curses_Exception; end if; end Refresh; @@ -1521,7 +1529,8 @@ package body Terminal_Interface.Curses is C_Int (Destination_Top_Row), C_Int (Destination_Left_Column), C_Int (Destination_Bottom_Row), - C_Int (Destination_Right_Column)) = Curses_Err then + C_Int (Destination_Right_Column)) = Curses_Err + then raise Curses_Exception; end if; end Refresh_Without_Update; @@ -1530,11 +1539,11 @@ package body Terminal_Interface.Curses is (Pad : Window; Ch : Attributed_Character) is - function Pechochar (Pad : Window; Ch : C_Chtype) + function Pechochar (Pad : Window; Ch : Attributed_Character) return C_Int; pragma Import (C, Pechochar, "pechochar"); begin - if Pechochar (Pad, AttrChar_To_Chtype (Ch)) = Curses_Err then + if Pechochar (Pad, Ch) = Curses_Err then raise Curses_Exception; end if; end Add_Character_To_Pad_And_Echo_It; @@ -1592,10 +1601,10 @@ package body Terminal_Interface.Curses is function Peek (Win : Window := Standard_Window) return Attributed_Character is - function Winch (Win : Window) return C_Chtype; + function Winch (Win : Window) return Attributed_Character; pragma Import (C, Winch, "winch"); begin - return Chtype_To_AttrChar (Winch (Win)); + return Winch (Win); end Peek; function Peek @@ -1605,19 +1614,19 @@ package body Terminal_Interface.Curses is is function Mvwinch (Win : Window; Lin : C_Int; - Col : C_Int) return C_Chtype; + Col : C_Int) return Attributed_Character; pragma Import (C, Mvwinch, "mvwinch"); begin - return Chtype_To_AttrChar (Mvwinch (Win, C_Int (Line), C_Int (Column))); + return Mvwinch (Win, C_Int (Line), C_Int (Column)); end Peek; ------------------------------------------------------------------------------ procedure Insert (Win : Window := Standard_Window; Ch : Attributed_Character) is - function Winsch (Win : Window; Ch : C_Chtype) return C_Int; + function Winsch (Win : Window; Ch : Attributed_Character) return C_Int; pragma Import (C, Winsch, "winsch"); begin - if Winsch (Win, AttrChar_To_Chtype (Ch)) = Curses_Err then + if Winsch (Win, Ch) = Curses_Err then raise Curses_Exception; end if; end Insert; @@ -1631,13 +1640,14 @@ package body Terminal_Interface.Curses is function Mvwinsch (Win : Window; Lin : C_Int; Col : C_Int; - Ch : C_Chtype) return C_Int; + Ch : Attributed_Character) return C_Int; pragma Import (C, Mvwinsch, "mvwinsch"); begin if Mvwinsch (Win, C_Int (Line), C_Int (Column), - AttrChar_To_Chtype (Ch)) = Curses_Err then + Ch) = Curses_Err + then raise Curses_Exception; end if; end Insert; @@ -1679,7 +1689,8 @@ package body Terminal_Interface.Curses is begin To_C (Str, Txt, Length); if Mvwinsnstr (Win, C_Int (Line), C_Int (Column), Txt, C_Int (Len)) - = Curses_Err then + = Curses_Err + then raise Curses_Exception; end if; end Insert; @@ -1840,7 +1851,8 @@ package body Terminal_Interface.Curses is begin To_C (Text, Txt, Len); if Slk_Set (C_Int (Label), Txt, - C_Int (Label_Justification'Pos (Fmt))) = Curses_Err then + C_Int (Label_Justification'Pos (Fmt))) = Curses_Err + then raise Curses_Exception; end if; end Set_Soft_Label_Key; @@ -1916,9 +1928,9 @@ package body Terminal_Interface.Curses is (Attr : Character_Attribute_Set; On : Boolean := True) is - function Slk_Attron (Ch : C_Chtype) return C_Int; + function Slk_Attron (Ch : Attributed_Character) return C_Int; pragma Import (C, Slk_Attron, "slk_attron"); - function Slk_Attroff (Ch : C_Chtype) return C_Int; + function Slk_Attroff (Ch : Attributed_Character) return C_Int; pragma Import (C, Slk_Attroff, "slk_attroff"); Err : C_Int; @@ -1927,9 +1939,9 @@ package body Terminal_Interface.Curses is Color => Color_Pair'First); begin if On then - Err := Slk_Attron (AttrChar_To_Chtype (Ch)); + Err := Slk_Attron (Ch); else - Err := Slk_Attroff (AttrChar_To_Chtype (Ch)); + Err := Slk_Attroff (Ch); end if; if Err = Curses_Err then raise Curses_Exception; @@ -1940,36 +1952,36 @@ package body Terminal_Interface.Curses is (Attr : Character_Attribute_Set := Normal_Video; Color : Color_Pair := Color_Pair'First) is - function Slk_Attrset (Ch : C_Chtype) return C_Int; + function Slk_Attrset (Ch : Attributed_Character) return C_Int; pragma Import (C, Slk_Attrset, "slk_attrset"); Ch : constant Attributed_Character := (Ch => Character'First, Attr => Attr, Color => Color); begin - if Slk_Attrset (AttrChar_To_Chtype (Ch)) = Curses_Err then + if Slk_Attrset (Ch) = Curses_Err then raise Curses_Exception; end if; end Set_Soft_Label_Key_Attributes; function Get_Soft_Label_Key_Attributes return Character_Attribute_Set is - function Slk_Attr return C_Chtype; + function Slk_Attr return Attributed_Character; pragma Import (C, Slk_Attr, "slk_attr"); - Attr : constant C_Chtype := Slk_Attr; + Attr : constant Attributed_Character := Slk_Attr; begin - return Chtype_To_AttrChar (Attr).Attr; + return Attr.Attr; end Get_Soft_Label_Key_Attributes; function Get_Soft_Label_Key_Attributes return Color_Pair is - function Slk_Attr return C_Chtype; + function Slk_Attr return Attributed_Character; pragma Import (C, Slk_Attr, "slk_attr"); - Attr : constant C_Chtype := Slk_Attr; + Attr : constant Attributed_Character := Slk_Attr; begin - return Chtype_To_AttrChar (Attr).Color; + return Attr.Color; end Get_Soft_Label_Key_Attributes; procedure Set_Soft_Label_Key_Color (Pair : Color_Pair) @@ -1991,7 +2003,8 @@ package body Terminal_Interface.Curses is pragma Import (C, Keyok, "keyok"); begin if Keyok (C_Int (Key), Curses_Bool (Boolean'Pos (Enable))) - = Curses_Err then + = Curses_Err + then raise Curses_Exception; end if; end Enable_Key; @@ -2015,18 +2028,18 @@ package body Terminal_Interface.Curses is procedure Un_Control (Ch : Attributed_Character; Str : out String) is - function Unctrl (Ch : C_Chtype) return chars_ptr; + function Unctrl (Ch : Attributed_Character) return chars_ptr; pragma Import (C, Unctrl, "unctrl"); begin - Fill_String (Unctrl (AttrChar_To_Chtype (Ch)), Str); + Fill_String (Unctrl (Ch), Str); end Un_Control; function Un_Control (Ch : Attributed_Character) return String is - function Unctrl (Ch : C_Chtype) return chars_ptr; + function Unctrl (Ch : Attributed_Character) return chars_ptr; pragma Import (C, Unctrl, "unctrl"); begin - return Fill_String (Unctrl (AttrChar_To_Chtype (Ch))); + return Fill_String (Unctrl (Ch)); end Un_Control; procedure Delay_Output (Msecs : Natural) @@ -2099,10 +2112,10 @@ package body Terminal_Interface.Curses is function Supported_Attributes return Character_Attribute_Set is - function Termattrs return C_Chtype; + function Termattrs return Attributed_Character; pragma Import (C, Termattrs, "termattrs"); - Ch : constant Attributed_Character := Chtype_To_AttrChar (Termattrs); + Ch : constant Attributed_Character := Termattrs; begin return Ch.Attr; end Supported_Attributes; @@ -2152,11 +2165,13 @@ package body Terminal_Interface.Curses is raise Constraint_Error; end if; if Integer (Fore) >= Number_Of_Colors or else - Integer (Back) >= Number_Of_Colors then + Integer (Back) >= Number_Of_Colors + then raise Constraint_Error; end if; if Initpair (C_Short (Pair), C_Short (Fore), C_Short (Back)) - = Curses_Err then + = Curses_Err + then raise Curses_Exception; end if; end Init_Pair; @@ -2205,7 +2220,8 @@ package body Terminal_Interface.Curses is pragma Import (C, Initcolor, "init_color"); begin if Initcolor (C_Short (Color), C_Short (Red), C_Short (Green), - C_Short (Blue)) = Curses_Err then + C_Short (Blue)) = Curses_Err + then raise Curses_Exception; end if; end Init_Color; @@ -2236,7 +2252,8 @@ package body Terminal_Interface.Curses is R, G, B : aliased C_Short; begin if Colorcontent (C_Short (Color), R'Access, G'Access, B'Access) = - Curses_Err then + Curses_Err + then raise Curses_Exception; else Red := RGB_Value (R); @@ -2337,7 +2354,46 @@ package body Terminal_Interface.Curses is end if; end Nap_Milli_Seconds; ------------------------------------------------------------------------------ -include(`Public_Variables') + function Lines return Line_Count + is + function LINES_As_Function return Interfaces.C.int; + pragma Import (C, LINES_As_Function, "LINES_as_function"); + begin + return Line_Count (LINES_As_Function); + end Lines; + + function Columns return Column_Count + is + function COLS_As_Function return Interfaces.C.int; + pragma Import (C, COLS_As_Function, "COLS_as_function"); + begin + return Column_Count (COLS_As_Function); + end Columns; + + function Tab_Size return Natural + is + function TABSIZE_As_Function return Interfaces.C.int; + pragma Import (C, TABSIZE_As_Function, "TABSIZE_as_function"); + + begin + return Natural (TABSIZE_As_Function); + end Tab_Size; + + function Number_Of_Colors return Natural + is + function COLORS_As_Function return Interfaces.C.int; + pragma Import (C, COLORS_As_Function, "COLORS_as_function"); + begin + return Natural (COLORS_As_Function); + end Number_Of_Colors; + + function Number_Of_Color_Pairs return Natural + is + function COLOR_PAIRS_As_Function return Interfaces.C.int; + pragma Import (C, COLOR_PAIRS_As_Function, "COLOR_PAIRS_as_function"); + begin + return Natural (COLOR_PAIRS_As_Function); + end Number_Of_Color_Pairs; ------------------------------------------------------------------------------ procedure Transform_Coordinates (W : Window := Standard_Window; @@ -2493,7 +2549,8 @@ include(`Public_Variables') begin if wresize (Win, C_Int (Number_Of_Lines), - C_Int (Number_Of_Columns)) = Curses_Err then + C_Int (Number_Of_Columns)) = Curses_Err + then raise Curses_Exception; end if; end Resize; diff --git a/Ada95/gen/terminal_interface-curses.ads.m4 b/Ada95/gen/terminal_interface-curses.ads.m4 index 28cc9d19..25bb5d9b 100644 --- a/Ada95/gen/terminal_interface-curses.ads.m4 +++ b/Ada95/gen/terminal_interface-curses.ads.m4 @@ -9,7 +9,7 @@ include(M4MACRO)---------------------------------------------------------------- -- S P E C -- -- -- ------------------------------------------------------------------------------ --- Copyright (c) 1998-2009,2011 Free Software Foundation, Inc. -- +-- Copyright (c) 1998-2011,2014 Free Software Foundation, Inc. -- -- -- -- Permission is hereby granted, free of charge, to any person obtaining a -- -- copy of this software and associated documentation files (the -- @@ -37,18 +37,23 @@ include(M4MACRO)---------------------------------------------------------------- ------------------------------------------------------------------------------ -- Author: Juergen Pfeifer, 1996 -- Version Control: --- $Revision: 1.44 $ --- $Date: 2011/03/19 23:05:56 $ +-- $Revision: 1.47 $ +-- $Date: 2014/05/24 21:31:57 $ -- Binding Version 01.00 ------------------------------------------------------------------------------ -include(`Base_Defs') with System.Storage_Elements; with Interfaces.C; -- We need this for some assertions. +with Terminal_Interface.Curses_Constants; + package Terminal_Interface.Curses is pragma Preelaborate (Terminal_Interface.Curses); -include(`Linker_Options') -include(`Version_Info') + pragma Linker_Options ("-lncurses" & Curses_Constants.DFT_ARG_SUFFIX); + + Major_Version : constant := Curses_Constants.NCURSES_VERSION_MAJOR; + Minor_Version : constant := Curses_Constants.NCURSES_VERSION_MINOR; + NC_Version : String renames Curses_Constants.Version; + type Window is private; Null_Window : constant Window; @@ -65,24 +70,315 @@ include(`Version_Info') -- request codes. -- FIXME: The "-1" should be Curses_Err - subtype Real_Key_Code is Key_Code range -1 .. M4_KEY_MAX; + subtype Real_Key_Code is Key_Code range -1 .. Curses_Constants.KEY_MAX; -- This are the codes that potentially represent a real keystroke. -- Not all codes may be possible on a specific terminal. To check the -- availability of a special key, the Has_Key function is provided. subtype Special_Key_Code is Real_Key_Code - range M4_SPECIAL_FIRST .. Real_Key_Code'Last; + range Curses_Constants. KEY_MIN - 1 .. Real_Key_Code'Last; -- Type for a function- or special key number subtype Normal_Key_Code is Real_Key_Code range Character'Pos (Character'First) .. Character'Pos (Character'Last); -- This are the codes for regular (incl. non-graphical) characters. + -- For those who like to use the original key names we produce them were + -- they differ from the original. + -- Constants for function- and special keys - -- - Key_None : constant Special_Key_Code := M4_SPECIAL_FIRST; -include(`Key_Definitions') - Key_Max : constant Special_Key_Code + Key_None : constant Special_Key_Code + := Curses_Constants.KEY_MIN - 1; + Key_Min : constant Special_Key_Code + := Curses_Constants.KEY_MIN; + Key_Break : constant Special_Key_Code + := Curses_Constants.KEY_BREAK; + KEY_DOWN : constant Special_Key_Code + := Curses_Constants.KEY_DOWN; + Key_Cursor_Down : Special_Key_Code renames KEY_DOWN; + KEY_UP : constant Special_Key_Code + := Curses_Constants.KEY_UP; + Key_Cursor_Up : Special_Key_Code renames KEY_UP; + KEY_LEFT : constant Special_Key_Code + := Curses_Constants.KEY_LEFT; + Key_Cursor_Left : Special_Key_Code renames KEY_LEFT; + KEY_RIGHT : constant Special_Key_Code + := Curses_Constants.KEY_RIGHT; + Key_Cursor_Right : Special_Key_Code renames KEY_RIGHT; + Key_Home : constant Special_Key_Code + := Curses_Constants.KEY_HOME; + Key_Backspace : constant Special_Key_Code + := Curses_Constants.KEY_BACKSPACE; + Key_F0 : constant Special_Key_Code + := Curses_Constants.KEY_F0; + Key_F1 : constant Special_Key_Code + := Curses_Constants.KEY_F1; + Key_F2 : constant Special_Key_Code + := Curses_Constants.KEY_F2; + Key_F3 : constant Special_Key_Code + := Curses_Constants.KEY_F3; + Key_F4 : constant Special_Key_Code + := Curses_Constants.KEY_F4; + Key_F5 : constant Special_Key_Code + := Curses_Constants.KEY_F5; + Key_F6 : constant Special_Key_Code + := Curses_Constants.KEY_F6; + Key_F7 : constant Special_Key_Code + := Curses_Constants.KEY_F7; + Key_F8 : constant Special_Key_Code + := Curses_Constants.KEY_F8; + Key_F9 : constant Special_Key_Code + := Curses_Constants.KEY_F9; + Key_F10 : constant Special_Key_Code + := Curses_Constants.KEY_F10; + Key_F11 : constant Special_Key_Code + := Curses_Constants.KEY_F11; + Key_F12 : constant Special_Key_Code + := Curses_Constants.KEY_F12; + Key_F13 : constant Special_Key_Code + := Curses_Constants.KEY_F13; + Key_F14 : constant Special_Key_Code + := Curses_Constants.KEY_F14; + Key_F15 : constant Special_Key_Code + := Curses_Constants.KEY_F15; + Key_F16 : constant Special_Key_Code + := Curses_Constants.KEY_F16; + Key_F17 : constant Special_Key_Code + := Curses_Constants.KEY_F17; + Key_F18 : constant Special_Key_Code + := Curses_Constants.KEY_F18; + Key_F19 : constant Special_Key_Code + := Curses_Constants.KEY_F19; + Key_F20 : constant Special_Key_Code + := Curses_Constants.KEY_F20; + Key_F21 : constant Special_Key_Code + := Curses_Constants.KEY_F21; + Key_F22 : constant Special_Key_Code + := Curses_Constants.KEY_F22; + Key_F23 : constant Special_Key_Code + := Curses_Constants.KEY_F23; + Key_F24 : constant Special_Key_Code + := Curses_Constants.KEY_F24; + KEY_DL : constant Special_Key_Code + := Curses_Constants.KEY_DL; + Key_Delete_Line : Special_Key_Code renames KEY_DL; + KEY_IL : constant Special_Key_Code + := Curses_Constants.KEY_IL; + Key_Insert_Line : Special_Key_Code renames KEY_IL; + KEY_DC : constant Special_Key_Code + := Curses_Constants.KEY_DC; + Key_Delete_Char : Special_Key_Code renames KEY_DC; + KEY_IC : constant Special_Key_Code + := Curses_Constants.KEY_IC; + Key_Insert_Char : Special_Key_Code renames KEY_IC; + KEY_EIC : constant Special_Key_Code + := Curses_Constants.KEY_EIC; + Key_Exit_Insert_Mode : Special_Key_Code renames KEY_EIC; + KEY_CLEAR : constant Special_Key_Code + := Curses_Constants.KEY_CLEAR; + Key_Clear_Screen : Special_Key_Code renames KEY_CLEAR; + KEY_EOS : constant Special_Key_Code + := Curses_Constants.KEY_EOS; + Key_Clear_End_Of_Screen : Special_Key_Code renames KEY_EOS; + KEY_EOL : constant Special_Key_Code + := Curses_Constants.KEY_EOL; + Key_Clear_End_Of_Line : Special_Key_Code renames KEY_EOL; + KEY_SF : constant Special_Key_Code + := Curses_Constants.KEY_SF; + Key_Scroll_1_Forward : Special_Key_Code renames KEY_SF; + KEY_SR : constant Special_Key_Code + := Curses_Constants.KEY_SR; + Key_Scroll_1_Backward : Special_Key_Code renames KEY_SR; + KEY_NPAGE : constant Special_Key_Code + := Curses_Constants.KEY_NPAGE; + Key_Next_Page : Special_Key_Code renames KEY_NPAGE; + KEY_PPAGE : constant Special_Key_Code + := Curses_Constants.KEY_PPAGE; + Key_Previous_Page : Special_Key_Code renames KEY_PPAGE; + KEY_STAB : constant Special_Key_Code + := Curses_Constants.KEY_STAB; + Key_Set_Tab : Special_Key_Code renames KEY_STAB; + KEY_CTAB : constant Special_Key_Code + := Curses_Constants.KEY_CTAB; + Key_Clear_Tab : Special_Key_Code renames KEY_CTAB; + KEY_CATAB : constant Special_Key_Code + := Curses_Constants.KEY_CATAB; + Key_Clear_All_Tabs : Special_Key_Code renames KEY_CATAB; + KEY_ENTER : constant Special_Key_Code + := Curses_Constants.KEY_ENTER; + Key_Enter_Or_Send : Special_Key_Code renames KEY_ENTER; + KEY_SRESET : constant Special_Key_Code + := Curses_Constants.KEY_SRESET; + Key_Soft_Reset : Special_Key_Code renames KEY_SRESET; + Key_Reset : constant Special_Key_Code + := Curses_Constants.KEY_RESET; + Key_Print : constant Special_Key_Code + := Curses_Constants.KEY_PRINT; + KEY_LL : constant Special_Key_Code + := Curses_Constants.KEY_LL; + Key_Bottom : Special_Key_Code renames KEY_LL; + KEY_A1 : constant Special_Key_Code + := Curses_Constants.KEY_A1; + Key_Upper_Left_Of_Keypad : Special_Key_Code renames KEY_A1; + KEY_A3 : constant Special_Key_Code + := Curses_Constants.KEY_A3; + Key_Upper_Right_Of_Keypad : Special_Key_Code renames KEY_A3; + KEY_B2 : constant Special_Key_Code + := Curses_Constants.KEY_B2; + Key_Center_Of_Keypad : Special_Key_Code renames KEY_B2; + KEY_C1 : constant Special_Key_Code + := Curses_Constants.KEY_C1; + Key_Lower_Left_Of_Keypad : Special_Key_Code renames KEY_C1; + KEY_C3 : constant Special_Key_Code + := Curses_Constants.KEY_C3; + Key_Lower_Right_Of_Keypad : Special_Key_Code renames KEY_C3; + KEY_BTAB : constant Special_Key_Code + := Curses_Constants.KEY_BTAB; + Key_Back_Tab : Special_Key_Code renames KEY_BTAB; + KEY_BEG : constant Special_Key_Code + := Curses_Constants.KEY_BEG; + Key_Beginning : Special_Key_Code renames KEY_BEG; + Key_Cancel : constant Special_Key_Code + := Curses_Constants.KEY_CANCEL; + Key_Close : constant Special_Key_Code + := Curses_Constants.KEY_CLOSE; + Key_Command : constant Special_Key_Code + := Curses_Constants.KEY_COMMAND; + Key_Copy : constant Special_Key_Code + := Curses_Constants.KEY_COPY; + Key_Create : constant Special_Key_Code + := Curses_Constants.KEY_CREATE; + Key_End : constant Special_Key_Code + := Curses_Constants.KEY_END; + Key_Exit : constant Special_Key_Code + := Curses_Constants.KEY_EXIT; + Key_Find : constant Special_Key_Code + := Curses_Constants.KEY_FIND; + Key_Help : constant Special_Key_Code + := Curses_Constants.KEY_HELP; + Key_Mark : constant Special_Key_Code + := Curses_Constants.KEY_MARK; + Key_Message : constant Special_Key_Code + := Curses_Constants.KEY_MESSAGE; + Key_Move : constant Special_Key_Code + := Curses_Constants.KEY_MOVE; + Key_Next : constant Special_Key_Code + := Curses_Constants.KEY_NEXT; + Key_Open : constant Special_Key_Code + := Curses_Constants.KEY_OPEN; + Key_Options : constant Special_Key_Code + := Curses_Constants.KEY_OPTIONS; + Key_Previous : constant Special_Key_Code + := Curses_Constants.KEY_PREVIOUS; + Key_Redo : constant Special_Key_Code + := Curses_Constants.KEY_REDO; + Key_Reference : constant Special_Key_Code + := Curses_Constants.KEY_REFERENCE; + Key_Refresh : constant Special_Key_Code + := Curses_Constants.KEY_REFRESH; + Key_Replace : constant Special_Key_Code + := Curses_Constants.KEY_REPLACE; + Key_Restart : constant Special_Key_Code + := Curses_Constants.KEY_RESTART; + Key_Resume : constant Special_Key_Code + := Curses_Constants.KEY_RESUME; + Key_Save : constant Special_Key_Code + := Curses_Constants.KEY_SAVE; + KEY_SBEG : constant Special_Key_Code + := Curses_Constants.KEY_SBEG; + Key_Shift_Begin : Special_Key_Code renames KEY_SBEG; + KEY_SCANCEL : constant Special_Key_Code + := Curses_Constants.KEY_SCANCEL; + Key_Shift_Cancel : Special_Key_Code renames KEY_SCANCEL; + KEY_SCOMMAND : constant Special_Key_Code + := Curses_Constants.KEY_SCOMMAND; + Key_Shift_Command : Special_Key_Code renames KEY_SCOMMAND; + KEY_SCOPY : constant Special_Key_Code + := Curses_Constants.KEY_SCOPY; + Key_Shift_Copy : Special_Key_Code renames KEY_SCOPY; + KEY_SCREATE : constant Special_Key_Code + := Curses_Constants.KEY_SCREATE; + Key_Shift_Create : Special_Key_Code renames KEY_SCREATE; + KEY_SDC : constant Special_Key_Code + := Curses_Constants.KEY_SDC; + Key_Shift_Delete_Char : Special_Key_Code renames KEY_SDC; + KEY_SDL : constant Special_Key_Code + := Curses_Constants.KEY_SDL; + Key_Shift_Delete_Line : Special_Key_Code renames KEY_SDL; + Key_Select : constant Special_Key_Code + := Curses_Constants.KEY_SELECT; + KEY_SEND : constant Special_Key_Code + := Curses_Constants.KEY_SEND; + Key_Shift_End : Special_Key_Code renames KEY_SEND; + KEY_SEOL : constant Special_Key_Code + := Curses_Constants.KEY_SEOL; + Key_Shift_Clear_End_Of_Line : Special_Key_Code renames KEY_SEOL; + KEY_SEXIT : constant Special_Key_Code + := Curses_Constants.KEY_SEXIT; + Key_Shift_Exit : Special_Key_Code renames KEY_SEXIT; + KEY_SFIND : constant Special_Key_Code + := Curses_Constants.KEY_SFIND; + Key_Shift_Find : Special_Key_Code renames KEY_SFIND; + KEY_SHELP : constant Special_Key_Code + := Curses_Constants.KEY_SHELP; + Key_Shift_Help : Special_Key_Code renames KEY_SHELP; + KEY_SHOME : constant Special_Key_Code + := Curses_Constants.KEY_SHOME; + Key_Shift_Home : Special_Key_Code renames KEY_SHOME; + KEY_SIC : constant Special_Key_Code + := Curses_Constants.KEY_SIC; + Key_Shift_Insert_Char : Special_Key_Code renames KEY_SIC; + KEY_SLEFT : constant Special_Key_Code + := Curses_Constants.KEY_SLEFT; + Key_Shift_Cursor_Left : Special_Key_Code renames KEY_SLEFT; + KEY_SMESSAGE : constant Special_Key_Code + := Curses_Constants.KEY_SMESSAGE; + Key_Shift_Message : Special_Key_Code renames KEY_SMESSAGE; + KEY_SMOVE : constant Special_Key_Code + := Curses_Constants.KEY_SMOVE; + Key_Shift_Move : Special_Key_Code renames KEY_SMOVE; + KEY_SNEXT : constant Special_Key_Code + := Curses_Constants.KEY_SNEXT; + Key_Shift_Next_Page : Special_Key_Code renames KEY_SNEXT; + KEY_SOPTIONS : constant Special_Key_Code + := Curses_Constants.KEY_SOPTIONS; + Key_Shift_Options : Special_Key_Code renames KEY_SOPTIONS; + KEY_SPREVIOUS : constant Special_Key_Code + := Curses_Constants.KEY_SPREVIOUS; + Key_Shift_Previous_Page : Special_Key_Code renames KEY_SPREVIOUS; + KEY_SPRINT : constant Special_Key_Code + := Curses_Constants.KEY_SPRINT; + Key_Shift_Print : Special_Key_Code renames KEY_SPRINT; + KEY_SREDO : constant Special_Key_Code + := Curses_Constants.KEY_SREDO; + Key_Shift_Redo : Special_Key_Code renames KEY_SREDO; + KEY_SREPLACE : constant Special_Key_Code + := Curses_Constants.KEY_SREPLACE; + Key_Shift_Replace : Special_Key_Code renames KEY_SREPLACE; + KEY_SRIGHT : constant Special_Key_Code + := Curses_Constants.KEY_SRIGHT; + Key_Shift_Cursor_Right : Special_Key_Code renames KEY_SRIGHT; + KEY_SRSUME : constant Special_Key_Code + := Curses_Constants.KEY_SRSUME; + Key_Shift_Resume : Special_Key_Code renames KEY_SRSUME; + KEY_SSAVE : constant Special_Key_Code + := Curses_Constants.KEY_SSAVE; + Key_Shift_Save : Special_Key_Code renames KEY_SSAVE; + KEY_SSUSPEND : constant Special_Key_Code + := Curses_Constants.KEY_SSUSPEND; + Key_Shift_Suspend : Special_Key_Code renames KEY_SSUSPEND; + KEY_SUNDO : constant Special_Key_Code + := Curses_Constants.KEY_SUNDO; + Key_Shift_Undo : Special_Key_Code renames KEY_SUNDO; + Key_Suspend : constant Special_Key_Code + := Curses_Constants.KEY_SUSPEND; + Key_Undo : constant Special_Key_Code + := Curses_Constants.KEY_UNDO; + Key_Mouse : constant Special_Key_Code + := Curses_Constants.KEY_MOUSE; + Key_Resize : constant Special_Key_Code + := Curses_Constants.KEY_RESIZE; + Key_Max : constant Special_Key_Code := Special_Key_Code'Last; subtype User_Key_Code is Key_Code @@ -90,12 +386,7 @@ include(`Key_Definitions') -- This is reserved for user defined key codes. The range between Key_Max -- and the first user code is reserved for subsystems like menu and forms. - -- For those who like to use the original key names we produce them were - -- they differ from the original. Please note that they may differ in - -- lower/upper case. -include(`Old_Keys')dnl - ------------------------------------------------------------------------------- + -------------------------------------------------------------------------- type Color_Number is range -1 .. Integer (Interfaces.C.short'Last); for Color_Number'Size use Interfaces.C.short'Size; @@ -104,7 +395,15 @@ include(`Old_Keys')dnl -- (potentially) definable colors. Some of those indices are -- predefined (see below), although they may not really exist. -include(`Color_Defs') + Black : constant Color_Number := Curses_Constants.COLOR_BLACK; + Red : constant Color_Number := Curses_Constants.COLOR_RED; + Green : constant Color_Number := Curses_Constants.COLOR_GREEN; + Yellow : constant Color_Number := Curses_Constants.COLOR_YELLOW; + Blue : constant Color_Number := Curses_Constants.COLOR_BLUE; + Magenta : constant Color_Number := Curses_Constants.COLOR_MAGENTA; + Cyan : constant Color_Number := Curses_Constants.COLOR_CYAN; + White : constant Color_Number := Curses_Constants.COLOR_WHITE; + type RGB_Value is range 0 .. Integer (Interfaces.C.short'Last); for RGB_Value'Size use Interfaces.C.short'Size; -- Some system may allow to redefine a color by setting RGB values. @@ -117,8 +416,73 @@ include(`Color_Defs') -- two colors described by Color_Numbers, one for the foreground and -- the other for the background -include(`Character_Attribute_Set_Rep') - -- (n)curses uses all but the lowest 16 Bits for Attributes. + type Character_Attribute_Set is + record + Stand_Out : Boolean; + Under_Line : Boolean; + Reverse_Video : Boolean; + Blink : Boolean; + Dim_Character : Boolean; + Bold_Character : Boolean; + Protected_Character : Boolean; + Invisible_Character : Boolean; + Alternate_Character_Set : Boolean; + Horizontal : Boolean; + Left : Boolean; + Low : Boolean; + Right : Boolean; + Top : Boolean; + Vertical : Boolean; + end record; + + for Character_Attribute_Set use + record + Stand_Out at 0 range + Curses_Constants.A_STANDOUT_First - Curses_Constants.Attr_First + .. Curses_Constants.A_STANDOUT_Last - Curses_Constants.Attr_First; + Under_Line at 0 range + Curses_Constants.A_UNDERLINE_First - Curses_Constants.Attr_First + .. Curses_Constants.A_UNDERLINE_Last - Curses_Constants.Attr_First; + Reverse_Video at 0 range + Curses_Constants.A_REVERSE_First - Curses_Constants.Attr_First + .. Curses_Constants.A_REVERSE_Last - Curses_Constants.Attr_First; + Blink at 0 range + Curses_Constants.A_BLINK_First - Curses_Constants.Attr_First + .. Curses_Constants.A_BLINK_Last - Curses_Constants.Attr_First; + Dim_Character at 0 range + Curses_Constants.A_DIM_First - Curses_Constants.Attr_First + .. Curses_Constants.A_DIM_Last - Curses_Constants.Attr_First; + Bold_Character at 0 range + Curses_Constants.A_BOLD_First - Curses_Constants.Attr_First + .. Curses_Constants.A_BOLD_Last - Curses_Constants.Attr_First; + Protected_Character at 0 range + Curses_Constants.A_PROTECT_First - Curses_Constants.Attr_First + .. Curses_Constants.A_PROTECT_Last - Curses_Constants.Attr_First; + Invisible_Character at 0 range + Curses_Constants.A_INVIS_First - Curses_Constants.Attr_First + .. Curses_Constants.A_INVIS_Last - Curses_Constants.Attr_First; + Alternate_Character_Set at 0 range + Curses_Constants.A_ALTCHARSET_First - Curses_Constants.Attr_First + .. Curses_Constants.A_ALTCHARSET_Last - Curses_Constants.Attr_First; + Horizontal at 0 range + Curses_Constants.A_HORIZONTAL_First - Curses_Constants.Attr_First + .. Curses_Constants.A_HORIZONTAL_Last - Curses_Constants.Attr_First; + Left at 0 range + Curses_Constants.A_LEFT_First - Curses_Constants.Attr_First + .. Curses_Constants.A_LEFT_Last - Curses_Constants.Attr_First; + Low at 0 range + Curses_Constants.A_LOW_First - Curses_Constants.Attr_First + .. Curses_Constants.A_LOW_Last - Curses_Constants.Attr_First; + Right at 0 range + Curses_Constants.A_RIGHT_First - Curses_Constants.Attr_First + .. Curses_Constants.A_RIGHT_Last - Curses_Constants.Attr_First; + Top at 0 range + Curses_Constants.A_TOP_First - Curses_Constants.Attr_First + .. Curses_Constants.A_TOP_Last - Curses_Constants.Attr_First; + Vertical at 0 range + Curses_Constants.A_VERTICAL_First - Curses_Constants.Attr_First + .. Curses_Constants.A_VERTICAL_Last - Curses_Constants.Attr_First; + end record; Normal_Video : constant Character_Attribute_Set := (others => False); @@ -128,17 +492,29 @@ include(`Character_Attribute_Set_Rep') Color : Color_Pair; Ch : Character; end record; - pragma Convention (C, Attributed_Character); + pragma Convention (C_Pass_By_Copy, Attributed_Character); -- This is the counterpart for the chtype in C. -include(`AC_Rep') + for Attributed_Character use + record + Ch at 0 range Curses_Constants.A_CHARTEXT_First + .. Curses_Constants.A_CHARTEXT_Last; + Color at 0 range Curses_Constants.A_COLOR_First + .. Curses_Constants.A_COLOR_Last; + pragma Warnings (Off); + Attr at 0 range Curses_Constants.Attr_First + .. Curses_Constants.Attr_Last; + pragma Warnings (On); + end record; + for Attributed_Character'Size use Curses_Constants.chtype_Size; + Default_Character : constant Attributed_Character := (Ch => Character'First, Color => Color_Pair'First, Attr => (others => False)); -- preelaboratable Normal_Video type Attributed_String is array (Positive range <>) of Attributed_Character; - pragma Pack (Attributed_String); + pragma Convention (C, Attributed_String); -- In this binding we allow strings of attributed characters. ------------------ @@ -188,7 +564,78 @@ include(`AC_Rep') function Number_Of_Color_Pairs return Natural; pragma Inline (Number_Of_Color_Pairs); -include(`ACS_Map')dnl + subtype ACS_Index is Character range + Character'Val (0) .. Character'Val (127); + function ACS_Map (Index : ACS_Index) return Attributed_Character; + pragma Import (C, ACS_Map, "acs_map_as_function"); + + -- Constants for several characters from the Alternate Character Set + -- You must use these constants as indices into the ACS_Map function + -- to get the corresponding attributed character at runtime + ACS_Upper_Left_Corner : constant ACS_Index + := Character'Val (Curses_Constants.ACS_ULCORNER); + ACS_Lower_Left_Corner : constant ACS_Index + := Character'Val (Curses_Constants.ACS_LLCORNER); + ACS_Upper_Right_Corner : constant ACS_Index + := Character'Val (Curses_Constants.ACS_URCORNER); + ACS_Lower_Right_Corner : constant ACS_Index + := Character'Val (Curses_Constants.ACS_LRCORNER); + ACS_Left_Tee : constant ACS_Index + := Character'Val (Curses_Constants.ACS_LTEE); + ACS_Right_Tee : constant ACS_Index + := Character'Val (Curses_Constants.ACS_RTEE); + ACS_Bottom_Tee : constant ACS_Index + := Character'Val (Curses_Constants.ACS_BTEE); + ACS_Top_Tee : constant ACS_Index + := Character'Val (Curses_Constants.ACS_TTEE); + ACS_Horizontal_Line : constant ACS_Index + := Character'Val (Curses_Constants.ACS_HLINE); + ACS_Vertical_Line : constant ACS_Index + := Character'Val (Curses_Constants.ACS_VLINE); + ACS_Plus_Symbol : constant ACS_Index + := Character'Val (Curses_Constants.ACS_PLUS); + ACS_Scan_Line_1 : constant ACS_Index + := Character'Val (Curses_Constants.ACS_S1); + ACS_Scan_Line_9 : constant ACS_Index + := Character'Val (Curses_Constants.ACS_S9); + ACS_Diamond : constant ACS_Index + := Character'Val (Curses_Constants.ACS_DIAMOND); + ACS_Checker_Board : constant ACS_Index + := Character'Val (Curses_Constants.ACS_CKBOARD); + ACS_Degree : constant ACS_Index + := Character'Val (Curses_Constants.ACS_DEGREE); + ACS_Plus_Minus : constant ACS_Index + := Character'Val (Curses_Constants.ACS_PLMINUS); + ACS_Bullet : constant ACS_Index + := Character'Val (Curses_Constants.ACS_BULLET); + ACS_Left_Arrow : constant ACS_Index + := Character'Val (Curses_Constants.ACS_LARROW); + ACS_Right_Arrow : constant ACS_Index + := Character'Val (Curses_Constants.ACS_RARROW); + ACS_Down_Arrow : constant ACS_Index + := Character'Val (Curses_Constants.ACS_DARROW); + ACS_Up_Arrow : constant ACS_Index + := Character'Val (Curses_Constants.ACS_UARROW); + ACS_Board_Of_Squares : constant ACS_Index + := Character'Val (Curses_Constants.ACS_BOARD); + ACS_Lantern : constant ACS_Index + := Character'Val (Curses_Constants.ACS_LANTERN); + ACS_Solid_Block : constant ACS_Index + := Character'Val (Curses_Constants.ACS_BLOCK); + ACS_Scan_Line_3 : constant ACS_Index + := Character'Val (Curses_Constants.ACS_S3); + ACS_Scan_Line_7 : constant ACS_Index + := Character'Val (Curses_Constants.ACS_S7); + ACS_Less_Or_Equal : constant ACS_Index + := Character'Val (Curses_Constants.ACS_LEQUAL); + ACS_Greater_Or_Equal : constant ACS_Index + := Character'Val (Curses_Constants.ACS_GEQUAL); + ACS_PI : constant ACS_Index + := Character'Val (Curses_Constants.ACS_PI); + ACS_Not_Equal : constant ACS_Index + := Character'Val (Curses_Constants.ACS_NEQUAL); + ACS_Sterling : constant ACS_Index + := Character'Val (Curses_Constants.ACS_STERLING); -- MANPAGE(`curs_initscr.3x') -- | Not implemented: newterm, set_term, delscreen @@ -196,11 +643,13 @@ include(`ACS_Map')dnl -- ANCHOR(`stdscr',`Standard_Window') function Standard_Window return Window; -- AKA + pragma Import (C, Standard_Window, "stdscr_as_function"); pragma Inline (Standard_Window); -- ANCHOR(`curscr',`Current_Window') function Current_Window return Window; -- AKA + pragma Import (C, Current_Window, "curscr_as_function"); pragma Inline (Current_Window); -- ANCHOR(`initscr()',`Init_Screen') @@ -1476,6 +1925,8 @@ include(`ACS_Map')dnl -- MANPAGE(`default_colors.3x') + Default_Color : constant Color_Number := -1; + -- ANCHOR(`use_default_colors()',`Use_Default_Colors') procedure Use_Default_Colors; -- AKA @@ -1553,7 +2004,11 @@ private -- The next constants are generated and may be different on your -- architecture. -- -include(`Window_Offsets')dnl + + Sizeof_Bool : constant := Curses_Constants.Sizeof_Bool; + + type Curses_Bool is mod 2 ** Sizeof_Bool; + Curses_Bool_False : constant Curses_Bool := 0; end Terminal_Interface.Curses; diff --git a/Ada95/samples/ncurses2-util.adb b/Ada95/samples/ncurses2-util.adb index 8ae32724..e0f3d35b 100644 --- a/Ada95/samples/ncurses2-util.adb +++ b/Ada95/samples/ncurses2-util.adb @@ -7,7 +7,7 @@ -- B O D Y -- -- -- ------------------------------------------------------------------------------ --- Copyright (c) 2000-2006,2008 Free Software Foundation, Inc. -- +-- Copyright (c) 2000-2008,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,16 +35,12 @@ ------------------------------------------------------------------------------ -- Author: Eugene V. Melaragno 2000 -- Version Control --- $Revision: 1.7 $ --- $Date: 2008/07/26 18:51:20 $ +-- $Revision: 1.9 $ +-- $Date: 2014/05/24 21:32:18 $ -- Binding Version 01.00 ------------------------------------------------------------------------------ with Ada.Text_IO; use Ada.Text_IO; -pragma Warnings (Off); -with Terminal_Interface.Curses.Aux; -pragma Warnings (On); - with Terminal_Interface.Curses.Trace; use Terminal_Interface.Curses.Trace; with Interfaces.C; @@ -115,7 +111,6 @@ package body ncurses2.util is procedure Cannot (s : String) is use Interfaces.C; use Interfaces.C.Strings; - use Terminal_Interface.Curses.Aux; function getenv (x : char_array) return chars_ptr; pragma Import (C, getenv, "getenv"); tmp1 : char_array (0 .. 10); diff --git a/Ada95/src/Makefile.in b/Ada95/src/Makefile.in index 9962859b..d74c4457 100644 --- a/Ada95/src/Makefile.in +++ b/Ada95/src/Makefile.in @@ -1,5 +1,5 @@ ############################################################################## -# Copyright (c) 1998-2010,2011 Free Software Foundation, Inc. # +# Copyright (c) 1998-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"), # @@ -28,7 +28,7 @@ # # Author: Juergen Pfeifer, 1996 # -# $Id: Makefile.in,v 1.62 2011/04/30 22:24:45 tom Exp $ +# $Id: Makefile.in,v 1.68 2014/05/24 21:29:11 tom Exp $ # .SUFFIXES: @@ -97,16 +97,6 @@ BUILD_DIR_LIB = $(BUILD_DIR)/lib SOURCE_DIR_SRC = $(SOURCE_DIR)/src ADAMAKE = @cf_ada_make@ -ADAMAKEFLAGS = \ - -P$(GNAT_PROJECT) \ - -XBUILD_DIR=`cd $(BUILD_DIR);pwd` \ - -XSOURCE_DIR=`cd $(SOURCE_DIR);pwd` \ - -XSOURCE_DIR2=`cd $(srcdir);pwd` \ - -XLIB_NAME=$(LIB_NAME) \ - -XSONAME=$(SONAME) - -CARGS = -cargs $(ADAFLAGS) -LARGS = STATIC_LIBNAME = lib$(LIB_NAME).a SHARED_LIBNAME = $(SONAME) @@ -215,66 +205,42 @@ BASEDEPS=$(ABASE).ads $(ABASE)-aux.ads $(ABASE).adb $(ABASE)-trace.adb : $(srcdir)/$(ABASE)-trace.adb_p rm -f $@ - $(ADAPREP) -DADA_TRACE=@ADA_TRACE@ -DPRAGMA_UNREF=@PRAGMA_UNREF@ $(srcdir)/$(ABASE)-trace.adb_p $@ + $(ADAPREP) -DADA_TRACE=@ADA_TRACE@ $(srcdir)/$(ABASE)-trace.adb_p $@ ############################################################################### # Use these definitions when building a shared library. -SHARED_C_OBJS = c_varargs_to_ada.o ncurses_compat.o -SHARED_OBJS = $(SHARED_C_OBJS) @USE_OLD_MAKERULES@$(LIBOBJS) @cf_generic_objects@ +SHARED_C_OBJS = c_varargs_to_ada.o c_threaded_variables.o ncurses_compat.o +SHARED_OBJS = $(SHARED_C_OBJS) $(LIBOBJS) @cf_generic_objects@ c_varargs_to_ada.o : $(srcdir)/c_varargs_to_ada.c $(CC) $(CFLAGS_DEFAULT) -c -o $@ $(srcdir)/c_varargs_to_ada.c +c_threaded_variables.o : $(srcdir)/c_threaded_variables.c + $(CC) $(CFLAGS_DEFAULT) -c -o $@ $(srcdir)/c_threaded_variables.c + ncurses_compat.o : $(srcdir)/ncurses_compat.c $(CC) $(CFLAGS_DEFAULT) -c -o $@ $(srcdir)/ncurses_compat.c ############################################################################### # Use these definitions when building a static library. -STATIC_C_OBJS = static_c_varargs_to_ada.o static_ncurses_compat.o -STATIC_OBJS = $(STATIC_C_OBJS) @USE_OLD_MAKERULES@$(LIBOBJS) @cf_generic_objects@ +STATIC_C_OBJS = static_c_varargs_to_ada.o static_c_threaded_variables.o static_ncurses_compat.o +STATIC_OBJS = $(STATIC_C_OBJS) $(LIBOBJS) @cf_generic_objects@ static_c_varargs_to_ada.o : $(srcdir)/c_varargs_to_ada.c $(CC) $(CFLAGS_NORMAL) -c -o $@ $(srcdir)/c_varargs_to_ada.c +static_c_threaded_variables.o : $(srcdir)/c_threaded_variables.c + $(CC) $(CFLAGS_NORMAL) -c -o $@ $(srcdir)/c_threaded_variables.c + static_ncurses_compat.o : $(srcdir)/ncurses_compat.c $(CC) $(CFLAGS_NORMAL) -c -o $@ $(srcdir)/ncurses_compat.c ############################################################################### -@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) - -$(BUILD_DIR)/static-ali : ; mkdir -p $@ -$(BUILD_DIR)/static-obj : ; mkdir -p $@ - -STATIC_DIRS = \ - $(BUILD_DIR_LIB) \ - $(BUILD_DIR)/static-ali \ - $(BUILD_DIR)/static-obj - -@USE_GNAT_PROJECTS@$(BUILD_DIR_LIB)/$(STATIC_LIBNAME) :: \ -@USE_GNAT_PROJECTS@ $(ABASE)-trace.adb \ -@USE_GNAT_PROJECTS@ $(STATIC_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) - -uninstall \ -uninstall.libs :: - @rm -f $(ADA_OBJECTS)/$(STATIC_LIBNAME) - -@USE_GNAT_LIBRARIES@uninstall \ -@USE_GNAT_LIBRARIES@uninstall.libs :: -@USE_GNAT_LIBRARIES@ @$(SHELL) -c 'for name in $(BUILD_DIR)/static-ali/*.ali ; do rm -f $(ADA_OBJECTS)/`basename $$name`; done' +$(BUILD_DIR_LIB)/$(STATIC_LIBNAME) :: \ + $(BUILD_DIR_LIB) \ + $(STATIC_OBJS) + $(AR) $(ARFLAGS) $@ $(STATIC_OBJS) $(BUILD_DIR)/dynamic-ali : ; mkdir -p $@ $(BUILD_DIR)/dynamic-obj : ; mkdir -p $@ @@ -284,13 +250,29 @@ SHARED_DIRS = \ $(BUILD_DIR)/dynamic-ali \ $(BUILD_DIR)/dynamic-obj +GPR_EMPTY := +GPR_SPACE := $(GPR_EMPTY) $(GPR_EMPTY) +GPR_COMMA := , +GPR_LIST = ("$(subst $(GPR_SPACE),"$(GPR_COMMA) ",$(strip $(1)))") +$(GNAT_PROJECT) : $(GNAT_PROJECT).sed + sed \ + -e "s|External (\"BUILD_DIR\")|\"`cd $(BUILD_DIR);pwd`\"|" \ + -e 's/External ("LIB_NAME")/"$(LIB_NAME)"/' \ + -e 's/External ("SONAME")/"$(SONAME)"/' \ + -e 's/External_As_List\ ("ADAFLAGS", " ")/$(call GPR_LIST,$(ADAFLAGS))/' \ + -e 's/External_As_List\ ("LDFLAGS", " ")/$(call GPR_LIST,$(LDFLAGS))/' \ + $< > $@ +clean :: + rm -rf $(GNAT_PROJECT) + @MAKE_ADA_SHAREDLIB@all :: $(BUILD_DIR_LIB)/$(SHARED_LIBNAME) @MAKE_ADA_SHAREDLIB@$(BUILD_DIR_LIB)/$(SHARED_LIBNAME) :: \ +@MAKE_ADA_SHAREDLIB@ $(GNAT_PROJECT) \ @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 +@MAKE_ADA_SHAREDLIB@ $(ADAMAKE) -P$(GNAT_PROJECT) install \ install.libs :: $(ADA_INCLUDE) @@ -328,6 +310,6 @@ uninstall.libs :: @MAKE_ADA_SHAREDLIB@ rm -f $(LIBDIR)/$(SHARED_LIBNAME) clean :: - rm -rf $(BUILD_DIR)/*-ali - rm -rf $(BUILD_DIR)/*-obj + rm -rf $(BUILD_DIR)/dynamic-ali + rm -rf $(BUILD_DIR)/dynamic-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 00000000..bc58c46a --- /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 00000000..eac3e1b1 --- /dev/null +++ b/Ada95/src/c_threaded_variables.h @@ -0,0 +1,46 @@ +/**************************************************************************** + * 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. * + ****************************************************************************/ + +#ifndef __C_THREADED_VARIABLES_H +#define __C_THREADED_VARIABLES_H + +#include + +extern WINDOW *stdscr_as_function(void); +extern WINDOW *curscr_as_function(void); + +extern int LINES_as_function(void); +extern int LINES_as_function(void); +extern int COLS_as_function(void); +extern int TABSIZE_as_function(void); +extern int COLORS_as_function(void); +extern int COLOR_PAIRS_as_function(void); + +extern chtype acs_map_as_function(char /* index */ ); + +#endif /* __C_THREADED_VARIABLES_H */ diff --git a/Ada95/src/c_varargs_to_ada.c b/Ada95/src/c_varargs_to_ada.c index ed236ddc..f0b1bbef 100644 --- a/Ada95/src/c_varargs_to_ada.c +++ b/Ada95/src/c_varargs_to_ada.c @@ -1,5 +1,5 @@ /**************************************************************************** - * Copyright (c) 2011 Free Software Foundation, Inc. * + * Copyright (c) 2011,2014 Free Software Foundation, Inc. * * * * Permission is hereby granted, free of charge, to any person obtaining a * * copy of this software and associated documentation files (the * @@ -32,12 +32,12 @@ /* Version Control - $Id: c_varargs_to_ada.c,v 1.4 2011/03/19 19:07:39 tom Exp $ + $Id: c_varargs_to_ada.c,v 1.6 2014/05/24 21:32:18 tom Exp $ --------------------------------------------------------------------------*/ /* */ -#include +#include "c_varargs_to_ada.h" int set_field_type_alnum(FIELD *field, diff --git a/Ada95/src/library.gpr b/Ada95/src/library.gpr.sed similarity index 79% rename from Ada95/src/library.gpr rename to Ada95/src/library.gpr.sed index 33e4a3c7..28b0b1cd 100644 --- a/Ada95/src/library.gpr +++ b/Ada95/src/library.gpr.sed @@ -1,5 +1,5 @@ ------------------------------------------------------------------------------ --- Copyright (c) 2010,2011 Free Software Foundation, Inc. -- +-- 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 -- @@ -25,32 +25,32 @@ -- sale, use or other dealings in this Software without prior written -- -- authorization. -- ------------------------------------------------------------------------------ --- $Id: library.gpr,v 1.7 2011/03/18 23:10:28 Nicolas.Boulenguez Exp $ +-- $Id: library.gpr.sed,v 1.2 2014/05/24 21:28:29 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_Kind use "dynamic"; 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"); + for Object_Dir use Build_Dir & "/dynamic-obj"; + for Library_ALI_Dir use Build_Dir & "/dynamic-ali"; + for Source_Dirs use ("."); + for Library_Options use + External_As_List ("LDFLAGS", " ") -- before libraries. + & ("-lncurses", "-lpanel", "-lmenu", "-lform"); package Compiler is for Default_Switches ("Ada") use ("-g", "-O2", "-gnatafno", "-gnatVa", -- All validity checks - "-gnatwa"); -- Activate all optional errors + "-gnatwa") -- Activate all optional errors + & External_As_List ("ADAFLAGS", " "); -- after default options end Compiler; + + -- gnatmake ignores C sources, but this option will let it embed + -- objects found in the Object_Dir. for Languages use ("C", "Ada"); end Library; 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 94336201..9c614cac 100644 --- a/Ada95/src/terminal_interface-curses-forms-field_types-alpha.adb +++ b/Ada95/src/terminal_interface-curses-forms-field_types-alpha.adb @@ -7,7 +7,7 @@ -- B O D Y -- -- -- ------------------------------------------------------------------------------ --- Copyright (c) 1998-2009,2011 Free Software Foundation, Inc. -- +-- Copyright (c) 1998-2011,2014 Free Software Foundation, Inc. -- -- -- -- Permission is hereby granted, free of charge, to any person obtaining a -- -- copy of this software and associated documentation files (the -- @@ -35,8 +35,8 @@ ------------------------------------------------------------------------------ -- Author: Juergen Pfeifer, 1996 -- Version Control: --- $Revision: 1.11 $ --- $Date: 2011/03/19 00:45:37 $ +-- $Revision: 1.13 $ +-- $Date: 2014/05/24 21:31:05 $ -- Binding Version 01.00 ------------------------------------------------------------------------------ with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; @@ -47,15 +47,11 @@ package body Terminal_Interface.Curses.Forms.Field_Types.Alpha is Typ : Alpha_Field) is function Set_Fld_Type (F : Field := Fld; - Arg1 : C_Int) return C_Int; + Arg1 : C_Int) return Eti_Error; pragma Import (C, Set_Fld_Type, "set_field_type_alpha"); - Res : Eti_Error; begin - Res := Set_Fld_Type (Arg1 => C_Int (Typ.Minimum_Field_Width)); - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Fld_Type (Arg1 => C_Int (Typ.Minimum_Field_Width))); Wrap_Builtin (Fld, Typ); end Set_Field_Type; diff --git a/Ada95/src/terminal_interface-curses-forms-field_types-alphanumeric.adb b/Ada95/src/terminal_interface-curses-forms-field_types-alphanumeric.adb index 53f66801..270906d4 100644 --- a/Ada95/src/terminal_interface-curses-forms-field_types-alphanumeric.adb +++ b/Ada95/src/terminal_interface-curses-forms-field_types-alphanumeric.adb @@ -7,7 +7,7 @@ -- B O D Y -- -- -- ------------------------------------------------------------------------------ --- Copyright (c) 1998-2009,2011 Free Software Foundation, Inc. -- +-- Copyright (c) 1998-2011,2014 Free Software Foundation, Inc. -- -- -- -- Permission is hereby granted, free of charge, to any person obtaining a -- -- copy of this software and associated documentation files (the -- @@ -35,8 +35,8 @@ ------------------------------------------------------------------------------ -- Author: Juergen Pfeifer, 1996 -- Version Control: --- $Revision: 1.11 $ --- $Date: 2011/03/19 00:45:37 $ +-- $Revision: 1.13 $ +-- $Date: 2014/05/24 21:31:05 $ -- Binding Version 01.00 ------------------------------------------------------------------------------ with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; @@ -47,15 +47,11 @@ package body Terminal_Interface.Curses.Forms.Field_Types.AlphaNumeric is Typ : AlphaNumeric_Field) is function Set_Fld_Type (F : Field := Fld; - Arg1 : C_Int) return C_Int; + Arg1 : C_Int) return Eti_Error; pragma Import (C, Set_Fld_Type, "set_field_type_alnum"); - Res : Eti_Error; begin - Res := Set_Fld_Type (Arg1 => C_Int (Typ.Minimum_Field_Width)); - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Fld_Type (Arg1 => C_Int (Typ.Minimum_Field_Width))); Wrap_Builtin (Fld, Typ); end Set_Field_Type; diff --git a/Ada95/src/terminal_interface-curses-forms-field_types-enumeration.adb b/Ada95/src/terminal_interface-curses-forms-field_types-enumeration.adb index 12648e5a..8d4c9cee 100644 --- a/Ada95/src/terminal_interface-curses-forms-field_types-enumeration.adb +++ b/Ada95/src/terminal_interface-curses-forms-field_types-enumeration.adb @@ -7,7 +7,7 @@ -- B O D Y -- -- -- ------------------------------------------------------------------------------ --- Copyright (c) 1998-2009,2011 Free Software Foundation, Inc. -- +-- Copyright (c) 1998-2011,2014 Free Software Foundation, Inc. -- -- -- -- Permission is hereby granted, free of charge, to any person obtaining a -- -- copy of this software and associated documentation files (the -- @@ -35,7 +35,7 @@ ------------------------------------------------------------------------------ -- Author: Juergen Pfeifer, 1996 -- Version Control: --- $Revision: 1.10 $ +-- $Revision: 1.12 $ -- Binding Version 01.00 ------------------------------------------------------------------------------ with Ada.Unchecked_Deallocation; @@ -94,21 +94,18 @@ package body Terminal_Interface.Curses.Forms.Field_Types.Enumeration is function Set_Fld_Type (F : Field := Fld; Arg1 : chars_ptr_array; Arg2 : C_Int; - Arg3 : C_Int) return C_Int; + Arg3 : C_Int) return Eti_Error; pragma Import (C, Set_Fld_Type, "set_field_type_enum"); - Res : Eti_Error; begin if Typ.Arr = null then raise Form_Exception; end if; - Res := Set_Fld_Type (Arg1 => Typ.Arr.all, - Arg2 => C_Int (Boolean'Pos (Typ.Case_Sensitive)), - Arg3 => C_Int (Boolean'Pos - (Typ.Match_Must_Be_Unique))); - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception + (Set_Fld_Type + (Arg1 => Typ.Arr.all, + Arg2 => C_Int (Boolean'Pos (Typ.Case_Sensitive)), + Arg3 => C_Int (Boolean'Pos (Typ.Match_Must_Be_Unique)))); Wrap_Builtin (Fld, Typ, C_Choice_Router); end Set_Field_Type; diff --git a/Ada95/src/terminal_interface-curses-forms-field_types-intfield.adb b/Ada95/src/terminal_interface-curses-forms-field_types-intfield.adb index b6229bec..5ec33053 100644 --- a/Ada95/src/terminal_interface-curses-forms-field_types-intfield.adb +++ b/Ada95/src/terminal_interface-curses-forms-field_types-intfield.adb @@ -7,7 +7,7 @@ -- B O D Y -- -- -- ------------------------------------------------------------------------------ --- Copyright (c) 1998-2009,2011 Free Software Foundation, Inc. -- +-- Copyright (c) 1998-2011,2014 Free Software Foundation, Inc. -- -- -- -- Permission is hereby granted, free of charge, to any person obtaining a -- -- copy of this software and associated documentation files (the -- @@ -35,8 +35,8 @@ ------------------------------------------------------------------------------ -- Author: Juergen Pfeifer, 1996 -- Version Control: --- $Revision: 1.11 $ --- $Date: 2011/03/19 00:45:37 $ +-- $Revision: 1.13 $ +-- $Date: 2014/05/24 21:31:05 $ -- Binding Version 01.00 ------------------------------------------------------------------------------ with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; @@ -49,17 +49,13 @@ package body Terminal_Interface.Curses.Forms.Field_Types.IntField is function Set_Fld_Type (F : Field := Fld; Arg1 : C_Int; Arg2 : C_Long_Int; - Arg3 : C_Long_Int) return C_Int; + Arg3 : C_Long_Int) return Eti_Error; pragma Import (C, Set_Fld_Type, "set_field_type_integer"); - Res : Eti_Error; begin - Res := Set_Fld_Type (Arg1 => C_Int (Typ.Precision), - Arg2 => C_Long_Int (Typ.Lower_Limit), - Arg3 => C_Long_Int (Typ.Upper_Limit)); - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Fld_Type (Arg1 => C_Int (Typ.Precision), + Arg2 => C_Long_Int (Typ.Lower_Limit), + Arg3 => C_Long_Int (Typ.Upper_Limit))); Wrap_Builtin (Fld, Typ); end Set_Field_Type; diff --git a/Ada95/src/terminal_interface-curses-forms-field_types-ipv4_address.adb b/Ada95/src/terminal_interface-curses-forms-field_types-ipv4_address.adb index 66e05294..978a47a1 100644 --- a/Ada95/src/terminal_interface-curses-forms-field_types-ipv4_address.adb +++ b/Ada95/src/terminal_interface-curses-forms-field_types-ipv4_address.adb @@ -7,7 +7,7 @@ -- B O D Y -- -- -- ------------------------------------------------------------------------------ --- Copyright (c) 1998-2009,2011 Free Software Foundation, Inc. -- +-- Copyright (c) 1998-2011,2014 Free Software Foundation, Inc. -- -- -- -- Permission is hereby granted, free of charge, to any person obtaining a -- -- copy of this software and associated documentation files (the -- @@ -35,8 +35,8 @@ ------------------------------------------------------------------------------ -- Author: Juergen Pfeifer, 1996 -- Version Control: --- $Revision: 1.11 $ --- $Date: 2011/03/19 00:45:37 $ +-- $Revision: 1.13 $ +-- $Date: 2014/05/24 21:31:05 $ -- Binding Version 01.00 ------------------------------------------------------------------------------ with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; @@ -47,15 +47,11 @@ package body Terminal_Interface.Curses.Forms.Field_Types.IPV4_Address is Typ : Internet_V4_Address_Field) is function Set_Fld_Type (F : Field := Fld) - return C_Int; + return Eti_Error; pragma Import (C, Set_Fld_Type, "set_field_type_ipv4"); - Res : Eti_Error; begin - Res := Set_Fld_Type; - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Fld_Type); Wrap_Builtin (Fld, Typ); end Set_Field_Type; diff --git a/Ada95/src/terminal_interface-curses-forms-field_types-numeric.adb b/Ada95/src/terminal_interface-curses-forms-field_types-numeric.adb index b31dfa65..94e2aa70 100644 --- a/Ada95/src/terminal_interface-curses-forms-field_types-numeric.adb +++ b/Ada95/src/terminal_interface-curses-forms-field_types-numeric.adb @@ -7,7 +7,7 @@ -- B O D Y -- -- -- ------------------------------------------------------------------------------ --- Copyright (c) 1998-2009,2011 Free Software Foundation, Inc. -- +-- Copyright (c) 1998-2011,2014 Free Software Foundation, Inc. -- -- -- -- Permission is hereby granted, free of charge, to any person obtaining a -- -- copy of this software and associated documentation files (the -- @@ -35,8 +35,8 @@ ------------------------------------------------------------------------------ -- Author: Juergen Pfeifer, 1996 -- Version Control: --- $Revision: 1.12 $ --- $Date: 2011/03/19 00:45:37 $ +-- $Revision: 1.14 $ +-- $Date: 2014/05/24 21:31:05 $ -- Binding Version 01.00 ------------------------------------------------------------------------------ with Interfaces.C; @@ -52,17 +52,13 @@ package body Terminal_Interface.Curses.Forms.Field_Types.Numeric is function Set_Fld_Type (F : Field := Fld; Arg1 : C_Int; Arg2 : Double; - Arg3 : Double) return C_Int; + Arg3 : Double) return Eti_Error; pragma Import (C, Set_Fld_Type, "set_field_type_numeric"); - Res : Eti_Error; begin - Res := Set_Fld_Type (Arg1 => C_Int (Typ.Precision), - Arg2 => Double (Typ.Lower_Limit), - Arg3 => Double (Typ.Upper_Limit)); - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Fld_Type (Arg1 => C_Int (Typ.Precision), + Arg2 => Double (Typ.Lower_Limit), + Arg3 => Double (Typ.Upper_Limit))); Wrap_Builtin (Fld, Typ); end Set_Field_Type; diff --git a/Ada95/src/terminal_interface-curses-forms-field_types-regexp.adb b/Ada95/src/terminal_interface-curses-forms-field_types-regexp.adb index 55f02550..f5ea0db2 100644 --- a/Ada95/src/terminal_interface-curses-forms-field_types-regexp.adb +++ b/Ada95/src/terminal_interface-curses-forms-field_types-regexp.adb @@ -7,7 +7,7 @@ -- B O D Y -- -- -- ------------------------------------------------------------------------------ --- Copyright (c) 1998-2009,2011 Free Software Foundation, Inc. -- +-- Copyright (c) 1998-2011,2014 Free Software Foundation, Inc. -- -- -- -- Permission is hereby granted, free of charge, to any person obtaining a -- -- copy of this software and associated documentation files (the -- @@ -35,7 +35,7 @@ ------------------------------------------------------------------------------ -- Author: Juergen Pfeifer, 1996 -- Version Control: --- $Revision: 1.10 $ +-- $Revision: 1.12 $ -- Binding Version 01.00 ------------------------------------------------------------------------------ with Interfaces.C; use Interfaces.C; @@ -46,21 +46,12 @@ package body Terminal_Interface.Curses.Forms.Field_Types.RegExp is procedure Set_Field_Type (Fld : Field; Typ : Regular_Expression_Field) is - type Char_Ptr is access all Interfaces.C.char; - function Set_Ftyp (F : Field := Fld; - Arg1 : Char_Ptr) return C_Int; + Arg1 : char_array) return Eti_Error; pragma Import (C, Set_Ftyp, "set_field_type_regexp"); - Txt : char_array (0 .. Typ.Regular_Expression.all'Length); - Len : size_t; - Res : Eti_Error; begin - To_C (Typ.Regular_Expression.all, Txt, Len); - Res := Set_Ftyp (Arg1 => Txt (Txt'First)'Access); - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Ftyp (Arg1 => To_C (Typ.Regular_Expression.all))); Wrap_Builtin (Fld, Typ); end Set_Field_Type; diff --git a/Ada95/src/terminal_interface-curses-forms-field_types-user-choice.adb b/Ada95/src/terminal_interface-curses-forms-field_types-user-choice.adb index 3a7e6b5a..8414cd03 100644 --- a/Ada95/src/terminal_interface-curses-forms-field_types-user-choice.adb +++ b/Ada95/src/terminal_interface-curses-forms-field_types-user-choice.adb @@ -7,7 +7,7 @@ -- B O D Y -- -- -- ------------------------------------------------------------------------------ --- Copyright (c) 1998-2008,2011 Free Software Foundation, Inc. -- +-- Copyright (c) 1998-2011,2014 Free Software Foundation, Inc. -- -- -- -- Permission is hereby granted, free of charge, to any person obtaining a -- -- copy of this software and associated documentation files (the -- @@ -35,8 +35,8 @@ ------------------------------------------------------------------------------ -- Author: Juergen Pfeifer, 1996 -- Version Control: --- $Revision: 1.17 $ --- $Date: 2011/03/22 10:53:37 $ +-- $Revision: 1.20 $ +-- $Date: 2014/05/24 21:31:05 $ -- Binding Version 01.00 ------------------------------------------------------------------------------ with System.Address_To_Access_Conversions; @@ -53,7 +53,7 @@ package body Terminal_Interface.Curses.Forms.Field_Types.User.Choice is Result : Boolean; Udf : constant User_Defined_Field_Type_With_Choice_Access := User_Defined_Field_Type_With_Choice_Access - (Argument_Access (Argument_Conversions.To_Pointer (Usr)).Typ); + (Argument_Access (Argument_Conversions.To_Pointer (Usr)).all.Typ); begin Result := Next (Fld, Udf.all); return Curses_Bool (Boolean'Pos (Result)); @@ -65,7 +65,7 @@ package body Terminal_Interface.Curses.Forms.Field_Types.User.Choice is Result : Boolean; Udf : constant User_Defined_Field_Type_With_Choice_Access := User_Defined_Field_Type_With_Choice_Access - (Argument_Access (Argument_Conversions.To_Pointer (Usr)).Typ); + (Argument_Access (Argument_Conversions.To_Pointer (Usr)).all.Typ); begin Result := Previous (Fld, Udf.all); return Curses_Bool (Boolean'Pos (Result)); @@ -88,16 +88,12 @@ package body Terminal_Interface.Curses.Forms.Field_Types.User.Choice is Make_Arg'Access, Copy_Arg'Access, Free_Arg'Access); - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Res); Res := Set_Fieldtype_Choice (T, Generic_Next'Access, Generic_Prev'Access); - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Res); end if; M_Generic_Choice := T; end if; diff --git a/Ada95/src/terminal_interface-curses-forms-field_types-user.adb b/Ada95/src/terminal_interface-curses-forms-field_types-user.adb index 2dd295db..98bcd244 100644 --- a/Ada95/src/terminal_interface-curses-forms-field_types-user.adb +++ b/Ada95/src/terminal_interface-curses-forms-field_types-user.adb @@ -7,7 +7,7 @@ -- B O D Y -- -- -- ------------------------------------------------------------------------------ --- Copyright (c) 1998-2009,2011 Free Software Foundation, Inc. -- +-- Copyright (c) 1998-2011,2014 Free Software Foundation, Inc. -- -- -- -- Permission is hereby granted, free of charge, to any person obtaining a -- -- copy of this software and associated documentation files (the -- @@ -35,8 +35,8 @@ ------------------------------------------------------------------------------ -- Author: Juergen Pfeifer, 1996 -- Version Control: --- $Revision: 1.21 $ --- $Date: 2011/03/23 00:44:58 $ +-- $Revision: 1.23 $ +-- $Date: 2014/05/24 21:31:05 $ -- Binding Version 01.00 ------------------------------------------------------------------------------ with System.Address_To_Access_Conversions; @@ -53,11 +53,9 @@ package body Terminal_Interface.Curses.Forms.Field_Types.User is function Set_Fld_Type (F : Field := Fld; Cft : C_Field_Type := C_Generic_Type; Arg1 : Argument_Access) - return C_Int; + return Eti_Error; pragma Import (C, Set_Fld_Type, "set_field_type_user"); - Res : Eti_Error; - function Allocate_Arg (T : User_Defined_Field_Type'Class) return Argument_Access is @@ -70,10 +68,7 @@ package body Terminal_Interface.Curses.Forms.Field_Types.User is end Allocate_Arg; begin - Res := Set_Fld_Type (Arg1 => Allocate_Arg (Typ)); - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Fld_Type (Arg1 => Allocate_Arg (Typ))); end Set_Field_Type; package Argument_Conversions is @@ -120,9 +115,7 @@ package body Terminal_Interface.Curses.Forms.Field_Types.User is Make_Arg'Access, Copy_Arg'Access, Free_Arg'Access); - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Res); end if; M_Generic_Type := T; end if; diff --git a/Ada95/src/terminal_interface-curses-forms-field_types.adb b/Ada95/src/terminal_interface-curses-forms-field_types.adb index 5195a20a..99ee3741 100644 --- a/Ada95/src/terminal_interface-curses-forms-field_types.adb +++ b/Ada95/src/terminal_interface-curses-forms-field_types.adb @@ -7,7 +7,7 @@ -- B O D Y -- -- -- ------------------------------------------------------------------------------ --- Copyright (c) 1998-2009,2011 Free Software Foundation, Inc. -- +-- Copyright (c) 1998-2011,2014 Free Software Foundation, Inc. -- -- -- -- Permission is hereby granted, free of charge, to any person obtaining a -- -- copy of this software and associated documentation files (the -- @@ -35,8 +35,8 @@ ------------------------------------------------------------------------------ -- Author: Juergen Pfeifer, 1996 -- Version Control: --- $Revision: 1.25 $ --- $Date: 2011/03/22 23:22:27 $ +-- $Revision: 1.27 $ +-- $Date: 2014/05/24 21:31:05 $ -- Binding Version 01.00 ------------------------------------------------------------------------------ with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; @@ -130,10 +130,9 @@ package body Terminal_Interface.Curses.Forms.Field_Types is Usr_Arg : constant System.Address := Get_Arg (Fld); Low_Level : constant C_Field_Type := Get_Fieldtype (Fld); Arg : Argument_Access; - Res : Eti_Error; function Set_Fld_Type (F : Field := Fld; Cf : C_Field_Type := Cft; - Arg1 : Argument_Access) return C_Int; + Arg1 : Argument_Access) return Eti_Error; pragma Import (C, Set_Fld_Type, "set_field_type_user"); begin @@ -152,10 +151,7 @@ package body Terminal_Interface.Curses.Forms.Field_Types is end if; end if; - Res := Set_Fld_Type (Arg1 => Arg); - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Fld_Type (Arg1 => Arg)); end if; end Wrap_Builtin; @@ -223,7 +219,6 @@ package body Terminal_Interface.Curses.Forms.Field_Types is -- function C_Builtin_Router return C_Field_Type is - Res : Eti_Error; T : C_Field_Type; begin if M_Builtin_Router = Null_Field_Type then @@ -232,13 +227,10 @@ package body Terminal_Interface.Curses.Forms.Field_Types is if T = Null_Field_Type then raise Form_Exception; else - Res := Set_Fieldtype_Arg (T, - Make_Arg'Access, - Copy_Arg'Access, - Free_Arg'Access); - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Fieldtype_Arg (T, + Make_Arg'Access, + Copy_Arg'Access, + Free_Arg'Access)); end if; M_Builtin_Router := T; end if; @@ -250,7 +242,6 @@ package body Terminal_Interface.Curses.Forms.Field_Types is -- function C_Choice_Router return C_Field_Type is - Res : Eti_Error; T : C_Field_Type; begin if M_Choice_Router = Null_Field_Type then @@ -259,20 +250,14 @@ package body Terminal_Interface.Curses.Forms.Field_Types is if T = Null_Field_Type then raise Form_Exception; else - Res := Set_Fieldtype_Arg (T, - Make_Arg'Access, - Copy_Arg'Access, - Free_Arg'Access); - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Fieldtype_Arg (T, + Make_Arg'Access, + Copy_Arg'Access, + Free_Arg'Access)); - Res := Set_Fieldtype_Choice (T, - Next_Router'Access, - Prev_Router'Access); - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Fieldtype_Choice (T, + Next_Router'Access, + Prev_Router'Access)); end if; M_Choice_Router := T; end if; diff --git a/Ada95/src/terminal_interface-curses-forms-field_user_data.adb b/Ada95/src/terminal_interface-curses-forms-field_user_data.adb index 96178d8a..24976147 100644 --- a/Ada95/src/terminal_interface-curses-forms-field_user_data.adb +++ b/Ada95/src/terminal_interface-curses-forms-field_user_data.adb @@ -7,7 +7,7 @@ -- B O D Y -- -- -- ------------------------------------------------------------------------------ --- Copyright (c) 1998-2003,2009 Free Software Foundation, Inc. -- +-- Copyright (c) 1998-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.13 $ +-- $Revision: 1.15 $ -- Binding Version 01.00 ------------------------------------------------------------------------------ with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; @@ -55,14 +55,11 @@ package body Terminal_Interface.Curses.Forms.Field_User_Data is Data : User_Access) is function Set_Field_Userptr (Fld : Field; - Usr : User_Access) return C_Int; + Usr : User_Access) return Eti_Error; pragma Import (C, Set_Field_Userptr, "set_field_userptr"); - Res : constant Eti_Error := Set_Field_Userptr (Fld, Data); begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Field_Userptr (Fld, Data)); end Set_User_Data; -- | -- | diff --git a/Ada95/src/terminal_interface-curses-forms-form_user_data.adb b/Ada95/src/terminal_interface-curses-forms-form_user_data.adb index 84353eb5..a8b74643 100644 --- a/Ada95/src/terminal_interface-curses-forms-form_user_data.adb +++ b/Ada95/src/terminal_interface-curses-forms-form_user_data.adb @@ -7,7 +7,7 @@ -- B O D Y -- -- -- ------------------------------------------------------------------------------ --- Copyright (c) 1998-2003,2009 Free Software Foundation, Inc. -- +-- Copyright (c) 1998-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.13 $ +-- $Revision: 1.15 $ -- Binding Version 01.00 ------------------------------------------------------------------------------ -- | @@ -56,14 +56,11 @@ package body Terminal_Interface.Curses.Forms.Form_User_Data is Data : User_Access) is function Set_Form_Userptr (Frm : Form; - Data : User_Access) return C_Int; + Data : User_Access) return Eti_Error; pragma Import (C, Set_Form_Userptr, "set_form_userptr"); - Res : constant Eti_Error := Set_Form_Userptr (Frm, Data); begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Form_Userptr (Frm, Data)); end Set_User_Data; -- | -- | diff --git a/Ada95/src/terminal_interface-curses-forms.adb b/Ada95/src/terminal_interface-curses-forms.adb index 915ed584..3ed053ae 100644 --- a/Ada95/src/terminal_interface-curses-forms.adb +++ b/Ada95/src/terminal_interface-curses-forms.adb @@ -7,7 +7,7 @@ -- B O D Y -- -- -- ------------------------------------------------------------------------------ --- Copyright (c) 1998-2009,2011 Free Software Foundation, Inc. -- +-- Copyright (c) 1998-2011,2014 Free Software Foundation, Inc. -- -- -- -- Permission is hereby granted, free of charge, to any person obtaining a -- -- copy of this software and associated documentation files (the -- @@ -35,12 +35,11 @@ ------------------------------------------------------------------------------ -- Author: Juergen Pfeifer, 1996 -- Version Control: --- $Revision: 1.28 $ --- $Date: 2011/03/22 23:37:32 $ +-- $Revision: 1.32 $ +-- $Date: 2014/05/24 21:31:05 $ -- Binding Version 01.00 ------------------------------------------------------------------------------ with Ada.Unchecked_Deallocation; -with Ada.Unchecked_Conversion; with Interfaces.C; use Interfaces.C; with Interfaces.C.Strings; use Interfaces.C.Strings; @@ -62,22 +61,6 @@ package body Terminal_Interface.Curses.Forms is -- | -- subtype chars_ptr is Interfaces.C.Strings.chars_ptr; - function FOS_2_CInt is new - Ada.Unchecked_Conversion (Field_Option_Set, - C_Int); - - function CInt_2_FOS is new - Ada.Unchecked_Conversion (C_Int, - Field_Option_Set); - - function FrmOS_2_CInt is new - Ada.Unchecked_Conversion (Form_Option_Set, - C_Int); - - function CInt_2_FrmOS is new - Ada.Unchecked_Conversion (C_Int, - Form_Option_Set); - procedure Request_Name (Key : Form_Request_Code; Name : out String) is @@ -130,15 +113,11 @@ package body Terminal_Interface.Curses.Forms is -- | procedure Delete (Fld : in out Field) is - function Free_Field (Fld : Field) return C_Int; + function Free_Field (Fld : Field) return Eti_Error; pragma Import (C, Free_Field, "free_field"); - Res : Eti_Error; begin - Res := Free_Field (Fld); - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Free_Field (Fld)); Fld := Null_Field; end Delete; -- | @@ -194,16 +173,12 @@ package body Terminal_Interface.Curses.Forms is Just : Field_Justification := None) is function Set_Field_Just (Fld : Field; - Just : C_Int) return C_Int; + Just : C_Int) return Eti_Error; pragma Import (C, Set_Field_Just, "set_field_just"); - Res : constant Eti_Error := - Set_Field_Just (Fld, - C_Int (Field_Justification'Pos (Just))); begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Field_Just (Fld, + C_Int (Field_Justification'Pos (Just)))); end Set_Justification; -- | -- | @@ -227,22 +202,14 @@ package body Terminal_Interface.Curses.Forms is Buffer : Buffer_Number := Buffer_Number'First; Str : String) is - type Char_Ptr is access all Interfaces.C.char; function Set_Fld_Buffer (Fld : Field; Bufnum : C_Int; - S : Char_Ptr) - return C_Int; + S : char_array) + return Eti_Error; pragma Import (C, Set_Fld_Buffer, "set_field_buffer"); - Txt : char_array (0 .. Str'Length); - Len : size_t; - Res : Eti_Error; begin - To_C (Str, Txt, Len); - Res := Set_Fld_Buffer (Fld, C_Int (Buffer), Txt (Txt'First)'Access); - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Fld_Buffer (Fld, C_Int (Buffer), To_C (Str))); end Set_Buffer; -- | -- | @@ -276,12 +243,11 @@ package body Terminal_Interface.Curses.Forms is Status : Boolean := True) is function Set_Fld_Status (Fld : Field; - St : C_Int) return C_Int; + St : C_Int) return Eti_Error; pragma Import (C, Set_Fld_Status, "set_field_status"); - Res : constant Eti_Error := Set_Fld_Status (Fld, Boolean'Pos (Status)); begin - if Res /= E_Ok then + if Set_Fld_Status (Fld, Boolean'Pos (Status)) /= E_Ok then raise Form_Exception; end if; end Set_Status; @@ -308,14 +274,11 @@ package body Terminal_Interface.Curses.Forms is Max : Natural := 0) is function Set_Field_Max (Fld : Field; - M : C_Int) return C_Int; + M : C_Int) return Eti_Error; pragma Import (C, Set_Field_Max, "set_max_field"); - Res : constant Eti_Error := Set_Field_Max (Fld, C_Int (Max)); begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Field_Max (Fld, C_Int (Max))); end Set_Maximum_Size; -- | -- |===================================================================== @@ -328,16 +291,11 @@ package body Terminal_Interface.Curses.Forms is Options : Field_Option_Set) is function Set_Field_Opts (Fld : Field; - Opt : C_Int) return C_Int; + Opt : Field_Option_Set) return Eti_Error; pragma Import (C, Set_Field_Opts, "set_field_opts"); - Opt : constant C_Int := FOS_2_CInt (Options); - Res : Eti_Error; begin - Res := Set_Field_Opts (Fld, Opt); - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Field_Opts (Fld, Options)); end Set_Options; -- | -- | @@ -347,22 +305,17 @@ package body Terminal_Interface.Curses.Forms is On : Boolean := True) is function Field_Opts_On (Fld : Field; - Opt : C_Int) return C_Int; + Opt : Field_Option_Set) return Eti_Error; pragma Import (C, Field_Opts_On, "field_opts_on"); function Field_Opts_Off (Fld : Field; - Opt : C_Int) return C_Int; + Opt : Field_Option_Set) return Eti_Error; pragma Import (C, Field_Opts_Off, "field_opts_off"); - Err : Eti_Error; - Opt : constant C_Int := FOS_2_CInt (Options); begin if On then - Err := Field_Opts_On (Fld, Opt); + Eti_Exception (Field_Opts_On (Fld, Options)); else - Err := Field_Opts_Off (Fld, Opt); - end if; - if Err /= E_Ok then - Eti_Exception (Err); + Eti_Exception (Field_Opts_Off (Fld, Options)); end if; end Switch_Options; -- | @@ -371,12 +324,11 @@ package body Terminal_Interface.Curses.Forms is procedure Get_Options (Fld : Field; Options : out Field_Option_Set) is - function Field_Opts (Fld : Field) return C_Int; + function Field_Opts (Fld : Field) return Field_Option_Set; pragma Import (C, Field_Opts, "field_opts"); - Res : constant C_Int := Field_Opts (Fld); begin - Options := CInt_2_FOS (Res); + Options := Field_Opts (Fld); end Get_Options; -- | -- | @@ -402,18 +354,13 @@ package body Terminal_Interface.Curses.Forms is Color : Color_Pair := Color_Pair'First) is function Set_Field_Fore (Fld : Field; - Attr : C_Chtype) return C_Int; + Attr : Attributed_Character) return Eti_Error; pragma Import (C, Set_Field_Fore, "set_field_fore"); - Ch : constant Attributed_Character := (Ch => Character'First, - Color => Color, - Attr => Fore); - Res : constant Eti_Error := - Set_Field_Fore (Fld, AttrChar_To_Chtype (Ch)); begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Field_Fore (Fld, (Ch => Character'First, + Color => Color, + Attr => Fore))); end Set_Foreground; -- | -- | @@ -421,21 +368,21 @@ package body Terminal_Interface.Curses.Forms is procedure Foreground (Fld : Field; Fore : out Character_Attribute_Set) is - function Field_Fore (Fld : Field) return C_Chtype; + function Field_Fore (Fld : Field) return Attributed_Character; pragma Import (C, Field_Fore, "field_fore"); begin - Fore := Chtype_To_AttrChar (Field_Fore (Fld)).Attr; + Fore := Field_Fore (Fld).Attr; end Foreground; procedure Foreground (Fld : Field; Fore : out Character_Attribute_Set; Color : out Color_Pair) is - function Field_Fore (Fld : Field) return C_Chtype; + function Field_Fore (Fld : Field) return Attributed_Character; pragma Import (C, Field_Fore, "field_fore"); begin - Fore := Chtype_To_AttrChar (Field_Fore (Fld)).Attr; - Color := Chtype_To_AttrChar (Field_Fore (Fld)).Color; + Fore := Field_Fore (Fld).Attr; + Color := Field_Fore (Fld).Color; end Foreground; -- | -- | @@ -446,18 +393,13 @@ package body Terminal_Interface.Curses.Forms is Color : Color_Pair := Color_Pair'First) is function Set_Field_Back (Fld : Field; - Attr : C_Chtype) return C_Int; + Attr : Attributed_Character) return Eti_Error; pragma Import (C, Set_Field_Back, "set_field_back"); - Ch : constant Attributed_Character := (Ch => Character'First, - Color => Color, - Attr => Back); - Res : constant Eti_Error := - Set_Field_Back (Fld, AttrChar_To_Chtype (Ch)); begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Field_Back (Fld, (Ch => Character'First, + Color => Color, + Attr => Back))); end Set_Background; -- | -- | @@ -465,21 +407,21 @@ package body Terminal_Interface.Curses.Forms is procedure Background (Fld : Field; Back : out Character_Attribute_Set) is - function Field_Back (Fld : Field) return C_Chtype; + function Field_Back (Fld : Field) return Attributed_Character; pragma Import (C, Field_Back, "field_back"); begin - Back := Chtype_To_AttrChar (Field_Back (Fld)).Attr; + Back := Field_Back (Fld).Attr; end Background; procedure Background (Fld : Field; Back : out Character_Attribute_Set; Color : out Color_Pair) is - function Field_Back (Fld : Field) return C_Chtype; + function Field_Back (Fld : Field) return Attributed_Character; pragma Import (C, Field_Back, "field_back"); begin - Back := Chtype_To_AttrChar (Field_Back (Fld)).Attr; - Color := Chtype_To_AttrChar (Field_Back (Fld)).Color; + Back := Field_Back (Fld).Attr; + Color := Field_Back (Fld).Color; end Background; -- | -- | @@ -488,15 +430,12 @@ package body Terminal_Interface.Curses.Forms is Pad : Character := Space) is function Set_Field_Pad (Fld : Field; - Ch : C_Int) return C_Int; + Ch : C_Int) return Eti_Error; pragma Import (C, Set_Field_Pad, "set_field_pad"); - Res : constant Eti_Error := Set_Field_Pad (Fld, - C_Int (Character'Pos (Pad))); begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Field_Pad (Fld, + C_Int (Character'Pos (Pad)))); end Set_Pad_Character; -- | -- | @@ -527,25 +466,21 @@ package body Terminal_Interface.Curses.Forms is type C_Int_Access is access all C_Int; function Fld_Info (Fld : Field; L, C, Fr, Fc, Os, Ab : C_Int_Access) - return C_Int; + return Eti_Error; pragma Import (C, Fld_Info, "field_info"); L, C, Fr, Fc, Os, Ab : aliased C_Int; - Res : constant Eti_Error := Fld_Info (Fld, - L'Access, C'Access, - Fr'Access, Fc'Access, - Os'Access, Ab'Access); begin - if Res /= E_Ok then - Eti_Exception (Res); - else - Lines := Line_Count (L); - Columns := Column_Count (C); - First_Row := Line_Position (Fr); - First_Column := Column_Position (Fc); - Off_Screen := Natural (Os); - Additional_Buffers := Buffer_Number (Ab); - end if; + Eti_Exception (Fld_Info (Fld, + L'Access, C'Access, + Fr'Access, Fc'Access, + Os'Access, Ab'Access)); + Lines := Line_Count (L); + Columns := Column_Count (C); + First_Row := Line_Position (Fr); + First_Column := Column_Position (Fc); + Off_Screen := Natural (Os); + Additional_Buffers := Buffer_Number (Ab); end Info; -- | -- | @@ -556,21 +491,17 @@ package body Terminal_Interface.Curses.Forms is Max : out Natural) is type C_Int_Access is access all C_Int; - function Dyn_Info (Fld : Field; L, C, M : C_Int_Access) return C_Int; + function Dyn_Info (Fld : Field; L, C, M : C_Int_Access) return Eti_Error; pragma Import (C, Dyn_Info, "dynamic_field_info"); L, C, M : aliased C_Int; - Res : constant Eti_Error := Dyn_Info (Fld, - L'Access, C'Access, - M'Access); begin - if Res /= E_Ok then - Eti_Exception (Res); - else - Lines := Line_Count (L); - Columns := Column_Count (C); - Max := Natural (M); - end if; + Eti_Exception (Dyn_Info (Fld, + L'Access, C'Access, + M'Access)); + Lines := Line_Count (L); + Columns := Column_Count (C); + Max := Natural (M); end Dynamic_Info; -- | -- |===================================================================== @@ -583,14 +514,11 @@ package body Terminal_Interface.Curses.Forms is Win : Window) is function Set_Form_Win (Frm : Form; - Win : Window) return C_Int; + Win : Window) return Eti_Error; pragma Import (C, Set_Form_Win, "set_form_win"); - Res : constant Eti_Error := Set_Form_Win (Frm, Win); begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Form_Win (Frm, Win)); end Set_Window; -- | -- | @@ -611,14 +539,11 @@ package body Terminal_Interface.Curses.Forms is Win : Window) is function Set_Form_Sub (Frm : Form; - Win : Window) return C_Int; + Win : Window) return Eti_Error; pragma Import (C, Set_Form_Sub, "set_form_sub"); - Res : constant Eti_Error := Set_Form_Sub (Frm, Win); begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Form_Sub (Frm, Win)); end Set_Sub_Window; -- | -- | @@ -640,16 +565,13 @@ package body Terminal_Interface.Curses.Forms is Columns : out Column_Count) is type C_Int_Access is access all C_Int; - function M_Scale (Frm : Form; Yp, Xp : C_Int_Access) return C_Int; + function M_Scale (Frm : Form; Yp, Xp : C_Int_Access) return Eti_Error; pragma Import (C, M_Scale, "scale_form"); X, Y : aliased C_Int; - Res : constant Eti_Error := M_Scale (Frm, Y'Access, X'Access); begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; - Lines := Line_Count (Y); + Eti_Exception (M_Scale (Frm, Y'Access, X'Access)); + Lines := Line_Count (Y); Columns := Column_Count (X); end Scale; -- | @@ -663,14 +585,11 @@ package body Terminal_Interface.Curses.Forms is Proc : Form_Hook_Function) is function Set_Field_Init (Frm : Form; - Proc : Form_Hook_Function) return C_Int; + Proc : Form_Hook_Function) return Eti_Error; pragma Import (C, Set_Field_Init, "set_field_init"); - Res : constant Eti_Error := Set_Field_Init (Frm, Proc); begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Field_Init (Frm, Proc)); end Set_Field_Init_Hook; -- | -- | @@ -679,14 +598,11 @@ package body Terminal_Interface.Curses.Forms is Proc : Form_Hook_Function) is function Set_Field_Term (Frm : Form; - Proc : Form_Hook_Function) return C_Int; + Proc : Form_Hook_Function) return Eti_Error; pragma Import (C, Set_Field_Term, "set_field_term"); - Res : constant Eti_Error := Set_Field_Term (Frm, Proc); begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Field_Term (Frm, Proc)); end Set_Field_Term_Hook; -- | -- | @@ -695,14 +611,11 @@ package body Terminal_Interface.Curses.Forms is Proc : Form_Hook_Function) is function Set_Form_Init (Frm : Form; - Proc : Form_Hook_Function) return C_Int; + Proc : Form_Hook_Function) return Eti_Error; pragma Import (C, Set_Form_Init, "set_form_init"); - Res : constant Eti_Error := Set_Form_Init (Frm, Proc); begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Form_Init (Frm, Proc)); end Set_Form_Init_Hook; -- | -- | @@ -711,14 +624,11 @@ package body Terminal_Interface.Curses.Forms is Proc : Form_Hook_Function) is function Set_Form_Term (Frm : Form; - Proc : Form_Hook_Function) return C_Int; + Proc : Form_Hook_Function) return Eti_Error; pragma Import (C, Set_Form_Term, "set_form_term"); - Res : constant Eti_Error := Set_Form_Term (Frm, Proc); begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Form_Term (Frm, Proc)); end Set_Form_Term_Hook; -- | -- |===================================================================== @@ -731,19 +641,15 @@ package body Terminal_Interface.Curses.Forms is Flds : Field_Array_Access) is function Set_Frm_Fields (Frm : Form; - Items : System.Address) return C_Int; + Items : System.Address) return Eti_Error; pragma Import (C, Set_Frm_Fields, "set_form_fields"); - Res : Eti_Error; begin pragma Assert (Flds.all (Flds'Last) = Null_Field); if Flds.all (Flds'Last) /= Null_Field then raise Form_Exception; else - Res := Set_Frm_Fields (Frm, Flds.all (Flds'First)'Address); - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Frm_Fields (Frm, Flds.all (Flds'First)'Address)); end if; end Redefine; -- | @@ -783,14 +689,11 @@ package body Terminal_Interface.Curses.Forms is Line : Line_Position; Column : Column_Position) is - function Move (Fld : Field; L, C : C_Int) return C_Int; + function Move (Fld : Field; L, C : C_Int) return Eti_Error; pragma Import (C, Move, "move_field"); - Res : constant Eti_Error := Move (Fld, C_Int (Line), C_Int (Column)); begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Move (Fld, C_Int (Line), C_Int (Column))); end Move; -- | -- |===================================================================== @@ -822,14 +725,11 @@ package body Terminal_Interface.Curses.Forms is -- | procedure Delete (Frm : in out Form) is - function Free (Frm : Form) return C_Int; + function Free (Frm : Form) return Eti_Error; pragma Import (C, Free, "free_form"); - Res : constant Eti_Error := Free (Frm); begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Free (Frm)); Frm := Null_Form; end Delete; -- | @@ -843,16 +743,11 @@ package body Terminal_Interface.Curses.Forms is Options : Form_Option_Set) is function Set_Form_Opts (Frm : Form; - Opt : C_Int) return C_Int; + Opt : Form_Option_Set) return Eti_Error; pragma Import (C, Set_Form_Opts, "set_form_opts"); - Opt : constant C_Int := FrmOS_2_CInt (Options); - Res : Eti_Error; begin - Res := Set_Form_Opts (Frm, Opt); - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Form_Opts (Frm, Options)); end Set_Options; -- | -- | @@ -862,22 +757,17 @@ package body Terminal_Interface.Curses.Forms is On : Boolean := True) is function Form_Opts_On (Frm : Form; - Opt : C_Int) return C_Int; + Opt : Form_Option_Set) return Eti_Error; pragma Import (C, Form_Opts_On, "form_opts_on"); function Form_Opts_Off (Frm : Form; - Opt : C_Int) return C_Int; + Opt : Form_Option_Set) return Eti_Error; pragma Import (C, Form_Opts_Off, "form_opts_off"); - Err : Eti_Error; - Opt : constant C_Int := FrmOS_2_CInt (Options); begin if On then - Err := Form_Opts_On (Frm, Opt); + Eti_Exception (Form_Opts_On (Frm, Options)); else - Err := Form_Opts_Off (Frm, Opt); - end if; - if Err /= E_Ok then - Eti_Exception (Err); + Eti_Exception (Form_Opts_Off (Frm, Options)); end if; end Switch_Options; -- | @@ -886,12 +776,11 @@ package body Terminal_Interface.Curses.Forms is procedure Get_Options (Frm : Form; Options : out Form_Option_Set) is - function Form_Opts (Frm : Form) return C_Int; + function Form_Opts (Frm : Form) return Form_Option_Set; pragma Import (C, Form_Opts, "form_opts"); - Res : constant C_Int := Form_Opts (Frm); begin - Options := CInt_2_FrmOS (Res); + Options := Form_Opts (Frm); end Get_Options; -- | -- | @@ -913,20 +802,16 @@ package body Terminal_Interface.Curses.Forms is procedure Post (Frm : Form; Post : Boolean := True) is - function M_Post (Frm : Form) return C_Int; + function M_Post (Frm : Form) return Eti_Error; pragma Import (C, M_Post, "post_form"); - function M_Unpost (Frm : Form) return C_Int; + function M_Unpost (Frm : Form) return Eti_Error; pragma Import (C, M_Unpost, "unpost_form"); - Res : Eti_Error; begin if Post then - Res := M_Post (Frm); + Eti_Exception (M_Post (Frm)); else - Res := M_Unpost (Frm); - end if; - if Res /= E_Ok then - Eti_Exception (Res); + Eti_Exception (M_Unpost (Frm)); end if; end Post; -- | @@ -938,14 +823,11 @@ package body Terminal_Interface.Curses.Forms is -- | procedure Position_Cursor (Frm : Form) is - function Pos_Form_Cursor (Frm : Form) return C_Int; + function Pos_Form_Cursor (Frm : Form) return Eti_Error; pragma Import (C, Pos_Form_Cursor, "pos_form_cursor"); - Res : constant Eti_Error := Pos_Form_Cursor (Frm); begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Pos_Form_Cursor (Frm)); end Position_Cursor; -- | -- |===================================================================== @@ -993,25 +875,22 @@ package body Terminal_Interface.Curses.Forms is function Driver (Frm : Form; Key : Key_Code) return Driver_Result is - function Frm_Driver (Frm : Form; Key : C_Int) return C_Int; + function Frm_Driver (Frm : Form; Key : C_Int) return Eti_Error; pragma Import (C, Frm_Driver, "form_driver"); R : constant Eti_Error := Frm_Driver (Frm, C_Int (Key)); begin - if R /= E_Ok then - if R = E_Unknown_Command then + case R is + when E_Unknown_Command => return Unknown_Request; - elsif R = E_Invalid_Field then + when E_Invalid_Field => return Invalid_Field; - elsif R = E_Request_Denied then + when E_Request_Denied => return Request_Denied; - else + when others => Eti_Exception (R); return Form_Ok; - end if; - else - return Form_Ok; - end if; + end case; end Driver; -- | -- |===================================================================== @@ -1023,14 +902,11 @@ package body Terminal_Interface.Curses.Forms is procedure Set_Current (Frm : Form; Fld : Field) is - function Set_Current_Fld (Frm : Form; Fld : Field) return C_Int; + function Set_Current_Fld (Frm : Form; Fld : Field) return Eti_Error; pragma Import (C, Set_Current_Fld, "set_current_field"); - Res : constant Eti_Error := Set_Current_Fld (Frm, Fld); begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Current_Fld (Frm, Fld)); end Set_Current; -- | -- | @@ -1053,14 +929,11 @@ package body Terminal_Interface.Curses.Forms is procedure Set_Page (Frm : Form; Page : Page_Number := Page_Number'First) is - function Set_Frm_Page (Frm : Form; Pg : C_Int) return C_Int; + function Set_Frm_Page (Frm : Form; Pg : C_Int) return Eti_Error; pragma Import (C, Set_Frm_Page, "set_form_page"); - Res : constant Eti_Error := Set_Frm_Page (Frm, C_Int (Page)); begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Frm_Page (Frm, C_Int (Page))); end Set_Page; -- | -- | @@ -1102,14 +975,11 @@ package body Terminal_Interface.Curses.Forms is procedure Set_New_Page (Fld : Field; New_Page : Boolean := True) is - function Set_Page (Fld : Field; Flg : C_Int) return C_Int; + function Set_Page (Fld : Field; Flg : C_Int) return Eti_Error; pragma Import (C, Set_Page, "set_new_page"); - Res : constant Eti_Error := Set_Page (Fld, Boolean'Pos (New_Page)); begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Page (Fld, Boolean'Pos (New_Page))); end Set_New_Page; -- | -- | diff --git a/Ada95/src/terminal_interface-curses-menus-item_user_data.adb b/Ada95/src/terminal_interface-curses-menus-item_user_data.adb index eb06d096..da26f80f 100644 --- a/Ada95/src/terminal_interface-curses-menus-item_user_data.adb +++ b/Ada95/src/terminal_interface-curses-menus-item_user_data.adb @@ -7,7 +7,7 @@ -- B O D Y -- -- -- ------------------------------------------------------------------------------ --- Copyright (c) 1998-2003,2009 Free Software Foundation, Inc. -- +-- Copyright (c) 1998-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.14 $ -- Binding Version 01.00 ------------------------------------------------------------------------------ with Interfaces.C; @@ -49,14 +49,11 @@ package body Terminal_Interface.Curses.Menus.Item_User_Data is Data : User_Access) is function Set_Item_Userptr (Itm : Item; - Addr : User_Access) return C_Int; + Addr : User_Access) return Eti_Error; pragma Import (C, Set_Item_Userptr, "set_item_userptr"); - Res : constant Eti_Error := Set_Item_Userptr (Itm, Data); begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Item_Userptr (Itm, Data)); end Set_User_Data; function Get_User_Data (Itm : Item) return User_Access diff --git a/Ada95/src/terminal_interface-curses-menus-menu_user_data.adb b/Ada95/src/terminal_interface-curses-menus-menu_user_data.adb index 7d66a8c0..746e7b41 100644 --- a/Ada95/src/terminal_interface-curses-menus-menu_user_data.adb +++ b/Ada95/src/terminal_interface-curses-menus-menu_user_data.adb @@ -7,7 +7,7 @@ -- B O D Y -- -- -- ------------------------------------------------------------------------------ --- Copyright (c) 1998-2003,2009 Free Software Foundation, Inc. -- +-- Copyright (c) 1998-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.13 $ +-- $Revision: 1.15 $ -- Binding Version 01.00 ------------------------------------------------------------------------------ with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; @@ -48,14 +48,12 @@ package body Terminal_Interface.Curses.Menus.Menu_User_Data is Data : User_Access) is function Set_Menu_Userptr (Men : Menu; - Data : User_Access) return C_Int; + Data : User_Access) return Eti_Error; pragma Import (C, Set_Menu_Userptr, "set_menu_userptr"); - Res : constant Eti_Error := Set_Menu_Userptr (Men, Data); begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Menu_Userptr (Men, Data)); + end Set_User_Data; function Get_User_Data (Men : Menu) return User_Access diff --git a/Ada95/src/terminal_interface-curses-menus.adb b/Ada95/src/terminal_interface-curses-menus.adb index a7dca07c..ef3a0d3e 100644 --- a/Ada95/src/terminal_interface-curses-menus.adb +++ b/Ada95/src/terminal_interface-curses-menus.adb @@ -7,7 +7,7 @@ -- B O D Y -- -- -- ------------------------------------------------------------------------------ --- Copyright (c) 1998-2009,2011 Free Software Foundation, Inc. -- +-- Copyright (c) 1998-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.28 $ --- $Date: 2011/03/22 23:38:12 $ +-- $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; use Interfaces.C; with Interfaces.C.Strings; use Interfaces.C.Strings; with Interfaces.C.Pointers; -with Ada.Unchecked_Conversion; - package body Terminal_Interface.Curses.Menus is type C_Item_Array is array (Natural range <>) of aliased Item; @@ -57,22 +55,6 @@ package body Terminal_Interface.Curses.Menus is use type System.Bit_Order; subtype chars_ptr is Interfaces.C.Strings.chars_ptr; - function MOS_2_CInt is new - Ada.Unchecked_Conversion (Menu_Option_Set, - C_Int); - - function CInt_2_MOS is new - Ada.Unchecked_Conversion (C_Int, - Menu_Option_Set); - - function IOS_2_CInt is new - Ada.Unchecked_Conversion (Item_Option_Set, - C_Int); - - function CInt_2_IOS is new - Ada.Unchecked_Conversion (C_Int, - Item_Option_Set); - ------------------------------------------------------------------------------ procedure Request_Name (Key : Menu_Request_Code; Name : out String) @@ -128,10 +110,9 @@ package body Terminal_Interface.Curses.Menus is function Itemname (Itm : Item) return chars_ptr; pragma Import (C, Itemname, "item_name"); - function Freeitem (Itm : Item) return C_Int; + function Freeitem (Itm : Item) return Eti_Error; pragma Import (C, Freeitem, "free_item"); - Res : Eti_Error; Ptr : chars_ptr; begin Ptr := Descname (Itm); @@ -142,10 +123,7 @@ package body Terminal_Interface.Curses.Menus is if Ptr /= Null_Ptr then Interfaces.C.Strings.Free (Ptr); end if; - Res := Freeitem (Itm); - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Freeitem (Itm)); Itm := Null_Item; end Delete; ------------------------------------------------------------------------------- @@ -153,14 +131,11 @@ package body Terminal_Interface.Curses.Menus is Value : Boolean := True) is function Set_Item_Val (Itm : Item; - Val : C_Int) return C_Int; + Val : C_Int) return Eti_Error; pragma Import (C, Set_Item_Val, "set_item_value"); - Res : constant Eti_Error := Set_Item_Val (Itm, Boolean'Pos (Value)); begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Item_Val (Itm, Boolean'Pos (Value))); end Set_Value; function Value (Itm : Item) return Boolean @@ -192,16 +167,11 @@ package body Terminal_Interface.Curses.Menus is Options : Item_Option_Set) is function Set_Item_Opts (Itm : Item; - Opt : C_Int) return C_Int; + Opt : Item_Option_Set) return Eti_Error; pragma Import (C, Set_Item_Opts, "set_item_opts"); - Opt : constant C_Int := IOS_2_CInt (Options); - Res : Eti_Error; begin - Res := Set_Item_Opts (Itm, Opt); - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Item_Opts (Itm, Options)); end Set_Options; procedure Switch_Options (Itm : Item; @@ -209,34 +179,28 @@ package body Terminal_Interface.Curses.Menus is On : Boolean := True) is function Item_Opts_On (Itm : Item; - Opt : C_Int) return C_Int; + Opt : Item_Option_Set) return Eti_Error; pragma Import (C, Item_Opts_On, "item_opts_on"); function Item_Opts_Off (Itm : Item; - Opt : C_Int) return C_Int; + Opt : Item_Option_Set) return Eti_Error; pragma Import (C, Item_Opts_Off, "item_opts_off"); - Opt : constant C_Int := IOS_2_CInt (Options); - Err : Eti_Error; begin if On then - Err := Item_Opts_On (Itm, Opt); + Eti_Exception (Item_Opts_On (Itm, Options)); else - Err := Item_Opts_Off (Itm, Opt); - end if; - if Err /= E_Ok then - Eti_Exception (Err); + Eti_Exception (Item_Opts_Off (Itm, Options)); end if; end Switch_Options; procedure Get_Options (Itm : Item; Options : out Item_Option_Set) is - function Item_Opts (Itm : Item) return C_Int; + function Item_Opts (Itm : Item) return Item_Option_Set; pragma Import (C, Item_Opts, "item_opts"); - Res : constant C_Int := Item_Opts (Itm); begin - Options := CInt_2_IOS (Res); + Options := Item_Opts (Itm); end Get_Options; function Get_Options (Itm : Item := Null_Item) return Item_Option_Set @@ -285,14 +249,11 @@ package body Terminal_Interface.Curses.Menus is Itm : Item) is function Set_Curr_Item (Men : Menu; - Itm : Item) return C_Int; + Itm : Item) return Eti_Error; pragma Import (C, Set_Curr_Item, "set_current_item"); - Res : constant Eti_Error := Set_Curr_Item (Men, Itm); begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Curr_Item (Men, Itm)); end Set_Current; function Current (Men : Menu) return Item @@ -312,14 +273,11 @@ package body Terminal_Interface.Curses.Menus is Line : Line_Position) is function Set_Toprow (Men : Menu; - Line : C_Int) return C_Int; + Line : C_Int) return Eti_Error; pragma Import (C, Set_Toprow, "set_top_row"); - Res : constant Eti_Error := Set_Toprow (Men, C_Int (Line)); begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Toprow (Men, C_Int (Line))); end Set_Top_Row; function Top_Row (Men : Menu) return Line_Position @@ -351,20 +309,16 @@ package body Terminal_Interface.Curses.Menus is procedure Post (Men : Menu; Post : Boolean := True) is - function M_Post (Men : Menu) return C_Int; + function M_Post (Men : Menu) return Eti_Error; pragma Import (C, M_Post, "post_menu"); - function M_Unpost (Men : Menu) return C_Int; + function M_Unpost (Men : Menu) return Eti_Error; pragma Import (C, M_Unpost, "unpost_menu"); - Res : Eti_Error; begin if Post then - Res := M_Post (Men); + Eti_Exception (M_Post (Men)); else - Res := M_Unpost (Men); - end if; - if Res /= E_Ok then - Eti_Exception (Res); + Eti_Exception (M_Unpost (Men)); end if; end Post; ------------------------------------------------------------------------------- @@ -372,16 +326,11 @@ package body Terminal_Interface.Curses.Menus is Options : Menu_Option_Set) is function Set_Menu_Opts (Men : Menu; - Opt : C_Int) return C_Int; + Opt : Menu_Option_Set) return Eti_Error; pragma Import (C, Set_Menu_Opts, "set_menu_opts"); - Opt : constant C_Int := MOS_2_CInt (Options); - Res : Eti_Error; begin - Res := Set_Menu_Opts (Men, Opt); - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Menu_Opts (Men, Options)); end Set_Options; procedure Switch_Options (Men : Menu; @@ -389,34 +338,28 @@ package body Terminal_Interface.Curses.Menus is On : Boolean := True) is function Menu_Opts_On (Men : Menu; - Opt : C_Int) return C_Int; + Opt : Menu_Option_Set) return Eti_Error; pragma Import (C, Menu_Opts_On, "menu_opts_on"); function Menu_Opts_Off (Men : Menu; - Opt : C_Int) return C_Int; + Opt : Menu_Option_Set) return Eti_Error; pragma Import (C, Menu_Opts_Off, "menu_opts_off"); - Opt : constant C_Int := MOS_2_CInt (Options); - Err : Eti_Error; begin if On then - Err := Menu_Opts_On (Men, Opt); + Eti_Exception (Menu_Opts_On (Men, Options)); else - Err := Menu_Opts_Off (Men, Opt); - end if; - if Err /= E_Ok then - Eti_Exception (Err); + Eti_Exception (Menu_Opts_Off (Men, Options)); end if; end Switch_Options; procedure Get_Options (Men : Menu; Options : out Menu_Option_Set) is - function Menu_Opts (Men : Menu) return C_Int; + function Menu_Opts (Men : Menu) return Menu_Option_Set; pragma Import (C, Menu_Opts, "menu_opts"); - Res : constant C_Int := Menu_Opts (Men); begin - Options := CInt_2_MOS (Res); + Options := Menu_Opts (Men); end Get_Options; function Get_Options (Men : Menu := Null_Menu) return Menu_Option_Set @@ -431,14 +374,11 @@ package body Terminal_Interface.Curses.Menus is Win : Window) is function Set_Menu_Win (Men : Menu; - Win : Window) return C_Int; + Win : Window) return Eti_Error; pragma Import (C, Set_Menu_Win, "set_menu_win"); - Res : constant Eti_Error := Set_Menu_Win (Men, Win); begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Menu_Win (Men, Win)); end Set_Window; function Get_Window (Men : Menu) return Window @@ -455,14 +395,11 @@ package body Terminal_Interface.Curses.Menus is Win : Window) is function Set_Menu_Sub (Men : Menu; - Win : Window) return C_Int; + Win : Window) return Eti_Error; pragma Import (C, Set_Menu_Sub, "set_menu_sub"); - Res : constant Eti_Error := Set_Menu_Sub (Men, Win); begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Menu_Sub (Men, Win)); end Set_Sub_Window; function Get_Sub_Window (Men : Menu) return Window @@ -481,29 +418,23 @@ package body Terminal_Interface.Curses.Menus is is type C_Int_Access is access all C_Int; function M_Scale (Men : Menu; - Yp, Xp : C_Int_Access) return C_Int; + Yp, Xp : C_Int_Access) return Eti_Error; pragma Import (C, M_Scale, "scale_menu"); X, Y : aliased C_Int; - Res : constant Eti_Error := M_Scale (Men, Y'Access, X'Access); begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (M_Scale (Men, Y'Access, X'Access)); Lines := Line_Count (Y); Columns := Column_Count (X); end Scale; ------------------------------------------------------------------------------- procedure Position_Cursor (Men : Menu) is - function Pos_Menu_Cursor (Men : Menu) return C_Int; + function Pos_Menu_Cursor (Men : Menu) return Eti_Error; pragma Import (C, Pos_Menu_Cursor, "pos_menu_cursor"); - Res : constant Eti_Error := Pos_Menu_Cursor (Men); begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Pos_Menu_Cursor (Men)); end Position_Cursor; ------------------------------------------------------------------------------- @@ -512,18 +443,14 @@ package body Terminal_Interface.Curses.Menus is is type Char_Ptr is access all Interfaces.C.char; function Set_Mark (Men : Menu; - Mark : Char_Ptr) return C_Int; + Mark : Char_Ptr) return Eti_Error; pragma Import (C, Set_Mark, "set_menu_mark"); Txt : char_array (0 .. Mark'Length); Len : size_t; - Res : Eti_Error; begin To_C (Mark, Txt, Len); - Res := Set_Mark (Men, Txt (Txt'First)'Access); - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Mark (Men, Txt (Txt'First)'Access)); end Set_Mark; procedure Mark (Men : Menu; @@ -550,37 +477,34 @@ package body Terminal_Interface.Curses.Menus is Color : Color_Pair := Color_Pair'First) is function Set_Menu_Fore (Men : Menu; - Attr : C_Chtype) return C_Int; + Attr : Attributed_Character) return Eti_Error; pragma Import (C, Set_Menu_Fore, "set_menu_fore"); Ch : constant Attributed_Character := (Ch => Character'First, Color => Color, Attr => Fore); - Res : constant Eti_Error := Set_Menu_Fore (Men, AttrChar_To_Chtype (Ch)); begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Menu_Fore (Men, Ch)); end Set_Foreground; procedure Foreground (Men : Menu; Fore : out Character_Attribute_Set) is - function Menu_Fore (Men : Menu) return C_Chtype; + function Menu_Fore (Men : Menu) return Attributed_Character; pragma Import (C, Menu_Fore, "menu_fore"); begin - Fore := Chtype_To_AttrChar (Menu_Fore (Men)).Attr; + Fore := Menu_Fore (Men).Attr; end Foreground; procedure Foreground (Men : Menu; Fore : out Character_Attribute_Set; Color : out Color_Pair) is - function Menu_Fore (Men : Menu) return C_Chtype; + function Menu_Fore (Men : Menu) return Attributed_Character; pragma Import (C, Menu_Fore, "menu_fore"); begin - Fore := Chtype_To_AttrChar (Menu_Fore (Men)).Attr; - Color := Chtype_To_AttrChar (Menu_Fore (Men)).Color; + Fore := Menu_Fore (Men).Attr; + Color := Menu_Fore (Men).Color; end Foreground; procedure Set_Background @@ -589,37 +513,34 @@ package body Terminal_Interface.Curses.Menus is Color : Color_Pair := Color_Pair'First) is function Set_Menu_Back (Men : Menu; - Attr : C_Chtype) return C_Int; + Attr : Attributed_Character) return Eti_Error; pragma Import (C, Set_Menu_Back, "set_menu_back"); Ch : constant Attributed_Character := (Ch => Character'First, Color => Color, Attr => Back); - Res : constant Eti_Error := Set_Menu_Back (Men, AttrChar_To_Chtype (Ch)); begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Menu_Back (Men, Ch)); end Set_Background; procedure Background (Men : Menu; Back : out Character_Attribute_Set) is - function Menu_Back (Men : Menu) return C_Chtype; + function Menu_Back (Men : Menu) return Attributed_Character; pragma Import (C, Menu_Back, "menu_back"); begin - Back := Chtype_To_AttrChar (Menu_Back (Men)).Attr; + Back := Menu_Back (Men).Attr; end Background; procedure Background (Men : Menu; Back : out Character_Attribute_Set; Color : out Color_Pair) is - function Menu_Back (Men : Menu) return C_Chtype; + function Menu_Back (Men : Menu) return Attributed_Character; pragma Import (C, Menu_Back, "menu_back"); begin - Back := Chtype_To_AttrChar (Menu_Back (Men)).Attr; - Color := Chtype_To_AttrChar (Menu_Back (Men)).Color; + Back := Menu_Back (Men).Attr; + Color := Menu_Back (Men).Color; end Background; procedure Set_Grey (Men : Menu; @@ -627,53 +548,46 @@ package body Terminal_Interface.Curses.Menus is Color : Color_Pair := Color_Pair'First) is function Set_Menu_Grey (Men : Menu; - Attr : C_Chtype) return C_Int; + Attr : Attributed_Character) return Eti_Error; pragma Import (C, Set_Menu_Grey, "set_menu_grey"); Ch : constant Attributed_Character := (Ch => Character'First, Color => Color, Attr => Grey); - Res : constant Eti_Error := Set_Menu_Grey (Men, AttrChar_To_Chtype (Ch)); begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Menu_Grey (Men, Ch)); end Set_Grey; procedure Grey (Men : Menu; Grey : out Character_Attribute_Set) is - function Menu_Grey (Men : Menu) return C_Chtype; + function Menu_Grey (Men : Menu) return Attributed_Character; pragma Import (C, Menu_Grey, "menu_grey"); begin - Grey := Chtype_To_AttrChar (Menu_Grey (Men)).Attr; + Grey := Menu_Grey (Men).Attr; end Grey; procedure Grey (Men : Menu; Grey : out Character_Attribute_Set; Color : out Color_Pair) is - function Menu_Grey (Men : Menu) return C_Chtype; + function Menu_Grey (Men : Menu) return Attributed_Character; pragma Import (C, Menu_Grey, "menu_grey"); begin - Grey := Chtype_To_AttrChar (Menu_Grey (Men)).Attr; - Color := Chtype_To_AttrChar (Menu_Grey (Men)).Color; + Grey := Menu_Grey (Men).Attr; + Color := Menu_Grey (Men).Color; end Grey; procedure Set_Pad_Character (Men : Menu; Pad : Character := Space) is function Set_Menu_Pad (Men : Menu; - Ch : C_Int) return C_Int; + Ch : C_Int) return Eti_Error; pragma Import (C, Set_Menu_Pad, "set_menu_pad"); - Res : constant Eti_Error := Set_Menu_Pad (Men, - C_Int (Character'Pos (Pad))); begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Menu_Pad (Men, C_Int (Character'Pos (Pad)))); end Set_Pad_Character; procedure Pad_Character (Men : Menu; @@ -691,17 +605,14 @@ package body Terminal_Interface.Curses.Menus is Col : Column_Position := 0) is function Set_Spacing (Men : Menu; - D, R, C : C_Int) return C_Int; + D, R, C : C_Int) return Eti_Error; pragma Import (C, Set_Spacing, "set_menu_spacing"); - Res : constant Eti_Error := Set_Spacing (Men, - C_Int (Descr), - C_Int (Row), - C_Int (Col)); begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Spacing (Men, + C_Int (Descr), + C_Int (Row), + C_Int (Col))); end Set_Spacing; procedure Spacing (Men : Menu; @@ -711,22 +622,18 @@ package body Terminal_Interface.Curses.Menus is is type C_Int_Access is access all C_Int; function Get_Spacing (Men : Menu; - D, R, C : C_Int_Access) return C_Int; + D, R, C : C_Int_Access) return Eti_Error; pragma Import (C, Get_Spacing, "menu_spacing"); D, R, C : aliased C_Int; - Res : constant Eti_Error := Get_Spacing (Men, - D'Access, - R'Access, - C'Access); begin - if Res /= E_Ok then - Eti_Exception (Res); - else - Descr := Column_Position (D); - Row := Line_Position (R); - Col := Column_Position (C); - end if; + Eti_Exception (Get_Spacing (Men, + D'Access, + R'Access, + C'Access)); + Descr := Column_Position (D); + Row := Line_Position (R); + Col := Column_Position (C); end Spacing; ------------------------------------------------------------------------------- function Set_Pattern (Men : Menu; @@ -734,7 +641,7 @@ package body Terminal_Interface.Curses.Menus is is type Char_Ptr is access all Interfaces.C.char; function Set_Pattern (Men : Menu; - Pattern : Char_Ptr) return C_Int; + Pattern : Char_Ptr) return Eti_Error; pragma Import (C, Set_Pattern, "set_menu_pattern"); S : char_array (0 .. Text'Length); @@ -744,11 +651,11 @@ package body Terminal_Interface.Curses.Menus is To_C (Text, S, L); Res := Set_Pattern (Men, S (S'First)'Access); case Res is - when E_No_Match => return False; - when E_Ok => return True; + when E_No_Match => + return False; when others => Eti_Exception (Res); - return False; + return True; end case; end Set_Pattern; @@ -767,16 +674,14 @@ package body Terminal_Interface.Curses.Menus is is function Set_Menu_Fmt (Men : Menu; Lin : C_Int; - Col : C_Int) return C_Int; + Col : C_Int) return Eti_Error; pragma Import (C, Set_Menu_Fmt, "set_menu_format"); - Res : constant Eti_Error := Set_Menu_Fmt (Men, - C_Int (Lines), - C_Int (Columns)); begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Menu_Fmt (Men, + C_Int (Lines), + C_Int (Columns))); + end Set_Format; procedure Format (Men : Menu; @@ -785,74 +690,58 @@ package body Terminal_Interface.Curses.Menus is is type C_Int_Access is access all C_Int; function Menu_Fmt (Men : Menu; - Y, X : C_Int_Access) return C_Int; + Y, X : C_Int_Access) return Eti_Error; pragma Import (C, Menu_Fmt, "menu_format"); L, C : aliased C_Int; - Res : constant Eti_Error := Menu_Fmt (Men, L'Access, C'Access); begin - if Res /= E_Ok then - Eti_Exception (Res); - else - Lines := Line_Count (L); - Columns := Column_Count (C); - end if; + Eti_Exception (Menu_Fmt (Men, L'Access, C'Access)); + Lines := Line_Count (L); + Columns := Column_Count (C); end Format; ------------------------------------------------------------------------------- procedure Set_Item_Init_Hook (Men : Menu; Proc : Menu_Hook_Function) is function Set_Item_Init (Men : Menu; - Proc : Menu_Hook_Function) return C_Int; + Proc : Menu_Hook_Function) return Eti_Error; pragma Import (C, Set_Item_Init, "set_item_init"); - Res : constant Eti_Error := Set_Item_Init (Men, Proc); begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Item_Init (Men, Proc)); end Set_Item_Init_Hook; procedure Set_Item_Term_Hook (Men : Menu; Proc : Menu_Hook_Function) is function Set_Item_Term (Men : Menu; - Proc : Menu_Hook_Function) return C_Int; + Proc : Menu_Hook_Function) return Eti_Error; pragma Import (C, Set_Item_Term, "set_item_term"); - Res : constant Eti_Error := Set_Item_Term (Men, Proc); begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Item_Term (Men, Proc)); end Set_Item_Term_Hook; procedure Set_Menu_Init_Hook (Men : Menu; Proc : Menu_Hook_Function) is function Set_Menu_Init (Men : Menu; - Proc : Menu_Hook_Function) return C_Int; + Proc : Menu_Hook_Function) return Eti_Error; pragma Import (C, Set_Menu_Init, "set_menu_init"); - Res : constant Eti_Error := Set_Menu_Init (Men, Proc); begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Menu_Init (Men, Proc)); end Set_Menu_Init_Hook; procedure Set_Menu_Term_Hook (Men : Menu; Proc : Menu_Hook_Function) is function Set_Menu_Term (Men : Menu; - Proc : Menu_Hook_Function) return C_Int; + Proc : Menu_Hook_Function) return Eti_Error; pragma Import (C, Set_Menu_Term, "set_menu_term"); - Res : constant Eti_Error := Set_Menu_Term (Men, Proc); begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Menu_Term (Men, Proc)); end Set_Menu_Term_Hook; function Get_Item_Init_Hook (Men : Menu) return Menu_Hook_Function @@ -891,19 +780,15 @@ package body Terminal_Interface.Curses.Menus is Items : Item_Array_Access) is function Set_Items (Men : Menu; - Items : System.Address) return C_Int; + Items : System.Address) return Eti_Error; pragma Import (C, Set_Items, "set_menu_items"); - Res : Eti_Error; begin pragma Assert (Items.all (Items'Last) = Null_Item); if Items.all (Items'Last) /= Null_Item then raise Menu_Exception; else - Res := Set_Items (Men, Items.all'Address); - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Items (Men, Items.all'Address)); end if; end Redefine; @@ -955,14 +840,11 @@ package body Terminal_Interface.Curses.Menus is procedure Delete (Men : in out Menu) is - function Free (Men : Menu) return C_Int; + function Free (Men : Menu) return Eti_Error; pragma Import (C, Free, "free_menu"); - Res : constant Eti_Error := Free (Men); begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Free (Men)); Men := Null_Menu; end Delete; @@ -971,22 +853,22 @@ package body Terminal_Interface.Curses.Menus is Key : Key_Code) return Driver_Result is function Driver (Men : Menu; - Key : C_Int) return C_Int; + Key : C_Int) return Eti_Error; pragma Import (C, Driver, "menu_driver"); R : constant Eti_Error := Driver (Men, C_Int (Key)); begin - if R /= E_Ok then - case R is - when E_Unknown_Command => return Unknown_Request; - when E_No_Match => return No_Match; - when E_Request_Denied | - E_Not_Selectable => return Request_Denied; - when others => - Eti_Exception (R); - end case; - end if; - return Menu_Ok; + case R is + when E_Unknown_Command => + return Unknown_Request; + when E_No_Match => + return No_Match; + when E_Request_Denied | E_Not_Selectable => + return Request_Denied; + when others => + Eti_Exception (R); + return Menu_Ok; + end case; end Driver; procedure Free (IA : in out Item_Array_Access; diff --git a/Ada95/src/terminal_interface-curses-text_io.adb b/Ada95/src/terminal_interface-curses-text_io.adb index e2ca27f2..85a4f44b 100644 --- a/Ada95/src/terminal_interface-curses-text_io.adb +++ b/Ada95/src/terminal_interface-curses-text_io.adb @@ -7,7 +7,7 @@ -- B O D Y -- -- -- ------------------------------------------------------------------------------ --- Copyright (c) 1998-2009,2011 Free Software Foundation, Inc. -- +-- Copyright (c) 1998-2011,2014 Free Software Foundation, Inc. -- -- -- -- Permission is hereby granted, free of charge, to any person obtaining a -- -- copy of this software and associated documentation files (the -- @@ -35,8 +35,8 @@ ------------------------------------------------------------------------------ -- Author: Juergen Pfeifer, 1996 -- Version Control: --- $Revision: 1.20 $ --- $Date: 2011/03/22 23:38:49 $ +-- $Revision: 1.22 $ +-- $Date: 2014/05/24 21:32:18 $ -- Binding Version 01.00 ------------------------------------------------------------------------------ package body Terminal_Interface.Curses.Text_IO is @@ -205,7 +205,7 @@ package body Terminal_Interface.Curses.Text_IO is end if; Get_Cursor_Position (Win, Y1, X); - pragma Unreferenced (X); + pragma Warnings (Off, X); -- unreferenced N := Natural (To); N := N - 1; Y2 := Line_Position (N); if Y2 < Y1 then diff --git a/Ada95/src/terminal_interface-curses-trace.adb_p b/Ada95/src/terminal_interface-curses-trace.adb_p index d2117a4c..0dead376 100644 --- a/Ada95/src/terminal_interface-curses-trace.adb_p +++ b/Ada95/src/terminal_interface-curses-trace.adb_p @@ -7,7 +7,7 @@ -- B O D Y -- -- -- ------------------------------------------------------------------------------ --- Copyright (c) 2000-2004,2009 Free Software Foundation, Inc. -- +-- Copyright (c) 2000-2009,2014 Free Software Foundation, Inc. -- -- -- -- Permission is hereby granted, free of charge, to any person obtaining a -- -- copy of this software and associated documentation files (the -- @@ -35,60 +35,39 @@ ------------------------------------------------------------------------------ -- Author: Juergen Pfeifer, 1996 -- Version Control: --- $Revision: 1.7 $ +-- $Revision: 1.11 $ -- Binding Version 01.00 ------------------------------------------------------------------------------ #if ADA_TRACE then with Interfaces.C; use Interfaces.C; -with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; -with Ada.Unchecked_Conversion; #end if; package body Terminal_Interface.Curses.Trace is #if ADA_TRACE then - type C_TraceType is new C_UInt; - - function TraceAda_To_TraceC is new - Ada.Unchecked_Conversion (Source => Trace_Attribute_Set, - Target => C_TraceType); - procedure Trace_On (x : Trace_Attribute_Set) is - procedure traceC (y : C_TraceType); + procedure traceC (y : Trace_Attribute_Set); pragma Import (C, traceC, "trace"); begin - traceC (TraceAda_To_TraceC (x)); + traceC (x); end Trace_On; - -- 75. (12) A C function that takes a variable number of arguments can - -- correspond to several Ada subprograms, taking various specific - -- numbers and types of parameters. - procedure Trace_Put (str : String) is procedure tracef (format : char_array; s : char_array); pragma Import (C, tracef, "_traces"); - Txt : char_array (0 .. str'Length); - Length : size_t; - formatstr : constant String := "%s" & ASCII.NUL; - formattxt : char_array (0 .. formatstr'Length); + -- _traces() is defined in c_varargs_to_ada.h begin - To_C (formatstr, formattxt, Length); - To_C (str, Txt, Length); - tracef (formattxt, Txt); + tracef (To_C ("%s"), To_C (str)); end Trace_Put; #else procedure Trace_On (x : Trace_Attribute_Set) is -#if PRAGMA_UNREF - pragma Unreferenced (x); -#end if; + pragma Warnings (Off, x); -- unreferenced begin null; end Trace_On; procedure Trace_Put (str : String) is -#if PRAGMA_UNREF - pragma Unreferenced (str); -#end if; + pragma Warnings (Off, str); -- unreferenced begin null; end Trace_Put; diff --git a/MANIFEST b/MANIFEST index 6b9fe483..85d01965 100644 --- a/MANIFEST +++ b/MANIFEST @@ -128,9 +128,11 @@ ./Ada95/samples/tour.adb ./Ada95/samples/tour.ads ./Ada95/src/Makefile.in +./Ada95/src/c_threaded_variables.c +./Ada95/src/c_threaded_variables.h ./Ada95/src/c_varargs_to_ada.c ./Ada95/src/c_varargs_to_ada.h -./Ada95/src/library.gpr +./Ada95/src/library.gpr.sed ./Ada95/src/modules ./Ada95/src/ncurses_compat.c ./Ada95/src/terminal_interface-curses-aux.adb @@ -333,6 +335,7 @@ ./doc/html/ada/terminal_interface-curses-trace__ads.htm ./doc/html/ada/terminal_interface-curses__adb.htm ./doc/html/ada/terminal_interface-curses__ads.htm +./doc/html/ada/terminal_interface-curses_constants__ads.htm ./doc/html/ada/terminal_interface__ads.htm ./doc/html/announce.html ./doc/html/hackguide.html @@ -1040,6 +1043,8 @@ ./progs/tabs.c ./progs/tic.c ./progs/toe.c +./progs/tparm_type.c +./progs/tparm_type.h ./progs/tput.c ./progs/transform.c ./progs/tset.c diff --git a/NEWS b/NEWS index 4cae0e2c..f0e3a472 100644 --- a/NEWS +++ b/NEWS @@ -25,7 +25,7 @@ -- sale, use or other dealings in this Software without prior written -- -- authorization. -- ------------------------------------------------------------------------------- --- $Id: NEWS,v 1.2201 2014/05/10 21:07:15 tom Exp $ +-- $Id: NEWS,v 1.2209 2014/05/24 21:40:16 tom Exp $ ------------------------------------------------------------------------------- This is a log of changes that ncurses has gone through since Zeyd started @@ -45,6 +45,53 @@ See the AUTHORS file for the corresponding full names. Changes through 1.9.9e did not credit all contributions; it is not possible to add this information. +20140524 + + fix typo in ncurses manpage for the NCURSES_NO_MAGIC_COOKIE + environment variable. + + improve discussion of input-echoing in curs_getch.3x + + clarify discussion in curs_addch.3x of wrapping. + + modify parametrized.h to make fln non-padded. + + correct several entries which had termcap-style padding used in + terminfo: adm21, aj510, alto-h19, att605-pc, x820 -TD + + correct syntax for padding in some entries: dg211, h19 -TD + + correct ti924-8 which had confused padding versus octal escapes -TD + + correct padding in sbi entry -TD + + fix an old bug in the termcap emulation; "%i" was ignored in tparm() + because the parameters to be incremented were already on the internal + stack (report by Corinna Vinschen). + + modify tic's "-c" option to take into account the "-C" option to + activate additional checks which compare the results from running + tparm() on the terminfo expressions versus the translated termcap + expressions. + + modify tic to allow it to read from FIFOs (report by Matthieu Fronton, + cf: 20120324). + > patches by Nicolas Boulenguez: + + explicit dereferences to suppress some style warnings. + + when c_varargs_to_ada.c includes its header, use double quotes + instead of <>. + + samples/ncurses2-util.adb: removed unused with clause. The warning + was removed by an obsolete pragma. + + replaced Unreferenced pragmas with Warnings (Off). The latter, + available with older GNATs, needs no configure test. This also + replaces 3 untested Unreferenced pragmas. + + simplified To_C usage in trace handling. Using two parameters allows + some basic formatting, and avoids a warning about security with some + compiler flags. + + for generated Ada sources, replace many snippets with one pure + package. + + removed C_Chtype and its conversions. + + removed C_AttrType and its conversions. + + removed conversions between int, Item_Option_Set, Menu_Option_Set. + + removed int, Field_Option_Set, Item_Option_Set conversions. + + removed C_TraceType, Attribute_Option_Set conversions. + + replaced C.int with direct use of Eti_Error, now enumerated. As it + was used in a case statement, values were tested by the Ada compiler + to be consecutive anyway. + + src/Makefile.in: remove duplicate stanza + + only consider using a project for shared libraries. + + style. Silent gnat-4.9 warning about misplaced "then". + + generate shared library project to honor ADAFLAGS, LDFLAGS. + 20140510 + cleanup recently introduced compiler warnings for MingW port. + workaround for ${MAKEFLAGS} configure check versus GNU make 4.0, @@ -77,7 +124,7 @@ it is not possible to add this information. + drop the -no-gcc option from Intel compiler, from lynx changes. + extend the --with-hashed-db configure option to simplify building with different versions of Berkeley database using FreeBSD ports. - + improve initialization for MinGW port (patch by Juergen Pfeifer): + + improve initialization for MinGW port (Juergen Pfeifer): + enforce Windows-style path-separator if cross-compiling, + add a driver-name method to each of the drivers, + allow the Windows driver name to match "unknown", ignoring case, @@ -355,7 +402,7 @@ it is not possible to add this information. 20130615 + minor changes to some configure macros to make them more reusable. - + fixes for tabs program (prompted by report by Nick Andrik): + + fixes for tabs program (prompted by report by Nick Andrik). + corrected logic in command-line parsing of -a and -c predefined tab-lists options. + allow "-0" and "-8" options to be combined with others, e.g.,"-0d". @@ -1450,7 +1497,7 @@ it is not possible to add this information. + Ada95 build-fix for big-endian architectures such as sparc. This undoes one of the fixes from 20110319, which added an "Unused" member to representation clauses, replacing that with pragmas to suppress - warnings about unused bits (patch by Nicolas Boulenguez): + warnings about unused bits (patch by Nicolas Boulenguez). 20110423 + add check in test/configure for use_window, use_screen. @@ -2137,7 +2184,7 @@ it is not possible to add this information. + quiet some pedantic gcc warnings. + modify _nc_wgetch() to check for a -1 in the fifo, e.g., after a SIGWINCH, and discard that value, to avoid confusing application - (patch by Eygene Ryabinkin, FreeBSD bin/136223). + (patch by Eygene Ryabinkin, FreeBSD #136223). 20091017 + modify handling of $PKG_CONFIG_LIBDIR to use only the first item in @@ -2217,7 +2264,7 @@ it is not possible to add this information. 20090815 + correct use of terminfo capabilities for initializing soft-keys, - broken in 20090509 merging. + broken in 20090510 merging. + modify wgetch() to ensure it checks SIGWINCH when it gets an error in non-blocking mode (patch by Clemens Ladisch). + use PATH_SEPARATOR symbol when substituting into run_tic.sh, to @@ -2256,7 +2303,7 @@ it is not possible to add this information. 20090718 + fix a null-pointer check in _nc_format_slks() in lib_slk.c, from - 20070704 changes. + 20090704 changes. + modify _nc_find_type_entry() to use hashing. + make CCHARW_MAX value configurable, noting that changing this would change the size of cchar_t, and would be ABI-incompatible. @@ -2362,7 +2409,7 @@ it is not possible to add this information. intermediate variable LT_UNDEF in the configure script, and then using that in the libtool link-commands. + fix an missing use of NCURSES_PUBLIC_VAR() in tinfo/MKcodes.awk - from 2009031 changes. + from 20090321 changes. + improve mk-1st.awk script by writing separate cases for the LIBTOOL_LINK command, depending on which library (ncurses, ticlib, termlib) is to be linked. @@ -9072,7 +9119,7 @@ it is not possible to add this information. + remove _nc_err_abort() calls when write_entry.c finds a directory but cannot write to it, e.g., when translating part/all of /etc/termcap (reported by Andreas Jaeger ). - (this dates back to 951102, in 1.9.7a). + (this dates back to 951102 in 1.9.7a). + minor ifdef fixes to compile with atac and glibc 2.0.5c + add check for -lgen when configuring regexpr.h + modify Solaris shared-library option "-d y" to "-dy" to workaround @@ -9541,7 +9588,7 @@ it is not possible to add this information. + modify tset to look in /etc/ttys or /etc/ttytype if the configuration does not have getttynam(). + extend baudrate table in tset.c to match baudrate() function. - + add table entries for 230400 and 460800 bd to baudrate() function. + + add table entries for B230400 and B460800 to baudrate() function. + improve breakout logic by allowing it before the first line updated, which is what SVr4 curses does (patch by Alexander V. Lukyanov). + correct initialization of vcost in relative_move(), for cursor-down diff --git a/aclocal.m4 b/aclocal.m4 index e45bace6..c9bbdf74 100644 --- a/aclocal.m4 +++ b/aclocal.m4 @@ -28,7 +28,7 @@ dnl*************************************************************************** dnl dnl Author: Thomas E. Dickey 1995-on dnl -dnl $Id: aclocal.m4,v 1.690 2014/05/10 21:07:38 tom Exp $ +dnl $Id: aclocal.m4,v 1.692 2014/05/24 21:24:50 tom Exp $ dnl Macros used in NCURSES auto-configuration script. dnl dnl These macros are maintained separately from NCURSES. The copyright on @@ -2150,36 +2150,7 @@ AC_SUBST(cf_compile_generics) AC_SUBST(cf_generic_objects) ])dnl dnl --------------------------------------------------------------------------- -dnl CF_GNAT_PRAGMA_UNREF version: 1 updated: 2010/06/19 15:22:18 -dnl -------------------- -dnl Check if the gnat pragma "Unreferenced" works. -AC_DEFUN([CF_GNAT_PRAGMA_UNREF],[ -AC_CACHE_CHECK(if GNAT pragma Unreferenced works,cf_cv_pragma_unreferenced,[ -CF_GNAT_TRY_LINK([procedure conftest;], -[with Text_IO; -with GNAT.OS_Lib; -procedure conftest is - test : Integer; - pragma Unreferenced (test); -begin - test := 1; - Text_IO.Put ("Hello World"); - Text_IO.New_Line; - GNAT.OS_Lib.OS_Exit (0); -end conftest;], - [cf_cv_pragma_unreferenced=yes], - [cf_cv_pragma_unreferenced=no])]) - -# if the pragma is supported, use it (needed in the Trace code). -if test $cf_cv_pragma_unreferenced = yes ; then - PRAGMA_UNREF=TRUE -else - PRAGMA_UNREF=FALSE -fi -AC_SUBST(PRAGMA_UNREF) -])dnl -dnl --------------------------------------------------------------------------- -dnl CF_GNAT_PROJECTS version: 4 updated: 2013/09/07 14:05:46 +dnl CF_GNAT_PROJECTS version: 5 updated: 2014/05/24 13:30:20 dnl ---------------- dnl GNAT projects are configured with ".gpr" project files. dnl GNAT libraries are a further development, using the project feature. @@ -2187,7 +2158,6 @@ AC_DEFUN([CF_GNAT_PROJECTS], [ AC_REQUIRE([CF_GNAT_VERSION]) -cf_gnat_libraries=no cf_gnat_projects=no AC_MSG_CHECKING(if GNAT supports project files) @@ -2199,28 +2169,17 @@ case $cf_gnat_version in #(vi cygwin*|msys*) #(vi ;; *) - mkdir conftest.src conftest.bin conftest.lib - cd conftest.src - rm -rf conftest* *~conftest* + mkdir conftest + cd conftest + mkdir lib obj cat >>library.gpr <>confpackage.ads <&AC_FD_CC 2>&1 ) ; then + if ( $cf_ada_make -Plibrary.gpr 1>&AC_FD_CC 2>&1 ); then cf_gnat_projects=yes fi cd .. - if test -f conftest.lib/confpackage.ali - then - cf_gnat_libraries=yes - fi - rm -rf conftest* *~conftest* + rm -rf conftest ;; esac ;; esac AC_MSG_RESULT($cf_gnat_projects) - -if test $cf_gnat_projects = yes -then - AC_MSG_CHECKING(if GNAT supports libraries) - AC_MSG_RESULT($cf_gnat_libraries) -fi - -if test "$cf_gnat_projects" = yes -then - USE_OLD_MAKERULES="#" - USE_GNAT_PROJECTS="" -else - USE_OLD_MAKERULES="" - USE_GNAT_PROJECTS="#" -fi - -if test "$cf_gnat_libraries" = yes -then - USE_GNAT_LIBRARIES="" -else - USE_GNAT_LIBRARIES="#" -fi - -AC_SUBST(USE_OLD_MAKERULES) -AC_SUBST(USE_GNAT_PROJECTS) -AC_SUBST(USE_GNAT_LIBRARIES) ])dnl dnl --------------------------------------------------------------------------- dnl CF_GNAT_SIGINT version: 1 updated: 2011/03/27 20:07:59 @@ -6657,14 +6580,15 @@ AC_SUBST(ADA_OBJECTS) AC_MSG_RESULT($ADA_OBJECTS) ])dnl dnl --------------------------------------------------------------------------- -dnl CF_WITH_ADA_SHAREDLIB version: 2 updated: 2010/06/26 17:35:58 +dnl CF_WITH_ADA_SHAREDLIB version: 3 updated: 2014/05/24 13:30:20 dnl --------------------- dnl Command-line option to specify if an Ada95 shared-library should be built, dnl and optionally what its soname should be. AC_DEFUN([CF_WITH_ADA_SHAREDLIB],[ +AC_REQUIRE([CF_GNAT_PROJECTS]) AC_MSG_CHECKING(if an Ada95 shared-library should be built) AC_ARG_WITH(ada-sharedlib, - [ --with-ada-sharedlib=XX build Ada95 shared-library], + [ --with-ada-sharedlib=soname build shared-library (requires GNAT projects)], [with_ada_sharedlib=$withval], [with_ada_sharedlib=no]) AC_MSG_RESULT($with_ada_sharedlib) @@ -6674,6 +6598,10 @@ MAKE_ADA_SHAREDLIB="#" if test "x$with_ada_sharedlib" != xno then + if test "$cf_gnat_projects" != yes + then + AC_MSG_ERROR(ada-sharedlib requires GNAT support for shared library projects,1) + fi MAKE_ADA_SHAREDLIB= if test "x$with_ada_sharedlib" != xyes then diff --git a/configure b/configure index d7e18069..bc3c34f8 100755 --- a/configure +++ b/configure @@ -1,5 +1,5 @@ #! /bin/sh -# From configure.in Revision: 1.579 . +# From configure.in Revision: 1.580 . # Guess values for system-dependent variables and create Makefiles. # Generated by Autoconf 2.52.20121002. # @@ -827,7 +827,7 @@ Ada95 Binding Options: --with-ada-compiler=CMD specify Ada95 compiler command (default gnatmake) --with-ada-include=DIR Ada includes are in DIR (default: PREFIX/share/ada/adainclude) --with-ada-objects=DIR Ada objects are in DIR (default: PREFIX/lib/ada/adalib) - --with-ada-sharedlib=XX build Ada95 shared-library + --with-ada-sharedlib=soname build shared-library (requires GNAT projects) Some influential environment variables: CC C compiler command @@ -19896,146 +19896,7 @@ else USE_GNAT_SIGINT="#" fi -echo "$as_me:19899: checking if GNAT pragma Unreferenced works" >&5 -echo $ECHO_N "checking if GNAT pragma Unreferenced works... $ECHO_C" >&6 -if test "${cf_cv_pragma_unreferenced+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 -else - -rm -rf conftest* *~conftest* -cat >>conftest.ads <>conftest.adb <&5 2>&1 ) ; then - cf_cv_pragma_unreferenced=yes -else - cf_cv_pragma_unreferenced=no -fi -rm -rf conftest* *~conftest* - -fi -echo "$as_me:19930: result: $cf_cv_pragma_unreferenced" >&5 -echo "${ECHO_T}$cf_cv_pragma_unreferenced" >&6 - -# if the pragma is supported, use it (needed in the Trace code). -if test $cf_cv_pragma_unreferenced = yes ; then - PRAGMA_UNREF=TRUE -else - PRAGMA_UNREF=FALSE -fi - -cf_gnat_libraries=no -cf_gnat_projects=no - -echo "$as_me:19943: checking if GNAT supports project files" >&5 -echo $ECHO_N "checking if GNAT supports project files... $ECHO_C" >&6 -case $cf_gnat_version in #(vi -3.[0-9]*) #(vi - ;; -*) - case $cf_cv_system_name in #(vi - cygwin*|msys*) #(vi - ;; - *) - mkdir conftest.src conftest.bin conftest.lib - cd conftest.src - rm -rf conftest* *~conftest* - cat >>library.gpr <>confpackage.ads <>confpackage.adb <&5 2>&1 ) ; then - cf_gnat_projects=yes - fi - cd .. - if test -f conftest.lib/confpackage.ali - then - cf_gnat_libraries=yes - fi - rm -rf conftest* *~conftest* - ;; - esac - ;; -esac -echo "$as_me:20011: result: $cf_gnat_projects" >&5 -echo "${ECHO_T}$cf_gnat_projects" >&6 - -if test $cf_gnat_projects = yes -then - echo "$as_me:20016: checking if GNAT supports libraries" >&5 -echo $ECHO_N "checking if GNAT supports libraries... $ECHO_C" >&6 - echo "$as_me:20018: result: $cf_gnat_libraries" >&5 -echo "${ECHO_T}$cf_gnat_libraries" >&6 -fi - -if test "$cf_gnat_projects" = yes -then - USE_OLD_MAKERULES="#" - USE_GNAT_PROJECTS="" -else - USE_OLD_MAKERULES="" - USE_GNAT_PROJECTS="#" -fi - -if test "$cf_gnat_libraries" = yes -then - USE_GNAT_LIBRARIES="" -else - USE_GNAT_LIBRARIES="#" -fi - -echo "$as_me:20038: checking for ada-compiler" >&5 +echo "$as_me:19899: checking for ada-compiler" >&5 echo $ECHO_N "checking for ada-compiler... $ECHO_C" >&6 # Check whether --with-ada-compiler or --without-ada-compiler was given. @@ -20046,12 +19907,12 @@ else cf_ada_compiler=gnatmake fi; -echo "$as_me:20049: result: $cf_ada_compiler" >&5 +echo "$as_me:19910: result: $cf_ada_compiler" >&5 echo "${ECHO_T}$cf_ada_compiler" >&6 cf_ada_package=terminal_interface -echo "$as_me:20054: checking for ada-include" >&5 +echo "$as_me:19915: checking for ada-include" >&5 echo $ECHO_N "checking for ada-include... $ECHO_C" >&6 # Check whether --with-ada-include or --without-ada-include was given. @@ -20087,7 +19948,7 @@ case ".$withval" in #(vi withval=`echo $withval | sed -e s%NONE%$cf_path_syntax%` ;; *) - { { echo "$as_me:20090: error: expected a pathname, not \"$withval\"" >&5 + { { echo "$as_me:19951: error: expected a pathname, not \"$withval\"" >&5 echo "$as_me: error: expected a pathname, not \"$withval\"" >&2;} { (exit 1); exit 1; }; } ;; @@ -20096,10 +19957,10 @@ esac fi eval ADA_INCLUDE="$withval" -echo "$as_me:20099: result: $ADA_INCLUDE" >&5 +echo "$as_me:19960: result: $ADA_INCLUDE" >&5 echo "${ECHO_T}$ADA_INCLUDE" >&6 -echo "$as_me:20102: checking for ada-objects" >&5 +echo "$as_me:19963: checking for ada-objects" >&5 echo $ECHO_N "checking for ada-objects... $ECHO_C" >&6 # Check whether --with-ada-objects or --without-ada-objects was given. @@ -20135,7 +19996,7 @@ case ".$withval" in #(vi withval=`echo $withval | sed -e s%NONE%$cf_path_syntax%` ;; *) - { { echo "$as_me:20138: error: expected a pathname, not \"$withval\"" >&5 + { { echo "$as_me:19999: error: expected a pathname, not \"$withval\"" >&5 echo "$as_me: error: expected a pathname, not \"$withval\"" >&2;} { (exit 1); exit 1; }; } ;; @@ -20144,10 +20005,62 @@ esac fi eval ADA_OBJECTS="$withval" -echo "$as_me:20147: result: $ADA_OBJECTS" >&5 +echo "$as_me:20008: result: $ADA_OBJECTS" >&5 echo "${ECHO_T}$ADA_OBJECTS" >&6 -echo "$as_me:20150: checking if an Ada95 shared-library should be built" >&5 +cf_gnat_projects=no + +echo "$as_me:20013: checking if GNAT supports project files" >&5 +echo $ECHO_N "checking if GNAT supports project files... $ECHO_C" >&6 +case $cf_gnat_version in #(vi +3.[0-9]*) #(vi + ;; +*) + case $cf_cv_system_name in #(vi + cygwin*|msys*) #(vi + ;; + *) + mkdir conftest + cd conftest + mkdir lib obj + cat >>library.gpr <>confpackage.ads <>confpackage.adb <&5 2>&1 ); then + cf_gnat_projects=yes + fi + cd .. + rm -rf conftest + ;; + esac + ;; +esac +echo "$as_me:20060: result: $cf_gnat_projects" >&5 +echo "${ECHO_T}$cf_gnat_projects" >&6 + +echo "$as_me:20063: checking if an Ada95 shared-library should be built" >&5 echo $ECHO_N "checking if an Ada95 shared-library should be built... $ECHO_C" >&6 # Check whether --with-ada-sharedlib or --without-ada-sharedlib was given. @@ -20157,7 +20070,7 @@ if test "${with_ada_sharedlib+set}" = set; then else with_ada_sharedlib=no fi; -echo "$as_me:20160: result: $with_ada_sharedlib" >&5 +echo "$as_me:20073: result: $with_ada_sharedlib" >&5 echo "${ECHO_T}$with_ada_sharedlib" >&6 ADA_SHAREDLIB='lib$(LIB_NAME).so.1' @@ -20165,6 +20078,12 @@ MAKE_ADA_SHAREDLIB="#" if test "x$with_ada_sharedlib" != xno then + if test "$cf_gnat_projects" != yes + then + { { echo "$as_me:20083: error: ada-sharedlib requires GNAT support for shared library projects" >&5 +echo "$as_me: error: ada-sharedlib requires GNAT support for shared library projects" >&2;} + { (exit 1); exit 1; }; } + fi MAKE_ADA_SHAREDLIB= if test "x$with_ada_sharedlib" != xyes then @@ -20180,13 +20099,13 @@ fi # do this "late" to avoid conflict with header-checks if test "x$with_widec" = xyes ; then - echo "$as_me:20183: checking for wchar_t" >&5 + echo "$as_me:20102: checking for wchar_t" >&5 echo $ECHO_N "checking for wchar_t... $ECHO_C" >&6 if test "${ac_cv_type_wchar_t+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF -#line 20189 "configure" +#line 20108 "configure" #include "confdefs.h" $ac_includes_default int @@ -20201,16 +20120,16 @@ if (sizeof (wchar_t)) } _ACEOF rm -f conftest.$ac_objext -if { (eval echo "$as_me:20204: \"$ac_compile\"") >&5 +if { (eval echo "$as_me:20123: \"$ac_compile\"") >&5 (eval $ac_compile) 2>&5 ac_status=$? - echo "$as_me:20207: \$? = $ac_status" >&5 + echo "$as_me:20126: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -s conftest.$ac_objext' - { (eval echo "$as_me:20210: \"$ac_try\"") >&5 + { (eval echo "$as_me:20129: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? - echo "$as_me:20213: \$? = $ac_status" >&5 + echo "$as_me:20132: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_type_wchar_t=yes else @@ -20220,10 +20139,10 @@ ac_cv_type_wchar_t=no fi rm -f conftest.$ac_objext conftest.$ac_ext fi -echo "$as_me:20223: result: $ac_cv_type_wchar_t" >&5 +echo "$as_me:20142: result: $ac_cv_type_wchar_t" >&5 echo "${ECHO_T}$ac_cv_type_wchar_t" >&6 -echo "$as_me:20226: checking size of wchar_t" >&5 +echo "$as_me:20145: checking size of wchar_t" >&5 echo $ECHO_N "checking size of wchar_t... $ECHO_C" >&6 if test "${ac_cv_sizeof_wchar_t+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 @@ -20232,7 +20151,7 @@ else if test "$cross_compiling" = yes; then # Depending upon the size, compute the lo and hi bounds. cat >conftest.$ac_ext <<_ACEOF -#line 20235 "configure" +#line 20154 "configure" #include "confdefs.h" $ac_includes_default int @@ -20244,21 +20163,21 @@ int _array_ [1 - 2 * !((sizeof (wchar_t)) >= 0)] } _ACEOF rm -f conftest.$ac_objext -if { (eval echo "$as_me:20247: \"$ac_compile\"") >&5 +if { (eval echo "$as_me:20166: \"$ac_compile\"") >&5 (eval $ac_compile) 2>&5 ac_status=$? - echo "$as_me:20250: \$? = $ac_status" >&5 + echo "$as_me:20169: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -s conftest.$ac_objext' - { (eval echo "$as_me:20253: \"$ac_try\"") >&5 + { (eval echo "$as_me:20172: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? - echo "$as_me:20256: \$? = $ac_status" >&5 + echo "$as_me:20175: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_lo=0 ac_mid=0 while :; do cat >conftest.$ac_ext <<_ACEOF -#line 20261 "configure" +#line 20180 "configure" #include "confdefs.h" $ac_includes_default int @@ -20270,16 +20189,16 @@ int _array_ [1 - 2 * !((sizeof (wchar_t)) <= $ac_mid)] } _ACEOF rm -f conftest.$ac_objext -if { (eval echo "$as_me:20273: \"$ac_compile\"") >&5 +if { (eval echo "$as_me:20192: \"$ac_compile\"") >&5 (eval $ac_compile) 2>&5 ac_status=$? - echo "$as_me:20276: \$? = $ac_status" >&5 + echo "$as_me:20195: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -s conftest.$ac_objext' - { (eval echo "$as_me:20279: \"$ac_try\"") >&5 + { (eval echo "$as_me:20198: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? - echo "$as_me:20282: \$? = $ac_status" >&5 + echo "$as_me:20201: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=$ac_mid; break else @@ -20295,7 +20214,7 @@ cat conftest.$ac_ext >&5 ac_hi=-1 ac_mid=-1 while :; do cat >conftest.$ac_ext <<_ACEOF -#line 20298 "configure" +#line 20217 "configure" #include "confdefs.h" $ac_includes_default int @@ -20307,16 +20226,16 @@ int _array_ [1 - 2 * !((sizeof (wchar_t)) >= $ac_mid)] } _ACEOF rm -f conftest.$ac_objext -if { (eval echo "$as_me:20310: \"$ac_compile\"") >&5 +if { (eval echo "$as_me:20229: \"$ac_compile\"") >&5 (eval $ac_compile) 2>&5 ac_status=$? - echo "$as_me:20313: \$? = $ac_status" >&5 + echo "$as_me:20232: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -s conftest.$ac_objext' - { (eval echo "$as_me:20316: \"$ac_try\"") >&5 + { (eval echo "$as_me:20235: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? - echo "$as_me:20319: \$? = $ac_status" >&5 + echo "$as_me:20238: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_lo=$ac_mid; break else @@ -20332,7 +20251,7 @@ rm -f conftest.$ac_objext conftest.$ac_ext while test "x$ac_lo" != "x$ac_hi"; do ac_mid=`expr '(' $ac_hi - $ac_lo ')' / 2 + $ac_lo` cat >conftest.$ac_ext <<_ACEOF -#line 20335 "configure" +#line 20254 "configure" #include "confdefs.h" $ac_includes_default int @@ -20344,16 +20263,16 @@ int _array_ [1 - 2 * !((sizeof (wchar_t)) <= $ac_mid)] } _ACEOF rm -f conftest.$ac_objext -if { (eval echo "$as_me:20347: \"$ac_compile\"") >&5 +if { (eval echo "$as_me:20266: \"$ac_compile\"") >&5 (eval $ac_compile) 2>&5 ac_status=$? - echo "$as_me:20350: \$? = $ac_status" >&5 + echo "$as_me:20269: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -s conftest.$ac_objext' - { (eval echo "$as_me:20353: \"$ac_try\"") >&5 + { (eval echo "$as_me:20272: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? - echo "$as_me:20356: \$? = $ac_status" >&5 + echo "$as_me:20275: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_hi=$ac_mid else @@ -20366,12 +20285,12 @@ done ac_cv_sizeof_wchar_t=$ac_lo else if test "$cross_compiling" = yes; then - { { echo "$as_me:20369: error: cannot run test program while cross compiling" >&5 + { { echo "$as_me:20288: error: cannot run test program while cross compiling" >&5 echo "$as_me: error: cannot run test program while cross compiling" >&2;} { (exit 1); exit 1; }; } else cat >conftest.$ac_ext <<_ACEOF -#line 20374 "configure" +#line 20293 "configure" #include "confdefs.h" $ac_includes_default int @@ -20387,15 +20306,15 @@ fclose (f); } _ACEOF rm -f conftest$ac_exeext -if { (eval echo "$as_me:20390: \"$ac_link\"") >&5 +if { (eval echo "$as_me:20309: \"$ac_link\"") >&5 (eval $ac_link) 2>&5 ac_status=$? - echo "$as_me:20393: \$? = $ac_status" >&5 + echo "$as_me:20312: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' - { (eval echo "$as_me:20395: \"$ac_try\"") >&5 + { (eval echo "$as_me:20314: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? - echo "$as_me:20398: \$? = $ac_status" >&5 + echo "$as_me:20317: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_sizeof_wchar_t=`cat conftest.val` else @@ -20411,7 +20330,7 @@ else ac_cv_sizeof_wchar_t=0 fi fi -echo "$as_me:20414: result: $ac_cv_sizeof_wchar_t" >&5 +echo "$as_me:20333: result: $ac_cv_sizeof_wchar_t" >&5 echo "${ECHO_T}$ac_cv_sizeof_wchar_t" >&6 cat >>confdefs.h <&5 +echo "$as_me:20351: checking for library subsets" >&5 echo $ECHO_N "checking for library subsets... $ECHO_C" >&6 LIB_SUBSETS= @@ -20470,7 +20389,7 @@ fi test "x$with_widec" = xyes && LIB_SUBSETS="${LIB_SUBSETS}+widechar" test "x$with_ext_funcs" = xyes && LIB_SUBSETS="${LIB_SUBSETS}+ext_funcs" -echo "$as_me:20473: result: $LIB_SUBSETS" >&5 +echo "$as_me:20392: result: $LIB_SUBSETS" >&5 echo "${ECHO_T}$LIB_SUBSETS" >&6 ### Construct the list of include-directories to be generated @@ -20508,7 +20427,7 @@ elif test "$includedir" != "/usr/include"; then fi ### Build up pieces for makefile rules -echo "$as_me:20511: checking default library suffix" >&5 +echo "$as_me:20430: checking default library suffix" >&5 echo $ECHO_N "checking default library suffix... $ECHO_C" >&6 case $DFT_LWR_MODEL in @@ -20519,10 +20438,10 @@ echo $ECHO_N "checking default library suffix... $ECHO_C" >&6 shared) DFT_ARG_SUFFIX='' ;; esac test -n "$LIB_SUFFIX" && DFT_ARG_SUFFIX="${LIB_SUFFIX}${DFT_ARG_SUFFIX}" -echo "$as_me:20522: result: $DFT_ARG_SUFFIX" >&5 +echo "$as_me:20441: result: $DFT_ARG_SUFFIX" >&5 echo "${ECHO_T}$DFT_ARG_SUFFIX" >&6 -echo "$as_me:20525: checking default library-dependency suffix" >&5 +echo "$as_me:20444: checking default library-dependency suffix" >&5 echo $ECHO_N "checking default library-dependency suffix... $ECHO_C" >&6 case X$DFT_LWR_MODEL in #(vi @@ -20577,10 +20496,10 @@ echo $ECHO_N "checking default library-dependency suffix... $ECHO_C" >&6 esac test -n "$LIB_SUFFIX" && DFT_LIB_SUFFIX="${LIB_SUFFIX}${DFT_LIB_SUFFIX}" test -n "$LIB_SUFFIX" && DFT_DEP_SUFFIX="${LIB_SUFFIX}${DFT_DEP_SUFFIX}" -echo "$as_me:20580: result: $DFT_DEP_SUFFIX" >&5 +echo "$as_me:20499: result: $DFT_DEP_SUFFIX" >&5 echo "${ECHO_T}$DFT_DEP_SUFFIX" >&6 -echo "$as_me:20583: checking default object directory" >&5 +echo "$as_me:20502: checking default object directory" >&5 echo $ECHO_N "checking default object directory... $ECHO_C" >&6 case $DFT_LWR_MODEL in @@ -20596,11 +20515,11 @@ echo $ECHO_N "checking default object directory... $ECHO_C" >&6 DFT_OBJ_SUBDIR='obj_s' ;; esac esac -echo "$as_me:20599: result: $DFT_OBJ_SUBDIR" >&5 +echo "$as_me:20518: result: $DFT_OBJ_SUBDIR" >&5 echo "${ECHO_T}$DFT_OBJ_SUBDIR" >&6 if test "x$cf_with_cxx" = xyes ; then -echo "$as_me:20603: checking c++ library-dependency suffix" >&5 +echo "$as_me:20522: checking c++ library-dependency suffix" >&5 echo $ECHO_N "checking c++ library-dependency suffix... $ECHO_C" >&6 if test "$with_libtool" != "no"; then # libtool thinks it can make c++ shared libraries (perhaps only g++) @@ -20665,7 +20584,7 @@ else test -n "$LIB_SUFFIX" && CXX_DEP_SUFFIX="${LIB_SUFFIX}${CXX_DEP_SUFFIX}" fi -echo "$as_me:20668: result: $CXX_LIB_SUFFIX" >&5 +echo "$as_me:20587: result: $CXX_LIB_SUFFIX" >&5 echo "${ECHO_T}$CXX_LIB_SUFFIX" >&6 fi @@ -20830,19 +20749,19 @@ fi if test -n "$LDFLAGS_STATIC" && test -n "$LDFLAGS_SHARED" then - echo "$as_me:20833: checking if linker supports switching between static/dynamic" >&5 + echo "$as_me:20752: checking if linker supports switching between static/dynamic" >&5 echo $ECHO_N "checking if linker supports switching between static/dynamic... $ECHO_C" >&6 rm -f libconftest.a cat >conftest.$ac_ext < int cf_ldflags_static(FILE *fp) { return fflush(fp); } EOF - if { (eval echo "$as_me:20842: \"$ac_compile\"") >&5 + if { (eval echo "$as_me:20761: \"$ac_compile\"") >&5 (eval $ac_compile) 2>&5 ac_status=$? - echo "$as_me:20845: \$? = $ac_status" >&5 + echo "$as_me:20764: \$? = $ac_status" >&5 (exit $ac_status); } ; then ( $AR $ARFLAGS libconftest.a conftest.o ) 2>&5 1>/dev/null ( eval $RANLIB libconftest.a ) 2>&5 >/dev/null @@ -20853,10 +20772,10 @@ EOF LIBS="$LDFLAGS_STATIC -L`pwd` -lconftest $LDFLAGS_DYNAMIC $LIBS" cat >conftest.$ac_ext <<_ACEOF -#line 20856 "configure" +#line 20775 "configure" #include "confdefs.h" -#line 20859 "configure" +#line 20778 "configure" #include int cf_ldflags_static(FILE *fp); @@ -20871,16 +20790,16 @@ main () } _ACEOF rm -f conftest.$ac_objext conftest$ac_exeext -if { (eval echo "$as_me:20874: \"$ac_link\"") >&5 +if { (eval echo "$as_me:20793: \"$ac_link\"") >&5 (eval $ac_link) 2>&5 ac_status=$? - echo "$as_me:20877: \$? = $ac_status" >&5 + echo "$as_me:20796: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -s conftest$ac_exeext' - { (eval echo "$as_me:20880: \"$ac_try\"") >&5 + { (eval echo "$as_me:20799: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? - echo "$as_me:20883: \$? = $ac_status" >&5 + echo "$as_me:20802: \$? = $ac_status" >&5 (exit $ac_status); }; }; then # some linkers simply ignore the -dynamic @@ -20903,7 +20822,7 @@ rm -f conftest.$ac_objext conftest$ac_exeext conftest.$ac_ext rm -f libconftest.* LIBS="$cf_save_LIBS" - echo "$as_me:20906: result: $cf_ldflags_static" >&5 + echo "$as_me:20825: result: $cf_ldflags_static" >&5 echo "${ECHO_T}$cf_ldflags_static" >&6 if test $cf_ldflags_static != yes @@ -20919,7 +20838,7 @@ fi ;; esac -echo "$as_me:20922: checking where we will install curses.h" >&5 +echo "$as_me:20841: checking where we will install curses.h" >&5 echo $ECHO_N "checking where we will install curses.h... $ECHO_C" >&6 includesubdir= @@ -20929,7 +20848,7 @@ if test "$with_overwrite" = no && \ then includesubdir="/ncurses${LIB_SUFFIX}" fi -echo "$as_me:20932: result: ${includedir}${includesubdir}" >&5 +echo "$as_me:20851: result: ${includedir}${includesubdir}" >&5 echo "${ECHO_T}${includedir}${includesubdir}" >&6 ### Resolve a conflict between normal and wide-curses by forcing applications @@ -20937,7 +20856,7 @@ echo "${ECHO_T}${includedir}${includesubdir}" >&6 if test "$with_overwrite" != no ; then if test "$NCURSES_LIBUTF8" = 1 ; then NCURSES_LIBUTF8='defined(HAVE_LIBUTF8_H)' - { echo "$as_me:20940: WARNING: Wide-character applications must define HAVE_LIBUTF8_H to include curses.h" >&5 + { echo "$as_me:20859: WARNING: Wide-character applications must define HAVE_LIBUTF8_H to include curses.h" >&5 echo "$as_me: WARNING: Wide-character applications must define HAVE_LIBUTF8_H to include curses.h" >&2;} fi fi @@ -20955,7 +20874,7 @@ EOF ### Construct the list of subdirectories for which we'll customize makefiles ### with the appropriate compile-rules. -echo "$as_me:20958: checking for src modules" >&5 +echo "$as_me:20877: checking for src modules" >&5 echo $ECHO_N "checking for src modules... $ECHO_C" >&6 # dependencies and linker-arguments for test-programs @@ -21020,7 +20939,7 @@ EOF fi fi done -echo "$as_me:21023: result: $cf_cv_src_modules" >&5 +echo "$as_me:20942: result: $cf_cv_src_modules" >&5 echo "${ECHO_T}$cf_cv_src_modules" >&6 TEST_ARGS="-L${LIB_DIR} $TEST_ARGS" @@ -21241,7 +21160,7 @@ fi # Extract the first word of "tic", so it can be a program name with args. set dummy tic; ac_word=$2 -echo "$as_me:21244: checking for $ac_word" >&5 +echo "$as_me:21163: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 if test "${ac_cv_path_TIC_PATH+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 @@ -21258,7 +21177,7 @@ for ac_dir in $ac_dummy; do test -z "$ac_dir" && ac_dir=. if $as_executable_p "$ac_dir/$ac_word"; then ac_cv_path_TIC_PATH="$ac_dir/$ac_word" - echo "$as_me:21261: found $ac_dir/$ac_word" >&5 + echo "$as_me:21180: found $ac_dir/$ac_word" >&5 break fi done @@ -21270,10 +21189,10 @@ fi TIC_PATH=$ac_cv_path_TIC_PATH if test -n "$TIC_PATH"; then - echo "$as_me:21273: result: $TIC_PATH" >&5 + echo "$as_me:21192: result: $TIC_PATH" >&5 echo "${ECHO_T}$TIC_PATH" >&6 else - echo "$as_me:21276: result: no" >&5 + echo "$as_me:21195: result: no" >&5 echo "${ECHO_T}no" >&6 fi @@ -21281,7 +21200,7 @@ if test -n "$FALLBACK_LIST" then if test "$TIC_PATH" = unknown then - { echo "$as_me:21284: WARNING: no tic program found for fallbacks" >&5 + { echo "$as_me:21203: WARNING: no tic program found for fallbacks" >&5 echo "$as_me: WARNING: no tic program found for fallbacks" >&2;} fi fi @@ -21307,7 +21226,7 @@ solaris2*) #(vi *-D_XOPEN_SOURCE_EXTENDED*) test -n "$verbose" && echo " moving _XOPEN_SOURCE_EXTENDED to work around g++ problem" 1>&6 -echo "${as_me:-configure}:21310: testing moving _XOPEN_SOURCE_EXTENDED to work around g++ problem ..." 1>&5 +echo "${as_me:-configure}:21229: testing moving _XOPEN_SOURCE_EXTENDED to work around g++ problem ..." 1>&5 CFLAGS="$CFLAGS -D_XOPEN_SOURCE_EXTENDED" CPPFLAGS=`echo "x$CPPFLAGS" | sed -e 's/^.//' -e 's/-D_XOPEN_SOURCE_EXTENDED//'` @@ -21425,7 +21344,7 @@ DEFS=-DHAVE_CONFIG_H : ${CONFIG_STATUS=./config.status} ac_clean_files_save=$ac_clean_files ac_clean_files="$ac_clean_files $CONFIG_STATUS" -{ echo "$as_me:21428: creating $CONFIG_STATUS" >&5 +{ echo "$as_me:21347: creating $CONFIG_STATUS" >&5 echo "$as_me: creating $CONFIG_STATUS" >&6;} cat >$CONFIG_STATUS <<_ACEOF #! $SHELL @@ -21601,7 +21520,7 @@ cat >>$CONFIG_STATUS <<\EOF echo "$ac_cs_version"; exit 0 ;; --he | --h) # Conflict between --help and --header - { { echo "$as_me:21604: error: ambiguous option: $1 + { { echo "$as_me:21523: error: ambiguous option: $1 Try \`$0 --help' for more information." >&5 echo "$as_me: error: ambiguous option: $1 Try \`$0 --help' for more information." >&2;} @@ -21620,7 +21539,7 @@ Try \`$0 --help' for more information." >&2;} ac_need_defaults=false;; # This is an error. - -*) { { echo "$as_me:21623: error: unrecognized option: $1 + -*) { { echo "$as_me:21542: error: unrecognized option: $1 Try \`$0 --help' for more information." >&5 echo "$as_me: error: unrecognized option: $1 Try \`$0 --help' for more information." >&2;} @@ -21685,7 +21604,6 @@ TINFO_ARG_SUFFIX="$TINFO_ARG_SUFFIX" TINFO_LIB_SUFFIX="$TINFO_LIB_SUFFIX" TINFO_NAME="$TINFO_NAME" TINFO_SUFFIX="$TINFO_SUFFIX" -USE_OLD_MAKERULES="$USE_OLD_MAKERULES" WITH_CURSES_H="$with_curses_h" WITH_ECHO="${enable_echo:=yes}" WITH_OVERWRITE="$with_overwrite" @@ -21731,7 +21649,7 @@ do "Makefile" ) CONFIG_FILES="$CONFIG_FILES Makefile" ;; "default" ) CONFIG_COMMANDS="$CONFIG_COMMANDS default" ;; "include/ncurses_cfg.h" ) CONFIG_HEADERS="$CONFIG_HEADERS include/ncurses_cfg.h:include/ncurses_cfg.hin" ;; - *) { { echo "$as_me:21734: error: invalid argument: $ac_config_target" >&5 + *) { { echo "$as_me:21652: error: invalid argument: $ac_config_target" >&5 echo "$as_me: error: invalid argument: $ac_config_target" >&2;} { (exit 1); exit 1; }; };; esac @@ -21997,10 +21915,6 @@ s,@cf_ada_make@,$cf_ada_make,;t t s,@cf_compile_generics@,$cf_compile_generics,;t t s,@cf_generic_objects@,$cf_generic_objects,;t t s,@USE_GNAT_SIGINT@,$USE_GNAT_SIGINT,;t t -s,@PRAGMA_UNREF@,$PRAGMA_UNREF,;t t -s,@USE_OLD_MAKERULES@,$USE_OLD_MAKERULES,;t t -s,@USE_GNAT_PROJECTS@,$USE_GNAT_PROJECTS,;t t -s,@USE_GNAT_LIBRARIES@,$USE_GNAT_LIBRARIES,;t t s,@cf_ada_compiler@,$cf_ada_compiler,;t t s,@cf_ada_package@,$cf_ada_package,;t t s,@ADA_INCLUDE@,$ADA_INCLUDE,;t t @@ -22166,7 +22080,7 @@ done; } esac if test x"$ac_file" != x-; then - { echo "$as_me:22169: creating $ac_file" >&5 + { echo "$as_me:22083: creating $ac_file" >&5 echo "$as_me: creating $ac_file" >&6;} rm -f "$ac_file" fi @@ -22184,7 +22098,7 @@ echo "$as_me: creating $ac_file" >&6;} -) echo $tmp/stdin ;; [\\/$]*) # Absolute (can't be DOS-style, as IFS=:) - test -f "$f" || { { echo "$as_me:22187: error: cannot find input file: $f" >&5 + test -f "$f" || { { echo "$as_me:22101: error: cannot find input file: $f" >&5 echo "$as_me: error: cannot find input file: $f" >&2;} { (exit 1); exit 1; }; } echo $f;; @@ -22197,7 +22111,7 @@ echo "$as_me: error: cannot find input file: $f" >&2;} echo $srcdir/$f else # /dev/null tree - { { echo "$as_me:22200: error: cannot find input file: $f" >&5 + { { echo "$as_me:22114: error: cannot find input file: $f" >&5 echo "$as_me: error: cannot find input file: $f" >&2;} { (exit 1); exit 1; }; } fi;; @@ -22213,7 +22127,7 @@ cat >>$CONFIG_STATUS <<\EOF if test -n "$ac_seen"; then ac_used=`grep '@datarootdir@' $ac_item` if test -z "$ac_used"; then - { echo "$as_me:22216: WARNING: datarootdir was used implicitly but not set: + { echo "$as_me:22130: WARNING: datarootdir was used implicitly but not set: $ac_seen" >&5 echo "$as_me: WARNING: datarootdir was used implicitly but not set: $ac_seen" >&2;} @@ -22222,7 +22136,7 @@ $ac_seen" >&2;} fi ac_seen=`grep '${datarootdir}' $ac_item` if test -n "$ac_seen"; then - { echo "$as_me:22225: WARNING: datarootdir was used explicitly but not set: + { echo "$as_me:22139: WARNING: datarootdir was used explicitly but not set: $ac_seen" >&5 echo "$as_me: WARNING: datarootdir was used explicitly but not set: $ac_seen" >&2;} @@ -22259,7 +22173,7 @@ s,@INSTALL@,$ac_INSTALL,;t t ac_init=`egrep '[ ]*'$ac_name'[ ]*=' $ac_file` if test -z "$ac_init"; then ac_seen=`echo "$ac_seen" |sed -e 's,^,'$ac_file':,'` - { echo "$as_me:22262: WARNING: Variable $ac_name is used but was not set: + { echo "$as_me:22176: WARNING: Variable $ac_name is used but was not set: $ac_seen" >&5 echo "$as_me: WARNING: Variable $ac_name is used but was not set: $ac_seen" >&2;} @@ -22270,7 +22184,7 @@ $ac_seen" >&2;} egrep -n '@[A-Z_][A-Z_0-9]+@' $ac_file >>$tmp/out if test -s $tmp/out; then ac_seen=`sed -e 's,^,'$ac_file':,' < $tmp/out` - { echo "$as_me:22273: WARNING: Some variables may not be substituted: + { echo "$as_me:22187: WARNING: Some variables may not be substituted: $ac_seen" >&5 echo "$as_me: WARNING: Some variables may not be substituted: $ac_seen" >&2;} @@ -22319,7 +22233,7 @@ for ac_file in : $CONFIG_HEADERS; do test "x$ac_file" = x: && continue * ) ac_file_in=$ac_file.in ;; esac - test x"$ac_file" != x- && { echo "$as_me:22322: creating $ac_file" >&5 + test x"$ac_file" != x- && { echo "$as_me:22236: creating $ac_file" >&5 echo "$as_me: creating $ac_file" >&6;} # First look for the input files in the build tree, otherwise in the @@ -22330,7 +22244,7 @@ echo "$as_me: creating $ac_file" >&6;} -) echo $tmp/stdin ;; [\\/$]*) # Absolute (can't be DOS-style, as IFS=:) - test -f "$f" || { { echo "$as_me:22333: error: cannot find input file: $f" >&5 + test -f "$f" || { { echo "$as_me:22247: error: cannot find input file: $f" >&5 echo "$as_me: error: cannot find input file: $f" >&2;} { (exit 1); exit 1; }; } echo $f;; @@ -22343,7 +22257,7 @@ echo "$as_me: error: cannot find input file: $f" >&2;} echo $srcdir/$f else # /dev/null tree - { { echo "$as_me:22346: error: cannot find input file: $f" >&5 + { { echo "$as_me:22260: error: cannot find input file: $f" >&5 echo "$as_me: error: cannot find input file: $f" >&2;} { (exit 1); exit 1; }; } fi;; @@ -22401,7 +22315,7 @@ cat >>$CONFIG_STATUS <<\EOF rm -f $tmp/in if test x"$ac_file" != x-; then if cmp -s $ac_file $tmp/config.h 2>/dev/null; then - { echo "$as_me:22404: $ac_file is unchanged" >&5 + { echo "$as_me:22318: $ac_file is unchanged" >&5 echo "$as_me: $ac_file is unchanged" >&6;} else ac_dir=`$as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ @@ -22704,7 +22618,7 @@ cf_ITEM=`echo "$cf_item" | sed y%abcdefghijklmnopqrstuvwxyz./-%ABCDEFGHIJKLMNOPQ cygdll|msysdll|mingw) #(vi test "x$with_shared_cxx" = xno && test -n "$verbose" && echo " overriding CXX_MODEL to SHARED" 1>&6 -echo "${as_me:-configure}:22707: testing overriding CXX_MODEL to SHARED ..." 1>&5 +echo "${as_me:-configure}:22621: testing overriding CXX_MODEL to SHARED ..." 1>&5 with_shared_cxx=yes ;; @@ -23093,9 +23007,7 @@ CF_EOF done if test "x$cf_with_ada" = "xyes" && test "x$cf_cv_prog_gnat_correct" = "xyes"; then -if test -z "$USE_OLD_MAKERULES" ; then $AWK -f $srcdir/Ada95/mk-1st.awk <$srcdir/Ada95/src/modules >>Ada95/src/Makefile -fi fi ;; esac diff --git a/configure.in b/configure.in index 75027874..d8fe13fd 100644 --- a/configure.in +++ b/configure.in @@ -28,14 +28,14 @@ dnl*************************************************************************** dnl dnl Author: Thomas E. Dickey 1995-on dnl -dnl $Id: configure.in,v 1.579 2014/04/26 20:02:13 tom Exp $ +dnl $Id: configure.in,v 1.580 2014/05/24 21:23:43 tom Exp $ dnl Process this file with autoconf to produce a configure script. dnl dnl See http://invisible-island.net/autoconf/ for additional information. dnl dnl --------------------------------------------------------------------------- AC_PREREQ(2.52.20030208) -AC_REVISION($Revision: 1.579 $) +AC_REVISION($Revision: 1.580 $) AC_INIT(ncurses/base/lib_initscr.c) AC_CONFIG_HEADER(include/ncurses_cfg.h:include/ncurses_cfg.hin) @@ -1620,8 +1620,6 @@ dnl At the moment we support no other Ada95 compiler. CF_GNAT_GENERICS CF_GNAT_SIGINT - CF_GNAT_PRAGMA_UNREF - CF_GNAT_PROJECTS CF_WITH_ADA_COMPILER @@ -2019,10 +2017,8 @@ fi CF_LIB_RULES($SRC_SUBDIRS) if test "x$cf_with_ada" = "xyes" && test "x$cf_cv_prog_gnat_correct" = "xyes"; then -if test -z "$USE_OLD_MAKERULES" ; then $AWK -f $srcdir/Ada95/mk-1st.awk <$srcdir/Ada95/src/modules >>Ada95/src/Makefile fi -fi ],[ ### Special initialization commands, used to pass information from the ### configuration-run into config.status @@ -2054,7 +2050,6 @@ TINFO_ARG_SUFFIX="$TINFO_ARG_SUFFIX" TINFO_LIB_SUFFIX="$TINFO_LIB_SUFFIX" TINFO_NAME="$TINFO_NAME" TINFO_SUFFIX="$TINFO_SUFFIX" -USE_OLD_MAKERULES="$USE_OLD_MAKERULES" WITH_CURSES_H="$with_curses_h" WITH_ECHO="${enable_echo:=yes}" WITH_OVERWRITE="$with_overwrite" diff --git a/dist.mk b/dist.mk index afddfc27..8082377b 100644 --- a/dist.mk +++ b/dist.mk @@ -25,7 +25,7 @@ # use or other dealings in this Software without prior written # # authorization. # ############################################################################## -# $Id: dist.mk,v 1.985 2014/05/10 14:37:35 tom Exp $ +# $Id: dist.mk,v 1.986 2014/05/21 10:14:18 tom Exp $ # Makefile for creating ncurses distributions. # # This only needs to be used directly as a makefile by developers, but @@ -37,7 +37,7 @@ SHELL = /bin/sh # These define the major/minor/patch versions of ncurses. NCURSES_MAJOR = 5 NCURSES_MINOR = 9 -NCURSES_PATCH = 20140510 +NCURSES_PATCH = 20140524 # We don't append the patch to the version, since this only applies to releases VERSION = $(NCURSES_MAJOR).$(NCURSES_MINOR) diff --git a/doc/html/ada/files/T.htm b/doc/html/ada/files/T.htm index dcb0cd42..b54027bb 100644 --- a/doc/html/ada/files/T.htm +++ b/doc/html/ada/files/T.htm @@ -78,5 +78,6 @@
  • terminal_interface-curses-trace.ads
  • terminal_interface-curses.adb
  • terminal_interface-curses.ads +
  • terminal_interface-curses_constants.ads
  • terminal_interface.ads diff --git a/doc/html/ada/funcs/A.htm b/doc/html/ada/funcs/A.htm index 73f0dd41..e784abdb 100644 --- a/doc/html/ada/funcs/A.htm +++ b/doc/html/ada/funcs/A.htm @@ -8,21 +8,22 @@

    Functions - A

    [index] diff --git a/doc/html/ada/funcs/B.htm b/doc/html/ada/funcs/B.htm index 511e6d0b..e14c876a 100644 --- a/doc/html/ada/funcs/B.htm +++ b/doc/html/ada/funcs/B.htm @@ -8,18 +8,18 @@

    Functions - B

    [index] diff --git a/doc/html/ada/funcs/C.htm b/doc/html/ada/funcs/C.htm index 12c97fb5..30c070f8 100644 --- a/doc/html/ada/funcs/C.htm +++ b/doc/html/ada/funcs/C.htm @@ -8,52 +8,55 @@

    Functions - C

    [index] diff --git a/doc/html/ada/funcs/H.htm b/doc/html/ada/funcs/H.htm index db9b50dd..ee7c6706 100644 --- a/doc/html/ada/funcs/H.htm +++ b/doc/html/ada/funcs/H.htm @@ -8,19 +8,19 @@

    Functions - H

    [index] diff --git a/doc/html/ada/funcs/I.htm b/doc/html/ada/funcs/I.htm index 22ed0392..aec05979 100644 --- a/doc/html/ada/funcs/I.htm +++ b/doc/html/ada/funcs/I.htm @@ -8,48 +8,48 @@

    Functions - I

    [index] diff --git a/doc/html/ada/funcs/K.htm b/doc/html/ada/funcs/K.htm index f1f5316e..45ee508a 100644 --- a/doc/html/ada/funcs/K.htm +++ b/doc/html/ada/funcs/K.htm @@ -9,10 +9,10 @@ [index] diff --git a/doc/html/ada/funcs/L.htm b/doc/html/ada/funcs/L.htm index 3f0e3acb..4047e8bc 100644 --- a/doc/html/ada/funcs/L.htm +++ b/doc/html/ada/funcs/L.htm @@ -8,17 +8,18 @@

    Functions - L

    [index] diff --git a/doc/html/ada/funcs/M.htm b/doc/html/ada/funcs/M.htm index 0bf76abc..95207f36 100644 --- a/doc/html/ada/funcs/M.htm +++ b/doc/html/ada/funcs/M.htm @@ -8,48 +8,48 @@

    Functions - M

    [index] diff --git a/doc/html/ada/funcs/N.htm b/doc/html/ada/funcs/N.htm index 50fa1a2c..4f8c9dee 100644 --- a/doc/html/ada/funcs/N.htm +++ b/doc/html/ada/funcs/N.htm @@ -8,32 +8,32 @@

    Functions - N

    [index] diff --git a/doc/html/ada/funcs/O.htm b/doc/html/ada/funcs/O.htm index 0c9189a6..c8606747 100644 --- a/doc/html/ada/funcs/O.htm +++ b/doc/html/ada/funcs/O.htm @@ -9,8 +9,8 @@ [index] diff --git a/doc/html/ada/funcs/P.htm b/doc/html/ada/funcs/P.htm index 06133d48..d3b3ca0a 100644 --- a/doc/html/ada/funcs/P.htm +++ b/doc/html/ada/funcs/P.htm @@ -8,33 +8,33 @@

    Functions - P

    [index] diff --git a/doc/html/ada/terminal_interface-curses-aux__adb.htm b/doc/html/ada/terminal_interface-curses-aux__adb.htm index d817b690..f36a3637 100644 --- a/doc/html/ada/terminal_interface-curses-aux__adb.htm +++ b/doc/html/ada/terminal_interface-curses-aux__adb.htm @@ -55,80 +55,80 @@ -- @Revision: 1.11 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ -package body Terminal_Interface.Curses.Aux is +package body Terminal_Interface.Curses.Aux is -- -- Some helpers - procedure Fill_String (Cp : chars_ptr; - Str : out String) + procedure Fill_String (Cp : chars_ptr; + Str : out String) is -- Fill the string with the characters referenced by the -- chars_ptr. -- Len : Natural; begin - if Cp /= Null_Ptr then - Len := Natural (Strlen (Cp)); - if Str'Length < Len then + if Cp /= Null_Ptr then + Len := Natural (Strlen (Cp)); + if Str'Length < Len then raise Constraint_Error; end if; declare S : String (1 .. Len); begin - S := Value (Cp); - Str (Str'First .. (Str'First + Len - 1)) := S (S'Range); + S := Value (Cp); + Str (Str'First .. (Str'First + Len - 1)) := S (S'Range); end; else Len := 0; end if; - if Len < Str'Length then - Str ((Str'First + Len) .. Str'Last) := (others => ' '); + if Len < Str'Length then + Str ((Str'First + Len) .. Str'Last) := (others => ' '); end if; - end Fill_String; + end Fill_String; - function Fill_String (Cp : chars_ptr) return String + function Fill_String (Cp : chars_ptr) return String is Len : Natural; begin - if Cp /= Null_Ptr then - Len := Natural (Strlen (Cp)); + if Cp /= Null_Ptr then + Len := Natural (Strlen (Cp)); if Len = 0 then return ""; else declare S : String (1 .. Len); begin - Fill_String (Cp, S); + Fill_String (Cp, S); return S; end; end if; else return ""; end if; - end Fill_String; + end Fill_String; - procedure Eti_Exception (Code : Eti_Error) + procedure Eti_Exception (Code : Eti_Error) is begin - case Code is - when E_Ok => null; - when E_System_Error => raise Eti_System_Error; - when E_Bad_Argument => raise Eti_Bad_Argument; - when E_Posted => raise Eti_Posted; - when E_Connected => raise Eti_Connected; - when E_Bad_State => raise Eti_Bad_State; - when E_No_Room => raise Eti_No_Room; - when E_Not_Posted => raise Eti_Not_Posted; - when E_Unknown_Command => raise Eti_Unknown_Command; - when E_No_Match => raise Eti_No_Match; - when E_Not_Selectable => raise Eti_Not_Selectable; - when E_Not_Connected => raise Eti_Not_Connected; - when E_Request_Denied => raise Eti_Request_Denied; - when E_Invalid_Field => raise Eti_Invalid_Field; - when E_Current => raise Eti_Current; + case Code is + when E_Ok => null; + when E_System_Error => raise Eti_System_Error; + when E_Bad_Argument => raise Eti_Bad_Argument; + when E_Posted => raise Eti_Posted; + when E_Connected => raise Eti_Connected; + when E_Bad_State => raise Eti_Bad_State; + when E_No_Room => raise Eti_No_Room; + when E_Not_Posted => raise Eti_Not_Posted; + when E_Unknown_Command => raise Eti_Unknown_Command; + when E_No_Match => raise Eti_No_Match; + when E_Not_Selectable => raise Eti_Not_Selectable; + when E_Not_Connected => raise Eti_Not_Connected; + when E_Request_Denied => raise Eti_Request_Denied; + when E_Invalid_Field => raise Eti_Invalid_Field; + when E_Current => raise Eti_Current; end case; - end Eti_Exception; + end Eti_Exception; -end Terminal_Interface.Curses.Aux; +end Terminal_Interface.Curses.Aux; diff --git a/doc/html/ada/terminal_interface-curses-aux__ads.htm b/doc/html/ada/terminal_interface-curses-aux__ads.htm index 932ebf14..391ab733 100644 --- a/doc/html/ada/terminal_interface-curses-aux__ads.htm +++ b/doc/html/ada/terminal_interface-curses-aux__ads.htm @@ -24,7 +24,7 @@ -- S P E C -- -- -- ------------------------------------------------------------------------------ --- Copyright (c) 1998-2009,2011 Free Software Foundation, Inc. -- +-- Copyright (c) 1998-2011,2014 Free Software Foundation, Inc. -- -- -- -- Permission is hereby granted, free of charge, to any person obtaining a -- -- copy of this software and associated documentation files (the -- @@ -52,91 +52,86 @@ ------------------------------------------------------------------------------ -- Author: Juergen Pfeifer, 1996 -- Version Control: --- @Revision: 1.18 @ +-- @Revision: 1.23 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ --- curses binding. --- This module is generated. Please don't change it manually! --- Run the generator instead. --- | with System; with Interfaces.C; with Interfaces.C.Strings; use Interfaces.C.Strings; -with Unchecked_Conversion; -package Terminal_Interface.Curses.Aux is - pragma Preelaborate (Terminal_Interface.Curses.Aux); +package Terminal_Interface.Curses.Aux is + pragma Preelaborate (Terminal_Interface.Curses.Aux); use type Interfaces.C.int; - subtype C_Int is Interfaces.C.int; - subtype C_Short is Interfaces.C.short; - subtype C_Long_Int is Interfaces.C.long; - subtype C_Size_T is Interfaces.C.size_t; - subtype C_UInt is Interfaces.C.unsigned; - subtype C_ULong is Interfaces.C.unsigned_long; - subtype C_Char_Ptr is Interfaces.C.Strings.chars_ptr; - type C_Void_Ptr is new System.Address; - type C_Chtype is new C_UInt; - type C_AttrType is new C_UInt; + subtype C_Int is Interfaces.C.int; + subtype C_Short is Interfaces.C.short; + subtype C_Long_Int is Interfaces.C.long; + subtype C_Size_T is Interfaces.C.size_t; + subtype C_UInt is Interfaces.C.unsigned; + subtype C_ULong is Interfaces.C.unsigned_long; + subtype C_Char_Ptr is Interfaces.C.Strings.chars_ptr; + type C_Void_Ptr is new System.Address; -- This is how those constants are defined in ncurses. I see them also -- exactly like this in all ETI implementations I ever tested. So it -- could be that this is quite general, but please check with your curses. -- This is critical, because curses sometime mixes Boolean returns with -- returning an error status. - Curses_Ok : constant C_Int := 0; - Curses_Err : constant C_Int := -1; + Curses_Ok : constant C_Int := Curses_Constants.OK; + Curses_Err : constant C_Int := Curses_Constants.ERR; - Curses_True : constant C_Int := 1; - Curses_False : constant C_Int := 0; + Curses_True : constant C_Int := Curses_Constants.TRUE; + Curses_False : constant C_Int := Curses_Constants.FALSE; -- Eti_Error: type for error codes returned by the menu and form subsystem - subtype Eti_Error is C_Int range -14 .. 0; + type Eti_Error is + (E_Current, + E_Invalid_Field, + E_Request_Denied, + E_Not_Connected, + E_Not_Selectable, + E_No_Match, + E_Unknown_Command, + E_Not_Posted, + E_No_Room, + E_Bad_State, + E_Connected, + E_Posted, + E_Bad_Argument, + E_System_Error, + E_Ok); - E_Ok : constant Eti_Error := 0; - E_System_Error : constant Eti_Error := -1; - E_Bad_Argument : constant Eti_Error := -2; - E_Posted : constant Eti_Error := -3; - E_Connected : constant Eti_Error := -4; - E_Bad_State : constant Eti_Error := -5; - E_No_Room : constant Eti_Error := -6; - E_Not_Posted : constant Eti_Error := -7; - E_Unknown_Command : constant Eti_Error := -8; - E_No_Match : constant Eti_Error := -9; - E_Not_Selectable : constant Eti_Error := -10; - E_Not_Connected : constant Eti_Error := -11; - E_Request_Denied : constant Eti_Error := -12; - E_Invalid_Field : constant Eti_Error := -13; - E_Current : constant Eti_Error := -14; + procedure Eti_Exception (Code : Eti_Error); + -- Do nothing if Code = E_Ok. + -- Else dispatch the error code and raise the appropriate exception. - procedure Eti_Exception (Code : Eti_Error); - -- Dispatch the error code and raise the appropriate exception - -- - -- - -- Some helpers - function Chtype_To_AttrChar is new - Unchecked_Conversion (Source => C_Chtype, - Target => Attributed_Character); - function AttrChar_To_Chtype is new - Unchecked_Conversion (Source => Attributed_Character, - Target => C_Chtype); - - function AttrChar_To_AttrType is new - Unchecked_Conversion (Source => Attributed_Character, - Target => C_AttrType); - - function AttrType_To_AttrChar is new - Unchecked_Conversion (Source => C_AttrType, - Target => Attributed_Character); - - procedure Fill_String (Cp : chars_ptr; - Str : out String); + procedure Fill_String (Cp : chars_ptr; + Str : out String); -- Fill the Str parameter with the string denoted by the chars_ptr -- C-Style string. - function Fill_String (Cp : chars_ptr) return String; + function Fill_String (Cp : chars_ptr) return String; -- Same but as function. -end Terminal_Interface.Curses.Aux; +private + for Eti_Error'Size use C_Int'Size; + pragma Convention (C, Eti_Error); + for Eti_Error use + (E_Current => Curses_Constants.E_CURRENT, + E_Invalid_Field => Curses_Constants.E_INVALID_FIELD, + E_Request_Denied => Curses_Constants.E_REQUEST_DENIED, + E_Not_Connected => Curses_Constants.E_NOT_CONNECTED, + E_Not_Selectable => Curses_Constants.E_NOT_SELECTABLE, + E_No_Match => Curses_Constants.E_NO_MATCH, + E_Unknown_Command => Curses_Constants.E_UNKNOWN_COMMAND, + E_Not_Posted => Curses_Constants.E_NOT_POSTED, + E_No_Room => Curses_Constants.E_NO_ROOM, + E_Bad_State => Curses_Constants.E_BAD_STATE, + E_Connected => Curses_Constants.E_CONNECTED, + E_Posted => Curses_Constants.E_POSTED, + E_Bad_Argument => Curses_Constants.E_BAD_ARGUMENT, + E_System_Error => Curses_Constants.E_SYSTEM_ERROR, + E_Ok => Curses_Constants.E_OK); +end Terminal_Interface.Curses.Aux; diff --git a/doc/html/ada/terminal_interface-curses-forms-field_types-alpha__adb.htm b/doc/html/ada/terminal_interface-curses-forms-field_types-alpha__adb.htm index a11bb352..eb94006d 100644 --- a/doc/html/ada/terminal_interface-curses-forms-field_types-alpha__adb.htm +++ b/doc/html/ada/terminal_interface-curses-forms-field_types-alpha__adb.htm @@ -24,7 +24,7 @@ -- B O D Y -- -- -- ------------------------------------------------------------------------------ --- Copyright (c) 1998-2009,2011 Free Software Foundation, Inc. -- +-- Copyright (c) 1998-2011,2014 Free Software Foundation, Inc. -- -- -- -- Permission is hereby granted, free of charge, to any person obtaining a -- -- copy of this software and associated documentation files (the -- @@ -52,29 +52,25 @@ ------------------------------------------------------------------------------ -- Author: Juergen Pfeifer, 1996 -- Version Control: --- @Revision: 1.11 @ --- @Date: 2011/03/19 00:45:37 @ +-- @Revision: 1.13 @ +-- @Date: 2014/05/24 21:31:05 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ -with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; +with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; -package body Terminal_Interface.Curses.Forms.Field_Types.Alpha is +package body Terminal_Interface.Curses.Forms.Field_Types.Alpha is - procedure Set_Field_Type (Fld : Field; + procedure Set_Field_Type (Fld : Field; Typ : Alpha_Field) is - function Set_Fld_Type (F : Field := Fld; - Arg1 : C_Int) return C_Int; + function Set_Fld_Type (F : Field := Fld; + 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; - Wrap_Builtin (Fld, Typ); + Eti_Exception (Set_Fld_Type (Arg1 => C_Int (Typ.Minimum_Field_Width))); + Wrap_Builtin (Fld, Typ); end Set_Field_Type; -end Terminal_Interface.Curses.Forms.Field_Types.Alpha; +end Terminal_Interface.Curses.Forms.Field_Types.Alpha; diff --git a/doc/html/ada/terminal_interface-curses-forms-field_types-alpha__ads.htm b/doc/html/ada/terminal_interface-curses-forms-field_types-alpha__ads.htm index 1c7e1a2e..ab3427ab 100644 --- a/doc/html/ada/terminal_interface-curses-forms-field_types-alpha__ads.htm +++ b/doc/html/ada/terminal_interface-curses-forms-field_types-alpha__ads.htm @@ -55,17 +55,17 @@ -- @Revision: 1.12 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ -package Terminal_Interface.Curses.Forms.Field_Types.Alpha is - pragma Preelaborate (Terminal_Interface.Curses.Forms.Field_Types.Alpha); +package Terminal_Interface.Curses.Forms.Field_Types.Alpha is + pragma Preelaborate (Terminal_Interface.Curses.Forms.Field_Types.Alpha); - type Alpha_Field is new Field_Type + type Alpha_Field is new Field_Type with record Minimum_Field_Width : Natural := 0; end record; - procedure Set_Field_Type (Fld : Field; + procedure Set_Field_Type (Fld : Field; Typ : Alpha_Field); pragma Inline (Set_Field_Type); -end Terminal_Interface.Curses.Forms.Field_Types.Alpha; +end Terminal_Interface.Curses.Forms.Field_Types.Alpha; diff --git a/doc/html/ada/terminal_interface-curses-forms-field_types-alphanumeric__adb.htm b/doc/html/ada/terminal_interface-curses-forms-field_types-alphanumeric__adb.htm index 25a6c128..15b45530 100644 --- a/doc/html/ada/terminal_interface-curses-forms-field_types-alphanumeric__adb.htm +++ b/doc/html/ada/terminal_interface-curses-forms-field_types-alphanumeric__adb.htm @@ -24,7 +24,7 @@ -- B O D Y -- -- -- ------------------------------------------------------------------------------ --- Copyright (c) 1998-2009,2011 Free Software Foundation, Inc. -- +-- Copyright (c) 1998-2011,2014 Free Software Foundation, Inc. -- -- -- -- Permission is hereby granted, free of charge, to any person obtaining a -- -- copy of this software and associated documentation files (the -- @@ -52,29 +52,25 @@ ------------------------------------------------------------------------------ -- Author: Juergen Pfeifer, 1996 -- Version Control: --- @Revision: 1.11 @ --- @Date: 2011/03/19 00:45:37 @ +-- @Revision: 1.13 @ +-- @Date: 2014/05/24 21:31:05 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ -with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; +with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; -package body Terminal_Interface.Curses.Forms.Field_Types.AlphaNumeric is +package body Terminal_Interface.Curses.Forms.Field_Types.AlphaNumeric is - procedure Set_Field_Type (Fld : Field; + procedure Set_Field_Type (Fld : Field; Typ : AlphaNumeric_Field) is - function Set_Fld_Type (F : Field := Fld; - Arg1 : C_Int) return C_Int; + function Set_Fld_Type (F : Field := Fld; + 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; - Wrap_Builtin (Fld, Typ); + Eti_Exception (Set_Fld_Type (Arg1 => C_Int (Typ.Minimum_Field_Width))); + Wrap_Builtin (Fld, Typ); end Set_Field_Type; -end Terminal_Interface.Curses.Forms.Field_Types.AlphaNumeric; +end Terminal_Interface.Curses.Forms.Field_Types.AlphaNumeric; diff --git a/doc/html/ada/terminal_interface-curses-forms-field_types-alphanumeric__ads.htm b/doc/html/ada/terminal_interface-curses-forms-field_types-alphanumeric__ads.htm index 7580482a..ea08cd27 100644 --- a/doc/html/ada/terminal_interface-curses-forms-field_types-alphanumeric__ads.htm +++ b/doc/html/ada/terminal_interface-curses-forms-field_types-alphanumeric__ads.htm @@ -55,18 +55,18 @@ -- @Revision: 1.12 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ -package Terminal_Interface.Curses.Forms.Field_Types.AlphaNumeric is +package Terminal_Interface.Curses.Forms.Field_Types.AlphaNumeric is pragma Preelaborate - (Terminal_Interface.Curses.Forms.Field_Types.AlphaNumeric); + (Terminal_Interface.Curses.Forms.Field_Types.AlphaNumeric); - type AlphaNumeric_Field is new Field_Type + type AlphaNumeric_Field is new Field_Type with record Minimum_Field_Width : Natural := 0; end record; - procedure Set_Field_Type (Fld : Field; + procedure Set_Field_Type (Fld : Field; Typ : AlphaNumeric_Field); pragma Inline (Set_Field_Type); -end Terminal_Interface.Curses.Forms.Field_Types.AlphaNumeric; +end Terminal_Interface.Curses.Forms.Field_Types.AlphaNumeric; diff --git a/doc/html/ada/terminal_interface-curses-forms-field_types-enumeration-ada__adb.htm b/doc/html/ada/terminal_interface-curses-forms-field_types-enumeration-ada__adb.htm index 8258cd54..346bc741 100644 --- a/doc/html/ada/terminal_interface-curses-forms-field_types-enumeration-ada__adb.htm +++ b/doc/html/ada/terminal_interface-curses-forms-field_types-enumeration-ada__adb.htm @@ -58,7 +58,7 @@ ------------------------------------------------------------------------------ with Ada.Characters.Handling; use Ada.Characters.Handling; -package body Terminal_Interface.Curses.Forms.Field_Types.Enumeration.Ada is +package body Terminal_Interface.Curses.Forms.Field_Types.Enumeration.Ada is function Create (Set : Type_Set := Mixed_Case; Case_Sensitive : Boolean := False; @@ -88,12 +88,12 @@ return Create (I, True); end Create; - function Value (Fld : Field; - Buf : Buffer_Number := Buffer_Number'First) return T + function Value (Fld : Field; + Buf : Buffer_Number := Buffer_Number'First) return T is begin - return T'Value (Get_Buffer (Fld, Buf)); + return T'Value (Get_Buffer (Fld, Buf)); end Value; -end Terminal_Interface.Curses.Forms.Field_Types.Enumeration.Ada; +end Terminal_Interface.Curses.Forms.Field_Types.Enumeration.Ada; diff --git a/doc/html/ada/terminal_interface-curses-forms-field_types-enumeration-ada__ads.htm b/doc/html/ada/terminal_interface-curses-forms-field_types-enumeration-ada__ads.htm index 37305f62..e17faca6 100644 --- a/doc/html/ada/terminal_interface-curses-forms-field_types-enumeration-ada__ads.htm +++ b/doc/html/ada/terminal_interface-curses-forms-field_types-enumeration-ada__ads.htm @@ -58,20 +58,20 @@ generic type T is (<>); -package Terminal_Interface.Curses.Forms.Field_Types.Enumeration.Ada is +package Terminal_Interface.Curses.Forms.Field_Types.Enumeration.Ada is pragma Preelaborate - (Terminal_Interface.Curses.Forms.Field_Types.Enumeration.Ada); + (Terminal_Interface.Curses.Forms.Field_Types.Enumeration.Ada); function Create (Set : Type_Set := Mixed_Case; Case_Sensitive : Boolean := False; Must_Be_Unique : Boolean := False) return Enumeration_Field; - function Value (Fld : Field; - Buf : Buffer_Number := Buffer_Number'First) return T; + function Value (Fld : Field; + Buf : Buffer_Number := Buffer_Number'First) return T; -- Translate the content of the fields buffer - indicated by the -- buffer number - into an enumeration value. If the buffer is empty -- or the content is invalid, a Constraint_Error is raises. -end Terminal_Interface.Curses.Forms.Field_Types.Enumeration.Ada; +end Terminal_Interface.Curses.Forms.Field_Types.Enumeration.Ada; diff --git a/doc/html/ada/terminal_interface-curses-forms-field_types-enumeration__adb.htm b/doc/html/ada/terminal_interface-curses-forms-field_types-enumeration__adb.htm index a5c44bb4..e4d75ddd 100644 --- a/doc/html/ada/terminal_interface-curses-forms-field_types-enumeration__adb.htm +++ b/doc/html/ada/terminal_interface-curses-forms-field_types-enumeration__adb.htm @@ -24,7 +24,7 @@ -- B O D Y -- -- -- ------------------------------------------------------------------------------ --- Copyright (c) 1998-2009,2011 Free Software Foundation, Inc. -- +-- Copyright (c) 1998-2011,2014 Free Software Foundation, Inc. -- -- -- -- Permission is hereby granted, free of charge, to any person obtaining a -- -- copy of this software and associated documentation files (the -- @@ -52,15 +52,15 @@ ------------------------------------------------------------------------------ -- Author: Juergen Pfeifer, 1996 -- Version Control: --- @Revision: 1.10 @ +-- @Revision: 1.12 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ with Ada.Unchecked_Deallocation; with Interfaces.C; use Interfaces.C; with Interfaces.C.Strings; use Interfaces.C.Strings; -with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; +with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; -package body Terminal_Interface.Curses.Forms.Field_Types.Enumeration is +package body Terminal_Interface.Curses.Forms.Field_Types.Enumeration is function Create (Info : Enumeration_Info; Auto_Release_Names : Boolean := False) @@ -78,7 +78,7 @@ E.Arr := new chars_ptr_array (size_t (1) .. L); for I in 1 .. Positive (L - 1) loop if Info.Names (I) = null then - raise Form_Exception; + raise Form_Exception; end if; E.Arr.all (size_t (I)) := New_String (Info.Names (I).all); if Auto_Release_Names then @@ -105,29 +105,26 @@ Enum.Arr := null; end Release; - procedure Set_Field_Type (Fld : Field; + procedure Set_Field_Type (Fld : Field; Typ : Enumeration_Field) is - function Set_Fld_Type (F : Field := Fld; + function Set_Fld_Type (F : Field := Fld; Arg1 : chars_ptr_array; - Arg2 : C_Int; - Arg3 : C_Int) return C_Int; + Arg2 : C_Int; + Arg3 : C_Int) return Eti_Error; pragma Import (C, Set_Fld_Type, "set_field_type_enum"); - Res : Eti_Error; begin if Typ.Arr = null then - raise Form_Exception; + raise Form_Exception; end if; - Res := Set_Fld_Type (Arg1 => Typ.Arr.all, - Arg2 => C_Int (Boolean'Pos (Typ.Case_Sensitive)), - Arg3 => C_Int (Boolean'Pos - (Typ.Match_Must_Be_Unique))); - if Res /= E_Ok then - Eti_Exception (Res); - end if; - Wrap_Builtin (Fld, Typ, C_Choice_Router); + 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; -end Terminal_Interface.Curses.Forms.Field_Types.Enumeration; +end Terminal_Interface.Curses.Forms.Field_Types.Enumeration; diff --git a/doc/html/ada/terminal_interface-curses-forms-field_types-enumeration__ads.htm b/doc/html/ada/terminal_interface-curses-forms-field_types-enumeration__ads.htm index a5ae6941..d7180b6e 100644 --- a/doc/html/ada/terminal_interface-curses-forms-field_types-enumeration__ads.htm +++ b/doc/html/ada/terminal_interface-curses-forms-field_types-enumeration__ads.htm @@ -57,9 +57,9 @@ ------------------------------------------------------------------------------ with Interfaces.C.Strings; -package Terminal_Interface.Curses.Forms.Field_Types.Enumeration is +package Terminal_Interface.Curses.Forms.Field_Types.Enumeration is pragma Preelaborate - (Terminal_Interface.Curses.Forms.Field_Types.Enumeration); + (Terminal_Interface.Curses.Forms.Field_Types.Enumeration); type String_Access is access String; @@ -76,7 +76,7 @@ Match_Must_Be_Unique : Boolean := False; end record; - type Enumeration_Field is new Field_Type with private; + type Enumeration_Field is new Field_Type with private; function Create (Info : Enumeration_Info; Auto_Release_Names : Boolean := False) @@ -98,19 +98,19 @@ -- The next type defintions are all ncurses extensions. They are typically -- not available in other curses implementations. - procedure Set_Field_Type (Fld : Field; + procedure Set_Field_Type (Fld : Field; Typ : Enumeration_Field); pragma Inline (Set_Field_Type); private type CPA_Access is access Interfaces.C.Strings.chars_ptr_array; - type Enumeration_Field is new Field_Type with + type Enumeration_Field is new Field_Type with record Case_Sensitive : Boolean := False; Match_Must_Be_Unique : Boolean := False; Arr : CPA_Access := null; end record; -end Terminal_Interface.Curses.Forms.Field_Types.Enumeration; +end Terminal_Interface.Curses.Forms.Field_Types.Enumeration; diff --git a/doc/html/ada/terminal_interface-curses-forms-field_types-intfield__adb.htm b/doc/html/ada/terminal_interface-curses-forms-field_types-intfield__adb.htm index 9fd50ea6..e9683ab1 100644 --- a/doc/html/ada/terminal_interface-curses-forms-field_types-intfield__adb.htm +++ b/doc/html/ada/terminal_interface-curses-forms-field_types-intfield__adb.htm @@ -24,7 +24,7 @@ -- B O D Y -- -- -- ------------------------------------------------------------------------------ --- Copyright (c) 1998-2009,2011 Free Software Foundation, Inc. -- +-- Copyright (c) 1998-2011,2014 Free Software Foundation, Inc. -- -- -- -- Permission is hereby granted, free of charge, to any person obtaining a -- -- copy of this software and associated documentation files (the -- @@ -52,33 +52,29 @@ ------------------------------------------------------------------------------ -- Author: Juergen Pfeifer, 1996 -- Version Control: --- @Revision: 1.11 @ --- @Date: 2011/03/19 00:45:37 @ +-- @Revision: 1.13 @ +-- @Date: 2014/05/24 21:31:05 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ -with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; +with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; -package body Terminal_Interface.Curses.Forms.Field_Types.IntField is +package body Terminal_Interface.Curses.Forms.Field_Types.IntField is - procedure Set_Field_Type (Fld : Field; + procedure Set_Field_Type (Fld : Field; Typ : Integer_Field) is - function Set_Fld_Type (F : Field := Fld; - Arg1 : C_Int; - Arg2 : C_Long_Int; - Arg3 : C_Long_Int) return C_Int; + function Set_Fld_Type (F : Field := Fld; + Arg1 : C_Int; + Arg2 : C_Long_Int; + Arg3 : C_Long_Int) return Eti_Error; pragma Import (C, Set_Fld_Type, "set_field_type_integer"); - Res : Eti_Error; begin - Res := Set_Fld_Type (Arg1 => C_Int (Typ.Precision), - Arg2 => C_Long_Int (Typ.Lower_Limit), - Arg3 => C_Long_Int (Typ.Upper_Limit)); - if Res /= E_Ok then - Eti_Exception (Res); - end if; - Wrap_Builtin (Fld, Typ); + 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; -end Terminal_Interface.Curses.Forms.Field_Types.IntField; +end Terminal_Interface.Curses.Forms.Field_Types.IntField; diff --git a/doc/html/ada/terminal_interface-curses-forms-field_types-intfield__ads.htm b/doc/html/ada/terminal_interface-curses-forms-field_types-intfield__ads.htm index b46963a5..6c0d7a65 100644 --- a/doc/html/ada/terminal_interface-curses-forms-field_types-intfield__ads.htm +++ b/doc/html/ada/terminal_interface-curses-forms-field_types-intfield__ads.htm @@ -55,19 +55,19 @@ -- @Revision: 1.12 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ -package Terminal_Interface.Curses.Forms.Field_Types.IntField is - pragma Preelaborate (Terminal_Interface.Curses.Forms.Field_Types.IntField); +package Terminal_Interface.Curses.Forms.Field_Types.IntField is + pragma Preelaborate (Terminal_Interface.Curses.Forms.Field_Types.IntField); - type Integer_Field is new Field_Type with + type Integer_Field is new Field_Type with record Precision : Natural; Lower_Limit : Integer; Upper_Limit : Integer; end record; - procedure Set_Field_Type (Fld : Field; + procedure Set_Field_Type (Fld : Field; Typ : Integer_Field); pragma Inline (Set_Field_Type); -end Terminal_Interface.Curses.Forms.Field_Types.IntField; +end Terminal_Interface.Curses.Forms.Field_Types.IntField; diff --git a/doc/html/ada/terminal_interface-curses-forms-field_types-ipv4_address__adb.htm b/doc/html/ada/terminal_interface-curses-forms-field_types-ipv4_address__adb.htm index 2c139165..9f9e09ca 100644 --- a/doc/html/ada/terminal_interface-curses-forms-field_types-ipv4_address__adb.htm +++ b/doc/html/ada/terminal_interface-curses-forms-field_types-ipv4_address__adb.htm @@ -24,7 +24,7 @@ -- B O D Y -- -- -- ------------------------------------------------------------------------------ --- Copyright (c) 1998-2009,2011 Free Software Foundation, Inc. -- +-- Copyright (c) 1998-2011,2014 Free Software Foundation, Inc. -- -- -- -- Permission is hereby granted, free of charge, to any person obtaining a -- -- copy of this software and associated documentation files (the -- @@ -52,29 +52,25 @@ ------------------------------------------------------------------------------ -- Author: Juergen Pfeifer, 1996 -- Version Control: --- @Revision: 1.11 @ --- @Date: 2011/03/19 00:45:37 @ +-- @Revision: 1.13 @ +-- @Date: 2014/05/24 21:31:05 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ -with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; +with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; -package body Terminal_Interface.Curses.Forms.Field_Types.IPV4_Address is +package body Terminal_Interface.Curses.Forms.Field_Types.IPV4_Address is - procedure Set_Field_Type (Fld : Field; + procedure Set_Field_Type (Fld : Field; Typ : Internet_V4_Address_Field) is - function Set_Fld_Type (F : Field := Fld) - return C_Int; + function Set_Fld_Type (F : Field := Fld) + return Eti_Error; pragma Import (C, Set_Fld_Type, "set_field_type_ipv4"); - Res : Eti_Error; begin - Res := Set_Fld_Type; - if Res /= E_Ok then - Eti_Exception (Res); - end if; - Wrap_Builtin (Fld, Typ); + Eti_Exception (Set_Fld_Type); + Wrap_Builtin (Fld, Typ); end Set_Field_Type; -end Terminal_Interface.Curses.Forms.Field_Types.IPV4_Address; +end Terminal_Interface.Curses.Forms.Field_Types.IPV4_Address; diff --git a/doc/html/ada/terminal_interface-curses-forms-field_types-ipv4_address__ads.htm b/doc/html/ada/terminal_interface-curses-forms-field_types-ipv4_address__ads.htm index 41942c16..5a020f10 100644 --- a/doc/html/ada/terminal_interface-curses-forms-field_types-ipv4_address__ads.htm +++ b/doc/html/ada/terminal_interface-curses-forms-field_types-ipv4_address__ads.htm @@ -55,15 +55,15 @@ -- @Revision: 1.12 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ -package Terminal_Interface.Curses.Forms.Field_Types.IPV4_Address is +package Terminal_Interface.Curses.Forms.Field_Types.IPV4_Address is pragma Preelaborate - (Terminal_Interface.Curses.Forms.Field_Types.IPV4_Address); + (Terminal_Interface.Curses.Forms.Field_Types.IPV4_Address); - type Internet_V4_Address_Field is new Field_Type with null record; + type Internet_V4_Address_Field is new Field_Type with null record; - procedure Set_Field_Type (Fld : 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; +end Terminal_Interface.Curses.Forms.Field_Types.IPV4_Address; diff --git a/doc/html/ada/terminal_interface-curses-forms-field_types-numeric__adb.htm b/doc/html/ada/terminal_interface-curses-forms-field_types-numeric__adb.htm index 5986b656..a996109f 100644 --- a/doc/html/ada/terminal_interface-curses-forms-field_types-numeric__adb.htm +++ b/doc/html/ada/terminal_interface-curses-forms-field_types-numeric__adb.htm @@ -24,7 +24,7 @@ -- B O D Y -- -- -- ------------------------------------------------------------------------------ --- Copyright (c) 1998-2009,2011 Free Software Foundation, Inc. -- +-- Copyright (c) 1998-2011,2014 Free Software Foundation, Inc. -- -- -- -- Permission is hereby granted, free of charge, to any person obtaining a -- -- copy of this software and associated documentation files (the -- @@ -52,36 +52,32 @@ ------------------------------------------------------------------------------ -- Author: Juergen Pfeifer, 1996 -- Version Control: --- @Revision: 1.12 @ --- @Date: 2011/03/19 00:45:37 @ +-- @Revision: 1.14 @ +-- @Date: 2014/05/24 21:31:05 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ with Interfaces.C; -with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; +with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; -package body Terminal_Interface.Curses.Forms.Field_Types.Numeric is +package body Terminal_Interface.Curses.Forms.Field_Types.Numeric is - procedure Set_Field_Type (Fld : Field; + procedure Set_Field_Type (Fld : Field; Typ : Numeric_Field) is type Double is new Interfaces.C.double; - function Set_Fld_Type (F : Field := Fld; - Arg1 : C_Int; + function Set_Fld_Type (F : Field := Fld; + Arg1 : C_Int; Arg2 : Double; - Arg3 : Double) return C_Int; + Arg3 : Double) return Eti_Error; pragma Import (C, Set_Fld_Type, "set_field_type_numeric"); - Res : Eti_Error; begin - Res := Set_Fld_Type (Arg1 => C_Int (Typ.Precision), - Arg2 => Double (Typ.Lower_Limit), - Arg3 => Double (Typ.Upper_Limit)); - if Res /= E_Ok then - Eti_Exception (Res); - end if; - Wrap_Builtin (Fld, Typ); + 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; -end Terminal_Interface.Curses.Forms.Field_Types.Numeric; +end Terminal_Interface.Curses.Forms.Field_Types.Numeric; diff --git a/doc/html/ada/terminal_interface-curses-forms-field_types-numeric__ads.htm b/doc/html/ada/terminal_interface-curses-forms-field_types-numeric__ads.htm index 14121bc2..659e69de 100644 --- a/doc/html/ada/terminal_interface-curses-forms-field_types-numeric__ads.htm +++ b/doc/html/ada/terminal_interface-curses-forms-field_types-numeric__ads.htm @@ -55,19 +55,19 @@ -- @Revision: 1.12 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ -package Terminal_Interface.Curses.Forms.Field_Types.Numeric is - pragma Preelaborate (Terminal_Interface.Curses.Forms.Field_Types.Numeric); +package Terminal_Interface.Curses.Forms.Field_Types.Numeric is + pragma Preelaborate (Terminal_Interface.Curses.Forms.Field_Types.Numeric); - type Numeric_Field is new Field_Type with + type Numeric_Field is new Field_Type with record Precision : Natural; Lower_Limit : Float; Upper_Limit : Float; end record; - procedure Set_Field_Type (Fld : Field; + procedure Set_Field_Type (Fld : Field; Typ : Numeric_Field); pragma Inline (Set_Field_Type); -end Terminal_Interface.Curses.Forms.Field_Types.Numeric; +end Terminal_Interface.Curses.Forms.Field_Types.Numeric; diff --git a/doc/html/ada/terminal_interface-curses-forms-field_types-regexp__adb.htm b/doc/html/ada/terminal_interface-curses-forms-field_types-regexp__adb.htm index b5ed9228..fc3ec333 100644 --- a/doc/html/ada/terminal_interface-curses-forms-field_types-regexp__adb.htm +++ b/doc/html/ada/terminal_interface-curses-forms-field_types-regexp__adb.htm @@ -24,7 +24,7 @@ -- B O D Y -- -- -- ------------------------------------------------------------------------------ --- Copyright (c) 1998-2009,2011 Free Software Foundation, Inc. -- +-- Copyright (c) 1998-2011,2014 Free Software Foundation, Inc. -- -- -- -- Permission is hereby granted, free of charge, to any person obtaining a -- -- copy of this software and associated documentation files (the -- @@ -52,34 +52,25 @@ ------------------------------------------------------------------------------ -- Author: Juergen Pfeifer, 1996 -- Version Control: --- @Revision: 1.10 @ +-- @Revision: 1.12 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ with Interfaces.C; use Interfaces.C; -with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; +with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; -package body Terminal_Interface.Curses.Forms.Field_Types.RegExp is +package body Terminal_Interface.Curses.Forms.Field_Types.RegExp is - procedure Set_Field_Type (Fld : Field; + procedure Set_Field_Type (Fld : Field; Typ : Regular_Expression_Field) is - type Char_Ptr is access all Interfaces.C.char; - - function Set_Ftyp (F : Field := Fld; - Arg1 : Char_Ptr) return C_Int; + function Set_Ftyp (F : Field := Fld; + 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; - Wrap_Builtin (Fld, Typ); + Eti_Exception (Set_Ftyp (Arg1 => To_C (Typ.Regular_Expression.all))); + Wrap_Builtin (Fld, Typ); end Set_Field_Type; -end Terminal_Interface.Curses.Forms.Field_Types.RegExp; +end Terminal_Interface.Curses.Forms.Field_Types.RegExp; diff --git a/doc/html/ada/terminal_interface-curses-forms-field_types-regexp__ads.htm b/doc/html/ada/terminal_interface-curses-forms-field_types-regexp__ads.htm index e15f1824..b2527b6a 100644 --- a/doc/html/ada/terminal_interface-curses-forms-field_types-regexp__ads.htm +++ b/doc/html/ada/terminal_interface-curses-forms-field_types-regexp__ads.htm @@ -55,19 +55,19 @@ -- @Revision: 1.12 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ -package Terminal_Interface.Curses.Forms.Field_Types.RegExp is - pragma Preelaborate (Terminal_Interface.Curses.Forms.Field_Types.RegExp); +package Terminal_Interface.Curses.Forms.Field_Types.RegExp is + pragma Preelaborate (Terminal_Interface.Curses.Forms.Field_Types.RegExp); type String_Access is access String; - type Regular_Expression_Field is new Field_Type with + type Regular_Expression_Field is new Field_Type with record Regular_Expression : String_Access; end record; - procedure Set_Field_Type (Fld : Field; + procedure Set_Field_Type (Fld : Field; Typ : Regular_Expression_Field); pragma Inline (Set_Field_Type); -end Terminal_Interface.Curses.Forms.Field_Types.RegExp; +end Terminal_Interface.Curses.Forms.Field_Types.RegExp; diff --git a/doc/html/ada/terminal_interface-curses-forms-field_types-user-choice__adb.htm b/doc/html/ada/terminal_interface-curses-forms-field_types-user-choice__adb.htm index 0761a198..c09a087d 100644 --- a/doc/html/ada/terminal_interface-curses-forms-field_types-user-choice__adb.htm +++ b/doc/html/ada/terminal_interface-curses-forms-field_types-user-choice__adb.htm @@ -24,7 +24,7 @@ -- B O D Y -- -- -- ------------------------------------------------------------------------------ --- Copyright (c) 1998-2008,2011 Free Software Foundation, Inc. -- +-- Copyright (c) 1998-2011,2014 Free Software Foundation, Inc. -- -- -- -- Permission is hereby granted, free of charge, to any person obtaining a -- -- copy of this software and associated documentation files (the -- @@ -52,75 +52,71 @@ ------------------------------------------------------------------------------ -- Author: Juergen Pfeifer, 1996 -- Version Control: --- @Revision: 1.17 @ --- @Date: 2011/03/22 10:53:37 @ +-- @Revision: 1.20 @ +-- @Date: 2014/05/24 21:31:05 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ with System.Address_To_Access_Conversions; -with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; +with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; -package body Terminal_Interface.Curses.Forms.Field_Types.User.Choice is +package body Terminal_Interface.Curses.Forms.Field_Types.User.Choice is package Argument_Conversions is - new System.Address_To_Access_Conversions (Argument); + new System.Address_To_Access_Conversions (Argument); - function Generic_Next (Fld : Field; - Usr : System.Address) return Curses_Bool + function Generic_Next (Fld : Field; + Usr : System.Address) return Curses_Bool is Result : Boolean; Udf : constant User_Defined_Field_Type_With_Choice_Access := User_Defined_Field_Type_With_Choice_Access - (Argument_Access (Argument_Conversions.To_Pointer (Usr)).Typ); + (Argument_Access (Argument_Conversions.To_Pointer (Usr)).all.Typ); begin Result := Next (Fld, Udf.all); - return Curses_Bool (Boolean'Pos (Result)); + return Curses_Bool (Boolean'Pos (Result)); end Generic_Next; - function Generic_Prev (Fld : Field; - Usr : System.Address) return Curses_Bool + function Generic_Prev (Fld : Field; + Usr : System.Address) return Curses_Bool is Result : Boolean; Udf : constant User_Defined_Field_Type_With_Choice_Access := User_Defined_Field_Type_With_Choice_Access - (Argument_Access (Argument_Conversions.To_Pointer (Usr)).Typ); + (Argument_Access (Argument_Conversions.To_Pointer (Usr)).all.Typ); begin Result := Previous (Fld, Udf.all); - return Curses_Bool (Boolean'Pos (Result)); + return Curses_Bool (Boolean'Pos (Result)); end Generic_Prev; -- ----------------------------------------------------------------------- -- - function C_Generic_Choice return C_Field_Type + function C_Generic_Choice return C_Field_Type is - Res : Eti_Error; - T : C_Field_Type; + Res : Eti_Error; + T : C_Field_Type; begin - if M_Generic_Choice = Null_Field_Type then - T := New_Fieldtype (Generic_Field_Check'Access, + if M_Generic_Choice = Null_Field_Type then + T := New_Fieldtype (Generic_Field_Check'Access, Generic_Char_Check'Access); - if T = Null_Field_Type then - raise Form_Exception; + if T = Null_Field_Type then + raise Form_Exception; else - Res := Set_Fieldtype_Arg (T, - Make_Arg'Access, - Copy_Arg'Access, - Free_Arg'Access); - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Res := Set_Fieldtype_Arg (T, + Make_Arg'Access, + Copy_Arg'Access, + Free_Arg'Access); + Eti_Exception (Res); - Res := Set_Fieldtype_Choice (T, + 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; + M_Generic_Choice := T; end if; - pragma Assert (M_Generic_Choice /= Null_Field_Type); - return M_Generic_Choice; + pragma Assert (M_Generic_Choice /= Null_Field_Type); + return M_Generic_Choice; end C_Generic_Choice; -end Terminal_Interface.Curses.Forms.Field_Types.User.Choice; +end Terminal_Interface.Curses.Forms.Field_Types.User.Choice; diff --git a/doc/html/ada/terminal_interface-curses-forms-field_types-user-choice__ads.htm b/doc/html/ada/terminal_interface-curses-forms-field_types-user-choice__ads.htm index 9785cd6c..4d83d4fd 100644 --- a/doc/html/ada/terminal_interface-curses-forms-field_types-user-choice__ads.htm +++ b/doc/html/ada/terminal_interface-curses-forms-field_types-user-choice__ads.htm @@ -58,9 +58,9 @@ ------------------------------------------------------------------------------ with Interfaces.C; -package Terminal_Interface.Curses.Forms.Field_Types.User.Choice is +package Terminal_Interface.Curses.Forms.Field_Types.User.Choice is pragma Preelaborate - (Terminal_Interface.Curses.Forms.Field_Types.User.Choice); + (Terminal_Interface.Curses.Forms.Field_Types.User.Choice); subtype C_Int is Interfaces.C.int; @@ -75,14 +75,14 @@ User_Defined_Field_Type_With_Choice'Class; function Next - (Fld : Field; + (Fld : Field; Typ : User_Defined_Field_Type_With_Choice) return Boolean is abstract; -- If True is returned, the function successfully generated a next -- value into the fields buffer. function Previous - (Fld : Field; + (Fld : Field; Typ : User_Defined_Field_Type_With_Choice) return Boolean is abstract; -- If True is returned, the function successfully generated a previous @@ -92,21 +92,21 @@ -- | Private Part. -- | private - function C_Generic_Choice return C_Field_Type; + function C_Generic_Choice return C_Field_Type; - function Generic_Next (Fld : Field; - Usr : System.Address) return Curses_Bool; + function Generic_Next (Fld : Field; + Usr : System.Address) return Curses_Bool; pragma Convention (C, Generic_Next); -- This is the generic next Choice_Function for the low-level fieldtype -- representing all the User_Defined_Field_Type derivatives. It routes -- the call to the Next implementation for the type. - function Generic_Prev (Fld : Field; - Usr : System.Address) return Curses_Bool; + function Generic_Prev (Fld : Field; + Usr : System.Address) return Curses_Bool; pragma Convention (C, Generic_Prev); -- This is the generic prev Choice_Function for the low-level fieldtype -- representing all the User_Defined_Field_Type derivatives. It routes -- the call to the Previous implementation for the type. -end Terminal_Interface.Curses.Forms.Field_Types.User.Choice; +end Terminal_Interface.Curses.Forms.Field_Types.User.Choice; diff --git a/doc/html/ada/terminal_interface-curses-forms-field_types-user__adb.htm b/doc/html/ada/terminal_interface-curses-forms-field_types-user__adb.htm index 94ed879f..f51abddb 100644 --- a/doc/html/ada/terminal_interface-curses-forms-field_types-user__adb.htm +++ b/doc/html/ada/terminal_interface-curses-forms-field_types-user__adb.htm @@ -24,7 +24,7 @@ -- B O D Y -- -- -- ------------------------------------------------------------------------------ --- Copyright (c) 1998-2009,2011 Free Software Foundation, Inc. -- +-- Copyright (c) 1998-2011,2014 Free Software Foundation, Inc. -- -- -- -- Permission is hereby granted, free of charge, to any person obtaining a -- -- copy of this software and associated documentation files (the -- @@ -52,100 +52,93 @@ ------------------------------------------------------------------------------ -- Author: Juergen Pfeifer, 1996 -- Version Control: --- @Revision: 1.21 @ --- @Date: 2011/03/23 00:44:58 @ +-- @Revision: 1.23 @ +-- @Date: 2014/05/24 21:31:05 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ with System.Address_To_Access_Conversions; -with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; +with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; -package body Terminal_Interface.Curses.Forms.Field_Types.User is +package body Terminal_Interface.Curses.Forms.Field_Types.User is - procedure Set_Field_Type (Fld : Field; + procedure Set_Field_Type (Fld : Field; Typ : User_Defined_Field_Type) is - function Allocate_Arg (T : User_Defined_Field_Type'Class) - return Argument_Access; + function Allocate_Arg (T : User_Defined_Field_Type'Class) + return Argument_Access; - function Set_Fld_Type (F : Field := Fld; - Cft : C_Field_Type := C_Generic_Type; - Arg1 : Argument_Access) - return C_Int; + function Set_Fld_Type (F : Field := Fld; + Cft : C_Field_Type := C_Generic_Type; + Arg1 : Argument_Access) + return Eti_Error; pragma Import (C, Set_Fld_Type, "set_field_type_user"); - Res : Eti_Error; - - function Allocate_Arg (T : User_Defined_Field_Type'Class) - return Argument_Access + function Allocate_Arg (T : User_Defined_Field_Type'Class) + return Argument_Access is - Ptr : constant Field_Type_Access + Ptr : constant Field_Type_Access := new User_Defined_Field_Type'Class'(T); begin - return new Argument'(Usr => System.Null_Address, - Typ => Ptr, - Cft => Null_Field_Type); + return new Argument'(Usr => System.Null_Address, + Typ => Ptr, + Cft => Null_Field_Type); end Allocate_Arg; begin - Res := Set_Fld_Type (Arg1 => Allocate_Arg (Typ)); - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Fld_Type (Arg1 => Allocate_Arg (Typ))); end Set_Field_Type; package Argument_Conversions is - new System.Address_To_Access_Conversions (Argument); + new System.Address_To_Access_Conversions (Argument); - function Generic_Field_Check (Fld : Field; - Usr : System.Address) return Curses_Bool + function Generic_Field_Check (Fld : Field; + Usr : System.Address) return Curses_Bool is - Result : Boolean; - Udf : constant User_Defined_Field_Type_Access := + Result : Boolean; + Udf : constant User_Defined_Field_Type_Access := User_Defined_Field_Type_Access - (Argument_Access (Argument_Conversions.To_Pointer (Usr)).all.Typ); + (Argument_Access (Argument_Conversions.To_Pointer (Usr)).all.Typ); begin - Result := Field_Check (Fld, Udf.all); - return Curses_Bool (Boolean'Pos (Result)); + Result := Field_Check (Fld, Udf.all); + return Curses_Bool (Boolean'Pos (Result)); end Generic_Field_Check; - function Generic_Char_Check (Ch : C_Int; - Usr : System.Address) return Curses_Bool + function Generic_Char_Check (Ch : C_Int; + Usr : System.Address) return Curses_Bool is - Result : Boolean; - Udf : constant User_Defined_Field_Type_Access := + Result : Boolean; + Udf : constant User_Defined_Field_Type_Access := User_Defined_Field_Type_Access - (Argument_Access (Argument_Conversions.To_Pointer (Usr)).all.Typ); + (Argument_Access (Argument_Conversions.To_Pointer (Usr)).all.Typ); begin - Result := Character_Check (Character'Val (Ch), Udf.all); - return Curses_Bool (Boolean'Pos (Result)); + Result := Character_Check (Character'Val (Ch), Udf.all); + return Curses_Bool (Boolean'Pos (Result)); end Generic_Char_Check; -- ----------------------------------------------------------------------- -- - function C_Generic_Type return C_Field_Type + function C_Generic_Type return C_Field_Type is - Res : Eti_Error; - T : C_Field_Type; + Res : Eti_Error; + T : C_Field_Type; begin - if M_Generic_Type = Null_Field_Type then - T := New_Fieldtype (Generic_Field_Check'Access, + if M_Generic_Type = Null_Field_Type then + T := New_Fieldtype (Generic_Field_Check'Access, Generic_Char_Check'Access); - if T = Null_Field_Type then - raise Form_Exception; + if T = Null_Field_Type then + raise Form_Exception; else - Res := Set_Fieldtype_Arg (T, - Make_Arg'Access, - Copy_Arg'Access, - Free_Arg'Access); - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Res := Set_Fieldtype_Arg (T, + Make_Arg'Access, + Copy_Arg'Access, + Free_Arg'Access); + Eti_Exception (Res); end if; - M_Generic_Type := T; + M_Generic_Type := T; end if; - pragma Assert (M_Generic_Type /= Null_Field_Type); - return M_Generic_Type; + pragma Assert (M_Generic_Type /= Null_Field_Type); + return M_Generic_Type; end C_Generic_Type; -end Terminal_Interface.Curses.Forms.Field_Types.User; +end Terminal_Interface.Curses.Forms.Field_Types.User; diff --git a/doc/html/ada/terminal_interface-curses-forms-field_types-user__ads.htm b/doc/html/ada/terminal_interface-curses-forms-field_types-user__ads.htm index 2b579166..f89e1f76 100644 --- a/doc/html/ada/terminal_interface-curses-forms-field_types-user__ads.htm +++ b/doc/html/ada/terminal_interface-curses-forms-field_types-user__ads.htm @@ -58,11 +58,11 @@ ------------------------------------------------------------------------------ with Interfaces.C; -package Terminal_Interface.Curses.Forms.Field_Types.User is - pragma Preelaborate (Terminal_Interface.Curses.Forms.Field_Types.User); +package Terminal_Interface.Curses.Forms.Field_Types.User is + pragma Preelaborate (Terminal_Interface.Curses.Forms.Field_Types.User); subtype C_Int is Interfaces.C.int; - type User_Defined_Field_Type is abstract new Field_Type with null record; + type User_Defined_Field_Type is abstract new Field_Type with null record; -- This is the root of the mechanism we use to create field types in -- Ada95. You should your own type derive from this one and implement -- the Field_Check and Character_Check functions for your own type. @@ -71,7 +71,7 @@ User_Defined_Field_Type'Class; function Field_Check - (Fld : Field; + (Fld : Field; Typ : User_Defined_Field_Type) return Boolean is abstract; -- If True is returned, the field is considered valid, otherwise it is @@ -84,7 +84,7 @@ -- If True is returned, the character is considered as valid for the -- field, otherwise as invalid. - procedure Set_Field_Type (Fld : Field; + 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. @@ -93,21 +93,21 @@ -- | Private Part. -- | Used by the Choice child package. private - function C_Generic_Type return C_Field_Type; + function C_Generic_Type return C_Field_Type; - function Generic_Field_Check (Fld : Field; - Usr : System.Address) return Curses_Bool; + function Generic_Field_Check (Fld : Field; + Usr : System.Address) return Curses_Bool; pragma Convention (C, Generic_Field_Check); -- This is the generic Field_Check_Function for the low-level fieldtype -- representing all the User_Defined_Field_Type derivatives. It routes -- the call to the Field_Check implementation for the type. - function Generic_Char_Check (Ch : C_Int; - Usr : System.Address) return Curses_Bool; + function Generic_Char_Check (Ch : C_Int; + Usr : System.Address) return Curses_Bool; pragma Convention (C, Generic_Char_Check); -- This is the generic Char_Check_Function for the low-level fieldtype -- representing all the User_Defined_Field_Type derivatives. It routes -- the call to the Character_Check implementation for the type. -end Terminal_Interface.Curses.Forms.Field_Types.User; +end Terminal_Interface.Curses.Forms.Field_Types.User; diff --git a/doc/html/ada/terminal_interface-curses-forms-field_types__adb.htm b/doc/html/ada/terminal_interface-curses-forms-field_types__adb.htm index e12eab6b..ccf3a7ac 100644 --- a/doc/html/ada/terminal_interface-curses-forms-field_types__adb.htm +++ b/doc/html/ada/terminal_interface-curses-forms-field_types__adb.htm @@ -24,7 +24,7 @@ -- B O D Y -- -- -- ------------------------------------------------------------------------------ --- Copyright (c) 1998-2009,2011 Free Software Foundation, Inc. -- +-- Copyright (c) 1998-2011,2014 Free Software Foundation, Inc. -- -- -- -- Permission is hereby granted, free of charge, to any person obtaining a -- -- copy of this software and associated documentation files (the -- @@ -52,11 +52,11 @@ ------------------------------------------------------------------------------ -- Author: Juergen Pfeifer, 1996 -- Version Control: --- @Revision: 1.25 @ --- @Date: 2011/03/22 23:22:27 @ +-- @Revision: 1.27 @ +-- @Date: 2014/05/24 21:31:05 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ -with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; +with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; with Ada.Unchecked_Deallocation; with System.Address_To_Access_Conversions; @@ -65,17 +65,17 @@ -- | man page form_fieldtype.3x -- |===================================================================== -- | -package body Terminal_Interface.Curses.Forms.Field_Types is +package body Terminal_Interface.Curses.Forms.Field_Types is use type System.Address; package Argument_Conversions is - new System.Address_To_Access_Conversions (Argument); + new System.Address_To_Access_Conversions (Argument); - function Get_Fieldtype (F : Field) return C_Field_Type; + function Get_Fieldtype (F : Field) return C_Field_Type; pragma Import (C, Get_Fieldtype, "field_type"); - function Get_Arg (F : Field) return System.Address; + function Get_Arg (F : Field) return System.Address; pragma Import (C, Get_Arg, "field_arg"); -- | -- |===================================================================== @@ -84,218 +84,203 @@ -- | -- | -- | - function Get_Type (Fld : 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; + Low_Level : constant C_Field_Type := Get_Fieldtype (Fld); + Arg : Argument_Access; begin - if Low_Level = Null_Field_Type then + if Low_Level = Null_Field_Type then return null; else - if Low_Level = M_Builtin_Router or else - Low_Level = M_Generic_Type or else - Low_Level = M_Choice_Router or else - Low_Level = M_Generic_Choice then - Arg := Argument_Access - (Argument_Conversions.To_Pointer (Get_Arg (Fld))); + if Low_Level = M_Builtin_Router or else + Low_Level = M_Generic_Type or else + Low_Level = M_Choice_Router or else + Low_Level = M_Generic_Choice then + Arg := Argument_Access + (Argument_Conversions.To_Pointer (Get_Arg (Fld))); if Arg = null then - raise Form_Exception; + raise Form_Exception; else - return Arg.all.Typ; + return Arg.all.Typ; end if; else - raise Form_Exception; + raise Form_Exception; end if; end if; - end Get_Type; + end Get_Type; - function Copy_Arg (Usr : System.Address) return System.Address + function Copy_Arg (Usr : System.Address) return System.Address is begin - return Usr; - end Copy_Arg; + return Usr; + end Copy_Arg; - procedure Free_Arg (Usr : System.Address) + procedure Free_Arg (Usr : System.Address) is procedure Free_Type is new Ada.Unchecked_Deallocation - (Field_Type'Class, Field_Type_Access); + (Field_Type'Class, Field_Type_Access); procedure Freeargs is new Ada.Unchecked_Deallocation - (Argument, Argument_Access); + (Argument, Argument_Access); - To_Be_Free : Argument_Access - := Argument_Access (Argument_Conversions.To_Pointer (Usr)); - Low_Level : C_Field_Type; + To_Be_Free : Argument_Access + := Argument_Access (Argument_Conversions.To_Pointer (Usr)); + Low_Level : C_Field_Type; begin if To_Be_Free /= null then - if To_Be_Free.all.Usr /= System.Null_Address then - Low_Level := To_Be_Free.all.Cft; - if Low_Level.all.Freearg /= null then - Low_Level.all.Freearg (To_Be_Free.all.Usr); + if To_Be_Free.all.Usr /= System.Null_Address then + Low_Level := To_Be_Free.all.Cft; + if Low_Level.all.Freearg /= null then + Low_Level.all.Freearg (To_Be_Free.all.Usr); end if; end if; - if To_Be_Free.all.Typ /= null then - Free_Type (To_Be_Free.all.Typ); + if To_Be_Free.all.Typ /= null then + Free_Type (To_Be_Free.all.Typ); end if; Freeargs (To_Be_Free); end if; - end Free_Arg; + end Free_Arg; - procedure Wrap_Builtin (Fld : Field; - Typ : Field_Type'Class; - Cft : C_Field_Type := C_Builtin_Router) + procedure Wrap_Builtin (Fld : Field; + Typ : Field_Type'Class; + Cft : C_Field_Type := C_Builtin_Router) is - Usr_Arg : constant System.Address := Get_Arg (Fld); - Low_Level : constant C_Field_Type := Get_Fieldtype (Fld); - Arg : Argument_Access; - Res : Eti_Error; - function Set_Fld_Type (F : Field := Fld; - Cf : C_Field_Type := Cft; - Arg1 : Argument_Access) return C_Int; + Usr_Arg : constant System.Address := Get_Arg (Fld); + Low_Level : constant C_Field_Type := Get_Fieldtype (Fld); + Arg : Argument_Access; + function Set_Fld_Type (F : Field := Fld; + Cf : C_Field_Type := Cft; + Arg1 : Argument_Access) return Eti_Error; pragma Import (C, Set_Fld_Type, "set_field_type_user"); begin - pragma Assert (Low_Level /= Null_Field_Type); - if Cft /= C_Builtin_Router and then Cft /= C_Choice_Router then - raise Form_Exception; + pragma Assert (Low_Level /= Null_Field_Type); + if Cft /= C_Builtin_Router and then Cft /= C_Choice_Router then + raise Form_Exception; else - Arg := new Argument'(Usr => System.Null_Address, - Typ => new Field_Type'Class'(Typ), - Cft => Get_Fieldtype (Fld)); + Arg := new Argument'(Usr => System.Null_Address, + Typ => new Field_Type'Class'(Typ), + Cft => Get_Fieldtype (Fld)); if Usr_Arg /= System.Null_Address then - if Low_Level.all.Copyarg /= null then - Arg.all.Usr := Low_Level.all.Copyarg (Usr_Arg); + if Low_Level.all.Copyarg /= null then + Arg.all.Usr := Low_Level.all.Copyarg (Usr_Arg); else - Arg.all.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; + end Wrap_Builtin; - function Field_Check_Router (Fld : Field; - Usr : System.Address) return Curses_Bool + function Field_Check_Router (Fld : Field; + Usr : System.Address) return Curses_Bool is - Arg : constant Argument_Access - := Argument_Access (Argument_Conversions.To_Pointer (Usr)); + Arg : constant Argument_Access + := Argument_Access (Argument_Conversions.To_Pointer (Usr)); begin - pragma Assert (Arg /= null and then Arg.all.Cft /= Null_Field_Type - and then Arg.all.Typ /= null); - if Arg.all.Cft.all.Fcheck /= null then - return Arg.all.Cft.all.Fcheck (Fld, Arg.all.Usr); + 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; + end Field_Check_Router; - function Char_Check_Router (Ch : C_Int; - Usr : System.Address) return Curses_Bool + function Char_Check_Router (Ch : C_Int; + Usr : System.Address) return Curses_Bool is - Arg : constant Argument_Access - := Argument_Access (Argument_Conversions.To_Pointer (Usr)); + Arg : constant Argument_Access + := Argument_Access (Argument_Conversions.To_Pointer (Usr)); begin - pragma Assert (Arg /= null and then Arg.all.Cft /= Null_Field_Type - and then Arg.all.Typ /= null); - if Arg.all.Cft.all.Ccheck /= null then - return Arg.all.Cft.all.Ccheck (Ch, Arg.all.Usr); + 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; + end Char_Check_Router; - function Next_Router (Fld : Field; - Usr : System.Address) return Curses_Bool + function Next_Router (Fld : Field; + Usr : System.Address) return Curses_Bool is - Arg : constant Argument_Access - := Argument_Access (Argument_Conversions.To_Pointer (Usr)); + Arg : constant Argument_Access + := Argument_Access (Argument_Conversions.To_Pointer (Usr)); begin - pragma Assert (Arg /= null and then Arg.all.Cft /= Null_Field_Type - and then Arg.all.Typ /= null); - if Arg.all.Cft.all.Next /= null then - return Arg.all.Cft.all.Next (Fld, Arg.all.Usr); + 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; + end Next_Router; - function Prev_Router (Fld : Field; - Usr : System.Address) return Curses_Bool + function Prev_Router (Fld : Field; + Usr : System.Address) return Curses_Bool is - Arg : constant Argument_Access := - Argument_Access (Argument_Conversions.To_Pointer (Usr)); + Arg : constant Argument_Access := + Argument_Access (Argument_Conversions.To_Pointer (Usr)); begin - pragma Assert (Arg /= null and then Arg.all.Cft /= Null_Field_Type - and then Arg.all.Typ /= null); - if Arg.all.Cft.all.Prev /= null then - return Arg.all.Cft.all.Prev (Fld, Arg.all.Usr); + pragma Assert (Arg /= null and then Arg.all.Cft /= Null_Field_Type + and then Arg.all.Typ /= null); + if Arg.all.Cft.all.Prev /= null then + return Arg.all.Cft.all.Prev (Fld, Arg.all.Usr); else return 1; end if; - end Prev_Router; + end Prev_Router; -- ----------------------------------------------------------------------- -- - function C_Builtin_Router return C_Field_Type + function C_Builtin_Router return C_Field_Type is - Res : Eti_Error; - T : C_Field_Type; + T : C_Field_Type; begin - if M_Builtin_Router = Null_Field_Type then - T := New_Fieldtype (Field_Check_Router'Access, - Char_Check_Router'Access); - if T = Null_Field_Type then - raise Form_Exception; + if M_Builtin_Router = Null_Field_Type then + T := New_Fieldtype (Field_Check_Router'Access, + Char_Check_Router'Access); + if T = Null_Field_Type then + raise Form_Exception; else - Res := Set_Fieldtype_Arg (T, - Make_Arg'Access, - Copy_Arg'Access, - Free_Arg'Access); - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Fieldtype_Arg (T, + Make_Arg'Access, + Copy_Arg'Access, + Free_Arg'Access)); end if; - M_Builtin_Router := T; + M_Builtin_Router := T; end if; - pragma Assert (M_Builtin_Router /= Null_Field_Type); - return M_Builtin_Router; - end C_Builtin_Router; + pragma Assert (M_Builtin_Router /= Null_Field_Type); + return M_Builtin_Router; + end C_Builtin_Router; -- ----------------------------------------------------------------------- -- - function C_Choice_Router return C_Field_Type + function C_Choice_Router return C_Field_Type is - Res : Eti_Error; - T : C_Field_Type; + T : C_Field_Type; begin - if M_Choice_Router = Null_Field_Type then - T := New_Fieldtype (Field_Check_Router'Access, - Char_Check_Router'Access); - if T = Null_Field_Type then - raise Form_Exception; + if M_Choice_Router = Null_Field_Type then + T := New_Fieldtype (Field_Check_Router'Access, + Char_Check_Router'Access); + if T = Null_Field_Type then + raise Form_Exception; else - Res := Set_Fieldtype_Arg (T, - Make_Arg'Access, - Copy_Arg'Access, - Free_Arg'Access); - if Res /= E_Ok then - Eti_Exception (Res); - end if; + 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; + M_Choice_Router := T; end if; - pragma Assert (M_Choice_Router /= Null_Field_Type); - return M_Choice_Router; - end C_Choice_Router; + pragma Assert (M_Choice_Router /= Null_Field_Type); + return M_Choice_Router; + end C_Choice_Router; -end Terminal_Interface.Curses.Forms.Field_Types; +end Terminal_Interface.Curses.Forms.Field_Types; diff --git a/doc/html/ada/terminal_interface-curses-forms-field_types__ads.htm b/doc/html/ada/terminal_interface-curses-forms-field_types__ads.htm index 00c5798e..705ef6ce 100644 --- a/doc/html/ada/terminal_interface-curses-forms-field_types__ads.htm +++ b/doc/html/ada/terminal_interface-curses-forms-field_types__ads.htm @@ -24,7 +24,7 @@ -- S P E C -- -- -- ------------------------------------------------------------------------------ --- Copyright (c) 1998-2009,2011 Free Software Foundation, Inc. -- +-- Copyright (c) 1998-2011,2014 Free Software Foundation, Inc. -- -- -- -- Permission is hereby granted, free of charge, to any person obtaining a -- -- copy of this software and associated documentation files (the -- @@ -52,21 +52,22 @@ ------------------------------------------------------------------------------ -- Author: Juergen Pfeifer, 1996 -- Version Control: --- @Revision: 1.17 @ +-- @Revision: 1.19 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ with Interfaces.C; +with Terminal_Interface.Curses.Aux; -package Terminal_Interface.Curses.Forms.Field_Types is - pragma Preelaborate (Terminal_Interface.Curses.Forms.Field_Types); +package Terminal_Interface.Curses.Forms.Field_Types is + pragma Preelaborate (Terminal_Interface.Curses.Forms.Field_Types); use type Interfaces.C.int; - subtype C_Int is Interfaces.C.int; + subtype C_Int is Interfaces.C.int; -- |===================================================================== -- | Man page form_fieldtype.3x -- |===================================================================== - type Field_Type is abstract tagged null record; + type Field_Type is abstract tagged null record; -- Abstract base type for all field types. A concrete field type -- is an extension that adds some data elements describing formats or -- boundary values for the type and validation routines. @@ -77,11 +78,11 @@ -- how to create you own child packages for low-level field types that -- you may have already written in C. - type Field_Type_Access is access all Field_Type'Class; + type Field_Type_Access is access all Field_Type'Class; -- #1A NAME="AFU_1"#2| - procedure Set_Field_Type (Fld : Field; - Fld_Type : Field_Type) is abstract; + procedure Set_Field_Type (Fld : Field; + Fld_Type : Field_Type) is abstract; -- AKA: set_field_type() -- But: we hide the vararg mechanism of the C interface. You always -- have to pass a single Field_Type parameter. @@ -93,7 +94,7 @@ -- |===================================================================== -- #1A NAME="AFU_2"#2| - function Get_Type (Fld : Field) return Field_Type_Access; + function Get_Type (Fld : Field) return Field_Type_Access; -- AKA: field_type() -- AKA: field_arg() -- In Ada95 we can combine these. If you try to retrieve the field type @@ -106,68 +107,68 @@ -- | Most of this is used by the implementations of the child packages. -- | private - type Makearg_Function is access - function (Args : System.Address) return System.Address; - pragma Convention (C, Makearg_Function); + type Makearg_Function is access + function (Args : System.Address) return System.Address; + pragma Convention (C, Makearg_Function); - type Copyarg_Function is access - function (Usr : System.Address) return System.Address; - pragma Convention (C, Copyarg_Function); + type Copyarg_Function is access + function (Usr : System.Address) return System.Address; + pragma Convention (C, Copyarg_Function); - type Freearg_Function is access - procedure (Usr : System.Address); - pragma Convention (C, Freearg_Function); + type Freearg_Function is access + procedure (Usr : System.Address); + pragma Convention (C, Freearg_Function); - type Field_Check_Function is access - function (Fld : Field; Usr : System.Address) return Curses_Bool; - pragma Convention (C, Field_Check_Function); + type Field_Check_Function is access + function (Fld : Field; Usr : System.Address) return Curses_Bool; + pragma Convention (C, Field_Check_Function); - type Char_Check_Function is access - function (Ch : C_Int; Usr : System.Address) return Curses_Bool; - pragma Convention (C, Char_Check_Function); + type Char_Check_Function is access + function (Ch : C_Int; Usr : System.Address) return Curses_Bool; + pragma Convention (C, Char_Check_Function); - type Choice_Function is access - function (Fld : Field; Usr : System.Address) return Curses_Bool; - pragma Convention (C, Choice_Function); + type Choice_Function is access + function (Fld : Field; Usr : System.Address) return Curses_Bool; + pragma Convention (C, Choice_Function); -- +---------------------------------------------------------------------- -- | This must be in sync with the FIELDTYPE structure in form.h -- | - type Low_Level_Field_Type is + type Low_Level_Field_Type is record - Status : Interfaces.C.unsigned_short; - Ref_Count : Interfaces.C.long; - Left, Right : System.Address; - Makearg : Makearg_Function; - Copyarg : Copyarg_Function; - Freearg : Freearg_Function; - Fcheck : Field_Check_Function; - Ccheck : Char_Check_Function; - Next, Prev : Choice_Function; + Status : Interfaces.C.unsigned_short; + Ref_Count : Interfaces.C.long; + Left, Right : System.Address; + Makearg : Makearg_Function; + Copyarg : Copyarg_Function; + Freearg : Freearg_Function; + Fcheck : Field_Check_Function; + Ccheck : Char_Check_Function; + Next, Prev : Choice_Function; end record; - pragma Convention (C, Low_Level_Field_Type); - type C_Field_Type is access all Low_Level_Field_Type; + pragma Convention (C, Low_Level_Field_Type); + type C_Field_Type is access all Low_Level_Field_Type; - Null_Field_Type : constant C_Field_Type := null; + Null_Field_Type : constant C_Field_Type := null; -- +---------------------------------------------------------------------- -- | This four low-level fieldtypes are the ones associated with -- | fieldtypes handled by this binding. Any other low-level fieldtype -- | will result in a Form_Exception is function Get_Type. -- | - M_Generic_Type : C_Field_Type := null; - M_Generic_Choice : C_Field_Type := null; - M_Builtin_Router : C_Field_Type := null; - M_Choice_Router : C_Field_Type := null; + M_Generic_Type : C_Field_Type := null; + M_Generic_Choice : C_Field_Type := null; + M_Builtin_Router : C_Field_Type := null; + M_Choice_Router : C_Field_Type := null; -- Two wrapper functions to access those low-level fieldtypes defined -- in this package. - function C_Builtin_Router return C_Field_Type; - function C_Choice_Router return C_Field_Type; + function C_Builtin_Router return C_Field_Type; + function C_Choice_Router return C_Field_Type; - procedure Wrap_Builtin (Fld : Field; - Typ : Field_Type'Class; - Cft : C_Field_Type := C_Builtin_Router); + procedure Wrap_Builtin (Fld : Field; + Typ : Field_Type'Class; + Cft : C_Field_Type := C_Builtin_Router); -- This procedure has to be called by the Set_Field_Type implementation -- for builtin low-level fieldtypes to replace it by an Ada95 -- conformant Field_Type object. @@ -176,48 +177,48 @@ -- low-level fieldtypes witch choice functions (like TYP_ENUM). -- Any other value will raise a Form_Exception. - function Make_Arg (Args : System.Address) return System.Address; + function Make_Arg (Args : System.Address) return System.Address; pragma Import (C, Make_Arg, "void_star_make_arg"); -- This is the Makearg_Function for the internal low-level types -- introduced by this binding. - function Copy_Arg (Usr : System.Address) return System.Address; - pragma Convention (C, Copy_Arg); + function Copy_Arg (Usr : System.Address) return System.Address; + pragma Convention (C, Copy_Arg); -- This is the Copyarg_Function for the internal low-level types -- introduced by this binding. - procedure Free_Arg (Usr : System.Address); - pragma Convention (C, Free_Arg); + procedure Free_Arg (Usr : System.Address); + pragma Convention (C, Free_Arg); -- This is the Freearg_Function for the internal low-level types -- introduced by this binding. - function Field_Check_Router (Fld : Field; - Usr : System.Address) return Curses_Bool; - pragma Convention (C, Field_Check_Router); + function Field_Check_Router (Fld : Field; + Usr : System.Address) return Curses_Bool; + pragma Convention (C, Field_Check_Router); -- This is the Field_Check_Function for the internal low-level types -- introduced to wrap the low-level types by a Field_Type derived -- type. It routes the call to the corresponding low-level validation -- function. - function Char_Check_Router (Ch : C_Int; - Usr : System.Address) return Curses_Bool; - pragma Convention (C, Char_Check_Router); + function Char_Check_Router (Ch : C_Int; + Usr : System.Address) return Curses_Bool; + pragma Convention (C, Char_Check_Router); -- This is the Char_Check_Function for the internal low-level types -- introduced to wrap the low-level types by a Field_Type derived -- type. It routes the call to the corresponding low-level validation -- function. - function Next_Router (Fld : Field; - Usr : System.Address) return Curses_Bool; - pragma Convention (C, Next_Router); + function Next_Router (Fld : Field; + Usr : System.Address) return Curses_Bool; + pragma Convention (C, Next_Router); -- This is the Choice_Function for the internal low-level types -- introduced to wrap the low-level types by a Field_Type derived -- type. It routes the call to the corresponding low-level next_choice -- function. - function Prev_Router (Fld : Field; - Usr : System.Address) return Curses_Bool; - pragma Convention (C, Prev_Router); + function Prev_Router (Fld : Field; + Usr : System.Address) return Curses_Bool; + pragma Convention (C, Prev_Router); -- This is the Choice_Function for the internal low-level types -- introduced to wrap the low-level types by a Field_Type derived -- type. It routes the call to the corresponding low-level prev_choice @@ -225,33 +226,33 @@ -- This is the Argument structure maintained by all low-level field types -- introduced by this binding. - type Argument is record - Typ : Field_Type_Access; -- the Field_Type creating this record - Usr : System.Address; -- original arg for builtin low-level types - Cft : C_Field_Type; -- the original low-level type + type Argument is record + Typ : Field_Type_Access; -- the Field_Type creating this record + Usr : System.Address; -- original arg for builtin low-level types + Cft : C_Field_Type; -- the original low-level type end record; - type Argument_Access is access all Argument; + type Argument_Access is access all Argument; -- +---------------------------------------------------------------------- -- | -- | Some Imports of libform routines to deal with low-level fieldtypes. -- | - function New_Fieldtype (Fcheck : Field_Check_Function; - Ccheck : Char_Check_Function) - return C_Field_Type; + function New_Fieldtype (Fcheck : Field_Check_Function; + Ccheck : Char_Check_Function) + return C_Field_Type; pragma Import (C, New_Fieldtype, "new_fieldtype"); - function Set_Fieldtype_Arg (Cft : C_Field_Type; - Mak : Makearg_Function := Make_Arg'Access; - Cop : Copyarg_Function := Copy_Arg'Access; - Fre : Freearg_Function := Free_Arg'Access) - return C_Int; + function Set_Fieldtype_Arg (Cft : C_Field_Type; + Mak : Makearg_Function := Make_Arg'Access; + Cop : Copyarg_Function := Copy_Arg'Access; + Fre : Freearg_Function := Free_Arg'Access) + return Aux.Eti_Error; pragma Import (C, Set_Fieldtype_Arg, "set_fieldtype_arg"); - function Set_Fieldtype_Choice (Cft : C_Field_Type; - Next, Prev : Choice_Function) - return C_Int; + function Set_Fieldtype_Choice (Cft : C_Field_Type; + Next, Prev : Choice_Function) + return Aux.Eti_Error; pragma Import (C, Set_Fieldtype_Choice, "set_fieldtype_choice"); -end Terminal_Interface.Curses.Forms.Field_Types; +end Terminal_Interface.Curses.Forms.Field_Types; diff --git a/doc/html/ada/terminal_interface-curses-forms-field_user_data__adb.htm b/doc/html/ada/terminal_interface-curses-forms-field_user_data__adb.htm index 677ec93f..75986d66 100644 --- a/doc/html/ada/terminal_interface-curses-forms-field_user_data__adb.htm +++ b/doc/html/ada/terminal_interface-curses-forms-field_user_data__adb.htm @@ -24,7 +24,7 @@ -- B O D Y -- -- -- ------------------------------------------------------------------------------ --- Copyright (c) 1998-2003,2009 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 -- @@ -52,52 +52,49 @@ ------------------------------------------------------------------------------ -- Author: Juergen Pfeifer, 1996 -- Version Control: --- @Revision: 1.13 @ +-- @Revision: 1.15 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ -with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; +with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; -- | -- |===================================================================== -- | man page form_field_userptr.3x -- |===================================================================== -- | -package body Terminal_Interface.Curses.Forms.Field_User_Data is +package body Terminal_Interface.Curses.Forms.Field_User_Data is -- | -- | -- | use type Interfaces.C.int; - procedure Set_User_Data (Fld : Field; + procedure Set_User_Data (Fld : Field; Data : User_Access) is - function Set_Field_Userptr (Fld : Field; - Usr : User_Access) return C_Int; + function Set_Field_Userptr (Fld : Field; + 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 : Field) return User_Access + function Get_User_Data (Fld : Field) return User_Access is - function Field_Userptr (Fld : Field) return User_Access; + function Field_Userptr (Fld : Field) return User_Access; pragma Import (C, Field_Userptr, "field_userptr"); begin - return Field_Userptr (Fld); + return Field_Userptr (Fld); end Get_User_Data; - procedure Get_User_Data (Fld : Field; - Data : out User_Access) + procedure Get_User_Data (Fld : Field; + Data : out User_Access) is begin Data := Get_User_Data (Fld); end Get_User_Data; -end Terminal_Interface.Curses.Forms.Field_User_Data; +end Terminal_Interface.Curses.Forms.Field_User_Data; diff --git a/doc/html/ada/terminal_interface-curses-forms-field_user_data__ads.htm b/doc/html/ada/terminal_interface-curses-forms-field_user_data__ads.htm index 86f55965..b4354387 100644 --- a/doc/html/ada/terminal_interface-curses-forms-field_user_data__ads.htm +++ b/doc/html/ada/terminal_interface-curses-forms-field_user_data__ads.htm @@ -59,29 +59,29 @@ generic type User is limited private; type User_Access is access User; -package Terminal_Interface.Curses.Forms.Field_User_Data is - pragma Preelaborate (Terminal_Interface.Curses.Forms.Field_User_Data); +package Terminal_Interface.Curses.Forms.Field_User_Data is + pragma Preelaborate (Terminal_Interface.Curses.Forms.Field_User_Data); -- |===================================================================== -- | Man page form_field_userptr.3x -- |===================================================================== -- #1A NAME="AFU_1"#2| - procedure Set_User_Data (Fld : Field; + procedure Set_User_Data (Fld : Field; Data : User_Access); -- AKA: set_field_userptr pragma Inline (Set_User_Data); -- #1A NAME="AFU_2"#2| - procedure Get_User_Data (Fld : Field; - Data : out User_Access); + procedure Get_User_Data (Fld : Field; + Data : out User_Access); -- AKA: field_userptr -- #1A NAME="AFU_3"#2| - function Get_User_Data (Fld : Field) return User_Access; + function Get_User_Data (Fld : Field) return User_Access; -- AKA: field_userptr -- Sama as function pragma Inline (Get_User_Data); -end Terminal_Interface.Curses.Forms.Field_User_Data; +end Terminal_Interface.Curses.Forms.Field_User_Data; diff --git a/doc/html/ada/terminal_interface-curses-forms-form_user_data__adb.htm b/doc/html/ada/terminal_interface-curses-forms-form_user_data__adb.htm index 5a48dd91..bc3e0655 100644 --- a/doc/html/ada/terminal_interface-curses-forms-form_user_data__adb.htm +++ b/doc/html/ada/terminal_interface-curses-forms-form_user_data__adb.htm @@ -24,7 +24,7 @@ -- B O D Y -- -- -- ------------------------------------------------------------------------------ --- Copyright (c) 1998-2003,2009 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 -- @@ -52,7 +52,7 @@ ------------------------------------------------------------------------------ -- Author: Juergen Pfeifer, 1996 -- Version Control: --- @Revision: 1.13 @ +-- @Revision: 1.15 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ -- | @@ -60,45 +60,42 @@ -- | man page form__userptr.3x -- |===================================================================== -- | -with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; +with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; -package body Terminal_Interface.Curses.Forms.Form_User_Data is +package body Terminal_Interface.Curses.Forms.Form_User_Data is use type Interfaces.C.int; -- | -- | -- | - procedure Set_User_Data (Frm : Form; + procedure Set_User_Data (Frm : Form; Data : User_Access) is - function Set_Form_Userptr (Frm : Form; - Data : User_Access) return C_Int; + function Set_Form_Userptr (Frm : Form; + 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 : Form) return User_Access + function Get_User_Data (Frm : Form) return User_Access is - function Form_Userptr (Frm : Form) return User_Access; + function Form_Userptr (Frm : Form) return User_Access; pragma Import (C, Form_Userptr, "form_userptr"); begin - return Form_Userptr (Frm); + return Form_Userptr (Frm); end Get_User_Data; - procedure Get_User_Data (Frm : Form; - Data : out User_Access) + procedure Get_User_Data (Frm : Form; + Data : out User_Access) is begin Data := Get_User_Data (Frm); end Get_User_Data; -end Terminal_Interface.Curses.Forms.Form_User_Data; +end Terminal_Interface.Curses.Forms.Form_User_Data; diff --git a/doc/html/ada/terminal_interface-curses-forms-form_user_data__ads.htm b/doc/html/ada/terminal_interface-curses-forms-form_user_data__ads.htm index 5817e189..d33dac5d 100644 --- a/doc/html/ada/terminal_interface-curses-forms-form_user_data__ads.htm +++ b/doc/html/ada/terminal_interface-curses-forms-form_user_data__ads.htm @@ -59,29 +59,29 @@ generic type User is limited private; type User_Access is access User; -package Terminal_Interface.Curses.Forms.Form_User_Data is - pragma Preelaborate (Terminal_Interface.Curses.Forms.Form_User_Data); +package Terminal_Interface.Curses.Forms.Form_User_Data is + pragma Preelaborate (Terminal_Interface.Curses.Forms.Form_User_Data); -- |===================================================================== -- | Man page form_userptr.3x -- |===================================================================== -- #1A NAME="AFU_1"#2| - procedure Set_User_Data (Frm : Form; + procedure Set_User_Data (Frm : Form; Data : User_Access); -- AKA: set_form_userptr pragma Inline (Set_User_Data); -- #1A NAME="AFU_2"#2| - procedure Get_User_Data (Frm : Form; - Data : out User_Access); + procedure Get_User_Data (Frm : Form; + Data : out User_Access); -- AKA: form_userptr -- #1A NAME="AFU_3"#2| - function Get_User_Data (Frm : Form) return User_Access; + function Get_User_Data (Frm : Form) return User_Access; -- AKA: form_userptr -- Same as function pragma Inline (Get_User_Data); -end Terminal_Interface.Curses.Forms.Form_User_Data; +end Terminal_Interface.Curses.Forms.Form_User_Data; diff --git a/doc/html/ada/terminal_interface-curses-forms__adb.htm b/doc/html/ada/terminal_interface-curses-forms__adb.htm index 305ba176..9d62eb23 100644 --- a/doc/html/ada/terminal_interface-curses-forms__adb.htm +++ b/doc/html/ada/terminal_interface-curses-forms__adb.htm @@ -24,7 +24,7 @@ -- B O D Y -- -- -- ------------------------------------------------------------------------------ --- Copyright (c) 1998-2009,2011 Free Software Foundation, Inc. -- +-- Copyright (c) 1998-2011,2014 Free Software Foundation, Inc. -- -- -- -- Permission is hereby granted, free of charge, to any person obtaining a -- -- copy of this software and associated documentation files (the -- @@ -52,26 +52,25 @@ ------------------------------------------------------------------------------ -- Author: Juergen Pfeifer, 1996 -- Version Control: --- @Revision: 1.28 @ --- @Date: 2011/03/22 23:37:32 @ +-- @Revision: 1.32 @ +-- @Date: 2014/05/24 21:31:05 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ with Ada.Unchecked_Deallocation; -with Ada.Unchecked_Conversion; with Interfaces.C; use Interfaces.C; with Interfaces.C.Strings; use Interfaces.C.Strings; with Interfaces.C.Pointers; -with Terminal_Interface.Curses.Aux; +with Terminal_Interface.Curses.Aux; -package body Terminal_Interface.Curses.Forms is +package body Terminal_Interface.Curses.Forms is - use Terminal_Interface.Curses.Aux; + use Terminal_Interface.Curses.Aux; - type C_Field_Array is array (Natural range <>) of aliased Field; + type C_Field_Array is array (Natural range <>) of aliased Field; package F_Array is new - Interfaces.C.Pointers (Natural, Field, C_Field_Array, Null_Field); + Interfaces.C.Pointers (Natural, Field, C_Field_Array, Null_Field); ------------------------------------------------------------------------------ -- | @@ -79,38 +78,22 @@ -- | -- subtype chars_ptr is Interfaces.C.Strings.chars_ptr; - function FOS_2_CInt is new - Ada.Unchecked_Conversion (Field_Option_Set, - C_Int); - - function CInt_2_FOS is new - Ada.Unchecked_Conversion (C_Int, - Field_Option_Set); - - function FrmOS_2_CInt is new - Ada.Unchecked_Conversion (Form_Option_Set, - C_Int); - - function CInt_2_FrmOS is new - Ada.Unchecked_Conversion (C_Int, - Form_Option_Set); - - procedure Request_Name (Key : Form_Request_Code; - Name : out String) + procedure Request_Name (Key : Form_Request_Code; + Name : out String) is - function Form_Request_Name (Key : C_Int) return chars_ptr; + function Form_Request_Name (Key : C_Int) return chars_ptr; pragma Import (C, Form_Request_Name, "form_request_name"); begin - Fill_String (Form_Request_Name (C_Int (Key)), Name); - end Request_Name; + Fill_String (Form_Request_Name (C_Int (Key)), Name); + end Request_Name; - function Request_Name (Key : Form_Request_Code) return String + function Request_Name (Key : Form_Request_Code) return String is - function Form_Request_Name (Key : C_Int) return chars_ptr; + function Form_Request_Name (Key : C_Int) return chars_ptr; pragma Import (C, Form_Request_Name, "form_request_name"); begin - return Fill_String (Form_Request_Name (C_Int (Key))); - end Request_Name; + return Fill_String (Form_Request_Name (C_Int (Key))); + end Request_Name; ------------------------------------------------------------------------------ -- | -- | @@ -122,84 +105,80 @@ -- | -- | -- | - function Create (Height : Line_Count; - Width : Column_Count; - Top : Line_Position; - Left : Column_Position; - Off_Screen : Natural := 0; - More_Buffers : Buffer_Number := Buffer_Number'First) - return Field + function Create (Height : Line_Count; + Width : Column_Count; + Top : Line_Position; + Left : Column_Position; + Off_Screen : Natural := 0; + More_Buffers : Buffer_Number := Buffer_Number'First) + return Field is - function Newfield (H, W, T, L, O, M : C_Int) return Field; + function Newfield (H, W, T, L, O, M : C_Int) return Field; pragma Import (C, Newfield, "new_field"); - Fld : constant Field := Newfield (C_Int (Height), C_Int (Width), - C_Int (Top), C_Int (Left), - C_Int (Off_Screen), - C_Int (More_Buffers)); + Fld : constant Field := Newfield (C_Int (Height), C_Int (Width), + C_Int (Top), C_Int (Left), + C_Int (Off_Screen), + C_Int (More_Buffers)); begin - if Fld = Null_Field then - raise Form_Exception; + if Fld = Null_Field then + raise Form_Exception; end if; - return Fld; - end Create; + return Fld; + end Create; -- | -- | -- | - procedure Delete (Fld : in out Field) + 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; - Fld := Null_Field; - end Delete; + Eti_Exception (Free_Field (Fld)); + Fld := Null_Field; + end Delete; -- | -- | -- | - function Duplicate (Fld : Field; - Top : Line_Position; - Left : Column_Position) return Field + function Duplicate (Fld : Field; + Top : Line_Position; + Left : Column_Position) return Field is - function Dup_Field (Fld : Field; - Top : C_Int; - Left : C_Int) return Field; + function Dup_Field (Fld : Field; + Top : C_Int; + Left : C_Int) return Field; pragma Import (C, Dup_Field, "dup_field"); - F : constant Field := Dup_Field (Fld, - C_Int (Top), - C_Int (Left)); + F : constant Field := Dup_Field (Fld, + C_Int (Top), + C_Int (Left)); begin - if F = Null_Field then - raise Form_Exception; + if F = Null_Field then + raise Form_Exception; end if; - return F; - end Duplicate; + return F; + end Duplicate; -- | -- | -- | - function Link (Fld : Field; - Top : Line_Position; - Left : Column_Position) return Field + function Link (Fld : Field; + Top : Line_Position; + Left : Column_Position) return Field is - function Lnk_Field (Fld : Field; - Top : C_Int; - Left : C_Int) return Field; + function Lnk_Field (Fld : Field; + Top : C_Int; + Left : C_Int) return Field; pragma Import (C, Lnk_Field, "link_field"); - F : constant Field := Lnk_Field (Fld, - C_Int (Top), - C_Int (Left)); + F : constant Field := Lnk_Field (Fld, + C_Int (Top), + C_Int (Left)); begin - if F = Null_Field then - raise Form_Exception; + if F = Null_Field then + raise Form_Exception; end if; - return F; - end Link; + return F; + end Link; -- | -- |===================================================================== -- | man page form_field_just.3x @@ -207,31 +186,27 @@ -- | -- | -- | - procedure Set_Justification (Fld : Field; - Just : 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; + function Set_Field_Just (Fld : Field; + 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; - end Set_Justification; + Eti_Exception (Set_Field_Just (Fld, + C_Int (Field_Justification'Pos (Just)))); + end Set_Justification; -- | -- | -- | - function Get_Justification (Fld : Field) return Field_Justification + function Get_Justification (Fld : Field) return Field_Justification is - function Field_Just (Fld : Field) return C_Int; + function Field_Just (Fld : Field) return C_Int; pragma Import (C, Field_Just, "field_just"); begin - return Field_Justification'Val (Field_Just (Fld)); - end Get_Justification; + return Field_Justification'Val (Field_Just (Fld)); + end Get_Justification; -- | -- |===================================================================== -- | man page form_field_buffer.3x @@ -239,101 +214,89 @@ -- | -- | -- | - procedure Set_Buffer - (Fld : Field; - Buffer : Buffer_Number := Buffer_Number'First; - Str : String) + procedure Set_Buffer + (Fld : Field; + Buffer : Buffer_Number := Buffer_Number'First; + Str : String) is - type Char_Ptr is access all Interfaces.C.char; - function Set_Fld_Buffer (Fld : Field; - Bufnum : C_Int; - S : Char_Ptr) - return C_Int; + function Set_Fld_Buffer (Fld : Field; + Bufnum : 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; - end Set_Buffer; + Eti_Exception (Set_Fld_Buffer (Fld, C_Int (Buffer), To_C (Str))); + end Set_Buffer; -- | -- | -- | - procedure Get_Buffer - (Fld : Field; - Buffer : Buffer_Number := Buffer_Number'First; - Str : out String) + procedure Get_Buffer + (Fld : Field; + Buffer : Buffer_Number := Buffer_Number'First; + Str : out String) is - function Field_Buffer (Fld : Field; - B : C_Int) return chars_ptr; + function Field_Buffer (Fld : Field; + B : C_Int) return chars_ptr; pragma Import (C, Field_Buffer, "field_buffer"); begin - Fill_String (Field_Buffer (Fld, C_Int (Buffer)), Str); - end Get_Buffer; + Fill_String (Field_Buffer (Fld, C_Int (Buffer)), Str); + end Get_Buffer; - function Get_Buffer - (Fld : Field; - Buffer : Buffer_Number := Buffer_Number'First) return String + function Get_Buffer + (Fld : Field; + Buffer : Buffer_Number := Buffer_Number'First) return String is - function Field_Buffer (Fld : Field; - B : C_Int) return chars_ptr; + function Field_Buffer (Fld : Field; + B : C_Int) return chars_ptr; pragma Import (C, Field_Buffer, "field_buffer"); begin - return Fill_String (Field_Buffer (Fld, C_Int (Buffer))); - end Get_Buffer; + return Fill_String (Field_Buffer (Fld, C_Int (Buffer))); + end Get_Buffer; -- | -- | -- | - procedure Set_Status (Fld : Field; - Status : Boolean := True) + procedure Set_Status (Fld : Field; + Status : Boolean := True) is - function Set_Fld_Status (Fld : Field; - St : C_Int) return C_Int; + function Set_Fld_Status (Fld : Field; + 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 - raise Form_Exception; + if Set_Fld_Status (Fld, Boolean'Pos (Status)) /= E_Ok then + raise Form_Exception; end if; - end Set_Status; + end Set_Status; -- | -- | -- | - function Changed (Fld : Field) return Boolean + function Changed (Fld : Field) return Boolean is - function Field_Status (Fld : Field) return C_Int; + function Field_Status (Fld : Field) return C_Int; pragma Import (C, Field_Status, "field_status"); - Res : constant C_Int := Field_Status (Fld); + Res : constant C_Int := Field_Status (Fld); begin - if Res = Curses_False then + if Res = Curses_False then return False; else return True; end if; - end Changed; + end Changed; -- | -- | -- | - procedure Set_Maximum_Size (Fld : Field; - Max : Natural := 0) + procedure Set_Maximum_Size (Fld : Field; + Max : Natural := 0) is - function Set_Field_Max (Fld : Field; - M : C_Int) return C_Int; + function Set_Field_Max (Fld : Field; + 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; - end Set_Maximum_Size; + Eti_Exception (Set_Field_Max (Fld, C_Int (Max))); + end Set_Maximum_Size; -- | -- |===================================================================== -- | man page form_field_opts.3x @@ -341,71 +304,60 @@ -- | -- | -- | - procedure Set_Options (Fld : Field; - Options : 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; + function Set_Field_Opts (Fld : Field; + 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; - end Set_Options; + Eti_Exception (Set_Field_Opts (Fld, Options)); + end Set_Options; -- | -- | -- | - procedure Switch_Options (Fld : Field; - Options : Field_Option_Set; - On : Boolean := True) + 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; + function Field_Opts_On (Fld : Field; + 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; + function Field_Opts_Off (Fld : Field; + 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); + if On then + 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; + end Switch_Options; -- | -- | -- | - procedure Get_Options (Fld : Field; - Options : out Field_Option_Set) + 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); - end Get_Options; + Options := Field_Opts (Fld); + end Get_Options; -- | -- | -- | - function Get_Options (Fld : Field := Null_Field) - return Field_Option_Set + function Get_Options (Fld : Field := Null_Field) + return Field_Option_Set is - Fos : Field_Option_Set; + Fos : Field_Option_Set; begin - Get_Options (Fld, Fos); - return Fos; - end Get_Options; + Get_Options (Fld, Fos); + return Fos; + end Get_Options; -- | -- |===================================================================== -- | man page form_field_attributes.3x @@ -413,119 +365,106 @@ -- | -- | -- | - procedure Set_Foreground - (Fld : Field; - Fore : Character_Attribute_Set := Normal_Video; - Color : Color_Pair := Color_Pair'First) + procedure Set_Foreground + (Fld : Field; + Fore : Character_Attribute_Set := Normal_Video; + Color : Color_Pair := Color_Pair'First) is - function Set_Field_Fore (Fld : Field; - Attr : C_Chtype) return C_Int; + function Set_Field_Fore (Fld : Field; + 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; - end Set_Foreground; + Eti_Exception (Set_Field_Fore (Fld, (Ch => Character'First, + Color => Color, + Attr => Fore))); + end Set_Foreground; -- | -- | -- | - procedure Foreground (Fld : Field; - Fore : out Character_Attribute_Set) + 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; - end Foreground; + Fore := Field_Fore (Fld).Attr; + end Foreground; - procedure Foreground (Fld : Field; - Fore : out Character_Attribute_Set; - Color : out Color_Pair) + 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; - end Foreground; + Fore := Field_Fore (Fld).Attr; + Color := Field_Fore (Fld).Color; + end Foreground; -- | -- | -- | - procedure Set_Background - (Fld : Field; - Back : Character_Attribute_Set := Normal_Video; - Color : Color_Pair := Color_Pair'First) + procedure Set_Background + (Fld : Field; + Back : Character_Attribute_Set := Normal_Video; + Color : Color_Pair := Color_Pair'First) is - function Set_Field_Back (Fld : Field; - Attr : C_Chtype) return C_Int; + function Set_Field_Back (Fld : Field; + 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; - end Set_Background; + Eti_Exception (Set_Field_Back (Fld, (Ch => Character'First, + Color => Color, + Attr => Back))); + end Set_Background; -- | -- | -- | - procedure Background (Fld : Field; - Back : out Character_Attribute_Set) + 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; - end Background; + Back := Field_Back (Fld).Attr; + end Background; - procedure Background (Fld : Field; - Back : out Character_Attribute_Set; - Color : out Color_Pair) + 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; - end Background; + Back := Field_Back (Fld).Attr; + Color := Field_Back (Fld).Color; + end Background; -- | -- | -- | - procedure Set_Pad_Character (Fld : Field; - Pad : Character := Space) + procedure Set_Pad_Character (Fld : Field; + Pad : Character := Space) is - function Set_Field_Pad (Fld : Field; - Ch : C_Int) return C_Int; + function Set_Field_Pad (Fld : Field; + 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; - end Set_Pad_Character; + Eti_Exception (Set_Field_Pad (Fld, + C_Int (Character'Pos (Pad)))); + end Set_Pad_Character; -- | -- | -- | - procedure Pad_Character (Fld : Field; - Pad : out Character) + procedure Pad_Character (Fld : Field; + Pad : out Character) is - function Field_Pad (Fld : Field) return C_Int; + function Field_Pad (Fld : Field) return C_Int; pragma Import (C, Field_Pad, "field_pad"); begin - Pad := Character'Val (Field_Pad (Fld)); - end Pad_Character; + Pad := Character'Val (Field_Pad (Fld)); + end Pad_Character; -- | -- |===================================================================== -- | man page form_field_info.3x @@ -533,62 +472,54 @@ -- | -- | -- | - procedure Info (Fld : Field; - Lines : out Line_Count; - Columns : out Column_Count; - First_Row : out Line_Position; - First_Column : out Column_Position; - Off_Screen : out Natural; - Additional_Buffers : out Buffer_Number) + procedure Info (Fld : Field; + Lines : out Line_Count; + Columns : out Column_Count; + First_Row : out Line_Position; + First_Column : out Column_Position; + Off_Screen : out Natural; + Additional_Buffers : out Buffer_Number) is - type C_Int_Access is access all C_Int; - function Fld_Info (Fld : Field; - L, C, Fr, Fc, Os, Ab : C_Int_Access) - return C_Int; + type C_Int_Access is access all C_Int; + function Fld_Info (Fld : Field; + L, C, Fr, Fc, Os, Ab : C_Int_Access) + 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); + L, C, Fr, Fc, Os, Ab : aliased C_Int; begin - if Res /= E_Ok then - Eti_Exception (Res); - else - Lines := Line_Count (L); - Columns := Column_Count (C); - First_Row := Line_Position (Fr); - First_Column := Column_Position (Fc); - Off_Screen := Natural (Os); - Additional_Buffers := Buffer_Number (Ab); - end if; - end Info; + 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 : Field; - Lines : out Line_Count; - Columns : out Column_Count; - Max : out Natural) + 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; + type C_Int_Access is access all 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); + L, C, M : aliased C_Int; begin - if Res /= E_Ok then - Eti_Exception (Res); - else - Lines := Line_Count (L); - Columns := Column_Count (C); - Max := Natural (M); - end if; - end Dynamic_Info; + 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; -- | -- |===================================================================== -- | man page form_win.3x @@ -596,79 +527,70 @@ -- | -- | -- | - procedure Set_Window (Frm : Form; - Win : Window) + procedure Set_Window (Frm : Form; + Win : Window) is - function Set_Form_Win (Frm : Form; - Win : Window) return C_Int; + function Set_Form_Win (Frm : Form; + 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; - end Set_Window; + Eti_Exception (Set_Form_Win (Frm, Win)); + end Set_Window; -- | -- | -- | - function Get_Window (Frm : Form) return Window + function Get_Window (Frm : Form) return Window is - function Form_Win (Frm : Form) return Window; + function Form_Win (Frm : Form) return Window; pragma Import (C, Form_Win, "form_win"); - W : constant Window := Form_Win (Frm); + W : constant Window := Form_Win (Frm); begin - return W; - end Get_Window; + return W; + end Get_Window; -- | -- | -- | - procedure Set_Sub_Window (Frm : Form; - Win : Window) + procedure Set_Sub_Window (Frm : Form; + Win : Window) is - function Set_Form_Sub (Frm : Form; - Win : Window) return C_Int; + function Set_Form_Sub (Frm : Form; + 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; - end Set_Sub_Window; + Eti_Exception (Set_Form_Sub (Frm, Win)); + end Set_Sub_Window; -- | -- | -- | - function Get_Sub_Window (Frm : Form) return Window + function Get_Sub_Window (Frm : Form) return Window is - function Form_Sub (Frm : Form) return Window; + function Form_Sub (Frm : Form) return Window; pragma Import (C, Form_Sub, "form_sub"); - W : constant Window := Form_Sub (Frm); + W : constant Window := Form_Sub (Frm); begin - return W; - end Get_Sub_Window; + return W; + end Get_Sub_Window; -- | -- | -- | - procedure Scale (Frm : Form; - Lines : out Line_Count; - Columns : out Column_Count) + 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; + type C_Int_Access is access all 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); + X, Y : aliased C_Int; begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; - Lines := Line_Count (Y); - Columns := Column_Count (X); - end Scale; + Eti_Exception (M_Scale (Frm, Y'Access, X'Access)); + Lines := Line_Count (Y); + Columns := Column_Count (X); + end Scale; -- | -- |===================================================================== -- | man page menu_hook.3x @@ -676,67 +598,55 @@ -- | -- | -- | - procedure Set_Field_Init_Hook (Frm : Form; - Proc : 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; + function Set_Field_Init (Frm : Form; + 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; - end Set_Field_Init_Hook; + Eti_Exception (Set_Field_Init (Frm, Proc)); + end Set_Field_Init_Hook; -- | -- | -- | - procedure Set_Field_Term_Hook (Frm : Form; - Proc : 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; + function Set_Field_Term (Frm : Form; + 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; - end Set_Field_Term_Hook; + Eti_Exception (Set_Field_Term (Frm, Proc)); + end Set_Field_Term_Hook; -- | -- | -- | - procedure Set_Form_Init_Hook (Frm : Form; - Proc : 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; + function Set_Form_Init (Frm : Form; + 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; - end Set_Form_Init_Hook; + Eti_Exception (Set_Form_Init (Frm, Proc)); + end Set_Form_Init_Hook; -- | -- | -- | - procedure Set_Form_Term_Hook (Frm : Form; - Proc : 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; + function Set_Form_Term (Frm : Form; + 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; - end Set_Form_Term_Hook; + Eti_Exception (Set_Form_Term (Frm, Proc)); + end Set_Form_Term_Hook; -- | -- |===================================================================== -- | man page form_fields.3x @@ -744,71 +654,64 @@ -- | -- | -- | - procedure Redefine (Frm : Form; - Flds : Field_Array_Access) + procedure Redefine (Frm : Form; + Flds : Field_Array_Access) is - function Set_Frm_Fields (Frm : Form; - Items : System.Address) return C_Int; + function Set_Frm_Fields (Frm : Form; + Items : System.Address) return Eti_Error; pragma Import (C, Set_Frm_Fields, "set_form_fields"); - Res : Eti_Error; begin - pragma Assert (Flds.all (Flds'Last) = Null_Field); - if Flds.all (Flds'Last) /= Null_Field then - raise Form_Exception; + pragma Assert (Flds.all (Flds'Last) = Null_Field); + if Flds.all (Flds'Last) /= Null_Field then + raise Form_Exception; else - Res := Set_Frm_Fields (Frm, Flds.all (Flds'First)'Address); - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Frm_Fields (Frm, Flds.all (Flds'First)'Address)); end if; - end Redefine; + end Redefine; -- | -- | -- | - function Fields (Frm : Form; - Index : Positive) return Field + function Fields (Frm : Form; + Index : Positive) return Field is use F_Array; - function C_Fields (Frm : Form) return Pointer; + function C_Fields (Frm : Form) return Pointer; pragma Import (C, C_Fields, "form_fields"); - P : Pointer := C_Fields (Frm); + P : Pointer := C_Fields (Frm); begin - if P = null or else Index > Field_Count (Frm) then - raise Form_Exception; + if P = null or else Index > Field_Count (Frm) then + raise Form_Exception; else - P := P + ptrdiff_t (C_Int (Index) - 1); + P := P + ptrdiff_t (C_Int (Index) - 1); return P.all; end if; - end Fields; + end Fields; -- | -- | -- | - function Field_Count (Frm : Form) return Natural + function Field_Count (Frm : Form) return Natural is - function Count (Frm : Form) return C_Int; + function Count (Frm : Form) return C_Int; pragma Import (C, Count, "field_count"); begin - return Natural (Count (Frm)); - end Field_Count; + return Natural (Count (Frm)); + end Field_Count; -- | -- | -- | - procedure Move (Fld : Field; - Line : Line_Position; - Column : 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; - end Move; + Eti_Exception (Move (Fld, C_Int (Line), C_Int (Column))); + end Move; -- | -- |===================================================================== -- | man page form_new.3x @@ -816,39 +719,36 @@ -- | -- | -- | - function Create (Fields : Field_Array_Access) return Form + function Create (Fields : Field_Array_Access) return Form is - function NewForm (Fields : System.Address) return Form; + function NewForm (Fields : System.Address) return Form; pragma Import (C, NewForm, "new_form"); - M : Form; + M : Form; begin - pragma Assert (Fields.all (Fields'Last) = Null_Field); - if Fields.all (Fields'Last) /= Null_Field then - raise Form_Exception; + pragma Assert (Fields.all (Fields'Last) = Null_Field); + if Fields.all (Fields'Last) /= Null_Field then + raise Form_Exception; else - M := NewForm (Fields.all (Fields'First)'Address); - if M = Null_Form then - raise Form_Exception; + M := NewForm (Fields.all (Fields'First)'Address); + if M = Null_Form then + raise Form_Exception; end if; - return M; + return M; end if; - end Create; + end Create; -- | -- | -- | - procedure Delete (Frm : in out Form) + 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; - Frm := Null_Form; - end Delete; + Eti_Exception (Free (Frm)); + Frm := Null_Form; + end Delete; -- | -- |===================================================================== -- | man page form_opts.3x @@ -856,70 +756,59 @@ -- | -- | -- | - procedure Set_Options (Frm : Form; - Options : 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; + function Set_Form_Opts (Frm : Form; + 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; - end Set_Options; + Eti_Exception (Set_Form_Opts (Frm, Options)); + end Set_Options; -- | -- | -- | - procedure Switch_Options (Frm : Form; - Options : Form_Option_Set; - On : Boolean := True) + 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; + function Form_Opts_On (Frm : Form; + 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; + function Form_Opts_Off (Frm : Form; + 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); + if On then + Eti_Exception (Form_Opts_On (Frm, Options)); else - Err := Form_Opts_Off (Frm, Opt); + Eti_Exception (Form_Opts_Off (Frm, Options)); end if; - if Err /= E_Ok then - Eti_Exception (Err); - end if; - end Switch_Options; + end Switch_Options; -- | -- | -- | - procedure Get_Options (Frm : Form; - Options : out Form_Option_Set) + 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); - end Get_Options; + Options := Form_Opts (Frm); + end Get_Options; -- | -- | -- | - function Get_Options (Frm : Form := Null_Form) return Form_Option_Set + function Get_Options (Frm : Form := Null_Form) return Form_Option_Set is - Fos : Form_Option_Set; + Fos : Form_Option_Set; begin - Get_Options (Frm, Fos); - return Fos; - end Get_Options; + Get_Options (Frm, Fos); + return Fos; + end Get_Options; -- | -- |===================================================================== -- | man page form_post.3x @@ -927,25 +816,21 @@ -- | -- | -- | - procedure Post (Frm : Form; - Post : 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); + if Post then + 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; + end Post; -- | -- |===================================================================== -- | man page form_cursor.3x @@ -953,17 +838,14 @@ -- | -- | -- | - procedure Position_Cursor (Frm : Form) + 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; - end Position_Cursor; + Eti_Exception (Pos_Form_Cursor (Frm)); + end Position_Cursor; -- | -- |===================================================================== -- | man page form_data.3x @@ -971,35 +853,35 @@ -- | -- | -- | - function Data_Ahead (Frm : Form) return Boolean + function Data_Ahead (Frm : Form) return Boolean is - function Ahead (Frm : Form) return C_Int; + function Ahead (Frm : Form) return C_Int; pragma Import (C, Ahead, "data_ahead"); - Res : constant C_Int := Ahead (Frm); + Res : constant C_Int := Ahead (Frm); begin - if Res = Curses_False then + if Res = Curses_False then return False; else return True; end if; - end Data_Ahead; + end Data_Ahead; -- | -- | -- | - function Data_Behind (Frm : Form) return Boolean + function Data_Behind (Frm : Form) return Boolean is - function Behind (Frm : Form) return C_Int; + function Behind (Frm : Form) return C_Int; pragma Import (C, Behind, "data_behind"); - Res : constant C_Int := Behind (Frm); + Res : constant C_Int := Behind (Frm); begin - if Res = Curses_False then + if Res = Curses_False then return False; else return True; end if; - end Data_Behind; + end Data_Behind; -- | -- |===================================================================== -- | man page form_driver.3x @@ -1007,29 +889,26 @@ -- | -- | -- | - function Driver (Frm : Form; - Key : Key_Code) return Driver_Result + 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)); + R : constant Eti_Error := Frm_Driver (Frm, C_Int (Key)); begin - if R /= E_Ok then - if R = E_Unknown_Command then - return Unknown_Request; - elsif R = E_Invalid_Field then - return Invalid_Field; - elsif R = E_Request_Denied then - return Request_Denied; - else - Eti_Exception (R); - return Form_Ok; - end if; - else - return Form_Ok; - end if; - end Driver; + case R is + when E_Unknown_Command => + return Unknown_Request; + when E_Invalid_Field => + return Invalid_Field; + when E_Request_Denied => + return Request_Denied; + when others => + Eti_Exception (R); + return Form_Ok; + end case; + end Driver; -- | -- |===================================================================== -- | man page form_page.3x @@ -1037,77 +916,71 @@ -- | -- | -- | - procedure Set_Current (Frm : Form; - Fld : 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; - end Set_Current; + Eti_Exception (Set_Current_Fld (Frm, Fld)); + end Set_Current; -- | -- | -- | - function Current (Frm : Form) return Field + function Current (Frm : Form) return Field is - function Current_Fld (Frm : Form) return Field; + function Current_Fld (Frm : Form) return Field; pragma Import (C, Current_Fld, "current_field"); - Fld : constant Field := Current_Fld (Frm); + Fld : constant Field := Current_Fld (Frm); begin - if Fld = Null_Field then - raise Form_Exception; + if Fld = Null_Field then + raise Form_Exception; end if; - return Fld; - end Current; + return Fld; + end Current; -- | -- | -- | - procedure Set_Page (Frm : Form; - Page : 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; - end Set_Page; + Eti_Exception (Set_Frm_Page (Frm, C_Int (Page))); + end Set_Page; -- | -- | -- | - function Page (Frm : Form) return Page_Number + function Page (Frm : Form) return Page_Number is - function Get_Page (Frm : Form) return C_Int; + function Get_Page (Frm : Form) return C_Int; pragma Import (C, Get_Page, "form_page"); - P : constant C_Int := Get_Page (Frm); + P : constant C_Int := Get_Page (Frm); begin - if P < 0 then - raise Form_Exception; + if P < 0 then + raise Form_Exception; else - return Page_Number (P); + return Page_Number (P); end if; - end Page; + end Page; - function Get_Index (Fld : Field) return Positive + function Get_Index (Fld : Field) return Positive is - function Get_Fieldindex (Fld : Field) return C_Int; + function Get_Fieldindex (Fld : Field) return C_Int; pragma Import (C, Get_Fieldindex, "field_index"); - Res : constant C_Int := Get_Fieldindex (Fld); + Res : constant C_Int := Get_Fieldindex (Fld); begin - if Res = Curses_Err then - raise Form_Exception; + if Res = Curses_Err then + raise Form_Exception; end if; - return Positive (Natural (Res) + Positive'First); - end Get_Index; + return Positive (Natural (Res) + Positive'First); + end Get_Index; -- | -- |===================================================================== @@ -1116,64 +989,61 @@ -- | -- | -- | - procedure Set_New_Page (Fld : Field; - New_Page : 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; - end Set_New_Page; + Eti_Exception (Set_Page (Fld, Boolean'Pos (New_Page))); + end Set_New_Page; -- | -- | -- | - function Is_New_Page (Fld : Field) return Boolean + function Is_New_Page (Fld : Field) return Boolean is - function Is_New (Fld : Field) return C_Int; + function Is_New (Fld : Field) return C_Int; pragma Import (C, Is_New, "new_page"); - Res : constant C_Int := Is_New (Fld); + Res : constant C_Int := Is_New (Fld); begin - if Res = Curses_False then + if Res = Curses_False then return False; else return True; end if; - end Is_New_Page; + end Is_New_Page; - procedure Free (FA : in out Field_Array_Access; - Free_Fields : Boolean := False) + procedure Free (FA : in out Field_Array_Access; + Free_Fields : Boolean := False) is procedure Release is new Ada.Unchecked_Deallocation - (Field_Array, Field_Array_Access); + (Field_Array, Field_Array_Access); begin - if FA /= null and then Free_Fields then - for I in FA'First .. (FA'Last - 1) loop - if FA.all (I) /= Null_Field then - Delete (FA.all (I)); + if FA /= null and then Free_Fields then + for I in FA'First .. (FA'Last - 1) loop + if FA.all (I) /= Null_Field then + Delete (FA.all (I)); end if; end loop; end if; - Release (FA); - end Free; + Release (FA); + end Free; -- |===================================================================== - function Default_Field_Options return Field_Option_Set + function Default_Field_Options return Field_Option_Set is begin - return Get_Options (Null_Field); - end Default_Field_Options; + return Get_Options (Null_Field); + end Default_Field_Options; - function Default_Form_Options return Form_Option_Set + function Default_Form_Options return Form_Option_Set is begin - return Get_Options (Null_Form); - end Default_Form_Options; + return Get_Options (Null_Form); + end Default_Form_Options; -end Terminal_Interface.Curses.Forms; +end Terminal_Interface.Curses.Forms; diff --git a/doc/html/ada/terminal_interface-curses-forms__ads.htm b/doc/html/ada/terminal_interface-curses-forms__ads.htm index 2a244ab7..dd40209a 100644 --- a/doc/html/ada/terminal_interface-curses-forms__ads.htm +++ b/doc/html/ada/terminal_interface-curses-forms__ads.htm @@ -24,7 +24,7 @@ -- S P E C -- -- -- ------------------------------------------------------------------------------ --- Copyright (c) 1998-2006,2009 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 -- @@ -52,388 +52,387 @@ ------------------------------------------------------------------------------ -- Author: Juergen Pfeifer, 1996 -- Version Control: --- @Revision: 1.30 @ --- @Date: 2009/12/26 17:31:35 @ +-- @Revision: 1.33 @ +-- @Date: 2014/05/24 21:31:57 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ --- form binding. --- This module is generated. Please don't change it manually! --- Run the generator instead. --- | with System; with Ada.Characters.Latin_1; -package Terminal_Interface.Curses.Forms is - pragma Preelaborate (Terminal_Interface.Curses.Forms); - pragma Linker_Options ("-lform"); - pragma Linker_Options ("-lncurses"); +package Terminal_Interface.Curses.Forms is + pragma Preelaborate (Terminal_Interface.Curses.Forms); + pragma Linker_Options ("-lform" & Curses_Constants.DFT_ARG_SUFFIX); Space : Character renames Ada.Characters.Latin_1.Space; - type Field is private; - type Form is private; + type Field is private; + type Form is private; - Null_Field : constant Field; - Null_Form : constant Form; + Null_Field : constant Field; + Null_Form : constant Form; - type Field_Justification is (None, - Left, - Center, - Right); + type Field_Justification is (None, + Left, + Center, + Right); - pragma Warnings (Off); - type Field_Option_Set is + type Field_Option_Set is record - Visible : Boolean; - Active : Boolean; - Public : Boolean; - Edit : Boolean; - Wrap : Boolean; - Blank : Boolean; - Auto_Skip : Boolean; - Null_Ok : Boolean; - Pass_Ok : Boolean; - Static : Boolean; + Visible : Boolean; + Active : Boolean; + Public : Boolean; + Edit : Boolean; + Wrap : Boolean; + Blank : Boolean; + Auto_Skip : Boolean; + Null_Ok : Boolean; + Pass_Ok : Boolean; + Static : Boolean; end record; - pragma Convention (C, Field_Option_Set); + pragma Convention (C_Pass_By_Copy, Field_Option_Set); - for Field_Option_Set use + for Field_Option_Set use record - Visible at 0 range 0 .. 0; - Active at 0 range 1 .. 1; - Public at 0 range 2 .. 2; - Edit at 0 range 3 .. 3; - Wrap at 0 range 4 .. 4; - Blank at 0 range 5 .. 5; - Auto_Skip at 0 range 6 .. 6; - Null_Ok at 0 range 7 .. 7; - Pass_Ok at 0 range 8 .. 8; - Static at 0 range 9 .. 9; + Visible at 0 range Curses_Constants.O_VISIBLE_First + .. Curses_Constants.O_VISIBLE_Last; + Active at 0 range Curses_Constants.O_ACTIVE_First + .. Curses_Constants.O_ACTIVE_Last; + Public at 0 range Curses_Constants.O_PUBLIC_First + .. Curses_Constants.O_PUBLIC_Last; + Edit at 0 range Curses_Constants.O_EDIT_First + .. Curses_Constants.O_EDIT_Last; + Wrap at 0 range Curses_Constants.O_WRAP_First + .. Curses_Constants.O_WRAP_Last; + Blank at 0 range Curses_Constants.O_BLANK_First + .. Curses_Constants.O_BLANK_Last; + Auto_Skip at 0 range Curses_Constants.O_AUTOSKIP_First + .. Curses_Constants.O_AUTOSKIP_Last; + Null_Ok at 0 range Curses_Constants.O_NULLOK_First + .. Curses_Constants.O_NULLOK_Last; + Pass_Ok at 0 range Curses_Constants.O_PASSOK_First + .. Curses_Constants.O_PASSOK_Last; + Static at 0 range Curses_Constants.O_STATIC_First + .. Curses_Constants.O_STATIC_Last; end record; - pragma Warnings (Off); for Field_Option_Set'Size use 32; - pragma Warnings (On); - -- Please note: this rep. clause is generated and may be - -- different on your system.Dnl - + pragma Warnings (Off); + for Field_Option_Set'Size use Curses_Constants.Field_Options_Size; pragma Warnings (On); - function Default_Field_Options return Field_Option_Set; + function Default_Field_Options return Field_Option_Set; -- The initial defaults for the field options. - pragma Inline (Default_Field_Options); + pragma Inline (Default_Field_Options); - pragma Warnings (Off); type Form_Option_Set is record NL_Overload : Boolean; BS_Overload : Boolean; end record; - pragma Convention (C, Form_Option_Set); + pragma Convention (C_Pass_By_Copy, Form_Option_Set); for Form_Option_Set use record - NL_Overload at 0 range 0 .. 0; - BS_Overload at 0 range 1 .. 1; + NL_Overload at 0 range Curses_Constants.O_NL_OVERLOAD_First + .. Curses_Constants.O_NL_OVERLOAD_Last; + BS_Overload at 0 range Curses_Constants.O_BS_OVERLOAD_First + .. Curses_Constants.O_BS_OVERLOAD_Last; end record; - pragma Warnings (Off); for Form_Option_Set'Size use 32; - pragma Warnings (On); - -- Please note: this rep. clause is generated and may be - -- different on your system.Dnl - + pragma Warnings (Off); + for Form_Option_Set'Size use Curses_Constants.Field_Options_Size; pragma Warnings (On); - function Default_Form_Options return Form_Option_Set; + function Default_Form_Options return Form_Option_Set; -- The initial defaults for the form options. - pragma Inline (Default_Form_Options); + pragma Inline (Default_Form_Options); - type Buffer_Number is new Natural; + type Buffer_Number is new Natural; - type Field_Array is array (Positive range <>) of aliased Field; + type Field_Array is array (Positive range <>) of aliased Field; pragma Convention (C, Field_Array); - type Field_Array_Access is access Field_Array; + type Field_Array_Access is access Field_Array; - procedure Free (FA : in out Field_Array_Access; - Free_Fields : Boolean := False); + procedure Free (FA : in out Field_Array_Access; + Free_Fields : Boolean := False); -- Release the memory for an allocated field array -- If Free_Fields is True, call Delete() for all the fields in -- the array. - subtype Form_Request_Code is Key_Code range (Key_Max + 1) .. (Key_Max + 57); + subtype Form_Request_Code is Key_Code range (Key_Max + 1) .. (Key_Max + 57); -- The prefix F_ stands for "Form Request" - F_Next_Page : constant Form_Request_Code := Key_Max + 1; - F_Previous_Page : constant Form_Request_Code := Key_Max + 2; - F_First_Page : constant Form_Request_Code := Key_Max + 3; - F_Last_Page : constant Form_Request_Code := Key_Max + 4; - - F_Next_Field : constant Form_Request_Code := Key_Max + 5; - F_Previous_Field : constant Form_Request_Code := Key_Max + 6; - F_First_Field : constant Form_Request_Code := Key_Max + 7; - F_Last_Field : constant Form_Request_Code := Key_Max + 8; - F_Sorted_Next_Field : constant Form_Request_Code := Key_Max + 9; - F_Sorted_Previous_Field : constant Form_Request_Code := Key_Max + 10; - F_Sorted_First_Field : constant Form_Request_Code := Key_Max + 11; - F_Sorted_Last_Field : constant Form_Request_Code := Key_Max + 12; - F_Left_Field : constant Form_Request_Code := Key_Max + 13; - F_Right_Field : constant Form_Request_Code := Key_Max + 14; - F_Up_Field : constant Form_Request_Code := Key_Max + 15; - F_Down_Field : constant Form_Request_Code := Key_Max + 16; - - F_Next_Char : constant Form_Request_Code := Key_Max + 17; - F_Previous_Char : constant Form_Request_Code := Key_Max + 18; - F_Next_Line : constant Form_Request_Code := Key_Max + 19; - F_Previous_Line : constant Form_Request_Code := Key_Max + 20; - F_Next_Word : constant Form_Request_Code := Key_Max + 21; - F_Previous_Word : constant Form_Request_Code := Key_Max + 22; - F_Begin_Field : constant Form_Request_Code := Key_Max + 23; - F_End_Field : constant Form_Request_Code := Key_Max + 24; - F_Begin_Line : constant Form_Request_Code := Key_Max + 25; - F_End_Line : constant Form_Request_Code := Key_Max + 26; - F_Left_Char : constant Form_Request_Code := Key_Max + 27; - F_Right_Char : constant Form_Request_Code := Key_Max + 28; - F_Up_Char : constant Form_Request_Code := Key_Max + 29; - F_Down_Char : constant Form_Request_Code := Key_Max + 30; - - F_New_Line : constant Form_Request_Code := Key_Max + 31; - F_Insert_Char : constant Form_Request_Code := Key_Max + 32; - F_Insert_Line : constant Form_Request_Code := Key_Max + 33; - F_Delete_Char : constant Form_Request_Code := Key_Max + 34; - F_Delete_Previous : constant Form_Request_Code := Key_Max + 35; - F_Delete_Line : constant Form_Request_Code := Key_Max + 36; - F_Delete_Word : constant Form_Request_Code := Key_Max + 37; - F_Clear_EOL : constant Form_Request_Code := Key_Max + 38; - F_Clear_EOF : constant Form_Request_Code := Key_Max + 39; - F_Clear_Field : constant Form_Request_Code := Key_Max + 40; - F_Overlay_Mode : constant Form_Request_Code := Key_Max + 41; - F_Insert_Mode : constant Form_Request_Code := Key_Max + 42; + F_Next_Page : constant Form_Request_Code := Key_Max + 1; + F_Previous_Page : constant Form_Request_Code := Key_Max + 2; + F_First_Page : constant Form_Request_Code := Key_Max + 3; + F_Last_Page : constant Form_Request_Code := Key_Max + 4; + + F_Next_Field : constant Form_Request_Code := Key_Max + 5; + F_Previous_Field : constant Form_Request_Code := Key_Max + 6; + F_First_Field : constant Form_Request_Code := Key_Max + 7; + F_Last_Field : constant Form_Request_Code := Key_Max + 8; + F_Sorted_Next_Field : constant Form_Request_Code := Key_Max + 9; + F_Sorted_Previous_Field : constant Form_Request_Code := Key_Max + 10; + F_Sorted_First_Field : constant Form_Request_Code := Key_Max + 11; + F_Sorted_Last_Field : constant Form_Request_Code := Key_Max + 12; + F_Left_Field : constant Form_Request_Code := Key_Max + 13; + F_Right_Field : constant Form_Request_Code := Key_Max + 14; + F_Up_Field : constant Form_Request_Code := Key_Max + 15; + F_Down_Field : constant Form_Request_Code := Key_Max + 16; + + F_Next_Char : constant Form_Request_Code := Key_Max + 17; + F_Previous_Char : constant Form_Request_Code := Key_Max + 18; + F_Next_Line : constant Form_Request_Code := Key_Max + 19; + F_Previous_Line : constant Form_Request_Code := Key_Max + 20; + F_Next_Word : constant Form_Request_Code := Key_Max + 21; + F_Previous_Word : constant Form_Request_Code := Key_Max + 22; + F_Begin_Field : constant Form_Request_Code := Key_Max + 23; + F_End_Field : constant Form_Request_Code := Key_Max + 24; + F_Begin_Line : constant Form_Request_Code := Key_Max + 25; + F_End_Line : constant Form_Request_Code := Key_Max + 26; + F_Left_Char : constant Form_Request_Code := Key_Max + 27; + F_Right_Char : constant Form_Request_Code := Key_Max + 28; + F_Up_Char : constant Form_Request_Code := Key_Max + 29; + F_Down_Char : constant Form_Request_Code := Key_Max + 30; + + F_New_Line : constant Form_Request_Code := Key_Max + 31; + F_Insert_Char : constant Form_Request_Code := Key_Max + 32; + F_Insert_Line : constant Form_Request_Code := Key_Max + 33; + F_Delete_Char : constant Form_Request_Code := Key_Max + 34; + F_Delete_Previous : constant Form_Request_Code := Key_Max + 35; + F_Delete_Line : constant Form_Request_Code := Key_Max + 36; + F_Delete_Word : constant Form_Request_Code := Key_Max + 37; + F_Clear_EOL : constant Form_Request_Code := Key_Max + 38; + F_Clear_EOF : constant Form_Request_Code := Key_Max + 39; + F_Clear_Field : constant Form_Request_Code := Key_Max + 40; + F_Overlay_Mode : constant Form_Request_Code := Key_Max + 41; + F_Insert_Mode : constant Form_Request_Code := Key_Max + 42; -- Vertical Scrolling - F_ScrollForward_Line : constant Form_Request_Code := Key_Max + 43; - F_ScrollBackward_Line : constant Form_Request_Code := Key_Max + 44; - F_ScrollForward_Page : constant Form_Request_Code := Key_Max + 45; - F_ScrollBackward_Page : constant Form_Request_Code := Key_Max + 46; - F_ScrollForward_HalfPage : constant Form_Request_Code := Key_Max + 47; - F_ScrollBackward_HalfPage : constant Form_Request_Code := Key_Max + 48; + F_ScrollForward_Line : constant Form_Request_Code := Key_Max + 43; + F_ScrollBackward_Line : constant Form_Request_Code := Key_Max + 44; + F_ScrollForward_Page : constant Form_Request_Code := Key_Max + 45; + F_ScrollBackward_Page : constant Form_Request_Code := Key_Max + 46; + F_ScrollForward_HalfPage : constant Form_Request_Code := Key_Max + 47; + F_ScrollBackward_HalfPage : constant Form_Request_Code := Key_Max + 48; -- Horizontal Scrolling - F_HScrollForward_Char : constant Form_Request_Code := Key_Max + 49; - F_HScrollBackward_Char : constant Form_Request_Code := Key_Max + 50; - F_HScrollForward_Line : constant Form_Request_Code := Key_Max + 51; - F_HScrollBackward_Line : constant Form_Request_Code := Key_Max + 52; - F_HScrollForward_HalfLine : constant Form_Request_Code := Key_Max + 53; - F_HScrollBackward_HalfLine : constant Form_Request_Code := Key_Max + 54; + F_HScrollForward_Char : constant Form_Request_Code := Key_Max + 49; + F_HScrollBackward_Char : constant Form_Request_Code := Key_Max + 50; + F_HScrollForward_Line : constant Form_Request_Code := Key_Max + 51; + F_HScrollBackward_Line : constant Form_Request_Code := Key_Max + 52; + F_HScrollForward_HalfLine : constant Form_Request_Code := Key_Max + 53; + F_HScrollBackward_HalfLine : constant Form_Request_Code := Key_Max + 54; - F_Validate_Field : constant Form_Request_Code := Key_Max + 55; - F_Next_Choice : constant Form_Request_Code := Key_Max + 56; - F_Previous_Choice : constant Form_Request_Code := Key_Max + 57; + F_Validate_Field : constant Form_Request_Code := Key_Max + 55; + F_Next_Choice : constant Form_Request_Code := Key_Max + 56; + F_Previous_Choice : constant Form_Request_Code := Key_Max + 57; -- For those who like the old 'C' style request names - REQ_NEXT_PAGE : Form_Request_Code renames F_Next_Page; - REQ_PREV_PAGE : Form_Request_Code renames F_Previous_Page; - REQ_FIRST_PAGE : Form_Request_Code renames F_First_Page; - REQ_LAST_PAGE : Form_Request_Code renames F_Last_Page; - - REQ_NEXT_FIELD : Form_Request_Code renames F_Next_Field; - REQ_PREV_FIELD : Form_Request_Code renames F_Previous_Field; - REQ_FIRST_FIELD : Form_Request_Code renames F_First_Field; - REQ_LAST_FIELD : Form_Request_Code renames F_Last_Field; - REQ_SNEXT_FIELD : Form_Request_Code renames F_Sorted_Next_Field; - REQ_SPREV_FIELD : Form_Request_Code renames F_Sorted_Previous_Field; - REQ_SFIRST_FIELD : Form_Request_Code renames F_Sorted_First_Field; - REQ_SLAST_FIELD : Form_Request_Code renames F_Sorted_Last_Field; - REQ_LEFT_FIELD : Form_Request_Code renames F_Left_Field; - REQ_RIGHT_FIELD : Form_Request_Code renames F_Right_Field; - REQ_UP_FIELD : Form_Request_Code renames F_Up_Field; - REQ_DOWN_FIELD : Form_Request_Code renames F_Down_Field; - - REQ_NEXT_CHAR : Form_Request_Code renames F_Next_Char; - REQ_PREV_CHAR : Form_Request_Code renames F_Previous_Char; - REQ_NEXT_LINE : Form_Request_Code renames F_Next_Line; - REQ_PREV_LINE : Form_Request_Code renames F_Previous_Line; - REQ_NEXT_WORD : Form_Request_Code renames F_Next_Word; - REQ_PREV_WORD : Form_Request_Code renames F_Previous_Word; - REQ_BEG_FIELD : Form_Request_Code renames F_Begin_Field; - REQ_END_FIELD : Form_Request_Code renames F_End_Field; - REQ_BEG_LINE : Form_Request_Code renames F_Begin_Line; - REQ_END_LINE : Form_Request_Code renames F_End_Line; - REQ_LEFT_CHAR : Form_Request_Code renames F_Left_Char; - REQ_RIGHT_CHAR : Form_Request_Code renames F_Right_Char; - REQ_UP_CHAR : Form_Request_Code renames F_Up_Char; - REQ_DOWN_CHAR : Form_Request_Code renames F_Down_Char; - - REQ_NEW_LINE : Form_Request_Code renames F_New_Line; - REQ_INS_CHAR : Form_Request_Code renames F_Insert_Char; - REQ_INS_LINE : Form_Request_Code renames F_Insert_Line; - REQ_DEL_CHAR : Form_Request_Code renames F_Delete_Char; - REQ_DEL_PREV : Form_Request_Code renames F_Delete_Previous; - REQ_DEL_LINE : Form_Request_Code renames F_Delete_Line; - REQ_DEL_WORD : Form_Request_Code renames F_Delete_Word; - REQ_CLR_EOL : Form_Request_Code renames F_Clear_EOL; - REQ_CLR_EOF : Form_Request_Code renames F_Clear_EOF; - REQ_CLR_FIELD : Form_Request_Code renames F_Clear_Field; - REQ_OVL_MODE : Form_Request_Code renames F_Overlay_Mode; - REQ_INS_MODE : Form_Request_Code renames F_Insert_Mode; - - REQ_SCR_FLINE : Form_Request_Code renames F_ScrollForward_Line; - REQ_SCR_BLINE : Form_Request_Code renames F_ScrollBackward_Line; - REQ_SCR_FPAGE : Form_Request_Code renames F_ScrollForward_Page; - REQ_SCR_BPAGE : Form_Request_Code renames F_ScrollBackward_Page; - REQ_SCR_FHPAGE : Form_Request_Code renames F_ScrollForward_HalfPage; - REQ_SCR_BHPAGE : Form_Request_Code renames F_ScrollBackward_HalfPage; - - REQ_SCR_FCHAR : Form_Request_Code renames F_HScrollForward_Char; - REQ_SCR_BCHAR : Form_Request_Code renames F_HScrollBackward_Char; - REQ_SCR_HFLINE : Form_Request_Code renames F_HScrollForward_Line; - REQ_SCR_HBLINE : Form_Request_Code renames F_HScrollBackward_Line; - REQ_SCR_HFHALF : Form_Request_Code renames F_HScrollForward_HalfLine; - REQ_SCR_HBHALF : Form_Request_Code renames F_HScrollBackward_HalfLine; - - REQ_VALIDATION : Form_Request_Code renames F_Validate_Field; - REQ_NEXT_CHOICE : Form_Request_Code renames F_Next_Choice; - REQ_PREV_CHOICE : Form_Request_Code renames F_Previous_Choice; - - procedure Request_Name (Key : Form_Request_Code; - Name : out String); - - function Request_Name (Key : Form_Request_Code) return String; + REQ_NEXT_PAGE : Form_Request_Code renames F_Next_Page; + REQ_PREV_PAGE : Form_Request_Code renames F_Previous_Page; + REQ_FIRST_PAGE : Form_Request_Code renames F_First_Page; + REQ_LAST_PAGE : Form_Request_Code renames F_Last_Page; + + REQ_NEXT_FIELD : Form_Request_Code renames F_Next_Field; + REQ_PREV_FIELD : Form_Request_Code renames F_Previous_Field; + REQ_FIRST_FIELD : Form_Request_Code renames F_First_Field; + REQ_LAST_FIELD : Form_Request_Code renames F_Last_Field; + REQ_SNEXT_FIELD : Form_Request_Code renames F_Sorted_Next_Field; + REQ_SPREV_FIELD : Form_Request_Code renames F_Sorted_Previous_Field; + REQ_SFIRST_FIELD : Form_Request_Code renames F_Sorted_First_Field; + REQ_SLAST_FIELD : Form_Request_Code renames F_Sorted_Last_Field; + REQ_LEFT_FIELD : Form_Request_Code renames F_Left_Field; + REQ_RIGHT_FIELD : Form_Request_Code renames F_Right_Field; + REQ_UP_FIELD : Form_Request_Code renames F_Up_Field; + REQ_DOWN_FIELD : Form_Request_Code renames F_Down_Field; + + REQ_NEXT_CHAR : Form_Request_Code renames F_Next_Char; + REQ_PREV_CHAR : Form_Request_Code renames F_Previous_Char; + REQ_NEXT_LINE : Form_Request_Code renames F_Next_Line; + REQ_PREV_LINE : Form_Request_Code renames F_Previous_Line; + REQ_NEXT_WORD : Form_Request_Code renames F_Next_Word; + REQ_PREV_WORD : Form_Request_Code renames F_Previous_Word; + REQ_BEG_FIELD : Form_Request_Code renames F_Begin_Field; + REQ_END_FIELD : Form_Request_Code renames F_End_Field; + REQ_BEG_LINE : Form_Request_Code renames F_Begin_Line; + REQ_END_LINE : Form_Request_Code renames F_End_Line; + REQ_LEFT_CHAR : Form_Request_Code renames F_Left_Char; + REQ_RIGHT_CHAR : Form_Request_Code renames F_Right_Char; + REQ_UP_CHAR : Form_Request_Code renames F_Up_Char; + REQ_DOWN_CHAR : Form_Request_Code renames F_Down_Char; + + REQ_NEW_LINE : Form_Request_Code renames F_New_Line; + REQ_INS_CHAR : Form_Request_Code renames F_Insert_Char; + REQ_INS_LINE : Form_Request_Code renames F_Insert_Line; + REQ_DEL_CHAR : Form_Request_Code renames F_Delete_Char; + REQ_DEL_PREV : Form_Request_Code renames F_Delete_Previous; + REQ_DEL_LINE : Form_Request_Code renames F_Delete_Line; + REQ_DEL_WORD : Form_Request_Code renames F_Delete_Word; + REQ_CLR_EOL : Form_Request_Code renames F_Clear_EOL; + REQ_CLR_EOF : Form_Request_Code renames F_Clear_EOF; + REQ_CLR_FIELD : Form_Request_Code renames F_Clear_Field; + REQ_OVL_MODE : Form_Request_Code renames F_Overlay_Mode; + REQ_INS_MODE : Form_Request_Code renames F_Insert_Mode; + + REQ_SCR_FLINE : Form_Request_Code renames F_ScrollForward_Line; + REQ_SCR_BLINE : Form_Request_Code renames F_ScrollBackward_Line; + REQ_SCR_FPAGE : Form_Request_Code renames F_ScrollForward_Page; + REQ_SCR_BPAGE : Form_Request_Code renames F_ScrollBackward_Page; + REQ_SCR_FHPAGE : Form_Request_Code renames F_ScrollForward_HalfPage; + REQ_SCR_BHPAGE : Form_Request_Code renames F_ScrollBackward_HalfPage; + + REQ_SCR_FCHAR : Form_Request_Code renames F_HScrollForward_Char; + REQ_SCR_BCHAR : Form_Request_Code renames F_HScrollBackward_Char; + REQ_SCR_HFLINE : Form_Request_Code renames F_HScrollForward_Line; + REQ_SCR_HBLINE : Form_Request_Code renames F_HScrollBackward_Line; + REQ_SCR_HFHALF : Form_Request_Code renames F_HScrollForward_HalfLine; + REQ_SCR_HBHALF : Form_Request_Code renames F_HScrollBackward_HalfLine; + + REQ_VALIDATION : Form_Request_Code renames F_Validate_Field; + REQ_NEXT_CHOICE : Form_Request_Code renames F_Next_Choice; + REQ_PREV_CHOICE : Form_Request_Code renames F_Previous_Choice; + + procedure Request_Name (Key : Form_Request_Code; + Name : out String); + + function Request_Name (Key : Form_Request_Code) return String; -- Same as function pragma Inline (Request_Name); ------------------ -- Exceptions -- ------------------ - Form_Exception : exception; + Form_Exception : exception; -- |===================================================================== -- | Man page form_field_new.3x -- |===================================================================== -- #1A NAME="AFU_1"#2| - function Create (Height : Line_Count; - Width : Column_Count; - Top : Line_Position; - Left : Column_Position; - Off_Screen : Natural := 0; - More_Buffers : Buffer_Number := Buffer_Number'First) - return Field; + function Create (Height : Line_Count; + Width : Column_Count; + Top : Line_Position; + Left : Column_Position; + Off_Screen : Natural := 0; + More_Buffers : Buffer_Number := Buffer_Number'First) + return Field; -- AKA: new_field() -- An overloaded Create is defined later. Pragma Inline appears there. -- #1A NAME="AFU_2"#2| - function New_Field (Height : Line_Count; - Width : Column_Count; - Top : Line_Position; - Left : Column_Position; - Off_Screen : Natural := 0; - More_Buffers : Buffer_Number := Buffer_Number'First) - return Field renames Create; + function New_Field (Height : Line_Count; + Width : Column_Count; + Top : Line_Position; + Left : Column_Position; + Off_Screen : Natural := 0; + More_Buffers : Buffer_Number := Buffer_Number'First) + return Field renames Create; -- AKA: new_field() pragma Inline (New_Field); -- #1A NAME="AFU_3"#2| - procedure Delete (Fld : in out Field); + procedure Delete (Fld : in out Field); -- AKA: free_field() -- Reset Fld to Null_Field -- An overloaded Delete is defined later. Pragma Inline appears there. -- #1A NAME="AFU_4"#2| - function Duplicate (Fld : Field; - Top : Line_Position; - Left : Column_Position) return Field; + function Duplicate (Fld : Field; + Top : Line_Position; + Left : Column_Position) return Field; -- AKA: dup_field() pragma Inline (Duplicate); -- #1A NAME="AFU_5"#2| - function Link (Fld : Field; - Top : Line_Position; - Left : Column_Position) return Field; + function Link (Fld : Field; + Top : Line_Position; + Left : Column_Position) return Field; -- AKA: link_field() - pragma Inline (Link); + pragma Inline (Link); -- |===================================================================== -- | Man page form_field_just.3x -- |===================================================================== -- #1A NAME="AFU_6"#2| - procedure Set_Justification (Fld : Field; - Just : Field_Justification := None); + procedure Set_Justification (Fld : Field; + Just : Field_Justification := None); -- AKA: set_field_just() - pragma Inline (Set_Justification); + pragma Inline (Set_Justification); -- #1A NAME="AFU_7"#2| - function Get_Justification (Fld : Field) return Field_Justification; + function Get_Justification (Fld : Field) return Field_Justification; -- AKA: field_just() - pragma Inline (Get_Justification); + pragma Inline (Get_Justification); -- |===================================================================== -- | Man page form_field_buffer.3x -- |===================================================================== -- #1A NAME="AFU_8"#2| - procedure Set_Buffer - (Fld : Field; - Buffer : Buffer_Number := Buffer_Number'First; - Str : String); + procedure Set_Buffer + (Fld : Field; + Buffer : Buffer_Number := Buffer_Number'First; + Str : String); -- AKA: set_field_buffer() -- Not inlined -- #1A NAME="AFU_9"#2| - procedure Get_Buffer - (Fld : Field; - Buffer : Buffer_Number := Buffer_Number'First; - Str : out String); + procedure Get_Buffer + (Fld : Field; + Buffer : Buffer_Number := Buffer_Number'First; + Str : out String); -- AKA: field_buffer() - function Get_Buffer - (Fld : Field; - Buffer : Buffer_Number := Buffer_Number'First) return String; + function Get_Buffer + (Fld : Field; + Buffer : Buffer_Number := Buffer_Number'First) return String; -- AKA: field_buffer() -- Same but as function pragma Inline (Get_Buffer); -- #1A NAME="AFU_10"#2| - procedure Set_Status (Fld : Field; - Status : Boolean := True); + procedure Set_Status (Fld : Field; + Status : Boolean := True); -- AKA: set_field_status() - pragma Inline (Set_Status); + pragma Inline (Set_Status); -- #1A NAME="AFU_11"#2| - function Changed (Fld : Field) return Boolean; + function Changed (Fld : Field) return Boolean; -- AKA: field_status() - pragma Inline (Changed); + pragma Inline (Changed); -- #1A NAME="AFU_12"#2| - procedure Set_Maximum_Size (Fld : Field; - Max : Natural := 0); + procedure Set_Maximum_Size (Fld : Field; + Max : Natural := 0); -- AKA: set_field_max() - pragma Inline (Set_Maximum_Size); + pragma Inline (Set_Maximum_Size); -- |===================================================================== -- | Man page form_field_opts.3x -- |===================================================================== -- #1A NAME="AFU_13"#2| - procedure Set_Options (Fld : Field; - Options : Field_Option_Set); + procedure Set_Options (Fld : Field; + Options : Field_Option_Set); -- AKA: set_field_opts() -- An overloaded version is defined later. Pragma Inline appears there -- #1A NAME="AFU_14"#2| - procedure Switch_Options (Fld : Field; - Options : Field_Option_Set; - On : Boolean := True); + procedure Switch_Options (Fld : Field; + Options : Field_Option_Set; + On : Boolean := True); -- AKA: field_opts_on() -- AKA: field_opts_off() -- An overloaded version is defined later. Pragma Inline appears there -- #1A NAME="AFU_15"#2| - procedure Get_Options (Fld : Field; - Options : out Field_Option_Set); + procedure Get_Options (Fld : Field; + Options : out Field_Option_Set); -- AKA: field_opts() -- #1A NAME="AFU_16"#2| - function Get_Options (Fld : Field := Null_Field) - return Field_Option_Set; + function Get_Options (Fld : Field := Null_Field) + return Field_Option_Set; -- AKA: field_opts() -- An overloaded version is defined later. Pragma Inline appears there @@ -442,161 +441,161 @@ -- |===================================================================== -- #1A NAME="AFU_17"#2| - procedure Set_Foreground - (Fld : Field; - Fore : Character_Attribute_Set := Normal_Video; - Color : Color_Pair := Color_Pair'First); + procedure Set_Foreground + (Fld : Field; + Fore : Character_Attribute_Set := Normal_Video; + Color : Color_Pair := Color_Pair'First); -- AKA: set_field_fore() - pragma Inline (Set_Foreground); + pragma Inline (Set_Foreground); -- #1A NAME="AFU_18"#2| - procedure Foreground (Fld : Field; - Fore : out Character_Attribute_Set); + procedure Foreground (Fld : Field; + Fore : out Character_Attribute_Set); -- AKA: field_fore() -- #1A NAME="AFU_19"#2| - procedure Foreground (Fld : Field; - Fore : out Character_Attribute_Set; - Color : out Color_Pair); + procedure Foreground (Fld : Field; + Fore : out Character_Attribute_Set; + Color : out Color_Pair); -- AKA: field_fore() pragma Inline (Foreground); -- #1A NAME="AFU_20"#2| - procedure Set_Background - (Fld : Field; - Back : Character_Attribute_Set := Normal_Video; - Color : Color_Pair := Color_Pair'First); + procedure Set_Background + (Fld : Field; + Back : Character_Attribute_Set := Normal_Video; + Color : Color_Pair := Color_Pair'First); -- AKA: set_field_back() pragma Inline (Set_Background); -- #1A NAME="AFU_21"#2| - procedure Background (Fld : Field; - Back : out Character_Attribute_Set); + procedure Background (Fld : Field; + Back : out Character_Attribute_Set); -- AKA: field_back() -- #1A NAME="AFU_22"#2| - procedure Background (Fld : Field; - Back : out Character_Attribute_Set; - Color : out Color_Pair); + procedure Background (Fld : Field; + Back : out Character_Attribute_Set; + Color : out Color_Pair); -- AKA: field_back() pragma Inline (Background); -- #1A NAME="AFU_23"#2| - procedure Set_Pad_Character (Fld : Field; - Pad : Character := Space); + procedure Set_Pad_Character (Fld : Field; + Pad : Character := Space); -- AKA: set_field_pad() - pragma Inline (Set_Pad_Character); + pragma Inline (Set_Pad_Character); -- #1A NAME="AFU_24"#2| - procedure Pad_Character (Fld : Field; - Pad : out Character); + procedure Pad_Character (Fld : Field; + Pad : out Character); -- AKA: field_pad() - pragma Inline (Pad_Character); + pragma Inline (Pad_Character); -- |===================================================================== -- | Man page form_field_info.3x -- |===================================================================== -- #1A NAME="AFU_25"#2| - procedure Info (Fld : Field; - Lines : out Line_Count; - Columns : out Column_Count; - First_Row : out Line_Position; - First_Column : out Column_Position; - Off_Screen : out Natural; - Additional_Buffers : out Buffer_Number); + procedure Info (Fld : Field; + Lines : out Line_Count; + Columns : out Column_Count; + First_Row : out Line_Position; + First_Column : out Column_Position; + Off_Screen : out Natural; + Additional_Buffers : out Buffer_Number); -- AKA: field_info() - pragma Inline (Info); + pragma Inline (Info); -- #1A NAME="AFU_26"#2| - procedure Dynamic_Info (Fld : Field; - Lines : out Line_Count; - Columns : out Column_Count; - Max : out Natural); + procedure Dynamic_Info (Fld : Field; + Lines : out Line_Count; + Columns : out Column_Count; + Max : out Natural); -- AKA: dynamic_field_info() - pragma Inline (Dynamic_Info); + pragma Inline (Dynamic_Info); -- |===================================================================== -- | Man page form_win.3x -- |===================================================================== -- #1A NAME="AFU_27"#2| - procedure Set_Window (Frm : Form; - Win : Window); + procedure Set_Window (Frm : Form; + Win : Window); -- AKA: set_form_win() - pragma Inline (Set_Window); + pragma Inline (Set_Window); -- #1A NAME="AFU_28"#2| - function Get_Window (Frm : Form) return Window; + function Get_Window (Frm : Form) return Window; -- AKA: form_win() - pragma Inline (Get_Window); + pragma Inline (Get_Window); -- #1A NAME="AFU_29"#2| - procedure Set_Sub_Window (Frm : Form; - Win : Window); + procedure Set_Sub_Window (Frm : Form; + Win : Window); -- AKA: set_form_sub() - pragma Inline (Set_Sub_Window); + pragma Inline (Set_Sub_Window); -- #1A NAME="AFU_30"#2| - function Get_Sub_Window (Frm : Form) return Window; + function Get_Sub_Window (Frm : Form) return Window; -- AKA: form_sub() - pragma Inline (Get_Sub_Window); + pragma Inline (Get_Sub_Window); -- #1A NAME="AFU_31"#2| - procedure Scale (Frm : Form; - Lines : out Line_Count; - Columns : out Column_Count); + procedure Scale (Frm : Form; + Lines : out Line_Count; + Columns : out Column_Count); -- AKA: scale_form() - pragma Inline (Scale); + pragma Inline (Scale); -- |===================================================================== -- | Man page form_hook.3x -- |===================================================================== - type Form_Hook_Function is access procedure (Frm : Form); - pragma Convention (C, Form_Hook_Function); + type Form_Hook_Function is access procedure (Frm : Form); + pragma Convention (C, Form_Hook_Function); -- #1A NAME="AFU_32"#2| - procedure Set_Field_Init_Hook (Frm : Form; - Proc : Form_Hook_Function); + procedure Set_Field_Init_Hook (Frm : Form; + Proc : Form_Hook_Function); -- AKA: set_field_init() - pragma Inline (Set_Field_Init_Hook); + pragma Inline (Set_Field_Init_Hook); -- #1A NAME="AFU_33"#2| - procedure Set_Field_Term_Hook (Frm : Form; - Proc : Form_Hook_Function); + procedure Set_Field_Term_Hook (Frm : Form; + Proc : Form_Hook_Function); -- AKA: set_field_term() - pragma Inline (Set_Field_Term_Hook); + pragma Inline (Set_Field_Term_Hook); -- #1A NAME="AFU_34"#2| - procedure Set_Form_Init_Hook (Frm : Form; - Proc : Form_Hook_Function); + procedure Set_Form_Init_Hook (Frm : Form; + Proc : Form_Hook_Function); -- AKA: set_form_init() - pragma Inline (Set_Form_Init_Hook); + pragma Inline (Set_Form_Init_Hook); -- #1A NAME="AFU_35"#2| - procedure Set_Form_Term_Hook (Frm : Form; - Proc : Form_Hook_Function); + procedure Set_Form_Term_Hook (Frm : Form; + Proc : Form_Hook_Function); -- AKA: set_form_term() - pragma Inline (Set_Form_Term_Hook); + pragma Inline (Set_Form_Term_Hook); -- #1A NAME="AFU_36"#2| - function Get_Field_Init_Hook (Frm : Form) return Form_Hook_Function; + function Get_Field_Init_Hook (Frm : Form) return Form_Hook_Function; -- AKA: field_init() pragma Import (C, Get_Field_Init_Hook, "field_init"); -- #1A NAME="AFU_37"#2| - function Get_Field_Term_Hook (Frm : Form) return Form_Hook_Function; + function Get_Field_Term_Hook (Frm : Form) return Form_Hook_Function; -- AKA: field_term() pragma Import (C, Get_Field_Term_Hook, "field_term"); -- #1A NAME="AFU_38"#2| - function Get_Form_Init_Hook (Frm : Form) return Form_Hook_Function; + function Get_Form_Init_Hook (Frm : Form) return Form_Hook_Function; -- AKA: form_init() pragma Import (C, Get_Form_Init_Hook, "form_init"); -- #1A NAME="AFU_39"#2| - function Get_Form_Term_Hook (Frm : Form) return Form_Hook_Function; + function Get_Form_Term_Hook (Frm : Form) return Form_Hook_Function; -- AKA: form_term() pragma Import (C, Get_Form_Term_Hook, "form_term"); @@ -605,52 +604,52 @@ -- |===================================================================== -- #1A NAME="AFU_40"#2| - procedure Redefine (Frm : Form; - Flds : Field_Array_Access); + procedure Redefine (Frm : Form; + Flds : Field_Array_Access); -- AKA: set_form_fields() - pragma Inline (Redefine); + pragma Inline (Redefine); -- #1A NAME="AFU_41"#2| - procedure Set_Fields (Frm : Form; - Flds : Field_Array_Access) renames Redefine; + procedure Set_Fields (Frm : Form; + Flds : Field_Array_Access) renames Redefine; -- AKA: set_form_fields() -- pragma Inline (Set_Fields); -- #1A NAME="AFU_42"#2| - function Fields (Frm : Form; - Index : Positive) return Field; + function Fields (Frm : Form; + Index : Positive) return Field; -- AKA: form_fields() - pragma Inline (Fields); + pragma Inline (Fields); -- #1A NAME="AFU_43"#2| - function Field_Count (Frm : Form) return Natural; + function Field_Count (Frm : Form) return Natural; -- AKA: field_count() - pragma Inline (Field_Count); + pragma Inline (Field_Count); -- #1A NAME="AFU_44"#2| - procedure Move (Fld : Field; - Line : Line_Position; - Column : Column_Position); + procedure Move (Fld : Field; + Line : Line_Position; + Column : Column_Position); -- AKA: move_field() - pragma Inline (Move); + pragma Inline (Move); -- |===================================================================== -- | Man page form_new.3x -- |===================================================================== -- #1A NAME="AFU_45"#2| - function Create (Fields : Field_Array_Access) return Form; + function Create (Fields : Field_Array_Access) return Form; -- AKA: new_form() pragma Inline (Create); -- #1A NAME="AFU_46"#2| - function New_Form (Fields : Field_Array_Access) return Form - renames Create; + function New_Form (Fields : Field_Array_Access) return Form + renames Create; -- AKA: new_form() -- pragma Inline (New_Form); -- #1A NAME="AFU_47"#2| - procedure Delete (Frm : in out Form); + procedure Delete (Frm : in out Form); -- AKA: free_form() -- Reset Frm to Null_Form pragma Inline (Delete); @@ -660,26 +659,26 @@ -- |===================================================================== -- #1A NAME="AFU_48"#2| - procedure Set_Options (Frm : Form; - Options : Form_Option_Set); + procedure Set_Options (Frm : Form; + Options : Form_Option_Set); -- AKA: set_form_opts() pragma Inline (Set_Options); -- #1A NAME="AFU_49"#2| - procedure Switch_Options (Frm : Form; - Options : Form_Option_Set; - On : Boolean := True); + procedure Switch_Options (Frm : Form; + Options : Form_Option_Set; + On : Boolean := True); -- AKA: form_opts_on() -- AKA: form_opts_off() pragma Inline (Switch_Options); -- #1A NAME="AFU_50"#2| - procedure Get_Options (Frm : Form; - Options : out Form_Option_Set); + procedure Get_Options (Frm : Form; + Options : out Form_Option_Set); -- AKA: form_opts() -- #1A NAME="AFU_51"#2| - function Get_Options (Frm : Form := Null_Form) return Form_Option_Set; + function Get_Options (Frm : Form := Null_Form) return Form_Option_Set; -- AKA: form_opts() pragma Inline (Get_Options); @@ -688,47 +687,47 @@ -- |===================================================================== -- #1A NAME="AFU_52"#2| - procedure Post (Frm : Form; - Post : Boolean := True); + procedure Post (Frm : Form; + Post : Boolean := True); -- AKA: post_form() -- AKA: unpost_form() - pragma Inline (Post); + pragma Inline (Post); -- |===================================================================== -- | Man page form_cursor.3x -- |===================================================================== -- #1A NAME="AFU_53"#2| - procedure Position_Cursor (Frm : Form); + procedure Position_Cursor (Frm : Form); -- AKA: pos_form_cursor() - pragma Inline (Position_Cursor); + pragma Inline (Position_Cursor); -- |===================================================================== -- | Man page form_data.3x -- |===================================================================== -- #1A NAME="AFU_54"#2| - function Data_Ahead (Frm : Form) return Boolean; + function Data_Ahead (Frm : Form) return Boolean; -- AKA: data_ahead() - pragma Inline (Data_Ahead); + pragma Inline (Data_Ahead); -- #1A NAME="AFU_55"#2| - function Data_Behind (Frm : Form) return Boolean; + function Data_Behind (Frm : Form) return Boolean; -- AKA: data_behind() - pragma Inline (Data_Behind); + pragma Inline (Data_Behind); -- |===================================================================== -- | Man page form_driver.3x -- |===================================================================== - type Driver_Result is (Form_Ok, - Request_Denied, - Unknown_Request, - Invalid_Field); + type Driver_Result is (Form_Ok, + Request_Denied, + Unknown_Request, + Invalid_Field); -- #1A NAME="AFU_56"#2| - function Driver (Frm : Form; - Key : Key_Code) return Driver_Result; + function Driver (Frm : Form; + Key : Key_Code) return Driver_Result; -- AKA: form_driver() -- Driver not inlined @@ -736,52 +735,52 @@ -- | Man page form_page.3x -- |===================================================================== - type Page_Number is new Natural; + type Page_Number is new Natural; -- #1A NAME="AFU_57"#2| - procedure Set_Current (Frm : Form; - Fld : Field); + procedure Set_Current (Frm : Form; + Fld : Field); -- AKA: set_current_field() - pragma Inline (Set_Current); + pragma Inline (Set_Current); -- #1A NAME="AFU_58"#2| - function Current (Frm : Form) return Field; + function Current (Frm : Form) return Field; -- AKA: current_field() - pragma Inline (Current); + pragma Inline (Current); -- #1A NAME="AFU_59"#2| - procedure Set_Page (Frm : Form; - Page : Page_Number := Page_Number'First); + procedure Set_Page (Frm : Form; + Page : Page_Number := Page_Number'First); -- AKA: set_form_page() - pragma Inline (Set_Page); + pragma Inline (Set_Page); -- #1A NAME="AFU_60"#2| - function Page (Frm : Form) return Page_Number; + function Page (Frm : Form) return Page_Number; -- AKA: form_page() - pragma Inline (Page); + pragma Inline (Page); -- #1A NAME="AFU_61"#2| - function Get_Index (Fld : Field) return Positive; + function Get_Index (Fld : Field) return Positive; -- AKA: field_index() -- Please note that in this binding we start the numbering of fields -- with 1. So this is number is one more than you get from the low -- level call. - pragma Inline (Get_Index); + pragma Inline (Get_Index); -- |===================================================================== -- | Man page form_new_page.3x -- |===================================================================== -- #1A NAME="AFU_62"#2| - procedure Set_New_Page (Fld : Field; - New_Page : Boolean := True); + procedure Set_New_Page (Fld : Field; + New_Page : Boolean := True); -- AKA: set_new_page() - pragma Inline (Set_New_Page); + pragma Inline (Set_New_Page); -- #1A NAME="AFU_63"#2| - function Is_New_Page (Fld : Field) return Boolean; + function Is_New_Page (Fld : Field) return Boolean; -- AKA: new_page() - pragma Inline (Is_New_Page); + pragma Inline (Is_New_Page); -- |===================================================================== -- | Man page form_requestname.3x @@ -790,11 +789,11 @@ ------------------------------------------------------------------------------ private - type Field is new System.Storage_Elements.Integer_Address; - type Form is new System.Storage_Elements.Integer_Address; + type Field is new System.Storage_Elements.Integer_Address; + type Form is new System.Storage_Elements.Integer_Address; - Null_Field : constant Field := 0; - Null_Form : constant Form := 0; + Null_Field : constant Field := 0; + Null_Form : constant Form := 0; -end Terminal_Interface.Curses.Forms; +end Terminal_Interface.Curses.Forms; diff --git a/doc/html/ada/terminal_interface-curses-menus-item_user_data__adb.htm b/doc/html/ada/terminal_interface-curses-menus-item_user_data__adb.htm index 703e8afe..f980ea53 100644 --- a/doc/html/ada/terminal_interface-curses-menus-item_user_data__adb.htm +++ b/doc/html/ada/terminal_interface-curses-menus-item_user_data__adb.htm @@ -24,7 +24,7 @@ -- B O D Y -- -- -- ------------------------------------------------------------------------------ --- Copyright (c) 1998-2003,2009 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 -- @@ -52,44 +52,41 @@ ------------------------------------------------------------------------------ -- Author: Juergen Pfeifer, 1996 -- Version Control: --- @Revision: 1.12 @ +-- @Revision: 1.14 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ with Interfaces.C; -with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; +with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; -package body Terminal_Interface.Curses.Menus.Item_User_Data is +package body Terminal_Interface.Curses.Menus.Item_User_Data is use type Interfaces.C.int; - procedure Set_User_Data (Itm : Item; + procedure Set_User_Data (Itm : Item; Data : User_Access) is - function Set_Item_Userptr (Itm : Item; - Addr : User_Access) return C_Int; + function Set_Item_Userptr (Itm : Item; + Addr : User_Access) return Eti_Error; pragma Import (C, Set_Item_Userptr, "set_item_userptr"); - Res : constant Eti_Error := Set_Item_Userptr (Itm, Data); begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Item_Userptr (Itm, Data)); end Set_User_Data; - function Get_User_Data (Itm : Item) return User_Access + function Get_User_Data (Itm : Item) return User_Access is - function Item_Userptr (Itm : Item) return User_Access; + function Item_Userptr (Itm : Item) return User_Access; pragma Import (C, Item_Userptr, "item_userptr"); begin - return Item_Userptr (Itm); + return Item_Userptr (Itm); end Get_User_Data; - procedure Get_User_Data (Itm : Item; - Data : out User_Access) + procedure Get_User_Data (Itm : Item; + Data : out User_Access) is begin Data := Get_User_Data (Itm); end Get_User_Data; -end Terminal_Interface.Curses.Menus.Item_User_Data; +end Terminal_Interface.Curses.Menus.Item_User_Data; diff --git a/doc/html/ada/terminal_interface-curses-menus-item_user_data__ads.htm b/doc/html/ada/terminal_interface-curses-menus-item_user_data__ads.htm index b5839631..31f1694c 100644 --- a/doc/html/ada/terminal_interface-curses-menus-item_user_data__ads.htm +++ b/doc/html/ada/terminal_interface-curses-menus-item_user_data__ads.htm @@ -60,8 +60,8 @@ generic type User is limited private; type User_Access is access User; -package Terminal_Interface.Curses.Menus.Item_User_Data is - pragma Preelaborate (Terminal_Interface.Curses.Menus.Item_User_Data); +package Terminal_Interface.Curses.Menus.Item_User_Data is + pragma Preelaborate (Terminal_Interface.Curses.Menus.Item_User_Data); -- The binding uses the same user pointer for menu items -- as the low level C implementation. So you can safely @@ -72,21 +72,21 @@ -- |===================================================================== -- #1A NAME="AFU_1"#2| - procedure Set_User_Data (Itm : Item; + procedure Set_User_Data (Itm : Item; Data : User_Access); -- AKA: set_item_userptr pragma Inline (Set_User_Data); -- #1A NAME="AFU_2"#2| - procedure Get_User_Data (Itm : Item; - Data : out User_Access); + procedure Get_User_Data (Itm : Item; + Data : out User_Access); -- AKA: item_userptr -- #1A NAME="AFU_3"#2| - function Get_User_Data (Itm : Item) return User_Access; + function Get_User_Data (Itm : Item) return User_Access; -- AKA: item_userptr -- Same as function pragma Inline (Get_User_Data); -end Terminal_Interface.Curses.Menus.Item_User_Data; +end Terminal_Interface.Curses.Menus.Item_User_Data; diff --git a/doc/html/ada/terminal_interface-curses-menus-menu_user_data__adb.htm b/doc/html/ada/terminal_interface-curses-menus-menu_user_data__adb.htm index 50be1edb..ebb4a81c 100644 --- a/doc/html/ada/terminal_interface-curses-menus-menu_user_data__adb.htm +++ b/doc/html/ada/terminal_interface-curses-menus-menu_user_data__adb.htm @@ -24,7 +24,7 @@ -- B O D Y -- -- -- ------------------------------------------------------------------------------ --- Copyright (c) 1998-2003,2009 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 -- @@ -52,43 +52,41 @@ ------------------------------------------------------------------------------ -- Author: Juergen Pfeifer, 1996 -- Version Control: --- @Revision: 1.13 @ +-- @Revision: 1.15 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ -with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; +with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; -package body Terminal_Interface.Curses.Menus.Menu_User_Data is +package body Terminal_Interface.Curses.Menus.Menu_User_Data is use type Interfaces.C.int; - procedure Set_User_Data (Men : Menu; + procedure Set_User_Data (Men : Menu; Data : User_Access) is - function Set_Menu_Userptr (Men : Menu; - Data : User_Access) return C_Int; + function Set_Menu_Userptr (Men : Menu; + Data : User_Access) return Eti_Error; pragma Import (C, Set_Menu_Userptr, "set_menu_userptr"); - Res : constant Eti_Error := Set_Menu_Userptr (Men, Data); begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; + Eti_Exception (Set_Menu_Userptr (Men, Data)); + end Set_User_Data; - function Get_User_Data (Men : Menu) return User_Access + function Get_User_Data (Men : Menu) return User_Access is - function Menu_Userptr (Men : Menu) return User_Access; + function Menu_Userptr (Men : Menu) return User_Access; pragma Import (C, Menu_Userptr, "menu_userptr"); begin - return Menu_Userptr (Men); + return Menu_Userptr (Men); end Get_User_Data; - procedure Get_User_Data (Men : Menu; - Data : out User_Access) + procedure Get_User_Data (Men : Menu; + Data : out User_Access) is begin Data := Get_User_Data (Men); end Get_User_Data; -end Terminal_Interface.Curses.Menus.Menu_User_Data; +end Terminal_Interface.Curses.Menus.Menu_User_Data; diff --git a/doc/html/ada/terminal_interface-curses-menus-menu_user_data__ads.htm b/doc/html/ada/terminal_interface-curses-menus-menu_user_data__ads.htm index 3cb525a0..7d03aee9 100644 --- a/doc/html/ada/terminal_interface-curses-menus-menu_user_data__ads.htm +++ b/doc/html/ada/terminal_interface-curses-menus-menu_user_data__ads.htm @@ -59,29 +59,29 @@ generic type User is limited private; type User_Access is access User; -package Terminal_Interface.Curses.Menus.Menu_User_Data is - pragma Preelaborate (Terminal_Interface.Curses.Menus.Menu_User_Data); +package Terminal_Interface.Curses.Menus.Menu_User_Data is + pragma Preelaborate (Terminal_Interface.Curses.Menus.Menu_User_Data); -- |===================================================================== -- | Man page menu_userptr.3x -- |===================================================================== -- #1A NAME="AFU_1"#2| - procedure Set_User_Data (Men : Menu; + procedure Set_User_Data (Men : Menu; Data : User_Access); -- AKA: set_menu_userptr pragma Inline (Set_User_Data); -- #1A NAME="AFU_2"#2| - procedure Get_User_Data (Men : Menu; - Data : out User_Access); + procedure Get_User_Data (Men : Menu; + Data : out User_Access); -- AKA: menu_userptr -- #1A NAME="AFU_3"#2| - function Get_User_Data (Men : Menu) return User_Access; + function Get_User_Data (Men : Menu) return User_Access; -- AKA: menu_userptr -- Same as function pragma Inline (Get_User_Data); -end Terminal_Interface.Curses.Menus.Menu_User_Data; +end Terminal_Interface.Curses.Menus.Menu_User_Data; diff --git a/doc/html/ada/terminal_interface-curses-menus__adb.htm b/doc/html/ada/terminal_interface-curses-menus__adb.htm index 6da134e3..820bdb0d 100644 --- a/doc/html/ada/terminal_interface-curses-menus__adb.htm +++ b/doc/html/ada/terminal_interface-curses-menus__adb.htm @@ -24,7 +24,7 @@ -- B O D Y -- -- -- ------------------------------------------------------------------------------ --- Copyright (c) 1998-2009,2011 Free Software Foundation, Inc. -- +-- Copyright (c) 1998-2011,2014 Free Software Foundation, Inc. -- -- -- -- Permission is hereby granted, free of charge, to any person obtaining a -- -- copy of this software and associated documentation files (the -- @@ -52,989 +52,871 @@ ------------------------------------------------------------------------------ -- Author: Juergen Pfeifer, 1996 -- Version Control: --- @Revision: 1.28 @ --- @Date: 2011/03/22 23:38:12 @ +-- @Revision: 1.32 @ +-- @Date: 2014/05/24 21:31:05 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ with Ada.Unchecked_Deallocation; -with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; +with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; with Interfaces.C; use Interfaces.C; with Interfaces.C.Strings; use Interfaces.C.Strings; with Interfaces.C.Pointers; -with Ada.Unchecked_Conversion; +package body Terminal_Interface.Curses.Menus is -package body Terminal_Interface.Curses.Menus is - - type C_Item_Array is array (Natural range <>) of aliased Item; + type C_Item_Array is array (Natural range <>) of aliased Item; package I_Array is new - Interfaces.C.Pointers (Natural, Item, C_Item_Array, Null_Item); + Interfaces.C.Pointers (Natural, Item, C_Item_Array, Null_Item); use type System.Bit_Order; - subtype chars_ptr is Interfaces.C.Strings.chars_ptr; - - function MOS_2_CInt is new - Ada.Unchecked_Conversion (Menu_Option_Set, - C_Int); - - function CInt_2_MOS is new - Ada.Unchecked_Conversion (C_Int, - Menu_Option_Set); - - function IOS_2_CInt is new - Ada.Unchecked_Conversion (Item_Option_Set, - C_Int); - - function CInt_2_IOS is new - Ada.Unchecked_Conversion (C_Int, - Item_Option_Set); + subtype chars_ptr is Interfaces.C.Strings.chars_ptr; ------------------------------------------------------------------------------ - procedure Request_Name (Key : Menu_Request_Code; - Name : out String) + procedure Request_Name (Key : Menu_Request_Code; + Name : out String) is - function Request_Name (Key : C_Int) return chars_ptr; + function Request_Name (Key : C_Int) return chars_ptr; pragma Import (C, Request_Name, "menu_request_name"); begin - Fill_String (Request_Name (C_Int (Key)), Name); - end Request_Name; + Fill_String (Request_Name (C_Int (Key)), Name); + end Request_Name; - function Request_Name (Key : Menu_Request_Code) return String + function Request_Name (Key : Menu_Request_Code) return String is - function Request_Name (Key : C_Int) return chars_ptr; + function Request_Name (Key : C_Int) return chars_ptr; pragma Import (C, Request_Name, "menu_request_name"); begin - return Fill_String (Request_Name (C_Int (Key))); - end Request_Name; + return Fill_String (Request_Name (C_Int (Key))); + end Request_Name; - function Create (Name : String; - Description : String := "") return Item + function Create (Name : String; + Description : String := "") return Item is - type Char_Ptr is access all Interfaces.C.char; - function Newitem (Name, Desc : Char_Ptr) return Item; + type Char_Ptr is access all Interfaces.C.char; + function Newitem (Name, Desc : Char_Ptr) return Item; pragma Import (C, Newitem, "new_item"); - type Name_String is new char_array (0 .. Name'Length); - type Name_String_Ptr is access Name_String; - pragma Controlled (Name_String_Ptr); - - type Desc_String is new char_array (0 .. Description'Length); - type Desc_String_Ptr is access Desc_String; - pragma Controlled (Desc_String_Ptr); - - Name_Str : constant Name_String_Ptr := new Name_String; - Desc_Str : constant Desc_String_Ptr := new Desc_String; - Name_Len, Desc_Len : size_t; - Result : Item; - begin - To_C (Name, Name_Str.all, Name_Len); - To_C (Description, Desc_Str.all, Desc_Len); - Result := Newitem (Name_Str.all (Name_Str.all'First)'Access, - Desc_Str.all (Desc_Str.all'First)'Access); - if Result = Null_Item then - raise Eti_System_Error; + type Name_String is new char_array (0 .. Name'Length); + type Name_String_Ptr is access Name_String; + pragma Controlled (Name_String_Ptr); + + type Desc_String is new char_array (0 .. Description'Length); + type Desc_String_Ptr is access Desc_String; + pragma Controlled (Desc_String_Ptr); + + Name_Str : constant Name_String_Ptr := new Name_String; + Desc_Str : constant Desc_String_Ptr := new Desc_String; + Name_Len, Desc_Len : size_t; + Result : Item; + begin + To_C (Name, Name_Str.all, Name_Len); + To_C (Description, Desc_Str.all, Desc_Len); + Result := Newitem (Name_Str.all (Name_Str.all'First)'Access, + Desc_Str.all (Desc_Str.all'First)'Access); + if Result = Null_Item then + raise Eti_System_Error; end if; - return Result; - end Create; + return Result; + end Create; - procedure Delete (Itm : in out Item) + procedure Delete (Itm : in out Item) is - function Descname (Itm : Item) return chars_ptr; + function Descname (Itm : Item) return chars_ptr; pragma Import (C, Descname, "item_description"); - function Itemname (Itm : Item) return chars_ptr; + 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; + Ptr : chars_ptr; begin - Ptr := Descname (Itm); - if Ptr /= Null_Ptr then - Interfaces.C.Strings.Free (Ptr); - end if; - Ptr := Itemname (Itm); - if Ptr /= Null_Ptr then - Interfaces.C.Strings.Free (Ptr); + Ptr := Descname (Itm); + if Ptr /= Null_Ptr then + Interfaces.C.Strings.Free (Ptr); end if; - Res := Freeitem (Itm); - if Res /= E_Ok then - Eti_Exception (Res); + Ptr := Itemname (Itm); + if Ptr /= Null_Ptr then + Interfaces.C.Strings.Free (Ptr); end if; - Itm := Null_Item; - end Delete; + Eti_Exception (Freeitem (Itm)); + Itm := Null_Item; + end Delete; ------------------------------------------------------------------------------- - procedure Set_Value (Itm : Item; - Value : Boolean := True) + procedure Set_Value (Itm : Item; + Value : Boolean := True) is - function Set_Item_Val (Itm : Item; - Val : C_Int) return C_Int; + function Set_Item_Val (Itm : Item; + 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; - end Set_Value; + Eti_Exception (Set_Item_Val (Itm, Boolean'Pos (Value))); + end Set_Value; - function Value (Itm : Item) return Boolean + function Value (Itm : Item) return Boolean is - function Item_Val (Itm : Item) return C_Int; + function Item_Val (Itm : Item) return C_Int; pragma Import (C, Item_Val, "item_value"); begin - if Item_Val (Itm) = Curses_False then + if Item_Val (Itm) = Curses_False then return False; else return True; end if; - end Value; + end Value; ------------------------------------------------------------------------------- - function Visible (Itm : Item) return Boolean + function Visible (Itm : Item) return Boolean is - function Item_Vis (Itm : Item) return C_Int; + function Item_Vis (Itm : Item) return C_Int; pragma Import (C, Item_Vis, "item_visible"); begin - if Item_Vis (Itm) = Curses_False then + if Item_Vis (Itm) = Curses_False then return False; else return True; end if; - end Visible; + end Visible; ------------------------------------------------------------------------------- - procedure Set_Options (Itm : Item; - Options : 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; + function Set_Item_Opts (Itm : Item; + 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; - end Set_Options; + Eti_Exception (Set_Item_Opts (Itm, Options)); + end Set_Options; - procedure Switch_Options (Itm : Item; - Options : Item_Option_Set; - On : Boolean := True) + 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; + function Item_Opts_On (Itm : Item; + 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; + function Item_Opts_Off (Itm : Item; + 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); + if On then + 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; + end Switch_Options; - procedure Get_Options (Itm : Item; - Options : out Item_Option_Set) + 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); - end Get_Options; + Options := Item_Opts (Itm); + end Get_Options; - function Get_Options (Itm : Item := Null_Item) return Item_Option_Set + function Get_Options (Itm : Item := Null_Item) return Item_Option_Set is - Ios : Item_Option_Set; + Ios : Item_Option_Set; begin - Get_Options (Itm, Ios); - return Ios; - end Get_Options; + Get_Options (Itm, Ios); + return Ios; + end Get_Options; ------------------------------------------------------------------------------- - procedure Name (Itm : Item; - Name : out String) + procedure Name (Itm : Item; + Name : out String) is - function Itemname (Itm : Item) return chars_ptr; + function Itemname (Itm : Item) return chars_ptr; pragma Import (C, Itemname, "item_name"); begin - Fill_String (Itemname (Itm), Name); - end Name; + Fill_String (Itemname (Itm), Name); + end Name; - function Name (Itm : Item) return String + function Name (Itm : Item) return String is - function Itemname (Itm : Item) return chars_ptr; + function Itemname (Itm : Item) return chars_ptr; pragma Import (C, Itemname, "item_name"); begin - return Fill_String (Itemname (Itm)); - end Name; + return Fill_String (Itemname (Itm)); + end Name; - procedure Description (Itm : Item; - Description : out String) + procedure Description (Itm : Item; + Description : out String) is - function Descname (Itm : Item) return chars_ptr; + function Descname (Itm : Item) return chars_ptr; pragma Import (C, Descname, "item_description"); begin - Fill_String (Descname (Itm), Description); - end Description; + Fill_String (Descname (Itm), Description); + end Description; - function Description (Itm : Item) return String + function Description (Itm : Item) return String is - function Descname (Itm : Item) return chars_ptr; + function Descname (Itm : Item) return chars_ptr; pragma Import (C, Descname, "item_description"); begin - return Fill_String (Descname (Itm)); - end Description; + return Fill_String (Descname (Itm)); + end Description; ------------------------------------------------------------------------------- - procedure Set_Current (Men : Menu; - Itm : Item) + procedure Set_Current (Men : Menu; + Itm : Item) is - function Set_Curr_Item (Men : Menu; - Itm : Item) return C_Int; + function Set_Curr_Item (Men : Menu; + 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; - end Set_Current; + Eti_Exception (Set_Curr_Item (Men, Itm)); + end Set_Current; - function Current (Men : Menu) return Item + function Current (Men : Menu) return Item is - function Curr_Item (Men : Menu) return Item; + function Curr_Item (Men : Menu) return Item; pragma Import (C, Curr_Item, "current_item"); - Res : constant Item := Curr_Item (Men); + Res : constant Item := Curr_Item (Men); begin - if Res = Null_Item then - raise Menu_Exception; + if Res = Null_Item then + raise Menu_Exception; end if; - return Res; - end Current; + return Res; + end Current; - procedure Set_Top_Row (Men : Menu; - Line : Line_Position) + procedure Set_Top_Row (Men : Menu; + Line : Line_Position) is - function Set_Toprow (Men : Menu; - Line : C_Int) return C_Int; + function Set_Toprow (Men : Menu; + 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; - end Set_Top_Row; + Eti_Exception (Set_Toprow (Men, C_Int (Line))); + end Set_Top_Row; - function Top_Row (Men : Menu) return Line_Position + function Top_Row (Men : Menu) return Line_Position is - function Toprow (Men : Menu) return C_Int; + function Toprow (Men : Menu) return C_Int; pragma Import (C, Toprow, "top_row"); - Res : constant C_Int := Toprow (Men); + Res : constant C_Int := Toprow (Men); begin - if Res = Curses_Err then - raise Menu_Exception; + if Res = Curses_Err then + raise Menu_Exception; end if; - return Line_Position (Res); - end Top_Row; + return Line_Position (Res); + end Top_Row; - function Get_Index (Itm : Item) return Positive + function Get_Index (Itm : Item) return Positive is - function Get_Itemindex (Itm : Item) return C_Int; + function Get_Itemindex (Itm : Item) return C_Int; pragma Import (C, Get_Itemindex, "item_index"); - Res : constant C_Int := Get_Itemindex (Itm); + Res : constant C_Int := Get_Itemindex (Itm); begin - if Res = Curses_Err then - raise Menu_Exception; + if Res = Curses_Err then + raise Menu_Exception; end if; - return Positive (Natural (Res) + Positive'First); - end Get_Index; + return Positive (Natural (Res) + Positive'First); + end Get_Index; ------------------------------------------------------------------------------- - procedure Post (Men : Menu; - Post : 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); + if Post then + Eti_Exception (M_Post (Men)); else - Res := M_Unpost (Men); + Eti_Exception (M_Unpost (Men)); end if; - if Res /= E_Ok then - Eti_Exception (Res); - end if; - end Post; + end Post; ------------------------------------------------------------------------------- - procedure Set_Options (Men : Menu; - Options : 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; + function Set_Menu_Opts (Men : Menu; + 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; - end Set_Options; + Eti_Exception (Set_Menu_Opts (Men, Options)); + end Set_Options; - procedure Switch_Options (Men : Menu; - Options : Menu_Option_Set; - On : 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; + function Menu_Opts_On (Men : Menu; + 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; + function Menu_Opts_Off (Men : Menu; + 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); + if On then + 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; + end Switch_Options; - procedure Get_Options (Men : 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); - end Get_Options; + Options := Menu_Opts (Men); + end Get_Options; - function Get_Options (Men : Menu := Null_Menu) return Menu_Option_Set + function Get_Options (Men : Menu := Null_Menu) return Menu_Option_Set is - Mos : Menu_Option_Set; + Mos : Menu_Option_Set; begin - Get_Options (Men, Mos); - return Mos; - end Get_Options; + Get_Options (Men, Mos); + return Mos; + end Get_Options; ------------------------------------------------------------------------------- - procedure Set_Window (Men : Menu; - Win : Window) + procedure Set_Window (Men : Menu; + Win : Window) is - function Set_Menu_Win (Men : Menu; - Win : Window) return C_Int; + function Set_Menu_Win (Men : Menu; + 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; - end Set_Window; + Eti_Exception (Set_Menu_Win (Men, Win)); + end Set_Window; - function Get_Window (Men : Menu) return Window + function Get_Window (Men : Menu) return Window is - function Menu_Win (Men : Menu) return Window; + function Menu_Win (Men : Menu) return Window; pragma Import (C, Menu_Win, "menu_win"); - W : constant Window := Menu_Win (Men); + W : constant Window := Menu_Win (Men); begin - return W; - end Get_Window; + return W; + end Get_Window; - procedure Set_Sub_Window (Men : Menu; - Win : Window) + procedure Set_Sub_Window (Men : Menu; + Win : Window) is - function Set_Menu_Sub (Men : Menu; - Win : Window) return C_Int; + function Set_Menu_Sub (Men : Menu; + 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; - end Set_Sub_Window; + Eti_Exception (Set_Menu_Sub (Men, Win)); + end Set_Sub_Window; - function Get_Sub_Window (Men : Menu) return Window + function Get_Sub_Window (Men : Menu) return Window is - function Menu_Sub (Men : Menu) return Window; + function Menu_Sub (Men : Menu) return Window; pragma Import (C, Menu_Sub, "menu_sub"); - W : constant Window := Menu_Sub (Men); + W : constant Window := Menu_Sub (Men); begin - return W; - end Get_Sub_Window; + return W; + end Get_Sub_Window; - procedure Scale (Men : Menu; - Lines : out Line_Count; - Columns : out Column_Count) + 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; + type C_Int_Access is access all C_Int; + function M_Scale (Men : Menu; + 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); + X, Y : aliased C_Int; begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; - Lines := Line_Count (Y); - Columns := Column_Count (X); - end Scale; + Eti_Exception (M_Scale (Men, Y'Access, X'Access)); + Lines := Line_Count (Y); + Columns := Column_Count (X); + end Scale; ------------------------------------------------------------------------------- - procedure Position_Cursor (Men : Menu) + 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; - end Position_Cursor; + Eti_Exception (Pos_Menu_Cursor (Men)); + end Position_Cursor; ------------------------------------------------------------------------------- - procedure Set_Mark (Men : Menu; - Mark : 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; + type Char_Ptr is access all Interfaces.C.char; + function Set_Mark (Men : Menu; + 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; + Txt : char_array (0 .. Mark'Length); + Len : size_t; begin - To_C (Mark, Txt, Len); - Res := Set_Mark (Men, Txt (Txt'First)'Access); - if Res /= E_Ok then - Eti_Exception (Res); - end if; - end Set_Mark; + To_C (Mark, Txt, Len); + Eti_Exception (Set_Mark (Men, Txt (Txt'First)'Access)); + end Set_Mark; - procedure Mark (Men : Menu; - Mark : out String) + procedure Mark (Men : Menu; + Mark : out String) is - function Get_Menu_Mark (Men : Menu) return chars_ptr; + function Get_Menu_Mark (Men : Menu) return chars_ptr; pragma Import (C, Get_Menu_Mark, "menu_mark"); begin - Fill_String (Get_Menu_Mark (Men), Mark); - end Mark; + Fill_String (Get_Menu_Mark (Men), Mark); + end Mark; - function Mark (Men : Menu) return String + function Mark (Men : Menu) return String is - function Get_Menu_Mark (Men : Menu) return chars_ptr; + function Get_Menu_Mark (Men : Menu) return chars_ptr; pragma Import (C, Get_Menu_Mark, "menu_mark"); begin - return Fill_String (Get_Menu_Mark (Men)); - end Mark; + return Fill_String (Get_Menu_Mark (Men)); + end Mark; ------------------------------------------------------------------------------- - procedure Set_Foreground - (Men : Menu; - Fore : Character_Attribute_Set := Normal_Video; - Color : Color_Pair := Color_Pair'First) + procedure Set_Foreground + (Men : Menu; + Fore : Character_Attribute_Set := Normal_Video; + Color : Color_Pair := Color_Pair'First) is - function Set_Menu_Fore (Men : Menu; - Attr : C_Chtype) return C_Int; + function Set_Menu_Fore (Men : Menu; + 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)); + Ch : constant Attributed_Character := (Ch => Character'First, + Color => Color, + Attr => Fore); begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; - end Set_Foreground; + Eti_Exception (Set_Menu_Fore (Men, Ch)); + end Set_Foreground; - procedure Foreground (Men : Menu; - Fore : out Character_Attribute_Set) + 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; - end Foreground; + Fore := Menu_Fore (Men).Attr; + end Foreground; - procedure Foreground (Men : Menu; - Fore : out Character_Attribute_Set; - Color : out Color_Pair) + 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; - end Foreground; + Fore := Menu_Fore (Men).Attr; + Color := Menu_Fore (Men).Color; + end Foreground; - procedure Set_Background - (Men : Menu; - Back : Character_Attribute_Set := Normal_Video; - Color : Color_Pair := Color_Pair'First) + procedure Set_Background + (Men : Menu; + Back : Character_Attribute_Set := Normal_Video; + Color : Color_Pair := Color_Pair'First) is - function Set_Menu_Back (Men : Menu; - Attr : C_Chtype) return C_Int; + function Set_Menu_Back (Men : Menu; + 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)); + Ch : constant Attributed_Character := (Ch => Character'First, + Color => Color, + Attr => Back); begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; - end Set_Background; + Eti_Exception (Set_Menu_Back (Men, Ch)); + end Set_Background; - procedure Background (Men : Menu; - Back : out Character_Attribute_Set) + 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; - end Background; + Back := Menu_Back (Men).Attr; + end Background; - procedure Background (Men : Menu; - Back : out Character_Attribute_Set; - Color : out Color_Pair) + 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; - end Background; + Back := Menu_Back (Men).Attr; + Color := Menu_Back (Men).Color; + end Background; - procedure Set_Grey (Men : Menu; - Grey : Character_Attribute_Set := Normal_Video; - Color : 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; + function Set_Menu_Grey (Men : Menu; + 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); + Ch : constant Attributed_Character := (Ch => Character'First, + Color => Color, + Attr => Grey); - Res : constant Eti_Error := Set_Menu_Grey (Men, AttrChar_To_Chtype (Ch)); begin - if Res /= E_Ok then - Eti_Exception (Res); - end if; - end Set_Grey; + Eti_Exception (Set_Menu_Grey (Men, Ch)); + end Set_Grey; - procedure Grey (Men : Menu; - Grey : out Character_Attribute_Set) + 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; - end Grey; + Grey := Menu_Grey (Men).Attr; + end Grey; - procedure Grey (Men : Menu; - Grey : out Character_Attribute_Set; - Color : out Color_Pair) + 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; - end Grey; + Grey := Menu_Grey (Men).Attr; + Color := Menu_Grey (Men).Color; + end Grey; - procedure Set_Pad_Character (Men : Menu; - Pad : Character := Space) + procedure Set_Pad_Character (Men : Menu; + Pad : Character := Space) is - function Set_Menu_Pad (Men : Menu; - Ch : C_Int) return C_Int; + function Set_Menu_Pad (Men : Menu; + 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; - end Set_Pad_Character; + Eti_Exception (Set_Menu_Pad (Men, C_Int (Character'Pos (Pad)))); + end Set_Pad_Character; - procedure Pad_Character (Men : Menu; - Pad : out Character) + procedure Pad_Character (Men : Menu; + Pad : out Character) is - function Menu_Pad (Men : Menu) return C_Int; + function Menu_Pad (Men : Menu) return C_Int; pragma Import (C, Menu_Pad, "menu_pad"); begin - Pad := Character'Val (Menu_Pad (Men)); - end Pad_Character; + Pad := Character'Val (Menu_Pad (Men)); + end Pad_Character; ------------------------------------------------------------------------------- - procedure Set_Spacing (Men : Menu; - Descr : Column_Position := 0; - Row : Line_Position := 0; - Col : Column_Position := 0) + 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; + function Set_Spacing (Men : Menu; + 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; - end Set_Spacing; + Eti_Exception (Set_Spacing (Men, + C_Int (Descr), + C_Int (Row), + C_Int (Col))); + end Set_Spacing; - procedure Spacing (Men : Menu; - Descr : out Column_Position; - Row : out Line_Position; - Col : out Column_Position) + 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; + type C_Int_Access is access all C_Int; + function Get_Spacing (Men : Menu; + 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); + D, R, C : aliased C_Int; begin - if Res /= E_Ok then - Eti_Exception (Res); - else - Descr := Column_Position (D); - Row := Line_Position (R); - Col := Column_Position (C); - end if; - end Spacing; + 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; - Text : String) return Boolean + function Set_Pattern (Men : Menu; + Text : String) return Boolean is - type Char_Ptr is access all Interfaces.C.char; - function Set_Pattern (Men : Menu; - Pattern : Char_Ptr) return C_Int; + type Char_Ptr is access all Interfaces.C.char; + function Set_Pattern (Men : Menu; + Pattern : Char_Ptr) return Eti_Error; pragma Import (C, Set_Pattern, "set_menu_pattern"); - S : char_array (0 .. Text'Length); - L : size_t; - Res : Eti_Error; + S : char_array (0 .. Text'Length); + L : size_t; + Res : Eti_Error; begin - To_C (Text, S, L); - Res := Set_Pattern (Men, S (S'First)'Access); - case Res is - when E_No_Match => return False; - when E_Ok => return True; - when others => - Eti_Exception (Res); + To_C (Text, S, L); + Res := Set_Pattern (Men, S (S'First)'Access); + case Res is + when E_No_Match => return False; + when others => + Eti_Exception (Res); + return True; end case; - end Set_Pattern; + end Set_Pattern; - procedure Pattern (Men : Menu; - Text : out String) + procedure Pattern (Men : Menu; + Text : out String) is - function Get_Pattern (Men : Menu) return chars_ptr; + function Get_Pattern (Men : Menu) return chars_ptr; pragma Import (C, Get_Pattern, "menu_pattern"); begin - Fill_String (Get_Pattern (Men), Text); - end Pattern; + Fill_String (Get_Pattern (Men), Text); + end Pattern; ------------------------------------------------------------------------------- - procedure Set_Format (Men : Menu; - Lines : Line_Count; - Columns : 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; + function Set_Menu_Fmt (Men : Menu; + Lin : 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; - end Set_Format; + Eti_Exception (Set_Menu_Fmt (Men, + C_Int (Lines), + C_Int (Columns))); + + end Set_Format; - procedure Format (Men : Menu; - Lines : out Line_Count; - Columns : out Column_Count) + 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; + type C_Int_Access is access all C_Int; + function Menu_Fmt (Men : Menu; + 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); + L, C : aliased C_Int; begin - if Res /= E_Ok then - Eti_Exception (Res); - else - Lines := Line_Count (L); - Columns := Column_Count (C); - end if; - end Format; + Eti_Exception (Menu_Fmt (Men, L'Access, C'Access)); + Lines := Line_Count (L); + Columns := Column_Count (C); + end Format; ------------------------------------------------------------------------------- - procedure Set_Item_Init_Hook (Men : Menu; - Proc : Menu_Hook_Function) + 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; + function Set_Item_Init (Men : Menu; + 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; - end Set_Item_Init_Hook; + Eti_Exception (Set_Item_Init (Men, Proc)); + end Set_Item_Init_Hook; - procedure Set_Item_Term_Hook (Men : Menu; - Proc : 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; + function Set_Item_Term (Men : Menu; + 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; - end Set_Item_Term_Hook; + Eti_Exception (Set_Item_Term (Men, Proc)); + end Set_Item_Term_Hook; - procedure Set_Menu_Init_Hook (Men : Menu; - Proc : 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; + function Set_Menu_Init (Men : Menu; + 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; - end Set_Menu_Init_Hook; + Eti_Exception (Set_Menu_Init (Men, Proc)); + end Set_Menu_Init_Hook; - procedure Set_Menu_Term_Hook (Men : Menu; - Proc : 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; + function Set_Menu_Term (Men : Menu; + 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; - end Set_Menu_Term_Hook; + Eti_Exception (Set_Menu_Term (Men, Proc)); + end Set_Menu_Term_Hook; - function Get_Item_Init_Hook (Men : Menu) return Menu_Hook_Function + function Get_Item_Init_Hook (Men : Menu) return Menu_Hook_Function is - function Item_Init (Men : Menu) return Menu_Hook_Function; + function Item_Init (Men : Menu) return Menu_Hook_Function; pragma Import (C, Item_Init, "item_init"); begin - return Item_Init (Men); - end Get_Item_Init_Hook; + return Item_Init (Men); + end Get_Item_Init_Hook; - function Get_Item_Term_Hook (Men : Menu) return Menu_Hook_Function + function Get_Item_Term_Hook (Men : Menu) return Menu_Hook_Function is - function Item_Term (Men : Menu) return Menu_Hook_Function; + function Item_Term (Men : Menu) return Menu_Hook_Function; pragma Import (C, Item_Term, "item_term"); begin - return Item_Term (Men); - end Get_Item_Term_Hook; + return Item_Term (Men); + end Get_Item_Term_Hook; - function Get_Menu_Init_Hook (Men : Menu) return Menu_Hook_Function + function Get_Menu_Init_Hook (Men : Menu) return Menu_Hook_Function is - function Menu_Init (Men : Menu) return Menu_Hook_Function; + function Menu_Init (Men : Menu) return Menu_Hook_Function; pragma Import (C, Menu_Init, "menu_init"); begin - return Menu_Init (Men); - end Get_Menu_Init_Hook; + return Menu_Init (Men); + end Get_Menu_Init_Hook; - function Get_Menu_Term_Hook (Men : Menu) return Menu_Hook_Function + function Get_Menu_Term_Hook (Men : Menu) return Menu_Hook_Function is - function Menu_Term (Men : Menu) return Menu_Hook_Function; + function Menu_Term (Men : Menu) return Menu_Hook_Function; pragma Import (C, Menu_Term, "menu_term"); begin - return Menu_Term (Men); - end Get_Menu_Term_Hook; + return Menu_Term (Men); + end Get_Menu_Term_Hook; ------------------------------------------------------------------------------- - procedure Redefine (Men : Menu; - Items : Item_Array_Access) + procedure Redefine (Men : Menu; + Items : Item_Array_Access) is - function Set_Items (Men : Menu; - Items : System.Address) return C_Int; + function Set_Items (Men : Menu; + Items : System.Address) return Eti_Error; pragma Import (C, Set_Items, "set_menu_items"); - Res : Eti_Error; begin - pragma Assert (Items.all (Items'Last) = Null_Item); - if Items.all (Items'Last) /= Null_Item then - raise Menu_Exception; + 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; + end Redefine; - function Item_Count (Men : Menu) return Natural + function Item_Count (Men : Menu) return Natural is - function Count (Men : Menu) return C_Int; + function Count (Men : Menu) return C_Int; pragma Import (C, Count, "item_count"); begin - return Natural (Count (Men)); - end Item_Count; + return Natural (Count (Men)); + end Item_Count; - function Items (Men : Menu; - Index : Positive) return Item + function Items (Men : Menu; + Index : Positive) return Item is use I_Array; - function C_Mitems (Men : Menu) return Pointer; + function C_Mitems (Men : Menu) return Pointer; pragma Import (C, C_Mitems, "menu_items"); - P : Pointer := C_Mitems (Men); + P : Pointer := C_Mitems (Men); begin - if P = null or else Index > Item_Count (Men) then - raise Menu_Exception; + if P = null or else Index > Item_Count (Men) then + raise Menu_Exception; else - P := P + ptrdiff_t (C_Int (Index) - 1); + P := P + ptrdiff_t (C_Int (Index) - 1); return P.all; end if; - end Items; + end Items; ------------------------------------------------------------------------------- - function Create (Items : Item_Array_Access) return Menu + function Create (Items : Item_Array_Access) return Menu is - function Newmenu (Items : System.Address) return Menu; + function Newmenu (Items : System.Address) return Menu; pragma Import (C, Newmenu, "new_menu"); - M : Menu; + M : Menu; begin - pragma Assert (Items.all (Items'Last) = Null_Item); - if Items.all (Items'Last) /= Null_Item then - raise Menu_Exception; + pragma Assert (Items.all (Items'Last) = Null_Item); + if Items.all (Items'Last) /= Null_Item then + raise Menu_Exception; else - M := Newmenu (Items.all'Address); - if M = Null_Menu then - raise Menu_Exception; + M := Newmenu (Items.all'Address); + if M = Null_Menu then + raise Menu_Exception; end if; - return M; + return M; end if; - end Create; + end Create; - procedure Delete (Men : in out Menu) + 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; - Men := Null_Menu; - end Delete; + Eti_Exception (Free (Men)); + Men := Null_Menu; + end Delete; ------------------------------------------------------------------------------ - function Driver (Men : Menu; - Key : Key_Code) return Driver_Result + function Driver (Men : Menu; + Key : Key_Code) return Driver_Result is - function Driver (Men : Menu; - Key : C_Int) return C_Int; + function Driver (Men : Menu; + 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; - end Driver; + R : constant Eti_Error := Driver (Men, C_Int (Key)); + begin + 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 : Boolean := False) + procedure Free (IA : in out Item_Array_Access; + Free_Items : Boolean := False) is procedure Release is new Ada.Unchecked_Deallocation - (Item_Array, Item_Array_Access); + (Item_Array, Item_Array_Access); begin - if IA /= null and then Free_Items then - for I in IA'First .. (IA'Last - 1) loop - if IA.all (I) /= Null_Item then - Delete (IA.all (I)); + if IA /= null and then Free_Items then + for I in IA'First .. (IA'Last - 1) loop + if IA.all (I) /= Null_Item then + Delete (IA.all (I)); end if; end loop; end if; - Release (IA); - end Free; + Release (IA); + end Free; ------------------------------------------------------------------------------- - function Default_Menu_Options return Menu_Option_Set + function Default_Menu_Options return Menu_Option_Set is begin - return Get_Options (Null_Menu); - end Default_Menu_Options; + return Get_Options (Null_Menu); + end Default_Menu_Options; - function Default_Item_Options return Item_Option_Set + function Default_Item_Options return Item_Option_Set is begin - return Get_Options (Null_Item); - end Default_Item_Options; + return Get_Options (Null_Item); + end Default_Item_Options; ------------------------------------------------------------------------------- -end Terminal_Interface.Curses.Menus; +end Terminal_Interface.Curses.Menus; diff --git a/doc/html/ada/terminal_interface-curses-menus__ads.htm b/doc/html/ada/terminal_interface-curses-menus__ads.htm index 7be457b2..0adf1177 100644 --- a/doc/html/ada/terminal_interface-curses-menus__ads.htm +++ b/doc/html/ada/terminal_interface-curses-menus__ads.htm @@ -24,7 +24,7 @@ -- S P E C -- -- -- ------------------------------------------------------------------------------ --- Copyright (c) 1998-2007,2009 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 -- @@ -52,152 +52,148 @@ ------------------------------------------------------------------------------ -- Author: Juergen Pfeifer, 1996 -- Version Control: --- @Revision: 1.28 @ --- @Date: 2009/12/26 18:35:22 @ +-- @Revision: 1.31 @ +-- @Date: 2014/05/24 21:31:57 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ --- menu binding. --- This module is generated. Please don't change it manually! --- Run the generator instead. --- | with System; with Ada.Characters.Latin_1; -package Terminal_Interface.Curses.Menus is - pragma Preelaborate (Terminal_Interface.Curses.Menus); - pragma Linker_Options ("-lmenu"); - pragma Linker_Options ("-lncurses"); +package Terminal_Interface.Curses.Menus is + pragma Preelaborate (Terminal_Interface.Curses.Menus); + pragma Linker_Options ("-lmenu" & Curses_Constants.DFT_ARG_SUFFIX); Space : Character renames Ada.Characters.Latin_1.Space; - type Item is private; - type Menu is private; + type Item is private; + type Menu is private; --------------------------- -- Interface constants -- --------------------------- - Null_Item : constant Item; - Null_Menu : constant Menu; + Null_Item : constant Item; + Null_Menu : constant Menu; - subtype Menu_Request_Code is Key_Code - range (Key_Max + 1) .. (Key_Max + 17); + subtype Menu_Request_Code is Key_Code + range (Key_Max + 1) .. (Key_Max + 17); -- The prefix M_ stands for "Menu Request" - M_Left_Item : constant Menu_Request_Code := Key_Max + 1; - M_Right_Item : constant Menu_Request_Code := Key_Max + 2; - M_Up_Item : constant Menu_Request_Code := Key_Max + 3; - M_Down_Item : constant Menu_Request_Code := Key_Max + 4; - M_ScrollUp_Line : constant Menu_Request_Code := Key_Max + 5; - M_ScrollDown_Line : constant Menu_Request_Code := Key_Max + 6; - M_ScrollDown_Page : constant Menu_Request_Code := Key_Max + 7; - M_ScrollUp_Page : constant Menu_Request_Code := Key_Max + 8; - M_First_Item : constant Menu_Request_Code := Key_Max + 9; - M_Last_Item : constant Menu_Request_Code := Key_Max + 10; - M_Next_Item : constant Menu_Request_Code := Key_Max + 11; - M_Previous_Item : constant Menu_Request_Code := Key_Max + 12; - M_Toggle_Item : constant Menu_Request_Code := Key_Max + 13; - M_Clear_Pattern : constant Menu_Request_Code := Key_Max + 14; - M_Back_Pattern : constant Menu_Request_Code := Key_Max + 15; - M_Next_Match : constant Menu_Request_Code := Key_Max + 16; - M_Previous_Match : constant Menu_Request_Code := Key_Max + 17; + M_Left_Item : constant Menu_Request_Code := Key_Max + 1; + M_Right_Item : constant Menu_Request_Code := Key_Max + 2; + M_Up_Item : constant Menu_Request_Code := Key_Max + 3; + M_Down_Item : constant Menu_Request_Code := Key_Max + 4; + M_ScrollUp_Line : constant Menu_Request_Code := Key_Max + 5; + M_ScrollDown_Line : constant Menu_Request_Code := Key_Max + 6; + M_ScrollDown_Page : constant Menu_Request_Code := Key_Max + 7; + M_ScrollUp_Page : constant Menu_Request_Code := Key_Max + 8; + M_First_Item : constant Menu_Request_Code := Key_Max + 9; + M_Last_Item : constant Menu_Request_Code := Key_Max + 10; + M_Next_Item : constant Menu_Request_Code := Key_Max + 11; + M_Previous_Item : constant Menu_Request_Code := Key_Max + 12; + M_Toggle_Item : constant Menu_Request_Code := Key_Max + 13; + M_Clear_Pattern : constant Menu_Request_Code := Key_Max + 14; + M_Back_Pattern : constant Menu_Request_Code := Key_Max + 15; + M_Next_Match : constant Menu_Request_Code := Key_Max + 16; + M_Previous_Match : constant Menu_Request_Code := Key_Max + 17; -- For those who like the old 'C' names for the request codes - REQ_LEFT_ITEM : Menu_Request_Code renames M_Left_Item; - REQ_RIGHT_ITEM : Menu_Request_Code renames M_Right_Item; - REQ_UP_ITEM : Menu_Request_Code renames M_Up_Item; - REQ_DOWN_ITEM : Menu_Request_Code renames M_Down_Item; - REQ_SCR_ULINE : Menu_Request_Code renames M_ScrollUp_Line; - REQ_SCR_DLINE : Menu_Request_Code renames M_ScrollDown_Line; - REQ_SCR_DPAGE : Menu_Request_Code renames M_ScrollDown_Page; - REQ_SCR_UPAGE : Menu_Request_Code renames M_ScrollUp_Page; - REQ_FIRST_ITEM : Menu_Request_Code renames M_First_Item; - REQ_LAST_ITEM : Menu_Request_Code renames M_Last_Item; - REQ_NEXT_ITEM : Menu_Request_Code renames M_Next_Item; - REQ_PREV_ITEM : Menu_Request_Code renames M_Previous_Item; - REQ_TOGGLE_ITEM : Menu_Request_Code renames M_Toggle_Item; - REQ_CLEAR_PATTERN : Menu_Request_Code renames M_Clear_Pattern; - REQ_BACK_PATTERN : Menu_Request_Code renames M_Back_Pattern; - REQ_NEXT_MATCH : Menu_Request_Code renames M_Next_Match; - REQ_PREV_MATCH : Menu_Request_Code renames M_Previous_Match; - - procedure Request_Name (Key : Menu_Request_Code; - Name : out String); - - function Request_Name (Key : Menu_Request_Code) return String; + REQ_LEFT_ITEM : Menu_Request_Code renames M_Left_Item; + REQ_RIGHT_ITEM : Menu_Request_Code renames M_Right_Item; + REQ_UP_ITEM : Menu_Request_Code renames M_Up_Item; + REQ_DOWN_ITEM : Menu_Request_Code renames M_Down_Item; + REQ_SCR_ULINE : Menu_Request_Code renames M_ScrollUp_Line; + REQ_SCR_DLINE : Menu_Request_Code renames M_ScrollDown_Line; + REQ_SCR_DPAGE : Menu_Request_Code renames M_ScrollDown_Page; + REQ_SCR_UPAGE : Menu_Request_Code renames M_ScrollUp_Page; + REQ_FIRST_ITEM : Menu_Request_Code renames M_First_Item; + REQ_LAST_ITEM : Menu_Request_Code renames M_Last_Item; + REQ_NEXT_ITEM : Menu_Request_Code renames M_Next_Item; + REQ_PREV_ITEM : Menu_Request_Code renames M_Previous_Item; + REQ_TOGGLE_ITEM : Menu_Request_Code renames M_Toggle_Item; + REQ_CLEAR_PATTERN : Menu_Request_Code renames M_Clear_Pattern; + REQ_BACK_PATTERN : Menu_Request_Code renames M_Back_Pattern; + REQ_NEXT_MATCH : Menu_Request_Code renames M_Next_Match; + REQ_PREV_MATCH : Menu_Request_Code renames M_Previous_Match; + + procedure Request_Name (Key : Menu_Request_Code; + Name : out String); + + function Request_Name (Key : Menu_Request_Code) return String; -- Same as function ------------------ -- Exceptions -- ------------------ - Menu_Exception : exception; + Menu_Exception : exception; -- -- Menu options -- - pragma Warnings (Off); - type Menu_Option_Set is + type Menu_Option_Set is record - One_Valued : Boolean; - Show_Descriptions : Boolean; - Row_Major_Order : Boolean; - Ignore_Case : Boolean; - Show_Matches : Boolean; - Non_Cyclic : Boolean; + One_Valued : Boolean; + Show_Descriptions : Boolean; + Row_Major_Order : Boolean; + Ignore_Case : Boolean; + Show_Matches : Boolean; + Non_Cyclic : Boolean; end record; - pragma Convention (C, Menu_Option_Set); + pragma Convention (C_Pass_By_Copy, Menu_Option_Set); - for Menu_Option_Set use + for Menu_Option_Set use record - One_Valued at 0 range 0 .. 0; - Show_Descriptions at 0 range 1 .. 1; - Row_Major_Order at 0 range 2 .. 2; - Ignore_Case at 0 range 3 .. 3; - Show_Matches at 0 range 4 .. 4; - Non_Cyclic at 0 range 5 .. 5; + One_Valued at 0 range Curses_Constants.O_ONEVALUE_First + .. Curses_Constants.O_ONEVALUE_Last; + Show_Descriptions at 0 range Curses_Constants.O_SHOWDESC_First + .. Curses_Constants.O_SHOWDESC_Last; + Row_Major_Order at 0 range Curses_Constants.O_ROWMAJOR_First + .. Curses_Constants.O_ROWMAJOR_Last; + Ignore_Case at 0 range Curses_Constants.O_IGNORECASE_First + .. Curses_Constants.O_IGNORECASE_Last; + Show_Matches at 0 range Curses_Constants.O_SHOWMATCH_First + .. Curses_Constants.O_SHOWMATCH_Last; + Non_Cyclic at 0 range Curses_Constants.O_NONCYCLIC_First + .. Curses_Constants.O_NONCYCLIC_Last; end record; - pragma Warnings (Off); for Menu_Option_Set'Size use 32; - pragma Warnings (On); - -- Please note: this rep. clause is generated and may be - -- different on your system. + pragma Warnings (Off); + for Menu_Option_Set'Size use Curses_Constants.Menu_Options_Size; pragma Warnings (On); - function Default_Menu_Options return Menu_Option_Set; + function Default_Menu_Options return Menu_Option_Set; -- Initial default options for a menu. - pragma Inline (Default_Menu_Options); + pragma Inline (Default_Menu_Options); -- -- Item options -- - pragma Warnings (Off); - type Item_Option_Set is + type Item_Option_Set is record - Selectable : Boolean; + Selectable : Boolean; end record; - pragma Convention (C, Item_Option_Set); + pragma Convention (C_Pass_By_Copy, Item_Option_Set); - for Item_Option_Set use + for Item_Option_Set use record - Selectable at 0 range 0 .. 0; + Selectable at 0 range Curses_Constants.O_SELECTABLE_First + .. Curses_Constants.O_SELECTABLE_Last; end record; - pragma Warnings (Off); for Item_Option_Set'Size use 32; - pragma Warnings (On); - -- Please note: this rep. clause is generated and may be - -- different on your system. + pragma Warnings (Off); + for Item_Option_Set'Size use Curses_Constants.Item_Options_Size; pragma Warnings (On); - function Default_Item_Options return Item_Option_Set; + function Default_Item_Options return Item_Option_Set; -- Initial default options for an item. - pragma Inline (Default_Item_Options); + pragma Inline (Default_Item_Options); -- -- Item Array -- - type Item_Array is array (Positive range <>) of aliased Item; + type Item_Array is array (Positive range <>) of aliased Item; pragma Convention (C, Item_Array); - type Item_Array_Access is access Item_Array; + type Item_Array_Access is access Item_Array; - procedure Free (IA : in out Item_Array_Access; - Free_Items : Boolean := False); + procedure Free (IA : in out Item_Array_Access; + Free_Items : Boolean := False); -- Release the memory for an allocated item array -- If Free_Items is True, call Delete() for all the items in -- the array. @@ -207,19 +203,19 @@ -- |===================================================================== -- #1A NAME="AFU_1"#2| - function Create (Name : String; - Description : String := "") return Item; + function Create (Name : String; + Description : String := "") return Item; -- AKA: new_item() -- Not inlined. -- #1A NAME="AFU_2"#2| - function New_Item (Name : String; - Description : String := "") return Item - renames Create; + function New_Item (Name : String; + Description : String := "") return Item + renames Create; -- AKA: new_item() -- #1A NAME="AFU_3"#2| - procedure Delete (Itm : in out Item); + procedure Delete (Itm : in out Item); -- AKA: free_item() -- Resets Itm to Null_Item @@ -228,51 +224,51 @@ -- |===================================================================== -- #1A NAME="AFU_4"#2| - procedure Set_Value (Itm : Item; - Value : Boolean := True); + procedure Set_Value (Itm : Item; + Value : Boolean := True); -- AKA: set_item_value() - pragma Inline (Set_Value); + pragma Inline (Set_Value); -- #1A NAME="AFU_5"#2| - function Value (Itm : Item) return Boolean; + function Value (Itm : Item) return Boolean; -- AKA: item_value() - pragma Inline (Value); + pragma Inline (Value); -- |===================================================================== -- | Man page mitem_visible.3x -- |===================================================================== -- #1A NAME="AFU_6"#2| - function Visible (Itm : Item) return Boolean; + function Visible (Itm : Item) return Boolean; -- AKA: item_visible() - pragma Inline (Visible); + pragma Inline (Visible); -- |===================================================================== -- | Man page mitem_opts.3x -- |===================================================================== -- #1A NAME="AFU_7"#2| - procedure Set_Options (Itm : Item; - Options : Item_Option_Set); + procedure Set_Options (Itm : Item; + Options : Item_Option_Set); -- AKA: set_item_opts() -- An overloaded Set_Options is defined later. Pragma Inline appears there -- #1A NAME="AFU_8"#2| - procedure Switch_Options (Itm : Item; - Options : Item_Option_Set; - On : Boolean := True); + procedure Switch_Options (Itm : Item; + Options : Item_Option_Set; + On : Boolean := True); -- AKA: item_opts_on() -- AKA: item_opts_off() -- An overloaded Switch_Options is defined later. -- Pragma Inline appears there -- #1A NAME="AFU_9"#2| - procedure Get_Options (Itm : Item; - Options : out Item_Option_Set); + procedure Get_Options (Itm : Item; + Options : out Item_Option_Set); -- AKA: item_opts() -- #1A NAME="AFU_10"#2| - function Get_Options (Itm : Item := Null_Item) return Item_Option_Set; + function Get_Options (Itm : Item := Null_Item) return Item_Option_Set; -- AKA: item_opts() -- An overloaded Get_Options is defined later. Pragma Inline appears there @@ -281,20 +277,20 @@ -- |===================================================================== -- #1A NAME="AFU_11"#2| - procedure Name (Itm : Item; - Name : out String); + procedure Name (Itm : Item; + Name : out String); -- AKA: item_name() - function Name (Itm : Item) return String; + function Name (Itm : Item) return String; -- AKA: item_name() -- Implemented as function pragma Inline (Name); -- #1A NAME="AFU_12"#2| - procedure Description (Itm : Item; - Description : out String); + procedure Description (Itm : Item; + Description : out String); -- AKA: item_description(); - function Description (Itm : Item) return String; + function Description (Itm : Item) return String; -- AKA: item_description(); -- Implemented as function pragma Inline (Description); @@ -304,71 +300,71 @@ -- |===================================================================== -- #1A NAME="AFU_13"#2| - procedure Set_Current (Men : Menu; - Itm : Item); + procedure Set_Current (Men : Menu; + Itm : Item); -- AKA: set_current_item() - pragma Inline (Set_Current); + pragma Inline (Set_Current); -- #1A NAME="AFU_14"#2| - function Current (Men : Menu) return Item; + function Current (Men : Menu) return Item; -- AKA: current_item() - pragma Inline (Current); + pragma Inline (Current); -- #1A NAME="AFU_15"#2| - procedure Set_Top_Row (Men : Menu; - Line : Line_Position); + procedure Set_Top_Row (Men : Menu; + Line : Line_Position); -- AKA: set_top_row() - pragma Inline (Set_Top_Row); + pragma Inline (Set_Top_Row); -- #1A NAME="AFU_16"#2| - function Top_Row (Men : Menu) return Line_Position; + function Top_Row (Men : Menu) return Line_Position; -- AKA: top_row() - pragma Inline (Top_Row); + pragma Inline (Top_Row); -- #1A NAME="AFU_17"#2| - function Get_Index (Itm : Item) return Positive; + function Get_Index (Itm : Item) return Positive; -- AKA: item_index() -- Please note that in this binding we start the numbering of items -- with 1. So this is number is one more than you get from the low -- level call. - pragma Inline (Get_Index); + pragma Inline (Get_Index); -- |===================================================================== -- | Man page menu_post.3x -- |===================================================================== -- #1A NAME="AFU_18"#2| - procedure Post (Men : Menu; - Post : Boolean := True); + procedure Post (Men : Menu; + Post : Boolean := True); -- AKA: post_menu() -- AKA: unpost_menu() - pragma Inline (Post); + pragma Inline (Post); -- |===================================================================== -- | Man page menu_opts.3x -- |===================================================================== -- #1A NAME="AFU_19"#2| - procedure Set_Options (Men : Menu; - Options : Menu_Option_Set); + procedure Set_Options (Men : Menu; + Options : Menu_Option_Set); -- AKA: set_menu_opts() pragma Inline (Set_Options); -- #1A NAME="AFU_20"#2| - procedure Switch_Options (Men : Menu; - Options : Menu_Option_Set; - On : Boolean := True); + procedure Switch_Options (Men : Menu; + Options : Menu_Option_Set; + On : Boolean := True); -- AKA: menu_opts_on() -- AKA: menu_opts_off() pragma Inline (Switch_Options); -- #1A NAME="AFU_21"#2| - procedure Get_Options (Men : Menu; - Options : out Menu_Option_Set); + procedure Get_Options (Men : Menu; + Options : out Menu_Option_Set); -- AKA: menu_opts() -- #1A NAME="AFU_22"#2| - function Get_Options (Men : Menu := Null_Menu) return Menu_Option_Set; + function Get_Options (Men : Menu := Null_Menu) return Menu_Option_Set; -- AKA: menu_opts() pragma Inline (Get_Options); @@ -377,59 +373,59 @@ -- |===================================================================== -- #1A NAME="AFU_23"#2| - procedure Set_Window (Men : Menu; - Win : Window); + procedure Set_Window (Men : Menu; + Win : Window); -- AKA: set_menu_win() - pragma Inline (Set_Window); + pragma Inline (Set_Window); -- #1A NAME="AFU_24"#2| - function Get_Window (Men : Menu) return Window; + function Get_Window (Men : Menu) return Window; -- AKA: menu_win() - pragma Inline (Get_Window); + pragma Inline (Get_Window); -- #1A NAME="AFU_25"#2| - procedure Set_Sub_Window (Men : Menu; - Win : Window); + procedure Set_Sub_Window (Men : Menu; + Win : Window); -- AKA: set_menu_sub() - pragma Inline (Set_Sub_Window); + pragma Inline (Set_Sub_Window); -- #1A NAME="AFU_26"#2| - function Get_Sub_Window (Men : Menu) return Window; + function Get_Sub_Window (Men : Menu) return Window; -- AKA: menu_sub() - pragma Inline (Get_Sub_Window); + pragma Inline (Get_Sub_Window); -- #1A NAME="AFU_27"#2| - procedure Scale (Men : Menu; - Lines : out Line_Count; - Columns : out Column_Count); + procedure Scale (Men : Menu; + Lines : out Line_Count; + Columns : out Column_Count); -- AKA: scale_menu() - pragma Inline (Scale); + pragma Inline (Scale); -- |===================================================================== -- | Man page menu_cursor.3x -- |===================================================================== -- #1A NAME="AFU_28"#2| - procedure Position_Cursor (Men : Menu); + procedure Position_Cursor (Men : Menu); -- AKA: pos_menu_cursor() - pragma Inline (Position_Cursor); + pragma Inline (Position_Cursor); -- |===================================================================== -- | Man page menu_mark.3x -- |===================================================================== -- #1A NAME="AFU_29"#2| - procedure Set_Mark (Men : Menu; - Mark : String); + procedure Set_Mark (Men : Menu; + Mark : String); -- AKA: set_menu_mark() - pragma Inline (Set_Mark); + pragma Inline (Set_Mark); -- #1A NAME="AFU_30"#2| - procedure Mark (Men : Menu; - Mark : out String); + procedure Mark (Men : Menu; + Mark : out String); -- AKA: menu_mark() - function Mark (Men : Menu) return String; + function Mark (Men : Menu) return String; -- AKA: menu_mark() -- Implemented as function pragma Inline (Mark); @@ -439,123 +435,123 @@ -- |===================================================================== -- #1A NAME="AFU_31"#2| - procedure Set_Foreground - (Men : Menu; - Fore : Character_Attribute_Set := Normal_Video; - Color : Color_Pair := Color_Pair'First); + procedure Set_Foreground + (Men : Menu; + Fore : Character_Attribute_Set := Normal_Video; + Color : Color_Pair := Color_Pair'First); -- AKA: set_menu_fore() - pragma Inline (Set_Foreground); + pragma Inline (Set_Foreground); -- #1A NAME="AFU_32"#2| - procedure Foreground (Men : Menu; - Fore : out Character_Attribute_Set); + procedure Foreground (Men : Menu; + Fore : out Character_Attribute_Set); -- AKA: menu_fore() -- #1A NAME="AFU_33"#2| - procedure Foreground (Men : Menu; - Fore : out Character_Attribute_Set; - Color : out Color_Pair); + procedure Foreground (Men : Menu; + Fore : out Character_Attribute_Set; + Color : out Color_Pair); -- AKA: menu_fore() pragma Inline (Foreground); -- #1A NAME="AFU_34"#2| - procedure Set_Background - (Men : Menu; - Back : Character_Attribute_Set := Normal_Video; - Color : Color_Pair := Color_Pair'First); + procedure Set_Background + (Men : Menu; + Back : Character_Attribute_Set := Normal_Video; + Color : Color_Pair := Color_Pair'First); -- AKA: set_menu_back() pragma Inline (Set_Background); -- #1A NAME="AFU_35"#2| - procedure Background (Men : Menu; - Back : out Character_Attribute_Set); + procedure Background (Men : Menu; + Back : out Character_Attribute_Set); -- AKA: menu_back() -- #1A NAME="AFU_36"#2| - procedure Background (Men : Menu; - Back : out Character_Attribute_Set; - Color : out Color_Pair); + procedure Background (Men : Menu; + Back : out Character_Attribute_Set; + Color : out Color_Pair); -- AKA: menu_back() pragma Inline (Background); -- #1A NAME="AFU_37"#2| - procedure Set_Grey - (Men : Menu; - Grey : Character_Attribute_Set := Normal_Video; - Color : Color_Pair := Color_Pair'First); + procedure Set_Grey + (Men : Menu; + Grey : Character_Attribute_Set := Normal_Video; + Color : Color_Pair := Color_Pair'First); -- AKA: set_menu_grey() - pragma Inline (Set_Grey); + pragma Inline (Set_Grey); -- #1A NAME="AFU_38"#2| - procedure Grey (Men : Menu; - Grey : out Character_Attribute_Set); + procedure Grey (Men : Menu; + Grey : out Character_Attribute_Set); -- AKA: menu_grey() -- #1A NAME="AFU_39"#2| - procedure Grey - (Men : Menu; - Grey : out Character_Attribute_Set; - Color : out Color_Pair); + procedure Grey + (Men : Menu; + Grey : out Character_Attribute_Set; + Color : out Color_Pair); -- AKA: menu_grey() pragma Inline (Grey); -- #1A NAME="AFU_40"#2| - procedure Set_Pad_Character (Men : Menu; - Pad : Character := Space); + procedure Set_Pad_Character (Men : Menu; + Pad : Character := Space); -- AKA: set_menu_pad() - pragma Inline (Set_Pad_Character); + pragma Inline (Set_Pad_Character); -- #1A NAME="AFU_41"#2| - procedure Pad_Character (Men : Menu; - Pad : out Character); + procedure Pad_Character (Men : Menu; + Pad : out Character); -- AKA: menu_pad() - pragma Inline (Pad_Character); + pragma Inline (Pad_Character); -- |===================================================================== -- | Man page menu_spacing.3x -- |===================================================================== -- #1A NAME="AFU_42"#2| - procedure Set_Spacing (Men : Menu; - Descr : Column_Position := 0; - Row : Line_Position := 0; - Col : Column_Position := 0); + procedure Set_Spacing (Men : Menu; + Descr : Column_Position := 0; + Row : Line_Position := 0; + Col : Column_Position := 0); -- AKA: set_menu_spacing() - pragma Inline (Set_Spacing); + pragma Inline (Set_Spacing); -- #1A NAME="AFU_43"#2| - procedure Spacing (Men : Menu; - Descr : out Column_Position; - Row : out Line_Position; - Col : out Column_Position); + procedure Spacing (Men : Menu; + Descr : out Column_Position; + Row : out Line_Position; + Col : out Column_Position); -- AKA: menu_spacing() - pragma Inline (Spacing); + pragma Inline (Spacing); -- |===================================================================== -- | Man page menu_pattern.3x -- |===================================================================== -- #1A NAME="AFU_44"#2| - function Set_Pattern (Men : Menu; - Text : String) return Boolean; + function Set_Pattern (Men : Menu; + Text : String) return Boolean; -- AKA: set_menu_pattern() -- Return TRUE if the pattern matches, FALSE otherwise - pragma Inline (Set_Pattern); + pragma Inline (Set_Pattern); -- #1A NAME="AFU_45"#2| - procedure Pattern (Men : Menu; - Text : out String); + procedure Pattern (Men : Menu; + Text : out String); -- AKA: menu_pattern() - pragma Inline (Pattern); + pragma Inline (Pattern); -- |===================================================================== -- | Man page menu_format.3x -- |===================================================================== -- #1A NAME="AFU_46"#2| - procedure Set_Format (Men : Menu; - Lines : Line_Count; - Columns : Column_Count); + procedure Set_Format (Men : Menu; + Lines : Line_Count; + Columns : Column_Count); -- Not implemented: 0 argument for Lines or Columns; -- instead use Format to get the current sizes -- The default format is 16 rows, 1 column. Calling @@ -564,104 +560,104 @@ -- is interpreted as a request not to change the current -- value. -- AKA: set_menu_format() - pragma Inline (Set_Format); + pragma Inline (Set_Format); -- #1A NAME="AFU_47"#2| - procedure Format (Men : Menu; - Lines : out Line_Count; - Columns : out Column_Count); + procedure Format (Men : Menu; + Lines : out Line_Count; + Columns : out Column_Count); -- AKA: menu_format() - pragma Inline (Format); + pragma Inline (Format); -- |===================================================================== -- | Man page menu_hook.3x -- |===================================================================== - type Menu_Hook_Function is access procedure (Men : Menu); - pragma Convention (C, Menu_Hook_Function); + type Menu_Hook_Function is access procedure (Men : Menu); + pragma Convention (C, Menu_Hook_Function); -- #1A NAME="AFU_48"#2| - procedure Set_Item_Init_Hook (Men : Menu; - Proc : Menu_Hook_Function); + procedure Set_Item_Init_Hook (Men : Menu; + Proc : Menu_Hook_Function); -- AKA: set_item_init() - pragma Inline (Set_Item_Init_Hook); + pragma Inline (Set_Item_Init_Hook); -- #1A NAME="AFU_49"#2| - procedure Set_Item_Term_Hook (Men : Menu; - Proc : Menu_Hook_Function); + procedure Set_Item_Term_Hook (Men : Menu; + Proc : Menu_Hook_Function); -- AKA: set_item_term() - pragma Inline (Set_Item_Term_Hook); + pragma Inline (Set_Item_Term_Hook); -- #1A NAME="AFU_50"#2| - procedure Set_Menu_Init_Hook (Men : Menu; - Proc : Menu_Hook_Function); + procedure Set_Menu_Init_Hook (Men : Menu; + Proc : Menu_Hook_Function); -- AKA: set_menu_init() - pragma Inline (Set_Menu_Init_Hook); + pragma Inline (Set_Menu_Init_Hook); -- #1A NAME="AFU_51"#2| - procedure Set_Menu_Term_Hook (Men : Menu; - Proc : Menu_Hook_Function); + procedure Set_Menu_Term_Hook (Men : Menu; + Proc : Menu_Hook_Function); -- AKA: set_menu_term() - pragma Inline (Set_Menu_Term_Hook); + pragma Inline (Set_Menu_Term_Hook); -- #1A NAME="AFU_52"#2| - function Get_Item_Init_Hook (Men : Menu) return Menu_Hook_Function; + function Get_Item_Init_Hook (Men : Menu) return Menu_Hook_Function; -- AKA: item_init() - pragma Inline (Get_Item_Init_Hook); + pragma Inline (Get_Item_Init_Hook); -- #1A NAME="AFU_53"#2| - function Get_Item_Term_Hook (Men : Menu) return Menu_Hook_Function; + function Get_Item_Term_Hook (Men : Menu) return Menu_Hook_Function; -- AKA: item_term() - pragma Inline (Get_Item_Term_Hook); + pragma Inline (Get_Item_Term_Hook); -- #1A NAME="AFU_54"#2| - function Get_Menu_Init_Hook (Men : Menu) return Menu_Hook_Function; + function Get_Menu_Init_Hook (Men : Menu) return Menu_Hook_Function; -- AKA: menu_init() - pragma Inline (Get_Menu_Init_Hook); + pragma Inline (Get_Menu_Init_Hook); -- #1A NAME="AFU_55"#2| - function Get_Menu_Term_Hook (Men : Menu) return Menu_Hook_Function; + function Get_Menu_Term_Hook (Men : Menu) return Menu_Hook_Function; -- AKA: menu_term() - pragma Inline (Get_Menu_Term_Hook); + pragma Inline (Get_Menu_Term_Hook); -- |===================================================================== -- | Man page menu_items.3x -- |===================================================================== -- #1A NAME="AFU_56"#2| - procedure Redefine (Men : Menu; - Items : Item_Array_Access); + procedure Redefine (Men : Menu; + Items : Item_Array_Access); -- AKA: set_menu_items() - pragma Inline (Redefine); + pragma Inline (Redefine); - procedure Set_Items (Men : Menu; - Items : Item_Array_Access) renames Redefine; + procedure Set_Items (Men : Menu; + Items : Item_Array_Access) renames Redefine; -- pragma Inline (Set_Items); -- #1A NAME="AFU_57"#2| - function Items (Men : Menu; - Index : Positive) return Item; + function Items (Men : Menu; + Index : Positive) return Item; -- AKA: menu_items() - pragma Inline (Items); + pragma Inline (Items); -- #1A NAME="AFU_58"#2| - function Item_Count (Men : Menu) return Natural; + function Item_Count (Men : Menu) return Natural; -- AKA: item_count() - pragma Inline (Item_Count); + pragma Inline (Item_Count); -- |===================================================================== -- | Man page menu_new.3x -- |===================================================================== -- #1A NAME="AFU_59"#2| - function Create (Items : Item_Array_Access) return Menu; + function Create (Items : Item_Array_Access) return Menu; -- AKA: new_menu() -- Not inlined - function New_Menu (Items : Item_Array_Access) return Menu renames Create; + function New_Menu (Items : Item_Array_Access) return Menu renames Create; -- #1A NAME="AFU_60"#2| - procedure Delete (Men : in out Menu); + procedure Delete (Men : in out Menu); -- AKA: free_menu() -- Reset Men to Null_Menu -- Not inlined @@ -670,14 +666,14 @@ -- | Man page menu_driver.3x -- |===================================================================== - type Driver_Result is (Menu_Ok, - Request_Denied, - Unknown_Request, - No_Match); + type Driver_Result is (Menu_Ok, + Request_Denied, + Unknown_Request, + No_Match); -- #1A NAME="AFU_61"#2| - function Driver (Men : Menu; - Key : Key_Code) return Driver_Result; + function Driver (Men : Menu; + Key : Key_Code) return Driver_Result; -- AKA: menu_driver() -- Driver is not inlined @@ -685,11 +681,11 @@ -- Not Implemented: menu_request_name, menu_request_by_name ------------------------------------------------------------------------------- private - type Item is new System.Storage_Elements.Integer_Address; - type Menu is new System.Storage_Elements.Integer_Address; + type Item is new System.Storage_Elements.Integer_Address; + type Menu is new System.Storage_Elements.Integer_Address; - Null_Item : constant Item := 0; - Null_Menu : constant Menu := 0; + Null_Item : constant Item := 0; + Null_Menu : constant Menu := 0; -end Terminal_Interface.Curses.Menus; +end Terminal_Interface.Curses.Menus; diff --git a/doc/html/ada/terminal_interface-curses-mouse__adb.htm b/doc/html/ada/terminal_interface-curses-mouse__adb.htm index 8119f8ca..1e43f099 100644 --- a/doc/html/ada/terminal_interface-curses-mouse__adb.htm +++ b/doc/html/ada/terminal_interface-curses-mouse__adb.htm @@ -56,117 +56,117 @@ -- @Date: 2009/12/26 17:38:58 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ -with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; +with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; with Interfaces.C; use Interfaces.C; use Interfaces; -package body Terminal_Interface.Curses.Mouse is +package body Terminal_Interface.Curses.Mouse is use type System.Bit_Order; - function Has_Mouse return Boolean + function Has_Mouse return Boolean is - function Mouse_Avail return C_Int; + function Mouse_Avail return C_Int; pragma Import (C, Mouse_Avail, "has_mouse"); begin - if Has_Key (Key_Mouse) or else Mouse_Avail /= 0 then + if Has_Key (Key_Mouse) or else Mouse_Avail /= 0 then return True; else return False; end if; - end Has_Mouse; + end Has_Mouse; - function Get_Mouse return Mouse_Event + function Get_Mouse return Mouse_Event is - type Event_Access is access all Mouse_Event; + type Event_Access is access all Mouse_Event; - function Getmouse (Ev : Event_Access) return C_Int; + function Getmouse (Ev : Event_Access) return C_Int; pragma Import (C, Getmouse, "getmouse"); - Event : aliased Mouse_Event; + Event : aliased Mouse_Event; begin - if Getmouse (Event'Access) = Curses_Err then - raise Curses_Exception; + if Getmouse (Event'Access) = Curses_Err then + raise Curses_Exception; end if; return Event; - end Get_Mouse; + end Get_Mouse; - procedure Register_Reportable_Event (Button : Mouse_Button; - State : Button_State; - Mask : in out Event_Mask) + procedure Register_Reportable_Event (Button : Mouse_Button; + State : Button_State; + Mask : in out Event_Mask) is - Button_Nr : constant Natural := Mouse_Button'Pos (Button); - State_Nr : constant Natural := Button_State'Pos (State); + Button_Nr : constant Natural := Mouse_Button'Pos (Button); + State_Nr : constant Natural := Button_State'Pos (State); begin - if Button in Modifier_Keys and then State /= Pressed then - raise Curses_Exception; + if Button in Modifier_Keys and then State /= Pressed then + raise Curses_Exception; else - if Button in Real_Buttons then - Mask := Mask or ((2 ** (6 * Button_Nr)) ** State_Nr); + if Button in Real_Buttons then + Mask := Mask or ((2 ** (6 * Button_Nr)) ** State_Nr); else - Mask := Mask or (BUTTON_CTRL ** (Button_Nr - 4)); + Mask := Mask or (BUTTON_CTRL ** (Button_Nr - 4)); end if; end if; - end Register_Reportable_Event; + end Register_Reportable_Event; - procedure Register_Reportable_Events (Button : Mouse_Button; - State : Button_States; - Mask : in out Event_Mask) + procedure Register_Reportable_Events (Button : Mouse_Button; + State : Button_States; + Mask : in out Event_Mask) is begin for S in Button_States'Range loop - if State (S) then - Register_Reportable_Event (Button, S, Mask); + if State (S) then + Register_Reportable_Event (Button, S, Mask); end if; end loop; - end Register_Reportable_Events; + end Register_Reportable_Events; - function Start_Mouse (Mask : Event_Mask := All_Events) - return Event_Mask + function Start_Mouse (Mask : Event_Mask := All_Events) + return Event_Mask is - function MMask (M : Event_Mask; - O : access Event_Mask) return Event_Mask; + function MMask (M : Event_Mask; + O : access Event_Mask) return Event_Mask; pragma Import (C, MMask, "mousemask"); - R : Event_Mask; - Old : aliased Event_Mask; + R : Event_Mask; + Old : aliased Event_Mask; begin - R := MMask (Mask, Old'Access); - if R = No_Events then - Beep; + R := MMask (Mask, Old'Access); + if R = No_Events then + Beep; end if; return Old; - end Start_Mouse; + end Start_Mouse; - procedure End_Mouse (Mask : Event_Mask := No_Events) + procedure End_Mouse (Mask : Event_Mask := No_Events) is begin - if Mask /= No_Events then - Beep; + if Mask /= No_Events then + Beep; end if; - end End_Mouse; + end End_Mouse; - procedure Dispatch_Event (Mask : Event_Mask; - Button : out Mouse_Button; - State : out Button_State); + procedure Dispatch_Event (Mask : Event_Mask; + Button : out Mouse_Button; + State : out Button_State); - procedure Dispatch_Event (Mask : Event_Mask; - Button : out Mouse_Button; - State : out Button_State) is - L : Event_Mask; + procedure Dispatch_Event (Mask : Event_Mask; + Button : out Mouse_Button; + State : out Button_State) is + L : Event_Mask; begin - Button := Alt; -- preset to non real button; - if (Mask and BUTTON1_EVENTS) /= 0 then - Button := Left; - elsif (Mask and BUTTON2_EVENTS) /= 0 then - Button := Middle; - elsif (Mask and BUTTON3_EVENTS) /= 0 then - Button := Right; - elsif (Mask and BUTTON4_EVENTS) /= 0 then - Button := Button4; + Button := Alt; -- preset to non real button; + if (Mask and BUTTON1_EVENTS) /= 0 then + Button := Left; + elsif (Mask and BUTTON2_EVENTS) /= 0 then + Button := Middle; + elsif (Mask and BUTTON3_EVENTS) /= 0 then + Button := Right; + elsif (Mask and BUTTON4_EVENTS) /= 0 then + Button := Button4; end if; - if Button in Real_Buttons then - L := 2 ** (6 * Mouse_Button'Pos (Button)); - for I in Button_State'Range loop + if Button in Real_Buttons then + L := 2 ** (6 * Mouse_Button'Pos (Button)); + for I in Button_State'Range loop if (Mask and L) /= 0 then State := I; exit; @@ -174,62 +174,62 @@ L := 2 * L; end loop; else - State := Pressed; - if (Mask and BUTTON_CTRL) /= 0 then - Button := Control; - elsif (Mask and BUTTON_SHIFT) /= 0 then - Button := Shift; - elsif (Mask and BUTTON_ALT) /= 0 then - Button := Alt; + State := Pressed; + if (Mask and BUTTON_CTRL) /= 0 then + Button := Control; + elsif (Mask and BUTTON_SHIFT) /= 0 then + Button := Shift; + elsif (Mask and BUTTON_ALT) /= 0 then + Button := Alt; end if; end if; end Dispatch_Event; - procedure Get_Event (Event : Mouse_Event; - Y : out Line_Position; - X : out Column_Position; - Button : out Mouse_Button; - State : out Button_State) + procedure Get_Event (Event : Mouse_Event; + Y : out Line_Position; + X : out Column_Position; + Button : out Mouse_Button; + State : out Button_State) is - Mask : constant Event_Mask := Event.Bstate; + Mask : constant Event_Mask := Event.Bstate; begin - X := Column_Position (Event.X); - Y := Line_Position (Event.Y); - Dispatch_Event (Mask, Button, State); - end Get_Event; + X := Column_Position (Event.X); + Y := Line_Position (Event.Y); + Dispatch_Event (Mask, Button, State); + end Get_Event; - procedure Unget_Mouse (Event : Mouse_Event) + procedure Unget_Mouse (Event : Mouse_Event) is - function Ungetmouse (Ev : Mouse_Event) return C_Int; + function Ungetmouse (Ev : Mouse_Event) return C_Int; pragma Import (C, Ungetmouse, "ungetmouse"); begin - if Ungetmouse (Event) = Curses_Err then - raise Curses_Exception; + if Ungetmouse (Event) = Curses_Err then + raise Curses_Exception; end if; - end Unget_Mouse; + end Unget_Mouse; - function Enclosed_In_Window (Win : Window := Standard_Window; - Event : Mouse_Event) return Boolean + function Enclosed_In_Window (Win : Window := Standard_Window; + Event : Mouse_Event) return Boolean is - function Wenclose (Win : Window; Y : C_Int; X : C_Int) - return Curses_Bool; + function Wenclose (Win : Window; Y : C_Int; X : C_Int) + return Curses_Bool; pragma Import (C, Wenclose, "wenclose"); begin - if Wenclose (Win, C_Int (Event.Y), C_Int (Event.X)) - = Curses_Bool_False then + if Wenclose (Win, C_Int (Event.Y), C_Int (Event.X)) + = Curses_Bool_False then return False; else return True; end if; - end Enclosed_In_Window; + end Enclosed_In_Window; - function Mouse_Interval (Msec : Natural := 200) return Natural + function Mouse_Interval (Msec : Natural := 200) return Natural is - function Mouseinterval (Msec : C_Int) return C_Int; + function Mouseinterval (Msec : C_Int) return C_Int; pragma Import (C, Mouseinterval, "mouseinterval"); begin - return Natural (Mouseinterval (C_Int (Msec))); - end Mouse_Interval; + return Natural (Mouseinterval (C_Int (Msec))); + end Mouse_Interval; -end Terminal_Interface.Curses.Mouse; +end Terminal_Interface.Curses.Mouse; diff --git a/doc/html/ada/terminal_interface-curses-mouse__ads.htm b/doc/html/ada/terminal_interface-curses-mouse__ads.htm index 4b3a071e..759d9482 100644 --- a/doc/html/ada/terminal_interface-curses-mouse__ads.htm +++ b/doc/html/ada/terminal_interface-curses-mouse__ads.htm @@ -24,7 +24,7 @@ -- S P E C -- -- -- ------------------------------------------------------------------------------ --- Copyright (c) 1998-2009,2011 Free Software Foundation, Inc. -- +-- Copyright (c) 1998-2011,2014 Free Software Foundation, Inc. -- -- -- -- Permission is hereby granted, free of charge, to any person obtaining a -- -- copy of this software and associated documentation files (the -- @@ -52,18 +52,14 @@ ------------------------------------------------------------------------------ -- Author: Juergen Pfeifer, 1996 -- Version Control: --- @Revision: 1.29 @ --- @Date: 2011/03/19 12:35:58 @ +-- @Revision: 1.31 @ +-- @Date: 2014/05/24 21:31:57 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ --- mouse binding. --- This module is generated. Please don't change it manually! --- Run the generator instead. --- | with System; -package Terminal_Interface.Curses.Mouse is - pragma Preelaborate (Terminal_Interface.Curses.Mouse); +package Terminal_Interface.Curses.Mouse is + pragma Preelaborate (Terminal_Interface.Curses.Mouse); -- |===================================================================== -- | Man page curs_mouse.3x @@ -74,56 +70,56 @@ -- Not implemented: -- REPORT_MOUSE_POSITION (i.e. as a parameter to Register_Reportable_Event -- or Start_Mouse) - type Event_Mask is private; - No_Events : constant Event_Mask; - All_Events : constant Event_Mask; - - type Mouse_Button is (Left, -- aka: Button 1 - Middle, -- aka: Button 2 - Right, -- aka: Button 3 - Button4, -- aka: Button 4 - Control, -- Control Key - Shift, -- Shift Key - Alt); -- ALT Key - - subtype Real_Buttons is Mouse_Button range Left .. Button4; - subtype Modifier_Keys is Mouse_Button range Control .. Alt; - - type Button_State is (Released, - Pressed, - Clicked, - Double_Clicked, - Triple_Clicked); - - type Button_States is array (Button_State) of Boolean; + type Event_Mask is private; + No_Events : constant Event_Mask; + All_Events : constant Event_Mask; + + type Mouse_Button is (Left, -- aka: Button 1 + Middle, -- aka: Button 2 + Right, -- aka: Button 3 + Button4, -- aka: Button 4 + Control, -- Control Key + Shift, -- Shift Key + Alt); -- ALT Key + + subtype Real_Buttons is Mouse_Button range Left .. Button4; + subtype Modifier_Keys is Mouse_Button range Control .. Alt; + + type Button_State is (Released, + Pressed, + Clicked, + Double_Clicked, + Triple_Clicked); + + type Button_States is array (Button_State) of Boolean; pragma Pack (Button_States); - All_Clicks : constant Button_States := (Clicked .. Triple_Clicked => True, + All_Clicks : constant Button_States := (Clicked .. Triple_Clicked => True, others => False); - All_States : constant Button_States := (others => True); + All_States : constant Button_States := (others => True); - type Mouse_Event is private; + type Mouse_Event is private; -- |===================================================================== -- | Man page curs_mouse.3x -- |===================================================================== - function Has_Mouse return Boolean; + function Has_Mouse return Boolean; -- Return true if a mouse device is supported, false otherwise. - procedure Register_Reportable_Event - (Button : Mouse_Button; - State : Button_State; - Mask : in out Event_Mask); + procedure Register_Reportable_Event + (Button : Mouse_Button; + State : Button_State; + Mask : in out Event_Mask); -- Stores the event described by the button and the state in the mask. -- Before you call this the first time, you should initialize the mask -- with the Empty_Mask constant - pragma Inline (Register_Reportable_Event); + pragma Inline (Register_Reportable_Event); - procedure Register_Reportable_Events - (Button : Mouse_Button; - State : Button_States; - Mask : in out Event_Mask); + procedure Register_Reportable_Events + (Button : Mouse_Button; + State : Button_States; + Mask : in out Event_Mask); -- Register all events described by the Button and the State bitmap. -- Before you call this the first time, you should initialize the mask -- with the Empty_Mask constant @@ -133,111 +129,91 @@ -- old mask, that means the event mask value before this call. -- Not Implemented: The library version -- returns a Mouse_Mask that tells which events are reported. - function Start_Mouse (Mask : Event_Mask := All_Events) - return Event_Mask; + function Start_Mouse (Mask : Event_Mask := All_Events) + return Event_Mask; -- AKA: mousemask() - pragma Inline (Start_Mouse); + pragma Inline (Start_Mouse); - procedure End_Mouse (Mask : Event_Mask := No_Events); + procedure End_Mouse (Mask : Event_Mask := No_Events); -- Terminates the mouse, restores the specified event mask - pragma Inline (End_Mouse); + pragma Inline (End_Mouse); -- #1A NAME="AFU_2"#2| - function Get_Mouse return Mouse_Event; + function Get_Mouse return Mouse_Event; -- AKA: getmouse() - pragma Inline (Get_Mouse); + pragma Inline (Get_Mouse); - procedure Get_Event (Event : Mouse_Event; - Y : out Line_Position; - X : out Column_Position; - Button : out Mouse_Button; - State : out Button_State); + procedure Get_Event (Event : Mouse_Event; + Y : out Line_Position; + X : out Column_Position; + Button : out Mouse_Button; + State : out Button_State); -- !!! Warning: X and Y are screen coordinates. Due to ripped of lines they -- may not be identical to window coordinates. -- Not Implemented: Get_Event only reports one event, the C library -- version supports multiple events, e.g. {click-1, click-3} - pragma Inline (Get_Event); + pragma Inline (Get_Event); -- #1A NAME="AFU_3"#2| - procedure Unget_Mouse (Event : Mouse_Event); + procedure Unget_Mouse (Event : Mouse_Event); -- AKA: ungetmouse() - pragma Inline (Unget_Mouse); + pragma Inline (Unget_Mouse); -- #1A NAME="AFU_4"#2| - function Enclosed_In_Window (Win : Window := Standard_Window; - Event : Mouse_Event) return Boolean; + function Enclosed_In_Window (Win : Window := Standard_Window; + Event : Mouse_Event) return Boolean; -- AKA: wenclose() -- But : use event instead of screen coordinates. - pragma Inline (Enclosed_In_Window); + pragma Inline (Enclosed_In_Window); -- #1A NAME="AFU_5"#2| - function Mouse_Interval (Msec : Natural := 200) return Natural; + function Mouse_Interval (Msec : Natural := 200) return Natural; -- AKA: mouseinterval() - pragma Inline (Mouse_Interval); + pragma Inline (Mouse_Interval); private - type Event_Mask is new Interfaces.C.unsigned_long; + type Event_Mask is new Interfaces.C.unsigned_long; - type Mouse_Event is + type Mouse_Event is record - Id : Integer range Integer (Interfaces.C.short'First) .. + Id : Integer range Integer (Interfaces.C.short'First) .. Integer (Interfaces.C.short'Last); - X, Y, Z : Integer range Integer (Interfaces.C.int'First) .. + X, Y, Z : Integer range Integer (Interfaces.C.int'First) .. Integer (Interfaces.C.int'Last); - Bstate : Event_Mask; + Bstate : Event_Mask; end record; - pragma Convention (C, Mouse_Event); + pragma Convention (C, Mouse_Event); - for Mouse_Event use + for Mouse_Event use record - Id at 0 range 0 .. 15; - X at 0 range 32 .. 63; - Y at 0 range 64 .. 95; - Z at 0 range 96 .. 127; - Bstate at 0 range 128 .. 191; + Id at 0 range Curses_Constants.MEVENT_id_First + .. Curses_Constants.MEVENT_id_Last; + X at 0 range Curses_Constants.MEVENT_x_First + .. Curses_Constants.MEVENT_x_Last; + Y at 0 range Curses_Constants.MEVENT_y_First + .. Curses_Constants.MEVENT_y_Last; + Z at 0 range Curses_Constants.MEVENT_z_First + .. Curses_Constants.MEVENT_z_Last; + Bstate at 0 range Curses_Constants.MEVENT_bstate_First + .. Curses_Constants.MEVENT_bstate_Last; end record; - -- Please note: this rep. clause is generated and may be - -- different on your system. - - Generation_Bit_Order : constant System.Bit_Order := System.Low_Order_First; - -- This constant may be different on your system. - - BUTTON1_RELEASED : constant Event_Mask := 8#00000000001#; - BUTTON1_PRESSED : constant Event_Mask := 8#00000000002#; - BUTTON1_CLICKED : constant Event_Mask := 8#00000000004#; - BUTTON1_DOUBLE_CLICKED : constant Event_Mask := 8#00000000010#; - BUTTON1_TRIPLE_CLICKED : constant Event_Mask := 8#00000000020#; - BUTTON1_RESERVED_EVENT : constant Event_Mask := 8#00000000040#; - BUTTON2_RELEASED : constant Event_Mask := 8#00000000100#; - BUTTON2_PRESSED : constant Event_Mask := 8#00000000200#; - BUTTON2_CLICKED : constant Event_Mask := 8#00000000400#; - BUTTON2_DOUBLE_CLICKED : constant Event_Mask := 8#00000001000#; - BUTTON2_TRIPLE_CLICKED : constant Event_Mask := 8#00000002000#; - BUTTON2_RESERVED_EVENT : constant Event_Mask := 8#00000004000#; - BUTTON3_RELEASED : constant Event_Mask := 8#00000010000#; - BUTTON3_PRESSED : constant Event_Mask := 8#00000020000#; - BUTTON3_CLICKED : constant Event_Mask := 8#00000040000#; - BUTTON3_DOUBLE_CLICKED : constant Event_Mask := 8#00000100000#; - BUTTON3_TRIPLE_CLICKED : constant Event_Mask := 8#00000200000#; - BUTTON3_RESERVED_EVENT : constant Event_Mask := 8#00000400000#; - BUTTON4_RELEASED : constant Event_Mask := 8#00001000000#; - BUTTON4_PRESSED : constant Event_Mask := 8#00002000000#; - BUTTON4_CLICKED : constant Event_Mask := 8#00004000000#; - BUTTON4_DOUBLE_CLICKED : constant Event_Mask := 8#00010000000#; - BUTTON4_TRIPLE_CLICKED : constant Event_Mask := 8#00020000000#; - BUTTON4_RESERVED_EVENT : constant Event_Mask := 8#00040000000#; - BUTTON_CTRL : constant Event_Mask := 8#00100000000#; - BUTTON_SHIFT : constant Event_Mask := 8#00200000000#; - BUTTON_ALT : constant Event_Mask := 8#00400000000#; - REPORT_MOUSE_POSITION : constant Event_Mask := 8#01000000000#; - ALL_MOUSE_EVENTS : constant Event_Mask := 8#00777777777#; - BUTTON1_EVENTS : constant Event_Mask := 8#00000000077#; - BUTTON2_EVENTS : constant Event_Mask := 8#00000007700#; - BUTTON3_EVENTS : constant Event_Mask := 8#00000770000#; - BUTTON4_EVENTS : constant Event_Mask := 8#00077000000#; - - No_Events : constant Event_Mask := 0; - All_Events : constant Event_Mask := ALL_MOUSE_EVENTS; - -end Terminal_Interface.Curses.Mouse; + for Mouse_Event'Size use Curses_Constants.MEVENT_Size; + Generation_Bit_Order : System.Bit_Order renames Curses_Constants.Bit_Order; + + BUTTON_CTRL : constant Event_Mask := Curses_Constants.BUTTON_CTRL; + BUTTON_SHIFT : constant Event_Mask := Curses_Constants.BUTTON_SHIFT; + BUTTON_ALT : constant Event_Mask := Curses_Constants.BUTTON_ALT; + BUTTON1_EVENTS : constant Event_Mask + := Curses_Constants.all_events_button_1; + BUTTON2_EVENTS : constant Event_Mask + := Curses_Constants.all_events_button_2; + BUTTON3_EVENTS : constant Event_Mask + := Curses_Constants.all_events_button_3; + BUTTON4_EVENTS : constant Event_Mask + := Curses_Constants.all_events_button_4; + ALL_MOUSE_EVENTS : constant Event_Mask := Curses_Constants.ALL_MOUSE_EVENTS; + No_Events : constant Event_Mask := 0; + All_Events : constant Event_Mask := ALL_MOUSE_EVENTS; + +end Terminal_Interface.Curses.Mouse; diff --git a/doc/html/ada/terminal_interface-curses-panels-user_data__adb.htm b/doc/html/ada/terminal_interface-curses-panels-user_data__adb.htm index 91c5a0b9..899364f9 100644 --- a/doc/html/ada/terminal_interface-curses-panels-user_data__adb.htm +++ b/doc/html/ada/terminal_interface-curses-panels-user_data__adb.htm @@ -56,41 +56,41 @@ -- Binding Version 01.00 ------------------------------------------------------------------------------ with Interfaces.C; -with Terminal_Interface.Curses.Aux; -use Terminal_Interface.Curses.Aux; -with Terminal_Interface.Curses.Panels; -use Terminal_Interface.Curses.Panels; +with Terminal_Interface.Curses.Aux; +use Terminal_Interface.Curses.Aux; +with Terminal_Interface.Curses.Panels; +use Terminal_Interface.Curses.Panels; -package body Terminal_Interface.Curses.Panels.User_Data is +package body Terminal_Interface.Curses.Panels.User_Data is use type Interfaces.C.int; - procedure Set_User_Data (Pan : Panel; + procedure Set_User_Data (Pan : Panel; Data : User_Access) is - function Set_Panel_Userptr (Pan : Panel; - Addr : User_Access) return C_Int; + function Set_Panel_Userptr (Pan : Panel; + Addr : User_Access) return C_Int; pragma Import (C, Set_Panel_Userptr, "set_panel_userptr"); begin - if Set_Panel_Userptr (Pan, Data) = Curses_Err then - raise Panel_Exception; + if Set_Panel_Userptr (Pan, Data) = Curses_Err then + raise Panel_Exception; end if; end Set_User_Data; - function Get_User_Data (Pan : Panel) return User_Access + function Get_User_Data (Pan : Panel) return User_Access is - function Panel_Userptr (Pan : Panel) return User_Access; + function Panel_Userptr (Pan : Panel) return User_Access; pragma Import (C, Panel_Userptr, "panel_userptr"); begin return Panel_Userptr (Pan); end Get_User_Data; - procedure Get_User_Data (Pan : Panel; + procedure Get_User_Data (Pan : Panel; Data : out User_Access) is begin Data := Get_User_Data (Pan); end Get_User_Data; -end Terminal_Interface.Curses.Panels.User_Data; +end Terminal_Interface.Curses.Panels.User_Data; diff --git a/doc/html/ada/terminal_interface-curses-panels-user_data__ads.htm b/doc/html/ada/terminal_interface-curses-panels-user_data__ads.htm index dc2eba0a..dacd2285 100644 --- a/doc/html/ada/terminal_interface-curses-panels-user_data__ads.htm +++ b/doc/html/ada/terminal_interface-curses-panels-user_data__ads.htm @@ -59,29 +59,29 @@ generic type User is limited private; type User_Access is access all User; -package Terminal_Interface.Curses.Panels.User_Data is - pragma Preelaborate (Terminal_Interface.Curses.Panels.User_Data); +package Terminal_Interface.Curses.Panels.User_Data is + pragma Preelaborate (Terminal_Interface.Curses.Panels.User_Data); -- |===================================================================== -- | Man page panel.3x -- |===================================================================== -- #1A NAME="AFU_1"#2| - procedure Set_User_Data (Pan : Panel; + procedure Set_User_Data (Pan : Panel; Data : User_Access); -- AKA: set_panel_userptr pragma Inline (Set_User_Data); -- #1A NAME="AFU_2"#2| - procedure Get_User_Data (Pan : Panel; + procedure Get_User_Data (Pan : Panel; Data : out User_Access); -- AKA: panel_userptr -- #1A NAME="AFU_3"#2| - function Get_User_Data (Pan : Panel) return User_Access; + function Get_User_Data (Pan : Panel) return User_Access; -- AKA: panel_userptr -- Same as function pragma Inline (Get_User_Data); -end Terminal_Interface.Curses.Panels.User_Data; +end Terminal_Interface.Curses.Panels.User_Data; diff --git a/doc/html/ada/terminal_interface-curses-panels__adb.htm b/doc/html/ada/terminal_interface-curses-panels__adb.htm index 819ad63b..33204636 100644 --- a/doc/html/ada/terminal_interface-curses-panels__adb.htm +++ b/doc/html/ada/terminal_interface-curses-panels__adb.htm @@ -56,128 +56,128 @@ -- @Date: 2009/12/26 17:38:58 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ -with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; +with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; with Interfaces.C; -package body Terminal_Interface.Curses.Panels is +package body Terminal_Interface.Curses.Panels is use type Interfaces.C.int; - function Create (Win : Window) return Panel + function Create (Win : Window) return Panel is - function Newpanel (Win : Window) return Panel; + function Newpanel (Win : Window) return Panel; pragma Import (C, Newpanel, "new_panel"); - Pan : Panel; + Pan : Panel; begin - Pan := Newpanel (Win); - if Pan = Null_Panel then - raise Panel_Exception; + Pan := Newpanel (Win); + if Pan = Null_Panel then + raise Panel_Exception; end if; return Pan; - end Create; + end Create; - procedure Bottom (Pan : Panel) + procedure Bottom (Pan : Panel) is - function Bottompanel (Pan : Panel) return C_Int; + function Bottompanel (Pan : Panel) return C_Int; pragma Import (C, Bottompanel, "bottom_panel"); begin - if Bottompanel (Pan) = Curses_Err then - raise Panel_Exception; + if Bottompanel (Pan) = Curses_Err then + raise Panel_Exception; end if; - end Bottom; + end Bottom; - procedure Top (Pan : Panel) + procedure Top (Pan : Panel) is - function Toppanel (Pan : Panel) return C_Int; + function Toppanel (Pan : Panel) return C_Int; pragma Import (C, Toppanel, "top_panel"); begin - if Toppanel (Pan) = Curses_Err then - raise Panel_Exception; + if Toppanel (Pan) = Curses_Err then + raise Panel_Exception; end if; - end Top; + end Top; - procedure Show (Pan : Panel) + procedure Show (Pan : Panel) is - function Showpanel (Pan : Panel) return C_Int; + function Showpanel (Pan : Panel) return C_Int; pragma Import (C, Showpanel, "show_panel"); begin - if Showpanel (Pan) = Curses_Err then - raise Panel_Exception; + if Showpanel (Pan) = Curses_Err then + raise Panel_Exception; end if; - end Show; + end Show; - procedure Hide (Pan : Panel) + procedure Hide (Pan : Panel) is - function Hidepanel (Pan : Panel) return C_Int; + function Hidepanel (Pan : Panel) return C_Int; pragma Import (C, Hidepanel, "hide_panel"); begin - if Hidepanel (Pan) = Curses_Err then - raise Panel_Exception; + if Hidepanel (Pan) = Curses_Err then + raise Panel_Exception; end if; - end Hide; + end Hide; - function Get_Window (Pan : Panel) return Window + function Get_Window (Pan : Panel) return Window is - function Panel_Win (Pan : Panel) return Window; + function Panel_Win (Pan : Panel) return Window; pragma Import (C, Panel_Win, "panel_window"); - Win : constant Window := Panel_Win (Pan); + Win : constant Window := Panel_Win (Pan); begin - if Win = Null_Window then - raise Panel_Exception; + if Win = Null_Window then + raise Panel_Exception; end if; return Win; - end Get_Window; + end Get_Window; - procedure Replace (Pan : Panel; - Win : Window) + procedure Replace (Pan : Panel; + Win : Window) is - function Replace_Pan (Pan : Panel; - Win : Window) return C_Int; + function Replace_Pan (Pan : Panel; + Win : Window) return C_Int; pragma Import (C, Replace_Pan, "replace_panel"); begin - if Replace_Pan (Pan, Win) = Curses_Err then - raise Panel_Exception; + if Replace_Pan (Pan, Win) = Curses_Err then + raise Panel_Exception; end if; - end Replace; + end Replace; - procedure Move (Pan : Panel; - Line : Line_Position; - Column : Column_Position) + procedure Move (Pan : Panel; + Line : Line_Position; + Column : Column_Position) is - function Move (Pan : Panel; - Line : C_Int; - Column : C_Int) return C_Int; + function Move (Pan : Panel; + Line : C_Int; + Column : C_Int) return C_Int; pragma Import (C, Move, "move_panel"); begin - if Move (Pan, C_Int (Line), C_Int (Column)) = Curses_Err then - raise Panel_Exception; + if Move (Pan, C_Int (Line), C_Int (Column)) = Curses_Err then + raise Panel_Exception; end if; - end Move; + end Move; - function Is_Hidden (Pan : Panel) return Boolean + function Is_Hidden (Pan : Panel) return Boolean is - function Panel_Hidden (Pan : Panel) return C_Int; + function Panel_Hidden (Pan : Panel) return C_Int; pragma Import (C, Panel_Hidden, "panel_hidden"); begin - if Panel_Hidden (Pan) = Curses_False then + if Panel_Hidden (Pan) = Curses_False then return False; else return True; end if; - end Is_Hidden; + end Is_Hidden; - procedure Delete (Pan : in out Panel) + procedure Delete (Pan : in out Panel) is - function Del_Panel (Pan : Panel) return C_Int; + function Del_Panel (Pan : Panel) return C_Int; pragma Import (C, Del_Panel, "del_panel"); begin - if Del_Panel (Pan) = Curses_Err then - raise Panel_Exception; + if Del_Panel (Pan) = Curses_Err then + raise Panel_Exception; end if; - Pan := Null_Panel; - end Delete; + Pan := Null_Panel; + end Delete; -end Terminal_Interface.Curses.Panels; +end Terminal_Interface.Curses.Panels; diff --git a/doc/html/ada/terminal_interface-curses-panels__ads.htm b/doc/html/ada/terminal_interface-curses-panels__ads.htm index 75864f70..843c3ce1 100644 --- a/doc/html/ada/terminal_interface-curses-panels__ads.htm +++ b/doc/html/ada/terminal_interface-curses-panels__ads.htm @@ -24,7 +24,7 @@ -- S P E C -- -- -- ------------------------------------------------------------------------------ --- Copyright (c) 1998-2006,2009 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 -- @@ -52,114 +52,113 @@ ------------------------------------------------------------------------------ -- Author: Juergen Pfeifer, 1996 -- Version Control: --- @Revision: 1.20 @ --- @Date: 2009/12/26 17:38:58 @ +-- @Revision: 1.22 @ +-- @Date: 2014/05/24 21:31:57 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ with System; -package Terminal_Interface.Curses.Panels is - pragma Preelaborate (Terminal_Interface.Curses.Panels); - pragma Linker_Options ("-lpanel"); - pragma Linker_Options ("-lncurses"); +package Terminal_Interface.Curses.Panels is + pragma Preelaborate (Terminal_Interface.Curses.Panels); + pragma Linker_Options ("-lpanel" & Curses_Constants.DFT_ARG_SUFFIX); - type Panel is private; + type Panel is private; --------------------------- -- Interface constants -- --------------------------- - Null_Panel : constant Panel; + Null_Panel : constant Panel; ------------------- -- Exceptions -- ------------------- - Panel_Exception : exception; + Panel_Exception : exception; -- |===================================================================== -- | Man page panel.3x -- |===================================================================== -- #1A NAME="AFU_1"#2| - function Create (Win : Window) return Panel; + function Create (Win : Window) return Panel; -- AKA: new_panel() pragma Inline (Create); -- #1A NAME="AFU_2"#2| - function New_Panel (Win : Window) return Panel renames Create; + function New_Panel (Win : Window) return Panel renames Create; -- AKA: new_panel() -- pragma Inline (New_Panel); -- #1A NAME="AFU_3"#2| - procedure Bottom (Pan : Panel); + procedure Bottom (Pan : Panel); -- AKA: bottom_panel() - pragma Inline (Bottom); + pragma Inline (Bottom); -- #1A NAME="AFU_4"#2| - procedure Top (Pan : Panel); + procedure Top (Pan : Panel); -- AKA: top_panel() - pragma Inline (Top); + pragma Inline (Top); -- #1A NAME="AFU_5"#2| - procedure Show (Pan : Panel); + procedure Show (Pan : Panel); -- AKA: show_panel() - pragma Inline (Show); + pragma Inline (Show); -- #1A NAME="AFU_6"#2| - procedure Update_Panels; + procedure Update_Panels; -- AKA: update_panels() pragma Import (C, Update_Panels, "update_panels"); -- #1A NAME="AFU_7"#2| - procedure Hide (Pan : Panel); + procedure Hide (Pan : Panel); -- AKA: hide_panel() - pragma Inline (Hide); + pragma Inline (Hide); -- #1A NAME="AFU_8"#2| - function Get_Window (Pan : Panel) return Window; + function Get_Window (Pan : Panel) return Window; -- AKA: panel_window() - pragma Inline (Get_Window); + pragma Inline (Get_Window); -- #1A NAME="AFU_9"#2| - function Panel_Window (Pan : Panel) return Window renames Get_Window; + function Panel_Window (Pan : Panel) return Window renames Get_Window; -- pragma Inline (Panel_Window); -- #1A NAME="AFU_10"#2| - procedure Replace (Pan : Panel; - Win : Window); + procedure Replace (Pan : Panel; + Win : Window); -- AKA: replace_panel() - pragma Inline (Replace); + pragma Inline (Replace); -- #1A NAME="AFU_11"#2| - procedure Move (Pan : Panel; - Line : Line_Position; - Column : Column_Position); + procedure Move (Pan : Panel; + Line : Line_Position; + Column : Column_Position); -- AKA: move_panel() - pragma Inline (Move); + pragma Inline (Move); -- #1A NAME="AFU_12"#2| - function Is_Hidden (Pan : Panel) return Boolean; + function Is_Hidden (Pan : Panel) return Boolean; -- AKA: panel_hidden() - pragma Inline (Is_Hidden); + pragma Inline (Is_Hidden); -- #1A NAME="AFU_13"#2| - function Above (Pan : Panel) return Panel; + function Above (Pan : Panel) return Panel; -- AKA: panel_above() pragma Import (C, Above, "panel_above"); -- #1A NAME="AFU_14"#2| - function Below (Pan : Panel) return Panel; + function Below (Pan : Panel) return Panel; -- AKA: panel_below() pragma Import (C, Below, "panel_below"); -- #1A NAME="AFU_15"#2| - procedure Delete (Pan : in out Panel); + procedure Delete (Pan : in out Panel); -- AKA: del_panel() pragma Inline (Delete); private - type Panel is new System.Storage_Elements.Integer_Address; - Null_Panel : constant Panel := 0; + type Panel is new System.Storage_Elements.Integer_Address; + Null_Panel : constant Panel := 0; -end Terminal_Interface.Curses.Panels; +end Terminal_Interface.Curses.Panels; diff --git a/doc/html/ada/terminal_interface-curses-putwin__adb.htm b/doc/html/ada/terminal_interface-curses-putwin__adb.htm index 45598f51..53f41f70 100644 --- a/doc/html/ada/terminal_interface-curses-putwin__adb.htm +++ b/doc/html/ada/terminal_interface-curses-putwin__adb.htm @@ -57,39 +57,39 @@ with Ada.Streams.Stream_IO.C_Streams; with Interfaces.C_Streams; -with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; +with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; -package body Terminal_Interface.Curses.PutWin is +package body Terminal_Interface.Curses.PutWin is package ICS renames Interfaces.C_Streams; package ACS renames Ada.Streams.Stream_IO.C_Streams; - use type C_Int; + use type C_Int; - procedure Put_Window (Win : Window; + procedure Put_Window (Win : Window; File : Ada.Streams.Stream_IO.File_Type) is - function putwin (Win : Window; f : ICS.FILEs) return C_Int; + function putwin (Win : Window; f : ICS.FILEs) return C_Int; pragma Import (C, putwin, "putwin"); - R : constant C_Int := putwin (Win, ACS.C_Stream (File)); + R : constant C_Int := putwin (Win, ACS.C_Stream (File)); begin - if R /= Curses_Ok then - raise Curses_Exception; + if R /= Curses_Ok then + raise Curses_Exception; end if; end Put_Window; function Get_Window (File : Ada.Streams.Stream_IO.File_Type) - return Window is - function getwin (f : ICS.FILEs) return Window; + return Window is + function getwin (f : ICS.FILEs) return Window; pragma Import (C, getwin, "getwin"); - W : constant Window := getwin (ACS.C_Stream (File)); + W : constant Window := getwin (ACS.C_Stream (File)); begin - if W = Null_Window then - raise Curses_Exception; + if W = Null_Window then + raise Curses_Exception; else return W; end if; end Get_Window; -end Terminal_Interface.Curses.PutWin; +end Terminal_Interface.Curses.PutWin; diff --git a/doc/html/ada/terminal_interface-curses-putwin__ads.htm b/doc/html/ada/terminal_interface-curses-putwin__ads.htm index 77fde726..73603cac 100644 --- a/doc/html/ada/terminal_interface-curses-putwin__ads.htm +++ b/doc/html/ada/terminal_interface-curses-putwin__ads.htm @@ -57,12 +57,12 @@ with Ada.Streams.Stream_IO; -package Terminal_Interface.Curses.PutWin is +package Terminal_Interface.Curses.PutWin is - procedure Put_Window (Win : Window; + procedure Put_Window (Win : Window; File : Ada.Streams.Stream_IO.File_Type); - function Get_Window (File : Ada.Streams.Stream_IO.File_Type) return Window; + function Get_Window (File : Ada.Streams.Stream_IO.File_Type) return Window; -end Terminal_Interface.Curses.PutWin; +end Terminal_Interface.Curses.PutWin; diff --git a/doc/html/ada/terminal_interface-curses-termcap__adb.htm b/doc/html/ada/terminal_interface-curses-termcap__adb.htm index 3a2ed5e8..c8c792ca 100644 --- a/doc/html/ada/terminal_interface-curses-termcap__adb.htm +++ b/doc/html/ada/terminal_interface-curses-termcap__adb.htm @@ -57,26 +57,26 @@ -- Binding Version 01.00 ------------------------------------------------------------------------------ -with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; +with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; with Interfaces.C; use Interfaces.C; with Interfaces.C.Strings; use Interfaces.C.Strings; -package body Terminal_Interface.Curses.Termcap is +package body Terminal_Interface.Curses.Termcap is function Get_Entry (Name : String) return Boolean is function tgetent (name : char_array; val : char_array) - return C_Int; + return C_Int; pragma Import (C, tgetent, "tgetent"); NameTxt : char_array (0 .. Name'Length); Length : size_t; ignored : constant char_array (0 .. 0) := (0 => nul); - result : C_Int; + result : C_Int; begin To_C (Name, NameTxt, Length); result := tgetent (char_array (ignored), NameTxt); if result = -1 then - raise Curses_Exception; + raise Curses_Exception; else return Boolean'Val (result); end if; @@ -85,7 +85,7 @@ ------------------------------------------------------------------------------ function Get_Flag (Name : String) return Boolean is - function tgetflag (id : char_array) return C_Int; + function tgetflag (id : char_array) return C_Int; pragma Import (C, tgetflag, "tgetflag"); Txt : char_array (0 .. Name'Length); Length : size_t; @@ -103,7 +103,7 @@ Value : out Integer; Result : out Boolean) is - function tgetnum (id : char_array) return C_Int; + function tgetnum (id : char_array) return C_Int; pragma Import (C, tgetnum, "tgetnum"); Txt : char_array (0 .. Name'Length); Length : size_t; @@ -136,7 +136,7 @@ if Txt2 = Null_Ptr then Result := False; else - Value := Fill_String (Txt2); + Value := Fill_String (Txt2); Result := True; end if; end Get_String; @@ -163,19 +163,19 @@ ------------------------------------------------------------------------------ function TGoto (Cap : String; - Col : Column_Position; - Row : Line_Position) return Termcap_String is + Col : Column_Position; + Row : Line_Position) return Termcap_String is function tgoto (cap : char_array; - col : C_Int; - row : C_Int) return chars_ptr; + col : C_Int; + row : C_Int) return chars_ptr; pragma Import (C, tgoto); Txt : char_array (0 .. Cap'Length); Length : size_t; begin To_C (Cap, Txt, Length); - return Termcap_String (Fill_String - (tgoto (Txt, C_Int (Col), C_Int (Row)))); + return Termcap_String (Fill_String + (tgoto (Txt, C_Int (Col), C_Int (Row)))); end TGoto; -end Terminal_Interface.Curses.Termcap; +end Terminal_Interface.Curses.Termcap; diff --git a/doc/html/ada/terminal_interface-curses-termcap__ads.htm b/doc/html/ada/terminal_interface-curses-termcap__ads.htm index e57e35a0..f8e8655a 100644 --- a/doc/html/ada/terminal_interface-curses-termcap__ads.htm +++ b/doc/html/ada/terminal_interface-curses-termcap__ads.htm @@ -56,8 +56,8 @@ -- Binding Version 01.00 ------------------------------------------------------------------------------ -package Terminal_Interface.Curses.Termcap is - pragma Preelaborate (Terminal_Interface.Curses.Termcap); +package Terminal_Interface.Curses.Termcap is + pragma Preelaborate (Terminal_Interface.Curses.Termcap); -- |===================================================================== -- | Man page curs_termcap.3x @@ -68,8 +68,8 @@ -- | function TGoto (Cap : String; - Col : Column_Position; - Row : Line_Position) return Termcap_String; + Col : Column_Position; + Row : Line_Position) return Termcap_String; -- AKA: tgoto() -- | @@ -94,5 +94,5 @@ -- Returns True if the string is found. -- AKA: tgetstr() -end Terminal_Interface.Curses.Termcap; +end Terminal_Interface.Curses.Termcap; diff --git a/doc/html/ada/terminal_interface-curses-terminfo__adb.htm b/doc/html/ada/terminal_interface-curses-terminfo__adb.htm index ea809a32..497c8c0e 100644 --- a/doc/html/ada/terminal_interface-curses-terminfo__adb.htm +++ b/doc/html/ada/terminal_interface-curses-terminfo__adb.htm @@ -57,12 +57,12 @@ -- Binding Version 01.00 ------------------------------------------------------------------------------ -with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; +with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; with Interfaces.C; use Interfaces.C; with Interfaces.C.Strings; use Interfaces.C.Strings; with Ada.Unchecked_Conversion; -package body Terminal_Interface.Curses.Terminfo is +package body Terminal_Interface.Curses.Terminfo is function Is_MinusOne_Pointer (P : chars_ptr) return Boolean; @@ -83,13 +83,13 @@ ------------------------------------------------------------------------------ function Get_Flag (Name : String) return Boolean is - function tigetflag (id : char_array) return Curses_Bool; + function tigetflag (id : char_array) return Curses_Bool; pragma Import (C, tigetflag); Txt : char_array (0 .. Name'Length); Length : size_t; begin To_C (Name, Txt, Length); - if tigetflag (Txt) = Curses_Bool (Curses_True) then + if tigetflag (Txt) = Curses_Bool (Curses_True) then return True; else return False; @@ -112,9 +112,9 @@ if Txt2 = Null_Ptr then Result := False; elsif Is_MinusOne_Pointer (Txt2) then - raise Curses_Exception; + raise Curses_Exception; else - Value := Terminfo_String (Fill_String (Txt2)); + Value := Terminfo_String (Fill_String (Txt2)); Result := True; end if; end Get_String; @@ -133,7 +133,7 @@ if Txt2 = Null_Ptr then return False; elsif Is_MinusOne_Pointer (Txt2) then - raise Curses_Exception; + raise Curses_Exception; else return True; end if; @@ -141,7 +141,7 @@ ------------------------------------------------------------------------------ function Get_Number (Name : String) return Integer is - function tigetstr (s : char_array) return C_Int; + function tigetstr (s : char_array) return C_Int; pragma Import (C, tigetstr); Txt : char_array (0 .. Name'Length); Length : size_t; @@ -155,25 +155,25 @@ affcnt : Natural := 1; putc : putctype := null) is function tputs (str : char_array; - affcnt : C_Int; - putc : putctype) return C_Int; - function putp (str : char_array) return C_Int; + affcnt : C_Int; + putc : putctype) return C_Int; + function putp (str : char_array) return C_Int; pragma Import (C, tputs); pragma Import (C, putp); Txt : char_array (0 .. Str'Length); Length : size_t; - Err : C_Int; + Err : C_Int; begin To_C (String (Str), Txt, Length); if putc = null then Err := putp (Txt); else - Err := tputs (Txt, C_Int (affcnt), putc); + Err := tputs (Txt, C_Int (affcnt), putc); end if; - if Err = Curses_Err then - raise Curses_Exception; + if Err = Curses_Err then + raise Curses_Exception; end if; end Put_String; -end Terminal_Interface.Curses.Terminfo; +end Terminal_Interface.Curses.Terminfo; diff --git a/doc/html/ada/terminal_interface-curses-terminfo__ads.htm b/doc/html/ada/terminal_interface-curses-terminfo__ads.htm index fa44003c..230ec7f0 100644 --- a/doc/html/ada/terminal_interface-curses-terminfo__ads.htm +++ b/doc/html/ada/terminal_interface-curses-terminfo__ads.htm @@ -58,8 +58,8 @@ with Interfaces.C; -package Terminal_Interface.Curses.Terminfo is - pragma Preelaborate (Terminal_Interface.Curses.Terminfo); +package Terminal_Interface.Curses.Terminfo is + pragma Preelaborate (Terminal_Interface.Curses.Terminfo); -- |===================================================================== -- | Man page curs_terminfo.3x @@ -95,5 +95,5 @@ putc : putctype := null); -- AKA: tputs() -end Terminal_Interface.Curses.Terminfo; +end Terminal_Interface.Curses.Terminfo; diff --git a/doc/html/ada/terminal_interface-curses-text_io-aux__adb.htm b/doc/html/ada/terminal_interface-curses-text_io-aux__adb.htm index b4fa34cf..79157cc3 100644 --- a/doc/html/ada/terminal_interface-curses-text_io-aux__adb.htm +++ b/doc/html/ada/terminal_interface-curses-text_io-aux__adb.htm @@ -56,10 +56,10 @@ -- @Date: 2009/12/26 17:38:58 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ -package body Terminal_Interface.Curses.Text_IO.Aux is +package body Terminal_Interface.Curses.Text_IO.Aux is procedure Put_Buf - (Win : Window; + (Win : Window; Buf : String; Width : Field; Signal : Boolean := True; @@ -68,10 +68,10 @@ L : Field; Len : Field; W : Field := Width; - LC : Line_Count; - CC : Column_Count; - Y : Line_Position; - X : Column_Position; + LC : Line_Count; + CC : Column_Count; + Y : Line_Position; + X : Column_Position; procedure Output (From, To : Field); @@ -88,8 +88,8 @@ end if; pragma Assert (Len <= W); - Get_Size (Win, LC, CC); - if Column_Count (Len) > CC then + Get_Size (Win, LC, CC); + if Column_Count (Len) > CC then if Signal then raise Layout_Error; else @@ -104,8 +104,8 @@ Put (Win, Filler); end; end if; - Get_Cursor_Position (Win, Y, X); - if (X + Column_Position (Len)) > CC then + Get_Cursor_Position (Win, Y, X); + if (X + Column_Position (Len)) > CC then New_Line (Win); end if; Put (Win, Buf (From .. To)); @@ -122,7 +122,7 @@ end Output; begin - pragma Assert (Win /= Null_Window); + pragma Assert (Win /= Null_Window); if Ljust then L := 1; for I in 1 .. Buf'Length loop @@ -142,5 +142,5 @@ end if; end Put_Buf; -end Terminal_Interface.Curses.Text_IO.Aux; +end Terminal_Interface.Curses.Text_IO.Aux; diff --git a/doc/html/ada/terminal_interface-curses-text_io-aux__ads.htm b/doc/html/ada/terminal_interface-curses-text_io-aux__ads.htm index a15046ac..eff7081c 100644 --- a/doc/html/ada/terminal_interface-curses-text_io-aux__ads.htm +++ b/doc/html/ada/terminal_interface-curses-text_io-aux__ads.htm @@ -56,18 +56,18 @@ -- @Date: 2009/12/26 17:38:58 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ -private package Terminal_Interface.Curses.Text_IO.Aux is +private package Terminal_Interface.Curses.Text_IO.Aux is -- pragma Preelaborate (Aux); -- This routine is called from the Text_IO output routines for numeric -- and enumeration types. -- procedure Put_Buf - (Win : Window; -- The output window + (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; +end Terminal_Interface.Curses.Text_IO.Aux; diff --git a/doc/html/ada/terminal_interface-curses-text_io-complex_io__adb.htm b/doc/html/ada/terminal_interface-curses-text_io-complex_io__adb.htm index a76a9f76..baf1c938 100644 --- a/doc/html/ada/terminal_interface-curses-text_io-complex_io__adb.htm +++ b/doc/html/ada/terminal_interface-curses-text_io-complex_io__adb.htm @@ -55,15 +55,15 @@ -- @Revision: 1.11 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ -with Terminal_Interface.Curses.Text_IO.Float_IO; +with Terminal_Interface.Curses.Text_IO.Float_IO; -package body Terminal_Interface.Curses.Text_IO.Complex_IO is +package body Terminal_Interface.Curses.Text_IO.Complex_IO is package FIO is new - Terminal_Interface.Curses.Text_IO.Float_IO (Complex_Types.Real'Base); + Terminal_Interface.Curses.Text_IO.Float_IO (Complex_Types.Real'Base); procedure Put - (Win : Window; + (Win : Window; Item : Complex; Fore : Field := Default_Fore; Aft : Field := Default_Aft; @@ -87,5 +87,5 @@ Put (Get_Window, Item, Fore, Aft, Exp); end Put; -end Terminal_Interface.Curses.Text_IO.Complex_IO; +end Terminal_Interface.Curses.Text_IO.Complex_IO; diff --git a/doc/html/ada/terminal_interface-curses-text_io-complex_io__ads.htm b/doc/html/ada/terminal_interface-curses-text_io-complex_io__ads.htm index d95ecffd..78bb8c45 100644 --- a/doc/html/ada/terminal_interface-curses-text_io-complex_io__ads.htm +++ b/doc/html/ada/terminal_interface-curses-text_io-complex_io__ads.htm @@ -60,7 +60,7 @@ generic with package Complex_Types is new Ada.Numerics.Generic_Complex_Types (<>); -package Terminal_Interface.Curses.Text_IO.Complex_IO is +package Terminal_Interface.Curses.Text_IO.Complex_IO is use Complex_Types; @@ -69,7 +69,7 @@ Default_Exp : Field := 3; procedure Put - (Win : Window; + (Win : Window; Item : Complex; Fore : Field := Default_Fore; Aft : Field := Default_Aft; @@ -84,5 +84,5 @@ private pragma Inline (Put); -end Terminal_Interface.Curses.Text_IO.Complex_IO; +end Terminal_Interface.Curses.Text_IO.Complex_IO; diff --git a/doc/html/ada/terminal_interface-curses-text_io-decimal_io__adb.htm b/doc/html/ada/terminal_interface-curses-text_io-decimal_io__adb.htm index 27b8299f..a1b55815 100644 --- a/doc/html/ada/terminal_interface-curses-text_io-decimal_io__adb.htm +++ b/doc/html/ada/terminal_interface-curses-text_io-decimal_io__adb.htm @@ -56,15 +56,15 @@ -- Binding Version 01.00 ------------------------------------------------------------------------------ with Ada.Text_IO; -with Terminal_Interface.Curses.Text_IO.Aux; +with Terminal_Interface.Curses.Text_IO.Aux; -package body Terminal_Interface.Curses.Text_IO.Decimal_IO is +package body Terminal_Interface.Curses.Text_IO.Decimal_IO is - package Aux renames Terminal_Interface.Curses.Text_IO.Aux; + package Aux renames Terminal_Interface.Curses.Text_IO.Aux; package DIO is new Ada.Text_IO.Decimal_IO (Num); procedure Put - (Win : Window; + (Win : Window; Item : Num; Fore : Field := Default_Fore; Aft : Field := Default_Aft; @@ -89,5 +89,5 @@ Put (Get_Window, Item, Fore, Aft, Exp); end Put; -end Terminal_Interface.Curses.Text_IO.Decimal_IO; +end Terminal_Interface.Curses.Text_IO.Decimal_IO; diff --git a/doc/html/ada/terminal_interface-curses-text_io-decimal_io__ads.htm b/doc/html/ada/terminal_interface-curses-text_io-decimal_io__ads.htm index a0a622e8..75a19a12 100644 --- a/doc/html/ada/terminal_interface-curses-text_io-decimal_io__ads.htm +++ b/doc/html/ada/terminal_interface-curses-text_io-decimal_io__ads.htm @@ -58,14 +58,14 @@ generic type Num is delta <> digits <>; -package Terminal_Interface.Curses.Text_IO.Decimal_IO is +package Terminal_Interface.Curses.Text_IO.Decimal_IO is Default_Fore : Field := Num'Fore; Default_Aft : Field := Num'Aft; Default_Exp : Field := 0; procedure Put - (Win : Window; + (Win : Window; Item : Num; Fore : Field := Default_Fore; Aft : Field := Default_Aft; @@ -80,5 +80,5 @@ private pragma Inline (Put); -end Terminal_Interface.Curses.Text_IO.Decimal_IO; +end Terminal_Interface.Curses.Text_IO.Decimal_IO; diff --git a/doc/html/ada/terminal_interface-curses-text_io-enumeration_io__adb.htm b/doc/html/ada/terminal_interface-curses-text_io-enumeration_io__adb.htm index 81eb2bec..872a7b12 100644 --- a/doc/html/ada/terminal_interface-curses-text_io-enumeration_io__adb.htm +++ b/doc/html/ada/terminal_interface-curses-text_io-enumeration_io__adb.htm @@ -57,15 +57,15 @@ ------------------------------------------------------------------------------ with Ada.Text_IO; with Ada.Characters.Handling; use Ada.Characters.Handling; -with Terminal_Interface.Curses.Text_IO.Aux; +with Terminal_Interface.Curses.Text_IO.Aux; -package body Terminal_Interface.Curses.Text_IO.Enumeration_IO is +package body Terminal_Interface.Curses.Text_IO.Enumeration_IO is - package Aux renames Terminal_Interface.Curses.Text_IO.Aux; + package Aux renames Terminal_Interface.Curses.Text_IO.Aux; package EIO is new Ada.Text_IO.Enumeration_IO (Enum); procedure Put - (Win : Window; + (Win : Window; Item : Enum; Width : Field := Default_Width; Set : Type_Set := Default_Setting) @@ -94,5 +94,5 @@ Put (Get_Window, Item, Width, Set); end Put; -end Terminal_Interface.Curses.Text_IO.Enumeration_IO; +end Terminal_Interface.Curses.Text_IO.Enumeration_IO; diff --git a/doc/html/ada/terminal_interface-curses-text_io-enumeration_io__ads.htm b/doc/html/ada/terminal_interface-curses-text_io-enumeration_io__ads.htm index 767f1a96..68fbb658 100644 --- a/doc/html/ada/terminal_interface-curses-text_io-enumeration_io__ads.htm +++ b/doc/html/ada/terminal_interface-curses-text_io-enumeration_io__ads.htm @@ -58,13 +58,13 @@ generic type Enum is (<>); -package Terminal_Interface.Curses.Text_IO.Enumeration_IO is +package Terminal_Interface.Curses.Text_IO.Enumeration_IO is Default_Width : Field := 0; Default_Setting : Type_Set := Mixed_Case; procedure Put - (Win : Window; + (Win : Window; Item : Enum; Width : Field := Default_Width; Set : Type_Set := Default_Setting); @@ -77,5 +77,5 @@ private pragma Inline (Put); -end Terminal_Interface.Curses.Text_IO.Enumeration_IO; +end Terminal_Interface.Curses.Text_IO.Enumeration_IO; diff --git a/doc/html/ada/terminal_interface-curses-text_io-fixed_io__adb.htm b/doc/html/ada/terminal_interface-curses-text_io-fixed_io__adb.htm index 5911efb7..e6d9b342 100644 --- a/doc/html/ada/terminal_interface-curses-text_io-fixed_io__adb.htm +++ b/doc/html/ada/terminal_interface-curses-text_io-fixed_io__adb.htm @@ -56,15 +56,15 @@ -- Binding Version 01.00 ------------------------------------------------------------------------------ with Ada.Text_IO; -with Terminal_Interface.Curses.Text_IO.Aux; +with Terminal_Interface.Curses.Text_IO.Aux; -package body Terminal_Interface.Curses.Text_IO.Fixed_IO is +package body Terminal_Interface.Curses.Text_IO.Fixed_IO is - package Aux renames Terminal_Interface.Curses.Text_IO.Aux; + package Aux renames Terminal_Interface.Curses.Text_IO.Aux; package FIXIO is new Ada.Text_IO.Fixed_IO (Num); procedure Put - (Win : Window; + (Win : Window; Item : Num; Fore : Field := Default_Fore; Aft : Field := Default_Aft; @@ -89,5 +89,5 @@ Put (Get_Window, Item, Fore, Aft, Exp); end Put; -end Terminal_Interface.Curses.Text_IO.Fixed_IO; +end Terminal_Interface.Curses.Text_IO.Fixed_IO; diff --git a/doc/html/ada/terminal_interface-curses-text_io-fixed_io__ads.htm b/doc/html/ada/terminal_interface-curses-text_io-fixed_io__ads.htm index c719f887..e990afea 100644 --- a/doc/html/ada/terminal_interface-curses-text_io-fixed_io__ads.htm +++ b/doc/html/ada/terminal_interface-curses-text_io-fixed_io__ads.htm @@ -58,14 +58,14 @@ generic type Num is delta <>; -package Terminal_Interface.Curses.Text_IO.Fixed_IO is +package Terminal_Interface.Curses.Text_IO.Fixed_IO is Default_Fore : Field := Num'Fore; Default_Aft : Field := Num'Aft; Default_Exp : Field := 0; procedure Put - (Win : Window; + (Win : Window; Item : Num; Fore : Field := Default_Fore; Aft : Field := Default_Aft; @@ -80,5 +80,5 @@ private pragma Inline (Put); -end Terminal_Interface.Curses.Text_IO.Fixed_IO; +end Terminal_Interface.Curses.Text_IO.Fixed_IO; diff --git a/doc/html/ada/terminal_interface-curses-text_io-float_io__adb.htm b/doc/html/ada/terminal_interface-curses-text_io-float_io__adb.htm index 6c1c53d1..2f1690fd 100644 --- a/doc/html/ada/terminal_interface-curses-text_io-float_io__adb.htm +++ b/doc/html/ada/terminal_interface-curses-text_io-float_io__adb.htm @@ -56,15 +56,15 @@ -- Binding Version 01.00 ------------------------------------------------------------------------------ with Ada.Text_IO; -with Terminal_Interface.Curses.Text_IO.Aux; +with Terminal_Interface.Curses.Text_IO.Aux; -package body Terminal_Interface.Curses.Text_IO.Float_IO is +package body Terminal_Interface.Curses.Text_IO.Float_IO is - package Aux renames Terminal_Interface.Curses.Text_IO.Aux; + package Aux renames Terminal_Interface.Curses.Text_IO.Aux; package FIO is new Ada.Text_IO.Float_IO (Num); procedure Put - (Win : Window; + (Win : Window; Item : Num; Fore : Field := Default_Fore; Aft : Field := Default_Aft; @@ -90,5 +90,5 @@ Put (Get_Window, Item, Fore, Aft, Exp); end Put; -end Terminal_Interface.Curses.Text_IO.Float_IO; +end Terminal_Interface.Curses.Text_IO.Float_IO; diff --git a/doc/html/ada/terminal_interface-curses-text_io-float_io__ads.htm b/doc/html/ada/terminal_interface-curses-text_io-float_io__ads.htm index 54816ac0..23f93b07 100644 --- a/doc/html/ada/terminal_interface-curses-text_io-float_io__ads.htm +++ b/doc/html/ada/terminal_interface-curses-text_io-float_io__ads.htm @@ -58,14 +58,14 @@ generic type Num is digits <>; -package Terminal_Interface.Curses.Text_IO.Float_IO is +package Terminal_Interface.Curses.Text_IO.Float_IO is Default_Fore : Field := 2; Default_Aft : Field := Num'Digits - 1; Default_Exp : Field := 3; procedure Put - (Win : Window; + (Win : Window; Item : Num; Fore : Field := Default_Fore; Aft : Field := Default_Aft; @@ -80,5 +80,5 @@ private pragma Inline (Put); -end Terminal_Interface.Curses.Text_IO.Float_IO; +end Terminal_Interface.Curses.Text_IO.Float_IO; diff --git a/doc/html/ada/terminal_interface-curses-text_io-integer_io__adb.htm b/doc/html/ada/terminal_interface-curses-text_io-integer_io__adb.htm index d06ba9fc..f4c984c7 100644 --- a/doc/html/ada/terminal_interface-curses-text_io-integer_io__adb.htm +++ b/doc/html/ada/terminal_interface-curses-text_io-integer_io__adb.htm @@ -56,15 +56,15 @@ -- Binding Version 01.00 ------------------------------------------------------------------------------ with Ada.Text_IO; -with Terminal_Interface.Curses.Text_IO.Aux; +with Terminal_Interface.Curses.Text_IO.Aux; -package body Terminal_Interface.Curses.Text_IO.Integer_IO is +package body Terminal_Interface.Curses.Text_IO.Integer_IO is - package Aux renames Terminal_Interface.Curses.Text_IO.Aux; + package Aux renames Terminal_Interface.Curses.Text_IO.Aux; package IIO is new Ada.Text_IO.Integer_IO (Num); procedure Put - (Win : Window; + (Win : Window; Item : Num; Width : Field := Default_Width; Base : Number_Base := Default_Base) @@ -84,5 +84,5 @@ Put (Get_Window, Item, Width, Base); end Put; -end Terminal_Interface.Curses.Text_IO.Integer_IO; +end Terminal_Interface.Curses.Text_IO.Integer_IO; diff --git a/doc/html/ada/terminal_interface-curses-text_io-integer_io__ads.htm b/doc/html/ada/terminal_interface-curses-text_io-integer_io__ads.htm index 4fc79311..e4b1c7b6 100644 --- a/doc/html/ada/terminal_interface-curses-text_io-integer_io__ads.htm +++ b/doc/html/ada/terminal_interface-curses-text_io-integer_io__ads.htm @@ -58,13 +58,13 @@ generic type Num is range <>; -package Terminal_Interface.Curses.Text_IO.Integer_IO is +package Terminal_Interface.Curses.Text_IO.Integer_IO is Default_Width : Field := Num'Width; Default_Base : Number_Base := 10; procedure Put - (Win : Window; + (Win : Window; Item : Num; Width : Field := Default_Width; Base : Number_Base := Default_Base); @@ -77,5 +77,5 @@ private pragma Inline (Put); -end Terminal_Interface.Curses.Text_IO.Integer_IO; +end Terminal_Interface.Curses.Text_IO.Integer_IO; diff --git a/doc/html/ada/terminal_interface-curses-text_io-modular_io__adb.htm b/doc/html/ada/terminal_interface-curses-text_io-modular_io__adb.htm index 19aeaf2c..af4b2228 100644 --- a/doc/html/ada/terminal_interface-curses-text_io-modular_io__adb.htm +++ b/doc/html/ada/terminal_interface-curses-text_io-modular_io__adb.htm @@ -56,15 +56,15 @@ -- Binding Version 01.00 ------------------------------------------------------------------------------ with Ada.Text_IO; -with Terminal_Interface.Curses.Text_IO.Aux; +with Terminal_Interface.Curses.Text_IO.Aux; -package body Terminal_Interface.Curses.Text_IO.Modular_IO is +package body Terminal_Interface.Curses.Text_IO.Modular_IO is - package Aux renames Terminal_Interface.Curses.Text_IO.Aux; + package Aux renames Terminal_Interface.Curses.Text_IO.Aux; package MIO is new Ada.Text_IO.Modular_IO (Num); procedure Put - (Win : Window; + (Win : Window; Item : Num; Width : Field := Default_Width; Base : Number_Base := Default_Base) @@ -84,5 +84,5 @@ Put (Get_Window, Item, Width, Base); end Put; -end Terminal_Interface.Curses.Text_IO.Modular_IO; +end Terminal_Interface.Curses.Text_IO.Modular_IO; diff --git a/doc/html/ada/terminal_interface-curses-text_io-modular_io__ads.htm b/doc/html/ada/terminal_interface-curses-text_io-modular_io__ads.htm index 8d485adc..1552b0c5 100644 --- a/doc/html/ada/terminal_interface-curses-text_io-modular_io__ads.htm +++ b/doc/html/ada/terminal_interface-curses-text_io-modular_io__ads.htm @@ -58,13 +58,13 @@ generic type Num is mod <>; -package Terminal_Interface.Curses.Text_IO.Modular_IO is +package Terminal_Interface.Curses.Text_IO.Modular_IO is Default_Width : Field := Num'Width; Default_Base : Number_Base := 10; procedure Put - (Win : Window; + (Win : Window; Item : Num; Width : Field := Default_Width; Base : Number_Base := Default_Base); @@ -77,5 +77,5 @@ private pragma Inline (Put); -end Terminal_Interface.Curses.Text_IO.Modular_IO; +end Terminal_Interface.Curses.Text_IO.Modular_IO; diff --git a/doc/html/ada/terminal_interface-curses-text_io__adb.htm b/doc/html/ada/terminal_interface-curses-text_io__adb.htm index f53067fe..fb818d03 100644 --- a/doc/html/ada/terminal_interface-curses-text_io__adb.htm +++ b/doc/html/ada/terminal_interface-curses-text_io__adb.htm @@ -24,7 +24,7 @@ -- B O D Y -- -- -- ------------------------------------------------------------------------------ --- Copyright (c) 1998-2009,2011 Free Software Foundation, Inc. -- +-- Copyright (c) 1998-2011,2014 Free Software Foundation, Inc. -- -- -- -- Permission is hereby granted, free of charge, to any person obtaining a -- -- copy of this software and associated documentation files (the -- @@ -52,35 +52,35 @@ ------------------------------------------------------------------------------ -- Author: Juergen Pfeifer, 1996 -- Version Control: --- @Revision: 1.20 @ --- @Date: 2011/03/22 23:38:49 @ +-- @Revision: 1.22 @ +-- @Date: 2014/05/24 21:32:18 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ -package body Terminal_Interface.Curses.Text_IO is +package body Terminal_Interface.Curses.Text_IO is - Default_Window : Window := Null_Window; + Default_Window : Window := Null_Window; - procedure Set_Window (Win : Window) + procedure Set_Window (Win : Window) is begin Default_Window := Win; end Set_Window; - function Get_Window return Window + function Get_Window return Window is begin - if Default_Window = Null_Window then - return Standard_Window; + if Default_Window = Null_Window then + return Standard_Window; else return Default_Window; end if; end Get_Window; pragma Inline (Get_Window); - procedure Flush (Win : Window) + procedure Flush (Win : Window) is begin - Refresh (Win); + Refresh (Win); end Flush; procedure Flush @@ -98,12 +98,12 @@ -- A scroll-window is interpreted as an page with unbounded page length, -- i.e. it returns the conventional 0 as page length. - function Line_Length (Win : Window) return Count + function Line_Length (Win : Window) return Count is - N_Lines : Line_Count; - N_Cols : Column_Count; + N_Lines : Line_Count; + N_Cols : Column_Count; begin - Get_Size (Win, N_Lines, N_Cols); + Get_Size (Win, N_Lines, N_Cols); -- if Natural (N_Cols) > Natural (Count'Last) then -- raise Layout_Error; -- end if; @@ -116,15 +116,15 @@ return Line_Length (Get_Window); end Line_Length; - function Page_Length (Win : Window) return Count + function Page_Length (Win : Window) return Count is - N_Lines : Line_Count; - N_Cols : Column_Count; + N_Lines : Line_Count; + N_Cols : Column_Count; begin - if Scrolling_Allowed (Win) then + if Scrolling_Allowed (Win) then return 0; else - Get_Size (Win, N_Lines, N_Cols); + Get_Size (Win, N_Lines, N_Cols); -- if Natural (N_Lines) > Natural (Count'Last) then -- raise Layout_Error; -- end if; @@ -141,7 +141,7 @@ ------------------------------------ -- Column, Line, and Page Control -- ------------------------------------ - procedure New_Line (Win : Window; Spacing : Positive_Count := 1) + procedure New_Line (Win : Window; Spacing : Positive_Count := 1) is P_Size : constant Count := Page_Length (Win); begin @@ -153,7 +153,7 @@ if P_Size > 0 and then Line (Win) >= P_Size then New_Page (Win); else - Add (Win, ASCII.LF); + Add (Win, ASCII.LF); end if; end loop; end New_Line; @@ -164,10 +164,10 @@ New_Line (Get_Window, Spacing); end New_Line; - procedure New_Page (Win : Window) + procedure New_Page (Win : Window) is begin - Clear (Win); + Clear (Win); end New_Page; procedure New_Page @@ -176,20 +176,20 @@ New_Page (Get_Window); end New_Page; - procedure Set_Col (Win : Window; To : Positive_Count) + procedure Set_Col (Win : Window; To : Positive_Count) is - Y : Line_Position; - X1 : Column_Position; - X2 : Column_Position; + Y : Line_Position; + X1 : Column_Position; + X2 : Column_Position; N : Natural; begin if not To'Valid then raise Constraint_Error; end if; - Get_Cursor_Position (Win, Y, X1); + Get_Cursor_Position (Win, Y, X1); N := Natural (To); N := N - 1; - X2 := Column_Position (N); + X2 := Column_Position (N); if X1 > X2 then New_Line (Win, 1); X1 := 0; @@ -210,21 +210,21 @@ Set_Col (Get_Window, To); end Set_Col; - procedure Set_Line (Win : Window; To : Positive_Count) + procedure Set_Line (Win : Window; To : Positive_Count) is - Y1 : Line_Position; - Y2 : Line_Position; - X : Column_Position; + Y1 : Line_Position; + Y2 : Line_Position; + X : Column_Position; N : Natural; begin if not To'Valid then raise Constraint_Error; end if; - Get_Cursor_Position (Win, Y1, X); - pragma Unreferenced (X); + Get_Cursor_Position (Win, Y1, X); + pragma Warnings (Off, X); -- unreferenced N := Natural (To); N := N - 1; - Y2 := Line_Position (N); + Y2 := Line_Position (N); if Y2 < Y1 then New_Page (Win); Y1 := 0; @@ -240,13 +240,13 @@ Set_Line (Get_Window, To); end Set_Line; - function Col (Win : Window) return Positive_Count + function Col (Win : Window) return Positive_Count is - Y : Line_Position; - X : Column_Position; + Y : Line_Position; + X : Column_Position; N : Natural; begin - Get_Cursor_Position (Win, Y, X); + Get_Cursor_Position (Win, Y, X); N := Natural (X); N := N + 1; -- if N > Natural (Count'Last) then -- raise Layout_Error; @@ -260,13 +260,13 @@ return Col (Get_Window); end Col; - function Line (Win : Window) return Positive_Count + function Line (Win : Window) return Positive_Count is - Y : Line_Position; - X : Column_Position; + Y : Line_Position; + X : Column_Position; N : Natural; begin - Get_Cursor_Position (Win, Y, X); + Get_Cursor_Position (Win, Y, X); N := Natural (Y); N := N + 1; -- if N > Natural (Count'Last) then -- raise Layout_Error; @@ -284,22 +284,22 @@ -- Characters Output -- ----------------------- - procedure Put (Win : Window; Item : Character) + procedure Put (Win : Window; Item : Character) is P_Size : constant Count := Page_Length (Win); - Y : Line_Position; - X : Column_Position; - L : Line_Count; - C : Column_Count; + Y : Line_Position; + X : Column_Position; + L : Line_Count; + C : Column_Count; begin if P_Size > 0 then - Get_Cursor_Position (Win, Y, X); - Get_Size (Win, L, C); + Get_Cursor_Position (Win, Y, X); + Get_Size (Win, L, C); if (Y + 1) = L and then (X + 1) = C then New_Page (Win); end if; end if; - Add (Win, Item); + Add (Win, Item); end Put; procedure Put (Item : Character) @@ -312,22 +312,22 @@ -- Strings-Output -- -------------------- - procedure Put (Win : Window; Item : String) + procedure Put (Win : Window; Item : String) is P_Size : constant Count := Page_Length (Win); - Y : Line_Position; - X : Column_Position; - L : Line_Count; - C : Column_Count; + Y : Line_Position; + X : Column_Position; + L : Line_Count; + C : Column_Count; begin if P_Size > 0 then - Get_Cursor_Position (Win, Y, X); - Get_Size (Win, L, C); + Get_Cursor_Position (Win, Y, X); + Get_Size (Win, L, C); if (Y + 1) = L and then (X + 1 + Item'Length) >= C then New_Page (Win); end if; end if; - Add (Win, Item); + Add (Win, Item); end Put; procedure Put (Item : String) @@ -337,7 +337,7 @@ end Put; procedure Put_Line - (Win : Window; + (Win : Window; Item : String) is begin @@ -352,5 +352,5 @@ Put_Line (Get_Window, Item); end Put_Line; -end Terminal_Interface.Curses.Text_IO; +end Terminal_Interface.Curses.Text_IO; diff --git a/doc/html/ada/terminal_interface-curses-text_io__ads.htm b/doc/html/ada/terminal_interface-curses-text_io__ads.htm index ac2fa990..f95e359f 100644 --- a/doc/html/ada/terminal_interface-curses-text_io__ads.htm +++ b/doc/html/ada/terminal_interface-curses-text_io__ads.htm @@ -58,7 +58,7 @@ with Ada.Text_IO; with Ada.IO_Exceptions; -package Terminal_Interface.Curses.Text_IO is +package Terminal_Interface.Curses.Text_IO is use type Ada.Text_IO.Count; subtype Count is Ada.Text_IO.Count; @@ -73,13 +73,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 : Window); + procedure Set_Window (Win : Window); -- Set Win as the default window - function Get_Window return Window; + function Get_Window return Window; -- Get the current default window - procedure Flush (Win : Window); + procedure Flush (Win : Window); procedure Flush; -------------------------------------------- @@ -91,49 +91,49 @@ -- A scroll-window is interpreted as an page with unbounded page length, -- i.e. it returns the conventional 0 as page length. - function Line_Length (Win : Window) return Count; + function Line_Length (Win : Window) return Count; function Line_Length return Count; - function Page_Length (Win : Window) return Count; + function Page_Length (Win : Window) return Count; function Page_Length return Count; ------------------------------------ -- Column, Line, and Page Control -- ------------------------------------ - procedure New_Line (Win : Window; Spacing : Positive_Count := 1); + procedure New_Line (Win : Window; Spacing : Positive_Count := 1); procedure New_Line (Spacing : Positive_Count := 1); - procedure New_Page (Win : Window); + procedure New_Page (Win : Window); procedure New_Page; - procedure Set_Col (Win : Window; To : Positive_Count); + procedure Set_Col (Win : Window; To : Positive_Count); procedure Set_Col (To : Positive_Count); - procedure Set_Line (Win : Window; To : Positive_Count); + procedure Set_Line (Win : Window; To : Positive_Count); procedure Set_Line (To : Positive_Count); - function Col (Win : Window) return Positive_Count; + function Col (Win : Window) return Positive_Count; function Col return Positive_Count; - function Line (Win : Window) return Positive_Count; + function Line (Win : Window) return Positive_Count; function Line return Positive_Count; ----------------------- -- Characters-Output -- ----------------------- - procedure Put (Win : Window; Item : Character); + procedure Put (Win : Window; Item : Character); procedure Put (Item : Character); -------------------- -- Strings-Output -- -------------------- - procedure Put (Win : Window; Item : String); + procedure Put (Win : Window; Item : String); procedure Put (Item : String); procedure Put_Line - (Win : Window; + (Win : Window; Item : String); procedure Put_Line @@ -150,5 +150,5 @@ Data_Error : exception renames Ada.IO_Exceptions.Data_Error; Layout_Error : exception renames Ada.IO_Exceptions.Layout_Error; -end Terminal_Interface.Curses.Text_IO; +end Terminal_Interface.Curses.Text_IO; diff --git a/doc/html/ada/terminal_interface-curses-trace__adb.htm b/doc/html/ada/terminal_interface-curses-trace__adb.htm index 106aa5d6..ae38c146 100644 --- a/doc/html/ada/terminal_interface-curses-trace__adb.htm +++ b/doc/html/ada/terminal_interface-curses-trace__adb.htm @@ -24,7 +24,7 @@ -- B O D Y -- -- -- ------------------------------------------------------------------------------ --- Copyright (c) 2000-2004,2009 Free Software Foundation, Inc. -- +-- Copyright (c) 2000-2009,2014 Free Software Foundation, Inc. -- -- -- -- Permission is hereby granted, free of charge, to any person obtaining a -- -- copy of this software and associated documentation files (the -- @@ -52,44 +52,23 @@ ------------------------------------------------------------------------------ -- Author: Juergen Pfeifer, 1996 -- Version Control: --- @Revision: 1.7 @ +-- @Revision: 1.11 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ -with Interfaces.C; use Interfaces.C; -with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; -with Ada.Unchecked_Conversion; -package body Terminal_Interface.Curses.Trace is +package body Terminal_Interface.Curses.Trace is - type C_TraceType is new C_UInt; - - function TraceAda_To_TraceC is new - Ada.Unchecked_Conversion (Source => Trace_Attribute_Set, - Target => C_TraceType); - - procedure Trace_On (x : Trace_Attribute_Set) is - procedure traceC (y : C_TraceType); - pragma Import (C, traceC, "trace"); + procedure Trace_On (x : Trace_Attribute_Set) is + pragma Warnings (Off, x); -- unreferenced begin - traceC (TraceAda_To_TraceC (x)); - end Trace_On; - - -- 75. (12) A C function that takes a variable number of arguments can - -- correspond to several Ada subprograms, taking various specific - -- numbers and types of parameters. + null; + end Trace_On; - procedure Trace_Put (str : String) is - procedure tracef (format : char_array; s : char_array); - pragma Import (C, tracef, "_traces"); - Txt : char_array (0 .. str'Length); - Length : size_t; - formatstr : constant String := "%s" & ASCII.NUL; - formattxt : char_array (0 .. formatstr'Length); + procedure Trace_Put (str : String) is + pragma Warnings (Off, str); -- unreferenced begin - To_C (formatstr, formattxt, Length); - To_C (str, Txt, Length); - tracef (formattxt, Txt); - end Trace_Put; + null; + end Trace_Put; -end Terminal_Interface.Curses.Trace; +end Terminal_Interface.Curses.Trace; diff --git a/doc/html/ada/terminal_interface-curses-trace__ads.htm b/doc/html/ada/terminal_interface-curses-trace__ads.htm index 5c6895a9..35d4531c 100644 --- a/doc/html/ada/terminal_interface-curses-trace__ads.htm +++ b/doc/html/ada/terminal_interface-curses-trace__ads.htm @@ -24,7 +24,7 @@ -- S P E C -- -- -- ------------------------------------------------------------------------------ --- Copyright (c) 2000 Free Software Foundation, Inc. -- +-- Copyright (c) 2000,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 -- @@ -52,65 +52,74 @@ ------------------------------------------------------------------------------ -- Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000 -- Version Control: --- @Revision: 1.1 @ +-- @Revision: 1.4 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ -package Terminal_Interface.Curses.Trace is - pragma Preelaborate (Terminal_Interface.Curses.Trace); +package Terminal_Interface.Curses.Trace is + pragma Preelaborate (Terminal_Interface.Curses.Trace); - pragma Warnings (Off); - type Trace_Attribute_Set is + type Trace_Attribute_Set is record - Times : Boolean; - Tputs : Boolean; - Update : Boolean; - Cursor_Move : Boolean; - Character_Output : Boolean; - Calls : Boolean; - Virtual_Puts : Boolean; - Input_Events : Boolean; - TTY_State : Boolean; - Internal_Calls : Boolean; - Character_Calls : Boolean; - Termcap_TermInfo : Boolean; - Attributes_And_Colors : Boolean; + Times : Boolean; + Tputs : Boolean; + Update : Boolean; + Cursor_Move : Boolean; + Character_Output : Boolean; + Calls : Boolean; + Virtual_Puts : Boolean; + Input_Events : Boolean; + TTY_State : Boolean; + Internal_Calls : Boolean; + Character_Calls : Boolean; + Termcap_TermInfo : Boolean; + Attribute_Color : Boolean; end record; - pragma Convention (C, Trace_Attribute_Set); + pragma Convention (C_Pass_By_Copy, Trace_Attribute_Set); - for Trace_Attribute_Set use + for Trace_Attribute_Set use record - Times at 0 range 0 .. 0; - Tputs at 0 range 1 .. 1; - Update at 0 range 2 .. 2; - Cursor_Move at 0 range 3 .. 3; - Character_Output at 0 range 4 .. 4; - Calls at 0 range 5 .. 5; - Virtual_Puts at 0 range 6 .. 6; - Input_Events at 0 range 7 .. 7; - TTY_State at 0 range 8 .. 8; - Internal_Calls at 0 range 9 .. 9; - Character_Calls at 0 range 10 .. 10; - Termcap_TermInfo at 0 range 11 .. 11; - Attributes_And_Colors at 0 range 12 .. 12; + Times at 0 range Curses_Constants.TRACE_TIMES_First + .. Curses_Constants.TRACE_TIMES_Last; + Tputs at 0 range Curses_Constants.TRACE_TPUTS_First + .. Curses_Constants.TRACE_TPUTS_Last; + Update at 0 range Curses_Constants.TRACE_UPDATE_First + .. Curses_Constants.TRACE_UPDATE_Last; + Cursor_Move at 0 range Curses_Constants.TRACE_MOVE_First + .. Curses_Constants.TRACE_MOVE_Last; + Character_Output at 0 range Curses_Constants.TRACE_CHARPUT_First + .. Curses_Constants.TRACE_CHARPUT_Last; + Calls at 0 range Curses_Constants.TRACE_CALLS_First + .. Curses_Constants.TRACE_CALLS_Last; + Virtual_Puts at 0 range Curses_Constants.TRACE_VIRTPUT_First + .. Curses_Constants.TRACE_VIRTPUT_Last; + Input_Events at 0 range Curses_Constants.TRACE_IEVENT_First + .. Curses_Constants.TRACE_IEVENT_Last; + TTY_State at 0 range Curses_Constants.TRACE_BITS_First + .. Curses_Constants.TRACE_BITS_Last; + Internal_Calls at 0 range Curses_Constants.TRACE_ICALLS_First + .. Curses_Constants.TRACE_ICALLS_Last; + Character_Calls at 0 range Curses_Constants.TRACE_CCALLS_First + .. Curses_Constants.TRACE_CCALLS_Last; + Termcap_TermInfo at 0 range Curses_Constants.TRACE_DATABASE_First + .. Curses_Constants.TRACE_DATABASE_Last; + Attribute_Color at 0 range Curses_Constants.TRACE_ATTRS_First + .. Curses_Constants.TRACE_ATTRS_Last; end record; - pragma Warnings (Off); for Trace_Attribute_Set'Size use 32; - pragma Warnings (On); - -- Please note: this rep. clause is generated and may be - -- different on your system. - + pragma Warnings (Off); + for Trace_Attribute_Set'Size use Curses_Constants.Trace_Size; pragma Warnings (On); - Trace_Disable : constant Trace_Attribute_Set := (others => False); + Trace_Disable : constant Trace_Attribute_Set := (others => False); - Trace_Ordinary : constant Trace_Attribute_Set := - (Times => True, - Tputs => True, - Update => True, - Cursor_Move => True, - Character_Output => True, + Trace_Ordinary : constant Trace_Attribute_Set := + (Times => True, + Tputs => True, + Update => True, + Cursor_Move => True, + Character_Output => True, others => False); - Trace_Maximum : constant Trace_Attribute_Set := (others => True); + Trace_Maximum : constant Trace_Attribute_Set := (others => True); ------------------------------------------------------------------------------ @@ -119,15 +128,15 @@ -- |===================================================================== -- #1A NAME="AFU_1"#2| - procedure Trace_On (x : Trace_Attribute_Set); + procedure Trace_On (x : Trace_Attribute_Set); -- The debugging library has trace. -- #1A NAME="AFU_2"#2| - procedure Trace_Put (str : String); + procedure Trace_Put (str : String); -- AKA: _tracef() - Current_Trace_Setting : Trace_Attribute_Set; - pragma Import (C, Current_Trace_Setting, "_nc_tracing"); + Current_Trace_Setting : Trace_Attribute_Set; + pragma Import (C, Current_Trace_Setting, "_nc_tracing"); -end Terminal_Interface.Curses.Trace; +end Terminal_Interface.Curses.Trace; diff --git a/doc/html/ada/terminal_interface-curses__adb.htm b/doc/html/ada/terminal_interface-curses__adb.htm index a54b7eea..62622d1d 100644 --- a/doc/html/ada/terminal_interface-curses__adb.htm +++ b/doc/html/ada/terminal_interface-curses__adb.htm @@ -24,7 +24,7 @@ -- B O D Y -- -- -- ------------------------------------------------------------------------------ --- Copyright (c) 1998-2009,2011 Free Software Foundation, Inc. -- +-- Copyright (c) 1998-2011,2014 Free Software Foundation, Inc. -- -- -- -- Permission is hereby granted, free of charge, to any person obtaining a -- -- copy of this software and associated documentation files (the -- @@ -52,43 +52,43 @@ ------------------------------------------------------------------------------ -- Author: Juergen Pfeifer, 1996 -- Version Control: --- @Revision: 1.8 @ --- @Date: 2011/03/22 23:02:14 @ +-- @Revision: 1.14 @ +-- @Date: 2014/05/24 21:31:05 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ with System; -with Terminal_Interface.Curses.Aux; +with Terminal_Interface.Curses.Aux; with Interfaces.C; use Interfaces.C; with Interfaces.C.Strings; use Interfaces.C.Strings; with Ada.Characters.Handling; use Ada.Characters.Handling; with Ada.Strings.Fixed; -package body Terminal_Interface.Curses is +package body Terminal_Interface.Curses is - use Aux; + use Aux; use type System.Bit_Order; package ASF renames Ada.Strings.Fixed; type chtype_array is array (size_t range <>) - of aliased Attributed_Character; + of aliased Attributed_Character; pragma Convention (C, chtype_array); ------------------------------------------------------------------------------ - function Key_Name (Key : Real_Key_Code) return String + function Key_Name (Key : Real_Key_Code) return String is - function Keyname (K : C_Int) return chars_ptr; + function Keyname (K : C_Int) return chars_ptr; pragma Import (C, Keyname, "keyname"); Ch : Character; begin - if Key <= Character'Pos (Character'Last) then - Ch := Character'Val (Key); + if Key <= Character'Pos (Character'Last) then + Ch := Character'Val (Key); if Is_Control (Ch) then - return Un_Control (Attributed_Character'(Ch => Ch, - Color => Color_Pair'First, - Attr => Normal_Video)); + return Un_Control (Attributed_Character'(Ch => Ch, + Color => Color_Pair'First, + Attr => Normal_Video)); elsif Is_Graphic (Ch) then declare S : String (1 .. 1); @@ -100,2380 +100,2380 @@ return ""; end if; else - return Fill_String (Keyname (C_Int (Key))); + return Fill_String (Keyname (C_Int (Key))); end if; - end Key_Name; + end Key_Name; - procedure Key_Name (Key : Real_Key_Code; - Name : out String) + procedure Key_Name (Key : Real_Key_Code; + Name : out String) is begin - ASF.Move (Key_Name (Key), Name); - end Key_Name; + ASF.Move (Key_Name (Key), Name); + end Key_Name; ------------------------------------------------------------------------------ - procedure Init_Screen + procedure Init_Screen is - function Initscr return Window; + function Initscr return Window; pragma Import (C, Initscr, "initscr"); - W : Window; + W : Window; begin W := Initscr; - if W = Null_Window then - raise Curses_Exception; + if W = Null_Window then + raise Curses_Exception; end if; - end Init_Screen; + end Init_Screen; - procedure End_Windows + procedure End_Windows is - function Endwin return C_Int; + function Endwin return C_Int; pragma Import (C, Endwin, "endwin"); begin - if Endwin = Curses_Err then - raise Curses_Exception; + if Endwin = Curses_Err then + raise Curses_Exception; end if; - end End_Windows; + end End_Windows; - function Is_End_Window return Boolean + function Is_End_Window return Boolean is - function Isendwin return Curses_Bool; + function Isendwin return Curses_Bool; pragma Import (C, Isendwin, "isendwin"); begin - if Isendwin = Curses_Bool_False then + if Isendwin = Curses_Bool_False then return False; else return True; end if; - end Is_End_Window; + end Is_End_Window; ------------------------------------------------------------------------------ - procedure Move_Cursor (Win : Window := Standard_Window; - Line : Line_Position; - Column : Column_Position) - is - function Wmove (Win : Window; - Line : C_Int; - Column : C_Int - ) return C_Int; + procedure Move_Cursor (Win : Window := Standard_Window; + Line : Line_Position; + Column : Column_Position) + is + function Wmove (Win : Window; + Line : C_Int; + Column : C_Int + ) return C_Int; pragma Import (C, Wmove, "wmove"); begin - if Wmove (Win, C_Int (Line), C_Int (Column)) = Curses_Err then - raise Curses_Exception; + if Wmove (Win, C_Int (Line), C_Int (Column)) = Curses_Err then + raise Curses_Exception; end if; - end Move_Cursor; + end Move_Cursor; ------------------------------------------------------------------------------ - procedure Add (Win : Window := Standard_Window; - Ch : Attributed_Character) + procedure Add (Win : Window := Standard_Window; + Ch : Attributed_Character) is - function Waddch (W : Window; - Ch : C_Chtype) return C_Int; + function Waddch (W : Window; + Ch : Attributed_Character) return C_Int; pragma Import (C, Waddch, "waddch"); begin - if Waddch (Win, AttrChar_To_Chtype (Ch)) = Curses_Err then - raise Curses_Exception; + if Waddch (Win, Ch) = Curses_Err then + raise Curses_Exception; end if; - end Add; + end Add; - procedure Add (Win : Window := Standard_Window; - Ch : Character) + procedure Add (Win : Window := Standard_Window; + Ch : Character) is begin - Add (Win, - Attributed_Character'(Ch => Ch, - Color => Color_Pair'First, - Attr => Normal_Video)); - end Add; + Add (Win, + Attributed_Character'(Ch => Ch, + Color => Color_Pair'First, + Attr => Normal_Video)); + end Add; - procedure Add - (Win : Window := Standard_Window; - Line : Line_Position; - Column : Column_Position; - Ch : Attributed_Character) + procedure Add + (Win : Window := Standard_Window; + Line : Line_Position; + Column : Column_Position; + Ch : Attributed_Character) is - function mvwaddch (W : Window; - Y : C_Int; - X : C_Int; - Ch : C_Chtype) return C_Int; + function mvwaddch (W : Window; + Y : C_Int; + X : C_Int; + Ch : Attributed_Character) return C_Int; pragma Import (C, mvwaddch, "mvwaddch"); begin - if mvwaddch (Win, C_Int (Line), - C_Int (Column), - AttrChar_To_Chtype (Ch)) = Curses_Err then - raise Curses_Exception; + if mvwaddch (Win, C_Int (Line), + C_Int (Column), + Ch) = Curses_Err + then + raise Curses_Exception; end if; - end Add; + end Add; - procedure Add - (Win : Window := Standard_Window; - Line : Line_Position; - Column : Column_Position; - Ch : Character) + procedure Add + (Win : Window := Standard_Window; + Line : Line_Position; + Column : Column_Position; + Ch : Character) is begin - Add (Win, - Line, - Column, - Attributed_Character'(Ch => Ch, - Color => Color_Pair'First, - Attr => Normal_Video)); - end Add; + Add (Win, + Line, + Column, + Attributed_Character'(Ch => Ch, + Color => Color_Pair'First, + Attr => Normal_Video)); + end Add; - procedure Add_With_Immediate_Echo - (Win : Window := Standard_Window; - Ch : Attributed_Character) + procedure Add_With_Immediate_Echo + (Win : Window := Standard_Window; + Ch : Attributed_Character) is - function Wechochar (W : Window; - Ch : C_Chtype) return C_Int; + function Wechochar (W : Window; + Ch : Attributed_Character) return C_Int; pragma Import (C, Wechochar, "wechochar"); begin - if Wechochar (Win, AttrChar_To_Chtype (Ch)) = Curses_Err then - raise Curses_Exception; + if Wechochar (Win, Ch) = Curses_Err then + raise Curses_Exception; end if; - end Add_With_Immediate_Echo; + end Add_With_Immediate_Echo; - procedure Add_With_Immediate_Echo - (Win : Window := Standard_Window; - Ch : Character) + procedure Add_With_Immediate_Echo + (Win : Window := Standard_Window; + Ch : Character) is begin - Add_With_Immediate_Echo - (Win, - Attributed_Character'(Ch => Ch, - Color => Color_Pair'First, - Attr => Normal_Video)); - end Add_With_Immediate_Echo; + Add_With_Immediate_Echo + (Win, + Attributed_Character'(Ch => Ch, + Color => Color_Pair'First, + Attr => Normal_Video)); + end Add_With_Immediate_Echo; ------------------------------------------------------------------------------ - function Create (Number_Of_Lines : Line_Count; - Number_Of_Columns : Column_Count; - First_Line_Position : Line_Position; - First_Column_Position : Column_Position) return Window - is - function Newwin (Number_Of_Lines : C_Int; - Number_Of_Columns : C_Int; - First_Line_Position : C_Int; - First_Column_Position : C_Int) return Window; + function Create (Number_Of_Lines : Line_Count; + Number_Of_Columns : Column_Count; + First_Line_Position : Line_Position; + First_Column_Position : Column_Position) return Window + is + function Newwin (Number_Of_Lines : C_Int; + Number_Of_Columns : C_Int; + First_Line_Position : C_Int; + First_Column_Position : C_Int) return Window; pragma Import (C, Newwin, "newwin"); - W : Window; + W : Window; begin - W := Newwin (C_Int (Number_Of_Lines), - C_Int (Number_Of_Columns), - C_Int (First_Line_Position), - C_Int (First_Column_Position)); - if W = Null_Window then - raise Curses_Exception; + W := Newwin (C_Int (Number_Of_Lines), + C_Int (Number_Of_Columns), + C_Int (First_Line_Position), + C_Int (First_Column_Position)); + if W = Null_Window then + raise Curses_Exception; end if; - return W; - end Create; + return W; + end Create; - procedure Delete (Win : in out Window) + procedure Delete (Win : in out Window) is - function Wdelwin (W : Window) return C_Int; + function Wdelwin (W : Window) return C_Int; pragma Import (C, Wdelwin, "delwin"); begin - if Wdelwin (Win) = Curses_Err then - raise Curses_Exception; - end if; - Win := Null_Window; - end Delete; - - function Sub_Window - (Win : Window := Standard_Window; - Number_Of_Lines : Line_Count; - Number_Of_Columns : Column_Count; - First_Line_Position : Line_Position; - First_Column_Position : Column_Position) return Window - is - function Subwin - (Win : Window; - Number_Of_Lines : C_Int; - Number_Of_Columns : C_Int; - First_Line_Position : C_Int; - First_Column_Position : C_Int) return Window; + if Wdelwin (Win) = Curses_Err then + raise Curses_Exception; + end if; + Win := Null_Window; + end Delete; + + function Sub_Window + (Win : Window := Standard_Window; + Number_Of_Lines : Line_Count; + Number_Of_Columns : Column_Count; + First_Line_Position : Line_Position; + First_Column_Position : Column_Position) return Window + is + function Subwin + (Win : Window; + Number_Of_Lines : C_Int; + Number_Of_Columns : C_Int; + First_Line_Position : C_Int; + First_Column_Position : C_Int) return Window; pragma Import (C, Subwin, "subwin"); - W : Window; - begin - W := Subwin (Win, - C_Int (Number_Of_Lines), - C_Int (Number_Of_Columns), - C_Int (First_Line_Position), - C_Int (First_Column_Position)); - if W = Null_Window then - raise Curses_Exception; - end if; - return W; - end Sub_Window; - - function Derived_Window - (Win : Window := Standard_Window; - Number_Of_Lines : Line_Count; - Number_Of_Columns : Column_Count; - First_Line_Position : Line_Position; - First_Column_Position : Column_Position) return Window - is - function Derwin - (Win : Window; - Number_Of_Lines : C_Int; - Number_Of_Columns : C_Int; - First_Line_Position : C_Int; - First_Column_Position : C_Int) return Window; + W : Window; + begin + W := Subwin (Win, + C_Int (Number_Of_Lines), + C_Int (Number_Of_Columns), + C_Int (First_Line_Position), + C_Int (First_Column_Position)); + if W = Null_Window then + raise Curses_Exception; + end if; + return W; + end Sub_Window; + + function Derived_Window + (Win : Window := Standard_Window; + Number_Of_Lines : Line_Count; + Number_Of_Columns : Column_Count; + First_Line_Position : Line_Position; + First_Column_Position : Column_Position) return Window + is + function Derwin + (Win : Window; + Number_Of_Lines : C_Int; + Number_Of_Columns : C_Int; + First_Line_Position : C_Int; + First_Column_Position : C_Int) return Window; pragma Import (C, Derwin, "derwin"); - W : Window; + W : Window; begin - W := Derwin (Win, - C_Int (Number_Of_Lines), - C_Int (Number_Of_Columns), - C_Int (First_Line_Position), - C_Int (First_Column_Position)); - if W = Null_Window then - raise Curses_Exception; + W := Derwin (Win, + C_Int (Number_Of_Lines), + C_Int (Number_Of_Columns), + C_Int (First_Line_Position), + C_Int (First_Column_Position)); + if W = Null_Window then + raise Curses_Exception; end if; - return W; - end Derived_Window; + return W; + end Derived_Window; - function Duplicate (Win : Window) return Window + function Duplicate (Win : Window) return Window is - function Dupwin (Win : Window) return Window; + function Dupwin (Win : Window) return Window; pragma Import (C, Dupwin, "dupwin"); - W : constant Window := Dupwin (Win); + W : constant Window := Dupwin (Win); begin - if W = Null_Window then - raise Curses_Exception; + if W = Null_Window then + raise Curses_Exception; end if; - return W; - end Duplicate; + return W; + end Duplicate; - procedure Move_Window (Win : Window; - Line : Line_Position; - Column : Column_Position) + procedure Move_Window (Win : Window; + Line : Line_Position; + Column : Column_Position) is - function Mvwin (Win : Window; - Line : C_Int; - Column : C_Int) return C_Int; + function Mvwin (Win : Window; + Line : C_Int; + Column : C_Int) return C_Int; pragma Import (C, Mvwin, "mvwin"); begin - if Mvwin (Win, C_Int (Line), C_Int (Column)) = Curses_Err then - raise Curses_Exception; + if Mvwin (Win, C_Int (Line), C_Int (Column)) = Curses_Err then + raise Curses_Exception; end if; - end Move_Window; + end Move_Window; - procedure Move_Derived_Window (Win : Window; - Line : Line_Position; - Column : Column_Position) + procedure Move_Derived_Window (Win : Window; + Line : Line_Position; + Column : Column_Position) is - function Mvderwin (Win : Window; - Line : C_Int; - Column : C_Int) return C_Int; + function Mvderwin (Win : Window; + Line : C_Int; + Column : C_Int) return C_Int; pragma Import (C, Mvderwin, "mvderwin"); begin - if Mvderwin (Win, C_Int (Line), C_Int (Column)) = Curses_Err then - raise Curses_Exception; + if Mvderwin (Win, C_Int (Line), C_Int (Column)) = Curses_Err then + raise Curses_Exception; end if; - end Move_Derived_Window; + end Move_Derived_Window; - procedure Set_Synch_Mode (Win : Window := Standard_Window; - Mode : Boolean := False) + procedure Set_Synch_Mode (Win : Window := Standard_Window; + Mode : Boolean := False) is - function Syncok (Win : Window; - Mode : Curses_Bool) return C_Int; + function Syncok (Win : Window; + Mode : Curses_Bool) return C_Int; pragma Import (C, Syncok, "syncok"); begin - if Syncok (Win, Curses_Bool (Boolean'Pos (Mode))) = Curses_Err then - raise Curses_Exception; + if Syncok (Win, Curses_Bool (Boolean'Pos (Mode))) = Curses_Err then + raise Curses_Exception; end if; - end Set_Synch_Mode; + end Set_Synch_Mode; ------------------------------------------------------------------------------ - procedure Add (Win : Window := Standard_Window; - Str : String; - Len : Integer := -1) + procedure Add (Win : Window := Standard_Window; + Str : String; + Len : Integer := -1) is - function Waddnstr (Win : Window; - Str : char_array; - Len : C_Int := -1) return C_Int; + function Waddnstr (Win : Window; + Str : char_array; + Len : C_Int := -1) return C_Int; pragma Import (C, Waddnstr, "waddnstr"); - Txt : char_array (0 .. Str'Length); - Length : size_t; + Txt : char_array (0 .. Str'Length); + Length : size_t; begin - To_C (Str, Txt, Length); - if Waddnstr (Win, Txt, C_Int (Len)) = Curses_Err then - raise Curses_Exception; + To_C (Str, Txt, Length); + if Waddnstr (Win, Txt, C_Int (Len)) = Curses_Err then + raise Curses_Exception; end if; - end Add; + end Add; - procedure Add - (Win : Window := Standard_Window; - Line : Line_Position; - Column : Column_Position; - Str : String; - Len : Integer := -1) + procedure Add + (Win : Window := Standard_Window; + Line : Line_Position; + Column : Column_Position; + Str : String; + Len : Integer := -1) is begin - Move_Cursor (Win, Line, Column); - Add (Win, Str, Len); - end Add; + Move_Cursor (Win, Line, Column); + Add (Win, Str, Len); + end Add; ------------------------------------------------------------------------------ - procedure Add - (Win : Window := Standard_Window; - Str : Attributed_String; - Len : Integer := -1) - is - function Waddchnstr (Win : Window; - Str : chtype_array; - Len : C_Int := -1) return C_Int; + procedure Add + (Win : Window := Standard_Window; + Str : Attributed_String; + Len : Integer := -1) + is + function Waddchnstr (Win : Window; + Str : chtype_array; + Len : C_Int := -1) return C_Int; pragma Import (C, Waddchnstr, "waddchnstr"); - Txt : chtype_array (0 .. Str'Length); + Txt : chtype_array (0 .. Str'Length); begin - for Length in 1 .. size_t (Str'Length) loop - Txt (Length - 1) := Str (Natural (Length)); + for Length in 1 .. size_t (Str'Length) loop + Txt (Length - 1) := Str (Natural (Length)); end loop; - Txt (Str'Length) := Default_Character; - if Waddchnstr (Win, - Txt, - C_Int (Len)) = Curses_Err then - raise Curses_Exception; + Txt (Str'Length) := Default_Character; + if Waddchnstr (Win, + Txt, + C_Int (Len)) = Curses_Err + then + raise Curses_Exception; end if; - end Add; + end Add; - procedure Add - (Win : Window := Standard_Window; - Line : Line_Position; - Column : Column_Position; - Str : Attributed_String; - Len : Integer := -1) + procedure Add + (Win : Window := Standard_Window; + Line : Line_Position; + Column : Column_Position; + Str : Attributed_String; + Len : Integer := -1) is begin - Move_Cursor (Win, Line, Column); - Add (Win, Str, Len); - end Add; + Move_Cursor (Win, Line, Column); + Add (Win, Str, Len); + end Add; ------------------------------------------------------------------------------ - procedure Border - (Win : Window := Standard_Window; - Left_Side_Symbol : Attributed_Character := Default_Character; - Right_Side_Symbol : Attributed_Character := Default_Character; - Top_Side_Symbol : Attributed_Character := Default_Character; - Bottom_Side_Symbol : Attributed_Character := Default_Character; - Upper_Left_Corner_Symbol : Attributed_Character := Default_Character; - Upper_Right_Corner_Symbol : Attributed_Character := Default_Character; - Lower_Left_Corner_Symbol : Attributed_Character := Default_Character; - Lower_Right_Corner_Symbol : Attributed_Character := Default_Character) - is - function Wborder (W : Window; - LS : C_Chtype; - RS : C_Chtype; - TS : C_Chtype; - BS : C_Chtype; - ULC : C_Chtype; - URC : C_Chtype; - LLC : C_Chtype; - LRC : C_Chtype) return C_Int; + procedure Border + (Win : Window := Standard_Window; + Left_Side_Symbol : Attributed_Character := Default_Character; + Right_Side_Symbol : Attributed_Character := Default_Character; + Top_Side_Symbol : Attributed_Character := Default_Character; + Bottom_Side_Symbol : Attributed_Character := Default_Character; + Upper_Left_Corner_Symbol : Attributed_Character := Default_Character; + Upper_Right_Corner_Symbol : Attributed_Character := Default_Character; + Lower_Left_Corner_Symbol : Attributed_Character := Default_Character; + Lower_Right_Corner_Symbol : Attributed_Character := Default_Character) + is + function Wborder (W : Window; + LS : Attributed_Character; + RS : Attributed_Character; + TS : Attributed_Character; + BS : Attributed_Character; + ULC : Attributed_Character; + URC : Attributed_Character; + LLC : Attributed_Character; + LRC : Attributed_Character) return C_Int; pragma Import (C, Wborder, "wborder"); begin - if Wborder (Win, - AttrChar_To_Chtype (Left_Side_Symbol), - AttrChar_To_Chtype (Right_Side_Symbol), - AttrChar_To_Chtype (Top_Side_Symbol), - AttrChar_To_Chtype (Bottom_Side_Symbol), - AttrChar_To_Chtype (Upper_Left_Corner_Symbol), - AttrChar_To_Chtype (Upper_Right_Corner_Symbol), - AttrChar_To_Chtype (Lower_Left_Corner_Symbol), - AttrChar_To_Chtype (Lower_Right_Corner_Symbol) - ) = Curses_Err + if Wborder (Win, + Left_Side_Symbol, + Right_Side_Symbol, + Top_Side_Symbol, + Bottom_Side_Symbol, + Upper_Left_Corner_Symbol, + Upper_Right_Corner_Symbol, + Lower_Left_Corner_Symbol, + Lower_Right_Corner_Symbol) = Curses_Err then - raise Curses_Exception; + raise Curses_Exception; end if; - end Border; + end Border; - procedure Box - (Win : Window := Standard_Window; - Vertical_Symbol : Attributed_Character := Default_Character; - Horizontal_Symbol : Attributed_Character := Default_Character) + procedure Box + (Win : Window := Standard_Window; + Vertical_Symbol : Attributed_Character := Default_Character; + Horizontal_Symbol : Attributed_Character := Default_Character) is begin - Border (Win, - Vertical_Symbol, Vertical_Symbol, - Horizontal_Symbol, Horizontal_Symbol); - end Box; + Border (Win, + Vertical_Symbol, Vertical_Symbol, + Horizontal_Symbol, Horizontal_Symbol); + end Box; - procedure Horizontal_Line - (Win : Window := Standard_Window; - Line_Size : Natural; - Line_Symbol : Attributed_Character := Default_Character) + procedure Horizontal_Line + (Win : Window := Standard_Window; + Line_Size : Natural; + Line_Symbol : Attributed_Character := Default_Character) is - function Whline (W : Window; - Ch : C_Chtype; - Len : C_Int) return C_Int; + function Whline (W : Window; + Ch : Attributed_Character; + Len : C_Int) return C_Int; pragma Import (C, Whline, "whline"); begin - if Whline (Win, - AttrChar_To_Chtype (Line_Symbol), - C_Int (Line_Size)) = Curses_Err then - raise Curses_Exception; + if Whline (Win, + Line_Symbol, + C_Int (Line_Size)) = Curses_Err + then + raise Curses_Exception; end if; - end Horizontal_Line; + end Horizontal_Line; - procedure Vertical_Line - (Win : Window := Standard_Window; - Line_Size : Natural; - Line_Symbol : Attributed_Character := Default_Character) + procedure Vertical_Line + (Win : Window := Standard_Window; + Line_Size : Natural; + Line_Symbol : Attributed_Character := Default_Character) is - function Wvline (W : Window; - Ch : C_Chtype; - Len : C_Int) return C_Int; + function Wvline (W : Window; + Ch : Attributed_Character; + Len : C_Int) return C_Int; pragma Import (C, Wvline, "wvline"); begin - if Wvline (Win, - AttrChar_To_Chtype (Line_Symbol), - C_Int (Line_Size)) = Curses_Err then - raise Curses_Exception; + if Wvline (Win, + Line_Symbol, + C_Int (Line_Size)) = Curses_Err + then + raise Curses_Exception; end if; - end Vertical_Line; + end Vertical_Line; ------------------------------------------------------------------------------ - function Get_Keystroke (Win : Window := Standard_Window) - return Real_Key_Code + function Get_Keystroke (Win : Window := Standard_Window) + return Real_Key_Code is - function Wgetch (W : Window) return C_Int; + function Wgetch (W : Window) return C_Int; pragma Import (C, Wgetch, "wgetch"); - C : constant C_Int := Wgetch (Win); + C : constant C_Int := Wgetch (Win); begin - if C = Curses_Err then + if C = Curses_Err then return Key_None; else - return Real_Key_Code (C); + return Real_Key_Code (C); end if; - end Get_Keystroke; + end Get_Keystroke; - procedure Undo_Keystroke (Key : Real_Key_Code) + procedure Undo_Keystroke (Key : Real_Key_Code) is - function Ungetch (Ch : C_Int) return C_Int; + function Ungetch (Ch : C_Int) return C_Int; pragma Import (C, Ungetch, "ungetch"); begin - if Ungetch (C_Int (Key)) = Curses_Err then - raise Curses_Exception; + if Ungetch (C_Int (Key)) = Curses_Err then + raise Curses_Exception; end if; - end Undo_Keystroke; + end Undo_Keystroke; - function Has_Key (Key : Special_Key_Code) return Boolean + function Has_Key (Key : Special_Key_Code) return Boolean is - function Haskey (Key : C_Int) return C_Int; + function Haskey (Key : C_Int) return C_Int; pragma Import (C, Haskey, "has_key"); begin - if Haskey (C_Int (Key)) = Curses_False then + if Haskey (C_Int (Key)) = Curses_False then return False; else return True; end if; - end Has_Key; + end Has_Key; - function Is_Function_Key (Key : Special_Key_Code) return Boolean + function Is_Function_Key (Key : Special_Key_Code) return Boolean is - L : constant Special_Key_Code := Special_Key_Code (Natural (Key_F0) + - Natural (Function_Key_Number'Last)); + L : constant Special_Key_Code := Special_Key_Code (Natural (Key_F0) + + Natural (Function_Key_Number'Last)); begin - if (Key >= Key_F0) and then (Key <= L) then + if (Key >= Key_F0) and then (Key <= L) then return True; else return False; end if; - end Is_Function_Key; + end Is_Function_Key; - function Function_Key (Key : Real_Key_Code) - return Function_Key_Number + function Function_Key (Key : Real_Key_Code) + return Function_Key_Number is begin - if Is_Function_Key (Key) then - return Function_Key_Number (Key - Key_F0); + if Is_Function_Key (Key) then + return Function_Key_Number (Key - Key_F0); else raise Constraint_Error; end if; - end Function_Key; + end Function_Key; - function Function_Key_Code (Key : Function_Key_Number) return Real_Key_Code + function Function_Key_Code (Key : Function_Key_Number) return Real_Key_Code is begin - return Real_Key_Code (Natural (Key_F0) + Natural (Key)); - end Function_Key_Code; + return Real_Key_Code (Natural (Key_F0) + Natural (Key)); + end Function_Key_Code; ------------------------------------------------------------------------------ - procedure Standout (Win : Window := Standard_Window; - On : Boolean := True) + procedure Standout (Win : Window := Standard_Window; + On : Boolean := True) is - function wstandout (Win : Window) return C_Int; + function wstandout (Win : Window) return C_Int; pragma Import (C, wstandout, "wstandout"); - function wstandend (Win : Window) return C_Int; + function wstandend (Win : Window) return C_Int; pragma Import (C, wstandend, "wstandend"); - Err : C_Int; + Err : C_Int; begin - if On then - Err := wstandout (Win); + if On then + Err := wstandout (Win); else - Err := wstandend (Win); + Err := wstandend (Win); end if; - if Err = Curses_Err then - raise Curses_Exception; + if Err = Curses_Err then + raise Curses_Exception; end if; - end Standout; + end Standout; - procedure Switch_Character_Attribute - (Win : Window := Standard_Window; - Attr : Character_Attribute_Set := Normal_Video; - On : Boolean := True) + procedure Switch_Character_Attribute + (Win : Window := Standard_Window; + Attr : Character_Attribute_Set := Normal_Video; + On : Boolean := True) is - function Wattron (Win : Window; - C_Attr : C_AttrType) return C_Int; + function Wattron (Win : Window; + C_Attr : Attributed_Character) return C_Int; pragma Import (C, Wattron, "wattr_on"); - function Wattroff (Win : Window; - C_Attr : C_AttrType) return C_Int; + function Wattroff (Win : Window; + C_Attr : Attributed_Character) return C_Int; pragma Import (C, Wattroff, "wattr_off"); -- In Ada we use the On Boolean to control whether or not we want to -- switch on or off the attributes in the set. - Err : C_Int; - AC : constant Attributed_Character := (Ch => Character'First, - Color => Color_Pair'First, - Attr => Attr); + Err : C_Int; + AC : constant Attributed_Character := (Ch => Character'First, + Color => Color_Pair'First, + Attr => Attr); begin - if On then - Err := Wattron (Win, AttrChar_To_AttrType (AC)); + if On then + Err := Wattron (Win, AC); else - Err := Wattroff (Win, AttrChar_To_AttrType (AC)); + Err := Wattroff (Win, AC); end if; - if Err = Curses_Err then - raise Curses_Exception; + if Err = Curses_Err then + raise Curses_Exception; end if; - end Switch_Character_Attribute; + end Switch_Character_Attribute; - procedure Set_Character_Attributes - (Win : Window := Standard_Window; - Attr : Character_Attribute_Set := Normal_Video; - Color : Color_Pair := Color_Pair'First) + procedure Set_Character_Attributes + (Win : Window := Standard_Window; + Attr : Character_Attribute_Set := Normal_Video; + Color : Color_Pair := Color_Pair'First) is - function Wattrset (Win : Window; - C_Attr : C_AttrType) return C_Int; + function Wattrset (Win : Window; + C_Attr : Attributed_Character) return C_Int; pragma Import (C, Wattrset, "wattrset"); -- ??? wattr_set begin - if Wattrset (Win, - AttrChar_To_AttrType (Attributed_Character' - (Ch => Character'First, - Color => Color, - Attr => Attr))) = Curses_Err then - raise Curses_Exception; + if Wattrset (Win, (Ch => Character'First, + Color => Color, + Attr => Attr)) = Curses_Err + then + raise Curses_Exception; end if; - end Set_Character_Attributes; + end Set_Character_Attributes; - function Get_Character_Attribute (Win : Window := Standard_Window) - return Character_Attribute_Set + function Get_Character_Attribute (Win : Window := Standard_Window) + return Character_Attribute_Set is - function Wattrget (Win : Window; - Atr : access C_AttrType; - Col : access C_Short; - Opt : System.Address) return C_Int; + function Wattrget (Win : Window; + Atr : access Attributed_Character; + Col : access C_Short; + Opt : System.Address) return C_Int; pragma Import (C, Wattrget, "wattr_get"); - Attr : aliased C_AttrType; - Col : aliased C_Short; - Res : constant C_Int := Wattrget (Win, Attr'Access, Col'Access, + Attr : aliased Attributed_Character; + Col : aliased C_Short; + Res : constant C_Int := Wattrget (Win, Attr'Access, Col'Access, System.Null_Address); - Ch : Attributed_Character; begin - if Res = Curses_Ok then - Ch := AttrType_To_AttrChar (Attr); - return Ch.Attr; + if Res = Curses_Ok then + return Attr.Attr; else - raise Curses_Exception; + raise Curses_Exception; end if; - end Get_Character_Attribute; + end Get_Character_Attribute; - function Get_Character_Attribute (Win : Window := Standard_Window) - return Color_Pair + function Get_Character_Attribute (Win : Window := Standard_Window) + return Color_Pair is - function Wattrget (Win : Window; - Atr : access C_AttrType; - Col : access C_Short; - Opt : System.Address) return C_Int; + function Wattrget (Win : Window; + Atr : access Attributed_Character; + Col : access C_Short; + Opt : System.Address) return C_Int; pragma Import (C, Wattrget, "wattr_get"); - Attr : aliased C_AttrType; - Col : aliased C_Short; - Res : constant C_Int := Wattrget (Win, Attr'Access, Col'Access, + Attr : aliased Attributed_Character; + Col : aliased C_Short; + Res : constant C_Int := Wattrget (Win, Attr'Access, Col'Access, System.Null_Address); - Ch : Attributed_Character; begin - if Res = Curses_Ok then - Ch := AttrType_To_AttrChar (Attr); - return Ch.Color; + if Res = Curses_Ok then + return Attr.Color; else - raise Curses_Exception; + raise Curses_Exception; end if; - end Get_Character_Attribute; + end Get_Character_Attribute; - procedure Set_Color (Win : Window := Standard_Window; - Pair : Color_Pair) + procedure Set_Color (Win : Window := Standard_Window; + Pair : Color_Pair) is - function Wset_Color (Win : Window; - Color : C_Short; - Opts : C_Void_Ptr) return C_Int; + function Wset_Color (Win : Window; + Color : C_Short; + Opts : C_Void_Ptr) return C_Int; pragma Import (C, Wset_Color, "wcolor_set"); begin - if Wset_Color (Win, - C_Short (Pair), - C_Void_Ptr (System.Null_Address)) = Curses_Err then - raise Curses_Exception; - end if; - end Set_Color; - - procedure Change_Attributes - (Win : Window := Standard_Window; - Count : Integer := -1; - Attr : Character_Attribute_Set := Normal_Video; - Color : Color_Pair := Color_Pair'First) - is - function Wchgat (Win : Window; - Cnt : C_Int; - Attr : C_AttrType; - Color : C_Short; - Opts : System.Address := System.Null_Address) - return C_Int; + if Wset_Color (Win, + C_Short (Pair), + C_Void_Ptr (System.Null_Address)) = Curses_Err + then + raise Curses_Exception; + end if; + end Set_Color; + + procedure Change_Attributes + (Win : Window := Standard_Window; + Count : Integer := -1; + Attr : Character_Attribute_Set := Normal_Video; + Color : Color_Pair := Color_Pair'First) + is + function Wchgat (Win : Window; + Cnt : C_Int; + Attr : Attributed_Character; + Color : C_Short; + Opts : System.Address := System.Null_Address) + return C_Int; pragma Import (C, Wchgat, "wchgat"); - - Ch : constant Attributed_Character := - (Ch => Character'First, Color => Color_Pair'First, Attr => Attr); begin - if Wchgat (Win, C_Int (Count), AttrChar_To_AttrType (Ch), - C_Short (Color)) = Curses_Err then - raise Curses_Exception; + if Wchgat (Win, + C_Int (Count), + (Ch => Character'First, + Color => Color_Pair'First, + Attr => Attr), + C_Short (Color)) = Curses_Err + then + raise Curses_Exception; end if; - end Change_Attributes; + end Change_Attributes; - procedure Change_Attributes - (Win : Window := Standard_Window; - Line : Line_Position := Line_Position'First; - Column : Column_Position := Column_Position'First; - Count : Integer := -1; - Attr : Character_Attribute_Set := Normal_Video; - Color : Color_Pair := Color_Pair'First) + procedure Change_Attributes + (Win : Window := Standard_Window; + Line : Line_Position := Line_Position'First; + Column : Column_Position := Column_Position'First; + Count : Integer := -1; + Attr : Character_Attribute_Set := Normal_Video; + Color : Color_Pair := Color_Pair'First) is begin - Move_Cursor (Win, Line, Column); - Change_Attributes (Win, Count, Attr, Color); - end Change_Attributes; + Move_Cursor (Win, Line, Column); + Change_Attributes (Win, Count, Attr, Color); + end Change_Attributes; ------------------------------------------------------------------------------ - procedure Beep + procedure Beep is - function Beeper return C_Int; + function Beeper return C_Int; pragma Import (C, Beeper, "beep"); begin - if Beeper = Curses_Err then - raise Curses_Exception; + if Beeper = Curses_Err then + raise Curses_Exception; end if; - end Beep; + end Beep; - procedure Flash_Screen + procedure Flash_Screen is - function Flash return C_Int; + function Flash return C_Int; pragma Import (C, Flash, "flash"); begin - if Flash = Curses_Err then - raise Curses_Exception; + if Flash = Curses_Err then + raise Curses_Exception; end if; - end Flash_Screen; + end Flash_Screen; ------------------------------------------------------------------------------ - procedure Set_Cbreak_Mode (SwitchOn : Boolean := True) + procedure Set_Cbreak_Mode (SwitchOn : Boolean := True) is - function Cbreak return C_Int; + function Cbreak return C_Int; pragma Import (C, Cbreak, "cbreak"); - function NoCbreak return C_Int; + function NoCbreak return C_Int; pragma Import (C, NoCbreak, "nocbreak"); - Err : C_Int; + Err : C_Int; begin - if SwitchOn then - Err := Cbreak; + if SwitchOn then + Err := Cbreak; else - Err := NoCbreak; + Err := NoCbreak; end if; - if Err = Curses_Err then - raise Curses_Exception; + if Err = Curses_Err then + raise Curses_Exception; end if; - end Set_Cbreak_Mode; + end Set_Cbreak_Mode; - procedure Set_Raw_Mode (SwitchOn : Boolean := True) + procedure Set_Raw_Mode (SwitchOn : Boolean := True) is - function Raw return C_Int; + function Raw return C_Int; pragma Import (C, Raw, "raw"); - function NoRaw return C_Int; + function NoRaw return C_Int; pragma Import (C, NoRaw, "noraw"); - Err : C_Int; + Err : C_Int; begin - if SwitchOn then - Err := Raw; + if SwitchOn then + Err := Raw; else - Err := NoRaw; + Err := NoRaw; end if; - if Err = Curses_Err then - raise Curses_Exception; + if Err = Curses_Err then + raise Curses_Exception; end if; - end Set_Raw_Mode; + end Set_Raw_Mode; - procedure Set_Echo_Mode (SwitchOn : Boolean := True) + procedure Set_Echo_Mode (SwitchOn : Boolean := True) is - function Echo return C_Int; + function Echo return C_Int; pragma Import (C, Echo, "echo"); - function NoEcho return C_Int; + function NoEcho return C_Int; pragma Import (C, NoEcho, "noecho"); - Err : C_Int; + Err : C_Int; begin - if SwitchOn then - Err := Echo; + if SwitchOn then + Err := Echo; else - Err := NoEcho; + Err := NoEcho; end if; - if Err = Curses_Err then - raise Curses_Exception; + if Err = Curses_Err then + raise Curses_Exception; end if; - end Set_Echo_Mode; + end Set_Echo_Mode; - procedure Set_Meta_Mode (Win : Window := Standard_Window; - SwitchOn : Boolean := True) + procedure Set_Meta_Mode (Win : Window := Standard_Window; + SwitchOn : Boolean := True) is - function Meta (W : Window; Mode : Curses_Bool) return C_Int; + function Meta (W : Window; Mode : Curses_Bool) return C_Int; pragma Import (C, Meta, "meta"); begin - if Meta (Win, Curses_Bool (Boolean'Pos (SwitchOn))) = Curses_Err then - raise Curses_Exception; + if Meta (Win, Curses_Bool (Boolean'Pos (SwitchOn))) = Curses_Err then + raise Curses_Exception; end if; - end Set_Meta_Mode; + end Set_Meta_Mode; - procedure Set_KeyPad_Mode (Win : Window := Standard_Window; - SwitchOn : Boolean := True) + procedure Set_KeyPad_Mode (Win : Window := Standard_Window; + SwitchOn : Boolean := True) is - function Keypad (W : Window; Mode : Curses_Bool) return C_Int; + function Keypad (W : Window; Mode : Curses_Bool) return C_Int; pragma Import (C, Keypad, "keypad"); begin - if Keypad (Win, Curses_Bool (Boolean'Pos (SwitchOn))) = Curses_Err then - raise Curses_Exception; + if Keypad (Win, Curses_Bool (Boolean'Pos (SwitchOn))) = Curses_Err then + raise Curses_Exception; end if; - end Set_KeyPad_Mode; + end Set_KeyPad_Mode; - function Get_KeyPad_Mode (Win : Window := Standard_Window) + function Get_KeyPad_Mode (Win : Window := Standard_Window) return Boolean is - function Is_Keypad (W : Window) return Curses_Bool; + function Is_Keypad (W : Window) return Curses_Bool; pragma Import (C, Is_Keypad, "is_keypad"); begin - return (Is_Keypad (Win) /= Curses_Bool_False); - end Get_KeyPad_Mode; + return (Is_Keypad (Win) /= Curses_Bool_False); + end Get_KeyPad_Mode; - procedure Half_Delay (Amount : Half_Delay_Amount) + procedure Half_Delay (Amount : Half_Delay_Amount) is - function Halfdelay (Amount : C_Int) return C_Int; + function Halfdelay (Amount : C_Int) return C_Int; pragma Import (C, Halfdelay, "halfdelay"); begin - if Halfdelay (C_Int (Amount)) = Curses_Err then - raise Curses_Exception; + if Halfdelay (C_Int (Amount)) = Curses_Err then + raise Curses_Exception; end if; - end Half_Delay; + end Half_Delay; - procedure Set_Flush_On_Interrupt_Mode - (Win : Window := Standard_Window; - Mode : Boolean := True) + procedure Set_Flush_On_Interrupt_Mode + (Win : Window := Standard_Window; + Mode : Boolean := True) is - function Intrflush (Win : Window; Mode : Curses_Bool) return C_Int; + function Intrflush (Win : Window; Mode : Curses_Bool) return C_Int; pragma Import (C, Intrflush, "intrflush"); begin - if Intrflush (Win, Curses_Bool (Boolean'Pos (Mode))) = Curses_Err then - raise Curses_Exception; + if Intrflush (Win, Curses_Bool (Boolean'Pos (Mode))) = Curses_Err then + raise Curses_Exception; end if; - end Set_Flush_On_Interrupt_Mode; + end Set_Flush_On_Interrupt_Mode; - procedure Set_Queue_Interrupt_Mode - (Win : Window := Standard_Window; - Flush : Boolean := True) + procedure Set_Queue_Interrupt_Mode + (Win : Window := Standard_Window; + Flush : Boolean := True) is - procedure Qiflush; + procedure Qiflush; pragma Import (C, Qiflush, "qiflush"); - procedure No_Qiflush; + procedure No_Qiflush; pragma Import (C, No_Qiflush, "noqiflush"); begin - if Win = Null_Window then - raise Curses_Exception; + if Win = Null_Window then + raise Curses_Exception; end if; - if Flush then - Qiflush; + if Flush then + Qiflush; else - No_Qiflush; + No_Qiflush; end if; - end Set_Queue_Interrupt_Mode; + end Set_Queue_Interrupt_Mode; - procedure Set_NoDelay_Mode - (Win : Window := Standard_Window; - Mode : Boolean := False) + procedure Set_NoDelay_Mode + (Win : Window := Standard_Window; + Mode : Boolean := False) is - function Nodelay (Win : Window; Mode : Curses_Bool) return C_Int; + function Nodelay (Win : Window; Mode : Curses_Bool) return C_Int; pragma Import (C, Nodelay, "nodelay"); begin - if Nodelay (Win, Curses_Bool (Boolean'Pos (Mode))) = Curses_Err then - raise Curses_Exception; + if Nodelay (Win, Curses_Bool (Boolean'Pos (Mode))) = Curses_Err then + raise Curses_Exception; end if; - end Set_NoDelay_Mode; + end Set_NoDelay_Mode; - procedure Set_Timeout_Mode (Win : Window := Standard_Window; - Mode : Timeout_Mode; - Amount : Natural) + procedure Set_Timeout_Mode (Win : Window := Standard_Window; + Mode : Timeout_Mode; + Amount : Natural) is - procedure Wtimeout (Win : Window; Amount : C_Int); + procedure Wtimeout (Win : Window; Amount : C_Int); pragma Import (C, Wtimeout, "wtimeout"); - Time : C_Int; + Time : C_Int; begin - case Mode is - when Blocking => Time := -1; - when Non_Blocking => Time := 0; - when Delayed => - if Amount = 0 then + case Mode is + when Blocking => Time := -1; + when Non_Blocking => Time := 0; + when Delayed => + if Amount = 0 then raise Constraint_Error; end if; - Time := C_Int (Amount); + Time := C_Int (Amount); end case; - Wtimeout (Win, Time); - end Set_Timeout_Mode; + Wtimeout (Win, Time); + end Set_Timeout_Mode; - procedure Set_Escape_Timer_Mode - (Win : Window := Standard_Window; - Timer_Off : Boolean := False) + procedure Set_Escape_Timer_Mode + (Win : Window := Standard_Window; + Timer_Off : Boolean := False) is - function Notimeout (Win : Window; Mode : Curses_Bool) return C_Int; + function Notimeout (Win : Window; Mode : Curses_Bool) return C_Int; pragma Import (C, Notimeout, "notimeout"); begin - if Notimeout (Win, Curses_Bool (Boolean'Pos (Timer_Off))) - = Curses_Err then - raise Curses_Exception; + if Notimeout (Win, Curses_Bool (Boolean'Pos (Timer_Off))) + = Curses_Err + then + raise Curses_Exception; end if; - end Set_Escape_Timer_Mode; + end Set_Escape_Timer_Mode; ------------------------------------------------------------------------------ - procedure Set_NL_Mode (SwitchOn : Boolean := True) + procedure Set_NL_Mode (SwitchOn : Boolean := True) is - function NL return C_Int; + function NL return C_Int; pragma Import (C, NL, "nl"); - function NoNL return C_Int; + function NoNL return C_Int; pragma Import (C, NoNL, "nonl"); - Err : C_Int; + Err : C_Int; begin - if SwitchOn then - Err := NL; + if SwitchOn then + Err := NL; else - Err := NoNL; + Err := NoNL; end if; - if Err = Curses_Err then - raise Curses_Exception; + if Err = Curses_Err then + raise Curses_Exception; end if; - end Set_NL_Mode; + end Set_NL_Mode; - procedure Clear_On_Next_Update - (Win : Window := Standard_Window; - Do_Clear : Boolean := True) + procedure Clear_On_Next_Update + (Win : Window := Standard_Window; + Do_Clear : Boolean := True) is - function Clear_Ok (W : Window; Flag : Curses_Bool) return C_Int; + function Clear_Ok (W : Window; Flag : Curses_Bool) return C_Int; pragma Import (C, Clear_Ok, "clearok"); begin - if Clear_Ok (Win, Curses_Bool (Boolean'Pos (Do_Clear))) = Curses_Err then - raise Curses_Exception; + if Clear_Ok (Win, Curses_Bool (Boolean'Pos (Do_Clear))) = Curses_Err then + raise Curses_Exception; end if; - end Clear_On_Next_Update; + end Clear_On_Next_Update; - procedure Use_Insert_Delete_Line - (Win : Window := Standard_Window; - Do_Idl : Boolean := True) + procedure Use_Insert_Delete_Line + (Win : Window := Standard_Window; + Do_Idl : Boolean := True) is - function IDL_Ok (W : Window; Flag : Curses_Bool) return C_Int; + function IDL_Ok (W : Window; Flag : Curses_Bool) return C_Int; pragma Import (C, IDL_Ok, "idlok"); begin - if IDL_Ok (Win, Curses_Bool (Boolean'Pos (Do_Idl))) = Curses_Err then - raise Curses_Exception; + if IDL_Ok (Win, Curses_Bool (Boolean'Pos (Do_Idl))) = Curses_Err then + raise Curses_Exception; end if; - end Use_Insert_Delete_Line; + end Use_Insert_Delete_Line; - procedure Use_Insert_Delete_Character - (Win : Window := Standard_Window; - Do_Idc : Boolean := True) + procedure Use_Insert_Delete_Character + (Win : Window := Standard_Window; + Do_Idc : Boolean := True) is - procedure IDC_Ok (W : Window; Flag : Curses_Bool); + procedure IDC_Ok (W : Window; Flag : Curses_Bool); pragma Import (C, IDC_Ok, "idcok"); begin - IDC_Ok (Win, Curses_Bool (Boolean'Pos (Do_Idc))); - end Use_Insert_Delete_Character; + IDC_Ok (Win, Curses_Bool (Boolean'Pos (Do_Idc))); + end Use_Insert_Delete_Character; - procedure Leave_Cursor_After_Update - (Win : Window := Standard_Window; - Do_Leave : Boolean := True) + procedure Leave_Cursor_After_Update + (Win : Window := Standard_Window; + Do_Leave : Boolean := True) is - function Leave_Ok (W : Window; Flag : Curses_Bool) return C_Int; + function Leave_Ok (W : Window; Flag : Curses_Bool) return C_Int; pragma Import (C, Leave_Ok, "leaveok"); begin - if Leave_Ok (Win, Curses_Bool (Boolean'Pos (Do_Leave))) = Curses_Err then - raise Curses_Exception; + if Leave_Ok (Win, Curses_Bool (Boolean'Pos (Do_Leave))) = Curses_Err then + raise Curses_Exception; end if; - end Leave_Cursor_After_Update; + end Leave_Cursor_After_Update; - procedure Immediate_Update_Mode - (Win : Window := Standard_Window; - Mode : Boolean := False) + procedure Immediate_Update_Mode + (Win : Window := Standard_Window; + Mode : Boolean := False) is - procedure Immedok (Win : Window; Mode : Curses_Bool); + procedure Immedok (Win : Window; Mode : Curses_Bool); pragma Import (C, Immedok, "immedok"); begin - Immedok (Win, Curses_Bool (Boolean'Pos (Mode))); - end Immediate_Update_Mode; + Immedok (Win, Curses_Bool (Boolean'Pos (Mode))); + end Immediate_Update_Mode; - procedure Allow_Scrolling - (Win : Window := Standard_Window; - Mode : Boolean := False) + procedure Allow_Scrolling + (Win : Window := Standard_Window; + Mode : Boolean := False) is - function Scrollok (Win : Window; Mode : Curses_Bool) return C_Int; + function Scrollok (Win : Window; Mode : Curses_Bool) return C_Int; pragma Import (C, Scrollok, "scrollok"); begin - if Scrollok (Win, Curses_Bool (Boolean'Pos (Mode))) = Curses_Err then - raise Curses_Exception; + if Scrollok (Win, Curses_Bool (Boolean'Pos (Mode))) = Curses_Err then + raise Curses_Exception; end if; - end Allow_Scrolling; + end Allow_Scrolling; - function Scrolling_Allowed (Win : Window := Standard_Window) + function Scrolling_Allowed (Win : Window := Standard_Window) return Boolean is - function Is_Scroll_Ok (W : Window) return Curses_Bool; + function Is_Scroll_Ok (W : Window) return Curses_Bool; pragma Import (C, Is_Scroll_Ok, "is_scrollok"); begin - return (Is_Scroll_Ok (Win) /= Curses_Bool_False); - end Scrolling_Allowed; + return (Is_Scroll_Ok (Win) /= Curses_Bool_False); + end Scrolling_Allowed; - procedure Set_Scroll_Region - (Win : Window := Standard_Window; - Top_Line : Line_Position; - Bottom_Line : Line_Position) + procedure Set_Scroll_Region + (Win : Window := Standard_Window; + Top_Line : Line_Position; + Bottom_Line : Line_Position) is - function Wsetscrreg (Win : Window; - Lin : C_Int; - Col : C_Int) return C_Int; + function Wsetscrreg (Win : Window; + Lin : C_Int; + Col : C_Int) return C_Int; pragma Import (C, Wsetscrreg, "wsetscrreg"); begin - if Wsetscrreg (Win, C_Int (Top_Line), C_Int (Bottom_Line)) - = Curses_Err then - raise Curses_Exception; + if Wsetscrreg (Win, C_Int (Top_Line), C_Int (Bottom_Line)) + = Curses_Err + then + raise Curses_Exception; end if; - end Set_Scroll_Region; + end Set_Scroll_Region; ------------------------------------------------------------------------------ - procedure Update_Screen + procedure Update_Screen is - function Do_Update return C_Int; + function Do_Update return C_Int; pragma Import (C, Do_Update, "doupdate"); begin - if Do_Update = Curses_Err then - raise Curses_Exception; + if Do_Update = Curses_Err then + raise Curses_Exception; end if; - end Update_Screen; + end Update_Screen; - procedure Refresh (Win : Window := Standard_Window) + procedure Refresh (Win : Window := Standard_Window) is - function Wrefresh (W : Window) return C_Int; + function Wrefresh (W : Window) return C_Int; pragma Import (C, Wrefresh, "wrefresh"); begin - if Wrefresh (Win) = Curses_Err then - raise Curses_Exception; + if Wrefresh (Win) = Curses_Err then + raise Curses_Exception; end if; - end Refresh; + end Refresh; - procedure Refresh_Without_Update - (Win : Window := Standard_Window) + procedure Refresh_Without_Update + (Win : Window := Standard_Window) is - function Wnoutrefresh (W : Window) return C_Int; + function Wnoutrefresh (W : Window) return C_Int; pragma Import (C, Wnoutrefresh, "wnoutrefresh"); begin - if Wnoutrefresh (Win) = Curses_Err then - raise Curses_Exception; + if Wnoutrefresh (Win) = Curses_Err then + raise Curses_Exception; end if; - end Refresh_Without_Update; + end Refresh_Without_Update; - procedure Redraw (Win : Window := Standard_Window) + procedure Redraw (Win : Window := Standard_Window) is - function Redrawwin (Win : Window) return C_Int; + function Redrawwin (Win : Window) return C_Int; pragma Import (C, Redrawwin, "redrawwin"); begin - if Redrawwin (Win) = Curses_Err then - raise Curses_Exception; + if Redrawwin (Win) = Curses_Err then + raise Curses_Exception; end if; - end Redraw; + end Redraw; - procedure Redraw - (Win : Window := Standard_Window; - Begin_Line : Line_Position; - Line_Count : Positive) + procedure Redraw + (Win : Window := Standard_Window; + Begin_Line : Line_Position; + Line_Count : Positive) is - function Wredrawln (Win : Window; First : C_Int; Cnt : C_Int) - return C_Int; + function Wredrawln (Win : Window; First : C_Int; Cnt : C_Int) + return C_Int; pragma Import (C, Wredrawln, "wredrawln"); begin - if Wredrawln (Win, - C_Int (Begin_Line), - C_Int (Line_Count)) = Curses_Err then - raise Curses_Exception; + if Wredrawln (Win, + C_Int (Begin_Line), + C_Int (Line_Count)) = Curses_Err + then + raise Curses_Exception; end if; - end Redraw; + end Redraw; ------------------------------------------------------------------------------ - procedure Erase (Win : Window := Standard_Window) + procedure Erase (Win : Window := Standard_Window) is - function Werase (W : Window) return C_Int; + function Werase (W : Window) return C_Int; pragma Import (C, Werase, "werase"); begin - if Werase (Win) = Curses_Err then - raise Curses_Exception; + if Werase (Win) = Curses_Err then + raise Curses_Exception; end if; - end Erase; + end Erase; - procedure Clear (Win : Window := Standard_Window) + procedure Clear (Win : Window := Standard_Window) is - function Wclear (W : Window) return C_Int; + function Wclear (W : Window) return C_Int; pragma Import (C, Wclear, "wclear"); begin - if Wclear (Win) = Curses_Err then - raise Curses_Exception; + if Wclear (Win) = Curses_Err then + raise Curses_Exception; end if; - end Clear; + end Clear; - procedure Clear_To_End_Of_Screen (Win : Window := Standard_Window) + procedure Clear_To_End_Of_Screen (Win : Window := Standard_Window) is - function Wclearbot (W : Window) return C_Int; + function Wclearbot (W : Window) return C_Int; pragma Import (C, Wclearbot, "wclrtobot"); begin - if Wclearbot (Win) = Curses_Err then - raise Curses_Exception; + if Wclearbot (Win) = Curses_Err then + raise Curses_Exception; end if; - end Clear_To_End_Of_Screen; + end Clear_To_End_Of_Screen; - procedure Clear_To_End_Of_Line (Win : Window := Standard_Window) + procedure Clear_To_End_Of_Line (Win : Window := Standard_Window) is - function Wcleareol (W : Window) return C_Int; + function Wcleareol (W : Window) return C_Int; pragma Import (C, Wcleareol, "wclrtoeol"); begin - if Wcleareol (Win) = Curses_Err then - raise Curses_Exception; + if Wcleareol (Win) = Curses_Err then + raise Curses_Exception; end if; - end Clear_To_End_Of_Line; + end Clear_To_End_Of_Line; ------------------------------------------------------------------------------ - procedure Set_Background - (Win : Window := Standard_Window; - Ch : Attributed_Character) + procedure Set_Background + (Win : Window := Standard_Window; + Ch : Attributed_Character) is - procedure WBackground (W : Window; Ch : C_Chtype); + procedure WBackground (W : Window; Ch : Attributed_Character); pragma Import (C, WBackground, "wbkgdset"); begin - WBackground (Win, AttrChar_To_Chtype (Ch)); - end Set_Background; + WBackground (Win, Ch); + end Set_Background; - procedure Change_Background - (Win : Window := Standard_Window; - Ch : Attributed_Character) + procedure Change_Background + (Win : Window := Standard_Window; + Ch : Attributed_Character) is - function WChangeBkgd (W : Window; Ch : C_Chtype) return C_Int; + function WChangeBkgd (W : Window; Ch : Attributed_Character) + return C_Int; pragma Import (C, WChangeBkgd, "wbkgd"); begin - if WChangeBkgd (Win, AttrChar_To_Chtype (Ch)) = Curses_Err then - raise Curses_Exception; + if WChangeBkgd (Win, Ch) = Curses_Err then + raise Curses_Exception; end if; - end Change_Background; + end Change_Background; - function Get_Background (Win : Window := Standard_Window) - return Attributed_Character + function Get_Background (Win : Window := Standard_Window) + return Attributed_Character is - function Wgetbkgd (Win : Window) return C_Chtype; + function Wgetbkgd (Win : Window) return Attributed_Character; pragma Import (C, Wgetbkgd, "getbkgd"); begin - return Chtype_To_AttrChar (Wgetbkgd (Win)); - end Get_Background; + return Wgetbkgd (Win); + end Get_Background; ------------------------------------------------------------------------------ - procedure Change_Lines_Status (Win : Window := Standard_Window; - Start : Line_Position; - Count : Positive; - State : Boolean) - is - function Wtouchln (Win : Window; - Sta : C_Int; - Cnt : C_Int; - Chg : C_Int) return C_Int; + procedure Change_Lines_Status (Win : Window := Standard_Window; + Start : Line_Position; + Count : Positive; + State : Boolean) + is + function Wtouchln (Win : Window; + Sta : C_Int; + Cnt : C_Int; + Chg : C_Int) return C_Int; pragma Import (C, Wtouchln, "wtouchln"); begin - if Wtouchln (Win, C_Int (Start), C_Int (Count), - C_Int (Boolean'Pos (State))) = Curses_Err then - raise Curses_Exception; + if Wtouchln (Win, C_Int (Start), C_Int (Count), + C_Int (Boolean'Pos (State))) = Curses_Err + then + raise Curses_Exception; end if; - end Change_Lines_Status; + end Change_Lines_Status; - procedure Touch (Win : Window := Standard_Window) + procedure Touch (Win : Window := Standard_Window) is - Y : Line_Position; - X : Column_Position; + Y : Line_Position; + X : Column_Position; begin - Get_Size (Win, Y, X); - pragma Unreferenced (X); - Change_Lines_Status (Win, 0, Positive (Y), True); - end Touch; + Get_Size (Win, Y, X); + pragma Warnings (Off, X); -- unreferenced + Change_Lines_Status (Win, 0, Positive (Y), True); + end Touch; - procedure Untouch (Win : Window := Standard_Window) + procedure Untouch (Win : Window := Standard_Window) is - Y : Line_Position; - X : Column_Position; + Y : Line_Position; + X : Column_Position; begin - Get_Size (Win, Y, X); - pragma Unreferenced (X); - Change_Lines_Status (Win, 0, Positive (Y), False); - end Untouch; + Get_Size (Win, Y, X); + pragma Warnings (Off, X); -- unreferenced + Change_Lines_Status (Win, 0, Positive (Y), False); + end Untouch; - procedure Touch (Win : Window := Standard_Window; - Start : Line_Position; - Count : Positive) + procedure Touch (Win : Window := Standard_Window; + Start : Line_Position; + Count : Positive) is begin - Change_Lines_Status (Win, Start, Count, True); - end Touch; + Change_Lines_Status (Win, Start, Count, True); + end Touch; - function Is_Touched - (Win : Window := Standard_Window; - Line : Line_Position) return Boolean + function Is_Touched + (Win : Window := Standard_Window; + Line : Line_Position) return Boolean is - function WLineTouched (W : Window; L : C_Int) return Curses_Bool; + function WLineTouched (W : Window; L : C_Int) return Curses_Bool; pragma Import (C, WLineTouched, "is_linetouched"); begin - if WLineTouched (Win, C_Int (Line)) = Curses_Bool_False then + if WLineTouched (Win, C_Int (Line)) = Curses_Bool_False then return False; else return True; end if; - end Is_Touched; + end Is_Touched; - function Is_Touched - (Win : Window := Standard_Window) return Boolean + function Is_Touched + (Win : Window := Standard_Window) return Boolean is - function WWinTouched (W : Window) return Curses_Bool; + function WWinTouched (W : Window) return Curses_Bool; pragma Import (C, WWinTouched, "is_wintouched"); begin - if WWinTouched (Win) = Curses_Bool_False then + if WWinTouched (Win) = Curses_Bool_False then return False; else return True; end if; - end Is_Touched; + end Is_Touched; ------------------------------------------------------------------------------ - procedure Copy - (Source_Window : Window; - Destination_Window : Window; - Source_Top_Row : Line_Position; - Source_Left_Column : Column_Position; - Destination_Top_Row : Line_Position; - Destination_Left_Column : Column_Position; - Destination_Bottom_Row : Line_Position; - Destination_Right_Column : Column_Position; - Non_Destructive_Mode : Boolean := True) - is - function Copywin (Src : Window; - Dst : Window; - Str : C_Int; - Slc : C_Int; - Dtr : C_Int; - Dlc : C_Int; - Dbr : C_Int; - Drc : C_Int; - Ndm : C_Int) return C_Int; + procedure Copy + (Source_Window : Window; + Destination_Window : Window; + Source_Top_Row : Line_Position; + Source_Left_Column : Column_Position; + Destination_Top_Row : Line_Position; + Destination_Left_Column : Column_Position; + Destination_Bottom_Row : Line_Position; + Destination_Right_Column : Column_Position; + Non_Destructive_Mode : Boolean := True) + is + function Copywin (Src : Window; + Dst : Window; + Str : C_Int; + Slc : C_Int; + Dtr : C_Int; + Dlc : C_Int; + Dbr : C_Int; + Drc : C_Int; + Ndm : C_Int) return C_Int; pragma Import (C, Copywin, "copywin"); begin - if Copywin (Source_Window, - Destination_Window, - C_Int (Source_Top_Row), - C_Int (Source_Left_Column), - C_Int (Destination_Top_Row), - C_Int (Destination_Left_Column), - C_Int (Destination_Bottom_Row), - C_Int (Destination_Right_Column), - Boolean'Pos (Non_Destructive_Mode) - ) = Curses_Err then - raise Curses_Exception; - end if; - end Copy; - - procedure Overwrite - (Source_Window : Window; - Destination_Window : Window) - is - function Overwrite (Src : Window; Dst : Window) return C_Int; + if Copywin (Source_Window, + Destination_Window, + C_Int (Source_Top_Row), + C_Int (Source_Left_Column), + C_Int (Destination_Top_Row), + C_Int (Destination_Left_Column), + C_Int (Destination_Bottom_Row), + C_Int (Destination_Right_Column), + Boolean'Pos (Non_Destructive_Mode) + ) = Curses_Err + then + raise Curses_Exception; + end if; + end Copy; + + procedure Overwrite + (Source_Window : Window; + Destination_Window : Window) + is + function Overwrite (Src : Window; Dst : Window) return C_Int; pragma Import (C, Overwrite, "overwrite"); begin - if Overwrite (Source_Window, Destination_Window) = Curses_Err then - raise Curses_Exception; + if Overwrite (Source_Window, Destination_Window) = Curses_Err then + raise Curses_Exception; end if; - end Overwrite; + end Overwrite; - procedure Overlay - (Source_Window : Window; - Destination_Window : Window) + procedure Overlay + (Source_Window : Window; + Destination_Window : Window) is - function Overlay (Src : Window; Dst : Window) return C_Int; + function Overlay (Src : Window; Dst : Window) return C_Int; pragma Import (C, Overlay, "overlay"); begin - if Overlay (Source_Window, Destination_Window) = Curses_Err then - raise Curses_Exception; + if Overlay (Source_Window, Destination_Window) = Curses_Err then + raise Curses_Exception; end if; - end Overlay; + end Overlay; ------------------------------------------------------------------------------ - procedure Insert_Delete_Lines - (Win : Window := Standard_Window; - Lines : Integer := 1) -- default is to insert one line above + procedure Insert_Delete_Lines + (Win : Window := Standard_Window; + Lines : Integer := 1) -- default is to insert one line above is - function Winsdelln (W : Window; N : C_Int) return C_Int; + function Winsdelln (W : Window; N : C_Int) return C_Int; pragma Import (C, Winsdelln, "winsdelln"); begin - if Winsdelln (Win, C_Int (Lines)) = Curses_Err then - raise Curses_Exception; + if Winsdelln (Win, C_Int (Lines)) = Curses_Err then + raise Curses_Exception; end if; - end Insert_Delete_Lines; + end Insert_Delete_Lines; - procedure Delete_Line (Win : Window := Standard_Window) + procedure Delete_Line (Win : Window := Standard_Window) is begin - Insert_Delete_Lines (Win, -1); - end Delete_Line; + Insert_Delete_Lines (Win, -1); + end Delete_Line; - procedure Insert_Line (Win : Window := Standard_Window) + procedure Insert_Line (Win : Window := Standard_Window) is begin - Insert_Delete_Lines (Win, 1); - end Insert_Line; + Insert_Delete_Lines (Win, 1); + end Insert_Line; ------------------------------------------------------------------------------ - procedure Get_Size - (Win : Window := Standard_Window; - Number_Of_Lines : out Line_Count; - Number_Of_Columns : out Column_Count) + procedure Get_Size + (Win : Window := Standard_Window; + Number_Of_Lines : out Line_Count; + Number_Of_Columns : out Column_Count) is - function GetMaxY (W : Window) return C_Int; + function GetMaxY (W : Window) return C_Int; pragma Import (C, GetMaxY, "getmaxy"); - function GetMaxX (W : Window) return C_Int; + function GetMaxX (W : Window) return C_Int; pragma Import (C, GetMaxX, "getmaxx"); - Y : constant C_Int := GetMaxY (Win); - X : constant C_Int := GetMaxX (Win); + Y : constant C_Int := GetMaxY (Win); + X : constant C_Int := GetMaxX (Win); begin - Number_Of_Lines := Line_Count (Y); - Number_Of_Columns := Column_Count (X); - end Get_Size; + Number_Of_Lines := Line_Count (Y); + Number_Of_Columns := Column_Count (X); + end Get_Size; - procedure Get_Window_Position - (Win : Window := Standard_Window; - Top_Left_Line : out Line_Position; - Top_Left_Column : out Column_Position) + procedure Get_Window_Position + (Win : Window := Standard_Window; + Top_Left_Line : out Line_Position; + Top_Left_Column : out Column_Position) is - function GetBegY (W : Window) return C_Int; + function GetBegY (W : Window) return C_Int; pragma Import (C, GetBegY, "getbegy"); - function GetBegX (W : Window) return C_Int; + function GetBegX (W : Window) return C_Int; pragma Import (C, GetBegX, "getbegx"); - Y : constant C_Short := C_Short (GetBegY (Win)); - X : constant C_Short := C_Short (GetBegX (Win)); + Y : constant C_Short := C_Short (GetBegY (Win)); + X : constant C_Short := C_Short (GetBegX (Win)); begin - Top_Left_Line := Line_Position (Y); - Top_Left_Column := Column_Position (X); - end Get_Window_Position; + Top_Left_Line := Line_Position (Y); + Top_Left_Column := Column_Position (X); + end Get_Window_Position; - procedure Get_Cursor_Position - (Win : Window := Standard_Window; - Line : out Line_Position; - Column : out Column_Position) + procedure Get_Cursor_Position + (Win : Window := Standard_Window; + Line : out Line_Position; + Column : out Column_Position) is - function GetCurY (W : Window) return C_Int; + function GetCurY (W : Window) return C_Int; pragma Import (C, GetCurY, "getcury"); - function GetCurX (W : Window) return C_Int; + function GetCurX (W : Window) return C_Int; pragma Import (C, GetCurX, "getcurx"); - Y : constant C_Short := C_Short (GetCurY (Win)); - X : constant C_Short := C_Short (GetCurX (Win)); + Y : constant C_Short := C_Short (GetCurY (Win)); + X : constant C_Short := C_Short (GetCurX (Win)); begin - Line := Line_Position (Y); - Column := Column_Position (X); - end Get_Cursor_Position; + Line := Line_Position (Y); + Column := Column_Position (X); + end Get_Cursor_Position; - procedure Get_Origin_Relative_To_Parent - (Win : Window; - Top_Left_Line : out Line_Position; - Top_Left_Column : out Column_Position; - Is_Not_A_Subwindow : out Boolean) + procedure Get_Origin_Relative_To_Parent + (Win : Window; + Top_Left_Line : out Line_Position; + Top_Left_Column : out Column_Position; + Is_Not_A_Subwindow : out Boolean) is - function GetParY (W : Window) return C_Int; + function GetParY (W : Window) return C_Int; pragma Import (C, GetParY, "getpary"); - function GetParX (W : Window) return C_Int; + function GetParX (W : Window) return C_Int; pragma Import (C, GetParX, "getparx"); - Y : constant C_Int := GetParY (Win); - X : constant C_Int := GetParX (Win); + Y : constant C_Int := GetParY (Win); + X : constant C_Int := GetParX (Win); begin - if Y = -1 then - Top_Left_Line := Line_Position'Last; - Top_Left_Column := Column_Position'Last; - Is_Not_A_Subwindow := True; + if Y = -1 then + Top_Left_Line := Line_Position'Last; + Top_Left_Column := Column_Position'Last; + Is_Not_A_Subwindow := True; else - Top_Left_Line := Line_Position (Y); - Top_Left_Column := Column_Position (X); - Is_Not_A_Subwindow := False; + Top_Left_Line := Line_Position (Y); + Top_Left_Column := Column_Position (X); + Is_Not_A_Subwindow := False; end if; - end Get_Origin_Relative_To_Parent; + end Get_Origin_Relative_To_Parent; ------------------------------------------------------------------------------ - function New_Pad (Lines : Line_Count; - Columns : Column_Count) return Window + function New_Pad (Lines : Line_Count; + Columns : Column_Count) return Window is - function Newpad (Lines : C_Int; Columns : C_Int) return Window; + function Newpad (Lines : C_Int; Columns : C_Int) return Window; pragma Import (C, Newpad, "newpad"); - W : Window; + W : Window; begin - W := Newpad (C_Int (Lines), C_Int (Columns)); - if W = Null_Window then - raise Curses_Exception; + W := Newpad (C_Int (Lines), C_Int (Columns)); + if W = Null_Window then + raise Curses_Exception; end if; - return W; - end New_Pad; + return W; + end New_Pad; - function Sub_Pad - (Pad : Window; - Number_Of_Lines : Line_Count; - Number_Of_Columns : Column_Count; - First_Line_Position : Line_Position; - First_Column_Position : Column_Position) return Window + function Sub_Pad + (Pad : Window; + Number_Of_Lines : Line_Count; + Number_Of_Columns : Column_Count; + First_Line_Position : Line_Position; + First_Column_Position : Column_Position) return Window is - function Subpad - (Pad : Window; - Number_Of_Lines : C_Int; - Number_Of_Columns : C_Int; - First_Line_Position : C_Int; - First_Column_Position : C_Int) return Window; + function Subpad + (Pad : Window; + Number_Of_Lines : C_Int; + Number_Of_Columns : C_Int; + First_Line_Position : C_Int; + First_Column_Position : C_Int) return Window; pragma Import (C, Subpad, "subpad"); - W : Window; - begin - W := Subpad (Pad, - C_Int (Number_Of_Lines), - C_Int (Number_Of_Columns), - C_Int (First_Line_Position), - C_Int (First_Column_Position)); - if W = Null_Window then - raise Curses_Exception; - end if; - return W; - end Sub_Pad; - - procedure Refresh - (Pad : Window; - Source_Top_Row : Line_Position; - Source_Left_Column : Column_Position; - Destination_Top_Row : Line_Position; - Destination_Left_Column : Column_Position; - Destination_Bottom_Row : Line_Position; - Destination_Right_Column : Column_Position) - is - function Prefresh - (Pad : Window; - Source_Top_Row : C_Int; - Source_Left_Column : C_Int; - Destination_Top_Row : C_Int; - Destination_Left_Column : C_Int; - Destination_Bottom_Row : C_Int; - Destination_Right_Column : C_Int) return C_Int; + W : Window; + begin + W := Subpad (Pad, + C_Int (Number_Of_Lines), + C_Int (Number_Of_Columns), + C_Int (First_Line_Position), + C_Int (First_Column_Position)); + if W = Null_Window then + raise Curses_Exception; + end if; + return W; + end Sub_Pad; + + procedure Refresh + (Pad : Window; + Source_Top_Row : Line_Position; + Source_Left_Column : Column_Position; + Destination_Top_Row : Line_Position; + Destination_Left_Column : Column_Position; + Destination_Bottom_Row : Line_Position; + Destination_Right_Column : Column_Position) + is + function Prefresh + (Pad : Window; + Source_Top_Row : C_Int; + Source_Left_Column : C_Int; + Destination_Top_Row : C_Int; + Destination_Left_Column : C_Int; + Destination_Bottom_Row : C_Int; + Destination_Right_Column : C_Int) return C_Int; pragma Import (C, Prefresh, "prefresh"); begin - if Prefresh (Pad, - C_Int (Source_Top_Row), - C_Int (Source_Left_Column), - C_Int (Destination_Top_Row), - C_Int (Destination_Left_Column), - C_Int (Destination_Bottom_Row), - C_Int (Destination_Right_Column)) = Curses_Err then - raise Curses_Exception; - end if; - end Refresh; - - procedure Refresh_Without_Update - (Pad : Window; - Source_Top_Row : Line_Position; - Source_Left_Column : Column_Position; - Destination_Top_Row : Line_Position; - Destination_Left_Column : Column_Position; - Destination_Bottom_Row : Line_Position; - Destination_Right_Column : Column_Position) - is - function Pnoutrefresh - (Pad : Window; - Source_Top_Row : C_Int; - Source_Left_Column : C_Int; - Destination_Top_Row : C_Int; - Destination_Left_Column : C_Int; - Destination_Bottom_Row : C_Int; - Destination_Right_Column : C_Int) return C_Int; + if Prefresh (Pad, + C_Int (Source_Top_Row), + C_Int (Source_Left_Column), + C_Int (Destination_Top_Row), + C_Int (Destination_Left_Column), + C_Int (Destination_Bottom_Row), + C_Int (Destination_Right_Column)) = Curses_Err + then + raise Curses_Exception; + end if; + end Refresh; + + procedure Refresh_Without_Update + (Pad : Window; + Source_Top_Row : Line_Position; + Source_Left_Column : Column_Position; + Destination_Top_Row : Line_Position; + Destination_Left_Column : Column_Position; + Destination_Bottom_Row : Line_Position; + Destination_Right_Column : Column_Position) + is + function Pnoutrefresh + (Pad : Window; + Source_Top_Row : C_Int; + Source_Left_Column : C_Int; + Destination_Top_Row : C_Int; + Destination_Left_Column : C_Int; + Destination_Bottom_Row : C_Int; + Destination_Right_Column : C_Int) return C_Int; pragma Import (C, Pnoutrefresh, "pnoutrefresh"); begin - if Pnoutrefresh (Pad, - C_Int (Source_Top_Row), - C_Int (Source_Left_Column), - C_Int (Destination_Top_Row), - C_Int (Destination_Left_Column), - C_Int (Destination_Bottom_Row), - C_Int (Destination_Right_Column)) = Curses_Err then - raise Curses_Exception; + if Pnoutrefresh (Pad, + C_Int (Source_Top_Row), + C_Int (Source_Left_Column), + C_Int (Destination_Top_Row), + C_Int (Destination_Left_Column), + C_Int (Destination_Bottom_Row), + C_Int (Destination_Right_Column)) = Curses_Err + then + raise Curses_Exception; end if; - end Refresh_Without_Update; + end Refresh_Without_Update; - procedure Add_Character_To_Pad_And_Echo_It - (Pad : Window; - Ch : Attributed_Character) + procedure Add_Character_To_Pad_And_Echo_It + (Pad : Window; + Ch : Attributed_Character) is - function Pechochar (Pad : Window; Ch : C_Chtype) - return C_Int; + function Pechochar (Pad : Window; Ch : Attributed_Character) + return C_Int; pragma Import (C, Pechochar, "pechochar"); begin - if Pechochar (Pad, AttrChar_To_Chtype (Ch)) = Curses_Err then - raise Curses_Exception; + if Pechochar (Pad, Ch) = Curses_Err then + raise Curses_Exception; end if; - end Add_Character_To_Pad_And_Echo_It; + end Add_Character_To_Pad_And_Echo_It; - procedure Add_Character_To_Pad_And_Echo_It - (Pad : Window; - Ch : Character) + procedure Add_Character_To_Pad_And_Echo_It + (Pad : Window; + Ch : Character) is begin - Add_Character_To_Pad_And_Echo_It - (Pad, - Attributed_Character'(Ch => Ch, - Color => Color_Pair'First, - Attr => Normal_Video)); - end Add_Character_To_Pad_And_Echo_It; + Add_Character_To_Pad_And_Echo_It + (Pad, + Attributed_Character'(Ch => Ch, + Color => Color_Pair'First, + Attr => Normal_Video)); + end Add_Character_To_Pad_And_Echo_It; ------------------------------------------------------------------------------ - procedure Scroll (Win : Window := Standard_Window; - Amount : Integer := 1) + procedure Scroll (Win : Window := Standard_Window; + Amount : Integer := 1) is - function Wscrl (Win : Window; N : C_Int) return C_Int; + function Wscrl (Win : Window; N : C_Int) return C_Int; pragma Import (C, Wscrl, "wscrl"); begin - if Wscrl (Win, C_Int (Amount)) = Curses_Err then - raise Curses_Exception; + if Wscrl (Win, C_Int (Amount)) = Curses_Err then + raise Curses_Exception; end if; - end Scroll; + end Scroll; ------------------------------------------------------------------------------ - procedure Delete_Character (Win : Window := Standard_Window) + procedure Delete_Character (Win : Window := Standard_Window) is - function Wdelch (Win : Window) return C_Int; + function Wdelch (Win : Window) return C_Int; pragma Import (C, Wdelch, "wdelch"); begin - if Wdelch (Win) = Curses_Err then - raise Curses_Exception; + if Wdelch (Win) = Curses_Err then + raise Curses_Exception; end if; - end Delete_Character; + end Delete_Character; - procedure Delete_Character - (Win : Window := Standard_Window; - Line : Line_Position; - Column : Column_Position) + procedure Delete_Character + (Win : Window := Standard_Window; + Line : Line_Position; + Column : Column_Position) is - function Mvwdelch (Win : Window; - Lin : C_Int; - Col : C_Int) return C_Int; + function Mvwdelch (Win : Window; + Lin : C_Int; + Col : C_Int) return C_Int; pragma Import (C, Mvwdelch, "mvwdelch"); begin - if Mvwdelch (Win, C_Int (Line), C_Int (Column)) = Curses_Err then - raise Curses_Exception; + if Mvwdelch (Win, C_Int (Line), C_Int (Column)) = Curses_Err then + raise Curses_Exception; end if; - end Delete_Character; + end Delete_Character; ------------------------------------------------------------------------------ - function Peek (Win : Window := Standard_Window) - return Attributed_Character + function Peek (Win : Window := Standard_Window) + return Attributed_Character is - function Winch (Win : Window) return C_Chtype; + function Winch (Win : Window) return Attributed_Character; pragma Import (C, Winch, "winch"); begin - return Chtype_To_AttrChar (Winch (Win)); - end Peek; + return Winch (Win); + end Peek; - function Peek - (Win : Window := Standard_Window; - Line : Line_Position; - Column : Column_Position) return Attributed_Character + function Peek + (Win : Window := Standard_Window; + Line : Line_Position; + Column : Column_Position) return Attributed_Character is - function Mvwinch (Win : Window; - Lin : C_Int; - Col : C_Int) return C_Chtype; + function Mvwinch (Win : Window; + Lin : C_Int; + Col : C_Int) return Attributed_Character; pragma Import (C, Mvwinch, "mvwinch"); begin - return Chtype_To_AttrChar (Mvwinch (Win, C_Int (Line), C_Int (Column))); - end Peek; + return Mvwinch (Win, C_Int (Line), C_Int (Column)); + end Peek; ------------------------------------------------------------------------------ - procedure Insert (Win : Window := Standard_Window; - Ch : Attributed_Character) + procedure Insert (Win : Window := Standard_Window; + Ch : Attributed_Character) is - function Winsch (Win : Window; Ch : C_Chtype) return C_Int; + function Winsch (Win : Window; Ch : Attributed_Character) return C_Int; pragma Import (C, Winsch, "winsch"); begin - if Winsch (Win, AttrChar_To_Chtype (Ch)) = Curses_Err then - raise Curses_Exception; + if Winsch (Win, Ch) = Curses_Err then + raise Curses_Exception; end if; - end Insert; + end Insert; - procedure Insert - (Win : Window := Standard_Window; - Line : Line_Position; - Column : Column_Position; - Ch : Attributed_Character) + procedure Insert + (Win : Window := Standard_Window; + Line : Line_Position; + Column : Column_Position; + Ch : Attributed_Character) is - function Mvwinsch (Win : Window; - Lin : C_Int; - Col : C_Int; - Ch : C_Chtype) return C_Int; + function Mvwinsch (Win : Window; + Lin : C_Int; + Col : C_Int; + Ch : Attributed_Character) return C_Int; pragma Import (C, Mvwinsch, "mvwinsch"); begin - if Mvwinsch (Win, - C_Int (Line), - C_Int (Column), - AttrChar_To_Chtype (Ch)) = Curses_Err then - raise Curses_Exception; + if Mvwinsch (Win, + C_Int (Line), + C_Int (Column), + Ch) = Curses_Err + then + raise Curses_Exception; end if; - end Insert; + end Insert; ------------------------------------------------------------------------------ - procedure Insert (Win : Window := Standard_Window; - Str : String; - Len : Integer := -1) + procedure Insert (Win : Window := Standard_Window; + Str : String; + Len : Integer := -1) is - function Winsnstr (Win : Window; - Str : char_array; - Len : Integer := -1) return C_Int; + function Winsnstr (Win : Window; + Str : char_array; + Len : Integer := -1) return C_Int; pragma Import (C, Winsnstr, "winsnstr"); - Txt : char_array (0 .. Str'Length); - Length : size_t; + Txt : char_array (0 .. Str'Length); + Length : size_t; begin - To_C (Str, Txt, Length); - if Winsnstr (Win, Txt, Len) = Curses_Err then - raise Curses_Exception; + To_C (Str, Txt, Length); + if Winsnstr (Win, Txt, Len) = Curses_Err then + raise Curses_Exception; end if; - end Insert; + end Insert; - procedure Insert - (Win : Window := Standard_Window; - Line : Line_Position; - Column : Column_Position; - Str : String; - Len : Integer := -1) + procedure Insert + (Win : Window := Standard_Window; + Line : Line_Position; + Column : Column_Position; + Str : String; + Len : Integer := -1) is - function Mvwinsnstr (Win : Window; - Line : C_Int; - Column : C_Int; - Str : char_array; - Len : C_Int) return C_Int; + function Mvwinsnstr (Win : Window; + Line : C_Int; + Column : C_Int; + Str : char_array; + Len : C_Int) return C_Int; pragma Import (C, Mvwinsnstr, "mvwinsnstr"); - Txt : char_array (0 .. Str'Length); - Length : size_t; + Txt : char_array (0 .. Str'Length); + Length : size_t; begin - To_C (Str, Txt, Length); - if Mvwinsnstr (Win, C_Int (Line), C_Int (Column), Txt, C_Int (Len)) - = Curses_Err then - raise Curses_Exception; + To_C (Str, Txt, Length); + if Mvwinsnstr (Win, C_Int (Line), C_Int (Column), Txt, C_Int (Len)) + = Curses_Err + then + raise Curses_Exception; end if; - end Insert; + end Insert; ------------------------------------------------------------------------------ - procedure Peek (Win : Window := Standard_Window; - Str : out String; - Len : Integer := -1) + procedure Peek (Win : Window := Standard_Window; + Str : out String; + Len : Integer := -1) is - function Winnstr (Win : Window; - Str : char_array; - Len : C_Int) return C_Int; + function Winnstr (Win : Window; + Str : char_array; + Len : C_Int) return C_Int; pragma Import (C, Winnstr, "winnstr"); - N : Integer := Len; - Txt : char_array (0 .. Str'Length); - Cnt : Natural; + N : Integer := Len; + Txt : char_array (0 .. Str'Length); + Cnt : Natural; begin - if N < 0 then - N := Str'Length; + if N < 0 then + N := Str'Length; end if; - if N > Str'Length then + if N > Str'Length then raise Constraint_Error; end if; - Txt (0) := Interfaces.C.char'First; - if Winnstr (Win, Txt, C_Int (N)) = Curses_Err then - raise Curses_Exception; + Txt (0) := Interfaces.C.char'First; + if Winnstr (Win, Txt, C_Int (N)) = Curses_Err then + raise Curses_Exception; end if; - To_Ada (Txt, Str, Cnt, True); - if Cnt < Str'Length then - Str ((Str'First + Cnt) .. Str'Last) := (others => ' '); + To_Ada (Txt, Str, Cnt, True); + if Cnt < Str'Length then + Str ((Str'First + Cnt) .. Str'Last) := (others => ' '); end if; - end Peek; + end Peek; - procedure Peek - (Win : Window := Standard_Window; - Line : Line_Position; - Column : Column_Position; - Str : out String; - Len : Integer := -1) + procedure Peek + (Win : Window := Standard_Window; + Line : Line_Position; + Column : Column_Position; + Str : out String; + Len : Integer := -1) is begin - Move_Cursor (Win, Line, Column); - Peek (Win, Str, Len); - end Peek; + Move_Cursor (Win, Line, Column); + Peek (Win, Str, Len); + end Peek; ------------------------------------------------------------------------------ - procedure Peek - (Win : Window := Standard_Window; - Str : out Attributed_String; - Len : Integer := -1) - is - function Winchnstr (Win : Window; - Str : chtype_array; -- out - Len : C_Int) return C_Int; + procedure Peek + (Win : Window := Standard_Window; + Str : out Attributed_String; + Len : Integer := -1) + is + function Winchnstr (Win : Window; + Str : chtype_array; -- out + Len : C_Int) return C_Int; pragma Import (C, Winchnstr, "winchnstr"); - N : Integer := Len; - Txt : constant chtype_array (0 .. Str'Length) - := (0 => Default_Character); - Cnt : Natural := 0; + N : Integer := Len; + Txt : constant chtype_array (0 .. Str'Length) + := (0 => Default_Character); + Cnt : Natural := 0; begin - if N < 0 then - N := Str'Length; + if N < 0 then + N := Str'Length; end if; - if N > Str'Length then + if N > Str'Length then raise Constraint_Error; end if; - if Winchnstr (Win, Txt, C_Int (N)) = Curses_Err then - raise Curses_Exception; + if Winchnstr (Win, Txt, C_Int (N)) = Curses_Err then + raise Curses_Exception; end if; - for To in Str'Range loop - exit when Txt (size_t (Cnt)) = Default_Character; - Str (To) := Txt (size_t (Cnt)); - Cnt := Cnt + 1; + for To in Str'Range loop + exit when Txt (size_t (Cnt)) = Default_Character; + Str (To) := Txt (size_t (Cnt)); + Cnt := Cnt + 1; end loop; - if Cnt < Str'Length then - Str ((Str'First + Cnt) .. Str'Last) := - (others => (Ch => ' ', - Color => Color_Pair'First, - Attr => Normal_Video)); + if Cnt < Str'Length then + Str ((Str'First + Cnt) .. Str'Last) := + (others => (Ch => ' ', + Color => Color_Pair'First, + Attr => Normal_Video)); end if; - end Peek; + end Peek; - procedure Peek - (Win : Window := Standard_Window; - Line : Line_Position; - Column : Column_Position; - Str : out Attributed_String; - Len : Integer := -1) + procedure Peek + (Win : Window := Standard_Window; + Line : Line_Position; + Column : Column_Position; + Str : out Attributed_String; + Len : Integer := -1) is begin - Move_Cursor (Win, Line, Column); - Peek (Win, Str, Len); - end Peek; + Move_Cursor (Win, Line, Column); + Peek (Win, Str, Len); + end Peek; ------------------------------------------------------------------------------ - procedure Get (Win : Window := Standard_Window; - Str : out String; - Len : Integer := -1) + procedure Get (Win : Window := Standard_Window; + Str : out String; + Len : Integer := -1) is - function Wgetnstr (Win : Window; - Str : char_array; - Len : C_Int) return C_Int; + function Wgetnstr (Win : Window; + Str : char_array; + Len : C_Int) return C_Int; pragma Import (C, Wgetnstr, "wgetnstr"); - N : Integer := Len; - Txt : char_array (0 .. Str'Length); - Cnt : Natural; + N : Integer := Len; + Txt : char_array (0 .. Str'Length); + Cnt : Natural; begin - if N < 0 then - N := Str'Length; + if N < 0 then + N := Str'Length; end if; - if N > Str'Length then + if N > Str'Length then raise Constraint_Error; end if; - Txt (0) := Interfaces.C.char'First; - if Wgetnstr (Win, Txt, C_Int (N)) = Curses_Err then - raise Curses_Exception; + Txt (0) := Interfaces.C.char'First; + if Wgetnstr (Win, Txt, C_Int (N)) = Curses_Err then + raise Curses_Exception; end if; - To_Ada (Txt, Str, Cnt, True); - if Cnt < Str'Length then - Str ((Str'First + Cnt) .. Str'Last) := (others => ' '); + To_Ada (Txt, Str, Cnt, True); + if Cnt < Str'Length then + Str ((Str'First + Cnt) .. Str'Last) := (others => ' '); end if; - end Get; + end Get; - procedure Get - (Win : Window := Standard_Window; - Line : Line_Position; - Column : Column_Position; - Str : out String; - Len : Integer := -1) + procedure Get + (Win : Window := Standard_Window; + Line : Line_Position; + Column : Column_Position; + Str : out String; + Len : Integer := -1) is begin - Move_Cursor (Win, Line, Column); - Get (Win, Str, Len); - end Get; + Move_Cursor (Win, Line, Column); + Get (Win, Str, Len); + end Get; ------------------------------------------------------------------------------ - procedure Init_Soft_Label_Keys - (Format : Soft_Label_Key_Format := Three_Two_Three) + procedure Init_Soft_Label_Keys + (Format : Soft_Label_Key_Format := Three_Two_Three) is - function Slk_Init (Fmt : C_Int) return C_Int; + function Slk_Init (Fmt : C_Int) return C_Int; pragma Import (C, Slk_Init, "slk_init"); begin - if Slk_Init (Soft_Label_Key_Format'Pos (Format)) = Curses_Err then - raise Curses_Exception; + if Slk_Init (Soft_Label_Key_Format'Pos (Format)) = Curses_Err then + raise Curses_Exception; end if; - end Init_Soft_Label_Keys; + end Init_Soft_Label_Keys; - procedure Set_Soft_Label_Key (Label : Label_Number; - Text : String; - Fmt : Label_Justification := Left) + procedure Set_Soft_Label_Key (Label : Label_Number; + Text : String; + Fmt : Label_Justification := Left) is - function Slk_Set (Label : C_Int; - Txt : char_array; - Fmt : C_Int) return C_Int; + function Slk_Set (Label : C_Int; + Txt : char_array; + Fmt : C_Int) return C_Int; pragma Import (C, Slk_Set, "slk_set"); - Txt : char_array (0 .. Text'Length); - Len : size_t; + Txt : char_array (0 .. Text'Length); + Len : size_t; begin - To_C (Text, Txt, Len); - if Slk_Set (C_Int (Label), Txt, - C_Int (Label_Justification'Pos (Fmt))) = Curses_Err then - raise Curses_Exception; + To_C (Text, Txt, Len); + if Slk_Set (C_Int (Label), Txt, + C_Int (Label_Justification'Pos (Fmt))) = Curses_Err + then + raise Curses_Exception; end if; - end Set_Soft_Label_Key; + end Set_Soft_Label_Key; - procedure Refresh_Soft_Label_Keys + procedure Refresh_Soft_Label_Keys is - function Slk_Refresh return C_Int; + function Slk_Refresh return C_Int; pragma Import (C, Slk_Refresh, "slk_refresh"); begin - if Slk_Refresh = Curses_Err then - raise Curses_Exception; + if Slk_Refresh = Curses_Err then + raise Curses_Exception; end if; - end Refresh_Soft_Label_Keys; + end Refresh_Soft_Label_Keys; - procedure Refresh_Soft_Label_Keys_Without_Update + procedure Refresh_Soft_Label_Keys_Without_Update is - function Slk_Noutrefresh return C_Int; + function Slk_Noutrefresh return C_Int; pragma Import (C, Slk_Noutrefresh, "slk_noutrefresh"); begin - if Slk_Noutrefresh = Curses_Err then - raise Curses_Exception; + if Slk_Noutrefresh = Curses_Err then + raise Curses_Exception; end if; - end Refresh_Soft_Label_Keys_Without_Update; + end Refresh_Soft_Label_Keys_Without_Update; - procedure Get_Soft_Label_Key (Label : Label_Number; - Text : out String) + procedure Get_Soft_Label_Key (Label : Label_Number; + Text : out String) is - function Slk_Label (Label : C_Int) return chars_ptr; + function Slk_Label (Label : C_Int) return chars_ptr; pragma Import (C, Slk_Label, "slk_label"); begin - Fill_String (Slk_Label (C_Int (Label)), Text); - end Get_Soft_Label_Key; + Fill_String (Slk_Label (C_Int (Label)), Text); + end Get_Soft_Label_Key; - function Get_Soft_Label_Key (Label : Label_Number) return String + function Get_Soft_Label_Key (Label : Label_Number) return String is - function Slk_Label (Label : C_Int) return chars_ptr; + function Slk_Label (Label : C_Int) return chars_ptr; pragma Import (C, Slk_Label, "slk_label"); begin - return Fill_String (Slk_Label (C_Int (Label))); - end Get_Soft_Label_Key; + return Fill_String (Slk_Label (C_Int (Label))); + end Get_Soft_Label_Key; - procedure Clear_Soft_Label_Keys + procedure Clear_Soft_Label_Keys is - function Slk_Clear return C_Int; + function Slk_Clear return C_Int; pragma Import (C, Slk_Clear, "slk_clear"); begin - if Slk_Clear = Curses_Err then - raise Curses_Exception; + if Slk_Clear = Curses_Err then + raise Curses_Exception; end if; - end Clear_Soft_Label_Keys; + end Clear_Soft_Label_Keys; - procedure Restore_Soft_Label_Keys + procedure Restore_Soft_Label_Keys is - function Slk_Restore return C_Int; + function Slk_Restore return C_Int; pragma Import (C, Slk_Restore, "slk_restore"); begin - if Slk_Restore = Curses_Err then - raise Curses_Exception; + if Slk_Restore = Curses_Err then + raise Curses_Exception; end if; - end Restore_Soft_Label_Keys; + end Restore_Soft_Label_Keys; - procedure Touch_Soft_Label_Keys + procedure Touch_Soft_Label_Keys is - function Slk_Touch return C_Int; + function Slk_Touch return C_Int; pragma Import (C, Slk_Touch, "slk_touch"); begin - if Slk_Touch = Curses_Err then - raise Curses_Exception; + if Slk_Touch = Curses_Err then + raise Curses_Exception; end if; - end Touch_Soft_Label_Keys; + end Touch_Soft_Label_Keys; - procedure Switch_Soft_Label_Key_Attributes - (Attr : Character_Attribute_Set; - On : Boolean := True) + procedure Switch_Soft_Label_Key_Attributes + (Attr : Character_Attribute_Set; + On : Boolean := True) is - function Slk_Attron (Ch : C_Chtype) return C_Int; + function Slk_Attron (Ch : Attributed_Character) return C_Int; pragma Import (C, Slk_Attron, "slk_attron"); - function Slk_Attroff (Ch : C_Chtype) return C_Int; + function Slk_Attroff (Ch : Attributed_Character) return C_Int; pragma Import (C, Slk_Attroff, "slk_attroff"); - Err : C_Int; - Ch : constant Attributed_Character := (Ch => Character'First, - Attr => Attr, - Color => Color_Pair'First); + Err : C_Int; + Ch : constant Attributed_Character := (Ch => Character'First, + Attr => Attr, + Color => Color_Pair'First); begin - if On then - Err := Slk_Attron (AttrChar_To_Chtype (Ch)); + if On then + Err := Slk_Attron (Ch); else - Err := Slk_Attroff (AttrChar_To_Chtype (Ch)); + Err := Slk_Attroff (Ch); end if; - if Err = Curses_Err then - raise Curses_Exception; + if Err = Curses_Err then + raise Curses_Exception; end if; - end Switch_Soft_Label_Key_Attributes; + end Switch_Soft_Label_Key_Attributes; - procedure Set_Soft_Label_Key_Attributes - (Attr : Character_Attribute_Set := Normal_Video; - Color : Color_Pair := Color_Pair'First) + procedure Set_Soft_Label_Key_Attributes + (Attr : Character_Attribute_Set := Normal_Video; + Color : Color_Pair := Color_Pair'First) is - function Slk_Attrset (Ch : C_Chtype) return C_Int; + function Slk_Attrset (Ch : Attributed_Character) return C_Int; pragma Import (C, Slk_Attrset, "slk_attrset"); - Ch : constant Attributed_Character := (Ch => Character'First, - Attr => Attr, - Color => Color); + Ch : constant Attributed_Character := (Ch => Character'First, + Attr => Attr, + Color => Color); begin - if Slk_Attrset (AttrChar_To_Chtype (Ch)) = Curses_Err then - raise Curses_Exception; + if Slk_Attrset (Ch) = Curses_Err then + raise Curses_Exception; end if; - end Set_Soft_Label_Key_Attributes; + end Set_Soft_Label_Key_Attributes; - function Get_Soft_Label_Key_Attributes return Character_Attribute_Set + function Get_Soft_Label_Key_Attributes return Character_Attribute_Set is - function Slk_Attr return C_Chtype; + function Slk_Attr return Attributed_Character; pragma Import (C, Slk_Attr, "slk_attr"); - Attr : constant C_Chtype := Slk_Attr; + Attr : constant Attributed_Character := Slk_Attr; begin - return Chtype_To_AttrChar (Attr).Attr; - end Get_Soft_Label_Key_Attributes; + return Attr.Attr; + end Get_Soft_Label_Key_Attributes; - function Get_Soft_Label_Key_Attributes return Color_Pair + function Get_Soft_Label_Key_Attributes return Color_Pair is - function Slk_Attr return C_Chtype; + function Slk_Attr return Attributed_Character; pragma Import (C, Slk_Attr, "slk_attr"); - Attr : constant C_Chtype := Slk_Attr; + Attr : constant Attributed_Character := Slk_Attr; begin - return Chtype_To_AttrChar (Attr).Color; - end Get_Soft_Label_Key_Attributes; + return Attr.Color; + end Get_Soft_Label_Key_Attributes; - procedure Set_Soft_Label_Key_Color (Pair : Color_Pair) + procedure Set_Soft_Label_Key_Color (Pair : Color_Pair) is - function Slk_Color (Color : C_Short) return C_Int; + function Slk_Color (Color : C_Short) return C_Int; pragma Import (C, Slk_Color, "slk_color"); begin - if Slk_Color (C_Short (Pair)) = Curses_Err then - raise Curses_Exception; + if Slk_Color (C_Short (Pair)) = Curses_Err then + raise Curses_Exception; end if; - end Set_Soft_Label_Key_Color; + end Set_Soft_Label_Key_Color; ------------------------------------------------------------------------------ - procedure Enable_Key (Key : Special_Key_Code; - Enable : Boolean := True) + procedure Enable_Key (Key : Special_Key_Code; + Enable : Boolean := True) is - function Keyok (Keycode : C_Int; - On_Off : Curses_Bool) return C_Int; + function Keyok (Keycode : C_Int; + On_Off : Curses_Bool) return C_Int; pragma Import (C, Keyok, "keyok"); begin - if Keyok (C_Int (Key), Curses_Bool (Boolean'Pos (Enable))) - = Curses_Err then - raise Curses_Exception; + if Keyok (C_Int (Key), Curses_Bool (Boolean'Pos (Enable))) + = Curses_Err + then + raise Curses_Exception; end if; - end Enable_Key; + end Enable_Key; ------------------------------------------------------------------------------ - procedure Define_Key (Definition : String; - Key : Special_Key_Code) + procedure Define_Key (Definition : String; + Key : Special_Key_Code) is - function Defkey (Def : char_array; - Key : C_Int) return C_Int; + function Defkey (Def : char_array; + Key : C_Int) return C_Int; pragma Import (C, Defkey, "define_key"); - Txt : char_array (0 .. Definition'Length); - Length : size_t; + Txt : char_array (0 .. Definition'Length); + Length : size_t; begin - To_C (Definition, Txt, Length); - if Defkey (Txt, C_Int (Key)) = Curses_Err then - raise Curses_Exception; + To_C (Definition, Txt, Length); + if Defkey (Txt, C_Int (Key)) = Curses_Err then + raise Curses_Exception; end if; - end Define_Key; + end Define_Key; ------------------------------------------------------------------------------ - procedure Un_Control (Ch : Attributed_Character; - Str : out String) + procedure Un_Control (Ch : Attributed_Character; + Str : out String) is - function Unctrl (Ch : C_Chtype) return chars_ptr; + function Unctrl (Ch : Attributed_Character) return chars_ptr; pragma Import (C, Unctrl, "unctrl"); begin - Fill_String (Unctrl (AttrChar_To_Chtype (Ch)), Str); - end Un_Control; + Fill_String (Unctrl (Ch), Str); + end Un_Control; - function Un_Control (Ch : Attributed_Character) return String + function Un_Control (Ch : Attributed_Character) return String is - function Unctrl (Ch : C_Chtype) return chars_ptr; + function Unctrl (Ch : Attributed_Character) return chars_ptr; pragma Import (C, Unctrl, "unctrl"); begin - return Fill_String (Unctrl (AttrChar_To_Chtype (Ch))); - end Un_Control; + return Fill_String (Unctrl (Ch)); + end Un_Control; - procedure Delay_Output (Msecs : Natural) + procedure Delay_Output (Msecs : Natural) is - function Delayoutput (Msecs : C_Int) return C_Int; + function Delayoutput (Msecs : C_Int) return C_Int; pragma Import (C, Delayoutput, "delay_output"); begin - if Delayoutput (C_Int (Msecs)) = Curses_Err then - raise Curses_Exception; + if Delayoutput (C_Int (Msecs)) = Curses_Err then + raise Curses_Exception; end if; - end Delay_Output; + end Delay_Output; - procedure Flush_Input + procedure Flush_Input is - function Flushinp return C_Int; + function Flushinp return C_Int; pragma Import (C, Flushinp, "flushinp"); begin - if Flushinp = Curses_Err then -- docu says that never happens, but... - raise Curses_Exception; + if Flushinp = Curses_Err then -- docu says that never happens, but... + raise Curses_Exception; end if; - end Flush_Input; + end Flush_Input; ------------------------------------------------------------------------------ - function Baudrate return Natural + function Baudrate return Natural is - function Baud return C_Int; + function Baud return C_Int; pragma Import (C, Baud, "baudrate"); begin - return Natural (Baud); - end Baudrate; + return Natural (Baud); + end Baudrate; - function Erase_Character return Character + function Erase_Character return Character is - function Erasechar return C_Int; + function Erasechar return C_Int; pragma Import (C, Erasechar, "erasechar"); begin - return Character'Val (Erasechar); - end Erase_Character; + return Character'Val (Erasechar); + end Erase_Character; - function Kill_Character return Character + function Kill_Character return Character is - function Killchar return C_Int; + function Killchar return C_Int; pragma Import (C, Killchar, "killchar"); begin - return Character'Val (Killchar); - end Kill_Character; + return Character'Val (Killchar); + end Kill_Character; - function Has_Insert_Character return Boolean + function Has_Insert_Character return Boolean is - function Has_Ic return Curses_Bool; + function Has_Ic return Curses_Bool; pragma Import (C, Has_Ic, "has_ic"); begin - if Has_Ic = Curses_Bool_False then + if Has_Ic = Curses_Bool_False then return False; else return True; end if; - end Has_Insert_Character; + end Has_Insert_Character; - function Has_Insert_Line return Boolean + function Has_Insert_Line return Boolean is - function Has_Il return Curses_Bool; + function Has_Il return Curses_Bool; pragma Import (C, Has_Il, "has_il"); begin - if Has_Il = Curses_Bool_False then + if Has_Il = Curses_Bool_False then return False; else return True; end if; - end Has_Insert_Line; + end Has_Insert_Line; - function Supported_Attributes return Character_Attribute_Set + function Supported_Attributes return Character_Attribute_Set is - function Termattrs return C_Chtype; + function Termattrs return Attributed_Character; pragma Import (C, Termattrs, "termattrs"); - Ch : constant Attributed_Character := Chtype_To_AttrChar (Termattrs); + Ch : constant Attributed_Character := Termattrs; begin - return Ch.Attr; - end Supported_Attributes; + return Ch.Attr; + end Supported_Attributes; - procedure Long_Name (Name : out String) + procedure Long_Name (Name : out String) is - function Longname return chars_ptr; + function Longname return chars_ptr; pragma Import (C, Longname, "longname"); begin - Fill_String (Longname, Name); - end Long_Name; + Fill_String (Longname, Name); + end Long_Name; - function Long_Name return String + function Long_Name return String is - function Longname return chars_ptr; + function Longname return chars_ptr; pragma Import (C, Longname, "longname"); begin - return Fill_String (Longname); - end Long_Name; + return Fill_String (Longname); + end Long_Name; - procedure Terminal_Name (Name : out String) + procedure Terminal_Name (Name : out String) is - function Termname return chars_ptr; + function Termname return chars_ptr; pragma Import (C, Termname, "termname"); begin - Fill_String (Termname, Name); - end Terminal_Name; + Fill_String (Termname, Name); + end Terminal_Name; - function Terminal_Name return String + function Terminal_Name return String is - function Termname return chars_ptr; + function Termname return chars_ptr; pragma Import (C, Termname, "termname"); begin - return Fill_String (Termname); - end Terminal_Name; + return Fill_String (Termname); + end Terminal_Name; ------------------------------------------------------------------------------ - procedure Init_Pair (Pair : Redefinable_Color_Pair; - Fore : Color_Number; - Back : Color_Number) + procedure Init_Pair (Pair : Redefinable_Color_Pair; + Fore : Color_Number; + Back : Color_Number) is - function Initpair (Pair : C_Short; - Fore : C_Short; - Back : C_Short) return C_Int; + function Initpair (Pair : C_Short; + Fore : C_Short; + Back : C_Short) return C_Int; pragma Import (C, Initpair, "init_pair"); begin - if Integer (Pair) >= Number_Of_Color_Pairs then + if Integer (Pair) >= Number_Of_Color_Pairs then raise Constraint_Error; end if; - if Integer (Fore) >= Number_Of_Colors or else - Integer (Back) >= Number_Of_Colors then + if Integer (Fore) >= Number_Of_Colors or else + Integer (Back) >= Number_Of_Colors + then raise Constraint_Error; end if; - if Initpair (C_Short (Pair), C_Short (Fore), C_Short (Back)) - = Curses_Err then - raise Curses_Exception; + if Initpair (C_Short (Pair), C_Short (Fore), C_Short (Back)) + = Curses_Err + then + raise Curses_Exception; end if; - end Init_Pair; + end Init_Pair; - procedure Pair_Content (Pair : Color_Pair; - Fore : out Color_Number; - Back : out Color_Number) + procedure Pair_Content (Pair : Color_Pair; + Fore : out Color_Number; + Back : out Color_Number) is - type C_Short_Access is access all C_Short; - function Paircontent (Pair : C_Short; - Fp : C_Short_Access; - Bp : C_Short_Access) return C_Int; + type C_Short_Access is access all C_Short; + function Paircontent (Pair : C_Short; + Fp : C_Short_Access; + Bp : C_Short_Access) return C_Int; pragma Import (C, Paircontent, "pair_content"); - F, B : aliased C_Short; + F, B : aliased C_Short; begin - if Paircontent (C_Short (Pair), F'Access, B'Access) = Curses_Err then - raise Curses_Exception; + if Paircontent (C_Short (Pair), F'Access, B'Access) = Curses_Err then + raise Curses_Exception; else - Fore := Color_Number (F); - Back := Color_Number (B); + Fore := Color_Number (F); + Back := Color_Number (B); end if; - end Pair_Content; + end Pair_Content; - function Has_Colors return Boolean + function Has_Colors return Boolean is - function Hascolors return Curses_Bool; + function Hascolors return Curses_Bool; pragma Import (C, Hascolors, "has_colors"); begin - if Hascolors = Curses_Bool_False then + if Hascolors = Curses_Bool_False then return False; else return True; end if; - end Has_Colors; + end Has_Colors; - procedure Init_Color (Color : Color_Number; - Red : RGB_Value; - Green : RGB_Value; - Blue : RGB_Value) + procedure Init_Color (Color : Color_Number; + Red : RGB_Value; + Green : RGB_Value; + Blue : RGB_Value) is - function Initcolor (Col : C_Short; - Red : C_Short; - Green : C_Short; - Blue : C_Short) return C_Int; + function Initcolor (Col : C_Short; + Red : C_Short; + Green : C_Short; + Blue : C_Short) return C_Int; pragma Import (C, Initcolor, "init_color"); begin - if Initcolor (C_Short (Color), C_Short (Red), C_Short (Green), - C_Short (Blue)) = Curses_Err then - raise Curses_Exception; + if Initcolor (C_Short (Color), C_Short (Red), C_Short (Green), + C_Short (Blue)) = Curses_Err + then + raise Curses_Exception; end if; - end Init_Color; + end Init_Color; - function Can_Change_Color return Boolean + function Can_Change_Color return Boolean is - function Canchangecolor return Curses_Bool; + function Canchangecolor return Curses_Bool; pragma Import (C, Canchangecolor, "can_change_color"); begin - if Canchangecolor = Curses_Bool_False then + if Canchangecolor = Curses_Bool_False then return False; else return True; end if; - end Can_Change_Color; + end Can_Change_Color; - procedure Color_Content (Color : Color_Number; - Red : out RGB_Value; - Green : out RGB_Value; - Blue : out RGB_Value) + procedure Color_Content (Color : Color_Number; + Red : out RGB_Value; + Green : out RGB_Value; + Blue : out RGB_Value) is - type C_Short_Access is access all C_Short; + type C_Short_Access is access all C_Short; - function Colorcontent (Color : C_Short; R, G, B : C_Short_Access) - return C_Int; + function Colorcontent (Color : C_Short; R, G, B : C_Short_Access) + return C_Int; pragma Import (C, Colorcontent, "color_content"); - R, G, B : aliased C_Short; + R, G, B : aliased C_Short; begin - if Colorcontent (C_Short (Color), R'Access, G'Access, B'Access) = - Curses_Err then - raise Curses_Exception; + if Colorcontent (C_Short (Color), R'Access, G'Access, B'Access) = + Curses_Err + then + raise Curses_Exception; else - Red := RGB_Value (R); - Green := RGB_Value (G); - Blue := RGB_Value (B); + Red := RGB_Value (R); + Green := RGB_Value (G); + Blue := RGB_Value (B); end if; - end Color_Content; + end Color_Content; ------------------------------------------------------------------------------ - procedure Save_Curses_Mode (Mode : Curses_Mode) + procedure Save_Curses_Mode (Mode : Curses_Mode) is - function Def_Prog_Mode return C_Int; + function Def_Prog_Mode return C_Int; pragma Import (C, Def_Prog_Mode, "def_prog_mode"); - function Def_Shell_Mode return C_Int; + function Def_Shell_Mode return C_Int; pragma Import (C, Def_Shell_Mode, "def_shell_mode"); - Err : C_Int; + Err : C_Int; begin - case Mode is - when Curses => Err := Def_Prog_Mode; - when Shell => Err := Def_Shell_Mode; + case Mode is + when Curses => Err := Def_Prog_Mode; + when Shell => Err := Def_Shell_Mode; end case; - if Err = Curses_Err then - raise Curses_Exception; + if Err = Curses_Err then + raise Curses_Exception; end if; - end Save_Curses_Mode; + end Save_Curses_Mode; - procedure Reset_Curses_Mode (Mode : Curses_Mode) + procedure Reset_Curses_Mode (Mode : Curses_Mode) is - function Reset_Prog_Mode return C_Int; + function Reset_Prog_Mode return C_Int; pragma Import (C, Reset_Prog_Mode, "reset_prog_mode"); - function Reset_Shell_Mode return C_Int; + function Reset_Shell_Mode return C_Int; pragma Import (C, Reset_Shell_Mode, "reset_shell_mode"); - Err : C_Int; + Err : C_Int; begin - case Mode is - when Curses => Err := Reset_Prog_Mode; - when Shell => Err := Reset_Shell_Mode; + case Mode is + when Curses => Err := Reset_Prog_Mode; + when Shell => Err := Reset_Shell_Mode; end case; - if Err = Curses_Err then - raise Curses_Exception; + if Err = Curses_Err then + raise Curses_Exception; end if; - end Reset_Curses_Mode; + end Reset_Curses_Mode; - procedure Save_Terminal_State + procedure Save_Terminal_State is - function Savetty return C_Int; + function Savetty return C_Int; pragma Import (C, Savetty, "savetty"); begin - if Savetty = Curses_Err then - raise Curses_Exception; + if Savetty = Curses_Err then + raise Curses_Exception; end if; - end Save_Terminal_State; + end Save_Terminal_State; - procedure Reset_Terminal_State + procedure Reset_Terminal_State is - function Resetty return C_Int; + function Resetty return C_Int; pragma Import (C, Resetty, "resetty"); begin - if Resetty = Curses_Err then - raise Curses_Exception; + if Resetty = Curses_Err then + raise Curses_Exception; end if; - end Reset_Terminal_State; + end Reset_Terminal_State; - procedure Rip_Off_Lines (Lines : Integer; - Proc : Stdscr_Init_Proc) + procedure Rip_Off_Lines (Lines : Integer; + Proc : Stdscr_Init_Proc) is - function Ripoffline (Lines : C_Int; - Proc : Stdscr_Init_Proc) return C_Int; + function Ripoffline (Lines : C_Int; + Proc : Stdscr_Init_Proc) return C_Int; pragma Import (C, Ripoffline, "_nc_ripoffline"); begin - if Ripoffline (C_Int (Lines), Proc) = Curses_Err then - raise Curses_Exception; + if Ripoffline (C_Int (Lines), Proc) = Curses_Err then + raise Curses_Exception; end if; - end Rip_Off_Lines; + end Rip_Off_Lines; - procedure Set_Cursor_Visibility (Visibility : in out Cursor_Visibility) + procedure Set_Cursor_Visibility (Visibility : in out Cursor_Visibility) is - function Curs_Set (Curs : C_Int) return C_Int; + function Curs_Set (Curs : C_Int) return C_Int; pragma Import (C, Curs_Set, "curs_set"); - Res : C_Int; + Res : C_Int; begin - Res := Curs_Set (Cursor_Visibility'Pos (Visibility)); - if Res /= Curses_Err then - Visibility := Cursor_Visibility'Val (Res); + Res := Curs_Set (Cursor_Visibility'Pos (Visibility)); + if Res /= Curses_Err then + Visibility := Cursor_Visibility'Val (Res); end if; - end Set_Cursor_Visibility; + end Set_Cursor_Visibility; - procedure Nap_Milli_Seconds (Ms : Natural) + procedure Nap_Milli_Seconds (Ms : Natural) is - function Napms (Ms : C_Int) return C_Int; + function Napms (Ms : C_Int) return C_Int; pragma Import (C, Napms, "napms"); begin - if Napms (C_Int (Ms)) = Curses_Err then - raise Curses_Exception; + if Napms (C_Int (Ms)) = Curses_Err then + raise Curses_Exception; end if; - end Nap_Milli_Seconds; + end Nap_Milli_Seconds; ------------------------------------------------------------------------------ - - function Standard_Window return Window - is - Result : Window; - pragma Import (C, Result, "stdscr"); - begin - return Result; - end Standard_Window; - - function Current_Window return Window + function Lines return Line_Count is - Result : Window; - pragma Import (C, Result, "curscr"); + function LINES_As_Function return Interfaces.C.int; + pragma Import (C, LINES_As_Function, "LINES_as_function"); begin - return Result; - end Current_Window; + return Line_Count (LINES_As_Function); + end Lines; - function Lines return Line_Count + function Columns return Column_Count is - Result : C_Int; - pragma Import (C, Result, "LINES"); + function COLS_As_Function return Interfaces.C.int; + pragma Import (C, COLS_As_Function, "COLS_as_function"); begin - return Line_Count (Result); - end Lines; + return Column_Count (COLS_As_Function); + end Columns; - function Columns return Column_Count + function Tab_Size return Natural is - Result : C_Int; - pragma Import (C, Result, "COLS"); - begin - return Column_Count (Result); - end Columns; + function TABSIZE_As_Function return Interfaces.C.int; + pragma Import (C, TABSIZE_As_Function, "TABSIZE_as_function"); - function Tab_Size return Natural - is - Result : C_Int; - pragma Import (C, Result, "TABSIZE"); begin - return Natural (Result); - end Tab_Size; + return Natural (TABSIZE_As_Function); + end Tab_Size; - function Number_Of_Colors return Natural + function Number_Of_Colors return Natural is - Result : C_Int; - pragma Import (C, Result, "COLORS"); + function COLORS_As_Function return Interfaces.C.int; + pragma Import (C, COLORS_As_Function, "COLORS_as_function"); begin - return Natural (Result); - end Number_Of_Colors; + return Natural (COLORS_As_Function); + end Number_Of_Colors; - function Number_Of_Color_Pairs return Natural + function Number_Of_Color_Pairs return Natural is - Result : C_Int; - pragma Import (C, Result, "COLOR_PAIRS"); + function COLOR_PAIRS_As_Function return Interfaces.C.int; + pragma Import (C, COLOR_PAIRS_As_Function, "COLOR_PAIRS_as_function"); begin - return Natural (Result); - end Number_Of_Color_Pairs; - + return Natural (COLOR_PAIRS_As_Function); + end Number_Of_Color_Pairs; ------------------------------------------------------------------------------ - procedure Transform_Coordinates - (W : Window := Standard_Window; - Line : in out Line_Position; - Column : in out Column_Position; - Dir : Transform_Direction := From_Screen) - is - type Int_Access is access all C_Int; - function Transform (W : Window; + procedure Transform_Coordinates + (W : Window := Standard_Window; + Line : in out Line_Position; + Column : in out Column_Position; + Dir : Transform_Direction := From_Screen) + is + type Int_Access is access all C_Int; + function Transform (W : Window; Y, X : Int_Access; - Dir : Curses_Bool) return C_Int; + Dir : Curses_Bool) return C_Int; pragma Import (C, Transform, "wmouse_trafo"); - X : aliased C_Int := C_Int (Column); - Y : aliased C_Int := C_Int (Line); - D : Curses_Bool := Curses_Bool_False; - R : C_Int; + X : aliased C_Int := C_Int (Column); + Y : aliased C_Int := C_Int (Line); + D : Curses_Bool := Curses_Bool_False; + R : C_Int; begin - if Dir = To_Screen then + if Dir = To_Screen then D := 1; end if; - R := Transform (W, Y'Access, X'Access, D); - if R = Curses_False then - raise Curses_Exception; + R := Transform (W, Y'Access, X'Access, D); + if R = Curses_False then + raise Curses_Exception; else - Line := Line_Position (Y); - Column := Column_Position (X); + Line := Line_Position (Y); + Column := Column_Position (X); end if; - end Transform_Coordinates; + end Transform_Coordinates; ------------------------------------------------------------------------------ - procedure Use_Default_Colors is - function C_Use_Default_Colors return C_Int; + procedure Use_Default_Colors is + function C_Use_Default_Colors return C_Int; pragma Import (C, C_Use_Default_Colors, "use_default_colors"); - Err : constant C_Int := C_Use_Default_Colors; + Err : constant C_Int := C_Use_Default_Colors; begin - if Err = Curses_Err then - raise Curses_Exception; + if Err = Curses_Err then + raise Curses_Exception; end if; - end Use_Default_Colors; + end Use_Default_Colors; - procedure Assume_Default_Colors (Fore : Color_Number := Default_Color; - Back : Color_Number := Default_Color) + procedure Assume_Default_Colors (Fore : Color_Number := Default_Color; + Back : Color_Number := Default_Color) is - function C_Assume_Default_Colors (Fore : C_Int; - Back : C_Int) return C_Int; + function C_Assume_Default_Colors (Fore : C_Int; + Back : C_Int) return C_Int; pragma Import (C, C_Assume_Default_Colors, "assume_default_colors"); - Err : constant C_Int := C_Assume_Default_Colors (C_Int (Fore), - C_Int (Back)); + Err : constant C_Int := C_Assume_Default_Colors (C_Int (Fore), + C_Int (Back)); begin - if Err = Curses_Err then - raise Curses_Exception; + if Err = Curses_Err then + raise Curses_Exception; end if; - end Assume_Default_Colors; + end Assume_Default_Colors; ------------------------------------------------------------------------------ - function Curses_Version return String + function Curses_Version return String is function curses_versionC return chars_ptr; pragma Import (C, curses_versionC, "curses_version"); Result : constant chars_ptr := curses_versionC; begin - return Fill_String (Result); - end Curses_Version; + return Fill_String (Result); + end Curses_Version; ------------------------------------------------------------------------------ - procedure Curses_Free_All is + procedure Curses_Free_All is procedure curses_freeall; pragma Import (C, curses_freeall, "_nc_freeall"); begin @@ -2485,90 +2485,91 @@ -- safely only from C - and again, that only as the "last" thing done -- before exiting the program. curses_freeall; - end Curses_Free_All; + end Curses_Free_All; ------------------------------------------------------------------------------ - function Use_Extended_Names (Enable : Boolean) return Boolean + function Use_Extended_Names (Enable : Boolean) return Boolean is - function use_extended_namesC (e : Curses_Bool) return C_Int; + function use_extended_namesC (e : Curses_Bool) return C_Int; pragma Import (C, use_extended_namesC, "use_extended_names"); - Res : constant C_Int := - use_extended_namesC (Curses_Bool (Boolean'Pos (Enable))); + Res : constant C_Int := + use_extended_namesC (Curses_Bool (Boolean'Pos (Enable))); begin - if Res = C_Int (Curses_Bool_False) then + if Res = C_Int (Curses_Bool_False) then return False; else return True; end if; - end Use_Extended_Names; + end Use_Extended_Names; ------------------------------------------------------------------------------ - procedure Screen_Dump_To_File (Filename : String) + procedure Screen_Dump_To_File (Filename : String) is - function scr_dump (f : char_array) return C_Int; + function scr_dump (f : char_array) return C_Int; pragma Import (C, scr_dump, "scr_dump"); - Txt : char_array (0 .. Filename'Length); + Txt : char_array (0 .. Filename'Length); Length : size_t; begin - To_C (Filename, Txt, Length); - if Curses_Err = scr_dump (Txt) then - raise Curses_Exception; + To_C (Filename, Txt, Length); + if Curses_Err = scr_dump (Txt) then + raise Curses_Exception; end if; - end Screen_Dump_To_File; + end Screen_Dump_To_File; - procedure Screen_Restore_From_File (Filename : String) + procedure Screen_Restore_From_File (Filename : String) is - function scr_restore (f : char_array) return C_Int; + function scr_restore (f : char_array) return C_Int; pragma Import (C, scr_restore, "scr_restore"); - Txt : char_array (0 .. Filename'Length); + Txt : char_array (0 .. Filename'Length); Length : size_t; begin - To_C (Filename, Txt, Length); - if Curses_Err = scr_restore (Txt) then - raise Curses_Exception; + To_C (Filename, Txt, Length); + if Curses_Err = scr_restore (Txt) then + raise Curses_Exception; end if; - end Screen_Restore_From_File; + end Screen_Restore_From_File; - procedure Screen_Init_From_File (Filename : String) + procedure Screen_Init_From_File (Filename : String) is - function scr_init (f : char_array) return C_Int; + function scr_init (f : char_array) return C_Int; pragma Import (C, scr_init, "scr_init"); - Txt : char_array (0 .. Filename'Length); + Txt : char_array (0 .. Filename'Length); Length : size_t; begin - To_C (Filename, Txt, Length); - if Curses_Err = scr_init (Txt) then - raise Curses_Exception; + To_C (Filename, Txt, Length); + if Curses_Err = scr_init (Txt) then + raise Curses_Exception; end if; - end Screen_Init_From_File; + end Screen_Init_From_File; - procedure Screen_Set_File (Filename : String) + procedure Screen_Set_File (Filename : String) is - function scr_set (f : char_array) return C_Int; + function scr_set (f : char_array) return C_Int; pragma Import (C, scr_set, "scr_set"); - Txt : char_array (0 .. Filename'Length); + Txt : char_array (0 .. Filename'Length); Length : size_t; begin - To_C (Filename, Txt, Length); - if Curses_Err = scr_set (Txt) then - raise Curses_Exception; + To_C (Filename, Txt, Length); + if Curses_Err = scr_set (Txt) then + raise Curses_Exception; end if; - end Screen_Set_File; + end Screen_Set_File; ------------------------------------------------------------------------------ - procedure Resize (Win : Window := Standard_Window; - Number_Of_Lines : Line_Count; - Number_Of_Columns : Column_Count) is - function wresize (win : Window; - lines : C_Int; - columns : C_Int) return C_Int; + procedure Resize (Win : Window := Standard_Window; + Number_Of_Lines : Line_Count; + Number_Of_Columns : Column_Count) is + function wresize (win : Window; + lines : C_Int; + columns : C_Int) return C_Int; pragma Import (C, wresize); begin - if wresize (Win, - C_Int (Number_Of_Lines), - C_Int (Number_Of_Columns)) = Curses_Err then - raise Curses_Exception; + if wresize (Win, + C_Int (Number_Of_Lines), + C_Int (Number_Of_Columns)) = Curses_Err + then + raise Curses_Exception; end if; - end Resize; + end Resize; ------------------------------------------------------------------------------ -end Terminal_Interface.Curses; +end Terminal_Interface.Curses; diff --git a/doc/html/ada/terminal_interface-curses__ads.htm b/doc/html/ada/terminal_interface-curses__ads.htm index 0d60bc43..727cc831 100644 --- a/doc/html/ada/terminal_interface-curses__ads.htm +++ b/doc/html/ada/terminal_interface-curses__ads.htm @@ -24,7 +24,7 @@ -- S P E C -- -- -- ------------------------------------------------------------------------------ --- Copyright (c) 1998-2009,2011 Free Software Foundation, Inc. -- +-- Copyright (c) 1998-2011,2014 Free Software Foundation, Inc. -- -- -- -- Permission is hereby granted, free of charge, to any person obtaining a -- -- copy of this software and associated documentation files (the -- @@ -52,372 +52,509 @@ ------------------------------------------------------------------------------ -- Author: Juergen Pfeifer, 1996 -- Version Control: --- @Revision: 1.44 @ --- @Date: 2011/03/19 23:05:56 @ +-- @Revision: 1.47 @ +-- @Date: 2014/05/24 21:31:57 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ --- curses binding. --- This module is generated. Please don't change it manually! --- Run the generator instead. --- | with System.Storage_Elements; with Interfaces.C; -- We need this for some assertions. -package Terminal_Interface.Curses is - pragma Preelaborate (Terminal_Interface.Curses); - pragma Linker_Options ("-lncurses"); +with Terminal_Interface.Curses_Constants; - NC_Major_Version : constant := 5; -- Major version of the library - NC_Minor_Version : constant := 9; -- Minor version of the library - NC_Version : constant String := "5.9"; -- Version of library +package Terminal_Interface.Curses is + pragma Preelaborate (Terminal_Interface.Curses); + pragma Linker_Options ("-lncurses" & Curses_Constants.DFT_ARG_SUFFIX); - type Window is private; - Null_Window : constant Window; + Major_Version : constant := Curses_Constants.NCURSES_VERSION_MAJOR; + Minor_Version : constant := Curses_Constants.NCURSES_VERSION_MINOR; + NC_Version : String renames Curses_Constants.Version; - type Line_Position is new Integer; -- line coordinate - type Column_Position is new Integer; -- column coordinate + type Window is private; + Null_Window : constant Window; - subtype Line_Count is Line_Position range 1 .. Line_Position'Last; + type Line_Position is new Integer; -- line coordinate + type Column_Position is new Integer; -- column coordinate + + subtype Line_Count is Line_Position range 1 .. Line_Position'Last; -- Type to count lines. We do not allow null windows, so must be positive - subtype Column_Count is Column_Position range 1 .. Column_Position'Last; + subtype Column_Count is Column_Position range 1 .. Column_Position'Last; -- Type to count columns. We do not allow null windows, so must be positive - type Key_Code is new Integer; + type Key_Code is new Integer; -- That is anything including real characters, special keys and logical -- request codes. -- FIXME: The "-1" should be Curses_Err - subtype Real_Key_Code is Key_Code range -1 .. 8#777#; + subtype Real_Key_Code is Key_Code range -1 .. Curses_Constants.KEY_MAX; -- This are the codes that potentially represent a real keystroke. -- Not all codes may be possible on a specific terminal. To check the -- availability of a special key, the Has_Key function is provided. - subtype Special_Key_Code is Real_Key_Code - range 8#400# .. Real_Key_Code'Last; + subtype Special_Key_Code is Real_Key_Code + range Curses_Constants. KEY_MIN - 1 .. Real_Key_Code'Last; -- Type for a function- or special key number - subtype Normal_Key_Code is Real_Key_Code range + subtype Normal_Key_Code is Real_Key_Code range Character'Pos (Character'First) .. Character'Pos (Character'Last); -- This are the codes for regular (incl. non-graphical) characters. + -- For those who like to use the original key names we produce them were + -- they differ from the original. + -- Constants for function- and special keys - -- - Key_None : constant Special_Key_Code := 8#400#; - Key_Code_Yes : constant Special_Key_Code := 8#400#; - Key_Min : constant Special_Key_Code := 8#401#; - Key_Break : constant Special_Key_Code := 8#401#; - Key_Cursor_Down : constant Special_Key_Code := 8#402#; - Key_Cursor_Up : constant Special_Key_Code := 8#403#; - Key_Cursor_Left : constant Special_Key_Code := 8#404#; - Key_Cursor_Right : constant Special_Key_Code := 8#405#; - Key_Home : constant Special_Key_Code := 8#406#; - Key_Backspace : constant Special_Key_Code := 8#407#; - Key_F0 : constant Special_Key_Code := 8#410#; - Key_F1 : constant Special_Key_Code := 8#411#; - Key_F2 : constant Special_Key_Code := 8#412#; - Key_F3 : constant Special_Key_Code := 8#413#; - Key_F4 : constant Special_Key_Code := 8#414#; - Key_F5 : constant Special_Key_Code := 8#415#; - Key_F6 : constant Special_Key_Code := 8#416#; - Key_F7 : constant Special_Key_Code := 8#417#; - Key_F8 : constant Special_Key_Code := 8#420#; - Key_F9 : constant Special_Key_Code := 8#421#; - Key_F10 : constant Special_Key_Code := 8#422#; - Key_F11 : constant Special_Key_Code := 8#423#; - Key_F12 : constant Special_Key_Code := 8#424#; - Key_F13 : constant Special_Key_Code := 8#425#; - Key_F14 : constant Special_Key_Code := 8#426#; - Key_F15 : constant Special_Key_Code := 8#427#; - Key_F16 : constant Special_Key_Code := 8#430#; - Key_F17 : constant Special_Key_Code := 8#431#; - Key_F18 : constant Special_Key_Code := 8#432#; - Key_F19 : constant Special_Key_Code := 8#433#; - Key_F20 : constant Special_Key_Code := 8#434#; - Key_F21 : constant Special_Key_Code := 8#435#; - Key_F22 : constant Special_Key_Code := 8#436#; - Key_F23 : constant Special_Key_Code := 8#437#; - Key_F24 : constant Special_Key_Code := 8#440#; - Key_Delete_Line : constant Special_Key_Code := 8#510#; - Key_Insert_Line : constant Special_Key_Code := 8#511#; - Key_Delete_Char : constant Special_Key_Code := 8#512#; - Key_Insert_Char : constant Special_Key_Code := 8#513#; - Key_Exit_Insert_Mode : constant Special_Key_Code := 8#514#; - Key_Clear_Screen : constant Special_Key_Code := 8#515#; - Key_Clear_End_Of_Screen : constant Special_Key_Code := 8#516#; - Key_Clear_End_Of_Line : constant Special_Key_Code := 8#517#; - Key_Scroll_1_Forward : constant Special_Key_Code := 8#520#; - Key_Scroll_1_Backward : constant Special_Key_Code := 8#521#; - Key_Next_Page : constant Special_Key_Code := 8#522#; - Key_Previous_Page : constant Special_Key_Code := 8#523#; - Key_Set_Tab : constant Special_Key_Code := 8#524#; - Key_Clear_Tab : constant Special_Key_Code := 8#525#; - Key_Clear_All_Tabs : constant Special_Key_Code := 8#526#; - Key_Enter_Or_Send : constant Special_Key_Code := 8#527#; - Key_Soft_Reset : constant Special_Key_Code := 8#530#; - Key_Reset : constant Special_Key_Code := 8#531#; - Key_Print : constant Special_Key_Code := 8#532#; - Key_Bottom : constant Special_Key_Code := 8#533#; - Key_Upper_Left_Of_Keypad : constant Special_Key_Code := 8#534#; - Key_Upper_Right_Of_Keypad : constant Special_Key_Code := 8#535#; - Key_Center_Of_Keypad : constant Special_Key_Code := 8#536#; - Key_Lower_Left_Of_Keypad : constant Special_Key_Code := 8#537#; - Key_Lower_Right_Of_Keypad : constant Special_Key_Code := 8#540#; - Key_Back_Tab : constant Special_Key_Code := 8#541#; - Key_Beginning : constant Special_Key_Code := 8#542#; - Key_Cancel : constant Special_Key_Code := 8#543#; - Key_Close : constant Special_Key_Code := 8#544#; - Key_Command : constant Special_Key_Code := 8#545#; - Key_Copy : constant Special_Key_Code := 8#546#; - Key_Create : constant Special_Key_Code := 8#547#; - Key_End : constant Special_Key_Code := 8#550#; - Key_Exit : constant Special_Key_Code := 8#551#; - Key_Find : constant Special_Key_Code := 8#552#; - Key_Help : constant Special_Key_Code := 8#553#; - Key_Mark : constant Special_Key_Code := 8#554#; - Key_Message : constant Special_Key_Code := 8#555#; - Key_Move : constant Special_Key_Code := 8#556#; - Key_Next : constant Special_Key_Code := 8#557#; - Key_Open : constant Special_Key_Code := 8#560#; - Key_Options : constant Special_Key_Code := 8#561#; - Key_Previous : constant Special_Key_Code := 8#562#; - Key_Redo : constant Special_Key_Code := 8#563#; - Key_Reference : constant Special_Key_Code := 8#564#; - Key_Refresh : constant Special_Key_Code := 8#565#; - Key_Replace : constant Special_Key_Code := 8#566#; - Key_Restart : constant Special_Key_Code := 8#567#; - Key_Resume : constant Special_Key_Code := 8#570#; - Key_Save : constant Special_Key_Code := 8#571#; - Key_Shift_Begin : constant Special_Key_Code := 8#572#; - Key_Shift_Cancel : constant Special_Key_Code := 8#573#; - Key_Shift_Command : constant Special_Key_Code := 8#574#; - Key_Shift_Copy : constant Special_Key_Code := 8#575#; - Key_Shift_Create : constant Special_Key_Code := 8#576#; - Key_Shift_Delete_Char : constant Special_Key_Code := 8#577#; - Key_Shift_Delete_Line : constant Special_Key_Code := 8#600#; - Key_Select : constant Special_Key_Code := 8#601#; - Key_Shift_End : constant Special_Key_Code := 8#602#; - Key_Shift_Clear_End_Of_Line : constant Special_Key_Code := 8#603#; - Key_Shift_Exit : constant Special_Key_Code := 8#604#; - Key_Shift_Find : constant Special_Key_Code := 8#605#; - Key_Shift_Help : constant Special_Key_Code := 8#606#; - Key_Shift_Home : constant Special_Key_Code := 8#607#; - Key_Shift_Insert_Char : constant Special_Key_Code := 8#610#; - Key_Shift_Cursor_Left : constant Special_Key_Code := 8#611#; - Key_Shift_Message : constant Special_Key_Code := 8#612#; - Key_Shift_Move : constant Special_Key_Code := 8#613#; - Key_Shift_Next_Page : constant Special_Key_Code := 8#614#; - Key_Shift_Options : constant Special_Key_Code := 8#615#; - Key_Shift_Previous_Page : constant Special_Key_Code := 8#616#; - Key_Shift_Print : constant Special_Key_Code := 8#617#; - Key_Shift_Redo : constant Special_Key_Code := 8#620#; - Key_Shift_Replace : constant Special_Key_Code := 8#621#; - Key_Shift_Cursor_Right : constant Special_Key_Code := 8#622#; - Key_Shift_Resume : constant Special_Key_Code := 8#623#; - Key_Shift_Save : constant Special_Key_Code := 8#624#; - Key_Shift_Suspend : constant Special_Key_Code := 8#625#; - Key_Shift_Undo : constant Special_Key_Code := 8#626#; - Key_Suspend : constant Special_Key_Code := 8#627#; - Key_Undo : constant Special_Key_Code := 8#630#; - Key_Mouse : constant Special_Key_Code := 8#631#; - Key_Resize : constant Special_Key_Code := 8#632#; - - Key_Max : constant Special_Key_Code - := Special_Key_Code'Last; - - subtype User_Key_Code is Key_Code - range (Key_Max + 129) .. Key_Code'Last; + Key_None : constant Special_Key_Code + := Curses_Constants.KEY_MIN - 1; + Key_Min : constant Special_Key_Code + := Curses_Constants.KEY_MIN; + Key_Break : constant Special_Key_Code + := Curses_Constants.KEY_BREAK; + KEY_DOWN : constant Special_Key_Code + := Curses_Constants.KEY_DOWN; + Key_Cursor_Down : Special_Key_Code renames KEY_DOWN; + KEY_UP : constant Special_Key_Code + := Curses_Constants.KEY_UP; + Key_Cursor_Up : Special_Key_Code renames KEY_UP; + KEY_LEFT : constant Special_Key_Code + := Curses_Constants.KEY_LEFT; + Key_Cursor_Left : Special_Key_Code renames KEY_LEFT; + KEY_RIGHT : constant Special_Key_Code + := Curses_Constants.KEY_RIGHT; + Key_Cursor_Right : Special_Key_Code renames KEY_RIGHT; + Key_Home : constant Special_Key_Code + := Curses_Constants.KEY_HOME; + Key_Backspace : constant Special_Key_Code + := Curses_Constants.KEY_BACKSPACE; + Key_F0 : constant Special_Key_Code + := Curses_Constants.KEY_F0; + Key_F1 : constant Special_Key_Code + := Curses_Constants.KEY_F1; + Key_F2 : constant Special_Key_Code + := Curses_Constants.KEY_F2; + Key_F3 : constant Special_Key_Code + := Curses_Constants.KEY_F3; + Key_F4 : constant Special_Key_Code + := Curses_Constants.KEY_F4; + Key_F5 : constant Special_Key_Code + := Curses_Constants.KEY_F5; + Key_F6 : constant Special_Key_Code + := Curses_Constants.KEY_F6; + Key_F7 : constant Special_Key_Code + := Curses_Constants.KEY_F7; + Key_F8 : constant Special_Key_Code + := Curses_Constants.KEY_F8; + Key_F9 : constant Special_Key_Code + := Curses_Constants.KEY_F9; + Key_F10 : constant Special_Key_Code + := Curses_Constants.KEY_F10; + Key_F11 : constant Special_Key_Code + := Curses_Constants.KEY_F11; + Key_F12 : constant Special_Key_Code + := Curses_Constants.KEY_F12; + Key_F13 : constant Special_Key_Code + := Curses_Constants.KEY_F13; + Key_F14 : constant Special_Key_Code + := Curses_Constants.KEY_F14; + Key_F15 : constant Special_Key_Code + := Curses_Constants.KEY_F15; + Key_F16 : constant Special_Key_Code + := Curses_Constants.KEY_F16; + Key_F17 : constant Special_Key_Code + := Curses_Constants.KEY_F17; + Key_F18 : constant Special_Key_Code + := Curses_Constants.KEY_F18; + Key_F19 : constant Special_Key_Code + := Curses_Constants.KEY_F19; + Key_F20 : constant Special_Key_Code + := Curses_Constants.KEY_F20; + Key_F21 : constant Special_Key_Code + := Curses_Constants.KEY_F21; + Key_F22 : constant Special_Key_Code + := Curses_Constants.KEY_F22; + Key_F23 : constant Special_Key_Code + := Curses_Constants.KEY_F23; + Key_F24 : constant Special_Key_Code + := Curses_Constants.KEY_F24; + KEY_DL : constant Special_Key_Code + := Curses_Constants.KEY_DL; + Key_Delete_Line : Special_Key_Code renames KEY_DL; + KEY_IL : constant Special_Key_Code + := Curses_Constants.KEY_IL; + Key_Insert_Line : Special_Key_Code renames KEY_IL; + KEY_DC : constant Special_Key_Code + := Curses_Constants.KEY_DC; + Key_Delete_Char : Special_Key_Code renames KEY_DC; + KEY_IC : constant Special_Key_Code + := Curses_Constants.KEY_IC; + Key_Insert_Char : Special_Key_Code renames KEY_IC; + KEY_EIC : constant Special_Key_Code + := Curses_Constants.KEY_EIC; + Key_Exit_Insert_Mode : Special_Key_Code renames KEY_EIC; + KEY_CLEAR : constant Special_Key_Code + := Curses_Constants.KEY_CLEAR; + Key_Clear_Screen : Special_Key_Code renames KEY_CLEAR; + KEY_EOS : constant Special_Key_Code + := Curses_Constants.KEY_EOS; + Key_Clear_End_Of_Screen : Special_Key_Code renames KEY_EOS; + KEY_EOL : constant Special_Key_Code + := Curses_Constants.KEY_EOL; + Key_Clear_End_Of_Line : Special_Key_Code renames KEY_EOL; + KEY_SF : constant Special_Key_Code + := Curses_Constants.KEY_SF; + Key_Scroll_1_Forward : Special_Key_Code renames KEY_SF; + KEY_SR : constant Special_Key_Code + := Curses_Constants.KEY_SR; + Key_Scroll_1_Backward : Special_Key_Code renames KEY_SR; + KEY_NPAGE : constant Special_Key_Code + := Curses_Constants.KEY_NPAGE; + Key_Next_Page : Special_Key_Code renames KEY_NPAGE; + KEY_PPAGE : constant Special_Key_Code + := Curses_Constants.KEY_PPAGE; + Key_Previous_Page : Special_Key_Code renames KEY_PPAGE; + KEY_STAB : constant Special_Key_Code + := Curses_Constants.KEY_STAB; + Key_Set_Tab : Special_Key_Code renames KEY_STAB; + KEY_CTAB : constant Special_Key_Code + := Curses_Constants.KEY_CTAB; + Key_Clear_Tab : Special_Key_Code renames KEY_CTAB; + KEY_CATAB : constant Special_Key_Code + := Curses_Constants.KEY_CATAB; + Key_Clear_All_Tabs : Special_Key_Code renames KEY_CATAB; + KEY_ENTER : constant Special_Key_Code + := Curses_Constants.KEY_ENTER; + Key_Enter_Or_Send : Special_Key_Code renames KEY_ENTER; + KEY_SRESET : constant Special_Key_Code + := Curses_Constants.KEY_SRESET; + Key_Soft_Reset : Special_Key_Code renames KEY_SRESET; + Key_Reset : constant Special_Key_Code + := Curses_Constants.KEY_RESET; + Key_Print : constant Special_Key_Code + := Curses_Constants.KEY_PRINT; + KEY_LL : constant Special_Key_Code + := Curses_Constants.KEY_LL; + Key_Bottom : Special_Key_Code renames KEY_LL; + KEY_A1 : constant Special_Key_Code + := Curses_Constants.KEY_A1; + Key_Upper_Left_Of_Keypad : Special_Key_Code renames KEY_A1; + KEY_A3 : constant Special_Key_Code + := Curses_Constants.KEY_A3; + Key_Upper_Right_Of_Keypad : Special_Key_Code renames KEY_A3; + KEY_B2 : constant Special_Key_Code + := Curses_Constants.KEY_B2; + Key_Center_Of_Keypad : Special_Key_Code renames KEY_B2; + KEY_C1 : constant Special_Key_Code + := Curses_Constants.KEY_C1; + Key_Lower_Left_Of_Keypad : Special_Key_Code renames KEY_C1; + KEY_C3 : constant Special_Key_Code + := Curses_Constants.KEY_C3; + Key_Lower_Right_Of_Keypad : Special_Key_Code renames KEY_C3; + KEY_BTAB : constant Special_Key_Code + := Curses_Constants.KEY_BTAB; + Key_Back_Tab : Special_Key_Code renames KEY_BTAB; + KEY_BEG : constant Special_Key_Code + := Curses_Constants.KEY_BEG; + Key_Beginning : Special_Key_Code renames KEY_BEG; + Key_Cancel : constant Special_Key_Code + := Curses_Constants.KEY_CANCEL; + Key_Close : constant Special_Key_Code + := Curses_Constants.KEY_CLOSE; + Key_Command : constant Special_Key_Code + := Curses_Constants.KEY_COMMAND; + Key_Copy : constant Special_Key_Code + := Curses_Constants.KEY_COPY; + Key_Create : constant Special_Key_Code + := Curses_Constants.KEY_CREATE; + Key_End : constant Special_Key_Code + := Curses_Constants.KEY_END; + Key_Exit : constant Special_Key_Code + := Curses_Constants.KEY_EXIT; + Key_Find : constant Special_Key_Code + := Curses_Constants.KEY_FIND; + Key_Help : constant Special_Key_Code + := Curses_Constants.KEY_HELP; + Key_Mark : constant Special_Key_Code + := Curses_Constants.KEY_MARK; + Key_Message : constant Special_Key_Code + := Curses_Constants.KEY_MESSAGE; + Key_Move : constant Special_Key_Code + := Curses_Constants.KEY_MOVE; + Key_Next : constant Special_Key_Code + := Curses_Constants.KEY_NEXT; + Key_Open : constant Special_Key_Code + := Curses_Constants.KEY_OPEN; + Key_Options : constant Special_Key_Code + := Curses_Constants.KEY_OPTIONS; + Key_Previous : constant Special_Key_Code + := Curses_Constants.KEY_PREVIOUS; + Key_Redo : constant Special_Key_Code + := Curses_Constants.KEY_REDO; + Key_Reference : constant Special_Key_Code + := Curses_Constants.KEY_REFERENCE; + Key_Refresh : constant Special_Key_Code + := Curses_Constants.KEY_REFRESH; + Key_Replace : constant Special_Key_Code + := Curses_Constants.KEY_REPLACE; + Key_Restart : constant Special_Key_Code + := Curses_Constants.KEY_RESTART; + Key_Resume : constant Special_Key_Code + := Curses_Constants.KEY_RESUME; + Key_Save : constant Special_Key_Code + := Curses_Constants.KEY_SAVE; + KEY_SBEG : constant Special_Key_Code + := Curses_Constants.KEY_SBEG; + Key_Shift_Begin : Special_Key_Code renames KEY_SBEG; + KEY_SCANCEL : constant Special_Key_Code + := Curses_Constants.KEY_SCANCEL; + Key_Shift_Cancel : Special_Key_Code renames KEY_SCANCEL; + KEY_SCOMMAND : constant Special_Key_Code + := Curses_Constants.KEY_SCOMMAND; + Key_Shift_Command : Special_Key_Code renames KEY_SCOMMAND; + KEY_SCOPY : constant Special_Key_Code + := Curses_Constants.KEY_SCOPY; + Key_Shift_Copy : Special_Key_Code renames KEY_SCOPY; + KEY_SCREATE : constant Special_Key_Code + := Curses_Constants.KEY_SCREATE; + Key_Shift_Create : Special_Key_Code renames KEY_SCREATE; + KEY_SDC : constant Special_Key_Code + := Curses_Constants.KEY_SDC; + Key_Shift_Delete_Char : Special_Key_Code renames KEY_SDC; + KEY_SDL : constant Special_Key_Code + := Curses_Constants.KEY_SDL; + Key_Shift_Delete_Line : Special_Key_Code renames KEY_SDL; + Key_Select : constant Special_Key_Code + := Curses_Constants.KEY_SELECT; + KEY_SEND : constant Special_Key_Code + := Curses_Constants.KEY_SEND; + Key_Shift_End : Special_Key_Code renames KEY_SEND; + KEY_SEOL : constant Special_Key_Code + := Curses_Constants.KEY_SEOL; + Key_Shift_Clear_End_Of_Line : Special_Key_Code renames KEY_SEOL; + KEY_SEXIT : constant Special_Key_Code + := Curses_Constants.KEY_SEXIT; + Key_Shift_Exit : Special_Key_Code renames KEY_SEXIT; + KEY_SFIND : constant Special_Key_Code + := Curses_Constants.KEY_SFIND; + Key_Shift_Find : Special_Key_Code renames KEY_SFIND; + KEY_SHELP : constant Special_Key_Code + := Curses_Constants.KEY_SHELP; + Key_Shift_Help : Special_Key_Code renames KEY_SHELP; + KEY_SHOME : constant Special_Key_Code + := Curses_Constants.KEY_SHOME; + Key_Shift_Home : Special_Key_Code renames KEY_SHOME; + KEY_SIC : constant Special_Key_Code + := Curses_Constants.KEY_SIC; + Key_Shift_Insert_Char : Special_Key_Code renames KEY_SIC; + KEY_SLEFT : constant Special_Key_Code + := Curses_Constants.KEY_SLEFT; + Key_Shift_Cursor_Left : Special_Key_Code renames KEY_SLEFT; + KEY_SMESSAGE : constant Special_Key_Code + := Curses_Constants.KEY_SMESSAGE; + Key_Shift_Message : Special_Key_Code renames KEY_SMESSAGE; + KEY_SMOVE : constant Special_Key_Code + := Curses_Constants.KEY_SMOVE; + Key_Shift_Move : Special_Key_Code renames KEY_SMOVE; + KEY_SNEXT : constant Special_Key_Code + := Curses_Constants.KEY_SNEXT; + Key_Shift_Next_Page : Special_Key_Code renames KEY_SNEXT; + KEY_SOPTIONS : constant Special_Key_Code + := Curses_Constants.KEY_SOPTIONS; + Key_Shift_Options : Special_Key_Code renames KEY_SOPTIONS; + KEY_SPREVIOUS : constant Special_Key_Code + := Curses_Constants.KEY_SPREVIOUS; + Key_Shift_Previous_Page : Special_Key_Code renames KEY_SPREVIOUS; + KEY_SPRINT : constant Special_Key_Code + := Curses_Constants.KEY_SPRINT; + Key_Shift_Print : Special_Key_Code renames KEY_SPRINT; + KEY_SREDO : constant Special_Key_Code + := Curses_Constants.KEY_SREDO; + Key_Shift_Redo : Special_Key_Code renames KEY_SREDO; + KEY_SREPLACE : constant Special_Key_Code + := Curses_Constants.KEY_SREPLACE; + Key_Shift_Replace : Special_Key_Code renames KEY_SREPLACE; + KEY_SRIGHT : constant Special_Key_Code + := Curses_Constants.KEY_SRIGHT; + Key_Shift_Cursor_Right : Special_Key_Code renames KEY_SRIGHT; + KEY_SRSUME : constant Special_Key_Code + := Curses_Constants.KEY_SRSUME; + Key_Shift_Resume : Special_Key_Code renames KEY_SRSUME; + KEY_SSAVE : constant Special_Key_Code + := Curses_Constants.KEY_SSAVE; + Key_Shift_Save : Special_Key_Code renames KEY_SSAVE; + KEY_SSUSPEND : constant Special_Key_Code + := Curses_Constants.KEY_SSUSPEND; + Key_Shift_Suspend : Special_Key_Code renames KEY_SSUSPEND; + KEY_SUNDO : constant Special_Key_Code + := Curses_Constants.KEY_SUNDO; + Key_Shift_Undo : Special_Key_Code renames KEY_SUNDO; + Key_Suspend : constant Special_Key_Code + := Curses_Constants.KEY_SUSPEND; + Key_Undo : constant Special_Key_Code + := Curses_Constants.KEY_UNDO; + Key_Mouse : constant Special_Key_Code + := Curses_Constants.KEY_MOUSE; + Key_Resize : constant Special_Key_Code + := Curses_Constants.KEY_RESIZE; + Key_Max : constant Special_Key_Code + := Special_Key_Code'Last; + + subtype User_Key_Code is Key_Code + range (Key_Max + 129) .. Key_Code'Last; -- This is reserved for user defined key codes. The range between Key_Max -- and the first user code is reserved for subsystems like menu and forms. - -- For those who like to use the original key names we produce them were - -- they differ from the original. Please note that they may differ in - -- lower/upper case. - KEY_DOWN : Special_Key_Code renames Key_Cursor_Down; - KEY_UP : Special_Key_Code renames Key_Cursor_Up; - KEY_LEFT : Special_Key_Code renames Key_Cursor_Left; - KEY_RIGHT : Special_Key_Code renames Key_Cursor_Right; - KEY_DL : Special_Key_Code renames Key_Delete_Line; - KEY_IL : Special_Key_Code renames Key_Insert_Line; - KEY_DC : Special_Key_Code renames Key_Delete_Char; - KEY_IC : Special_Key_Code renames Key_Insert_Char; - KEY_EIC : Special_Key_Code renames Key_Exit_Insert_Mode; - KEY_CLEAR : Special_Key_Code renames Key_Clear_Screen; - KEY_EOS : Special_Key_Code renames Key_Clear_End_Of_Screen; - KEY_EOL : Special_Key_Code renames Key_Clear_End_Of_Line; - KEY_SF : Special_Key_Code renames Key_Scroll_1_Forward; - KEY_SR : Special_Key_Code renames Key_Scroll_1_Backward; - KEY_NPAGE : Special_Key_Code renames Key_Next_Page; - KEY_PPAGE : Special_Key_Code renames Key_Previous_Page; - KEY_STAB : Special_Key_Code renames Key_Set_Tab; - KEY_CTAB : Special_Key_Code renames Key_Clear_Tab; - KEY_CATAB : Special_Key_Code renames Key_Clear_All_Tabs; - KEY_ENTER : Special_Key_Code renames Key_Enter_Or_Send; - KEY_SRESET : Special_Key_Code renames Key_Soft_Reset; - KEY_LL : Special_Key_Code renames Key_Bottom; - KEY_A1 : Special_Key_Code renames Key_Upper_Left_Of_Keypad; - KEY_A3 : Special_Key_Code renames Key_Upper_Right_Of_Keypad; - KEY_B2 : Special_Key_Code renames Key_Center_Of_Keypad; - KEY_C1 : Special_Key_Code renames Key_Lower_Left_Of_Keypad; - KEY_C3 : Special_Key_Code renames Key_Lower_Right_Of_Keypad; - KEY_BTAB : Special_Key_Code renames Key_Back_Tab; - KEY_BEG : Special_Key_Code renames Key_Beginning; - KEY_SBEG : Special_Key_Code renames Key_Shift_Begin; - KEY_SCANCEL : Special_Key_Code renames Key_Shift_Cancel; - KEY_SCOMMAND : Special_Key_Code renames Key_Shift_Command; - KEY_SCOPY : Special_Key_Code renames Key_Shift_Copy; - KEY_SCREATE : Special_Key_Code renames Key_Shift_Create; - KEY_SDC : Special_Key_Code renames Key_Shift_Delete_Char; - KEY_SDL : Special_Key_Code renames Key_Shift_Delete_Line; - KEY_SEND : Special_Key_Code renames Key_Shift_End; - KEY_SEOL : Special_Key_Code renames Key_Shift_Clear_End_Of_Line; - KEY_SEXIT : Special_Key_Code renames Key_Shift_Exit; - KEY_SFIND : Special_Key_Code renames Key_Shift_Find; - KEY_SHELP : Special_Key_Code renames Key_Shift_Help; - KEY_SHOME : Special_Key_Code renames Key_Shift_Home; - KEY_SIC : Special_Key_Code renames Key_Shift_Insert_Char; - KEY_SLEFT : Special_Key_Code renames Key_Shift_Cursor_Left; - KEY_SMESSAGE : Special_Key_Code renames Key_Shift_Message; - KEY_SMOVE : Special_Key_Code renames Key_Shift_Move; - KEY_SNEXT : Special_Key_Code renames Key_Shift_Next_Page; - KEY_SOPTIONS : Special_Key_Code renames Key_Shift_Options; - KEY_SPREVIOUS : Special_Key_Code renames Key_Shift_Previous_Page; - KEY_SPRINT : Special_Key_Code renames Key_Shift_Print; - KEY_SREDO : Special_Key_Code renames Key_Shift_Redo; - KEY_SREPLACE : Special_Key_Code renames Key_Shift_Replace; - KEY_SRIGHT : Special_Key_Code renames Key_Shift_Cursor_Right; - KEY_SRSUME : Special_Key_Code renames Key_Shift_Resume; - KEY_SSAVE : Special_Key_Code renames Key_Shift_Save; - KEY_SSUSPEND : Special_Key_Code renames Key_Shift_Suspend; - KEY_SUNDO : Special_Key_Code renames Key_Shift_Undo; - ------------------------------------------------------------------------------- + -------------------------------------------------------------------------- - type Color_Number is range -1 .. Integer (Interfaces.C.short'Last); - for Color_Number'Size use Interfaces.C.short'Size; + type Color_Number is range -1 .. Integer (Interfaces.C.short'Last); + for Color_Number'Size use Interfaces.C.short'Size; -- (n)curses uses a short for the color index -- The model is, that a Color_Number is an index into an array of -- (potentially) definable colors. Some of those indices are -- predefined (see below), although they may not really exist. - Default_Color : constant Color_Number := -1; - Black : constant Color_Number := 0; - Red : constant Color_Number := 1; - Green : constant Color_Number := 2; - Yellow : constant Color_Number := 3; - Blue : constant Color_Number := 4; - Magenta : constant Color_Number := 5; - Cyan : constant Color_Number := 6; - White : constant Color_Number := 7; - - type RGB_Value is range 0 .. Integer (Interfaces.C.short'Last); - for RGB_Value'Size use Interfaces.C.short'Size; + Black : constant Color_Number := Curses_Constants.COLOR_BLACK; + Red : constant Color_Number := Curses_Constants.COLOR_RED; + Green : constant Color_Number := Curses_Constants.COLOR_GREEN; + Yellow : constant Color_Number := Curses_Constants.COLOR_YELLOW; + Blue : constant Color_Number := Curses_Constants.COLOR_BLUE; + Magenta : constant Color_Number := Curses_Constants.COLOR_MAGENTA; + Cyan : constant Color_Number := Curses_Constants.COLOR_CYAN; + White : constant Color_Number := Curses_Constants.COLOR_WHITE; + + type RGB_Value is range 0 .. Integer (Interfaces.C.short'Last); + for RGB_Value'Size use Interfaces.C.short'Size; -- Some system may allow to redefine a color by setting RGB values. - type Color_Pair is range 0 .. 255; - for Color_Pair'Size use 8; - subtype Redefinable_Color_Pair is Color_Pair range 1 .. 255; + type Color_Pair is range 0 .. 255; + for Color_Pair'Size use 8; + subtype Redefinable_Color_Pair is Color_Pair range 1 .. 255; -- (n)curses reserves 1 Byte for the color-pair number. Color Pair 0 -- is fixed (Black & White). A color pair is simply a combination of -- two colors described by Color_Numbers, one for the foreground and -- the other for the background - type Character_Attribute_Set is + type Character_Attribute_Set is record - Stand_Out : Boolean; - Under_Line : Boolean; - Reverse_Video : Boolean; - Blink : Boolean; - Dim_Character : Boolean; - Bold_Character : Boolean; - Alternate_Character_Set : Boolean; - Invisible_Character : Boolean; - Protected_Character : Boolean; - Horizontal : Boolean; - Left : Boolean; - Low : Boolean; - Right : Boolean; - Top : Boolean; - Vertical : Boolean; + Stand_Out : Boolean; + Under_Line : Boolean; + Reverse_Video : Boolean; + Blink : Boolean; + Dim_Character : Boolean; + Bold_Character : Boolean; + Protected_Character : Boolean; + Invisible_Character : Boolean; + Alternate_Character_Set : Boolean; + Horizontal : Boolean; + Left : Boolean; + Low : Boolean; + Right : Boolean; + Top : Boolean; + Vertical : Boolean; end record; - pragma Convention (C, Character_Attribute_Set); - for Character_Attribute_Set use + for Character_Attribute_Set use record - Stand_Out at 0 range 0 .. 0; - Under_Line at 0 range 1 .. 1; - Reverse_Video at 0 range 2 .. 2; - Blink at 0 range 3 .. 3; - Dim_Character at 0 range 4 .. 4; - Bold_Character at 0 range 5 .. 5; - Alternate_Character_Set at 0 range 6 .. 6; - Invisible_Character at 0 range 7 .. 7; - Protected_Character at 0 range 8 .. 8; - Horizontal at 0 range 9 .. 9; - Left at 0 range 10 .. 10; - Low at 0 range 11 .. 11; - Right at 0 range 12 .. 12; - Top at 0 range 13 .. 13; - Vertical at 0 range 14 .. 14; + Stand_Out at 0 range + Curses_Constants.A_STANDOUT_First - Curses_Constants.Attr_First + .. Curses_Constants.A_STANDOUT_Last - Curses_Constants.Attr_First; + Under_Line at 0 range + Curses_Constants.A_UNDERLINE_First - Curses_Constants.Attr_First + .. Curses_Constants.A_UNDERLINE_Last - Curses_Constants.Attr_First; + Reverse_Video at 0 range + Curses_Constants.A_REVERSE_First - Curses_Constants.Attr_First + .. Curses_Constants.A_REVERSE_Last - Curses_Constants.Attr_First; + Blink at 0 range + Curses_Constants.A_BLINK_First - Curses_Constants.Attr_First + .. Curses_Constants.A_BLINK_Last - Curses_Constants.Attr_First; + Dim_Character at 0 range + Curses_Constants.A_DIM_First - Curses_Constants.Attr_First + .. Curses_Constants.A_DIM_Last - Curses_Constants.Attr_First; + Bold_Character at 0 range + Curses_Constants.A_BOLD_First - Curses_Constants.Attr_First + .. Curses_Constants.A_BOLD_Last - Curses_Constants.Attr_First; + Protected_Character at 0 range + Curses_Constants.A_PROTECT_First - Curses_Constants.Attr_First + .. Curses_Constants.A_PROTECT_Last - Curses_Constants.Attr_First; + Invisible_Character at 0 range + Curses_Constants.A_INVIS_First - Curses_Constants.Attr_First + .. Curses_Constants.A_INVIS_Last - Curses_Constants.Attr_First; + Alternate_Character_Set at 0 range + Curses_Constants.A_ALTCHARSET_First - Curses_Constants.Attr_First + .. Curses_Constants.A_ALTCHARSET_Last - Curses_Constants.Attr_First; + Horizontal at 0 range + Curses_Constants.A_HORIZONTAL_First - Curses_Constants.Attr_First + .. Curses_Constants.A_HORIZONTAL_Last - Curses_Constants.Attr_First; + Left at 0 range + Curses_Constants.A_LEFT_First - Curses_Constants.Attr_First + .. Curses_Constants.A_LEFT_Last - Curses_Constants.Attr_First; + Low at 0 range + Curses_Constants.A_LOW_First - Curses_Constants.Attr_First + .. Curses_Constants.A_LOW_Last - Curses_Constants.Attr_First; + Right at 0 range + Curses_Constants.A_RIGHT_First - Curses_Constants.Attr_First + .. Curses_Constants.A_RIGHT_Last - Curses_Constants.Attr_First; + Top at 0 range + Curses_Constants.A_TOP_First - Curses_Constants.Attr_First + .. Curses_Constants.A_TOP_Last - Curses_Constants.Attr_First; + Vertical at 0 range + Curses_Constants.A_VERTICAL_First - Curses_Constants.Attr_First + .. Curses_Constants.A_VERTICAL_Last - Curses_Constants.Attr_First; end record; - pragma Warnings (Off); for Character_Attribute_Set'Size use 16; - pragma Warnings (On); - -- Please note: this rep. clause is generated and may be - -- different on your system. - -- (n)curses uses all but the lowest 16 Bits for Attributes. - Normal_Video : constant Character_Attribute_Set := (others => False); + Normal_Video : constant Character_Attribute_Set := (others => False); - type Attributed_Character is + type Attributed_Character is record - Attr : Character_Attribute_Set; - Color : Color_Pair; - Ch : Character; + Attr : Character_Attribute_Set; + Color : Color_Pair; + Ch : Character; end record; - pragma Convention (C, Attributed_Character); + pragma Convention (C_Pass_By_Copy, Attributed_Character); -- This is the counterpart for the chtype in C. - for Attributed_Character use + for Attributed_Character use record - Ch at 0 range 0 .. 7; - Color at 0 range 8 .. 15; - Attr at 0 range 16 .. 31; + Ch at 0 range Curses_Constants.A_CHARTEXT_First + .. Curses_Constants.A_CHARTEXT_Last; + Color at 0 range Curses_Constants.A_COLOR_First + .. Curses_Constants.A_COLOR_Last; + pragma Warnings (Off); + Attr at 0 range Curses_Constants.Attr_First + .. Curses_Constants.Attr_Last; + pragma Warnings (On); end record; - for Attributed_Character'Size use 32; - -- Please note: this rep. clause is generated and may be - -- different on your system. + for Attributed_Character'Size use Curses_Constants.chtype_Size; - Default_Character : constant Attributed_Character - := (Ch => Character'First, - Color => Color_Pair'First, - Attr => (others => False)); -- preelaboratable Normal_Video + Default_Character : constant Attributed_Character + := (Ch => Character'First, + Color => Color_Pair'First, + Attr => (others => False)); -- preelaboratable Normal_Video - type Attributed_String is array (Positive range <>) of Attributed_Character; - pragma Pack (Attributed_String); + type Attributed_String is array (Positive range <>) of Attributed_Character; + pragma Convention (C, Attributed_String); -- In this binding we allow strings of attributed characters. ------------------ -- Exceptions -- ------------------ - Curses_Exception : exception; - Wrong_Curses_Version : exception; + Curses_Exception : exception; + Wrong_Curses_Version : exception; -- Those exceptions are raised by the ETI (Extended Terminal Interface) -- subpackets for Menu and Forms handling. -- - Eti_System_Error : exception; - Eti_Bad_Argument : exception; - Eti_Posted : exception; - Eti_Connected : exception; - Eti_Bad_State : exception; - Eti_No_Room : exception; - Eti_Not_Posted : exception; - Eti_Unknown_Command : exception; - Eti_No_Match : exception; - Eti_Not_Selectable : exception; - Eti_Not_Connected : exception; - Eti_Request_Denied : exception; - Eti_Invalid_Field : exception; - Eti_Current : exception; + Eti_System_Error : exception; + Eti_Bad_Argument : exception; + Eti_Posted : exception; + Eti_Connected : exception; + Eti_Bad_State : exception; + Eti_No_Room : exception; + Eti_Not_Posted : exception; + Eti_Unknown_Command : exception; + Eti_No_Match : exception; + Eti_Not_Selectable : exception; + Eti_Not_Connected : exception; + Eti_Request_Denied : exception; + Eti_Invalid_Field : exception; + Eti_Current : exception; -------------------------------------------------------------------------- -- External C variables @@ -427,63 +564,93 @@ -- this is to use functions. -------------------------------------------------------------------------- - function Lines return Line_Count; - pragma Inline (Lines); + function Lines return Line_Count; + pragma Inline (Lines); - function Columns return Column_Count; - pragma Inline (Columns); + function Columns return Column_Count; + pragma Inline (Columns); - function Tab_Size return Natural; - pragma Inline (Tab_Size); + function Tab_Size return Natural; + pragma Inline (Tab_Size); - function Number_Of_Colors return Natural; - pragma Inline (Number_Of_Colors); + function Number_Of_Colors return Natural; + pragma Inline (Number_Of_Colors); - function Number_Of_Color_Pairs return Natural; - pragma Inline (Number_Of_Color_Pairs); + function Number_Of_Color_Pairs return Natural; + pragma Inline (Number_Of_Color_Pairs); + + subtype ACS_Index is Character range + Character'Val (0) .. Character'Val (127); + function ACS_Map (Index : ACS_Index) return Attributed_Character; + pragma Import (C, ACS_Map, "acs_map_as_function"); - type C_ACS_Map is array (Character'Val (0) .. Character'Val (127)) - of Attributed_Character; - ACS_Map : C_ACS_Map; - pragma Import (C, ACS_Map, "acs_map"); - -- - -- -- Constants for several characters from the Alternate Character Set - -- You must use these constants as indices into the ACS_Map array - -- to get the corresponding attributed character at runtime. - -- - ACS_Upper_Left_Corner : constant Character := 'l'; - ACS_Lower_Left_Corner : constant Character := 'm'; - ACS_Upper_Right_Corner : constant Character := 'k'; - ACS_Lower_Right_Corner : constant Character := 'j'; - ACS_Left_Tee : constant Character := 't'; - ACS_Right_Tee : constant Character := 'u'; - ACS_Bottom_Tee : constant Character := 'v'; - ACS_Top_Tee : constant Character := 'w'; - ACS_Horizontal_Line : constant Character := 'q'; - ACS_Vertical_Line : constant Character := 'x'; - ACS_Plus_Symbol : constant Character := 'n'; - ACS_Scan_Line_1 : constant Character := 'o'; - ACS_Scan_Line_9 : constant Character := 's'; - ACS_Diamond : constant Character := Character'Val (96); - ACS_Checker_Board : constant Character := 'a'; - ACS_Degree : constant Character := 'f'; - ACS_Plus_Minus : constant Character := 'g'; - ACS_Bullet : constant Character := '~'; - ACS_Left_Arrow : constant Character := ','; - ACS_Right_Arrow : constant Character := '+'; - ACS_Down_Arrow : constant Character := '.'; - ACS_Up_Arrow : constant Character := '-'; - ACS_Board_Of_Squares : constant Character := 'h'; - ACS_Lantern : constant Character := 'i'; - ACS_Solid_Block : constant Character := '0'; - ACS_Scan_Line_3 : constant Character := 'p'; - ACS_Scan_Line_7 : constant Character := 'r'; - ACS_Less_Or_Equal : constant Character := 'y'; - ACS_Greater_Or_Equal : constant Character := 'z'; - ACS_PI : constant Character := '{'; - ACS_Not_Equal : constant Character := '|'; - ACS_Sterling : constant Character := '}'; + -- You must use these constants as indices into the ACS_Map function + -- to get the corresponding attributed character at runtime + ACS_Upper_Left_Corner : constant ACS_Index + := Character'Val (Curses_Constants.ACS_ULCORNER); + ACS_Lower_Left_Corner : constant ACS_Index + := Character'Val (Curses_Constants.ACS_LLCORNER); + ACS_Upper_Right_Corner : constant ACS_Index + := Character'Val (Curses_Constants.ACS_URCORNER); + ACS_Lower_Right_Corner : constant ACS_Index + := Character'Val (Curses_Constants.ACS_LRCORNER); + ACS_Left_Tee : constant ACS_Index + := Character'Val (Curses_Constants.ACS_LTEE); + ACS_Right_Tee : constant ACS_Index + := Character'Val (Curses_Constants.ACS_RTEE); + ACS_Bottom_Tee : constant ACS_Index + := Character'Val (Curses_Constants.ACS_BTEE); + ACS_Top_Tee : constant ACS_Index + := Character'Val (Curses_Constants.ACS_TTEE); + ACS_Horizontal_Line : constant ACS_Index + := Character'Val (Curses_Constants.ACS_HLINE); + ACS_Vertical_Line : constant ACS_Index + := Character'Val (Curses_Constants.ACS_VLINE); + ACS_Plus_Symbol : constant ACS_Index + := Character'Val (Curses_Constants.ACS_PLUS); + ACS_Scan_Line_1 : constant ACS_Index + := Character'Val (Curses_Constants.ACS_S1); + ACS_Scan_Line_9 : constant ACS_Index + := Character'Val (Curses_Constants.ACS_S9); + ACS_Diamond : constant ACS_Index + := Character'Val (Curses_Constants.ACS_DIAMOND); + ACS_Checker_Board : constant ACS_Index + := Character'Val (Curses_Constants.ACS_CKBOARD); + ACS_Degree : constant ACS_Index + := Character'Val (Curses_Constants.ACS_DEGREE); + ACS_Plus_Minus : constant ACS_Index + := Character'Val (Curses_Constants.ACS_PLMINUS); + ACS_Bullet : constant ACS_Index + := Character'Val (Curses_Constants.ACS_BULLET); + ACS_Left_Arrow : constant ACS_Index + := Character'Val (Curses_Constants.ACS_LARROW); + ACS_Right_Arrow : constant ACS_Index + := Character'Val (Curses_Constants.ACS_RARROW); + ACS_Down_Arrow : constant ACS_Index + := Character'Val (Curses_Constants.ACS_DARROW); + ACS_Up_Arrow : constant ACS_Index + := Character'Val (Curses_Constants.ACS_UARROW); + ACS_Board_Of_Squares : constant ACS_Index + := Character'Val (Curses_Constants.ACS_BOARD); + ACS_Lantern : constant ACS_Index + := Character'Val (Curses_Constants.ACS_LANTERN); + ACS_Solid_Block : constant ACS_Index + := Character'Val (Curses_Constants.ACS_BLOCK); + ACS_Scan_Line_3 : constant ACS_Index + := Character'Val (Curses_Constants.ACS_S3); + ACS_Scan_Line_7 : constant ACS_Index + := Character'Val (Curses_Constants.ACS_S7); + ACS_Less_Or_Equal : constant ACS_Index + := Character'Val (Curses_Constants.ACS_LEQUAL); + ACS_Greater_Or_Equal : constant ACS_Index + := Character'Val (Curses_Constants.ACS_GEQUAL); + ACS_PI : constant ACS_Index + := Character'Val (Curses_Constants.ACS_PI); + ACS_Not_Equal : constant ACS_Index + := Character'Val (Curses_Constants.ACS_NEQUAL); + ACS_Sterling : constant ACS_Index + := Character'Val (Curses_Constants.ACS_STERLING); -- |===================================================================== -- | Man page curs_initscr.3x @@ -491,90 +658,92 @@ -- | Not implemented: newterm, set_term, delscreen -- #1A NAME="AFU_1"#2| - function Standard_Window return Window; + function Standard_Window return Window; -- AKA: stdscr - pragma Inline (Standard_Window); + pragma Import (C, Standard_Window, "stdscr_as_function"); + pragma Inline (Standard_Window); -- #1A NAME="AFU_2"#2| - function Current_Window return Window; + function Current_Window return Window; -- AKA: curscr - pragma Inline (Current_Window); + pragma Import (C, Current_Window, "curscr_as_function"); + pragma Inline (Current_Window); -- #1A NAME="AFU_3"#2| - procedure Init_Screen; + procedure Init_Screen; -- #1A NAME="AFU_4"#2| - procedure Init_Windows renames Init_Screen; + procedure Init_Windows renames Init_Screen; -- AKA: initscr() - pragma Inline (Init_Screen); + pragma Inline (Init_Screen); -- pragma Inline (Init_Windows); -- #1A NAME="AFU_5"#2| - procedure End_Windows; + procedure End_Windows; -- AKA: endwin() - procedure End_Screen renames End_Windows; - pragma Inline (End_Windows); + procedure End_Screen renames End_Windows; + pragma Inline (End_Windows); -- pragma Inline (End_Screen); -- #1A NAME="AFU_6"#2| - function Is_End_Window return Boolean; + function Is_End_Window return Boolean; -- AKA: isendwin() - pragma Inline (Is_End_Window); + pragma Inline (Is_End_Window); -- |===================================================================== -- | Man page curs_move.3x -- |===================================================================== -- #1A NAME="AFU_7"#2| - procedure Move_Cursor (Win : Window := Standard_Window; - Line : Line_Position; - Column : Column_Position); + procedure Move_Cursor (Win : Window := Standard_Window; + Line : Line_Position; + Column : Column_Position); -- AKA: wmove() -- AKA: move() - pragma Inline (Move_Cursor); + pragma Inline (Move_Cursor); -- |===================================================================== -- | Man page curs_addch.3x -- |===================================================================== -- #1A NAME="AFU_8"#2| - procedure Add (Win : Window := Standard_Window; - Ch : Attributed_Character); + procedure Add (Win : Window := Standard_Window; + Ch : Attributed_Character); -- AKA: waddch() -- AKA: addch() - procedure Add (Win : Window := Standard_Window; - Ch : Character); + procedure Add (Win : Window := Standard_Window; + Ch : Character); -- Add a single character at the current logical cursor position to -- the window. Use the current windows attributes. -- #1A NAME="AFU_9"#2| - procedure Add - (Win : Window := Standard_Window; - Line : Line_Position; - Column : Column_Position; - Ch : Attributed_Character); + procedure Add + (Win : Window := Standard_Window; + Line : Line_Position; + Column : Column_Position; + Ch : Attributed_Character); -- AKA: mvwaddch() -- AKA: mvaddch() - procedure Add - (Win : Window := Standard_Window; - Line : Line_Position; - Column : Column_Position; - Ch : Character); + procedure Add + (Win : Window := Standard_Window; + Line : Line_Position; + Column : Column_Position; + Ch : Character); -- Move to the position and add a single character into the window -- There are more Add routines, so the Inline pragma follows later -- #1A NAME="AFU_10"#2| - procedure Add_With_Immediate_Echo - (Win : Window := Standard_Window; - Ch : Attributed_Character); + procedure Add_With_Immediate_Echo + (Win : Window := Standard_Window; + Ch : Attributed_Character); -- AKA: wechochar() -- AKA: echochar() - procedure Add_With_Immediate_Echo - (Win : Window := Standard_Window; - Ch : Character); + procedure Add_With_Immediate_Echo + (Win : Window := Standard_Window; + Ch : Character); -- Add a character and do an immediate refresh of the screen. pragma Inline (Add_With_Immediate_Echo); @@ -584,104 +753,104 @@ -- Not Implemented: wcursyncup -- #1A NAME="AFU_11"#2| - function Create - (Number_Of_Lines : Line_Count; - Number_Of_Columns : Column_Count; - First_Line_Position : Line_Position; - First_Column_Position : Column_Position) return Window; + function Create + (Number_Of_Lines : Line_Count; + Number_Of_Columns : Column_Count; + First_Line_Position : Line_Position; + First_Column_Position : Column_Position) return Window; -- Not Implemented: Default Number_Of_Lines, Number_Of_Columns -- the C version lets them be 0, see the man page. -- AKA: newwin() - pragma Inline (Create); + pragma Inline (Create); function New_Window - (Number_Of_Lines : Line_Count; - Number_Of_Columns : Column_Count; - First_Line_Position : Line_Position; - First_Column_Position : Column_Position) return Window - renames Create; + (Number_Of_Lines : Line_Count; + Number_Of_Columns : Column_Count; + First_Line_Position : Line_Position; + First_Column_Position : Column_Position) return Window + renames Create; -- pragma Inline (New_Window); -- #1A NAME="AFU_12"#2| - procedure Delete (Win : in out Window); + procedure Delete (Win : in out Window); -- AKA: delwin() -- Reset Win to Null_Window - pragma Inline (Delete); + pragma Inline (Delete); -- #1A NAME="AFU_13"#2| - function Sub_Window - (Win : Window := Standard_Window; - Number_Of_Lines : Line_Count; - Number_Of_Columns : Column_Count; - First_Line_Position : Line_Position; - First_Column_Position : Column_Position) return Window; + function Sub_Window + (Win : Window := Standard_Window; + Number_Of_Lines : Line_Count; + Number_Of_Columns : Column_Count; + First_Line_Position : Line_Position; + First_Column_Position : Column_Position) return Window; -- AKA: subwin() - pragma Inline (Sub_Window); + pragma Inline (Sub_Window); -- #1A NAME="AFU_14"#2| - function Derived_Window - (Win : Window := Standard_Window; - Number_Of_Lines : Line_Count; - Number_Of_Columns : Column_Count; - First_Line_Position : Line_Position; - First_Column_Position : Column_Position) return Window; + function Derived_Window + (Win : Window := Standard_Window; + Number_Of_Lines : Line_Count; + Number_Of_Columns : Column_Count; + First_Line_Position : Line_Position; + First_Column_Position : Column_Position) return Window; -- AKA: derwin() - pragma Inline (Derived_Window); + pragma Inline (Derived_Window); -- #1A NAME="AFU_15"#2| - function Duplicate (Win : Window) return Window; + function Duplicate (Win : Window) return Window; -- AKA: dupwin() - pragma Inline (Duplicate); + pragma Inline (Duplicate); -- #1A NAME="AFU_16"#2| - procedure Move_Window (Win : Window; - Line : Line_Position; - Column : Column_Position); + procedure Move_Window (Win : Window; + Line : Line_Position; + Column : Column_Position); -- AKA: mvwin() - pragma Inline (Move_Window); + pragma Inline (Move_Window); -- #1A NAME="AFU_17"#2| - procedure Move_Derived_Window (Win : Window; - Line : Line_Position; - Column : Column_Position); + procedure Move_Derived_Window (Win : Window; + Line : Line_Position; + Column : Column_Position); -- AKA: mvderwin() - pragma Inline (Move_Derived_Window); + pragma Inline (Move_Derived_Window); -- #1A NAME="AFU_18"#2| - procedure Synchronize_Upwards (Win : Window); + procedure Synchronize_Upwards (Win : Window); -- AKA: wsyncup() pragma Import (C, Synchronize_Upwards, "wsyncup"); -- #1A NAME="AFU_19"#2| - procedure Synchronize_Downwards (Win : Window); + procedure Synchronize_Downwards (Win : Window); -- AKA: wsyncdown() pragma Import (C, Synchronize_Downwards, "wsyncdown"); -- #1A NAME="AFU_20"#2| - procedure Set_Synch_Mode (Win : Window := Standard_Window; - Mode : Boolean := False); + procedure Set_Synch_Mode (Win : Window := Standard_Window; + Mode : Boolean := False); -- AKA: syncok() - pragma Inline (Set_Synch_Mode); + pragma Inline (Set_Synch_Mode); -- |===================================================================== -- | Man page curs_addstr.3x -- |===================================================================== -- #1A NAME="AFU_21"#2| - procedure Add (Win : Window := Standard_Window; - Str : String; - Len : Integer := -1); + procedure Add (Win : Window := Standard_Window; + Str : String; + Len : Integer := -1); -- AKA: waddnstr() -- AKA: waddstr() -- AKA: addnstr() -- AKA: addstr() -- #1A NAME="AFU_22"#2| - procedure Add (Win : Window := Standard_Window; - Line : Line_Position; - Column : Column_Position; - Str : String; - Len : Integer := -1); + procedure Add (Win : Window := Standard_Window; + Line : Line_Position; + Column : Column_Position; + Str : String; + Len : Integer := -1); -- AKA: mvwaddnstr() -- AKA: mvwaddstr() -- AKA: mvaddnstr() @@ -692,20 +861,20 @@ -- |===================================================================== -- #1A NAME="AFU_23"#2| - procedure Add (Win : Window := Standard_Window; - Str : Attributed_String; - Len : Integer := -1); + procedure Add (Win : Window := Standard_Window; + Str : Attributed_String; + Len : Integer := -1); -- AKA: waddchnstr() -- AKA: waddchstr() -- AKA: addchnstr() -- AKA: addchstr() -- #1A NAME="AFU_24"#2| - procedure Add (Win : Window := Standard_Window; - Line : Line_Position; - Column : Column_Position; - Str : Attributed_String; - Len : Integer := -1); + procedure Add (Win : Window := Standard_Window; + Line : Line_Position; + Column : Column_Position; + Str : Attributed_String; + Len : Integer := -1); -- AKA: mvwaddchnstr() -- AKA: mvwaddchstr() -- AKA: mvaddchnstr() @@ -719,46 +888,46 @@ -- | use Move_Cursor then Horizontal_Line or Vertical_Line -- #1A NAME="AFU_25"#2| - procedure Border - (Win : Window := Standard_Window; - Left_Side_Symbol : Attributed_Character := Default_Character; - Right_Side_Symbol : Attributed_Character := Default_Character; - Top_Side_Symbol : Attributed_Character := Default_Character; - Bottom_Side_Symbol : Attributed_Character := Default_Character; - Upper_Left_Corner_Symbol : Attributed_Character := Default_Character; - Upper_Right_Corner_Symbol : Attributed_Character := Default_Character; - Lower_Left_Corner_Symbol : Attributed_Character := Default_Character; - Lower_Right_Corner_Symbol : Attributed_Character := Default_Character + procedure Border + (Win : Window := Standard_Window; + Left_Side_Symbol : Attributed_Character := Default_Character; + Right_Side_Symbol : Attributed_Character := Default_Character; + Top_Side_Symbol : Attributed_Character := Default_Character; + Bottom_Side_Symbol : Attributed_Character := Default_Character; + Upper_Left_Corner_Symbol : Attributed_Character := Default_Character; + Upper_Right_Corner_Symbol : Attributed_Character := Default_Character; + Lower_Left_Corner_Symbol : Attributed_Character := Default_Character; + Lower_Right_Corner_Symbol : Attributed_Character := Default_Character ); -- AKA: wborder() -- AKA: border() - pragma Inline (Border); + pragma Inline (Border); -- #1A NAME="AFU_26"#2| - procedure Box - (Win : Window := Standard_Window; - Vertical_Symbol : Attributed_Character := Default_Character; - Horizontal_Symbol : Attributed_Character := Default_Character); + procedure Box + (Win : Window := Standard_Window; + Vertical_Symbol : Attributed_Character := Default_Character; + Horizontal_Symbol : Attributed_Character := Default_Character); -- AKA: box() - pragma Inline (Box); + pragma Inline (Box); -- #1A NAME="AFU_27"#2| - procedure Horizontal_Line - (Win : Window := Standard_Window; - Line_Size : Natural; - Line_Symbol : Attributed_Character := Default_Character); + procedure Horizontal_Line + (Win : Window := Standard_Window; + Line_Size : Natural; + Line_Symbol : Attributed_Character := Default_Character); -- AKA: whline() -- AKA: hline() - pragma Inline (Horizontal_Line); + pragma Inline (Horizontal_Line); -- #1A NAME="AFU_28"#2| - procedure Vertical_Line - (Win : Window := Standard_Window; - Line_Size : Natural; - Line_Symbol : Attributed_Character := Default_Character); + procedure Vertical_Line + (Win : Window := Standard_Window; + Line_Size : Natural; + Line_Symbol : Attributed_Character := Default_Character); -- AKA: wvline() -- AKA: vline() - pragma Inline (Vertical_Line); + pragma Inline (Vertical_Line); -- |===================================================================== -- | Man page curs_getch.3x @@ -766,44 +935,44 @@ -- Not implemented: mvgetch, mvwgetch -- #1A NAME="AFU_29"#2| - function Get_Keystroke (Win : Window := Standard_Window) - return Real_Key_Code; + function Get_Keystroke (Win : Window := Standard_Window) + return Real_Key_Code; -- AKA: wgetch() -- AKA: getch() -- Get a character from the keyboard and echo it - if enabled - to the -- window. -- If for any reason (i.e. a timeout) we could not get a character the -- returned keycode is Key_None. - pragma Inline (Get_Keystroke); + pragma Inline (Get_Keystroke); -- #1A NAME="AFU_30"#2| - procedure Undo_Keystroke (Key : Real_Key_Code); + procedure Undo_Keystroke (Key : Real_Key_Code); -- AKA: ungetch() - pragma Inline (Undo_Keystroke); + pragma Inline (Undo_Keystroke); -- #1A NAME="AFU_31"#2| - function Has_Key (Key : Special_Key_Code) return Boolean; + function Has_Key (Key : Special_Key_Code) return Boolean; -- AKA: has_key() - pragma Inline (Has_Key); + pragma Inline (Has_Key); -- | -- | Some helper functions -- | - function Is_Function_Key (Key : Special_Key_Code) return Boolean; + function Is_Function_Key (Key : Special_Key_Code) return Boolean; -- Return True if the Key is a function key (i.e. one of F0 .. F63) - pragma Inline (Is_Function_Key); + pragma Inline (Is_Function_Key); - subtype Function_Key_Number is Integer range 0 .. 63; + subtype Function_Key_Number is Integer range 0 .. 63; -- (n)curses allows for 64 function keys. - function Function_Key (Key : Real_Key_Code) return Function_Key_Number; + function Function_Key (Key : Real_Key_Code) return Function_Key_Number; -- Return the number of the function key. If the code is not a -- function key, a CONSTRAINT_ERROR will be raised. - pragma Inline (Function_Key); + pragma Inline (Function_Key); - function Function_Key_Code (Key : Function_Key_Number) return Real_Key_Code; + function Function_Key_Code (Key : Function_Key_Number) return Real_Key_Code; -- Return the key code for a given function-key number. - pragma Inline (Function_Key_Code); + pragma Inline (Function_Key_Code); -- |===================================================================== -- | Man page curs_attr.3x @@ -815,16 +984,16 @@ -- PAIR_NUMBER(c) is the same as c.Color -- #1A NAME="AFU_32"#2| - procedure Standout (Win : Window := Standard_Window; - On : Boolean := True); + procedure Standout (Win : Window := Standard_Window; + On : Boolean := True); -- AKA: wstandout() -- AKA: wstandend() -- #1A NAME="AFU_33"#2| - procedure Switch_Character_Attribute - (Win : Window := Standard_Window; - Attr : Character_Attribute_Set := Normal_Video; - On : Boolean := True); -- if False we switch Off. + procedure Switch_Character_Attribute + (Win : Window := Standard_Window; + Attr : Character_Attribute_Set := Normal_Video; + On : Boolean := True); -- if False we switch Off. -- Switches those Attributes set to true in the list. -- AKA: wattron() -- AKA: wattroff() @@ -832,50 +1001,50 @@ -- AKA: attroff() -- #1A NAME="AFU_34"#2| - procedure Set_Character_Attributes - (Win : Window := Standard_Window; - Attr : Character_Attribute_Set := Normal_Video; - Color : Color_Pair := Color_Pair'First); + procedure Set_Character_Attributes + (Win : Window := Standard_Window; + Attr : Character_Attribute_Set := Normal_Video; + Color : Color_Pair := Color_Pair'First); -- AKA: wattrset() -- AKA: attrset() - pragma Inline (Set_Character_Attributes); + pragma Inline (Set_Character_Attributes); -- #1A NAME="AFU_35"#2| - function Get_Character_Attribute - (Win : Window := Standard_Window) return Character_Attribute_Set; + function Get_Character_Attribute + (Win : Window := Standard_Window) return Character_Attribute_Set; -- AKA: wattr_get() -- AKA: attr_get() -- #1A NAME="AFU_36"#2| - function Get_Character_Attribute - (Win : Window := Standard_Window) return Color_Pair; + function Get_Character_Attribute + (Win : Window := Standard_Window) return Color_Pair; -- AKA: wattr_get() pragma Inline (Get_Character_Attribute); -- #1A NAME="AFU_37"#2| - procedure Set_Color (Win : Window := Standard_Window; - Pair : Color_Pair); + procedure Set_Color (Win : Window := Standard_Window; + Pair : Color_Pair); -- AKA: wcolor_set() -- AKA: color_set() - pragma Inline (Set_Color); + pragma Inline (Set_Color); -- #1A NAME="AFU_38"#2| - procedure Change_Attributes - (Win : Window := Standard_Window; - Count : Integer := -1; - Attr : Character_Attribute_Set := Normal_Video; - Color : Color_Pair := Color_Pair'First); + procedure Change_Attributes + (Win : Window := Standard_Window; + Count : Integer := -1; + Attr : Character_Attribute_Set := Normal_Video; + Color : Color_Pair := Color_Pair'First); -- AKA: wchgat() -- AKA: chgat() -- #1A NAME="AFU_39"#2| - procedure Change_Attributes - (Win : Window := Standard_Window; - Line : Line_Position := Line_Position'First; - Column : Column_Position := Column_Position'First; - Count : Integer := -1; - Attr : Character_Attribute_Set := Normal_Video; - Color : Color_Pair := Color_Pair'First); + procedure Change_Attributes + (Win : Window := Standard_Window; + Line : Line_Position := Line_Position'First; + Column : Column_Position := Column_Position'First; + Count : Integer := -1; + Attr : Character_Attribute_Set := Normal_Video; + Color : Color_Pair := Color_Pair'First); -- AKA: mvwchgat() -- AKA: mvchgat() pragma Inline (Change_Attributes); @@ -885,14 +1054,14 @@ -- |===================================================================== -- #1A NAME="AFU_40"#2| - procedure Beep; + procedure Beep; -- AKA: beep() - pragma Inline (Beep); + pragma Inline (Beep); -- #1A NAME="AFU_41"#2| - procedure Flash_Screen; + procedure Flash_Screen; -- AKA: flash() - pragma Inline (Flash_Screen); + pragma Inline (Flash_Screen); -- |===================================================================== -- | Man page curs_inopts.3x @@ -901,75 +1070,75 @@ -- | Not implemented : typeahead -- -- #1A NAME="AFU_42"#2| - procedure Set_Cbreak_Mode (SwitchOn : Boolean := True); + procedure Set_Cbreak_Mode (SwitchOn : Boolean := True); -- AKA: cbreak() -- AKA: nocbreak() - pragma Inline (Set_Cbreak_Mode); + pragma Inline (Set_Cbreak_Mode); -- #1A NAME="AFU_43"#2| - procedure Set_Raw_Mode (SwitchOn : Boolean := True); + procedure Set_Raw_Mode (SwitchOn : Boolean := True); -- AKA: raw() -- AKA: noraw() - pragma Inline (Set_Raw_Mode); + pragma Inline (Set_Raw_Mode); -- #1A NAME="AFU_44"#2| - procedure Set_Echo_Mode (SwitchOn : Boolean := True); + procedure Set_Echo_Mode (SwitchOn : Boolean := True); -- AKA: echo() -- AKA: noecho() - pragma Inline (Set_Echo_Mode); + pragma Inline (Set_Echo_Mode); -- #1A NAME="AFU_45"#2| - procedure Set_Meta_Mode (Win : Window := Standard_Window; - SwitchOn : Boolean := True); + procedure Set_Meta_Mode (Win : Window := Standard_Window; + SwitchOn : Boolean := True); -- AKA: meta() - pragma Inline (Set_Meta_Mode); + pragma Inline (Set_Meta_Mode); -- #1A NAME="AFU_46"#2| - procedure Set_KeyPad_Mode (Win : Window := Standard_Window; - SwitchOn : Boolean := True); + procedure Set_KeyPad_Mode (Win : Window := Standard_Window; + SwitchOn : Boolean := True); -- AKA: keypad() - pragma Inline (Set_KeyPad_Mode); + pragma Inline (Set_KeyPad_Mode); - function Get_KeyPad_Mode (Win : Window := Standard_Window) + function Get_KeyPad_Mode (Win : Window := Standard_Window) return Boolean; -- This has no pendant in C. There you've to look into the WINDOWS -- structure to get the value. Bad practice, not repeated in Ada. - type Half_Delay_Amount is range 1 .. 255; + type Half_Delay_Amount is range 1 .. 255; -- #1A NAME="AFU_47"#2| - procedure Half_Delay (Amount : Half_Delay_Amount); + procedure Half_Delay (Amount : Half_Delay_Amount); -- AKA: halfdelay() - pragma Inline (Half_Delay); + pragma Inline (Half_Delay); -- #1A NAME="AFU_48"#2| - procedure Set_Flush_On_Interrupt_Mode - (Win : Window := Standard_Window; - Mode : Boolean := True); + procedure Set_Flush_On_Interrupt_Mode + (Win : Window := Standard_Window; + Mode : Boolean := True); -- AKA: intrflush() - pragma Inline (Set_Flush_On_Interrupt_Mode); + pragma Inline (Set_Flush_On_Interrupt_Mode); -- #1A NAME="AFU_49"#2| - procedure Set_Queue_Interrupt_Mode - (Win : Window := Standard_Window; - Flush : Boolean := True); + procedure Set_Queue_Interrupt_Mode + (Win : Window := Standard_Window; + Flush : Boolean := True); -- AKA: qiflush() -- AKA: noqiflush() - pragma Inline (Set_Queue_Interrupt_Mode); + pragma Inline (Set_Queue_Interrupt_Mode); -- #1A NAME="AFU_50"#2| - procedure Set_NoDelay_Mode - (Win : Window := Standard_Window; - Mode : Boolean := False); + procedure Set_NoDelay_Mode + (Win : Window := Standard_Window; + Mode : Boolean := False); -- AKA: nodelay() - pragma Inline (Set_NoDelay_Mode); + pragma Inline (Set_NoDelay_Mode); - type Timeout_Mode is (Blocking, Non_Blocking, Delayed); + type Timeout_Mode is (Blocking, Non_Blocking, Delayed); -- #1A NAME="AFU_51"#2| - procedure Set_Timeout_Mode (Win : Window := Standard_Window; - Mode : Timeout_Mode; - Amount : Natural); -- in Milliseconds + procedure Set_Timeout_Mode (Win : Window := Standard_Window; + Mode : Timeout_Mode; + Amount : Natural); -- in Milliseconds -- AKA: wtimeout() -- AKA: timeout() -- Instead of overloading the semantic of the sign of amount, we @@ -979,108 +1148,108 @@ -- We do not inline this procedure. -- #1A NAME="AFU_52"#2| - procedure Set_Escape_Timer_Mode - (Win : Window := Standard_Window; - Timer_Off : Boolean := False); + procedure Set_Escape_Timer_Mode + (Win : Window := Standard_Window; + Timer_Off : Boolean := False); -- AKA: notimeout() - pragma Inline (Set_Escape_Timer_Mode); + pragma Inline (Set_Escape_Timer_Mode); -- |===================================================================== -- | Man page curs_outopts.3x -- |===================================================================== -- #1A NAME="AFU_53"#2| - procedure Set_NL_Mode (SwitchOn : Boolean := True); + procedure Set_NL_Mode (SwitchOn : Boolean := True); -- AKA: nl() -- AKA: nonl() - pragma Inline (Set_NL_Mode); + pragma Inline (Set_NL_Mode); -- #1A NAME="AFU_54"#2| - procedure Clear_On_Next_Update - (Win : Window := Standard_Window; - Do_Clear : Boolean := True); + procedure Clear_On_Next_Update + (Win : Window := Standard_Window; + Do_Clear : Boolean := True); -- AKA: clearok() - pragma Inline (Clear_On_Next_Update); + pragma Inline (Clear_On_Next_Update); -- #1A NAME="AFU_55"#2| - procedure Use_Insert_Delete_Line - (Win : Window := Standard_Window; - Do_Idl : Boolean := True); + procedure Use_Insert_Delete_Line + (Win : Window := Standard_Window; + Do_Idl : Boolean := True); -- AKA: idlok() - pragma Inline (Use_Insert_Delete_Line); + pragma Inline (Use_Insert_Delete_Line); -- #1A NAME="AFU_56"#2| - procedure Use_Insert_Delete_Character - (Win : Window := Standard_Window; - Do_Idc : Boolean := True); + procedure Use_Insert_Delete_Character + (Win : Window := Standard_Window; + Do_Idc : Boolean := True); -- AKA: idcok() - pragma Inline (Use_Insert_Delete_Character); + pragma Inline (Use_Insert_Delete_Character); -- #1A NAME="AFU_57"#2| - procedure Leave_Cursor_After_Update - (Win : Window := Standard_Window; - Do_Leave : Boolean := True); + procedure Leave_Cursor_After_Update + (Win : Window := Standard_Window; + Do_Leave : Boolean := True); -- AKA: leaveok() - pragma Inline (Leave_Cursor_After_Update); + pragma Inline (Leave_Cursor_After_Update); -- #1A NAME="AFU_58"#2| - procedure Immediate_Update_Mode - (Win : Window := Standard_Window; - Mode : Boolean := False); + procedure Immediate_Update_Mode + (Win : Window := Standard_Window; + Mode : Boolean := False); -- AKA: immedok() - pragma Inline (Immediate_Update_Mode); + pragma Inline (Immediate_Update_Mode); -- #1A NAME="AFU_59"#2| - procedure Allow_Scrolling - (Win : Window := Standard_Window; - Mode : Boolean := False); + procedure Allow_Scrolling + (Win : Window := Standard_Window; + Mode : Boolean := False); -- AKA: scrollok() - pragma Inline (Allow_Scrolling); + pragma Inline (Allow_Scrolling); - function Scrolling_Allowed (Win : Window := Standard_Window) return Boolean; + function Scrolling_Allowed (Win : Window := Standard_Window) return Boolean; -- There is no such function in the C interface. - pragma Inline (Scrolling_Allowed); + pragma Inline (Scrolling_Allowed); -- #1A NAME="AFU_60"#2| - procedure Set_Scroll_Region - (Win : Window := Standard_Window; - Top_Line : Line_Position; - Bottom_Line : Line_Position); + procedure Set_Scroll_Region + (Win : Window := Standard_Window; + Top_Line : Line_Position; + Bottom_Line : Line_Position); -- AKA: wsetscrreg() -- AKA: setscrreg() - pragma Inline (Set_Scroll_Region); + pragma Inline (Set_Scroll_Region); -- |===================================================================== -- | Man page curs_refresh.3x -- |===================================================================== -- #1A NAME="AFU_61"#2| - procedure Update_Screen; + procedure Update_Screen; -- AKA: doupdate() - pragma Inline (Update_Screen); + pragma Inline (Update_Screen); -- #1A NAME="AFU_62"#2| - procedure Refresh (Win : Window := Standard_Window); + procedure Refresh (Win : Window := Standard_Window); -- AKA: wrefresh() -- There is an overloaded Refresh for Pads. -- The Inline pragma appears there -- AKA: refresh() -- #1A NAME="AFU_63"#2| - procedure Refresh_Without_Update - (Win : Window := Standard_Window); + procedure Refresh_Without_Update + (Win : Window := Standard_Window); -- AKA: wnoutrefresh() -- There is an overloaded Refresh_Without_Update for Pads. -- The Inline pragma appears there -- #1A NAME="AFU_64"#2| - procedure Redraw (Win : Window := Standard_Window); + procedure Redraw (Win : Window := Standard_Window); -- AKA: redrawwin() -- #1A NAME="AFU_65"#2| - procedure Redraw (Win : Window := Standard_Window; - Begin_Line : Line_Position; - Line_Count : Positive); + procedure Redraw (Win : Window := Standard_Window; + Begin_Line : Line_Position; + Line_Count : Positive); -- AKA: wredrawln() pragma Inline (Redraw); @@ -1089,31 +1258,31 @@ -- |===================================================================== -- #1A NAME="AFU_66"#2| - procedure Erase (Win : Window := Standard_Window); + procedure Erase (Win : Window := Standard_Window); -- AKA: werase() -- AKA: erase() - pragma Inline (Erase); + pragma Inline (Erase); -- #1A NAME="AFU_67"#2| - procedure Clear - (Win : Window := Standard_Window); + procedure Clear + (Win : Window := Standard_Window); -- AKA: wclear() -- AKA: clear() - pragma Inline (Clear); + pragma Inline (Clear); -- #1A NAME="AFU_68"#2| - procedure Clear_To_End_Of_Screen - (Win : Window := Standard_Window); + procedure Clear_To_End_Of_Screen + (Win : Window := Standard_Window); -- AKA: wclrtobot() -- AKA: clrtobot() - pragma Inline (Clear_To_End_Of_Screen); + pragma Inline (Clear_To_End_Of_Screen); -- #1A NAME="AFU_69"#2| - procedure Clear_To_End_Of_Line - (Win : Window := Standard_Window); + procedure Clear_To_End_Of_Line + (Win : Window := Standard_Window); -- AKA: wclrtoeol() -- AKA: clrtoeol() - pragma Inline (Clear_To_End_Of_Line); + pragma Inline (Clear_To_End_Of_Line); -- |===================================================================== -- | Man page curs_bkgd.3x @@ -1123,64 +1292,64 @@ -- TODO: we could have Set_Background(Window; Character_Attribute_Set) -- because in C it is common to see bkgdset(A_BOLD) or -- bkgdset(COLOR_PAIR(n)) - procedure Set_Background - (Win : Window := Standard_Window; - Ch : Attributed_Character); + procedure Set_Background + (Win : Window := Standard_Window; + Ch : Attributed_Character); -- AKA: wbkgdset() -- AKA: bkgdset() - pragma Inline (Set_Background); + pragma Inline (Set_Background); -- #1A NAME="AFU_71"#2| - procedure Change_Background - (Win : Window := Standard_Window; - Ch : Attributed_Character); + procedure Change_Background + (Win : Window := Standard_Window; + Ch : Attributed_Character); -- AKA: wbkgd() -- AKA: bkgd() - pragma Inline (Change_Background); + pragma Inline (Change_Background); -- #1A NAME="AFU_72"#2| -- ? wbkgdget is not listed in curs_bkgd, getbkgd is thpough. - function Get_Background (Win : Window := Standard_Window) - return Attributed_Character; + function Get_Background (Win : Window := Standard_Window) + return Attributed_Character; -- AKA: wbkgdget() -- AKA: bkgdget() - pragma Inline (Get_Background); + pragma Inline (Get_Background); -- |===================================================================== -- | Man page curs_touch.3x -- |===================================================================== -- #1A NAME="AFU_73"#2| - procedure Untouch (Win : Window := Standard_Window); + procedure Untouch (Win : Window := Standard_Window); -- AKA: untouchwin() - pragma Inline (Untouch); + pragma Inline (Untouch); -- #1A NAME="AFU_74"#2| - procedure Touch (Win : Window := Standard_Window); + procedure Touch (Win : Window := Standard_Window); -- AKA: touchwin() -- #1A NAME="AFU_75"#2| - procedure Touch (Win : Window := Standard_Window; - Start : Line_Position; - Count : Positive); + procedure Touch (Win : Window := Standard_Window; + Start : Line_Position; + Count : Positive); -- AKA: touchline() pragma Inline (Touch); -- #1A NAME="AFU_76"#2| - procedure Change_Lines_Status (Win : Window := Standard_Window; - Start : Line_Position; - Count : Positive; - State : Boolean); + procedure Change_Lines_Status (Win : Window := Standard_Window; + Start : Line_Position; + Count : Positive; + State : Boolean); -- AKA: wtouchln() - pragma Inline (Change_Lines_Status); + pragma Inline (Change_Lines_Status); -- #1A NAME="AFU_77"#2| - function Is_Touched (Win : Window := Standard_Window; - Line : Line_Position) return Boolean; + function Is_Touched (Win : Window := Standard_Window; + Line : Line_Position) return Boolean; -- AKA: is_linetouched() -- #1A NAME="AFU_78"#2| - function Is_Touched (Win : Window := Standard_Window) return Boolean; + function Is_Touched (Win : Window := Standard_Window) return Boolean; -- AKA: is_wintouched() pragma Inline (Is_Touched); @@ -1189,147 +1358,147 @@ -- |===================================================================== -- #1A NAME="AFU_79"#2| - procedure Copy - (Source_Window : Window; - Destination_Window : Window; - Source_Top_Row : Line_Position; - Source_Left_Column : Column_Position; - Destination_Top_Row : Line_Position; - Destination_Left_Column : Column_Position; - Destination_Bottom_Row : Line_Position; - Destination_Right_Column : Column_Position; - Non_Destructive_Mode : Boolean := True); + procedure Copy + (Source_Window : Window; + Destination_Window : Window; + Source_Top_Row : Line_Position; + Source_Left_Column : Column_Position; + Destination_Top_Row : Line_Position; + Destination_Left_Column : Column_Position; + Destination_Bottom_Row : Line_Position; + Destination_Right_Column : Column_Position; + Non_Destructive_Mode : Boolean := True); -- AKA: copywin() - pragma Inline (Copy); + pragma Inline (Copy); -- #1A NAME="AFU_80"#2| - procedure Overwrite (Source_Window : Window; - Destination_Window : Window); + procedure Overwrite (Source_Window : Window; + Destination_Window : Window); -- AKA: overwrite() - pragma Inline (Overwrite); + pragma Inline (Overwrite); -- #1A NAME="AFU_81"#2| - procedure Overlay (Source_Window : Window; - Destination_Window : Window); + procedure Overlay (Source_Window : Window; + Destination_Window : Window); -- AKA: overlay() - pragma Inline (Overlay); + pragma Inline (Overlay); -- |===================================================================== -- | Man page curs_deleteln.3x -- |===================================================================== -- #1A NAME="AFU_82"#2| - procedure Insert_Delete_Lines - (Win : Window := Standard_Window; - Lines : Integer := 1); -- default is to insert one line above + procedure Insert_Delete_Lines + (Win : Window := Standard_Window; + Lines : Integer := 1); -- default is to insert one line above -- AKA: winsdelln() -- AKA: insdelln() - pragma Inline (Insert_Delete_Lines); + pragma Inline (Insert_Delete_Lines); -- #1A NAME="AFU_83"#2| - procedure Delete_Line (Win : Window := Standard_Window); + procedure Delete_Line (Win : Window := Standard_Window); -- AKA: wdeleteln() -- AKA: deleteln() - pragma Inline (Delete_Line); + pragma Inline (Delete_Line); -- #1A NAME="AFU_84"#2| - procedure Insert_Line (Win : Window := Standard_Window); + procedure Insert_Line (Win : Window := Standard_Window); -- AKA: winsertln() -- AKA: insertln() - pragma Inline (Insert_Line); + pragma Inline (Insert_Line); -- |===================================================================== -- | Man page curs_getyx.3x -- |===================================================================== -- #1A NAME="AFU_85"#2| - procedure Get_Size - (Win : Window := Standard_Window; - Number_Of_Lines : out Line_Count; - Number_Of_Columns : out Column_Count); + procedure Get_Size + (Win : Window := Standard_Window; + Number_Of_Lines : out Line_Count; + Number_Of_Columns : out Column_Count); -- AKA: getmaxyx() - pragma Inline (Get_Size); + pragma Inline (Get_Size); -- #1A NAME="AFU_86"#2| - procedure Get_Window_Position - (Win : Window := Standard_Window; - Top_Left_Line : out Line_Position; - Top_Left_Column : out Column_Position); + procedure Get_Window_Position + (Win : Window := Standard_Window; + Top_Left_Line : out Line_Position; + Top_Left_Column : out Column_Position); -- AKA: getbegyx() - pragma Inline (Get_Window_Position); + pragma Inline (Get_Window_Position); -- #1A NAME="AFU_87"#2| - procedure Get_Cursor_Position - (Win : Window := Standard_Window; - Line : out Line_Position; - Column : out Column_Position); + procedure Get_Cursor_Position + (Win : Window := Standard_Window; + Line : out Line_Position; + Column : out Column_Position); -- AKA: getyx() - pragma Inline (Get_Cursor_Position); + pragma Inline (Get_Cursor_Position); -- #1A NAME="AFU_88"#2| - procedure Get_Origin_Relative_To_Parent - (Win : Window; - Top_Left_Line : out Line_Position; - Top_Left_Column : out Column_Position; - Is_Not_A_Subwindow : out Boolean); + procedure Get_Origin_Relative_To_Parent + (Win : Window; + Top_Left_Line : out Line_Position; + Top_Left_Column : out Column_Position; + Is_Not_A_Subwindow : out Boolean); -- AKA: getparyx() -- Instead of placing -1 in the coordinates as return, we use a Boolean -- to return the info that the window has no parent. - pragma Inline (Get_Origin_Relative_To_Parent); + pragma Inline (Get_Origin_Relative_To_Parent); -- |===================================================================== -- | Man page curs_pad.3x -- |===================================================================== -- #1A NAME="AFU_89"#2| - function New_Pad (Lines : Line_Count; - Columns : Column_Count) return Window; + function New_Pad (Lines : Line_Count; + Columns : Column_Count) return Window; -- AKA: newpad() - pragma Inline (New_Pad); + pragma Inline (New_Pad); -- #1A NAME="AFU_90"#2| - function Sub_Pad - (Pad : Window; - Number_Of_Lines : Line_Count; - Number_Of_Columns : Column_Count; - First_Line_Position : Line_Position; - First_Column_Position : Column_Position) return Window; + function Sub_Pad + (Pad : Window; + Number_Of_Lines : Line_Count; + Number_Of_Columns : Column_Count; + First_Line_Position : Line_Position; + First_Column_Position : Column_Position) return Window; -- AKA: subpad() - pragma Inline (Sub_Pad); + pragma Inline (Sub_Pad); -- #1A NAME="AFU_91"#2| - procedure Refresh - (Pad : Window; - Source_Top_Row : Line_Position; - Source_Left_Column : Column_Position; - Destination_Top_Row : Line_Position; - Destination_Left_Column : Column_Position; - Destination_Bottom_Row : Line_Position; - Destination_Right_Column : Column_Position); + procedure Refresh + (Pad : Window; + Source_Top_Row : Line_Position; + Source_Left_Column : Column_Position; + Destination_Top_Row : Line_Position; + Destination_Left_Column : Column_Position; + Destination_Bottom_Row : Line_Position; + Destination_Right_Column : Column_Position); -- AKA: prefresh() pragma Inline (Refresh); -- #1A NAME="AFU_92"#2| - procedure Refresh_Without_Update - (Pad : Window; - Source_Top_Row : Line_Position; - Source_Left_Column : Column_Position; - Destination_Top_Row : Line_Position; - Destination_Left_Column : Column_Position; - Destination_Bottom_Row : Line_Position; - Destination_Right_Column : Column_Position); + procedure Refresh_Without_Update + (Pad : Window; + Source_Top_Row : Line_Position; + Source_Left_Column : Column_Position; + Destination_Top_Row : Line_Position; + Destination_Left_Column : Column_Position; + Destination_Bottom_Row : Line_Position; + Destination_Right_Column : Column_Position); -- AKA: pnoutrefresh() pragma Inline (Refresh_Without_Update); -- #1A NAME="AFU_93"#2| - procedure Add_Character_To_Pad_And_Echo_It - (Pad : Window; - Ch : Attributed_Character); + procedure Add_Character_To_Pad_And_Echo_It + (Pad : Window; + Ch : Attributed_Character); -- AKA: pechochar() - procedure Add_Character_To_Pad_And_Echo_It - (Pad : Window; - Ch : Character); + procedure Add_Character_To_Pad_And_Echo_It + (Pad : Window; + Ch : Character); pragma Inline (Add_Character_To_Pad_And_Echo_It); -- |===================================================================== @@ -1337,27 +1506,27 @@ -- |===================================================================== -- #1A NAME="AFU_94"#2| - procedure Scroll (Win : Window := Standard_Window; - Amount : Integer := 1); + procedure Scroll (Win : Window := Standard_Window; + Amount : Integer := 1); -- AKA: wscrl() -- AKA: scroll() -- AKA: scrl() - pragma Inline (Scroll); + pragma Inline (Scroll); -- |===================================================================== -- | Man page curs_delch.3x -- |===================================================================== -- #1A NAME="AFU_95"#2| - procedure Delete_Character (Win : Window := Standard_Window); + procedure Delete_Character (Win : Window := Standard_Window); -- AKA: wdelch() -- AKA: delch() -- #1A NAME="AFU_96"#2| - procedure Delete_Character - (Win : Window := Standard_Window; - Line : Line_Position; - Column : Column_Position); + procedure Delete_Character + (Win : Window := Standard_Window; + Line : Line_Position; + Column : Column_Position); -- AKA: mvwdelch() -- AKA: mvdelch() pragma Inline (Delete_Character); @@ -1367,16 +1536,16 @@ -- |===================================================================== -- #1A NAME="AFU_97"#2| - function Peek (Win : Window := Standard_Window) - return Attributed_Character; + function Peek (Win : Window := Standard_Window) + return Attributed_Character; -- AKA: inch() -- AKA: winch() -- #1A NAME="AFU_98"#2| - function Peek - (Win : Window := Standard_Window; - Line : Line_Position; - Column : Column_Position) return Attributed_Character; + function Peek + (Win : Window := Standard_Window; + Line : Line_Position; + Column : Column_Position) return Attributed_Character; -- AKA: mvwinch() -- AKA: mvinch() -- More Peek's follow, pragma Inline appears later. @@ -1386,16 +1555,16 @@ -- |===================================================================== -- #1A NAME="AFU_99"#2| - procedure Insert (Win : Window := Standard_Window; - Ch : Attributed_Character); + procedure Insert (Win : Window := Standard_Window; + Ch : Attributed_Character); -- AKA: winsch() -- AKA: insch() -- #1A NAME="AFU_100"#2| - procedure Insert (Win : Window := Standard_Window; - Line : Line_Position; - Column : Column_Position; - Ch : Attributed_Character); + procedure Insert (Win : Window := Standard_Window; + Line : Line_Position; + Column : Column_Position; + Ch : Attributed_Character); -- AKA: mvwinsch() -- AKA: mvinsch() @@ -1404,20 +1573,20 @@ -- |===================================================================== -- #1A NAME="AFU_101"#2| - procedure Insert (Win : Window := Standard_Window; - Str : String; - Len : Integer := -1); + procedure Insert (Win : Window := Standard_Window; + Str : String; + Len : Integer := -1); -- AKA: winsnstr() -- AKA: winsstr() -- AKA: insnstr() -- AKA: insstr() -- #1A NAME="AFU_102"#2| - procedure Insert (Win : Window := Standard_Window; - Line : Line_Position; - Column : Column_Position; - Str : String; - Len : Integer := -1); + procedure Insert (Win : Window := Standard_Window; + Line : Line_Position; + Column : Column_Position; + Str : String; + Len : Integer := -1); -- AKA: mvwinsnstr() -- AKA: mvwinsstr() -- AKA: mvinsnstr() @@ -1429,20 +1598,20 @@ -- |===================================================================== -- #1A NAME="AFU_103"#2| - procedure Peek (Win : Window := Standard_Window; - Str : out String; - Len : Integer := -1); + procedure Peek (Win : Window := Standard_Window; + Str : out String; + Len : Integer := -1); -- AKA: winnstr() -- AKA: winstr() -- AKA: innstr() -- AKA: instr() -- #1A NAME="AFU_104"#2| - procedure Peek (Win : Window := Standard_Window; - Line : Line_Position; - Column : Column_Position; - Str : out String; - Len : Integer := -1); + procedure Peek (Win : Window := Standard_Window; + Line : Line_Position; + Column : Column_Position; + Str : out String; + Len : Integer := -1); -- AKA: mvwinnstr() -- AKA: mvwinstr() -- AKA: mvinnstr() @@ -1453,20 +1622,20 @@ -- |===================================================================== -- #1A NAME="AFU_105"#2| - procedure Peek (Win : Window := Standard_Window; - Str : out Attributed_String; - Len : Integer := -1); + procedure Peek (Win : Window := Standard_Window; + Str : out Attributed_String; + Len : Integer := -1); -- AKA: winchnstr() -- AKA: winchstr() -- AKA: inchnstr() -- AKA: inchstr() -- #1A NAME="AFU_106"#2| - procedure Peek (Win : Window := Standard_Window; - Line : Line_Position; - Column : Column_Position; - Str : out Attributed_String; - Len : Integer := -1); + procedure Peek (Win : Window := Standard_Window; + Line : Line_Position; + Column : Column_Position; + Str : out Attributed_String; + Len : Integer := -1); -- AKA: mvwinchnstr() -- AKA: mvwinchstr() -- AKA: mvinchnstr() @@ -1478,9 +1647,9 @@ -- |===================================================================== -- #1A NAME="AFU_107"#2| - procedure Get (Win : Window := Standard_Window; - Str : out String; - Len : Integer := -1); + procedure Get (Win : Window := Standard_Window; + Str : out String; + Len : Integer := -1); -- AKA: wgetnstr() -- AKA: wgetstr() -- AKA: getnstr() @@ -1489,11 +1658,11 @@ -- overflows. -- #1A NAME="AFU_108"#2| - procedure Get (Win : Window := Standard_Window; - Line : Line_Position; - Column : Column_Position; - Str : out String; - Len : Integer := -1); + procedure Get (Win : Window := Standard_Window; + Line : Line_Position; + Column : Column_Position; + Str : out String; + Len : Integer := -1); -- AKA: mvwgetnstr() -- AKA: mvwgetstr() -- AKA: mvgetnstr() @@ -1506,90 +1675,90 @@ -- Not Implemented: slk_attr_on, slk_attr_off, slk_attr_set - type Soft_Label_Key_Format is (Three_Two_Three, - Four_Four, - PC_Style, -- ncurses specific - PC_Style_With_Index); -- " - type Label_Number is new Positive range 1 .. 12; - type Label_Justification is (Left, Centered, Right); + type Soft_Label_Key_Format is (Three_Two_Three, + Four_Four, + PC_Style, -- ncurses specific + PC_Style_With_Index); -- " + type Label_Number is new Positive range 1 .. 12; + type Label_Justification is (Left, Centered, Right); -- #1A NAME="AFU_109"#2| - procedure Init_Soft_Label_Keys - (Format : Soft_Label_Key_Format := Three_Two_Three); + procedure Init_Soft_Label_Keys + (Format : Soft_Label_Key_Format := Three_Two_Three); -- AKA: slk_init() - pragma Inline (Init_Soft_Label_Keys); + pragma Inline (Init_Soft_Label_Keys); -- #1A NAME="AFU_110"#2| - procedure Set_Soft_Label_Key (Label : Label_Number; - Text : String; - Fmt : Label_Justification := Left); + procedure Set_Soft_Label_Key (Label : Label_Number; + Text : String; + Fmt : Label_Justification := Left); -- AKA: slk_set() -- We do not inline this procedure -- #1A NAME="AFU_111"#2| - procedure Refresh_Soft_Label_Keys; + procedure Refresh_Soft_Label_Keys; -- AKA: slk_refresh() - pragma Inline (Refresh_Soft_Label_Keys); + pragma Inline (Refresh_Soft_Label_Keys); -- #1A NAME="AFU_112"#2| - procedure Refresh_Soft_Label_Keys_Without_Update; + procedure Refresh_Soft_Label_Keys_Without_Update; -- AKA: slk_noutrefresh() - pragma Inline (Refresh_Soft_Label_Keys_Without_Update); + pragma Inline (Refresh_Soft_Label_Keys_Without_Update); -- #1A NAME="AFU_113"#2| - procedure Get_Soft_Label_Key (Label : Label_Number; - Text : out String); + procedure Get_Soft_Label_Key (Label : Label_Number; + Text : out String); -- AKA: slk_label() -- #1A NAME="AFU_114"#2| - function Get_Soft_Label_Key (Label : Label_Number) return String; + function Get_Soft_Label_Key (Label : Label_Number) return String; -- AKA: slk_label() -- Same as function pragma Inline (Get_Soft_Label_Key); -- #1A NAME="AFU_115"#2| - procedure Clear_Soft_Label_Keys; + procedure Clear_Soft_Label_Keys; -- AKA: slk_clear() - pragma Inline (Clear_Soft_Label_Keys); + pragma Inline (Clear_Soft_Label_Keys); -- #1A NAME="AFU_116"#2| - procedure Restore_Soft_Label_Keys; + procedure Restore_Soft_Label_Keys; -- AKA: slk_restore() - pragma Inline (Restore_Soft_Label_Keys); + pragma Inline (Restore_Soft_Label_Keys); -- #1A NAME="AFU_117"#2| - procedure Touch_Soft_Label_Keys; + procedure Touch_Soft_Label_Keys; -- AKA: slk_touch() - pragma Inline (Touch_Soft_Label_Keys); + pragma Inline (Touch_Soft_Label_Keys); -- #1A NAME="AFU_118"#2| - procedure Switch_Soft_Label_Key_Attributes - (Attr : Character_Attribute_Set; - On : Boolean := True); + procedure Switch_Soft_Label_Key_Attributes + (Attr : Character_Attribute_Set; + On : Boolean := True); -- AKA: slk_attron() -- AKA: slk_attroff() - pragma Inline (Switch_Soft_Label_Key_Attributes); + pragma Inline (Switch_Soft_Label_Key_Attributes); -- #1A NAME="AFU_119"#2| - procedure Set_Soft_Label_Key_Attributes - (Attr : Character_Attribute_Set := Normal_Video; - Color : Color_Pair := Color_Pair'First); + procedure Set_Soft_Label_Key_Attributes + (Attr : Character_Attribute_Set := Normal_Video; + Color : Color_Pair := Color_Pair'First); -- AKA: slk_attrset() - pragma Inline (Set_Soft_Label_Key_Attributes); + pragma Inline (Set_Soft_Label_Key_Attributes); -- #1A NAME="AFU_120"#2| - function Get_Soft_Label_Key_Attributes return Character_Attribute_Set; + function Get_Soft_Label_Key_Attributes return Character_Attribute_Set; -- AKA: slk_attr() -- #1A NAME="AFU_121"#2| - function Get_Soft_Label_Key_Attributes return Color_Pair; + function Get_Soft_Label_Key_Attributes return Color_Pair; -- AKA: slk_attr() pragma Inline (Get_Soft_Label_Key_Attributes); -- #1A NAME="AFU_122"#2| - procedure Set_Soft_Label_Key_Color (Pair : Color_Pair); + procedure Set_Soft_Label_Key_Color (Pair : Color_Pair); -- AKA: slk_color() - pragma Inline (Set_Soft_Label_Key_Color); + pragma Inline (Set_Soft_Label_Key_Color); -- |===================================================================== -- | Man page keybound.3x @@ -1601,20 +1770,20 @@ -- |===================================================================== -- #1A NAME="AFU_123"#2| - procedure Enable_Key (Key : Special_Key_Code; - Enable : Boolean := True); + procedure Enable_Key (Key : Special_Key_Code; + Enable : Boolean := True); -- AKA: keyok() - pragma Inline (Enable_Key); + pragma Inline (Enable_Key); -- |===================================================================== -- | Man page define_key.3x -- |===================================================================== -- #1A NAME="AFU_124"#2| - procedure Define_Key (Definition : String; - Key : Special_Key_Code); + procedure Define_Key (Definition : String; + Key : Special_Key_Code); -- AKA: define_key() - pragma Inline (Define_Key); + pragma Inline (Define_Key); -- |===================================================================== -- | Man page curs_util.3x @@ -1625,88 +1794,88 @@ -- -- #1A NAME="AFU_125"#2| - procedure Key_Name (Key : Real_Key_Code; - Name : out String); + procedure Key_Name (Key : Real_Key_Code; + Name : out String); -- AKA: keyname() -- The external name for a real keystroke. -- #1A NAME="AFU_126"#2| - function Key_Name (Key : Real_Key_Code) return String; + function Key_Name (Key : Real_Key_Code) return String; -- AKA: keyname() -- Same as function -- We do not inline this routine -- #1A NAME="AFU_127"#2| - procedure Un_Control (Ch : Attributed_Character; - Str : out String); + procedure Un_Control (Ch : Attributed_Character; + Str : out String); -- AKA: unctrl() -- #1A NAME="AFU_128"#2| - function Un_Control (Ch : Attributed_Character) return String; + function Un_Control (Ch : Attributed_Character) return String; -- AKA: unctrl() -- Same as function pragma Inline (Un_Control); -- #1A NAME="AFU_129"#2| - procedure Delay_Output (Msecs : Natural); + procedure Delay_Output (Msecs : Natural); -- AKA: delay_output() - pragma Inline (Delay_Output); + pragma Inline (Delay_Output); -- #1A NAME="AFU_130"#2| - procedure Flush_Input; + procedure Flush_Input; -- AKA: flushinp() - pragma Inline (Flush_Input); + pragma Inline (Flush_Input); -- |===================================================================== -- | Man page curs_termattrs.3x -- |===================================================================== -- #1A NAME="AFU_131"#2| - function Baudrate return Natural; + function Baudrate return Natural; -- AKA: baudrate() - pragma Inline (Baudrate); + pragma Inline (Baudrate); -- #1A NAME="AFU_132"#2| - function Erase_Character return Character; + function Erase_Character return Character; -- AKA: erasechar() - pragma Inline (Erase_Character); + pragma Inline (Erase_Character); -- #1A NAME="AFU_133"#2| - function Kill_Character return Character; + function Kill_Character return Character; -- AKA: killchar() - pragma Inline (Kill_Character); + pragma Inline (Kill_Character); -- #1A NAME="AFU_134"#2| - function Has_Insert_Character return Boolean; + function Has_Insert_Character return Boolean; -- AKA: has_ic() - pragma Inline (Has_Insert_Character); + pragma Inline (Has_Insert_Character); -- #1A NAME="AFU_135"#2| - function Has_Insert_Line return Boolean; + function Has_Insert_Line return Boolean; -- AKA: has_il() - pragma Inline (Has_Insert_Line); + pragma Inline (Has_Insert_Line); -- #1A NAME="AFU_136"#2| - function Supported_Attributes return Character_Attribute_Set; + function Supported_Attributes return Character_Attribute_Set; -- AKA: termattrs() - pragma Inline (Supported_Attributes); + pragma Inline (Supported_Attributes); -- #1A NAME="AFU_137"#2| - procedure Long_Name (Name : out String); + procedure Long_Name (Name : out String); -- AKA: longname() -- #1A NAME="AFU_138"#2| - function Long_Name return String; + function Long_Name return String; -- AKA: longname() -- Same as function pragma Inline (Long_Name); -- #1A NAME="AFU_139"#2| - procedure Terminal_Name (Name : out String); + procedure Terminal_Name (Name : out String); -- AKA: termname() -- #1A NAME="AFU_140"#2| - function Terminal_Name return String; + function Terminal_Name return String; -- AKA: termname() -- Same as function pragma Inline (Terminal_Name); @@ -1722,118 +1891,118 @@ -- This is equivalent to c.Color := n; -- #1A NAME="AFU_141"#2| - procedure Start_Color; + procedure Start_Color; -- AKA: start_color() pragma Import (C, Start_Color, "start_color"); -- #1A NAME="AFU_142"#2| - procedure Init_Pair (Pair : Redefinable_Color_Pair; - Fore : Color_Number; - Back : Color_Number); + procedure Init_Pair (Pair : Redefinable_Color_Pair; + Fore : Color_Number; + Back : Color_Number); -- AKA: init_pair() - pragma Inline (Init_Pair); + pragma Inline (Init_Pair); -- #1A NAME="AFU_143"#2| - procedure Pair_Content (Pair : Color_Pair; - Fore : out Color_Number; - Back : out Color_Number); + procedure Pair_Content (Pair : Color_Pair; + Fore : out Color_Number; + Back : out Color_Number); -- AKA: pair_content() - pragma Inline (Pair_Content); + pragma Inline (Pair_Content); -- #1A NAME="AFU_144"#2| - function Has_Colors return Boolean; + function Has_Colors return Boolean; -- AKA: has_colors() - pragma Inline (Has_Colors); + pragma Inline (Has_Colors); -- #1A NAME="AFU_145"#2| - procedure Init_Color (Color : Color_Number; - Red : RGB_Value; - Green : RGB_Value; - Blue : RGB_Value); + procedure Init_Color (Color : Color_Number; + Red : RGB_Value; + Green : RGB_Value; + Blue : RGB_Value); -- AKA: init_color() - pragma Inline (Init_Color); + pragma Inline (Init_Color); -- #1A NAME="AFU_146"#2| - function Can_Change_Color return Boolean; + function Can_Change_Color return Boolean; -- AKA: can_change_color() - pragma Inline (Can_Change_Color); + pragma Inline (Can_Change_Color); -- #1A NAME="AFU_147"#2| - procedure Color_Content (Color : Color_Number; - Red : out RGB_Value; - Green : out RGB_Value; - Blue : out RGB_Value); + procedure Color_Content (Color : Color_Number; + Red : out RGB_Value; + Green : out RGB_Value; + Blue : out RGB_Value); -- AKA: color_content() - pragma Inline (Color_Content); + pragma Inline (Color_Content); -- |===================================================================== -- | Man page curs_kernel.3x -- |===================================================================== -- | Not implemented: getsyx, setsyx -- - type Curses_Mode is (Curses, Shell); + type Curses_Mode is (Curses, Shell); -- #1A NAME="AFU_148"#2| - procedure Save_Curses_Mode (Mode : Curses_Mode); + procedure Save_Curses_Mode (Mode : Curses_Mode); -- AKA: def_prog_mode() -- AKA: def_shell_mode() - pragma Inline (Save_Curses_Mode); + pragma Inline (Save_Curses_Mode); -- #1A NAME="AFU_149"#2| - procedure Reset_Curses_Mode (Mode : Curses_Mode); + procedure Reset_Curses_Mode (Mode : Curses_Mode); -- AKA: reset_prog_mode() -- AKA: reset_shell_mode() - pragma Inline (Reset_Curses_Mode); + pragma Inline (Reset_Curses_Mode); -- #1A NAME="AFU_150"#2| - procedure Save_Terminal_State; + procedure Save_Terminal_State; -- AKA: savetty() - pragma Inline (Save_Terminal_State); + pragma Inline (Save_Terminal_State); -- #1A NAME="AFU_151"#2| - procedure Reset_Terminal_State; + procedure Reset_Terminal_State; -- AKA: resetty(); - pragma Inline (Reset_Terminal_State); + pragma Inline (Reset_Terminal_State); - type Stdscr_Init_Proc is access - function (Win : Window; - Columns : Column_Count) return Integer; - pragma Convention (C, Stdscr_Init_Proc); + type Stdscr_Init_Proc is access + function (Win : Window; + Columns : Column_Count) return Integer; + pragma Convention (C, Stdscr_Init_Proc); -- N.B.: the return value is actually ignored, but it seems to be -- a good practice to return 0 if you think all went fine -- and -1 otherwise. -- #1A NAME="AFU_152"#2| - procedure Rip_Off_Lines (Lines : Integer; - Proc : Stdscr_Init_Proc); + procedure Rip_Off_Lines (Lines : Integer; + Proc : Stdscr_Init_Proc); -- AKA: ripoffline() -- N.B.: to be more precise, this uses a ncurses specific enhancement of -- ripoffline(), in which the Lines argument absolute value is the -- number of lines to be ripped of. The official ripoffline() only -- uses the sign of Lines to remove a single line from bottom or top. - pragma Inline (Rip_Off_Lines); + pragma Inline (Rip_Off_Lines); - type Cursor_Visibility is (Invisible, Normal, Very_Visible); + type Cursor_Visibility is (Invisible, Normal, Very_Visible); -- #1A NAME="AFU_153"#2| - procedure Set_Cursor_Visibility (Visibility : in out Cursor_Visibility); + procedure Set_Cursor_Visibility (Visibility : in out Cursor_Visibility); -- AKA: curs_set() - pragma Inline (Set_Cursor_Visibility); + pragma Inline (Set_Cursor_Visibility); -- #1A NAME="AFU_154"#2| - procedure Nap_Milli_Seconds (Ms : Natural); + procedure Nap_Milli_Seconds (Ms : Natural); -- AKA: napms() - pragma Inline (Nap_Milli_Seconds); + pragma Inline (Nap_Milli_Seconds); -- |===================================================================== -- | Some useful helpers. -- |===================================================================== - type Transform_Direction is (From_Screen, To_Screen); - procedure Transform_Coordinates - (W : Window := Standard_Window; - Line : in out Line_Position; - Column : in out Column_Position; - Dir : Transform_Direction := From_Screen); + type Transform_Direction is (From_Screen, To_Screen); + procedure Transform_Coordinates + (W : Window := Standard_Window; + Line : in out Line_Position; + Column : in out Column_Position; + Dir : Transform_Direction := From_Screen); -- This procedure transforms screen coordinates into coordinates relative -- to the window and vice versa, depending on the Dir parameter. -- Screen coordinates are the position information for the physical device. @@ -1845,28 +2014,30 @@ -- | Man page default_colors.3x -- |===================================================================== + Default_Color : constant Color_Number := -1; + -- #1A NAME="AFU_155"#2| - procedure Use_Default_Colors; + procedure Use_Default_Colors; -- AKA: use_default_colors() - pragma Inline (Use_Default_Colors); + pragma Inline (Use_Default_Colors); -- #1A NAME="AFU_156"#2| - procedure Assume_Default_Colors (Fore : Color_Number := Default_Color; - Back : Color_Number := Default_Color); + procedure Assume_Default_Colors (Fore : Color_Number := Default_Color; + Back : Color_Number := Default_Color); -- AKA: assume_default_colors() - pragma Inline (Assume_Default_Colors); + pragma Inline (Assume_Default_Colors); -- |===================================================================== -- | Man page curs_extend.3x -- |===================================================================== -- #1A NAME="AFU_157"#2| - function Curses_Version return String; + function Curses_Version return String; -- AKA: curses_version() -- #1A NAME="AFU_158"#2| -- The returnvalue is the previous setting of the flag - function Use_Extended_Names (Enable : Boolean) return Boolean; + function Use_Extended_Names (Enable : Boolean) return Boolean; -- AKA: use_extended_names() -- |===================================================================== @@ -1874,7 +2045,7 @@ -- |===================================================================== -- #1A NAME="AFU_159"#2| - procedure Curses_Free_All; + procedure Curses_Free_All; -- AKA: _nc_freeall() -- |===================================================================== @@ -1882,19 +2053,19 @@ -- |===================================================================== -- #1A NAME="AFU_160"#2| - procedure Screen_Dump_To_File (Filename : String); + procedure Screen_Dump_To_File (Filename : String); -- AKA: scr_dump() -- #1A NAME="AFU_161"#2| - procedure Screen_Restore_From_File (Filename : String); + procedure Screen_Restore_From_File (Filename : String); -- AKA: scr_restore() -- #1A NAME="AFU_162"#2| - procedure Screen_Init_From_File (Filename : String); + procedure Screen_Init_From_File (Filename : String); -- AKA: scr_init() -- #1A NAME="AFU_163"#2| - procedure Screen_Set_File (Filename : String); + procedure Screen_Set_File (Filename : String); -- AKA: scr_set() -- |===================================================================== @@ -1926,21 +2097,24 @@ -- |===================================================================== -- #1A NAME="AFU_164"#2| - procedure Resize (Win : Window := Standard_Window; - Number_Of_Lines : Line_Count; - Number_Of_Columns : Column_Count); + procedure Resize (Win : Window := Standard_Window; + Number_Of_Lines : Line_Count; + Number_Of_Columns : Column_Count); -- AKA: wresize() private - type Window is new System.Storage_Elements.Integer_Address; - Null_Window : constant Window := 0; + type Window is new System.Storage_Elements.Integer_Address; + Null_Window : constant Window := 0; -- The next constants are generated and may be different on your -- architecture. -- - Sizeof_bool : constant Natural := 1; -- bool - type Curses_Bool is mod 2 ** Interfaces.C.char'Size; - Curses_Bool_False : constant Curses_Bool := 0; -end Terminal_Interface.Curses; + Sizeof_Bool : constant := Curses_Constants.Sizeof_Bool; + + type Curses_Bool is mod 2 ** Sizeof_Bool; + + Curses_Bool_False : constant Curses_Bool := 0; + +end Terminal_Interface.Curses; diff --git a/doc/html/ada/terminal_interface-curses_constants__ads.htm b/doc/html/ada/terminal_interface-curses_constants__ads.htm new file mode 100644 index 00000000..4ee45d5a --- /dev/null +++ b/doc/html/ada/terminal_interface-curses_constants__ads.htm @@ -0,0 +1,405 @@ + + + +terminal_interface-curses_constants.ads + + + + +

    File : terminal_interface-curses_constants.ads

    +
    +--  Generated by the C program ./generate (source ./gen.c).
+--  Do not edit this file directly.
+--  The values provided here may vary on your system.
+
+with System;
+package Terminal_Interface.Curses_Constants is
+   pragma Pure;
+
+   DFT_ARG_SUFFIX : constant String := "";
+   Bit_Order : constant System.Bit_Order := System.Low_Order_First;
+   Sizeof_Bool                  : constant := 8;
+   OK                           : constant := 0;
+   ERR                          : constant := -1;
+   pragma Warnings (Off); -- redefinition of Standard.True and False
+   TRUE                         : constant := 1;
+   FALSE                        : constant := 0;
+   pragma Warnings (On);
+
+   --  Version of the ncurses library from extensions(3NCURSES)
+
+   NCURSES_VERSION_MAJOR        : constant := 5;
+   NCURSES_VERSION_MINOR        : constant := 9;
+   Version : constant String := "5.9";
+
+   --  Character non-color attributes from attr(3NCURSES)
+
+   --  attr_t and chtype may be signed in C.
+   type attr_t is mod 2 ** 32;
+   A_CHARTEXT_First             : constant := 0;
+   A_CHARTEXT_Last              : constant := 7;
+   A_COLOR_First                : constant := 8;
+   A_COLOR_Last                 : constant := 15;
+   Attr_First                   : constant := 16;
+   Attr_Last                    : constant := 31;
+   A_STANDOUT_First             : constant := 16;
+   A_STANDOUT_Last              : constant := 16;
+   A_UNDERLINE_First            : constant := 17;
+   A_UNDERLINE_Last             : constant := 17;
+   A_REVERSE_First              : constant := 18;
+   A_REVERSE_Last               : constant := 18;
+   A_BLINK_First                : constant := 19;
+   A_BLINK_Last                 : constant := 19;
+   A_DIM_First                  : constant := 20;
+   A_DIM_Last                   : constant := 20;
+   A_BOLD_First                 : constant := 21;
+   A_BOLD_Last                  : constant := 21;
+   A_PROTECT_First              : constant := 24;
+   A_PROTECT_Last               : constant := 24;
+   A_INVIS_First                : constant := 23;
+   A_INVIS_Last                 : constant := 23;
+   A_ALTCHARSET_First           : constant := 22;
+   A_ALTCHARSET_Last            : constant := 22;
+   A_HORIZONTAL_First           : constant := 25;
+   A_HORIZONTAL_Last            : constant := 25;
+   A_LEFT_First                 : constant := 26;
+   A_LEFT_Last                  : constant := 26;
+   A_LOW_First                  : constant := 27;
+   A_LOW_Last                   : constant := 27;
+   A_RIGHT_First                : constant := 28;
+   A_RIGHT_Last                 : constant := 28;
+   A_TOP_First                  : constant := 29;
+   A_TOP_Last                   : constant := 29;
+   A_VERTICAL_First             : constant := 30;
+   A_VERTICAL_Last              : constant := 30;
+   chtype_Size                  : constant := 32;
+
+   --  predefined color numbers from color(3NCURSES)
+
+   COLOR_BLACK                  : constant := 0;
+   COLOR_RED                    : constant := 1;
+   COLOR_GREEN                  : constant := 2;
+   COLOR_YELLOW                 : constant := 3;
+   COLOR_BLUE                   : constant := 4;
+   COLOR_MAGENTA                : constant := 5;
+   COLOR_CYAN                   : constant := 6;
+   COLOR_WHITE                  : constant := 7;
+
+   --  ETI return codes from ncurses.h
+
+   E_OK                         : constant := 0;
+   E_SYSTEM_ERROR               : constant := -1;
+   E_BAD_ARGUMENT               : constant := -2;
+   E_POSTED                     : constant := -3;
+   E_CONNECTED                  : constant := -4;
+   E_BAD_STATE                  : constant := -5;
+   E_NO_ROOM                    : constant := -6;
+   E_NOT_POSTED                 : constant := -7;
+   E_UNKNOWN_COMMAND            : constant := -8;
+   E_NO_MATCH                   : constant := -9;
+   E_NOT_SELECTABLE             : constant := -10;
+   E_NOT_CONNECTED              : constant := -11;
+   E_REQUEST_DENIED             : constant := -12;
+   E_INVALID_FIELD              : constant := -13;
+   E_CURRENT                    : constant := -14;
+
+   --  Input key codes not defined in any ncurses manpage
+
+   KEY_MIN                      : constant := 257;
+   KEY_MAX                      : constant := 511;
+   KEY_CODE_YES                 : constant := 256;
+
+   --  Input key codes from getch(3NCURSES)
+
+   KEY_BREAK                    : constant := 257;
+   KEY_DOWN                     : constant := 258;
+   KEY_UP                       : constant := 259;
+   KEY_LEFT                     : constant := 260;
+   KEY_RIGHT                    : constant := 261;
+   KEY_HOME                     : constant := 262;
+   KEY_BACKSPACE                : constant := 263;
+   KEY_F0                       : constant := 264;
+   KEY_F1                       : constant := 265;
+   KEY_F2                       : constant := 266;
+   KEY_F3                       : constant := 267;
+   KEY_F4                       : constant := 268;
+   KEY_F5                       : constant := 269;
+   KEY_F6                       : constant := 270;
+   KEY_F7                       : constant := 271;
+   KEY_F8                       : constant := 272;
+   KEY_F9                       : constant := 273;
+   KEY_F10                      : constant := 274;
+   KEY_F11                      : constant := 275;
+   KEY_F12                      : constant := 276;
+   KEY_F13                      : constant := 277;
+   KEY_F14                      : constant := 278;
+   KEY_F15                      : constant := 279;
+   KEY_F16                      : constant := 280;
+   KEY_F17                      : constant := 281;
+   KEY_F18                      : constant := 282;
+   KEY_F19                      : constant := 283;
+   KEY_F20                      : constant := 284;
+   KEY_F21                      : constant := 285;
+   KEY_F22                      : constant := 286;
+   KEY_F23                      : constant := 287;
+   KEY_F24                      : constant := 288;
+   KEY_DL                       : constant := 328;
+   KEY_IL                       : constant := 329;
+   KEY_DC                       : constant := 330;
+   KEY_IC                       : constant := 331;
+   KEY_EIC                      : constant := 332;
+   KEY_CLEAR                    : constant := 333;
+   KEY_EOS                      : constant := 334;
+   KEY_EOL                      : constant := 335;
+   KEY_SF                       : constant := 336;
+   KEY_SR                       : constant := 337;
+   KEY_NPAGE                    : constant := 338;
+   KEY_PPAGE                    : constant := 339;
+   KEY_STAB                     : constant := 340;
+   KEY_CTAB                     : constant := 341;
+   KEY_CATAB                    : constant := 342;
+   KEY_ENTER                    : constant := 343;
+   KEY_SRESET                   : constant := 344;
+   KEY_RESET                    : constant := 345;
+   KEY_PRINT                    : constant := 346;
+   KEY_LL                       : constant := 347;
+   KEY_A1                       : constant := 348;
+   KEY_A3                       : constant := 349;
+   KEY_B2                       : constant := 350;
+   KEY_C1                       : constant := 351;
+   KEY_C3                       : constant := 352;
+   KEY_BTAB                     : constant := 353;
+   KEY_BEG                      : constant := 354;
+   KEY_CANCEL                   : constant := 355;
+   KEY_CLOSE                    : constant := 356;
+   KEY_COMMAND                  : constant := 357;
+   KEY_COPY                     : constant := 358;
+   KEY_CREATE                   : constant := 359;
+   KEY_END                      : constant := 360;
+   KEY_EXIT                     : constant := 361;
+   KEY_FIND                     : constant := 362;
+   KEY_HELP                     : constant := 363;
+   KEY_MARK                     : constant := 364;
+   KEY_MESSAGE                  : constant := 365;
+   KEY_MOVE                     : constant := 366;
+   KEY_NEXT                     : constant := 367;
+   KEY_OPEN                     : constant := 368;
+   KEY_OPTIONS                  : constant := 369;
+   KEY_PREVIOUS                 : constant := 370;
+   KEY_REDO                     : constant := 371;
+   KEY_REFERENCE                : constant := 372;
+   KEY_REFRESH                  : constant := 373;
+   KEY_REPLACE                  : constant := 374;
+   KEY_RESTART                  : constant := 375;
+   KEY_RESUME                   : constant := 376;
+   KEY_SAVE                     : constant := 377;
+   KEY_SBEG                     : constant := 378;
+   KEY_SCANCEL                  : constant := 379;
+   KEY_SCOMMAND                 : constant := 380;
+   KEY_SCOPY                    : constant := 381;
+   KEY_SCREATE                  : constant := 382;
+   KEY_SDC                      : constant := 383;
+   KEY_SDL                      : constant := 384;
+   KEY_SELECT                   : constant := 385;
+   KEY_SEND                     : constant := 386;
+   KEY_SEOL                     : constant := 387;
+   KEY_SEXIT                    : constant := 388;
+   KEY_SFIND                    : constant := 389;
+   KEY_SHELP                    : constant := 390;
+   KEY_SHOME                    : constant := 391;
+   KEY_SIC                      : constant := 392;
+   KEY_SLEFT                    : constant := 393;
+   KEY_SMESSAGE                 : constant := 394;
+   KEY_SMOVE                    : constant := 395;
+   KEY_SNEXT                    : constant := 396;
+   KEY_SOPTIONS                 : constant := 397;
+   KEY_SPREVIOUS                : constant := 398;
+   KEY_SPRINT                   : constant := 399;
+   KEY_SREDO                    : constant := 400;
+   KEY_SREPLACE                 : constant := 401;
+   KEY_SRIGHT                   : constant := 402;
+   KEY_SRSUME                   : constant := 403;
+   KEY_SSAVE                    : constant := 404;
+   KEY_SSUSPEND                 : constant := 405;
+   KEY_SUNDO                    : constant := 406;
+   KEY_SUSPEND                  : constant := 407;
+   KEY_UNDO                     : constant := 408;
+   KEY_MOUSE                    : constant := 409;
+   KEY_RESIZE                   : constant := 410;
+
+   --  alternate character codes (ACS) from addch(3NCURSES)
+
+   ACS_ULCORNER                 : constant := 108;
+   ACS_LLCORNER                 : constant := 109;
+   ACS_URCORNER                 : constant := 107;
+   ACS_LRCORNER                 : constant := 106;
+   ACS_LTEE                     : constant := 116;
+   ACS_RTEE                     : constant := 117;
+   ACS_BTEE                     : constant := 118;
+   ACS_TTEE                     : constant := 119;
+   ACS_HLINE                    : constant := 113;
+   ACS_VLINE                    : constant := 120;
+   ACS_PLUS                     : constant := 110;
+   ACS_S1                       : constant := 111;
+   ACS_S9                       : constant := 115;
+   ACS_DIAMOND                  : constant := 96;
+   ACS_CKBOARD                  : constant := 97;
+   ACS_DEGREE                   : constant := 102;
+   ACS_PLMINUS                  : constant := 103;
+   ACS_BULLET                   : constant := 126;
+   ACS_LARROW                   : constant := 44;
+   ACS_RARROW                   : constant := 43;
+   ACS_DARROW                   : constant := 46;
+   ACS_UARROW                   : constant := 45;
+   ACS_BOARD                    : constant := 104;
+   ACS_LANTERN                  : constant := 105;
+   ACS_BLOCK                    : constant := 48;
+   ACS_S3                       : constant := 112;
+   ACS_S7                       : constant := 114;
+   ACS_LEQUAL                   : constant := 121;
+   ACS_GEQUAL                   : constant := 122;
+   ACS_PI                       : constant := 123;
+   ACS_NEQUAL                   : constant := 124;
+   ACS_STERLING                 : constant := 125;
+
+   --  Menu_Options from opts(3MENU)
+
+   O_ONEVALUE_First             : constant := 0;
+   O_ONEVALUE_Last              : constant := 0;
+   O_SHOWDESC_First             : constant := 1;
+   O_SHOWDESC_Last              : constant := 1;
+   O_ROWMAJOR_First             : constant := 2;
+   O_ROWMAJOR_Last              : constant := 2;
+   O_IGNORECASE_First           : constant := 3;
+   O_IGNORECASE_Last            : constant := 3;
+   O_SHOWMATCH_First            : constant := 4;
+   O_SHOWMATCH_Last             : constant := 4;
+   O_NONCYCLIC_First            : constant := 5;
+   O_NONCYCLIC_Last             : constant := 5;
+   Menu_Options_Size            : constant := 32;
+
+   --  Item_Options from menu_opts(3MENU)
+
+   O_SELECTABLE_First           : constant := 0;
+   O_SELECTABLE_Last            : constant := 0;
+   Item_Options_Size            : constant := 32;
+
+   --  Field_Options from field_opts(3FORM)
+
+   O_VISIBLE_First              : constant := 0;
+   O_VISIBLE_Last               : constant := 0;
+   O_ACTIVE_First               : constant := 1;
+   O_ACTIVE_Last                : constant := 1;
+   O_PUBLIC_First               : constant := 2;
+   O_PUBLIC_Last                : constant := 2;
+   O_EDIT_First                 : constant := 3;
+   O_EDIT_Last                  : constant := 3;
+   O_WRAP_First                 : constant := 4;
+   O_WRAP_Last                  : constant := 4;
+   O_BLANK_First                : constant := 5;
+   O_BLANK_Last                 : constant := 5;
+   O_AUTOSKIP_First             : constant := 6;
+   O_AUTOSKIP_Last              : constant := 6;
+   O_NULLOK_First               : constant := 7;
+   O_NULLOK_Last                : constant := 7;
+   O_PASSOK_First               : constant := 8;
+   O_PASSOK_Last                : constant := 8;
+   O_STATIC_First               : constant := 9;
+   O_STATIC_Last                : constant := 9;
+   Field_Options_Size           : constant := 32;
+
+   --  Field_Options from opts(3FORM)
+
+   O_NL_OVERLOAD_First          : constant := 0;
+   O_NL_OVERLOAD_Last           : constant := 0;
+   O_BS_OVERLOAD_First          : constant := 1;
+   O_BS_OVERLOAD_Last           : constant := 1;
+
+   --  MEVENT structure from mouse(3NCURSES)
+
+   MEVENT_id_First              : constant := 0;
+   MEVENT_id_Last               : constant := 15;
+   MEVENT_x_First               : constant := 32;
+   MEVENT_x_Last                : constant := 63;
+   MEVENT_y_First               : constant := 64;
+   MEVENT_y_Last                : constant := 95;
+   MEVENT_z_First               : constant := 96;
+   MEVENT_z_Last                : constant := 127;
+   MEVENT_bstate_First          : constant := 128;
+   MEVENT_bstate_Last           : constant := 191;
+   MEVENT_Size                  : constant := 192;
+
+   --  mouse events from mouse(3NCURSES)
+
+   BUTTON1_RELEASED             : constant := 1;
+   BUTTON1_PRESSED              : constant := 2;
+   BUTTON1_CLICKED              : constant := 4;
+   BUTTON1_DOUBLE_CLICKED       : constant := 8;
+   BUTTON1_TRIPLE_CLICKED       : constant := 16;
+   BUTTON1_RESERVED_EVENT       : constant := 32;
+   all_events_button_1          : constant := 63;
+   BUTTON2_RELEASED             : constant := 64;
+   BUTTON2_PRESSED              : constant := 128;
+   BUTTON2_CLICKED              : constant := 256;
+   BUTTON2_DOUBLE_CLICKED       : constant := 512;
+   BUTTON2_TRIPLE_CLICKED       : constant := 1024;
+   BUTTON2_RESERVED_EVENT       : constant := 2048;
+   all_events_button_2          : constant := 4032;
+   BUTTON3_RELEASED             : constant := 4096;
+   BUTTON3_PRESSED              : constant := 8192;
+   BUTTON3_CLICKED              : constant := 16384;
+   BUTTON3_DOUBLE_CLICKED       : constant := 32768;
+   BUTTON3_TRIPLE_CLICKED       : constant := 65536;
+   BUTTON3_RESERVED_EVENT       : constant := 131072;
+   all_events_button_3          : constant := 258048;
+   BUTTON4_RELEASED             : constant := 262144;
+   BUTTON4_PRESSED              : constant := 524288;
+   BUTTON4_CLICKED              : constant := 1048576;
+   BUTTON4_DOUBLE_CLICKED       : constant := 2097152;
+   BUTTON4_TRIPLE_CLICKED       : constant := 4194304;
+   BUTTON4_RESERVED_EVENT       : constant := 8388608;
+   all_events_button_4          : constant := 16515072;
+   BUTTON_CTRL                  : constant := 16777216;
+   BUTTON_SHIFT                 : constant := 33554432;
+   BUTTON_ALT                   : constant := 67108864;
+   REPORT_MOUSE_POSITION        : constant := 134217728;
+   ALL_MOUSE_EVENTS             : constant := 134217727;
+
+   --  trace selection from trace(3NCURSES)
+
+   TRACE_TIMES_First            : constant := 0;
+   TRACE_TIMES_Last             : constant := 0;
+   TRACE_TPUTS_First            : constant := 1;
+   TRACE_TPUTS_Last             : constant := 1;
+   TRACE_UPDATE_First           : constant := 2;
+   TRACE_UPDATE_Last            : constant := 2;
+   TRACE_MOVE_First             : constant := 3;
+   TRACE_MOVE_Last              : constant := 3;
+   TRACE_CHARPUT_First          : constant := 4;
+   TRACE_CHARPUT_Last           : constant := 4;
+   TRACE_CALLS_First            : constant := 5;
+   TRACE_CALLS_Last             : constant := 5;
+   TRACE_VIRTPUT_First          : constant := 6;
+   TRACE_VIRTPUT_Last           : constant := 6;
+   TRACE_IEVENT_First           : constant := 7;
+   TRACE_IEVENT_Last            : constant := 7;
+   TRACE_BITS_First             : constant := 8;
+   TRACE_BITS_Last              : constant := 8;
+   TRACE_ICALLS_First           : constant := 9;
+   TRACE_ICALLS_Last            : constant := 9;
+   TRACE_CCALLS_First           : constant := 10;
+   TRACE_CCALLS_Last            : constant := 10;
+   TRACE_DATABASE_First         : constant := 11;
+   TRACE_DATABASE_Last          : constant := 11;
+   TRACE_ATTRS_First            : constant := 12;
+   TRACE_ATTRS_Last             : constant := 12;
+   Trace_Size                   : constant := 32;
+end Terminal_Interface.Curses_Constants;
+
    diff --git a/doc/html/man/adacurses-config.1.html b/doc/html/man/adacurses-config.1.html index 11fd61fa..69aaf294 100644 --- a/doc/html/man/adacurses-config.1.html +++ b/doc/html/man/adacurses-config.1.html @@ -83,7 +83,7 @@

    SEE ALSO

            curses(3x)
 
-       This describes ncurses version 5.9 (patch 20131221).
+       This describes ncurses version 5.9 (patch 20140524).
 
 
 
diff --git a/doc/html/man/captoinfo.1m.html b/doc/html/man/captoinfo.1m.html
index 2251ab04..b9ca9363 100644
--- a/doc/html/man/captoinfo.1m.html
+++ b/doc/html/man/captoinfo.1m.html
@@ -205,7 +205,7 @@
 
    SEE ALSO
            infocmp(1m), curses(3x), terminfo(5)
 
-       This describes ncurses version 5.9 (patch 20131221).
+       This describes ncurses version 5.9 (patch 20140524).
 
 
 
    
diff --git a/doc/html/man/clear.1.html b/doc/html/man/clear.1.html
index 02b5e31d..9b2ae01c 100644
--- a/doc/html/man/clear.1.html
+++ b/doc/html/man/clear.1.html
@@ -71,7 +71,7 @@
 
    SEE ALSO
            tput(1), terminfo(5)
 
-       This describes ncurses version 5.9 (patch 20131221).
+       This describes ncurses version 5.9 (patch 20140524).
 
 
 
diff --git a/doc/html/man/curs_addch.3x.html b/doc/html/man/curs_addch.3x.html
index b8e1fb01..b9f0f282 100644
--- a/doc/html/man/curs_addch.3x.html
+++ b/doc/html/man/curs_addch.3x.html
@@ -2,7 +2,7 @@
 
 
 
@@ -71,19 +71,33 @@
        character ch into the given window at its  current  window
        position,  which  is then advanced.  They are analogous to
        putchar in stdio(3).  If the advance is at the right  mar-
-       gin,  the  cursor  automatically wraps to the beginning of
-       the next line.  At the bottom  of  the  current  scrolling
-       region,  if  scrollok  is enabled, the scrolling region is
-       scrolled up one line.
+       gin:
+
+       o   The cursor automatically wraps to the beginning of the
+           next line.
+
+       o   At the bottom of the current scrolling region, and  if
+           scrollok  is enabled, the scrolling region is scrolled
+           up one line.
+
+       o   If scrollok is not enabled, writing a character at the
+           lower  right  margin  succeeds.   However, an error is
+           returned because it is not possible to wrap to  a  new
+           line
 
        If ch is a tab, newline, or backspace, the cursor is moved
-       appropriately within the window.  Backspace moves the cur-
-       sor one character left; at the left edge of  a  window  it
-       does  nothing.   Newline  does  a clrtoeol, then moves the
-       cursor to  the  window  left  margin  on  the  next  line,
-       scrolling  the  window if on the last line.  Tabs are con-
-       sidered to be at every eighth column.   The  tab  interval
-       may be altered by setting the TABSIZE variable.
+       appropriately within the window:
+
+       o   Backspace moves the cursor one character left; at  the
+           left edge of a window it does nothing.
+
+       o   Newline  does a clrtoeol, then moves the cursor to the
+           window left margin on the  next  line,  scrolling  the
+           window if on the last line.
+
+       o   Tabs are considered to be at every eighth column.  The
+           tab interval may be altered  by  setting  the  TABSIZE
+           variable.
 
        If ch is any control character other than tab, newline, or
        backspace, it is drawn  in  ^X  notation.   Calling  winch
diff --git a/doc/html/man/curs_getch.3x.html b/doc/html/man/curs_getch.3x.html
index 64953795..80d68f2a 100644
--- a/doc/html/man/curs_getch.3x.html
+++ b/doc/html/man/curs_getch.3x.html
@@ -2,7 +2,7 @@
 
 
 
@@ -76,14 +76,24 @@
        waits  until a character is typed or the specified timeout
        has been reached.
 
-       Unless noecho has been set, then the character  will  also
-       be echoed into the designated window according to the fol-
-       lowing rules: if the character is the current erase  char-
-       acter,  left  arrow, or backspace, the cursor is moved one
-       space to the left and that screen position is erased as if
-       delch had been called.  If the character value is any oth-
-       er KEY_ define, the user is  alerted  with  a  beep  call.
-       Otherwise the character is simply output to the screen.
+       If echo is enabled, and the window is not a pad, then  the
+       character  will  also be echoed into the designated window
+       according to the following rules:
+
+       o   If the character is the current erase character,  left
+           arrow,  or backspace, the cursor is moved one space to
+           the left and that screen  position  is  erased  as  if
+           delch had been called.
+
+       o   If  the  character value is any other KEY_ define, the
+           user is alerted with a beep call.
+
+       o   If the character is a carriage-return, and  if  nl  is
+           enabled,  it  is translated to a line-feed after echo-
+           ing.
+
+       o   Otherwise  the  character  is  simply  output  to  the
+           screen.
 
        If the window is not a pad, and it has been moved or modi-
        fied since the last call to  wrefresh,  wrefresh  will  be
@@ -93,7 +103,7 @@
        ken for that function key is returned instead of  the  raw
        characters.   Possible function keys are defined in <curs-
        es.h> as macros with values outside  the  range  of  8-bit
-       characters  whose  names begin with KEY_. Thus, a variable
+       characters  whose names begin with KEY_.  Thus, a variable
        intended to hold the return value of a function  key  must
        be of short size or larger.
 
@@ -116,8 +126,8 @@
        that not all of these are  necessarily  supported  on  any
        particular terminal.
 
-
             Name            Key name
+            -------------------------------------------------
             KEY_BREAK       Break key
             KEY_DOWN        The four arrow keys ...
             KEY_UP
@@ -168,6 +178,7 @@
             KEY_MESSAGE     Message key
             KEY_MOUSE       Mouse event read
             KEY_MOVE        Move key
+
             KEY_NEXT        Next object key
             KEY_OPEN        Open key
             KEY_OPTIONS     Options key
@@ -178,7 +189,6 @@
             KEY_REPLACE     Replace key
             KEY_RESIZE      Screen resized
             KEY_RESTART     Restart key
-
             KEY_RESUME      Resume key
             KEY_SAVE        Save key
             KEY_SBEG        Shifted beginning key
diff --git a/doc/html/man/curs_initscr.3x.html b/doc/html/man/curs_initscr.3x.html
index b61b21dc..d68a23d7 100644
--- a/doc/html/man/curs_initscr.3x.html
+++ b/doc/html/man/curs_initscr.3x.html
@@ -1,7 +1,7 @@
 
 
 
 
@@ -86,22 +86,34 @@
        use newterm.  The routine newterm should  be  called  once
        for each terminal.  It returns a variable of type SCREEN *
        which should be saved as a  reference  to  that  terminal.
-       The  arguments  are the type of the terminal to be used in
-       place of $TERM, a file pointer for output to the terminal,
-       and  another  file pointer for input from the terminal (if
-       type is NULL, $TERM will be used).  The program must  also
-       call  endwin  for  each terminal being used before exiting
-       from curses.  If newterm is called more than once for  the
-       same  terminal, the first terminal referred to must be the
-       last one for which endwin is called.
-
-       A program should always call endwin before exiting or  es-
-       caping  from  curses  mode  temporarily.  This routine re-
-       stores tty modes, moves the cursor to the lower  left-hand
-       corner  of  the  screen  and  resets the terminal into the
-       proper non-visual mode.  Calling refresh or doupdate after
-       a  temporary  escape  causes  the program to resume visual
-       mode.
+       newterm's arguments are
+
+       o   the type of the terminal to be used in place of $TERM,
+
+       o   a file pointer for output to the terminal, and
+
+       o   another file pointer for input from the terminal
+
+       If the type parameter is NULL, $TERM will be used.
+
+       The  program must also call endwin for each terminal being
+       used before exiting from curses.   If  newterm  is  called
+       more  than  once for the same terminal, the first terminal
+       referred to must be the  last  one  for  which  endwin  is
+       called.
+
+       A  program should always call endwin before exiting or es-
+       caping from curses mode temporarily.  This routine
+
+       o   restores tty modes,
+
+       o   moves the cursor to the lower left-hand corner of  the
+           screen and
+
+       o   resets the terminal into the proper non-visual mode.
+
+       Calling refresh or doupdate after a temporary escape caus-
+       es the program to resume visual mode.
 
        The isendwin routine  returns  TRUE  if  endwin  has  been
        called without any subsequent calls to wrefresh, and FALSE
@@ -128,8 +140,17 @@
        Routines that return pointers always return NULL on error.
 
        X/Open  defines  no error conditions.  In this implementa-
-       tion endwin returns an error if the terminal was not  ini-
-       tialized.
+       tion
+
+       o   endwin returns an error if the terminal was  not  ini-
+           tialized.
+
+       o   newterm returns an error if it cannot allocate the da-
+           ta structures for the screen,  or  for  the  top-level
+           windows  within  the  screen, i.e., curscr, newscr, or
+           stdscr.
+
+       o   set_term returns no error.
 
 
 
    
@@ -139,20 +160,20 @@

    PORTABILITY

    -       These  functions are described in the XSI Curses standard,
+       These functions are described in the XSI Curses  standard,
        Issue 4.  It specifies that portable applications must not
        call initscr more than once.
 
        Old versions of curses, e.g., BSD 4.4, may have returned a
-       null pointer from  initscr  when  an  error  is  detected,
-       rather  than  exiting.   It is safe but redundant to check
+       null  pointer  from  initscr  when  an  error is detected,
+       rather than exiting.  It is safe but  redundant  to  check
        the return value of initscr in XSI Curses.
 
        If the TERM variable is missing or empty, initscr uses the
-       value  "unknown", which normally corresponds to a terminal
-       entry with the generic (gn) capability.   Generic  entries
+       value "unknown", which normally corresponds to a  terminal
+       entry  with  the generic (gn) capability.  Generic entries
        are detected by curs_terminfo(3x) and cannot be used for full-
-       screen operation.   Other  implementations  may  handle  a
+       screen  operation.   Other  implementations  may  handle a
        missing/empty TERM variable differently.
 
 
diff --git a/doc/html/man/curs_opaque.3x.html b/doc/html/man/curs_opaque.3x.html
index ff0e5711..9516893a 100644
--- a/doc/html/man/curs_opaque.3x.html
+++ b/doc/html/man/curs_opaque.3x.html
@@ -1,7 +1,7 @@
 
 
 
 
@@ -69,6 +69,7 @@
        bool is_subwin(const WINDOW *win);
        bool is_syncok(const WINDOW *win);
        WINDOW * wgetparent(const WINDOW *win);
+       int wgetdelay(const WINDOW *win);
        int wgetscrreg(const WINDOW *win, int *top, int *bottom);
 
 
@@ -116,6 +117,9 @@
        is_syncok
             returns the value set in syncok
 
+       wgetdelay
+            returns the delay timeout as set in wtimeout.
+
        wgetparent
             returns  the parent WINDOW pointer for subwindows, or
             NULL for windows having no parent.
diff --git a/doc/html/man/curs_threads.3x.html b/doc/html/man/curs_threads.3x.html
index 89903733..f0a9d10d 100644
--- a/doc/html/man/curs_threads.3x.html
+++ b/doc/html/man/curs_threads.3x.html
@@ -1,7 +1,7 @@
 
 
@@ -552,6 +552,7 @@
       wget_wstr               screen (input-operation)
       wgetbkgrnd              window
       wgetch                  screen (input-operation)
+      wgetdelay               window
       wgetn_wstr              screen (input-operation)
       wgetnstr                screen (input-operation)
       wgetparent              window
@@ -582,8 +583,8 @@
       wnoutrefresh            screen
       wprintw                 window
       wredrawln               window
-      wrefresh                screen
 
+      wrefresh                screen
       wresize                 window locks(windowlist)
       wscanw                  screen
       wscrl                   window
diff --git a/doc/html/man/curs_window.3x.html b/doc/html/man/curs_window.3x.html
index b98446a0..a72ed31d 100644
--- a/doc/html/man/curs_window.3x.html
+++ b/doc/html/man/curs_window.3x.html
@@ -1,7 +1,7 @@
 
 
 
 
@@ -56,13 +56,16 @@
 
    SYNOPSIS
            #include <curses.h>
 
-       WINDOW *newwin(int nlines, int ncols, int begin_y,
-             int begin_x);
+       WINDOW *newwin(
+             int nlines, int ncols,
+             int begin_y, int begin_x);
        int delwin(WINDOW *win);
        int mvwin(WINDOW *win, int y, int x);
-       WINDOW *subwin(WINDOW *orig, int nlines, int ncols,
+       WINDOW *subwin(WINDOW *orig,
+             int nlines, int ncols,
              int begin_y, int begin_x);
-       WINDOW *derwin(WINDOW *orig, int nlines, int ncols,
+       WINDOW *derwin(WINDOW *orig,
+             int nlines, int ncols,
              int begin_y, int begin_x);
        int mvderwin(WINDOW *win, int par_y, int par_x);
        WINDOW *dupwin(WINDOW *win);
@@ -76,10 +79,16 @@
 
    DESCRIPTION
            Calling newwin creates and returns a pointer to a new win-
        dow with the given number of lines and columns.  The upper
-       left-hand  corner of the window is at line begin_y, column
-       begin_x.  If either nlines or ncols is zero, they  default
-       to  LINES - begin_y and COLS - begin_x.  A new full-screen
-       window is created by calling newwin(0,0,0,0).
+       left-hand corner of the window is at
+              line begin_y,
+              column begin_x
+
+       If either nlines or ncols is zero, they default to
+              LINES - begin_y and
+              COLS - begin_x.
+
+       A   new   full-screen   window   is   created  by  calling
+       newwin(0,0,0,0).
 
        Calling delwin deletes the named window, freeing all memo-
        ry associated with it (it does not actually erase the win-
@@ -95,13 +104,11 @@
        Calling subwin creates and returns a pointer to a new win-
        dow with the given number of lines, nlines,  and  columns,
        ncols.   The  window  is at position (begin_y, begin_x) on
-       the screen.  (This position is relative to the screen, and
-       not to the window orig.)  The window is made in the middle
-       of the window orig, so that changes  made  to  one  window
-       will  affect  both  windows.   The subwindow shares memory
-       with the window orig.  When using this routine, it is nec-
-       essary  to call touchwin or touchline on orig before call-
-       ing wrefresh on the subwindow.
+       the screen.  The subwindow shares memory with  the  window
+       orig,  so that changes made to one window will affect both
+       windows.  When using this routine, it is necessary to call
+       touchwin  or  touchline on orig before calling wrefresh on
+       the subwindow.
 
        Calling derwin is the same as calling subwin, except  that
        begin_y and begin_x are relative to the origin of the win-
@@ -143,30 +150,50 @@
        X/Open defines no error conditions.  In  this  implementa-
        tion
 
-              delwin
-                   returns  an  error  if  the  window pointer is
-                   null, or if the window is the parent of anoth-
-                   er window.
-
-                   This  implementation  also maintains a list of
-                   windows, and checks that the pointer passed to
-                   delwin  is  one  that it created, returning an
-                   error if it was not..
-
-              mvderwin
-                   returns an error  if  the  window  pointer  is
-                   null,  or  if some part of the window would be
-                   placed off-screen.
-
-              mvwin
-                   returns an error  if  the  window  pointer  is
-                   null,  or if the window is really a pad, or if
-                   some part of the window would be  placed  off-
-                   screen.
-
-              syncok
-                   returns  an  error  if  the  window pointer is
-                   null.
+       delwin
+            returns an error if the window pointer is null, or if
+            the window is the parent of another window.
+
+       derwin
+            returns an error if  the  parent  window  pointer  is
+            null,  or  if  any  of its ordinates or dimensions is
+            negative, or if the resulting window does not fit in-
+            side the parent window.
+
+       dupwin
+            returns an error if the window pointer is null.
+
+            This implementation also maintains a list of windows,
+            and checks that the pointer passed to delwin  is  one
+            that it created, returning an error if it was not..
+
+       mvderwin
+            returns an error if the window pointer is null, or if
+            some part of the window would be placed off-screen.
+
+       mvwin
+            returns an error if the window pointer is null, or if
+            the  window  is  really a pad, or if some part of the
+            window would be placed off-screen.
+
+       newwin
+            will fail if either of  its  beginning  ordinates  is
+            negative, or if either the number of lines or columns
+            is negative.
+
+       syncok
+            returns an error if the window pointer is null.
+
+       subwin
+            returns an error if  the  parent  window  pointer  is
+            null,  or  if  any  of its ordinates or dimensions is
+            negative, or if the resulting window does not fit in-
+            side the parent window.
+
+       The  functions which return a window pointer may also fail
+       if there is insufficient memory for its  data  structures.
+       Any  of  these  functions  will fail if the screen has not
+       been initialized, i.e., with initscr or newterm.
 
 
 
    
diff --git a/doc/html/man/form.3x.html b/doc/html/man/form.3x.html
index 57e92f2c..6c620aec 100644
--- a/doc/html/man/form.3x.html
+++ b/doc/html/man/form.3x.html
@@ -243,7 +243,7 @@
 
 
    
 
    SEE ALSO
    -       This describes ncurses version 5.9 (patch 20131221).
+       This describes ncurses version 5.9 (patch 20140524).
 
 
 
diff --git a/doc/html/man/infocmp.1m.html b/doc/html/man/infocmp.1m.html
index fc15a2b9..4d814961 100644
--- a/doc/html/man/infocmp.1m.html
+++ b/doc/html/man/infocmp.1m.html
@@ -2,7 +2,7 @@
 
 
 
@@ -352,8 +352,8 @@
             All  but NORMAL may be prefixed with `+' (turn on) or
             `-' (turn off).
 
-       An SGR0 designates an empty highlight sequence (equivalent
-       to {SGR:NORMAL}).
+            An  SGR0  designates  an  empty  highlight   sequence
+            (equivalent to {SGR:NORMAL}).
 
        -l   Set output format to terminfo.
 
@@ -455,7 +455,7 @@
 
        http://invisible-island.net/ncurses/tctest.html
 
-       This describes ncurses version 5.9 (patch 20131221).
+       This describes ncurses version 5.9 (patch 20140524).
 
 
 
    
diff --git a/doc/html/man/infotocap.1m.html b/doc/html/man/infotocap.1m.html
index 247f85eb..37c06938 100644
--- a/doc/html/man/infotocap.1m.html
+++ b/doc/html/man/infotocap.1m.html
@@ -94,7 +94,7 @@
 
    SEE ALSO
            curses(3x), tic(1m), infocmp(1m), terminfo(5)
 
-       This describes ncurses version 5.9 (patch 20131221).
+       This describes ncurses version 5.9 (patch 20140524).
 
 
 
    
diff --git a/doc/html/man/menu.3x.html b/doc/html/man/menu.3x.html
index c974468d..822b44a6 100644
--- a/doc/html/man/menu.3x.html
+++ b/doc/html/man/menu.3x.html
@@ -226,7 +226,7 @@

    SEE ALSO

    -       This describes ncurses version 5.9 (patch 20131221).
+       This describes ncurses version 5.9 (patch 20140524).
 
 
 
diff --git a/doc/html/man/ncurses.3x.html b/doc/html/man/ncurses.3x.html
index 57ca23ab..c4153e2e 100644
--- a/doc/html/man/ncurses.3x.html
+++ b/doc/html/man/ncurses.3x.html
@@ -2,7 +2,7 @@
 
 
 
@@ -63,7 +63,7 @@
        sonable optimization.  This implementation is "new curses"
        (ncurses) and is the approved replacement for 4.4BSD clas-
        sic  curses,  which has been discontinued.  This describes
-       ncurses version 5.9 (patch 20131221).
+       ncurses version 5.9 (patch 20140524).
 
        The ncurses library emulates the curses library of  System
        V  Release  4  UNIX,  and  XPG4 (X/Open Portability Guide)
@@ -774,15 +774,6 @@
        ing the runtime behavior of the ncurses library.  The most
        important ones have been already discussed in detail.
 
-       BAUDRATE
-            The  debugging  library checks this environment vari-
-            able when the application has redirected output to  a
-            file.   The  variable's numeric value is used for the
-            baudrate.  If no value is found, ncurses  uses  9600.
-            This  allows  testers  to  construct repeatable test-
-            cases that take into account  costs  that  depend  on
-            baudrate.
-
        CC   When set, change occurrences of the command_character
             (i.e., the cmdch capability) of the  loaded  terminfo
             entries to the value of this variable.  Very few ter-
@@ -793,6 +784,15 @@
             ignores it if it does not happen to be a single char-
             acter.
 
+       BAUDRATE
+            The  debugging  library checks this environment vari-
+            able when the application has redirected output to  a
+            file.   The  variable's numeric value is used for the
+            baudrate.  If no value is found, ncurses  uses  9600.
+            This  allows  testers  to  construct repeatable test-
+            cases that take into account  costs  that  depend  on
+            baudrate.
+
        COLUMNS
             Specify  the  width  of  the  screen  in  characters.
             Applications running in a windowing environment  usu-
@@ -892,6 +892,17 @@
             tive value from zero to the terminfo max_colors value
             is allowed.
 
+       NCURSES_CONSOLE2
+            This applies only to the MinGW port of ncurses.
+
+            The Console2 program's handling of the Microsoft Con-
+            sole API call CreateConsoleScreenBuffer is defective.
+            Applications which use this will hang.   However,  it
+            is  possible  to  simulate the action of this call by
+            mapping coordinates, explicitly saving and  restoring
+            the  original  screen contents.  Setting the environ-
+            ment variable NCGDB has the same effect.
+
        NCURSES_GPM_TERMS
             This applies only to ncurses configured  to  use  the
             GPM interface.
@@ -912,7 +923,7 @@
             variable to disable the feature.  You can also adjust
             your stty settings to avoid the problem.
 
-       NCURSES_NO_MAGIC_COOKIES
+       NCURSES_NO_MAGIC_COOKIE
             Some  terminals  use  a  magic-cookie  feature  which
             requires  special  handling  to make highlighting and
             other video attributes  display  properly.   You  can
@@ -1157,6 +1168,17 @@
             applications  to  be  built using either library from
             the same set of headers.
 
+       --with-pthread
+            The configure script renames the library.  All of the
+            library names have a "t" appended to them (before any
+            "w" added by --enable-widec).
+
+            The global variables such as LINES  are  replaced  by
+            macros  to allow read-only access.  At the same time,
+            setter-functions are provided to  set  these  values.
+            Some  applications  (very few) may require changes to
+            work with this convention.
+
        --with-shared
 
        --with-normal
diff --git a/doc/html/man/ncurses5-config.1.html b/doc/html/man/ncurses5-config.1.html
index 99c00fb4..37b3d7db 100644
--- a/doc/html/man/ncurses5-config.1.html
+++ b/doc/html/man/ncurses5-config.1.html
@@ -119,7 +119,7 @@
 
    SEE ALSO
            curses(3x)
 
-       This describes ncurses version 5.9 (patch 20131221).
+       This describes ncurses version 5.9 (patch 20140524).
 
 
 
diff --git a/doc/html/man/panel.3x.html b/doc/html/man/panel.3x.html
index 8f9af37b..00496bb7 100644
--- a/doc/html/man/panel.3x.html
+++ b/doc/html/man/panel.3x.html
@@ -218,7 +218,7 @@
 
    SEE ALSO
            curses(3x), curs_variables(3x),
 
-       This describes ncurses version 5.9 (patch 20131221).
+       This describes ncurses version 5.9 (patch 20140524).
 
 
 
    
diff --git a/doc/html/man/tabs.1.html b/doc/html/man/tabs.1.html
index 030d59d9..9f8e2b97 100644
--- a/doc/html/man/tabs.1.html
+++ b/doc/html/man/tabs.1.html
@@ -160,7 +160,7 @@
 
    SEE ALSO
            tset(1), infocmp(1m), curses(3x), terminfo(5).
 
-       This describes ncurses version 5.9 (patch 20131221).
+       This describes ncurses version 5.9 (patch 20140524).
 
 
 
diff --git a/doc/html/man/term_variables.3x.html b/doc/html/man/term_variables.3x.html
index 8041832a..089267d9 100644
--- a/doc/html/man/term_variables.3x.html
+++ b/doc/html/man/term_variables.3x.html
@@ -27,7 +27,7 @@
   * sale, use or other dealings in this Software without prior written       *
   * authorization.                                                           *
   ****************************************************************************
-  * @Id: term_variables.3x,v 1.3 2011/12/17 23:31:50 tom Exp @
+  * @Id: term_variables.3x,v 1.4 2013/12/21 22:17:39 tom Exp @
 -->
 
 
diff --git a/doc/html/man/terminfo.5.html b/doc/html/man/terminfo.5.html
index 94e2b034..757120b9 100644
--- a/doc/html/man/terminfo.5.html
+++ b/doc/html/man/terminfo.5.html
@@ -78,7 +78,7 @@
        nals by giving a set of capabilities which they  have,  by
        specifying how to perform screen operations, and by speci-
        fying padding requirements and  initialization  sequences.
-       This describes ncurses version 5.9 (patch 20131221).
+       This describes ncurses version 5.9 (patch 20140524).
 
        Entries in terminfo consist of a sequence of `,' separated
        fields (embedded commas may be escaped with a backslash or
diff --git a/doc/html/man/tic.1m.html b/doc/html/man/tic.1m.html
index 1d2085fb..5e543398 100644
--- a/doc/html/man/tic.1m.html
+++ b/doc/html/man/tic.1m.html
@@ -1,7 +1,7 @@
 
 
 
 
@@ -142,85 +142,106 @@
               stricter BSD-compatible  translation,  add  the  -K
               option.
 
-       -c     tells  tic to only check file for errors, including
-              syntax problems and bad use links.  If you  specify
+              If  this  is combined with -c, tic makes additional
+              checks to report cases where the terminfo values do
+              not  have an exact equivalent in termcap form.  For
+              example:
+
+              o   sgr usually will not convert,  because  termcap
+                  lacks  the  ability  to work with more than two
+                  parameters, and because termcap lacks  many  of
+                  the  arithmetic/logical  operators used in ter-
+                  minfo.
+
+              o   capabilities with more than one delay  or  with
+                  delays  before  the  end of the string will not
+                  convert completely.
+
+       -c     tells tic to only check file for errors,  including
+              syntax  problems and bad use links.  If you specify
               -C (-I) with this option, the code will print warn-
               ings about entries which, after use resolution, are
-              more  than  1023 (4096) bytes long.  Due to a fixed
-              buffer length in older termcap libraries,  as  well
+              more than 1023 (4096) bytes long.  Due to  a  fixed
+              buffer  length  in older termcap libraries, as well
               as buggy checking for the buffer length (and a doc-
               umented limit in terminfo), these entries may cause
               core dumps with other implementations.
 
-       -D     tells  tic  to print the database locations that it
+              tic checks string capabilities to ensure that those
+              with parameters will be valid expressions.  It does
+              this check only for the predefined string capabili-
+              ties;  those  which  are defined with the -x option
+              are ignored.
+
+       -D     tells tic to print the database locations  that  it
               knows about, and exit.  The first location shown is
-              the  one  to which it would write compiled terminal
+              the one to which it would write  compiled  terminal
               descriptions.   If  tic  is  not  able  to  find  a
-              writable  database  location according to the rules
-              summarized above, it will print  a  diagnostic  and
-              exit  with  an error rather than printing a list of
+              writable database location according to  the  rules
+              summarized  above,  it  will print a diagnostic and
+              exit with an error rather than printing a  list  of
               database locations.
 
        -e names
-              Limit writes  and  translations  to  the  following
-              comma-separated  list of terminals.  If any name or
+              Limit  writes  and  translations  to  the following
+              comma-separated list of terminals.  If any name  or
               alias of a terminal matches one of the names in the
-              list,  the  entry  will be written or translated as
-              normal.  Otherwise no output will be generated  for
+              list, the entry will be written  or  translated  as
+              normal.   Otherwise no output will be generated for
               it.  The option value is interpreted as a file con-
-              taining the list if  it  contains  a  '/'.   (Note:
-              depending  on how tic was compiled, this option may
+              taining  the  list  if  it  contains a '/'.  (Note:
+              depending on how tic was compiled, this option  may
               require -I or -C.)
 
        -f     Display  complex  terminfo  strings  which  contain
-              if/then/else/endif  expressions  indented for read-
+              if/then/else/endif expressions indented  for  read-
               ability.
 
-       -G     Display constant literals in  decimal  form  rather
+       -G     Display  constant  literals  in decimal form rather
               than their character equivalents.
 
-       -g     Display  constant character literals in quoted form
+       -g     Display constant character literals in quoted  form
               rather than their decimal equivalents.
 
        -I     Force source translation to terminfo format.
 
-       -K     Suppress some longstanding  ncurses  extensions  to
+       -K     Suppress  some  longstanding  ncurses extensions to
               termcap format, e.g., "\s" for space.
 
-       -L     Force  source  translation to terminfo format using
+       -L     Force source translation to terminfo  format  using
               the long C variable names listed in <term.h>
 
        -N     Disable smart defaults.  Normally, when translating
               from termcap to terminfo, the compiler makes a num-
-              ber of assumptions about  the  defaults  of  string
-              capabilities  reset1_string,  carriage_return, cur-
-              sor_left, cursor_down,  scroll_forward,  tab,  new-
-              line,  key_backspace,  key_left, and key_down, then
-              attempts to use obsolete  termcap  capabilities  to
+              ber  of  assumptions  about  the defaults of string
+              capabilities reset1_string,  carriage_return,  cur-
+              sor_left,  cursor_down,  scroll_forward,  tab, new-
+              line, key_backspace, key_left, and  key_down,  then
+              attempts  to  use  obsolete termcap capabilities to
               deduce correct values.  It also normally suppresses
               output of obsolete termcap capabilities such as bs.
-              This  option forces a more literal translation that
+              This option forces a more literal translation  that
               also preserves the obsolete capabilities.
 
-       -odir  Write compiled entries to given database  location.
+       -odir  Write  compiled entries to given database location.
               Overrides the TERMINFO environment variable.
 
        -Rsubset
-              Restrict  output to a given subset.  This option is
-              for use with  archaic  versions  of  terminfo  like
+              Restrict output to a given subset.  This option  is
+              for  use  with  archaic  versions  of terminfo like
               those on SVr1, Ultrix, or HP/UX that do not support
-              the full set of SVR4/XSI Curses terminfo; and  out-
+              the  full set of SVR4/XSI Curses terminfo; and out-
               right broken ports like AIX 3.x that have their own
-              extensions incompatible with  SVr4/XSI.   Available
+              extensions  incompatible  with SVr4/XSI.  Available
               subsets  are  "SVr1",  "Ultrix",  "HP",  "BSD"  and
               "AIX"; see terminfo(5) for details.
 
-       -r     Force entry resolution (so there are  no  remaining
-              tc  capabilities)  even  when  doing translation to
+       -r     Force  entry  resolution (so there are no remaining
+              tc capabilities) even  when  doing  translation  to
               termcap format.  This may be needed if you are pre-
-              paring  a  termcap file for a termcap library (such
-              as GNU termcap through version 1.3 or  BSD  termcap
-              through  4.3BSD)  that  does not handle multiple tc
+              paring a termcap file for a termcap  library  (such
+              as  GNU  termcap through version 1.3 or BSD termcap
+              through 4.3BSD) that does not  handle  multiple  tc
               capabilities per entry.
 
        -s     Summarize the compile by showing the database loca-
@@ -228,28 +249,28 @@
               of entries which are compiled.
 
        -T     eliminates size-restrictions on the generated text.
-              This  is  mainly  useful  for testing and analysis,
-              since the compiled descriptions are limited  (e.g.,
+              This is mainly useful  for  testing  and  analysis,
+              since  the compiled descriptions are limited (e.g.,
               1023 for termcap, 4096 for terminfo).
 
-       -t     tells  tic  to  discard commented-out capabilities.
+       -t     tells tic to  discard  commented-out  capabilities.
               Normally when translating from terminfo to termcap,
               untranslatable capabilities are commented-out.
 
-       -U   tells  tic to not post-process the data after parsing
-            the source file.  Normally, it infers data  which  is
-            commonly  missing in older terminfo data, or in term-
+       -U   tells tic to not post-process the data after  parsing
+            the  source  file.  Normally, it infers data which is
+            commonly missing in older terminfo data, or in  term-
             caps.
 
        -V   reports the version of ncurses which was used in this
             program, and exits.
 
-       -vn  specifies  that  (verbose) output be written to stan-
-            dard error trace information showing tic's  progress.
-            The  optional  parameter  n is a number from 1 to 10,
-            inclusive, indicating the desired level of detail  of
-            information.   If  n is omitted, the default level is
-            1.  If n is specified and greater than 1,  the  level
+       -vn  specifies that (verbose) output be written  to  stan-
+            dard  error trace information showing tic's progress.
+            The optional parameter n is a number from  1  to  10,
+            inclusive,  indicating the desired level of detail of
+            information.  If n is omitted, the default  level  is
+            1.   If  n is specified and greater than 1, the level
             of detail is increased.
 
             The debug flag levels are as follows:
@@ -266,30 +287,30 @@
 
             8      List of tokens encountered by scanner
 
-            9      All  values  computed  in  construction of the
+            9      All values computed  in  construction  of  the
                    hash table
 
-            If the debug level n is not given, it is taken to  be
+            If  the debug level n is not given, it is taken to be
             one.
 
-       -wn  specifies  the width of the output.  The parameter is
+       -wn  specifies the width of the output.  The parameter  is
             optional.  If it is omitted, it defaults to 60.
 
        -x   Treat unknown capabilities as user-defined.  That is,
-            if  you  supply  a capability name which tic does not
+            if you supply a capability name which  tic  does  not
             recognize, it will infer its type (boolean, number or
-            string)  from  the  syntax and make an extended table
+            string) from the syntax and make  an  extended  table
             entry  for  that.   User-defined  capability  strings
-            whose  name  begins  with "k" are treated as function
+            whose name begins with "k" are  treated  as  function
             keys.
 
    PARAMETERS
        file   contains one or more terminfo terminal descriptions
-              in  source format [see terminfo(5)].  Each descrip-
-              tion in the file describes the  capabilities  of  a
+              in source format [see terminfo(5)].  Each  descrip-
+              tion  in  the  file describes the capabilities of a
               particular terminal.
 
-              If  file  is  "-",  then  the data is read from the
+              If file is "-", then the  data  is  read  from  the
               standard input.  The file parameter may also be the
               path of a character-device.
 
@@ -298,62 +319,62 @@
        umented in terminfo(5).  The exception is the use capabil-
        ity.
 
-       When  a  use=entry-name  field is discovered in a terminal
-       entry currently being compiled, tic reads  in  the  binary
-       from  /usr/share/terminfo to complete the entry.  (Entries
-       created from file will be used first.  tic duplicates  the
+       When a use=entry-name field is discovered  in  a  terminal
+       entry  currently  being  compiled, tic reads in the binary
+       from /usr/share/terminfo to complete the entry.   (Entries
+       created  from file will be used first.  tic duplicates the
        capabilities in entry-name for the current entry, with the
-       exception  of  those  capabilities  that  explicitly   are
+       exception   of  those  capabilities  that  explicitly  are
        defined in the current entry.
 
-       When    an   entry,   e.g.,   entry_name_1,   contains   a
-       use=entry_name_2  field,  any  canceled  capabilities   in
-       entry_name_2  must also appear in entry_name_1 before use=
+       When   an   entry,   e.g.,   entry_name_1,   contains    a
+       use=entry_name_2   field,  any  canceled  capabilities  in
+       entry_name_2 must also appear in entry_name_1 before  use=
        for these capabilities to be canceled in entry_name_1.
 
        Total compiled entries cannot exceed 4096 bytes.  The name
-       field  cannot  exceed 512 bytes.  Terminal names exceeding
-       the maximum alias length (32 characters  on  systems  with
+       field cannot exceed 512 bytes.  Terminal  names  exceeding
+       the  maximum  alias  length (32 characters on systems with
        long filenames, 14 characters otherwise) will be truncated
-       to the maximum alias length and a warning message will  be
+       to  the maximum alias length and a warning message will be
        printed.
 
 
 
    
 
    COMPATIBILITY
    -       There  is  some evidence that historic tic implementations
-       treated description fields with no whitespace in  them  as
-       additional  aliases  or short names.  This tic does not do
-       that, but it does warn  when  description  fields  may  be
+       There is some evidence that historic  tic  implementations
+       treated  description  fields with no whitespace in them as
+       additional aliases or short names.  This tic does  not  do
+       that,  but  it  does  warn  when description fields may be
        treated that way and check them for dangerous characters.
 
 
 
    
 
    EXTENSIONS
            Unlike the SVr4 tic command, this implementation can actu-
-       ally compile termcap sources.  In fact,  entries  in  ter-
-       minfo  and  termcap syntax can be mixed in a single source
+       ally  compile  termcap  sources.  In fact, entries in ter-
+       minfo and termcap syntax can be mixed in a  single  source
        file.  See terminfo(5) for the list of termcap names taken
        to be equivalent to terminfo names.
 
-       The  SVr4  manual  pages  are  not clear on the resolution
-       rules for use capabilities.  This  implementation  of  tic
+       The SVr4 manual pages are  not  clear  on  the  resolution
+       rules  for  use  capabilities.  This implementation of tic
        will find use targets anywhere in the source file, or any-
-       where in the file tree rooted at TERMINFO (if TERMINFO  is
+       where  in the file tree rooted at TERMINFO (if TERMINFO is
        defined), or in the user's $HOME/.terminfo database (if it
-       exists), or (finally) anywhere in the system's  file  tree
+       exists),  or  (finally) anywhere in the system's file tree
        of compiled entries.
 
-       The  error  messages from this tic have the same format as
-       GNU C error messages, and can be  parsed  by  GNU  Emacs's
+       The error messages from this tic have the same  format  as
+       GNU  C  error  messages,  and can be parsed by GNU Emacs's
        compile facility.
 
-       The  -0,  -1,  -C, -G, -I, -N, -R, -T, -V, -a, -e, -f, -g,
-       -o, -r, -s, -t and -x  options  are  not  supported  under
+       The -0, -1, -C, -G, -I, -N, -R, -T, -V, -a,  -e,  -f,  -g,
+       -o,  -r,  -s,  -t  and  -x options are not supported under
        SVr4.  The SVr4 -c mode does not report bad use links.
 
-       System  V does not compile entries to or read entries from
-       your $HOME/.terminfo database unless TERMINFO  is  explic-
+       System V does not compile entries to or read entries  from
+       your  $HOME/.terminfo  database unless TERMINFO is explic-
        itly set to it.
 
 
@@ -365,10 +386,10 @@
 
 
    
 
    SEE ALSO
    -       infocmp(1m),    captoinfo(1m),   infotocap(1m),   toe(1m),
+       infocmp(1m),   captoinfo(1m),   infotocap(1m),    toe(1m),
        curses(3x), term(5).  terminfo(5).
 
-       This describes ncurses version 5.9 (patch 20131221).
+       This describes ncurses version 5.9 (patch 20140524).
 
 
 
    
diff --git a/doc/html/man/toe.1m.html b/doc/html/man/toe.1m.html
index 6eb523cc..bb724137 100644
--- a/doc/html/man/toe.1m.html
+++ b/doc/html/man/toe.1m.html
@@ -119,7 +119,7 @@
        tic(1m),    infocmp(1m),   captoinfo(1m),   infotocap(1m),
        curses(3x), terminfo(5).
 
-       This describes ncurses version 5.9 (patch 20131221).
+       This describes ncurses version 5.9 (patch 20140524).
 
 
 
diff --git a/doc/html/man/tput.1.html b/doc/html/man/tput.1.html
index 0f4bc644..95d873b9 100644
--- a/doc/html/man/tput.1.html
+++ b/doc/html/man/tput.1.html
@@ -338,7 +338,7 @@
 
    SEE ALSO
            clear(1), stty(1), tabs(1), terminfo(5), curs_termcap(3x).
 
-       This describes ncurses version 5.9 (patch 20131221).
+       This describes ncurses version 5.9 (patch 20140524).
 
 
 
diff --git a/doc/html/man/tset.1.html b/doc/html/man/tset.1.html
index 81aabd66..f12cf7e3 100644
--- a/doc/html/man/tset.1.html
+++ b/doc/html/man/tset.1.html
@@ -27,7 +27,7 @@
   * sale, use or other dealings in this Software without prior written       *
   * authorization.                                                           *
   ****************************************************************************
-  * @Id: tset.1,v 1.28 2013/07/20 19:40:55 tom Exp @
+  * @Id: tset.1,v 1.29 2013/12/21 22:15:53 tom Exp @
 -->
 
 
@@ -319,7 +319,7 @@
        csh(1),   sh(1),   stty(1),   curs_terminfo(3x),   tty(4),
        terminfo(5), ttys(5), environ(7)
 
-       This describes ncurses version 5.9 (patch 20131221).
+       This describes ncurses version 5.9 (patch 20140524).
 
 
 
diff --git a/include/MKparametrized.sh b/include/MKparametrized.sh
index 2825c822..3ce5d9c9 100755
--- a/include/MKparametrized.sh
+++ b/include/MKparametrized.sh
@@ -1,6 +1,6 @@
 #!/bin/sh
 ##############################################################################
-# Copyright (c) 1998-2000,2006 Free Software Foundation, Inc.                #
+# Copyright (c) 1998-2006,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"), #
@@ -26,7 +26,7 @@
 # use or other dealings in this Software without prior written               #
 # authorization.                                                             #
 ##############################################################################
-# $Id: MKparametrized.sh,v 1.6 2006/04/22 21:36:16 tom Exp $
+# $Id: MKparametrized.sh,v 1.7 2014/05/24 15:07:19 tom Exp $
 #
 # MKparametrized.sh -- generate indirection vectors for various sort methods
 #
@@ -53,10 +53,11 @@ EOF
 # this, that would be cleaner....
 
 ${AWK-awk} <$CAPS '
-$3 != "str"	{next;}
-$1 ~ /^acs_/	{print "-1,\t/* ", $2, " */"; count++; next;}
-$0 ~ /#[0-9]/	{print "1,\t/* ", $2, " */"; count++; next;}
-		{print "0,\t/* ", $2, " */"; count++;}
-END		{printf("} /* %d entries */;\n\n", count);}
+$3 != "str"		{next;}
+$1 ~ /^acs_/		{print "-1,\t/* ", $2, " */"; count++; next;}
+$1 ~ /^label_format/	{print "-1,\t/* ", $2, " */"; count++; next;}
+$0 ~ /#[0-9]/		{print "1,\t/* ", $2, " */"; count++; next;}
+			{print "0,\t/* ", $2, " */"; count++;}
+END			{printf("} /* %d entries */;\n\n", count);}
 '
 
diff --git a/man/curs_addch.3x b/man/curs_addch.3x
index 1ad071a8..e4504879 100644
--- a/man/curs_addch.3x
+++ b/man/curs_addch.3x
@@ -1,6 +1,6 @@
 '\" t
 .\"***************************************************************************
-.\" Copyright (c) 1998-2010,2011 Free Software Foundation, Inc.              *
+.\" Copyright (c) 1998-2011,2014 Free Software Foundation, Inc.              *
 .\"                                                                          *
 .\" Permission is hereby granted, free of charge, to any person obtaining a  *
 .\" copy of this software and associated documentation files (the            *
@@ -27,8 +27,11 @@
 .\" authorization.                                                           *
 .\"***************************************************************************
 .\"
-.\" $Id: curs_addch.3x,v 1.32 2011/01/15 14:15:10 tom Exp $
+.\" $Id: curs_addch.3x,v 1.33 2014/05/24 19:47:41 tom Exp $
 .TH curs_addch 3X ""
+.de bP
+.IP \(bu 4
+..
 .SH NAME
 \fBaddch\fR,
 \fBwaddch\fR,
@@ -55,17 +58,29 @@
 The \fBaddch\fR, \fBwaddch\fR, \fBmvaddch\fR and \fBmvwaddch\fR routines put
 the character \fIch\fR into the given window at its current window position,
 which is then advanced.  They are analogous to \fBputchar\fR in \fBstdio\fR(3).
-If the advance is at the right margin, the cursor automatically wraps to the
-beginning of the next line.  At the bottom of the current scrolling region, if
-\fBscrollok\fR is enabled, the scrolling region is scrolled up one line.
+If the advance is at the right margin:
+.bP
+The cursor automatically wraps to the beginning of the next line.
+.bP
+At the bottom of the current scrolling region,
+and if \fBscrollok\fR is enabled,
+the scrolling region is scrolled up one line.
+.bP
+If \fBscrollok\fR is not enabled,
+writing a character at the lower right margin succeeds.
+However, an error is returned because
+it is not possible to wrap to a new line
 .PP
 If \fIch\fR is a tab, newline, or backspace,
-the cursor is moved appropriately within the window.
+the cursor is moved appropriately within the window:
+.bP
 Backspace moves the cursor one character left; at the left
 edge of a window it does nothing.
+.bP
 Newline does a \fBclrtoeol\fR,
 then moves the cursor to the window left margin on the next line,
 scrolling the window if on the last line.
+.bP
 Tabs are considered to be at every eighth column.
 The tab interval may be altered by setting the \fBTABSIZE\fR variable.
 .PP
diff --git a/man/curs_getch.3x b/man/curs_getch.3x
index a8b2ffea..74f6ba8d 100644
--- a/man/curs_getch.3x
+++ b/man/curs_getch.3x
@@ -1,6 +1,6 @@
 '\" t
 .\"***************************************************************************
-.\" Copyright (c) 1998-2011,2012 Free Software Foundation, Inc.              *
+.\" Copyright (c) 1998-2012,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            *
@@ -27,7 +27,7 @@
 .\" authorization.                                                           *
 .\"***************************************************************************
 .\"
-.\" $Id: curs_getch.3x,v 1.37 2012/07/07 20:04:56 tom Exp $
+.\" $Id: curs_getch.3x,v 1.39 2014/05/24 20:16:31 tom Exp $
 .TH curs_getch 3X ""
 .na
 .hy 0
@@ -71,14 +71,21 @@ In half-delay mode,
 the program waits until a character is typed or the
 specified timeout has been reached.
 .PP
-Unless \fBnoecho\fR has been set,
+If \fBecho\fR is enabled, and the window is not a pad,
 then the character will also be echoed into the
 designated window according to the following rules:
-if the character is the current erase character, left arrow, or backspace,
+.bP
+If the character is the current erase character, left arrow, or backspace,
 the cursor is moved one space to the left and that screen position is erased
 as if \fBdelch\fR had been called.
+.bP
 If the character value is any other \fBKEY_\fR define, the user is alerted
 with a \fBbeep\fR call.
+.bP
+If the character is a carriage-return,
+and if \fBnl\fP is enabled,
+it is translated to a line-feed after echoing.
+.bP
 Otherwise the character is simply output to the screen.
 .PP
 If the window is not a pad, and it has been moved or modified since the last
@@ -89,7 +96,8 @@ If \fBkeypad\fR is \fBTRUE\fR, and a function key is pressed, the token for
 that function key is returned instead of the raw characters.
 Possible function
 keys are defined in \fB\fR as macros with values outside the range
-of 8-bit characters whose names begin with \fBKEY_\fR. Thus, a variable
+of 8-bit characters whose names begin with \fBKEY_\fR.
+Thus, a variable
 intended to hold the return value of a function key must be of short size or
 larger.
 .PP
@@ -111,12 +119,12 @@ The following function keys, defined in \fB\fR, might be returned by
 \fBgetch\fR if \fBkeypad\fR has been enabled.
 Note that not all of these are
 necessarily supported on any particular terminal.
-.sp
+.PP
 .TS
 center tab(/) ;
-l l
 l l .
 \fIName\fR/\fIKey\fR \fIname\fR
+_
 KEY_BREAK/Break key
 KEY_DOWN/The four arrow keys ...
 KEY_UP
diff --git a/man/ncurses.3x b/man/ncurses.3x
index 9a7ec6bd..73154b03 100644
--- a/man/ncurses.3x
+++ b/man/ncurses.3x
@@ -27,7 +27,7 @@
 .\" authorization.                                                           *
 .\"***************************************************************************
 .\"
-.\" $Id: ncurses.3x,v 1.116 2014/03/15 19:26:00 tom Exp $
+.\" $Id: ncurses.3x,v 1.117 2014/05/24 20:29:27 tom Exp $
 .hy 0
 .TH ncurses 3X ""
 .ie \n(.g .ds `` \(lq
@@ -898,7 +898,7 @@ your terminal driver may not handle these properly.
 Set this environment variable to disable the feature.
 You can also adjust your \fBstty\fP settings to avoid the problem.
 .TP 5
-NCURSES_NO_MAGIC_COOKIES
+NCURSES_NO_MAGIC_COOKIE
 Some terminals use a magic-cookie feature which requires special handling
 to make highlighting and other video attributes display properly.
 You can suppress the highlighting entirely for these terminals by
diff --git a/man/tic.1m b/man/tic.1m
index 5c3a63fa..878e213b 100644
--- a/man/tic.1m
+++ b/man/tic.1m
@@ -1,5 +1,5 @@
 .\"***************************************************************************
-.\" Copyright (c) 1998-2012,2013 Free Software Foundation, Inc.              *
+.\" Copyright (c) 1998-2013,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            *
@@ -26,7 +26,7 @@
 .\" authorization.                                                           *
 .\"***************************************************************************
 .\"
-.\" $Id: tic.1m,v 1.58 2013/07/20 19:31:25 tom Exp $
+.\" $Id: tic.1m,v 1.60 2014/05/24 22:00:11 tom Exp $
 .TH @TIC@ 1M ""
 .ie \n(.g .ds `` \(lq
 .el       .ds `` ``
@@ -152,6 +152,20 @@ but commented out with two preceding dots.
 The actual format used incorporates some improvements for escaped characters
 from terminfo format.
 For a stricter BSD-compatible translation, add the \fB\-K\fR option.
+.IP
+If this is combined with \fB\-c\fR, \fB@TIC@\fR makes additional checks
+to report cases where the terminfo values do not have an exact equivalent
+in termcap form.
+For example:
+.RS
+.bP
+\fBsgr\fP usually will not convert, because termcap lacks the ability to
+work with more than two parameters, and because termcap lacks many of
+the arithmetic/logical operators used in terminfo.
+.bP
+capabilities with more than one delay or with delays before the end of
+the string will not convert completely.
+.RE
 .TP
 \fB\-c\fR
 tells \fB@TIC@\fP to only check \fIfile\fR for errors, including syntax problems and
@@ -164,6 +178,11 @@ as well as buggy checking for the buffer length
 (and a documented limit in terminfo),
 these entries may cause core
 dumps with other implementations.
+.IP
+\fB@TIC@\fP checks string capabilities to ensure that those with parameters
+will be valid expressions.
+It does this check only for the predefined string capabilities;
+those which are defined with the \fB\-x\fP option are ignored.
 .TP
 \fB\-D\fR
 tells \fB@TIC@\fP to print the database locations that it knows about, and exit.
diff --git a/misc/terminfo.src b/misc/terminfo.src
index d215aeee..dccf9b92 100644
--- a/misc/terminfo.src
+++ b/misc/terminfo.src
@@ -6,8 +6,8 @@
 # Report bugs and new terminal descriptions to
 #	bug-ncurses@gnu.org
 #
-#	$Revision: 1.492 $
-#	$Date: 2014/05/03 23:19:22 $
+#	$Revision: 1.494 $
+#	$Date: 2014/05/24 16:04:53 $
 #
 # The original header is preserved below for reference.  It is noted that there
 # is a "newer" version which differs in some cosmetic details (but actually
@@ -7814,10 +7814,10 @@ adm20|lear siegler adm20,
 	sgr0=\E(, smso=\E),
 adm21|lear siegler adm21,
 	xmc#1,
-	bel=^G, cr=^M, cud1=^J, dch1=\EW, dl1=30*\ER, ed=\EY, el=\ET,
-	ich1=\EQ, il1=30*\EE, ind=^J, invis@, kbs=^H, kcub1=^H,
-	kcud1=^J, kcuf1=^L, kcuu1=^K, khome=^^, use=adm+sgr,
-	use=adm3a,
+	bel=^G, cr=^M, cud1=^J, dch1=\EW, dl1=\ER$<30*>, ed=\EY,
+	el=\ET, ich1=\EQ, il1=\EE$<30*>, ind=^J, invis@, kbs=^H,
+	kcub1=^H, kcud1=^J, kcuf1=^L, kcuu1=^K, khome=^^,
+	use=adm+sgr, use=adm3a,
 # (adm22: ":em=:" was an obvious typo for ":ei=:"; also,
 # removed obsolete ":kn#7:ma=j^Jk^P^K^Pl ^R^L^L :";
 # removed bogus-looking \200 from before . -- esr)
@@ -11584,8 +11584,8 @@ att605-pc|ATT 605 in pc term mode,
 	kdl1=\E[M, kend=\E[F, kf1=\E[M, kf10=\E[V, kf2=\E[N,
 	kf3=\E[O, kf4=\E[P, kf5=\E[Q, kf6=\E[R, kf7=\E[S, kf8=\E[T,
 	kf9=\E[U, khome=\E[H, kich1=\E[@, knp=\E[G, kpp=\E[I,
-	rmsc=400\E[50;0|, smsc=250\E[?11l\E[50;1|, xoffc=g,
-	xonc=e, use=att605,
+	rmsc=\E[50;0|$<400>, smsc=\E[?11l\E[50;1|$<250>,
+	xoffc=g, xonc=e, use=att605,
 att605-w|AT&T 605-w 132 column 102 key keyboard,
 	cols#132, wsl#132,
 	is1=\E[8;0|\E[?4;5;13;15l\E[13;20l\E[?3;7h\E[12h\E(B\E)0,
@@ -13768,7 +13768,7 @@ dg210|dg-ansi|Data General 210/211,
 dg211|Data General d211,
 	cnorm=^L, cvvis=^L^R, ht=^I, ind@, kbs=^Y, kf0@, kf1@, kf2@, kf3@,
 	kf4@, kf5@, kf6@, kf7@, kf8@, kf9@, lf0@, nel=^M^Z, rmcup=^L,
-	rmso=\036E$<\0/>, smcup=^L^R, smso=\036D$<5/>, use=dg200,
+	rmso=\036E$<0/>, smcup=^L^R, smso=\036D$<5/>, use=dg200,
 
 # dg450 from Cornell (not official)
 dg450|dg6134|data general 6134,
@@ -14749,7 +14749,7 @@ sb1|beehive superbee,
 	smso=\E_1, smul=\E_0, tbc=\E3,
 sbi|superbee|beehive superbee at Indiana U.,
 	xsb,
-	cr=\r$<1>, il1=1\EN\EL$<9>\EQ \EP$<9> \EO\ER\EA,
+	cr=\r$<1>, il1=\EN$<1>\EL$<9>\EQ \EP$<9> \EO\ER\EA,
 	use=sb1,
 # Alternate (older) description of Superbee - f1=escape, f2=^C.
 # Note: there are at least 3 kinds of superbees in the world.  The sb1
@@ -18287,7 +18287,7 @@ megatek|pegasus workstation terminal emulator,
 xerox820|x820|Xerox 820,
 	am,
 	cols#80, lines#24,
-	bel=^G, clear=1^Z, cr=^M, cub1=^H, cud1=^J, cuf1=^L,
+	bel=^G, clear=\032$<1>, cr=^M, cub1=^H, cud1=^J, cuf1=^L,
 	cup=\E=%p1%{32}%+%c%p2%{32}%+%c, cuu1=^K, ed=^Q, el=^X,
 	home=^^, ind=^J,
 
@@ -19338,7 +19338,7 @@ h19|heath|h19-b|heathkit|heath-19|z19|zenith|heathkit h19,
 	clear=\EE, cnorm=\Ey4, cr=^M, cub1=^H, cud1=\EB, cuf1=\EC,
 	cup=\EY%p1%{32}%+%c%p2%{32}%+%c, cuu1=\EA, cvvis=\Ex4,
 	dch1=\EN, ed=\EJ, el=\EK, fsl=\Ek\Ey5, home=\EH, ht=^I, ind=^J,
-	ip=<1.5/>, kbs=^H, kcub1=\ED, kcud1=\EB, kcuf1=\EC,
+	ip=$<1.5/>, kbs=^H, kcub1=\ED, kcud1=\EB, kcuf1=\EC,
 	kcuu1=\EA, kf1=\ES, kf2=\ET, kf3=\EU, kf4=\EV, kf5=\EW,
 	kf6=\EP, kf7=\EQ, kf8=\ER, khome=\EH, lf6=blue, lf7=red,
 	lf8=white, ri=\EI, rmacs=\EG, rmir=\EO, rmso=\Eq, smacs=\EF,
@@ -20098,12 +20098,11 @@ ti924-8|Texas Instruments 924 VDT 8859/1 8 bit CTRL,
 	cup=%i\E[%p1%d;%p2%dH, cuu1=\E[A, cvvis=\E[?31h,
 	dl1=\E[M, ed=\E[J, el=\E[K, home=\E[H, ht=^I, hts=\EH,
 	il1=\E[L, ind=\ED, kbs=^H, kcub1=\E[D, kcud1=\E[B,
-	kcuf1=\E[C, kcuu1=\E[A, kdch1=P$<\233>, kf1=P$<\217>,
-	kf2=Q$<\217>, kf3=R$<\217>, kf4=S$<\217>, kf5=~$<\23316>,
-	kf6=~$<\23317>, kf7=~$<\23318>, kf8=~$<\23319>,
-	kf9=~$<\23320>, kich1=@$<\233>, rc=\E8, rev=\E[7m, ri=\EM,
-	rmso=\E[m, rmul=\E[m, sc=\E7, sgr0=\E[m, smso=\E[7m,
-	smul=\E[4m, tbc=\E[3g,
+	kcuf1=\E[C, kcuu1=\E[A, kdch1=\233P, kf1=\217P, kf2=\217Q,
+	kf3=\217R, kf4=\217S, kf5=\23316~, kf6=\23317~,
+	kf7=\23318~, kf8=\23319~, kf9=\23320~, kich1=\233@, rc=\E8,
+	rev=\E[7m, ri=\EM, rmso=\E[m, rmul=\E[m, sc=\E7, sgr0=\E[m,
+	smso=\E[7m, smul=\E[4m, tbc=\E[3g,
 ti924w|Texas Instruments 924 VDT 7 bit - 132 column mode,
 	cols#132, use=ti924,
 ti924-8w|Texas Instruments 924 VDT 8 bit - 132 column mode,
@@ -20772,7 +20771,7 @@ aj510|Anderson-Jacobson model 510,
 	cols#80, lines#24,
 	clear=^L, cub1=^H, cuf1=\EX,
 	cup=\E#%p1%{32}%+%c%p2%{32}%+%c, cuu1=\EY,
-	dch1=.1*\E'D, dl1=\E&D$<2*/>, ed=\E'P, el=\E'L, ich1=,
+	dch1=\E'D$<.1*>, dl1=\E&D$<2*/>, ed=\E'P, el=\E'L, ich1=,
 	il1=\E&I$<2*/>, ip=$<.1*/>, kcub1=\EW, kcud1=\EZ,
 	kcuf1=\EX, kcuu1=\EY, pad=\177, rmcup=\E"N, rmir=\E'J,
 	rmso=\E"I, rmul=\E"U, smcup=\E"N, smir=\E'I, smso=\E"I,
@@ -23303,4 +23302,11 @@ v3220|LANPAR Vision II model 3220/3221/3222,
 # 2014-05-03
 #	* add vt520ansi (Mike Gran)
 #
+# 2014-05-24
+#	* correct several entries which had termcap-style padding used in
+#	  terminfo: adm21, aj510, alto-h19, att605-pc, x820 -TD
+#	* correct syntax for padding in some entries: dg211, h19 -TD
+#	* correct ti924-8 which had confused padding versus octal escapes -TD
+#	* correct padding in sbi entry -TD
+#
 ######## SHANTIH!  SHANTIH!  SHANTIH!
diff --git a/ncurses/tinfo/lib_tparm.c b/ncurses/tinfo/lib_tparm.c
index 439115b0..bca90c8c 100644
--- a/ncurses/tinfo/lib_tparm.c
+++ b/ncurses/tinfo/lib_tparm.c
@@ -1,5 +1,5 @@
 /****************************************************************************
- * Copyright (c) 1998-2012,2013 Free Software Foundation, Inc.              *
+ * Copyright (c) 1998-2013,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            *
@@ -42,7 +42,7 @@
 #include 
 #include 
 
-MODULE_ID("$Id: lib_tparm.c,v 1.90 2013/11/09 14:53:05 tom Exp $")
+MODULE_ID("$Id: lib_tparm.c,v 1.92 2014/05/23 00:33:45 tom Exp $")
 
 /*
  *	char *
@@ -466,6 +466,8 @@ tparam_internal(int use_TPARM_ARG, const char *string, va_list ap)
     int i;
     const char *cp = string;
     size_t len2;
+    bool termcap_hack;
+    bool incremented_two;
 
     if (cp == NULL)
 	return NULL;
@@ -482,6 +484,8 @@ tparam_internal(int use_TPARM_ARG, const char *string, va_list ap)
     if (TPS(fmt_buff) == 0)
 	return NULL;
 
+    incremented_two = FALSE;
+
     if (number > NUM_PARM)
 	number = NUM_PARM;
     if (popcount > NUM_PARM)
@@ -514,7 +518,9 @@ tparam_internal(int use_TPARM_ARG, const char *string, va_list ap)
      * style, which means tparam() will expand termcap strings OK.
      */
     TPS(stack_ptr) = 0;
+    termcap_hack = FALSE;
     if (popcount == 0) {
+	termcap_hack = TRUE;
 	popcount = number;
 	for (i = number - 1; i >= 0; i--) {
 	    if (p_is_s[i])
@@ -573,10 +579,11 @@ tparam_internal(int use_TPARM_ARG, const char *string, va_list ap)
 		cp++;
 		i = (UChar(*cp) - '1');
 		if (i >= 0 && i < NUM_PARM) {
-		    if (p_is_s[i])
+		    if (p_is_s[i]) {
 			spush(p_is_s[i]);
-		    else
+		    } else {
 			npush((int) param[i]);
+		    }
 		}
 		break;
 
@@ -691,10 +698,26 @@ tparam_internal(int use_TPARM_ARG, const char *string, va_list ap)
 		break;
 
 	    case 'i':
-		if (p_is_s[0] == 0)
-		    param[0]++;
-		if (p_is_s[1] == 0)
-		    param[1]++;
+		/*
+		 * Increment the first two parameters -- if they are numbers
+		 * rather than strings.  As a side effect, assign into the
+		 * stack; if this is termcap, then the stack was populated
+		 * using the termcap hack above rather than via the terminfo
+		 * 'p' case.
+		 */
+		if (!incremented_two) {
+		    incremented_two = TRUE;
+		    if (p_is_s[0] == 0) {
+			param[0]++;
+			if (termcap_hack)
+			    TPS(stack)[0].data.num = (int) param[0];
+		    }
+		    if (p_is_s[1] == 0) {
+			param[1]++;
+			if (termcap_hack)
+			    TPS(stack)[1].data.num = (int) param[1];
+		    }
+		}
 		break;
 
 	    case '?':
diff --git a/package/debian-mingw/changelog b/package/debian-mingw/changelog
index 9ff697a4..9901849c 100644
--- a/package/debian-mingw/changelog
+++ b/package/debian-mingw/changelog
@@ -1,8 +1,8 @@
-ncurses6 (5.9-20140510) unstable; urgency=low
+ncurses6 (5.9-20140524) unstable; urgency=low
 
   * latest weekly patch
 
- -- Thomas E. Dickey   Sat, 10 May 2014 10:37:35 -0400
+ -- Thomas E. Dickey   Wed, 21 May 2014 06:14:18 -0400
 
 ncurses6 (5.9-20131005) unstable; urgency=low
 
diff --git a/package/debian-mingw64/changelog b/package/debian-mingw64/changelog
index 9ff697a4..9901849c 100644
--- a/package/debian-mingw64/changelog
+++ b/package/debian-mingw64/changelog
@@ -1,8 +1,8 @@
-ncurses6 (5.9-20140510) unstable; urgency=low
+ncurses6 (5.9-20140524) unstable; urgency=low
 
   * latest weekly patch
 
- -- Thomas E. Dickey   Sat, 10 May 2014 10:37:35 -0400
+ -- Thomas E. Dickey   Wed, 21 May 2014 06:14:18 -0400
 
 ncurses6 (5.9-20131005) unstable; urgency=low
 
diff --git a/package/debian/changelog b/package/debian/changelog
index adca77dc..2ec799c7 100644
--- a/package/debian/changelog
+++ b/package/debian/changelog
@@ -1,8 +1,8 @@
-ncurses6 (5.9-20140510) unstable; urgency=low
+ncurses6 (5.9-20140524) unstable; urgency=low
 
   * latest weekly patch
 
- -- Thomas E. Dickey   Sat, 10 May 2014 10:37:35 -0400
+ -- Thomas E. Dickey   Wed, 21 May 2014 06:14:18 -0400
 
 ncurses6 (5.9-20120608) unstable; urgency=low
 
diff --git a/package/mingw-ncurses.nsi b/package/mingw-ncurses.nsi
index 8a4ae5fb..29e9d7d6 100644
--- a/package/mingw-ncurses.nsi
+++ b/package/mingw-ncurses.nsi
@@ -1,4 +1,4 @@
-; $Id: mingw-ncurses.nsi,v 1.40 2014/05/10 14:37:35 tom Exp $
+; $Id: mingw-ncurses.nsi,v 1.41 2014/05/21 10:14:18 tom Exp $
 
 ; TODO add examples
 ; TODO bump ABI to 6
@@ -10,7 +10,7 @@
 !define VERSION_MAJOR "5"
 !define VERSION_MINOR "9"
 !define VERSION_YYYY  "2014"
-!define VERSION_MMDD  "0510"
+!define VERSION_MMDD  "0524"
 !define VERSION_PATCH ${VERSION_YYYY}${VERSION_MMDD}
 
 !define MY_ABI   "5"
diff --git a/package/mingw-ncurses.spec b/package/mingw-ncurses.spec
index 5bbf4021..3bd812ec 100644
--- a/package/mingw-ncurses.spec
+++ b/package/mingw-ncurses.spec
@@ -3,7 +3,7 @@
 Summary: shared libraries for terminal handling
 Name: mingw32-ncurses6
 Version: 5.9
-Release: 20140510
+Release: 20140524
 License: X11
 Group: Development/Libraries
 Source: ncurses-%{version}-%{release}.tgz
diff --git a/package/ncurses.spec b/package/ncurses.spec
index 3e11caaa..3ad478b4 100644
--- a/package/ncurses.spec
+++ b/package/ncurses.spec
@@ -1,7 +1,7 @@
 Summary: shared libraries for terminal handling
 Name: ncurses6
 Version: 5.9
-Release: 20140510
+Release: 20140524
 License: X11
 Group: Development/Libraries
 Source: ncurses-%{version}-%{release}.tgz
diff --git a/progs/Makefile.in b/progs/Makefile.in
index a9161b16..21723637 100644
--- a/progs/Makefile.in
+++ b/progs/Makefile.in
@@ -1,6 +1,6 @@
-# $Id: Makefile.in,v 1.90 2013/08/04 20:23:20 tom Exp $
+# $Id: Makefile.in,v 1.91 2014/05/21 17:01:48 tom Exp $
 ##############################################################################
-# Copyright (c) 1998-2012,2013 Free Software Foundation, Inc.                #
+# Copyright (c) 1998-2013,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"), #
@@ -232,6 +232,7 @@ $(DESTDIR)$(bindir) :
 DEPS_TIC = \
 	$(MODEL)/tic$o \
 	$(MODEL)/dump_entry$o \
+	$(MODEL)/tparm_type$o \
 	$(MODEL)/transform$o
 
 tic$x: $(DEPS_TIC) $(DEPS_CURSES) transform.h
@@ -257,6 +258,7 @@ tabs$x: $(DEPS_TABS) $(DEPS_TABS)
 
 DEPS_TPUT = \
 	$(MODEL)/tput$o \
+	$(MODEL)/tparm_type$o \
 	$(MODEL)/transform$o
 
 tput$x: $(DEPS_TPUT) $(DEPS_CURSES) transform.h
diff --git a/progs/modules b/progs/modules
index 55d7a9fb..c09d2a62 100644
--- a/progs/modules
+++ b/progs/modules
@@ -1,7 +1,7 @@
-# $Id: modules,v 1.17 2010/01/23 17:47:23 tom Exp $
+# $Id: modules,v 1.18 2014/05/21 17:01:28 tom Exp $
 # Program modules (some are in ncurses lib!)
 ##############################################################################
-# Copyright (c) 1998-2009,2010 Free Software Foundation, Inc.                #
+# Copyright (c) 1998-2010,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"), #
@@ -33,12 +33,13 @@
 
 @ base
 clear		progs		$(srcdir)	$(HEADER_DEPS)
-tic		progs		$(srcdir)	$(HEADER_DEPS) transform.h $(srcdir)/dump_entry.h
+tic		progs		$(srcdir)	$(HEADER_DEPS) transform.h $(srcdir)/dump_entry.h $(srcdir)/tparm_type.h
 toe		progs		$(srcdir)	$(HEADER_DEPS)             $(INCDIR)/hashed_db.h
 dump_entry	progs		$(srcdir)	$(HEADER_DEPS)             $(srcdir)/dump_entry.h ../include/parametrized.h $(INCDIR)/capdefaults.c termsort.c
 infocmp		progs		$(srcdir)	$(HEADER_DEPS)             $(srcdir)/dump_entry.h
 tabs		progs		$(srcdir)	$(HEADER_DEPS)
-tput		progs		$(srcdir)	$(HEADER_DEPS) transform.h $(srcdir)/dump_entry.h termsort.c
+tparm_type	progs		$(srcdir)	$(HEADER_DEPS)             $(srcdir)/tparm_type.h
+tput		progs		$(srcdir)	$(HEADER_DEPS) transform.h $(srcdir)/dump_entry.h $(srcdir)/tparm_type.h termsort.c
 tset		progs		$(srcdir)	$(HEADER_DEPS) transform.h $(srcdir)/dump_entry.h ../include/termcap.h
 transform	progs		$(srcdir)	$(HEADER_DEPS) transform.h
 
diff --git a/progs/progs.priv.h b/progs/progs.priv.h
index 3ead89f8..c1cc1e6e 100644
--- a/progs/progs.priv.h
+++ b/progs/progs.priv.h
@@ -1,5 +1,5 @@
 /****************************************************************************
- * Copyright (c) 1998-2011,2012 Free Software Foundation, Inc.              *
+ * Copyright (c) 1998-2012,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            *
@@ -30,13 +30,16 @@
  *  Author: Thomas E. Dickey                    1997-on                     *
  ****************************************************************************/
 /*
- * $Id: progs.priv.h,v 1.39 2012/02/22 22:11:27 tom Exp $
+ * $Id: progs.priv.h,v 1.40 2014/05/21 17:00:19 tom Exp $
  *
  *	progs.priv.h
  *
  *	Header file for curses utility programs
  */
 
+#ifndef PROGS_PRIV_H
+#define PROGS_PRIV_H 1
+
 #include 
 
 #if USE_RCS_IDS
@@ -200,3 +203,5 @@ extern int optind;
 #define UChar(c)    ((unsigned char)(c))
 
 #define SIZEOF(v) (sizeof(v)/sizeof(v[0]))
+
+#endif /* PROGS_PRIV_H */
diff --git a/progs/tic.c b/progs/tic.c
index eeb209a7..2781bae7 100644
--- a/progs/tic.c
+++ b/progs/tic.c
@@ -1,5 +1,5 @@
 /****************************************************************************
- * Copyright (c) 1998-2012,2013 Free Software Foundation, Inc.              *
+ * Copyright (c) 1998-2013,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            *
@@ -43,10 +43,12 @@
 #include 
 
 #include 
+#include 
 #include 
+#include 
 #include 
 
-MODULE_ID("$Id: tic.c,v 1.190 2014/03/29 19:45:18 tom Exp $")
+MODULE_ID("$Id: tic.c,v 1.204 2014/05/24 15:47:40 tom Exp $")
 
 #define STDIN_NAME ""
 
@@ -143,7 +145,6 @@ usage(void)
 #if NCURSES_XNAMES
 	"  -a         retain commented-out capabilities (sets -x also)",
 #endif
-	"  -K         translate entries to termcap source form with BSD syntax",
 	"  -C         translate entries to termcap source form",
 	"  -D         print list of tic's database locations (first must be writable)",
 	"  -c         check only, validate input without compiling or translating",
@@ -152,6 +153,7 @@ usage(void)
 	"  -G         format %{number} to %'char'",
 	"  -g         format %'char' to %{number}",
 	"  -I         translate entries to terminfo source form",
+	"  -K         translate entries to termcap source form with BSD syntax",
 	"  -L         translate entries to full terminfo source form",
 	"  -N         disable smart defaults for source translation",
 	"  -o    set output directory for compiled entry writes",
@@ -450,7 +452,7 @@ open_input(const char *filename, char *alt_file)
 	fprintf(stderr, "%s: %s %s\n", _nc_progname, filename, strerror(errno));
 	ExitProgram(EXIT_FAILURE);
     } else if ((mode = (sb.st_mode & S_IFMT)) == S_IFDIR
-	       || (mode != S_IFREG && mode != S_IFCHR)) {
+	       || (mode != S_IFREG && mode != S_IFCHR && mode != S_IFIFO)) {
 	fprintf(stderr, "%s: %s is not a file\n", _nc_progname, filename);
 	ExitProgram(EXIT_FAILURE);
     } else {
@@ -939,7 +941,7 @@ main(int argc, char *argv[])
     }
 
     /* length check */
-    if (check_only && (capdump || infodump)) {
+    if (check_only && limited && (capdump || infodump)) {
 	for_entry_list(qp) {
 	    if (matches(namelst, qp->tterm.term_names)) {
 		int len = fmt_entry(&qp->tterm, NULL, FALSE, TRUE, infodump, numbers);
@@ -1674,7 +1676,7 @@ check_params(TERMTYPE *tp, const char *name, char *value)
     int expected = expected_params(name);
     int actual = 0;
     int n;
-    bool params[10];
+    bool params[NUM_PARM];
     char *s = value;
 
 #ifdef set_top_margin_parm
@@ -1683,7 +1685,7 @@ check_params(TERMTYPE *tp, const char *name, char *value)
 	expected = 2;
 #endif
 
-    for (n = 0; n < 10; n++)
+    for (n = 0; n < NUM_PARM; n++)
 	params[n] = FALSE;
 
     while (*s != 0) {
@@ -1721,6 +1723,229 @@ check_params(TERMTYPE *tp, const char *name, char *value)
     }
 }
 
+static char *
+check_1_infotocap(const char *name, NCURSES_CONST char *value, int count)
+{
+    int k;
+    int ignored;
+    long numbers[1 + NUM_PARM];
+    char *strings[1 + NUM_PARM];
+    char *p_is_s[NUM_PARM];
+    char *result;
+    char blob[NUM_PARM * 10];
+    char *next = blob;
+
+    *next++ = '\0';
+    for (k = 1; k <= NUM_PARM; k++) {
+	numbers[k] = count;
+	sprintf(next, "XYZ%d", count);
+	strings[k] = next;
+	next += strlen(next) + 1;
+    }
+
+    switch (tparm_type(name)) {
+    case Num_Str:
+	result = TPARM_2(value, numbers[1], strings[2]);
+	break;
+    case Num_Str_Str:
+	result = TPARM_3(value, numbers[1], strings[2], strings[3]);
+	break;
+    case Numbers:
+    default:
+	(void) _nc_tparm_analyze(value, p_is_s, &ignored);
+#define myParam(n) (p_is_s[n - 1] != 0 ? ((TPARM_ARG) strings[n]) : numbers[n])
+	result = TPARM_9(value,
+			 myParam(1),
+			 myParam(2),
+			 myParam(3),
+			 myParam(4),
+			 myParam(5),
+			 myParam(6),
+			 myParam(7),
+			 myParam(8),
+			 myParam(9));
+	break;
+    }
+    return result;
+}
+
+#define IsDelay(ch) ((ch) == '.' || isdigit(UChar(ch)))
+
+static const char *
+parse_delay_value(const char *src, double *delays, int *always)
+{
+    int star = 0;
+
+    *delays = 0.0;
+    if (always)
+	*always = 0;
+
+    while (isdigit(UChar(*src))) {
+	(*delays) = (*delays) * 10 + (*src++ - '0');
+    }
+    if (*src == '.') {
+	int gotdot = 1;
+
+	++src;
+	while (isdigit(UChar(*src))) {
+	    gotdot *= 10;
+	    (*delays) += (*src++ - '0') / gotdot;
+	}
+    }
+    while (*src == '*' || *src == '/') {
+	if (always == 0 && *src == '/')
+	    break;
+	if (*src++ == '*') {
+	    star = 1;
+	} else {
+	    *always = 1;
+	}
+    }
+    if (star)
+	*delays = -(*delays);
+    return src;
+}
+
+static const char *
+parse_ti_delay(const char *ti, double *delays)
+{
+    int star = 0;
+
+    *delays = 0.0;
+    while (*ti != '\0') {
+	if (*ti == '\\') {
+	    ++ti;
+	}
+	if (ti[0] == '$'
+	    && ti[1] == '<'
+	    && IsDelay(UChar(ti[2]))) {
+	    int ignored;
+	    const char *last = parse_delay_value(ti + 2, delays, &ignored);
+	    if (*last == '>') {
+		ti = last;
+	    }
+	} else {
+	    ++ti;
+	}
+	if (star)
+	    *delays = -(*delays);
+    }
+    return ti;
+}
+
+static const char *
+parse_tc_delay(const char *tc, double *delays)
+{
+    return parse_delay_value(tc, delays, (int *) 0);
+}
+
+/*
+ * Compare terminfo- and termcap-strings, factoring out delays.
+ */
+static bool
+same_ti_tc(const char *ti, const char *tc, bool * embedded)
+{
+    bool same = TRUE;
+    double ti_delay = 0.0;
+    double tc_delay = 0.0;
+    const char *ti_last;
+
+    *embedded = FALSE;
+    ti_last = parse_ti_delay(ti, &ti_delay);
+    tc = parse_tc_delay(tc, &tc_delay);
+
+    while ((ti < ti_last) && *tc) {
+	if (*ti == '\\' && ispunct(UChar(ti[1]))) {
+	    ++ti;
+	    if ((*ti == '^') && !strncmp(tc, "\\136", 4)) {
+		ti += 1;
+		tc += 4;
+		continue;
+	    }
+	} else if (ti[0] == '$' && ti[1] == '<') {
+	    double no_delay;
+	    const char *ss = parse_ti_delay(ti, &no_delay);
+	    if (ss != ti) {
+		*embedded = TRUE;
+		ti = ss;
+		continue;
+	    }
+	}
+	if (*tc == '\\' && ispunct(UChar(tc[1]))) {
+	    ++tc;
+	}
+	if (*ti++ != *tc++) {
+	    same = FALSE;
+	    break;
+	}
+    }
+
+    if (*embedded) {
+	if (same) {
+	    same = FALSE;
+	} else {
+	    *embedded = FALSE;	/* report only one problem */
+	}
+    }
+
+    return same;
+}
+
+/*
+ * Check terminfo to termcap translation.
+ */
+static void
+check_infotocap(TERMTYPE *tp, int i, char *value)
+{
+    const char *name = ExtStrname(tp, i, strnames);
+    int params = ((i < (int) SIZEOF(parametrized))
+		  ? parametrized[i]
+		  : 0);
+    int to_char = 0;
+    char *ti_value = _nc_tic_expand(value, TRUE, to_char);
+    char *tc_value = _nc_infotocap(name, ti_value, params);
+    bool embedded;
+
+    if (ti_value == ABSENT_STRING) {
+	_nc_warning("tic-expansion of %s failed", name);
+    } else if (tc_value == ABSENT_STRING) {
+	_nc_warning("tic-conversion of %s failed", name);
+    } else if (params > 0) {
+	int limit = 5;
+	int count;
+	bool first = TRUE;
+
+	if (!strcmp(name, "setf")
+	    || !strcmp(name, "setb")
+	    || !strcmp(name, "setaf")
+	    || !strcmp(name, "setab")) {
+	    limit = max_colors;
+	}
+	for (count = 0; count < limit; ++count) {
+	    char *ti_check = check_1_infotocap(name, ti_value, count);
+	    char *tc_check = check_1_infotocap(name, tc_value, count);
+
+	    if (strcmp(ti_check, tc_check)) {
+		if (first) {
+		    fprintf(stderr, "check_infotocap(%s)\n", name);
+		    fprintf(stderr, "...ti '%s'\n", ti_value);
+		    fprintf(stderr, "...tc '%s'\n", tc_value);
+		    first = FALSE;
+		}
+		_nc_warning("tparm-conversion of %s(%d) differs between\n\tterminfo %s\n\ttermcap  %s",
+			    name, count, ti_check, tc_check);
+	    }
+	}
+    } else if (params == 0 && !same_ti_tc(ti_value, tc_value, &embedded)) {
+	if (embedded) {
+	    _nc_warning("termcap equivalent of %s cannot use embedded delay", name);
+	} else {
+	    _nc_warning("tic-conversion of %s changed value\n\tfrom %s\n\tto   %s",
+			name, ti_value, tc_value);
+	}
+    }
+}
+
 static char *
 skip_delay(char *s)
 {
@@ -1947,20 +2172,17 @@ show_fkey_name(NAME_VALUE * data)
     }
 }
 
-/* other sanity-checks (things that we don't want in the normal
- * logic that reads a terminfo entry)
+/*
+ * A terminal entry may contain more than one keycode assigned to a given
+ * string (e.g., KEY_END and KEY_LL).  But curses will only return one (the
+ * last one assigned).
  */
 static void
-check_termtype(TERMTYPE *tp, bool literal)
+check_conflict(TERMTYPE *tp)
 {
     bool conflict = FALSE;
     unsigned j, k;
 
-    /*
-     * A terminal entry may contain more than one keycode assigned to
-     * a given string (e.g., KEY_END and KEY_LL).  But curses will only
-     * return one (the last one assigned).
-     */
     if (!(_nc_syntax == SYN_TERMCAP && capdump)) {
 	char *check = calloc((size_t) (NUM_STRINGS(tp) + 1), sizeof(char));
 	NAME_VALUE *given = get_fkey_list(tp);
@@ -2001,11 +2223,26 @@ check_termtype(TERMTYPE *tp, bool literal)
 	free(given);
 	free(check);
     }
+}
+
+/* other sanity-checks (things that we don't want in the normal
+ * logic that reads a terminfo entry)
+ */
+static void
+check_termtype(TERMTYPE *tp, bool literal)
+{
+    unsigned j;
+
+    check_conflict(tp);
 
     for_each_string(j, tp) {
 	char *a = tp->Strings[j];
-	if (VALID_STRING(a))
+	if (VALID_STRING(a)) {
 	    check_params(tp, ExtStrname(tp, (int) j, strnames), a);
+	    if (capdump) {
+		check_infotocap(tp, (int) j, a);
+	    }
+	}
     }
 
     check_acs(tp);
diff --git a/progs/tparm_type.c b/progs/tparm_type.c
new file mode 100644
index 00000000..26eee698
--- /dev/null
+++ b/progs/tparm_type.c
@@ -0,0 +1,68 @@
+/****************************************************************************
+ * Copyright (c) 1998-2012,2013 Free 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                                                *
+ ****************************************************************************/
+
+#include 
+
+MODULE_ID("$Id: tparm_type.c,v 1.1 2014/05/21 16:50:57 tom Exp $")
+
+/*
+ * Lookup the type of call we should make to tparm().  This ignores the actual
+ * terminfo capability (bad, because it is not extensible), but makes this
+ * code portable to platforms where sizeof(int) != sizeof(char *).
+ */
+TParams
+tparm_type(const char *name)
+{
+#define TD(code, longname, ti, tc) {code,longname},{code,ti},{code,tc}
+    TParams result = Numbers;
+    /* *INDENT-OFF* */
+    static const struct {
+	TParams code;
+	const char *name;
+    } table[] = {
+	TD(Num_Str,	"pkey_key",	"pfkey",	"pk"),
+	TD(Num_Str,	"pkey_local",	"pfloc",	"pl"),
+	TD(Num_Str,	"pkey_xmit",	"pfx",		"px"),
+	TD(Num_Str,	"plab_norm",	"pln",		"pn"),
+	TD(Num_Str_Str, "pkey_plab",	"pfxl",		"xl"),
+    };
+    /* *INDENT-ON* */
+
+    unsigned n;
+    for (n = 0; n < SIZEOF(table); n++) {
+	if (!strcmp(name, table[n].name)) {
+	    result = table[n].code;
+	    break;
+	}
+    }
+    return result;
+}
diff --git a/progs/tparm_type.h b/progs/tparm_type.h
new file mode 100644
index 00000000..d1431683
--- /dev/null
+++ b/progs/tparm_type.h
@@ -0,0 +1,52 @@
+/****************************************************************************
+ * Copyright (c) 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: Thomas E. Dickey                                                *
+ ****************************************************************************/
+
+/*
+ * $Id: tparm_type.h,v 1.1 2014/05/21 16:57:56 tom Exp $
+ *
+ * determine expected/actual number of parameters to setup for tparm
+ */
+#ifndef TPARM_TYPE_H
+#define TPARM_TYPE_H 1
+
+#define USE_LIBTINFO
+#include 
+
+typedef enum {
+    Numbers = 0
+    ,Num_Str
+    ,Num_Str_Str
+} TParams;
+
+extern TParams tparm_type(const char *name);
+
+#endif /* TPARM_TYPE_H */
diff --git a/progs/tput.c b/progs/tput.c
index 6652d345..5069a5c3 100644
--- a/progs/tput.c
+++ b/progs/tput.c
@@ -1,5 +1,5 @@
 /****************************************************************************
- * Copyright (c) 1998-2012,2013 Free Software Foundation, Inc.              *
+ * Copyright (c) 1998-2013,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            *
@@ -29,6 +29,7 @@
 /****************************************************************************
  *  Author: Zeyd M. Ben-Halim  1992,1995               *
  *     and: Eric S. Raymond                          *
+ *     and: Thomas E. Dickey                        1996-on                 *
  ****************************************************************************/
 
 /*
@@ -38,8 +39,7 @@
  * Ross Ridge's mytinfo package.
  */
 
-#define USE_LIBTINFO
-#include 
+#include 
 
 #if !PURE_TERMINFO
 #include 
@@ -47,18 +47,12 @@
 #endif
 #include 
 
-MODULE_ID("$Id: tput.c,v 1.49 2013/09/28 20:57:25 tom Exp $")
+MODULE_ID("$Id: tput.c,v 1.50 2014/05/21 16:57:16 tom Exp $")
 
 #define PUTS(s)		fputs(s, stdout)
 #define PUTCHAR(c)	putchar(c)
 #define FLUSH		fflush(stdout)
 
-typedef enum {
-    Numbers = 0
-    ,Num_Str
-    ,Num_Str_Str
-} TParams;
-
 static char *prg_name;
 static bool is_init = FALSE;
 static bool is_reset = FALSE;
@@ -90,39 +84,6 @@ check_aliases(const char *name)
     is_reset = same_program(name, PROG_RESET);
 }
 
-/*
- * Lookup the type of call we should make to tparm().  This ignores the actual
- * terminfo capability (bad, because it is not extensible), but makes this
- * code portable to platforms where sizeof(int) != sizeof(char *).
- */
-static TParams
-tparm_type(const char *name)
-{
-#define TD(code, longname, ti, tc) {code,longname},{code,ti},{code,tc}
-    TParams result = Numbers;
-    /* *INDENT-OFF* */
-    static const struct {
-	TParams code;
-	const char *name;
-    } table[] = {
-	TD(Num_Str,	"pkey_key",	"pfkey",	"pk"),
-	TD(Num_Str,	"pkey_local",	"pfloc",	"pl"),
-	TD(Num_Str,	"pkey_xmit",	"pfx",		"px"),
-	TD(Num_Str,	"plab_norm",	"pln",		"pn"),
-	TD(Num_Str_Str, "pkey_plab",	"pfxl",		"xl"),
-    };
-    /* *INDENT-ON* */
-
-    unsigned n;
-    for (n = 0; n < SIZEOF(table); n++) {
-	if (!strcmp(name, table[n].name)) {
-	    result = table[n].code;
-	    break;
-	}
-    }
-    return result;
-}
-
 static int
 exit_code(int token, int value)
 {
-- 
2.44.0