1------------------------------------------------------------------------------ 2-- -- 3-- GNAT ncurses Binding -- 4-- -- 5-- Terminal_Interface.Curses.Aux -- 6-- -- 7-- B O D Y -- 8-- -- 9------------------------------------------------------------------------------ 10-- Copyright 2020 Thomas E. Dickey -- 11-- Copyright 1999-2003,2009 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.12 $ 40-- Binding Version 01.00 41------------------------------------------------------------------------------ 42package body Terminal_Interface.Curses.Aux is 43 -- 44 -- Some helpers 45 procedure Fill_String (Cp : chars_ptr; 46 Str : out String) 47 is 48 -- Fill the string with the characters referenced by the 49 -- chars_ptr. 50 -- 51 Len : Natural; 52 begin 53 if Cp /= Null_Ptr then 54 Len := Natural (Strlen (Cp)); 55 if Str'Length < Len then 56 raise Constraint_Error; 57 end if; 58 declare 59 S : String (1 .. Len); 60 begin 61 S := Value (Cp); 62 Str (Str'First .. (Str'First + Len - 1)) := S (S'Range); 63 end; 64 else 65 Len := 0; 66 end if; 67 68 if Len < Str'Length then 69 Str ((Str'First + Len) .. Str'Last) := (others => ' '); 70 end if; 71 72 end Fill_String; 73 74 function Fill_String (Cp : chars_ptr) return String 75 is 76 Len : Natural; 77 begin 78 if Cp /= Null_Ptr then 79 Len := Natural (Strlen (Cp)); 80 if Len = 0 then 81 return ""; 82 else 83 declare 84 S : String (1 .. Len); 85 begin 86 Fill_String (Cp, S); 87 return S; 88 end; 89 end if; 90 else 91 return ""; 92 end if; 93 end Fill_String; 94 95 procedure Eti_Exception (Code : Eti_Error) 96 is 97 begin 98 case Code is 99 when E_Ok => null; 100 when E_System_Error => raise Eti_System_Error; 101 when E_Bad_Argument => raise Eti_Bad_Argument; 102 when E_Posted => raise Eti_Posted; 103 when E_Connected => raise Eti_Connected; 104 when E_Bad_State => raise Eti_Bad_State; 105 when E_No_Room => raise Eti_No_Room; 106 when E_Not_Posted => raise Eti_Not_Posted; 107 when E_Unknown_Command => raise Eti_Unknown_Command; 108 when E_No_Match => raise Eti_No_Match; 109 when E_Not_Selectable => raise Eti_Not_Selectable; 110 when E_Not_Connected => raise Eti_Not_Connected; 111 when E_Request_Denied => raise Eti_Request_Denied; 112 when E_Invalid_Field => raise Eti_Invalid_Field; 113 when E_Current => raise Eti_Current; 114 end case; 115 end Eti_Exception; 116 117end Terminal_Interface.Curses.Aux; 118