| ------------------------------------------------------------------------------ |
| -- -- |
| -- GNAT ncurses Binding Samples -- |
| -- -- |
| -- Sample.Function_Key_Setting -- |
| -- -- |
| -- B O D Y -- |
| -- -- |
| ------------------------------------------------------------------------------ |
| -- Copyright (c) 1998,2004 Free Software Foundation, Inc. -- |
| -- -- |
| -- Permission is hereby granted, free of charge, to any person obtaining a -- |
| -- copy of this software and associated documentation files (the -- |
| -- "Software"), to deal in the Software without restriction, including -- |
| -- without limitation the rights to use, copy, modify, merge, publish, -- |
| -- distribute, distribute with modifications, sublicense, and/or sell -- |
| -- copies of the Software, and to permit persons to whom the Software is -- |
| -- furnished to do so, subject to the following conditions: -- |
| -- -- |
| -- The above copyright notice and this permission notice shall be included -- |
| -- in all copies or substantial portions of the Software. -- |
| -- -- |
| -- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- |
| -- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- |
| -- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- |
| -- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- |
| -- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- |
| -- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- |
| -- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- |
| -- -- |
| -- Except as contained in this notice, the name(s) of the above copyright -- |
| -- holders shall not be used in advertising or otherwise to promote the -- |
| -- sale, use or other dealings in this Software without prior written -- |
| -- authorization. -- |
| ------------------------------------------------------------------------------ |
| -- Author: Juergen Pfeifer, 1996 |
| -- Version Control |
| -- $Revision: 1.13 $ |
| -- $Date: 2004/08/21 21:37:00 $ |
| -- Binding Version 01.00 |
| ------------------------------------------------------------------------------ |
| with Ada.Unchecked_Deallocation; |
| with Sample.Manifest; use Sample.Manifest; |
| |
| -- This package implements a simple stack of function key label environments. |
| -- |
| package body Sample.Function_Key_Setting is |
| |
| Max_Label_Length : constant Positive := 8; |
| Number_Of_Keys : Label_Number := Label_Number'Last; |
| Justification : Label_Justification := Left; |
| |
| subtype Label is String (1 .. Max_Label_Length); |
| type Label_Array is array (Label_Number range <>) of Label; |
| |
| type Key_Environment (N : Label_Number := Label_Number'Last); |
| type Env_Ptr is access Key_Environment; |
| pragma Controlled (Env_Ptr); |
| |
| type String_Access is access String; |
| pragma Controlled (String_Access); |
| |
| Active_Context : String_Access := new String'("MAIN"); |
| Active_Notepad : Panel := Null_Panel; |
| |
| type Key_Environment (N : Label_Number := Label_Number'Last) is |
| record |
| Prev : Env_Ptr; |
| Help : String_Access; |
| Notepad : Panel; |
| Labels : Label_Array (1 .. N); |
| end record; |
| |
| procedure Release_String is |
| new Ada.Unchecked_Deallocation (String, |
| String_Access); |
| |
| procedure Release_Environment is |
| new Ada.Unchecked_Deallocation (Key_Environment, |
| Env_Ptr); |
| |
| Top_Of_Stack : Env_Ptr := null; |
| |
| procedure Push_Environment (Key : in String; |
| Reset : in Boolean := True) |
| is |
| P : constant Env_Ptr := new Key_Environment (Number_Of_Keys); |
| begin |
| -- Store the current labels in the environment |
| for I in 1 .. Number_Of_Keys loop |
| Get_Soft_Label_Key (I, P.Labels (I)); |
| if Reset then |
| Set_Soft_Label_Key (I, " "); |
| end if; |
| end loop; |
| P.Prev := Top_Of_Stack; |
| -- now store active help context and notepad |
| P.Help := Active_Context; |
| P.Notepad := Active_Notepad; |
| -- The notepad must now vanish and the new notepad is empty. |
| if P.Notepad /= Null_Panel then |
| Hide (P.Notepad); |
| Update_Panels; |
| end if; |
| Active_Notepad := Null_Panel; |
| Active_Context := new String'(Key); |
| |
| Top_Of_Stack := P; |
| if Reset then |
| Refresh_Soft_Label_Keys_Without_Update; |
| end if; |
| end Push_Environment; |
| |
| procedure Pop_Environment |
| is |
| P : Env_Ptr := Top_Of_Stack; |
| begin |
| if Top_Of_Stack = null then |
| raise Function_Key_Stack_Error; |
| else |
| for I in 1 .. Number_Of_Keys loop |
| Set_Soft_Label_Key (I, P.Labels (I), Justification); |
| end loop; |
| pragma Assert (Active_Context /= null); |
| Release_String (Active_Context); |
| Active_Context := P.Help; |
| Refresh_Soft_Label_Keys_Without_Update; |
| Notepad_To_Context (P.Notepad); |
| Top_Of_Stack := P.Prev; |
| Release_Environment (P); |
| end if; |
| end Pop_Environment; |
| |
| function Context return String |
| is |
| begin |
| if Active_Context /= null then |
| return Active_Context.all; |
| else |
| return ""; |
| end if; |
| end Context; |
| |
| function Find_Context (Key : String) return Boolean |
| is |
| P : Env_Ptr := Top_Of_Stack; |
| begin |
| if Active_Context.all = Key then |
| return True; |
| else |
| loop |
| exit when P = null; |
| if P.Help.all = Key then |
| return True; |
| else |
| P := P.Prev; |
| end if; |
| end loop; |
| return False; |
| end if; |
| end Find_Context; |
| |
| procedure Notepad_To_Context (Pan : in Panel) |
| is |
| W : Window; |
| begin |
| if Active_Notepad /= Null_Panel then |
| W := Get_Window (Active_Notepad); |
| Clear (W); |
| Delete (Active_Notepad); |
| Delete (W); |
| end if; |
| Active_Notepad := Pan; |
| if Pan /= Null_Panel then |
| Top (Pan); |
| end if; |
| Update_Panels; |
| Update_Screen; |
| end Notepad_To_Context; |
| |
| procedure Initialize (Mode : Soft_Label_Key_Format := PC_Style; |
| Just : Label_Justification := Left) |
| is |
| begin |
| case Mode is |
| when PC_Style .. PC_Style_With_Index |
| => Number_Of_Keys := 12; |
| when others |
| => Number_Of_Keys := 8; |
| end case; |
| Init_Soft_Label_Keys (Mode); |
| Justification := Just; |
| end Initialize; |
| |
| procedure Default_Labels |
| is |
| begin |
| Set_Soft_Label_Key (FKEY_QUIT, "Quit"); |
| Set_Soft_Label_Key (FKEY_HELP, "Help"); |
| Set_Soft_Label_Key (FKEY_EXPLAIN, "Keys"); |
| Refresh_Soft_Label_Keys_Without_Update; |
| end Default_Labels; |
| |
| function Notepad_Window return Window |
| is |
| begin |
| if Active_Notepad /= Null_Panel then |
| return Get_Window (Active_Notepad); |
| else |
| return Null_Window; |
| end if; |
| end Notepad_Window; |
| |
| end Sample.Function_Key_Setting; |
