1------------------------------------------------------------------------------ 2-- -- 3-- GNAT ncurses Binding Samples -- 4-- -- 5-- Sample.Function_Key_Setting -- 6-- -- 7-- B O D Y -- 8-- -- 9------------------------------------------------------------------------------ 10-- Copyright 2020 Thomas E. Dickey -- 11-- Copyright 1998-2009,2011 Free Software Foundation, Inc. -- 12-- -- 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: -- 20-- -- 21-- The above copyright notice and this permission notice shall be included -- 22-- in all copies or substantial portions of the Software. -- 23-- -- 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. -- 31-- -- 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 -- 35-- authorization. -- 36------------------------------------------------------------------------------ 37-- Author: Juergen Pfeifer, 1996 38-- Version Control 39-- $Revision: 1.16 $ 40-- $Date: 2020/02/02 23:34:34 $ 41-- Binding Version 01.00 42------------------------------------------------------------------------------ 43with Ada.Unchecked_Deallocation; 44with Sample.Manifest; use Sample.Manifest; 45 46-- This package implements a simple stack of function key label environments. 47-- 48package body Sample.Function_Key_Setting is 49 50 Max_Label_Length : constant Positive := 8; 51 Number_Of_Keys : Label_Number := Label_Number'Last; 52 Justification : Label_Justification := Left; 53 54 subtype Label is String (1 .. Max_Label_Length); 55 type Label_Array is array (Label_Number range <>) of Label; 56 57 type Key_Environment (N : Label_Number := Label_Number'Last); 58 type Env_Ptr is access Key_Environment; 59 pragma Controlled (Env_Ptr); 60 61 type String_Access is access String; 62 pragma Controlled (String_Access); 63 64 Active_Context : String_Access := new String'("MAIN"); 65 Active_Notepad : Panel := Null_Panel; 66 67 type Key_Environment (N : Label_Number := Label_Number'Last) is 68 record 69 Prev : Env_Ptr; 70 Help : String_Access; 71 Notepad : Panel; 72 Labels : Label_Array (1 .. N); 73 end record; 74 75 procedure Release_String is 76 new Ada.Unchecked_Deallocation (String, 77 String_Access); 78 79 procedure Release_Environment is 80 new Ada.Unchecked_Deallocation (Key_Environment, 81 Env_Ptr); 82 83 Top_Of_Stack : Env_Ptr := null; 84 85 procedure Push_Environment (Key : String; 86 Reset : Boolean := True) 87 is 88 P : constant Env_Ptr := new Key_Environment (Number_Of_Keys); 89 begin 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)); 93 if Reset then 94 Set_Soft_Label_Key (I, " "); 95 end if; 96 end loop; 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); 104 Update_Panels; 105 end if; 106 Active_Notepad := Null_Panel; 107 Active_Context := new String'(Key); 108 109 Top_Of_Stack := P; 110 if Reset then 111 Refresh_Soft_Label_Keys_Without_Update; 112 end if; 113 end Push_Environment; 114 115 procedure Pop_Environment 116 is 117 P : Env_Ptr := Top_Of_Stack; 118 begin 119 if Top_Of_Stack = null then 120 raise Function_Key_Stack_Error; 121 else 122 for I in 1 .. Number_Of_Keys loop 123 Set_Soft_Label_Key (I, P.all.Labels (I), Justification); 124 end loop; 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); 132 end if; 133 end Pop_Environment; 134 135 function Context return String 136 is 137 begin 138 if Active_Context /= null then 139 return Active_Context.all; 140 else 141 return ""; 142 end if; 143 end Context; 144 145 function Find_Context (Key : String) return Boolean 146 is 147 P : Env_Ptr := Top_Of_Stack; 148 begin 149 if Active_Context.all = Key then 150 return True; 151 else 152 loop 153 exit when P = null; 154 if P.all.Help.all = Key then 155 return True; 156 else 157 P := P.all.Prev; 158 end if; 159 end loop; 160 return False; 161 end if; 162 end Find_Context; 163 164 procedure Notepad_To_Context (Pan : Panel) 165 is 166 W : Window; 167 begin 168 if Active_Notepad /= Null_Panel then 169 W := Get_Window (Active_Notepad); 170 Clear (W); 171 Delete (Active_Notepad); 172 Delete (W); 173 end if; 174 Active_Notepad := Pan; 175 if Pan /= Null_Panel then 176 Top (Pan); 177 end if; 178 Update_Panels; 179 Update_Screen; 180 end Notepad_To_Context; 181 182 procedure Initialize (Mode : Soft_Label_Key_Format := PC_Style; 183 Just : Label_Justification := Left) 184 is 185 begin 186 case Mode is 187 when PC_Style .. PC_Style_With_Index 188 => Number_Of_Keys := 12; 189 when others 190 => Number_Of_Keys := 8; 191 end case; 192 Init_Soft_Label_Keys (Mode); 193 Justification := Just; 194 end Initialize; 195 196 procedure Default_Labels 197 is 198 begin 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; 203 end Default_Labels; 204 205 function Notepad_Window return Window 206 is 207 begin 208 if Active_Notepad /= Null_Panel then 209 return Get_Window (Active_Notepad); 210 else 211 return Null_Window; 212 end if; 213 end Notepad_Window; 214 215end Sample.Function_Key_Setting; 216