Ada95/gen/terminal_interface-curses-forms-field_types.ads.m4

   1 --  -*- ada -*-
   2 define(`HTMLNAME',`terminal_interface-curses-forms-field_user_data__ads.htm')dnl
   3 include(M4MACRO)dnl
   4 ------------------------------------------------------------------------------
   5 --                                                                          --
   6 --                           GNAT ncurses Binding                           --
   7 --                                                                          --
   8 --                 Terminal_Interface.Curses.Forms.Field_Types              --
   9 --                                                                          --
  10 --                                 S P E C                                  --
  11 --                                                                          --
  12 ------------------------------------------------------------------------------
  13 -- Copyright (c) 1998-2011,2014 Free Software Foundation, Inc.              --
  14 --                                                                          --
  15 -- Permission is hereby granted, free of charge, to any person obtaining a  --
  16 -- copy of this software and associated documentation files (the            --
  17 -- "Software"), to deal in the Software without restriction, including      --
  18 -- without limitation the rights to use, copy, modify, merge, publish,      --
  19 -- distribute, distribute with modifications, sublicense, and/or sell       --
  20 -- copies of the Software, and to permit persons to whom the Software is    --
  21 -- furnished to do so, subject to the following conditions:                 --
  22 --                                                                          --
  23 -- The above copyright notice and this permission notice shall be included  --
  24 -- in all copies or substantial portions of the Software.                   --
  25 --                                                                          --
  26 -- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS  --
  27 -- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF               --
  28 -- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.   --
  29 -- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM,   --
  30 -- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR    --
  31 -- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR    --
  32 -- THE USE OR OTHER DEALINGS IN THE SOFTWARE.                               --
  33 --                                                                          --
  34 -- Except as contained in this notice, the name(s) of the above copyright   --
  35 -- holders shall not be used in advertising or otherwise to promote the     --
  36 -- sale, use or other dealings in this Software without prior written       --
  37 -- authorization.                                                           --
  38 ------------------------------------------------------------------------------
  39 --  Author:  Juergen Pfeifer, 1996
  40 --  Version Control:
  41 --  $Revision: 1.19 $
  42 --  Binding Version 01.00
  43 ------------------------------------------------------------------------------
  44 with Interfaces.C;
  45 with Terminal_Interface.Curses.Aux;
  46
  47 package Terminal_Interface.Curses.Forms.Field_Types is
  48    pragma Preelaborate (Terminal_Interface.Curses.Forms.Field_Types);
  49    use type Interfaces.C.int;
  50    subtype C_Int is Interfaces.C.int;
  51
  52    --  MANPAGE(`form_fieldtype.3x')
  53
  54    type Field_Type is abstract tagged null record;
  55    --  Abstract base type for all field types. A concrete field type
  56    --  is an extension that adds some data elements describing formats or
  57    --  boundary values for the type and validation routines.
  58    --  For the builtin low-level fieldtypes, the validation routines are
  59    --  already defined by the low-level C library.
  60    --  The builtin types like Alpha or AlphaNumeric etc. are defined in
  61    --  child packages of this package. You may use one of them as example
  62    --  how to create you own child packages for low-level field types that
  63    --  you may have already written in C.
  64
  65    type Field_Type_Access is access all Field_Type'Class;
  66
  67    --  ANCHOR(`set_field_type()',`Set_Type')
  68    procedure Set_Field_Type (Fld      : Field;
  69                              Fld_Type : Field_Type) is abstract;
  70    --  AKA
  71    --  But: we hide the vararg mechanism of the C interface. You always
  72    --       have to pass a single Field_Type parameter.
  73
  74    --  ---------------------------------------------------------------------
  75
  76    --  MANPAGE(`form_field_validation.3x')
  77
  78    --  ANCHOR(`field_type()',`Get_Type')
  79    function Get_Type (Fld : Field) return Field_Type_Access;
  80    --  AKA
  81    --  ALIAS(`field_arg()')
  82    --  In Ada95 we can combine these. If you try to retrieve the field type
  83    --  that is not defined as extension of the abstract tagged type above,
  84    --  you will raise a Form_Exception.
  85    --  This is not inlined
  86
  87    --  +----------------------------------------------------------------------
  88    --  | Private Part.
  89    --  | Most of this is used by the implementations of the child packages.
  90    --  |
  91 private
  92    type Makearg_Function is access
  93      function (Args : System.Address) return System.Address;
  94    pragma Convention (C, Makearg_Function);
  95
  96    type Copyarg_Function is access
  97      function (Usr : System.Address) return System.Address;
  98    pragma Convention (C, Copyarg_Function);
  99
 100    type Freearg_Function is access
 101      procedure (Usr : System.Address);
 102    pragma Convention (C, Freearg_Function);
 103
 104    type Field_Check_Function is access
 105      function (Fld : Field; Usr : System.Address) return Curses_Bool;
 106    pragma Convention (C, Field_Check_Function);
 107
 108    type Char_Check_Function is access
 109      function (Ch : C_Int; Usr : System.Address) return Curses_Bool;
 110    pragma Convention (C, Char_Check_Function);
 111
 112    type Choice_Function is access
 113      function (Fld : Field; Usr : System.Address) return Curses_Bool;
 114    pragma Convention (C, Choice_Function);
 115
 116    --  +----------------------------------------------------------------------
 117    --  | This must be in sync with the FIELDTYPE structure in form.h
 118    --  |
 119    type Low_Level_Field_Type is
 120       record
 121          Status :              Interfaces.C.unsigned_short;
 122          Ref_Count :           Interfaces.C.long;
 123          Left, Right :         System.Address;
 124          Makearg :             Makearg_Function;
 125          Copyarg :             Copyarg_Function;
 126          Freearg :             Freearg_Function;
 127          Fcheck :              Field_Check_Function;
 128          Ccheck :              Char_Check_Function;
 129          Next, Prev :          Choice_Function;
 130       end record;
 131    pragma Convention (C, Low_Level_Field_Type);
 132    type C_Field_Type is access all Low_Level_Field_Type;
 133
 134    Null_Field_Type   : constant C_Field_Type := null;
 135
 136    --  +----------------------------------------------------------------------
 137    --  | This four low-level fieldtypes are the ones associated with
 138    --  | fieldtypes handled by this binding. Any other low-level fieldtype
 139    --  | will result in a Form_Exception is function Get_Type.
 140    --  |
 141    M_Generic_Type   : C_Field_Type := null;
 142    M_Generic_Choice : C_Field_Type := null;
 143    M_Builtin_Router : C_Field_Type := null;
 144    M_Choice_Router  : C_Field_Type := null;
 145
 146    --  Two wrapper functions to access those low-level fieldtypes defined
 147    --  in this package.
 148    function C_Builtin_Router return C_Field_Type;
 149    function C_Choice_Router  return C_Field_Type;
 150
 151    procedure Wrap_Builtin (Fld : Field;
 152                            Typ : Field_Type'Class;
 153                            Cft : C_Field_Type := C_Builtin_Router);
 154    --  This procedure has to be called by the Set_Field_Type implementation
 155    --  for builtin low-level fieldtypes to replace it by an Ada95
 156    --  conformant Field_Type object.
 157    --  The parameter Cft must be C_Builtin_Router for regular low-level
 158    --  fieldtypes (like TYP_ALPHA or TYP_ALNUM) and C_Choice_Router for
 159    --  low-level fieldtypes witch choice functions (like TYP_ENUM).
 160    --  Any other value will raise a Form_Exception.
 161
 162    function Make_Arg (Args : System.Address) return System.Address;
 163    pragma Import (C, Make_Arg, "void_star_make_arg");
 164    --  This is the Makearg_Function for the internal low-level types
 165    --  introduced by this binding.
 166
 167    function Copy_Arg (Usr : System.Address) return System.Address;
 168    pragma Convention (C, Copy_Arg);
 169    --  This is the Copyarg_Function for the internal low-level types
 170    --  introduced by this binding.
 171
 172    procedure Free_Arg (Usr : System.Address);
 173    pragma Convention (C, Free_Arg);
 174    --  This is the Freearg_Function for the internal low-level types
 175    --  introduced by this binding.
 176
 177    function Field_Check_Router (Fld : Field;
 178                                 Usr : System.Address) return Curses_Bool;
 179    pragma Convention (C, Field_Check_Router);
 180    --  This is the Field_Check_Function for the internal low-level types
 181    --  introduced to wrap the low-level types by a Field_Type derived
 182    --  type. It routes the call to the corresponding low-level validation
 183    --  function.
 184
 185    function Char_Check_Router (Ch : C_Int;
 186                                Usr : System.Address) return Curses_Bool;
 187    pragma Convention (C, Char_Check_Router);
 188    --  This is the Char_Check_Function for the internal low-level types
 189    --  introduced to wrap the low-level types by a Field_Type derived
 190    --  type. It routes the call to the corresponding low-level validation
 191    --  function.
 192
 193    function Next_Router (Fld : Field;
 194                          Usr : System.Address) return Curses_Bool;
 195    pragma Convention (C, Next_Router);
 196    --  This is the Choice_Function for the internal low-level types
 197    --  introduced to wrap the low-level types by a Field_Type derived
 198    --  type. It routes the call to the corresponding low-level next_choice
 199    --  function.
 200
 201    function Prev_Router (Fld : Field;
 202                          Usr : System.Address) return Curses_Bool;
 203    pragma Convention (C, Prev_Router);
 204    --  This is the Choice_Function for the internal low-level types
 205    --  introduced to wrap the low-level types by a Field_Type derived
 206    --  type. It routes the call to the corresponding low-level prev_choice
 207    --  function.
 208
 209    --  This is the Argument structure maintained by all low-level field types
 210    --  introduced by this binding.
 211    type Argument is record
 212       Typ : Field_Type_Access;   --  the Field_Type creating this record
 213       Usr : System.Address;      --  original arg for builtin low-level types
 214       Cft : C_Field_Type;        --  the original low-level type
 215    end record;
 216    type Argument_Access is access all Argument;
 217
 218    --  +----------------------------------------------------------------------
 219    --  |
 220    --  | Some Imports of libform routines to deal with low-level fieldtypes.
 221    --  |
 222    function New_Fieldtype (Fcheck : Field_Check_Function;
 223                            Ccheck : Char_Check_Function)
 224      return C_Field_Type;
 225    pragma Import (C, New_Fieldtype, "new_fieldtype");
 226
 227    function Set_Fieldtype_Arg (Cft : C_Field_Type;
 228                                Mak : Makearg_Function := Make_Arg'Access;
 229                                Cop : Copyarg_Function := Copy_Arg'Access;
 230                                Fre : Freearg_Function := Free_Arg'Access)
 231      return Aux.Eti_Error;
 232    pragma Import (C, Set_Fieldtype_Arg, "set_fieldtype_arg");
 233
 234    function Set_Fieldtype_Choice (Cft : C_Field_Type;
 235                                   Next, Prev : Choice_Function)
 236      return Aux.Eti_Error;
 237    pragma Import (C, Set_Fieldtype_Choice, "set_fieldtype_choice");
 238
 239 end Terminal_Interface.Curses.Forms.Field_Types;