浏览代码

Make ISPP's Exec call TSetupCompiler.CallIdleProc instead of its own MsgProc. Also some more changes to try and make things more consistent: I suppose ISPP's Exec and CompForm's InternalSignCommand should be alike in the way they loop, instead of Exec being like InstExec in this regard.

Martijn Laan 1 年之前
父节点
当前提交
0ea03e400d

+ 18 - 34
Projects/ISPP/IsppFuncs.pas

@@ -632,7 +632,7 @@ end;
 
 function Exec(const Filename, Params: String; WorkingDir: String;
   const WaitUntilTerminated: Boolean; const ShowCmd: Integer;
-  const ProcessMessagesProc: TProcedure; const Log: Boolean; const LogProc: TLogProc;
+  const Preprocessor: TPreprocessor; const Log: Boolean; const LogProc: TLogProc;
   const LogProcData: NativeInt; var ResultCode: Integer): Boolean;
 var
   CmdLine: String;
@@ -640,7 +640,7 @@ var
   StartupInfo: TStartupInfo;
   ProcessInfo: TProcessInformation;
 begin
-  {Also see InstFuncs' InstExec which is very similar }
+  {This function is a combination of InstFuncs' InstExec and Compile's InternalSignCommand }
 
   if Filename = '>' then
     CmdLine := Params
@@ -677,8 +677,8 @@ begin
       OutputReader.UpdateStartupInfo(StartupInfo, InheritHandles);
     end;
 
-    Result := CreateProcess(nil, PChar(CmdLine), nil, nil, InheritHandles, 0, nil,
-       WorkingDirP, StartupInfo, ProcessInfo);
+    Result := CreateProcess(nil, PChar(CmdLine), nil, nil, InheritHandles,
+      CREATE_DEFAULT_ERROR_MODE, nil, WorkingDirP, StartupInfo, ProcessInfo);
     if not Result then begin
       ResultCode := GetLastError;
       Exit;
@@ -694,24 +694,18 @@ begin
         { Wait until the process returns, but still process any messages that
           arrive and read the output. }
         var WaitMilliseconds := IfThen(OutputReader <> nil, 50, INFINITE);
-        var WaitResult: DWORD := 0;
-        repeat
-          { Process any pending messages first because MsgWaitForMultipleObjects
-            (called below) only returns when *new* messages arrive, unless there's
-            a timeout }
-          if WaitResult <> WAIT_TIMEOUT then
-            ProcessMessagesProc;
-          if OutputReader <> nil then
-            OutputReader.Read(False);
-          WaitResult := MsgWaitForMultipleObjects(1, ProcessInfo.hProcess, False,
-            WaitMilliseconds, QS_ALLINPUT);
-        until (WaitResult <> WAIT_OBJECT_0+1) and (WaitResult <> WAIT_TIMEOUT);
-        { Process messages once more in case MsgWaitForMultipleObjects saw the
-          process terminate and new messages arrive simultaneously. (Can't leave
-          unprocessed messages waiting, or a subsequent call to WaitMessage
-          won't see them.) }
-        if Assigned(ProcessMessagesProc) then
-          ProcessMessagesProc;
+        while True do begin
+          case WaitForSingleObject(ProcessInfo.hProcess, WaitMilliseconds) of
+            WAIT_OBJECT_0: Break;
+            WAIT_TIMEOUT:
+              begin
+                OutputReader.Read(False);
+                Preprocessor.CallIdleProc; { Doesn't allow an Abort }
+              end;
+          else
+            Preprocessor.RaiseError('Exec: WaitForSingleObject failed');
+          end;
+        end;
         if OutputReader <> nil then
           OutputReader.Read(True);
       end;
@@ -726,17 +720,6 @@ begin
   end;
 end;
 
-procedure MsgProc;
-var
-  Msg: TMsg;
-begin
-  while PeekMessage(Msg, 0, 0, 0, PM_REMOVE) do
-  begin
-    TranslateMessage(Msg);
-    DispatchMessage(Msg);
-  end;
-end;
-
 procedure ExecLog(const S: String; const Error, FirstLine: Boolean; const Data: NativeInt);
 begin
   var Preprocessor := TPreprocessor(Data);
@@ -766,9 +749,10 @@ begin
       if (GetCount > 3) and (Get(3).Typ <> evNull) then WaitUntilTerminated := Get(3).AsInt <> 0;
       if (GetCount > 4) and (Get(4).Typ <> evNull) then ShowCmd := Get(4).AsInt;
       if (GetCount > 5) and (Get(5).Typ <> evNull) then Log := Get(5).AsInt <> 0;
+      var Preprocessor := TPreprocessor(Ext);
       var ResultCode: Integer;
       var Success := Exec(Get(0).AsStr, ParamsS, WorkingDir, WaitUntilTerminated,
-        ShowCmd, MsgProc, Log, ExecLog, Ext, ResultCode);
+        ShowCmd, Preprocessor, Log, ExecLog, NativeInt(Preprocessor), ResultCode);
       if not WaitUntilTerminated then
         MakeBool(ResPtr^, Success)
       else

+ 2 - 2
Projects/ISPP/IsppPreprocess.pas

@@ -3,7 +3,7 @@
   Copyright (C) 2001-2002 Alex Yackimoff
  
   Inno Setup
-  Copyright (C) 1997-2020 Jordan Russell
+  Copyright (C) 1997-2024 Jordan Russell
   Portions by Martijn Laan
   For conditions of distribution and use, see LICENSE.TXT.
 }
@@ -222,7 +222,7 @@ var
   LineNumber: Integer;
 begin
   if (Params.Size <> SizeOf(Params)) or
-     (Params.InterfaceVersion <> 2) then
+     (Params.InterfaceVersion <> 3) then
   begin
     Result := ispeInvalidParam;
     Exit;

+ 6 - 0
Projects/ISPP/IsppPreprocessor.pas

@@ -123,6 +123,7 @@ type
       VarManager: TIdentManager; const Options: TIsppOptions;
       const SourcePath: string; const CompilerPath: string; const FileName: string = '');
     destructor Destroy; override;
+    procedure CallIdleProc;
     procedure VerboseMsg(Level: Byte; const Msg: string; const Args: array of const);
     procedure StatusMsg(const Msg: string; const Args: array of const);
     procedure WarningMsg(const Msg: string; const Args: array of const);
@@ -1098,6 +1099,11 @@ begin
   FFileStack.AddObject(ExpandFileName(FileName), TObject(dsPublic));
 end;
 
+procedure TPreprocessor.CallIdleProc;
+begin
+  FCompilerParams.IdleProc(FCompilerParams.CompilerData);
+end;
+
 procedure TPreprocessor.VerboseMsg(Level: Byte; const Msg: string;
   const Args: array of const);
 begin

+ 6 - 2
Projects/Src/CompPreprocInt.pas

@@ -2,7 +2,7 @@ unit CompPreprocInt;
 
 {
   Inno Setup
-  Copyright (C) 1997-2020 Jordan Russell
+  Copyright (C) 1997-2024 Jordan Russell
   Portions by Martijn Laan
   For conditions of distribution and use, see LICENSE.TXT.
 
@@ -42,13 +42,14 @@ type
     function(CompilerData: TPreprocCompilerData; Filename: PChar; Dir: PChar;
       ErrorFilename: PChar; ErrorLine: Integer; ErrorColumn: Integer): PChar; stdcall;
   TPreprocCleanupProc = function(CleanupProcData: Pointer): Integer; stdcall;
+  TPreprocIdleProc = procedure(CompilerData: TPreprocCompilerData); stdcall;
 
   PPreprocessScriptParams = ^TPreprocessScriptParams;
   TPreprocessScriptParams = record
     Size: Cardinal;                { [in] Set to SizeOf(TPreprocessScriptParams).
                                      Preprocessor must return ispeInvalidParam
                                      if value is not recognized. }
-    InterfaceVersion: Cardinal;    { [in] Currently set to 2.
+    InterfaceVersion: Cardinal;    { [in] Currently set to 3.
                                      Preprocessor must return ispeInvalidParam
                                      if value is not recognized. }
     CompilerBinVersion: Cardinal;  { [in] Compiler version as an integer }
@@ -102,6 +103,9 @@ type
                                          returns NULL and internally calls
                                          ErrorProc with a description of the
                                          error.}
+    IdleProc: TPreprocIdleProc;        { [in] Call at various intervals during
+                                         preprocessing. Doesn't allow an Abort
+                                         by the host. }
 
     PreprocCleanupProc: TPreprocCleanupProc;
                                        { [out] Preprocessor-defined function

+ 21 - 9
Projects/Src/Compile.pas

@@ -260,8 +260,9 @@ type
     procedure AbortCompileParamError(const Msg, ParamName: String);
     function PrependDirName(const Filename, Dir: String): String;
     function PrependSourceDirName(const Filename: String): String;
-    procedure CallIdleProc;
-    procedure DoCallback(const Code: Integer; var Data: TCompilerCallbackData);
+    procedure CallIdleProc(const IgnoreCallbackResult: Boolean = False);
+    procedure DoCallback(const Code: Integer; var Data: TCompilerCallbackData;
+      const IgnoreCallbackResult: Boolean = False);
     procedure EnumIniSection(const EnumProc: TEnumIniSectionProc;
       const SectionName: String; const Ext: Integer; const Verbose, SkipBlankLines: Boolean;
       const Filename: String; const LangSection: Boolean = False; const LangSectionPre: Boolean = False);
@@ -1137,7 +1138,7 @@ var
 
 begin
   if (Params.Size <> SizeOf(Params)) or
-     (Params.InterfaceVersion <> 2) then begin
+     (Params.InterfaceVersion <> 3) then begin
     Result := ispeInvalidParam;
     Exit;
   end;
@@ -1733,17 +1734,17 @@ begin
 end;
 
 procedure TSetupCompiler.DoCallback(const Code: Integer;
-  var Data: TCompilerCallbackData);
+  var Data: TCompilerCallbackData; const IgnoreCallbackResult: Boolean);
 begin
   case CallbackProc(Code, Data, AppData) of
     iscrSuccess: ;
-    iscrRequestAbort: Abort;
+    iscrRequestAbort: if not IgnoreCallbackResult then Abort;
   else
     AbortCompile('CallbackProc return code invalid');
   end;
 end;
 
-procedure TSetupCompiler.CallIdleProc;
+procedure TSetupCompiler.CallIdleProc(const IgnoreCallbackResult: Boolean);
 const
   ProgressMax = 1024;
 var
@@ -1796,7 +1797,7 @@ begin
     end;
   end;
   Data.CompressProgressMax := ProgressMax;
-  DoCallback(iscbNotifyIdle, Data);
+  DoCallback(iscbNotifyIdle, Data, IgnoreCallbackResult);
 end;
 
 type
@@ -1956,6 +1957,14 @@ begin
   end;
 end;
 
+procedure PreIdleProc(CompilerData: TPreprocCompilerData); stdcall;
+var
+  Data: PPreCompilerData;
+begin
+  Data := CompilerData;
+  Data.Compiler.CallIdleProc(True); { Doesn't allow an Abort }
+end;
+
 function TSetupCompiler.ReadScriptFile(const Filename: String;
   const UseCache: Boolean; const AnsiConvertCodePage: Cardinal): TScriptFileLines;
 
@@ -2025,7 +2034,7 @@ function TSetupCompiler.ReadScriptFile(const Filename: String;
     LCompilerPath := CompilerDir;
     FillChar(Params, SizeOf(Params), 0);
     Params.Size := SizeOf(Params);
-    Params.InterfaceVersion := 2;
+    Params.InterfaceVersion := 3;
     Params.CompilerBinVersion := SetupBinVersion;
     Params.Filename := PChar(Filename);
     Params.SourcePath := PChar(LSourcePath);
@@ -2038,6 +2047,7 @@ function TSetupCompiler.ReadScriptFile(const Filename: String;
     Params.StatusProc := PreStatusProc;
     Params.ErrorProc := PreErrorProc;
     Params.PrependDirNameProc := PrePrependDirNameProc;
+    Params.IdleProc := PreIdleProc;
 
     FillChar(Data, SizeOf(Data), 0);
     Data.Compiler := Self;
@@ -7355,6 +7365,8 @@ procedure TSetupCompiler.SignCommand(const AName, ACommand, AParams, AExeFilenam
     ProcessInfo: TProcessInformation;
     LastError, ExitCode: DWORD;
   begin
+    {Also see IsppFuncs' Exec }
+
     if Delay <> 0 then begin
       AddStatus(Format(SCompilerStatusSigningWithDelay, [AName, Delay, AFormattedCommand]));
       Sleep(Delay);
@@ -7388,7 +7400,7 @@ procedure TSetupCompiler.SignCommand(const AName, ACommand, AParams, AExeFilenam
             WAIT_TIMEOUT:
               begin
                 OutputReader.Read(False);
-                CallIdleProc;
+                CallIdleProc(True); { Doesn't allow an Abort }
               end;
           else
             AbortCompile('Sign: WaitForSingleObject failed');

+ 1 - 1
Projects/Src/InstFunc.pas

@@ -864,7 +864,7 @@ var
   StartupInfo: TStartupInfo;
   ProcessInfo: TProcessInformation;
 begin
-  {Also see IsppFuncs' Exec which is very similar }
+  {Also see IsppFuncs' Exec }
 
   if Filename = '>' then
     CmdLine := Params