mirror of https://github.com/briot/gnatbdd
Emmanuel Briot
parent
18c134745d
commit
921a40ee8e
83
src/colors.c
83
src/colors.c
|
|
@ -1,83 +0,0 @@
|
|||
|
||||
#ifdef _WIN32
|
||||
#include <windows.h>
|
||||
#include <wincon.h>
|
||||
#else
|
||||
#include <unistd.h>
|
||||
#include <sys/ioctl.h>
|
||||
#endif
|
||||
|
||||
int gnatcoll_get_console_screen_buffer_info(int forStderr) {
|
||||
#ifdef _WIN32
|
||||
const HANDLE handle =
|
||||
GetStdHandle (forStderr ? STD_ERROR_HANDLE : STD_OUTPUT_HANDLE);
|
||||
CONSOLE_SCREEN_BUFFER_INFO csbiInfo;
|
||||
if (GetConsoleScreenBufferInfo (handle, &csbiInfo)) {
|
||||
return csbiInfo.wAttributes;
|
||||
}
|
||||
#else
|
||||
return -1;
|
||||
#endif
|
||||
}
|
||||
|
||||
void gnatcoll_set_console_text_attribute(int forStderr, int attrs) {
|
||||
#ifdef _WIN32
|
||||
const HANDLE handle =
|
||||
GetStdHandle (forStderr ? STD_ERROR_HANDLE : STD_OUTPUT_HANDLE);
|
||||
SetConsoleTextAttribute (handle, (WORD)attrs);
|
||||
#endif
|
||||
}
|
||||
|
||||
int gnatcoll_terminal_has_colors(int fd) {
|
||||
#ifdef _WIN32
|
||||
return 0; // Unix only
|
||||
#else
|
||||
// Ideally, we should check the terminfo database and check the
|
||||
// max_colors fields (from the command line, this is done with
|
||||
// "tput colors"). However, this is fairly complex, and would
|
||||
// drag in the curses library.
|
||||
// For now, let's just assume that a tty always supports colors,
|
||||
// which is true in this day and age for interactive terminals on
|
||||
// all Unix platforms. A pipe will return 0 below, so will not have
|
||||
// colors by default.
|
||||
// ??? We could also check the value of the TERM environment variable,
|
||||
// but this is very approximate at best.
|
||||
|
||||
return isatty(fd);
|
||||
#endif
|
||||
}
|
||||
|
||||
void gnatcoll_beginning_of_line(int forStderr) {
|
||||
#ifdef _WIN32
|
||||
const HANDLE handle =
|
||||
GetStdHandle (forStderr ? STD_ERROR_HANDLE : STD_OUTPUT_HANDLE);
|
||||
CONSOLE_SCREEN_BUFFER_INFO csbiInfo;
|
||||
if (GetConsoleScreenBufferInfo (handle, &csbiInfo)) {
|
||||
csbiInfo.dwCursorPosition.X = 0;
|
||||
SetConsoleCursorPosition(handle, csbiInfo.dwCursorPosition);
|
||||
}
|
||||
#else
|
||||
// struct winsize ws;
|
||||
// ioctl(forStderr ? 2 : 1, TIOCGWINSZ, &ws);
|
||||
write(forStderr ? 2 : 1, "\r", 1);
|
||||
#endif
|
||||
}
|
||||
|
||||
void gnatcoll_clear_to_end_of_line(int forStderr) {
|
||||
#ifdef _WIN32
|
||||
const HANDLE handle =
|
||||
GetStdHandle (forStderr ? STD_ERROR_HANDLE : STD_OUTPUT_HANDLE);
|
||||
CONSOLE_SCREEN_BUFFER_INFO csbiInfo;
|
||||
if (GetConsoleScreenBufferInfo (handle, &csbiInfo)) {
|
||||
DWORD numberOfCharsWritten;
|
||||
FillConsoleOutputCharacter(
|
||||
handle, ' ',
|
||||
csbiInfo.dwSize.X - csbiInfo.dwCursorPosition.X + 1, // length
|
||||
csbiInfo.dwCursorPosition, // dWriteCoord
|
||||
&numberOfCharsWritten);
|
||||
}
|
||||
|
||||
#else
|
||||
write(forStderr ? 2 : 1, "\033[0K", 4);
|
||||
#endif
|
||||
}
|
||||
|
|
@ -1,409 +0,0 @@
|
|||
------------------------------------------------------------------------------
|
||||
-- G N A T C O L L --
|
||||
-- --
|
||||
-- Copyright (C) 2005-2014, AdaCore --
|
||||
-- --
|
||||
-- This library is free software; you can redistribute it and/or modify it --
|
||||
-- under terms of the GNU General Public License as published by the Free --
|
||||
-- Software Foundation; either version 3, or (at your option) any later --
|
||||
-- version. This library is distributed in the hope that it will be useful, --
|
||||
-- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- --
|
||||
-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. --
|
||||
-- --
|
||||
-- As a special exception under Section 7 of GPL version 3, you are granted --
|
||||
-- additional permissions described in the GCC Runtime Library Exception, --
|
||||
-- version 3.1, as published by the Free Software Foundation. --
|
||||
-- --
|
||||
-- You should have received a copy of the GNU General Public License and --
|
||||
-- a copy of the GCC Runtime Library Exception along with this program; --
|
||||
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
|
||||
-- <http://www.gnu.org/licenses/>. --
|
||||
-- --
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
with Ada.Text_IO; use Ada.Text_IO;
|
||||
with GNAT.OS_Lib; use GNAT.OS_Lib;
|
||||
|
||||
package body GNATCOLL.Terminal is
|
||||
|
||||
On_Windows : constant Boolean := GNAT.OS_Lib.Directory_Separator = '\';
|
||||
|
||||
Color_To_Win32 : constant array (ANSI_Color) of Integer :=
|
||||
(Unchanged => -1,
|
||||
Black => 0,
|
||||
Red => 4,
|
||||
Green => 2,
|
||||
Yellow => 6,
|
||||
Blue => 1,
|
||||
Magenta => 5,
|
||||
Cyan => 3,
|
||||
Grey => 7,
|
||||
Reset => -1);
|
||||
|
||||
Style_To_Win32 : constant array (ANSI_Style) of Integer :=
|
||||
(Unchanged => -1,
|
||||
Bright => 16#08#,
|
||||
Dim => 16#00#, -- same as Normal
|
||||
Normal => 16#00#,
|
||||
Reset_All => -1);
|
||||
|
||||
procedure Win_Set_Console
|
||||
(Self : Terminal_Info'Class;
|
||||
Attrs : Integer);
|
||||
-- Windows-specific implementation to change the attributes of the console
|
||||
|
||||
procedure Decode_Windows_Attributes
|
||||
(Self : in out Terminal_Info'Class;
|
||||
Attrs : Integer);
|
||||
-- Decode the value of the attributes returned by Windows, into the
|
||||
-- default parameters for the terminal.
|
||||
|
||||
procedure Auto_Detect_Colors
|
||||
(Self : in out Terminal_Info'Class;
|
||||
Support : Supports_Color);
|
||||
-- Auto-detect whether colors are supported
|
||||
|
||||
function getConsoleScreenBufferInfo (Stderr : Integer) return Integer;
|
||||
pragma Import (C, getConsoleScreenBufferInfo,
|
||||
"gnatcoll_get_console_screen_buffer_info");
|
||||
|
||||
function terminal_has_colors (Fd : File_Descriptor) return Integer;
|
||||
pragma Import (C, terminal_has_colors, "gnatcoll_terminal_has_colors");
|
||||
-- Whether Fd is a terminal that supports color output
|
||||
|
||||
-------------------------------
|
||||
-- Decode_Windows_Attributes --
|
||||
-------------------------------
|
||||
|
||||
procedure Decode_Windows_Attributes
|
||||
(Self : in out Terminal_Info'Class;
|
||||
Attrs : Integer)
|
||||
is
|
||||
type Mod_32 is mod 2 ** 32;
|
||||
A : Mod_32;
|
||||
begin
|
||||
Self.Default_Fore := Black;
|
||||
Self.Default_Back := Grey;
|
||||
Self.Default_Style := Normal;
|
||||
|
||||
if not On_Windows then
|
||||
return;
|
||||
elsif Attrs = -1 then
|
||||
Self.Colors := Unsupported;
|
||||
else
|
||||
A := Mod_32 (Attrs);
|
||||
case A and 7 is
|
||||
when 0 => Self.Default_Fore := Black;
|
||||
when 1 => Self.Default_Fore := Blue;
|
||||
when 2 => Self.Default_Fore := Green;
|
||||
when 3 => Self.Default_Fore := Cyan;
|
||||
when 4 => Self.Default_Fore := Red;
|
||||
when 5 => Self.Default_Fore := Magenta;
|
||||
when 6 => Self.Default_Fore := Yellow;
|
||||
when others => Self.Default_Fore := Grey ;
|
||||
end case;
|
||||
|
||||
case (A / 16) and 7 is
|
||||
when 0 => Self.Default_Back := Black;
|
||||
when 1 => Self.Default_Back := Blue;
|
||||
when 2 => Self.Default_Back := Green;
|
||||
when 3 => Self.Default_Back := Cyan;
|
||||
when 4 => Self.Default_Back := Red;
|
||||
when 5 => Self.Default_Back := Magenta;
|
||||
when 6 => Self.Default_Back := Yellow;
|
||||
when others => Self.Default_Back := Grey ;
|
||||
end case;
|
||||
|
||||
if (A and 16#08#) /= 0 then
|
||||
Self.Default_Style := Bright;
|
||||
else
|
||||
Self.Default_Style := Normal;
|
||||
end if;
|
||||
end if;
|
||||
end Decode_Windows_Attributes;
|
||||
|
||||
------------------------
|
||||
-- Auto_Detect_Colors --
|
||||
------------------------
|
||||
|
||||
procedure Auto_Detect_Colors
|
||||
(Self : in out Terminal_Info'Class;
|
||||
Support : Supports_Color)
|
||||
is
|
||||
Env : String_Access;
|
||||
begin
|
||||
case Support is
|
||||
when No =>
|
||||
Self.Colors := Unsupported;
|
||||
|
||||
when Yes =>
|
||||
if On_Windows then
|
||||
Env := Getenv ("ANSICON");
|
||||
if Env = null or else Env.all = "" then
|
||||
Self.Colors := WIN32_Sequences;
|
||||
else
|
||||
Self.Colors := ANSI_Sequences;
|
||||
end if;
|
||||
Free (Env);
|
||||
else
|
||||
Self.Colors := ANSI_Sequences;
|
||||
end if;
|
||||
|
||||
when Auto =>
|
||||
if On_Windows then
|
||||
-- This procedure is only called for stdout or stderr
|
||||
Env := Getenv ("ANSICON");
|
||||
if Env = null or else Env.all = "" then
|
||||
Self.Colors := WIN32_Sequences;
|
||||
else
|
||||
Self.Colors := ANSI_Sequences;
|
||||
end if;
|
||||
Free (Env);
|
||||
|
||||
else
|
||||
if Self.FD = Stdout
|
||||
and then terminal_has_colors (Standout) /= 0
|
||||
then
|
||||
Self.Colors := ANSI_Sequences;
|
||||
elsif Self.FD = Stderr
|
||||
and then terminal_has_colors (Standerr) /= 0
|
||||
then
|
||||
Self.Colors := ANSI_Sequences;
|
||||
else
|
||||
Self.Colors := Unsupported;
|
||||
end if;
|
||||
end if;
|
||||
end case;
|
||||
end Auto_Detect_Colors;
|
||||
|
||||
---------------------
|
||||
-- Init_For_Stdout --
|
||||
---------------------
|
||||
|
||||
procedure Init_For_Stdout
|
||||
(Self : in out Terminal_Info;
|
||||
Colors : Supports_Color := Auto)
|
||||
is
|
||||
begin
|
||||
Self.FD := Stdout;
|
||||
Auto_Detect_Colors (Self, Colors);
|
||||
Decode_Windows_Attributes
|
||||
(Self, getConsoleScreenBufferInfo(Stderr => 0));
|
||||
end Init_For_Stdout;
|
||||
|
||||
---------------------
|
||||
-- Init_For_Stderr --
|
||||
---------------------
|
||||
|
||||
procedure Init_For_Stderr
|
||||
(Self : in out Terminal_Info;
|
||||
Colors : Supports_Color := Auto)
|
||||
is
|
||||
begin
|
||||
Self.FD := Stderr;
|
||||
Auto_Detect_Colors (Self, Colors);
|
||||
Decode_Windows_Attributes
|
||||
(Self, getConsoleScreenBufferInfo(Stderr => 1));
|
||||
end Init_For_Stderr;
|
||||
|
||||
-------------------
|
||||
-- Init_For_File --
|
||||
-------------------
|
||||
|
||||
procedure Init_For_File
|
||||
(Self : in out Terminal_Info;
|
||||
Term : Ada.Text_IO.File_Type := Ada.Text_IO.Standard_Output;
|
||||
Colors : Supports_Color := Auto) is
|
||||
begin
|
||||
Self.FD := File;
|
||||
|
||||
case Colors is
|
||||
when Yes =>
|
||||
-- Have to use ANSI sequences, since WIN32 sequences call
|
||||
-- subprograms on the terminal itself.
|
||||
Self.Colors := ANSI_Sequences;
|
||||
when No | Auto =>
|
||||
Self.Colors := Unsupported;
|
||||
end case;
|
||||
end Init_For_File;
|
||||
|
||||
----------------
|
||||
-- Has_Colors --
|
||||
----------------
|
||||
|
||||
function Has_Colors (Self : Terminal_Info) return Boolean is
|
||||
begin
|
||||
return Self.Colors /= Unsupported;
|
||||
end Has_Colors;
|
||||
|
||||
---------------------
|
||||
-- Win_Set_Console --
|
||||
---------------------
|
||||
|
||||
procedure Win_Set_Console
|
||||
(Self : Terminal_Info'Class;
|
||||
Attrs : Integer)
|
||||
is
|
||||
procedure Set_Console_Text_Attribute (Stderr : Integer; Attrs : Integer);
|
||||
pragma Import (C, Set_Console_Text_Attribute,
|
||||
"gnatcoll_set_console_text_attribute");
|
||||
begin
|
||||
Set_Console_Text_Attribute (Boolean'Pos (Self.FD = Stderr), Attrs);
|
||||
end Win_Set_Console;
|
||||
|
||||
------------
|
||||
-- Set_Fg --
|
||||
------------
|
||||
|
||||
procedure Set_Fg
|
||||
(Self : in out Terminal_Info;
|
||||
Color : ANSI_Color;
|
||||
Term : Ada.Text_IO.File_Type := Ada.Text_IO.Standard_Output)
|
||||
is
|
||||
begin
|
||||
Set_Color (Self, Term, Color, Unchanged, Unchanged);
|
||||
end Set_Fg;
|
||||
|
||||
------------
|
||||
-- Set_Bg --
|
||||
------------
|
||||
|
||||
procedure Set_Bg
|
||||
(Self : in out Terminal_Info;
|
||||
Color : ANSI_Color;
|
||||
Term : Ada.Text_IO.File_Type := Ada.Text_IO.Standard_Output)
|
||||
is
|
||||
begin
|
||||
Set_Color (Self, Term, Unchanged, Color, Unchanged);
|
||||
end Set_Bg;
|
||||
|
||||
---------------
|
||||
-- Set_Style --
|
||||
---------------
|
||||
|
||||
procedure Set_Style
|
||||
(Self : in out Terminal_Info;
|
||||
Style : ANSI_Style;
|
||||
Term : Ada.Text_IO.File_Type := Ada.Text_IO.Standard_Output)
|
||||
is
|
||||
begin
|
||||
Set_Color (Self, Term, Unchanged, Unchanged, Style);
|
||||
end Set_Style;
|
||||
|
||||
---------------
|
||||
-- Set_Color --
|
||||
---------------
|
||||
|
||||
procedure Set_Color
|
||||
(Self : in out Terminal_Info;
|
||||
Term : Ada.Text_IO.File_Type := Ada.Text_IO.Standard_Output;
|
||||
Foreground : ANSI_Color := Unchanged;
|
||||
Background : ANSI_Color := Unchanged;
|
||||
Style : ANSI_Style := Unchanged)
|
||||
is
|
||||
Attrs : Integer := 0;
|
||||
begin
|
||||
case Self.Colors is
|
||||
when Unsupported =>
|
||||
null;
|
||||
|
||||
when ANSI_Sequences =>
|
||||
case Style is
|
||||
when Unchanged => null;
|
||||
when Bright => Put (Term, ASCII.ESC & "[1m");
|
||||
when Dim => Put (Term, ASCII.ESC & "[2m");
|
||||
when Normal => Put (Term, ASCII.ESC & "[22m");
|
||||
when Reset_All => Put (Term, ASCII.ESC & "[0m");
|
||||
end case;
|
||||
|
||||
case Foreground is
|
||||
when Unchanged => null;
|
||||
when Black => Put (Term, ASCII.ESC & "[30m");
|
||||
when Red => Put (Term, ASCII.ESC & "[31m");
|
||||
when Green => Put (Term, ASCII.ESC & "[32m");
|
||||
when Yellow => Put (Term, ASCII.ESC & "[33m");
|
||||
when Blue => Put (Term, ASCII.ESC & "[34m");
|
||||
when Magenta => Put (Term, ASCII.ESC & "[35m");
|
||||
when Cyan => Put (Term, ASCII.ESC & "[36m");
|
||||
when Grey => Put (Term, ASCII.ESC & "[37m");
|
||||
when Reset => Put (Term, ASCII.ESC & "[39m");
|
||||
end case;
|
||||
|
||||
case Background is
|
||||
when Unchanged => null;
|
||||
when Black => Put (Term, ASCII.ESC & "[40m");
|
||||
when Red => Put (Term, ASCII.ESC & "[41m");
|
||||
when Green => Put (Term, ASCII.ESC & "[42m");
|
||||
when Yellow => Put (Term, ASCII.ESC & "[43m");
|
||||
when Blue => Put (Term, ASCII.ESC & "[44m");
|
||||
when Magenta => Put (Term, ASCII.ESC & "[45m");
|
||||
when Cyan => Put (Term, ASCII.ESC & "[46m");
|
||||
when Grey => Put (Term, ASCII.ESC & "[47m");
|
||||
when Reset => Put (Term, ASCII.ESC & "[49m");
|
||||
end case;
|
||||
|
||||
when WIN32_Sequences =>
|
||||
if Style = Reset_All then
|
||||
Self.Style := Self.Default_Style;
|
||||
Self.Fore := Self.Default_Fore;
|
||||
Self.Back := Self.Default_Back;
|
||||
elsif Style /= Unchanged then
|
||||
Self.Style := Style;
|
||||
end if;
|
||||
|
||||
if Foreground = Reset then
|
||||
Self.Fore := Self.Default_Fore;
|
||||
elsif Foreground /= Unchanged then
|
||||
Self.Fore := Foreground;
|
||||
end if;
|
||||
|
||||
if Background = Reset then
|
||||
Self.Back := Self.Default_Back ;
|
||||
elsif Background /= Unchanged then
|
||||
Self.Back := Background;
|
||||
end if;
|
||||
|
||||
Attrs := Attrs + Style_To_Win32(Self.Style) +
|
||||
Color_To_Win32(Self.Fore) +
|
||||
Color_To_Win32(Self.Back) * 16;
|
||||
|
||||
Win_Set_Console (Self, Attrs);
|
||||
end case;
|
||||
end Set_Color;
|
||||
|
||||
-----------------------
|
||||
-- Beginning_Of_Line --
|
||||
-----------------------
|
||||
|
||||
procedure Beginning_Of_Line
|
||||
(Self : in out Terminal_Info;
|
||||
Term : Ada.Text_IO.File_Type := Ada.Text_IO.Standard_Output)
|
||||
is
|
||||
procedure Internal (Stderr : Integer);
|
||||
pragma Import (C, Internal, "gnatcoll_beginning_of_line");
|
||||
begin
|
||||
if Self.FD = File or else Self.Colors = Unsupported then
|
||||
null;
|
||||
else
|
||||
Internal (Boolean'Pos (Self.FD = Stderr));
|
||||
end if;
|
||||
end Beginning_Of_Line;
|
||||
|
||||
--------------------------
|
||||
-- Clear_To_End_Of_Line --
|
||||
--------------------------
|
||||
|
||||
procedure Clear_To_End_Of_Line
|
||||
(Self : in out Terminal_Info;
|
||||
Term : Ada.Text_IO.File_Type := Ada.Text_IO.Standard_Output)
|
||||
is
|
||||
procedure Internal (Stderr : Integer);
|
||||
pragma Import (C, Internal, "gnatcoll_clear_to_end_of_line");
|
||||
begin
|
||||
if Self.FD = File or else Self.Colors = Unsupported then
|
||||
null;
|
||||
else
|
||||
Internal (Boolean'Pos (Self.FD = Stderr));
|
||||
end if;
|
||||
end Clear_To_End_Of_Line;
|
||||
end GNATCOLL.Terminal;
|
||||
|
|
@ -1,160 +0,0 @@
|
|||
------------------------------------------------------------------------------
|
||||
-- G N A T C O L L --
|
||||
-- --
|
||||
-- Copyright (C) 2014, AdaCore --
|
||||
-- --
|
||||
-- This library is free software; you can redistribute it and/or modify it --
|
||||
-- under terms of the GNU General Public License as published by the Free --
|
||||
-- Software Foundation; either version 3, or (at your option) any later --
|
||||
-- version. This library is distributed in the hope that it will be useful, --
|
||||
-- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- --
|
||||
-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. --
|
||||
-- --
|
||||
-- As a special exception under Section 7 of GPL version 3, you are granted --
|
||||
-- additional permissions described in the GCC Runtime Library Exception, --
|
||||
-- version 3.1, as published by the Free Software Foundation. --
|
||||
-- --
|
||||
-- You should have received a copy of the GNU General Public License and --
|
||||
-- a copy of the GCC Runtime Library Exception along with this program; --
|
||||
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
|
||||
-- <http://www.gnu.org/licenses/>. --
|
||||
-- --
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
-- This package provides a number of cross-platform subprograms to control
|
||||
-- output in terminals, in particular colors.
|
||||
--
|
||||
-- On Windows, color sequences are either set using the standard WIN32 codes,
|
||||
-- or if the package ANSICON (https://github.com/adoxa/ansicon/) is running it
|
||||
-- will use the standard ANSI sequences.
|
||||
|
||||
with Ada.Text_IO;
|
||||
|
||||
package GNATCOLL.Terminal is
|
||||
|
||||
type Terminal_Info is tagged private;
|
||||
-- Information about a terminal on which we output.
|
||||
-- This structure does not encapsulate the terminal itself, which is a
|
||||
-- limited type.
|
||||
-- By default, this is configured without support for colors. It is thus
|
||||
-- recommended to first call Init before you use this type.
|
||||
-- This type is almost always used in conjonction with a File_Type, which
|
||||
-- is where text is actually output. The properties of that File_Type are
|
||||
-- queried and cached in the Terminal_Info.
|
||||
|
||||
------------
|
||||
-- Colors --
|
||||
------------
|
||||
|
||||
type Supports_Color is (Yes, No, Auto);
|
||||
procedure Init_For_Stdout
|
||||
(Self : in out Terminal_Info;
|
||||
Colors : Supports_Color := Auto);
|
||||
procedure Init_For_Stderr
|
||||
(Self : in out Terminal_Info;
|
||||
Colors : Supports_Color := Auto);
|
||||
procedure Init_For_File
|
||||
(Self : in out Terminal_Info;
|
||||
Term : Ada.Text_IO.File_Type := Ada.Text_IO.Standard_Output;
|
||||
Colors : Supports_Color := Auto);
|
||||
-- Checks whether the terminal supports colors. By default, automatic
|
||||
-- detection is attempted, but this can be overridden by the use of the
|
||||
-- Colors parameter.
|
||||
-- The three variants depend on which type of terminal you are outputting
|
||||
-- to. Unfortunately, the type Ada.Text_IO.File_Type is opaque and it is
|
||||
-- not possible to check what is applies to, or what are the properties of
|
||||
-- the underling file handle.
|
||||
|
||||
function Has_Colors (Self : Terminal_Info) return Boolean;
|
||||
-- Whether the terminals supports colors.
|
||||
|
||||
type ANSI_Color is
|
||||
(Unchanged,
|
||||
Black,
|
||||
Red,
|
||||
Green,
|
||||
Yellow,
|
||||
Blue,
|
||||
Magenta,
|
||||
Cyan,
|
||||
Grey,
|
||||
Reset);
|
||||
-- The colors that can be output in a terminal (ANSI definitions). The
|
||||
-- actual color that the user will see might be different, since a terminal
|
||||
-- might associate a different color to the same escape sequence.
|
||||
|
||||
type ANSI_Style is
|
||||
(Unchanged,
|
||||
Bright,
|
||||
Dim,
|
||||
Normal,
|
||||
Reset_All);
|
||||
-- The style for the text. Some styles are not supported on some
|
||||
-- terminals, like Dim on the Windows console.
|
||||
|
||||
procedure Set_Color
|
||||
(Self : in out Terminal_Info;
|
||||
Term : Ada.Text_IO.File_Type := Ada.Text_IO.Standard_Output;
|
||||
Foreground : ANSI_Color := Unchanged;
|
||||
Background : ANSI_Color := Unchanged;
|
||||
Style : ANSI_Style := Unchanged);
|
||||
-- Change the colors that will be used for subsequent output on the
|
||||
-- terminal.
|
||||
-- This procedure has no effect if Has_Colors returns False.
|
||||
-- In general, it is not recommended to output colors to files, so you
|
||||
-- should not use Set_Color in such a context.
|
||||
|
||||
procedure Set_Fg
|
||||
(Self : in out Terminal_Info;
|
||||
Color : ANSI_Color;
|
||||
Term : Ada.Text_IO.File_Type := Ada.Text_IO.Standard_Output);
|
||||
procedure Set_Bg
|
||||
(Self : in out Terminal_Info;
|
||||
Color : ANSI_Color;
|
||||
Term : Ada.Text_IO.File_Type := Ada.Text_IO.Standard_Output);
|
||||
procedure Set_Style
|
||||
(Self : in out Terminal_Info;
|
||||
Style : ANSI_Style;
|
||||
Term : Ada.Text_IO.File_Type := Ada.Text_IO.Standard_Output);
|
||||
-- Override specific colors.
|
||||
|
||||
-------------
|
||||
-- Cursors --
|
||||
-------------
|
||||
|
||||
procedure Beginning_Of_Line
|
||||
(Self : in out Terminal_Info;
|
||||
Term : Ada.Text_IO.File_Type := Ada.Text_IO.Standard_Output);
|
||||
-- Move the cursor back to the beginning of the line.
|
||||
-- This has no impact on files, only in interactive terminals.
|
||||
|
||||
procedure Clear_To_End_Of_Line
|
||||
(Self : in out Terminal_Info;
|
||||
Term : Ada.Text_IO.File_Type := Ada.Text_IO.Standard_Output);
|
||||
-- Delete from the cursor position to the end of line
|
||||
|
||||
private
|
||||
type Color_Sequence_Type is (Unsupported, ANSI_Sequences, WIN32_Sequences);
|
||||
|
||||
type FD_Type is (Stdout, Stderr, File);
|
||||
-- What type of file descriptor the terminal_info applies to.
|
||||
|
||||
type Terminal_Info is tagged record
|
||||
Colors : Color_Sequence_Type := Unsupported;
|
||||
|
||||
Fore : ANSI_Color := Black;
|
||||
Back : ANSI_Color := Grey;
|
||||
Style : ANSI_Style := Normal;
|
||||
-- Current attributes (on Windows, all three must be changed at the
|
||||
-- same time)
|
||||
|
||||
Default_Fore : ANSI_Color := Black;
|
||||
Default_Back : ANSI_Color := Grey;
|
||||
Default_Style : ANSI_Style := Normal;
|
||||
-- Default windows attributes (computed in Init)
|
||||
|
||||
FD : FD_Type := Stdout;
|
||||
-- Whether the associated terminal is stdout (windows only)
|
||||
end record;
|
||||
|
||||
end GNATCOLL.Terminal;
|
||||
|
|
@ -1,67 +0,0 @@
|
|||
with GNATCOLL.Terminal; use GNATCOLL.Terminal;
|
||||
with Ada.Text_IO; use Ada.Text_IO;
|
||||
|
||||
procedure Test_Colors is
|
||||
Info : Terminal_Info;
|
||||
|
||||
procedure Header (Name : String; Fg : ANSI_Color);
|
||||
procedure Header (Name : String; Fg : ANSI_Color) is
|
||||
begin
|
||||
Info.Set_Color (Standard_Output, Fg, Reset, Normal);
|
||||
Put (Name);
|
||||
end Header;
|
||||
|
||||
procedure Show (Name : String; Bg : ANSI_Color);
|
||||
procedure Show (Name : String; Bg : ANSI_Color) is
|
||||
begin
|
||||
Info.Set_Color (Standard_Output, Reset, Bg, Normal);
|
||||
Put (Name);
|
||||
|
||||
for Fg in Black .. Grey loop
|
||||
Info.Set_Color (Standard_Output, Fg, Bg, Normal);
|
||||
Put ("X ");
|
||||
Info.Set_Color (Standard_Output, Style => Dim);
|
||||
Put ("X ");
|
||||
Info.Set_Color (Standard_Output, Style => Bright);
|
||||
Put ("X ");
|
||||
Info.Set_Color (Standard_Output, Style => Reset_All);
|
||||
Put (" ");
|
||||
end loop;
|
||||
|
||||
New_Line;
|
||||
end Show;
|
||||
|
||||
begin
|
||||
Info.Init_For_Stdout (Auto);
|
||||
|
||||
Header (" ", Reset);
|
||||
Header ("black ", Black);
|
||||
Header ("red ", Red);
|
||||
Header ("green ", Green);
|
||||
Header ("yellow ", Yellow);
|
||||
Header ("blue ", Blue);
|
||||
Header ("magenta", Magenta);
|
||||
Header ("cyan ", Cyan);
|
||||
Header ("white ", Grey);
|
||||
New_Line;
|
||||
|
||||
Show ("black ", Black);
|
||||
Show ("red ", Red);
|
||||
Show ("green ", Green);
|
||||
Show ("yellow ", Yellow);
|
||||
Show ("blue ", Blue);
|
||||
Show ("magenta ", Magenta);
|
||||
Show ("cyan ", Cyan);
|
||||
Show ("white ", Grey);
|
||||
|
||||
for J in 1 .. 1_000 loop
|
||||
if J mod 10 = 0 then
|
||||
Put ("Processing file" & J'Img & " with long name");
|
||||
else
|
||||
Put ("Processing file" & J'Img);
|
||||
end if;
|
||||
delay 0.1;
|
||||
Info.Beginning_Of_Line (Standard_Output);
|
||||
Info.Clear_To_End_Of_Line (Standard_Output);
|
||||
end loop;
|
||||
end Test_Colors;
|
||||
Loading…
Reference in New Issue