]> ncurses.scripts.mit.edu Git - ncurses.git/blobdiff - Ada95/src/terminal_interface-curses-menus.adb
projects / ncurses.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
ncurses 5.0
[ncurses.git] / Ada95 / src / terminal_interface-curses-menus.adb
diff --git a/Ada95/ada_include/terminal_interface-curses-menus.adb b/Ada95/src/terminal_interface-curses-menus.adb
similarity index 92%
rename from Ada95/ada_include/terminal_interface-curses-menus.adb
rename to Ada95/src/terminal_interface-curses-menus.adb
index 2df514ec4bcd415a1c90f7fde7d2af44cafea377..92ae0f9c2d1b1dc06849375e2deda7c8231d6ef4 100644 (file)
--- a/Ada95/ada_include/terminal_interface-curses-menus.adb
+++ b/Ada95/src/terminal_interface-curses-menus.adb
@@ -33,40 +33,44 @@
 -- sale, use or other dealings in this Software without prior written       --
 -- authorization.                                                           --
 ------------------------------------------------------------------------------
---  Author: Juergen Pfeifer <Juergen.Pfeifer@T-Online.de> 1996
+--  Author: Juergen Pfeifer <juergen.pfeifer@gmx.net> 1996
 --  Version Control:
---  $Revision: 1.13 $
---  Binding Version 00.93
+--  $Revision: 1.20 $
+--  Binding Version 01.00
 ------------------------------------------------------------------------------
 with Ada.Unchecked_Deallocation;
 with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux;
 
 with Interfaces.C; use Interfaces.C;
 with Interfaces.C.Strings; use Interfaces.C.Strings;
-with Terminal_Interface.Curses;
+with Interfaces.C.Pointers;
 
-with Unchecked_Conversion;
+with Ada.Unchecked_Conversion;
 
 package body Terminal_Interface.Curses.Menus is
 
+   type C_Item_Array is array (Natural range <>) of aliased Item;
+   package I_Array is new
+     Interfaces.C.Pointers (Natural, Item, C_Item_Array, Null_Item);
+
    use type System.Bit_Order;
    subtype chars_ptr is Interfaces.C.Strings.chars_ptr;
 
    function MOS_2_CInt is new
-     Unchecked_Conversion (Menu_Option_Set,
-                           C_Int);
+     Ada.Unchecked_Conversion (Menu_Option_Set,
+                               C_Int);
 
    function CInt_2_MOS is new
-     Unchecked_Conversion (C_Int,
-                           Menu_Option_Set);
+     Ada.Unchecked_Conversion (C_Int,
+                               Menu_Option_Set);
 
    function IOS_2_CInt is new
-     Unchecked_Conversion (Item_Option_Set,
-                           C_Int);
+     Ada.Unchecked_Conversion (Item_Option_Set,
+                               C_Int);
 
    function CInt_2_IOS is new
-     Unchecked_Conversion (C_Int,
-                           Item_Option_Set);
+     Ada.Unchecked_Conversion (C_Int,
+                               Item_Option_Set);
 
 ------------------------------------------------------------------------------
    procedure Request_Name (Key  : in Menu_Request_Code;
@@ -89,7 +93,7 @@ package body Terminal_Interface.Curses.Menus is
    function Create (Name        : String;
                     Description : String := "") return Item
    is
-      type Char_Ptr is access all Interfaces.C.Char;
+      type Char_Ptr is access all Interfaces.C.char;
       function Newitem (Name, Desc : Char_Ptr) return Item;
       pragma Import (C, Newitem, "new_item");
 
@@ -183,9 +187,6 @@ package body Terminal_Interface.Curses.Menus is
       end if;
    end Visible;
 -------------------------------------------------------------------------------
-   procedure Normalize_Item_Options (Options : in out C_Int);
-   pragma Import (C, Normalize_Item_Options, "_nc_ada_normalize_item_opts");
-
    procedure Set_Options (Itm     : in Item;
                           Options : in Item_Option_Set)
    is
@@ -196,7 +197,6 @@ package body Terminal_Interface.Curses.Menus is
       Opt : C_Int := IOS_2_CInt (Options);
       Res : Eti_Error;
    begin
-      Normalize_Item_Options (Opt);
       Res := Set_Item_Opts (Itm, Opt);
       if Res /= E_Ok then
          Eti_Exception (Res);
@@ -217,7 +217,6 @@ package body Terminal_Interface.Curses.Menus is
       Opt : C_Int := IOS_2_CInt (Options);
       Err : Eti_Error;
    begin
-      Normalize_Item_Options (Opt);
       if On then
          Err := Item_Opts_On (Itm, Opt);
       else
@@ -236,7 +235,6 @@ package body Terminal_Interface.Curses.Menus is
 
       Res : C_Int := Item_Opts (Itm);
    begin
-      Normalize_Item_Options (Res);
       Options := CInt_2_IOS (Res);
    end Get_Options;
 
@@ -369,9 +367,6 @@ package body Terminal_Interface.Curses.Menus is
       end if;
    end Post;
 -------------------------------------------------------------------------------
-   procedure Normalize_Menu_Options (Options : in out C_Int);
-   pragma Import (C, Normalize_Menu_Options, "_nc_ada_normalize_menu_opts");
-
    procedure Set_Options (Men     : in Menu;
                           Options : in Menu_Option_Set)
    is
@@ -382,7 +377,6 @@ package body Terminal_Interface.Curses.Menus is
       Opt : C_Int := MOS_2_CInt (Options);
       Res : Eti_Error;
    begin
-      Normalize_Menu_Options (Opt);
       Res := Set_Menu_Opts (Men, Opt);
       if  Res /= E_Ok then
          Eti_Exception (Res);
@@ -403,7 +397,6 @@ package body Terminal_Interface.Curses.Menus is
       Opt : C_Int := MOS_2_CInt (Options);
       Err : Eti_Error;
    begin
-      Normalize_Menu_Options (Opt);
       if On then
          Err := Menu_Opts_On  (Men, Opt);
       else
@@ -422,7 +415,6 @@ package body Terminal_Interface.Curses.Menus is
 
       Res : C_Int := Menu_Opts (Men);
    begin
-      Normalize_Menu_Options (Res);
       Options := CInt_2_MOS (Res);
    end Get_Options;
 
@@ -517,7 +509,7 @@ package body Terminal_Interface.Curses.Menus is
    procedure Set_Mark (Men  : in Menu;
                        Mark : in String)
    is
-      type Char_Ptr is access all Interfaces.C.Char;
+      type Char_Ptr is access all Interfaces.C.char;
       function Set_Mark (Men  : Menu;
                          Mark : Char_Ptr) return C_Int;
       pragma Import (C, Set_Mark, "set_menu_mark");
@@ -557,13 +549,13 @@ package body Terminal_Interface.Curses.Menus is
       Color : in Color_Pair := Color_Pair'First)
    is
       function Set_Menu_Fore (Men  : Menu;
-                              Attr : C_Int) return C_Int;
+                              Attr : C_Chtype) return C_Int;
       pragma Import (C, Set_Menu_Fore, "set_menu_fore");
 
       Ch : constant Attributed_Character := (Ch    => Character'First,
                                              Color => Color,
                                              Attr  => Fore);
-      Res : constant Eti_Error := Set_Menu_Fore (Men, Chtype_To_CInt (Ch));
+      Res : constant Eti_Error := Set_Menu_Fore (Men, AttrChar_To_Chtype (Ch));
    begin
       if  Res /= E_Ok then
          Eti_Exception (Res);
@@ -573,21 +565,21 @@ package body Terminal_Interface.Curses.Menus is
    procedure Foreground (Men  : in  Menu;
                          Fore : out Character_Attribute_Set)
    is
-      function Menu_Fore (Men : Menu) return C_Int;
+      function Menu_Fore (Men : Menu) return C_Chtype;
       pragma Import (C, Menu_Fore, "menu_fore");
    begin
-      Fore := CInt_To_Chtype (Menu_Fore (Men)).Attr;
+      Fore := Chtype_To_AttrChar (Menu_Fore (Men)).Attr;
    end Foreground;
 
    procedure Foreground (Men   : in  Menu;
                          Fore  : out Character_Attribute_Set;
                          Color : out Color_Pair)
    is
-      function Menu_Fore (Men : Menu) return C_Int;
+      function Menu_Fore (Men : Menu) return C_Chtype;
       pragma Import (C, Menu_Fore, "menu_fore");
    begin
-      Fore  := CInt_To_Chtype (Menu_Fore (Men)).Attr;
-      Color := CInt_To_Chtype (Menu_Fore (Men)).Color;
+      Fore  := Chtype_To_AttrChar (Menu_Fore (Men)).Attr;
+      Color := Chtype_To_AttrChar (Menu_Fore (Men)).Color;
    end Foreground;
 
    procedure Set_Background
@@ -596,13 +588,13 @@ package body Terminal_Interface.Curses.Menus is
       Color : in Color_Pair := Color_Pair'First)
    is
       function Set_Menu_Back (Men  : Menu;
-                              Attr : C_Int) return C_Int;
+                              Attr : C_Chtype) return C_Int;
       pragma Import (C, Set_Menu_Back, "set_menu_back");
 
       Ch : constant Attributed_Character := (Ch    => Character'First,
                                              Color => Color,
                                              Attr  => Back);
-      Res : constant Eti_Error := Set_Menu_Back (Men, Chtype_To_CInt (Ch));
+      Res : constant Eti_Error := Set_Menu_Back (Men, AttrChar_To_Chtype (Ch));
    begin
       if  Res /= E_Ok then
          Eti_Exception (Res);
@@ -612,21 +604,21 @@ package body Terminal_Interface.Curses.Menus is
    procedure Background (Men  : in  Menu;
                          Back : out Character_Attribute_Set)
    is
-      function Menu_Back (Men : Menu) return C_Int;
+      function Menu_Back (Men : Menu) return C_Chtype;
       pragma Import (C, Menu_Back, "menu_back");
    begin
-      Back := CInt_To_Chtype (Menu_Back (Men)).Attr;
+      Back := Chtype_To_AttrChar (Menu_Back (Men)).Attr;
    end Background;
 
    procedure Background (Men   : in  Menu;
                          Back  : out Character_Attribute_Set;
                          Color : out Color_Pair)
    is
-      function Menu_Back (Men : Menu) return C_Int;
+      function Menu_Back (Men : Menu) return C_Chtype;
       pragma Import (C, Menu_Back, "menu_back");
    begin
-      Back  := CInt_To_Chtype (Menu_Back (Men)).Attr;
-      Color := CInt_To_Chtype (Menu_Back (Men)).Color;
+      Back  := Chtype_To_AttrChar (Menu_Back (Men)).Attr;
+      Color := Chtype_To_AttrChar (Menu_Back (Men)).Color;
    end Background;
 
    procedure Set_Grey (Men   : in Menu;
@@ -634,14 +626,14 @@ package body Terminal_Interface.Curses.Menus is
                        Color : in Color_Pair := Color_Pair'First)
    is
       function Set_Menu_Grey (Men  : Menu;
-                              Attr : C_Int) return C_Int;
+                              Attr : C_Chtype) return C_Int;
       pragma Import (C, Set_Menu_Grey, "set_menu_grey");
 
       Ch : constant Attributed_Character := (Ch    => Character'First,
                                              Color => Color,
                                              Attr  => Grey);
 
-      Res : constant Eti_Error := Set_Menu_Grey (Men, Chtype_To_CInt (Ch));
+      Res : constant Eti_Error := Set_Menu_Grey (Men, AttrChar_To_Chtype (Ch));
    begin
       if  Res /= E_Ok then
          Eti_Exception (Res);
@@ -651,21 +643,21 @@ package body Terminal_Interface.Curses.Menus is
    procedure Grey (Men  : in  Menu;
                    Grey : out Character_Attribute_Set)
    is
-      function Menu_Grey (Men : Menu) return C_Int;
+      function Menu_Grey (Men : Menu) return C_Chtype;
       pragma Import (C, Menu_Grey, "menu_grey");
    begin
-      Grey := CInt_To_Chtype (Menu_Grey (Men)).Attr;
+      Grey := Chtype_To_AttrChar (Menu_Grey (Men)).Attr;
    end Grey;
 
    procedure Grey (Men  : in  Menu;
                    Grey : out Character_Attribute_Set;
                    Color : out Color_Pair)
    is
-      function Menu_Grey (Men : Menu) return C_Int;
+      function Menu_Grey (Men : Menu) return C_Chtype;
       pragma Import (C, Menu_Grey, "menu_grey");
    begin
-      Grey  := CInt_To_Chtype (Menu_Grey (Men)).Attr;
-      Color := CInt_To_Chtype (Menu_Grey (Men)).Color;
+      Grey  := Chtype_To_AttrChar (Menu_Grey (Men)).Attr;
+      Color := Chtype_To_AttrChar (Menu_Grey (Men)).Color;
    end Grey;
 
    procedure Set_Pad_Character (Men : in Menu;
@@ -739,7 +731,7 @@ package body Terminal_Interface.Curses.Menus is
    function Set_Pattern (Men  : Menu;
                          Text : String) return Boolean
    is
-      type Char_Ptr is access all Interfaces.C.Char;
+      type Char_Ptr is access all Interfaces.C.char;
       function Set_Pattern (Men     : Menu;
                             Pattern : Char_Ptr) return C_Int;
       pragma Import (C, Set_Pattern, "set_menu_pattern");
@@ -907,7 +899,7 @@ package body Terminal_Interface.Curses.Menus is
       if Items (Items'Last) /= Null_Item then
          raise Menu_Exception;
       else
-         Res := Set_Items (Men, Items (Items'First)'Address);
+         Res := Set_Items (Men, Items.all'Address);
          if  Res /= E_Ok then
             Eti_Exception (Res);
          end if;
@@ -925,14 +917,18 @@ package body Terminal_Interface.Curses.Menus is
    function Items (Men   : Menu;
                    Index : Positive) return Item
    is
-      function M_Items (Men : Menu;
-                        Idx : C_Int) return Item;
-      pragma Import (C, M_Items, "_nc_get_item");
+      use I_Array;
+
+      function C_Mitems (Men : Menu) return Pointer;
+      pragma Import (C, C_Mitems, "menu_items");
+
+      P : Pointer := C_Mitems (Men);
    begin
-      if Men = Null_Menu or else Index not in 1 .. Item_Count (Men) then
+      if P = null or else Index not in 1 .. Item_Count (Men) then
          raise Menu_Exception;
       else
-         return M_Items (Men, C_Int (Index) - 1);
+         P := P + ptrdiff_t (C_Int (Index) - 1);
+         return P.all;
       end if;
    end Items;
 
@@ -943,13 +939,12 @@ package body Terminal_Interface.Curses.Menus is
       pragma Import (C, Newmenu, "new_menu");
 
       M   : Menu;
-      I   : Item_Array_Access;
    begin
       pragma Assert (Items (Items'Last) = Null_Item);
       if Items (Items'Last) /= Null_Item then
          raise Menu_Exception;
       else
-         M := Newmenu (Items (Items'First)'Address);
+         M := Newmenu (Items.all'Address);
          if M = Null_Menu then
             raise Menu_Exception;
          end if;
ncurses, with patches starting at ncurses-5.6; new users should use https://github.com/ThomasDickey/ncurses-snapshots/