1 ------------------------------------------------------------------------------
3 -- GNAT ncurses Binding Samples --
5 -- Sample.Function_Key_Setting --
9 ------------------------------------------------------------------------------
10 -- Copyright 2020 Thomas E. Dickey --
11 -- Copyright 1998-2009,2011 Free Software Foundation, Inc. --
13 -- Permission is hereby granted, free of charge, to any person obtaining a --
14 -- copy of this software and associated documentation files (the --
15 -- "Software"), to deal in the Software without restriction, including --
16 -- without limitation the rights to use, copy, modify, merge, publish, --
17 -- distribute, distribute with modifications, sublicense, and/or sell --
18 -- copies of the Software, and to permit persons to whom the Software is --
19 -- furnished to do so, subject to the following conditions: --
21 -- The above copyright notice and this permission notice shall be included --
22 -- in all copies or substantial portions of the Software. --
24 -- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
25 -- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
26 -- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
27 -- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
28 -- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
29 -- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
30 -- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
32 -- Except as contained in this notice, the name(s) of the above copyright --
33 -- holders shall not be used in advertising or otherwise to promote the --
34 -- sale, use or other dealings in this Software without prior written --
36 ------------------------------------------------------------------------------
37 -- Author: Juergen Pfeifer, 1996
40 -- $Date: 2020/02/02 23:34:34 $
41 -- Binding Version 01.00
42 ------------------------------------------------------------------------------
43 with Ada.Unchecked_Deallocation;
44 with Sample.Manifest; use Sample.Manifest;
46 -- This package implements a simple stack of function key label environments.
48 package body Sample.Function_Key_Setting is
50 Max_Label_Length : constant Positive := 8;
51 Number_Of_Keys : Label_Number := Label_Number'Last;
52 Justification : Label_Justification := Left;
54 subtype Label is String (1 .. Max_Label_Length);
55 type Label_Array is array (Label_Number range <>) of Label;
57 type Key_Environment (N : Label_Number := Label_Number'Last);
58 type Env_Ptr is access Key_Environment;
59 pragma Controlled (Env_Ptr);
61 type String_Access is access String;
62 pragma Controlled (String_Access);
64 Active_Context : String_Access := new String'("MAIN");
65 Active_Notepad : Panel := Null_Panel;
67 type Key_Environment (N : Label_Number := Label_Number'Last) is
72 Labels : Label_Array (1 .. N);
75 procedure Release_String is
76 new Ada.Unchecked_Deallocation (String,
79 procedure Release_Environment is
80 new Ada.Unchecked_Deallocation (Key_Environment,
83 Top_Of_Stack : Env_Ptr := null;
85 procedure Push_Environment (Key : String;
86 Reset : Boolean := True)
88 P : constant Env_Ptr := new Key_Environment (Number_Of_Keys);
90 -- Store the current labels in the environment
91 for I in 1 .. Number_Of_Keys loop
92 Get_Soft_Label_Key (I, P.all.Labels (I));
94 Set_Soft_Label_Key (I, " ");
97 P.all.Prev := Top_Of_Stack;
98 -- now store active help context and notepad
99 P.all.Help := Active_Context;
100 P.all.Notepad := Active_Notepad;
101 -- The notepad must now vanish and the new notepad is empty.
102 if P.all.Notepad /= Null_Panel then
103 Hide (P.all.Notepad);
106 Active_Notepad := Null_Panel;
107 Active_Context := new String'(Key);
111 Refresh_Soft_Label_Keys_Without_Update;
113 end Push_Environment;
115 procedure Pop_Environment
117 P : Env_Ptr := Top_Of_Stack;
119 if Top_Of_Stack = null then
120 raise Function_Key_Stack_Error;
122 for I in 1 .. Number_Of_Keys loop
123 Set_Soft_Label_Key (I, P.all.Labels (I), Justification);
125 pragma Assert (Active_Context /= null);
126 Release_String (Active_Context);
127 Active_Context := P.all.Help;
128 Refresh_Soft_Label_Keys_Without_Update;
129 Notepad_To_Context (P.all.Notepad);
130 Top_Of_Stack := P.all.Prev;
131 Release_Environment (P);
135 function Context return String
138 if Active_Context /= null then
139 return Active_Context.all;
145 function Find_Context (Key : String) return Boolean
147 P : Env_Ptr := Top_Of_Stack;
149 if Active_Context.all = Key then
154 if P.all.Help.all = Key then
164 procedure Notepad_To_Context (Pan : Panel)
168 if Active_Notepad /= Null_Panel then
169 W := Get_Window (Active_Notepad);
171 Delete (Active_Notepad);
174 Active_Notepad := Pan;
175 if Pan /= Null_Panel then
180 end Notepad_To_Context;
182 procedure Initialize (Mode : Soft_Label_Key_Format := PC_Style;
183 Just : Label_Justification := Left)
187 when PC_Style .. PC_Style_With_Index
188 => Number_Of_Keys := 12;
190 => Number_Of_Keys := 8;
192 Init_Soft_Label_Keys (Mode);
193 Justification := Just;
196 procedure Default_Labels
199 Set_Soft_Label_Key (FKEY_QUIT, "Quit");
200 Set_Soft_Label_Key (FKEY_HELP, "Help");
201 Set_Soft_Label_Key (FKEY_EXPLAIN, "Keys");
202 Refresh_Soft_Label_Keys_Without_Update;
205 function Notepad_Window return Window
208 if Active_Notepad /= Null_Panel then
209 return Get_Window (Active_Notepad);
215 end Sample.Function_Key_Setting;