Răsfoiți Sursa

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

Martijn Laan 6 ani în urmă
părinte
comite
e33ea430d0
5 a modificat fișierele cu 63 adăugiri și 50 ștergeri
  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
         Top = 0
         Width = 361
         Width = 361
         Height = 83
         Height = 83
+        Style = lbOwnerDrawFixed
         Align = alClient
         Align = alClient
         BorderStyle = bsNone
         BorderStyle = bsNone
         ItemHeight = 13
         ItemHeight = 13
         PopupMenu = ListPopupMenu
         PopupMenu = ListPopupMenu
         TabOrder = 0
         TabOrder = 0
+        OnDrawItem = CompilerOutputListDrawItem
       end
       end
       object TabSet: TNewTabSet
       object TabSet: TNewTabSet
         Left = 0
         Left = 0

+ 46 - 39
Projects/CompForm.pas

@@ -51,6 +51,8 @@ const
 type
 type
   TISScintEdit = class;
   TISScintEdit = class;
 
 
+  TStatusMessageKind = (smkStartEnd, smkNormal, smkWarning, smkError);
+
   TCompileForm = class(TUIStateForm)
   TCompileForm = class(TUIStateForm)
     MainMenu1: TMainMenu;
     MainMenu1: TMainMenu;
     FMenu: TMenuItem;
     FMenu: TMenuItem;
@@ -245,6 +247,8 @@ type
     procedure VZoomResetClick(Sender: TObject);
     procedure VZoomResetClick(Sender: TObject);
     procedure ECompleteWordClick(Sender: TObject);
     procedure ECompleteWordClick(Sender: TObject);
     procedure FSaveEncodingItemClick(Sender: TObject);
     procedure FSaveEncodingItemClick(Sender: TObject);
+    procedure CompilerOutputListDrawItem(Control: TWinControl; Index: Integer;
+      Rect: TRect; State: TOwnerDrawState);
   private
   private
     { Private declarations }
     { Private declarations }
     FCompilerVersion: PCompilerVersionInfo;
     FCompilerVersion: PCompilerVersionInfo;
@@ -367,7 +371,7 @@ type
     procedure SetStatusPanelVisible(const AVisible: Boolean);
     procedure SetStatusPanelVisible(const AVisible: Boolean);
     procedure SetStepLine(ALine: Integer);
     procedure SetStepLine(ALine: Integer);
     procedure ShowOpenDialog(const Examples: Boolean);
     procedure ShowOpenDialog(const Examples: Boolean);
-    procedure StatusMessage(const S: String);
+    procedure StatusMessage(const Kind: TStatusMessageKind; const S: String);
     procedure SyncEditorOptions;
     procedure SyncEditorOptions;
     procedure ToggleBreakPoint(Line: Integer);
     procedure ToggleBreakPoint(Line: Integer);
     procedure UpdateAllLineMarkers;
     procedure UpdateAllLineMarkers;
@@ -1381,14 +1385,14 @@ begin
   end;
   end;
 end;
 end;
 
 
-procedure TCompileForm.StatusMessage(const S: String);
+procedure TCompileForm.StatusMessage(const Kind: TStatusMessageKind; const S: String);
 var
 var
   DC: HDC;
   DC: HDC;
   Size: TSize;
   Size: TSize;
 begin
 begin
   with CompilerOutputList do begin
   with CompilerOutputList do begin
     try
     try
-      TopIndex := Items.Add(S);
+      TopIndex := Items.AddObject(S, TObject(Kind));
     except
     except
       on EOutOfResources do begin
       on EOutOfResources do begin
         Clear;
         Clear;
@@ -1424,6 +1428,7 @@ var
   begin
   begin
     if FirstLine then begin
     if FirstLine then begin
       FirstLine := False;
       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,
       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.wMinute, {$IFDEF IS_DXE}FormatSettings.{$ENDIF}TimeSeparator, ST.wSecond, {$IFDEF IS_DXE}FormatSettings.{$ENDIF}DecimalSeparator,
         ST.wMilliseconds]), S, 1);
         ST.wMilliseconds]), S, 1);
@@ -1519,7 +1524,10 @@ begin
           end;
           end;
         end;
         end;
       iscbNotifyStatus:
       iscbNotifyStatus:
-        Form.StatusMessage(Data.StatusMsg);
+        if Data.Warning then
+          Form.StatusMessage(smkWarning, Data.StatusMsg)
+        else
+          Form.StatusMessage(smkNormal, Data.StatusMsg);
       iscbNotifyIdle:
       iscbNotifyIdle:
         begin
         begin
           Form.UpdateCompileStatusPanels(Data.CompressProgress,
           Form.UpdateCompileStatusPanels(Data.CompressProgress,
@@ -1685,8 +1693,8 @@ begin
     ReadScriptLines(AppData.Lines);
     ReadScriptLines(AppData.Lines);
 
 
     StartTime := GetTickCount;
     StartTime := GetTickCount;
-    StatusMessage(Format(SCompilerStatusStarting, [TimeToStr(Time)]));
-    StatusMessage('');
+    StatusMessage(smkStartEnd, Format(SCompilerStatusStarting, [TimeToStr(Time)]));
+    StatusMessage(smkStartEnd, '');
     FCompiling := True;
     FCompiling := True;
     FCompileWantAbort := False;
     FCompileWantAbort := False;
     UpdateRunMenu;
     UpdateRunMenu;
@@ -1697,7 +1705,7 @@ begin
     {$ELSE}
     {$ELSE}
     if ISCompileScript(Params, False) <> isceNoError then begin
     if ISCompileScript(Params, False) <> isceNoError then begin
     {$ENDIF}
     {$ENDIF}
-      StatusMessage(SCompilerStatusErrorAborted);
+      StatusMessage(smkError, SCompilerStatusErrorAborted);
       if not ReadFromFile and (AppData.ErrorLine > 0) and
       if not ReadFromFile and (AppData.ErrorLine > 0) and
          (AppData.ErrorFilename = '') then begin
          (AppData.ErrorFilename = '') then begin
         { Move the caret to the line number the error occured on }
         { Move the caret to the line number the error occured on }
@@ -1718,7 +1726,7 @@ begin
     end;
     end;
     ElapsedTime := GetTickCount - StartTime;
     ElapsedTime := GetTickCount - StartTime;
     ElapsedSeconds := ElapsedTime div 1000;
     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,
       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])]));
         ElapsedSeconds mod 60, {$IFDEF IS_DXE}FormatSettings.{$ENDIF}DecimalSeparator, ElapsedTime mod 1000])]));
   finally
   finally
@@ -3940,48 +3948,47 @@ begin
   end;
   end;
 end;
 end;
 
 
-procedure TCompileForm.DebugOutputListDrawItem(Control: TWinControl;
+procedure TCompileForm.CompilerOutputListDrawItem(Control: TWinControl;
   Index: Integer; Rect: TRect; State: TOwnerDrawState);
   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
 var
+  Canvas: TCanvas;
   S: String;
   S: String;
 begin
 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);
   Inc(Rect.Left, 2);
   if (S <> '') and (S[1] = #9) then
   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
   else begin
     if (Length(S) > 20) and (S[18] = '-') and (S[19] = '-') and (S[20] = ' ') then 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 }
       { 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;
 end;
 end;
 
 

+ 3 - 4
Projects/CompInt.pas

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

+ 10 - 7
Projects/Compile.pas

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