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

   1 --  -*- ada -*-
   2 define(`HTMLNAME',`terminal_interface-curses-forms_s.html')dnl
   3 include(M4MACRO)dnl
   4 ------------------------------------------------------------------------------
   5 --                                                                          --
   6 --                           GNAT ncurses Binding                           --
   7 --                                                                          --
   8 --                      Terminal_Interface.Curses.Form                      --
   9 --                                                                          --
  10 --                                 S P E C                                  --
  11 --                                                                          --
  12 --  Version 00.92                                                           --
  13 --                                                                          --
  14 --  The ncurses Ada95 binding is copyrighted 1996 by                        --
  15 --  Juergen Pfeifer, Email: Juergen.Pfeifer@T-Online.de                     --
  16 --                                                                          --
  17 --  Permission is hereby granted to reproduce and distribute this           --
  18 --  binding by any means and for any fee, whether alone or as part          --
  19 --  of a larger distribution, in source or in binary form, PROVIDED         --
  20 --  this notice is included with any such distribution, and is not          --
  21 --  removed from any of its header files. Mention of ncurses and the        --
  22 --  author of this binding in any applications linked with it is            --
  23 --  highly appreciated.                                                     --
  24 --                                                                          --
  25 --  This binding comes AS IS with no warranty, implied or expressed.        --
  26 ------------------------------------------------------------------------------
  27 --  Version Control:
  28 --  $Revision: 1.9 $
  29 ------------------------------------------------------------------------------
  30 include(`Form_Base_Defs')
  31 with System;
  32 with Ada.Tags; use Ada.Tags;
  33 with Ada.Characters.Latin_1;
  34 with Interfaces.C;
  35 with Interfaces.C.Strings;
  36
  37 package Terminal_Interface.Curses.Forms is
  38
  39 include(`Form_Linker_Options')
  40
  41    Space : Character renames Ada.Characters.Latin_1.Space;
  42
  43    type Field        is private;
  44    type Form         is private;
  45    type C_Field_Type is private;
  46
  47    Null_Field        : constant Field;
  48    Null_Form         : constant Form;
  49    Null_Field_Type   : constant C_Field_Type;
  50
  51
  52    type Field_Justification is (None,
  53                                 Left,
  54                                 Center,
  55                                 Right);
  56
  57 include(`Field_Rep')
  58
  59    Default_Field_Options : Field_Option_Set;
  60    --  The initial defaults for the field options.
  61
  62 include(`Form_Opt_Rep')
  63
  64    Default_Form_Options : Form_Option_Set;
  65    --  The initial defaults for the form options.
  66
  67    type Buffer_Number is new Natural;
  68
  69    type Field_Array is array (Positive range <>) of aliased Field;
  70    pragma Convention (C, Field_Array);
  71
  72    type Field_Array_Access is access all Field_Array;
  73
  74    subtype Form_Request_Code is Key_Code range (Key_Max + 1) .. (Key_Max + 57);
  75
  76    --  The prefix F_ stands for "Form Request"
  77    F_Next_Page                : constant Form_Request_Code := Key_Max + 1;
  78    F_Previous_Page            : constant Form_Request_Code := Key_Max + 2;
  79    F_First_Page               : constant Form_Request_Code := Key_Max + 3;
  80    F_Last_Page                : constant Form_Request_Code := Key_Max + 4;
  81
  82    F_Next_Field               : constant Form_Request_Code := Key_Max + 5;
  83    F_Previous_Field           : constant Form_Request_Code := Key_Max + 6;
  84    F_First_Field              : constant Form_Request_Code := Key_Max + 7;
  85    F_Last_Field               : constant Form_Request_Code := Key_Max + 8;
  86    F_Sorted_Next_Field        : constant Form_Request_Code := Key_Max + 9;
  87    F_Sorted_Previous_Field    : constant Form_Request_Code := Key_Max + 10;
  88    F_Sorted_First_Field       : constant Form_Request_Code := Key_Max + 11;
  89    F_Sorted_Last_Field        : constant Form_Request_Code := Key_Max + 12;
  90    F_Left_Field               : constant Form_Request_Code := Key_Max + 13;
  91    F_Right_Field              : constant Form_Request_Code := Key_Max + 14;
  92    F_Up_Field                 : constant Form_Request_Code := Key_Max + 15;
  93    F_Down_Field               : constant Form_Request_Code := Key_Max + 16;
  94
  95    F_Next_Char                : constant Form_Request_Code := Key_Max + 17;
  96    F_Previous_Char            : constant Form_Request_Code := Key_Max + 18;
  97    F_Next_Line                : constant Form_Request_Code := Key_Max + 19;
  98    F_Previous_Line            : constant Form_Request_Code := Key_Max + 20;
  99    F_Next_Word                : constant Form_Request_Code := Key_Max + 21;
 100    F_Previous_Word            : constant Form_Request_Code := Key_Max + 22;
 101    F_Begin_Field              : constant Form_Request_Code := Key_Max + 23;
 102    F_End_Field                : constant Form_Request_Code := Key_Max + 24;
 103    F_Begin_Line               : constant Form_Request_Code := Key_Max + 25;
 104    F_End_Line                 : constant Form_Request_Code := Key_Max + 26;
 105    F_Left_Char                : constant Form_Request_Code := Key_Max + 27;
 106    F_Right_Char               : constant Form_Request_Code := Key_Max + 28;
 107    F_Up_Char                  : constant Form_Request_Code := Key_Max + 29;
 108    F_Down_Char                : constant Form_Request_Code := Key_Max + 30;
 109
 110    F_New_Line                 : constant Form_Request_Code := Key_Max + 31;
 111    F_Insert_Char              : constant Form_Request_Code := Key_Max + 32;
 112    F_Insert_Line              : constant Form_Request_Code := Key_Max + 33;
 113    F_Delete_Char              : constant Form_Request_Code := Key_Max + 34;
 114    F_Delete_Previous          : constant Form_Request_Code := Key_Max + 35;
 115    F_Delete_Line              : constant Form_Request_Code := Key_Max + 36;
 116    F_Delete_Word              : constant Form_Request_Code := Key_Max + 37;
 117    F_Clear_EOL                : constant Form_Request_Code := Key_Max + 38;
 118    F_Clear_EOF                : constant Form_Request_Code := Key_Max + 39;
 119    F_Clear_Field              : constant Form_Request_Code := Key_Max + 40;
 120    F_Overlay_Mode             : constant Form_Request_Code := Key_Max + 41;
 121    F_Insert_Mode              : constant Form_Request_Code := Key_Max + 42;
 122
 123    --  Vertical Scrolling
 124    F_ScrollForward_Line       : constant Form_Request_Code := Key_Max + 43;
 125    F_ScrollBackward_Line      : constant Form_Request_Code := Key_Max + 44;
 126    F_ScrollForward_Page       : constant Form_Request_Code := Key_Max + 45;
 127    F_ScrollBackward_Page      : constant Form_Request_Code := Key_Max + 46;
 128    F_ScrollForward_HalfPage   : constant Form_Request_Code := Key_Max + 47;
 129    F_ScrollBackward_HalfPage  : constant Form_Request_Code := Key_Max + 48;
 130
 131    --  Horizontal Scrolling
 132    F_HScrollForward_Char      : constant Form_Request_Code := Key_Max + 49;
 133    F_HScrollBackward_Char     : constant Form_Request_Code := Key_Max + 50;
 134    F_HScrollForward_Line      : constant Form_Request_Code := Key_Max + 51;
 135    F_HScrollBackward_Line     : constant Form_Request_Code := Key_Max + 52;
 136    F_HScrollForward_HalfLine  : constant Form_Request_Code := Key_Max + 53;
 137    F_HScrollBackward_HalfLine : constant Form_Request_Code := Key_Max + 54;
 138
 139    F_Validate_Field           : constant Form_Request_Code := Key_Max + 55;
 140    F_Next_Choice              : constant Form_Request_Code := Key_Max + 56;
 141    F_Previous_Choice          : constant Form_Request_Code := Key_Max + 57;
 142
 143    --  For those who like the old 'C' style request names
 144    REQ_NEXT_PAGE    : Form_Request_Code renames F_Next_Page;
 145    REQ_PREV_PAGE    : Form_Request_Code renames F_Previous_Page;
 146    REQ_FIRST_PAGE   : Form_Request_Code renames F_First_Page;
 147    REQ_LAST_PAGE    : Form_Request_Code renames F_Last_Page;
 148
 149    REQ_NEXT_FIELD   : Form_Request_Code renames F_Next_Field;
 150    REQ_PREV_FIELD   : Form_Request_Code renames F_Previous_Field;
 151    REQ_FIRST_FIELD  : Form_Request_Code renames F_First_Field;
 152    REQ_LAST_FIELD   : Form_Request_Code renames F_Last_Field;
 153    REQ_SNEXT_FIELD  : Form_Request_Code renames F_Sorted_Next_Field;
 154    REQ_SPREV_FIELD  : Form_Request_Code renames F_Sorted_Previous_Field;
 155    REQ_SFIRST_FIELD : Form_Request_Code renames F_Sorted_First_Field;
 156    REQ_SLAST_FIELD  : Form_Request_Code renames F_Sorted_Last_Field;
 157    REQ_LEFT_FIELD   : Form_Request_Code renames F_Left_Field;
 158    REQ_RIGHT_FIELD  : Form_Request_Code renames F_Right_Field;
 159    REQ_UP_FIELD     : Form_Request_Code renames F_Up_Field;
 160    REQ_DOWN_FIELD   : Form_Request_Code renames F_Down_Field;
 161
 162    REQ_NEXT_CHAR    : Form_Request_Code renames F_Next_Char;
 163    REQ_PREV_CHAR    : Form_Request_Code renames F_Previous_Char;
 164    REQ_NEXT_LINE    : Form_Request_Code renames F_Next_Line;
 165    REQ_PREV_LINE    : Form_Request_Code renames F_Previous_Line;
 166    REQ_NEXT_WORD    : Form_Request_Code renames F_Next_Word;
 167    REQ_PREV_WORD    : Form_Request_Code renames F_Previous_Word;
 168    REQ_BEG_FIELD    : Form_Request_Code renames F_Begin_Field;
 169    REQ_END_FIELD    : Form_Request_Code renames F_End_Field;
 170    REQ_BEG_LINE     : Form_Request_Code renames F_Begin_Line;
 171    REQ_END_LINE     : Form_Request_Code renames F_End_Line;
 172    REQ_LEFT_CHAR    : Form_Request_Code renames F_Left_Char;
 173    REQ_RIGHT_CHAR   : Form_Request_Code renames F_Right_Char;
 174    REQ_UP_CHAR      : Form_Request_Code renames F_Up_Char;
 175    REQ_DOWN_CHAR    : Form_Request_Code renames F_Down_Char;
 176
 177    REQ_NEW_LINE     : Form_Request_Code renames F_New_Line;
 178    REQ_INS_CHAR     : Form_Request_Code renames F_Insert_Char;
 179    REQ_INS_LINE     : Form_Request_Code renames F_Insert_Line;
 180    REQ_DEL_CHAR     : Form_Request_Code renames F_Delete_Char;
 181    REQ_DEL_PREV     : Form_Request_Code renames F_Delete_Previous;
 182    REQ_DEL_LINE     : Form_Request_Code renames F_Delete_Line;
 183    REQ_DEL_WORD     : Form_Request_Code renames F_Delete_Word;
 184    REQ_CLR_EOL      : Form_Request_Code renames F_Clear_EOL;
 185    REQ_CLR_EOF      : Form_Request_Code renames F_Clear_EOF;
 186    REQ_CLR_FIELD    : Form_Request_Code renames F_Clear_Field;
 187    REQ_OVL_MODE     : Form_Request_Code renames F_Overlay_Mode;
 188    REQ_INS_MODE     : Form_Request_Code renames F_Insert_Mode;
 189
 190    REQ_SCR_FLINE    : Form_Request_Code renames F_ScrollForward_Line;
 191    REQ_SCR_BLINE    : Form_Request_Code renames F_ScrollBackward_Line;
 192    REQ_SCR_FPAGE    : Form_Request_Code renames F_ScrollForward_Page;
 193    REQ_SCR_BPAGE    : Form_Request_Code renames F_ScrollBackward_Page;
 194    REQ_SCR_FHPAGE   : Form_Request_Code renames F_ScrollForward_HalfPage;
 195    REQ_SCR_BHPAGE   : Form_Request_Code renames F_ScrollBackward_HalfPage;
 196
 197    REQ_SCR_FCHAR    : Form_Request_Code renames F_HScrollForward_Char;
 198    REQ_SCR_BCHAR    : Form_Request_Code renames F_HScrollBackward_Char;
 199    REQ_SCR_HFLINE   : Form_Request_Code renames F_HScrollForward_Line;
 200    REQ_SCR_HBLINE   : Form_Request_Code renames F_HScrollBackward_Line;
 201    REQ_SCR_HFHALF   : Form_Request_Code renames F_HScrollForward_HalfLine;
 202    REQ_SCR_HBHALF   : Form_Request_Code renames F_HScrollBackward_HalfLine;
 203
 204    REQ_VALIDATION   : Form_Request_Code renames F_Validate_Field;
 205    REQ_NEXT_CHOICE  : Form_Request_Code renames F_Next_Choice;
 206    REQ_PREV_CHOICE  : Form_Request_Code renames F_Previous_Choice;
 207
 208
 209    procedure Request_Name (Key  : in Form_Request_Code;
 210                            Name : out String);
 211
 212    ------------------
 213    --  Exceptions  --
 214    ------------------
 215    Form_Exception : exception;
 216
 217    --  MANPAGE(`form_field_new.3x')
 218
 219    --  ANCHOR(`new_field()',`Create')
 220    function Create (Height       : Line_Count;
 221                     Width        : Column_Count;
 222                     Top          : Line_Position;
 223                     Left         : Column_Position;
 224                     Off_Screen   : Natural := 0;
 225                     More_Buffers : Buffer_Number := Buffer_Number'First)
 226                     return Field;
 227    --  AKA
 228
 229    --  ANCHOR(`new_field()',`New_Field')
 230    function New_Field (Height       : Line_Count;
 231                        Width        : Column_Count;
 232                        Top          : Line_Position;
 233                        Left         : Column_Position;
 234                        Off_Screen   : Natural := 0;
 235                        More_Buffers : Buffer_Number := Buffer_Number'First)
 236                        return Field renames Create;
 237    --  AKA
 238
 239    --  ANCHOR(`free_field()',`Delete')
 240    procedure Delete (Fld : in out Field);
 241    --  AKA
 242    --  Reset Fld to Null_Field
 243
 244    --  ANCHOR(`dup_field()',`Duplicate')
 245    function Duplicate (Fld  : Field;
 246                        Top  : Line_Position;
 247                        Left : Column_Position) return Field;
 248    --  AKA
 249
 250    --  ANCHOR(`link_field()',`Link')
 251    function Link (Fld  : Field;
 252                   Top  : Line_Position;
 253                   Left : Column_Position) return Field;
 254    --  AKA
 255
 256    --  MANPAGE(`form_field_just.3x')
 257
 258    --  ANCHOR(`set_field_just()',`Set_Justification')
 259    procedure Set_Justification (Fld  : in Field;
 260                                 Just : in Field_Justification := None);
 261    --  AKA
 262
 263    --  ANCHOR(`field_just()',`Get_Justification')
 264    function Get_Justification (Fld : Field) return Field_Justification;
 265    --  AKA
 266
 267    --  MANPAGE(`form_field_buffer.3x')
 268
 269    --  ANCHOR(`set_field_buffer()',`Set_Buffer')
 270    procedure Set_Buffer
 271      (Fld    : in Field;
 272       Buffer : in Buffer_Number := Buffer_Number'First;
 273       Str    : in String);
 274    --  AKA
 275
 276    --  ANCHOR(`field_buffer()',`Get_Buffer')
 277    procedure Get_Buffer
 278      (Fld    : in Field;
 279       Buffer : in Buffer_Number := Buffer_Number'First;
 280       Str    : out String);
 281    --  AKA
 282
 283    --  ANCHOR(`set_field_status()',`Set_Status')
 284    procedure Set_Status (Fld    : in Field;
 285                          Status : in Boolean := True);
 286    --  AKA
 287
 288    --  ANCHOR(`field_status()',`Changed')
 289    function Changed (Fld : Field) return Boolean;
 290    --  AKA
 291
 292    --  ANCHOR(`set_field_max()',`Set_Maximum_Size')
 293    procedure Set_Maximum_Size (Fld : in Field;
 294                                Max : in Natural := 0);
 295    --  AKA
 296
 297    --  MANPAGE(`form_field_opts.3x')
 298
 299    --  ANCHOR(`set_field_opts()',`Set_Options')
 300    procedure Set_Options (Fld     : in Field;
 301                           Options : in Field_Option_Set);
 302    --  AKA
 303
 304    --  ANCHOR(`field_opts_on()',`Switch_Options')
 305    procedure Switch_Options (Fld     : in Field;
 306                              Options : in Field_Option_Set;
 307                              On      : Boolean := True);
 308    --  AKA
 309    --  ALIAS(`field_opts_off()')
 310
 311    --  ANCHOR(`field_opts()',`Get_Options')
 312    procedure Get_Options (Fld     : in  Field;
 313                           Options : out Field_Option_Set);
 314    --  AKA
 315
 316    --  ANCHOR(`field_opts()',`Get_Options')
 317    function Get_Options (Fld : Field := Null_Field)
 318                          return Field_Option_Set;
 319    --  AKA
 320
 321    --  MANPAGE(`form_field_attributes.3x')
 322
 323    --  ANCHOR(`set_field_fore()',`Set_Foreground')
 324    procedure Set_Foreground
 325      (Fld   : in Field;
 326       Fore  : in Character_Attribute_Set := Normal_Video;
 327       Color : in Color_Pair := Color_Pair'First);
 328    --  AKA
 329
 330    --  ANCHOR(`field_fore()',`Foreground')
 331    procedure Foreground (Fld  : in  Field;
 332                          Fore : out Character_Attribute_Set);
 333    --  AKA
 334
 335    --  ANCHOR(`field_fore()',`Foreground')
 336    procedure Foreground (Fld   : in  Field;
 337                          Fore  : out Character_Attribute_Set;
 338                          Color : out Color_Pair);
 339    --  AKA
 340
 341    --  ANCHOR(`set_field_back()',`Set_Background')
 342    procedure Set_Background
 343      (Fld   : in Field;
 344       Back  : in Character_Attribute_Set := Normal_Video;
 345       Color : in Color_Pair := Color_Pair'First);
 346    --  AKA
 347
 348    --  ANCHOR(`field_back()',`Background')
 349    procedure Background (Fld  : in  Field;
 350                          Back : out Character_Attribute_Set);
 351    --  AKA
 352
 353    --  ANCHOR(`field_back()',`Background')
 354    procedure Background (Fld   : in  Field;
 355                          Back  : out Character_Attribute_Set;
 356                          Color : out Color_Pair);
 357    --  AKA
 358
 359    --  ANCHOR(`set_field_pad()',`Set_Pad_Character')
 360    procedure Set_Pad_Character (Fld : in Field;
 361                                 Pad : in Character := Space);
 362    --  AKA
 363
 364    --  ANCHOR(`field_pad()',`Pad_Character')
 365    procedure Pad_Character (Fld : in  Field;
 366                             Pad : out Character);
 367    --  AKA
 368
 369    --  MANPAGE(`form_field_info.3x')
 370
 371    --  ANCHOR(`field_info()',`Info')
 372    procedure Info (Fld                : in  Field;
 373                    Lines              : out Line_Count;
 374                    Columns            : out Column_Count;
 375                    First_Row          : out Line_Position;
 376                    First_Column       : out Column_Position;
 377                    Off_Screen         : out Natural;
 378                    Additional_Buffers : out Buffer_Number);
 379    --  AKA
 380
 381    --  ANCHOR(`dynamic_field_info()',`Dynamic_Info')
 382    procedure Dynamic_Info (Fld     : in Field;
 383                            Lines   : out Line_Count;
 384                            Columns : out Column_Count;
 385                            Max     : out Natural);
 386    --  AKA
 387
 388    --  MANPAGE(`form_win.3x')
 389
 390    --  ANCHOR(`set_form_win()',`Set_Window')
 391    procedure Set_Window (Frm : in Form;
 392                          Win : in Window);
 393    --  AKA
 394
 395    --  ANCHOR(`form_win()',`Get_Window')
 396    function Get_Window (Frm : Form) return Window;
 397    --  AKA
 398
 399    --  ANCHOR(`set_form_sub()',`Set_Sub_Window')
 400    procedure Set_Sub_Window (Frm : in Form;
 401                              Win : in Window);
 402    --  AKA
 403
 404    --  ANCHOR(`form_sub()',`Get_Sub_Window')
 405    function Get_Sub_Window (Frm : Form) return Window;
 406    --  AKA
 407
 408    --  ANCHOR(`scale_form()',`Scale')
 409    procedure Scale (Frm     : in Form;
 410                     Lines   : out Line_Count;
 411                     Columns : out Column_Count);
 412    --  AKA
 413
 414    --  MANPAGE(`form_hook.3x')
 415
 416    type Form_Hook_Function is access procedure (Frm : in Form);
 417    pragma Convention (C, Form_Hook_Function);
 418
 419    --  ANCHOR(`set_field_init()',`Set_Field_Init_Hook')
 420    procedure Set_Field_Init_Hook (Frm  : in Form;
 421                                   Proc : in Form_Hook_Function);
 422    --  AKA
 423
 424    --  ANCHOR(`set_field_term()',`Set_Field_Term_Hook')
 425    procedure Set_Field_Term_Hook (Frm  : in Form;
 426                                   Proc : in Form_Hook_Function);
 427    --  AKA
 428
 429    --  ANCHOR(`set_form_init()',`Set_Form_Init_Hook')
 430    procedure Set_Form_Init_Hook (Frm  : in Form;
 431                                  Proc : in Form_Hook_Function);
 432    --  AKA
 433
 434    --  ANCHOR(`set_form_term()',`Set_Form_Term_Hook')
 435    procedure Set_Form_Term_Hook (Frm  : in Form;
 436                                  Proc : in Form_Hook_Function);
 437    --  AKA
 438
 439    --  ANCHOR(`field_init()',`Get_Field_Init_Hook')
 440    function Get_Field_Init_Hook (Frm : Form) return Form_Hook_Function;
 441    --  AKA
 442    pragma Import (C, Get_Field_Init_Hook, "field_init");
 443
 444    --  ANCHOR(`field_term()',`Get_Field_Term_Hook')
 445    function Get_Field_Term_Hook (Frm : Form) return Form_Hook_Function;
 446    --  AKA
 447    pragma Import (C, Get_Field_Term_Hook, "field_term");
 448
 449    --  ANCHOR(`form_init()',`Get_Form_Init_Hook')
 450    function Get_Form_Init_Hook (Frm : Form) return Form_Hook_Function;
 451    --  AKA
 452    pragma Import (C, Get_Form_Init_Hook, "form_init");
 453
 454    --  ANCHOR(`form_term()',`Get_Form_Term_Hook')
 455    function Get_Form_Term_Hook (Frm : Form) return Form_Hook_Function;
 456    --  AKA
 457    pragma Import (C, Get_Form_Term_Hook, "form_term");
 458
 459    --  MANPAGE(`form_field.3x')
 460
 461    --  ANCHOR(`set_form_fields()',`Redefine')
 462    procedure Redefine (Frm  : in Form;
 463                        Flds : in Field_Array);
 464    --  AKA
 465    --  With a bit more comfort. You don´t need to terminate the Field_Array
 466    --  with a null entry. This is handled internally in the binding.
 467
 468    --  ANCHOR(`set_form_fields()',`Set_Fields')
 469    procedure Set_Fields (Frm  : in Form;
 470                          Flds : in Field_Array) renames Redefine;
 471    --  AKA
 472
 473    --  ANCHOR(`form_fields()',`Fields')
 474    function Fields (Frm : Form) return Field_Array_Access;
 475    --  AKA
 476
 477    --  ANCHOR(`field_count()',`Field_Count')
 478    function Field_Count (Frm : Form) return Natural;
 479    --  AKA
 480
 481    --  ANCHOR(`move_field()',`Move')
 482    procedure Move (Fld    : in Field;
 483                    Line   : in Line_Position;
 484                    Column : in Column_Position);
 485    --  AKA
 486
 487    --  MANPAGE(`form_new.3x')
 488
 489    --  ANCHOR(`new_form()',`Create')
 490    function Create (Fields : Field_Array) return Form;
 491    --  AKA
 492
 493    --  ANCHOR(`new_form()',`New_Form')
 494    function New_Form (Fields : Field_Array) return Form renames Create;
 495    --  AKA
 496
 497    --  ANCHOR(`free_form()',`Delete')
 498    procedure Delete (Frm : in out Form);
 499    --  AKA
 500    --  Reset Frm to Null_Form
 501
 502    --  MANPAGE(`form_opts.3x')
 503
 504    --  ANCHOR(`set_form_opts()',`Set_Options')
 505    procedure Set_Options (Frm     : in Form;
 506                           Options : in Form_Option_Set);
 507    --  AKA
 508
 509    --  ANCHOR(`form_opts_on()',`Switch_Options')
 510    procedure Switch_Options (Frm     : in Form;
 511                              Options : in Form_Option_Set;
 512                              On      : Boolean := True);
 513    --  AKA
 514    --  ALIAS(`form_opts_off()')
 515
 516    --  ANCHOR(`form_opts()',`Get_Options')
 517    procedure Get_Options (Frm     : in  Form;
 518                           Options : out Form_Option_Set);
 519    --  AKA
 520
 521    --  ANCHOR(`form_opts()',`Get_Options')
 522    function Get_Options (Frm : Form := Null_Form) return Form_Option_Set;
 523    --  AKA
 524
 525    --  MANPAGE(`form_post.3x')
 526
 527    --  ANCHOR(`post_form()',`Post')
 528    procedure Post (Frm  : in Form;
 529                    Post : in Boolean := True);
 530    --  AKA
 531    --  ALIAS(`unpost_form()')
 532
 533    --  MANPAGE(`form_cursor.3x')
 534
 535    --  ANCHOR(`pos_form_cursor()',`Position_Cursor')
 536    procedure Position_Cursor (Frm : Form);
 537    --  AKA
 538
 539    --  MANPAGE(`form_data.3x')
 540
 541    --  ANCHOR(`data_ahead()',`Data_Ahead')
 542    function Data_Ahead (Frm : Form) return Boolean;
 543    --  AKA
 544
 545    --  ANCHOR(`data_behind()',`Data_Behind')
 546    function Data_Behind (Frm : Form) return Boolean;
 547    --  AKA
 548
 549    --  MANPAGE(`form_driver.3x')
 550
 551    type Driver_Result is (Form_Ok,
 552                           Request_Denied,
 553                           Unknown_Request,
 554                           Invalid_Field);
 555
 556    --  ANCHOR(`form_driver()',`Driver')
 557    function Driver (Frm : Form;
 558                     Key : Key_Code) return Driver_Result;
 559    --  AKA
 560
 561    --  MANPAGE(`form_page.3x')
 562
 563    type Page_Number is new Natural;
 564
 565    --  ANCHOR(`set_current_field()',`Set_Current')
 566    procedure Set_Current (Frm : in Form;
 567                           Fld : in Field);
 568    --  AKA
 569
 570    --  ANCHOR(`current_field()',`Current')
 571    function Current (Frm : in Form) return Field;
 572    --  AKA
 573
 574    --  ANCHOR(`set_form_page()',`Set_Page')
 575    procedure Set_Page (Frm  : in Form;
 576                        Page : in Page_Number := Page_Number'First);
 577    --  AKA
 578
 579    --  ANCHOR(`form_page()',`Page')
 580    function Page (Frm : Form) return Page_Number;
 581    --  AKA
 582
 583    --  ANCHOR(`field_index()',`Get_Index')
 584    function Get_Index (Fld : Field) return Positive;
 585    --  AKA
 586    --  Please note that in this binding we start the numbering of fields
 587    --  with 1. So this is number is one more than you get from the low
 588    --  level call.
 589
 590    --  MANPAGE(`form_new_page.3x')
 591
 592    --  ANCHOR(`set_new_page()',`Set_New_Page')
 593    procedure Set_New_Page (Fld      : in Field;
 594                            New_Page : in Boolean := True);
 595    --  AKA
 596
 597    --  ANCHOR(`new_page()',`Is_New_Page')
 598    function Is_New_Page (Fld : Field) return Boolean;
 599    --  AKA
 600
 601    --  MANPAGE(`form_fieldtype.3x')
 602
 603    type Field_Type is abstract tagged null record;
 604    type Field_Type_Access is access all Field_Type'Class;
 605
 606    function Native_Type (Ftype : Field_Type)
 607                          return C_Field_Type is abstract;
 608    --  This function returns the C libraries handle to the field type.
 609    --  May be you need this if you want to interface to lower level
 610    --  routines in the form library.
 611
 612    --  ANCHOR(`set_field_type()',`Set_Type')
 613    procedure Set_Type (Fld      : in Field;
 614                        Fld_Type : in Field_Type) is abstract;
 615    --  AKA
 616    --  But: we hide the vararg mechanism of the C interface. You always
 617    --       have to pass a single Field_Type parameter.
 618
 619    type C_Defined_Field_Type is abstract new Field_Type with null record;
 620    --  This is the root of all field typed defined in C, i.e. this are
 621    --  the predefined field types in the form library.
 622
 623    type Alpha_Field is new C_Defined_Field_Type
 624       with record
 625          Minimum_Field_Width : Natural := 0;
 626       end record;
 627    procedure Set_Type (Fld      : in Field;
 628                        Fld_Type : in Alpha_Field);
 629    function Native_Type (Ftype : Alpha_Field)
 630                          return C_Field_Type;
 631
 632    type Alpha_Numeric_Field is new C_Defined_Field_Type with
 633       record
 634          Minimum_Field_Width : Natural := 0;
 635       end record;
 636    procedure Set_Type (Fld      : in Field;
 637                        Fld_Type : in Alpha_Numeric_Field);
 638    function Native_Type (Ftype : Alpha_Numeric_Field)
 639                          return C_Field_Type;
 640
 641    type Integer_Field is new C_Defined_Field_Type with
 642       record
 643          Precision   : Natural;
 644          Lower_Limit : Integer;
 645          Upper_Limit : Integer;
 646       end record;
 647    procedure Set_Type (Fld      : in Field;
 648                        Fld_Type : in Integer_Field);
 649    function Native_Type (Ftype : Integer_Field)
 650                          return C_Field_Type;
 651
 652    type Numeric_Field is new C_Defined_Field_Type with
 653       record
 654          Precision   : Natural;
 655          Lower_Limit : Float;
 656          Upper_Limit : Float;
 657       end record;
 658    procedure Set_Type (Fld      : in Field;
 659                        Fld_Type : in Numeric_Field);
 660    function Native_Type (Ftype : Numeric_Field)
 661                          return C_Field_Type;
 662
 663    type String_Access is access String;
 664
 665    type Regular_Expression_Field is new C_Defined_Field_Type with
 666       record
 667          Regular_Expression : String_Access;
 668       end record;
 669    procedure Set_Type (Fld      : in Field;
 670                        Fld_Type : in Regular_Expression_Field);
 671    function Native_Type (Ftype : Regular_Expression_Field)
 672                          return C_Field_Type;
 673
 674    type Enum_Array is array (Positive range <>)
 675       of String_Access;
 676
 677    type Enumeration_Info (C : Positive) is
 678       record
 679          Names                : Enum_Array (1 .. C);
 680          Case_Sensitive       : Boolean := False;
 681          Match_Must_Be_Unique : Boolean := False;
 682       end record;
 683
 684    type Enumeration_Field is new C_Defined_Field_Type with private;
 685
 686    function Create (Info : Enumeration_Info;
 687                     Auto_Release_Names : Boolean := False)
 688                     return Enumeration_Field;
 689    --  Make an fieldtype from the info. Enumerations are special, because
 690    --  they normally don't copy the enum values into a private store, so
 691    --  we have to care for the lifetime of the info we provide.
 692    --  The Auto_Release_Names flag may be used to automatically releases
 693    --  the strings in the Names array of the Enumeration_Info.
 694
 695    function Make_Enumeration_Type (Info : Enumeration_Info;
 696                                    Auto_Release_Names : Boolean := False)
 697                                    return Enumeration_Field renames Create;
 698
 699    procedure Release (Enum : in out Enumeration_Field);
 700    --  But we may want to release the field to release the memory allocated
 701    --  by it internally. After that the Enumeration field is no longer usable.
 702
 703    procedure Set_Type (Fld      : in Field;
 704                        Fld_Type : in Enumeration_Field);
 705    function Native_Type (Ftype : Enumeration_Field)
 706                          return C_Field_Type;
 707
 708    --  The next type defintions are all ncurses extensions. They are typically
 709    --  not available in other curses implementations.
 710
 711    type Internet_V4_Address_Field is new C_Defined_Field_Type
 712      with null record;
 713    procedure Set_Type (Fld      : in Field;
 714                        Fld_Type : in Internet_V4_Address_Field);
 715    function Native_Type (Ftype : Internet_V4_Address_Field)
 716                          return C_Field_Type;
 717
 718
 719    type Ada_Defined_Field_Type is abstract new Field_Type with null record;
 720    --  This is the root of the mechanism we use to create field types in
 721    --  Ada95. You don't have to redefine the Set_Field_Type and
 722    --  Native_Field_Type methods, because they work generically on this
 723    --  class.
 724
 725    procedure Set_Type (Fld      : Field;
 726                        Fld_Type : Ada_Defined_Field_Type);
 727
 728    function Native_Type (Ftype : Ada_Defined_Field_Type)
 729                          return C_Field_Type;
 730
 731    --  MANPAGE(`form_field_validation.3x')
 732
 733    --  ANCHOR(`field_type()',`Get_Type')
 734    function Get_Type (Fld : in Field) return Field_Type_Access;
 735    --  AKA
 736    --  ALIAS(`field_arg()')
 737    --  In Ada95 we can combine these
 738
 739 ------------------------------------------------------------------------------
 740 private
 741
 742    type Field        is new System.Address;
 743    type Form         is new System.Address;
 744    type C_Field_Type is new System.Address;
 745
 746    Null_Field        : constant Field        := Field (System.Null_Address);
 747    Null_Form         : constant Form         := Form  (System.Null_Address);
 748    Null_Field_Type   : constant C_Field_Type :=
 749      C_Field_Type (System.Null_Address);
 750
 751    type CPA_Access is access Interfaces.C.Strings.chars_ptr_array;
 752
 753    type Enumeration_Field is new C_Defined_Field_Type with
 754       record
 755          Case_Sensitive       : Boolean := False;
 756          Match_Must_Be_Unique : Boolean := False;
 757          Arr                  : CPA_Access := null;
 758       end record;
 759
 760    --  In our binding we use the fields user pointer as hook to maintain
 761    --  our own info structure about the field type. To be able to still
 762    --  provide a user pointer, we use this wrapper.
 763    --
 764    type Field_User_Wrapper is
 765       record
 766          U : System.Address;    --  the hook we provide for the user
 767          T : Field_Type_Access; --  may be null
 768          N : Natural;           --  use counter
 769       end record;
 770    pragma Convention (C, Field_User_Wrapper);
 771    type Field_User_Wrapper_Access is access all Field_User_Wrapper;
 772    pragma Controlled (Field_User_Wrapper_Access);
 773
 774    function Set_Field_Userptr (Fld : Field;
 775                                Wrp : Field_User_Wrapper_Access)
 776                                return Interfaces.C.int;
 777    pragma Import (C, Set_Field_Userptr, "set_field_userptr");
 778
 779    function Field_Userptr (Fld : Field) return Field_User_Wrapper_Access;
 780    pragma Import (C, Field_Userptr, "field_userptr");
 781
 782    --  In our binding we use the forms user pointer as hook to maintain
 783    --  our own info structure about the field association. To be able to still
 784    --  provide a user pointer, we use this wrapper.
 785    --
 786    type Form_User_Wrapper is
 787       record
 788          U : System.Address;      --  the hook we provide for the user
 789          I : Field_Array_Access;
 790       end record;
 791    pragma Convention (C, Form_User_Wrapper);
 792    type Form_User_Wrapper_Access is access all Form_User_Wrapper;
 793    pragma Controlled (Form_User_Wrapper_Access);
 794
 795    function Set_Form_Userptr (Frm : Form;
 796                               Wrp : Form_User_Wrapper_Access)
 797                               return Interfaces.C.int;
 798    pragma Import (C, Set_Form_Userptr, "set_form_userptr");
 799
 800    function Form_Userptr (Frm : Form) return Form_User_Wrapper_Access;
 801    pragma Import (C, Form_Userptr, "form_userptr");
 802
 803    procedure Register_Type   (T   : in Ada_Defined_Field_Type'Class;
 804                               Cft : in C_Field_Type);
 805    procedure Unregister_Type (T   : in Ada_Defined_Field_Type'Class);
 806    function  Search_Type (T : Ada_Defined_Field_Type'Class)
 807                           return C_Field_Type;
 808
 809    Generation_Bit_Order : constant System.Bit_Order := System.M4_BIT_ORDER;
 810    --  This constant may be different on your system.
 811
 812 end Terminal_Interface.Curses.Forms;