Ada95/gen/terminal_interface-curses-menus.ads.m4

   1 --  -*- ada -*-
   2 define(`HTMLNAME',`terminal_interface-curses-menus_s.html')dnl
   3 include(M4MACRO)dnl
   4 ------------------------------------------------------------------------------
   5 --                                                                          --
   6 --                           GNAT ncurses Binding                           --
   7 --                                                                          --
   8 --                      Terminal_Interface.Curses.Menu                      --
   9 --                                                                          --
  10 --                                 S P E C                                  --
  11 --                                                                          --
  12 --  Version 00.92                                                           --
  13 --                                                                          --
  14 --  The ncurses Ada95 binding is copyrighted 1996 by                        --
  15 --  Juergen Pfeifer, Email: Juergen.Pfeifer@T-Online.de                     --
  16 --                                                                          --
  17 --  Permission is hereby granted to reproduce and distribute this           --
  18 --  binding by any means and for any fee, whether alone or as part          --
  19 --  of a larger distribution, in source or in binary form, PROVIDED         --
  20 --  this notice is included with any such distribution, and is not          --
  21 --  removed from any of its header files. Mention of ncurses and the        --
  22 --  author of this binding in any applications linked with it is            --
  23 --  highly appreciated.                                                     --
  24 --                                                                          --
  25 --  This binding comes AS IS with no warranty, implied or expressed.        --
  26 ------------------------------------------------------------------------------
  27 --  Version Control:
  28 --  $Revision: 1.7 $
  29 ------------------------------------------------------------------------------
  30 include(`Menu_Base_Defs')
  31 with System;
  32 with Interfaces.C;
  33 with Ada.Characters.Latin_1;
  34
  35 package Terminal_Interface.Curses.Menus is
  36
  37 include(`Menu_Linker_Options')
  38
  39
  40    Space : Character renames Ada.Characters.Latin_1.Space;
  41
  42    type Item is private;
  43    type Menu is private;
  44
  45    ---------------------------
  46    --  Interface constants  --
  47    ---------------------------
  48    Null_Item : constant Item;
  49    Null_Menu : constant Menu;
  50
  51    subtype Menu_Request_Code is Key_Code
  52      range (Key_Max + 1) .. (Key_Max + 17);
  53
  54    --  The prefix M_ stands for "Menu Request"
  55    M_Left_Item       : constant Menu_Request_Code := Key_Max + 1;
  56    M_Right_Item      : constant Menu_Request_Code := Key_Max + 2;
  57    M_Up_Item         : constant Menu_Request_Code := Key_Max + 3;
  58    M_Down_Item       : constant Menu_Request_Code := Key_Max + 4;
  59    M_ScrollUp_Line   : constant Menu_Request_Code := Key_Max + 5;
  60    M_ScrollDown_Line : constant Menu_Request_Code := Key_Max + 6;
  61    M_ScrollDown_Page : constant Menu_Request_Code := Key_Max + 7;
  62    M_ScrollUp_Page   : constant Menu_Request_Code := Key_Max + 8;
  63    M_First_Item      : constant Menu_Request_Code := Key_Max + 9;
  64    M_Last_Item       : constant Menu_Request_Code := Key_Max + 10;
  65    M_Next_Item       : constant Menu_Request_Code := Key_Max + 11;
  66    M_Previous_Item   : constant Menu_Request_Code := Key_Max + 12;
  67    M_Toggle_Item     : constant Menu_Request_Code := Key_Max + 13;
  68    M_Clear_Pattern   : constant Menu_Request_Code := Key_Max + 14;
  69    M_Back_Pattern    : constant Menu_Request_Code := Key_Max + 15;
  70    M_Next_Match      : constant Menu_Request_Code := Key_Max + 16;
  71    M_Previous_Match  : constant Menu_Request_Code := Key_Max + 17;
  72
  73    --  For those who like the old 'C' names for the request codes
  74    REQ_LEFT_ITEM     : Menu_Request_Code renames M_Left_Item;
  75    REQ_RIGHT_ITEM    : Menu_Request_Code renames M_Right_Item;
  76    REQ_UP_ITEM       : Menu_Request_Code renames M_Up_Item;
  77    REQ_DOWN_ITEM     : Menu_Request_Code renames M_Down_Item;
  78    REQ_SCR_ULINE     : Menu_Request_Code renames M_ScrollUp_Line;
  79    REQ_SCR_DLINE     : Menu_Request_Code renames M_ScrollDown_Line;
  80    REQ_SCR_DPAGE     : Menu_Request_Code renames M_ScrollDown_Page;
  81    REQ_SCR_UPAGE     : Menu_Request_Code renames M_ScrollUp_Page;
  82    REQ_FIRST_ITEM    : Menu_Request_Code renames M_First_Item;
  83    REQ_LAST_ITEM     : Menu_Request_Code renames M_Last_Item;
  84    REQ_NEXT_ITEM     : Menu_Request_Code renames M_Next_Item;
  85    REQ_PREV_ITEM     : Menu_Request_Code renames M_Previous_Item;
  86    REQ_TOGGLE_ITEM   : Menu_Request_Code renames M_Toggle_Item;
  87    REQ_CLEAR_PATTERN : Menu_Request_Code renames M_Clear_Pattern;
  88    REQ_BACK_PATTERN  : Menu_Request_Code renames M_Back_Pattern;
  89    REQ_NEXT_MATCH    : Menu_Request_Code renames M_Next_Match;
  90    REQ_PREV_MATCH    : Menu_Request_Code renames M_Previous_Match;
  91
  92    procedure Request_Name (Key  : in Menu_Request_Code;
  93                            Name : out String);
  94
  95    ------------------
  96    --  Exceptions  --
  97    ------------------
  98
  99    Menu_Exception : exception;
 100    --
 101    --  Menu options
 102    --
 103
 104 include(`Menu_Opt_Rep')
 105
 106    Default_Menu_Options : Menu_Option_Set;
 107    --  Initial default options for a menu.
 108
 109    --
 110    --  Item options
 111    --
 112 include(`Item_Rep')
 113
 114    Default_Item_Options : Item_Option_Set;
 115    --  Initial default options for an item.
 116
 117    --
 118    --  Item Array
 119    --
 120    type Item_Array is array (Positive range <>) of aliased Item;
 121    pragma Convention (C, Item_Array);
 122
 123    type Item_Array_Access is access all Item_Array;
 124
 125    --  MANPAGE(`mitem_new.3x')
 126
 127    --  ANCHOR(`new_item()',`Create')
 128    function Create (Name        : String;
 129                     Description : String := "") return Item;
 130    --  AKA
 131
 132    --  ANCHOR(`new_item()',`New_Item')
 133    function New_Item (Name        : String;
 134                       Description : String := "") return Item
 135      renames Create;
 136    --  AKA
 137
 138    --  ANCHOR(`free_item()',`Delete')
 139    procedure Delete (Itm : in out Item);
 140    --  AKA
 141    --  Resets Itm to Null_Item
 142
 143    --  MANPAGE(`mitem_value.3x')
 144
 145    --  ANCHOR(`set_item_value()',`Set_Value')
 146    procedure Set_Value (Itm   : in Item;
 147                         Value : in Boolean := True);
 148    --  AKA
 149
 150    --  ANCHOR(`item_value()',`Value')
 151    function Value (Itm : Item) return Boolean;
 152    --  AKA
 153
 154    --  MANPAGE(`mitem_visible.3x')
 155
 156    --  ANCHOR(`item_visible()',`Visible')
 157    function Visible (Itm : Item) return Boolean;
 158    --  AKA
 159
 160    --  MANPAGE(`mitem_opts.3x')
 161
 162    --  ANCHOR(`set_item_opts()',`Set_Options')
 163    procedure Set_Options (Itm     : in Item;
 164                           Options : in Item_Option_Set);
 165    --  AKA
 166
 167    --  ANCHOR(`item_opts_on()',`Switch_Options')
 168    procedure Switch_Options (Itm     : in Item;
 169                              Options : in Item_Option_Set;
 170                              On      : Boolean := True);
 171    --  AKA
 172    --  ALIAS(`item_opts_off()')
 173
 174    --  ANCHOR(`item_opts()',`Get_Options')
 175    procedure Get_Options (Itm     : in  Item;
 176                           Options : out Item_Option_Set);
 177    --  AKA
 178
 179    --  ANCHOR(`item_opts()',`Get_Options')
 180    function Get_Options (Itm : Item := Null_Item) return Item_Option_Set;
 181    --  AKA
 182
 183    --  MANPAGE(`mitem_name.3x')
 184
 185    --  ANCHOR(`item_name()',`Name')
 186    procedure Name (Itm  : in Item;
 187                    Name : out String);
 188    --  AKA
 189
 190    --  ANCHOR(`item_description();',`Description')
 191    procedure Description (Itm         : in Item;
 192                           Description : out String);
 193    --  AKA
 194
 195    --  MANPAGE(`mitem_current.3x')
 196
 197    --  ANCHOR(`set_current_item()',`Set_Current')
 198    procedure Set_Current (Men : in Menu;
 199                           Itm : in Item);
 200    --  AKA
 201
 202    --  ANCHOR(`current_item()',`Current')
 203    function Current (Men : Menu) return Item;
 204    --  AKA
 205
 206    --  ANCHOR(`set_top_row()',`Set_Top_Row')
 207    procedure Set_Top_Row (Men  : in Menu;
 208                           Line : in Line_Position);
 209    --  AKA
 210
 211    --  ANCHOR(`top_row()',`Top_Row')
 212    function Top_Row (Men : Menu) return Line_Position;
 213    --  AKA
 214
 215    --  ANCHOR(`item_index()',`Get_Index')
 216    function Get_Index (Itm : Item) return Positive;
 217    --  AKA
 218    --  Please note that in this binding we start the numbering of items
 219    --  with 1. So this is number is one more than you get from the low
 220    --  level call.
 221
 222    --  MANPAGE(`menu_post.3x')
 223
 224    --  ANCHOR(`post_menu()',`Post')
 225    procedure Post (Men  : in Menu;
 226                    Post : in Boolean := True);
 227    --  AKA
 228    --  ALIAS(`unpost_menu()')
 229
 230    --  MANPAGE(`menu_opts.3x')
 231
 232    --  ANCHOR(`set_menu_opts()',`Set_Options')
 233    procedure Set_Options (Men     : in Menu;
 234                           Options : in Menu_Option_Set);
 235    --  AKA
 236
 237    --  ANCHOR(`menu_opts_on()',`Switch_Options')
 238    procedure Switch_Options (Men     : in Menu;
 239                              Options : in Menu_Option_Set;
 240                              On      : Boolean := True);
 241    --  AKA
 242    --  ALIAS(`menu_opts_off()')
 243
 244    --  ANCHOR(`menu_opts()',`Get_Options')
 245    procedure Get_Options (Men     : in  Menu;
 246                           Options : out Menu_Option_Set);
 247    --  AKA
 248
 249    --  ANCHOR(`menu_opts()',`Get_Options')
 250    function Get_Options (Men : Menu := Null_Menu) return Menu_Option_Set;
 251    --  AKA
 252
 253    --  MANPAGE(`menu_win.3x')
 254
 255    --  ANCHOR(`set_menu_win()',`Set_Window')
 256    procedure Set_Window (Men : in Menu;
 257                          Win : in Window);
 258    --  AKA
 259
 260    --  ANCHOR(`menu_win()',`Get_Window')
 261    function Get_Window (Men : Menu) return Window;
 262    --  AKA
 263
 264    --  ANCHOR(`set_menu_sub()',`Set_Sub_Window')
 265    procedure Set_Sub_Window (Men : in Menu;
 266                              Win : in Window);
 267    --  AKA
 268
 269    --  ANCHOR(`menu_sub()',`Get_Sub_Window')
 270    function Get_Sub_Window (Men : Menu) return Window;
 271    --  AKA
 272
 273    --  ANCHOR(`scale_menu()',`Scale')
 274    procedure Scale (Men     : in Menu;
 275                     Lines   : out Line_Count;
 276                     Columns : out Column_Count);
 277    --  AKA
 278
 279    --  MANPAGE(`menu_cursor.3x')
 280
 281    --  ANCHOR(`pos_menu_cursor()',`Position_Cursor')
 282    procedure Position_Cursor (Men : Menu);
 283    --  AKA
 284
 285    --  MANPAGE(`menu_mark.3x')
 286
 287    --  ANCHOR(`set_menu_mark()',`Set_Mark')
 288    procedure Set_Mark (Men  : in Menu;
 289                        Mark : in String);
 290    --  AKA
 291
 292    --  ANCHOR(`menu_mark()',`Mark')
 293    procedure Mark (Men  : in  Menu;
 294                    Mark : out String);
 295    --  AKA
 296
 297    --  MANPAGE(`menu_attribs.3x')
 298
 299    --  ANCHOR(`set_menu_fore()',`Set_Foreground')
 300    procedure Set_Foreground
 301      (Men   : in Menu;
 302       Fore  : in Character_Attribute_Set := Normal_Video;
 303       Color : in Color_Pair := Color_Pair'First);
 304    --  AKA
 305
 306    --  ANCHOR(`menu_fore()',`Foreground')
 307    procedure Foreground (Men   : in  Menu;
 308                          Fore  : out Character_Attribute_Set);
 309    --  AKA
 310
 311    --  ANCHOR(`menu_fore()',`Foreground')
 312    procedure Foreground (Men   : in  Menu;
 313                          Fore  : out Character_Attribute_Set;
 314                          Color : out Color_Pair);
 315    --  AKA
 316
 317    --  ANCHOR(`set_menu_back()',`Set_Background')
 318    procedure Set_Background
 319      (Men   : in Menu;
 320       Back  : in Character_Attribute_Set := Normal_Video;
 321       Color : in Color_Pair := Color_Pair'First);
 322    --  AKA
 323
 324    --  ANCHOR(`menu_back()',`Background')
 325    procedure Background (Men  : in  Menu;
 326                          Back : out Character_Attribute_Set);
 327    --  AKA
 328    --  ANCHOR(`menu_back()',`Background')
 329
 330    procedure Background (Men   : in  Menu;
 331                          Back  : out Character_Attribute_Set;
 332                          Color : out Color_Pair);
 333    --  AKA
 334
 335    --  ANCHOR(`set_menu_grey()',`Set_Grey')
 336    procedure Set_Grey
 337      (Men   : in Menu;
 338       Grey  : in Character_Attribute_Set := Normal_Video;
 339       Color : in Color_Pair := Color_Pair'First);
 340    --  AKA
 341
 342    --  ANCHOR(`menu_grey()',`Grey')
 343    procedure Grey (Men  : in  Menu;
 344                    Grey : out Character_Attribute_Set);
 345    --  AKA
 346
 347    --  ANCHOR(`menu_grey()',`Grey')
 348    procedure Grey
 349      (Men   : in  Menu;
 350       Grey  : out Character_Attribute_Set;
 351       Color : out Color_Pair);
 352    --  AKA
 353
 354    --  ANCHOR(`set_menu_pad()',`Set_Pad_Character')
 355    procedure Set_Pad_Character (Men : in Menu;
 356                                 Pad : in Character := Space);
 357    --  AKA
 358
 359    --  ANCHOR(`menu_pad()',`Pad_Character')
 360    procedure Pad_Character (Men : in  Menu;
 361                             Pad : out Character);
 362    --  AKA
 363
 364    --  MANPAGE(`menu_spacing.3x')
 365
 366    --  ANCHOR(`set_menu_spacing()',`Set_Spacing')
 367    procedure Set_Spacing (Men   : in Menu;
 368                           Descr : in Column_Position := 0;
 369                           Row   : in Line_Position   := 0;
 370                           Col   : in Column_Position := 0);
 371    --  AKA
 372
 373    --  ANCHOR(`menu_spacing()',`Spacing')
 374    procedure Spacing (Men   : in Menu;
 375                       Descr : out Column_Position;
 376                       Row   : out Line_Position;
 377                       Col   : out Column_Position);
 378    --  AKA
 379
 380    --  MANPAGE(`menu_pattern.3x')
 381
 382    --  ANCHOR(`set_menu_pattern()',`Set_Pattern')
 383    function Set_Pattern (Men  : Menu;
 384                          Text : String) return Boolean;
 385    --  AKA
 386    --  Return TRUE if the pattern matches, FALSE otherwise
 387
 388    --  ANCHOR(`menu_pattern()',`Pattern')
 389    procedure Pattern (Men  : in  Menu;
 390                       Text : out String);
 391    --  AKA
 392
 393    --  MANPAGE(`menu_format.3x')
 394
 395    --  ANCHOR(`set_menu_format()',`Set_Format')
 396    procedure Set_Format (Men     : in Menu;
 397                          Lines   : in Line_Count;
 398                          Columns : in Column_Count);
 399    --  AKA
 400
 401    --  ANCHOR(`menu_format()',`Format')
 402    procedure Format (Men     : in  Menu;
 403                      Lines   : out Line_Count;
 404                      Columns : out Column_Count);
 405    --  AKA
 406
 407    --  MANPAGE(`menu_hook.3x')
 408
 409    type Menu_Hook_Function is access procedure (Men : in Menu);
 410    pragma Convention (C, Menu_Hook_Function);
 411
 412    --  ANCHOR(`set_item_init()',`Set_Item_Init_Hook')
 413    procedure Set_Item_Init_Hook (Men  : in Menu;
 414                                  Proc : in Menu_Hook_Function);
 415    --  AKA
 416
 417    --  ANCHOR(`set_item_term()',`Set_Item_Term_Hook')
 418    procedure Set_Item_Term_Hook (Men  : in Menu;
 419                                  Proc : in Menu_Hook_Function);
 420    --  AKA
 421
 422    --  ANCHOR(`set_menu_init()',`Set_Menu_Init_Hook')
 423    procedure Set_Menu_Init_Hook (Men  : in Menu;
 424                                  Proc : in Menu_Hook_Function);
 425    --  AKA
 426
 427    --  ANCHOR(`set_menu_term()',`Set_Menu_Term_Hook')
 428    procedure Set_Menu_Term_Hook (Men  : in Menu;
 429                                  Proc : in Menu_Hook_Function);
 430    --  AKA
 431
 432    --  ANCHOR(`item_init()',`Get_Item_Init_Hook')
 433    function Get_Item_Init_Hook (Men : Menu) return Menu_Hook_Function;
 434    --  AKA
 435
 436    --  ANCHOR(`item_term()',`Get_Item_Term_Hook')
 437    function Get_Item_Term_Hook (Men : Menu) return Menu_Hook_Function;
 438    --  AKA
 439
 440    --  ANCHOR(`menu_init()',`Get_Menu_Init_Hook')
 441    function Get_Menu_Init_Hook (Men : Menu) return Menu_Hook_Function;
 442    --  AKA
 443
 444    --  ANCHOR(`menu_term()',`Get_Menu_Term_Hook')
 445    function Get_Menu_Term_Hook (Men : Menu) return Menu_Hook_Function;
 446    --  AKA
 447
 448    --  MANPAGE(`menu_items.3x')
 449
 450    --  ANCHOR(`set_menu_items()',`Redefine')
 451    procedure Redefine (Men   : in Menu;
 452                        Items : in Item_Array);
 453    --  AKA
 454    --  With a bit more comfort. You don´t need to terminate the Item_Array
 455    --  with a null entry. This is handled internally in the binding.
 456
 457    procedure Set_Items (Men   : in Menu;
 458                         Items : in Item_Array) renames Redefine;
 459
 460    --  ANCHOR(`menu_items()',`Items')
 461    function Items (Men : Menu) return Item_Array_Access;
 462    --  AKA
 463
 464    --  ANCHOR(`item_count()',`Item_Count')
 465    function Item_Count (Men : Menu) return Natural;
 466    --  AKA
 467
 468    --  MANPAGE(`menu_new.3x')
 469
 470    --  ANCHOR(`new_menu()',`Create')
 471    function Create (Items : Item_Array) return Menu;
 472    --  AKA
 473
 474    function New_Menu (Items : Item_Array) return Menu renames Create;
 475
 476    --  ANCHOR(`free_menu()',`Delete')
 477    procedure Delete (Men : in out Menu);
 478    --  AKA
 479    --  Reset Men to Null_Menu
 480
 481    --  MANPAGE(`menu_new.3x')
 482
 483    type Driver_Result is (Menu_Ok,
 484                           Request_Denied,
 485                           Unknown_Request,
 486                           No_Match);
 487
 488    --  ANCHOR(`menu_driver()',`Driver')
 489    function Driver (Men : Menu;
 490                     Key : Key_Code) return Driver_Result;
 491    --  AKA
 492
 493 -------------------------------------------------------------------------------
 494 private
 495    type Item   is new System.Address;
 496    type Menu   is new System.Address;
 497
 498    Null_Item : constant Item := Item (System.Null_Address);
 499    Null_Menu : constant Menu := Menu (System.Null_Address);
 500
 501    --  This binding uses the original user pointer mechanism of a menu to store
 502    --  specific informations about a menu. This wrapper record carries this
 503    --  specifics and contains a field to maintain a new user pointer. Please
 504    --  note that you must take this into account if you wan't to use the user
 505    --  pointer mechanism of a menu created with this binding in low-level C
 506    --  routines.
 507    type Ada_User_Wrapper is
 508       record
 509          U : System.Address;
 510          I : Item_Array_Access;
 511       end record;
 512    pragma Convention (C, Ada_User_Wrapper);
 513    type Ada_User_Wrapper_Access is access all Ada_User_Wrapper;
 514    pragma Controlled (Ada_User_Wrapper_Access);
 515
 516    Generation_Bit_Order : constant System.Bit_Order := System.M4_BIT_ORDER;
 517    --  This constant may be different on your system.
 518
 519 end Terminal_Interface.Curses.Menus;