1 ------------------------------------------------------------------------------
3 -- GNAT ncurses Binding Samples --
5 -- Sample.Function_Key_Setting --
9 ------------------------------------------------------------------------------
10 -- Copyright (c) 1998 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 <juergen.pfeifer@gmx.net> 1996
39 -- Binding Version 01.00
40 ------------------------------------------------------------------------------
41 with Ada.Unchecked_Deallocation;
42 with Sample.Manifest; use Sample.Manifest;
44 -- This package implements a simple stack of function key label environments.
46 package body Sample.Function_Key_Setting is
48 Max_Label_Length : constant Positive := 8;
49 Number_Of_Keys : Label_Number := Label_Number'Last;
50 Justification : Label_Justification := Left;
52 subtype Label is String (1 .. Max_Label_Length);
53 type Label_Array is array (Label_Number range <>) of Label;
55 type Key_Environment (N : Label_Number := Label_Number'Last);
56 type Env_Ptr is access Key_Environment;
57 pragma Controlled (Env_Ptr);
59 type String_Access is access String;
60 pragma Controlled (String_Access);
62 Active_Context : String_Access := new String'("MAIN");
63 Active_Notepad : Panel := Null_Panel;
65 type Key_Environment (N : Label_Number := Label_Number'Last) is
70 Labels : Label_Array (1 .. N);
73 procedure Release_String is
74 new Ada.Unchecked_Deallocation (String,
77 procedure Release_Environment is
78 new Ada.Unchecked_Deallocation (Key_Environment,
81 Top_Of_Stack : Env_Ptr := null;
83 procedure Push_Environment (Key : in String;
84 Reset : in Boolean := True)
86 P : constant Env_Ptr := new Key_Environment (Number_Of_Keys);
88 -- Store the current labels in the environment
89 for I in 1 .. Number_Of_Keys loop
90 Get_Soft_Label_Key (I, P.Labels (I));
92 Set_Soft_Label_Key (I, " ");
95 P.Prev := Top_Of_Stack;
96 -- now store active help context and notepad
97 P.Help := Active_Context;
98 P.Notepad := Active_Notepad;
99 -- The notepad must now vanish and the new notepad is empty.
100 if (P.Notepad /= Null_Panel) then
104 Active_Notepad := Null_Panel;
105 Active_Context := new String'(Key);
109 Refresh_Soft_Label_Keys_Without_Update;
111 end Push_Environment;
113 procedure Pop_Environment
115 P : Env_Ptr := Top_Of_Stack;
117 if Top_Of_Stack = null then
118 raise Function_Key_Stack_Error;
120 for I in 1 .. Number_Of_Keys loop
121 Set_Soft_Label_Key (I, P.Labels (I), Justification);
123 pragma Assert (Active_Context /= null);
124 Release_String (Active_Context);
125 Active_Context := P.Help;
126 Refresh_Soft_Label_Keys_Without_Update;
127 Notepad_To_Context (P.Notepad);
128 Top_Of_Stack := P.Prev;
129 Release_Environment (P);
133 function Context return String
136 if Active_Context /= null then
137 return Active_Context.all;
143 function Find_Context (Key : String) return Boolean
145 P : Env_Ptr := Top_Of_Stack;
147 if Active_Context.all = Key then
152 if P.Help.all = Key then
162 procedure Notepad_To_Context (Pan : in Panel)
166 if Active_Notepad /= Null_Panel then
167 W := Get_Window (Active_Notepad);
169 Delete (Active_Notepad);
172 Active_Notepad := Pan;
173 if Pan /= Null_Panel then
178 end Notepad_To_Context;
180 procedure Initialize (Mode : Soft_Label_Key_Format := PC_Style;
181 Just : Label_Justification := Left)
185 when PC_Style .. PC_Style_With_Index
186 => Number_Of_Keys := 12;
188 => Number_Of_Keys := 8;
190 Init_Soft_Label_Keys (Mode);
191 Justification := Just;
194 procedure Default_Labels
197 Set_Soft_Label_Key (FKEY_QUIT, "Quit");
198 Set_Soft_Label_Key (FKEY_HELP, "Help");
199 Set_Soft_Label_Key (FKEY_EXPLAIN, "Keys");
200 Refresh_Soft_Label_Keys_Without_Update;
203 function Notepad_Window return Window
206 if Active_Notepad /= Null_Panel then
207 return Get_Window (Active_Notepad);
213 end Sample.Function_Key_Setting;