From 8e3ed7da28e82c770a7e812bbc88ba315af6088d Mon Sep 17 00:00:00 2001 From: Juha Date: Sat, 6 Apr 2024 20:38:23 +0300 Subject: [PATCH] LazBuild: Print colored warnings, errors and notes when running on real TTY. Issue #40878, patch by Anton Kavalenka. --- ide/lazbuild.lpr | 22 +++-- ide/laztty.pas | 205 +++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 222 insertions(+), 5 deletions(-) create mode 100644 ide/laztty.pas diff --git a/ide/lazbuild.lpr b/ide/lazbuild.lpr index 4bc58e4aa9..0d76b066d9 100644 --- a/ide/lazbuild.lpr +++ b/ide/lazbuild.lpr @@ -45,7 +45,7 @@ uses InitialSetupProc, ExtToolsConsole, ApplicationBundle, IDETranslations, LazarusIDEStrConsts, MiscOptions, Project, PackageDefs, PackageLinks, PackageSystem, InterPkgConflictFiles, BuildLazDialog, - BuildProfileManager, BuildManager, BaseBuildManager, ModeMatrixOpts; + BuildProfileManager, BuildManager, BaseBuildManager, ModeMatrixOpts, LazTTY; type TPkgAction = ( @@ -1836,25 +1836,37 @@ end; procedure TLazBuildApplication.PrintInfo(const Msg: string); begin if ConsoleVerbosity >= 1 then - debugln('Info: (lazbuild) ', LineBreaksToSystemLineBreaks(Msg)); + begin + WriteColoredoutput(output,oc_lightgray,'Info:'); + debugln('(lazbuild) ',LineBreaksToSystemLineBreaks(Msg)) + end; end; procedure TLazBuildApplication.PrintHint(const Msg: string); begin if ConsoleVerbosity >= 0 then - debugln('Hint: (lazbuild) ', LineBreaksToSystemLineBreaks(Msg)); + begin + WriteColoredoutput(output,oc_lightgray,'Hint:'); + debugln('(lazbuild) ',LineBreaksToSystemLineBreaks(Msg)); + end; end; procedure TLazBuildApplication.PrintWarning(const Msg: string); begin if ConsoleVerbosity >= -1 then - debugln('Warning: (lazbuild) ', LineBreaksToSystemLineBreaks(Msg)); + begin + WriteColoredoutput(output,oc_magenta,'Warning:'); + debugln('(lazbuild) ', LineBreaksToSystemLineBreaks(Msg)); + end; end; procedure TLazBuildApplication.PrintErrorAndHalt(Code: Byte; const Msg: string); begin if Msg <> '' then - writeln('Error: (lazbuild) ', LineBreaksToSystemLineBreaks(Msg)); + begin + WriteColoredoutput(output,oc_red,'Error:'); + writeln('(lazbuild) ', LineBreaksToSystemLineBreaks(Msg)); + end; halt(Code); end; diff --git a/ide/laztty.pas b/ide/laztty.pas new file mode 100644 index 0000000000..a43eb0d0ef --- /dev/null +++ b/ide/laztty.pas @@ -0,0 +1,205 @@ +{ + This is copied from Free Pascal Compiler source files comptty.pas and comphook.pas. + 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 LazTTY; + +{-$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) or defined(DARWIN)} + TTYCheckSupported = true; +{$else defined(linux) or defined(MSWINDOWS) or defined(OS2) or defined(GO32V2) or defined(WATCOM) or defined(DARWIN)} + TTYCheckSupported = false; +{$endif defined(linux) or defined(MSWINDOWS) or defined(OS2) or defined(GO32V2) or defined(WATCOM) or defined(DARWIN)} + +type + TOutputColor = (oc_black,oc_red,oc_green,oc_orange,og_blue,oc_magenta,oc_cyan,oc_lightgray); + +procedure WriteColoredOutput(var t: Text;color: TOutputColor;const s : AnsiString); + +implementation + +{$if defined(linux) or defined(darwin)} + uses + termio; +{$endif defined(linux) or defined(darwin)} +{$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; + +{$if defined(linux) or defined(darwin)} +function LinuxIsATTY(var t : text) : Boolean; inline; +begin + LinuxIsATTY:=termio.IsATTY(t)=1; +end; +{$endif defined(linux) or defined(darwin)} + +{$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. *) +{$if defined(linux) or defined(darwin)} + IsATTYValue:=LinuxIsATTY(t); +{$endif defined(linux) or defined(darwin)} +{$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; + +procedure WriteColoredOutput(var t: Text;color: TOutputColor;const s : AnsiString); +begin + if TTYCheckSupported and IsATTY(t) then + begin + case color of + oc_black: + write(t,#27'[1m'#27'[30m'); + oc_red: + write(t,#27'[1m'#27'[31m'); + oc_green: + write(t,#27'[1m'#27'[32m'); + oc_orange: + write(t,#27'[1m'#27'[33m'); + og_blue: + write(t,#27'[1m'#27'[34m'); + oc_magenta: + write(t,#27'[1m'#27'[35m'); + oc_cyan: + write(t,#27'[1m'#27'[36m'); + oc_lightgray: + write(t,#27'[1m'#27'[37m'); + end; + end; + write(t,s); + if TTYCheckSupported and IsATTY(t) then + write(t,#27'[0m'); +end; + + +end.