mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-22 06:49:27 +02:00
+ added coloured compiler output support for OS/2 and DOS targets, platform-specific parts refactored to a standalone unit to remove the heap of ifdefs in unit comphook
git-svn-id: trunk@47566 -
This commit is contained in:
Tomas Hajny
parent
6ac2957187
commit
74eb7b5050
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -167,6 +167,7 @@ compiler/comphook.pas svneol=native#text/plain
|
||||
compiler/compiler.pas svneol=native#text/plain
|
||||
compiler/compinnr.pas svneol=native#text/plain
|
||||
compiler/comprsrc.pas svneol=native#text/plain
|
||||
compiler/comptty.pas svneol=native#text/plain
|
||||
compiler/constexp.pas svneol=native#text/x-pascal
|
||||
compiler/cprofile.pas svneol=native#text/pascal
|
||||
compiler/crefs.pas svneol=native#text/plain
|
||||
|
||||
@ -169,14 +169,7 @@ const
|
||||
implementation
|
||||
|
||||
uses
|
||||
cutils, systems, globals
|
||||
{$ifdef linux}
|
||||
,termio
|
||||
{$endif linux}
|
||||
{$ifdef mswindows}
|
||||
,windows
|
||||
{$endif mswindows}
|
||||
;
|
||||
cutils, systems, globals, comptty;
|
||||
|
||||
{****************************************************************************
|
||||
Helper Routines
|
||||
@ -214,51 +207,9 @@ end;
|
||||
type
|
||||
TOutputColor = (oc_black,oc_red,oc_green,oc_orange,og_blue,oc_magenta,oc_cyan,oc_lightgray);
|
||||
|
||||
{$if defined(linux) or defined(MSWINDOWS)}
|
||||
const
|
||||
CachedIsATTY : Boolean = false;
|
||||
IsATTYValue : Boolean = false;
|
||||
|
||||
{$ifdef linux}
|
||||
function IsATTY(var t : text) : Boolean;
|
||||
begin
|
||||
if not(CachedIsATTY) then
|
||||
begin
|
||||
IsATTYValue:=termio.IsATTY(t)=1;
|
||||
CachedIsATTY:=true;
|
||||
end;
|
||||
Result:=IsATTYValue;
|
||||
end;
|
||||
{$endif linux}
|
||||
|
||||
{$ifdef MSWINDOWS}
|
||||
const ENABLE_VIRTUAL_TERMINAL_PROCESSING = $0004;
|
||||
|
||||
function IsATTY(var t : text) : Boolean;
|
||||
const dwMode: dword = 0;
|
||||
begin
|
||||
if not(CachedIsATTY) then
|
||||
begin
|
||||
IsATTYValue := false;
|
||||
if GetConsoleMode(TextRec(t).handle, dwMode) then
|
||||
begin
|
||||
dwMode := dwMode or ENABLE_VIRTUAL_TERMINAL_PROCESSING;
|
||||
if SetConsoleMode(TextRec(t).handle, dwMode) then
|
||||
IsATTYValue := true;
|
||||
end;
|
||||
CachedIsATTY:=true;
|
||||
end;
|
||||
Result:=IsATTYValue;
|
||||
end;
|
||||
{$endif MSWINDOWS}
|
||||
|
||||
{$endif defined(linux) or defined(MSWINDOWS)}
|
||||
|
||||
|
||||
procedure WriteColoredOutput(var t: Text;color: TOutputColor;const s : AnsiString);
|
||||
begin
|
||||
{$if defined(linux) or defined(mswindows)}
|
||||
if IsATTY(t) then
|
||||
if TTYCheckSupported and IsATTY(t) then
|
||||
begin
|
||||
case color of
|
||||
oc_black:
|
||||
@ -279,12 +230,9 @@ procedure WriteColoredOutput(var t: Text;color: TOutputColor;const s : AnsiStrin
|
||||
write(t,#27'[1m'#27'[37m');
|
||||
end;
|
||||
end;
|
||||
{$endif linux or mswindows}
|
||||
write(t,s);
|
||||
{$if defined(linux) or defined(mswindows)}
|
||||
if IsATTY(t) then
|
||||
if TTYCheckSupported and IsATTY(t) then
|
||||
write(t,#27'[0m');
|
||||
{$endif linux}
|
||||
end;
|
||||
{****************************************************************************
|
||||
Stopping the compiler
|
||||
|
||||
172
compiler/comptty.pas
Normal file
172
compiler/comptty.pas
Normal file
@ -0,0 +1,172 @@
|
||||
{
|
||||
This file is part of the Free Pascal compiler.
|
||||
Copyright (c) 2020 by the Free Pascal development team
|
||||
|
||||
This unit contains platform-specific code for checking TTY output
|
||||
|
||||
This program is free software; you can redistribute it and/or modify
|
||||
it under the terms of the GNU General Public License as published by
|
||||
the Free Software Foundation; either version 2 of the License, or
|
||||
(at your option) any later version.
|
||||
|
||||
This program is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
GNU General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public License
|
||||
along with this program; if not, write to the Free Software
|
||||
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
|
||||
|
||||
****************************************************************************
|
||||
}
|
||||
unit comptty;
|
||||
|
||||
{$i fpcdefs.inc}
|
||||
|
||||
interface
|
||||
|
||||
function IsATTY(var t : text) : Boolean;
|
||||
|
||||
const
|
||||
(* This allows compile-time removal of the colouring functionality under not supported platforms *)
|
||||
{$if defined(linux) or defined(MSWINDOWS) or defined(OS2) or defined(GO32V2) or defined(WATCOM)}
|
||||
TTYCheckSupported = true;
|
||||
{$else defined(linux) or defined(MSWINDOWS) or defined(OS2) or defined(GO32V2) or defined(WATCOM)}
|
||||
TTYCheckSupported = false;
|
||||
{$endif defined(linux) or defined(MSWINDOWS) or defined(OS2) or defined(GO32V2) or defined(WATCOM)}
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
{$ifdef linux}
|
||||
uses
|
||||
termio;
|
||||
{$endif linux}
|
||||
{$ifdef mswindows}
|
||||
uses
|
||||
windows;
|
||||
{$endif mswindows}
|
||||
{$ifdef os2}
|
||||
uses
|
||||
doscalls;
|
||||
{$endif os2}
|
||||
{$if defined(GO32V2) or defined(WATCOM)}
|
||||
uses
|
||||
dos;
|
||||
{$endif defined(GO32V2) or defined(WATCOM)}
|
||||
|
||||
const
|
||||
CachedIsATTY : Boolean = false;
|
||||
IsATTYValue : Boolean = false;
|
||||
|
||||
{$ifdef linux}
|
||||
function LinuxIsATTY(var t : text) : Boolean; inline;
|
||||
begin
|
||||
LinuxIsATTY:=termio.IsATTY(t)=1;
|
||||
end;
|
||||
{$endif linux}
|
||||
|
||||
{$ifdef MSWINDOWS}
|
||||
const
|
||||
ENABLE_VIRTUAL_TERMINAL_PROCESSING = $0004;
|
||||
|
||||
function WindowsIsATTY(var t : text) : Boolean; inline;
|
||||
const
|
||||
dwMode: dword = 0;
|
||||
begin
|
||||
WindowsIsATTY := false;
|
||||
if GetConsoleMode(TextRec(t).handle, dwMode) then
|
||||
begin
|
||||
dwMode := dwMode or ENABLE_VIRTUAL_TERMINAL_PROCESSING;
|
||||
if SetConsoleMode(TextRec(t).handle, dwMode) then
|
||||
WindowsIsATTY := true;
|
||||
end;
|
||||
end;
|
||||
{$endif MSWINDOWS}
|
||||
|
||||
{$IFDEF OS2}
|
||||
function OS2IsATTY(var t : text) : Boolean; inline;
|
||||
var
|
||||
HT, Attr: cardinal;
|
||||
{$IFDEF EMX}
|
||||
OK: boolean;
|
||||
{$ENDIF EMX}
|
||||
const
|
||||
dhDevice = 1;
|
||||
begin
|
||||
{$IFDEF EMX}
|
||||
if os_mode = osOS2 then
|
||||
begin
|
||||
{$ENDIF EMX}
|
||||
OS2IsATTY := (DosQueryHType (TextRec (T).Handle, HT, Attr) = 0)
|
||||
and (HT = dhDevice);
|
||||
{$IFDEF EMX}
|
||||
end
|
||||
else
|
||||
begin
|
||||
OK := false;
|
||||
{$ASMMODE INTEL}
|
||||
asm
|
||||
mov ebx, TextRec (T).Handle
|
||||
mov eax, 4400h
|
||||
call syscall
|
||||
jc @IsDevEnd
|
||||
test edx, 80h { bit 7 is set if it is a device or a pipe }
|
||||
jz @IsDevEnd
|
||||
mov eax, 1A00h { Check ANSI.SYS availability }
|
||||
int 2Fh
|
||||
inc al { If it was FFh, then OK }
|
||||
jnz @IsDevEnd
|
||||
mov OK, true
|
||||
@IsDevEnd:
|
||||
end;
|
||||
OS2IsATTY := OK;
|
||||
end;
|
||||
{$ENDIF EMX}
|
||||
end;
|
||||
{$ENDIF OS2}
|
||||
|
||||
{$if defined(GO32V2) or defined(WATCOM)}
|
||||
function DosIsATTY(var t : text) : Boolean; inline;
|
||||
var
|
||||
Regs: Registers;
|
||||
begin
|
||||
Regs.EBX := TextRec (T).Handle;
|
||||
Regs.EAX := $4400;
|
||||
MsDos (Regs);
|
||||
if (Regs.Flags and FCarry <> 0) or (Regs.EDX and $80 = 0) then
|
||||
{ bit 7 is set if it is a device or a pipe }
|
||||
DosIsATTY := false
|
||||
else
|
||||
begin
|
||||
Regs.EAX := $1A00; { Check ANSI.SYS availability }
|
||||
Intr ($2F, Regs);
|
||||
DosIsATTY := Regs.AL = $FF; { If it was FFh, then OK }
|
||||
end;
|
||||
end;
|
||||
{$endif defined(GO32V2) or defined(WATCOM)}
|
||||
|
||||
function IsATTY(var t : text) : Boolean;
|
||||
begin
|
||||
if not(CachedIsATTY) then
|
||||
begin
|
||||
(* If none of the supported values is defined, false is returned by default. *)
|
||||
{$ifdef linux}
|
||||
IsATTYValue:=LinuxIsATTY(t);
|
||||
{$endif linux}
|
||||
{$ifdef MSWINDOWS}
|
||||
IsATTYValue:=WindowsIsATTY(t);
|
||||
{$endif MSWINDOWS}
|
||||
{$ifdef OS2}
|
||||
IsATTYValue:=OS2IsATTY(t);
|
||||
{$endif OS2}
|
||||
{$if defined(GO32V2) or defined(WATCOM)}
|
||||
IsATTYValue:=DosIsATTY(t);
|
||||
{$endif defined(GO32V2) or defined(WATCOM)}
|
||||
CachedIsATTY:=true;
|
||||
end;
|
||||
Result:=IsATTYValue;
|
||||
end;
|
||||
|
||||
end.
|
||||
Loading…
Reference in New Issue
Block a user