Merge branch 'event-attributes' into is-6

Did comment tweaks + a fix during merge.

Doesn't work under Non Unicode (PS crashes) for unknown reasons.

Components/ScintStylerInnoSetup.pas

@@ -689,8 +689,7 @@ begin
       stMessageArg: Attributes.ForeColor := $FF8000;
       stPascalString, stPascalNumber, stISPPString, stISPPNumber: Attributes.ForeColor := clMaroon;
     end;
-  end
-  else begin
+  end else begin
     case Style of
       STYLE_BRACELIGHT: Attributes.BackColor := $E0E0E0;
       STYLE_IDENTGUIDE: Attributes.ForeColor := clSilver;
@@ -742,10 +741,12 @@ const
     'CancelButtonClick', 'InitializeUninstallProgressForm',
     'PrepareToInstall', 'RegisterExtraCloseApplicationsResources',
     'CurInstallProgressChanged');
+  EventNamingAttribute = 'event';
 var
   S: TScintRawString;
   I: Integer;
   C: AnsiChar;
+  PreviousIsAttributeOpen: Boolean;
 begin
   case SpanState of
     spBraceComment:
@@ -760,20 +761,24 @@ begin
   SkipWhitespace;
   while not EndOfLine do begin
     if CurChar in PascalIdentFirstChars then begin
+      PreviousIsAttributeOpen := PreviousCharIn(['<']);
       S := ConsumeString(PascalIdentChars);
-      for I := Low(PascalReservedWords) to High(PascalReservedWords) do
-        if SameRawText(S, PascalReservedWords[I]) then begin
-          CommitStyle(stPascalReservedWord);
-          Break;
-        end;
-      for I := Low(EventFunctions) to High(EventFunctions) do
-        if SameRawText(S, EventFunctions[I]) then begin
-          CommitStyle(stEventFunction);
-          Break;
-        end;
-      CommitStyle(stDefault);
-    end
-    else if ConsumeChars(DigitChars) then begin
+      if PreviousIsAttributeOpen and SameRawText(S, EventNamingAttribute) then
+        CommitStyle(stPascalReservedWord)
+      else begin
+        for I := Low(PascalReservedWords) to High(PascalReservedWords) do
+          if SameRawText(S, PascalReservedWords[I]) then begin
+            CommitStyle(stPascalReservedWord);
+            Break;
+          end;
+        for I := Low(EventFunctions) to High(EventFunctions) do
+          if SameRawText(S, EventFunctions[I]) then begin
+            CommitStyle(stEventFunction);
+            Break;
+          end;
+        CommitStyle(stDefault);
+      end;
+    end else if ConsumeChars(DigitChars) then begin
       if not CurCharIs('.') or not NextCharIs('.') then begin
         if ConsumeChar('.') then
           ConsumeChars(DigitChars);
@@ -787,8 +792,7 @@ begin
         end;
       end;
       CommitStyle(stPascalNumber);
-    end
-    else begin
+    end else begin
       C := CurChar;
       ConsumeChar(C);
       case C of
@@ -798,14 +802,12 @@ begin
             if (C = '/') and ConsumeChar('/') then begin
               ConsumeAllRemaining;
               CommitStyle(stComment);
-            end
-            else if (C = '(') and ConsumeChar('*') then begin
+            end else if (C = '(') and ConsumeChar('*') then begin
               if not FinishConsumingStarComment then begin
                 SpanState := spStarComment;
                 Exit;
               end;
-            end
-            else
+            end else
               CommitStyle(stSymbol);
           end;
         '''':
@@ -840,8 +842,7 @@ begin
             if ConsumeChar('$') then begin
               if not ConsumeChars(HexDigitChars) then
                  CommitStyleSqPending(stPascalString);
-            end
-            else if not ConsumeChars(DigitChars) then
+            end else if not ConsumeChars(DigitChars) then
               CommitStyleSqPending(stPascalString);
             CommitStyle(stPascalString);
           end;
@@ -955,8 +956,7 @@ begin
   if ConsumeCharIn(ISPPDirectiveShorthands) then begin
     NeedIspp := True;
     FinishDirectiveNameOrShorthand(True); { All shorthands require a parameter }
-  end
-  else begin
+  end else begin
     S := ConsumeString(ISPPIdentChars);
     for I := Low(ISPPDirectives) to High(ISPPDirectives) do
       if SameRawText(S, ISPPDirectives[I].Name) then begin
@@ -989,8 +989,7 @@ begin
           Break;
         end;
       CommitStyle(stDefault)
-    end
-    else if ConsumeChars(DigitChars) then begin
+    end else if ConsumeChars(DigitChars) then begin
       if not CurCharIs('.') or not NextCharIs('.') then begin
         if ConsumeChar('.') then
           ConsumeChars(DigitChars);
@@ -1003,8 +1002,7 @@ begin
         ConsumeChars(['L', 'U', 'l', 'u']);
       end;
       CommitStyle(stISPPNumber);
-    end
-    else begin
+    end else begin
       C := CurChar;
       ConsumeChar(C);
       case C of
@@ -1123,8 +1121,7 @@ begin
         if not ConsumeChar('"') then
           Break;
       end;
-    end
-    else begin
+    end else begin
       while True do begin
         StyleConstsUntilChars([';', '"'], stParameterValue, BraceLevel);
         { Squigglify any quote characters inside an unquoted string }
@@ -1298,8 +1295,7 @@ begin
           ApplyPendingSquigglyFromToIndex(StartIndex, I - 1);
         { Replace the directive with spaces to prevent any further processing }
         ReplaceText(StartIndex, I - 1, ' ');
-      end
-      else
+      end else
         Inc(I);
     end;
   end;
@@ -1371,12 +1367,10 @@ begin
   if (Section <> scCode) and ConsumeChar(';') then begin
     ConsumeAllRemaining;
     CommitStyle(stComment);
-  end
-  else if CurCharIs('/') and NextCharIs('/') then begin
+  end else if CurCharIs('/') and NextCharIs('/') then begin
     ConsumeAllRemaining;
     CommitStyleSq(stComment, not IsppInstalled and (Section <> scCode))
-  end
-  else if ConsumeChar('[') then begin
+  end else if ConsumeChar('[') then begin
     SectionEnd := ConsumeChar('/');
     S := ConsumeString(AlphaUnderscoreChars);
     if ConsumeChar(']') then begin
@@ -1386,14 +1380,12 @@ begin
         (SectionEnd and (NewSection <> Section)));
       if not SectionEnd then
         NewLineState.NextLineSection := NewSection;
-    end
-    else
+    end else
       CommitStyleSqPending(stDefault);
     { Section tags themselves are not associated with any section }
     Section := scNone;
     SquigglifyUntilChars([], stDefault);
-  end
-  else if CurCharIs('#') then
+  end else if CurCharIs('#') then
     HandleCompilerDirective(False, -1, NewLineState.OpenCompilerDirectivesCount)
   else begin
     case Section of

Components/UniPs

@@ -1 +1 @@
-Subproject commit 76e377efa5fddc55b3a6a3a3d944317bdfde4a12
+Subproject commit 7f3720701fc9467123e940c2f719543652b82109

Examples/CodeExample1.iss

@@ -33,6 +33,17 @@ begin
     MsgBox('InitializeSetup:' #13#13 'Ok, bye bye.', mbInformation, MB_OK);
 end;
 
+procedure InitializeWizard;
+begin
+  Log('InitializeWizard called');
+end;
+
+<event('InitializeWizard')>
+procedure InitializeWizard2;
+begin
+  Log('InitializeWizard2 called');
+end;
+
 procedure DeinitializeSetup();
 var
   FileName: String;

ISHelp/isetup.dtd

@@ -72,7 +72,7 @@
 
 <!-- Fancier block elements -->
 
-<!ELEMENT ul (li*)>
+<!ELEMENT ul (li|ul)*>
 <!ATTLIST ul appearance (normal|compact) "normal">
 <!ELEMENT ol (li*)>
 <!ELEMENT li %InlineOrBlock;>

ISHelp/isx.xml

@@ -82,6 +82,9 @@
 <topic name="scriptevents" title="Pascal Scripting: Event Functions">
 <keyword value="Pascal Scripting: Event Functions" />
 <keyword value="Event Functions" />
+<keyword value="Pascal Scripting: Event Attributes" anchor="eventattributes" />
+<keyword value="Event Attributes" anchor="eventattributes" />
+<keyword value="Attributes" anchor="eventattributes" />
 <keyword value="InitializeSetup" anchor="InitializeSetup" />
 <keyword value="InitializeWizard" anchor="InitializeWizard" />
 <keyword value="DeinitializeSetup" anchor="DeinitializeSetup" />
@@ -281,7 +284,45 @@ wpWelcome, wpLicense, wpPassword, wpInfoBefore, wpUserInfo, wpSelectDir, wpSelec
 
 </ul>
 
-<p>None of these functions are required to be present in a Pascal script.</p>
+<heading><a name="eventattributes">Event Attributes</a></heading>
+
+<p>Normally a script can contain only one implementation per event function. Using event attributes it is possible to have multiple implementations of the same event function in your script. This is especially useful in included scripts implementing an event function to avoid conflicts with the main script.</p>
+
+<p>Here is an example of a script which contains three implementations of the <tt>InitializeWizard</tt> event function.</p>
+
+<precode>
+[Code]
+procedure InitializeWizard;
+begin
+  Log('InitializeWizard called');
+end;
+
+&lt;event('InitializeWizard')&gt;
+procedure InitializeWizard2;
+begin
+  Log('InitializeWizard2 called');
+end;
+
+&lt;event('InitializeWizard')&gt;
+procedure InitializeWizard3;
+begin
+  Log('InitializeWizard3 called');
+end;
+</precode>
+
+<p>The following rules apply:</p>
+
+<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:</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 does not stop the calls to the other implementations. In other words: the results are 'and'-ed without lazy evaluation.</li>
+<li><tt>CheckPassword</tt>, <tt>CheckSerial</tt>, <tt>ShouldSkipPage</tt>, <tt>NeedRestart</tt>: One implementation must return True for the event function to be treated as returning True and an implementation returning True does not stop the calls to the other implementations. In other words: the results are 'or'-ed without lazy evaluation.</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>
+<li>To call an implementation with an event attribute yourself from [Code] you should use the normal name of the function, just as if the implementation had no event attribute.</li>
+</ul>
 
 </body>
 </topic>

Projects/Compile.pas

@@ -1763,6 +1763,12 @@ begin
   CodeDebugInfo := TMemoryStream.Create;
   CodeText := TStringList.Create;
   CodeCompiler := TScriptCompiler.Create;
+  CodeCompiler.NamingAttribute := 'Event';
+  CodeCompiler.OnLineToLineInfo := CodeCompilerOnLineToLineInfo;
+  CodeCompiler.OnUsedLine := CodeCompilerOnUsedLine;
+  CodeCompiler.OnUsedVariable := CodeCompilerOnUsedVariable;
+  CodeCompiler.OnError := CodeCompilerOnError;
+  CodeCompiler.OnWarning := CodeCompilerOnWarning;
 end;
 
 destructor TSetupCompiler.Destroy;
@@ -2806,7 +2812,7 @@ function TSetupCompiler.CheckConst(const S: String; const MinVersion: TSetupVers
     ScriptFunc := Z;
     if ConvertConstPercentStr(ScriptFunc) and ConvertConstPercentStr(Param) then begin
       CheckConst(Param, MinVersion, AllowedConsts);
-      CodeCompiler.AddExport(ScriptFunc, 'String @String', True, ParseFileName, LineNumber);
+      CodeCompiler.AddExport(ScriptFunc, 'String @String', False, True, ParseFileName, LineNumber);
       Result := True;
       Exit;
     end;
@@ -3025,7 +3031,7 @@ begin
       raise Exception.Create('Internal Error: unknown parameter type');
   end;
 
-  CodeCompiler.AddExport(Name, Decl, True, ParseFileName, LineNumber);
+  CodeCompiler.AddExport(Name, Decl, False, True, ParseFileName, LineNumber);
 
   Result := True; { Result doesn't matter }
 end;
@@ -7475,42 +7481,39 @@ var
   CompiledCodeDebugInfo: AnsiString;
 begin
   { Compile CodeText }
-
-  CodeCompiler.OnLineToLineInfo := CodeCompilerOnLineToLineInfo;
-  CodeCompiler.OnUsedLine := CodeCompilerOnUsedLine;
-  CodeCompiler.OnUsedVariable := CodeCompilerOnUsedVariable;
-  CodeCompiler.OnError := CodeCompilerOnError;
-  CodeCompiler.OnWarning := CodeCompilerOnWarning;
-
   if (CodeText.Count > 0) or (CodeCompiler.ExportCount > 0) then begin
     if CodeText.Count > 0 then
       AddStatus(SCompilerStatusCompilingCode);
 
     //don't forget highlighter!
-    CodeCompiler.AddExport('InitializeSetup', 'Boolean', False, '', 0);
-    CodeCompiler.AddExport('DeinitializeSetup', '0', False, '', 0);
-    CodeCompiler.AddExport('CurStepChanged', '0 @TSetupStep', False, '', 0);
-    CodeCompiler.AddExport('NextButtonClick', 'Boolean @LongInt', False, '', 0);
-    CodeCompiler.AddExport('BackButtonClick', 'Boolean @LongInt', False, '', 0);
-    CodeCompiler.AddExport('CancelButtonClick', '0 @LongInt !Boolean !Boolean', False, '', 0);
-    CodeCompiler.AddExport('ShouldSkipPage', 'Boolean @LongInt', False, '', 0);
-    CodeCompiler.AddExport('CurPageChanged', '0 @LongInt', False, '', 0);
-    CodeCompiler.AddExport('CheckPassword', 'Boolean @String', False, '', 0);
-    CodeCompiler.AddExport('NeedRestart', 'Boolean', False, '', 0);
-    CodeCompiler.AddExport('UpdateReadyMemo', 'String @String @String @String @String @String @String @String @String', False, '', 0);
-    CodeCompiler.AddExport('RegisterPreviousData', '0 @LongInt', False, '', 0);
-    CodeCompiler.AddExport('CheckSerial', 'Boolean @String', False, '', 0);
-    CodeCompiler.AddExport('InitializeWizard', '0', False, '', 0);
-    CodeCompiler.AddExport('GetCustomSetupExitCode', 'LongInt', False, '', 0);
-    CodeCompiler.AddExport('PrepareToInstall', 'String !Boolean', False, '', 0);
-    CodeCompiler.AddExport('RegisterExtraCloseApplicationsResources', '0', False, '', 0);
-    CodeCompiler.AddExport('CurInstallProgressChanged', '0 @LongInt @LongInt', False, '', 0);
-
-    CodeCompiler.AddExport('InitializeUninstall', 'Boolean', False, '', 0);
-    CodeCompiler.AddExport('DeinitializeUninstall', '0', False, '', 0);
-    CodeCompiler.AddExport('CurUninstallStepChanged', '0 @TUninstallStep', False, '', 0);
-    CodeCompiler.AddExport('UninstallNeedRestart', 'Boolean', False, '', 0);
-    CodeCompiler.AddExport('InitializeUninstallProgressForm', '0', False, '', 0);
+    //setup + allownamingattribute (=all procedures and boolean functions)
+    CodeCompiler.AddExport('InitializeSetup', 'Boolean', True, False, '', 0);
+    CodeCompiler.AddExport('DeinitializeSetup', '0', True, False, '', 0);
+    CodeCompiler.AddExport('CurStepChanged', '0 @TSetupStep', True, False, '', 0);
+    CodeCompiler.AddExport('NextButtonClick', 'Boolean @LongInt', True, False, '', 0);
+    CodeCompiler.AddExport('BackButtonClick', 'Boolean @LongInt', True, False, '', 0);
+    CodeCompiler.AddExport('CancelButtonClick', '0 @LongInt !Boolean !Boolean', True, False, '', 0);
+    CodeCompiler.AddExport('ShouldSkipPage', 'Boolean @LongInt', True, False, '', 0);
+    CodeCompiler.AddExport('CurPageChanged', '0 @LongInt', True, False, '', 0);
+    CodeCompiler.AddExport('CheckPassword', 'Boolean @String', True, False, '', 0);
+    CodeCompiler.AddExport('NeedRestart', 'Boolean', True, False, '', 0);
+    CodeCompiler.AddExport('RegisterPreviousData', '0 @LongInt', True, False, '', 0);
+    CodeCompiler.AddExport('CheckSerial', 'Boolean @String', True, False, '', 0);
+    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('InitializeUninstall', 'Boolean', True, False, '', 0);
+    CodeCompiler.AddExport('DeinitializeUninstall', '0', True, False, '', 0);
+    CodeCompiler.AddExport('CurUninstallStepChanged', '0 @TUninstallStep', True, False, '', 0);
+    CodeCompiler.AddExport('UninstallNeedRestart', 'Boolean', True, False, '', 0);
+    CodeCompiler.AddExport('InitializeUninstallProgressForm', '0', True, False, '', 0);
 
     CodeStr := CodeText.Text;
     { Remove trailing CR-LF so that ROPS will never report an error on

Projects/Install.pas

@@ -140,9 +140,9 @@ begin
   end;
   SetAppTaskbarProgressValue(NewPosition.Lo, WizardForm.ProgressGauge.Max);
 
-  if (CodeRunner <> nil) and CodeRunner.FunctionExists('CurInstallProgressChanged') then begin
+  if (CodeRunner <> nil) and CodeRunner.FunctionExists('CurInstallProgressChanged', True) then begin
     try
-      CodeRunner.RunProcedure('CurInstallProgressChanged', [NewPosition.Lo,
+      CodeRunner.RunProcedures('CurInstallProgressChanged', [NewPosition.Lo,
         WizardForm.ProgressGauge.Max], False);
     except
       Log('CurInstallProgressChanged raised an exception.');
@@ -721,7 +721,7 @@ var
       { Also see SetPreviousData in ScriptFunc.pas }
       if CodeRunner <> nil then begin
         try
-          CodeRunner.RunProcedure('RegisterPreviousData', [Integer(H2)], False);
+          CodeRunner.RunProcedures('RegisterPreviousData', [Integer(H2)], False);
         except
           Log('RegisterPreviousData raised an exception.');
           Application.HandleException(nil);
@@ -2916,10 +2916,10 @@ var
 
   procedure ProcessNeedRestartEvent;
   begin
-    if (CodeRunner <> nil) and CodeRunner.FunctionExists('NeedRestart') then begin
+    if (CodeRunner <> nil) and CodeRunner.FunctionExists('NeedRestart', True) then begin
       if not NeedsRestart then begin
         try
-          if CodeRunner.RunBooleanFunction('NeedRestart', [''], False, False) then begin
+          if CodeRunner.RunBooleanFunctions('NeedRestart', [''], False, False, False) then begin
             NeedsRestart := True;
             Log('Will restart because NeedRestart returned True.');
           end;

Projects/Main.pas

@@ -1994,7 +1994,7 @@ begin
       AllowCodeRegisterExtraCloseApplicationsResource := True;
       try
         try
-          CodeRunner.RunProcedure('RegisterExtraCloseApplicationsResources', [''], False);
+          CodeRunner.RunProcedures('RegisterExtraCloseApplicationsResources', [''], False);
         except
           Log('RegisterExtraCloseApplicationsResources raised an exception.');
           Application.HandleException(nil);
@@ -2679,7 +2679,7 @@ var
       if shPassword in SetupHeader.Options then
         PasswordOk := TestPassword(S);
       if not PasswordOk and (CodeRunner <> nil) then
-        PasswordOk := CodeRunner.RunBooleanFunction('CheckPassword', [S], False, PasswordOk);
+        PasswordOk := CodeRunner.RunBooleanFunctions('CheckPassword', [S], False, False, PasswordOk);
 
       if PasswordOk then begin
         Result := False;
@@ -3198,6 +3198,7 @@ begin
   if SetupHeader.CompiledCodeText <> '' then begin
     CodeRunner := TScriptRunner.Create();
     try
+      CodeRunner.NamingAttribute := 'Event';
       CodeRunner.OnLog := CodeRunnerOnLog;
       CodeRunner.OnLogFmt := CodeRunnerOnLogFmt;
       CodeRunner.OnDllImport := CodeRunnerOnDllImport;
@@ -3206,17 +3207,17 @@ begin
       CodeRunner.OnException := CodeRunnerOnException;
       CodeRunner.LoadScript(SetupHeader.CompiledCodeText, DebugClientCompiledCodeDebugInfo);
       if not NeedPassword then
-        NeedPassword := CodeRunner.FunctionExists('CheckPassword');
+        NeedPassword := CodeRunner.FunctionExists('CheckPassword', True);
       NeedPassword := HandleInitPassword(NeedPassword);
       if not NeedSerial then
-        NeedSerial := CodeRunner.FunctionExists('CheckSerial');
+        NeedSerial := CodeRunner.FunctionExists('CheckSerial', True);
     except
       { Don't let DeinitSetup see a partially-initialized CodeRunner }
       FreeAndNil(CodeRunner);
       raise;
     end;
     try
-      Res := CodeRunner.RunBooleanFunction('InitializeSetup', [''], False, True);
+      Res := CodeRunner.RunBooleanFunctions('InitializeSetup', [''], True, False, True);
     except
       Log('InitializeSetup raised an exception (fatal).');
       raise;
@@ -3400,7 +3401,7 @@ begin
       end;
     end;
     try
-      CodeRunner.RunProcedure('DeinitializeSetup', [''], False);
+      CodeRunner.RunProcedures('DeinitializeSetup', [''], False);
     except
       Log('DeinitializeSetup raised an exception.');
       Application.HandleException(nil);
@@ -3709,7 +3710,7 @@ begin
   CurStep := AStep;
   if CodeRunner <> nil then begin
     try
-      CodeRunner.RunProcedure('CurStepChanged', [Ord(CurStep)], False);
+      CodeRunner.RunProcedures('CurStepChanged', [Ord(CurStep)], False);
     except
       if HandleExceptions then begin
         Log('CurStepChanged raised an exception.');
@@ -3728,7 +3729,7 @@ begin
   WizardForm := TWizardForm.Create(Application);
   if CodeRunner <> nil then begin
     try
-      CodeRunner.RunProcedure('InitializeWizard', [''], False);
+      CodeRunner.RunProcedures('InitializeWizard', [''], False);
     except
       Log('InitializeWizard raised an exception (fatal).');
       raise;

Projects/ScriptCompiler.pas

@@ -25,6 +25,7 @@ type
 
   TScriptCompiler = class
     private
+      FNamingAttribute: String;
       FExports, FUsedLines: TList;
       FFunctionsFound: TStringList;
       FScriptText: AnsiString;
@@ -33,17 +34,19 @@ type
       FOnUsedVariable: TScriptCompilerOnUsedVariable;
       FOnError: TScriptCompilerOnError;
       FOnWarning: TScriptCompilerOnWarning;
+      function FindExport(const Name, Decl: String; const IgnoreIndex: Integer): Integer;
       function GetExportCount: Integer;
       procedure PSPositionToLineCol(Position: LongInt; var Line, Col: LongInt);
     public
       constructor Create;
       destructor Destroy; override;
-      procedure AddExport(const Name, Decl: String; const Required: Boolean; const RequiredFilename: String; const RequiredLine: LongInt);
+      procedure AddExport(const Name, Decl: String; const AllowNamingAttribute, Required: Boolean; const RequiredFilename: String; const RequiredLine: LongInt);
       function CheckExports: Boolean;
       function Compile(const ScriptText: String; var CompiledScriptText, CompiledScriptDebugInfo: tbtString): Boolean;
       property ExportCount: Integer read GetExportCount;
       function ExportFound(const Name: String): Boolean;
       function FunctionFound(const Name: String): Boolean;
+      property NamingAttribute: String write FNamingAttribute;
       property OnLineToLineInfo: TScriptCompilerOnLineToLineInfo write FOnLineToLineInfo;
       property OnUsedLine: TScriptCompilerOnUsedLine write FOnUsedLine;
       property OnUsedVariable: TScriptCompilerOnUsedVariable write FOnUsedVariable;
@@ -61,6 +64,7 @@ uses
 type
   TScriptExport = class
     Name, Decl: String;
+    AllowNamingAttribute: Boolean;
     Required: Boolean;
     RequiredFilename: String;
     RequiredLine: LongInt;
@@ -95,13 +99,95 @@ begin
   Result := DllExternalProc(Sender, Decl, Name, tbtstring(TrimRight(S)));
 end;
 
-function PSPascalCompilerOnUses(Sender: TPSPascalCompiler; const Name: tbtstring): Boolean; 
+function PSPascalCompilerOnApplyAttributeToProc(Sender: TPSPascalCompiler; aProc: TPSProcedure; Attr: TPSAttribute): Boolean;
+var
+  ScriptCompiler: TScriptCompiler;
+  AttrValue: String;
+  ScriptExport: TScriptExport;
+  B: Boolean;
+  I: Integer;
+begin
+  ScriptCompiler := TScriptCompiler(Sender.ID);
+  if CompareText(String(Attr.AType.Name), ScriptCompiler.FNamingAttribute) = 0 then begin
+    if aProc.ClassType <> TPSInternalProcedure then begin
+      with Sender.MakeError('', ecCustomError, tbtstring(Format('"%s" attribute cannot be used on external function or procedure', [ScriptCompiler.FNamingAttribute]))) do
+        SetCustomPos(Attr.DeclarePos, Attr.DeclareRow, Attr.DeclareCol);
+      Result := False;
+    end else if Attr.Count <> 1 then begin
+      with Sender.MakeError('', ecCustomError, tbtstring(Format('"%s" attribute value not found', [ScriptCompiler.FNamingAttribute]))) do
+        SetCustomPos(Attr.DeclarePos, Attr.DeclareRow, Attr.DeclareCol);
+      Result := False;
+    end else begin
+      if ScriptCompiler.FindExport(String(TPSInternalProcedure(aProc).Name), '', -1) <> -1 then begin
+        { Don't allow attributes on functions already matching an export (by their name) so that we don't have to deal with this later. }
+        with Sender.MakeError('', ecCustomError, tbtstring(Format('"%s" attribute not allowed for function or procedure "%s"', [ScriptCompiler.FNamingAttribute, String(TPSInternalProcedure(aProc).Name)]))) do
+          SetCustomPos(Attr.DeclarePos, Attr.DeclareRow, Attr.DeclareCol);
+        Result := False;
+      end else begin
+        AttrValue := String(GetString(Attr.Values[0], B));
+        I := ScriptCompiler.FindExport(AttrValue, String(Sender.MakeDecl(TPSInternalProcedure(aProc).Decl)), -1);
+        if I <> -1 then begin
+          { The name from the attribute and the function prototype are both ok. }
+          ScriptExport := ScriptCompiler.FExports[I];
+          if not ScriptExport.AllowNamingAttribute then begin
+            with Sender.MakeError('', ecCustomError, tbtstring(Format('"%s" attribute value "%s" not allowed', [ScriptCompiler.FNamingAttribute, AttrValue]))) do
+              SetCustomPos(Attr.DeclarePos, Attr.DeclareRow, Attr.DeclareCol);
+            Result := False;
+          end else begin
+            ScriptExport.Exported := True;
+            Result := True;
+          end;
+        end else if ScriptCompiler.FindExport(AttrValue, '', -1) <> -1 then begin
+          { The name from the attribute is ok but the function prototype is not. }
+          with Sender.MakeError('', ecCustomError, tbtstring(Format('Invalid function or procedure prototype for attribute value "%s"', [AttrValue]))) do
+            SetCustomPos(TPSInternalProcedure(aProc).DeclarePos, TPSInternalProcedure(aProc).DeclareRow, TPSInternalProcedure(aProc).DeclareCol);
+          Result := False;
+        end else begin
+          { The name from the attribute is not ok. } 
+          with Sender.MakeError('', ecCustomError, tbtstring(Format('"%s" attribute value "%s" invalid', [ScriptCompiler.FNamingAttribute, AttrValue]))) do
+            SetCustomPos(Attr.DeclarePos, Attr.DeclareRow, Attr.DeclareCol);
+          Result := False;
+        end;
+      end;
+    end;
+  end else
+    Result := True;
+end;
+
+function PSPascalCompilerOnApplyAttributeToType(Sender: TPSPascalCompiler; aType: TPSType; Attr: TPSAttribute): Boolean;
+var
+  NamingAttribute: String;
+begin
+  NamingAttribute := TScriptCompiler(Sender.ID).FNamingAttribute;
+  if CompareText(String(Attr.AType.Name), NamingAttribute) = 0 then begin
+    with Sender.MakeError('', ecCustomError, tbtstring(Format('"%s" attribute cannot be used on types', [NamingAttribute]))) do
+      SetCustomPos(Attr.DeclarePos, Attr.DeclareRow, Attr.DeclareCol);
+    Result := False;
+  end else
+    Result := True;
+end;
+
+function PSPascalCompilerOnUses(Sender: TPSPascalCompiler; const Name: tbtstring): Boolean;
+var
+  NamingAttribute: String;
 begin
   if Name = 'SYSTEM' then begin
     RegisterDll_Compiletime(Sender);
     Sender.OnExternalProc := PSPascalCompilerOnExternalProc;
     ScriptClassesLibraryRegister_C(Sender);
     ScriptFuncLibraryRegister_C(Sender);
+    NamingAttribute := TScriptCompiler(Sender.ID).FNamingAttribute;
+    if NamingAttribute <> '' then begin
+      with Sender.AddAttributeType do begin
+        OrgName := tbtstring(NamingAttribute);
+        with AddField do begin
+          FieldOrgName := 'Name';
+          FieldType := Sender.FindType('String');
+        end;
+        OnApplyAttributeToProc := PSPascalCompilerOnApplyAttributeToProc;
+        OnApplyAttributeToType := PSPascalCompilerOnApplyAttributeToType;
+      end;
+    end;
     Result := True;
   end else begin
     Sender.MakeError('', ecUnknownIdentifier, '');
@@ -109,39 +195,32 @@ begin
   end;
 end;
 
-function PSPascalCompilerOnExportCheck(Sender: TPSPascalCompiler; Proc: TPSInternalProcedure; const ProcDecl: tbtstring): Boolean; 
+function PSPascalCompilerOnExportCheck(Sender: TPSPascalCompiler; Proc: TPSInternalProcedure; const ProcDecl: tbtstring): Boolean;
 var
-  ScriptExports: TList;
+  ScriptCompiler: TScriptCompiler;
   ScriptExport: TScriptExport;
-  NameFound: Boolean;
   I: Integer;
 begin
-  TScriptCompiler(Sender.ID).FFunctionsFound.Add(String(Proc.Name));
-  ScriptExports := TScriptCompiler(Sender.ID).FExports;
-
-  { Try and see if the [Code] function matches an export name and if so,
-    see if one of the prototypes for that name matches }
+  ScriptCompiler := TScriptCompiler(Sender.ID);
 
-  NameFound := False;
+  ScriptCompiler.FFunctionsFound.Add(String(Proc.Name));
 
-  for I := 0 to ScriptExports.Count-1 do begin
-    ScriptExport := ScriptExports[I];
-    if CompareText(ScriptExport.Name, String(Proc.Name)) = 0 then begin
-      NameFound := True;
-      if CompareText(ScriptExport.Decl, String(ProcDecl)) = 0 then begin
-        ScriptExport.Exported := True;
-        Result := True;
-        Exit;
-      end;
-    end;
-  end;
+  { Try and see if the function name matches an export and if so,
+    see if one of the prototypes for that name matches. }
 
-  if NameFound then begin
+  I := ScriptCompiler.FindExport(String(Proc.Name), String(Procdecl), -1);
+  if I <> -1 then begin
+    { The function name is a matche and the function prototype is ok. }    
+    ScriptExport := ScriptCompiler.FExports[I];
+    ScriptExport.Exported := True;
+    Result := True;
+  end else if ScriptCompiler.FindExport(String(Proc.Name), '', -1) <> -1 then begin
+    { The function name is a match but the function prototype is not. }
     with Sender.MakeError('', ecCustomError, tbtstring(Format('Invalid prototype for ''%s''', [Proc.OriginalName]))) do
       SetCustomPos(Proc.DeclarePos, Proc.DeclareRow, Proc.DeclareCol);
     Result := False;
   end else
-    Result := True;
+    Result := True; { The function name is not a match - this is a user function. }
 end;
 
 function PSPascalCompilerOnBeforeOutput(Sender: TPSPascalCompiler): Boolean;
@@ -274,26 +353,30 @@ begin
   Col := Position;
 end;
 
-procedure TScriptCompiler.AddExport(const Name, Decl: String; const Required: Boolean; const RequiredFilename: String; const RequiredLine: LongInt);
+procedure TScriptCompiler.AddExport(const Name, Decl: String; const AllowNamingAttribute, Required: Boolean; const RequiredFilename: String; const RequiredLine: LongInt);
 var
   ScriptExport: TScriptExport;
   I: Integer;
 begin
-  for I := 0 to FExports.Count-1 do 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];
-    if (CompareText(ScriptExport.Name, Name) = 0) and (CompareText(ScriptExport.Decl, Decl) = 0) then begin
-      if Required and not ScriptExport.Required then begin
-        ScriptExport.Required := True;
-        ScriptExport.RequiredFilename := RequiredFilename;
-        ScriptExport.RequiredLine := RequiredLine;
-      end;
-      Exit;
+    if Required and not ScriptExport.Required then begin
+      ScriptExport.Required := True;
+      ScriptExport.RequiredFilename := RequiredFilename;
+      ScriptExport.RequiredLine := RequiredLine;
     end;
+    ScriptExport.AllowNamingAttribute := ScriptExport.AllowNamingAttribute and AllowNamingAttribute;
+    Exit;
   end;
 
   ScriptExport := TScriptExport.Create();
   ScriptExport.Name := Name;
   ScriptExport.Decl := Decl;
+  ScriptExport.AllowNamingAttribute := AllowNamingAttribute;
   ScriptExport.Required := Required;
   if Required then begin
     ScriptExport.RequiredFilename := RequiredFilename;
@@ -302,12 +385,28 @@ begin
   FExports.Add(ScriptExport);
 end;
 
+function TScriptCompiler.FindExport(const Name, Decl: String; const IgnoreIndex: Integer): Integer;
+var
+  ScriptExport: TScriptExport;
+  I: Integer;
+begin
+  for I := 0 to FExports.Count-1 do begin
+    ScriptExport := FExports[I];
+    if ((Name = '') or (CompareText(ScriptExport.Name, Name) = 0)) and
+       ((Decl = '') or (CompareText(ScriptExport.Decl, Decl) = 0)) and
+       ((IgnoreIndex = -1) or (I <> IgnoreIndex)) then begin
+      Result := I;
+      Exit;
+    end;
+  end;
+  Result := -1;
+end;
+
 function TScriptCompiler.CheckExports: Boolean;
 var
-  ScriptExport, ScriptExport2: TScriptExport;
-  I, J: Integer;
+  ScriptExport: TScriptExport;
+  I: Integer;
   Msg: String;
-  NameFound: Boolean;
 begin
   Result := True;
   for I := 0 to FExports.Count-1 do begin
@@ -315,15 +414,7 @@ begin
     if ScriptExport.Required and not ScriptExport.Exported then begin
       if Assigned(FOnError) then begin
         { Either the function wasn't present or it was present but matched another export }
-        NameFound := False;
-        for J := 0 to FExports.Count-1 do begin
-          ScriptExport2 := FExports[J];
-          if (I <> J) and (CompareText(ScriptExport.Name, ScriptExport2.Name) = 0) then begin
-            NameFound := True;
-            Break;
-          end;
-        end;
-        if NameFound then
+        if FindExport(ScriptExport.Name, '', I) <> -1 then
           Msg := Format('Required function or procedure ''%s'' found but not with a compatible prototype', [ScriptExport.Name])
         else
           Msg := Format('Required function or procedure ''%s'' not found', [ScriptExport.Name]);
@@ -340,6 +431,7 @@ var
   PSPascalCompiler: TPSPascalCompiler;
   L, Line, Col: LongInt;
   Filename, Msg: String;
+  I: Integer;
 begin
   Result := False;
 
@@ -349,6 +441,10 @@ begin
   FScriptText := ScriptText;
 {$ENDIF}
 
+  for I := 0 to FExports.Count-1 do
+    TScriptExport(FExports[I]).Exported := False;
+  FFunctionsFound.Clear;
+
   PSPascalCompiler := TPSPascalCompiler.Create();
 
   try
@@ -360,6 +456,8 @@ begin
     PSPascalCompiler.AllowDuplicateRegister := False;
     PSPascalCompiler.UTF8Decode := True;
 {$ENDIF}
+    PSPascalCompiler.AttributesOpenTokenID := CSTI_Less;
+    PSPascalCompiler.AttributesCloseTokenID := CSTI_Greater;
 
     PSPascalCompiler.OnUses := PSPascalCompilerOnUses;
     PSPascalCompiler.OnExportCheck := PSPascalCompilerOnExportCheck;

Projects/ScriptRunner.pas

@@ -26,6 +26,7 @@ type
 
   TScriptRunner = class
     private
+      FNamingAttribute: String;
       FPSExec: TPSDebugExec;
       FClassImporter: TPSRuntimeClassImporter;
       FOnLog: TScriptRunnerOnLog;
@@ -34,6 +35,9 @@ type
       FOnDebug: TScriptRunnerOnDebug;
       FOnDebugIntermediate: TScriptRunnerOnDebugIntermediate;
       FOnException: TScriptRunnerOnException;
+      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, CheckNamingAttributeAndResults, MustExist, Default: Boolean): Boolean;
       procedure Log(const S: String);
       procedure LogFmt(const S: String; const Args: array of const);
       procedure RaisePSExecException;
@@ -44,12 +48,15 @@ type
       constructor Create;
       destructor Destroy; override;
       procedure LoadScript(const CompiledScriptText, CompiledScriptDebugInfo: AnsiString);
-      function FunctionExists(const Name: AnsiString): Boolean;
+      function FunctionExists(const Name: AnsiString; const CheckNamingAttribute: Boolean): Boolean;
       procedure RunProcedure(const Name: AnsiString; const Parameters: array of Const; const MustExist: Boolean);
+      procedure RunProcedures(const Name: AnsiString; const Parameters: array of Const; const MustExist: Boolean);
       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 AndResults, MustExist, Default: Boolean): Boolean;
       function RunIntegerFunction(const Name: AnsiString; const Parameters: array of Const; const MustExist: Boolean; const Default: Integer): Integer;
       function RunStringFunction(const Name: AnsiString; const Parameters: array of Const; const MustExist: Boolean; const 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;
       property OnLogFmt: TScriptRunnerOnLogFmt read FOnLogFmt write FOnLogFmt;
       property OnDllImport: TScriptRunnerOnDllImport read FOnDllImport write FOnDllImport;
@@ -356,9 +363,47 @@ begin
   end;
 end;
 
-function TScriptRunner.FunctionExists(const Name: AnsiString): Boolean;
+function TScriptRunner.GetProcNos(const Name: AnsiString; const CheckNamingAttribute: Boolean; const ProcNos: TPSList): Integer;
+var
+  MainProcNo, ProcNo: Cardinal;
+  Proc: PIFProcRec;
+  Attr: TPSRuntimeAttribute;
+begin
+  Result := 0;
+
+  { Locate main implementation. Will add later. }
+  MainProcNo := FPSExec.GetProc(Name);
+  
+  { Locate other implementations using attributes. }
+  if CheckNamingAttribute and (FNamingAttribute <> '') then begin
+    for ProcNo := 0 to FPSExec.GetProcCount-1 do begin
+      if ProcNo <> MainProcNo then begin
+        Proc := FPSExec.GetProcNo(ProcNo);
+        if Proc.Attributes.Count > 0 then begin
+          Attr := Proc.Attributes.FindAttribute(AnsiString(FNamingAttribute));
+          if (Attr <> nil) and (Attr.ValueCount = 1) and
+             ({$IFDEF UNICODE} ((Attr.Value[0].FType.BaseType = btUnicodeString) and (CompareText(PPSVariantUString(Attr.Value[0]).Data, Name) = 0)) or {$ENDIF}
+              ((Attr.Value[0].FType.BaseType = btString) and (CompareText(PPSVariantAString(Attr.Value[0]).Data, Name) = 0))) then begin
+            if ProcNos <> nil then
+              ProcNos.Add(Pointer(ProcNo));
+            Inc(Result);
+          end;
+        end;
+      end;
+    end;
+  end;
+
+  { Add main implementation. Doing this last so it will be called last always. }
+  if MainProcNo <> Cardinal(-1) then begin
+    if ProcNos <> nil then
+      ProcNos.Add(Pointer(MainProcNo));
+    Inc(Result);
+  end;
+end;
+
+function TScriptRunner.FunctionExists(const Name: AnsiString; const CheckNamingAttribute: Boolean): Boolean;
 begin
-  Result := FPSExec.GetProc(Name) <> Cardinal(-1);
+  Result := GetProcNos(Name, CheckNamingAttribute, nil) <> 0;
 end;
 
 procedure WriteBackParameters(const Parameters: array of Const; const Params: TPSList);
@@ -371,65 +416,98 @@ begin
       Boolean(Parameters[I].VPointer^) := (PPSVariantU8(Params[High(Parameters)-I]).Data = 1);
 end;
 
-procedure TScriptRunner.RunProcedure(const Name: AnsiString; const Parameters: array of Const; const MustExist: Boolean);
+procedure TScriptRunner.InternalRunProcedure(const Name: AnsiString; const Parameters: array of Const; const CheckNamingAttribute, MustExist: Boolean);
 var
-  ProcNo: Cardinal;
-  Params: TPSList;
+  ProcNos, Params: TPSList;
+  I: Integer;
 begin
-  ProcNo := FPSExec.GetProc(Name);
-  if ProcNo <> Cardinal(-1) then begin
-    Params := TPSList.Create();
-    try
-      SetPSExecParameters(Parameters, Params);
-      FPSExec.RunProc(Params, ProcNo);
-      WriteBackParameters(Parameters, Params);
-    finally
-      FreePSVariantList(Params);
+  ProcNos := TPSList.Create;
+  try
+    if GetProcNos(Name, CheckNamingAttribute, ProcNos) <> 0 then begin
+      for I := 0 to ProcNos.Count-1 do begin
+        Params := TPSList.Create();
+        try
+          SetPSExecParameters(Parameters, Params);
+          FPSExec.RunProc(Params, Cardinal(ProcNos[I]));
+          WriteBackParameters(Parameters, Params);
+
+          RaisePSExecException;
+        finally
+          FreePSVariantList(Params);
+        end;
+      end;
+    end else begin
+      if MustExist then
+        ShowPSExecError(erCouldNotCallProc);
     end;
-
-    RaisePSExecException;
-  end else begin
-    if MustExist then
-      ShowPSExecError(erCouldNotCallProc);
+  finally
+    ProcNos.Free;
   end;
 end;
 
-function TScriptRunner.RunBooleanFunction(const Name: AnsiString; const Parameters: array of Const; const MustExist, Default: Boolean): Boolean;
-var
-  ProcNo: Cardinal;
-  Params: TPSList;
-  Res: PPSVariant;
+procedure TScriptRunner.RunProcedure(const Name: AnsiString; const Parameters: array of Const; const MustExist: Boolean);
 begin
-  Result := Default;
+  InternalRunProcedure(Name, Parameters, False, MustExist);
+end;
 
-  ProcNo := FPSExec.GetProc(Name);
-  if ProcNo <> Cardinal(-1) then begin
-    Params := TPSList.Create();
-    try
-      SetPSExecParameters(Parameters, Params);
-      SetPSExecReturnValue(Params, btU8, Res);
-      FPSExec.RunProc(Params, ProcNo);
-      WriteBackParameters(Parameters, Params);
+procedure TScriptRunner.RunProcedures(const Name: AnsiString; const Parameters: array of Const; const MustExist: Boolean);
+begin
+  InternalRunProcedure(Name, Parameters, True, MustExist);
+end;
 
-      RaisePSExecException;
-      Result := PPSVariantU8(Res).Data = 1;
-    finally
-      FreePSVariantList(Params);
+function TScriptRunner.InternalRunBooleanFunction(const Name: AnsiString; const Parameters: array of Const; const CheckNamingAttribute, CheckNamingAttributeAndResults, MustExist, Default: Boolean): Boolean;
+var
+  ProcNos, Params: TPSList;
+  Res: PPSVariant;
+  I: Integer;
+begin
+  ProcNos := TPSList.Create;
+  try
+    if GetProcNos(Name, CheckNamingAttribute, ProcNos) <> 0 then begin
+      Result := True;
+      for I := 0 to ProcNos.Count-1 do begin
+        Params := TPSList.Create();
+        try
+          SetPSExecParameters(Parameters, Params);
+          SetPSExecReturnValue(Params, btU8, Res);
+          FPSExec.RunProc(Params, Cardinal(ProcNos[I]));
+          WriteBackParameters(Parameters, Params);
+
+          RaisePSExecException;
+          if CheckNamingAttributeAndResults then
+            Result := Result and (PPSVariantU8(Res).Data = 1) { Don't break on Result = False: need to call all procs always. }
+          else
+            Result := Result or (PPSVariantU8(Res).Data = 1) { Don't break on Result = True: need to call all procs always. }
+        finally
+          FreePSVariantList(Params);
+        end;
+      end;
+    end else begin
+      if MustExist then
+        ShowPSExecError(erCouldNotCallProc);
+      Result := Default;
     end;
-  end else begin
-    if MustExist then
-      ShowPSExecError(erCouldNotCallProc);
+  finally
+    ProcNos.Free;
   end;
 end;
 
+function TScriptRunner.RunBooleanFunction(const Name: AnsiString; const Parameters: array of Const; const MustExist, Default: Boolean): Boolean;
+begin
+  Result := InternalRunBooleanFunction(Name, Parameters, False, False, MustExist, Default);
+end;
+
+function TScriptRunner.RunBooleanFunctions(const Name: AnsiString; const Parameters: array of Const; const AndResults, MustExist, Default: Boolean): Boolean;
+begin
+  Result := InternalRunBooleanFunction(Name, Parameters, True, AndResults, MustExist, Default);
+end;
+
 function TScriptRunner.RunIntegerFunction(const Name: AnsiString; const Parameters: array of Const; const MustExist: Boolean; const Default: Integer): Integer;
 var
   ProcNo: Cardinal;
   Params: TPSList;
   Res: PPSVariant;
 begin
-  Result := Default;
-
   ProcNo := FPSExec.GetProc(Name);
   if ProcNo <> Cardinal(-1) then begin
     Params := TPSList.Create();
@@ -447,6 +525,7 @@ begin
   end else begin
     if MustExist then
       ShowPSExecError(erCouldNotCallProc);
+    Result := Default;
   end;
 end;
 
@@ -456,8 +535,6 @@ var
   Params: TPSList;
   Res: PPSVariant;
 begin
-  Result := Default;
-
   ProcNo := FPSExec.GetProc(Name);
   if ProcNo <> Cardinal(-1) then begin
     Params := TPSList.Create();
@@ -483,6 +560,7 @@ begin
   end else begin
     if MustExist then
       ShowPSExecError(erCouldNotCallProc);
+    Result := Default;
   end;
 end;
 

Projects/Uninstall.pas

@@ -98,7 +98,7 @@ begin
   UninstallProgressForm.Initialize(Title, UninstLog.AppName);
   if CodeRunner <> nil then begin
     try
-      CodeRunner.RunProcedure('InitializeUninstallProgressForm', [''], False);
+      CodeRunner.RunProcedures('InitializeUninstallProgressForm', [''], False);
     except
       Log('InitializeUninstallProgressForm raised an exception (fatal).');
       raise;
@@ -299,7 +299,7 @@ procedure CurUninstallStepChanged(CurUninstallStep: TUninstallStep; HandleExcept
 begin
   if CodeRunner <> nil then begin
     try
-      CodeRunner.RunProcedure('CurUninstallStepChanged', [Ord(CurUninstallStep)], False);
+      CodeRunner.RunProcedures('CurUninstallStepChanged', [Ord(CurUninstallStep)], False);
     except
       if HandleException then begin
         Log('CurUninstallStepChanged raised an exception.');
@@ -603,7 +603,7 @@ begin
       try
         if CodeRunner <> nil then begin
           try
-            Res := CodeRunner.RunBooleanFunction('InitializeUninstall', [''], False, True);
+            Res := CodeRunner.RunBooleanFunctions('InitializeUninstall', [''], True, False, True);
           except
             Log('InitializeUninstall raised an exception (fatal).');
             raise;
@@ -654,10 +654,10 @@ begin
         LogFmt('Removed all? %s', [SYesNo[RemovedAll]]);
 
         UninstallNeedsRestart := UninstLog.NeedRestart or (ufAlwaysRestart in UninstLog.Flags);
-        if (CodeRunner <> nil) and CodeRunner.FunctionExists('UninstallNeedRestart') then begin
+        if (CodeRunner <> nil) and CodeRunner.FunctionExists('UninstallNeedRestart', True) then begin
           if not UninstallNeedsRestart then begin
             try
-              if CodeRunner.RunBooleanFunction('UninstallNeedRestart', [''], False, False) then begin
+              if CodeRunner.RunBooleanFunctions('UninstallNeedRestart', [''], False, False, False) then begin
                 UninstallNeedsRestart := True;
                 Log('Will restart because UninstallNeedRestart returned True.');
               end;
@@ -719,7 +719,7 @@ begin
       end;
       if CodeRunner <> nil then begin
         try
-          CodeRunner.RunProcedure('DeinitializeUninstall', [''], False);
+          CodeRunner.RunProcedures('DeinitializeUninstall', [''], False);
         except
           Log('DeinitializeUninstall raised an exception.');
           ShowExceptionMsg;

Projects/Wizard.pas

@@ -431,7 +431,7 @@ begin
     WizardUserInfoName := UserInfoNameEdit.Text;
     WizardUserInfoOrg := UserInfoOrgEdit.Text;
     WizardUserInfoSerial := UserInfoSerialEdit.Text;
-    Result := CodeRunner.RunBooleanFunction('CheckSerial', [UserInfoSerialEdit.Text], True, False)
+    Result := CodeRunner.RunBooleanFunctions('CheckSerial', [UserInfoSerialEdit.Text], False, True, False)
   end else
     Result := True;
 end;
@@ -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') then begin
+  end else if (CodeRunner <> nil) and CodeRunner.FunctionExists('PrepareToInstall', False) then begin
     SetCurPage(wpPreparing);
     BackButton.Visible := False;
     NextButton.Visible := False;
@@ -1837,7 +1837,7 @@ procedure TWizardForm.UpdatePage(const PageID: Integer);
         MemoTasksInfo := '';
       SelectedTasks.Free();
 
-      if (CodeRunner <> nil) and CodeRunner.FunctionExists('UpdateReadyMemo') then begin
+      if (CodeRunner <> nil) and CodeRunner.FunctionExists('UpdateReadyMemo', False) then begin
         try
           ReadyMemo.Lines.Text := CodeRunner.RunStringFunction('UpdateReadyMemo',
             [Space, SNewLine, MemoUserInfoInfo, MemoDirInfo, MemoTypeInfo,
@@ -2003,7 +2003,7 @@ begin
 
   try
     if CodeRunner <> nil then
-      CodeRunner.RunProcedure('CurPageChanged', [CurPageID], False);
+      CodeRunner.RunProcedures('CurPageChanged', [CurPageID], False);
   except
     Application.HandleException(Self);
   end;
@@ -2042,7 +2042,7 @@ begin
     if not Result then begin
       try
         if CodeRunner <> nil then
-          Result := CodeRunner.RunBooleanFunction('ShouldSkipPage', [PageID], False, Result);
+          Result := CodeRunner.RunBooleanFunctions('ShouldSkipPage', [PageID], False, False, Result);
       except
         Application.HandleException(Self);
       end;
@@ -2063,7 +2063,7 @@ procedure TWizardForm.NextButtonClick(Sender: TObject);
     if shPassword in SetupHeader.Options then
       Result := TestPassword(S);
     if not Result and (CodeRunner <> nil) then
-      Result := CodeRunner.RunBooleanFunction('CheckPassword', [S], False, Result);
+      Result := CodeRunner.RunBooleanFunctions('CheckPassword', [S], False, False, Result);
 
     if Result then begin
       NeedPassword := False;
@@ -2228,7 +2228,7 @@ begin
     Exit;
 
   if CodeRunner <> nil then
-    if CodeRunner.RunBooleanFunction('NextButtonClick', [CurPageID], False, True) = False then
+    if CodeRunner.RunBooleanFunctions('NextButtonClick', [CurPageID], True, False, True) = False then
       Exit;
 
   { Go to the next page, or close wizard if it was on the last page }
@@ -2328,7 +2328,7 @@ begin
     Exit;
 
   if CodeRunner <> nil then
-    if CodeRunner.RunBooleanFunction('BackButtonClick', [CurPageID], False, True) = False then
+    if CodeRunner.RunBooleanFunctions('BackButtonClick', [CurPageID], True, False, True) = False then
       Exit;
 
   PrevPageID := GetPreviousPageID;
@@ -2349,7 +2349,7 @@ begin
     Exit;
 
   if CodeRunner <> nil then
-    CodeRunner.RunProcedure('CancelButtonClick', [CurPageID, @ACancel,
+    CodeRunner.RunProcedures('CancelButtonClick', [CurPageID, @ACancel,
       @AConfirm], False);
 end;
 

whatsnew.htm

@@ -67,6 +67,7 @@ For conditions of distribution and use, see <a href="http://www.jrsoftware.org/f
 <li>The Compiler IDE 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>Pascal Scripting changes:
 <ul>
+  <li>Using event attributes it is now possible to have multiple implementations of the same event function in your script. This is especially useful in included scripts implementing an event function to avoid conflicts with the main script. See the help file for more information and the <i>CodeExample1.iss</i> example script for an example.</li>
   <li>[Setup] section directives <tt>ChangesAssociations</tt> and <tt>ChangesEnvironment</tt> may now be set to a boolean expression, which may contain calls to check functions.</li>
   <li>Added new special-purpose <i>HelpTextNote</i> message that can be used to specify one or more lines of text that are added to the list of parameters in the summary shown when passing /HELP on the command line.</li>
   <li>Added new <tt>SameStr</tt> and <tt>SameText</tt> support functions.</li>
@@ -85,6 +86,7 @@ For conditions of distribution and use, see <a href="http://www.jrsoftware.org/f
 <li>All documentation referring to the Power Users group has been removed: this group is not special anymore in Windows.</li>
 <li>Documentation and examples improvements.</li>
 <li>Added official Icelandic translation.</li>
+<li>Unicode [Code] based on RemObjects Pascal Script Git commit 7f3720701fc9467123e940c2f719543652b82109.</li>
 <li>Minor tweaks.</li>
 </ul>