Add support for event attributes to string and integer functions as well. Possible thanks to the lazy evaluation.

ISHelp/isx.xml

@@ -314,10 +314,12 @@ end;
 
 <ul>
 <li>The implementations will be called in order of their definition except that any main implementation (=the implementation without an event attribute) will be called last.</li>
-<li>Event attributes may only be used for event functions which are a procedure or are a function which return a Boolean. In the latter case lazy evaluation is performed:</li>
+<li>Event attributes may be used for all event functions. If the event function has a return value then lazy evaluation is performed:</li>
 <ul>
 <li><tt>InitializeSetup</tt>, <tt>BackButtonClick</tt>, <tt>NextButtonClick</tt>, <tt>InitializeUninstall</tt>: All implementations must return True for the event function to be treated as returning True and an implementation returning False stops the calls to the other implementations.</li>
-<li><tt>CheckPassword</tt>, <tt>CheckSerial</tt>, <tt>ShouldSkipPage</tt>, <tt>NeedRestart</tt>: All implementation must return False for the event function to be treated as returning False and an implementation returning True stop the calls to the other implementations.</li>
+<li><tt>CheckPassword</tt>, <tt>CheckSerial</tt>, <tt>ShouldSkipPage</tt>, <tt>NeedRestart</tt>: All implementations must return False for the event function to be treated as returning False and an implementation returning True stops the calls to the other implementations.</li>
+<li><tt>UpdateReadyMemo</tt>, <tt>PrepareToInstall</tt>: All implementations must return an empty string for the event function to be treated as returning an empty string and an implementation returning a non empty string stops the calls to the other implementations.</li>
+<li><tt>GetCustomSetupExitCode</tt>: All implementations must return zero for the event function to be treated as returning zero and an implementation returning a non zero number stops the calls to the other implementations.</li>
 </ul>
 <li>Event attributes may only be used on procedures or functions which do not already have the name of an event function.</li>
 <li>If the event function uses <tt>var</tt> parameters then the value will be passed on from implementation to implementation.</li>

Projects/Compile.pas

@@ -7511,7 +7511,7 @@ begin
       AddStatus(SCompilerStatusCompilingCode);
 
     //don't forget highlighter!
-    //setup + allownamingattribute (=all procedures and boolean functions)
+    //setup
     CodeCompiler.AddExport('InitializeSetup', 'Boolean', True, False, '', 0);
     CodeCompiler.AddExport('DeinitializeSetup', '0', True, False, '', 0);
     CodeCompiler.AddExport('CurStepChanged', '0 @TSetupStep', True, False, '', 0);
@@ -7527,13 +7527,10 @@ begin
     CodeCompiler.AddExport('InitializeWizard', '0', True, False, '', 0);
     CodeCompiler.AddExport('RegisterExtraCloseApplicationsResources', '0', True, False, '', 0);
     CodeCompiler.AddExport('CurInstallProgressChanged', '0 @LongInt @LongInt', True, False, '', 0);
-
-    //setup + !allownamingattribute (=non boolean functions)
-    CodeCompiler.AddExport('UpdateReadyMemo', 'String @String @String @String @String @String @String @String @String', False, False, '', 0);
-    CodeCompiler.AddExport('GetCustomSetupExitCode', 'LongInt', False, False, '', 0);
-    CodeCompiler.AddExport('PrepareToInstall', 'String !Boolean', False, False, '', 0);
-
-    //uninstall + allownamingattribute (=all procedures and boolean functions)
+    CodeCompiler.AddExport('UpdateReadyMemo', 'String @String @String @String @String @String @String @String @String', True, False, '', 0);
+    CodeCompiler.AddExport('GetCustomSetupExitCode', 'LongInt', True, False, '', 0);
+    CodeCompiler.AddExport('PrepareToInstall', 'String !Boolean', True, False, '', 0);
+    //uninstall
     CodeCompiler.AddExport('InitializeUninstall', 'Boolean', True, False, '', 0);
     CodeCompiler.AddExport('DeinitializeUninstall', '0', True, False, '', 0);
     CodeCompiler.AddExport('CurUninstallStepChanged', '0 @TUninstallStep', True, False, '', 0);

Projects/Main.pas

@@ -3489,8 +3489,8 @@ begin
   if Assigned(CodeRunner) then begin
     if AllowCustomSetupExitCode then begin
       try
-        SetupExitCode := CodeRunner.RunIntegerFunction('GetCustomSetupExitCode',
-          [''], False, SetupExitCode);
+        SetupExitCode := CodeRunner.RunIntegerFunctions('GetCustomSetupExitCode',
+          [''], bcNonZero, False, SetupExitCode);
       except
         Log('GetCustomSetupExitCode raised an exception.');
         Application.HandleException(nil);

Projects/ScriptCompiler.pas

@@ -391,9 +391,6 @@ var
   ScriptExport: TScriptExport;
   I: Integer;
 begin
-  if AllowNamingAttribute and not ((Pos('0', Decl) = 1) or (Pos('Boolean', Decl) = 1)) then
-    raise Exception.Create('Naming attributes only supported on procedures and boolean functions.');
-
   I := FindExport(Name, Decl, -1);
   if I <> -1 then begin
     ScriptExport := FExports[I];

Projects/ScriptRunner.pas

@@ -2,13 +2,11 @@ unit ScriptRunner;
 
 {
   Inno Setup
-  Copyright (C) 1997-2011 Jordan Russell
+  Copyright (C) 1997-2019 Jordan Russell
   Portions by Martijn Laan
   For conditions of distribution and use, see LICENSE.TXT.
 
   Script runner
-
-  $jrsoftware: issrc/Projects/ScriptRunner.pas,v 1.34 2011/01/11 05:30:39 jr Exp $
 }
 
 interface
@@ -24,7 +22,7 @@ type
   TScriptRunnerOnDebugIntermediate = function(const Position: LongInt; var ContinueStepOver: Boolean): Boolean;
   TScriptRunnerOnException = procedure(const Exception: AnsiString; const Position: LongInt);
 
-  TBreakCondition = (bcNone, bcTrue, bcFalse);
+  TBreakCondition = (bcNone, bcTrue, bcFalse, bcNonZero, bcNonEmpty);
 
   TScriptRunner = class
     private
@@ -40,12 +38,13 @@ type
       function GetProcNos(const Name: AnsiString; const CheckNamingAttribute: Boolean; const ProcNos: TPSList): Integer;
       procedure InternalRunProcedure(const Name: AnsiString; const Parameters: array of Const; const CheckNamingAttribute, MustExist: Boolean);
       function InternalRunBooleanFunction(const Name: AnsiString; const Parameters: array of Const; const CheckNamingAttribute: Boolean; const BreakCondition: TBreakCondition; const MustExist, Default: Boolean): Boolean;
+      function InternalRunIntegerFunction(const Name: AnsiString; const Parameters: array of Const; const CheckNamingAttribute: Boolean; const BreakCondition: TBreakCondition; const MustExist: Boolean; const Default: Integer): Integer;
+      function InternalRunStringFunction(const Name: AnsiString; const Parameters: array of Const; const CheckNamingAttribute: Boolean; const BreakCondition: TBreakCondition; const MustExist: Boolean; const Default: String): String;
       procedure Log(const S: String);
       procedure LogFmt(const S: String; const Args: array of const);
       procedure RaisePSExecException;
       procedure SetPSExecParameters(const Parameters: array of Const; Params: TPSList);
       procedure SetPSExecReturnValue(Params: TPSList; BaseType: TPSBaseType; var Res: PPSVariant);
-      procedure ShowPSExecError(const Error: TPSError);
     public
       constructor Create;
       destructor Destroy; override;
@@ -56,7 +55,9 @@ type
       function RunBooleanFunction(const Name: AnsiString; const Parameters: array of Const; const MustExist, Default: Boolean): Boolean;
       function RunBooleanFunctions(const Name: AnsiString; const Parameters: array of Const; const BreakCondition: TBreakCondition; const MustExist, Default: Boolean): Boolean;
       function RunIntegerFunction(const Name: AnsiString; const Parameters: array of Const; const MustExist: Boolean; const Default: Integer): Integer;
+      function RunIntegerFunctions(const Name: AnsiString; const Parameters: array of Const; const BreakCondition: TBreakCondition; const MustExist: Boolean; Default: Integer): Integer;
       function RunStringFunction(const Name: AnsiString; const Parameters: array of Const; const MustExist: Boolean; const Default: String): String;
+      function RunStringFunctions(const Name: AnsiString; const Parameters: array of Const; const BreakCondition: TBreakCondition; const MustExist: Boolean; Default: String): String;
       function EvaluateUsedVariable(const Param1, Param2, Param3: LongInt; const Param4: AnsiString): String;
       property NamingAttribute: String write FNamingAttribute;
       property OnLog: TScriptRunnerOnLog read FOnLog write FOnLog;
@@ -98,9 +99,14 @@ begin
     FOnLogFmt(S, Args);
 end;
 
-procedure TScriptRunner.ShowPSExecError(const Error: TPSError);
+procedure ShowError(const Error: String);
 begin
-  raise Exception.Create('Script error: ' + PSErrorToString(Error, ''));
+  raise Exception.Create(Error);
+end;
+
+procedure ShowPSExecError(const Error: TPSError);
+begin
+  ShowError('Script error: ' + PSErrorToString(Error, ''));
 end;
 
 procedure TScriptRunner.RaisePSExecException;
@@ -114,14 +120,14 @@ begin
       'Exception' objects raised from other modules (which we mustn't modify) }
     E := ExceptObject;
     if E is Exception then begin
-      Exception(E).Message := Format('Runtime Error (at %d:%d):'#13#10#13#10,
+      Exception(E).Message := Format('Runtime error (at %d:%d):'#13#10#13#10,
         [FPSExec.ExceptionProcNo, FPSExec.ExceptionPos]) + Exception(E).Message;
       raise;
     end
     else begin
       { If we don't see it as an Exception, it was likely raised by another
         module }
-      raise Exception.CreateFmt('Runtime Error (at %d:%d):'#13#10#13#10 +
+      raise Exception.CreateFmt('Runtime error (at %d:%d):'#13#10#13#10 +
         'Exception "%s" at address %p',
         [FPSExec.ExceptionProcNo, FPSExec.ExceptionPos, E.ClassName, ExceptAddr]);
     end;
@@ -466,8 +472,10 @@ begin
   ProcNos := TPSList.Create;
   try
     if GetProcNos(Name, CheckNamingAttribute, ProcNos) <> 0 then begin
-      if (BreakCondition = bcNone) and (ProcNos.Count > 1) then
-        InternalError('InternalRunBooleanFunction: invalid BreakCondition');
+      if not (BreakCondition in [bcNone, bcTrue, bcFalse]) or
+         ((BreakCondition = bcNone) and (ProcNos.Count > 1)) then
+        ShowError('Internal error: InternalRunBooleanFunction: invalid BreakCondition');
+      Result := True; { Silence compiler }
       for I := 0 to ProcNos.Count-1 do begin
         Params := TPSList.Create();
         try
@@ -505,68 +513,112 @@ begin
   Result := InternalRunBooleanFunction(Name, Parameters, True, BreakCondition, MustExist, Default);
 end;
 
-function TScriptRunner.RunIntegerFunction(const Name: AnsiString; const Parameters: array of Const; const MustExist: Boolean; const Default: Integer): Integer;
+function TScriptRunner.InternalRunIntegerFunction(const Name: AnsiString; const Parameters: array of Const; const CheckNamingAttribute: Boolean; const BreakCondition: TBreakCondition; const MustExist: Boolean; const Default: Integer): Integer;
 var
-  ProcNo: Cardinal;
-  Params: TPSList;
+  ProcNos, Params: TPSList;
   Res: PPSVariant;
+  I: Integer;
 begin
-  ProcNo := FPSExec.GetProc(Name);
-  if ProcNo <> Cardinal(-1) then begin
-    Params := TPSList.Create();
-    try
-      SetPSExecParameters(Parameters, Params);
-      SetPSExecReturnValue(Params, btS32, Res);
-      FPSExec.RunProc(Params, ProcNo);
-      WriteBackParameters(Parameters, Params);
-
-      RaisePSExecException;
-      Result := PPSVariantS32(Res).Data;
-    finally
-      FreePSVariantList(Params);
+  ProcNos := TPSList.Create;
+  try
+    if GetProcNos(Name, CheckNamingAttribute, ProcNos) <> 0 then begin
+      if not (BreakCondition in [bcNone, bcNonZero]) or
+         ((BreakCondition = bcNone) and (ProcNos.Count > 1)) then
+        ShowError('Internal error: InternalRunIntegerFunction: invalid BreakCondition');
+      Result := 0; { Silence compiler }
+      for I := 0 to ProcNos.Count-1 do begin
+        Params := TPSList.Create();
+        try
+          SetPSExecParameters(Parameters, Params);
+          SetPSExecReturnValue(Params, btS32, Res);
+          FPSExec.RunProc(Params, Cardinal(ProcNos[I]));
+          WriteBackParameters(Parameters, Params);
+
+          RaisePSExecException;
+          Result := PPSVariantS32(Res).Data;
+          if (Result <> 0) and (BreakCondition = bcNonZero) then
+            Exit;
+        finally
+          FreePSVariantList(Params);
+        end;
+      end;
+    end else begin
+      if MustExist then
+        ShowPSExecError(erCouldNotCallProc);
+      Result := Default;
     end;
-  end else begin
-    if MustExist then
-      ShowPSExecError(erCouldNotCallProc);
-    Result := Default;
+  finally
+    ProcNos.Free;
   end;
 end;
 
-function TScriptRunner.RunStringFunction(const Name: AnsiString; const Parameters: array of Const; const MustExist: Boolean; const Default: String): String;
+function TScriptRunner.RunIntegerFunction(const Name: AnsiString; const Parameters: array of Const; const MustExist: Boolean; const Default: Integer): Integer;
+begin
+  Result := InternalRunIntegerFunction(Name, Parameters, False, bcNone, MustExist, Default);
+end;
+
+function TScriptRunner.RunIntegerFunctions(const Name: AnsiString; const Parameters: array of Const; const BreakCondition: TBreakCondition; const MustExist: Boolean; Default: Integer): Integer;
+begin
+  Result := InternalRunIntegerFunction(Name, Parameters, True, BreakCondition, MustExist, Default);
+end;
+
+function TScriptRunner.InternalRunStringFunction(const Name: AnsiString; const Parameters: array of Const; const CheckNamingAttribute: Boolean; const BreakCondition: TBreakCondition; const MustExist: Boolean; const Default: String): String;
 var
-  ProcNo: Cardinal;
-  Params: TPSList;
+  ProcNos, Params: TPSList;
   Res: PPSVariant;
+  I: Integer;
 begin
-  ProcNo := FPSExec.GetProc(Name);
-  if ProcNo <> Cardinal(-1) then begin
-    Params := TPSList.Create();
-    try
-      SetPSExecParameters(Parameters, Params);
+  ProcNos := TPSList.Create;
+  try
+    if GetProcNos(Name, CheckNamingAttribute, ProcNos) <> 0 then begin
+      if not (BreakCondition in [bcNone, bcNonEmpty]) or
+         ((BreakCondition = bcNone) and (ProcNos.Count > 1)) then
+        ShowError('Internal error: InternalRunStringFunction: invalid BreakCondition');
+      Result := ''; { Silence compiler }
+      for I := 0 to ProcNos.Count-1 do begin
+        Params := TPSList.Create();
+        try
+          SetPSExecParameters(Parameters, Params);
 {$IFDEF UNICODE}
-      SetPSExecReturnValue(Params, btUnicodeString, Res);
+          SetPSExecReturnValue(Params, btUnicodeString, Res);
 {$ELSE}
-      SetPSExecReturnValue(Params, btString, Res);
+          SetPSExecReturnValue(Params, btString, Res);
 {$ENDIF}
-      FPSExec.RunProc(Params, ProcNo);
-      WriteBackParameters(Parameters, Params);
+          FPSExec.RunProc(Params, Cardinal(ProcNos[I]));
+          WriteBackParameters(Parameters, Params);
 
-      RaisePSExecException;
+          RaisePSExecException;
 {$IFDEF UNICODE}
-      Result := PPSVariantUString(Res).Data;
+          Result := PPSVariantUString(Res).Data;
 {$ELSE}
-      Result := PPSVariantAString(Res).Data;
+          Result := PPSVariantAString(Res).Data;
 {$ENDIF}
-    finally
-      FreePSVariantList(Params);
+          if (Result <> '') and (BreakCondition = bcNonEmpty) then
+            Exit;
+        finally
+          FreePSVariantList(Params);
+        end;
+      end;
+    end else begin
+      if MustExist then
+        ShowPSExecError(erCouldNotCallProc);
+      Result := Default;
     end;
-  end else begin
-    if MustExist then
-      ShowPSExecError(erCouldNotCallProc);
-    Result := Default;
+  finally
+    ProcNos.Free;
   end;
 end;
 
+function TScriptRunner.RunStringFunction(const Name: AnsiString; const Parameters: array of Const; const MustExist: Boolean; const Default: String): String;
+begin
+  Result := InternalRunStringFunction(Name, Parameters, False, bcNone, MustExist, Default);
+end;
+
+function TScriptRunner.RunStringFunctions(const Name: AnsiString; const Parameters: array of Const; const BreakCondition: TBreakCondition; const MustExist: Boolean; Default: String): String;
+begin
+  Result := InternalRunStringFunction(Name, Parameters, True, BreakCondition, MustExist, Default);
+end;
+
 function TScriptRunner.EvaluateUsedVariable(const Param1, Param2, Param3: LongInt; const Param4: AnsiString): String;
 
   function VariantToString(const p: TPSVariantIFC; const ClassProperties: AnsiString): String;

Projects/Wizard.pas

@@ -1633,7 +1633,7 @@ begin
   if not PreviousInstallCompleted(WizardComponents, WizardTasks) then begin
     Result := ExpandSetupMessage(msgPreviousInstallNotCompleted);
     PrepareToInstallNeedsRestart := True;
-  end else if (CodeRunner <> nil) and CodeRunner.FunctionExists('PrepareToInstall', False) then begin
+  end else if (CodeRunner <> nil) and CodeRunner.FunctionExists('PrepareToInstall', True) then begin
     SetCurPage(wpPreparing);
     BackButton.Visible := False;
     NextButton.Visible := False;
@@ -1645,7 +1645,7 @@ begin
     WindowDisabler := TWindowDisabler.Create;
     try
       CodeNeedsRestart := False;
-      Result := CodeRunner.RunStringFunction('PrepareToInstall', [@CodeNeedsRestart], True, '');
+      Result := CodeRunner.RunStringFunctions('PrepareToInstall', [@CodeNeedsRestart], bcNonEmpty, True, '');
       PrepareToInstallNeedsRestart := (Result <> '') and CodeNeedsRestart;
     finally
       WindowDisabler.Free;
@@ -1837,11 +1837,11 @@ procedure TWizardForm.UpdatePage(const PageID: Integer);
         MemoTasksInfo := '';
       SelectedTasks.Free();
 
-      if (CodeRunner <> nil) and CodeRunner.FunctionExists('UpdateReadyMemo', False) then begin
+      if (CodeRunner <> nil) and CodeRunner.FunctionExists('UpdateReadyMemo', True) then begin
         try
-          ReadyMemo.Lines.Text := CodeRunner.RunStringFunction('UpdateReadyMemo',
+          ReadyMemo.Lines.Text := CodeRunner.RunStringFunctions('UpdateReadyMemo',
             [Space, SNewLine, MemoUserInfoInfo, MemoDirInfo, MemoTypeInfo,
-             MemoComponentsInfo, MemoGroupInfo, MemoTasksInfo], True, '');
+             MemoComponentsInfo, MemoGroupInfo, MemoTasksInfo], bcNonEmpty, True, '');
         except
           Application.HandleException(Self);
         end;