with GNAT.OS_Lib; use GNAT.OS_Lib;
package body Output is
Current_FD : File_Descriptor := Standout;
Special_Output_Proc : Output_Proc := null;
procedure Flush_Buffer;
procedure Cancel_Special_Output is
begin
Special_Output_Proc := null;
end Cancel_Special_Output;
procedure Flush_Buffer is
Len : constant Natural := Next_Col - 1;
begin
if Len /= 0 then
if Special_Output_Proc /= null then
Special_Output_Proc.all (Buffer (1 .. Len));
elsif Len /= Write (Current_FD, Buffer'Address, Len) then
if Current_FD = Standerr then
OS_Exit (2);
else
Current_FD := Standerr;
Next_Col := 1;
Write_Line ("fatal error: disk full");
OS_Exit (2);
end if;
end if;
Next_Col := 1;
end if;
end Flush_Buffer;
function Column return Pos is
begin
return Pos (Next_Col);
end Column;
procedure Restore_Output_Buffer (S : Saved_Output_Buffer) is
begin
Next_Col := S.Next_Col;
Buffer (1 .. Next_Col - 1) := S.Buffer (1 .. Next_Col - 1);
end Restore_Output_Buffer;
function Save_Output_Buffer return Saved_Output_Buffer is
S : Saved_Output_Buffer;
begin
S.Buffer (1 .. Next_Col - 1) := Buffer (1 .. Next_Col - 1);
S.Next_Col := Next_Col;
Next_Col := 1;
return S;
end Save_Output_Buffer;
procedure Set_Special_Output (P : Output_Proc) is
begin
Special_Output_Proc := P;
end Set_Special_Output;
procedure Set_Standard_Error is
begin
if Special_Output_Proc = null then
Flush_Buffer;
Next_Col := 1;
end if;
Current_FD := Standerr;
end Set_Standard_Error;
procedure Set_Standard_Output is
begin
if Special_Output_Proc = null then
Flush_Buffer;
Next_Col := 1;
end if;
Current_FD := Standout;
end Set_Standard_Output;
procedure w (C : Character) is
begin
Write_Char (''');
Write_Char (C);
Write_Char (''');
Write_Eol;
end w;
procedure w (S : String) is
begin
Write_Str (S);
Write_Eol;
end w;
procedure w (V : Int) is
begin
Write_Int (V);
Write_Eol;
end w;
procedure w (B : Boolean) is
begin
if B then
w ("True");
else
w ("False");
end if;
end w;
procedure w (L : String; C : Character) is
begin
Write_Str (L);
Write_Char (' ');
w (C);
end w;
procedure w (L : String; S : String) is
begin
Write_Str (L);
Write_Char (' ');
w (S);
end w;
procedure w (L : String; V : Int) is
begin
Write_Str (L);
Write_Char (' ');
w (V);
end w;
procedure w (L : String; B : Boolean) is
begin
Write_Str (L);
Write_Char (' ');
w (B);
end w;
procedure Write_Char (C : Character) is
begin
if Next_Col = Buffer'Length then
Write_Eol;
end if;
Buffer (Next_Col) := C;
Next_Col := Next_Col + 1;
end Write_Char;
procedure Write_Eol is
begin
Buffer (Next_Col) := ASCII.LF;
Next_Col := Next_Col + 1;
Flush_Buffer;
end Write_Eol;
procedure Write_Erase_Char (C : Character) is
begin
if Next_Col /= 1 and then Buffer (Next_Col - 1) = C then
Next_Col := Next_Col - 1;
end if;
end Write_Erase_Char;
procedure Write_Int (Val : Int) is
begin
if Val < 0 then
Write_Char ('-');
Write_Int (-Val);
else
if Val > 9 then
Write_Int (Val / 10);
end if;
Write_Char (Character'Val ((Val mod 10) + Character'Pos ('0')));
end if;
end Write_Int;
procedure Write_Line (S : String) is
begin
Write_Str (S);
Write_Eol;
end Write_Line;
procedure Write_Str (S : String) is
begin
for J in S'Range loop
Write_Char (S (J));
end loop;
end Write_Str;
end Output;