X-Git-Url: https://ncurses.scripts.mit.edu/?p=ncurses.git;a=blobdiff_plain;f=doc%2Fhtml%2Fada%2Fterminal_interface-curses-terminfo__adb.htm;h=fdc68efd5593cdd341cd3d9397c85c223457c25b;hp=0e6979a5d45be1007a97f873ac470c44a208cffe;hb=a8987e73ec254703634802b4f7ee30d3a485524d;hpb=46722468f47c2b77b3987729b4bcf2321cccfd01 diff --git a/doc/html/ada/terminal_interface-curses-terminfo__adb.htm b/doc/html/ada/terminal_interface-curses-terminfo__adb.htm index 0e6979a5..fdc68efd 100644 --- a/doc/html/ada/terminal_interface-curses-terminfo__adb.htm +++ b/doc/html/ada/terminal_interface-curses-terminfo__adb.htm @@ -37,131 +37,130 @@ -- sale, use or other dealings in this Software without prior written -- -- authorization. -- ------------------------------------------------------------------------------ --- Author: Jürgen Pfeifer, 1996 --- Contact: www.familiepfeifer.de/Contact.aspx?Lang=en +-- Author: Juergen Pfeifer, 1996 -- Version Control: --- @Revision: 1.2 @ +-- @Revision: 1.3 @ -- 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 : in 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 To_Weird is new Ada.Unchecked_Conversion - (Source => chars_ptr, Target => Weird_Address); + 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 To_Weird is new Ada.Unchecked_Conversion + (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; - pragma Import (C, tigetflag); - Txt : char_array (0 .. Name'Length); - Length : size_t; + function tigetflag (id : char_array) return Curses_Bool; + pragma Import (C, tigetflag); + 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; - pragma Import (C, tigetstr, "tigetstr"); - Txt : char_array (0 .. Name'Length); - Length : size_t; - Txt2 : 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; 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; - pragma Import (C, tigetstr, "tigetstr"); - Txt : char_array (0 .. Name'Length); - Length : size_t; - Txt2 : 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; 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; - pragma Import (C, tigetstr); - Txt : char_array (0 .. Name'Length); - Length : size_t; + 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; 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; - pragma Import (C, tputs); - pragma Import (C, putp); - Txt : char_array (0 .. Str'Length); - Length : size_t; - Err : 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; 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; - \ No newline at end of file +end Terminal_Interface.Curses.Terminfo; +