ncurses 6.1 - patch 20180210
[ncurses.git] / Ada95 / src / terminal_interface-curses-forms.adb
1 ------------------------------------------------------------------------------
2 --                                                                          --
3 --                           GNAT ncurses Binding                           --
4 --                                                                          --
5 --                      Terminal_Interface.Curses.Forms                     --
6 --                                                                          --
7 --                                 B O D Y                                  --
8 --                                                                          --
9 ------------------------------------------------------------------------------
10 -- Copyright (c) 1998-2011,2014 Free Software Foundation, Inc.              --
11 --                                                                          --
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:                 --
19 --                                                                          --
20 -- The above copyright notice and this permission notice shall be included  --
21 -- in all copies or substantial portions of the Software.                   --
22 --                                                                          --
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.                               --
30 --                                                                          --
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       --
34 -- authorization.                                                           --
35 ------------------------------------------------------------------------------
36 --  Author:  Juergen Pfeifer, 1996
37 --  Version Control:
38 --  $Revision: 1.32 $
39 --  $Date: 2014/05/24 21:31:05 $
40 --  Binding Version 01.00
41 ------------------------------------------------------------------------------
42 with Ada.Unchecked_Deallocation;
43
44 with Interfaces.C; use Interfaces.C;
45 with Interfaces.C.Strings; use Interfaces.C.Strings;
46 with Interfaces.C.Pointers;
47
48 with Terminal_Interface.Curses.Aux;
49
50 package body Terminal_Interface.Curses.Forms is
51
52    use Terminal_Interface.Curses.Aux;
53
54    type C_Field_Array is array (Natural range <>) of aliased Field;
55    package F_Array is new
56      Interfaces.C.Pointers (Natural, Field, C_Field_Array, Null_Field);
57
58 ------------------------------------------------------------------------------
59    --  |
60    --  |
61    --  |
62    --  subtype chars_ptr is Interfaces.C.Strings.chars_ptr;
63
64    procedure Request_Name (Key  : Form_Request_Code;
65                                 Name : out String)
66    is
67       function Form_Request_Name (Key : C_Int) return chars_ptr;
68       pragma Import (C, Form_Request_Name, "form_request_name");
69    begin
70       Fill_String (Form_Request_Name (C_Int (Key)), Name);
71    end Request_Name;
72
73    function Request_Name (Key : Form_Request_Code) return String
74    is
75       function Form_Request_Name (Key : C_Int) return chars_ptr;
76       pragma Import (C, Form_Request_Name, "form_request_name");
77    begin
78       return Fill_String (Form_Request_Name (C_Int (Key)));
79    end Request_Name;
80 ------------------------------------------------------------------------------
81    --  |
82    --  |
83    --  |
84    --  |
85    --  |=====================================================================
86    --  | man page form_field_new.3x
87    --  |=====================================================================
88    --  |
89    --  |
90    --  |
91    function Create (Height       : Line_Count;
92                     Width        : Column_Count;
93                     Top          : Line_Position;
94                     Left         : Column_Position;
95                     Off_Screen   : Natural := 0;
96                     More_Buffers : Buffer_Number := Buffer_Number'First)
97                     return Field
98    is
99       function Newfield (H, W, T, L, O, M : C_Int) return Field;
100       pragma Import (C, Newfield, "new_field");
101       Fld : constant Field := Newfield (C_Int (Height), C_Int (Width),
102                                         C_Int (Top), C_Int (Left),
103                                         C_Int (Off_Screen),
104                                         C_Int (More_Buffers));
105    begin
106       if Fld = Null_Field then
107          raise Form_Exception;
108       end if;
109       return Fld;
110    end Create;
111 --  |
112 --  |
113 --  |
114    procedure Delete (Fld : in out Field)
115    is
116       function Free_Field (Fld : Field) return Eti_Error;
117       pragma Import (C, Free_Field, "free_field");
118
119    begin
120       Eti_Exception (Free_Field (Fld));
121       Fld := Null_Field;
122    end Delete;
123    --  |
124    --  |
125    --  |
126    function Duplicate (Fld  : Field;
127                        Top  : Line_Position;
128                        Left : Column_Position) return Field
129    is
130       function Dup_Field (Fld  : Field;
131                           Top  : C_Int;
132                           Left : C_Int) return Field;
133       pragma Import (C, Dup_Field, "dup_field");
134
135       F : constant Field := Dup_Field (Fld,
136                                        C_Int (Top),
137                                        C_Int (Left));
138    begin
139       if F = Null_Field then
140          raise Form_Exception;
141       end if;
142       return F;
143    end Duplicate;
144    --  |
145    --  |
146    --  |
147    function Link (Fld  : Field;
148                   Top  : Line_Position;
149                   Left : Column_Position) return Field
150    is
151       function Lnk_Field (Fld  : Field;
152                           Top  : C_Int;
153                           Left : C_Int) return Field;
154       pragma Import (C, Lnk_Field, "link_field");
155
156       F : constant Field := Lnk_Field (Fld,
157                                        C_Int (Top),
158                                        C_Int (Left));
159    begin
160       if F = Null_Field then
161          raise Form_Exception;
162       end if;
163       return F;
164    end Link;
165    --  |
166    --  |=====================================================================
167    --  | man page form_field_just.3x
168    --  |=====================================================================
169    --  |
170    --  |
171    --  |
172    procedure Set_Justification (Fld  : Field;
173                                 Just : Field_Justification := None)
174    is
175       function Set_Field_Just (Fld  : Field;
176                                Just : C_Int) return Eti_Error;
177       pragma Import (C, Set_Field_Just, "set_field_just");
178
179    begin
180       Eti_Exception (Set_Field_Just (Fld,
181                                      C_Int (Field_Justification'Pos (Just))));
182    end Set_Justification;
183    --  |
184    --  |
185    --  |
186    function Get_Justification (Fld : Field) return Field_Justification
187    is
188       function Field_Just (Fld : Field) return C_Int;
189       pragma Import (C, Field_Just, "field_just");
190    begin
191       return Field_Justification'Val (Field_Just (Fld));
192    end Get_Justification;
193    --  |
194    --  |=====================================================================
195    --  | man page form_field_buffer.3x
196    --  |=====================================================================
197    --  |
198    --  |
199    --  |
200    procedure Set_Buffer
201      (Fld    : Field;
202       Buffer : Buffer_Number := Buffer_Number'First;
203       Str    : String)
204    is
205       function Set_Fld_Buffer (Fld    : Field;
206                                  Bufnum : C_Int;
207                                  S      : char_array)
208         return Eti_Error;
209       pragma Import (C, Set_Fld_Buffer, "set_field_buffer");
210
211    begin
212       Eti_Exception (Set_Fld_Buffer (Fld, C_Int (Buffer), To_C (Str)));
213    end Set_Buffer;
214    --  |
215    --  |
216    --  |
217    procedure Get_Buffer
218      (Fld    : Field;
219       Buffer : Buffer_Number := Buffer_Number'First;
220       Str    : out String)
221    is
222       function Field_Buffer (Fld : Field;
223                              B   : C_Int) return chars_ptr;
224       pragma Import (C, Field_Buffer, "field_buffer");
225    begin
226       Fill_String (Field_Buffer (Fld, C_Int (Buffer)), Str);
227    end Get_Buffer;
228
229    function Get_Buffer
230      (Fld    : Field;
231       Buffer : Buffer_Number := Buffer_Number'First) return String
232    is
233       function Field_Buffer (Fld : Field;
234                              B   : C_Int) return chars_ptr;
235       pragma Import (C, Field_Buffer, "field_buffer");
236    begin
237       return Fill_String (Field_Buffer (Fld, C_Int (Buffer)));
238    end Get_Buffer;
239    --  |
240    --  |
241    --  |
242    procedure Set_Status (Fld    : Field;
243                          Status : Boolean := True)
244    is
245       function Set_Fld_Status (Fld : Field;
246                                St  : C_Int) return Eti_Error;
247       pragma Import (C, Set_Fld_Status, "set_field_status");
248
249    begin
250       if Set_Fld_Status (Fld, Boolean'Pos (Status)) /= E_Ok then
251          raise Form_Exception;
252       end if;
253    end Set_Status;
254    --  |
255    --  |
256    --  |
257    function Changed (Fld : Field) return Boolean
258    is
259       function Field_Status (Fld : Field) return C_Int;
260       pragma Import (C, Field_Status, "field_status");
261
262       Res : constant C_Int := Field_Status (Fld);
263    begin
264       if Res = Curses_False then
265          return False;
266       else
267          return True;
268       end if;
269    end Changed;
270    --  |
271    --  |
272    --  |
273    procedure Set_Maximum_Size (Fld : Field;
274                                Max : Natural := 0)
275    is
276       function Set_Field_Max (Fld : Field;
277                               M   : C_Int) return Eti_Error;
278       pragma Import (C, Set_Field_Max, "set_max_field");
279
280    begin
281       Eti_Exception (Set_Field_Max (Fld, C_Int (Max)));
282    end Set_Maximum_Size;
283    --  |
284    --  |=====================================================================
285    --  | man page form_field_opts.3x
286    --  |=====================================================================
287    --  |
288    --  |
289    --  |
290    procedure Set_Options (Fld     : Field;
291                           Options : Field_Option_Set)
292    is
293       function Set_Field_Opts (Fld : Field;
294                                Opt : Field_Option_Set) return Eti_Error;
295       pragma Import (C, Set_Field_Opts, "set_field_opts");
296
297    begin
298       Eti_Exception (Set_Field_Opts (Fld, Options));
299    end Set_Options;
300    --  |
301    --  |
302    --  |
303    procedure Switch_Options (Fld     : Field;
304                              Options : Field_Option_Set;
305                              On      : Boolean := True)
306    is
307       function Field_Opts_On (Fld : Field;
308                               Opt : Field_Option_Set) return Eti_Error;
309       pragma Import (C, Field_Opts_On, "field_opts_on");
310       function Field_Opts_Off (Fld : Field;
311                                Opt : Field_Option_Set) return Eti_Error;
312       pragma Import (C, Field_Opts_Off, "field_opts_off");
313
314    begin
315       if On then
316          Eti_Exception (Field_Opts_On (Fld, Options));
317       else
318          Eti_Exception (Field_Opts_Off (Fld, Options));
319       end if;
320    end Switch_Options;
321    --  |
322    --  |
323    --  |
324    procedure Get_Options (Fld     : Field;
325                           Options : out Field_Option_Set)
326    is
327       function Field_Opts (Fld : Field) return Field_Option_Set;
328       pragma Import (C, Field_Opts, "field_opts");
329
330    begin
331       Options := Field_Opts (Fld);
332    end Get_Options;
333    --  |
334    --  |
335    --  |
336    function Get_Options (Fld : Field := Null_Field)
337                          return Field_Option_Set
338    is
339       Fos : Field_Option_Set;
340    begin
341       Get_Options (Fld, Fos);
342       return Fos;
343    end Get_Options;
344    --  |
345    --  |=====================================================================
346    --  | man page form_field_attributes.3x
347    --  |=====================================================================
348    --  |
349    --  |
350    --  |
351    procedure Set_Foreground
352      (Fld   : Field;
353       Fore  : Character_Attribute_Set := Normal_Video;
354       Color : Color_Pair := Color_Pair'First)
355    is
356       function Set_Field_Fore (Fld  : Field;
357                                Attr : Attributed_Character) return Eti_Error;
358       pragma Import (C, Set_Field_Fore, "set_field_fore");
359
360    begin
361       Eti_Exception (Set_Field_Fore (Fld, (Ch    => Character'First,
362                                            Color => Color,
363                                            Attr  => Fore)));
364    end Set_Foreground;
365    --  |
366    --  |
367    --  |
368    procedure Foreground (Fld  : Field;
369                          Fore : out Character_Attribute_Set)
370    is
371       function Field_Fore (Fld : Field) return Attributed_Character;
372       pragma Import (C, Field_Fore, "field_fore");
373    begin
374       Fore := Field_Fore (Fld).Attr;
375    end Foreground;
376
377    procedure Foreground (Fld   : Field;
378                          Fore  : out Character_Attribute_Set;
379                          Color : out Color_Pair)
380    is
381       function Field_Fore (Fld : Field) return Attributed_Character;
382       pragma Import (C, Field_Fore, "field_fore");
383    begin
384       Fore  := Field_Fore (Fld).Attr;
385       Color := Field_Fore (Fld).Color;
386    end Foreground;
387    --  |
388    --  |
389    --  |
390    procedure Set_Background
391      (Fld   : Field;
392       Back  : Character_Attribute_Set := Normal_Video;
393       Color : Color_Pair := Color_Pair'First)
394    is
395       function Set_Field_Back (Fld  : Field;
396                                Attr : Attributed_Character) return Eti_Error;
397       pragma Import (C, Set_Field_Back, "set_field_back");
398
399    begin
400       Eti_Exception (Set_Field_Back (Fld, (Ch    => Character'First,
401                                            Color => Color,
402                                            Attr  => Back)));
403    end Set_Background;
404    --  |
405    --  |
406    --  |
407    procedure Background (Fld  : Field;
408                          Back : out Character_Attribute_Set)
409    is
410       function Field_Back (Fld : Field) return Attributed_Character;
411       pragma Import (C, Field_Back, "field_back");
412    begin
413       Back := Field_Back (Fld).Attr;
414    end Background;
415
416    procedure Background (Fld   : Field;
417                          Back  : out Character_Attribute_Set;
418                          Color : out Color_Pair)
419    is
420       function Field_Back (Fld : Field) return Attributed_Character;
421       pragma Import (C, Field_Back, "field_back");
422    begin
423       Back  := Field_Back (Fld).Attr;
424       Color := Field_Back (Fld).Color;
425    end Background;
426    --  |
427    --  |
428    --  |
429    procedure Set_Pad_Character (Fld : Field;
430                                 Pad : Character := Space)
431    is
432       function Set_Field_Pad (Fld : Field;
433                               Ch  : C_Int) return Eti_Error;
434       pragma Import (C, Set_Field_Pad, "set_field_pad");
435
436    begin
437       Eti_Exception (Set_Field_Pad (Fld,
438                                     C_Int (Character'Pos (Pad))));
439    end Set_Pad_Character;
440    --  |
441    --  |
442    --  |
443    procedure Pad_Character (Fld : Field;
444                             Pad : out Character)
445    is
446       function Field_Pad (Fld : Field) return C_Int;
447       pragma Import (C, Field_Pad, "field_pad");
448    begin
449       Pad := Character'Val (Field_Pad (Fld));
450    end Pad_Character;
451    --  |
452    --  |=====================================================================
453    --  | man page form_field_info.3x
454    --  |=====================================================================
455    --  |
456    --  |
457    --  |
458    procedure Info (Fld                : Field;
459                    Lines              : out Line_Count;
460                    Columns            : out Column_Count;
461                    First_Row          : out Line_Position;
462                    First_Column       : out Column_Position;
463                    Off_Screen         : out Natural;
464                    Additional_Buffers : out Buffer_Number)
465    is
466       type C_Int_Access is access all C_Int;
467       function Fld_Info (Fld : Field;
468                          L, C, Fr, Fc, Os, Ab : C_Int_Access)
469                          return Eti_Error;
470       pragma Import (C, Fld_Info, "field_info");
471
472       L, C, Fr, Fc, Os, Ab : aliased C_Int;
473    begin
474       Eti_Exception (Fld_Info (Fld,
475                                L'Access, C'Access,
476                                Fr'Access, Fc'Access,
477                                Os'Access, Ab'Access));
478       Lines              := Line_Count (L);
479       Columns            := Column_Count (C);
480       First_Row          := Line_Position (Fr);
481       First_Column       := Column_Position (Fc);
482       Off_Screen         := Natural (Os);
483       Additional_Buffers := Buffer_Number (Ab);
484    end Info;
485 --  |
486 --  |
487 --  |
488    procedure Dynamic_Info (Fld     : Field;
489                            Lines   : out Line_Count;
490                            Columns : out Column_Count;
491                            Max     : out Natural)
492    is
493       type C_Int_Access is access all C_Int;
494       function Dyn_Info (Fld : Field; L, C, M : C_Int_Access) return Eti_Error;
495       pragma Import (C, Dyn_Info, "dynamic_field_info");
496
497       L, C, M : aliased C_Int;
498    begin
499       Eti_Exception (Dyn_Info (Fld,
500                                L'Access, C'Access,
501                                M'Access));
502       Lines   := Line_Count (L);
503       Columns := Column_Count (C);
504       Max     := Natural (M);
505    end Dynamic_Info;
506    --  |
507    --  |=====================================================================
508    --  | man page form_win.3x
509    --  |=====================================================================
510    --  |
511    --  |
512    --  |
513    procedure Set_Window (Frm : Form;
514                          Win : Window)
515    is
516       function Set_Form_Win (Frm : Form;
517                              Win : Window) return Eti_Error;
518       pragma Import (C, Set_Form_Win, "set_form_win");
519
520    begin
521       Eti_Exception (Set_Form_Win (Frm, Win));
522    end Set_Window;
523    --  |
524    --  |
525    --  |
526    function Get_Window (Frm : Form) return Window
527    is
528       function Form_Win (Frm : Form) return Window;
529       pragma Import (C, Form_Win, "form_win");
530
531       W : constant Window := Form_Win (Frm);
532    begin
533       return W;
534    end Get_Window;
535    --  |
536    --  |
537    --  |
538    procedure Set_Sub_Window (Frm : Form;
539                              Win : Window)
540    is
541       function Set_Form_Sub (Frm : Form;
542                              Win : Window) return Eti_Error;
543       pragma Import (C, Set_Form_Sub, "set_form_sub");
544
545    begin
546       Eti_Exception (Set_Form_Sub (Frm, Win));
547    end Set_Sub_Window;
548    --  |
549    --  |
550    --  |
551    function Get_Sub_Window (Frm : Form) return Window
552    is
553       function Form_Sub (Frm : Form) return Window;
554       pragma Import (C, Form_Sub, "form_sub");
555
556       W : constant Window := Form_Sub (Frm);
557    begin
558       return W;
559    end Get_Sub_Window;
560    --  |
561    --  |
562    --  |
563    procedure Scale (Frm     : Form;
564                     Lines   : out Line_Count;
565                     Columns : out Column_Count)
566    is
567       type C_Int_Access is access all C_Int;
568       function M_Scale (Frm : Form; Yp, Xp : C_Int_Access) return Eti_Error;
569       pragma Import (C, M_Scale, "scale_form");
570
571       X, Y : aliased C_Int;
572    begin
573       Eti_Exception (M_Scale (Frm, Y'Access, X'Access));
574       Lines   := Line_Count (Y);
575       Columns := Column_Count (X);
576    end Scale;
577    --  |
578    --  |=====================================================================
579    --  | man page menu_hook.3x
580    --  |=====================================================================
581    --  |
582    --  |
583    --  |
584    procedure Set_Field_Init_Hook (Frm  : Form;
585                                   Proc : Form_Hook_Function)
586    is
587       function Set_Field_Init (Frm  : Form;
588                                Proc : Form_Hook_Function) return Eti_Error;
589       pragma Import (C, Set_Field_Init, "set_field_init");
590
591    begin
592       Eti_Exception (Set_Field_Init (Frm, Proc));
593    end Set_Field_Init_Hook;
594    --  |
595    --  |
596    --  |
597    procedure Set_Field_Term_Hook (Frm  : Form;
598                                   Proc : Form_Hook_Function)
599    is
600       function Set_Field_Term (Frm  : Form;
601                                Proc : Form_Hook_Function) return Eti_Error;
602       pragma Import (C, Set_Field_Term, "set_field_term");
603
604    begin
605       Eti_Exception (Set_Field_Term (Frm, Proc));
606    end Set_Field_Term_Hook;
607    --  |
608    --  |
609    --  |
610    procedure Set_Form_Init_Hook (Frm  : Form;
611                                  Proc : Form_Hook_Function)
612    is
613       function Set_Form_Init (Frm  : Form;
614                               Proc : Form_Hook_Function) return Eti_Error;
615       pragma Import (C, Set_Form_Init, "set_form_init");
616
617    begin
618       Eti_Exception (Set_Form_Init (Frm, Proc));
619    end Set_Form_Init_Hook;
620    --  |
621    --  |
622    --  |
623    procedure Set_Form_Term_Hook (Frm  : Form;
624                                  Proc : Form_Hook_Function)
625    is
626       function Set_Form_Term (Frm  : Form;
627                               Proc : Form_Hook_Function) return Eti_Error;
628       pragma Import (C, Set_Form_Term, "set_form_term");
629
630    begin
631       Eti_Exception (Set_Form_Term (Frm, Proc));
632    end Set_Form_Term_Hook;
633    --  |
634    --  |=====================================================================
635    --  | man page form_fields.3x
636    --  |=====================================================================
637    --  |
638    --  |
639    --  |
640    procedure Redefine (Frm  : Form;
641                        Flds : Field_Array_Access)
642    is
643       function Set_Frm_Fields (Frm   : Form;
644                                Items : System.Address) return Eti_Error;
645       pragma Import (C, Set_Frm_Fields, "set_form_fields");
646
647    begin
648       pragma Assert (Flds.all (Flds'Last) = Null_Field);
649       if Flds.all (Flds'Last) /= Null_Field then
650          raise Form_Exception;
651       else
652          Eti_Exception (Set_Frm_Fields (Frm, Flds.all (Flds'First)'Address));
653       end if;
654    end Redefine;
655    --  |
656    --  |
657    --  |
658    function Fields (Frm   : Form;
659                     Index : Positive) return Field
660    is
661       use F_Array;
662
663       function C_Fields (Frm : Form) return Pointer;
664       pragma Import (C, C_Fields, "form_fields");
665
666       P : Pointer := C_Fields (Frm);
667    begin
668       if P = null or else Index > Field_Count (Frm) then
669          raise Form_Exception;
670       else
671          P := P + ptrdiff_t (C_Int (Index) - 1);
672          return P.all;
673       end if;
674    end Fields;
675    --  |
676    --  |
677    --  |
678    function Field_Count (Frm : Form) return Natural
679    is
680       function Count (Frm : Form) return C_Int;
681       pragma Import (C, Count, "field_count");
682    begin
683       return Natural (Count (Frm));
684    end Field_Count;
685    --  |
686    --  |
687    --  |
688    procedure Move (Fld    : Field;
689                    Line   : Line_Position;
690                    Column : Column_Position)
691    is
692       function Move (Fld : Field; L, C : C_Int) return Eti_Error;
693       pragma Import (C, Move, "move_field");
694
695    begin
696       Eti_Exception (Move (Fld, C_Int (Line), C_Int (Column)));
697    end Move;
698    --  |
699    --  |=====================================================================
700    --  | man page form_new.3x
701    --  |=====================================================================
702    --  |
703    --  |
704    --  |
705    function Create (Fields : Field_Array_Access) return Form
706    is
707       function NewForm (Fields : System.Address) return Form;
708       pragma Import (C, NewForm, "new_form");
709
710       M   : Form;
711    begin
712       pragma Assert (Fields.all (Fields'Last) = Null_Field);
713       if Fields.all (Fields'Last) /= Null_Field then
714          raise Form_Exception;
715       else
716          M := NewForm (Fields.all (Fields'First)'Address);
717          if M = Null_Form then
718             raise Form_Exception;
719          end if;
720          return M;
721       end if;
722    end Create;
723    --  |
724    --  |
725    --  |
726    procedure Delete (Frm : in out Form)
727    is
728       function Free (Frm : Form) return Eti_Error;
729       pragma Import (C, Free, "free_form");
730
731    begin
732       Eti_Exception (Free (Frm));
733       Frm := Null_Form;
734    end Delete;
735    --  |
736    --  |=====================================================================
737    --  | man page form_opts.3x
738    --  |=====================================================================
739    --  |
740    --  |
741    --  |
742    procedure Set_Options (Frm     : Form;
743                           Options : Form_Option_Set)
744    is
745       function Set_Form_Opts (Frm : Form;
746                               Opt : Form_Option_Set) return Eti_Error;
747       pragma Import (C, Set_Form_Opts, "set_form_opts");
748
749    begin
750       Eti_Exception (Set_Form_Opts (Frm, Options));
751    end Set_Options;
752    --  |
753    --  |
754    --  |
755    procedure Switch_Options (Frm     : Form;
756                              Options : Form_Option_Set;
757                              On      : Boolean := True)
758    is
759       function Form_Opts_On (Frm : Form;
760                              Opt : Form_Option_Set) return Eti_Error;
761       pragma Import (C, Form_Opts_On, "form_opts_on");
762       function Form_Opts_Off (Frm : Form;
763                               Opt : Form_Option_Set) return Eti_Error;
764       pragma Import (C, Form_Opts_Off, "form_opts_off");
765
766    begin
767       if On then
768          Eti_Exception (Form_Opts_On (Frm, Options));
769       else
770          Eti_Exception (Form_Opts_Off (Frm, Options));
771       end if;
772    end Switch_Options;
773    --  |
774    --  |
775    --  |
776    procedure Get_Options (Frm     : Form;
777                           Options : out Form_Option_Set)
778    is
779       function Form_Opts (Frm : Form) return Form_Option_Set;
780       pragma Import (C, Form_Opts, "form_opts");
781
782    begin
783       Options := Form_Opts (Frm);
784    end Get_Options;
785    --  |
786    --  |
787    --  |
788    function Get_Options (Frm : Form := Null_Form) return Form_Option_Set
789    is
790       Fos : Form_Option_Set;
791    begin
792       Get_Options (Frm, Fos);
793       return Fos;
794    end Get_Options;
795    --  |
796    --  |=====================================================================
797    --  | man page form_post.3x
798    --  |=====================================================================
799    --  |
800    --  |
801    --  |
802    procedure Post (Frm  : Form;
803                    Post : Boolean := True)
804    is
805       function M_Post (Frm : Form) return Eti_Error;
806       pragma Import (C, M_Post, "post_form");
807       function M_Unpost (Frm : Form) return Eti_Error;
808       pragma Import (C, M_Unpost, "unpost_form");
809
810    begin
811       if Post then
812          Eti_Exception (M_Post (Frm));
813       else
814          Eti_Exception (M_Unpost (Frm));
815       end if;
816    end Post;
817    --  |
818    --  |=====================================================================
819    --  | man page form_cursor.3x
820    --  |=====================================================================
821    --  |
822    --  |
823    --  |
824    procedure Position_Cursor (Frm : Form)
825    is
826       function Pos_Form_Cursor (Frm : Form) return Eti_Error;
827       pragma Import (C, Pos_Form_Cursor, "pos_form_cursor");
828
829    begin
830       Eti_Exception (Pos_Form_Cursor (Frm));
831    end Position_Cursor;
832    --  |
833    --  |=====================================================================
834    --  | man page form_data.3x
835    --  |=====================================================================
836    --  |
837    --  |
838    --  |
839    function Data_Ahead (Frm : Form) return Boolean
840    is
841       function Ahead (Frm : Form) return C_Int;
842       pragma Import (C, Ahead, "data_ahead");
843
844       Res : constant C_Int := Ahead (Frm);
845    begin
846       if Res = Curses_False then
847          return False;
848       else
849          return True;
850       end if;
851    end Data_Ahead;
852    --  |
853    --  |
854    --  |
855    function Data_Behind (Frm : Form) return Boolean
856    is
857       function Behind (Frm : Form) return C_Int;
858       pragma Import (C, Behind, "data_behind");
859
860       Res : constant C_Int := Behind (Frm);
861    begin
862       if Res = Curses_False then
863          return False;
864       else
865          return True;
866       end if;
867    end Data_Behind;
868    --  |
869    --  |=====================================================================
870    --  | man page form_driver.3x
871    --  |=====================================================================
872    --  |
873    --  |
874    --  |
875    function Driver (Frm : Form;
876                     Key : Key_Code) return Driver_Result
877    is
878       function Frm_Driver (Frm : Form; Key : C_Int) return Eti_Error;
879       pragma Import (C, Frm_Driver, "form_driver");
880
881       R : constant Eti_Error := Frm_Driver (Frm, C_Int (Key));
882    begin
883       case R is
884          when E_Unknown_Command =>
885             return Unknown_Request;
886          when E_Invalid_Field =>
887             return Invalid_Field;
888          when E_Request_Denied =>
889             return Request_Denied;
890          when others =>
891             Eti_Exception (R);
892             return Form_Ok;
893       end case;
894    end Driver;
895    --  |
896    --  |=====================================================================
897    --  | man page form_page.3x
898    --  |=====================================================================
899    --  |
900    --  |
901    --  |
902    procedure Set_Current (Frm : Form;
903                           Fld : Field)
904    is
905       function Set_Current_Fld (Frm : Form; Fld : Field) return Eti_Error;
906       pragma Import (C, Set_Current_Fld, "set_current_field");
907
908    begin
909       Eti_Exception (Set_Current_Fld (Frm, Fld));
910    end Set_Current;
911    --  |
912    --  |
913    --  |
914    function Current (Frm : Form) return Field
915    is
916       function Current_Fld (Frm : Form) return Field;
917       pragma Import (C, Current_Fld, "current_field");
918
919       Fld : constant Field := Current_Fld (Frm);
920    begin
921       if Fld = Null_Field then
922          raise Form_Exception;
923       end if;
924       return Fld;
925    end Current;
926    --  |
927    --  |
928    --  |
929    procedure Set_Page (Frm  : Form;
930                        Page : Page_Number := Page_Number'First)
931    is
932       function Set_Frm_Page (Frm : Form; Pg : C_Int) return Eti_Error;
933       pragma Import (C, Set_Frm_Page, "set_form_page");
934
935    begin
936       Eti_Exception (Set_Frm_Page (Frm, C_Int (Page)));
937    end Set_Page;
938    --  |
939    --  |
940    --  |
941    function Page (Frm : Form) return Page_Number
942    is
943       function Get_Page (Frm : Form) return C_Int;
944       pragma Import (C, Get_Page, "form_page");
945
946       P : constant C_Int := Get_Page (Frm);
947    begin
948       if P < 0 then
949          raise Form_Exception;
950       else
951          return Page_Number (P);
952       end if;
953    end Page;
954
955    function Get_Index (Fld : Field) return Positive
956    is
957       function Get_Fieldindex (Fld : Field) return C_Int;
958       pragma Import (C, Get_Fieldindex, "field_index");
959
960       Res : constant C_Int := Get_Fieldindex (Fld);
961    begin
962       if Res = Curses_Err then
963          raise Form_Exception;
964       end if;
965       return Positive (Natural (Res) + Positive'First);
966    end Get_Index;
967
968    --  |
969    --  |=====================================================================
970    --  | man page form_new_page.3x
971    --  |=====================================================================
972    --  |
973    --  |
974    --  |
975    procedure Set_New_Page (Fld      : Field;
976                            New_Page : Boolean := True)
977    is
978       function Set_Page (Fld : Field; Flg : C_Int) return Eti_Error;
979       pragma Import (C, Set_Page, "set_new_page");
980
981    begin
982       Eti_Exception (Set_Page (Fld, Boolean'Pos (New_Page)));
983    end Set_New_Page;
984    --  |
985    --  |
986    --  |
987    function Is_New_Page (Fld : Field) return Boolean
988    is
989       function Is_New (Fld : Field) return C_Int;
990       pragma Import (C, Is_New, "new_page");
991
992       Res : constant C_Int := Is_New (Fld);
993    begin
994       if Res = Curses_False then
995          return False;
996       else
997          return True;
998       end if;
999    end Is_New_Page;
1000
1001    procedure Free (FA          : in out Field_Array_Access;
1002                    Free_Fields : Boolean := False)
1003    is
1004       procedure Release is new Ada.Unchecked_Deallocation
1005         (Field_Array, Field_Array_Access);
1006    begin
1007       if FA /= null and then Free_Fields then
1008          for I in FA'First .. (FA'Last - 1) loop
1009             if FA.all (I) /= Null_Field then
1010                Delete (FA.all (I));
1011             end if;
1012          end loop;
1013       end if;
1014       Release (FA);
1015    end Free;
1016
1017    --  |=====================================================================
1018
1019    function Default_Field_Options return Field_Option_Set
1020    is
1021    begin
1022       return Get_Options (Null_Field);
1023    end Default_Field_Options;
1024
1025    function Default_Form_Options return Form_Option_Set
1026    is
1027    begin
1028       return Get_Options (Null_Form);
1029    end Default_Form_Options;
1030
1031 end Terminal_Interface.Curses.Forms;