X-Git-Url: https://ncurses.scripts.mit.edu/?p=ncurses.git;a=blobdiff_plain;f=Ada95%2Fgen%2Fterminal_interface-curses-forms.ads.m4;h=1293d37349411c8cbc258a46b76921eabec374d6;hp=998fdba1036efe7563d18f41627a39e73b6c9881;hb=9b4c4abadc0a29999c5ddad5aa8d769fee28d687;hpb=3a9b6a3bf0269231bef7de74757a910dedd04e0c diff --git a/Ada95/gen/terminal_interface-curses-forms.ads.m4 b/Ada95/gen/terminal_interface-curses-forms.ads.m4 index 998fdba1..1293d373 100644 --- a/Ada95/gen/terminal_interface-curses-forms.ads.m4 +++ b/Ada95/gen/terminal_interface-curses-forms.ads.m4 @@ -1,5 +1,5 @@ -- -*- ada -*- -define(`HTMLNAME',`terminal_interface-curses-forms_s.html')dnl +define(`HTMLNAME',`terminal_interface-curses-forms__ads.htm')dnl include(M4MACRO)dnl ------------------------------------------------------------------------------ -- -- @@ -9,67 +9,140 @@ include(M4MACRO)dnl -- -- -- S P E C -- -- -- --- Version 00.92 -- +------------------------------------------------------------------------------ +-- Copyright 2020 Thomas E. Dickey -- +-- Copyright 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.34 $ +-- $Date: 2020/02/02 23:34:34 $ +-- 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); @@ -205,10 +278,13 @@ include(`Form_Opt_Rep') 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 -- ------------------ @@ -225,6 +301,7 @@ include(`Form_Opt_Rep') 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; @@ -235,81 +312,100 @@ include(`Form_Opt_Rep') 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 @@ -317,59 +413,66 @@ include(`Form_Opt_Rep') 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; @@ -377,64 +480,75 @@ include(`Form_Opt_Rep') 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; @@ -459,92 +573,107 @@ include(`Form_Opt_Rep') -- 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') @@ -557,28 +686,33 @@ include(`Form_Opt_Rep') 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; @@ -586,227 +720,30 @@ include(`Form_Opt_Rep') -- 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;