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
;