Browse Source

The "Compiler Output" view is now colorized. Will add option to disable this. Also updates for previous commit.

Martijn Laan 6 years ago
parent
commit
e33ea430d0
5 changed files with 63 additions and 50 deletions
  1. 2 0
      Projects/CompForm.dfm
  2. 46 39
      Projects/CompForm.pas
  3. 3 4
      Projects/CompInt.pas
  4. 10 7
      Projects/Compile.pas
  5. 2 0
      whatsnew.htm

+ 2 - 0
Projects/CompForm.dfm

@@ -80,11 +80,13 @@ object CompileForm: TCompileForm
         Top = 0
         Width = 361
         Height = 83
+        Style = lbOwnerDrawFixed
         Align = alClient
         BorderStyle = bsNone
         ItemHeight = 13
         PopupMenu = ListPopupMenu
         TabOrder = 0
+        OnDrawItem = CompilerOutputListDrawItem
       end
       object TabSet: TNewTabSet
         Left = 0

+ 46 - 39
Projects/CompForm.pas

@@ -51,6 +51,8 @@ const
 type
   TISScintEdit = class;
 
+  TStatusMessageKind = (smkStartEnd, smkNormal, smkWarning, smkError);
+
   TCompileForm = class(TUIStateForm)
     MainMenu1: TMainMenu;
     FMenu: TMenuItem;
@@ -245,6 +247,8 @@ type
     procedure VZoomResetClick(Sender: TObject);
     procedure ECompleteWordClick(Sender: TObject);
     procedure FSaveEncodingItemClick(Sender: TObject);
+    procedure CompilerOutputListDrawItem(Control: TWinControl; Index: Integer;
+      Rect: TRect; State: TOwnerDrawState);
   private
     { Private declarations }
     FCompilerVersion: PCompilerVersionInfo;
@@ -367,7 +371,7 @@ type
     procedure SetStatusPanelVisible(const AVisible: Boolean);
     procedure SetStepLine(ALine: Integer);
     procedure ShowOpenDialog(const Examples: Boolean);
-    procedure StatusMessage(const S: String);
+    procedure StatusMessage(const Kind: TStatusMessageKind; const S: String);
     procedure SyncEditorOptions;
     procedure ToggleBreakPoint(Line: Integer);
     procedure UpdateAllLineMarkers;
@@ -1381,14 +1385,14 @@ begin
   end;
 end;
 
-procedure TCompileForm.StatusMessage(const S: String);
+procedure TCompileForm.StatusMessage(const Kind: TStatusMessageKind; const S: String);
 var
   DC: HDC;
   Size: TSize;
 begin
   with CompilerOutputList do begin
     try
-      TopIndex := Items.Add(S);
+      TopIndex := Items.AddObject(S, TObject(Kind));
     except
       on EOutOfResources do begin
         Clear;
@@ -1424,6 +1428,7 @@ var
   begin
     if FirstLine then begin
       FirstLine := False;
+      { Don't forget about DebugOutputListDrawItem if you change the format of the following timestamp. }
       Insert(Format('[%.2u%s%.2u%s%.2u%s%.3u]   ', [ST.wHour, {$IFDEF IS_DXE}FormatSettings.{$ENDIF}TimeSeparator,
         ST.wMinute, {$IFDEF IS_DXE}FormatSettings.{$ENDIF}TimeSeparator, ST.wSecond, {$IFDEF IS_DXE}FormatSettings.{$ENDIF}DecimalSeparator,
         ST.wMilliseconds]), S, 1);
@@ -1519,7 +1524,10 @@ begin
           end;
         end;
       iscbNotifyStatus:
-        Form.StatusMessage(Data.StatusMsg);
+        if Data.Warning then
+          Form.StatusMessage(smkWarning, Data.StatusMsg)
+        else
+          Form.StatusMessage(smkNormal, Data.StatusMsg);
       iscbNotifyIdle:
         begin
           Form.UpdateCompileStatusPanels(Data.CompressProgress,
@@ -1685,8 +1693,8 @@ begin
     ReadScriptLines(AppData.Lines);
 
     StartTime := GetTickCount;
-    StatusMessage(Format(SCompilerStatusStarting, [TimeToStr(Time)]));
-    StatusMessage('');
+    StatusMessage(smkStartEnd, Format(SCompilerStatusStarting, [TimeToStr(Time)]));
+    StatusMessage(smkStartEnd, '');
     FCompiling := True;
     FCompileWantAbort := False;
     UpdateRunMenu;
@@ -1697,7 +1705,7 @@ begin
     {$ELSE}
     if ISCompileScript(Params, False) <> isceNoError then begin
     {$ENDIF}
-      StatusMessage(SCompilerStatusErrorAborted);
+      StatusMessage(smkError, SCompilerStatusErrorAborted);
       if not ReadFromFile and (AppData.ErrorLine > 0) and
          (AppData.ErrorFilename = '') then begin
         { Move the caret to the line number the error occured on }
@@ -1718,7 +1726,7 @@ begin
     end;
     ElapsedTime := GetTickCount - StartTime;
     ElapsedSeconds := ElapsedTime div 1000;
-    StatusMessage(Format(SCompilerStatusFinished, [TimeToStr(Time),
+    StatusMessage(smkStartEnd, Format(SCompilerStatusFinished, [TimeToStr(Time),
       Format('%.2u%s%.2u%s%.3u', [ElapsedSeconds div 60, {$IFDEF IS_DXE}FormatSettings.{$ENDIF}TimeSeparator,
         ElapsedSeconds mod 60, {$IFDEF IS_DXE}FormatSettings.{$ENDIF}DecimalSeparator, ElapsedTime mod 1000])]));
   finally
@@ -3940,48 +3948,47 @@ begin
   end;
 end;
 
-procedure TCompileForm.DebugOutputListDrawItem(Control: TWinControl;
+procedure TCompileForm.CompilerOutputListDrawItem(Control: TWinControl;
   Index: Integer; Rect: TRect; State: TOwnerDrawState);
+const
+  Colors: array [TStatusMessageKind] of TColor = (clGreen, clWindowText, clOlive, clRed);
+var
+  Canvas: TCanvas;
+  S: String;
+  Color: TColor;
+begin
+  Canvas := CompilerOutputList.Canvas;
+  S := CompilerOutputList.Items[Index];
+  Color := Colors[TStatusMessageKind(CompilerOutputList.Items.Objects[Index])];
 
-  function SafeGetItem(const ListBoxHandle: HWND; const Index: Integer): String;
-  { Prior to Delphi 6, the VCL will incur a buffer overflow if you trying
-    reading an item from a TListBox longer than 4096 characters. }
-  var
-    Len: Integer;
-  begin
-    Len := SendMessage(ListBoxHandle, LB_GETTEXTLEN, Index, 0);
-    if Len <= 0 then
-      Result := ''  { zero length or out of range? }
-    else begin
-      SetString(Result, nil, Len);
-      Len := SendMessage(ListBoxHandle, LB_GETTEXT, Index, LPARAM(Result));
-      if Len <= 0 then
-        Result := ''  { failed? }
-      else
-        SetLength(Result, Len);  { since LB_GETTEXTLEN can overestimate }
-    end;
-  end;
+  Canvas.FillRect(Rect);
+  Inc(Rect.Left, 2);
+  if not (odSelected in State) then
+    Canvas.Font.Color := Color;
+  Canvas.TextOut(Rect.Left, Rect.Top, S);
+end;
 
+procedure TCompileForm.DebugOutputListDrawItem(Control: TWinControl;
+  Index: Integer; Rect: TRect; State: TOwnerDrawState);
 var
+  Canvas: TCanvas;
   S: String;
 begin
-  { An owner drawn list box is used for precise tab expansion }  
-  S := SafeGetItem(DebugOutputList.Handle, Index);
-  DebugOutputList.Canvas.FillRect(Rect);
+  Canvas := DebugOutputList.Canvas;
+  S := DebugOutputList.Items[Index];
+
+  Canvas.FillRect(Rect);
   Inc(Rect.Left, 2);
   if (S <> '') and (S[1] = #9) then
-    DebugOutputList.Canvas.TextOut(Rect.Left + FDebugLogListTimeWidth,
-      Rect.Top, Copy(S, 2, Maxint))
+    Canvas.TextOut(Rect.Left + FDebugLogListTimeWidth, Rect.Top, Copy(S, 2, Maxint))
   else begin
     if (Length(S) > 20) and (S[18] = '-') and (S[19] = '-') and (S[20] = ' ') then begin
       { Draw lines that begin with '-- ' (like '-- File entry --') in bold }
-      DebugOutputList.Canvas.TextOut(Rect.Left, Rect.Top, Copy(S, 1, 17));
-      DebugOutputList.Canvas.Font.Style := [fsBold];
-      DebugOutputList.Canvas.TextOut(Rect.Left + FDebugLogListTimeWidth,
-        Rect.Top, Copy(S, 18, Maxint));
-    end
-    else
-      DebugOutputList.Canvas.TextOut(Rect.Left, Rect.Top, S);
+      Canvas.TextOut(Rect.Left, Rect.Top, Copy(S, 1, 17));
+      Canvas.Font.Style := [fsBold];
+      Canvas.TextOut(Rect.Left + FDebugLogListTimeWidth, Rect.Top, Copy(S, 18, Maxint));
+    end else
+      Canvas.TextOut(Rect.Left, Rect.Top, S);
   end;
 end;
 

+ 3 - 4
Projects/CompInt.pas

@@ -2,13 +2,11 @@ unit CompInt;
 
 {
   Inno Setup
-  Copyright (C) 1997-2007 Jordan Russell
+  Copyright (C) 1997-2018 Jordan Russell
   Portions by Martijn Laan
   For conditions of distribution and use, see LICENSE.TXT.
 
   Compiler interface
-
-  $jrsoftware: issrc/Projects/CompInt.pas,v 1.16 2011/06/15 14:37:46 mlaan Exp $
 }
 
 interface
@@ -62,7 +60,8 @@ type
                                 same pointer each time). }
 
       iscbNotifyStatus: (
-        StatusMsg: PChar);    { [in] Contents of status message. }
+        StatusMsg: PChar;     { [in] Contents of status message. }
+        Warning: BOOL);       { [in] Warning indicator (new in 6.0.0) }
 
       iscbNotifyIdle: (
         CompressProgress: Cardinal;     { [in] Amount compressed so far

+ 10 - 7
Projects/Compile.pas

@@ -408,8 +408,9 @@ type
 
     CachedUserDocsDir: String;
 
-    procedure AddStatus(const S: String);
-    procedure AddStatusFmt(const Msg: String; const Args: array of const);
+    procedure AddStatus(const S: String; const Warning: Boolean = False);
+    procedure AddStatusFmt(const Msg: String; const Args: array of const;
+      const Warning: Boolean);
     procedure AbortCompile(const Msg: String);
     procedure AbortCompileFmt(const Msg: String; const Args: array of const);
     procedure AbortCompileOnLine(const Msg: String);
@@ -2548,17 +2549,19 @@ begin
   end;
 end;
 
-procedure TSetupCompiler.AddStatus(const S: String);
+procedure TSetupCompiler.AddStatus(const S: String; const Warning: Boolean);
 var
   Data: TCompilerCallbackData;
 begin
   Data.StatusMsg := PChar(S);
+  Data.Warning := Warning;
   DoCallback(iscbNotifyStatus, Data);
 end;
 
-procedure TSetupCompiler.AddStatusFmt(const Msg: String; const Args: array of const);
+procedure TSetupCompiler.AddStatusFmt(const Msg: String; const Args: array of const;
+  const Warning: Boolean);
 begin
-  AddStatus(Format(Msg, Args));
+  AddStatus(Format(Msg, Args), Warning);
 end;
 
 procedure TSetupCompiler.AbortCompile(const Msg: String);
@@ -8529,7 +8532,7 @@ var
       ResultCode := PreprocCleanupProc(PreprocCleanupProcData);
       if ResultCode <> 0 then
         AddStatusFmt(SCompilerStatusWarning +
-          'Preprocessor cleanup function failed with code %d.', [ResultCode]);
+          'Preprocessor cleanup function failed with code %d.', [ResultCode], True);
     end;
   end;
 
@@ -9223,7 +9226,7 @@ begin
     { Done }
     AddStatus('');
     for I := 0 to WarningsList.Count-1 do
-      AddStatus(SCompilerStatusWarning + WarningsList[I]);
+      AddStatus(SCompilerStatusWarning + WarningsList[I], True);
     asm jmp @1; db 0,'Inno Setup Compiler, Copyright (C) 1997-2018 Jordan Russell, '
                   db 'Portions Copyright (C) 2000-2018 Martijn Laan',0; @1: end;
     { Note: Removing or modifying the copyright text is a violation of the

+ 2 - 0
whatsnew.htm

@@ -92,6 +92,8 @@ For conditions of distribution and use, see <a href="http://www.jrsoftware.org/f
     <li>Options button <i>Associate .iss files with this compiler</i> can now associate for the current user instead of displaying an error if administrative privileges are not available.</li>
     <li>Option <i>Allow Undo after save</i> is now on by default for new installations.</li>
     <li>Updated all icons and flattened the interface for a more modern look.</li>
+    <li>The "Compiler Output" view is now colorized.</li>
+    <li>The "Debout Output" view now uses bold text for any entry lines such as '-- File entry --'.</li>
   </ul>
   </li>
   <li>Pascal Scripting changes: