X-Git-Url: https://ncurses.scripts.mit.edu/?p=ncurses.git;a=blobdiff_plain;f=doc%2Fhtml%2Fada%2Fterminal_interface-curses-forms__adb.htm;h=0db8b0310b26b75f48a160653b4bc9ae70792464;hp=cb5ab3110e821d27267ae4dd682b94386aae568a;hb=77afe78361875f531dc2bf8d73f2e781c8e76176;hpb=55ccd2b959766810cf7db8d1c4462f338ce0afc8;ds=sidebyside
diff --git a/doc/html/ada/terminal_interface-curses-forms__adb.htm b/doc/html/ada/terminal_interface-curses-forms__adb.htm
index cb5ab311..0db8b031 100644
--- a/doc/html/ada/terminal_interface-curses-forms__adb.htm
+++ b/doc/html/ada/terminal_interface-curses-forms__adb.htm
@@ -12,7 +12,7 @@
-- B O D Y --
-- --
------------------------------------------------------------------------------
--- Copyright (c) 1998,2004 Free Software Foundation, Inc. --
+-- Copyright (c) 1998-2008,2009 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 --
@@ -40,26 +40,26 @@
------------------------------------------------------------------------------
-- Author: Juergen Pfeifer, 1996
-- Version Control:
--- @Revision: 1.25 @
--- @Date: 2004/08/21 21:37:00 @
+-- @Revision: 1.27 @
+-- @Date: 2009/12/26 17:38:58 @
-- Binding Version 01.00
------------------------------------------------------------------------------
with Ada.Unchecked_Deallocation;
with Ada.Unchecked_Conversion;
-with Interfaces.C; use Interfaces.C;
-with Interfaces.C.Strings; use Interfaces.C.Strings;
-with Interfaces.C.Pointers;
+with Interfaces.C; use Interfaces.C;
+with Interfaces.C.Strings; use Interfaces.C.Strings;
+with Interfaces.C.Pointers;
-with Terminal_Interface.Curses.Aux;
+with Terminal_Interface.Curses.Aux;
-package body Terminal_Interface.Curses.Forms is
+package body Terminal_Interface.Curses.Forms is
- use Terminal_Interface.Curses.Aux;
+ use Terminal_Interface.Curses.Aux;
- type C_Field_Array is array (Natural range <>) of aliased Field;
- package F_Array is new
- Interfaces.C.Pointers (Natural, Field, C_Field_Array, Null_Field);
+ type C_Field_Array is array (Natural range <>) of aliased Field;
+ package F_Array is new
+ Interfaces.C.Pointers (Natural, Field, C_Field_Array, Null_Field);
------------------------------------------------------------------------------
-- |
@@ -67,35 +67,35 @@
-- |
-- subtype chars_ptr is Interfaces.C.Strings.chars_ptr;
- function FOS_2_CInt is new
- Ada.Unchecked_Conversion (Field_Option_Set,
+ function FOS_2_CInt is new
+ Ada.Unchecked_Conversion (Field_Option_Set,
C_Int);
- function CInt_2_FOS is new
+ function CInt_2_FOS is new
Ada.Unchecked_Conversion (C_Int,
- Field_Option_Set);
+ Field_Option_Set);
- function FrmOS_2_CInt is new
- Ada.Unchecked_Conversion (Form_Option_Set,
+ function FrmOS_2_CInt is new
+ Ada.Unchecked_Conversion (Form_Option_Set,
C_Int);
- function CInt_2_FrmOS is new
+ function CInt_2_FrmOS is new
Ada.Unchecked_Conversion (C_Int,
- Form_Option_Set);
+ Form_Option_Set);
- procedure Request_Name (Key : in Form_Request_Code;
+ procedure Request_Name (Key : Form_Request_Code;
Name : out String)
is
- function Form_Request_Name (Key : C_Int) return chars_ptr;
- pragma Import (C, Form_Request_Name, "form_request_name");
+ function Form_Request_Name (Key : C_Int) return chars_ptr;
+ pragma Import (C, Form_Request_Name, "form_request_name");
begin
Fill_String (Form_Request_Name (C_Int (Key)), Name);
end Request_Name;
- function Request_Name (Key : Form_Request_Code) return String
+ function Request_Name (Key : Form_Request_Code) return String
is
- function Form_Request_Name (Key : C_Int) return chars_ptr;
- pragma Import (C, Form_Request_Name, "form_request_name");
+ function Form_Request_Name (Key : C_Int) return chars_ptr;
+ pragma Import (C, Form_Request_Name, "form_request_name");
begin
return Fill_String (Form_Request_Name (C_Int (Key)));
end Request_Name;
@@ -115,17 +115,17 @@
Top : Line_Position;
Left : Column_Position;
Off_Screen : Natural := 0;
- More_Buffers : Buffer_Number := Buffer_Number'First)
- return Field
+ More_Buffers : Buffer_Number := Buffer_Number'First)
+ return Field
is
- function Newfield (H, W, T, L, O, M : C_Int) return Field;
- pragma Import (C, Newfield, "new_field");
- Fld : constant Field := Newfield (C_Int (Height), C_Int (Width),
+ function Newfield (H, W, T, L, O, M : C_Int) return Field;
+ pragma Import (C, Newfield, "new_field");
+ Fld : constant Field := Newfield (C_Int (Height), C_Int (Width),
C_Int (Top), C_Int (Left),
C_Int (Off_Screen),
C_Int (More_Buffers));
begin
- if Fld = Null_Field then
+ if Fld = Null_Field then
raise Form_Exception;
end if;
return Fld;
@@ -133,10 +133,10 @@
-- |
-- |
-- |
- procedure Delete (Fld : in out Field)
+ procedure Delete (Fld : in out Field)
is
- function Free_Field (Fld : Field) return C_Int;
- pragma Import (C, Free_Field, "free_field");
+ function Free_Field (Fld : Field) return C_Int;
+ pragma Import (C, Free_Field, "free_field");
Res : Eti_Error;
begin
@@ -144,25 +144,25 @@
if Res /= E_Ok then
Eti_Exception (Res);
end if;
- Fld := Null_Field;
+ Fld := Null_Field;
end Delete;
-- |
-- |
-- |
- function Duplicate (Fld : Field;
+ function Duplicate (Fld : Field;
Top : Line_Position;
- Left : Column_Position) return Field
+ Left : Column_Position) return Field
is
- function Dup_Field (Fld : Field;
- Top : C_Int;
- Left : C_Int) return Field;
- pragma Import (C, Dup_Field, "dup_field");
+ function Dup_Field (Fld : Field;
+ Top : C_Int;
+ Left : C_Int) return Field;
+ pragma Import (C, Dup_Field, "dup_field");
- F : constant Field := Dup_Field (Fld,
+ F : constant Field := Dup_Field (Fld,
C_Int (Top),
C_Int (Left));
begin
- if F = Null_Field then
+ if F = Null_Field then
raise Form_Exception;
end if;
return F;
@@ -170,20 +170,20 @@
-- |
-- |
-- |
- function Link (Fld : Field;
+ function Link (Fld : Field;
Top : Line_Position;
- Left : Column_Position) return Field
+ Left : Column_Position) return Field
is
- function Lnk_Field (Fld : Field;
- Top : C_Int;
- Left : C_Int) return Field;
- pragma Import (C, Lnk_Field, "link_field");
+ function Lnk_Field (Fld : Field;
+ Top : C_Int;
+ Left : C_Int) return Field;
+ pragma Import (C, Lnk_Field, "link_field");
- F : constant Field := Lnk_Field (Fld,
+ F : constant Field := Lnk_Field (Fld,
C_Int (Top),
C_Int (Left));
begin
- if F = Null_Field then
+ if F = Null_Field then
raise Form_Exception;
end if;
return F;
@@ -195,16 +195,16 @@
-- |
-- |
-- |
- procedure Set_Justification (Fld : in Field;
- Just : in Field_Justification := None)
+ procedure Set_Justification (Fld : Field;
+ Just : Field_Justification := None)
is
- function Set_Field_Just (Fld : Field;
- Just : C_Int) return C_Int;
- pragma Import (C, Set_Field_Just, "set_field_just");
+ function Set_Field_Just (Fld : Field;
+ Just : C_Int) return C_Int;
+ pragma Import (C, Set_Field_Just, "set_field_just");
Res : constant Eti_Error :=
Set_Field_Just (Fld,
- C_Int (Field_Justification'Pos (Just)));
+ C_Int (Field_Justification'Pos (Just)));
begin
if Res /= E_Ok then
Eti_Exception (Res);
@@ -213,12 +213,12 @@
-- |
-- |
-- |
- function Get_Justification (Fld : Field) return Field_Justification
+ function Get_Justification (Fld : Field) return Field_Justification
is
- function Field_Just (Fld : Field) return C_Int;
- pragma Import (C, Field_Just, "field_just");
+ function Field_Just (Fld : Field) return C_Int;
+ pragma Import (C, Field_Just, "field_just");
begin
- return Field_Justification'Val (Field_Just (Fld));
+ return Field_Justification'Val (Field_Just (Fld));
end Get_Justification;
-- |
-- |=====================================================================
@@ -228,16 +228,16 @@
-- |
-- |
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)
is
- type Char_Ptr is access all Interfaces.C.char;
- function Set_Fld_Buffer (Fld : Field;
- Bufnum : C_Int;
- S : Char_Ptr)
+ type Char_Ptr is access all Interfaces.C.char;
+ function Set_Fld_Buffer (Fld : Field;
+ Bufnum : C_Int;
+ S : Char_Ptr)
return C_Int;
- pragma Import (C, Set_Fld_Buffer, "set_field_buffer");
+ pragma Import (C, Set_Fld_Buffer, "set_field_buffer");
Txt : char_array (0 .. Str'Length);
Len : size_t;
@@ -253,36 +253,36 @@
-- |
-- |
procedure Get_Buffer
- (Fld : in Field;
- Buffer : in Buffer_Number := Buffer_Number'First;
+ (Fld : Field;
+ Buffer : Buffer_Number := Buffer_Number'First;
Str : out String)
is
- function Field_Buffer (Fld : Field;
- B : C_Int) return chars_ptr;
- pragma Import (C, Field_Buffer, "field_buffer");
+ function Field_Buffer (Fld : Field;
+ B : C_Int) return chars_ptr;
+ pragma Import (C, Field_Buffer, "field_buffer");
begin
Fill_String (Field_Buffer (Fld, C_Int (Buffer)), Str);
end Get_Buffer;
function Get_Buffer
- (Fld : in Field;
- Buffer : in Buffer_Number := Buffer_Number'First) return String
+ (Fld : Field;
+ Buffer : Buffer_Number := Buffer_Number'First) return String
is
- function Field_Buffer (Fld : Field;
- B : C_Int) return chars_ptr;
- pragma Import (C, Field_Buffer, "field_buffer");
+ function Field_Buffer (Fld : Field;
+ B : C_Int) return chars_ptr;
+ pragma Import (C, Field_Buffer, "field_buffer");
begin
return Fill_String (Field_Buffer (Fld, C_Int (Buffer)));
end Get_Buffer;
-- |
-- |
-- |
- procedure Set_Status (Fld : in Field;
- Status : in Boolean := True)
+ procedure Set_Status (Fld : Field;
+ Status : Boolean := True)
is
- function Set_Fld_Status (Fld : Field;
- St : C_Int) return C_Int;
- pragma Import (C, Set_Fld_Status, "set_field_status");
+ function Set_Fld_Status (Fld : Field;
+ St : C_Int) return C_Int;
+ pragma Import (C, Set_Fld_Status, "set_field_status");
Res : constant Eti_Error := Set_Fld_Status (Fld, Boolean'Pos (Status));
begin
@@ -293,10 +293,10 @@
-- |
-- |
-- |
- function Changed (Fld : Field) return Boolean
+ function Changed (Fld : Field) return Boolean
is
- function Field_Status (Fld : Field) return C_Int;
- pragma Import (C, Field_Status, "field_status");
+ function Field_Status (Fld : Field) return C_Int;
+ pragma Import (C, Field_Status, "field_status");
Res : constant C_Int := Field_Status (Fld);
begin
@@ -309,12 +309,12 @@
-- |
-- |
-- |
- procedure Set_Maximum_Size (Fld : in Field;
- Max : in Natural := 0)
+ procedure Set_Maximum_Size (Fld : Field;
+ Max : Natural := 0)
is
- function Set_Field_Max (Fld : Field;
- M : C_Int) return C_Int;
- pragma Import (C, Set_Field_Max, "set_max_field");
+ function Set_Field_Max (Fld : Field;
+ M : C_Int) return C_Int;
+ pragma Import (C, Set_Field_Max, "set_max_field");
Res : constant Eti_Error := Set_Field_Max (Fld, C_Int (Max));
begin
@@ -329,14 +329,14 @@
-- |
-- |
-- |
- procedure Set_Options (Fld : in Field;
- Options : in Field_Option_Set)
+ procedure Set_Options (Fld : Field;
+ Options : Field_Option_Set)
is
- function Set_Field_Opts (Fld : Field;
- Opt : C_Int) return C_Int;
- pragma Import (C, Set_Field_Opts, "set_field_opts");
+ function Set_Field_Opts (Fld : Field;
+ Opt : C_Int) return C_Int;
+ pragma Import (C, Set_Field_Opts, "set_field_opts");
- Opt : constant C_Int := FOS_2_CInt (Options);
+ Opt : constant C_Int := FOS_2_CInt (Options);
Res : Eti_Error;
begin
Res := Set_Field_Opts (Fld, Opt);
@@ -347,19 +347,19 @@
-- |
-- |
-- |
- procedure Switch_Options (Fld : in Field;
- Options : in Field_Option_Set;
+ procedure Switch_Options (Fld : Field;
+ Options : Field_Option_Set;
On : Boolean := True)
is
- function Field_Opts_On (Fld : Field;
- Opt : C_Int) return C_Int;
- pragma Import (C, Field_Opts_On, "field_opts_on");
- function Field_Opts_Off (Fld : Field;
- Opt : C_Int) return C_Int;
- pragma Import (C, Field_Opts_Off, "field_opts_off");
+ function Field_Opts_On (Fld : Field;
+ Opt : C_Int) return C_Int;
+ pragma Import (C, Field_Opts_On, "field_opts_on");
+ function Field_Opts_Off (Fld : Field;
+ Opt : C_Int) return C_Int;
+ pragma Import (C, Field_Opts_Off, "field_opts_off");
Err : Eti_Error;
- Opt : constant C_Int := FOS_2_CInt (Options);
+ Opt : constant C_Int := FOS_2_CInt (Options);
begin
if On then
Err := Field_Opts_On (Fld, Opt);
@@ -373,23 +373,23 @@
-- |
-- |
-- |
- procedure Get_Options (Fld : in Field;
- Options : out Field_Option_Set)
+ procedure Get_Options (Fld : Field;
+ Options : out Field_Option_Set)
is
- function Field_Opts (Fld : Field) return C_Int;
- pragma Import (C, Field_Opts, "field_opts");
+ function Field_Opts (Fld : Field) return C_Int;
+ pragma Import (C, Field_Opts, "field_opts");
Res : constant C_Int := Field_Opts (Fld);
begin
- Options := CInt_2_FOS (Res);
+ Options := CInt_2_FOS (Res);
end Get_Options;
-- |
-- |
-- |
- function Get_Options (Fld : Field := Null_Field)
- return Field_Option_Set
+ function Get_Options (Fld : Field := Null_Field)
+ return Field_Option_Set
is
- Fos : Field_Option_Set;
+ Fos : Field_Option_Set;
begin
Get_Options (Fld, Fos);
return Fos;
@@ -402,19 +402,19 @@
-- |
-- |
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)
is
- function Set_Field_Fore (Fld : Field;
- Attr : C_Chtype) return C_Int;
- pragma Import (C, Set_Field_Fore, "set_field_fore");
+ function Set_Field_Fore (Fld : Field;
+ Attr : C_Chtype) return C_Int;
+ pragma Import (C, Set_Field_Fore, "set_field_fore");
- Ch : constant Attributed_Character := (Ch => Character'First,
- Color => Color,
- Attr => Fore);
+ Ch : constant Attributed_Character := (Ch => Character'First,
+ Color => Color,
+ Attr => Fore);
Res : constant Eti_Error :=
- Set_Field_Fore (Fld, AttrChar_To_Chtype (Ch));
+ Set_Field_Fore (Fld, AttrChar_To_Chtype (Ch));
begin
if Res /= E_Ok then
Eti_Exception (Res);
@@ -423,42 +423,42 @@
-- |
-- |
-- |
- procedure Foreground (Fld : in Field;
+ procedure Foreground (Fld : Field;
Fore : out Character_Attribute_Set)
is
- function Field_Fore (Fld : Field) return C_Chtype;
- pragma Import (C, Field_Fore, "field_fore");
+ function Field_Fore (Fld : Field) return C_Chtype;
+ pragma Import (C, Field_Fore, "field_fore");
begin
- Fore := Chtype_To_AttrChar (Field_Fore (Fld)).Attr;
+ Fore := Chtype_To_AttrChar (Field_Fore (Fld)).Attr;
end Foreground;
- procedure Foreground (Fld : in Field;
+ procedure Foreground (Fld : Field;
Fore : out Character_Attribute_Set;
Color : out Color_Pair)
is
- function Field_Fore (Fld : Field) return C_Chtype;
- pragma Import (C, Field_Fore, "field_fore");
+ function Field_Fore (Fld : Field) return C_Chtype;
+ pragma Import (C, Field_Fore, "field_fore");
begin
- Fore := Chtype_To_AttrChar (Field_Fore (Fld)).Attr;
- Color := Chtype_To_AttrChar (Field_Fore (Fld)).Color;
+ Fore := Chtype_To_AttrChar (Field_Fore (Fld)).Attr;
+ Color := Chtype_To_AttrChar (Field_Fore (Fld)).Color;
end Foreground;
-- |
-- |
-- |
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)
is
- function Set_Field_Back (Fld : Field;
- Attr : C_Chtype) return C_Int;
- pragma Import (C, Set_Field_Back, "set_field_back");
+ function Set_Field_Back (Fld : Field;
+ Attr : C_Chtype) return C_Int;
+ pragma Import (C, Set_Field_Back, "set_field_back");
- Ch : constant Attributed_Character := (Ch => Character'First,
- Color => Color,
- Attr => Back);
+ Ch : constant Attributed_Character := (Ch => Character'First,
+ Color => Color,
+ Attr => Back);
Res : constant Eti_Error :=
- Set_Field_Back (Fld, AttrChar_To_Chtype (Ch));
+ Set_Field_Back (Fld, AttrChar_To_Chtype (Ch));
begin
if Res /= E_Ok then
Eti_Exception (Res);
@@ -467,34 +467,34 @@
-- |
-- |
-- |
- procedure Background (Fld : in Field;
+ procedure Background (Fld : Field;
Back : out Character_Attribute_Set)
is
- function Field_Back (Fld : Field) return C_Chtype;
- pragma Import (C, Field_Back, "field_back");
+ function Field_Back (Fld : Field) return C_Chtype;
+ pragma Import (C, Field_Back, "field_back");
begin
- Back := Chtype_To_AttrChar (Field_Back (Fld)).Attr;
+ Back := Chtype_To_AttrChar (Field_Back (Fld)).Attr;
end Background;
- procedure Background (Fld : in Field;
+ procedure Background (Fld : Field;
Back : out Character_Attribute_Set;
Color : out Color_Pair)
is
- function Field_Back (Fld : Field) return C_Chtype;
- pragma Import (C, Field_Back, "field_back");
+ function Field_Back (Fld : Field) return C_Chtype;
+ pragma Import (C, Field_Back, "field_back");
begin
- Back := Chtype_To_AttrChar (Field_Back (Fld)).Attr;
- Color := Chtype_To_AttrChar (Field_Back (Fld)).Color;
+ Back := Chtype_To_AttrChar (Field_Back (Fld)).Attr;
+ Color := Chtype_To_AttrChar (Field_Back (Fld)).Color;
end Background;
-- |
-- |
-- |
- procedure Set_Pad_Character (Fld : in Field;
- Pad : in Character := Space)
+ procedure Set_Pad_Character (Fld : Field;
+ Pad : Character := Space)
is
- function Set_Field_Pad (Fld : Field;
- Ch : C_Int) return C_Int;
- pragma Import (C, Set_Field_Pad, "set_field_pad");
+ function Set_Field_Pad (Fld : Field;
+ Ch : C_Int) return C_Int;
+ pragma Import (C, Set_Field_Pad, "set_field_pad");
Res : constant Eti_Error := Set_Field_Pad (Fld,
C_Int (Character'Pos (Pad)));
@@ -506,11 +506,11 @@
-- |
-- |
-- |
- procedure Pad_Character (Fld : in Field;
+ procedure Pad_Character (Fld : Field;
Pad : out Character)
is
- function Field_Pad (Fld : Field) return C_Int;
- pragma Import (C, Field_Pad, "field_pad");
+ function Field_Pad (Fld : Field) return C_Int;
+ pragma Import (C, Field_Pad, "field_pad");
begin
Pad := Character'Val (Field_Pad (Fld));
end Pad_Character;
@@ -521,19 +521,19 @@
-- |
-- |
-- |
- procedure Info (Fld : in Field;
+ procedure Info (Fld : Field;
Lines : out Line_Count;
Columns : out Column_Count;
First_Row : out Line_Position;
First_Column : out Column_Position;
Off_Screen : out Natural;
- Additional_Buffers : out Buffer_Number)
+ Additional_Buffers : out Buffer_Number)
is
type C_Int_Access is access all C_Int;
- function Fld_Info (Fld : Field;
- L, C, Fr, Fc, Os, Ab : C_Int_Access)
+ function Fld_Info (Fld : Field;
+ L, C, Fr, Fc, Os, Ab : C_Int_Access)
return C_Int;
- pragma Import (C, Fld_Info, "field_info");
+ pragma Import (C, Fld_Info, "field_info");
L, C, Fr, Fc, Os, Ab : aliased C_Int;
Res : constant Eti_Error := Fld_Info (Fld,
@@ -549,20 +549,20 @@
First_Row := Line_Position (Fr);
First_Column := Column_Position (Fc);
Off_Screen := Natural (Os);
- Additional_Buffers := Buffer_Number (Ab);
+ Additional_Buffers := Buffer_Number (Ab);
end if;
end Info;
-- |
-- |
-- |
- procedure Dynamic_Info (Fld : in Field;
+ procedure Dynamic_Info (Fld : Field;
Lines : out Line_Count;
Columns : out Column_Count;
Max : out Natural)
is
type C_Int_Access is access all C_Int;
- function Dyn_Info (Fld : Field; L, C, M : C_Int_Access) return C_Int;
- pragma Import (C, Dyn_Info, "dynamic_field_info");
+ function Dyn_Info (Fld : Field; L, C, M : C_Int_Access) return C_Int;
+ pragma Import (C, Dyn_Info, "dynamic_field_info");
L, C, M : aliased C_Int;
Res : constant Eti_Error := Dyn_Info (Fld,
@@ -584,12 +584,12 @@
-- |
-- |
-- |
- procedure Set_Window (Frm : in Form;
- Win : in Window)
+ procedure Set_Window (Frm : Form;
+ Win : Window)
is
- function Set_Form_Win (Frm : Form;
- Win : Window) return C_Int;
- pragma Import (C, Set_Form_Win, "set_form_win");
+ function Set_Form_Win (Frm : Form;
+ Win : Window) return C_Int;
+ pragma Import (C, Set_Form_Win, "set_form_win");
Res : constant Eti_Error := Set_Form_Win (Frm, Win);
begin
@@ -600,10 +600,10 @@
-- |
-- |
-- |
- function Get_Window (Frm : Form) return Window
+ function Get_Window (Frm : Form) return Window
is
- function Form_Win (Frm : Form) return Window;
- pragma Import (C, Form_Win, "form_win");
+ function Form_Win (Frm : Form) return Window;
+ pragma Import (C, Form_Win, "form_win");
W : constant Window := Form_Win (Frm);
begin
@@ -612,12 +612,12 @@
-- |
-- |
-- |
- procedure Set_Sub_Window (Frm : in Form;
- Win : in Window)
+ procedure Set_Sub_Window (Frm : Form;
+ Win : Window)
is
- function Set_Form_Sub (Frm : Form;
- Win : Window) return C_Int;
- pragma Import (C, Set_Form_Sub, "set_form_sub");
+ function Set_Form_Sub (Frm : Form;
+ Win : Window) return C_Int;
+ pragma Import (C, Set_Form_Sub, "set_form_sub");
Res : constant Eti_Error := Set_Form_Sub (Frm, Win);
begin
@@ -628,10 +628,10 @@
-- |
-- |
-- |
- function Get_Sub_Window (Frm : Form) return Window
+ function Get_Sub_Window (Frm : Form) return Window
is
- function Form_Sub (Frm : Form) return Window;
- pragma Import (C, Form_Sub, "form_sub");
+ function Form_Sub (Frm : Form) return Window;
+ pragma Import (C, Form_Sub, "form_sub");
W : constant Window := Form_Sub (Frm);
begin
@@ -640,13 +640,13 @@
-- |
-- |
-- |
- procedure Scale (Frm : in Form;
+ procedure Scale (Frm : Form;
Lines : out Line_Count;
Columns : out Column_Count)
is
type C_Int_Access is access all C_Int;
- function M_Scale (Frm : Form; Yp, Xp : C_Int_Access) return C_Int;
- pragma Import (C, M_Scale, "scale_form");
+ function M_Scale (Frm : Form; Yp, Xp : C_Int_Access) return C_Int;
+ pragma Import (C, M_Scale, "scale_form");
X, Y : aliased C_Int;
Res : constant Eti_Error := M_Scale (Frm, Y'Access, X'Access);
@@ -664,12 +664,12 @@
-- |
-- |
-- |
- procedure Set_Field_Init_Hook (Frm : in Form;
- Proc : in Form_Hook_Function)
+ procedure Set_Field_Init_Hook (Frm : Form;
+ Proc : Form_Hook_Function)
is
- function Set_Field_Init (Frm : Form;
- Proc : Form_Hook_Function) return C_Int;
- pragma Import (C, Set_Field_Init, "set_field_init");
+ function Set_Field_Init (Frm : Form;
+ Proc : Form_Hook_Function) return C_Int;
+ pragma Import (C, Set_Field_Init, "set_field_init");
Res : constant Eti_Error := Set_Field_Init (Frm, Proc);
begin
@@ -680,12 +680,12 @@
-- |
-- |
-- |
- procedure Set_Field_Term_Hook (Frm : in Form;
- Proc : in Form_Hook_Function)
+ procedure Set_Field_Term_Hook (Frm : Form;
+ Proc : Form_Hook_Function)
is
- function Set_Field_Term (Frm : Form;
- Proc : Form_Hook_Function) return C_Int;
- pragma Import (C, Set_Field_Term, "set_field_term");
+ function Set_Field_Term (Frm : Form;
+ Proc : Form_Hook_Function) return C_Int;
+ pragma Import (C, Set_Field_Term, "set_field_term");
Res : constant Eti_Error := Set_Field_Term (Frm, Proc);
begin
@@ -696,12 +696,12 @@
-- |
-- |
-- |
- procedure Set_Form_Init_Hook (Frm : in Form;
- Proc : in Form_Hook_Function)
+ procedure Set_Form_Init_Hook (Frm : Form;
+ Proc : Form_Hook_Function)
is
- function Set_Form_Init (Frm : Form;
- Proc : Form_Hook_Function) return C_Int;
- pragma Import (C, Set_Form_Init, "set_form_init");
+ function Set_Form_Init (Frm : Form;
+ Proc : Form_Hook_Function) return C_Int;
+ pragma Import (C, Set_Form_Init, "set_form_init");
Res : constant Eti_Error := Set_Form_Init (Frm, Proc);
begin
@@ -712,12 +712,12 @@
-- |
-- |
-- |
- procedure Set_Form_Term_Hook (Frm : in Form;
- Proc : in Form_Hook_Function)
+ procedure Set_Form_Term_Hook (Frm : Form;
+ Proc : Form_Hook_Function)
is
- function Set_Form_Term (Frm : Form;
- Proc : Form_Hook_Function) return C_Int;
- pragma Import (C, Set_Form_Term, "set_form_term");
+ function Set_Form_Term (Frm : Form;
+ Proc : Form_Hook_Function) return C_Int;
+ pragma Import (C, Set_Form_Term, "set_form_term");
Res : constant Eti_Error := Set_Form_Term (Frm, Proc);
begin
@@ -732,17 +732,17 @@
-- |
-- |
-- |
- procedure Redefine (Frm : in Form;
- Flds : in Field_Array_Access)
+ procedure Redefine (Frm : Form;
+ Flds : Field_Array_Access)
is
- function Set_Frm_Fields (Frm : Form;
- Items : System.Address) return C_Int;
- pragma Import (C, Set_Frm_Fields, "set_form_fields");
+ function Set_Frm_Fields (Frm : Form;
+ Items : System.Address) return C_Int;
+ pragma Import (C, Set_Frm_Fields, "set_form_fields");
Res : Eti_Error;
begin
- pragma Assert (Flds (Flds'Last) = Null_Field);
- if Flds (Flds'Last) /= Null_Field then
+ pragma Assert (Flds (Flds'Last) = Null_Field);
+ if Flds (Flds'Last) /= Null_Field then
raise Form_Exception;
else
Res := Set_Frm_Fields (Frm, Flds (Flds'First)'Address);
@@ -754,42 +754,42 @@
-- |
-- |
-- |
- function Fields (Frm : Form;
- Index : Positive) return Field
+ function Fields (Frm : Form;
+ Index : Positive) return Field
is
- use F_Array;
+ use F_Array;
- function C_Fields (Frm : Form) return Pointer;
- pragma Import (C, C_Fields, "form_fields");
+ function C_Fields (Frm : Form) return Pointer;
+ pragma Import (C, C_Fields, "form_fields");
- P : Pointer := C_Fields (Frm);
+ P : Pointer := C_Fields (Frm);
begin
- if P = null or else Index not in 1 .. Field_Count (Frm) then
+ if P = null or else Index > Field_Count (Frm) then
raise Form_Exception;
else
- P := P + ptrdiff_t (C_Int (Index) - 1);
- return P.all;
+ P := P + ptrdiff_t (C_Int (Index) - 1);
+ return P.all;
end if;
end Fields;
-- |
-- |
-- |
- function Field_Count (Frm : Form) return Natural
+ function Field_Count (Frm : Form) return Natural
is
- function Count (Frm : Form) return C_Int;
- pragma Import (C, Count, "field_count");
+ function Count (Frm : Form) return C_Int;
+ pragma Import (C, Count, "field_count");
begin
return Natural (Count (Frm));
end Field_Count;
-- |
-- |
-- |
- procedure Move (Fld : in Field;
- Line : in Line_Position;
- Column : in Column_Position)
+ procedure Move (Fld : Field;
+ Line : Line_Position;
+ Column : Column_Position)
is
- function Move (Fld : Field; L, C : C_Int) return C_Int;
- pragma Import (C, Move, "move_field");
+ function Move (Fld : Field; L, C : C_Int) return C_Int;
+ pragma Import (C, Move, "move_field");
Res : constant Eti_Error := Move (Fld, C_Int (Line), C_Int (Column));
begin
@@ -804,19 +804,19 @@
-- |
-- |
-- |
- function Create (Fields : Field_Array_Access) return Form
+ function Create (Fields : Field_Array_Access) return Form
is
- function NewForm (Fields : System.Address) return Form;
- pragma Import (C, NewForm, "new_form");
+ function NewForm (Fields : System.Address) return Form;
+ pragma Import (C, NewForm, "new_form");
- M : Form;
+ M : Form;
begin
- pragma Assert (Fields (Fields'Last) = Null_Field);
- if Fields (Fields'Last) /= Null_Field then
+ pragma Assert (Fields (Fields'Last) = Null_Field);
+ if Fields (Fields'Last) /= Null_Field then
raise Form_Exception;
else
M := NewForm (Fields (Fields'First)'Address);
- if M = Null_Form then
+ if M = Null_Form then
raise Form_Exception;
end if;
return M;
@@ -825,17 +825,17 @@
-- |
-- |
-- |
- procedure Delete (Frm : in out Form)
+ procedure Delete (Frm : in out Form)
is
- function Free (Frm : Form) return C_Int;
- pragma Import (C, Free, "free_form");
+ function Free (Frm : Form) return C_Int;
+ pragma Import (C, Free, "free_form");
Res : constant Eti_Error := Free (Frm);
begin
if Res /= E_Ok then
Eti_Exception (Res);
end if;
- Frm := Null_Form;
+ Frm := Null_Form;
end Delete;
-- |
-- |=====================================================================
@@ -844,14 +844,14 @@
-- |
-- |
-- |
- procedure Set_Options (Frm : in Form;
- Options : in Form_Option_Set)
+ procedure Set_Options (Frm : Form;
+ Options : Form_Option_Set)
is
- function Set_Form_Opts (Frm : Form;
- Opt : C_Int) return C_Int;
- pragma Import (C, Set_Form_Opts, "set_form_opts");
+ function Set_Form_Opts (Frm : Form;
+ Opt : C_Int) return C_Int;
+ pragma Import (C, Set_Form_Opts, "set_form_opts");
- Opt : constant C_Int := FrmOS_2_CInt (Options);
+ Opt : constant C_Int := FrmOS_2_CInt (Options);
Res : Eti_Error;
begin
Res := Set_Form_Opts (Frm, Opt);
@@ -862,19 +862,19 @@
-- |
-- |
-- |
- procedure Switch_Options (Frm : in Form;
- Options : in Form_Option_Set;
+ procedure Switch_Options (Frm : Form;
+ Options : Form_Option_Set;
On : Boolean := True)
is
- function Form_Opts_On (Frm : Form;
- Opt : C_Int) return C_Int;
- pragma Import (C, Form_Opts_On, "form_opts_on");
- function Form_Opts_Off (Frm : Form;
- Opt : C_Int) return C_Int;
- pragma Import (C, Form_Opts_Off, "form_opts_off");
+ function Form_Opts_On (Frm : Form;
+ Opt : C_Int) return C_Int;
+ pragma Import (C, Form_Opts_On, "form_opts_on");
+ function Form_Opts_Off (Frm : Form;
+ Opt : C_Int) return C_Int;
+ pragma Import (C, Form_Opts_Off, "form_opts_off");
Err : Eti_Error;
- Opt : constant C_Int := FrmOS_2_CInt (Options);
+ Opt : constant C_Int := FrmOS_2_CInt (Options);
begin
if On then
Err := Form_Opts_On (Frm, Opt);
@@ -888,22 +888,22 @@
-- |
-- |
-- |
- procedure Get_Options (Frm : in Form;
- Options : out Form_Option_Set)
+ procedure Get_Options (Frm : Form;
+ Options : out Form_Option_Set)
is
- function Form_Opts (Frm : Form) return C_Int;
- pragma Import (C, Form_Opts, "form_opts");
+ function Form_Opts (Frm : Form) return C_Int;
+ pragma Import (C, Form_Opts, "form_opts");
Res : constant C_Int := Form_Opts (Frm);
begin
- Options := CInt_2_FrmOS (Res);
+ Options := CInt_2_FrmOS (Res);
end Get_Options;
-- |
-- |
-- |
- function Get_Options (Frm : Form := Null_Form) return Form_Option_Set
+ function Get_Options (Frm : Form := Null_Form) return Form_Option_Set
is
- Fos : Form_Option_Set;
+ Fos : Form_Option_Set;
begin
Get_Options (Frm, Fos);
return Fos;
@@ -915,13 +915,13 @@
-- |
-- |
-- |
- procedure Post (Frm : in Form;
- Post : in Boolean := True)
+ procedure Post (Frm : Form;
+ Post : Boolean := True)
is
- function M_Post (Frm : Form) return C_Int;
- pragma Import (C, M_Post, "post_form");
- function M_Unpost (Frm : Form) return C_Int;
- pragma Import (C, M_Unpost, "unpost_form");
+ function M_Post (Frm : Form) return C_Int;
+ pragma Import (C, M_Post, "post_form");
+ function M_Unpost (Frm : Form) return C_Int;
+ pragma Import (C, M_Unpost, "unpost_form");
Res : Eti_Error;
begin
@@ -941,10 +941,10 @@
-- |
-- |
-- |
- procedure Position_Cursor (Frm : Form)
+ procedure Position_Cursor (Frm : Form)
is
- function Pos_Form_Cursor (Frm : Form) return C_Int;
- pragma Import (C, Pos_Form_Cursor, "pos_form_cursor");
+ function Pos_Form_Cursor (Frm : Form) return C_Int;
+ pragma Import (C, Pos_Form_Cursor, "pos_form_cursor");
Res : constant Eti_Error := Pos_Form_Cursor (Frm);
begin
@@ -959,10 +959,10 @@
-- |
-- |
-- |
- function Data_Ahead (Frm : Form) return Boolean
+ function Data_Ahead (Frm : Form) return Boolean
is
- function Ahead (Frm : Form) return C_Int;
- pragma Import (C, Ahead, "data_ahead");
+ function Ahead (Frm : Form) return C_Int;
+ pragma Import (C, Ahead, "data_ahead");
Res : constant C_Int := Ahead (Frm);
begin
@@ -975,10 +975,10 @@
-- |
-- |
-- |
- function Data_Behind (Frm : Form) return Boolean
+ function Data_Behind (Frm : Form) return Boolean
is
- function Behind (Frm : Form) return C_Int;
- pragma Import (C, Behind, "data_behind");
+ function Behind (Frm : Form) return C_Int;
+ pragma Import (C, Behind, "data_behind");
Res : constant C_Int := Behind (Frm);
begin
@@ -995,11 +995,11 @@
-- |
-- |
-- |
- function Driver (Frm : Form;
+ function Driver (Frm : Form;
Key : Key_Code) return Driver_Result
is
- function Frm_Driver (Frm : Form; Key : C_Int) return C_Int;
- pragma Import (C, Frm_Driver, "form_driver");
+ function Frm_Driver (Frm : Form; Key : C_Int) return C_Int;
+ pragma Import (C, Frm_Driver, "form_driver");
R : constant Eti_Error := Frm_Driver (Frm, C_Int (Key));
begin
@@ -1025,11 +1025,11 @@
-- |
-- |
-- |
- procedure Set_Current (Frm : in Form;
- Fld : in Field)
+ procedure Set_Current (Frm : Form;
+ Fld : Field)
is
- function Set_Current_Fld (Frm : Form; Fld : Field) return C_Int;
- pragma Import (C, Set_Current_Fld, "set_current_field");
+ function Set_Current_Fld (Frm : Form; Fld : Field) return C_Int;
+ pragma Import (C, Set_Current_Fld, "set_current_field");
Res : constant Eti_Error := Set_Current_Fld (Frm, Fld);
begin
@@ -1040,14 +1040,14 @@
-- |
-- |
-- |
- function Current (Frm : in Form) return Field
+ function Current (Frm : Form) return Field
is
- function Current_Fld (Frm : Form) return Field;
- pragma Import (C, Current_Fld, "current_field");
+ function Current_Fld (Frm : Form) return Field;
+ pragma Import (C, Current_Fld, "current_field");
- Fld : constant Field := Current_Fld (Frm);
+ Fld : constant Field := Current_Fld (Frm);
begin
- if Fld = Null_Field then
+ if Fld = Null_Field then
raise Form_Exception;
end if;
return Fld;
@@ -1055,11 +1055,11 @@
-- |
-- |
-- |
- procedure Set_Page (Frm : in Form;
- Page : in Page_Number := Page_Number'First)
+ procedure Set_Page (Frm : Form;
+ Page : Page_Number := Page_Number'First)
is
- function Set_Frm_Page (Frm : Form; Pg : C_Int) return C_Int;
- pragma Import (C, Set_Frm_Page, "set_form_page");
+ function Set_Frm_Page (Frm : Form; Pg : C_Int) return C_Int;
+ pragma Import (C, Set_Frm_Page, "set_form_page");
Res : constant Eti_Error := Set_Frm_Page (Frm, C_Int (Page));
begin
@@ -1070,10 +1070,10 @@
-- |
-- |
-- |
- function Page (Frm : Form) return Page_Number
+ function Page (Frm : Form) return Page_Number
is
- function Get_Page (Frm : Form) return C_Int;
- pragma Import (C, Get_Page, "form_page");
+ function Get_Page (Frm : Form) return C_Int;
+ pragma Import (C, Get_Page, "form_page");
P : constant C_Int := Get_Page (Frm);
begin
@@ -1084,10 +1084,10 @@
end if;
end Page;
- function Get_Index (Fld : Field) return Positive
+ function Get_Index (Fld : Field) return Positive
is
- function Get_Fieldindex (Fld : Field) return C_Int;
- pragma Import (C, Get_Fieldindex, "field_index");
+ function Get_Fieldindex (Fld : Field) return C_Int;
+ pragma Import (C, Get_Fieldindex, "field_index");
Res : constant C_Int := Get_Fieldindex (Fld);
begin
@@ -1104,11 +1104,11 @@
-- |
-- |
-- |
- procedure Set_New_Page (Fld : in Field;
- New_Page : in Boolean := True)
+ procedure Set_New_Page (Fld : Field;
+ New_Page : Boolean := True)
is
- function Set_Page (Fld : Field; Flg : C_Int) return C_Int;
- pragma Import (C, Set_Page, "set_new_page");
+ function Set_Page (Fld : Field; Flg : C_Int) return C_Int;
+ pragma Import (C, Set_Page, "set_new_page");
Res : constant Eti_Error := Set_Page (Fld, Boolean'Pos (New_Page));
begin
@@ -1119,10 +1119,10 @@
-- |
-- |
-- |
- function Is_New_Page (Fld : Field) return Boolean
+ function Is_New_Page (Fld : Field) return Boolean
is
- function Is_New (Fld : Field) return C_Int;
- pragma Import (C, Is_New, "new_page");
+ function Is_New (Fld : Field) return C_Int;
+ pragma Import (C, Is_New, "new_page");
Res : constant C_Int := Is_New (Fld);
begin
@@ -1133,35 +1133,35 @@
end if;
end Is_New_Page;
- procedure Free (FA : in out Field_Array_Access;
- Free_Fields : in Boolean := False)
+ procedure Free (FA : in out Field_Array_Access;
+ Free_Fields : Boolean := False)
is
- procedure Release is new Ada.Unchecked_Deallocation
- (Field_Array, Field_Array_Access);
+ procedure Release is new Ada.Unchecked_Deallocation
+ (Field_Array, Field_Array_Access);
begin
- if FA /= null and then Free_Fields then
- for I in FA'First .. (FA'Last - 1) loop
- if FA (I) /= Null_Field then
- Delete (FA (I));
+ if FA /= null and then Free_Fields then
+ for I in FA'First .. (FA'Last - 1) loop
+ if FA (I) /= Null_Field then
+ Delete (FA (I));
end if;
end loop;
end if;
- Release (FA);
- end Free;
+ Release (FA);
+ end Free;
-- |=====================================================================
- function Default_Field_Options return Field_Option_Set
+ function Default_Field_Options return Field_Option_Set
is
begin
- return Get_Options (Null_Field);
- end Default_Field_Options;
+ return Get_Options (Null_Field);
+ end Default_Field_Options;
- function Default_Form_Options return Form_Option_Set
+ function Default_Form_Options return Form_Option_Set
is
begin
- return Get_Options (Null_Form);
- end Default_Form_Options;
+ return Get_Options (Null_Form);
+ end Default_Form_Options;
-end Terminal_Interface.Curses.Forms;
+end Terminal_Interface.Curses.Forms;