From 87a53d1ed2dbf5cf072498660002721effc06ca6 Mon Sep 17 00:00:00 2001
From: dinkumoil <anonymous@example.com>
Date: Thu, 10 Nov 2022 14:50:02 +0100
Subject: [PATCH] Add Pascal/Delphi for Function List

Add Pascal/Delphi FunctionList parser and unit tests.

Fix #3664, close #12489
---
 PowerEditor/Test/FunctionList/pascal/unitTest | 445 ++++++++++++++++++
 .../pascal/unitTest.expected.result           |   1 +
 PowerEditor/installer/functionList/pascal.xml | 161 +++++++
 3 files changed, 607 insertions(+)
 create mode 100644 PowerEditor/Test/FunctionList/pascal/unitTest
 create mode 100644 PowerEditor/Test/FunctionList/pascal/unitTest.expected.result
 create mode 100644 PowerEditor/installer/functionList/pascal.xml

diff --git a/PowerEditor/Test/FunctionList/pascal/unitTest b/PowerEditor/Test/FunctionList/pascal/unitTest
new file mode 100644
index 000000000..af90bbae7
--- /dev/null
+++ b/PowerEditor/Test/FunctionList/pascal/unitTest
@@ -0,0 +1,445 @@
+unit Test;
+
+
+interface
+
+uses
+  System.SysUtils, System.Types, System.Classes;
+
+
+// ATTENTION!!! This is a known issue!
+// The following function should NOT be part of the function list tree.
+// However, it is still included because of the TYPE keyword after its declaration.
+// Global functions or procedures should therefor be declared immediately before
+// the keyword IMPLEMENTATION.
+function FreeFunc(const Param: integer): integer;
+
+
+type
+// -----------------------------------------------------------------------------
+// TStdClass
+// -----------------------------------------------------------------------------
+
+  TStdClass = class(TObject)
+  private type
+    TStdInternalClass = class(TObject)
+    private
+      FName: string;
+      FId:   integer;
+
+    public
+      constructor Create;
+      destructor  Destroy; override;
+
+      procedure   CopyTo(Dest: TStdInternalClass);
+
+      property    Name: string  read FName write FName;
+      property    Id:   integer read FId   write FId;
+    end;
+
+  private
+    FId:    integer;
+    FValue: string;
+
+    class var FInstCnt: integer;
+
+    class function Init(Cnt: integer): boolean;
+    class function DeInit(Cnt: integer): boolean;
+
+    procedure      SetValue(const Value: string);
+
+  public
+    constructor    Create;
+    destructor     Destroy; override;
+
+    function       Convert<X: class, constructor>(const Value: string): X;
+
+    class property InstCnt:   integer read FInstCnt;
+
+    property       PropId:    integer read FId    write FId;
+    property       PropValue: string  read FValue write SetValue;
+
+  end;
+
+
+// -----------------------------------------------------------------------------
+// TGenericClass<T>
+// -----------------------------------------------------------------------------
+
+  TGenericClass<T> = class(TObject)
+  private type
+    TGenericInternalClass<T, I> = class(TObject)
+    strict private
+      FName:  string;
+      FId:    T;
+      FValue: I;
+
+    public
+      constructor Create;
+      destructor  Destroy; override;
+
+      procedure   CopyTo<I>(Dest: TGenericInternalClass<T, I>);
+
+      property    Name:  string read FName  write FName;
+      property    Id:    T      read FId    write FId;
+      property    Value: I      read FValue write FValue;
+    end;
+
+  strict private
+    FId:    integer;
+    FValue: T;
+
+    class var FInstCnt: integer;
+
+    class function Init<I>(Cnt: integer): boolean;
+    class function DeInit(Cnt: integer): boolean;
+
+    procedure      SetValue(const Value: T);
+
+  public
+    constructor    Create;
+    destructor     Destroy; override;
+
+    class property InstCnt:   integer read FInstCnt;
+
+    property       PropId:    integer read FId    write FId;
+    property       PropValue: T       read FValue write SetValue;
+
+  end;
+
+
+
+type
+// -----------------------------------------------------------------------------
+// TEnum
+// -----------------------------------------------------------------------------
+  TEnum = (enMember1, enMember2, enMember3);
+
+  TEnumHelper = record helper for TEnum
+  public
+    function       ToString: string;
+    class function FromString(const AString: string): TEnum; static;
+  end;
+
+
+// -----------------------------------------------------------------------------
+// TStdClassHelper
+// -----------------------------------------------------------------------------
+  TStdClassHelper = class helper for TStdClass
+  public
+    function       AsString: string;
+    class function FromString(const AString: string): TStdClass; static;
+  end;
+
+  
+
+// -----------------------------------------------------------------------------
+// Free routines
+// -----------------------------------------------------------------------------
+
+function FreeFunc2(const Param: integer): integer;
+
+
+
+implementation
+
+{R *.dfm}
+
+
+// -----------------------------------------------------------------------------
+// Free routines
+// -----------------------------------------------------------------------------
+
+{ Free function 3 }
+
+function FreeFunc3(const Param: integer): integer; forward;
+
+
+
+{ Free function 1 }
+
+function FreeFunc(const Param: integer): integer;
+begin
+  //
+end;
+
+
+
+{ Free function 4 }
+
+procedure FreeFunc4(const Param: integer); forward;
+
+
+
+// -----------------------------------------------------------------------------
+// TStdClass
+// -----------------------------------------------------------------------------
+
+constructor TStdClass.Create;
+begin
+  inherited;
+
+  Init(Succ(InstCnt));
+end;
+
+
+destructor TStdClass.Destroy;
+begin
+  DeInit(Pred(InstCnt));
+
+  inherited;
+end;
+
+
+class function TStdClass.Init(Cnt: integer): boolean;
+begin
+  FInstCnt := Cnt;
+end;
+
+
+class function TStdClass.DeInit(Cnt: integer): boolean;
+begin
+  FInstCnt := Cnt;
+end;
+
+
+procedure TStdClass.SetValue(const Value: string);
+begin
+  FValue := Value;
+end;
+
+
+function TStdClass.Convert<X>(const Value: string): X;
+begin
+  Result := ToType<X>(Value);
+end;
+
+
+
+
+// -----------------------------------------------------------------------------
+// TStdClass.TStdInternalClass
+// -----------------------------------------------------------------------------
+
+constructor TStdClass.TStdInternalClass.Create;
+begin
+  inherited;
+
+  //
+end;
+
+
+destructor TStdClass.TStdInternalClass.Destroy;
+begin
+  //
+
+  inherited;
+end;
+
+
+procedure TStdClass.TStdInternalClass.CopyTo(Dest: TStdInternalClass);
+begin
+  Dest.Name := Name;
+  Dest.Id   := Id;
+end;
+
+
+
+// -----------------------------------------------------------------------------
+// Free routines
+// -----------------------------------------------------------------------------
+
+{ Free function 2 with internal function preceeded by a comment }
+
+function FreeFunc2(const Param: integer): integer;
+
+  // Internal routine
+  function FreeFunc2Internal: integer;
+  begin
+    //
+  end;
+
+begin
+  //
+end;
+
+
+
+{ Free function 3 with internal procedure }
+
+function FreeFunc3: integer;
+
+  procedure FreeFunc3Internal(const Param: integer);
+  begin
+    //
+  end;
+
+begin
+  //
+end;
+
+
+
+{ Free procedure 4 with internal function }
+
+procedure FreeFunc4;
+
+  function FreeFunc4Internal(const Param: integer): string;
+  begin
+    //
+  end;
+
+begin
+  //
+end;
+
+
+
+{ Free procedure 5 with internal procedure preceeded by a comment }
+
+procedure FreeFunc5;
+
+  // Internal routine
+  procedure FreeFunc5Internal;
+  begin
+    //
+  end;
+
+begin
+  //
+end;
+
+
+
+// -----------------------------------------------------------------------------
+// TGenericClass<T>
+// -----------------------------------------------------------------------------
+
+constructor TGenericClass<T>.Create;
+begin
+  inherited;
+
+  Init<string>(Succ(InstCnt));
+end;
+
+
+destructor TGenericClass<T>.Destroy;
+begin
+  DeInit(Pred(InstCnt));
+
+  inherited;
+end;
+
+
+// This is a class function
+class function TGenericClass<T>.Init<I>(Cnt: integer): boolean;
+
+  // ---------------------------------------------------------------------------
+  // This is an inline function with surrounding comments
+  function InitStdInternalClass: integer;
+  begin
+    //
+  end;
+  // ---------------------------------------------------------------------------
+
+  function ReInitStdInternalClass: integer;
+  begin
+    // This is an inline function without surrounding comments
+  end;
+
+// This is the main function's body
+begin
+  FInstCnt := Cnt;
+end;
+
+
+// This is a class function
+class function TGenericClass<T>.DeInit(Cnt: integer): boolean;
+begin
+  FInstCnt := Cnt;
+end;
+
+
+procedure TGenericClass<T>.SetValue(const Value: T);
+begin
+  FValue := Value;
+end;
+
+
+
+// -----------------------------------------------------------------------------
+// TGenericClass<T>.TGenericInternalClass<T, I>
+// -----------------------------------------------------------------------------
+
+constructor TGenericClass<T>.TGenericInternalClass<T, I>.Create;
+begin
+  inherited;
+
+  FValue := '';
+  FId    := Default(T);
+  FName  := Default(I);
+end;
+
+
+destructor TGenericClass<T>.TGenericInternalClass<T, I>.Destroy;
+begin
+  //
+
+  inherited;
+end;
+
+
+procedure TGenericClass<T>.TGenericInternalClass<T, I>.CopyTo<I>(Dest: TGenericInternalClass<T, I>);
+begin
+  Dest.Name  := Name;
+  Dest.Id    := Id;
+  Dest.Value := Value;
+end;
+
+
+
+// -----------------------------------------------------------------------------
+// TEnumHelper
+// -----------------------------------------------------------------------------
+
+function TEnumHelper.ToString: string;
+begin
+  case Self of
+    enMember2: Result := 'Member 2';
+    enMember3: Result := 'Member 3';
+    else       Result := 'Unknown';
+  end;
+end;
+
+
+class function TEnumHelper.FromString(const AString: string): TEnum;
+begin
+  if SameText(AString, 'Member 2') then
+    Result := enMember2
+    
+  if SameText(AString, 'Member 3') then
+    Result := enMember3
+    
+  else
+    Result := enMember1;
+end;
+
+
+
+// -----------------------------------------------------------------------------
+// TStdClassHelper
+// -----------------------------------------------------------------------------
+
+function TStdClassHelper.AsString: string;
+begin
+  Result := 'TStdClass instance';
+end;
+
+
+class function TStdClassHelper.FromString(const AString: string): TStdClass;
+begin
+  Result := TStdClass.Create.Convert<TStdClass>(AString);
+end;
+
+
+end.
diff --git a/PowerEditor/Test/FunctionList/pascal/unitTest.expected.result b/PowerEditor/Test/FunctionList/pascal/unitTest.expected.result
new file mode 100644
index 000000000..74202abc3
--- /dev/null
+++ b/PowerEditor/Test/FunctionList/pascal/unitTest.expected.result
@@ -0,0 +1 @@
+{"leaves":["FreeFunc","FreeFunc","FreeFunc2","FreeFunc2Internal","FreeFunc3","FreeFunc3Internal","FreeFunc4","FreeFunc4Internal","FreeFunc5","FreeFunc5Internal","InitStdInternalClass","ReInitStdInternalClass"],"nodes":[{"leaves":["Create","Destroy","Init","DeInit","SetValue","Convert<X>"],"name":"TStdClass"},{"leaves":["Create","Destroy","CopyTo"],"name":"TStdClass.TStdInternalClass"},{"leaves":["Create","Destroy","Init<I>","DeInit","SetValue"],"name":"TGenericClass<T>"},{"leaves":["Create","Destroy","CopyTo<I>"],"name":"TGenericClass<T>.TGenericInternalClass<T, I>"},{"leaves":["ToString","FromString"],"name":"TEnumHelper"},{"leaves":["AsString","FromString"],"name":"TStdClassHelper"}],"root":"unitTest"}
\ No newline at end of file
diff --git a/PowerEditor/installer/functionList/pascal.xml b/PowerEditor/installer/functionList/pascal.xml
new file mode 100644
index 000000000..e2719c132
--- /dev/null
+++ b/PowerEditor/installer/functionList/pascal.xml
@@ -0,0 +1,161 @@
+<?xml version="1.0" encoding="UTF-8" ?>
+<!-- ==========================================================================\
+|
+|   To learn how to make your own language parser, please check the following
+|   link:
+|       https://npp-user-manual.org/docs/function-list/
+|
+\=========================================================================== -->
+<NotepadPlus>
+	<functionList>
+		<!-- ====================================================== [ Pascal ] -->
+
+		<parser
+			displayName="Pascal"
+			id         ="pascal_syntax"
+			commentExpr="(?x)                                                                      # Utilize inline comments (see `RegEx - Pattern Modifiers`)
+						   (?s:\x7B.*?\x7D)                                                        # Multi Line Comment 1st variant
+						 | (?s:\x28\x2A.*?\x2A\x29)                                                # Multi Line Comment 2nd variant
+						 | (?m-s:\x2F{2}.*$)                                                       # Single Line Comment
+						 "
+		>
+			<classRange
+				mainExpr="(?x)                                                                     # Utilize inline comments (see `RegEx - Pattern Modifiers`)
+						  (?im-s)                                                                  # multi-line mode on, single-line mode off
+						  ^\h*                                                                     # optional leading whitespace
+						  (?:
+							 CLASS\s+
+						  )?
+						  (?:
+							 (?'CONSTRUCTOR_HEADER'                                                # constructor
+							 CONSTRUCTOR
+							 )
+							 |                                                                     # or
+							 (?'DESTRUCTOR_HEADER'                                                 # destructor
+							 DESTRUCTOR
+							 )
+							 |                                                                     # or
+							 (?'PROCEDURE_HEADER'                                                  # procedure
+							 PROCEDURE
+							 )
+							 |                                                                     # or
+							 (?'FUNCTION_HEADER'                                                   # function
+							 FUNCTION
+							 )
+							 |                                                                     # or
+							 (?'OPERATOR_HEADER'                                                   # operator
+							 OPERATOR
+							 )
+						  )\s+
+						  (?'CLASS_NAME'                                                           # class/interface name
+							(?:[A-Z_]\w*(?:\s*&lt;[^&gt;]+&gt;)?\s*\.\s*)+                         # match nested classes too
+						  )
+						  (?'METHOD_NAME'                                                          # method name
+							[A-Z_]\w*(?:\s*&lt;[^&gt;]+&gt;)?
+						  )
+						  (?'PARAM_LIST'                                                           # optional parameter list
+							\s*\(                                                                  # start-of-parameter-list indicator
+							[^()]*                                                                 # parameter list
+							\)                                                                     # end-of-parameter-list indicator
+						  )?
+						  (?('CONSTRUCTOR_HEADER')                                                 # constructors don't have a return type
+							\s*
+							;                                                                      # end-of-statement indicator
+						  )
+						  (?('DESTRUCTOR_HEADER')                                                  # destructors don't have a return type
+							\s*
+							;                                                                      # end-of-statement indicator
+						  )
+						  (?('PROCEDURE_HEADER')                                                   # procedures don't have a return type
+							\s*
+							;                                                                      # end-of-statement indicator
+						  )
+						  (?('FUNCTION_HEADER')                                                    # functions have a return type
+							\s*:                                                                   # type indicator
+							\s*[^;]+                                                               # type identifier
+							;                                                                      # end-of-statement indicator
+						  )
+						  (?('OPERATOR_HEADER')                                                    # operators have a return type
+							\s*:                                                                   # type indicator
+							\s*[^;]+                                                               # type identifier
+							;                                                                      # end-of-statement indicator
+						  )
+						"
+			>
+				<className>
+					<nameExpr expr="(?i)(?:(CONSTRUCTOR|DESTRUCTOR|PROCEDURE|FUNCTION|OPERATOR)\s+)\K(?:(?:[A-Z_]\w*(?:\s*&lt;[^&gt;]+&gt;)?\s*\.\s*)+)(?:[A-Z_]\w*)" />
+					<nameExpr expr="(?i)(?:(?:[A-Z_]\w*(?:\s*&lt;[^&gt;]+&gt;)?\s*\.\s*)+)(?=[A-Z_])" />
+					<nameExpr expr="(?i)(?:(?:\s*\.\s*)?[A-Z_]\w*(?:\s*&lt;[^&gt;]+&gt;)?)+(?!\Z)" />
+				</className>
+				<function
+					mainExpr="(?x)                                                                 # Utilize inline comments (see `RegEx - Pattern Modifiers`)
+							  (?im-s)                                                              # multi-line mode on, single-line mode off
+							  \s+
+							  (?'CLASS_NAME'                                                       # class/interface name
+								(?:[A-Z_]\w*(?:\s*&lt;[^&gt;]+&gt;)?\s*\.\s*)+
+							  )
+							  (?'METHOD_NAME'                                                      # method name
+								[A-Z_]\w*(?:\s*&lt;[^&gt;]+&gt;)?
+							  )
+							  (?'PARAM_LIST'                                                       # optional parameter list
+								\s*\(                                                                # start-of-parameter-list indicator
+								[^()]*                                                               # parameter list
+								\)                                                                   # end-of-parameter-list indicator
+							  )?
+							"
+				>
+					<functionName>
+						<funcNameExpr expr="(?i)(?:(?:[A-Z_]\w*(?:\s*&lt;[^&gt;]+&gt;)?\s*\.\s*)+)\K(?:[A-Z_]\w*(?:\s*&lt;[^&gt;]+&gt;)?)(?:\s*\([^()]*\))*" />
+						<!-- comment out the following node to display the method with its parameters -->
+						<funcNameExpr expr="(?i)(?:[A-Z_]\w*(?:\s*&lt;[^&gt;]+&gt;)?)(?=\s*|\(|\Z)" />
+					</functionName>
+				</function>
+			</classRange>
+			<function
+				mainExpr="(?x)                                                                     # Utilize inline comments (see `RegEx - Pattern Modifiers`)
+						  (?im-s)                                                                  # multi-line mode on, single-line mode off
+						  ^\h*                                                                     # optional leading whitespace
+                          (?:
+                                (?:PROCEDURE\s+                                                    # procedure
+                                  ([A-Z_]\w*)\s*                                                     #  name
+                                  (?:                                                                #  optional parameter list
+                                    \([^()]*\)
+                                  )?\s*
+                                  ;                                                                  #  end-of-statement indicator
+                                )
+                              | (?:FUNCTION\s+                                                     # or function
+                                  ([A-Z_]\w*)\s*                                                     # name
+                                  (?:                                                                # optional parameter list
+                                    \([^()]*\)
+                                  )?\s*
+                                  :\s*[^;]+                                                          # return type
+                                  ;                                                                  # end-of-statement indicator
+                                )
+                          )
+						  (?:\s*OVERLOAD\s*;)?                                                     # function/procedure overloading
+						  (?:\s*(?:REGISTER|PASCAL|CDECL|STDCALL|SAFECALL)\s*;)?                   # calling convention
+						  (?:                                                                      # external function from object file
+							(?:\s*(?:VARARGS)\s*;)                                                   # variadic C function with cdecl calling convention
+							| (?:\s*(?:EXTERNAL)\s+[^;]+;)                                           # or normal function
+						  )?
+						  (?!\s*(?:FORWARD)\s*;)                                                   # prevent matching forward declarations
+						  (?=(?:\s*                                                                # only match function/procedure definitions
+							   (?:                                                                 # optional comment
+								(?s:\x7B.*?\x7D)                                                     #     multi line comment 1st variant
+								| (?s:\x28\x2A.*?\x2A\x29)                                           # or  multi line comment 2nd variant
+								| (?-s:\x2F{2}.*$)                                                   # or single line comment
+							   )
+						   )*
+						   \s*(?:CONST|TYPE|VAR|LABEL|BEGIN|(?R))\s*                               # declaration block
+						  )
+						 "
+			>
+				<functionName>
+					<nameExpr expr="(?i)(?:(PROCEDURE|FUNCTION)\s+)\K(?:[A-Z_]\w*)(?:\s*\([^()]*\))*" />
+					<!-- comment out the following node to display the routine with its parameters -->
+					<nameExpr expr="(?i)(?:[A-Z_]\w*)(?=\s*|\(|$)" />
+				</functionName>
+			</function>
+		</parser>
+	</functionList>
+</NotepadPlus>
\ No newline at end of file