X-Git-Url: http://ncurses.scripts.mit.edu/?p=ncurses.git;a=blobdiff_plain;f=Ada95%2Fsrc%2Fterminal_interface-curses-forms.adb;h=68825fc3dfbdfc876ab5ce95297510c63f569d58;hp=669ac5f3415b73347b2d8bc94df4896dcb5000a2;hb=3b18e0dcb8788afe80d6cdda05171669e3db0068;hpb=0eb88fc5281804773e2a0c7a488a4452463535ce diff --git a/Ada95/src/terminal_interface-curses-forms.adb b/Ada95/src/terminal_interface-curses-forms.adb index 669ac5f3..68825fc3 100644 --- a/Ada95/src/terminal_interface-curses-forms.adb +++ b/Ada95/src/terminal_interface-curses-forms.adb @@ -7,7 +7,7 @@ -- B O D Y -- -- -- ------------------------------------------------------------------------------ --- Copyright (c) 1998 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 -- @@ -33,9 +33,10 @@ -- sale, use or other dealings in this Software without prior written -- -- authorization. -- ------------------------------------------------------------------------------ --- Author: Juergen Pfeifer 1996 +-- Author: Juergen Pfeifer, 1996 -- Version Control: --- $Revision: 1.20 $ +-- $Revision: 1.27 $ +-- $Date: 2009/12/26 17:38:58 $ -- Binding Version 01.00 ------------------------------------------------------------------------------ with Ada.Unchecked_Deallocation; @@ -77,7 +78,7 @@ package body Terminal_Interface.Curses.Forms is Ada.Unchecked_Conversion (C_Int, 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; @@ -189,8 +190,8 @@ package body Terminal_Interface.Curses.Forms is -- | -- | -- | - 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; @@ -222,9 +223,9 @@ package body Terminal_Interface.Curses.Forms is -- | -- | 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; @@ -247,8 +248,8 @@ package body Terminal_Interface.Curses.Forms is -- | -- | 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; @@ -259,8 +260,8 @@ package body Terminal_Interface.Curses.Forms is 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; @@ -271,8 +272,8 @@ package body Terminal_Interface.Curses.Forms is -- | -- | -- | - 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; @@ -303,8 +304,8 @@ package body Terminal_Interface.Curses.Forms is -- | -- | -- | - 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; @@ -323,14 +324,14 @@ package body Terminal_Interface.Curses.Forms is -- | -- | -- | - 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"); - Opt : C_Int := FOS_2_CInt (Options); + Opt : constant C_Int := FOS_2_CInt (Options); Res : Eti_Error; begin Res := Set_Field_Opts (Fld, Opt); @@ -341,8 +342,8 @@ package body Terminal_Interface.Curses.Forms is -- | -- | -- | - 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; @@ -353,7 +354,7 @@ package body Terminal_Interface.Curses.Forms is pragma Import (C, Field_Opts_Off, "field_opts_off"); Err : Eti_Error; - Opt : C_Int := FOS_2_CInt (Options); + Opt : constant C_Int := FOS_2_CInt (Options); begin if On then Err := Field_Opts_On (Fld, Opt); @@ -367,13 +368,13 @@ package body Terminal_Interface.Curses.Forms is -- | -- | -- | - procedure Get_Options (Fld : in Field; + 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"); - Res : C_Int := Field_Opts (Fld); + Res : constant C_Int := Field_Opts (Fld); begin Options := CInt_2_FOS (Res); end Get_Options; @@ -396,9 +397,9 @@ package body Terminal_Interface.Curses.Forms is -- | -- | 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; @@ -417,7 +418,7 @@ package body Terminal_Interface.Curses.Forms is -- | -- | -- | - procedure Foreground (Fld : in Field; + procedure Foreground (Fld : Field; Fore : out Character_Attribute_Set) is function Field_Fore (Fld : Field) return C_Chtype; @@ -426,7 +427,7 @@ package body Terminal_Interface.Curses.Forms is 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 @@ -440,9 +441,9 @@ package body Terminal_Interface.Curses.Forms is -- | -- | 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; @@ -461,7 +462,7 @@ package body Terminal_Interface.Curses.Forms is -- | -- | -- | - procedure Background (Fld : in Field; + procedure Background (Fld : Field; Back : out Character_Attribute_Set) is function Field_Back (Fld : Field) return C_Chtype; @@ -470,7 +471,7 @@ package body Terminal_Interface.Curses.Forms is 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 @@ -483,8 +484,8 @@ package body Terminal_Interface.Curses.Forms is -- | -- | -- | - 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; @@ -500,7 +501,7 @@ package body Terminal_Interface.Curses.Forms is -- | -- | -- | - procedure Pad_Character (Fld : in Field; + procedure Pad_Character (Fld : Field; Pad : out Character) is function Field_Pad (Fld : Field) return C_Int; @@ -515,7 +516,7 @@ package body Terminal_Interface.Curses.Forms is -- | -- | -- | - procedure Info (Fld : in Field; + procedure Info (Fld : Field; Lines : out Line_Count; Columns : out Column_Count; First_Row : out Line_Position; @@ -549,7 +550,7 @@ package body Terminal_Interface.Curses.Forms is -- | -- | -- | - procedure Dynamic_Info (Fld : in Field; + procedure Dynamic_Info (Fld : Field; Lines : out Line_Count; Columns : out Column_Count; Max : out Natural) @@ -578,8 +579,8 @@ package body Terminal_Interface.Curses.Forms is -- | -- | -- | - 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; @@ -606,8 +607,8 @@ package body Terminal_Interface.Curses.Forms is -- | -- | -- | - 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; @@ -634,7 +635,7 @@ package body Terminal_Interface.Curses.Forms is -- | -- | -- | - procedure Scale (Frm : in Form; + procedure Scale (Frm : Form; Lines : out Line_Count; Columns : out Column_Count) is @@ -658,8 +659,8 @@ package body Terminal_Interface.Curses.Forms is -- | -- | -- | - 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; @@ -674,8 +675,8 @@ package body Terminal_Interface.Curses.Forms is -- | -- | -- | - 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; @@ -690,8 +691,8 @@ package body Terminal_Interface.Curses.Forms is -- | -- | -- | - 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; @@ -706,8 +707,8 @@ package body Terminal_Interface.Curses.Forms is -- | -- | -- | - 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; @@ -726,8 +727,8 @@ package body Terminal_Interface.Curses.Forms is -- | -- | -- | - 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; @@ -758,7 +759,7 @@ package body Terminal_Interface.Curses.Forms is 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); @@ -778,9 +779,9 @@ package body Terminal_Interface.Curses.Forms is -- | -- | -- | - 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"); @@ -838,14 +839,14 @@ package body Terminal_Interface.Curses.Forms is -- | -- | -- | - 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"); - Opt : C_Int := FrmOS_2_CInt (Options); + Opt : constant C_Int := FrmOS_2_CInt (Options); Res : Eti_Error; begin Res := Set_Form_Opts (Frm, Opt); @@ -856,8 +857,8 @@ package body Terminal_Interface.Curses.Forms is -- | -- | -- | - 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; @@ -868,7 +869,7 @@ package body Terminal_Interface.Curses.Forms is pragma Import (C, Form_Opts_Off, "form_opts_off"); Err : Eti_Error; - Opt : C_Int := FrmOS_2_CInt (Options); + Opt : constant C_Int := FrmOS_2_CInt (Options); begin if On then Err := Form_Opts_On (Frm, Opt); @@ -882,13 +883,13 @@ package body Terminal_Interface.Curses.Forms is -- | -- | -- | - procedure Get_Options (Frm : in Form; + 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"); - Res : C_Int := Form_Opts (Frm); + Res : constant C_Int := Form_Opts (Frm); begin Options := CInt_2_FrmOS (Res); end Get_Options; @@ -909,8 +910,8 @@ package body Terminal_Interface.Curses.Forms is -- | -- | -- | - 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"); @@ -995,7 +996,7 @@ package body Terminal_Interface.Curses.Forms is function Frm_Driver (Frm : Form; Key : C_Int) return C_Int; pragma Import (C, Frm_Driver, "form_driver"); - R : Eti_Error := Frm_Driver (Frm, C_Int (Key)); + R : constant Eti_Error := Frm_Driver (Frm, C_Int (Key)); begin if R /= E_Ok then if R = E_Unknown_Command then @@ -1019,8 +1020,8 @@ package body Terminal_Interface.Curses.Forms is -- | -- | -- | - 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"); @@ -1034,7 +1035,7 @@ package body Terminal_Interface.Curses.Forms is -- | -- | -- | - 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"); @@ -1049,8 +1050,8 @@ package body Terminal_Interface.Curses.Forms is -- | -- | -- | - 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"); @@ -1098,8 +1099,8 @@ package body Terminal_Interface.Curses.Forms is -- | -- | -- | - 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"); @@ -1128,14 +1129,14 @@ package body Terminal_Interface.Curses.Forms is end Is_New_Page; procedure Free (FA : in out Field_Array_Access; - Free_Fields : in Boolean := False) + Free_Fields : Boolean := False) is 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 + if FA (I) /= Null_Field then Delete (FA (I)); end if; end loop;