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=57c68ba3fb66850de0679eae95c033718281b9ed;hp=fdc68efd5593cdd341cd3d9397c85c223457c25b;hb=55ccd2b959766810cf7db8d1c4462f338ce0afc8;hpb=a8987e73ec254703634802b4f7ee30d3a485524d diff --git a/doc/html/ada/terminal_interface-curses-terminfo__adb.htm b/doc/html/ada/terminal_interface-curses-terminfo__adb.htm index fdc68efd..57c68ba3 100644 --- a/doc/html/ada/terminal_interface-curses-terminfo__adb.htm +++ b/doc/html/ada/terminal_interface-curses-terminfo__adb.htm @@ -1,3 +1,4 @@ + terminal_interface-curses-terminfo.adb

File : terminal_interface-curses-terminfo.adb

@@ -43,124 +44,124 @@ -- Binding Version 01.00 ------------------------------------------------------------------------------ -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 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; +end Terminal_Interface.Curses.Terminfo;