1 ------------------------------------------------------------------------------
3 -- GNAT ncurses Binding --
5 -- Terminal_Interface.Curses.Forms --
9 ------------------------------------------------------------------------------
10 -- Copyright (c) 1998,2004 Free Software Foundation, Inc. --
12 -- Permission is hereby granted, free of charge, to any person obtaining a --
13 -- copy of this software and associated documentation files (the --
14 -- "Software"), to deal in the Software without restriction, including --
15 -- without limitation the rights to use, copy, modify, merge, publish, --
16 -- distribute, distribute with modifications, sublicense, and/or sell --
17 -- copies of the Software, and to permit persons to whom the Software is --
18 -- furnished to do so, subject to the following conditions: --
20 -- The above copyright notice and this permission notice shall be included --
21 -- in all copies or substantial portions of the Software. --
23 -- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
24 -- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
25 -- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
26 -- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
27 -- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
28 -- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
29 -- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
31 -- Except as contained in this notice, the name(s) of the above copyright --
32 -- holders shall not be used in advertising or otherwise to promote the --
33 -- sale, use or other dealings in this Software without prior written --
35 ------------------------------------------------------------------------------
36 -- Author: Juergen Pfeifer, 1996
39 -- $Date: 2004/08/21 21:37:00 $
40 -- Binding Version 01.00
41 ------------------------------------------------------------------------------
42 with Ada.Unchecked_Deallocation;
43 with Ada.Unchecked_Conversion;
45 with Interfaces.C; use Interfaces.C;
46 with Interfaces.C.Strings; use Interfaces.C.Strings;
47 with Interfaces.C.Pointers;
49 with Terminal_Interface.Curses.Aux;
51 package body Terminal_Interface.Curses.Forms is
53 use Terminal_Interface.Curses.Aux;
55 type C_Field_Array is array (Natural range <>) of aliased Field;
56 package F_Array is new
57 Interfaces.C.Pointers (Natural, Field, C_Field_Array, Null_Field);
59 ------------------------------------------------------------------------------
63 -- subtype chars_ptr is Interfaces.C.Strings.chars_ptr;
65 function FOS_2_CInt is new
66 Ada.Unchecked_Conversion (Field_Option_Set,
69 function CInt_2_FOS is new
70 Ada.Unchecked_Conversion (C_Int,
73 function FrmOS_2_CInt is new
74 Ada.Unchecked_Conversion (Form_Option_Set,
77 function CInt_2_FrmOS is new
78 Ada.Unchecked_Conversion (C_Int,
81 procedure Request_Name (Key : in Form_Request_Code;
84 function Form_Request_Name (Key : C_Int) return chars_ptr;
85 pragma Import (C, Form_Request_Name, "form_request_name");
87 Fill_String (Form_Request_Name (C_Int (Key)), Name);
90 function Request_Name (Key : Form_Request_Code) return String
92 function Form_Request_Name (Key : C_Int) return chars_ptr;
93 pragma Import (C, Form_Request_Name, "form_request_name");
95 return Fill_String (Form_Request_Name (C_Int (Key)));
97 ------------------------------------------------------------------------------
102 -- |=====================================================================
103 -- | man page form_field_new.3x
104 -- |=====================================================================
108 function Create (Height : Line_Count;
109 Width : Column_Count;
111 Left : Column_Position;
112 Off_Screen : Natural := 0;
113 More_Buffers : Buffer_Number := Buffer_Number'First)
116 function Newfield (H, W, T, L, O, M : C_Int) return Field;
117 pragma Import (C, Newfield, "new_field");
118 Fld : constant Field := Newfield (C_Int (Height), C_Int (Width),
119 C_Int (Top), C_Int (Left),
121 C_Int (More_Buffers));
123 if Fld = Null_Field then
124 raise Form_Exception;
131 procedure Delete (Fld : in out Field)
133 function Free_Field (Fld : Field) return C_Int;
134 pragma Import (C, Free_Field, "free_field");
138 Res := Free_Field (Fld);
147 function Duplicate (Fld : Field;
149 Left : Column_Position) return Field
151 function Dup_Field (Fld : Field;
153 Left : C_Int) return Field;
154 pragma Import (C, Dup_Field, "dup_field");
156 F : constant Field := Dup_Field (Fld,
160 if F = Null_Field then
161 raise Form_Exception;
168 function Link (Fld : Field;
170 Left : Column_Position) return Field
172 function Lnk_Field (Fld : Field;
174 Left : C_Int) return Field;
175 pragma Import (C, Lnk_Field, "link_field");
177 F : constant Field := Lnk_Field (Fld,
181 if F = Null_Field then
182 raise Form_Exception;
187 -- |=====================================================================
188 -- | man page form_field_just.3x
189 -- |=====================================================================
193 procedure Set_Justification (Fld : in Field;
194 Just : in Field_Justification := None)
196 function Set_Field_Just (Fld : Field;
197 Just : C_Int) return C_Int;
198 pragma Import (C, Set_Field_Just, "set_field_just");
200 Res : constant Eti_Error :=
202 C_Int (Field_Justification'Pos (Just)));
207 end Set_Justification;
211 function Get_Justification (Fld : Field) return Field_Justification
213 function Field_Just (Fld : Field) return C_Int;
214 pragma Import (C, Field_Just, "field_just");
216 return Field_Justification'Val (Field_Just (Fld));
217 end Get_Justification;
219 -- |=====================================================================
220 -- | man page form_field_buffer.3x
221 -- |=====================================================================
227 Buffer : in Buffer_Number := Buffer_Number'First;
230 type Char_Ptr is access all Interfaces.C.char;
231 function Set_Fld_Buffer (Fld : Field;
235 pragma Import (C, Set_Fld_Buffer, "set_field_buffer");
237 Txt : char_array (0 .. Str'Length);
241 To_C (Str, Txt, Len);
242 Res := Set_Fld_Buffer (Fld, C_Int (Buffer), Txt (Txt'First)'Access);
252 Buffer : in Buffer_Number := Buffer_Number'First;
255 function Field_Buffer (Fld : Field;
256 B : C_Int) return chars_ptr;
257 pragma Import (C, Field_Buffer, "field_buffer");
259 Fill_String (Field_Buffer (Fld, C_Int (Buffer)), Str);
264 Buffer : in Buffer_Number := Buffer_Number'First) return String
266 function Field_Buffer (Fld : Field;
267 B : C_Int) return chars_ptr;
268 pragma Import (C, Field_Buffer, "field_buffer");
270 return Fill_String (Field_Buffer (Fld, C_Int (Buffer)));
275 procedure Set_Status (Fld : in Field;
276 Status : in Boolean := True)
278 function Set_Fld_Status (Fld : Field;
279 St : C_Int) return C_Int;
280 pragma Import (C, Set_Fld_Status, "set_field_status");
282 Res : constant Eti_Error := Set_Fld_Status (Fld, Boolean'Pos (Status));
285 raise Form_Exception;
291 function Changed (Fld : Field) return Boolean
293 function Field_Status (Fld : Field) return C_Int;
294 pragma Import (C, Field_Status, "field_status");
296 Res : constant C_Int := Field_Status (Fld);
298 if Res = Curses_False then
307 procedure Set_Maximum_Size (Fld : in Field;
308 Max : in Natural := 0)
310 function Set_Field_Max (Fld : Field;
311 M : C_Int) return C_Int;
312 pragma Import (C, Set_Field_Max, "set_max_field");
314 Res : constant Eti_Error := Set_Field_Max (Fld, C_Int (Max));
319 end Set_Maximum_Size;
321 -- |=====================================================================
322 -- | man page form_field_opts.3x
323 -- |=====================================================================
327 procedure Set_Options (Fld : in Field;
328 Options : in Field_Option_Set)
330 function Set_Field_Opts (Fld : Field;
331 Opt : C_Int) return C_Int;
332 pragma Import (C, Set_Field_Opts, "set_field_opts");
334 Opt : constant C_Int := FOS_2_CInt (Options);
337 Res := Set_Field_Opts (Fld, Opt);
345 procedure Switch_Options (Fld : in Field;
346 Options : in Field_Option_Set;
347 On : Boolean := True)
349 function Field_Opts_On (Fld : Field;
350 Opt : C_Int) return C_Int;
351 pragma Import (C, Field_Opts_On, "field_opts_on");
352 function Field_Opts_Off (Fld : Field;
353 Opt : C_Int) return C_Int;
354 pragma Import (C, Field_Opts_Off, "field_opts_off");
357 Opt : constant C_Int := FOS_2_CInt (Options);
360 Err := Field_Opts_On (Fld, Opt);
362 Err := Field_Opts_Off (Fld, Opt);
371 procedure Get_Options (Fld : in Field;
372 Options : out Field_Option_Set)
374 function Field_Opts (Fld : Field) return C_Int;
375 pragma Import (C, Field_Opts, "field_opts");
377 Res : constant C_Int := Field_Opts (Fld);
379 Options := CInt_2_FOS (Res);
384 function Get_Options (Fld : Field := Null_Field)
385 return Field_Option_Set
387 Fos : Field_Option_Set;
389 Get_Options (Fld, Fos);
393 -- |=====================================================================
394 -- | man page form_field_attributes.3x
395 -- |=====================================================================
399 procedure Set_Foreground
401 Fore : in Character_Attribute_Set := Normal_Video;
402 Color : in Color_Pair := Color_Pair'First)
404 function Set_Field_Fore (Fld : Field;
405 Attr : C_Chtype) return C_Int;
406 pragma Import (C, Set_Field_Fore, "set_field_fore");
408 Ch : constant Attributed_Character := (Ch => Character'First,
411 Res : constant Eti_Error :=
412 Set_Field_Fore (Fld, AttrChar_To_Chtype (Ch));
421 procedure Foreground (Fld : in Field;
422 Fore : out Character_Attribute_Set)
424 function Field_Fore (Fld : Field) return C_Chtype;
425 pragma Import (C, Field_Fore, "field_fore");
427 Fore := Chtype_To_AttrChar (Field_Fore (Fld)).Attr;
430 procedure Foreground (Fld : in Field;
431 Fore : out Character_Attribute_Set;
432 Color : out Color_Pair)
434 function Field_Fore (Fld : Field) return C_Chtype;
435 pragma Import (C, Field_Fore, "field_fore");
437 Fore := Chtype_To_AttrChar (Field_Fore (Fld)).Attr;
438 Color := Chtype_To_AttrChar (Field_Fore (Fld)).Color;
443 procedure Set_Background
445 Back : in Character_Attribute_Set := Normal_Video;
446 Color : in Color_Pair := Color_Pair'First)
448 function Set_Field_Back (Fld : Field;
449 Attr : C_Chtype) return C_Int;
450 pragma Import (C, Set_Field_Back, "set_field_back");
452 Ch : constant Attributed_Character := (Ch => Character'First,
455 Res : constant Eti_Error :=
456 Set_Field_Back (Fld, AttrChar_To_Chtype (Ch));
465 procedure Background (Fld : in Field;
466 Back : out Character_Attribute_Set)
468 function Field_Back (Fld : Field) return C_Chtype;
469 pragma Import (C, Field_Back, "field_back");
471 Back := Chtype_To_AttrChar (Field_Back (Fld)).Attr;
474 procedure Background (Fld : in Field;
475 Back : out Character_Attribute_Set;
476 Color : out Color_Pair)
478 function Field_Back (Fld : Field) return C_Chtype;
479 pragma Import (C, Field_Back, "field_back");
481 Back := Chtype_To_AttrChar (Field_Back (Fld)).Attr;
482 Color := Chtype_To_AttrChar (Field_Back (Fld)).Color;
487 procedure Set_Pad_Character (Fld : in Field;
488 Pad : in Character := Space)
490 function Set_Field_Pad (Fld : Field;
491 Ch : C_Int) return C_Int;
492 pragma Import (C, Set_Field_Pad, "set_field_pad");
494 Res : constant Eti_Error := Set_Field_Pad (Fld,
495 C_Int (Character'Pos (Pad)));
500 end Set_Pad_Character;
504 procedure Pad_Character (Fld : in Field;
507 function Field_Pad (Fld : Field) return C_Int;
508 pragma Import (C, Field_Pad, "field_pad");
510 Pad := Character'Val (Field_Pad (Fld));
513 -- |=====================================================================
514 -- | man page form_field_info.3x
515 -- |=====================================================================
519 procedure Info (Fld : in Field;
520 Lines : out Line_Count;
521 Columns : out Column_Count;
522 First_Row : out Line_Position;
523 First_Column : out Column_Position;
524 Off_Screen : out Natural;
525 Additional_Buffers : out Buffer_Number)
527 type C_Int_Access is access all C_Int;
528 function Fld_Info (Fld : Field;
529 L, C, Fr, Fc, Os, Ab : C_Int_Access)
531 pragma Import (C, Fld_Info, "field_info");
533 L, C, Fr, Fc, Os, Ab : aliased C_Int;
534 Res : constant Eti_Error := Fld_Info (Fld,
536 Fr'Access, Fc'Access,
537 Os'Access, Ab'Access);
542 Lines := Line_Count (L);
543 Columns := Column_Count (C);
544 First_Row := Line_Position (Fr);
545 First_Column := Column_Position (Fc);
546 Off_Screen := Natural (Os);
547 Additional_Buffers := Buffer_Number (Ab);
553 procedure Dynamic_Info (Fld : in Field;
554 Lines : out Line_Count;
555 Columns : out Column_Count;
558 type C_Int_Access is access all C_Int;
559 function Dyn_Info (Fld : Field; L, C, M : C_Int_Access) return C_Int;
560 pragma Import (C, Dyn_Info, "dynamic_field_info");
562 L, C, M : aliased C_Int;
563 Res : constant Eti_Error := Dyn_Info (Fld,
570 Lines := Line_Count (L);
571 Columns := Column_Count (C);
576 -- |=====================================================================
577 -- | man page form_win.3x
578 -- |=====================================================================
582 procedure Set_Window (Frm : in Form;
585 function Set_Form_Win (Frm : Form;
586 Win : Window) return C_Int;
587 pragma Import (C, Set_Form_Win, "set_form_win");
589 Res : constant Eti_Error := Set_Form_Win (Frm, Win);
598 function Get_Window (Frm : Form) return Window
600 function Form_Win (Frm : Form) return Window;
601 pragma Import (C, Form_Win, "form_win");
603 W : constant Window := Form_Win (Frm);
610 procedure Set_Sub_Window (Frm : in Form;
613 function Set_Form_Sub (Frm : Form;
614 Win : Window) return C_Int;
615 pragma Import (C, Set_Form_Sub, "set_form_sub");
617 Res : constant Eti_Error := Set_Form_Sub (Frm, Win);
626 function Get_Sub_Window (Frm : Form) return Window
628 function Form_Sub (Frm : Form) return Window;
629 pragma Import (C, Form_Sub, "form_sub");
631 W : constant Window := Form_Sub (Frm);
638 procedure Scale (Frm : in Form;
639 Lines : out Line_Count;
640 Columns : out Column_Count)
642 type C_Int_Access is access all C_Int;
643 function M_Scale (Frm : Form; Yp, Xp : C_Int_Access) return C_Int;
644 pragma Import (C, M_Scale, "scale_form");
646 X, Y : aliased C_Int;
647 Res : constant Eti_Error := M_Scale (Frm, Y'Access, X'Access);
652 Lines := Line_Count (Y);
653 Columns := Column_Count (X);
656 -- |=====================================================================
657 -- | man page menu_hook.3x
658 -- |=====================================================================
662 procedure Set_Field_Init_Hook (Frm : in Form;
663 Proc : in Form_Hook_Function)
665 function Set_Field_Init (Frm : Form;
666 Proc : Form_Hook_Function) return C_Int;
667 pragma Import (C, Set_Field_Init, "set_field_init");
669 Res : constant Eti_Error := Set_Field_Init (Frm, Proc);
674 end Set_Field_Init_Hook;
678 procedure Set_Field_Term_Hook (Frm : in Form;
679 Proc : in Form_Hook_Function)
681 function Set_Field_Term (Frm : Form;
682 Proc : Form_Hook_Function) return C_Int;
683 pragma Import (C, Set_Field_Term, "set_field_term");
685 Res : constant Eti_Error := Set_Field_Term (Frm, Proc);
690 end Set_Field_Term_Hook;
694 procedure Set_Form_Init_Hook (Frm : in Form;
695 Proc : in Form_Hook_Function)
697 function Set_Form_Init (Frm : Form;
698 Proc : Form_Hook_Function) return C_Int;
699 pragma Import (C, Set_Form_Init, "set_form_init");
701 Res : constant Eti_Error := Set_Form_Init (Frm, Proc);
706 end Set_Form_Init_Hook;
710 procedure Set_Form_Term_Hook (Frm : in Form;
711 Proc : in Form_Hook_Function)
713 function Set_Form_Term (Frm : Form;
714 Proc : Form_Hook_Function) return C_Int;
715 pragma Import (C, Set_Form_Term, "set_form_term");
717 Res : constant Eti_Error := Set_Form_Term (Frm, Proc);
722 end Set_Form_Term_Hook;
724 -- |=====================================================================
725 -- | man page form_fields.3x
726 -- |=====================================================================
730 procedure Redefine (Frm : in Form;
731 Flds : in Field_Array_Access)
733 function Set_Frm_Fields (Frm : Form;
734 Items : System.Address) return C_Int;
735 pragma Import (C, Set_Frm_Fields, "set_form_fields");
739 pragma Assert (Flds (Flds'Last) = Null_Field);
740 if Flds (Flds'Last) /= Null_Field then
741 raise Form_Exception;
743 Res := Set_Frm_Fields (Frm, Flds (Flds'First)'Address);
752 function Fields (Frm : Form;
753 Index : Positive) return Field
757 function C_Fields (Frm : Form) return Pointer;
758 pragma Import (C, C_Fields, "form_fields");
760 P : Pointer := C_Fields (Frm);
762 if P = null or else Index not in 1 .. Field_Count (Frm) then
763 raise Form_Exception;
765 P := P + ptrdiff_t (C_Int (Index) - 1);
772 function Field_Count (Frm : Form) return Natural
774 function Count (Frm : Form) return C_Int;
775 pragma Import (C, Count, "field_count");
777 return Natural (Count (Frm));
782 procedure Move (Fld : in Field;
783 Line : in Line_Position;
784 Column : in Column_Position)
786 function Move (Fld : Field; L, C : C_Int) return C_Int;
787 pragma Import (C, Move, "move_field");
789 Res : constant Eti_Error := Move (Fld, C_Int (Line), C_Int (Column));
796 -- |=====================================================================
797 -- | man page form_new.3x
798 -- |=====================================================================
802 function Create (Fields : Field_Array_Access) return Form
804 function NewForm (Fields : System.Address) return Form;
805 pragma Import (C, NewForm, "new_form");
809 pragma Assert (Fields (Fields'Last) = Null_Field);
810 if Fields (Fields'Last) /= Null_Field then
811 raise Form_Exception;
813 M := NewForm (Fields (Fields'First)'Address);
814 if M = Null_Form then
815 raise Form_Exception;
823 procedure Delete (Frm : in out Form)
825 function Free (Frm : Form) return C_Int;
826 pragma Import (C, Free, "free_form");
828 Res : constant Eti_Error := Free (Frm);
836 -- |=====================================================================
837 -- | man page form_opts.3x
838 -- |=====================================================================
842 procedure Set_Options (Frm : in Form;
843 Options : in Form_Option_Set)
845 function Set_Form_Opts (Frm : Form;
846 Opt : C_Int) return C_Int;
847 pragma Import (C, Set_Form_Opts, "set_form_opts");
849 Opt : constant C_Int := FrmOS_2_CInt (Options);
852 Res := Set_Form_Opts (Frm, Opt);
860 procedure Switch_Options (Frm : in Form;
861 Options : in Form_Option_Set;
862 On : Boolean := True)
864 function Form_Opts_On (Frm : Form;
865 Opt : C_Int) return C_Int;
866 pragma Import (C, Form_Opts_On, "form_opts_on");
867 function Form_Opts_Off (Frm : Form;
868 Opt : C_Int) return C_Int;
869 pragma Import (C, Form_Opts_Off, "form_opts_off");
872 Opt : constant C_Int := FrmOS_2_CInt (Options);
875 Err := Form_Opts_On (Frm, Opt);
877 Err := Form_Opts_Off (Frm, Opt);
886 procedure Get_Options (Frm : in Form;
887 Options : out Form_Option_Set)
889 function Form_Opts (Frm : Form) return C_Int;
890 pragma Import (C, Form_Opts, "form_opts");
892 Res : constant C_Int := Form_Opts (Frm);
894 Options := CInt_2_FrmOS (Res);
899 function Get_Options (Frm : Form := Null_Form) return Form_Option_Set
901 Fos : Form_Option_Set;
903 Get_Options (Frm, Fos);
907 -- |=====================================================================
908 -- | man page form_post.3x
909 -- |=====================================================================
913 procedure Post (Frm : in Form;
914 Post : in Boolean := True)
916 function M_Post (Frm : Form) return C_Int;
917 pragma Import (C, M_Post, "post_form");
918 function M_Unpost (Frm : Form) return C_Int;
919 pragma Import (C, M_Unpost, "unpost_form");
926 Res := M_Unpost (Frm);
933 -- |=====================================================================
934 -- | man page form_cursor.3x
935 -- |=====================================================================
939 procedure Position_Cursor (Frm : Form)
941 function Pos_Form_Cursor (Frm : Form) return C_Int;
942 pragma Import (C, Pos_Form_Cursor, "pos_form_cursor");
944 Res : constant Eti_Error := Pos_Form_Cursor (Frm);
951 -- |=====================================================================
952 -- | man page form_data.3x
953 -- |=====================================================================
957 function Data_Ahead (Frm : Form) return Boolean
959 function Ahead (Frm : Form) return C_Int;
960 pragma Import (C, Ahead, "data_ahead");
962 Res : constant C_Int := Ahead (Frm);
964 if Res = Curses_False then
973 function Data_Behind (Frm : Form) return Boolean
975 function Behind (Frm : Form) return C_Int;
976 pragma Import (C, Behind, "data_behind");
978 Res : constant C_Int := Behind (Frm);
980 if Res = Curses_False then
987 -- |=====================================================================
988 -- | man page form_driver.3x
989 -- |=====================================================================
993 function Driver (Frm : Form;
994 Key : Key_Code) return Driver_Result
996 function Frm_Driver (Frm : Form; Key : C_Int) return C_Int;
997 pragma Import (C, Frm_Driver, "form_driver");
999 R : constant Eti_Error := Frm_Driver (Frm, C_Int (Key));
1002 if R = E_Unknown_Command then
1003 return Unknown_Request;
1004 elsif R = E_Invalid_Field then
1005 return Invalid_Field;
1006 elsif R = E_Request_Denied then
1007 return Request_Denied;
1017 -- |=====================================================================
1018 -- | man page form_page.3x
1019 -- |=====================================================================
1023 procedure Set_Current (Frm : in Form;
1026 function Set_Current_Fld (Frm : Form; Fld : Field) return C_Int;
1027 pragma Import (C, Set_Current_Fld, "set_current_field");
1029 Res : constant Eti_Error := Set_Current_Fld (Frm, Fld);
1032 Eti_Exception (Res);
1038 function Current (Frm : in Form) return Field
1040 function Current_Fld (Frm : Form) return Field;
1041 pragma Import (C, Current_Fld, "current_field");
1043 Fld : constant Field := Current_Fld (Frm);
1045 if Fld = Null_Field then
1046 raise Form_Exception;
1053 procedure Set_Page (Frm : in Form;
1054 Page : in Page_Number := Page_Number'First)
1056 function Set_Frm_Page (Frm : Form; Pg : C_Int) return C_Int;
1057 pragma Import (C, Set_Frm_Page, "set_form_page");
1059 Res : constant Eti_Error := Set_Frm_Page (Frm, C_Int (Page));
1062 Eti_Exception (Res);
1068 function Page (Frm : Form) return Page_Number
1070 function Get_Page (Frm : Form) return C_Int;
1071 pragma Import (C, Get_Page, "form_page");
1073 P : constant C_Int := Get_Page (Frm);
1076 raise Form_Exception;
1078 return Page_Number (P);
1082 function Get_Index (Fld : Field) return Positive
1084 function Get_Fieldindex (Fld : Field) return C_Int;
1085 pragma Import (C, Get_Fieldindex, "field_index");
1087 Res : constant C_Int := Get_Fieldindex (Fld);
1089 if Res = Curses_Err then
1090 raise Form_Exception;
1092 return Positive (Natural (Res) + Positive'First);
1096 -- |=====================================================================
1097 -- | man page form_new_page.3x
1098 -- |=====================================================================
1102 procedure Set_New_Page (Fld : in Field;
1103 New_Page : in Boolean := True)
1105 function Set_Page (Fld : Field; Flg : C_Int) return C_Int;
1106 pragma Import (C, Set_Page, "set_new_page");
1108 Res : constant Eti_Error := Set_Page (Fld, Boolean'Pos (New_Page));
1111 Eti_Exception (Res);
1117 function Is_New_Page (Fld : Field) return Boolean
1119 function Is_New (Fld : Field) return C_Int;
1120 pragma Import (C, Is_New, "new_page");
1122 Res : constant C_Int := Is_New (Fld);
1124 if Res = Curses_False then
1131 procedure Free (FA : in out Field_Array_Access;
1132 Free_Fields : in Boolean := False)
1134 procedure Release is new Ada.Unchecked_Deallocation
1135 (Field_Array, Field_Array_Access);
1137 if FA /= null and then Free_Fields then
1138 for I in FA'First .. (FA'Last - 1) loop
1139 if FA (I) /= Null_Field then
1147 -- |=====================================================================
1149 function Default_Field_Options return Field_Option_Set
1152 return Get_Options (Null_Field);
1153 end Default_Field_Options;
1155 function Default_Form_Options return Form_Option_Set
1158 return Get_Options (Null_Form);
1159 end Default_Form_Options;
1161 end Terminal_Interface.Curses.Forms;