X-Git-Url: https://ncurses.scripts.mit.edu/?p=ncurses.git;a=blobdiff_plain;f=doc%2Fhtml%2Fada%2Fterminal_interface-curses-terminfo__adb.htm;fp=doc%2Fhtml%2Fada%2Fterminal_interface-curses-terminfo__adb.htm;h=9b25898c6f5c3d6de2c35dd906a86093f785da7a;hp=665f8e1547ae9261be666b01a0842e44d7aa7921;hb=47d2fb4537d9ad5bb14f4810561a327930ca4280;hpb=c55d387cebf1cee4757ca2c2ef4fbeae59ee4175 diff --git a/doc/html/ada/terminal_interface-curses-terminfo__adb.htm b/doc/html/ada/terminal_interface-curses-terminfo__adb.htm index 665f8e15..9b25898c 100644 --- a/doc/html/ada/terminal_interface-curses-terminfo__adb.htm +++ b/doc/html/ada/terminal_interface-curses-terminfo__adb.htm @@ -24,7 +24,8 @@ -- B O D Y -- -- -- ------------------------------------------------------------------------------ --- Copyright (c) 1998-2006,2009 Free Software Foundation, Inc. -- +-- Copyright 2020 Thomas E. Dickey -- +-- Copyright 2000-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 -- @@ -52,128 +53,128 @@ ------------------------------------------------------------------------------ -- Author: Juergen Pfeifer, 1996 -- Version Control: --- @Revision: 1.6 @ --- @Date: 2009/12/26 17:38:58 @ +-- @Revision: 1.7 @ +-- @Date: 2020/02/02 23:34:34 @ -- 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 : chars_ptr) return Boolean; + function Is_MinusOne_Pointer (P : chars_ptr) return Boolean; - 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 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); + (Source => chars_ptr, Target => Weird_Address); begin - if To_Weird (P) = Invalid_Pointer then + if To_Weird (P) = Invalid_Pointer then return True; else return False; end if; - end Is_MinusOne_Pointer; - pragma Inline (Is_MinusOne_Pointer); + 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 + To_C (Name, Txt, Length); + if tigetflag (Txt) = Curses_Bool (Curses_True) then return True; else return False; end if; - end Get_Flag; + 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; + To_C (Name, Txt, Length); + Txt2 := tigetstr (Txt); + if Txt2 = Null_Ptr then + Result := False; + elsif Is_MinusOne_Pointer (Txt2) then + raise Curses_Exception; else - Value := Terminfo_String (Fill_String (Txt2)); - Result := True; + Value := Terminfo_String (Fill_String (Txt2)); + Result := True; end if; - end Get_String; + 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 + To_C (Name, Txt, Length); + Txt2 := tigetstr (Txt); + if Txt2 = Null_Ptr then return False; - elsif Is_MinusOne_Pointer (Txt2) then - raise Curses_Exception; + elsif Is_MinusOne_Pointer (Txt2) then + raise Curses_Exception; else return True; end if; - end Has_String; + 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; + 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); + 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 Put_String; -end Terminal_Interface.Curses.Terminfo; +end Terminal_Interface.Curses.Terminfo;