-- -*- ada -*-
-define(`HTMLNAME',`terminal_interface-curses-forms_s.html')dnl
+define(`HTMLNAME',`terminal_interface-curses-forms__ads.htm')dnl
include(M4MACRO)dnl
------------------------------------------------------------------------------
-- --
-- --
-- S P E C --
-- --
--- Version 00.92 --
+------------------------------------------------------------------------------
+-- 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 --
+-- "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 ncurses Ada95 binding is copyrighted 1996 by --
--- Juergen Pfeifer, Email: Juergen.Pfeifer@T-Online.de --
+-- The above copyright notice and this permission notice shall be included --
+-- in all copies or substantial portions of the Software. --
-- --
--- Permission is hereby granted to reproduce and distribute this --
--- binding by any means and for any fee, whether alone or as part --
--- of a larger distribution, in source or in binary form, PROVIDED --
--- this notice is included with any such distribution, and is not --
--- removed from any of its header files. Mention of ncurses and the --
--- author of this binding in any applications linked with it is --
--- highly appreciated. --
+-- 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. --
-- --
--- This binding comes AS IS with no warranty, implied or expressed. --
+-- Except as contained in this notice, the name(s) of the above copyright --
+-- holders shall not be used in advertising or otherwise to promote the --
+-- sale, use or other dealings in this Software without prior written --
+-- authorization. --
------------------------------------------------------------------------------
+-- Author: Juergen Pfeifer, 1996
-- Version Control:
--- $Revision: 1.9 $
+-- $Revision: 1.33 $
+-- $Date: 2014/05/24 21:31:57 $
+-- Binding Version 01.00
------------------------------------------------------------------------------
-include(`Form_Base_Defs')
with System;
-with Ada.Tags; use Ada.Tags;
with Ada.Characters.Latin_1;
-with Interfaces.C;
-with Interfaces.C.Strings;
package Terminal_Interface.Curses.Forms is
-
-include(`Form_Linker_Options')
+ 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 C_Field_Type is private;
Null_Field : constant Field;
Null_Form : constant Form;
- Null_Field_Type : constant C_Field_Type;
-
type Field_Justification is (None,
Left,
Center,
Right);
-include(`Field_Rep')
+ 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);
+ for Field_Option_Set'Size use Curses_Constants.Field_Options_Size;
+ pragma Warnings (On);
- Default_Field_Options : Field_Option_Set;
+ function Default_Field_Options return Field_Option_Set;
-- The initial defaults for the field options.
+ pragma Inline (Default_Field_Options);
-include(`Form_Opt_Rep')
+ 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);
+ for Form_Option_Set'Size use Curses_Constants.Field_Options_Size;
+ pragma Warnings (On);
- Default_Form_Options : Form_Option_Set;
+ function Default_Form_Options return Form_Option_Set;
-- The initial defaults for the form options.
+ pragma Inline (Default_Form_Options);
type Buffer_Number is new Natural;
type Field_Array is array (Positive range <>) of aliased Field;
pragma Convention (C, Field_Array);
- type Field_Array_Access is access all Field_Array;
+ type Field_Array_Access is access Field_Array;
+
+ 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);
REQ_NEXT_CHOICE : Form_Request_Code renames F_Next_Choice;
REQ_PREV_CHOICE : Form_Request_Code renames F_Previous_Choice;
-
- procedure Request_Name (Key : in Form_Request_Code;
+ 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 --
------------------
More_Buffers : Buffer_Number := Buffer_Number'First)
return Field;
-- AKA
+ -- An overloaded Create is defined later. Pragma Inline appears there.
-- ANCHOR(`new_field()',`New_Field')
function New_Field (Height : Line_Count;
More_Buffers : Buffer_Number := Buffer_Number'First)
return Field renames Create;
-- AKA
+ pragma Inline (New_Field);
-- ANCHOR(`free_field()',`Delete')
procedure Delete (Fld : in out Field);
-- AKA
-- Reset Fld to Null_Field
+ -- An overloaded Delete is defined later. Pragma Inline appears there.
-- ANCHOR(`dup_field()',`Duplicate')
function Duplicate (Fld : Field;
Top : Line_Position;
Left : Column_Position) return Field;
-- AKA
+ pragma Inline (Duplicate);
-- ANCHOR(`link_field()',`Link')
function Link (Fld : Field;
Top : Line_Position;
Left : Column_Position) return Field;
-- AKA
+ pragma Inline (Link);
-- MANPAGE(`form_field_just.3x')
-- ANCHOR(`set_field_just()',`Set_Justification')
- procedure Set_Justification (Fld : in Field;
- Just : in Field_Justification := None);
+ procedure Set_Justification (Fld : Field;
+ Just : Field_Justification := None);
-- AKA
+ pragma Inline (Set_Justification);
-- ANCHOR(`field_just()',`Get_Justification')
function Get_Justification (Fld : Field) return Field_Justification;
-- AKA
+ pragma Inline (Get_Justification);
-- MANPAGE(`form_field_buffer.3x')
-- ANCHOR(`set_field_buffer()',`Set_Buffer')
procedure Set_Buffer
- (Fld : in Field;
- Buffer : in Buffer_Number := Buffer_Number'First;
- Str : in String);
+ (Fld : Field;
+ Buffer : Buffer_Number := Buffer_Number'First;
+ Str : String);
-- AKA
+ -- Not inlined
-- ANCHOR(`field_buffer()',`Get_Buffer')
procedure Get_Buffer
- (Fld : in Field;
- Buffer : in Buffer_Number := Buffer_Number'First;
+ (Fld : Field;
+ Buffer : Buffer_Number := Buffer_Number'First;
Str : out String);
-- AKA
+ function Get_Buffer
+ (Fld : Field;
+ Buffer : Buffer_Number := Buffer_Number'First) return String;
+ -- AKA
+ -- Same but as function
+ pragma Inline (Get_Buffer);
+
-- ANCHOR(`set_field_status()',`Set_Status')
- procedure Set_Status (Fld : in Field;
- Status : in Boolean := True);
+ procedure Set_Status (Fld : Field;
+ Status : Boolean := True);
-- AKA
+ pragma Inline (Set_Status);
-- ANCHOR(`field_status()',`Changed')
function Changed (Fld : Field) return Boolean;
-- AKA
+ pragma Inline (Changed);
-- ANCHOR(`set_field_max()',`Set_Maximum_Size')
- procedure Set_Maximum_Size (Fld : in Field;
- Max : in Natural := 0);
+ procedure Set_Maximum_Size (Fld : Field;
+ Max : Natural := 0);
-- AKA
+ pragma Inline (Set_Maximum_Size);
-- MANPAGE(`form_field_opts.3x')
-- ANCHOR(`set_field_opts()',`Set_Options')
- procedure Set_Options (Fld : in Field;
- Options : in Field_Option_Set);
+ procedure Set_Options (Fld : Field;
+ Options : Field_Option_Set);
-- AKA
+ -- An overloaded version is defined later. Pragma Inline appears there
-- ANCHOR(`field_opts_on()',`Switch_Options')
- procedure Switch_Options (Fld : in Field;
- Options : in Field_Option_Set;
+ procedure Switch_Options (Fld : Field;
+ Options : Field_Option_Set;
On : Boolean := True);
-- AKA
-- ALIAS(`field_opts_off()')
+ -- An overloaded version is defined later. Pragma Inline appears there
-- ANCHOR(`field_opts()',`Get_Options')
- procedure Get_Options (Fld : in Field;
+ procedure Get_Options (Fld : Field;
Options : out Field_Option_Set);
-- AKA
function Get_Options (Fld : Field := Null_Field)
return Field_Option_Set;
-- AKA
+ -- An overloaded version is defined later. Pragma Inline appears there
-- MANPAGE(`form_field_attributes.3x')
-- ANCHOR(`set_field_fore()',`Set_Foreground')
procedure Set_Foreground
- (Fld : in Field;
- Fore : in Character_Attribute_Set := Normal_Video;
- Color : in Color_Pair := Color_Pair'First);
+ (Fld : Field;
+ Fore : Character_Attribute_Set := Normal_Video;
+ Color : Color_Pair := Color_Pair'First);
-- AKA
+ pragma Inline (Set_Foreground);
-- ANCHOR(`field_fore()',`Foreground')
- procedure Foreground (Fld : in Field;
+ procedure Foreground (Fld : Field;
Fore : out Character_Attribute_Set);
-- AKA
-- ANCHOR(`field_fore()',`Foreground')
- procedure Foreground (Fld : in Field;
+ procedure Foreground (Fld : Field;
Fore : out Character_Attribute_Set;
Color : out Color_Pair);
-- AKA
+ pragma Inline (Foreground);
-- ANCHOR(`set_field_back()',`Set_Background')
procedure Set_Background
- (Fld : in Field;
- Back : in Character_Attribute_Set := Normal_Video;
- Color : in Color_Pair := Color_Pair'First);
+ (Fld : Field;
+ Back : Character_Attribute_Set := Normal_Video;
+ Color : Color_Pair := Color_Pair'First);
-- AKA
+ pragma Inline (Set_Background);
-- ANCHOR(`field_back()',`Background')
- procedure Background (Fld : in Field;
+ procedure Background (Fld : Field;
Back : out Character_Attribute_Set);
-- AKA
-- ANCHOR(`field_back()',`Background')
- procedure Background (Fld : in Field;
+ procedure Background (Fld : Field;
Back : out Character_Attribute_Set;
Color : out Color_Pair);
-- AKA
+ pragma Inline (Background);
-- ANCHOR(`set_field_pad()',`Set_Pad_Character')
- procedure Set_Pad_Character (Fld : in Field;
- Pad : in Character := Space);
+ procedure Set_Pad_Character (Fld : Field;
+ Pad : Character := Space);
-- AKA
+ pragma Inline (Set_Pad_Character);
-- ANCHOR(`field_pad()',`Pad_Character')
- procedure Pad_Character (Fld : in Field;
+ procedure Pad_Character (Fld : Field;
Pad : out Character);
-- AKA
+ pragma Inline (Pad_Character);
-- MANPAGE(`form_field_info.3x')
-- ANCHOR(`field_info()',`Info')
- procedure Info (Fld : in Field;
+ procedure Info (Fld : Field;
Lines : out Line_Count;
Columns : out Column_Count;
First_Row : out Line_Position;
Off_Screen : out Natural;
Additional_Buffers : out Buffer_Number);
-- AKA
+ pragma Inline (Info);
-- ANCHOR(`dynamic_field_info()',`Dynamic_Info')
- procedure Dynamic_Info (Fld : in Field;
+ procedure Dynamic_Info (Fld : Field;
Lines : out Line_Count;
Columns : out Column_Count;
Max : out Natural);
-- AKA
+ pragma Inline (Dynamic_Info);
-- MANPAGE(`form_win.3x')
-- ANCHOR(`set_form_win()',`Set_Window')
- procedure Set_Window (Frm : in Form;
- Win : in Window);
+ procedure Set_Window (Frm : Form;
+ Win : Window);
-- AKA
+ pragma Inline (Set_Window);
-- ANCHOR(`form_win()',`Get_Window')
function Get_Window (Frm : Form) return Window;
-- AKA
+ pragma Inline (Get_Window);
-- ANCHOR(`set_form_sub()',`Set_Sub_Window')
- procedure Set_Sub_Window (Frm : in Form;
- Win : in Window);
+ procedure Set_Sub_Window (Frm : Form;
+ Win : Window);
-- AKA
+ pragma Inline (Set_Sub_Window);
-- ANCHOR(`form_sub()',`Get_Sub_Window')
function Get_Sub_Window (Frm : Form) return Window;
-- AKA
+ pragma Inline (Get_Sub_Window);
-- ANCHOR(`scale_form()',`Scale')
- procedure Scale (Frm : in Form;
+ procedure Scale (Frm : Form;
Lines : out Line_Count;
Columns : out Column_Count);
-- AKA
+ pragma Inline (Scale);
-- MANPAGE(`form_hook.3x')
- type Form_Hook_Function is access procedure (Frm : in Form);
+ type Form_Hook_Function is access procedure (Frm : Form);
pragma Convention (C, Form_Hook_Function);
-- ANCHOR(`set_field_init()',`Set_Field_Init_Hook')
- procedure Set_Field_Init_Hook (Frm : in Form;
- Proc : in Form_Hook_Function);
+ procedure Set_Field_Init_Hook (Frm : Form;
+ Proc : Form_Hook_Function);
-- AKA
+ pragma Inline (Set_Field_Init_Hook);
-- ANCHOR(`set_field_term()',`Set_Field_Term_Hook')
- procedure Set_Field_Term_Hook (Frm : in Form;
- Proc : in Form_Hook_Function);
+ procedure Set_Field_Term_Hook (Frm : Form;
+ Proc : Form_Hook_Function);
-- AKA
+ pragma Inline (Set_Field_Term_Hook);
-- ANCHOR(`set_form_init()',`Set_Form_Init_Hook')
- procedure Set_Form_Init_Hook (Frm : in Form;
- Proc : in Form_Hook_Function);
+ procedure Set_Form_Init_Hook (Frm : Form;
+ Proc : Form_Hook_Function);
-- AKA
+ pragma Inline (Set_Form_Init_Hook);
-- ANCHOR(`set_form_term()',`Set_Form_Term_Hook')
- procedure Set_Form_Term_Hook (Frm : in Form;
- Proc : in Form_Hook_Function);
+ procedure Set_Form_Term_Hook (Frm : Form;
+ Proc : Form_Hook_Function);
-- AKA
+ pragma Inline (Set_Form_Term_Hook);
-- ANCHOR(`field_init()',`Get_Field_Init_Hook')
function Get_Field_Init_Hook (Frm : Form) return Form_Hook_Function;
-- MANPAGE(`form_field.3x')
-- ANCHOR(`set_form_fields()',`Redefine')
- procedure Redefine (Frm : in Form;
- Flds : in Field_Array);
+ procedure Redefine (Frm : Form;
+ Flds : Field_Array_Access);
-- AKA
- -- With a bit more comfort. You don´t need to terminate the Field_Array
- -- with a null entry. This is handled internally in the binding.
+ pragma Inline (Redefine);
-- ANCHOR(`set_form_fields()',`Set_Fields')
- procedure Set_Fields (Frm : in Form;
- Flds : in Field_Array) renames Redefine;
+ procedure Set_Fields (Frm : Form;
+ Flds : Field_Array_Access) renames Redefine;
-- AKA
+ -- pragma Inline (Set_Fields);
-- ANCHOR(`form_fields()',`Fields')
- function Fields (Frm : Form) return Field_Array_Access;
+ function Fields (Frm : Form;
+ Index : Positive) return Field;
-- AKA
+ pragma Inline (Fields);
-- ANCHOR(`field_count()',`Field_Count')
function Field_Count (Frm : Form) return Natural;
-- AKA
+ pragma Inline (Field_Count);
-- ANCHOR(`move_field()',`Move')
- procedure Move (Fld : in Field;
- Line : in Line_Position;
- Column : in Column_Position);
+ procedure Move (Fld : Field;
+ Line : Line_Position;
+ Column : Column_Position);
-- AKA
+ pragma Inline (Move);
-- MANPAGE(`form_new.3x')
-- ANCHOR(`new_form()',`Create')
- function Create (Fields : Field_Array) return Form;
+ function Create (Fields : Field_Array_Access) return Form;
-- AKA
+ pragma Inline (Create);
-- ANCHOR(`new_form()',`New_Form')
- function New_Form (Fields : Field_Array) return Form renames Create;
+ function New_Form (Fields : Field_Array_Access) return Form
+ renames Create;
-- AKA
+ -- pragma Inline (New_Form);
-- ANCHOR(`free_form()',`Delete')
procedure Delete (Frm : in out Form);
-- AKA
-- Reset Frm to Null_Form
+ pragma Inline (Delete);
-- MANPAGE(`form_opts.3x')
-- ANCHOR(`set_form_opts()',`Set_Options')
- procedure Set_Options (Frm : in Form;
- Options : in Form_Option_Set);
+ procedure Set_Options (Frm : Form;
+ Options : Form_Option_Set);
-- AKA
+ pragma Inline (Set_Options);
-- ANCHOR(`form_opts_on()',`Switch_Options')
- procedure Switch_Options (Frm : in Form;
- Options : in Form_Option_Set;
+ procedure Switch_Options (Frm : Form;
+ Options : Form_Option_Set;
On : Boolean := True);
-- AKA
-- ALIAS(`form_opts_off()')
+ pragma Inline (Switch_Options);
-- ANCHOR(`form_opts()',`Get_Options')
- procedure Get_Options (Frm : in Form;
+ procedure Get_Options (Frm : Form;
Options : out Form_Option_Set);
-- AKA
-- ANCHOR(`form_opts()',`Get_Options')
function Get_Options (Frm : Form := Null_Form) return Form_Option_Set;
-- AKA
+ pragma Inline (Get_Options);
-- MANPAGE(`form_post.3x')
-- ANCHOR(`post_form()',`Post')
- procedure Post (Frm : in Form;
- Post : in Boolean := True);
+ procedure Post (Frm : Form;
+ Post : Boolean := True);
-- AKA
-- ALIAS(`unpost_form()')
+ pragma Inline (Post);
-- MANPAGE(`form_cursor.3x')
-- ANCHOR(`pos_form_cursor()',`Position_Cursor')
procedure Position_Cursor (Frm : Form);
-- AKA
+ pragma Inline (Position_Cursor);
-- MANPAGE(`form_data.3x')
-- ANCHOR(`data_ahead()',`Data_Ahead')
function Data_Ahead (Frm : Form) return Boolean;
-- AKA
+ pragma Inline (Data_Ahead);
-- ANCHOR(`data_behind()',`Data_Behind')
function Data_Behind (Frm : Form) return Boolean;
-- AKA
+ pragma Inline (Data_Behind);
-- MANPAGE(`form_driver.3x')
function Driver (Frm : Form;
Key : Key_Code) return Driver_Result;
-- AKA
+ -- Driver not inlined
-- MANPAGE(`form_page.3x')
type Page_Number is new Natural;
-- ANCHOR(`set_current_field()',`Set_Current')
- procedure Set_Current (Frm : in Form;
- Fld : in Field);
+ procedure Set_Current (Frm : Form;
+ Fld : Field);
-- AKA
+ pragma Inline (Set_Current);
-- ANCHOR(`current_field()',`Current')
- function Current (Frm : in Form) return Field;
+ function Current (Frm : Form) return Field;
-- AKA
+ pragma Inline (Current);
-- ANCHOR(`set_form_page()',`Set_Page')
- procedure Set_Page (Frm : in Form;
- Page : in Page_Number := Page_Number'First);
+ procedure Set_Page (Frm : Form;
+ Page : Page_Number := Page_Number'First);
-- AKA
+ pragma Inline (Set_Page);
-- ANCHOR(`form_page()',`Page')
function Page (Frm : Form) return Page_Number;
-- AKA
+ pragma Inline (Page);
-- ANCHOR(`field_index()',`Get_Index')
function Get_Index (Fld : Field) return Positive;
-- 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);
-- MANPAGE(`form_new_page.3x')
-- ANCHOR(`set_new_page()',`Set_New_Page')
- procedure Set_New_Page (Fld : in Field;
- New_Page : in Boolean := True);
+ procedure Set_New_Page (Fld : Field;
+ New_Page : Boolean := True);
-- AKA
+ pragma Inline (Set_New_Page);
-- ANCHOR(`new_page()',`Is_New_Page')
function Is_New_Page (Fld : Field) return Boolean;
-- AKA
+ pragma Inline (Is_New_Page);
- -- MANPAGE(`form_fieldtype.3x')
-
- type Field_Type is abstract tagged null record;
- type Field_Type_Access is access all Field_Type'Class;
-
- function Native_Type (Ftype : Field_Type)
- return C_Field_Type is abstract;
- -- This function returns the C libraries handle to the field type.
- -- May be you need this if you want to interface to lower level
- -- routines in the form library.
-
- -- ANCHOR(`set_field_type()',`Set_Type')
- procedure Set_Type (Fld : in Field;
- Fld_Type : in Field_Type) is abstract;
- -- AKA
- -- But: we hide the vararg mechanism of the C interface. You always
- -- have to pass a single Field_Type parameter.
-
- type C_Defined_Field_Type is abstract new Field_Type with null record;
- -- This is the root of all field typed defined in C, i.e. this are
- -- the predefined field types in the form library.
-
- type Alpha_Field is new C_Defined_Field_Type
- with record
- Minimum_Field_Width : Natural := 0;
- end record;
- procedure Set_Type (Fld : in Field;
- Fld_Type : in Alpha_Field);
- function Native_Type (Ftype : Alpha_Field)
- return C_Field_Type;
-
- type Alpha_Numeric_Field is new C_Defined_Field_Type with
- record
- Minimum_Field_Width : Natural := 0;
- end record;
- procedure Set_Type (Fld : in Field;
- Fld_Type : in Alpha_Numeric_Field);
- function Native_Type (Ftype : Alpha_Numeric_Field)
- return C_Field_Type;
-
- type Integer_Field is new C_Defined_Field_Type with
- record
- Precision : Natural;
- Lower_Limit : Integer;
- Upper_Limit : Integer;
- end record;
- procedure Set_Type (Fld : in Field;
- Fld_Type : in Integer_Field);
- function Native_Type (Ftype : Integer_Field)
- return C_Field_Type;
-
- type Numeric_Field is new C_Defined_Field_Type with
- record
- Precision : Natural;
- Lower_Limit : Float;
- Upper_Limit : Float;
- end record;
- procedure Set_Type (Fld : in Field;
- Fld_Type : in Numeric_Field);
- function Native_Type (Ftype : Numeric_Field)
- return C_Field_Type;
-
- type String_Access is access String;
-
- type Regular_Expression_Field is new C_Defined_Field_Type with
- record
- Regular_Expression : String_Access;
- end record;
- procedure Set_Type (Fld : in Field;
- Fld_Type : in Regular_Expression_Field);
- function Native_Type (Ftype : Regular_Expression_Field)
- return C_Field_Type;
-
- type Enum_Array is array (Positive range <>)
- of String_Access;
-
- type Enumeration_Info (C : Positive) is
- record
- Names : Enum_Array (1 .. C);
- Case_Sensitive : Boolean := False;
- Match_Must_Be_Unique : Boolean := False;
- end record;
-
- type Enumeration_Field is new C_Defined_Field_Type with private;
-
- function Create (Info : Enumeration_Info;
- Auto_Release_Names : Boolean := False)
- return Enumeration_Field;
- -- Make an fieldtype from the info. Enumerations are special, because
- -- they normally don't copy the enum values into a private store, so
- -- we have to care for the lifetime of the info we provide.
- -- The Auto_Release_Names flag may be used to automatically releases
- -- the strings in the Names array of the Enumeration_Info.
-
- function Make_Enumeration_Type (Info : Enumeration_Info;
- Auto_Release_Names : Boolean := False)
- return Enumeration_Field renames Create;
-
- procedure Release (Enum : in out Enumeration_Field);
- -- But we may want to release the field to release the memory allocated
- -- by it internally. After that the Enumeration field is no longer usable.
-
- procedure Set_Type (Fld : in Field;
- Fld_Type : in Enumeration_Field);
- function Native_Type (Ftype : Enumeration_Field)
- return C_Field_Type;
-
- -- The next type defintions are all ncurses extensions. They are typically
- -- not available in other curses implementations.
-
- type Internet_V4_Address_Field is new C_Defined_Field_Type
- with null record;
- procedure Set_Type (Fld : in Field;
- Fld_Type : in Internet_V4_Address_Field);
- function Native_Type (Ftype : Internet_V4_Address_Field)
- return C_Field_Type;
-
-
- type Ada_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 don't have to redefine the Set_Field_Type and
- -- Native_Field_Type methods, because they work generically on this
- -- class.
-
- procedure Set_Type (Fld : Field;
- Fld_Type : Ada_Defined_Field_Type);
-
- function Native_Type (Ftype : Ada_Defined_Field_Type)
- return C_Field_Type;
-
- -- MANPAGE(`form_field_validation.3x')
-
- -- ANCHOR(`field_type()',`Get_Type')
- function Get_Type (Fld : in Field) return Field_Type_Access;
- -- AKA
- -- ALIAS(`field_arg()')
- -- In Ada95 we can combine these
+ -- MANPAGE(`form_requestname.3x')
+ -- Not Implemented: form_request_name, form_request_by_name
------------------------------------------------------------------------------
private
+ type Field is new System.Storage_Elements.Integer_Address;
+ type Form is new System.Storage_Elements.Integer_Address;
- type Field is new System.Address;
- type Form is new System.Address;
- type C_Field_Type is new System.Address;
-
- Null_Field : constant Field := Field (System.Null_Address);
- Null_Form : constant Form := Form (System.Null_Address);
- Null_Field_Type : constant C_Field_Type :=
- C_Field_Type (System.Null_Address);
-
- type CPA_Access is access Interfaces.C.Strings.chars_ptr_array;
-
- type Enumeration_Field is new C_Defined_Field_Type with
- record
- Case_Sensitive : Boolean := False;
- Match_Must_Be_Unique : Boolean := False;
- Arr : CPA_Access := null;
- end record;
-
- -- In our binding we use the fields user pointer as hook to maintain
- -- our own info structure about the field type. To be able to still
- -- provide a user pointer, we use this wrapper.
- --
- type Field_User_Wrapper is
- record
- U : System.Address; -- the hook we provide for the user
- T : Field_Type_Access; -- may be null
- N : Natural; -- use counter
- end record;
- pragma Convention (C, Field_User_Wrapper);
- type Field_User_Wrapper_Access is access all Field_User_Wrapper;
- pragma Controlled (Field_User_Wrapper_Access);
-
- function Set_Field_Userptr (Fld : Field;
- Wrp : Field_User_Wrapper_Access)
- return Interfaces.C.int;
- pragma Import (C, Set_Field_Userptr, "set_field_userptr");
-
- function Field_Userptr (Fld : Field) return Field_User_Wrapper_Access;
- pragma Import (C, Field_Userptr, "field_userptr");
-
- -- In our binding we use the forms user pointer as hook to maintain
- -- our own info structure about the field association. To be able to still
- -- provide a user pointer, we use this wrapper.
- --
- type Form_User_Wrapper is
- record
- U : System.Address; -- the hook we provide for the user
- I : Field_Array_Access;
- end record;
- pragma Convention (C, Form_User_Wrapper);
- type Form_User_Wrapper_Access is access all Form_User_Wrapper;
- pragma Controlled (Form_User_Wrapper_Access);
-
- function Set_Form_Userptr (Frm : Form;
- Wrp : Form_User_Wrapper_Access)
- return Interfaces.C.int;
- pragma Import (C, Set_Form_Userptr, "set_form_userptr");
-
- function Form_Userptr (Frm : Form) return Form_User_Wrapper_Access;
- pragma Import (C, Form_Userptr, "form_userptr");
-
- procedure Register_Type (T : in Ada_Defined_Field_Type'Class;
- Cft : in C_Field_Type);
- procedure Unregister_Type (T : in Ada_Defined_Field_Type'Class);
- function Search_Type (T : Ada_Defined_Field_Type'Class)
- return C_Field_Type;
-
- Generation_Bit_Order : constant System.Bit_Order := System.M4_BIT_ORDER;
- -- This constant may be different on your system.
+ Null_Field : constant Field := 0;
+ Null_Form : constant Form := 0;
end Terminal_Interface.Curses.Forms;
projects / ncurses.git / blobdiff