diff options
Diffstat (limited to 'src/fltk-widgets-menus.ads')
| -rw-r--r-- | src/fltk-widgets-menus.ads | 187 |
1 files changed, 181 insertions, 6 deletions
diff --git a/src/fltk-widgets-menus.ads b/src/fltk-widgets-menus.ads index 1d7b55b..5285414 100644 --- a/src/fltk-widgets-menus.ads +++ b/src/fltk-widgets-menus.ads @@ -12,6 +12,7 @@ with private with Ada.Containers.Vectors, + Ada.Finalization, Interfaces; @@ -30,11 +31,18 @@ package FLTK.Widgets.Menus is subtype Extended_Index is Natural; No_Index : constant Extended_Index := Extended_Index'First; - No_Reference : exception; type Cursor is private; + -- If your menu item path names are longer than this, + -- then calls to Item_Pathname will raise an exception. + Item_Path_Max : constant Integer := 1023; + + + No_Reference_Error : exception; + + package Forge is @@ -50,12 +58,44 @@ package FLTK.Widgets.Menus is procedure Add + (This : in out Menu; + Text : in String); + + function Add + (This : in out Menu; + Text : in String) + return Index; + + procedure Add (This : in out Menu; Text : in String; Action : in Widget_Callback := null; Shortcut : in Key_Combo := No_Key; Flags : in Menu_Flag := Flag_Normal); + function Add + (This : in out Menu; + Text : in String; + Action : in Widget_Callback := null; + Shortcut : in Key_Combo := No_Key; + Flags : in Menu_Flag := Flag_Normal) + return Index; + + procedure Add + (This : in out Menu; + Text : in String; + Action : in Widget_Callback := null; + Shortcut : in String; + Flags : in Menu_Flag := Flag_Normal); + + function Add + (This : in out Menu; + Text : in String; + Action : in Widget_Callback := null; + Shortcut : in String; + Flags : in Menu_Flag := Flag_Normal) + return Index; + procedure Insert (This : in out Menu; Place : in Index; @@ -64,6 +104,40 @@ package FLTK.Widgets.Menus is Shortcut : in Key_Combo := No_Key; Flags : in Menu_Flag := Flag_Normal); + function Insert + (This : in out Menu; + Place : in Index; + Text : in String; + Action : in Widget_Callback := null; + Shortcut : in Key_Combo := No_Key; + Flags : in Menu_Flag := Flag_Normal) + return Index; + + procedure Insert + (This : in out Menu; + Place : in Index; + Text : in String; + Action : in Widget_Callback := null; + Shortcut : in String; + Flags : in Menu_Flag := Flag_Normal); + + function Insert + (This : in out Menu; + Place : in Index; + Text : in String; + Action : in Widget_Callback := null; + Shortcut : in String; + Flags : in Menu_Flag := Flag_Normal) + return Index; + + procedure Set_Items + (This : in out Menu; + Items : in FLTK.Menu_Items.Menu_Item_Array); + + procedure Use_Same_Items + (This : in out Menu; + Donor : in Menu'Class); + procedure Remove (This : in out Menu; Place : in Index); @@ -71,6 +145,10 @@ package FLTK.Widgets.Menus is procedure Clear (This : in out Menu); + procedure Clear_Submenu + (This : in out Menu; + Place : in Index); + @@ -118,6 +196,16 @@ package FLTK.Widgets.Menus is Action : in Widget_Callback) return Extended_Index; + function Item_Pathname + (This : in Menu) + return String; + + function Item_Pathname + (This : in Menu; + Item : in FLTK.Menu_Items.Menu_Item) + return String; + + -- May not be what you expect due to submenu terminators function Number_Of_Items (This : in Menu) return Natural; @@ -151,10 +239,52 @@ package FLTK.Widgets.Menus is (This : in out Menu; Place : in Index); + function Set_Chosen + (This : in out Menu; + Place : in Index) + return Boolean; + procedure Set_Chosen (This : in out Menu; Item : in FLTK.Menu_Items.Menu_Item); + function Set_Chosen + (This : in out Menu; + Item : in FLTK.Menu_Items.Menu_Item) + return Boolean; + + + + + procedure Set_Only + (This : in out Menu; + Item : in out FLTK.Menu_Items.Menu_Item); + + function Get_Label + (This : in Menu; + Place : in Index) + return String; + + procedure Set_Label + (This : in out Menu; + Place : in Index; + Text : in String); + + procedure Set_Shortcut + (This : in out Menu; + Place : in Index; + Press : in Key_Combo); + + function Get_Flags + (This : in Menu; + Place : in Index) + return Menu_Flag; + + procedure Set_Flags + (This : in out Menu; + Place : in Index; + Flags : in Menu_Flag); + @@ -217,6 +347,32 @@ package FLTK.Widgets.Menus is Initial : in Extended_Index := No_Index) return Extended_Index; + procedure Picked + (This : in out Menu; + Item : in out FLTK.Menu_Items.Menu_Item); + + function Find_Shortcut + (This : in out Menu; + Require_Alt : in Boolean := False) + return access FLTK.Menu_Items.Menu_Item'Class; + + function Find_Shortcut + (This : in out Menu; + Place : out Extended_Index; + Require_Alt : in Boolean := False) + return access FLTK.Menu_Items.Menu_Item'Class; + + function Test_Shortcut + (This : in out Menu) + return access FLTK.Menu_Items.Menu_Item'Class; + + + + + procedure Resize + (This : in out Menu; + W, H : in Integer); + @@ -238,11 +394,13 @@ private type Item_Access is access FLTK.Menu_Items.Menu_Item; package Item_Vectors is new Ada.Containers.Vectors - (Index_Type => Positive, + (Index_Type => Positive, Element_Type => Item_Access); type Menu is new Widget with record My_Items : Item_Vectors.Vector; + My_Find : aliased FLTK.Menu_Items.Menu_Item; + My_Pick : aliased FLTK.Menu_Items.Menu_Item; end record; overriding procedure Initialize @@ -261,10 +419,6 @@ private (This : in out Menu); - procedure Item_Hook (M, U : in Storage.Integer_Address); - pragma Convention (C, Item_Hook); - - type Cursor is record My_Container : access Menu; My_Index : Index'Base := Index'First; @@ -293,6 +447,8 @@ private return Cursor; + pragma Inline (Use_Same_Items); + pragma Inline (Has_Item); pragma Inline (Item); pragma Inline (Find_Item); @@ -306,6 +462,13 @@ private pragma Inline (Chosen_Index); pragma Inline (Set_Chosen); + pragma Inline (Set_Only); + pragma Inline (Get_Label); + pragma Inline (Set_Label); + pragma Inline (Set_Shortcut); + pragma Inline (Get_Flags); + pragma Inline (Set_Flags); + pragma Inline (Get_Text_Color); pragma Inline (Set_Text_Color); pragma Inline (Get_Text_Font); @@ -320,10 +483,22 @@ private pragma Inline (Popup); pragma Inline (Pulldown); + pragma Inline (Picked); + pragma Inline (Test_Shortcut); + + pragma Inline (Resize); pragma Inline (Draw_Item); + type Menu_Final_Controller is new Ada.Finalization.Limited_Controlled with null record; + + overriding procedure Finalize + (This : in out Menu_Final_Controller); + + Cleanup : Menu_Final_Controller; + + end FLTK.Widgets.Menus; |