X-Git-Url: https://ncurses.scripts.mit.edu/?a=blobdiff_plain;f=doc%2Fhtml%2Fada%2Fterminal_interface-curses-terminfo__adb.htm;h=665f8e1547ae9261be666b01a0842e44d7aa7921;hb=97cb42f22c43eb31a4bf11475bd73ab0e0b10923;hp=64899f69dc1db2cbd0b712b1da99d23b40175480;hpb=027ae42953e3186daed8f3882da73de48291b606;p=ncurses.git diff --git a/doc/html/ada/terminal_interface-curses-terminfo__adb.htm b/doc/html/ada/terminal_interface-curses-terminfo__adb.htm index 64899f69..665f8e15 100644 --- a/doc/html/ada/terminal_interface-curses-terminfo__adb.htm +++ b/doc/html/ada/terminal_interface-curses-terminfo__adb.htm @@ -1,62 +1,74 @@ - -
------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding -- --- -- --- Terminal_Interface.Curses.Terminfo -- --- -- --- B O D Y -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 1998-2000,2006 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.5 @ --- @Date: 2006/06/25 14:30:22 @ --- Binding Version 01.00 ------------------------------------------------------------------------------- +------------------------------------------------------------------------------ +-- -- +-- GNAT ncurses Binding -- +-- -- +-- Terminal_Interface.Curses.Terminfo -- +-- -- +-- B O D Y -- +-- -- +------------------------------------------------------------------------------ +-- Copyright (c) 1998-2006,2009 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.6 @ +-- @Date: 2009/12/26 17:38:58 @ +-- Binding Version 01.00 +------------------------------------------------------------------------------ -with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; +with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; with Interfaces.C; use Interfaces.C; with Interfaces.C.Strings; use Interfaces.C.Strings; with Ada.Unchecked_Conversion; -package body Terminal_Interface.Curses.Terminfo is +package body Terminal_Interface.Curses.Terminfo is - function Is_MinusOne_Pointer (P : in chars_ptr) return Boolean; + function Is_MinusOne_Pointer (P : chars_ptr) return Boolean; - function Is_MinusOne_Pointer (P : in chars_ptr) return Boolean is - type Weird_Address is new System.Storage_Elements.Integer_Address; - Invalid_Pointer : constant Weird_Address := -1; + function Is_MinusOne_Pointer (P : chars_ptr) return Boolean is + type Weird_Address is new System.Storage_Elements.Integer_Address; + Invalid_Pointer : constant Weird_Address := -1; function To_Weird is new Ada.Unchecked_Conversion (Source => chars_ptr, Target => Weird_Address); begin @@ -68,100 +80,100 @@ end Is_MinusOne_Pointer; pragma Inline (Is_MinusOne_Pointer); ------------------------------------------------------------------------------- - function Get_Flag (Name : String) return Boolean +------------------------------------------------------------------------------ + function Get_Flag (Name : String) return Boolean is - function tigetflag (id : char_array) return Curses_Bool; + function tigetflag (id : char_array) return Curses_Bool; pragma Import (C, tigetflag); - Txt : char_array (0 .. Name'Length); - Length : size_t; + Txt : char_array (0 .. Name'Length); + Length : size_t; begin To_C (Name, Txt, Length); - if tigetflag (Txt) = Curses_Bool (Curses_True) then + if tigetflag (Txt) = Curses_Bool (Curses_True) then return True; else return False; end if; end Get_Flag; ------------------------------------------------------------------------------- - procedure Get_String (Name : String; - Value : out Terminfo_String; - Result : out Boolean) +------------------------------------------------------------------------------ + procedure Get_String (Name : String; + Value : out Terminfo_String; + Result : out Boolean) is - function tigetstr (id : char_array) return chars_ptr; + function tigetstr (id : char_array) return chars_ptr; pragma Import (C, tigetstr, "tigetstr"); - Txt : char_array (0 .. Name'Length); - Length : size_t; - Txt2 : chars_ptr; + Txt : char_array (0 .. Name'Length); + Length : size_t; + Txt2 : chars_ptr; begin To_C (Name, Txt, Length); Txt2 := tigetstr (Txt); if Txt2 = Null_Ptr then Result := False; elsif Is_MinusOne_Pointer (Txt2) then - raise Curses_Exception; + raise Curses_Exception; else - Value := Terminfo_String (Fill_String (Txt2)); + Value := Terminfo_String (Fill_String (Txt2)); Result := True; end if; end Get_String; ------------------------------------------------------------------------------- - function Has_String (Name : String) return Boolean +------------------------------------------------------------------------------ + function Has_String (Name : String) return Boolean is - function tigetstr (id : char_array) return chars_ptr; + function tigetstr (id : char_array) return chars_ptr; pragma Import (C, tigetstr, "tigetstr"); - Txt : char_array (0 .. Name'Length); - Length : size_t; - Txt2 : chars_ptr; + Txt : char_array (0 .. Name'Length); + Length : size_t; + Txt2 : chars_ptr; begin To_C (Name, Txt, Length); Txt2 := tigetstr (Txt); if Txt2 = Null_Ptr then return False; elsif Is_MinusOne_Pointer (Txt2) then - raise Curses_Exception; + raise Curses_Exception; else return True; end if; end Has_String; ------------------------------------------------------------------------------- - function Get_Number (Name : String) return Integer is - function tigetstr (s : char_array) return C_Int; +------------------------------------------------------------------------------ + function Get_Number (Name : String) return Integer is + function tigetstr (s : char_array) return C_Int; pragma Import (C, tigetstr); - Txt : char_array (0 .. Name'Length); - Length : size_t; + Txt : char_array (0 .. Name'Length); + Length : size_t; begin To_C (Name, Txt, Length); return Integer (tigetstr (Txt)); end Get_Number; ------------------------------------------------------------------------------- - procedure Put_String (Str : Terminfo_String; - affcnt : Natural := 1; - putc : putctype := null) is - function tputs (str : char_array; - affcnt : C_Int; - putc : putctype) return C_Int; - function putp (str : char_array) return C_Int; +------------------------------------------------------------------------------ + procedure Put_String (Str : Terminfo_String; + affcnt : Natural := 1; + putc : putctype := null) is + function tputs (str : char_array; + affcnt : C_Int; + putc : putctype) return C_Int; + function putp (str : char_array) return C_Int; pragma Import (C, tputs); pragma Import (C, putp); - Txt : char_array (0 .. Str'Length); - Length : size_t; - Err : C_Int; + Txt : char_array (0 .. Str'Length); + Length : size_t; + Err : C_Int; begin To_C (String (Str), Txt, Length); if putc = null then Err := putp (Txt); else - Err := tputs (Txt, C_Int (affcnt), putc); + Err := tputs (Txt, C_Int (affcnt), putc); end if; - if Err = Curses_Err then - raise Curses_Exception; + if Err = Curses_Err then + raise Curses_Exception; end if; end Put_String; -end Terminal_Interface.Curses.Terminfo; +end Terminal_Interface.Curses.Terminfo;