ncursesada_6.3.0_c6c68b5b/Ada95/src/terminal_interface-curses-forms.adb

------------------------------------------------------------------------------
--                                                                          --
--                           GNAT ncurses Binding                           --
--                                                                          --
--                      Terminal_Interface.Curses.Forms                     --
--                                                                          --
--                                 B O D Y                                  --
--                                                                          --
------------------------------------------------------------------------------
-- 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            --
-- "Software"), to deal in the Software without restriction, including      --
-- without limitation the rights to use, copy, modify, merge, publish,      --
-- distribute, distribute with modifications, sublicense, and/or sell       --
-- copies of the Software, and to permit persons to whom the Software is    --
-- furnished to do so, subject to the following conditions:                 --
--                                                                          --
-- The above copyright notice and this permission notice shall be included  --
-- in all copies or substantial portions of the Software.                   --
--                                                                          --
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS  --
-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF               --
-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.   --
-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM,   --
-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR    --
-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR    --
-- THE USE OR OTHER DEALINGS IN THE SOFTWARE.                               --
--                                                                          --
-- Except as contained in this notice, the name(s) of the above copyright   --
-- holders shall not be used in advertising or otherwise to promote the     --
-- sale, use or other dealings in this Software without prior written       --
-- authorization.                                                           --
------------------------------------------------------------------------------
--  Author:  Juergen Pfeifer, 1996
--  Version Control:
--  $Revision: 1.33 $
--  $Date: 2020/02/02 23:34:34 $
--  Binding Version 01.00
------------------------------------------------------------------------------
with Ada.Unchecked_Deallocation;

with Interfaces.C; use Interfaces.C;
with Interfaces.C.Strings; use Interfaces.C.Strings;
with Interfaces.C.Pointers;

with Terminal_Interface.Curses.Aux;

package body Terminal_Interface.Curses.Forms is

   use Terminal_Interface.Curses.Aux;

   type C_Field_Array is array (Natural range <>) of aliased Field;
   package F_Array is new
     Interfaces.C.Pointers (Natural, Field, C_Field_Array, Null_Field);

------------------------------------------------------------------------------
   --  |
   --  |
   --  |
   --  subtype chars_ptr is Interfaces.C.Strings.chars_ptr;

   procedure Request_Name (Key  : Form_Request_Code;
                                Name : out String)
   is
      function Form_Request_Name (Key : C_Int) return chars_ptr;
      pragma Import (C, Form_Request_Name, "form_request_name");
   begin
      Fill_String (Form_Request_Name (C_Int (Key)), Name);
   end Request_Name;

   function Request_Name (Key : Form_Request_Code) return String
   is
      function Form_Request_Name (Key : C_Int) return chars_ptr;
      pragma Import (C, Form_Request_Name, "form_request_name");
   begin
      return Fill_String (Form_Request_Name (C_Int (Key)));
   end Request_Name;
------------------------------------------------------------------------------
   --  |
   --  |
   --  |
   --  |
   --  |=====================================================================
   --  | man page form_field_new.3x
   --  |=====================================================================
   --  |
   --  |
   --  |
   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;
      pragma Import (C, Newfield, "new_field");
      Fld : constant Field := Newfield (C_Int (Height), C_Int (Width),
                                        C_Int (Top), C_Int (Left),
                                        C_Int (Off_Screen),
                                        C_Int (More_Buffers));
   begin
      if Fld = Null_Field then
         raise Form_Exception;
      end if;
      return Fld;
   end Create;
--  |
--  |
--  |
   procedure Delete (Fld : in out Field)
   is
      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;
   --  |
   --  |
   --  |
   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;
      pragma Import (C, Dup_Field, "dup_field");

      F : constant Field := Dup_Field (Fld,
                                       C_Int (Top),
                                       C_Int (Left));
   begin
      if F = Null_Field then
         raise Form_Exception;
      end if;
      return F;
   end Duplicate;
   --  |
   --  |
   --  |
   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;
      pragma Import (C, Lnk_Field, "link_field");

      F : constant Field := Lnk_Field (Fld,
                                       C_Int (Top),
                                       C_Int (Left));
   begin
      if F = Null_Field then
         raise Form_Exception;
      end if;
      return F;
   end Link;
   --  |
   --  |=====================================================================
   --  | man page form_field_just.3x
   --  |=====================================================================
   --  |
   --  |
   --  |
   procedure Set_Justification (Fld  : Field;
                                Just : Field_Justification := None)
   is
      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;
   --  |
   --  |
   --  |
   function Get_Justification (Fld : Field) return Field_Justification
   is
      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;
   --  |
   --  |=====================================================================
   --  | man page form_field_buffer.3x
   --  |=====================================================================
   --  |
   --  |
   --  |
   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;
      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;
   --  |
   --  |
   --  |
   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;
      pragma Import (C, Field_Buffer, "field_buffer");
   begin
      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
   is
      function Field_Buffer (Fld : Field;
                             B   : C_Int) return chars_ptr;
      pragma Import (C, Field_Buffer, "field_buffer");
   begin
      return Fill_String (Field_Buffer (Fld, C_Int (Buffer)));
   end Get_Buffer;
   --  |
   --  |
   --  |
   procedure Set_Status (Fld    : Field;
                         Status : Boolean := True)
   is
      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;
      end if;
   end Set_Status;
   --  |
   --  |
   --  |
   function Changed (Fld : Field) return Boolean
   is
      function Field_Status (Fld : Field) return C_Int;
      pragma Import (C, Field_Status, "field_status");

      Res : constant C_Int := Field_Status (Fld);
   begin
      if Res = Curses_False then
         return False;
      else
         return True;
      end if;
   end Changed;
   --  |
   --  |
   --  |
   procedure Set_Maximum_Size (Fld : Field;
                               Max : Natural := 0)
   is
      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;
   --  |
   --  |=====================================================================
   --  | man page form_field_opts.3x
   --  |=====================================================================
   --  |
   --  |
   --  |
   procedure Set_Options (Fld     : Field;
                          Options : Field_Option_Set)
   is
      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;
   --  |
   --  |
   --  |
   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;
      pragma Import (C, Field_Opts_On, "field_opts_on");
      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));
      else
         Eti_Exception (Field_Opts_Off (Fld, Options));
      end if;
   end Switch_Options;
   --  |
   --  |
   --  |
   procedure Get_Options (Fld     : Field;
                          Options : out Field_Option_Set)
   is
      function Field_Opts (Fld : Field) return Field_Option_Set;
      pragma Import (C, Field_Opts, "field_opts");

   begin
      Options := Field_Opts (Fld);
   end Get_Options;
   --  |
   --  |
   --  |
   function Get_Options (Fld : Field := Null_Field)
                         return Field_Option_Set
   is
      Fos : Field_Option_Set;
   begin
      Get_Options (Fld, Fos);
      return Fos;
   end Get_Options;
   --  |
   --  |=====================================================================
   --  | man page form_field_attributes.3x
   --  |=====================================================================
   --  |
   --  |
   --  |
   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;
      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;
   --  |
   --  |
   --  |
   procedure Foreground (Fld  : Field;
                         Fore : out Character_Attribute_Set)
   is
      function Field_Fore (Fld : Field) return Attributed_Character;
      pragma Import (C, Field_Fore, "field_fore");
   begin
      Fore := Field_Fore (Fld).Attr;
   end Foreground;

   procedure Foreground (Fld   : Field;
                         Fore  : out Character_Attribute_Set;
                         Color : out Color_Pair)
   is
      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;
   --  |
   --  |
   --  |
   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;
      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;
   --  |
   --  |
   --  |
   procedure Background (Fld  : Field;
                         Back : out Character_Attribute_Set)
   is
      function Field_Back (Fld : Field) return Attributed_Character;
      pragma Import (C, Field_Back, "field_back");
   begin
      Back := Field_Back (Fld).Attr;
   end Background;

   procedure Background (Fld   : Field;
                         Back  : out Character_Attribute_Set;
                         Color : out Color_Pair)
   is
      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;
   --  |
   --  |
   --  |
   procedure Set_Pad_Character (Fld : Field;
                                Pad : Character := Space)
   is
      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;
   --  |
   --  |
   --  |
   procedure Pad_Character (Fld : Field;
                            Pad : out Character)
   is
      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;
   --  |
   --  |=====================================================================
   --  | man page form_field_info.3x
   --  |=====================================================================
   --  |
   --  |
   --  |
   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;
      pragma Import (C, Fld_Info, "field_info");

      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;
--  |
--  |
--  |
   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;
      pragma Import (C, Dyn_Info, "dynamic_field_info");

      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;
   --  |
   --  |=====================================================================
   --  | man page form_win.3x
   --  |=====================================================================
   --  |
   --  |
   --  |
   procedure Set_Window (Frm : Form;
                         Win : Window)
   is
      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;
   --  |
   --  |
   --  |
   function Get_Window (Frm : Form) return Window
   is
      function Form_Win (Frm : Form) return Window;
      pragma Import (C, Form_Win, "form_win");

      W : constant Window := Form_Win (Frm);
   begin
      return W;
   end Get_Window;
   --  |
   --  |
   --  |
   procedure Set_Sub_Window (Frm : Form;
                             Win : Window)
   is
      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;
   --  |
   --  |
   --  |
   function Get_Sub_Window (Frm : Form) return Window
   is
      function Form_Sub (Frm : Form) return Window;
      pragma Import (C, Form_Sub, "form_sub");

      W : constant Window := Form_Sub (Frm);
   begin
      return W;
   end Get_Sub_Window;
   --  |
   --  |
   --  |
   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;
      pragma Import (C, M_Scale, "scale_form");

      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;
   --  |
   --  |=====================================================================
   --  | man page menu_hook.3x
   --  |=====================================================================
   --  |
   --  |
   --  |
   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;
      pragma Import (C, Set_Field_Init, "set_field_init");

   begin
      Eti_Exception (Set_Field_Init (Frm, Proc));
   end Set_Field_Init_Hook;
   --  |
   --  |
   --  |
   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;
      pragma Import (C, Set_Field_Term, "set_field_term");

   begin
      Eti_Exception (Set_Field_Term (Frm, Proc));
   end Set_Field_Term_Hook;
   --  |
   --  |
   --  |
   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;
      pragma Import (C, Set_Form_Init, "set_form_init");

   begin
      Eti_Exception (Set_Form_Init (Frm, Proc));
   end Set_Form_Init_Hook;
   --  |
   --  |
   --  |
   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;
      pragma Import (C, Set_Form_Term, "set_form_term");

   begin
      Eti_Exception (Set_Form_Term (Frm, Proc));
   end Set_Form_Term_Hook;
   --  |
   --  |=====================================================================
   --  | man page form_fields.3x
   --  |=====================================================================
   --  |
   --  |
   --  |
   procedure Redefine (Frm  : Form;
                       Flds : Field_Array_Access)
   is
      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;
      else
         Eti_Exception (Set_Frm_Fields (Frm, Flds.all (Flds'First)'Address));
      end if;
   end Redefine;
   --  |
   --  |
   --  |
   function Fields (Frm   : Form;
                    Index : Positive) return Field
   is
      use F_Array;

      function C_Fields (Frm : Form) return Pointer;
      pragma Import (C, C_Fields, "form_fields");

      P : Pointer := C_Fields (Frm);
   begin
      if P = null or else Index > Field_Count (Frm) then
         raise Form_Exception;
      else
         P := P + ptrdiff_t (C_Int (Index) - 1);
         return P.all;
      end if;
   end Fields;
   --  |
   --  |
   --  |
   function Field_Count (Frm : Form) return Natural
   is
      function Count (Frm : Form) return C_Int;
      pragma Import (C, Count, "field_count");
   begin
      return Natural (Count (Frm));
   end Field_Count;
   --  |
   --  |
   --  |
   procedure Move (Fld    : Field;
                   Line   : Line_Position;
                   Column : Column_Position)
   is
      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;
   --  |
   --  |=====================================================================
   --  | man page form_new.3x
   --  |=====================================================================
   --  |
   --  |
   --  |
   function Create (Fields : Field_Array_Access) return Form
   is
      function NewForm (Fields : System.Address) return Form;
      pragma Import (C, NewForm, "new_form");

      M   : Form;
   begin
      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;
         end if;
         return M;
      end if;
   end Create;
   --  |
   --  |
   --  |
   procedure Delete (Frm : in out Form)
   is
      function Free (Frm : Form) return Eti_Error;
      pragma Import (C, Free, "free_form");

   begin
      Eti_Exception (Free (Frm));
      Frm := Null_Form;
   end Delete;
   --  |
   --  |=====================================================================
   --  | man page form_opts.3x
   --  |=====================================================================
   --  |
   --  |
   --  |
   procedure Set_Options (Frm     : Form;
                          Options : Form_Option_Set)
   is
      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;
   --  |
   --  |
   --  |
   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;
      pragma Import (C, Form_Opts_On, "form_opts_on");
      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));
      else
         Eti_Exception (Form_Opts_Off (Frm, Options));
      end if;
   end Switch_Options;
   --  |
   --  |
   --  |
   procedure Get_Options (Frm     : Form;
                          Options : out Form_Option_Set)
   is
      function Form_Opts (Frm : Form) return Form_Option_Set;
      pragma Import (C, Form_Opts, "form_opts");

   begin
      Options := Form_Opts (Frm);
   end Get_Options;
   --  |
   --  |
   --  |
   function Get_Options (Frm : Form := Null_Form) return Form_Option_Set
   is
      Fos : Form_Option_Set;
   begin
      Get_Options (Frm, Fos);
      return Fos;
   end Get_Options;
   --  |
   --  |=====================================================================
   --  | man page form_post.3x
   --  |=====================================================================
   --  |
   --  |
   --  |
   procedure Post (Frm  : Form;
                   Post : Boolean := True)
   is
      function M_Post (Frm : Form) return Eti_Error;
      pragma Import (C, M_Post, "post_form");
      function M_Unpost (Frm : Form) return Eti_Error;
      pragma Import (C, M_Unpost, "unpost_form");

   begin
      if Post then
         Eti_Exception (M_Post (Frm));
      else
         Eti_Exception (M_Unpost (Frm));
      end if;
   end Post;
   --  |
   --  |=====================================================================
   --  | man page form_cursor.3x
   --  |=====================================================================
   --  |
   --  |
   --  |
   procedure Position_Cursor (Frm : Form)
   is
      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;
   --  |
   --  |=====================================================================
   --  | man page form_data.3x
   --  |=====================================================================
   --  |
   --  |
   --  |
   function Data_Ahead (Frm : Form) return Boolean
   is
      function Ahead (Frm : Form) return C_Int;
      pragma Import (C, Ahead, "data_ahead");

      Res : constant C_Int := Ahead (Frm);
   begin
      if Res = Curses_False then
         return False;
      else
         return True;
      end if;
   end Data_Ahead;
   --  |
   --  |
   --  |
   function Data_Behind (Frm : Form) return Boolean
   is
      function Behind (Frm : Form) return C_Int;
      pragma Import (C, Behind, "data_behind");

      Res : constant C_Int := Behind (Frm);
   begin
      if Res = Curses_False then
         return False;
      else
         return True;
      end if;
   end Data_Behind;
   --  |
   --  |=====================================================================
   --  | man page form_driver.3x
   --  |=====================================================================
   --  |
   --  |
   --  |
   function Driver (Frm : Form;
                    Key : Key_Code) return Driver_Result
   is
      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));
   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;
         when others =>
            Eti_Exception (R);
            return Form_Ok;
      end case;
   end Driver;
   --  |
   --  |=====================================================================
   --  | man page form_page.3x
   --  |=====================================================================
   --  |
   --  |
   --  |
   procedure Set_Current (Frm : Form;
                          Fld : Field)
   is
      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;
   --  |
   --  |
   --  |
   function Current (Frm : Form) return Field
   is
      function Current_Fld (Frm : Form) return Field;
      pragma Import (C, Current_Fld, "current_field");

      Fld : constant Field := Current_Fld (Frm);
   begin
      if Fld = Null_Field then
         raise Form_Exception;
      end if;
      return Fld;
   end Current;
   --  |
   --  |
   --  |
   procedure Set_Page (Frm  : Form;
                       Page : Page_Number := Page_Number'First)
   is
      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;
   --  |
   --  |
   --  |
   function Page (Frm : Form) return Page_Number
   is
      function Get_Page (Frm : Form) return C_Int;
      pragma Import (C, Get_Page, "form_page");

      P : constant C_Int := Get_Page (Frm);
   begin
      if P < 0 then
         raise Form_Exception;
      else
         return Page_Number (P);
      end if;
   end Page;

   function Get_Index (Fld : Field) return Positive
   is
      function Get_Fieldindex (Fld : Field) return C_Int;
      pragma Import (C, Get_Fieldindex, "field_index");

      Res : constant C_Int := Get_Fieldindex (Fld);
   begin
      if Res = Curses_Err then
         raise Form_Exception;
      end if;
      return Positive (Natural (Res) + Positive'First);
   end Get_Index;

   --  |
   --  |=====================================================================
   --  | man page form_new_page.3x
   --  |=====================================================================
   --  |
   --  |
   --  |
   procedure Set_New_Page (Fld      : Field;
                           New_Page : Boolean := True)
   is
      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;
   --  |
   --  |
   --  |
   function Is_New_Page (Fld : Field) return Boolean
   is
      function Is_New (Fld : Field) return C_Int;
      pragma Import (C, Is_New, "new_page");

      Res : constant C_Int := Is_New (Fld);
   begin
      if Res = Curses_False then
         return False;
      else
         return True;
      end if;
   end Is_New_Page;

   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);
   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));
            end if;
         end loop;
      end if;
      Release (FA);
   end Free;

   --  |=====================================================================

   function Default_Field_Options return Field_Option_Set
   is
   begin
      return Get_Options (Null_Field);
   end Default_Field_Options;

   function Default_Form_Options return Form_Option_Set
   is
   begin
      return Get_Options (Null_Form);
   end Default_Form_Options;

end Terminal_Interface.Curses.Forms;