LazBuild: Improve colored output. Issue #40878, patch by n7800.

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);
-    //WriteLn(FActiveLogText^, s);
-    if TTYCheckSupported and IsATTY(FActiveLogText^) then
-      WriteLn(FActiveLogText^, Colorize(s))
-    else
-      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;

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;

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 <http://www.gnu.org/copyleft/gpl.html>. 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.
+

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}

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;
 

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.