X-Git-Url: http://ncurses.scripts.mit.edu/?p=ncurses.git;a=blobdiff_plain;f=doc%2Fhtml%2Fada%2Fterminal_interface-curses-forms__adb.htm;h=7820c331ce2529ea31147ee41cfea5927bde104b;hp=8909b3e6b2eec081aba5fa2865990cfc936a09eb;hb=refs%2Ftags%2Fv6.2;hpb=c55d387cebf1cee4757ca2c2ef4fbeae59ee4175 diff --git a/doc/html/ada/terminal_interface-curses-forms__adb.htm b/doc/html/ada/terminal_interface-curses-forms__adb.htm index 8909b3e6..7820c331 100644 --- a/doc/html/ada/terminal_interface-curses-forms__adb.htm +++ b/doc/html/ada/terminal_interface-curses-forms__adb.htm @@ -24,7 +24,8 @@ -- B O D Y -- -- -- ------------------------------------------------------------------------------ --- Copyright (c) 1998-2011,2014 Free Software Foundation, Inc. -- +-- Copyright 2020 Thomas E. Dickey -- +-- Copyright 1999-2011,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 -- @@ -52,8 +53,8 @@ ------------------------------------------------------------------------------ -- Author: Juergen Pfeifer, 1996 -- Version Control: --- @Revision: 1.32 @ --- @Date: 2014/05/24 21:31:05 @ +-- @Revision: 1.33 @ +-- @Date: 2020/02/02 23:34:34 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ with Ada.Unchecked_Deallocation; @@ -62,15 +63,15 @@ 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; + 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); + Interfaces.C.Pointers (Natural, Field, C_Field_Array, Null_Field); ------------------------------------------------------------------------------ -- | @@ -78,22 +79,22 @@ -- | -- subtype chars_ptr is Interfaces.C.Strings.chars_ptr; - procedure Request_Name (Key : Form_Request_Code; - Name : out String) + procedure Request_Name (Key : Form_Request_Code; + Name : out String) is - function Form_Request_Name (Key : C_Int) return chars_ptr; + 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; + 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; + 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; + return Fill_String (Form_Request_Name (C_Int (Key))); + end Request_Name; ------------------------------------------------------------------------------ -- | -- | @@ -105,80 +106,80 @@ -- | -- | -- | - function Create (Height : Line_Count; - Width : Column_Count; - Top : Line_Position; - Left : Column_Position; - Off_Screen : Natural := 0; - More_Buffers : Buffer_Number := Buffer_Number'First) - return Field + function Create (Height : Line_Count; + Width : Column_Count; + Top : Line_Position; + Left : Column_Position; + Off_Screen : Natural := 0; + More_Buffers : Buffer_Number := Buffer_Number'First) + return Field is - function Newfield (H, W, T, L, O, M : C_Int) return Field; + 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)); + 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 - raise Form_Exception; + if Fld = Null_Field then + raise Form_Exception; end if; - return Fld; - end Create; + return Fld; + end Create; -- | -- | -- | - procedure Delete (Fld : in out Field) + procedure Delete (Fld : in out Field) is - function Free_Field (Fld : Field) return Eti_Error; + function Free_Field (Fld : Field) return Eti_Error; pragma Import (C, Free_Field, "free_field"); begin - Eti_Exception (Free_Field (Fld)); - Fld := Null_Field; - end Delete; + Eti_Exception (Free_Field (Fld)); + Fld := Null_Field; + end Delete; -- | -- | -- | - function Duplicate (Fld : Field; - Top : Line_Position; - Left : Column_Position) return Field + function Duplicate (Fld : Field; + Top : Line_Position; + Left : Column_Position) return Field is - function Dup_Field (Fld : Field; - Top : C_Int; - Left : C_Int) return 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, - C_Int (Top), - C_Int (Left)); + F : constant Field := Dup_Field (Fld, + C_Int (Top), + C_Int (Left)); begin - if F = Null_Field then - raise Form_Exception; + if F = Null_Field then + raise Form_Exception; end if; - return F; - end Duplicate; + return F; + end Duplicate; -- | -- | -- | - function Link (Fld : Field; - Top : Line_Position; - Left : Column_Position) return Field + function Link (Fld : Field; + Top : Line_Position; + Left : Column_Position) return Field is - function Lnk_Field (Fld : Field; - Top : C_Int; - Left : C_Int) return 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, - C_Int (Top), - C_Int (Left)); + F : constant Field := Lnk_Field (Fld, + C_Int (Top), + C_Int (Left)); begin - if F = Null_Field then - raise Form_Exception; + if F = Null_Field then + raise Form_Exception; end if; - return F; - end Link; + return F; + end Link; -- | -- |===================================================================== -- | man page form_field_just.3x @@ -186,27 +187,27 @@ -- | -- | -- | - procedure Set_Justification (Fld : Field; - Just : Field_Justification := None) + procedure Set_Justification (Fld : Field; + Just : Field_Justification := None) is - function Set_Field_Just (Fld : Field; - Just : C_Int) return Eti_Error; + function Set_Field_Just (Fld : Field; + Just : C_Int) return Eti_Error; pragma Import (C, Set_Field_Just, "set_field_just"); begin - Eti_Exception (Set_Field_Just (Fld, - C_Int (Field_Justification'Pos (Just)))); - end Set_Justification; + Eti_Exception (Set_Field_Just (Fld, + C_Int (Field_Justification'Pos (Just)))); + end Set_Justification; -- | -- | -- | - 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; + function Field_Just (Fld : Field) return C_Int; pragma Import (C, Field_Just, "field_just"); begin - return Field_Justification'Val (Field_Just (Fld)); - end Get_Justification; + return Field_Justification'Val (Field_Just (Fld)); + end Get_Justification; -- | -- |===================================================================== -- | man page form_field_buffer.3x @@ -214,89 +215,89 @@ -- | -- | -- | - procedure Set_Buffer - (Fld : Field; - Buffer : Buffer_Number := Buffer_Number'First; - Str : String) + procedure Set_Buffer + (Fld : Field; + Buffer : Buffer_Number := Buffer_Number'First; + Str : String) is - function Set_Fld_Buffer (Fld : Field; - Bufnum : C_Int; - S : char_array) - return Eti_Error; + function Set_Fld_Buffer (Fld : Field; + Bufnum : C_Int; + S : char_array) + return Eti_Error; pragma Import (C, Set_Fld_Buffer, "set_field_buffer"); begin - Eti_Exception (Set_Fld_Buffer (Fld, C_Int (Buffer), To_C (Str))); - end Set_Buffer; + Eti_Exception (Set_Fld_Buffer (Fld, C_Int (Buffer), To_C (Str))); + end Set_Buffer; -- | -- | -- | - procedure Get_Buffer - (Fld : Field; - Buffer : Buffer_Number := Buffer_Number'First; - Str : out String) + procedure Get_Buffer + (Fld : Field; + Buffer : Buffer_Number := Buffer_Number'First; + Str : out String) is - function Field_Buffer (Fld : Field; - B : C_Int) return chars_ptr; + 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; + Fill_String (Field_Buffer (Fld, C_Int (Buffer)), Str); + end Get_Buffer; - function Get_Buffer - (Fld : Field; - Buffer : Buffer_Number := Buffer_Number'First) return String + function Get_Buffer + (Fld : Field; + Buffer : Buffer_Number := Buffer_Number'First) return String is - function Field_Buffer (Fld : Field; - B : C_Int) return chars_ptr; + 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; + return Fill_String (Field_Buffer (Fld, C_Int (Buffer))); + end Get_Buffer; -- | -- | -- | - procedure Set_Status (Fld : Field; - Status : Boolean := True) + procedure Set_Status (Fld : Field; + Status : Boolean := True) is - function Set_Fld_Status (Fld : Field; - St : C_Int) return Eti_Error; + function Set_Fld_Status (Fld : Field; + St : C_Int) return Eti_Error; pragma Import (C, Set_Fld_Status, "set_field_status"); begin - if Set_Fld_Status (Fld, Boolean'Pos (Status)) /= E_Ok then - raise Form_Exception; + if Set_Fld_Status (Fld, Boolean'Pos (Status)) /= E_Ok then + raise Form_Exception; end if; - end Set_Status; + end Set_Status; -- | -- | -- | - function Changed (Fld : Field) return Boolean + function Changed (Fld : Field) return Boolean is - function Field_Status (Fld : Field) return C_Int; + function Field_Status (Fld : Field) return C_Int; pragma Import (C, Field_Status, "field_status"); - Res : constant C_Int := Field_Status (Fld); + Res : constant C_Int := Field_Status (Fld); begin - if Res = Curses_False then + if Res = Curses_False then return False; else return True; end if; - end Changed; + end Changed; -- | -- | -- | - procedure Set_Maximum_Size (Fld : Field; - Max : Natural := 0) + procedure Set_Maximum_Size (Fld : Field; + Max : Natural := 0) is - function Set_Field_Max (Fld : Field; - M : C_Int) return Eti_Error; + function Set_Field_Max (Fld : Field; + M : C_Int) return Eti_Error; pragma Import (C, Set_Field_Max, "set_max_field"); begin - Eti_Exception (Set_Field_Max (Fld, C_Int (Max))); - end Set_Maximum_Size; + Eti_Exception (Set_Field_Max (Fld, C_Int (Max))); + end Set_Maximum_Size; -- | -- |===================================================================== -- | man page form_field_opts.3x @@ -304,60 +305,60 @@ -- | -- | -- | - procedure Set_Options (Fld : Field; - Options : Field_Option_Set) + procedure Set_Options (Fld : Field; + Options : Field_Option_Set) is - function Set_Field_Opts (Fld : Field; - Opt : Field_Option_Set) return Eti_Error; + function Set_Field_Opts (Fld : Field; + Opt : Field_Option_Set) return Eti_Error; pragma Import (C, Set_Field_Opts, "set_field_opts"); begin - Eti_Exception (Set_Field_Opts (Fld, Options)); - end Set_Options; + Eti_Exception (Set_Field_Opts (Fld, Options)); + end Set_Options; -- | -- | -- | - procedure Switch_Options (Fld : Field; - Options : Field_Option_Set; - On : Boolean := True) + procedure Switch_Options (Fld : Field; + Options : Field_Option_Set; + On : Boolean := True) is - function Field_Opts_On (Fld : Field; - Opt : Field_Option_Set) return Eti_Error; + function Field_Opts_On (Fld : Field; + Opt : Field_Option_Set) return Eti_Error; pragma Import (C, Field_Opts_On, "field_opts_on"); - function Field_Opts_Off (Fld : Field; - Opt : Field_Option_Set) return Eti_Error; + function Field_Opts_Off (Fld : Field; + Opt : Field_Option_Set) return Eti_Error; pragma Import (C, Field_Opts_Off, "field_opts_off"); begin - if On then - Eti_Exception (Field_Opts_On (Fld, Options)); + if On then + Eti_Exception (Field_Opts_On (Fld, Options)); else - Eti_Exception (Field_Opts_Off (Fld, Options)); + Eti_Exception (Field_Opts_Off (Fld, Options)); end if; - end Switch_Options; + end Switch_Options; -- | -- | -- | - procedure Get_Options (Fld : Field; - Options : out Field_Option_Set) + procedure Get_Options (Fld : Field; + Options : out Field_Option_Set) is - function Field_Opts (Fld : Field) return Field_Option_Set; + function Field_Opts (Fld : Field) return Field_Option_Set; pragma Import (C, Field_Opts, "field_opts"); begin - Options := Field_Opts (Fld); - end Get_Options; + Options := Field_Opts (Fld); + 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; - end Get_Options; + Get_Options (Fld, Fos); + return Fos; + end Get_Options; -- | -- |===================================================================== -- | man page form_field_attributes.3x @@ -365,106 +366,106 @@ -- | -- | -- | - procedure Set_Foreground - (Fld : Field; - Fore : Character_Attribute_Set := Normal_Video; - Color : Color_Pair := Color_Pair'First) + procedure Set_Foreground + (Fld : Field; + Fore : Character_Attribute_Set := Normal_Video; + Color : Color_Pair := Color_Pair'First) is - function Set_Field_Fore (Fld : Field; - Attr : Attributed_Character) return Eti_Error; + function Set_Field_Fore (Fld : Field; + Attr : Attributed_Character) return Eti_Error; pragma Import (C, Set_Field_Fore, "set_field_fore"); begin - Eti_Exception (Set_Field_Fore (Fld, (Ch => Character'First, - Color => Color, - Attr => Fore))); - end Set_Foreground; + Eti_Exception (Set_Field_Fore (Fld, (Ch => Character'First, + Color => Color, + Attr => Fore))); + end Set_Foreground; -- | -- | -- | - procedure Foreground (Fld : Field; - Fore : out Character_Attribute_Set) + procedure Foreground (Fld : Field; + Fore : out Character_Attribute_Set) is - function Field_Fore (Fld : Field) return Attributed_Character; + function Field_Fore (Fld : Field) return Attributed_Character; pragma Import (C, Field_Fore, "field_fore"); begin - Fore := Field_Fore (Fld).Attr; - end Foreground; + Fore := Field_Fore (Fld).Attr; + end Foreground; - procedure Foreground (Fld : Field; - Fore : out Character_Attribute_Set; - Color : out Color_Pair) + procedure Foreground (Fld : Field; + Fore : out Character_Attribute_Set; + Color : out Color_Pair) is - function Field_Fore (Fld : Field) return Attributed_Character; + function Field_Fore (Fld : Field) return Attributed_Character; pragma Import (C, Field_Fore, "field_fore"); begin - Fore := Field_Fore (Fld).Attr; - Color := Field_Fore (Fld).Color; - end Foreground; + Fore := Field_Fore (Fld).Attr; + Color := Field_Fore (Fld).Color; + end Foreground; -- | -- | -- | - procedure Set_Background - (Fld : Field; - Back : Character_Attribute_Set := Normal_Video; - Color : Color_Pair := Color_Pair'First) + procedure Set_Background + (Fld : Field; + Back : Character_Attribute_Set := Normal_Video; + Color : Color_Pair := Color_Pair'First) is - function Set_Field_Back (Fld : Field; - Attr : Attributed_Character) return Eti_Error; + function Set_Field_Back (Fld : Field; + Attr : Attributed_Character) return Eti_Error; pragma Import (C, Set_Field_Back, "set_field_back"); begin - Eti_Exception (Set_Field_Back (Fld, (Ch => Character'First, - Color => Color, - Attr => Back))); - end Set_Background; + Eti_Exception (Set_Field_Back (Fld, (Ch => Character'First, + Color => Color, + Attr => Back))); + end Set_Background; -- | -- | -- | - procedure Background (Fld : Field; - Back : out Character_Attribute_Set) + procedure Background (Fld : Field; + Back : out Character_Attribute_Set) is - function Field_Back (Fld : Field) return Attributed_Character; + function Field_Back (Fld : Field) return Attributed_Character; pragma Import (C, Field_Back, "field_back"); begin - Back := Field_Back (Fld).Attr; - end Background; + Back := Field_Back (Fld).Attr; + end Background; - procedure Background (Fld : Field; - Back : out Character_Attribute_Set; - Color : out Color_Pair) + procedure Background (Fld : Field; + Back : out Character_Attribute_Set; + Color : out Color_Pair) is - function Field_Back (Fld : Field) return Attributed_Character; + function Field_Back (Fld : Field) return Attributed_Character; pragma Import (C, Field_Back, "field_back"); begin - Back := Field_Back (Fld).Attr; - Color := Field_Back (Fld).Color; - end Background; + Back := Field_Back (Fld).Attr; + Color := Field_Back (Fld).Color; + end Background; -- | -- | -- | - procedure Set_Pad_Character (Fld : Field; - Pad : Character := Space) + procedure Set_Pad_Character (Fld : Field; + Pad : Character := Space) is - function Set_Field_Pad (Fld : Field; - Ch : C_Int) return Eti_Error; + function Set_Field_Pad (Fld : Field; + Ch : C_Int) return Eti_Error; pragma Import (C, Set_Field_Pad, "set_field_pad"); begin - Eti_Exception (Set_Field_Pad (Fld, - C_Int (Character'Pos (Pad)))); - end Set_Pad_Character; + Eti_Exception (Set_Field_Pad (Fld, + C_Int (Character'Pos (Pad)))); + end Set_Pad_Character; -- | -- | -- | - procedure Pad_Character (Fld : Field; - Pad : out Character) + procedure Pad_Character (Fld : Field; + Pad : out Character) is - function Field_Pad (Fld : Field) return C_Int; + 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; + Pad := Character'Val (Field_Pad (Fld)); + end Pad_Character; -- | -- |===================================================================== -- | man page form_field_info.3x @@ -472,54 +473,54 @@ -- | -- | -- | - 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) + 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) is - type C_Int_Access is access all C_Int; - function Fld_Info (Fld : Field; - L, C, Fr, Fc, Os, Ab : C_Int_Access) - return Eti_Error; + type C_Int_Access is access all C_Int; + function Fld_Info (Fld : Field; + L, C, Fr, Fc, Os, Ab : C_Int_Access) + return Eti_Error; pragma Import (C, Fld_Info, "field_info"); - L, C, Fr, Fc, Os, Ab : aliased C_Int; + L, C, Fr, Fc, Os, Ab : aliased C_Int; begin - Eti_Exception (Fld_Info (Fld, - L'Access, C'Access, - Fr'Access, Fc'Access, - Os'Access, Ab'Access)); - Lines := Line_Count (L); - Columns := Column_Count (C); - First_Row := Line_Position (Fr); - First_Column := Column_Position (Fc); - Off_Screen := Natural (Os); - Additional_Buffers := Buffer_Number (Ab); - end Info; + Eti_Exception (Fld_Info (Fld, + L'Access, C'Access, + Fr'Access, Fc'Access, + Os'Access, Ab'Access)); + Lines := Line_Count (L); + Columns := Column_Count (C); + First_Row := Line_Position (Fr); + First_Column := Column_Position (Fc); + Off_Screen := Natural (Os); + Additional_Buffers := Buffer_Number (Ab); + end Info; -- | -- | -- | - procedure Dynamic_Info (Fld : Field; - Lines : out Line_Count; - Columns : out Column_Count; - Max : out Natural) + 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 Eti_Error; + type C_Int_Access is access all C_Int; + function Dyn_Info (Fld : Field; L, C, M : C_Int_Access) return Eti_Error; pragma Import (C, Dyn_Info, "dynamic_field_info"); - L, C, M : aliased C_Int; + L, C, M : aliased C_Int; begin - Eti_Exception (Dyn_Info (Fld, - L'Access, C'Access, - M'Access)); - Lines := Line_Count (L); - Columns := Column_Count (C); - Max := Natural (M); - end Dynamic_Info; + Eti_Exception (Dyn_Info (Fld, + L'Access, C'Access, + M'Access)); + Lines := Line_Count (L); + Columns := Column_Count (C); + Max := Natural (M); + end Dynamic_Info; -- | -- |===================================================================== -- | man page form_win.3x @@ -527,70 +528,70 @@ -- | -- | -- | - procedure Set_Window (Frm : Form; - Win : Window) + procedure Set_Window (Frm : Form; + Win : Window) is - function Set_Form_Win (Frm : Form; - Win : Window) return Eti_Error; + function Set_Form_Win (Frm : Form; + Win : Window) return Eti_Error; pragma Import (C, Set_Form_Win, "set_form_win"); begin - Eti_Exception (Set_Form_Win (Frm, Win)); - end Set_Window; + Eti_Exception (Set_Form_Win (Frm, Win)); + end Set_Window; -- | -- | -- | - function Get_Window (Frm : Form) return Window + function Get_Window (Frm : Form) return Window is - function Form_Win (Frm : Form) return Window; + function Form_Win (Frm : Form) return Window; pragma Import (C, Form_Win, "form_win"); - W : constant Window := Form_Win (Frm); + W : constant Window := Form_Win (Frm); begin - return W; - end Get_Window; + return W; + end Get_Window; -- | -- | -- | - procedure Set_Sub_Window (Frm : Form; - Win : Window) + procedure Set_Sub_Window (Frm : Form; + Win : Window) is - function Set_Form_Sub (Frm : Form; - Win : Window) return Eti_Error; + function Set_Form_Sub (Frm : Form; + Win : Window) return Eti_Error; pragma Import (C, Set_Form_Sub, "set_form_sub"); begin - Eti_Exception (Set_Form_Sub (Frm, Win)); - end Set_Sub_Window; + Eti_Exception (Set_Form_Sub (Frm, Win)); + end Set_Sub_Window; -- | -- | -- | - function Get_Sub_Window (Frm : Form) return Window + function Get_Sub_Window (Frm : Form) return Window is - function Form_Sub (Frm : Form) return Window; + function Form_Sub (Frm : Form) return Window; pragma Import (C, Form_Sub, "form_sub"); - W : constant Window := Form_Sub (Frm); + W : constant Window := Form_Sub (Frm); begin - return W; - end Get_Sub_Window; + return W; + end Get_Sub_Window; -- | -- | -- | - procedure Scale (Frm : Form; - Lines : out Line_Count; - Columns : out Column_Count) + 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 Eti_Error; + type C_Int_Access is access all C_Int; + function M_Scale (Frm : Form; Yp, Xp : C_Int_Access) return Eti_Error; pragma Import (C, M_Scale, "scale_form"); - X, Y : aliased C_Int; + X, Y : aliased C_Int; begin - Eti_Exception (M_Scale (Frm, Y'Access, X'Access)); - Lines := Line_Count (Y); - Columns := Column_Count (X); - end Scale; + Eti_Exception (M_Scale (Frm, Y'Access, X'Access)); + Lines := Line_Count (Y); + Columns := Column_Count (X); + end Scale; -- | -- |===================================================================== -- | man page menu_hook.3x @@ -598,55 +599,55 @@ -- | -- | -- | - procedure Set_Field_Init_Hook (Frm : Form; - Proc : 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 Eti_Error; + function Set_Field_Init (Frm : Form; + Proc : Form_Hook_Function) return Eti_Error; pragma Import (C, Set_Field_Init, "set_field_init"); begin - Eti_Exception (Set_Field_Init (Frm, Proc)); - end Set_Field_Init_Hook; + Eti_Exception (Set_Field_Init (Frm, Proc)); + end Set_Field_Init_Hook; -- | -- | -- | - procedure Set_Field_Term_Hook (Frm : Form; - Proc : 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 Eti_Error; + function Set_Field_Term (Frm : Form; + Proc : Form_Hook_Function) return Eti_Error; pragma Import (C, Set_Field_Term, "set_field_term"); begin - Eti_Exception (Set_Field_Term (Frm, Proc)); - end Set_Field_Term_Hook; + Eti_Exception (Set_Field_Term (Frm, Proc)); + end Set_Field_Term_Hook; -- | -- | -- | - procedure Set_Form_Init_Hook (Frm : Form; - Proc : 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 Eti_Error; + function Set_Form_Init (Frm : Form; + Proc : Form_Hook_Function) return Eti_Error; pragma Import (C, Set_Form_Init, "set_form_init"); begin - Eti_Exception (Set_Form_Init (Frm, Proc)); - end Set_Form_Init_Hook; + Eti_Exception (Set_Form_Init (Frm, Proc)); + end Set_Form_Init_Hook; -- | -- | -- | - procedure Set_Form_Term_Hook (Frm : Form; - Proc : 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 Eti_Error; + function Set_Form_Term (Frm : Form; + Proc : Form_Hook_Function) return Eti_Error; pragma Import (C, Set_Form_Term, "set_form_term"); begin - Eti_Exception (Set_Form_Term (Frm, Proc)); - end Set_Form_Term_Hook; + Eti_Exception (Set_Form_Term (Frm, Proc)); + end Set_Form_Term_Hook; -- | -- |===================================================================== -- | man page form_fields.3x @@ -654,64 +655,64 @@ -- | -- | -- | - procedure Redefine (Frm : Form; - Flds : Field_Array_Access) + procedure Redefine (Frm : Form; + Flds : Field_Array_Access) is - function Set_Frm_Fields (Frm : Form; - Items : System.Address) return Eti_Error; + function Set_Frm_Fields (Frm : Form; + Items : System.Address) return Eti_Error; pragma Import (C, Set_Frm_Fields, "set_form_fields"); begin - pragma Assert (Flds.all (Flds'Last) = Null_Field); - if Flds.all (Flds'Last) /= Null_Field then - raise Form_Exception; + pragma Assert (Flds.all (Flds'Last) = Null_Field); + if Flds.all (Flds'Last) /= Null_Field then + raise Form_Exception; else - Eti_Exception (Set_Frm_Fields (Frm, Flds.all (Flds'First)'Address)); + Eti_Exception (Set_Frm_Fields (Frm, Flds.all (Flds'First)'Address)); end if; - end Redefine; + end Redefine; -- | -- | -- | - function Fields (Frm : Form; - Index : Positive) return Field + function Fields (Frm : Form; + Index : Positive) return Field is use F_Array; - function C_Fields (Frm : Form) return Pointer; + 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 > Field_Count (Frm) then - raise Form_Exception; + if P = null or else Index > Field_Count (Frm) then + raise Form_Exception; else - P := P + ptrdiff_t (C_Int (Index) - 1); + P := P + ptrdiff_t (C_Int (Index) - 1); return P.all; end if; - end Fields; + end Fields; -- | -- | -- | - function Field_Count (Frm : Form) return Natural + function Field_Count (Frm : Form) return Natural is - function Count (Frm : Form) return C_Int; + function Count (Frm : Form) return C_Int; pragma Import (C, Count, "field_count"); begin - return Natural (Count (Frm)); - end Field_Count; + return Natural (Count (Frm)); + end Field_Count; -- | -- | -- | - procedure Move (Fld : Field; - Line : Line_Position; - Column : Column_Position) + procedure Move (Fld : Field; + Line : Line_Position; + Column : Column_Position) is - function Move (Fld : Field; L, C : C_Int) return Eti_Error; + function Move (Fld : Field; L, C : C_Int) return Eti_Error; pragma Import (C, Move, "move_field"); begin - Eti_Exception (Move (Fld, C_Int (Line), C_Int (Column))); - end Move; + Eti_Exception (Move (Fld, C_Int (Line), C_Int (Column))); + end Move; -- | -- |===================================================================== -- | man page form_new.3x @@ -719,36 +720,36 @@ -- | -- | -- | - function Create (Fields : Field_Array_Access) return Form + function Create (Fields : Field_Array_Access) return Form is - function NewForm (Fields : System.Address) return Form; + function NewForm (Fields : System.Address) return Form; pragma Import (C, NewForm, "new_form"); - M : Form; + M : Form; begin - pragma Assert (Fields.all (Fields'Last) = Null_Field); - if Fields.all (Fields'Last) /= Null_Field then - raise Form_Exception; + pragma Assert (Fields.all (Fields'Last) = Null_Field); + if Fields.all (Fields'Last) /= Null_Field then + raise Form_Exception; else - M := NewForm (Fields.all (Fields'First)'Address); - if M = Null_Form then - raise Form_Exception; + M := NewForm (Fields.all (Fields'First)'Address); + if M = Null_Form then + raise Form_Exception; end if; - return M; + return M; end if; - end Create; + end Create; -- | -- | -- | - procedure Delete (Frm : in out Form) + procedure Delete (Frm : in out Form) is - function Free (Frm : Form) return Eti_Error; + function Free (Frm : Form) return Eti_Error; pragma Import (C, Free, "free_form"); begin - Eti_Exception (Free (Frm)); - Frm := Null_Form; - end Delete; + Eti_Exception (Free (Frm)); + Frm := Null_Form; + end Delete; -- | -- |===================================================================== -- | man page form_opts.3x @@ -756,59 +757,59 @@ -- | -- | -- | - procedure Set_Options (Frm : Form; - Options : Form_Option_Set) + procedure Set_Options (Frm : Form; + Options : Form_Option_Set) is - function Set_Form_Opts (Frm : Form; - Opt : Form_Option_Set) return Eti_Error; + function Set_Form_Opts (Frm : Form; + Opt : Form_Option_Set) return Eti_Error; pragma Import (C, Set_Form_Opts, "set_form_opts"); begin - Eti_Exception (Set_Form_Opts (Frm, Options)); - end Set_Options; + Eti_Exception (Set_Form_Opts (Frm, Options)); + end Set_Options; -- | -- | -- | - procedure Switch_Options (Frm : Form; - Options : Form_Option_Set; - On : Boolean := True) + procedure Switch_Options (Frm : Form; + Options : Form_Option_Set; + On : Boolean := True) is - function Form_Opts_On (Frm : Form; - Opt : Form_Option_Set) return Eti_Error; + function Form_Opts_On (Frm : Form; + Opt : Form_Option_Set) return Eti_Error; pragma Import (C, Form_Opts_On, "form_opts_on"); - function Form_Opts_Off (Frm : Form; - Opt : Form_Option_Set) return Eti_Error; + function Form_Opts_Off (Frm : Form; + Opt : Form_Option_Set) return Eti_Error; pragma Import (C, Form_Opts_Off, "form_opts_off"); begin - if On then - Eti_Exception (Form_Opts_On (Frm, Options)); + if On then + Eti_Exception (Form_Opts_On (Frm, Options)); else - Eti_Exception (Form_Opts_Off (Frm, Options)); + Eti_Exception (Form_Opts_Off (Frm, Options)); end if; - end Switch_Options; + end Switch_Options; -- | -- | -- | - procedure Get_Options (Frm : Form; - Options : out Form_Option_Set) + procedure Get_Options (Frm : Form; + Options : out Form_Option_Set) is - function Form_Opts (Frm : Form) return Form_Option_Set; + function Form_Opts (Frm : Form) return Form_Option_Set; pragma Import (C, Form_Opts, "form_opts"); begin - Options := Form_Opts (Frm); - end Get_Options; + Options := Form_Opts (Frm); + 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; - end Get_Options; + Get_Options (Frm, Fos); + return Fos; + end Get_Options; -- | -- |===================================================================== -- | man page form_post.3x @@ -816,21 +817,21 @@ -- | -- | -- | - procedure Post (Frm : Form; - Post : Boolean := True) + procedure Post (Frm : Form; + Post : Boolean := True) is - function M_Post (Frm : Form) return Eti_Error; + function M_Post (Frm : Form) return Eti_Error; pragma Import (C, M_Post, "post_form"); - function M_Unpost (Frm : Form) return Eti_Error; + function M_Unpost (Frm : Form) return Eti_Error; pragma Import (C, M_Unpost, "unpost_form"); begin - if Post then - Eti_Exception (M_Post (Frm)); + if Post then + Eti_Exception (M_Post (Frm)); else - Eti_Exception (M_Unpost (Frm)); + Eti_Exception (M_Unpost (Frm)); end if; - end Post; + end Post; -- | -- |===================================================================== -- | man page form_cursor.3x @@ -838,14 +839,14 @@ -- | -- | -- | - procedure Position_Cursor (Frm : Form) + procedure Position_Cursor (Frm : Form) is - function Pos_Form_Cursor (Frm : Form) return Eti_Error; + function Pos_Form_Cursor (Frm : Form) return Eti_Error; pragma Import (C, Pos_Form_Cursor, "pos_form_cursor"); begin - Eti_Exception (Pos_Form_Cursor (Frm)); - end Position_Cursor; + Eti_Exception (Pos_Form_Cursor (Frm)); + end Position_Cursor; -- | -- |===================================================================== -- | man page form_data.3x @@ -853,35 +854,35 @@ -- | -- | -- | - function Data_Ahead (Frm : Form) return Boolean + function Data_Ahead (Frm : Form) return Boolean is - function Ahead (Frm : Form) return C_Int; + function Ahead (Frm : Form) return C_Int; pragma Import (C, Ahead, "data_ahead"); - Res : constant C_Int := Ahead (Frm); + Res : constant C_Int := Ahead (Frm); begin - if Res = Curses_False then + if Res = Curses_False then return False; else return True; end if; - end Data_Ahead; + end Data_Ahead; -- | -- | -- | - function Data_Behind (Frm : Form) return Boolean + function Data_Behind (Frm : Form) return Boolean is - function Behind (Frm : Form) return C_Int; + function Behind (Frm : Form) return C_Int; pragma Import (C, Behind, "data_behind"); - Res : constant C_Int := Behind (Frm); + Res : constant C_Int := Behind (Frm); begin - if Res = Curses_False then + if Res = Curses_False then return False; else return True; end if; - end Data_Behind; + end Data_Behind; -- | -- |===================================================================== -- | man page form_driver.3x @@ -889,26 +890,26 @@ -- | -- | -- | - function Driver (Frm : Form; - Key : Key_Code) return Driver_Result + function Driver (Frm : Form; + Key : Key_Code) return Driver_Result is - function Frm_Driver (Frm : Form; Key : C_Int) return Eti_Error; + function Frm_Driver (Frm : Form; Key : C_Int) return Eti_Error; pragma Import (C, Frm_Driver, "form_driver"); - R : constant Eti_Error := Frm_Driver (Frm, C_Int (Key)); + R : constant Eti_Error := Frm_Driver (Frm, C_Int (Key)); begin - case R is - when E_Unknown_Command => - return Unknown_Request; - when E_Invalid_Field => - return Invalid_Field; - when E_Request_Denied => - return Request_Denied; + case R is + when E_Unknown_Command => + return Unknown_Request; + when E_Invalid_Field => + return Invalid_Field; + when E_Request_Denied => + return Request_Denied; when others => - Eti_Exception (R); - return Form_Ok; + Eti_Exception (R); + return Form_Ok; end case; - end Driver; + end Driver; -- | -- |===================================================================== -- | man page form_page.3x @@ -916,71 +917,71 @@ -- | -- | -- | - procedure Set_Current (Frm : Form; - Fld : Field) + procedure Set_Current (Frm : Form; + Fld : Field) is - function Set_Current_Fld (Frm : Form; Fld : Field) return Eti_Error; + function Set_Current_Fld (Frm : Form; Fld : Field) return Eti_Error; pragma Import (C, Set_Current_Fld, "set_current_field"); begin - Eti_Exception (Set_Current_Fld (Frm, Fld)); - end Set_Current; + Eti_Exception (Set_Current_Fld (Frm, Fld)); + end Set_Current; -- | -- | -- | - function Current (Frm : Form) return Field + function Current (Frm : Form) return Field is - function Current_Fld (Frm : Form) return 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 - raise Form_Exception; + if Fld = Null_Field then + raise Form_Exception; end if; - return Fld; - end Current; + return Fld; + end Current; -- | -- | -- | - procedure Set_Page (Frm : Form; - Page : 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 Eti_Error; + function Set_Frm_Page (Frm : Form; Pg : C_Int) return Eti_Error; pragma Import (C, Set_Frm_Page, "set_form_page"); begin - Eti_Exception (Set_Frm_Page (Frm, C_Int (Page))); - end Set_Page; + Eti_Exception (Set_Frm_Page (Frm, C_Int (Page))); + end Set_Page; -- | -- | -- | - function Page (Frm : Form) return Page_Number + function Page (Frm : Form) return Page_Number is - function Get_Page (Frm : Form) return C_Int; + function Get_Page (Frm : Form) return C_Int; pragma Import (C, Get_Page, "form_page"); - P : constant C_Int := Get_Page (Frm); + P : constant C_Int := Get_Page (Frm); begin - if P < 0 then - raise Form_Exception; + if P < 0 then + raise Form_Exception; else - return Page_Number (P); + return Page_Number (P); end if; - end Page; + 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; + function Get_Fieldindex (Fld : Field) return C_Int; pragma Import (C, Get_Fieldindex, "field_index"); - Res : constant C_Int := Get_Fieldindex (Fld); + Res : constant C_Int := Get_Fieldindex (Fld); begin - if Res = Curses_Err then - raise Form_Exception; + if Res = Curses_Err then + raise Form_Exception; end if; - return Positive (Natural (Res) + Positive'First); - end Get_Index; + return Positive (Natural (Res) + Positive'First); + end Get_Index; -- | -- |===================================================================== @@ -989,61 +990,61 @@ -- | -- | -- | - procedure Set_New_Page (Fld : Field; - New_Page : Boolean := True) + procedure Set_New_Page (Fld : Field; + New_Page : Boolean := True) is - function Set_Page (Fld : Field; Flg : C_Int) return Eti_Error; + function Set_Page (Fld : Field; Flg : C_Int) return Eti_Error; pragma Import (C, Set_Page, "set_new_page"); begin - Eti_Exception (Set_Page (Fld, Boolean'Pos (New_Page))); - end Set_New_Page; + Eti_Exception (Set_Page (Fld, Boolean'Pos (New_Page))); + end Set_New_Page; -- | -- | -- | - 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; + function Is_New (Fld : Field) return C_Int; pragma Import (C, Is_New, "new_page"); - Res : constant C_Int := Is_New (Fld); + Res : constant C_Int := Is_New (Fld); begin - if Res = Curses_False then + if Res = Curses_False then return False; else return True; end if; - end Is_New_Page; + end Is_New_Page; - procedure Free (FA : in out Field_Array_Access; - Free_Fields : 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); + (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.all (I) /= Null_Field then - Delete (FA.all (I)); + if FA /= null and then Free_Fields then + for I in FA'First .. (FA'Last - 1) loop + if FA.all (I) /= Null_Field then + Delete (FA.all (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;