From fde93a7b256f5e75ee95e82e95a095b50f7a7d36 Mon Sep 17 00:00:00 2001 From: Juha Date: Sat, 20 Apr 2024 08:03:00 +0300 Subject: [PATCH] LazBuild: Improve colored output. Issue #40878, patch by n7800. --- components/lazutils/lazlogger.pas | 11 +-- components/lazutils/lazloggerbase.pas | 1 + ide/colortty.pas | 104 ++++++++++++++++++++++++ ide/lazarus.pp | 3 +- ide/lazbuild.lpr | 5 +- {components/lazutils => ide}/laztty.pas | 78 +----------------- 6 files changed, 115 insertions(+), 87 deletions(-) create mode 100644 ide/colortty.pas rename {components/lazutils => ide}/laztty.pas (72%) diff --git a/components/lazutils/lazlogger.pas b/components/lazutils/lazlogger.pas index 5320f150cc..bd356edf31 100644 --- a/components/lazutils/lazlogger.pas +++ b/components/lazutils/lazlogger.pas @@ -15,7 +15,7 @@ interface uses Classes, SysUtils, types, math, // LazUtils - LazLoggerBase, LazClasses, LazFileUtils, LazStringUtils, LazUTF8, laztty; + LazLoggerBase, LazClasses, LazFileUtils, LazStringUtils, LazUTF8; type @@ -536,13 +536,7 @@ begin DoOpenFile; if FActiveLogText = nil then exit; - - //WriteLn(FActiveLogText^, s); - if TTYCheckSupported and IsATTY(FActiveLogText^) then - WriteLn(FActiveLogText^, Colorize(s)) - else - WriteLn(FActiveLogText^, s); - + WriteLn(FActiveLogText^, s); if FCloseLogFileBetweenWrites then DoCloseFile; @@ -806,6 +800,7 @@ begin Handled := False; CbInfo.Group := AGroup; CbInfo.DbgOutAtBOL := AtBOL; + CbInfo.LogText := FileHandle.ActiveLogText; CB2(Self, s, Indent, Handled, CbInfo); if Handled then Exit; diff --git a/components/lazutils/lazloggerbase.pas b/components/lazutils/lazloggerbase.pas index dddc4d7226..109da6ebde 100644 --- a/components/lazutils/lazloggerbase.pas +++ b/components/lazutils/lazloggerbase.pas @@ -55,6 +55,7 @@ type TLazLoggerWriteExEventInfo = record Group: PLazLoggerLogGroup; // if only one group / remember nestlevel count DbgOutAtBOL: Boolean; // Only for DbgOut, True if first segment in new line + LogText: PText; end; TLazLoggerWriteEvent = procedure(Sender: TObject; S: string; var Handled: Boolean) of object; diff --git a/ide/colortty.pas b/ide/colortty.pas new file mode 100644 index 0000000000..ff32627616 --- /dev/null +++ b/ide/colortty.pas @@ -0,0 +1,104 @@ +{ + *************************************************************************** + * * + * This source 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 code 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. * + * * + * A copy of the GNU General Public License is available on the World * + * Wide Web at . You can also * + * obtain it by writing to the Free Software Foundation, * + * Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA. * + * * + *************************************************************************** + + Abstract: + Unit for coloring Lazarus and LazBuild messages in LazLogger +} +unit ColorTTY; + +{$mode objfpc}{$H+} + +interface + +uses + LazTTY, LazLogger; + +implementation + +type + TOutputColor = (oc_black, oc_red, oc_green, oc_orange, oc_blue, oc_magenta, oc_cyan, oc_lightgray); + + TTermColor = record + fTerm: PChar; + fColor: TOutputColor; + end; + +const + cTermColors: array[0..5] of TTermColor = + ( + (fTerm: 'Info:' ; fColor: oc_lightgray), + (fTerm: 'Note:' ; fColor: oc_cyan ), + (fTerm: 'Hint:' ; fColor: oc_cyan ), + (fTerm: 'Warning:'; fColor: oc_magenta ), + (fTerm: 'Error:' ; fColor: oc_red ), + (fTerm: 'Fatal:' ; fColor: oc_red ) + ); + +function ColorizeTerm(aTerm: string; aColor: TOutputColor): ansistring; inline; +begin + case aColor of + oc_black : result := #27'[1m'#27'[30m'; + oc_red : result := #27'[1m'#27'[31m'; + oc_green : result := #27'[1m'#27'[32m'; + oc_orange : result := #27'[1m'#27'[33m'; + oc_blue : result := #27'[1m'#27'[34m'; + oc_magenta : result := #27'[1m'#27'[35m'; + oc_cyan : result := #27'[1m'#27'[36m'; + oc_lightgray: result := #27'[1m'#27'[37m'; + end; + result := result + aTerm + #27'[0m'; +end; + +{ TColorTTY } + +type + TColorTTY = class + class procedure DoLazLoggerDebugLnEx({%H-}Sender: TObject; var LogTxt, {%H-}LogIndent: string; + var {%H-}Handled: Boolean; const AnInfo: TLazLoggerWriteExEventInfo); + end; + +class procedure TColorTTY.DoLazLoggerDebugLnEx(Sender: TObject; var LogTxt, LogIndent: string; + var Handled: Boolean; const AnInfo: TLazLoggerWriteExEventInfo); +var + i, lTermPos, lTermLen: integer; + lPart1, lPart2, lPart3: ansistring; +begin + // do not change message if colors are not supported + if not TTYCheckSupported then {%H-}exit; + if not Assigned(AnInfo.LogText) then exit; + if not IsATTY(AnInfo.LogText^) then exit; + + for i := 0 to high(cTermColors) do + begin + lTermPos := pos(cTermColors[i].fTerm, LogTxt); + if lTermPos <= 0 then continue; + lTermLen := length(cTermColors[i].fTerm); + lPart1 := copy(LogTxt, 1, lTermPos - 1); + lPart2 := copy(LogTxt, lTermPos, lTermLen); + lPart3 := copy(LogTxt, lTermPos + lTermLen, length(LogTxt)); + LogTxt := lPart1 + ColorizeTerm(lPart2, cTermColors[i].fColor) + lPart3; + exit; + end; +end; + +initialization + DebugLogger.OnDebugLnEx := @TColorTTY.DoLazLoggerDebugLnEx; +end. + diff --git a/ide/lazarus.pp b/ide/lazarus.pp index f60546e74a..55a8870334 100644 --- a/ide/lazarus.pp +++ b/ide/lazarus.pp @@ -81,7 +81,8 @@ uses OnlinePackageManager, SimpleWebServerGUI, LazProjectGroups, Pas2jsDsgn, charactermap_ide_pkg, {$ENDIF} - MainBase; + MainBase, + ColorTTY; {$I revision.inc} {$R lazarus.res} diff --git a/ide/lazbuild.lpr b/ide/lazbuild.lpr index 0a88eac47a..0599af0b9b 100644 --- a/ide/lazbuild.lpr +++ b/ide/lazbuild.lpr @@ -50,7 +50,8 @@ uses InitialSetupProc, ExtToolsConsole, ApplicationBundle, IDETranslations, LazarusIDEStrConsts, MiscOptions, Project, PackageDefs, PackageLinks, PackageSystem, InterPkgConflictFiles, BuildLazDialog, - BuildProfileManager, BuildManager, BaseBuildManager, ModeMatrixOpts; + BuildProfileManager, BuildManager, BaseBuildManager, ModeMatrixOpts, + ColorTTY; type TPkgAction = ( @@ -1859,7 +1860,7 @@ end; procedure TLazBuildApplication.PrintErrorAndHalt(Code: Byte; const Msg: string); begin if Msg <> '' then - writeln('Error: (lazbuild) ', LineBreaksToSystemLineBreaks(Msg)); + debugln('Error: (lazbuild) ', LineBreaksToSystemLineBreaks(Msg)); halt(Code); end; diff --git a/components/lazutils/laztty.pas b/ide/laztty.pas similarity index 72% rename from components/lazutils/laztty.pas rename to ide/laztty.pas index 441dcc1c16..0905e685c1 100644 --- a/components/lazutils/laztty.pas +++ b/ide/laztty.pas @@ -1,5 +1,6 @@ { - This is copied from Free Pascal Compiler source files comptty.pas and comphook.pas. + * This is copied from the Free Pascal Compiler source file comptty.pas + Copyright (c) 2020 by the Free Pascal development team This unit contains platform-specific code for checking TTY output @@ -37,11 +38,6 @@ const 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); -function Colorize(const s : AnsiString):AnsiString; implementation @@ -175,74 +171,4 @@ begin Result:=IsATTYValue; end; -function open_esc(color: TOutputColor):ansistring; -begin - case color of - oc_black: - Result:=#27'[1m'#27'[30m'; - oc_red: - Result:=#27'[1m'#27'[31m'; - oc_green: - Result:=#27'[1m'#27'[32m'; - oc_orange: - Result:=#27'[1m'#27'[33m'; - og_blue: - Result:=#27'[1m'#27'[34m'; - oc_magenta: - Result:=#27'[1m'#27'[35m'; - oc_cyan: - Result:=#27'[1m'#27'[36m'; - oc_lightgray: - Result:=#27'[1m'#27'[37m'; - end; -end; - -type tkeyword=record - t:pchar; - c:TOutputColor; - end; - -const terms:array[0..6] of tkeyword = -( - (t:'Note:';c:oc_orange), - (t:'Hint:';c:oc_lightgray), - (t:'Warning:';c:oc_magenta), - (t:'Error:';c:oc_red), - (t:'(lazbuild)';c:oc_lightgray), - (t:'(lazarus)';c:oc_cyan), - (t:'gtk2';c:oc_green) -); - -function Colorize(const s : AnsiString):AnsiString; -var - i,p,ll:integer; - color:ToutputColor; - p1,p2,p3:ansistring; -begin - for i:=0 to high(terms) do - begin - p:=pos(terms[i].t,s); - if p<=0 then continue; - ll:=length(terms[i].t); - p1:=copy(s,1,p-1); - p2:=copy(s,p,ll); - p3:=copy(s,p+ll,length(s)); - Result:=p1+ - open_esc(terms[i].c)+p2+#27'[0m'+ - p3; - exit; - end; - Result:=s; -end; - -procedure WriteColoredOutput(var t: Text;color: TOutputColor;const s : AnsiString); -begin - if TTYCheckSupported and IsATTY(t) then - write(t,open_esc(color)); - write(t,s); - if TTYCheckSupported and IsATTY(t) then - write(t,#27'[0m'); -end; - - end.