1 ------------------------------------------------------------------------------
3 -- GNAT ncurses Binding Samples --
5 -- Sample.Function_Key_Setting --
9 ------------------------------------------------------------------------------
10 -- Copyright (c) 1998-2009,2011 Free Software Foundation, Inc. --
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: --
20 -- The above copyright notice and this permission notice shall be included --
21 -- in all copies or substantial portions of the Software. --
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. --
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 --
35 ------------------------------------------------------------------------------
36 -- Author: Juergen Pfeifer, 1996
39 -- $Date: 2011/03/23 00:44:12 $
40 -- Binding Version 01.00
41 ------------------------------------------------------------------------------
42 with Ada.Unchecked_Deallocation;
43 with Sample.Manifest; use Sample.Manifest;
45 -- This package implements a simple stack of function key label environments.
47 package body Sample.Function_Key_Setting is
49 Max_Label_Length : constant Positive := 8;
50 Number_Of_Keys : Label_Number := Label_Number'Last;
51 Justification : Label_Justification := Left;
53 subtype Label is String (1 .. Max_Label_Length);
54 type Label_Array is array (Label_Number range <>) of Label;
56 type Key_Environment (N : Label_Number := Label_Number'Last);
57 type Env_Ptr is access Key_Environment;
58 pragma Controlled (Env_Ptr);
60 type String_Access is access String;
61 pragma Controlled (String_Access);
63 Active_Context : String_Access := new String'("MAIN");
64 Active_Notepad : Panel := Null_Panel;
66 type Key_Environment (N : Label_Number := Label_Number'Last) is
71 Labels : Label_Array (1 .. N);
74 procedure Release_String is
75 new Ada.Unchecked_Deallocation (String,
78 procedure Release_Environment is
79 new Ada.Unchecked_Deallocation (Key_Environment,
82 Top_Of_Stack : Env_Ptr := null;
84 procedure Push_Environment (Key : String;
85 Reset : Boolean := True)
87 P : constant Env_Ptr := new Key_Environment (Number_Of_Keys);
89 -- Store the current labels in the environment
90 for I in 1 .. Number_Of_Keys loop
91 Get_Soft_Label_Key (I, P.all.Labels (I));
93 Set_Soft_Label_Key (I, " ");
96 P.all.Prev := Top_Of_Stack;
97 -- now store active help context and notepad
98 P.all.Help := Active_Context;
99 P.all.Notepad := Active_Notepad;
100 -- The notepad must now vanish and the new notepad is empty.
101 if P.all.Notepad /= Null_Panel then
102 Hide (P.all.Notepad);
105 Active_Notepad := Null_Panel;
106 Active_Context := new String'(Key);
110 Refresh_Soft_Label_Keys_Without_Update;
112 end Push_Environment;
114 procedure Pop_Environment
116 P : Env_Ptr := Top_Of_Stack;
118 if Top_Of_Stack = null then
119 raise Function_Key_Stack_Error;
121 for I in 1 .. Number_Of_Keys loop
122 Set_Soft_Label_Key (I, P.all.Labels (I), Justification);
124 pragma Assert (Active_Context /= null);
125 Release_String (Active_Context);
126 Active_Context := P.all.Help;
127 Refresh_Soft_Label_Keys_Without_Update;
128 Notepad_To_Context (P.all.Notepad);
129 Top_Of_Stack := P.all.Prev;
130 Release_Environment (P);
134 function Context return String
137 if Active_Context /= null then
138 return Active_Context.all;
144 function Find_Context (Key : String) return Boolean
146 P : Env_Ptr := Top_Of_Stack;
148 if Active_Context.all = Key then
153 if P.all.Help.all = Key then
163 procedure Notepad_To_Context (Pan : Panel)
167 if Active_Notepad /= Null_Panel then
168 W := Get_Window (Active_Notepad);
170 Delete (Active_Notepad);
173 Active_Notepad := Pan;
174 if Pan /= Null_Panel then
179 end Notepad_To_Context;
181 procedure Initialize (Mode : Soft_Label_Key_Format := PC_Style;
182 Just : Label_Justification := Left)
186 when PC_Style .. PC_Style_With_Index
187 => Number_Of_Keys := 12;
189 => Number_Of_Keys := 8;
191 Init_Soft_Label_Keys (Mode);
192 Justification := Just;
195 procedure Default_Labels
198 Set_Soft_Label_Key (FKEY_QUIT, "Quit");
199 Set_Soft_Label_Key (FKEY_HELP, "Help");
200 Set_Soft_Label_Key (FKEY_EXPLAIN, "Keys");
201 Refresh_Soft_Label_Keys_Without_Update;
204 function Notepad_Window return Window
207 if Active_Notepad /= Null_Panel then
208 return Get_Window (Active_Notepad);
214 end Sample.Function_Key_Setting;