From 33702f35a48582915e95785d3b203f468f6b282e Mon Sep 17 00:00:00 2001 From: nielsie95 Date: Sat, 13 Mar 2010 16:55:22 +0100 Subject: [PATCH] Added Code Insight source. --- Projects/Code Insight/CastaliaPasLex.pas | 2882 ++++++++ Projects/Code Insight/CastaliaPasLexTypes.pas | 322 + .../Code Insight/CastaliaSimplePasPar.pas | 5955 +++++++++++++++++ .../CastaliaSimplePasParTypes.pas | 330 + Projects/Code Insight/Valistus.ico | Bin 0 -> 137040 bytes Projects/Code Insight/Valistus.lpi | 519 ++ Projects/Code Insight/Valistus.lpr | 21 + Projects/Code Insight/Valistus.res | Bin 0 -> 855 bytes Projects/Code Insight/ValistusDefines.inc | 7 + Projects/Code Insight/main.lfm | 825 +++ Projects/Code Insight/main.pas | 446 ++ Projects/Code Insight/ps dump/Project1.dpr | 14 + Projects/Code Insight/ps dump/Project1.dproj | 108 + Projects/Code Insight/ps dump/Project1.res | Bin 0 -> 5280 bytes Projects/Code Insight/ps dump/Unit1.dfm | 39 + Projects/Code Insight/ps dump/Unit1.pas | 59 + Projects/Code Insight/v_Constants.pas | 18 + Projects/Code Insight/v_MiscFunctions.pas | 145 + Projects/Code Insight/v_autocompleteform.pas | 581 ++ Projects/Code Insight/v_ideCodeInsight.pas | 1259 ++++ Projects/Code Insight/v_ideCodeParser.pas | 1663 +++++ 21 files changed, 15193 insertions(+) create mode 100644 Projects/Code Insight/CastaliaPasLex.pas create mode 100644 Projects/Code Insight/CastaliaPasLexTypes.pas create mode 100644 Projects/Code Insight/CastaliaSimplePasPar.pas create mode 100644 Projects/Code Insight/CastaliaSimplePasParTypes.pas create mode 100644 Projects/Code Insight/Valistus.ico create mode 100644 Projects/Code Insight/Valistus.lpi create mode 100644 Projects/Code Insight/Valistus.lpr create mode 100644 Projects/Code Insight/Valistus.res create mode 100644 Projects/Code Insight/ValistusDefines.inc create mode 100644 Projects/Code Insight/main.lfm create mode 100644 Projects/Code Insight/main.pas create mode 100644 Projects/Code Insight/ps dump/Project1.dpr create mode 100644 Projects/Code Insight/ps dump/Project1.dproj create mode 100644 Projects/Code Insight/ps dump/Project1.res create mode 100644 Projects/Code Insight/ps dump/Unit1.dfm create mode 100644 Projects/Code Insight/ps dump/Unit1.pas create mode 100644 Projects/Code Insight/v_Constants.pas create mode 100644 Projects/Code Insight/v_MiscFunctions.pas create mode 100644 Projects/Code Insight/v_autocompleteform.pas create mode 100644 Projects/Code Insight/v_ideCodeInsight.pas create mode 100644 Projects/Code Insight/v_ideCodeParser.pas diff --git a/Projects/Code Insight/CastaliaPasLex.pas b/Projects/Code Insight/CastaliaPasLex.pas new file mode 100644 index 0000000..b2f345e --- /dev/null +++ b/Projects/Code Insight/CastaliaPasLex.pas @@ -0,0 +1,2882 @@ +{----------------------------------------------------------------------------- +The contents of this file are subject to the Mozilla Public License Version +1.1 (the "License"); you may not use this file except in compliance with the +License. You may obtain a copy of the License at +http://www.mozilla.org/NPL/NPL-1_1Final.html + +Software distributed under the License is distributed on an "AS IS" basis, +WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for +the specific language governing rights and limitations under the License. + +The Original Code is: mwPasLex.PAS, released August 17, 1999. + +The Initial Developer of the Original Code is Martin Waldenburg +(Martin.Waldenburg@T-Online.de). +Portions created by Martin Waldenburg are Copyright (C) 1998, 1999 Martin +Waldenburg. +All Rights Reserved. + +Contributor(s): James Jacobson _____________________________________. + +Last Modified: mm/dd/yyyy +Current Version: 2.2 + +Notes: This program is a very fast Pascal tokenizer. I'd like to invite the +Delphi community to develop it further and to create a fully featured Object +Pascal parser. + +Modification history: + +Daniel Rolf between 20010723 and 20020116 + +Made ready for Delphi 6 + +platform +deprecated +varargs +local + +Known Issues: +-----------------------------------------------------------------------------} + +unit CastaliaPasLex; + +{$include ValistusDefines.inc} +{$IFDEF FPC} + {$mode delphi} +{$ENDIF} + +interface + +uses + //!! pruned uses + SysUtils, Classes, Controls, CastaliaPasLexTypes; + +var + Identifiers: array[#0..#255] of ByteBool; + mHashTable: array[#0..#255] of Integer; + +type + TmwBasePasLex = class; + TDirectiveEvent = procedure(Sender: TmwBasePasLex) of object; + + PDefineRec = ^TDefineRec; + TDefineRec = record + Defined: Boolean; + StartCount: Integer; + Next: PDefineRec; + end; + TDefineRecArray = array of TDefineRec; + + TSaveDefinesRec = record + RecArray: TDefineRecArray; + Stack: Integer; + Defines: string; + end; + + TmwBasePasLex = class(TObject) + private + fCommentState: TCommentState; + fOrigin: PAnsiChar; + fProcTable: array[#0..#255] of procedure of object; + Run: Integer; + RunAhead: Integer; + TempRun: Integer; + fIdentFuncTable: array[0..191] of function: TptTokenKind of object; + fTokenPos: Integer; + fLineNumber: Integer; + FTokenID: TptTokenKind; + fLinePos: Integer; + fExID: TptTokenKind; + FOnMessage: TMessageEvent; + fOnCompDirect: TDirectiveEvent; + fOnElseDirect: TDirectiveEvent; + fOnEndIfDirect: TDirectiveEvent; + fOnIfDefDirect: TDirectiveEvent; + fOnIfNDefDirect: TDirectiveEvent; + fOnResourceDirect: TDirectiveEvent; + fOnIncludeDirect: TDirectiveEvent; + fOnDefineDirect: TDirectiveEvent; + fOnIfOptDirect: TDirectiveEvent; + fOnIfDirect: TDirectiveEvent; + fOnIfEndDirect: TDirectiveEvent; + fOnElseIfDirect: TDirectiveEvent; + fOnUnDefDirect: TDirectiveEvent; + FDirectiveParamOrigin: PAnsiChar; + + fAsmCode : Boolean; // DR 2002-01-14 + + FDefines: TStrings; + FDefineStack: Integer; + FTopDefineRec: PDefineRec; + FUseDefines: Boolean; + + function KeyHash: Integer; + function KeyComp(const aKey: string): Boolean; + function Func9: tptTokenKind; + function Func15: TptTokenKind; + function Func19: TptTokenKind; + function Func20: TptTokenKind; + function Func21: TptTokenKind; + function Func23: TptTokenKind; + function Func25: TptTokenKind; + function Func27: TptTokenKind; + function Func28: TptTokenKind; + function Func29: TptTokenKind; + function Func30: TptTokenKind; + function Func32: TptTokenKind; + function Func33: TptTokenKind; + function Func35: TptTokenKind; + function Func36: TptTokenKind; + function Func37: TptTokenKind; + function Func38: TptTokenKind; + function Func39: TptTokenKind; + function Func40: TptTokenKind; + function Func41: TptTokenKind; + {$IFDEF D8_NEWER} //JThurman 2004-03-2003 + function Func42: TptTokenKind; + {$ENDIF} + function Func43: TptTokenKind; + function Func44: TptTokenKind; + function Func45: TptTokenKind; + function Func46: TptTokenKind; + function Func47: TptTokenKind; + function Func49: TptTokenKind; + function Func52: TptTokenKind; + function Func54: TptTokenKind; + function Func55: TptTokenKind; + function Func56: TptTokenKind; + function Func57: TptTokenKind; + function Func58: TptTokenKind; + function Func59: TptTokenKind; + function Func60: TptTokenKind; + function Func61: TptTokenKind; + function Func62: TptTokenKind; + function Func63: TptTokenKind; + function Func64: TptTokenKind; + function Func65: TptTokenKind; + function Func66: TptTokenKind; + function Func69: TptTokenKind; + function Func71: TptTokenKind; + {$IFDEF D8_NEWER} //JThurman 2004-03-2003 + function Func72: TptTokenKind; + {$ENDIF} + function Func73: TptTokenKind; + function Func75: TptTokenKind; + function Func76: TptTokenKind; + function Func78: TptTokenKind; + function Func79: TptTokenKind; + function Func81: TptTokenKind; + function Func84: TptTokenKind; + function Func85: TptTokenKind; + function Func86: TptTokenKind; + function Func87: TptTokenKind; + function Func88: TptTokenKind; + {$IFDEF D8_NEWER} + function Func89: TptTokenKind; //JThurman 2004-03-03 + {$ENDIF} + function Func91: TptTokenKind; + function Func92: TptTokenKind; + function Func94: TptTokenKind; + function Func95: TptTokenKind; + function Func96: TptTokenKind; + function Func97: TptTokenKind; + function Func98: TptTokenKind; + function Func99: TptTokenKind; + function Func100: TptTokenKind; + function Func101: TptTokenKind; + function Func102: TptTokenKind; + function Func103: TptTokenKind; + function Func104: TptTokenKind; + function Func105: TptTokenKind; + function Func106: TptTokenKind; + function Func107: TptTokenKind; + function Func108: TptTokenKind; + function Func112: TptTokenKind; + function Func117: TptTokenKind; + function Func123: TptTokenKind; + function Func126: TptTokenKind; + function Func127: TptTokenKind; + function Func128: TptTokenKind; + function Func129: TptTokenKind; + function Func130: TptTokenKind; + function Func132: TptTokenKind; + function Func133: TptTokenKind; + function Func136: TptTokenKind; + function Func141: TptTokenKind; + function Func143: TptTokenKind; + function Func166: TptTokenKind; + function Func167: TptTokenKind; + function Func168: TptTokenKind; + function Func191: TptTokenKind; + function AltFunc: TptTokenKind; + procedure InitIdent; + function GetPosXY: TTokenPoint; // !! changed to TokenPoint //jdj 7/18/1999 + function IdentKind: TptTokenKind; + procedure SetRunPos(Value: Integer); + procedure MakeMethodTables; + procedure AddressOpProc; + {$IFDEF D8_NEWER} //JThurman 2004-04-06 + procedure AmpersandOpProc; + {$ENDIF} + procedure AsciiCharProc; + procedure AnsiProc; + procedure BorProc; + procedure BraceCloseProc; + procedure BraceOpenProc; + procedure ColonProc; + procedure CommaProc; + procedure CRProc; + procedure EqualProc; + procedure GreaterProc; + procedure IdentProc; + procedure IntegerProc; + procedure LFProc; + procedure LowerProc; + procedure MinusProc; + procedure NullProc; + procedure NumberProc; + procedure PlusProc; + procedure PointerSymbolProc; + procedure PointProc; + procedure RoundCloseProc; + procedure RoundOpenProc; + procedure SemiColonProc; + procedure SlashProc; + procedure SpaceProc; + procedure SquareCloseProc; + procedure SquareOpenProc; + procedure StarProc; + procedure StringProc; + procedure StringDQProc; + procedure SymbolProc; + procedure UnknownProc; + function GetToken: string; + function GetTokenLen: Integer; + function GetCommentState: Pointer; + function GetCompilerDirective: string; + procedure SetCommentState(const Value: Pointer); + procedure InitLine; + function GetDirectiveKind: TptTokenKind; + function GetDirectiveParam: string; + function GetStringContent: string; + function GetIsJunk: Boolean; + function GetIsSpace: Boolean; + function GetIsOrdIdent: Boolean; + function GetIsRealType: Boolean; + function GetIsStringType: Boolean; + function GetIsVarantType: Boolean; + function GetIsAddOperator: Boolean; + function GetIsMulOperator: Boolean; + function GetIsRelativeOperator: Boolean; + function GetIsCompilerDirective: Boolean; + function GetIsOrdinalType: Boolean; + function GetGenID: TptTokenKind;procedure SetOnElseIfDirect(const Value: TDirectiveEvent); + + function IsDefined(const ADefine: string): Boolean; + procedure EnterDefineBlock(ADefined: Boolean); + procedure ExitDefineBlock; + + procedure DoProcTable(AChar: AnsiChar); + function IsIdentifiers(AChar: AnsiChar): Boolean; + function HashValue(AChar: AnsiChar): Integer; + protected + procedure SetLine(const Value: AnsiString); virtual; + procedure SetOrigin(NewValue: PAnsiChar); virtual; + procedure SetOnCompDirect(const Value: TDirectiveEvent); virtual; + procedure SetOnDefineDirect(const Value: TDirectiveEvent); virtual; + procedure SetOnElseDirect(const Value: TDirectiveEvent); virtual; + procedure SetOnEndIfDirect(const Value: TDirectiveEvent); virtual; + procedure SetOnIfDefDirect(const Value: TDirectiveEvent); virtual; + procedure SetOnIfNDefDirect(const Value: TDirectiveEvent); virtual; + procedure SetOnIfOptDirect(const Value: TDirectiveEvent); virtual; + procedure SetOnIncludeDirect(const Value: TDirectiveEvent); virtual; + procedure SetOnResourceDirect(const Value: TDirectiveEvent); virtual; + procedure SetOnUnDefDirect(const Value: TDirectiveEvent); virtual; + procedure SetOnIfDirect(const Value: TDirectiveEvent); virtual; + procedure SetOnIfEndDirect(const Value: TDirectiveEvent); virtual; + + public + MaxPos: Integer; + + constructor Create; + destructor Destroy; override; + function CharAhead: AnsiChar; + procedure Next; + procedure NextID(ID: TptTokenKind); + procedure NextNoJunk; + procedure NextNoSpace; + procedure Init; + procedure InitFrom(ALexer: TmwBasePasLex); + function FirstInLine: Boolean; + + procedure AddDefine(const ADefine: string); + procedure RemoveDefine(const ADefine: string); + procedure ClearDefines; + procedure InitDefines; + procedure CloneDefinesFrom(ALexer: TmwBasePasLex); + function SaveDefines: TSaveDefinesRec; + procedure LoadDefines(From: TSaveDefinesRec); + + property CommentState: Pointer read GetCommentState write SetCommentState; + property CompilerDirective: string read GetCompilerDirective; + property DirectiveParam: string read GetDirectiveParam; + property IsJunk: Boolean read GetIsJunk; + property IsSpace: Boolean read GetIsSpace; + property Line: AnsiString write SetLine; + //Note: setting the following two properties does not GO to that line, it just sets the internal counters + property LineNumber: Integer read fLineNumber write fLineNumber; + property LinePos: Integer read fLinePos write fLinePos; + property Origin: PAnsiChar read fOrigin write SetOrigin; + property PosXY: TTokenPoint read GetPosXY; // !! changed to TokenPoint //jdj 7/18/1999 + property RunPos: Integer read Run write SetRunPos; + property Token: string read GetToken; + property TokenLen: Integer read GetTokenLen; + property TokenPos: Integer read fTokenPos; + property TokenID: TptTokenKind read FTokenID; + property ExID: TptTokenKind read fExID; + property GenID: TptTokenKind read GetGenID; + property StringContent: string read GetStringContent; + property IsOrdIdent: Boolean read GetIsOrdIdent; + property IsOrdinalType: Boolean read GetIsOrdinalType; + property IsRealType: Boolean read GetIsRealType; + property IsStringType: Boolean read GetIsStringType; + property IsVariantType: Boolean read GetIsVarantType; + property IsRelativeOperator: Boolean read GetIsRelativeOperator; + property IsAddOperator: Boolean read GetIsAddOperator; + property IsMulOperator: Boolean read GetIsMulOperator; + property IsCompilerDirective: Boolean read GetIsCompilerDirective; + property OnMessage: TMessageEvent read FOnMessage write FOnMessage; + property OnCompDirect: TDirectiveEvent read fOnCompDirect write SetOnCompDirect; + property OnDefineDirect: TDirectiveEvent read fOnDefineDirect write SetOnDefineDirect; + property OnElseDirect: TDirectiveEvent read fOnElseDirect write SetOnElseDirect; + property OnEndIfDirect: TDirectiveEvent read fOnEndIfDirect write SetOnEndIfDirect; + property OnIfDefDirect: TDirectiveEvent read fOnIfDefDirect write SetOnIfDefDirect; + property OnIfNDefDirect: TDirectiveEvent read fOnIfNDefDirect write SetOnIfNDefDirect; + property OnIfOptDirect: TDirectiveEvent read fOnIfOptDirect write SetOnIfOptDirect; + property OnIncludeDirect: TDirectiveEvent read fOnIncludeDirect write SetOnIncludeDirect; + property OnIfDirect: TDirectiveEvent read fOnIfDirect write SetOnIfDirect; + property OnIfEndDirect: TDirectiveEvent read fOnIfEndDirect write + SetOnIfEndDirect; + property OnElseIfDirect: TDirectiveEvent read fOnElseIfDirect write + SetOnElseIfDirect; + property OnResourceDirect: TDirectiveEvent read fOnResourceDirect write SetOnResourceDirect; + property OnUnDefDirect: TDirectiveEvent read fOnUnDefDirect write SetOnUnDefDirect; + + property AsmCode : Boolean read fAsmCode write fAsmCode; // DR 2002-01-14 + property DirectiveParamOrigin: PAnsiChar read FDirectiveParamOrigin; + + property UseDefines: Boolean read FUseDefines write FUseDefines; + + property Defines: TStrings read FDefines; + end; + + TmwPasLex = class(TmwBasePasLex) + private + fAheadLex: TmwBasePasLex; + function GetAheadExID: TptTokenKind; + function GetAheadGenID: TptTokenKind; + function GetAheadToken: string; + function GetAheadTokenID: TptTokenKind; + function GetStatus: TmwPasLexStatus; + procedure SetStatus(const Value: TmwPasLexStatus); + protected + procedure SetLine(const Value: AnsiString); override; + procedure SetOrigin(NewValue: PAnsiChar); override; + procedure SetOnCompDirect(const Value: TDirectiveEvent); override; + procedure SetOnDefineDirect(const Value: TDirectiveEvent); override; + procedure SetOnElseDirect(const Value: TDirectiveEvent); override; + procedure SetOnEndIfDirect(const Value: TDirectiveEvent); override; + procedure SetOnIfDefDirect(const Value: TDirectiveEvent); override; + procedure SetOnIfNDefDirect(const Value: TDirectiveEvent); override; + procedure SetOnIfOptDirect(const Value: TDirectiveEvent); override; + procedure SetOnIncludeDirect(const Value: TDirectiveEvent); override; + procedure SetOnResourceDirect(const Value: TDirectiveEvent); override; + procedure SetOnUnDefDirect(const Value: TDirectiveEvent); override; + public + constructor Create; + destructor Destroy; override; + procedure InitAhead; + procedure AheadNext; + property AheadLex: TmwBasePasLex read fAheadLex; + property AheadToken: string read GetAheadToken; + property AheadTokenID: TptTokenKind read GetAheadTokenID; + property AheadExID: TptTokenKind read GetAheadExID; + property AheadGenID: TptTokenKind read GetAheadGenID; + property Status: TmwPasLexStatus read GetStatus write SetStatus; + end; + +implementation + +{$IFNDEF LCL} +uses Windows; +{$ENDIF} + +procedure MakeIdentTable; +var + I, J: AnsiChar; +begin + for I := #0 to #255 do + begin + case I of + '_', '0'..'9', 'a'..'z', 'A'..'Z': Identifiers[I] := True; + else Identifiers[I] := False; + end; + J := AnsiString(UpCase(I))[1]; + case I of + 'a'..'z', 'A'..'Z', '_': mHashTable[I] := Ord(J) - 64; + '0'..'9': mHashTable[I] := Ord(J) - 47; + else mHashTable[Char(I)] := 0; + end; + end; +end; + +function TmwBasePasLex.CharAhead: AnsiChar; +begin + RunAhead := Run; +// while fOrigin[RunAhead] in [#1..#32] do + while (fOrigin[RunAhead] > #0) and (fOrigin[RunAhead] < #33) do + + inc(RunAhead); + Result := fOrigin[RunAhead]; +end; + +procedure TmwBasePasLex.ClearDefines; +var + Frame: PDefineRec; +begin + while FTopDefineRec <> nil do + begin + Frame := FTopDefineRec; + FTopDefineRec := Frame^.Next; + Dispose(Frame); + end; + FDefines.Clear; + FDefineStack := 0; + FTopDefineRec := nil; +end; + +procedure TmwBasePasLex.CloneDefinesFrom(ALexer: TmwBasePasLex); +var + Frame, LastFrame, SourceFrame: PDefineRec; +begin + ClearDefines; + FDefines.Assign(ALexer.FDefines); + FDefineStack := ALexer.FDefineStack; + + Frame := nil; + LastFrame := nil; + SourceFrame := ALexer.FTopDefineRec; + while SourceFrame <> nil do + begin + New(Frame); + if FTopDefineRec = nil then + FTopDefineRec := Frame + else + LastFrame^.Next := Frame; + Frame^.Defined := SourceFrame^.Defined; + Frame^.StartCount := SourceFrame^.StartCount; + LastFrame := Frame; + + SourceFrame := SourceFrame^.Next; + end; + if Frame <> nil then + Frame^.Next := nil; +end; + +function TmwBasePasLex.SaveDefines: TSaveDefinesRec; +var + Frame: PDefineRec; +begin + Result.Defines := FDefines.CommaText; + Result.Stack := FDefineStack; + + Frame := FTopDefineRec; + while (Frame <> nil) do + begin + SetLength(Result.RecArray, Length(Result.RecArray) + 1); + Result.RecArray[High(Result.RecArray)] := Frame^; + Result.RecArray[High(Result.RecArray)].Next := nil; + Frame := Frame^.Next; + end; +end; + +procedure TmwBasePasLex.LoadDefines(From: TSaveDefinesRec); +var + Frame, LastFrame: PDefineRec; + i: Integer; +begin + ClearDefines; + FDefines.CommaText := From.Defines; + FDefineStack := From.Stack; + + Frame := nil; + LastFrame := nil; + for i := 0 to High(From.RecArray) do + begin + New(Frame); + if (i = 0) then + FTopDefineRec := Frame + else + LastFrame^.Next := Frame; + + Frame^ := From.RecArray[i]; + LastFrame := Frame; + end; + + if (Frame <> nil) then + Frame^.Next := nil; +end; + +function TmwBasePasLex.GetPosXY: TTokenPoint; +begin //jdj 7/18/1999 + // !! changed setting code + Result.X:= FTokenPos - FLinePos; + Result.Y:= FLineNumber; +end; + +procedure TmwBasePasLex.InitIdent; +var + I: Integer; +begin + for I := 0 to 191 do + case I of + {$IFDEF D8_NEWER} + 9: fIdentFuncTable[I] := Func9; + {$ENDIF} + 15: fIdentFuncTable[I] := Func15; + 19: fIdentFuncTable[I] := Func19; + 20: fIdentFuncTable[I] := Func20; + 21: fIdentFuncTable[I] := Func21; + 23: fIdentFuncTable[I] := Func23; + 25: fIdentFuncTable[I] := Func25; + 27: fIdentFuncTable[I] := Func27; + 28: fIdentFuncTable[I] := Func28; + 29: fIdentFuncTable[I] := Func29; + 30: fIdentFuncTable[I] := Func30; + 32: fIdentFuncTable[I] := Func32; + 33: fIdentFuncTable[I] := Func33; + 35: fIdentFuncTable[I] := Func35; + 36: fIdentFuncTable[I] := Func36; + 37: fIdentFuncTable[I] := Func37; + 38: fIdentFuncTable[I] := Func38; + 39: fIdentFuncTable[I] := Func39; + 40: fIdentFuncTable[I] := Func40; + 41: fIdentFuncTable[I] := Func41; + {$IFDEF D8_NEWER} //JThurman 2004-03-2003 + 42: fIdentFuncTable[I] := Func42; + {$ENDIF} + 43: fIdentFuncTable[I] := Func43; + 44: fIdentFuncTable[I] := Func44; + 45: fIdentFuncTable[I] := Func45; + 46: fIdentFuncTable[I] := Func46; + 47: fIdentFuncTable[I] := Func47; + 49: fIdentFuncTable[I] := Func49; + 52: fIdentFuncTable[I] := Func52; + 54: fIdentFuncTable[I] := Func54; + 55: fIdentFuncTable[I] := Func55; + 56: fIdentFuncTable[I] := Func56; + 57: fIdentFuncTable[I] := Func57; + 58: fIdentFuncTable[I] := Func58; + 59: fIdentFuncTable[I] := Func59; + 60: fIdentFuncTable[I] := Func60; + 61: fIdentFuncTable[I] := Func61; + 62: fIdentFuncTable[I] := Func62; + 63: fIdentFuncTable[I] := Func63; + 64: fIdentFuncTable[I] := Func64; + 65: fIdentFuncTable[I] := Func65; + 66: fIdentFuncTable[I] := Func66; + 69: fIdentFuncTable[I] := Func69; + 71: fIdentFuncTable[I] := Func71; + {$IFDEF D8_NEWER} //JThurman 2004-03-2003 + 72: fIdentFuncTable[I] := Func72; + {$ENDIF} + 73: fIdentFuncTable[I] := Func73; + 75: fIdentFuncTable[I] := Func75; + 76: fIdentFuncTable[I] := Func76; + 78: fIdentFuncTable[I] := Func78; + 79: fIdentFuncTable[I] := Func79; + 81: fIdentFuncTable[I] := Func81; + 84: fIdentFuncTable[I] := Func84; + 85: fIdentFuncTable[I] := Func85; + 86: fIdentFuncTable[I] := Func86; + 87: fIdentFuncTable[I] := Func87; + 88: fIdentFuncTable[I] := Func88; + {$IFDEF D8_NEWER} //JThurman 2004-03-03 + 89: fIdentFuncTable[I] := Func89; + {$ENDIF} + 91: fIdentFuncTable[I] := Func91; + 92: fIdentFuncTable[I] := Func92; + 94: fIdentFuncTable[I] := Func94; + 95: fIdentFuncTable[I] := Func95; + 96: fIdentFuncTable[I] := Func96; + 97: fIdentFuncTable[I] := Func97; + 98: fIdentFuncTable[I] := Func98; + 99: fIdentFuncTable[I] := Func99; + 100: fIdentFuncTable[I] := Func100; + 101: fIdentFuncTable[I] := Func101; + 102: fIdentFuncTable[I] := Func102; + 103: fIdentFuncTable[I] := Func103; + 104: fIdentFuncTable[I] := Func104; + 105: fIdentFuncTable[I] := Func105; + 106: fIdentFuncTable[I] := Func106; + 107: fIdentFuncTable[I] := Func107; + 108: fIdentFuncTable[I] := Func108; + 112: fIdentFuncTable[I] := Func112; + 117: fIdentFuncTable[I] := Func117; + 123: fIdentFuncTable[I] := Func123; + 126: fIdentFuncTable[I] := Func126; + 127: fIdentFuncTable[I] := Func127; + 128: fIdentFuncTable[I] := Func128; + 129: fIdentFuncTable[I] := Func129; + 130: fIdentFuncTable[I] := Func130; + 132: fIdentFuncTable[I] := Func132; + 133: fIdentFuncTable[I] := Func133; + 136: fIdentFuncTable[I] := Func136; + 141: fIdentFuncTable[I] := Func141; + 143: fIdentFuncTable[I] := Func143; + 166: fIdentFuncTable[I] := Func166; + 167: fIdentFuncTable[I] := Func167; + 168: fIdentFuncTable[I] := Func168; + 191: fIdentFuncTable[I] := Func191; + else fIdentFuncTable[I] := AltFunc; + end; +end; + +function TmwBasePasLex.KeyHash: Integer; +begin + Result := 0; + while IsIdentifiers(fOrigin[Run]) do + begin + Inc(Result, HashValue(fOrigin[Run])); + //inc(Result, mHashTable[fOrigin[Run]]); + inc(Run); + end; +end; { KeyHash } + +function TmwBasePasLex.KeyComp(const aKey: string): Boolean; +var + I: Integer; + Temp: PAnsiChar; +begin + if Length(aKey) = TokenLen then + begin + Temp := fOrigin + fTokenPos; + Result := True; + for i := 1 to TokenLen do + begin + if mHashTable[Temp^] <> mHashTable[aKey[i]] then + begin + Result := False; + break; + end; + inc(Temp); + end; + end + else Result := False; +end; { KeyComp } + +function TmwBasePasLex.Func9: tptTokenKind; +begin + Result := tokIdentifier; + if KeyComp('Add') then + FExID := tokAdd; +end; + +function TmwBasePasLex.Func15: TptTokenKind; +begin + Result := tokIdentifier; + if KeyComp('If') then Result := tokIf; +end; + +function TmwBasePasLex.Func19: TptTokenKind; +begin + Result := tokIdentifier; + if KeyComp('Do') then Result := tokDo else + if KeyComp('And') then Result := tokAnd; +end; + +function TmwBasePasLex.Func20: TptTokenKind; +begin + Result := tokIdentifier; + if KeyComp('As') then Result := tokAs; +end; + +function TmwBasePasLex.Func21: TptTokenKind; +begin + Result := tokIdentifier; + if KeyComp('Of') then Result := tokOf else + if KeyComp('At') then fExID := tokAt; +end; + +function TmwBasePasLex.Func23: TptTokenKind; +begin + Result := tokIdentifier; + if KeyComp('End') then Result := tokEnd else + if KeyComp('In') then Result := tokIn; +end; + +function TmwBasePasLex.Func25: TptTokenKind; +begin + Result := tokIdentifier; + if KeyComp('Far') then fExID := tokFar; +end; + +function TmwBasePasLex.Func27: TptTokenKind; +begin + Result := tokIdentifier; + if KeyComp('Cdecl') then fExID := tokCdecl; +end; + +function TmwBasePasLex.Func28: TptTokenKind; +begin + Result := tokIdentifier; + if KeyComp('Read') then fExID := tokRead else + if KeyComp('Case') then Result := tokCase else + if KeyComp('Is') then Result := tokIs; +end; + +function TmwBasePasLex.Func29: TptTokenKind; +begin + Result := tokIdentifier; + if KeyComp('On') then fExID := tokOn; +end; + +function TmwBasePasLex.Func30: TptTokenKind; +begin + Result := tokIdentifier; + if KeyComp('Char') then fExID := tokChar; +end; + +function TmwBasePasLex.Func32: TptTokenKind; +begin + Result := tokIdentifier; + if KeyComp('File') then Result := tokFile else + if KeyComp('Label') then Result := tokLabel else + if KeyComp('Mod') then Result := tokMod; +end; + +function TmwBasePasLex.Func33: TptTokenKind; +begin + Result := tokIdentifier; + if KeyComp('Or') then Result := tokOr else + if KeyComp('Name') then fExID := tokName else + if KeyComp('Asm') then Result := tokAsm; +end; + +function TmwBasePasLex.Func35: TptTokenKind; +begin + Result := tokIdentifier; + if KeyComp('Nil') then Result := tokNil else + if KeyComp('To') then Result := tokTo else + if KeyComp('Div') then Result := tokDiv; +end; + +function TmwBasePasLex.Func36: TptTokenKind; +begin + Result := tokIdentifier; + if KeyComp('Real') then fExID := tokReal else + if KeyComp('Real48') then fExID := tokReal48; +end; + +function TmwBasePasLex.Func37: TptTokenKind; +begin + Result := tokIdentifier; + if KeyComp('Begin') then Result := tokBegin else + if KeyComp('Break') then fExID := tokBreak; +end; + +function TmwBasePasLex.Func38: TptTokenKind; +begin + Result := tokIdentifier; + if KeyComp('Near') then fExID := tokNear; +end; + +function TmwBasePasLex.Func39: TptTokenKind; +begin + Result := tokIdentifier; + if KeyComp('For') then Result := tokFor else + if KeyComp('Shl') then Result := tokShl; +end; + +function TmwBasePasLex.Func40: TptTokenKind; +begin + Result := tokIdentifier; + if KeyComp('Packed') then Result := tokPacked; +end; + +function TmwBasePasLex.Func41: TptTokenKind; +begin + Result := tokIdentifier; + if KeyComp('Var') then Result := tokVar else + if KeyComp('Else') then Result := tokElse else + if KeyComp('Halt') then fExID := tokHalt; +end; + +{$IFDEF D8_NEWER} //JThurman 2004-03-2003 +function TmwBasePasLex.Func42: TptTokenKind; +begin + Result := tokIdentifier; + if KeyComp('Final') then + fExID := tokFinal; //TODO: Is this supposed to be an ExID? +end; +{$ENDIF} + +function TmwBasePasLex.Func43: TptTokenKind; +begin + Result := tokIdentifier; + if KeyComp('Int64') then fExID := tokInt64 + else if KeyComp('local') then fExID := tokLocal; +end; + +function TmwBasePasLex.Func44: TptTokenKind; +begin + Result := tokIdentifier; + if KeyComp('Set') then Result := tokSet else + if KeyComp('Package') then fExID := tokPackage; +end; + +function TmwBasePasLex.Func45: TptTokenKind; +begin + Result := tokIdentifier; + if KeyComp('Shr') then Result := tokShr; +end; + +function TmwBasePasLex.Func46: TptTokenKind; +begin + Result := tokIdentifier; + if KeyComp('PChar') then fExId := tokPChar + {$IFDEF D8_NEWER} //JThurman 2004-03-19 + else + if KeyComp('Sealed') then Result := tokSealed; + {$ELSE} + ; + {$ENDIF} +end; + +function TmwBasePasLex.Func47: TptTokenKind; +begin + Result := tokIdentifier; + if KeyComp('Then') then Result := tokThen else + if KeyComp('Comp') then fExID := tokComp; +end; + +function TmwBasePasLex.Func49: TptTokenKind; +begin + Result := tokIdentifier; + if KeyComp('Not') then Result := tokNot; +end; + +function TmwBasePasLex.Func52: TptTokenKind; +begin + Result := tokIdentifier; + if KeyComp('Byte') then fExID := tokByte else + if KeyComp('Raise') then Result := tokRaise else + if KeyComp('Pascal') then fExID := tokPascal; +end; + +function TmwBasePasLex.Func54: TptTokenKind; +begin + Result := tokIdentifier; + if KeyComp('Class') then Result := tokClass; +end; + +function TmwBasePasLex.Func55: TptTokenKind; +begin + Result := tokIdentifier; + if KeyComp('Object') then Result := tokObject; +end; + +function TmwBasePasLex.Func56: TptTokenKind; +begin + Result := tokIdentifier; + if KeyComp('Index') then fExID := tokIndex else + if KeyComp('Out') then fExID := tokOut else // bug in Delphi's documentation: OUT is a directive + if KeyComp('Abort') then fExID := tokAbort; +end; + +function TmwBasePasLex.Func57: TptTokenKind; +begin + Result := tokIdentifier; + if KeyComp('While') then Result := tokWhile else + if KeyComp('Xor') then Result := tokXor else + if KeyComp('Goto') then Result := tokGoto; +end; + +function TmwBasePasLex.Func58: TptTokenKind; +begin + Result := tokIdentifier; + if KeyComp('Exit') then fExID := tokExit; +end; + +function TmwBasePasLex.Func59: TptTokenKind; +begin + Result := tokIdentifier; + if KeyComp('Safecall') then fExID := tokSafecall else + if KeyComp('Double') then fExID := tokDouble; +end; + +function TmwBasePasLex.Func60: TptTokenKind; +begin + Result := tokIdentifier; + if KeyComp('With') then Result := tokWith else + if KeyComp('Word') then fExID := tokWord; +end; + +function TmwBasePasLex.Func61: TptTokenKind; +begin + Result := tokIdentifier; + if KeyComp('Dispid') then fExID := tokDispid; +end; + +function TmwBasePasLex.Func62: TptTokenKind; +begin + Result := tokIdentifier; + if KeyComp('Cardinal') then fExID := tokCardinal; +end; + +function TmwBasePasLex.Func63: TptTokenKind; +begin + Result := tokIdentifier; + case fOrigin[fTokenPos] of + 'P', 'p': if KeyComp('Public') then fExID := tokPublic; + 'A', 'a': if KeyComp('Array') then Result := tokArray; + 'T', 't': if KeyComp('Try') then Result := tokTry; + 'R', 'r': if KeyComp('Record') then Result := tokRecord; + 'I', 'i': if KeyComp('Inline') then + begin + Result := tokInline; + fExID := tokInline; + end; + end; +end; + +function TmwBasePasLex.Func64: TptTokenKind; +begin + Result := tokIdentifier; + case fOrigin[fTokenPos] of + 'B', 'b': if KeyComp('Boolean') then fExID := tokBoolean; + 'D', 'd': if KeyComp('DWORD') then fExID := tokDWORD; + 'U', 'u': if KeyComp('Uses') then Result := tokUses + else + if KeyComp('Unit') then Result := tokUnit; + {$IFDEF D8_NEWER} + 'H', 'h': if KeyComp('Helper') then fExID := tokHelper; + {$ENDIF} + end; +end; + +function TmwBasePasLex.Func65: TptTokenKind; +begin + Result := tokIdentifier; + if KeyComp('Repeat') then Result := tokRepeat; +end; + +function TmwBasePasLex.Func66: TptTokenKind; +begin + Result := tokIdentifier; + if KeyComp('Single') then fExID := tokSingle else + if KeyComp('Type') then Result := tokType + {$IFDEF D8_NEWER}//JThurman 2004-03-23 + else + if KeyComp('Unsafe') then Result := tokUnsafe + {$ENDIF} + ; +end; + +function TmwBasePasLex.Func69: TptTokenKind; +begin + Result := tokIdentifier; + if KeyComp('Default') then fExID := tokDefault else + if KeyComp('Dynamic') then fExID := tokDynamic else + if KeyComp('Message') then fExID := tokMessage; +end; + +function TmwBasePasLex.Func71: TptTokenKind; +begin + Result := tokIdentifier; + if KeyComp('WideChar') then fExID := tokWideChar else + if KeyComp('Stdcall') then fExID := tokStdcall else + if KeyComp('Const') then Result := tokConst; +end; + +{$IFDEF D8_NEWER} //JThurman 2004-03-2003 +function TmwBasePasLex.Func72: TptTokenKind; +begin + Result := tokIdentifier; + if KeyComp('Static') then + fExID := tokStatic; +end; +{$ENDIF} + +function TmwBasePasLex.Func73: TptTokenKind; +begin + Result := tokIdentifier; + if KeyComp('Except') then Result := tokExcept; +end; + +function TmwBasePasLex.Func75: TptTokenKind; +begin + Result := tokIdentifier; + if KeyComp('Write') then fExID := tokWrite; +end; + +function TmwBasePasLex.Func76: TptTokenKind; +begin + Result := tokIdentifier; + if KeyComp('Until') then Result := tokUntil; +end; + +function TmwBasePasLex.Func78: TptTokenKind; +begin + Result := tokIdentifier; + if KeyComp('Integer') then fExID := tokInteger + {$IFDEF D8_NEWER} + else if KeyComp('Remove') then + FExID := tokRemove + {$ENDIF} + ; +end; + +function TmwBasePasLex.Func79: TptTokenKind; +begin + Result := tokIdentifier; + if KeyComp('Finally') then Result := tokFinally + {$IFDEF D12_NEWER} + else if KeyComp('Reference') then fExID := tokReference; + {$ENDIF} + +end; + +function TmwBasePasLex.Func81: TptTokenKind; +begin + Result := tokIdentifier; + if KeyComp('Extended') then fExID := tokExtended else + if KeyComp('Stored') then fExID := tokStored else + if KeyComp('Interface') then Result := tokInterface + else if KeyComp('Deprecated') then fExID := tokDeprecated; // DR 2001-10-20 +end; + +function TmwBasePasLex.Func84: TptTokenKind; +begin + Result := tokIdentifier; + if KeyComp('Abstract') then fExID := tokAbstract; +end; + +function TmwBasePasLex.Func85: TptTokenKind; +begin + Result := tokIdentifier; + if KeyComp('Library') then Result := tokLibrary else + if KeyComp('Forward') then fExID := tokForward else + if KeyComp('Variant') then fExID := tokVariant; +end; + +function TmwBasePasLex.Func87: TptTokenKind; +begin + Result := tokIdentifier; + if KeyComp('String') then Result := tokString; +end; + +function TmwBasePasLex.Func88: TptTokenKind; +begin + Result := tokIdentifier; + if KeyComp('Program') then Result := tokProgram; +end; + +{$IFDEF D8_NEWER} //JThurman 2004-03-03 +function TmwBasePasLex.Func89: TptTokenKind; +begin + Result := tokIdentifier; + if KeyComp('Strict') then Result := tokStrict; +end; +{$ENDIF} + +function TmwBasePasLex.Func91: TptTokenKind; +begin + Result := tokIdentifier; + if KeyComp('Downto') then Result := tokDownto else + if KeyComp('Private') then fExID := tokPrivate else + if KeyComp('Longint') then fExID := tokLongint; +end; + +function TmwBasePasLex.Func92: TptTokenKind; +begin + Result := tokIdentifier; + if KeyComp('Inherited') then Result := tokInherited else + if KeyComp('LongBool') then fExID := tokLongBool else + if KeyComp('Overload') then fExID := tokOverload; +end; + +function TmwBasePasLex.Func94: TptTokenKind; +begin + Result := tokIdentifier; + if KeyComp('Resident') then fExID := tokResident else + if KeyComp('Readonly') then fExID := tokReadonly else + if KeyComp('Assembler') then fExID := tokAssembler; +end; + +function TmwBasePasLex.Func95: TptTokenKind; +begin + Result := tokIdentifier; + if KeyComp('Contains') then fExID := tokContains else + if KeyComp('Absolute') then fExID := tokAbsolute; +end; + +function TmwBasePasLex.Func96: TptTokenKind; +begin + Result := tokIdentifier; + if KeyComp('ByteBool') then fExID := tokByteBool else + if KeyComp('Override') then fExID := tokOverride else + if KeyComp('Published') then fExID := tokPublished; +end; + +function TmwBasePasLex.Func97: TptTokenKind; +begin + Result := tokIdentifier; + if KeyComp('Threadvar') then Result := tokThreadvar; +end; + +function TmwBasePasLex.Func98: TptTokenKind; +begin + Result := tokIdentifier; + if KeyComp('Export') then fExID := tokExport else + if KeyComp('Nodefault') then fExID := tokNodefault; +end; + +function TmwBasePasLex.Func99: TptTokenKind; +begin + Result := tokIdentifier; + if KeyComp('External') then fExID := tokExternal; +end; + +function TmwBasePasLex.Func100: TptTokenKind; +begin + Result := tokIdentifier; + if KeyComp('Automated') then fExID := tokAutomated else + if KeyComp('Smallint') then fExID := tokSmallint; +end; + +function TmwBasePasLex.Func101: TptTokenKind; +begin + Result := tokIdentifier; + if KeyComp('Register') then fExID := tokRegister + else if KeyComp('Platform') then fExID := tokPlatform // DR 2001-10-20 + else if KeyComp('Continue') then fExID := tokContinue; +end; + +function TmwBasePasLex.Func102: TptTokenKind; +begin + Result := tokIdentifier; + if KeyComp('Function') then Result := tokFunction; +end; + +function TmwBasePasLex.Func103: TptTokenKind; +begin + Result := tokIdentifier; + if KeyComp('Virtual') then fExID := tokVirtual; +end; + +function TmwBasePasLex.Func104: TptTokenKind; +begin + Result := tokIdentifier; + if KeyComp('WordBool') then fExID := tokWordBool; +end; + +function TmwBasePasLex.Func105: TptTokenKind; +begin + Result := tokIdentifier; + if KeyComp('Procedure') then Result := tokProcedure; +end; + +function TmwBasePasLex.Func106: TptTokenKind; +begin + Result := tokIdentifier; + if KeyComp('Protected') then fExID := tokProtected; +end; + +function TmwBasePasLex.Func107: TptTokenKind; +begin + Result := tokIdentifier; + if KeyComp('Currency') then fExID := tokCurrency; +end; + +function TmwBasePasLex.Func108: TptTokenKind; +begin + Result := tokIdentifier; + if KeyComp('Longword') then fExID := tokLongword; + {$IFDEF D8_NEWER} //JThurman 2004-03-20 + if KeyComp('Operator') then fExID := tokOperator; + {$ENDIF} +end; + +function TmwBasePasLex.Func112: TptTokenKind; +begin + Result := tokIdentifier; + if KeyComp('Requires') then fExID := tokRequires; +end; + +function TmwBasePasLex.Func117: TptTokenKind; +begin + Result := tokIdentifier; + if KeyComp('Exports') then Result := tokExports else + if KeyComp('OleVariant') then fExID := tokOleVariant; +end; + +function TmwBasePasLex.Func123: TptTokenKind; +begin + Result := tokIdentifier; + if KeyComp('Shortint') then fExID := tokShortint; +end; + +function TmwBasePasLex.Func126: TptTokenKind; +begin + Result := tokIdentifier; + if KeyComp('Implements') then fExID := tokImplements; +end; + +function TmwBasePasLex.Func127: TptTokenKind; +begin + Result := tokIdentifier; + if KeyComp('Runerror') then fExID := tokRunError; +end; + +function TmwBasePasLex.Func128: TptTokenKind; +begin + if KeyComp('WideString') then fExID := tokWideString; + Result := tokIdentifier; +end; + +function TmwBasePasLex.Func129: TptTokenKind; +begin + Result := tokIdentifier; + if KeyComp('Dispinterface') then Result := tokDispinterface +end; + +function TmwBasePasLex.Func130: TptTokenKind; +begin + Result := tokIdentifier; + if KeyComp('AnsiString') then fExID := tokAnsiString; +end; + +function TmwBasePasLex.Func132: TptTokenKind; +begin + Result := tokIdentifier; + if KeyComp('Reintroduce') then fExID := tokReintroduce; +end; + +function TmwBasePasLex.Func133: TptTokenKind; +begin + Result := tokIdentifier; + if KeyComp('Property') then Result := tokProperty; +end; + +function TmwBasePasLex.Func136: TptTokenKind; +begin + Result := tokIdentifier; + if KeyComp('Finalization') then Result := tokFinalization; +end; + +function TmwBasePasLex.Func141: TptTokenKind; +begin + Result := tokIdentifier; + if KeyComp('Writeonly') then fExID := tokWriteonly; +end; + +function TmwBasePasLex.Func143: TptTokenKind; +begin + Result := tokIdentifier; + if KeyComp('Destructor') then Result := tokDestructor; +end; + +function TmwBasePasLex.Func166: TptTokenKind; +begin + Result := tokIdentifier; + if KeyComp('Constructor') then Result := tokConstructor else + if KeyComp('Implementation') then Result := tokImplementation; +end; + +function TmwBasePasLex.Func167: TptTokenKind; +begin + Result := tokIdentifier; + if KeyComp('ShortString') then fExID := tokShortString; +end; + +function TmwBasePasLex.Func168: TptTokenKind; +begin + Result := tokIdentifier; + if KeyComp('Initialization') then Result := tokInitialization; +end; + +function TmwBasePasLex.Func191: TptTokenKind; +begin + Result := tokIdentifier; + if KeyComp('Resourcestring') then Result := tokResourcestring else + if KeyComp('Stringresource') then fExID := tokStringresource; +end; + +function TmwBasePasLex.AltFunc: TptTokenKind; +begin + Result := tokIdentifier; +end; + +function TmwBasePasLex.IdentKind: TptTokenKind; +var + HashKey: Integer; +begin + HashKey := KeyHash; + if HashKey < 192 then + Result := fIdentFuncTable[HashKey] + else Result := tokIdentifier; +end; + +procedure TmwBasePasLex.MakeMethodTables; +var + I: Char; +begin + for I := #0 to #255 do + case I of + #0: fProcTable[I] := NullProc; + #10: fProcTable[I] := LFProc; + #13: fProcTable[I] := CRProc; + #1..#9, #11, #12, #14..#32: + fProcTable[I] := SpaceProc; + '#': fProcTable[I] := AsciiCharProc; + '$': fProcTable[I] := IntegerProc; + #39: fProcTable[I] := StringProc; + '0'..'9': fProcTable[I] := NumberProc; + 'A'..'Z', 'a'..'z', '_': + fProcTable[I] := IdentProc; + '{': fProcTable[I] := BraceOpenProc; + '}': fProcTable[I] := BraceCloseProc; + '!', '"', '%', '&', '('..'/', ':'..'@', '['..'^', '`', '~': + begin + case I of + '(': fProcTable[I] := RoundOpenProc; + ')': fProcTable[I] := RoundCloseProc; + '*': fProcTable[I] := StarProc; + '+': fProcTable[I] := PlusProc; + ',': fProcTable[I] := CommaProc; + '-': fProcTable[I] := MinusProc; + '.': fProcTable[I] := PointProc; + '/': fProcTable[I] := SlashProc; + ':': fProcTable[I] := ColonProc; + ';': fProcTable[I] := SemiColonProc; + '<': fProcTable[I] := LowerProc; + '=': fProcTable[I] := EqualProc; + '>': fProcTable[I] := GreaterProc; + '@': fProcTable[I] := AddressOpProc; + '[': fProcTable[I] := SquareOpenProc; + ']': fProcTable[I] := SquareCloseProc; + '^': fProcTable[I] := PointerSymbolProc; + '"': fProcTable[I] := StringDQProc; // DR 2002-01-14 + {$IFDEF D8_NEWER} //JThurman 2004-04-06 + '&': fProcTable[I] := AmpersandOpProc; + {$ENDIF} + else fProcTable[I] := SymbolProc; + end; + end; + else fProcTable[I] := UnknownProc; + end; +end; + +constructor TmwBasePasLex.Create; +begin + inherited Create; + fOrigin := nil; + InitIdent; + MakeMethodTables; + fExID := tokUnKnown; + + FUseDefines := True; + FDefines := TStringList.Create; + FTopDefineRec := nil; + InitDefines; + + MaxPos := -1; +end; { Create } + +destructor TmwBasePasLex.Destroy; +begin + ClearDefines; //If we don't do this, we get a memory leak + FDefines.Free; + fOrigin := nil; + inherited Destroy; +end; + +procedure TmwBasePasLex.DoProcTable(AChar: AnsiChar); +begin + if AChar <= #255 then + fProcTable[AChar] + else + begin + IdentProc; + end; +end; + +{ Destroy } + +procedure TmwBasePasLex.SetOrigin(NewValue: PAnsiChar); +begin + fOrigin := NewValue; + Init; + Next; +end; { SetOrigin } + +procedure TmwBasePasLex.SetRunPos(Value: Integer); +begin + Run := Value; + Next; +end; + +procedure TmwBasePasLex.AddDefine(const ADefine: string); +begin + if (FDefines.IndexOf(ADefine) < 0) then + FDefines.Add(ADefine); +end; + +procedure TmwBasePasLex.AddressOpProc; +begin + case FOrigin[Run + 1] of + '@': + begin + fTokenID := tokDoubleAddressOp; + inc(Run, 2); + end; + else + begin + fTokenID := tokAddressOp; + inc(Run); + end; + end; +end; + +procedure TmwBasePasLex.AsciiCharProc; +begin + fTokenID := tokAsciiChar; + inc(Run); + if FOrigin[Run] = '$' then + begin + inc(Run); + while FOrigin[Run] in ['0'..'9', 'A'..'F', 'a'..'f'] do inc(Run); + end else + begin + while FOrigin[Run] in ['0'..'9'] do + inc(Run); + end; +end; + +procedure TmwBasePasLex.BraceCloseProc; +begin + inc(Run); + fTokenId := tokError; + if Assigned(FOnMessage) then + FOnMessage(Self, meError, 'Illegal character', PosXY.X, PosXY.Y); +end; + +procedure TmwBasePasLex.BorProc; +begin + fTokenID := tokBorComment; + case FOrigin[Run] of + #0: + begin + NullProc; + if Assigned(FOnMessage) then + FOnMessage(Self, meError, 'Unexpected file end', PosXY.X, PosXY.Y); + exit; + end; +{ DR 2001-08-02 + + #10: + begin + LFProc; + exit; + end; + + #13: + begin + CRProc; + exit; + end; +} + end; + + while FOrigin[Run] <> #0 do + case FOrigin[Run] of + '}': + begin + fCommentState := csNo; + inc(Run); + break; + end; +{ DR 2001-08-02 + #10: break; + + #13: break; +} + #10: + begin + inc(Run); + inc(fLineNumber); + fLinePos := Run; + end; + #13: + begin + inc(Run); + if FOrigin[Run] = #10 then inc( Run ); + inc(fLineNumber); + fLinePos := Run; + end; + else inc(Run); + end; +end; + +procedure TmwBasePasLex.BraceOpenProc; +var + Param, Def: string; + tmpRun: Integer; +begin + case FOrigin[Run + 1] of + '$': fTokenID := GetDirectiveKind; + '.': + begin + tmpRun := fTokenPos; + Run := fTokenPos + 2; + FDirectiveParamOrigin := FOrigin + FTokenPos; + FTokenPos := Run; + case KeyHash of + 68: if KeyComp('INCLUDE') then + fTokenID := tokIncludeDirect + else + fTokenID := tokBorComment; + 136: if KeyComp('INCLUDE_ONCE') then + fTokenID := tokIncludeDirect + else + fTokenID := tokBorComment; + else + fTokenId := tokBorComment; + end; + FTokenPos := tmpRun; + Dec(Run); + end + else + fTokenID := tokBorComment; + end; + if (fTokenID = tokBorComment) then + fCommentState := csBor; + inc(Run); + while FOrigin[Run] <> #0 do + case FOrigin[Run] of + '}': + begin + fCommentState := csNo; + inc(Run); + break; + end; + #10: + begin + inc(Run); + inc(fLineNumber); + fLinePos := Run; + end; + #13: + begin + inc(Run); + if FOrigin[Run] = #10 then inc( Run ); + inc(fLineNumber); + fLinePos := Run; + end; +{ #10: break; DR 2001-10-12 + + #13: break;} + else inc(Run); + end; + case fTokenID of + tokCompDirect: + begin + if Assigned(fOnCompDirect) and (FDefineStack = 0) then + fOnCompDirect(Self); + end; + tokDefineDirect: + begin + if FUseDefines and (FDefineStack = 0) then + AddDefine(DirectiveParam); + if Assigned(fOnDefineDirect) then + fOnDefineDirect(Self); + end; + tokElseDirect: + begin + if FUseDefines then + begin + if FTopDefineRec <> nil then + begin + if FTopDefineRec^.Defined then + Inc(FDefineStack) + else + if FDefineStack > 0 then + Dec(FDefineStack); + end; + end; + if Assigned(fOnElseDirect) then + fOnElseDirect(Self); + end; + tokEndIfDirect: + begin + if FUseDefines then + ExitDefineBlock; + if Assigned(fOnEndIfDirect) then + fOnEndIfDirect(Self); + end; + tokIfDefDirect: + begin + if FUseDefines then + EnterDefineBlock(IsDefined(DirectiveParam)); + if Assigned(fOnIfDefDirect) then + fOnIfDefDirect(Self); + end; + tokIfNDefDirect: + begin + if FUseDefines then + EnterDefineBlock(not IsDefined(DirectiveParam)); + if Assigned(fOnIfNDefDirect) then + fOnIfNDefDirect(Self); + end; + tokIfOptDirect: + begin + if Assigned(fOnIfOptDirect) then + fOnIfOptDirect(Self); + end; + tokIfDirect: + begin + if FUseDefines then + begin + Param := DirectiveParam; + if Pos('DEFINED', Param) = 1 then + begin + Def := Copy(Param, 9, Length(Param) - 9); + EnterDefineBlock(IsDefined(Def)); + end; + end; + if Assigned(fOnIfDirect) then + fOnIfDirect(Self); + end; + tokIfEndDirect: + begin + if FUseDefines then + ExitDefineBlock; + if Assigned(fOnIfEndDirect) then + fOnIfEndDirect(Self); + end; + tokElseIfDirect: + begin + if FUseDefines then + begin + if FTopDefineRec <> nil then + begin + if FTopDefineRec^.Defined then + Inc(FDefineStack) + else + begin + if FDefineStack > 0 then + Dec(FDefineStack); + Param := DirectiveParam; + if Pos('DEFINED', Param) = 1 then + begin + Def := Copy(Param, 9, Length(Param) - 9); + EnterDefineBlock(IsDefined(Def)); + end; + end; + end; + end; + if Assigned(fOnElseIfDirect) then + fOnElseIfDirect(Self); + end; + tokIncludeDirect: + begin + if Assigned(fOnIncludeDirect) and (FDefineStack = 0) then + fOnIncludeDirect(Self); + end; + tokResourceDirect: + begin + if Assigned(fOnResourceDirect) and (FDefineStack = 0) then + fOnResourceDirect(Self); + end; + tokUndefDirect: + begin + if FUseDefines and (FDefineStack = 0) then + RemoveDefine(DirectiveParam); + if Assigned(fOnUndefDirect) then + fOnUndefDirect(Self); + end; + end; +end; + +procedure TmwBasePasLex.ColonProc; +begin + case FOrigin[Run + 1] of + '=': + begin + inc(Run, 2); + fTokenID := tokAssign; + end; + else + begin + inc(Run); + fTokenID := tokColon; + end; + end; +end; + +procedure TmwBasePasLex.CommaProc; +begin + inc(Run); + fTokenID := tokComma; +end; + +procedure TmwBasePasLex.CRProc; +begin + case fCommentState of + csBor: fTokenID := tokCRLFCo; + csAnsi: fTokenID := tokCRLFCo; + else fTokenID := tokCRLF; + end; + + case FOrigin[Run + 1] of + #10: inc(Run, 2); + else inc(Run); + end; + inc(fLineNumber); + fLinePos := Run; +end; + +procedure TmwBasePasLex.EnterDefineBlock(ADefined: Boolean); +var + StackFrame: PDefineRec; +begin + New(StackFrame); + StackFrame^.Next := FTopDefineRec; + StackFrame^.Defined := ADefined; + StackFrame^.StartCount := FDefineStack; + FTopDefineRec := StackFrame; + if not ADefined then + Inc(FDefineStack); +end; + +procedure TmwBasePasLex.EqualProc; +begin + inc(Run); + fTokenID := tokEqual; +end; + +procedure TmwBasePasLex.ExitDefineBlock; +var + StackFrame: PDefineRec; +begin + StackFrame := FTopDefineRec; + if StackFrame <> nil then + begin + FDefineStack := StackFrame^.StartCount; + FTopDefineRec := StackFrame^.Next; + Dispose(StackFrame); + end; +end; +procedure TmwBasePasLex.GreaterProc; +begin + case FOrigin[Run + 1] of + '=': + begin + inc(Run, 2); + fTokenID := tokGreaterEqual; + end; + else + begin + inc(Run); + fTokenID := tokGreater; + end; + end; +end; + +function TmwBasePasLex.HashValue(AChar: AnsiChar): Integer; +begin + if AChar <= #255 then + Result := mHashTable[fOrigin[Run]] + else + Result := Ord(AChar); +end; + +procedure TmwBasePasLex.IdentProc; +begin + fTokenID := IdentKind; +end; + +procedure TmwBasePasLex.IntegerProc; +begin + inc(Run); + fTokenID := tokIntegerConst; + while FOrigin[Run] in ['0'..'9', 'A'..'F', 'a'..'f'] do + inc(Run); +end; + +function TmwBasePasLex.IsDefined(const ADefine: string): Boolean; +begin + Result := FDefines.IndexOf(ADefine) > -1; +end; + +function TmwBasePasLex.IsIdentifiers(AChar: AnsiChar): Boolean; +begin + if AChar <= #255 then + Result := Identifiers[AChar] + else + Result := True; +end; + +procedure TmwBasePasLex.LFProc; +begin + case fCommentState of + csBor: fTokenID := tokCRLFCo; + csAnsi: fTokenID := tokCRLFCo; + else fTokenID := tokCRLF; + end; + inc(Run); + inc(fLineNumber); + fLinePos := Run; +end; + +procedure TmwBasePasLex.LowerProc; +begin + case FOrigin[Run + 1] of + '=': + begin + inc(Run, 2); + fTokenID := tokLowerEqual; + end; + '>': + begin + inc(Run, 2); + fTokenID := tokNotEqual; + end + else + begin + inc(Run); + fTokenID := tokLower; + end; + end; +end; + +procedure TmwBasePasLex.MinusProc; +begin + inc(Run); + fTokenID := tokMinus; +end; + +procedure TmwBasePasLex.NullProc; +begin + fTokenID := tokNull; +end; + +procedure TmwBasePasLex.NumberProc; +begin + inc(Run); + fTokenID := tokIntegerConst; + while FOrigin[Run] in ['0'..'9', '.', 'e', 'E'] do + begin + case FOrigin[Run] of + '.': + if FOrigin[Run + 1] = '.' then + break + else fTokenID := tokFloat + end; + inc(Run); + end; +end; + +procedure TmwBasePasLex.PlusProc; +begin + inc(Run); + fTokenID := tokPlus; +end; + +procedure TmwBasePasLex.PointerSymbolProc; +begin + inc(Run); + fTokenID := tokPointerSymbol; + + //This is a wierd Pascal construct that rarely appears, but needs to be + //supported. ^M is a valid char reference (#13, in this case) + if FOrigin[Run] in ['a'..'z','A'..'Z'] then + begin + inc(Run); + fTokenID := tokAsciiChar; + end; +end; + +procedure TmwBasePasLex.PointProc; +begin + case FOrigin[Run + 1] of + '.': + begin + inc(Run, 2); + fTokenID := tokDotDot; + end; + ')': + begin + inc(Run, 2); + fTokenID := tokSquareClose; + end; + else + begin + inc(Run); + fTokenID := tokPoint; + end; + end; +end; + +procedure TmwBasePasLex.RemoveDefine(const ADefine: string); +var + I: Integer; +begin + I := FDefines.IndexOf(ADefine); + if I > -1 then + FDefines.Delete(I); +end; + +procedure TmwBasePasLex.RoundCloseProc; +begin + inc(Run); + fTokenID := tokRoundClose; +end; + +procedure TmwBasePasLex.AnsiProc; +begin + fTokenID := tokAnsiComment; + case FOrigin[Run] of + #0: + begin + NullProc; + if Assigned(FOnMessage) then + FOnMessage(Self, meError, 'Unexpected file end', PosXY.X, PosXY.Y); + exit; + end; + +{ DR 2001-08-02 + #10: + begin + LFProc; + exit; + end; + + #13: + begin + CRProc; + exit; + end; +} + end; + + while fOrigin[Run] <> #0 do + case fOrigin[Run] of + '*': + if fOrigin[Run + 1] = ')' then + begin + fCommentState := csNo; + inc(Run, 2); + break; + end + else inc(Run); +{ DR 2001-08-02 + #10: break; + + #13: break; +} + #10: + begin + inc(Run); + inc(fLineNumber); + fLinePos := Run; + end; + #13: + begin + inc(Run); + if FOrigin[Run] = #10 then inc( Run ); + inc(fLineNumber); + fLinePos := Run; + end; + else inc(Run); + end; +end; + +procedure TmwBasePasLex.RoundOpenProc; +begin + inc(Run); + case fOrigin[Run] of + '*': + begin + fTokenID := tokAnsiComment; + if FOrigin[Run + 1] = '$' then + fTokenID := GetDirectiveKind + else fCommentState := csAnsi; + inc(Run); + while fOrigin[Run] <> #0 do + case fOrigin[Run] of + '*': + if fOrigin[Run + 1] = ')' then + begin + fCommentState := csNo; + inc(Run, 2); + break; + end + else inc(Run); +{ DR 2001-08-02 + #10: break; + #13: break; +} + #10: + begin + inc(Run); + inc(fLineNumber); + fLinePos := Run; + end; + #13: + begin + inc(Run); + if FOrigin[Run] = #10 then inc( Run ); + inc(fLineNumber); + fLinePos := Run; + end; + else inc(Run); + end; + end; + '.': + begin + inc(Run); + fTokenID := tokSquareOpen; + end; + else fTokenID := tokRoundOpen; + end; + case fTokenID of + tokCompDirect: + begin + if Assigned(fOnCompDirect) then + fOnCompDirect(Self); + end; + tokDefineDirect: + begin + if Assigned(fOnDefineDirect) then + fOnDefineDirect(Self); + end; + tokElseDirect: + begin + if Assigned(fOnElseDirect) then + fOnElseDirect(Self); + end; + tokEndIfDirect: + begin + if Assigned(fOnEndIfDirect) then + fOnEndIfDirect(Self); + end; + tokIfDefDirect: + begin + if Assigned(fOnIfDefDirect) then + fOnIfDefDirect(Self); + end; + tokIfNDefDirect: + begin + if Assigned(fOnIfNDefDirect) then + fOnIfNDefDirect(Self); + end; + tokIfOptDirect: + begin + if Assigned(fOnIfOptDirect) then + fOnIfOptDirect(Self); + end; + tokIncludeDirect: + begin + if Assigned(fOnIncludeDirect) then + fOnIncludeDirect(Self); + end; + tokResourceDirect: + begin + if Assigned(fOnResourceDirect) then + fOnResourceDirect(Self); + end; + tokUndefDirect: + begin + if Assigned(fOnUndefDirect) then + fOnUndefDirect(Self); + end; + end; +end; + +procedure TmwBasePasLex.SemiColonProc; +begin + inc(Run); + fTokenID := tokSemiColon; +end; + +procedure TmwBasePasLex.SlashProc; +begin + case FOrigin[Run + 1] of + '/': + begin + inc(Run, 2); + fTokenID := tokSlashesComment; + while FOrigin[Run] <> #0 do + begin + case FOrigin[Run] of + #10, #13: break; + end; + inc(Run); + end; + end; + else + begin + inc(Run); + fTokenID := tokSlash; + end; + end; +end; + +procedure TmwBasePasLex.SpaceProc; +begin + inc(Run); + fTokenID := tokSpace; + while FOrigin[Run] in [#1..#9, #11, #12, #14..#32] do + inc(Run); +end; + +procedure TmwBasePasLex.SquareCloseProc; +begin + inc(Run); + fTokenID := tokSquareClose; +end; + +procedure TmwBasePasLex.SquareOpenProc; +begin + inc(Run); + fTokenID := tokSquareOpen; +end; + +procedure TmwBasePasLex.StarProc; +begin + inc(Run); + fTokenID := tokStar; +end; + +procedure TmwBasePasLex.StringProc; +begin + fTokenID := tokStringConst; + repeat + inc(Run); + case FOrigin[Run] of + #0, #10, #13: + begin + if Assigned(FOnMessage) then + FOnMessage(Self, meError, 'Unterminated string', PosXY.X, PosXY.Y); + break; + end; + #39: + begin + while (FOrigin[Run] = #39) and (FOrigin[Run + 1] = #39) do + begin + inc(Run, 2); + end; + end; + end; + until FOrigin[Run] = #39; + if FOrigin[Run] = #39 then + begin + inc(Run); + if TokenLen = 3 then + begin + fTokenID := tokAsciiChar; + end; + end; +end; + +procedure TmwBasePasLex.SymbolProc; +begin + inc(Run); + fTokenID := tokSymbol; +end; + +procedure TmwBasePasLex.UnknownProc; +begin + inc(Run); + fTokenID := tokUnknown; + if Assigned(FOnMessage) then + FOnMessage(Self, meError, 'Unknown Character', PosXY.X, PosXY.Y); +end; + +procedure TmwBasePasLex.Next; +begin + fExID := tokUnKnown; + fTokenPos := Run; + + if (MaxPos > -1) and (fTokenPos > MaxPos) then + fTokenID := tok_DONE + else + case fCommentState of + csNo: + begin + DoProcTable(fOrigin[Run]); + (*{$IFDEF D10_NEWER} + if fOrigin[Run] < #256 then + fProcTable[fOrigin[Run]] + else //non-ASCII unicode char + IdentProc; + {$ELSE} + fProcTable[fOrigin[Run]]; + {$ENDIF}*) + end; + else + case fCommentState of + csBor: BorProc; + csAnsi: AnsiProc; + end; + end; +end; + + +function TmwBasePasLex.GetIsJunk: Boolean; +begin + result := IsTokenIDJunk(FTokenID) or (FUseDefines and (FDefineStack > 0) and (TokenID <> tokNull) and (TokenID <> tok_DONE)); +// Result := fTokenID in [tokAnsiComment, tokBorComment, tokCRLF, tokCRLFCo, tokSlashesComment, tokSpace]; //XM 20001210 +end; + +function TmwBasePasLex.GetIsSpace: Boolean; +begin + Result := fTokenID in [tokCRLF, tokSpace]; +end; + +function TmwBasePasLex.GetToken: string; +begin + SetString(Result, (FOrigin + fTokenPos), GetTokenLen); +end; + +function TmwBasePasLex.GetTokenLen: Integer; +begin + Result := Run - fTokenPos; +end; + +procedure TmwBasePasLex.NextID(ID: TptTokenKind); +begin + repeat + case fTokenID of + tokNull, tok_DONE: break; + else Next; + end; + until fTokenID = ID; +end; + +procedure TmwBasePasLex.NextNoJunk; +begin + repeat + Next; + until not IsJunk; +end; + +procedure TmwBasePasLex.NextNoSpace; +begin + repeat + Next; + until not IsSpace; +end; + +function TmwBasePasLex.FirstInLine: Boolean; +var + RunBack: Integer; +begin + Result := True; + if fTokenPos = 0 then exit; + RunBack := fTokenPos; + dec(RunBack); + while fOrigin[RunBack] in [#1..#9, #11, #12, #14..#32] do + dec(RunBack); + if RunBack = 0 then exit; + case fOrigin[RunBack] of + #10, #13: exit; + else + begin + Result := False; + exit; + end; + end; +end; + +function TmwBasePasLex.GetCommentState: Pointer; +begin + Result := Pointer(fCommentState); +end; + +function TmwBasePasLex.GetCompilerDirective: string; +var + DirectLen: Integer; +begin + if TokenID <> tokCompDirect then + Result := '' + else + case fOrigin[fTokenPos] of + '(': + begin + DirectLen := Run - fTokenPos - 4; + SetString(Result, (FOrigin + fTokenPos + 2), DirectLen); + Result := UpperCase(Result); + end; + '{': + begin + DirectLen := Run - fTokenPos - 2; + SetString(Result, (FOrigin + fTokenPos + 1), DirectLen); + Result := UpperCase(Result); + end; + end; +end; + +function TmwBasePasLex.GetDirectiveKind: TptTokenKind; +var + TempPos: Integer; +begin + case fOrigin[fTokenPos] of + '(': Run := FTokenPos + 3; + '{': Run := FTokenPos + 2; + end; + FDirectiveParamOrigin := FOrigin + FTokenPos; + TempPos := fTokenPos; + fTokenPos := Run; + case KeyHash of + 9: + if KeyComp('I') then + Result := tokIncludeDirect else + Result := tokCompDirect; + 15: + if KeyComp('IF') then + Result := tokIfDirect else + Result := tokCompDirect; + 18: + if KeyComp('R') then + begin + if not (fOrigin[Run] in ['+', '-']) then + Result := tokResourceDirect else Result := tokCompDirect; + end else Result := tokCompDirect; + 30: + if KeyComp('IFDEF') then + Result := tokIfDefDirect else + Result := tokCompDirect; + 38: + if KeyComp('ENDIF') then + Result := tokEndIfDirect else + if KeyComp('IFEND') then + Result := tokIfEndDirect else + Result := tokCompDirect; + 41: + if KeyComp('ELSE') then + Result := tokElseDirect else + Result := tokCompDirect; + 43: + if KeyComp('DEFINE') then + Result := tokDefineDirect else + Result := tokCompDirect; + 44: + if KeyComp('IFNDEF') then + Result := tokIfNDefDirect else + Result := tokCompDirect; + 50: + if KeyComp('UNDEF') then + Result := tokUndefDirect else + Result := tokCompDirect; + 56: + if KeyComp('ELSEIF') then + Result := tokElseIfDirect else + Result := tokCompDirect; + 66: + if KeyComp('IFOPT') then + Result := tokIfOptDirect else + Result := tokCompDirect; + 68: + if KeyComp('INCLUDE') then + Result := tokIncludeDirect else + Result := tokCompDirect; + 104: + if KeyComp('Resource') then + Result := tokResourceDirect else + Result := tokCompDirect; + else Result := tokCompDirect; + end; + fTokenPos := TempPos; + dec(Run); +end; + +function TmwBasePasLex.GetDirectiveParam: string; +var + EndPos: Integer; + ParamLen: Integer; +begin + // !! without this set... there is a warning? + EndPos:= 0; + case fOrigin[fTokenPos] of + '(': + begin + TempRun := FTokenPos + 3; + EndPos := Run - 2; + end; + '{': + begin + TempRun := FTokenPos + 2; + EndPos := Run - 1; + end; + end; + while IsIdentifiers(fOrigin[TempRun]) do + inc(TempRun); + while fOrigin[TempRun] in ['+', ',', '-'] do + begin + inc(TempRun); + while IsIdentifiers(fOrigin[TempRun]) do + inc(TempRun); + if (fOrigin[TempRun - 1] in ['+', ',', '-']) and (fOrigin[TempRun] = ' ') + then inc(TempRun); + end; + if fOrigin[TempRun] = ' ' then inc(TempRun); + ParamLen := EndPos - TempRun; + SetString(Result, (FOrigin + TempRun), ParamLen); + Result := UpperCase(Result); +end; + +procedure TmwBasePasLex.Init; +begin + fCommentState := csNo; + fLineNumber := 0; + fLinePos := 0; + Run := 0; + //InitDefines; +end; + +procedure TmwBasePasLex.InitFrom(ALexer: TmwBasePasLex); +begin + Origin := ALexer.Origin; + fCommentState := ALexer.fCommentState; + fLineNumber := ALexer.fLineNumber; + fLinePos := ALexer.fLinePos; + Run := ALexer.Run; + CloneDefinesFrom(ALexer); +end; + +procedure TmwBasePasLex.InitDefines; +begin + ClearDefines; + //Set up the defines that are defined by the compiler + (* + {$IFDEF VER130} + AddDefine('VER130'); + {$ENDIF} + {$IFDEF VER140} + AddDefine('VER140'); + {$ENDIF} + {$IFDEF VER150} + AddDefine('VER150'); + {$ENDIF} + {$IFDEF VER160} + AddDefine('VER160'); + {$ENDIF} + {$IFDEF VER170} + AddDefine('VER170'); + {$ENDIF} + {$IFDEF VER180} + AddDefine('VER180'); + {$ENDIF} + {$IFDEF VER185} + AddDefine('VER185'); + {$ENDIF} + {$IFDEF VER190} + AddDefine('VER190'); + {$ENDIF} + {$IFDEF VER200} + AddDefine('VER200'); + {$ENDIF} + {$IFDEF WIN32} + AddDefine('WIN32'); + {$ENDIF} + {$IFDEF LINUX} + AddDefine('LINUX'); + {$ENDIF} + {$IFDEF CPU386} + AddDefine('CPU386'); + {$ENDIF} + {$IFDEF MSWINDOWS} + AddDefine('MSWINDOWS'); + {$ENDIF} + {$IFDEF CONDITIONALEXPRESSIONS} + AddDefine('CONDITIONALEXPRESSIONS'); + {$ENDIF} + {$IFDEF UNICODE} + AddDefine('UNICODE'); + {$ENDIF} + *) +end; + +procedure TmwBasePasLex.InitLine; +begin + fLineNumber := 0; + fLinePos := 0; + Run := 0; +end; + +procedure TmwBasePasLex.SetCommentState(const Value: Pointer); +begin + fCommentState := TCommentState(Value); +end; + +procedure TmwBasePasLex.SetLine(const Value: AnsiString); +begin + fOrigin := PAnsiChar(Value); + InitLine; + Next; +end; + +function TmwBasePasLex.GetStringContent: string; +var + TempString: string; + sEnd: Integer; +begin + if TokenID <> tokStringConst then + Result := '' + else + begin + TempString := Token; + sEnd := Length(TempString); + if TempString[sEnd] <> #39 then inc(sEnd); + Result := Copy(TempString, 2, sEnd - 2); + TempString := ''; + end; +end; + +function TmwBasePasLex.GetIsOrdIdent: Boolean; +begin + Result := False; + if fTokenID = tokIdentifier then + Result := fExID in [tokBoolean, tokByte, tokChar, tokDWord, tokInt64, tokInteger, + tokLongInt, tokLongWord, tokPChar, tokShortInt, tokSmallInt, tokWideChar, tokWord] +end; + +function TmwBasePasLex.GetIsOrdinalType: Boolean; +begin + Result := GetIsOrdIdent or (fTokenID in [tokAsciiChar, tokIntegerConst]); +end; + +function TmwBasePasLex.GetIsRealType: Boolean; +begin + Result := False; + if fTokenID = tokIdentifier then + Result := fExID in [tokComp, tokCurrency, tokDouble, tokExtended, tokReal, tokReal48, tokSingle] +end; + +function TmwBasePasLex.GetIsStringType: Boolean; +begin + Result := False; + if fTokenID = tokIdentifier then + Result := fExID in [tokAnsiString, tokWideString] + else + if fTokenID = tokString then + Result := True + else + if fTokenID = tokStringConst then Result := True; +end; + +function TmwBasePasLex.GetIsVarantType: Boolean; +begin + Result := False; + if fTokenID = tokIdentifier then + Result := fExID in [tokOleVariant, tokVariant] +end; + +function TmwBasePasLex.GetIsAddOperator: Boolean; +begin + Result := fTokenID in [tokMinus, tokOr, tokPlus, tokXor]; +end; + +function TmwBasePasLex.GetIsMulOperator: Boolean; +begin + Result := fTokenID in [tokAnd, tokAs, tokDiv, tokMod, tokShl, tokShr, tokSlash, tokStar]; +end; + +function TmwBasePasLex.GetIsRelativeOperator: Boolean; +begin + Result := fTokenID in [tokAs, tokEqual, tokGreater, tokGreaterEqual, tokLower, tokLowerEqual, + tokIn, tokIs, tokNotEqual]; +end; + +function TmwBasePasLex.GetIsCompilerDirective: Boolean; +begin + Result := fTokenID in [tokCompDirect, tokDefineDirect, tokElseDirect, + tokEndIfDirect, tokIfDefDirect, tokIfNDefDirect, tokIfOptDirect, + tokIncludeDirect, tokResourceDirect, tokUndefDirect]; +end; + +function TmwBasePasLex.GetGenID: TptTokenKind; +begin + Result := fTokenID; + if fTokenID = tokIdentifier then + if fExID <> tokUnknown then Result := fExID; +end; + +{ TmwPasLex } + +constructor TmwPasLex.Create; +begin + inherited Create; + fAheadLex := TmwBasePasLex.Create; +end; + +destructor TmwPasLex.Destroy; +begin + fAheadLex.Free; + inherited Destroy; +end; + +procedure TmwPasLex.SetOrigin(NewValue: PAnsiChar); +begin + inherited SetOrigin(NewValue); + fAheadLex.SetOrigin(NewValue); +end; + +procedure TmwPasLex.SetLine(const Value: AnsiString); +begin + inherited SetLine(Value); + fAheadLex.SetLine(Value); +end; + +procedure TmwPasLex.AheadNext; +begin + fAheadLex.NextNoJunk; +end; + +function TmwPasLex.GetAheadExID: TptTokenKind; +begin + Result := fAheadLex.ExID; +end; + +function TmwPasLex.GetAheadGenID: TptTokenKind; +begin + Result := fAheadLex.GenID; +end; + +function TmwPasLex.GetAheadToken: string; +begin + Result := fAheadLex.Token; +end; + +function TmwPasLex.GetAheadTokenID: TptTokenKind; +begin + Result := fAheadLex.TokenID; +end; + +procedure TmwPasLex.InitAhead; +begin + fAheadLex.CommentState := CommentState; + fAheadLex.RunPos := RunPos; + FAheadLex.fLineNumber := FLineNumber; + FAheadLex.FLinePos := FLinePos; + + FAheadLex.CloneDefinesFrom(Self); + + //FAheadLex.FTokenPos := FTokenPos; + while fAheadLex.IsJunk do + fAheadLex.Next; +end; + +function TmwPasLex.GetStatus: TmwPasLexStatus; +begin + Result.CommentState := fCommentState; + Result.ExID := fExID; + Result.LineNumber := fLineNumber; + Result.LinePos := fLinePos; + Result.Origin := fOrigin; + Result.RunPos := Run; + Result.TokenPos := fTokenPos; + Result.TokenID := fTokenID; +end; + +procedure TmwPasLex.SetStatus(const Value: TmwPasLexStatus); +begin + fCommentState := Value.CommentState; + fExID := Value.ExID; + fLineNumber := Value.LineNumber; + fLinePos := Value.LinePos; + fOrigin := Value.Origin; + Run := Value.RunPos; + fTokenPos := Value.TokenPos; + fTokenID := Value.TokenID; + fAheadLex.Origin := Value.Origin; +end; + +procedure TmwBasePasLex.SetOnCompDirect(const Value: TDirectiveEvent); +begin + fOnCompDirect := Value; +end; + +procedure TmwBasePasLex.SetOnDefineDirect(const Value: TDirectiveEvent); +begin + fOnDefineDirect := Value; +end; + +procedure TmwBasePasLex.SetOnElseDirect(const Value: TDirectiveEvent); +begin + fOnElseDirect := Value; +end; + +procedure TmwBasePasLex.SetOnElseIfDirect(const Value: TDirectiveEvent); +begin + fOnElseIfDirect := Value; +end; + +procedure TmwBasePasLex.SetOnEndIfDirect(const Value: TDirectiveEvent); +begin + fOnEndIfDirect := Value; +end; + +procedure TmwBasePasLex.SetOnIfDefDirect(const Value: TDirectiveEvent); +begin + fOnIfDefDirect := Value; +end; + +procedure TmwBasePasLex.SetOnIfDirect(const Value: TDirectiveEvent); +begin + FOnIfDirect := Value; +end; + +procedure TmwBasePasLex.SetOnIfEndDirect(const Value: TDirectiveEvent); +begin + FOnIfEndDirect := Value; +end; + +procedure TmwBasePasLex.SetOnIfNDefDirect(const Value: TDirectiveEvent); +begin + fOnIfNDefDirect := Value; +end; + +procedure TmwBasePasLex.SetOnIfOptDirect(const Value: TDirectiveEvent); +begin + fOnIfOptDirect := Value; +end; + +procedure TmwBasePasLex.SetOnIncludeDirect(const Value: TDirectiveEvent); +begin + fOnIncludeDirect := Value; +end; + +procedure TmwBasePasLex.SetOnResourceDirect(const Value: TDirectiveEvent); +begin + fOnResourceDirect := Value; +end; + +procedure TmwBasePasLex.SetOnUnDefDirect(const Value: TDirectiveEvent); +begin + fOnUnDefDirect := Value; +end; + +procedure TmwPasLex.SetOnCompDirect(const Value: TDirectiveEvent); +begin + inherited; + //AheadLex.OnCompDirect := Value; +end; + +procedure TmwPasLex.SetOnDefineDirect(const Value: TDirectiveEvent); +begin + inherited; + //AheadLex.OnDefineDirect := Value; +end; + +procedure TmwPasLex.SetOnElseDirect(const Value: TDirectiveEvent); +begin + inherited; + //AheadLex.OnElseDirect := Value; +end; + +procedure TmwPasLex.SetOnEndIfDirect(const Value: TDirectiveEvent); +begin + inherited; + //AheadLex.OnEndIfDirect := Value; +end; + +procedure TmwPasLex.SetOnIfDefDirect(const Value: TDirectiveEvent); +begin + inherited; + //AheadLex.OnIfDefDirect := Value; +end; + +procedure TmwPasLex.SetOnIfNDefDirect(const Value: TDirectiveEvent); +begin + inherited; + //AheadLex.OnIfNDefDirect := Value; +end; + +procedure TmwPasLex.SetOnIfOptDirect(const Value: TDirectiveEvent); +begin + inherited; + //AheadLex.OnIfOptDirect := Value; +end; + +procedure TmwPasLex.SetOnIncludeDirect(const Value: TDirectiveEvent); +begin + inherited; + //AheadLex.OnIncludeDirect := Value; +end; + +procedure TmwPasLex.SetOnResourceDirect(const Value: TDirectiveEvent); +begin + inherited; + //AheadLex.OnResourceDirect := Value; +end; + +procedure TmwPasLex.SetOnUnDefDirect(const Value: TDirectiveEvent); +begin + inherited; + //AheadLex.OnUnDefDirect := Value; +end; + +function TmwBasePasLex.Func86: TptTokenKind; +begin + Result := tokIdentifier; + if KeyComp('Varargs') then fExID := tokVarargs; +end; + +procedure TmwBasePasLex.StringDQProc; +begin + if not fAsmCode then + begin + SymbolProc; + Exit; + end; + fTokenID := tokStringDQConst; + repeat + inc(Run); + case FOrigin[Run] of + #0, #10, #13: + begin + if Assigned(FOnMessage) then + FOnMessage(Self, meError, 'Unterminated string', PosXY.X, PosXY.Y); + break; + end; + '\': + begin + Inc( Run ); + if FOrigin[Run] in [#32..#255] then Inc( Run ); + end; + end; + until FOrigin[Run] = '"'; + if FOrigin[Run] = '"' then + inc(Run); +end; + +{$IFDEF D8_NEWER} //JThurman 2004-04-06 +procedure TmwBasePasLex.AmpersandOpProc; +begin + FTokenID := tokAmpersand; + inc(Run); + while FOrigin[Run] in ['a'..'z', 'A'..'Z','0'..'9'] do + inc(Run); + FTokenID := tokIdentifier; +end; +{$ENDIF} + +initialization + MakeIdentTable; +end. + diff --git a/Projects/Code Insight/CastaliaPasLexTypes.pas b/Projects/Code Insight/CastaliaPasLexTypes.pas new file mode 100644 index 0000000..ce65d81 --- /dev/null +++ b/Projects/Code Insight/CastaliaPasLexTypes.pas @@ -0,0 +1,322 @@ +{--------------------------------------------------------------------------- +The contents of this file are subject to the Mozilla Public License Version +1.1 (the "License"); you may not use this file except in compliance with the +License. You may obtain a copy of the License at +http://www.mozilla.org/NPL/NPL-1_1Final.html + +Software distributed under the License is distributed on an "AS IS" basis, +WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for +the specific language governing rights and limitations under the License. + +The Original Code is: mwPasLexTypes, released November 14, 1999. + +The Initial Developer of the Original Code is Martin Waldenburg +unit CastaliaPasLexTypes; + +----------------------------------------------------------------------------} + +unit CastaliaPasLexTypes; + +{$include ValistusDefines.inc} + +interface + +uses SysUtils, TypInfo; + +var + CompTable: array[#0..#255] of byte; + +type + + TMessageEventType = ( meError, meNotSupported ); + + TMessageEvent = procedure(Sender: TObject; const Typ : TMessageEventType; const Msg: string; X, Y: Integer ) of object; //jdj 7/16/1999; DR 2001-11-06 + + TCommentState = (csAnsi, csBor, csNo); + + TTokenPoint = packed record + X : Integer; + Y : Integer; + end; + + TptTokenKind = ( + tokAbort, //JThurman 2004-11-8 (flow control routines) + tokAbsolute, + tokAbstract, + tokAdd, + tokAddressOp, + tokAmpersand, + tokAnd, + tokAnsiComment, + tokAnsiString, + tokArray, + tokAs, + tokAsciiChar, + tokAsm, + tokAssembler, + tokAssign, + tokAt, + tokAutomated, + tokBegin, + tokBoolean, + tokBorComment, + tokBraceClose, + tokBraceOpen, + tokBreak, //JThurman 2004-11-8 (flow control routines) + tokByte, + tokByteBool, + tokCardinal, + tokCase, + tokCdecl, + tokChar, + tokClass, + tokClassForward, + tokClassFunction, + tokClassProcedure, + tokColon, + tokComma, + tokComp, + tokCompDirect, + tokConst, + tokConstructor, + tokContains, + tokContinue, //JThurman 2004-11-8 (flow control routines) + tokCRLF, + tokCRLFCo, + tokCurrency, + tokDefault, + tokDefineDirect, + tokDeprecated, // DR 2001-10-20 + tokDestructor, + tokDispid, + tokDispinterface, + tokDiv, + tokDo, + tokDotDot, + tokDouble, + tokDoubleAddressOp, + tokDownto, + tokDWORD, + tokDynamic, + tokElse, + tokElseDirect, + tokEnd, + tokEndIfDirect, + tokEqual, + tokError, + tokExcept, + tokExit, //JThurman 2004-11-8 (flow control routine) + tokExport, + tokExports, + tokExtended, + tokExternal, + tokFar, + tokFile, + {$IFDEF D8_NEWER} //JThurman 2004-03-20 + tokFinal, + {$ENDIF} + tokFinalization, + tokFinally, + tokFloat, + tokFor, + tokForward, + tokFunction, + tokGoto, + tokGreater, + tokGreaterEqual, + tokHalt, //JThurman 2004-11-8 (flow control routines) + {$IFDEF D8_NEWER} //JThurman 2004-04-06 + tokHelper, + {$ENDIF} + tokIdentifier, + tokIf, + tokIfDirect, + tokIfEndDirect, + tokElseIfDirect, + tokIfDefDirect, + tokIfNDefDirect, + tokIfOptDirect, + tokImplementation, + tokImplements, + tokIn, + tokIncludeDirect, + tokIndex, + tokInherited, + tokInitialization, + tokInline, + tokInt64, + tokInteger, + tokIntegerConst, + tokInterface, + tokIs, + tokLabel, + tokLibrary, + tokLocal, // DR 2001-11-14 + tokLongBool, + tokLongint, + tokLongword, + tokLower, + tokLowerEqual, + tokMessage, + tokMinus, + tokMod, + tokName, + tokNear, + tokNil, + tokNodefault, + tokNone, + tokNot, + tokNotEqual, + tokNull, + tokObject, + tokOf, + tokOleVariant, + tokOn, + {$IFDEF D8_NEWER} //JThurman 2004-03-20 + tokOperator, + {$ENDIF} + tokOr, + tokOut, + tokOverload, + tokOverride, + tokPackage, + tokPacked, + tokPascal, + tokPChar, + tokPlatform, // DR 2001-10-20 + tokPlus, + tokPoint, + tokPointerSymbol, + tokPrivate, + tokProcedure, + tokProgram, + tokProperty, + tokProtected, + tokPublic, + tokPublished, + tokRaise, + tokRead, + tokReadonly, + tokReal, + tokReal48, + tokRecord, + {$IFDEF D12_NEWER} + tokReference, //JThurman 2008-25-07 (anonymous methods) + {$ENDIF} + tokRegister, + tokReintroduce, + tokRemove, + tokRepeat, + tokRequires, + tokResident, + tokResourceDirect, + tokResourcestring, + tokRoundClose, + tokRoundOpen, + tokRunError, //JThurman 2004-11-8 (flow control routines) + tokSafeCall, + {$IFDEF D8_NEWER} //JThurman 2004-03-19 + tokSealed, + {$ENDIF} + tokSemiColon, + tokSet, + tokShl, + tokShortint, + tokShortString, + tokShr, + tokSingle, + tokSlash, + tokSlashesComment, + tokSmallint, + tokSpace, + tokSquareClose, + tokSquareOpen, + tokStar, + {$IFDEF D8_NEWER} //JThurman 2004-03-20 + tokStatic, + {$ENDIF} + tokStdcall, + tokStored, + {$IFDEF D8_NEWER} + tokStrict, //JThurman 2004-03-03 + {$ENDIF} + tokString, + tokStringConst, + tokStringDQConst, // 2002-01-14 + tokStringresource, + tokSymbol, + tokThen, + tokThreadvar, + tokTo, + tokTry, + tokType, + tokUndefDirect, + tokUnit, + tokUnknown, + {$IFDEF D8_NEWER} //JThurman 2004-03-2003 + tokUnsafe, + {$ENDIF} + tokUntil, + tokUses, + tokVar, + tokVarargs, // DR 2001-11-14 + tokVariant, + tokVirtual, + tokWhile, + tokWideChar, + tokWideString, + tokWith, + tokWord, + tokWordBool, + tokWrite, + tokWriteonly, + tokXor, + + tok_DONE); + +TmwPasLexStatus = record + CommentState: TCommentState; + ExID: TptTokenKind; + LineNumber: Integer; + LinePos: Integer; + Origin: PAnsiChar; + RunPos: Integer; + TokenPos: Integer; + TokenID: TptTokenKind; +end; + +const ExTypes = [tokDWORD, tokUnknown]; + +function TokenName(Value: TptTokenKind): string; +function tokTokenName(Value: TptTokenKind): string; +function IsTokenIDJunk(const aTokenID : TptTokenKind ) :Boolean; //XM 20001210 + +implementation + +function TokenName(Value: TptTokenKind): string; +begin //jdj 7/18/1999 + Result := Copy(tokTokenName(Value), 4, MaxInt); +end; + +function tokTokenName(Value: TptTokenKind): string; +begin + result := GetEnumName(TypeInfo(TptTokenKind), Integer(Value)); +end; + +function IsTokenIDJunk(const aTokenID : TptTokenKind ) :boolean; //XM 20001210 +begin + Result := aTokenID in [tokAnsiComment, tokBorComment, tokCRLF, tokCRLFCo, tokSlashesComment, tokSpace, + tokIfDirect, + tokIfEndDirect, + tokElseIfDirect, + tokIfDefDirect, + tokIfNDefDirect, + tokEndIfDirect, + tokIfOptDirect, + tokDefineDirect, + tokUndefDirect]; +end; + + +end. + diff --git a/Projects/Code Insight/CastaliaSimplePasPar.pas b/Projects/Code Insight/CastaliaSimplePasPar.pas new file mode 100644 index 0000000..ee23d07 --- /dev/null +++ b/Projects/Code Insight/CastaliaSimplePasPar.pas @@ -0,0 +1,5955 @@ +{--------------------------------------------------------------------------- +The contents of this file are subject to the Mozilla Public License Version +1.1 (the "License"); you may not use this file except in compliance with the +License. You may obtain a copy of the License at +http://www.mozilla.org/NPL/NPL-1_1Final.html + +Software distributed under the License is distributed on an "AS IS" basis, +WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for +the specific language governing rights and limitations under the License. + +The Original Code is: mwSimplePasPar.pas, released November 14, 1999. + +The Initial Developer of the Original Code is Martin Waldenburg +(Martin.Waldenburg@T-Online.de). +Portions created by Martin Waldenburg are Copyright (C) 1998, 1999 Martin +Waldenburg. +All Rights Reserved. +Portions CopyRight by Robert Zierer. + +Contributor(s): James Jacobson, Dean Hill, Vladimir Churbanov___________________. + +Last Modified: 2002/01/16 +Current Version: 1.02 + +Notes: This program is an early beginning of a Pascal parser. +I'd like to invite the Delphi community to develop it further and to create +a fully featured Object Pascal parser. + +Modification history: + +Jacob Thurman between 20040301 and 20020401 + +Made ready for Delphi 8: + +Added new directives and keywords: static, sealed, final, operator, unsafe. + +Added parsing for custom attributes (based on ECMA C# specification). + +Added support for nested types in class declarations. + +Jeff Rafter between 20020116 and 20020302 + +Added AncestorId and AncestorIdList back in, but now treat them as Qualified +Identifiers per Daniel Rolf's fix. The separation from QualifiedIdentifierList +is need for descendent classes. + +Added VarName and VarNameList back in for descendent classes, fixed to correctly +use Identifiers as in Daniel's verison + +Removed fInJunk flags (they were never used, only set) + +Pruned uses clause to remove windows dependency. This required changing +"TPoint" to "TTokenPoint". TTokenPoint was declared in mwPasLexTypes + +Daniel Rolf between 20010723 and 20020116 + +Made ready for Delphi 6 + +ciClassClass for "class function" etc. +ciClassTypeEnd marks end of a class declaration (I needed that for the delphi-objectif-connector) +ciEnumeratedTypeItem for items of enumerations +ciDirectiveXXX for the platform, deprecated, varargs, local +ciForwardDeclaration for "forward" (until now it has been read but no event) +ciIndexSpecifier for properties +ciObjectTypeEnd marks end of an object declaration +ciObjectProperty property for objects +ciObjectPropertySpecifiers property for objects +ciPropertyDefault marking default of property +ciDispIDSpecifier for dispid + +patched some functions for implementing the above things and patching the following bugs/improv.: + +ObjectProperty handling overriden properties +ProgramFile, UnitFile getting Identifier instead of dropping it +InterfaceHeritage: Qualified identifiers +bugs in variant records +typedconstant failed with complex set constants. simple patch using ConstantExpression + +German localization for the two string constants. Define GERMAN for german string constants. + +Greg Chapman on 20010522 +Better handling of defaut array property +Separate handling of X and Y in property Pixels[X, Y: Integer through identifier "event" +corrected spelling of "ForwardDeclaration" + +James Jacobson on 20010223 +semi colon before finalization fix + +James Jacobson on 20010223 +RecordConstant Fix + +Martin waldenburg on 2000107 +Even Faster lexer implementation !!!! + +James Jacobson on 20010107 + Improper handling of the construct + property TheName: Integer read FTheRecord.One.Two; (stop at second point) + where one and two are "qualifiable" structures. + +James Jacobson on 20001221 + Stops at the second const. + property Anchor[const Section: string; const Ident:string]: string read + changed TmwSimplePasPar.PropertyParameterList + +On behalf of Martin Waldenburg and James Jacobson + Correction in array property Handling (Matin and James) 07/12/2000 + Use of ExId instead of TokenId in ExportsElements (James) 07/12/2000 + Reverting to old behavior in Statementlist [tokintegerConst put back in] (James) 07/12/2000 + +Xavier Masson InnerCircleProject : XM : 08/11/2000 + Integration of the new version delivered by Martin Waldenburg with the modification I made described just below + +Xavier Masson InnerCircleProject : XM : 07/15/2000 + Added "states/events " for spaces( SkipSpace;) CRLFco (SkipCRLFco) and + CRLF (SkipCRLF) this way the parser can give a complete view on code allowing + "perfect" code reconstruction. + (I fully now that this is not what a standard parser will do but I think it is more usefull this way ;) ) + go to www.innercircleproject.com for more explanations or express your critisism ;) + +previous modifications not logged sorry ;) + +Known Issues: +-----------------------------------------------------------------------------} +{---------------------------------------------------------------------------- + Last Modified: 05/22/2001 + Current Version: 1.1 + official version + Maintained by InnerCircle + + http://www.innercircleproject.org + + 02/07/2001 + added property handling in Object types + changed handling of forward declarations in ExportedHeading method +-----------------------------------------------------------------------------} +unit CastaliaSimplePasPar; + +{$include ValistusDefines.inc} + +interface + +uses + //!! pruned uses + SysUtils, + Classes, + CastaliaPasLexTypes, + CastaliaPasLex, + CastaliaSimplePasParTypes; + +resourcestring + rsExpected = '''%s'' expected found ''%s'''; + rsEndOfFile = 'end of file'; + +const + + ClassMethodDirectiveEnum = [tokAbstract, tokCdecl, tokDynamic, tokMessage, tokOverride, + tokOverload, tokPascal, tokRegister, tokReintroduce, tokSafeCall, tokStdCall, + tokVirtual, + tokDeprecated, tokLibrary, tokPlatform // DR 2001-10-20 + {$IFDEF D8_NEWER} + , tokStatic //JThurman 2004-11-10 + {$ENDIF} + {$IFDEF D9_NEWER} + , tokInline + {$ENDIF} + ]; //XM 2002-01-29 + +type + ESyntaxError = class(Exception) + private //jdj 7/18/1999 + FPosXY: TTokenPoint; + protected + + public + constructor Create(const Msg: string); + constructor CreateFmt(const Msg: string; const Args: array of const); + constructor CreatePos(const Msg: string; aPosXY: TTokenPoint); + property PosXY: TTokenPoint read FPosXY write FPosXY; + end; + +type + TmwSimplePasPar = class(TObject) + private + fOnMessage: TMessageEvent; + fLexer: TmwPasLex; + fInterfaceOnly: Boolean; + fLastNoJunkPos: Integer; + fLastNoJunkLen: Integer; + + AheadParse: TmwSimplePasPar; + procedure InitAhead; + protected + fInRound: Boolean; + + procedure Expected(Sym: TptTokenKind); virtual; + procedure ExpectedEx(Sym: TptTokenKind); virtual; + procedure ExpectedFatal(Sym: TptTokenKind); virtual; + procedure HandlePtCompDirect(Sender: TmwBasePasLex); virtual; + procedure HandlePtDefineDirect(Sender: TmwBasePasLex); virtual; + procedure HandlePtElseDirect(Sender: TmwBasePasLex); virtual; + procedure HandlePtEndIfDirect(Sender: TmwBasePasLex); virtual; + procedure HandlePtIfDefDirect(Sender: TmwBasePasLex); virtual; + procedure HandlePtIfNDefDirect(Sender: TmwBasePasLex); virtual; + procedure HandlePtIfOptDirect(Sender: TmwBasePasLex); virtual; + procedure HandlePtIncludeDirect(Sender: TmwBasePasLex); virtual; + procedure HandlePtResourceDirect(Sender: TmwBasePasLex); virtual; + procedure HandlePtUndefDirect(Sender: TmwBasePasLex); virtual; + procedure HandlePtIfDirect(Sender: TmwBasePasLex); virtual; + procedure HandlePtIfEndDirect(Sender: TmwBasePasLex); virtual; + procedure HandlePtElseIfDirect(Sender: TmwBasePasLex); virtual; + procedure NextToken; virtual; + procedure SkipJunk; virtual; + procedure TerminateStream(Stream: TCustomMemoryStream); virtual; + procedure SEMICOLON; virtual; + function GetExID: TptTokenKind; virtual; + function GetTokenID: TptTokenKind; virtual; + function GetGenID: TptTokenKind; virtual; + procedure AccessSpecifier; virtual; + procedure AdditiveOperator; virtual; + procedure AncestorIdList; virtual; // !! Added ancestorIdList back in... + procedure AncestorId; virtual; // !! Added ancestorId back in... + procedure AnonymousMethod; virtual; + procedure AnonymousMethodType; virtual; + procedure ArrayConstant; virtual; + procedure ArrayType; virtual; + procedure AsmStatement; virtual; + procedure Block; virtual; + procedure CaseLabel; virtual; + procedure CaseSelector; virtual; + procedure CaseStatement; virtual; + procedure CharString; virtual; + procedure ClassField; virtual; + procedure ClassForward; virtual; + procedure ClassFunctionHeading; virtual; + procedure ClassHeritage; virtual; + procedure ClassMemberList; virtual; + procedure ClassMethodDirective; virtual; + procedure ClassMethodHeading; virtual; + procedure ClassMethodOrProperty; virtual; + procedure ClassMethodResolution; virtual; + procedure ClassProcedureHeading; virtual; + procedure ClassClass; virtual; + procedure ClassProperty; virtual; + procedure ClassReferenceType; virtual; + procedure ClassType; virtual; + procedure ClassTypeEnd; virtual; // DR 2001-07-31 + procedure ClassVisibility; virtual; + procedure CompoundStatement; virtual; + procedure ConstantColon; virtual; + procedure ConstantDeclaration; virtual; + procedure ConstantEqual; virtual; + procedure ConstantExpression; virtual; + procedure ConstantName; virtual; +//JR added constant type + procedure ConstantType; virtual; + procedure ConstantValue; virtual; + procedure ConstantValueTyped; virtual; + procedure ConstParameter; virtual; + procedure ConstructorHeading; virtual; + procedure ConstructorName; virtual; + procedure ConstSection; virtual; + procedure ContainsClause; virtual; + procedure ContainsExpression; virtual; + procedure ContainsIdentifier; virtual; + procedure ContainsStatement; virtual; + {$IFDEF D8_NEWER} + procedure CustomAttribute; virtual; //JThurman 2004-03-03 + {$ENDIF} + procedure DeclarationSection; virtual; + procedure Designator; virtual; + procedure DestructorHeading; virtual; + procedure DestructorName; virtual; + procedure Directive16Bit; virtual; + procedure DirectiveBinding; virtual; + procedure DirectiveCalling; virtual; + procedure DirectiveDeprecated; virtual; // DR 2001-10-20 + procedure DirectiveLibrary; virtual; // DR 2001-10-20 + procedure DirectiveLocal; virtual; // DR 2001-11-14 + procedure DirectivePlatform; virtual; // DR 2001-10-20 + procedure DirectiveVarargs; virtual; // DR 2001-11-14 + procedure DispInterfaceForward; virtual; + procedure DispIDSpecifier; virtual; // DR 2001-07-26 + procedure EmptyStatement; virtual; + procedure EnumeratedType; virtual; + procedure EnumeratedTypeItem; virtual; // DR 2001-10-29 + procedure ExceptBlock; virtual; + procedure ExceptionBlockElseBranch; virtual; + procedure ExceptionClassTypeIdentifier; virtual; + procedure ExceptionHandler; virtual; + procedure ExceptionHandlerList; virtual; + procedure ExceptionIdentifier; virtual; + procedure ExceptionVariable; virtual; + procedure ExplicitType; virtual; // !! changed spelling to "Explicit" + procedure ExportedHeading; virtual; + procedure ExportsClause; virtual; + procedure ExportsElement; virtual; + procedure Expression; virtual; + procedure ExpressionList; virtual; + procedure ExternalDirective; virtual; + procedure ExternalDirectiveThree; virtual; + procedure ExternalDirectiveTwo; virtual; + procedure Factor; virtual; + procedure FieldDeclaration; virtual; + procedure FieldList; virtual; + procedure FieldNameList; virtual; + procedure FieldName; virtual; + procedure FileType; virtual; + procedure FormalParameterList; virtual; + procedure FormalParameterSection; virtual; + procedure ForStatement; virtual; + procedure ForwardDeclaration; virtual; {GLC: corrected spelling} + procedure FunctionHeading; virtual; + procedure FunctionMethodDeclaration; virtual; + procedure FunctionMethodName; virtual; + procedure FunctionProcedureBlock; virtual; + procedure FunctionProcedureName; virtual; + procedure Identifier; virtual; + procedure IdentifierList; virtual; + procedure IfStatement; virtual; + procedure ImplementationSection; virtual; + procedure IncludeFile; virtual; + procedure IndexSpecifier; virtual; // DR 2001-07-26 + procedure InheritedStatement; virtual; + procedure InitializationSection; virtual; + procedure InlineStatement; virtual; + procedure InParameter; virtual; + procedure InterfaceDeclaration; virtual; + procedure InterfaceForward; virtual; + procedure InterfaceGUID; virtual; + procedure InterfaceHeritage; virtual; + procedure InterfaceMemberList; virtual; + procedure InterfaceSection; virtual; + procedure InterfaceType; virtual; + procedure LabelDeclarationSection; virtual; + procedure LabeledStatement; virtual; + procedure LabelId; virtual; + procedure LibraryFile; virtual; + procedure MainUsedUnitExpression; virtual; + procedure MainUsedUnitName; virtual; + procedure MainUsedUnitStatement; virtual; + procedure MainUsesClause; virtual; + procedure MultiplicativeOperator; virtual; + procedure NewFormalParameterType; virtual; + procedure Number; virtual; + procedure ObjectConstructorHeading; virtual; + procedure ObjectDestructorHeading; virtual; + procedure ObjectField; virtual; + procedure ObjectForward; virtual; + procedure ObjectFunctionHeading; virtual; + procedure ObjectHeritage; virtual; + procedure ObjectMemberList; virtual; + procedure ObjectMethodDirective; virtual; + procedure ObjectMethodHeading; virtual; + procedure ObjectNameOfMethod; virtual; + procedure ObjectProperty; virtual; + procedure ObjectPropertySpecifiers; virtual; + procedure ObjectProcedureHeading; virtual; + procedure ObjectType; virtual; + procedure ObjectTypeEnd; virtual; // DR 2001-08-07 + procedure ObjectVisibility; virtual; + procedure OldFormalParameterType; virtual; + procedure OrdinalIdentifier; virtual; + procedure OrdinalType; virtual; + procedure OutParameter; virtual; + procedure PackageFile; virtual; + procedure ParameterFormal; virtual; + procedure ParameterName; virtual; + procedure ParameterNameList; virtual; + procedure ParseFile; virtual; + procedure PointerType; virtual; + procedure ProceduralDirective; virtual; + procedure ProceduralType; virtual; + procedure ProcedureDeclarationSection; virtual; + procedure ProcedureHeading; virtual; + procedure ProcedureMethodDeclaration; virtual; + procedure ProcedureMethodName; virtual; + procedure ProgramBlock; virtual; + procedure ProgramFile; virtual; + procedure PropertyDefault; virtual; + procedure PropertyInterface; virtual; + procedure PropertyName; virtual; + procedure PropertyParameterConst; virtual; + procedure PropertyParameterList; virtual; + procedure PropertySpecifiers; virtual; + procedure QualifiedIdentifier; virtual; + procedure QualifiedIdentifierList; virtual; + procedure RaiseStatement; virtual; + procedure ReadAccessIdentifier; virtual; + procedure RealIdentifier; virtual; + procedure RealType; virtual; + procedure RecordConstant; virtual; + procedure RecordFieldConstant; virtual; + procedure RecordType; virtual; + procedure RecordVariant; virtual; + procedure RelativeOperator; virtual; + procedure RepeatStatement; virtual; + procedure RequiresClause; virtual; + procedure RequiresIdentifier; virtual; + procedure ResolutionInterfaceName; virtual; + procedure ResourceDeclaration; virtual; + procedure ReturnType; virtual; + procedure SetConstructor; virtual; + procedure SetElement; virtual; + procedure SetType; virtual; + procedure SimpleExpression; virtual; + procedure SimpleStatement; virtual; + procedure SimpleType; virtual; + procedure SkipAnsiComment; virtual; + procedure SkipBorComment; virtual; + procedure SkipSlashesComment; virtual; + procedure SkipSpace; virtual; //XM Jul-2000 + procedure SkipCRLFco; virtual; //XM Jul-2000 + procedure SkipCRLF; virtual; //XM Jul-2000 + procedure Statement; virtual; + procedure StatementList; virtual; + procedure StorageExpression; virtual; + procedure StorageIdentifier; virtual; + procedure StorageDefault; virtual; + procedure StorageNoDefault; virtual; + procedure StorageSpecifier; virtual; + procedure StorageStored; virtual; + procedure StringIdentifier; virtual; + procedure StringStatement; virtual; + procedure StringType; virtual; + procedure StructuredType; virtual; + procedure SubrangeType; virtual; + procedure TagField; virtual; + procedure TagFieldName; virtual; + procedure TagFieldTypeName; virtual; + procedure Term; virtual; + procedure TryStatement; virtual; + procedure TypedConstant; virtual; + procedure TypeDeclaration; virtual; + procedure TypeId; virtual; + procedure TypeKind; virtual; + procedure TypeName; virtual; + //generics + procedure TypeArgs; virtual; + procedure TypeParams; virtual; + procedure TypeParamDecl; virtual; + procedure TypeParamDeclList; virtual; + procedure TypeParamList; virtual; + procedure ConstraintList; virtual; + procedure Constraint; virtual; + //end generics + procedure TypeSection; virtual; + procedure UnitFile; virtual; + procedure UnitId; virtual; + procedure UnitName; virtual; + procedure UsedUnitName; virtual; + procedure UsedUnitsList; virtual; + procedure UsesClause; virtual; + procedure VarAbsolute; virtual; + procedure VarEqual; virtual; + procedure VarDeclaration; virtual; + procedure Variable; virtual; + procedure VariableList; virtual; + procedure VariableReference; virtual; + procedure VariableTwo; virtual; + procedure VariantIdentifier; virtual; + procedure VariantSection; virtual; + procedure VarParameter; virtual; + procedure VarName; virtual; //!! Added VarName and VarNameList back in... + procedure VarNameList; virtual; + procedure VarSection; virtual; + procedure VisibilityAutomated; virtual; + procedure VisibilityPrivate; virtual; + procedure VisibilityProtected; virtual; + procedure VisibilityPublic; virtual; + procedure VisibilityPublished; virtual; + procedure VisibilityUnknown; virtual; + procedure WhileStatement; virtual; + procedure WithStatement; virtual; + procedure WriteAccessIdentifier; virtual; + {$IFDEF D8_NEWER}//JThurman 2004-03-21 + {This is the syntax for custom attributes, based quite strictly on the + ECMA syntax specifications for C#, but with a Delphi expression being + used at the bottom as opposed to a C# expression} + procedure GlobalAttributes; + procedure GlobalAttributeSections; + procedure GlobalAttributeSection; + procedure GlobalAttributeTargetSpecifier; + procedure GlobalAttributeTarget; + procedure Attributes; + procedure AttributeSections; + procedure AttributeSection; + procedure AttributeTargetSpecifier; + procedure AttributeTarget; + procedure AttributeList; + procedure Attribute; + procedure AttributeName; + procedure AttributeArguments; + procedure PositionalArgumentList; + procedure PositionalArgument; + procedure NamedArgumentList; + procedure NamedArgument; + procedure AttributeArgumentExpression; + {$ENDIF} + property ExID: TptTokenKind read GetExID; + property GenID: TptTokenKind read GetGenID; + property TokenID: TptTokenKind read GetTokenID; + public + constructor Create; + destructor Destroy; override; + procedure Assign(From: TObject); virtual; + procedure SynError(Error: TmwParseError); virtual; + procedure Run(SourceStream: TCustomMemoryStream; MaxPos: Integer = -1); virtual; + + property InterfaceOnly: Boolean read fInterfaceOnly write fInterfaceOnly; + property Lexer: TmwPasLex read fLexer; + property OnMessage: TMessageEvent read FOnMessage write FOnMessage; + property LastNoJunkPos: Integer read fLastNoJunkPos; + property LastNoJunkLen: Integer read fLastNoJunkLen; + published + end; + +implementation + +{ ESyntaxError } + +constructor ESyntaxError.Create(const Msg: string); +begin + // !! changed initialization for TTokenPoint + FPosXY.X:= -1; + FPosXY.Y:= -1; + inherited Create(Msg); +end; + +constructor ESyntaxError.CreateFmt(const Msg: string; const Args: array of const); +begin + // !! changed initialization for TTokenPoint + FPosXY.X:= -1; + FPosXY.Y:= -1; + inherited CreateFmt(Msg, Args); +end; + +constructor ESyntaxError.CreatePos(const Msg: string; aPosXY: TTokenPoint); +begin + Message := Msg; + FPosXY := aPosXY; +end; + +{ TmwSimplePasPar } +(* DR 2002-01-16 +const + cnExpected = 'Expected ''%s'' found ''%s'''; +// cnOrExpected = 'Expected ''%s'' or ''%s'' found ''%s'''; + cnEndOfFile = 'end of file'; {jdj 7/22/1999} +// cnIntegerOverflow = 'Integer constant too large'; {jdj 7/22/1999} +*) + + {range checks a tokIntegerConst-slightly faster than StrToInt} +{function IsValidInteger(const S: string): Boolean; jdj 7/22/1999 +var jdj removed 02/07/2001 + C: Integer; + N: Integer; +begin + Val(S, N, C); + Result := (C = 0); +end;} + +procedure TmwSimplePasPar.ForwardDeclaration; +begin {jdj added method 02/07/2001} + NextToken; + SEMICOLON; +end; + +procedure TmwSimplePasPar.ObjectProperty; +begin {jdj added method 02/07/2001} + // DR 2001-08-07 -> changed. for array-property override failure + Expected(tokProperty); + PropertyName; + case TokenID of + tokColon, tokSquareOpen: + begin + PropertyInterface; + end; + end; + ObjectPropertySpecifiers; + case ExID of + tokDefault: + begin + PropertyDefault; //DR 2001-07-16 + SEMICOLON; + end; + end; +end; + +procedure TmwSimplePasPar.ObjectPropertySpecifiers; +begin {jdj added method 02/07/2001} + if ExID = tokIndex then + begin + IndexSpecifier; // DR 2001-08-07 + end; + while ExID in [tokRead, tokReadOnly, tokWrite, tokWriteOnly] do + begin + AccessSpecifier; + end; + while ExID in [tokDefault, tokNoDefault, tokStored] do + begin + StorageSpecifier; + end; + SEMICOLON; +end; + +procedure TmwSimplePasPar.Run(SourceStream: TCustomMemoryStream; MaxPos: Integer = -1); +begin + TerminateStream(SourceStream); + fLexer.Origin := SourceStream.Memory; + fLexer.MaxPos := MaxPos; + + ParseFile; +end; + +constructor TmwSimplePasPar.Create; +begin + inherited Create; + fLexer := TmwPasLex.Create; + fLexer.OnCompDirect := {$IFDEF FPC}@{$ENDIF}HandlePtCompDirect; + fLexer.OnDefineDirect := {$IFDEF FPC}@{$ENDIF}HandlePtDefineDirect; + fLexer.OnElseDirect := {$IFDEF FPC}@{$ENDIF}HandlePtElseDirect; + fLexer.OnEndIfDirect := {$IFDEF FPC}@{$ENDIF}HandlePtEndIfDirect; + fLexer.OnIfDefDirect := {$IFDEF FPC}@{$ENDIF}HandlePtIfDefDirect; + fLexer.OnIfNDefDirect := {$IFDEF FPC}@{$ENDIF}HandlePtIfNDefDirect; + fLexer.OnIfOptDirect := {$IFDEF FPC}@{$ENDIF}HandlePtIfOptDirect; + fLexer.OnIncludeDirect := {$IFDEF FPC}@{$ENDIF}HandlePtIncludeDirect; + fLexer.OnResourceDirect := {$IFDEF FPC}@{$ENDIF}HandlePtResourceDirect; + fLexer.OnUnDefDirect := {$IFDEF FPC}@{$ENDIF}HandlePtUndefDirect; + fLexer.OnIfDirect := {$IFDEF FPC}@{$ENDIF}HandlePtIfDirect; + fLexer.OnIfEndDirect := {$IFDEF FPC}@{$ENDIF}HandlePtIfEndDirect; + fLexer.OnElseIfDirect := {$IFDEF FPC}@{$ENDIF}HandlePtElseIfDirect; +end; + +destructor TmwSimplePasPar.Destroy; +begin + FreeAndNil(AheadParse); + FreeAndNil(fLexer); + + inherited; +end; + +procedure TmwSimplePasPar.Assign(From: TObject); +begin + if (From is TmwSimplePasPar) then + with From as TmwSimplePasPar do + begin + Self.Lexer.CloneDefinesFrom(Lexer); + Self.OnMessage := OnMessage; + end; +end; + +{next two check for tokNull and ExpectedFatal for an EOF Error} + +procedure TmwSimplePasPar.Expected(Sym: TptTokenKind); +begin + if Sym <> Lexer.TokenID then + begin + if TokenID = tokNull then + ExpectedFatal(Sym) {jdj 7/22/1999} + else + begin + if Assigned(FOnMessage) then + FOnMessage(Self, meError, Format(rsExpected, [TokenName(Sym), fLexer.Token]), + fLexer.PosXY.X, fLexer.PosXY.Y); + end; + end + else + NextToken; +end; + +procedure TmwSimplePasPar.ExpectedEx(Sym: TptTokenKind); +begin + if Sym <> Lexer.ExID then + begin + if Lexer.TokenID = tokNull then + ExpectedFatal(Sym) {jdj 7/22/1999} + else if Assigned(FOnMessage) then + FOnMessage(Self, meError, Format(rsExpected, ['EX:' + TokenName(Sym), fLexer.Token]), + fLexer.PosXY.X, fLexer.PosXY.Y); + end + else + NextToken; +end; + +{Replace Token with cnEndOfFile if TokenId = toknull} + +procedure TmwSimplePasPar.ExpectedFatal(Sym: TptTokenKind); +var + tS: string; +begin + if Sym <> Lexer.TokenID then + begin + {--jdj 7/22/1999--} + if Lexer.TokenId = tokNull then + tS := rsEndOfFile + else + tS := fLexer.Token; + {--jdj 7/22/1999--} + raise ESyntaxError.CreatePos(Format(rsExpected, [TokenName(Sym), tS]), fLexer.PosXY); + end + else + NextToken; +end; + +procedure TmwSimplePasPar.HandlePtCompDirect(Sender: TmwBasePasLex); +begin + if Assigned(FOnMessage) then + FOnMessage(Self, meNotSupported, 'Currently not supported ' + fLexer.Token, fLexer.PosXY.X, fLexer.PosXY.Y); + + Sender.Next; //XM Jul-2000 + { ToDo } +end; + +procedure TmwSimplePasPar.HandlePtDefineDirect(Sender: TmwBasePasLex); +begin + Sender.Next; //XM Jul-2000 +end; + +procedure TmwSimplePasPar.HandlePtElseDirect(Sender: TmwBasePasLex); +begin + if Sender = Lexer then + NextToken + else + Sender.Next; //XM Jul-2000 + { ToDo } +end; + +procedure TmwSimplePasPar.HandlePtElseIfDirect(Sender: TmwBasePasLex); +begin + if Sender = Lexer then + NextToken + else + Sender.Next; +end; + +procedure TmwSimplePasPar.HandlePtEndIfDirect(Sender: TmwBasePasLex); +begin + if Sender = Lexer then + NextToken + else + Sender.Next; //XM Jul-2000 + + { ToDo } +end; + +procedure TmwSimplePasPar.HandlePtIfDefDirect(Sender: TmwBasePasLex); +begin + if Sender = Lexer then + NextToken + else + Sender.Next; //XM Jul-2000 + + { ToDo } +end; + +procedure TmwSimplePasPar.HandlePtIfDirect(Sender: TmwBasePasLex); +begin + if Sender = Lexer then + NextToken + else + Sender.Next; +end; + +procedure TmwSimplePasPar.HandlePtIfEndDirect(Sender: TmwBasePasLex); +begin + if Sender = Lexer then + NextToken + else + Sender.Next; +end; + +procedure TmwSimplePasPar.HandlePtIfNDefDirect(Sender: TmwBasePasLex); +begin + if Sender = Lexer then + NextToken + else + Sender.Next; //XM Jul-2000 + + { ToDo } +end; + +procedure TmwSimplePasPar.HandlePtIfOptDirect(Sender: TmwBasePasLex); +begin + if Assigned(FOnMessage) then + FOnMessage(Self, meNotSupported, 'Currently not supported ' + fLexer.Token, fLexer.PosXY.X, fLexer.PosXY.Y); + + Sender.Next; //XM Jul-2000 + + { ToDo } +end; + +procedure TmwSimplePasPar.HandlePtIncludeDirect(Sender: TmwBasePasLex); +begin + if Assigned(FOnMessage) then + FOnMessage(Self, meNotSupported, 'Currently not supported ' + fLexer.Token, fLexer.PosXY.X, fLexer.PosXY.Y); + + Sender.Next; //XM Jul-2000 + + { ToDo } +end; + +procedure TmwSimplePasPar.HandlePtResourceDirect(Sender: TmwBasePasLex); +begin + if Assigned(FOnMessage) then + FOnMessage(Self, meNotSupported, 'Currently not supported ' + fLexer.Token, fLexer.PosXY.X, fLexer.PosXY.Y); + + Sender.Next; //XM Jul-2000 + + { ToDo } +end; + +procedure TmwSimplePasPar.HandlePtUndefDirect(Sender: TmwBasePasLex); +begin + Sender.Next; //XM Jul-2000 + + { ToDo } +end; + +procedure TmwSimplePasPar.NextToken; +begin + FLexer.NextNoJunk; +end; + +procedure TmwSimplePasPar.SkipJunk; +begin + if Lexer.IsJunk then + begin + case TokenID of + tokAnsiComment: + begin + SkipAnsiComment; + end; + tokBorComment: + begin + SkipBorComment; + end; + tokSlashesComment: + begin + SkipSlashesComment; + end; + tokSpace: + begin + SkipSpace; //XM Jul-2000 + end; + tokCRLFCo: + begin + SkipCRLFco; + end; + tokCRLF: + begin + SkipCRLF; + end; + {$IFDEF D8_NEWER} //JThurman 2004-3-19 + tokSquareOpen: + begin + CustomAttribute; + end; + {$ENDIF} + else + begin + Lexer.Next; + end; + end; + end; + fLastNoJunkPos := Lexer.TokenPos; + fLastNoJunkLen := Lexer.TokenLen; +end; + +procedure TmwSimplePasPar.SkipAnsiComment; +begin + Expected(tokAnsiComment); + while TokenID in [tokAnsiComment] do + Lexer.Next; +end; + +procedure TmwSimplePasPar.SkipBorComment; +begin + Expected(tokBorComment); + while TokenID in [tokBorComment] do + Lexer.Next; +end; + +procedure TmwSimplePasPar.SkipSlashesComment; +begin + Expected(tokSlashesComment); +end; + +procedure TmwSimplePasPar.TerminateStream(Stream: TCustomMemoryStream); +var + aChar: Char; +begin + Stream.Position := Stream.Size; + aChar := #0; + Stream.Write(aChar, SizeOf(char)); +end; + +procedure TmwSimplePasPar.SEMICOLON; +begin + case Lexer.TokenID of + tokElse, tokEnd, tokExcept, tokfinally, tokFinalization, tokRoundClose, tokUntil: // jdj 2.23.20001 added tokFinalization + ; + else + Expected(tokSemiColon); + //Check for semicolon before else - common syntax error - JT 11.10.2007 + //Doesn't work here - it fails a CASE statement +// if Lexer.TokenID = tokElse then +// begin +// if Assigned(FOnMessage) then +// begin +// FOnMessage(Self, meError, ''';'' not allowed before ''ELSE''', +// FLexer.PosXY.X, FLexer.PosXY.Y); +// end; +// end; + end; +end; + +function TmwSimplePasPar.GetExID: TptTokenKind; +begin + Result := fLexer.ExID; +end; + +function TmwSimplePasPar.GetTokenID: TptTokenKind; +begin + Result := fLexer.TokenID; +end; + +function TmwSimplePasPar.GetGenID: TptTokenKind; +begin + Result := fLexer.GenID; +end; + +procedure TmwSimplePasPar.SynError(Error: TmwParseError); +begin + if Assigned(FOnMessage) then + FOnMessage(Self, meError, ParserErrorName(Error) + ' found ' + fLexer.Token, fLexer.PosXY.X, + fLexer.PosXY.Y); + +end; + +(****************************************************************************** + This part is oriented at the official grammar of Delphi 4 + and parialy based on Robert Zierers Delphi grammar. + For more information about Delphi grammars take a look at: + http://www.stud.mw.tu-muenchen.de/~rz1/Grammar.html +******************************************************************************) + +procedure TmwSimplePasPar.ParseFile; +//var +// I: Integer; +begin +// OutputDebugString('ParseFile'); + + SkipJunk; + case GenID of + tokLibrary: + begin + LibraryFile; + end; + tokPackage: + begin + PackageFile; + end; + tokProgram: + begin + ProgramFile; + end; + tokUnit: + begin + UnitFile; + end; + else + begin + IncludeFile; + end; + end; +end; + +procedure TmwSimplePasPar.LibraryFile; +begin + Expected(tokLibrary); + Expected(tokIdentifier); + SEMICOLON; + ProgramBlock; + Expected(tokPoint); +end; + +procedure TmwSimplePasPar.PackageFile; +begin + ExpectedEx(tokPackage); + Expected(tokIdentifier); + + {$IFDEF D8_NEWER} + while Lexer.TokenID = tokPoint do + begin + NextToken; + Expected(tokIdentifier); + end; + {$ENDIF} + + SEMICOLON; + case ExID of + tokRequires: + begin + RequiresClause; + end; + end; + case ExID of + tokContains: + begin + ContainsClause; + end; + end; + + {$IFDEF D8_NEWER} + while Lexer.TokenID = tokSquareOpen do + begin + CustomAttribute; + end; + {$ENDIF} + + Expected(tokEnd); + Expected(tokPoint); +end; + +procedure TmwSimplePasPar.ProgramFile; +begin + // DR 2002-01-11 + Expected(tokProgram); + QualifiedIdentifier; + if TokenID = tokRoundOpen then + begin + NextToken; + IdentifierList; + Expected(tokRoundClose); + end; + if not InterfaceOnly then + begin + SEMICOLON; + ProgramBlock; + Expected(tokPoint); + end; +end; + +procedure TmwSimplePasPar.UnitFile; +begin + // DR 2002-01-11 + +//?? + Expected(tokUnit); + UnitName; + + while ExID in [tokDeprecated, tokLibrary, tokPlatform] do + case ExID of + tokDeprecated: DirectiveDeprecated; + tokLibrary: DirectiveLibrary; + tokPlatform: DirectivePlatform; + end; + + SEMICOLON; + InterfaceSection; + if not InterfaceOnly then + begin + ImplementationSection; + InitializationSection; + Expected(tokPoint); + end; +end; + +procedure TmwSimplePasPar.ProgramBlock; +begin + if TokenID = tokUses then + begin + MainUsesClause; + end; + Block; +end; + +procedure TmwSimplePasPar.MainUsesClause; +begin + Expected(tokUses); + MainUsedUnitStatement; + while TokenID = tokComma do + begin + NextToken; + MainUsedUnitStatement; + end; + SEMICOLON; +end; + +procedure TmwSimplePasPar.MainUsedUnitStatement; +begin + MainUsedUnitName; + if Lexer.TokenID = tokIn then + begin + NextToken; + MainUsedUnitExpression; + end; +end; + +procedure TmwSimplePasPar.MainUsedUnitName; +begin +// Expected(tokIdentifier); + UsedUnitName; //JThurman 2004-11-10 +end; + +procedure TmwSimplePasPar.MainUsedUnitExpression; +begin + ConstantExpression; +end; + +procedure TmwSimplePasPar.UsesClause; +begin + Expected(tokUses); + UsedUnitsList; + SEMICOLON; +end; + +procedure TmwSimplePasPar.UsedUnitsList; +begin + UsedUnitName; + while TokenID = tokComma do + begin + NextToken; + UsedUnitName; + end; +end; + +procedure TmwSimplePasPar.UsedUnitName; +begin + {$IFDEF D8_NEWER} //JThurman 2004-03-03 + Expected(tokIdentifier); + while TokenID = tokPoint do + begin + NextToken; + Expected(tokIdentifier); + end; + {$ELSE} + Expected(tokIdentifier); + {$ENDIF} +end; + +procedure TmwSimplePasPar.Block; +begin + while TokenID in [tokClass, tokConst, tokConstructor, tokDestructor, tokExports, + tokFunction, tokLabel, tokProcedure, tokResourceString, tokThreadVar, tokType, + tokVar{$IFDEF D8_NEWER}, tokSquareOpen{$ENDIF}] do + begin + DeclarationSection; + end; + case TokenID of + tokAsm: + begin + AsmStatement; + end; + else + begin + CompoundStatement; + end; + end; +end; + +procedure TmwSimplePasPar.DeclarationSection; +begin + case TokenID of + tokClass: + begin + ProcedureDeclarationSection; + end; + tokConst: + begin + ConstSection; + end; + tokConstructor: + begin + ProcedureDeclarationSection; + end; + tokDestructor: + begin + ProcedureDeclarationSection; + end; + tokExports: + begin + ExportsClause; + end; + tokFunction: + begin + ProcedureDeclarationSection; + end; + tokLabel: + begin + LabelDeclarationSection; + end; + tokProcedure: + begin + ProcedureDeclarationSection; + end; + tokResourceString: + begin + ConstSection; + end; + tokType: + begin + TypeSection; + end; + tokThreadVar: + begin + VarSection; + end; + tokVar: + begin + VarSection; + end; + {$IFDEF D8_NEWER} //JThurman + tokSquareOpen: + begin + CustomAttribute; + end; + {$ENDIF} + else + begin + SynError(InvalidDeclarationSection); + end; + end; +end; + +procedure TmwSimplePasPar.UnitId; +begin + Expected(tokIdentifier); +end; + +procedure TmwSimplePasPar.UnitName; +begin + Expected(tokIdentifier); + while Lexer.TokenID = tokPoint do + begin + NextToken; + Expected(tokIdentifier); + end; +end; + +procedure TmwSimplePasPar.InterfaceHeritage; +begin + Expected(tokRoundOpen); + AncestorIdList; // JR moved qualified check into ancestorIdList // DR 2001-11-01 can also be qualified! + Expected(tokRoundClose); +end; + +procedure TmwSimplePasPar.InterfaceGUID; +begin + Expected(tokSquareOpen); + CharString; + Expected(tokSquareClose); +end; + +procedure TmwSimplePasPar.AccessSpecifier; +begin + case ExID of + tokRead: + begin + NextToken; + ReadAccessIdentifier; + end; + tokWrite: + begin + NextToken; + WriteAccessIdentifier; + end; + tokReadOnly: + begin + NextToken; + end; + tokWriteOnly: + begin + NextToken; + end; + {$IFDEF D8_NEWER} + tokAdd: + begin + NextToken; + QualifiedIdentifier; //TODO: AddAccessIdentifier + end; + tokRemove: + begin + NextToken; + QualifiedIdentifier; //TODO: RemoveAccessIdentifier + end; + {$ENDIF} + else + begin + SynError(InvalidAccessSpecifier); + end; + end; +end; + +procedure TmwSimplePasPar.ReadAccessIdentifier; +begin + QualifiedIdentifier; + (* XM removed at Martin suggestion. Martin send a more general fix in QualifiedIdentifier + //jdj 12/05/2000 + if (TokenID = tokSquareOpen) then + begin + ConstantExpression; + end; + //jdj 12/05/2000*) +end; + +procedure TmwSimplePasPar.WriteAccessIdentifier; +begin + QualifiedIdentifier; + (* XM removed at Martin suggestion. Martin send a more general fix in QualifiedIdentifier + //jdj 12/05/2000 + if (TokenID = tokSquareOpen) then + begin + ConstantExpression; + end; + //jdj 12/05/2000*) +end; + +procedure TmwSimplePasPar.StorageSpecifier; +begin + case ExID of + tokStored: + begin + StorageStored; + end; + tokDefault: + begin + StorageDefault; + end; + tokNoDefault: + begin + StorageNoDefault; + end + else + begin + SynError(InvalidStorageSpecifier); + end; + end; +end; + +procedure TmwSimplePasPar.StorageDefault; +begin + ExpectedEx(tokDefault); + StorageExpression; +end; + +procedure TmwSimplePasPar.StorageNoDefault; +begin + ExpectedEx(tokNoDefault); +end; + +procedure TmwSimplePasPar.StorageStored; +begin + ExpectedEx(tokStored); + case TokenID of + tokIdentifier: + begin + StorageIdentifier; + end; + else + if TokenID <> tokSemiColon then + begin + StorageExpression; + end; + end; +end; + +procedure TmwSimplePasPar.StorageExpression; +begin + ConstantExpression; +end; + +procedure TmwSimplePasPar.StorageIdentifier; +begin + Expected(tokIdentifier); +end; + +procedure TmwSimplePasPar.PropertyParameterList; +//changed James Jacobson on 20001221 +begin + Expected(tokSquareOpen); + if TokenID = tokConst then + begin + PropertyParameterConst; + end; + IdentifierList; + Expected(tokColon); + TypeId; + while TokenID = tokSemiColon do + begin + SEMICOLON; + if TokenID = tokConst then + begin //jdj 12-21-2000 + PropertyParameterConst; + end; + IdentifierList; + Expected(tokColon); + TypeId; + end; + Expected(tokSquareClose); +end; + +(*begin + Expected(tokSquareOpen); + if TokenID = tokConst then + begin + PropertyParameterConst; + end; + IdentifierList; + Expected(tokColon); + TypeId; + while TokenID = tokSemiColon do + begin + SEMICOLON; + IdentifierList; + Expected(tokColon); + TypeId; + end; + Expected(tokSquareClose); +end;*) + +procedure TmwSimplePasPar.PropertyParameterConst; +begin + Expected(tokConst); +end; + +procedure TmwSimplePasPar.PropertySpecifiers; +begin + if ExID = tokIndex then + begin + IndexSpecifier; // DR 2001-07-26 + end; + while ExID in [tokRead, tokReadOnly, tokWrite, tokWriteOnly + {$IFDEF D8_NEWER}, tokAdd, tokRemove{$ENDIF}] do + begin + AccessSpecifier; + end; + if ExID = tokDispId then + begin + DispIDSpecifier; // DR 2001-07-26 + end; + while ExID in [tokDefault, tokNoDefault, tokStored] do + begin + StorageSpecifier; + end; + if ExID = tokImplements then + begin + NextToken; + QualifiedIdentifierList; + end; + SEMICOLON; +end; + +procedure TmwSimplePasPar.PropertyInterface; +begin + if TokenID = tokSquareOpen then + begin + PropertyParameterList; + end; + Expected(tokColon); + TypeID; +end; + +procedure TmwSimplePasPar.ClassMethodHeading; +begin + case TokenID of + tokConstructor: + begin + ConstructorHeading; + end; + tokDestructor: + begin + DestructorHeading; + end; + {$IFDEF D8_NEWER} //JThurman 2004-03-2003 + tokFunction, tokIdentifier: + begin + if (TokenID = tokIdentifier) and (Lexer.ExID <> tokOperator) then + Expected(tokOperator); + {$ELSE} + tokFunction: + begin + {$ENDIF} + Lexer.InitAhead; + Lexer.AheadNext; + case Lexer.AheadTokenID of + tokPoint: + begin + ClassMethodResolution; + end; + else + begin + ClassFunctionHeading; + end; + end; + end; + tokProcedure: + begin + Lexer.InitAhead; + Lexer.AheadNext; + case Lexer.AheadTokenID of + tokPoint: + begin + ClassMethodResolution; + end; + else + begin + ClassProcedureHeading; + end; + end; + end; + else + SynError(InvalidClassMethodHeading); + end; +end; + +procedure TmwSimplePasPar.ClassFunctionHeading; +begin + {$IFDEF D8_NEWER} //JThurman 2004-03-2003 + if (TokenID = tokIdentifier) and (Lexer.ExID = tokOperator) then + Expected(tokIdentifier) else + {$ENDIF} + Expected(tokFunction); + FunctionMethodName; + if TokenID = tokRoundOpen then + begin + FormalParameterList; + end; + Expected(tokColon); + ReturnType; + if TokenId = tokSemicolon then // DR 2002-01-14 + SEMICOLON; + if ExID = tokDispId then + begin + DispIDSpecifier; // DR 2001-07-26 + if TokenId = tokSemicolon then // DR 2002-01-14 + SEMICOLON; + end; + if ExID in ClassMethodDirectiveEnum //XM 2002-01-29 + then ClassMethodDirective; //XM 2002-01-26 +end; + +procedure TmwSimplePasPar.FunctionMethodName; +begin + Expected(tokIdentifier); +end; + +procedure TmwSimplePasPar.ClassProcedureHeading; +begin + Expected(tokProcedure); + ProcedureMethodName; + if TokenID = tokRoundOpen then + begin + FormalParameterList; + end; + + if TokenId = tokSemicolon then // DR 2002-01-14 + SEMICOLON; + + if ExID = tokDispId then + begin + DispIDSpecifier; // DR 2001-07-26 + if TokenId = tokSemicolon then // DR 2002-01-14 + SEMICOLON; + end; + if exID in ClassMethodDirectiveEnum then // XM 2002-01-29 + ClassMethodDirective; +end; + +procedure TmwSimplePasPar.ProcedureMethodName; +begin + Expected(tokIdentifier); +end; + +procedure TmwSimplePasPar.ClassMethodResolution; +begin + case TokenID of + tokFunction: + begin + NextToken; + end; + tokProcedure: + begin + NextToken; + end; + {$IFDEF D8_NEWER} //JThurman 2004-03-2003 + tokIdentifier: + begin + if Lexer.ExID = tokOperator then + NextToken; + end; + {$ENDIF} + end; + ResolutionInterfaceName; + Expected(tokPoint); + Expected(tokIdentifier); + Expected(tokEqual); + Expected(tokIdentifier); + SEMICOLON; +end; + +procedure TmwSimplePasPar.ResolutionInterfaceName; +begin + Expected(tokIdentifier); +end; + +procedure TmwSimplePasPar.Constraint; +begin + while TokenId in [tokConstructor, tokRecord, tokClass, tokIdentifier] do + begin + case TokenId of + tokConstructor, tokRecord, tokClass: NextToken; + tokIdentifier: TypeId; + end; + if TokenId = tokComma then + NextToken; + end; +end; + +procedure TmwSimplePasPar.ConstraintList; +begin + Constraint; + while TokenId = tokComma do + begin + Constraint; + end; +end; + +procedure TmwSimplePasPar.ConstructorHeading; +begin + Expected(tokConstructor); + ConstructorName; + if TokenID = tokRoundOpen then + begin + FormalParameterList; + end; + SEMICOLON; + ClassMethodDirective; +end; + +procedure TmwSimplePasPar.ConstructorName; +begin + Expected(tokIdentifier); +end; + +procedure TmwSimplePasPar.DestructorHeading; +begin + Expected(tokDestructor); + DestructorName; + if TokenID = tokRoundOpen then + begin + FormalParameterList; + end; + SEMICOLON; + ClassMethodDirective; +end; + +procedure TmwSimplePasPar.DestructorName; +begin + Expected(tokIdentifier); +end; + +procedure TmwSimplePasPar.ClassMethodDirective; +begin + while ExId in ClassMethodDirectiveEnum do + begin + ProceduralDirective; + if TokenId = tokSemicolon then // DR 2002-01-14 + SEMICOLON; + end; +end; + +procedure TmwSimplePasPar.ObjectMethodHeading; +begin + case TokenID of + tokConstructor: + begin + ObjectConstructorHeading; + end; + tokDestructor: + begin + ObjectDestructorHeading; + end; + tokFunction: + begin + ObjectFunctionHeading; + end; + tokProcedure: + begin + ObjectProcedureHeading; + end; + else + begin + SynError(InvalidMethodHeading); + end; + end; +end; + +procedure TmwSimplePasPar.ObjectFunctionHeading; +begin + Expected(tokFunction); + FunctionMethodName; + if TokenID = tokRoundOpen then + begin + FormalParameterList; + end; + Expected(tokColon); + ReturnType; + if TokenID = tokSemiColon then SEMICOLON; + ObjectMethodDirective; +end; + +procedure TmwSimplePasPar.ObjectProcedureHeading; +begin + Expected(tokProcedure); + ProcedureMethodName; + if TokenID = tokRoundOpen then + begin + FormalParameterList; + end; + if TokenID = tokSemiColon then SEMICOLON; + ObjectMethodDirective; +end; + +procedure TmwSimplePasPar.ObjectConstructorHeading; +begin + Expected(tokConstructor); + ConstructorName; + if TokenID = tokRoundOpen then + begin + FormalParameterList; + end; + if TokenID = tokSemiColon then SEMICOLON; + ObjectMethodDirective; +end; + +procedure TmwSimplePasPar.ObjectDestructorHeading; +begin + Expected(tokDestructor); + DestructorName; + if TokenID = tokRoundOpen then + begin + FormalParameterList; + end; + if TokenID = tokSemiColon then SEMICOLON; + ObjectMethodDirective; +end; + +procedure TmwSimplePasPar.ObjectMethodDirective; +begin + while ExID in [tokAbstract, tokCdecl, tokDynamic, tokExport, tokExternal, tokFar, + tokMessage, tokNear, + tokOverload, // DR 2001-08-07 + tokPascal, tokRegister, tokSafeCall, tokStdCall, tokVirtual, + tokDeprecated, tokLibrary, tokPlatform // DR 2001-10-20 + {$IFDEF D8_NEWER} + , tokStatic + {$ENDIF} + {$IFDEF D9_NEWER} + , tokInline + {$ENDIF} + ] do + begin + ProceduralDirective; + if TokenID = tokSemiColon then SEMICOLON; + end; +end; + +procedure TmwSimplePasPar.Directive16Bit; +begin + case ExID of + tokNear: + begin + NextToken; + end; + tokFar: + begin + NextToken; + end; + tokExport: + begin + NextToken; + end; + else + begin + SynError(InvalidDirective16Bit); + end; + end; +end; + +procedure TmwSimplePasPar.DirectiveBinding; +begin + case ExID of + tokVirtual: + begin + NextToken; + end; + tokDynamic: + begin + NextToken; + end; + tokMessage: + begin + NextToken; + ConstantExpression; + end; + tokOverride: + begin + NextToken; + end; + tokOverload: + begin + NextToken; + end; + tokReintroduce: + begin + NextToken; + end; + else + begin + SynError(InvalidDirectiveBinding); + end; + end; +end; + +procedure TmwSimplePasPar.ReturnType; +begin + {$IFDEF D8_NEWER} + while TokenID = tokSquareOpen do + CustomAttribute; + {$ENDIF} + case TokenID of + tokString: + begin + StringType; + end; + else + begin + TypeID; + end; + end; +end; + +procedure TmwSimplePasPar.FormalParameterList; +begin + Expected(tokRoundOpen); + FormalParameterSection; + while TokenID = tokSemiColon do + begin + SEMICOLON; + FormalParameterSection; + end; + Expected(tokRoundClose); +end; + +procedure TmwSimplePasPar.FormalParameterSection; +begin + {$IFDEF D8_NEWER}//JThurman 2004-03-23 + while TokenID = tokSquareOpen do + CustomAttribute; + {$ENDIF} + case TokenID of + tokConst: + begin + ConstParameter; + end; + tokIdentifier: + case ExID of + tokOut: OutParameter; + else + ParameterFormal; + end; + tokIn: + begin + InParameter; + end; + tokVar: + begin + VarParameter; + end; + end; +end; + +procedure TmwSimplePasPar.ConstParameter; +begin + Expected(tokConst); + ParameterNameList; + case TokenID of + tokColon: + begin + NextToken; + NewFormalParameterType; + if TokenID = tokEqual then + begin + NextToken; + TypedConstant; + end; + end + end; +end; + +procedure TmwSimplePasPar.VarParameter; +begin + Expected(tokVar); + ParameterNameList; + case TokenID of + tokColon: + begin + NextToken; + NewFormalParameterType; + end + end; +end; + +procedure TmwSimplePasPar.OutParameter; +begin + ExpectedEx(tokOut); + ParameterNameList; + case TokenID of + tokColon: + begin + NextToken; + NewFormalParameterType; + end + end; +end; + +procedure TmwSimplePasPar.ParameterFormal; +begin + case TokenID of + tokIdentifier: + begin + ParameterNameList; + + case TokenID of + tokColon: + begin + NextToken; + NewFormalParameterType; + if TokenID = tokEqual then + begin + NextToken; + TypedConstant; + end; + end + end; + + {Expected(tokColon); + NewFormalParameterType; + if TokenID = tokEqual then + begin + NextToken; + TypedConstant; + end;} + end; + else + begin + SynError(InvalidParameter); + end; + end; +end; + +procedure TmwSimplePasPar.ParameterNameList; +begin + ParameterName; + while TokenID = tokComma do + begin + NextToken; + ParameterName; + end; +end; + +procedure TmwSimplePasPar.ParameterName; +begin + Expected(tokIdentifier); +end; + +procedure TmwSimplePasPar.NewFormalParameterType; +begin + case TokenID of + tokArray: + begin + NextToken; + Expected(tokOf); + case TokenID of + tokConst: (*new in ObjectPascal80*) + begin + NextToken; + end; + else + begin + OldFormalParameterType; + end; + end; + end; + else + begin + OldFormalParameterType; + end; + end; +end; + +procedure TmwSimplePasPar.OldFormalParameterType; +begin + case TokenID of + tokString: + begin + NextToken; + end; + tokFile: + begin + FileType; + end; + else + begin + TypeID; + end; + end; +end; + +procedure TmwSimplePasPar.FunctionMethodDeclaration; +begin + {$IFDEF D8_NEWER} //JThurman 2004-03-2003 + if (TokenID = tokIdentifier) and (Lexer.ExID = tokOperator) then + NextToken else + {$ENDIF} + Expected(tokFunction); + Lexer.InitAhead; + if Lexer.AheadTokenID in [tokPoint, tokLower] then + begin + ObjectNameOfMethod; + Expected(tokPoint); + end; + FunctionProcedureName; + if TokenID = tokRoundOpen then + begin + FormalParameterList; + end; + case TokenID of + tokSemiColon: + begin + FunctionProcedureBlock; + end; + else + begin + Expected(tokColon); + ReturnType; + FunctionProcedureBlock; + end; + end; +end; + +procedure TmwSimplePasPar.ProcedureMethodDeclaration; +begin + case TokenID of + tokConstructor: + begin + NextToken; + end; + tokDestructor: + begin + NextToken; + end; + tokProcedure: + begin + NextToken; + end; + else + begin + SynError(InvalidProcedureMethodDeclaration); + end; + end; + Lexer.InitAhead; + if Lexer.AheadTokenID in [tokPoint, tokLower] then + begin + ObjectNameOfMethod; + Expected(tokPoint); + end; + FunctionProcedureName; + if TokenID = tokRoundOpen then + begin + FormalParameterList; + end; + FunctionProcedureBlock; +end; + +procedure TmwSimplePasPar.FunctionProcedureName; +begin + Expected(tokIdentifier); +end; + +procedure TmwSimplePasPar.ObjectNameOfMethod; +begin + Expected(tokIdentifier); + {$IFDEF D8_NEWER} //JThurman 2004-03-22 + if TokenId = tokLower then + TypeParams; + Lexer.InitAHead; + Lexer.AheadNext; + if Lexer.AheadTokenID = tokPoint then + begin + Expected(tokPoint); + ObjectNameOfMethod; + end; + {$ENDIF} +end; + +procedure TmwSimplePasPar.FunctionProcedureBlock; +var + NoExternal: Boolean; +begin + NoExternal := True; + if TokenID = tokSemiColon + then SEMICOLON; + case ExID of + tokForward: + ForwardDeclaration; // DR 2001-07-23 + else + while ExID in [tokAbstract, tokCdecl, tokDynamic, tokExport, tokExternal, tokFar, + tokMessage, tokNear, tokOverload, tokOverride, tokPascal, tokRegister, + tokReintroduce, tokSafeCall, tokStdCall, tokVirtual, + tokDeprecated, tokLibrary, tokPlatform, // DR 2001-10-20 + tokLocal, tokVarargs, + tokAssembler //JT 2004-10-29 + {$IFDEF D8_NEWER} + , tokStatic + {$ENDIF} + {$IFDEF D9_NEWER} + , tokInline + {$ENDIF} + ] // DR 2001-11-14 + do + begin + case ExId of + tokExternal: + begin + ProceduralDirective; + if TokenID = tokSemiColon then SEMICOLON; + NoExternal := False; + end; + else + begin + ProceduralDirective; + if TokenID = tokSemiColon then SEMICOLON; + end; + end; + end; + if ExID = tokForward then + ForwardDeclaration // DR 2001-07-23 + else if NoExternal then + begin + if ExId = tokAssembler then + begin + NextToken; + SEMICOLON; + end; + case TokenID of + tokAsm: + begin + AsmStatement; + end; + else + begin + Block; + end; + end; + SEMICOLON; + end; + end; +end; + +procedure TmwSimplePasPar.ExternalDirective; +begin + ExpectedEx(tokExternal); + case TokenID of + tokSemiColon: + begin + SEMICOLON; + end; + else + begin + SimpleExpression; + ExternalDirectiveTwo; + end; + end; +end; + +procedure TmwSimplePasPar.ExternalDirectiveTwo; +begin + case fLexer.ExID of + tokIndex: + begin + NextToken; + end; + tokName: + begin + NextToken; + SimpleExpression; + end; + tokSemiColon: + begin + SEMICOLON; + ExternalDirectiveThree; + end; + end +end; + +procedure TmwSimplePasPar.ExternalDirectiveThree; +begin + case TokenID of + tokMinus: + begin + NextToken; + end; + end; + case TokenID of + tokIdentifier, tokIntegerConst: + begin + NextToken; + end; + end; +end; + +procedure TmwSimplePasPar.ForStatement; +begin + Expected(tokFor); + QualifiedIdentifier; + {$IFDEF D8_NEWER} + if Lexer.TokenID = tokAssign then + begin + Expected(tokAssign); + Expression; + case TokenID of + tokTo: + begin + NextToken; + end; + tokDownTo: + begin + NextToken; + end; + else + begin + SynError(InvalidForStatement); + end; + end; + Expression; + end else + if Lexer.TokenID = tokIn then + begin + Expected(tokIn); + //QualifiedIdentifier; + Expression; + end; + {$ELSE} + Expected(tokAssign); + Expression; + case TokenID of + tokTo: + begin + NextToken; + end; + tokDownTo: + begin + NextToken; + end; + else + begin + SynError(InvalidForStatement); + end; + end; + Expression; + {$ENDIF} + Expected(tokDo); + Statement; +end; + +procedure TmwSimplePasPar.WhileStatement; +begin + Expected(tokWhile); + Expression; + Expected(tokDo); + Statement; +end; + +procedure TmwSimplePasPar.RepeatStatement; +begin + Expected(tokRepeat); + StatementList; + Expected(tokUntil); + Expression; +end; + +procedure TmwSimplePasPar.CaseStatement; +begin + Expected(tokCase); + Expression; + Expected(tokOf); + CaseSelector; + while TokenID = tokSemiColon do + begin + SEMICOLON; + case TokenID of + tokElse, tokEnd: ; + else + CaseSelector; + end; + end; + if TokenID = tokElse then + begin + NextToken; + StatementList; + SEMICOLON; + end; + Expected(tokEnd); +end; + +procedure TmwSimplePasPar.CaseSelector; +begin + CaseLabel; + while TokenID = tokComma do + begin + NextToken; + CaseLabel; + end; + Expected(tokColon); + case TokenID of + tokSemiColon: ; + else + Statement; + end; +end; + +procedure TmwSimplePasPar.CaseLabel; +begin + ConstantExpression; + if TokenID = tokDotDot then + begin + NextToken; + ConstantExpression; + end; +end; + +procedure TmwSimplePasPar.IfStatement; +begin + Expected(tokIf); + Expression; + Expected(tokThen); + Statement; + //This breaks if you have an if statement immediately preceding the else + //clause of a case statement +{ Lexer.InitAhead; + if (TokenID = tokSemicolon) and (Lexer.AheadTokenID = tokElse) then + begin + if Assigned(FOnMessage) then + begin + FOnMessage(Self, meError, ''';'' not allowed before ''ELSE''', + FLexer.PosXY.X, FLexer.PosXY.Y); + end; + end;} + if TokenID = tokElse then + begin + NextToken; + Statement; + end; +end; + +procedure TmwSimplePasPar.ExceptBlock; +begin + case ExID of + tokOn: + begin + ExceptionHandlerList; + ExceptionBlockElseBranch + end; + else + begin + StatementList; + end; + end; +end; + +procedure TmwSimplePasPar.ExceptionHandlerList; +begin + while fLexer.ExID = tokOn do + begin + ExceptionHandler; + SEMICOLON; + end; +end; + +procedure TmwSimplePasPar.ExceptionHandler; +begin + ExpectedEx(tokOn); + ExceptionIdentifier; + Expected(tokDo); + Statement; +end; + +procedure TmwSimplePasPar.ExceptionBlockElseBranch; +begin + case TokenID of + tokElse: + begin + NextToken; + StatementList; + end; + end; +end; + +procedure TmwSimplePasPar.ExceptionIdentifier; +begin + Lexer.InitAhead; + case Lexer.AheadTokenID of + tokPoint: + begin + ExceptionClassTypeIdentifier; + end; + else + begin + ExceptionVariable; + case Lexer.TokenID of + tokColon: + begin + NextToken; + ExceptionClassTypeIdentifier; + end; + end; + end; + end; +end; + +procedure TmwSimplePasPar.ExceptionClassTypeIdentifier; +begin + QualifiedIdentifier; +end; + +procedure TmwSimplePasPar.ExceptionVariable; +begin + Expected(tokIdentifier); +end; + +procedure TmwSimplePasPar.InlineStatement; +begin + Expected(tokInline); + Expected(tokRoundOpen); + Expected(tokIntegerConst); + while (TokenID = tokSlash) do + begin + NextToken; + Expected(tokIntegerConst); + end; + Expected(tokRoundClose); +end; + +procedure TmwSimplePasPar.InParameter; +begin + Expected(tokIn); + ParameterNameList; + case TokenID of + tokColon: + begin + NextToken; + NewFormalParameterType; + if TokenID = tokEqual then + begin + NextToken; + TypedConstant; + end; + end + end; +end; + +procedure TmwSimplePasPar.AsmStatement; +begin + Lexer.AsmCode := True; + Expected(tokAsm); + { should be replaced with a Assembler lexer } + while TokenID <> tokEnd do + case fLexer.TokenID of + tokBegin, tokCase, tokEnd, tokIf, tokFunction, tokProcedure, tokRepeat, tokwhile: break; + tokAddressOp: + begin + NextToken; + NextToken; + end; + tokDoubleAddressOp: + begin + NextToken; + NextToken; + end; + tokNull: //JThurman 10-26-2004. Need another way out of this. + begin + Expected(tokEnd); + Exit; + end; + else + NextToken; + end; + Lexer.AsmCode := False; + Expected(tokEnd); +end; + +procedure TmwSimplePasPar.RaiseStatement; +begin + Expected(tokRaise); + case TokenID of + tokAddressOp, tokDoubleAddressOp, tokIdentifier, tokPointerSymbol, tokRoundOpen: + begin + Designator; + end; + end; + if ExID = tokAt then + begin + NextToken; + Expression; + end; +end; + +procedure TmwSimplePasPar.TryStatement; +begin + Expected(tokTry); + StatementList; + case TokenID of + tokExcept: + begin + NextToken; + ExceptBlock; + + if (TokenID = tokFinally) then + begin + NextToken; + StateMentList; + end; + + Expected(tokEnd); + end; + tokFinally: + begin + NextToken; + StatementList; + + if (TokenID = tokExcept) then + begin + NextToken; + StateMentList; + end; + + Expected(tokEnd); + end; + else + begin + SynError(InvalidTryStatement); + end; + end; +end; + +procedure TmwSimplePasPar.WithStatement; +begin + Expected(tokWith); + VariableList; + Expected(tokDo); + Statement; +end; + +procedure TmwSimplePasPar.VariableList; +begin + VariableReference; (* acessing func.recordfield not allowed here;as well as UNITNAMEID *) + while fLexer.TokenID = tokComma do + begin + NextToken; + VariableReference; + end; +end; + +procedure TmwSimplePasPar.StatementList; +begin {removed tokIntegerConst jdj-Put back in for labels} + while TokenID in [tokAddressOp, tokAsm, tokBegin, tokCase, tokDoubleAddressOp, + tokFor, tokGoTo, tokIdentifier, tokIf, tokInherited, tokInline, tokIntegerConst, + tokPointerSymbol, tokRaise, tokRoundOpen, tokRepeat, tokSemiColon, tokString, + tokTry, tokWhile, tokWith] do + begin + Statement; + SEMICOLON; + end; +end; + +procedure TmwSimplePasPar.SimpleStatement; +begin + case TokenID of + tokAddressOp, tokDoubleAddressOp, tokIdentifier, tokPointerSymbol, tokRoundOpen: + begin + Designator; + if TokenID = tokAssign then + begin + NextToken; + if TokenID = tokInherited then + begin + NextToken; + end; + Expression; + end; + end; + tokGoTo: + begin + NextToken; + LabelId; + end; + end; +end; + +procedure TmwSimplePasPar.Statement; +begin + case TokenID of + tokAsm: + begin + AsmStatement; + end; + tokBegin: + begin + CompoundStatement; + end; + tokCase: + begin + CaseStatement; + end; + tokFor: + begin + ForStatement; + end; + tokIf: + begin + IfStatement; + end; + tokIdentifier: + begin + fLexer.InitAhead; + case Lexer.AheadTokenID of + tokColon: + begin + LabeledStatement; + end; + else + begin + SimpleStatement; + end; + end; + end; + tokInherited: + begin + InheritedStatement; + end; + tokInLine: + begin + InlineStatement; + end; + tokIntegerConst: + begin + fLexer.InitAhead; + case Lexer.AheadTokenID of + tokColon: + begin + LabeledStatement; + end; + else + begin + SynError(InvalidLabeledStatement); + NextToken; + end; + end; + end; + tokRepeat: + begin + RepeatStatement; + end; + tokRaise: + begin + RaiseStatement; + end; + tokSemiColon: + begin + EmptyStatement; + end; + tokString: + begin + StringStatement; + end; + tokTry: + begin + TryStatement; + end; + tokWhile: + begin + WhileStatement; + end; + tokWith: + begin + WithStatement; + end; + else + begin + SimpleStatement; + end; + end; +end; + +procedure TmwSimplePasPar.EmptyStatement; +begin + { Nothing to do here. + The semicolon will be removed in StatementList } +end; + +procedure TmwSimplePasPar.InheritedStatement; +begin + Expected(tokInherited); + case TokenID of + tokSemiColon: ; + else + begin + Statement; + end; + end; +end; + +procedure TmwSimplePasPar.LabeledStatement; +begin + case TokenID of + tokIdentifier: + begin + NextToken; + Expected(tokColon); + Statement; + end; + tokIntegerConst: + begin + NextToken; + Expected(tokColon); + Statement; + end; + else + begin + SynError(InvalidLabeledStatement); + end; + end; +end; + +procedure TmwSimplePasPar.StringStatement; +begin + Expected(tokString); + Statement; +end; + +procedure TmwSimplePasPar.SetElement; +begin + Expression; + if TokenID = tokDotDot then + begin + NextToken; + Expression; + end; +end; + +procedure TmwSimplePasPar.QualifiedIdentifier; +begin //mw 12/7/2000 + Expected(tokIdentifier); + case TokenID of + tokPoint: + begin + while TokenID = tokPoint do + begin //jdj 1/7/2001 + NextToken; + {$IFDEF D8_NEWER} + if TokenID in [tokAnd, tokArray, tokAs, tokASM, tokBegin, tokCase, tokClass, + tokConst, tokConstructor, tokDestructor, tokDispInterface, tokDiv, tokDo, + tokDOwnto, tokElse, tokEnd, tokExcept, tokExports, tokFile, tokFinal, + tokFinalization, tokFinally, tokFor, tokFunction, tokGoto, tokIf, + tokImplementation, tokIn, tokInherited, tokInitialization, tokInline, + tokInterface, tokIs, tokLabel, tokLibrary, tokMod, tokNil, tokNot, tokObject, + tokOf, tokOr, tokOut, tokPacked, tokProcedure, tokProgram, tokProperty, + tokRaise, tokRecord, tokRepeat, tokResourceString, tokSealed, tokSet, + tokShl, tokShr, tokStatic, tokString, tokThen, tokThreadVar, tokTo, tokTry, + tokType, tokUnit, tokUnsafe, tokUntil, tokUses, tokVar, tokWhile, tokWith, + tokXor] then + NextToken + else + {$ENDIF} + Expected(tokIdentifier); + if (TokenID = tokSquareOpen) then + begin + ConstantExpression; + end; + end; + end; + tokSquareOpen: + begin + ConstantExpression; + end; + end; +(* Expected(tokIdentifier); // old code for information removed in next versions + case TokenID of + tokPoint: + begin + NextToken; + Expected(tokIdentifier); + if (TokenID = tokSquareOpen) then + begin + ConstantExpression; + end; + end; + tokSquareOpen: {MW 20001207} + begin + ConstantExpression; + end; + end;*) + +end; + +procedure TmwSimplePasPar.SetConstructor; +begin + Expected(tokSquareOpen); + SetElement; + while TokenID = tokComma do + begin + NextToken; + SetElement; + end; + Expected(tokSquareClose); +end; + +procedure TmwSimplePasPar.Number; +begin + case TokenID of + tokFloat: + begin + NextToken; + end; + tokIntegerConst: + begin + NextToken; + end; + tokIdentifier: + begin + NextToken; + end; + else + begin + SynError(InvalidNumber); + end; + end; +end; + +procedure TmwSimplePasPar.ExpressionList; +begin + Expression; + if TokenID = tokAssign then //JT Nov 26, 2004 - supporting ole automation syntax + begin + Expected(tokAssign); + Expression; + end; + while TokenID = tokComma do + begin + NextToken; + Expression; + if TokenID = tokAssign then //JT Nov 26, 2004 - supporting ole automation syntax + begin + Expected(tokAssign); + Expression; + end; + end; +end; + +procedure TmwSimplePasPar.Designator; +begin + VariableReference; +end; + +procedure TmwSimplePasPar.MultiplicativeOperator; +begin + case TokenID of + tokAnd: + begin + NextToken; + end; + tokDiv: + begin + NextToken; + end; + tokMod: + begin + NextToken; + end; + tokShl: + begin + NextToken; + end; + tokShr: + begin + NextToken; + end; + tokSlash: + begin + NextToken; + end; + tokStar: + begin + NextToken; + end; + else + begin SynError(InvalidMultiplicativeOperator); + end; + end; +end; + +procedure TmwSimplePasPar.Factor; +begin + case TokenID of + tokAsciiChar, tokStringConst: + begin + CharString; + end; + tokAddressOp, tokDoubleAddressOp, tokIdentifier, tokInherited, tokPointerSymbol, + tokRoundOpen: + begin + Designator; + end; + tokIntegerConst, tokFloat: + begin + Number; + end; + tokNil: + begin + NextToken; + end; + tokMinus: + begin + NextToken; + Factor; + end; + tokNot: + begin + NextToken; + Factor; + end; + tokPlus: + begin + NextToken; + Factor; + end; + tokSquareOpen: + begin + SetConstructor; + end; + tokString: + begin + NextToken; + Factor; + end; + tokFunction, tokProcedure: + AnonymousMethod; + end; +end; + +procedure TmwSimplePasPar.AdditiveOperator; +begin + if TokenID in [tokMinus, tokOr, tokPlus, tokXor] then + begin + NextToken; // DR 2001-12-19 + { + case TokenID of + tokMinus, tokPlus: + begin + while TokenID in [tokMinus, tokPlus] do + case TokenID of + tokMinus: + begin + NextToken; + end; + tokPlus: + begin + NextToken; + end; + end; + end; + tokOr: + begin + NextToken; + end; + tokXor: + begin + NextToken; + end; + end;} + end + else + begin + SynError(InvalidAdditiveOperator); + end; +end; + +procedure TmwSimplePasPar.Term; +begin + Factor; + while TokenID in [tokAnd, tokDiv, tokMod, tokShl, tokShr, tokSlash, tokStar] do + begin + MultiplicativeOperator; + Factor; + end; +end; + +procedure TmwSimplePasPar.RelativeOperator; +begin + case TokenID of + tokAs: + begin + NextToken; + end; + tokEqual: + begin + NextToken; + end; + tokGreater: + begin + NextToken; + end; + tokGreaterEqual: + begin + NextToken; + end; + tokIn: + begin + NextToken; + end; + tokIs: + begin + NextToken; + end; + tokLower: + begin + NextToken; + end; + tokLowerEqual: + begin + NextToken; + end; + tokNotEqual: + begin + NextToken; + end; + else + begin + SynError(InvalidRelativeOperator); + end; + end; +end; + +procedure TmwSimplePasPar.SimpleExpression; +begin +(* while TokenID in [tokMinus, tokPlus] do + begin + NextToken; // DR 2001-12-19 + end; +*) + Term; + while TokenID in [tokMinus, tokOr, tokPlus, tokXor] do + begin + AdditiveOperator; + Term; + end; +end; + +procedure TmwSimplePasPar.Expression; +begin + SimpleExpression; + + //JT 2006-07-17 The Delphi language guide has this as + //Expression -> SimpleExpression [RelOp SimpleExpression]... + //So this needs to be able to repeat itself. + case TokenID of + tokEqual, tokGreater, tokGreaterEqual, tokLower, tokLowerEqual, tokIn, tokIs, + tokNotEqual: + begin + while TokenID in [tokEqual, tokGreater, tokGreaterEqual, tokLower, tokLowerEqual, + tokIn, tokIs, tokNotEqual{, tokColon}] do + begin + RelativeOperator; + SimpleExpression; + end; + end; + tokColon: + begin + case fInRound of + False: ; + True: + while TokenID = tokColon do + begin + NextToken; + SimpleExpression; + end; + end; + end; + end; +end; + +procedure TmwSimplePasPar.VarDeclaration; +begin + // !! Changed back to var name list from IdentifierList + VarNameList; + Expected(tokColon); + TypeKind; + while ExID in [tokDeprecated, tokLibrary, tokPlatform] do // DR 2001-10-20 + case ExID of + tokDeprecated: DirectiveDeprecated; + tokLibrary: DirectiveLibrary; + tokPlatform: DirectivePlatform; + end; + case GenID of + tokAbsolute: + begin + VarAbsolute; + end; + tokEqual: + begin + VarEqual; + end; + end; + while ExID in [tokDeprecated, tokLibrary, tokPlatform] do // DR 2001-10-20 + case ExID of + tokDeprecated: DirectiveDeprecated; + tokLibrary: DirectiveLibrary; + tokPlatform: DirectivePlatform; + end; +end; + +procedure TmwSimplePasPar.VarAbsolute; +begin + ExpectedEx(tokAbsolute); + ConstantValue; +end; + +procedure TmwSimplePasPar.VarEqual; +begin + Expected(tokEqual); + ConstantValueTyped; +end; + +procedure TmwSimplePasPar.VarNameList; +begin + VarName; + while TokenID = tokComma do + begin + NextToken; + VarName; + end; +end; + +procedure TmwSimplePasPar.VarName; +begin + Expected(tokIdentifier); +end; + +procedure TmwSimplePasPar.DirectiveCalling; +begin + case ExID of + tokCdecl: + begin + NextToken; + end; + tokPascal: + begin + NextToken; + end; + tokRegister: + begin + NextToken; + end; + tokSafeCall: + begin + NextToken; + end; + tokStdCall: + begin + NextToken; + end; + else + begin + SynError(InvalidDirectiveCalling); + end; + end; +end; + +procedure TmwSimplePasPar.RecordVariant; +begin + ConstantExpression; + while (TokenID = tokComma) do + begin + NextToken; + ConstantExpression; + end; + Expected(tokColon); + Expected(tokRoundOpen); + if TokenID <> tokRoundClose then + begin + FieldList; + end; + Expected(tokRoundClose); +end; + +procedure TmwSimplePasPar.VariantSection; +begin + Expected(tokCase); + TagField; + Expected(tokOf); + RecordVariant; + while TokenID = tokSemiColon do + begin + SEMICOLON; + case TokenID of //DR 2001-12-11 + tokEnd, tokRoundClose: Break; + else + RecordVariant; + end; + end; +end; + +procedure TmwSimplePasPar.TagField; +begin + TagFieldName; + case fLexer.TokenID of + tokColon: + begin + NextToken; + TagFieldTypeName; + end; + end; +end; + +procedure TmwSimplePasPar.TagFieldName; +begin + Expected(tokIdentifier); +end; + +procedure TmwSimplePasPar.TagFieldTypeName; +begin + QualifiedIdentifier; +end; + +procedure TmwSimplePasPar.FieldDeclaration; +begin + //IdentifierList; + FieldNameList; + Expected(tokColon); + TypeKind; + while ExID in [tokDeprecated, tokLibrary, tokPlatform] do // DR 2002-01-09 + case ExID of + tokDeprecated: DirectiveDeprecated; + tokLibrary: DirectiveLibrary; + tokPlatform: DirectivePlatform; + end; +end; + +procedure TmwSimplePasPar.FieldList; +begin + while TokenID = tokIdentifier do + begin + FieldDeclaration; + SEMICOLON; + end; + if TokenID = tokCase then + begin + VariantSection; + end; +end; + +procedure TmwSimplePasPar.FieldName; +begin + Expected(tokIdentifier); +end; + +procedure TmwSimplePasPar.FieldNameList; +begin + FieldName; + while TokenID = tokComma do + begin + NextToken; + FieldName; + end; +end; + +procedure TmwSimplePasPar.RecordType; +begin + Expected(tokRecord); + if TokenID = tokSemicolon then + Exit; + {$IFDEF D8_NEWER1} + if TokenID = tokRoundOpen then + begin + ClassHeritage; + if TokenID = tokSemicolon then + Exit; + end; + ClassMemberList; + {$ELSE} + FieldList; + {$ENDIF} + Expected(tokEnd); +end; + +procedure TmwSimplePasPar.FileType; +begin + Expected(tokFile); + if TokenID = tokOf then + begin + NextToken; + TypeId; + end; +end; + +procedure TmwSimplePasPar.SetType; +begin + Expected(tokSet); + Expected(tokOf); + OrdinalType; +end; + +procedure TmwSimplePasPar.ArrayType; +begin + Expected(tokArray); + if TokenID = tokSquareOpen then + begin + NextToken; + OrdinalType; + while TokenID = tokComma do + begin + NextToken; + OrdinalType; + end; + Expected(tokSquareClose); + end; + Expected(tokOf); + TypeKind; +end; + +procedure TmwSimplePasPar.EnumeratedType; +begin + Expected(tokRoundOpen); + EnumeratedTypeItem; + while TokenID = tokComma do + begin + NextToken; + EnumeratedTypeItem; + end; + Expected(tokRoundClose); +end; + +procedure TmwSimplePasPar.SubrangeType; +begin + ConstantExpression; + if TokenID = tokDotDot then + begin + NextToken; + ConstantExpression; + end; +end; + +procedure TmwSimplePasPar.RealIdentifier; +begin + case ExID of + tokReal48: + begin + NextToken; + end; + tokReal: + begin + NextToken; + end; + tokSingle: + begin + NextToken; + end; + tokDouble: + begin + NextToken; + end; + tokExtended: + begin + NextToken; + end; + tokCurrency: + begin + NextToken; + end; + tokComp: + begin + NextToken; + end; + else + begin + SynError(InvalidRealIdentifier); + end; + end; +end; + +procedure TmwSimplePasPar.RealType; +begin + case TokenID of + tokMinus: + begin + NextToken; + end; + tokPlus: + begin + NextToken; + end; + end; + case TokenId of + tokFloat: + begin + NextToken; + end; + else + begin + VariableReference; + end; + end; +end; + +procedure TmwSimplePasPar.OrdinalIdentifier; +begin + case ExID of + tokBoolean: + begin + NextToken; + end; + tokByte: + begin + NextToken; + end; + tokBytebool: + begin + NextToken; + end; + tokCardinal: + begin + NextToken; + end; + tokChar: + begin + NextToken; + end; + tokDWord: + begin + NextToken; + end; + tokInt64: + begin + NextToken; + end; + tokInteger: + begin + NextToken; + end; + tokLongBool: + begin + NextToken; + end; + tokLongInt: + begin + NextToken; + end; + tokLongWord: + begin + NextToken; + end; + tokPChar: + begin + NextToken; + end; + tokShortInt: + begin + NextToken; + end; + tokSmallInt: + begin + NextToken; + end; + tokWideChar: + begin + NextToken; + end; + tokWord: + begin + NextToken; + end; + tokWordbool: + begin + NextToken; + end; + else + begin + SynError(InvalidOrdinalIdentifier); + end; + end; +end; + +procedure TmwSimplePasPar.OrdinalType; +begin + case TokenID of + tokIdentifier: + begin + Lexer.InitAhead; + case Lexer.AheadTokenID of + tokPoint: + begin + Expression; + end; + tokRoundOpen: + begin //jdj + ConstantExpression; + end; + else + begin + TypeID; + end; + end; + end; + tokRoundOpen: + begin + EnumeratedType; + end; + tokSquareOpen: + begin + NextToken; + SubrangeType; + Expected(tokSquareClose); + end; + else + begin + Expression; + end; + end; + if TokenID = tokDotDot then + begin + NextToken; + ConstantExpression; + end; +end; + +procedure TmwSimplePasPar.VariableReference; +begin + case TokenID of + tokAddressOp: + begin + NextToken; + variable; + end; + tokDoubleAddressOp: + begin + NextToken; + variable; + end; + tokPointerSymbol: + begin + NextToken; + case TokenID of + tokRoundClose, tokSquareClose: ; + else + begin + variable; + end; + end; + end; + else + variable; + end; +end; + +procedure TmwSimplePasPar.Variable; (* Attention: could also came from proc_call ! ! *) +begin + case TokenID of + tokInherited: + begin + NextToken; + QualifiedIdentifier; + end; + tokPoint: + begin + VariableTwo; + end; + tokPointerSymbol: + begin + VariableTwo; + end; + tokRoundOpen: + begin + VariableTwo; + end; + tokSquareOpen: + begin + VariableTwo; + end; +//{$IFDEF D11_NEWER} +// tokLower: +// begin +// VariableTwo; +// end; +//{$ENDIF} + else + QualifiedIdentifier; + end; + VariableTwo; + case TokenID of + tokAs: + begin + NextToken; + QualifiedIdentifier; + end; + end; +end; + +procedure TmwSimplePasPar.VariableTwo; +begin + case TokenID of + tokPoint: + begin + NextToken; + case TokenID of + tokAddressOp, tokDoubleAddressOp, tokIdentifier: + begin + VariableReference; + end; + tokPointerSymbol, tokRoundOpen, tokSquareOpen: + begin + VariableTwo; + end; + end; + end; + tokPointerSymbol: + begin + NextToken; + case TokenID of + tokAddressOp, tokDoubleAddressOp, tokIdentifier: + begin + VariableReference; + end; + tokPoint, tokPointerSymbol, tokRoundOpen, tokSquareOpen: + begin + VariableTwo; + end; + end; + end; + tokRoundOpen: + begin + NextToken; + fInRound := True; + case TokenID of + tokRoundClose: + begin + NextToken; + //Expected(tokRoundClose); + fInRound := False; + end; + else + begin + case TokenID of + tokAddressOp, tokDoubleAddressOp: + begin + VariableReference; + end; + tokPoint, tokPointerSymbol, tokRoundOpen, tokSquareOpen: + begin + VariableTwo; + end; + end; + fInRound := True; + ExpressionList; + fInRound := True; + Expected(tokRoundClose); + fInRound := False; + end; + end; + case TokenID of + tokAddressOp, tokDoubleAddressOp: + begin + VariableReference; + end; + tokPoint, tokPointerSymbol, tokRoundOpen, tokSquareOpen: + begin + VariableTwo; + end; + end; + end; + tokSquareOpen: + begin + Lexer.InitAhead; + while Lexer.AheadTokenID <> tokSemiColon do + begin + case Lexer.AheadTokenID of + tokBegin, tokClass, tokConst, tokEnd, tokDotDot, tokIn, tokNull, tokThreadVar, tokType, + tokVar: break; + else + Lexer.AheadNext; + end; + end; + case Lexer.AheadTokenID of + tokDotDot: + begin + SubrangeType; + end; + else + begin + NextToken; + case TokenID of + tokSquareClose: + begin + NextToken; + end; + else + begin + case TokenID of + tokAddressOp, tokDoubleAddressOp: + begin + VariableReference; + end; + tokPoint, tokPointerSymbol, tokRoundOpen, tokSquareOpen: + begin + VariableTwo; + end; + end; + ExpressionList; + Expected(tokSquareClose); + end; + end; + case TokenID of + tokAddressOp, tokDoubleAddressOp: + begin + VariableReference; + end; + tokPoint, tokPointerSymbol, tokRoundOpen, tokSquareOpen: + begin + VariableTwo; + end; + end; + + end; + end; + end; + {$IFDEF D11_NEWER} + tokLower: + begin + InitAhead; + AheadParse.NextToken; + AheadParse.TypeKind; + + if AheadParse.TokenId = tokGreater then + begin + NextToken; + TypeKind; + Expected(tokGreater); + case TokenID of + tokAddressOp, tokDoubleAddressOp, tokIdentifier: + begin + VariableReference; + end; + tokPoint, tokPointerSymbol, tokRoundOpen, tokSquareOpen: + begin + VariableTwo; + end; + end; + end; + end; + {$ENDIF} + end; +end; + +procedure TmwSimplePasPar.InterfaceType; +begin + case TokenID of + tokInterface: + begin + NextToken; + end; + tokDispInterface: + begin + NextToken; + end + else + begin + SynError(InvalidInterfaceType); + end; + end; + case TokenID of + tokEnd: + begin + NextToken; { Direct descendant without new members } + end; + tokRoundOpen: + begin + InterfaceHeritage; + case TokenID of + tokEnd: + begin + NextToken; { No new members } + end; + tokSemiColon: ; { No new members } + else + begin + if TokenID = tokSquareOpen then + begin + InterfaceGUID; + end; + InterfaceMemberList; + Expected(tokEnd); + end; + end; + end; + else + begin + if TokenID = tokSquareOpen then + begin + InterfaceGUID; + end; + InterfaceMemberList; { Direct descendant } + Expected(tokEnd); + end; + end; +end; + +procedure TmwSimplePasPar.InterfaceMemberList; +begin + while TokenID in [tokFunction, tokProcedure, tokProperty] do + begin + ClassMethodOrProperty; + end; +end; + +procedure TmwSimplePasPar.ClassType; +begin + Expected(tokClass); + {$IFDEF D8_NEWER} //JThurman 2004-03-19 + case TokenID of + tokIdentifier: //NASTY hack because Abstract is generally an ExID, except in this case when it should be a keyword. + case Lexer.ExID of + tokAbstract: ExpectedEx(tokAbstract); + tokHelper: + begin + ExpectedEx(tokHelper); + Expected(tokFor); + Expected(tokIdentifier); + end; + end; + tokSealed: + Expected(tokSealed); + end; + {$ENDIF} + case TokenID of + tokEnd: + begin + ClassTypeEnd; // DR 2001-07-31 + NextToken; { Direct descendant of TObject without new members } + end; + tokRoundOpen: + begin + ClassHeritage; + case TokenID of + tokEnd: + begin + Expected(tokEnd); // DR 2001-07-31 + ClassTypeEnd; // DR 2001-07-31 + end; + tokSemiColon: ClassTypeEnd; // DR 2001-07-31 + else + begin + ClassMemberList; { Direct descendant of TObject } + Expected(tokEnd); // DR 2001-07-31 + ClassTypeEnd; // DR 2001-07-31 + end; + end; + end; + else + begin + ClassMemberList; { Direct descendant of TObject } + Expected(tokEnd); // DR 2001-07-31 + ClassTypeEnd; // DR 2001-07-31 + end; + end; +end; + +procedure TmwSimplePasPar.ClassHeritage; +begin + Expected(tokRoundOpen); + AncestorIdList; + Expected(tokRoundClose); +end; + +procedure TmwSimplePasPar.ClassVisibility; +begin + {$IFDEF D8_NEWER} //JThurman 2004-03-03 + if TokenID = tokStrict then + Expected(tokStrict); + {$ENDIF} + while ExID in [tokAutomated, tokPrivate, tokProtected, tokPublic, tokPublished] do + begin + Lexer.InitAhead; + case Lexer.AheadExID of + tokColon, tokComma: ; + else + case ExID of + tokAutomated: + begin + VisibilityAutomated; + end; + tokPrivate: + begin + VisibilityPrivate; + end; + tokProtected: + begin + VisibilityProtected; + end; + tokPublic: + begin + VisibilityPublic; + end; + tokPublished: + begin + VisibilityPublished; + end; + end; + end; + end; +end; + +procedure TmwSimplePasPar.VisibilityAutomated; +begin + ExpectedEx(tokAutomated); +end; + +procedure TmwSimplePasPar.VisibilityPrivate; +begin + ExpectedEx(tokPrivate); +end; + +procedure TmwSimplePasPar.VisibilityProtected; +begin + ExpectedEx(tokProtected); +end; + +procedure TmwSimplePasPar.VisibilityPublic; +begin + ExpectedEx(tokPublic); +end; + +procedure TmwSimplePasPar.VisibilityPublished; +begin + ExpectedEx(tokPublished); +end; + +procedure TmwSimplePasPar.VisibilityUnknown; +begin + // +end; + +procedure TmwSimplePasPar.ClassMemberList; +begin + ClassVisibility; + while TokenID in [tokClass, tokConstructor, tokDestructor, tokFunction, + tokIdentifier, tokProcedure, tokProperty + {$IFDEF D8_NEWER}, tokType, tokSquareOpen, tokVar, tokConst, tokStrict, + tokCase{$ENDIF}] do + begin + while (TokenID = tokIdentifier) and + not (ExID in [tokPrivate, tokProtected, tokPublished, tokPublic]) do + begin + ClassField; + SEMICOLON; + ClassVisibility; + end; + while TokenID in [tokClass, tokConstructor, tokDestructor, tokFunction, + tokProcedure, tokProperty{$IFDEF D8_NEWER}, tokSquareOpen, tokVar, tokConst{$ENDIF}] do + begin + ClassMethodOrProperty; + end; + {$IFDEF D8_NEWER}//JThurman 2004-03-22 + {Nested types for D8} + while TokenID = tokType do + TypeSection; + while TokenID = tokCase do + begin + VariantSection; + end; + {$ENDIF} + ClassVisibility; + end; +end; + +procedure TmwSimplePasPar.ClassMethodOrProperty; +begin + {$IFDEF D8_NEWER} + if TokenID = tokSquareOpen then + CustomAttribute; + {$ENDIF} + if TokenID = tokClass + then ClassClass; //DR 2001-07-16 + case TokenID of + tokProperty: + begin + ClassProperty; + end; + {$IFDEF D8_NEWER} + tokVar: + begin + NextToken; + while (TokenID = tokIdentifier) and (ExID = tokUnknown) do + begin + ClassField; + SemiColon; + end; + end; + tokConst: + begin + NextToken; + while (TokenID = tokIdentifier) and (ExID = tokUnknown) do + begin + ConstantDeclaration; + SemiColon; + end; + end; + {$ENDIF} + else + begin + ClassMethodHeading; + end; + end; +end; + +procedure TmwSimplePasPar.ClassProperty; +begin + // DR 2001-07-19 -> changed. for array-property override failure + Expected(tokProperty); + PropertyName; + case TokenID of + tokColon, tokSquareOpen: + begin + PropertyInterface; + end; + end; + PropertySpecifiers; + case ExID of + tokDefault: + begin + PropertyDefault; //DR 2001-07-16 + SEMICOLON; + end; + end; +end; + +procedure TmwSimplePasPar.PropertyName; +begin + Expected(tokIdentifier); +end; + +procedure TmwSimplePasPar.ClassField; +begin + //IdentifierList; + FieldNameList; + Expected(tokColon); + TypeKind; + while ExID in [tokDeprecated, tokLibrary, tokPlatform] do // DR 2001-10-20 + case ExID of + tokDeprecated: DirectiveDeprecated; + tokLibrary: DirectiveLibrary; + tokPlatform: DirectivePlatform; + end; +end; + +procedure TmwSimplePasPar.ObjectType; +begin + Expected(tokObject); + case TokenID of + tokEnd: + begin + ObjectTypeEnd; // DR 2001-07-31 + NextToken; { Direct descendant without new members } + end; + tokRoundOpen: + begin + ObjectHeritage; + case TokenID of + tokEnd: + begin + Expected(tokEnd); // DR 2001-07-31 + ObjectTypeEnd; // DR 2001-07-31 + end; + tokSemiColon: ObjectTypeEnd; // DR 2001-07-31 + else + begin + ObjectMemberList; { Direct descendant } + Expected(tokEnd); // DR 2001-07-31 + ObjectTypeEnd; // DR 2001-07-31 + end; + end; + end; + else + begin + ObjectMemberList; { Direct descendant } + Expected(tokEnd); // DR 2001-07-31 + ObjectTypeEnd; // DR 2001-07-31 + end; + end; +end; + +procedure TmwSimplePasPar.ObjectHeritage; +begin + Expected(tokRoundOpen); + AncestorIdList; + Expected(tokRoundClose); +end; + +procedure TmwSimplePasPar.ObjectMemberList; +begin {jdj added tokProperty-call to ObjectProperty 02/07/2001} + ObjectVisibility; + while TokenID in [tokConstructor, tokDestructor, tokFunction, tokIdentifier, + tokProcedure, tokProperty] do + begin + while TokenID = tokIdentifier do + begin + ObjectField; + SEMICOLON; + ObjectVisibility; + end; + while TokenID in [tokConstructor, tokDestructor, tokFunction, tokProcedure, tokProperty] do + begin + case TokenID of + tokConstructor, tokDestructor, tokFunction, tokProcedure: + ObjectMethodHeading; + tokProperty: + ObjectProperty; + end; + end; + ObjectVisibility; + end; +end; + +procedure TmwSimplePasPar.ObjectVisibility; +begin + while ExID in [tokPrivate, tokProtected, tokPublic] do + begin + Lexer.InitAhead; + case Lexer.AheadExID of + tokColon, tokComma: ; + else + case ExID of + tokPrivate: + begin + VisibilityPrivate; + end; + tokProtected: + begin + VisibilityProtected; + end; + tokPublic: + begin + VisibilityPublic; + end; + end; + end; + end; +end; + +procedure TmwSimplePasPar.ObjectField; +begin + IdentifierList; + Expected(tokColon); + TypeKind; + while ExID in [tokDeprecated, tokLibrary, tokPlatform] do // DR 2001-10-20 + case ExID of + tokDeprecated: DirectiveDeprecated; + tokLibrary: DirectiveLibrary; + tokPlatform: DirectivePlatform; + end; +end; + +procedure TmwSimplePasPar.ClassReferenceType; +begin + Expected(tokClass); + Expected(tokOf); + TypeId; +end; + +procedure TmwSimplePasPar.VariantIdentifier; +begin + case ExID of + tokOleVariant: + begin + NextToken; + end; + tokVariant: + begin + NextToken; + end; + else + begin + SynError(InvalidVariantIdentifier); + end; + end; +end; + +procedure TmwSimplePasPar.ProceduralType; +var + TheTokenID: TptTokenKind; +begin + case TokenID of + tokFunction: + begin + NextToken; + if TokenID = tokRoundOpen then + begin + FormalParameterList; + end; + Expected(tokColon); + ReturnType; + end; + tokProcedure: + begin + NextToken; + if TokenID = tokRoundOpen then + begin + FormalParameterList; + end; + end; + else + begin + SynError(InvalidProceduralType); + end; + end; + if TokenID = tokOf then + begin + NextToken; + Expected(tokObject); + end; + Lexer.InitAhead; + case TokenID of + tokSemiColon: TheTokenID := Lexer.AheadExID; + else + TheTokenID := ExID; + end; + while TheTokenID in [tokAbstract, tokCdecl, tokDynamic, tokExport, tokExternal, tokFar, + tokMessage, tokNear, tokOverload, tokOverride, tokPascal, tokRegister, + tokReintroduce, tokSafeCall, tokStdCall, tokVirtual + {$IFDEF D8_NEWER}, tokStatic{$ENDIF}{$IFDEF D9_NEWER}, tokInline{$ENDIF} + ] do + // DR 2001-11-14 no checking for deprecated etc. since it's captured by the typedecl + begin + if TokenID = tokSemiColon then SEMICOLON; + ProceduralDirective; + Lexer.InitAhead; + case TokenID of + tokSemiColon: TheTokenID := Lexer.AheadExID; + else + TheTokenID := ExID; + end; + end; +end; + +procedure TmwSimplePasPar.StringIdentifier; +begin + case ExID of + tokAnsiString: + begin + NextToken; + end; + tokShortString: + begin + NextToken; + end; + tokWideString: + begin + NextToken; + end; + else + begin + SynError(InvalidStringIdentifier); + end; + end; +end; + +procedure TmwSimplePasPar.StringType; +begin + case TokenID of + tokString: + begin + NextToken; + if TokenID = tokSquareOpen then + begin + NextToken; + ConstantExpression; + Expected(tokSquareClose); + end; + end; + else + begin + VariableReference; + end; + end; +end; + +procedure TmwSimplePasPar.PointerType; +begin + Expected(tokPointerSymbol); + TypeId; +end; + +procedure TmwSimplePasPar.StructuredType; +begin + if TokenID = tokPacked then + begin + NextToken; + end; + case TokenID of + tokArray: + begin + ArrayType; + end; + tokFile: + begin + FileType; + end; + tokRecord: + begin + RecordType; + end; + tokSet: + begin + SetType; + end; + else + begin + SynError(InvalidStructuredType); + end; + end; +end; + +procedure TmwSimplePasPar.SimpleType; +begin + case TokenID of + tokMinus: + begin + NextToken; + end; + tokPlus: + begin + NextToken; + end; + end; + case fLexer.TokenID of + tokAsciiChar, tokIntegerConst: + begin + OrdinalType; + end; + tokFloat: + begin + RealType; + end; + tokIdentifier: + begin + fLexer.InitAhead; + case Lexer.AheadTokenID of + tokPoint, tokSemiColon: + begin + TypeID; + end; + else + begin + SimpleExpression; + if fLexer.TokenID = tokDotDot then + begin + NextToken; + SimpleExpression; + end; + end; + end; + end; + tokRoundOpen: + begin + EnumeratedType; + end; + tokSquareOpen: + begin + SubrangeType; + end; + else + begin + VariableReference; + end; + end; +end; + +procedure TmwSimplePasPar.RecordFieldConstant; +begin + Expected(tokIdentifier); + Expected(tokColon); + TypedConstant; +end; + +procedure TmwSimplePasPar.RecordConstant; +begin + Expected(tokRoundOpen); + RecordFieldConstant; + while (TokenID = tokSemiColon) do + begin + SEMICOLON; + if TokenId <> tokRoundClose then //jdj 2.23.2001 + RecordFieldConstant; + end; + Expected(tokRoundClose); +end; + +procedure TmwSimplePasPar.ArrayConstant; +begin + Expected(tokRoundOpen); + TypedConstant; + while (TokenID = tokComma) do + begin + NextToken; + TypedConstant; + end; + Expected(tokRoundClose); +end; + +procedure TmwSimplePasPar.ClassForward; +begin + Expected(tokClass); +end; + +procedure TmwSimplePasPar.DispInterfaceForward; +begin + Expected(tokDispInterface); +end; + +procedure TmwSimplePasPar.InterfaceForward; +begin + Expected(tokInterface); +end; + +procedure TmwSimplePasPar.ObjectForward; +begin + Expected(tokObject); +end; + +procedure TmwSimplePasPar.TypeDeclaration; +begin + TypeName; + //For generics +// if TokenId = tokLower then +// TypeParams; + //end generics + Expected(tokEqual); + if TokenID = tokType then + begin + ExplicitType; + end; + Lexer.InitAhead; + case TokenID of + tokClass: + begin + case Lexer.AheadTokenID of + tokOf: + begin + ClassReferenceType; + end; + tokSemiColon: + begin + ClassForward; + end; + else + begin + ClassType; + end; + end; + end; + tokInterface: + begin + case Lexer.AheadTokenID of + tokSemiColon: + begin + InterfaceForward; + end; + else + begin + InterfaceType; + end; + end; + end; + tokDispInterface: + begin + case Lexer.AheadTokenID of + tokSemiColon: + begin + DispInterfaceForward; + end; + else + begin + InterfaceType; + end; + end; + end; + tokObject: + begin + case Lexer.AheadTokenID of + tokSemiColon: + begin + ObjectForward; + end; + else + begin + ObjectType; + end; + end; + end; + else + begin + {$IFDEF D12_NEWER} + if ExID = tokReference then + AnonymousMethodType + else + {$ENDIF} + TypeKind; + end; + end; + while ExID in [tokDeprecated, tokLibrary, tokPlatform] do // DR 2001-10-20 + case ExID of + tokDeprecated: DirectiveDeprecated; + tokLibrary: DirectiveLibrary; + tokPlatform: DirectivePlatform; + end; +end; + +procedure TmwSimplePasPar.TypeName; +begin + if (TokenID = tokString) then + NextToken + else + begin + Expected(tokIdentifier); + if TokenId = tokLower then + TypeParams; + end; +end; + +procedure TmwSimplePasPar.ExplicitType; +begin + Expected(tokType); +end; + +procedure TmwSimplePasPar.TypeKind; +begin + case TokenID of + tokAsciiChar, tokFloat, tokIntegerConst, tokMinus, tokNil, tokPlus, tokRoundOpen, + tokSquareOpen, tokStringConst: + begin + SimpleType; + end; + tokArray, tokFile, tokPacked, tokRecord, tokSet: + begin + StructuredType; + end; + tokFunction, tokProcedure: + begin + ProceduralType; + end; + tokIdentifier: + begin + Lexer.InitAhead; + case Lexer.AheadTokenID of + tokPoint, tokSemiColon, tokLower: + begin + TypeId; + end; + else + begin + SimpleExpression; + if Lexer.TokenID = tokDotDot then + begin + NextToken; + SimpleExpression; + end; + end; + end; + end; + tokPointerSymbol: + begin + PointerType; + end; + tokString: + begin + StringType; + end; + else + begin + SynError(InvalidTypeKind); + end; + end; +end; + +procedure TmwSimplePasPar.TypeArgs; +begin + Expected(tokLower); + TypeId; + while TokenId = tokComma do + begin + NextToken; + TypeId; + end; + Expected(tokGreater); +end; + +procedure TmwSimplePasPar.TypedConstant; +begin + case TokenID of + tokRoundOpen: + begin + Lexer.InitAhead; + while Lexer.AheadTokenID <> tokSemiColon do + case Lexer.AheadTokenID of + tokAnd, tokBegin, tokCase, tokColon, tokEnd, tokElse, tokIf, tokMinus, tokNull, + tokOr, tokPlus, tokShl, tokShr, tokSlash, tokStar, tokWhile, tokWith, + tokXor: break; + tokRoundOpen: + begin + repeat + case Lexer.AheadTokenID of + tokBegin, tokCase, tokEnd, tokElse, tokIf, tokNull, tokWhile, tokWith: break; + else + begin + case Lexer.AheadTokenID of + tokRoundClose: + begin + NextToken; + break; + end; + else + Lexer.AheadNext; + end; + end; + end; + until Lexer.AheadTokenID = tokRoundClose; + end; + else + Lexer.AheadNext; + end; + case Lexer.AheadTokenID of + tokColon: + begin + RecordConstant; + end; + tokNull: ; + tokAnd, tokMinus, tokOr, tokPlus, tokShl, tokShr, tokSlash, tokStar, tokXor: + begin + ConstantExpression; + end; + else + begin + ArrayConstant; + end; + end; + end; + tokSquareOpen: + ConstantExpression; // DR 2002-01-11 + + { DR: fails with constructed set constants like + WordDelimiters: set of Char = [#0..#255] - ['a'..'z','A'..'Z','1'..'9','0']; + + (*empty; there mustn't be all fields of a record mentioned*) + begin + NextToken; + if TokenID <> tokSquareClose then + begin + case TokenID of + tokDotDot: + begin + NextToken; + NextToken; + end; + else + NextToken; + case TokenID of + tokDotDot: + begin + NextToken; + NextToken; + end; + end; + end; + while TokenID = tokComma do + begin + NextToken; + NextToken; + case TokenID of + tokDotDot: + begin + NextToken; + NextToken; + end; + end; + end; + Expected(tokSquareClose); + end + else NextToken; + end;} + else + begin + ConstantExpression; + end; + end; +end; + +procedure TmwSimplePasPar.TypeId; +begin + Lexer.InitAhead; + {$IFDEF D8_NEWER} //JThurman 2004-03-03 + while Lexer.AheadTokenID = tokPoint do + begin + //UnitId; + NextToken; + Expected(tokPoint); + Lexer.InitAhead; + end; + {$ELSE} + if Lexer.AheadTokenID = tokPoint then + begin + UnitId; + Expected(tokPoint); + end; + {$ENDIF} + case GenID of + tokBoolean, tokByte, tokChar, tokDWord, tokInt64, tokInteger, tokLongInt, + tokLongWord, tokPChar, tokShortInt, tokSmallInt, tokWideChar, tokWord: + begin + OrdinalIdentifier; + end; + tokComp, tokCurrency, tokDouble, tokExtended, tokReal, tokReal48, tokSingle: + begin + RealIdentifier; + end; + tokAnsiString, tokShortString, tokWideString: + begin + StringIdentifier; + end; + tokOleVariant, tokVariant: + begin + VariantIdentifier; + end; + tokString: + begin + StringType; + end; + else + begin + //Problem: Delphi 8 allows things like 'Object' to be types + //when they are fully qualified (as System.Object, etc...), so + //tokIdentifier doesn't quite work right in this context + //TODO: Come up with a more elegant solution to the 'Object' dilemna + {$IFDEF D8_NEWER}//JThurman 2004-03-03 + NextToken; + {$ELSE} + Expected(tokIdentifier); + {$ENDIF} + if TokenId = tokLower then + TypeArgs; + end; + end; +end; + +procedure TmwSimplePasPar.ConstantExpression; +begin + Expression; +end; + +procedure TmwSimplePasPar.ResourceDeclaration; +begin + Identifier; + Expected(tokEqual); + CharString; + while ExID in [tokDeprecated, tokLibrary, tokPlatform] do // DR 2002-01-10 + case ExID of + tokDeprecated: DirectiveDeprecated; + tokLibrary: DirectiveLibrary; + tokPlatform: DirectivePlatform; + end; +end; + +procedure TmwSimplePasPar.ConstantDeclaration; +begin + ConstantName; + case TokenID of + tokEqual: + begin + ConstantEqual; + end; + tokColon: + begin + ConstantColon; + end; + else + begin + SynError(InvalidConstantDeclaration); + end; + end; + while ExID in [tokDeprecated, tokLibrary, tokPlatform] do // DR 2001-10-20 + case ExID of + tokDeprecated: DirectiveDeprecated; + tokLibrary: DirectiveLibrary; + tokPlatform: DirectivePlatform; + end; +end; + +procedure TmwSimplePasPar.ConstantColon; +begin + Expected(tokColon); +//JR changed to constant Type + ConstantType; + Expected(tokEqual); + ConstantValueTyped; +end; + +procedure TmwSimplePasPar.ConstantEqual; +begin + Expected(tokEqual); + ConstantValue; +end; + +procedure TmwSimplePasPar.ConstantValue; +begin + ConstantExpression; +end; + +procedure TmwSimplePasPar.ConstantValueTyped; +begin + TypedConstant; +end; + +procedure TmwSimplePasPar.ConstantName; +begin + Expected(tokIdentifier); +end; + +procedure TmwSimplePasPar.ConstantType; +begin + TypeKind; +end; +procedure TmwSimplePasPar.LabelId; +begin + case TokenID of + tokIntegerConst: + begin + NextToken; + end; + tokIdentifier: + begin + NextToken; + end; + else + begin + SynError(InvalidLabelId); + end; + end; +end; + +procedure TmwSimplePasPar.ProcedureDeclarationSection; +begin + if TokenID = tokClass then + begin + NextToken; + end; + case TokenID of + tokConstructor: + begin + ProcedureMethodDeclaration; + end; + tokDestructor: + begin + ProcedureMethodDeclaration; + end; + tokProcedure: + begin + ProcedureMethodDeclaration; + end; + tokFunction: + begin + FunctionMethodDeclaration; + end; + {$IFDEF D8_NEWER} //JThurman 2004-03-2003 + tokIdentifier: + begin + if Lexer.ExID = tokOperator then + begin + FunctionMethodDeclaration; + end + else + SynError(InvalidProcedureDeclarationSection); + end; + {$ENDIF} + else + begin + SynError(InvalidProcedureDeclarationSection); + end; + end; +end; + +procedure TmwSimplePasPar.LabelDeclarationSection; +begin + Expected(tokLabel); + LabelId; + while (TokenID = tokComma) do + begin + NextToken; + LabelId; + end; + SEMICOLON; +end; + +procedure TmwSimplePasPar.ProceduralDirective; //TODO: Add STATIC and FINAL +begin + case ExID of + tokAbstract: + begin + NextToken; + end; + tokCdecl, tokPascal, tokRegister, tokSafeCall, tokStdCall: + begin + DirectiveCalling; + end; + tokExport, tokFar, tokNear: + begin + Directive16Bit; + end; + tokExternal: + begin + ExternalDirective; + end; + tokDynamic, tokMessage, tokOverload, tokOverride, tokReintroduce, tokVirtual: + begin + DirectiveBinding; + end; + tokAssembler: + begin + NextToken; + end; + {$IFDEF D8_NEWER} + tokStatic: + begin + NextToken; + end; + {$ENDIF} + {$IFDEF D9_NEWER} + tokInline: + begin + NextToken; + end; + {$ENDIF} + tokDeprecated: + DirectiveDeprecated; // DR 2001-10-20 + tokLibrary: + DirectiveLibrary; // DR 2001-10-20 + tokPlatform: + DirectivePlatform; // DR 2001-10-20 + tokLocal: + DirectiveLocal; // DR 2001-11-14 + tokVarargs: + DirectiveVarargs; // DR 2001-11-14 + else + begin + SynError(InvalidProceduralDirective); + end; + end; +end; + +procedure TmwSimplePasPar.ExportedHeading; +begin + case TokenID of + tokFunction: + begin + FunctionHeading; + end; + tokProcedure: + begin + ProcedureHeading; + end; + else + begin + SynError(InvalidExportedHeading); + end; + end; + if TokenID = tokSemiColon then SEMICOLON; + case ExID of + tokForward: + begin + ForwardDeclaration; //jdj added 02/07/2001 +// NextToken; +// SEMICOLON; + end; + tokAssembler: + begin + NextToken; + SEMICOLON; + if Exid = tokForward then + ForwardDeclaration; //jdj added 02/07/2001 + end; + else //TODO: Add STATIC and FINAL + while ExID in [tokAbstract, tokCdecl, tokDynamic, tokExport, tokExternal, tokFar, + tokMessage, tokNear, tokOverload, tokOverride, tokPascal, tokRegister, + tokReintroduce, tokSafeCall, tokStdCall, tokVirtual, + tokDeprecated, tokLibrary, tokPlatform, // DR 2001-10-20 + tokLocal, tokVarargs // DR 2001-11-14 + {$IFDEF D8_NEWER}, tokStatic{$ENDIF}{$IFDEF D9_NEWER}, tokInline{$ENDIF} + ] do + begin + ProceduralDirective; + if TokenID = tokSemiColon then SEMICOLON; + end; + if ExId = tokForward then + ForwardDeclaration; //jdj added 02/07/2001 + end; +end; + +procedure TmwSimplePasPar.FunctionHeading; +begin + Expected(tokFunction); + FunctionProcedureName; + if TokenID = tokRoundOpen then + begin + FormalParameterList; + end; + Expected(tokColon); + ReturnType; +end; + +procedure TmwSimplePasPar.ProcedureHeading; +begin + Expected(tokProcedure); + FunctionProcedureName; + if TokenID = tokRoundOpen then + begin + FormalParameterList; + end; + +end; + +procedure TmwSimplePasPar.VarSection; +begin + case TokenID of + tokThreadVar: + begin + NextToken; + end; + tokVar: + begin + NextToken; + end; + else + begin + SynError(InvalidVarSection); + end; + end; + {$IFDEF D8_NEWER}//JThurman 2004-03-22 + while TokenID in [tokIdentifier, tokSquareOpen] do + begin + if TokenID = tokSquareOpen then + CustomAttribute + else + begin + VarDeclaration; + SEMICOLON; + end; + end; + {$ELSE} + while TokenID = tokIdentifier do + begin + VarDeclaration; + SEMICOLON; + end; + {$ENDIF} +end; + +procedure TmwSimplePasPar.TypeSection; +begin + Expected(tokType); + {$IFDEF D8_NEWER} + while ((TokenID = tokIdentifier) and (Lexer.ExID in ExTypes)) or + (Lexer.TokenID = tokSquareOpen) or (Lexer.TokenID = tokString) do + begin + if TokenID = tokSquareOpen then + CustomAttribute + else + begin + TypeDeclaration; + if TokenID = tokEqual then + TypedConstant; + SEMICOLON; + end; + end; + {$ELSE} + while (TokenID = tokIdentifier) or (TokenID = tokString) do + begin + TypeDeclaration; + if TokenId = tokEqual then //jdj 8/2/00 + TypedConstant; + SEMICOLON; + end; + {$ENDIF} +end; + +procedure TmwSimplePasPar.TypeParamDecl; +begin + TypeParamList; + if TokenId = tokColon then + begin + NextToken; + ConstraintList; + end; +end; + +procedure TmwSimplePasPar.TypeParamDeclList; +begin + TypeParamDecl; + while TokenId = tokSemicolon do + begin + NextToken; + TypeParamDecl; + end; +end; + +procedure TmwSimplePasPar.TypeParamList; +begin + {$IFDEF D8_NEWER} + if TokenId = tokSquareOpen then + AttributeSection; + {$ENDIF} + Identifier; + while TokenId = tokComma do + begin + NextToken; + {$IFDEF D8_NEWER} + if TokenId = tokSquareOpen then + AttributeSection; + {$ENDIF} + Identifier; + end; +end; + +procedure TmwSimplePasPar.TypeParams; +begin + Expected(tokLower); + TypeParamDeclList; + Expected(tokGreater); +end; + +procedure TmwSimplePasPar.ConstSection; +begin + case TokenID of + tokConst: + begin + NextToken; + {$IFDEF D8_NEWER} //JThurman 2004-03-22 + while TokenID in [tokIdentifier, tokSquareOpen] do + begin + if TokenID = tokSquareOpen then + CustomAttribute + else + begin + ConstantDeclaration; + SEMICOLON; + end; + end; + {$ELSE} + while (TokenID = tokIdentifier) do + begin + ConstantDeclaration; + SEMICOLON; + end; + {$ENDIF} + end; + tokResourceString: + begin + NextToken; + while (TokenID = tokIdentifier) do + begin + ResourceDeclaration; + SEMICOLON; + end; + end + else + begin + SynError(InvalidConstSection); + end; + end; +end; + +procedure TmwSimplePasPar.InterfaceDeclaration; +begin + case TokenID of + tokConst: + begin + ConstSection; + end; + tokFunction: + begin + ExportedHeading; + end; + tokProcedure: + begin + ExportedHeading; + end; + tokResourceString: + begin + ConstSection; + end; + tokType: + begin + TypeSection; + end; + tokThreadVar: + begin + VarSection; + end; + tokVar: + begin + VarSection; + end; + tokExports: + begin + ExportsClause; + end; + {$IFDEF D8_NEWER} //JThurman 2004-03-03 + tokSquareOpen: + begin + CustomAttribute; + end; + {$ENDIF} + else + begin + SynError(InvalidInterfaceDeclaration); + end; + end; +end; + +procedure TmwSimplePasPar.ExportsElement; +begin + Expected(tokIdentifier); + // if TokenID = tokIndex then + if FLexer.ExID = tokIndex then //jdj 20001207 + begin + NextToken; + Expected(tokIntegerConst); + end; + // if TokenID = tokName then + if FLexer.ExID = tokName then //jdj 20001207 + begin + NextToken; + CharString; + end; + // if TokenID = tokResident then + if FLexer.ExID = tokResident then //jdj 20001207 + begin + NextToken; + end; +end; + +procedure TmwSimplePasPar.CompoundStatement; +begin + Expected(tokBegin); + StatementList; + Expected(tokEnd); +end; + +procedure TmwSimplePasPar.ExportsClause; +begin + Expected(tokExports); + ExportsElement; + while TokenID = tokComma do + begin + NextToken; + ExportsElement; + end; + SEMICOLON; +end; + +procedure TmwSimplePasPar.ContainsClause; +begin + ExpectedEx(tokContains); + ContainsStatement; + while TokenID = tokComma do + begin + NextToken; + ContainsStatement; + end; + SEMICOLON; +end; + +procedure TmwSimplePasPar.ContainsStatement; +begin + ContainsIdentifier; + if fLexer.TokenID = tokIn then + begin + NextToken; + ContainsExpression; + end; +end; + +procedure TmwSimplePasPar.ContainsIdentifier; +begin + Expected(tokIdentifier); +end; + +procedure TmwSimplePasPar.ContainsExpression; +begin + ConstantExpression; +end; + +procedure TmwSimplePasPar.RequiresClause; +begin + ExpectedEx(tokRequires); + RequiresIdentifier; + while TokenID = tokComma do + begin + NextToken; + RequiresIdentifier; + end; + SEMICOLON; +end; + +procedure TmwSimplePasPar.RequiresIdentifier; +begin + Expected(tokIdentifier); + {$IFDEF D8_NEWER} + while Lexer.TokenID = tokPoint do + begin + NextToken; + Expected(tokIdentifier); + end; + {$ENDIF} +end; + +procedure TmwSimplePasPar.InitializationSection; +begin + case TokenID of + tokInitialization: + begin + NextToken; + StatementList; + if TokenID = tokFinalization then + begin + NextToken; + StatementList; + end; + Expected(tokEnd); + end; + tokBegin: + begin + CompoundStatement; + end; + tokEnd: + begin + NextToken; + end; + else + begin + SynError(InvalidInitializationSection); + end; + end; +end; + +procedure TmwSimplePasPar.ImplementationSection; +begin + Expected(tokImplementation); + if TokenID = tokUses then + begin + UsesClause; + end; + while TokenID in [tokClass, tokConst, tokConstructor, tokDestructor, tokFunction, + tokLabel, tokProcedure, tokResourceString, tokThreadVar, tokType, tokVar, + tokExports + {$IFDEF D8_NEWER}//JThurman 2004-03-22 + , tokSquareOpen + {$ENDIF} + ] do //tokResourceString added jdj + begin + DeclarationSection; + end; +end; + +procedure TmwSimplePasPar.InterfaceSection; +begin + Expected(tokInterface); + if TokenID = tokUses then + begin + UsesClause; + end; + while TokenID in [tokConst, tokFunction, tokResourceString, tokProcedure, + tokThreadVar, tokType, tokVar, tokExports + {$IFDEF D8_NEWER} //JThurman 2004-03-03 + , tokSquareOpen + {$ENDIF} + ] do + begin + InterfaceDeclaration; + end; +end; + +procedure TmwSimplePasPar.IdentifierList; +begin + Identifier; // DR 2001-10-20 + while TokenID = tokComma do + begin + NextToken; + Identifier; + end; +end; + +procedure TmwSimplePasPar.QualifiedIdentifierList; +begin + QualifiedIdentifier; + while (TokenID = tokComma) do + begin + NextToken; + QualifiedIdentifier; + end; +end; + +procedure TmwSimplePasPar.CharString; +begin //updated mw 2/22/00, JThurman 6/24/2004 + case TokenID of + tokAsciiChar, tokIdentifier, tokRoundOpen, tokStringConst: + while TokenID in + [tokAsciiChar, tokIdentifier, tokPlus, tokRoundOpen, tokStringConst, + tokString] do + begin + case TokenID of + tokIdentifier, tokRoundOpen: + begin + VariableReference; + end; + tokString: //JT + begin + StringStatement; + end; + else + NextToken; + end; + {$IFDEF D8_NEWER} + if Lexer.TokenID = tokPoint then + begin + NextToken; + VariableReference; + end; + {$ENDIF} + end; + else + begin + SynError(InvalidCharString); + end; + end; +end; + +(*procedure TmwSimplePasPar.CharString; +begin //updated mw 2/22/00 + case TokenID of + tokAsciiChar, tokIdentifier, tokRoundOpen, tokStringConst: + while TokenID in + [tokAsciiChar, tokIdentifier, tokPlus, tokRoundOpen, tokStringConst] do + begin + case TokenID of + tokIdentifier, tokRoundOpen: + begin + VariableReference; + end; + else + NextToken; + end; + end; + else + begin + SynError(InvalidCharString); + end; + end; +end;*) + +(*procedure TmwSimplePasPar.CharString; +begin + case TokenID of + tokAsciiChar, tokStringConst: + while TokenID in [tokAsciiChar, tokPlus, tokStringConst] do + begin + case TokenID of + tokPlus: + begin + NextToken; + if TokenID = tokIdentifier then + begin + VariableReference; + end; + end; + else + begin + NextToken; + end; + end; + end; + tokIdentifier: + begin + VariableReference; + case TokenID of + tokPlus: + begin + NextToken; + while TokenID in [tokAsciiChar, tokPlus, tokStringConst] do + begin + case TokenID of + tokPlus: + begin + NextToken; + if TokenID = tokIdentifier then + begin + VariableReference; + end; + end; + else + begin + NextToken; + end; + end; + end; + end; + end; + end + else + begin + SynError(InvalidCharString); + end; + end; +end;*) + +procedure TmwSimplePasPar.IncludeFile; +begin + while TokenID <> tokNull do + case TokenID of + tokClass: + begin + ProcedureDeclarationSection; + end; + tokConst: + begin + ConstSection; + end; + tokConstructor: + begin + ProcedureDeclarationSection; + end; + tokDestructor: + begin + ProcedureDeclarationSection; + end; + tokExports: + begin + ExportsClause; + end; + tokFunction: + begin + ProcedureDeclarationSection; + end; + tokIdentifier: + begin + Lexer.InitAhead; + if Lexer.AheadTokenID in [tokColon, tokEqual] then + begin + ConstantDeclaration; + if TokenID = tokSemiColon then SEMICOLON; + end + else + NextToken; + end; + tokLabel: + begin + LabelDeclarationSection; + end; + tokProcedure: + begin + ProcedureDeclarationSection; + end; + tokResourceString: + begin + ConstSection; + end; + tokType: + begin + TypeSection; + end; + tokThreadVar: + begin + VarSection; + end; + tokVar: + begin + VarSection; + end; + else + begin + NextToken; + end; + end; +end; + +procedure TmwSimplePasPar.SkipSpace; //XM Jul-2000 +begin + Expected(tokSpace); + while TokenID in [tokSpace] do + Lexer.Next; +end; + +procedure TmwSimplePasPar.SkipCRLFco; //XM Jul-2000 +begin + Expected(tokCRLFCo); + while TokenID in [tokCRLFCo] do + Lexer.Next; +end; + +procedure TmwSimplePasPar.SkipCRLF; //XM Jul-2000 +begin + Expected(tokCRLF); + while TokenID in [tokCRLF] do + Lexer.Next; +end; + +procedure TmwSimplePasPar.ClassClass; +begin + Expected(tokClass); +end; + +procedure TmwSimplePasPar.PropertyDefault; +begin + ExpectedEx(tokDefault); +end; + +procedure TmwSimplePasPar.DispIDSpecifier; // DR 2001-07-26 +begin + ExpectedEx(tokDispid); + ConstantExpression; +end; + +procedure TmwSimplePasPar.IndexSpecifier; +begin + ExpectedEx(tokIndex); + ConstantExpression; +end; + +procedure TmwSimplePasPar.ClassTypeEnd; +begin +end; + +procedure TmwSimplePasPar.ObjectTypeEnd; +begin +end; + +procedure TmwSimplePasPar.DirectiveDeprecated; +begin + ExpectedEx(tokDeprecated); + if TokenID = tokStringConst then + NextToken; +end; + +procedure TmwSimplePasPar.DirectiveLibrary; +begin + ExpectedEx(tokLibrary); +end; + +procedure TmwSimplePasPar.DirectivePlatform; +begin + ExpectedEx(tokPlatform); +end; + +procedure TmwSimplePasPar.EnumeratedTypeItem; +begin + QualifiedIdentifier; + if TokenID = tokEqual then + begin + Expected(tokEqual); + ConstantExpression; + end; +end; + +procedure TmwSimplePasPar.Identifier; +begin + Expected(tokIdentifier); +end; + +procedure TmwSimplePasPar.DirectiveLocal; +begin + ExpectedEx(tokLocal); +end; + +procedure TmwSimplePasPar.DirectiveVarargs; +begin + ExpectedEx(tokVarargs); +end; + +procedure TmwSimplePasPar.AncestorId; +begin + // !! Although I re-added this function I modified it + // so that it now calls QualifiedIdentifier, per DR's change + QualifiedIdentifier; +end; + +procedure TmwSimplePasPar.AncestorIdList; +begin + // !! Added this function back in + AncestorId; + while(TokenID = tokComma) do + begin + NextToken; + AncestorId; + end; +end; + + + +procedure TmwSimplePasPar.AnonymousMethod; +begin + case TokenID of + tokFunction: + begin + NextToken; + if TokenID = tokRoundOpen then + FormalParameterList; + Expected(tokColon); + ReturnType; + end; + tokProcedure: + begin + NextToken; + if TokenId = tokRoundOpen then + FormalParameterList; + end; + end; + Block; +end; + +procedure TmwSimplePasPar.AnonymousMethodType; +begin +{$IFDEF D11_NEWER} + ExpectedEx(tokReference); //ExID = tokReference + Expected(tokTo); + case TokenID of + tokProcedure: + begin + NextToken; + if TokenID = tokRoundOpen then + FormalParameterList; + end; + tokFunction: + begin + NextToken; + if TokenID = tokRoundOpen then + FormalParameterList; + Expected(tokColon); + ReturnType; + end; + end; +{$ENDIF} +end; + +procedure TmwSimplePasPar.InitAhead; +begin + if AheadParse = nil then + AheadParse := TmwSimplePasPar.Create; + AheadParse.Lexer.InitFrom(Lexer); +end; + +{$IFDEF D8_NEWER} //JThurman 2004-03-03 + +procedure TmwSimplePasPar.GlobalAttributes; +begin + GlobalAttributeSections; +end; + +procedure TmwSimplePasPar.GlobalAttributeSections; +begin + while TokenID = tokSquareOpen do + GlobalAttributeSection; +end; + +procedure TmwSimplePasPar.GlobalAttributeSection; +begin + Expected(tokSquareOpen); + GlobalAttributeTargetSpecifier; + AttributeList; + while TokenID = tokComma do + begin + Expected(tokComma); + GlobalAttributeTargetSpecifier; + AttributeList; + end; + Expected(tokSquareClose); +end; + +procedure TmwSimplePasPar.GlobalAttributeTargetSpecifier; +begin + GlobalAttributeTarget; + Expected(tokColon); +end; + +procedure TmwSimplePasPar.GlobalAttributeTarget; +begin + Expected(tokIdentifier); +end; + +procedure TmwSimplePasPar.Attributes; +begin + AttributeSections; +end; + +procedure TmwSimplePasPar.AttributeSections; +begin + while TokenID = tokSquareOpen do + AttributeSection; +end; + +procedure TmwSimplePasPar.AttributeSection; +begin + Expected(tokSquareOpen); + Lexer.InitAhead; + if Lexer.AheadTokenID = tokColon then + AttributeTargetSpecifier; + AttributeList; + while TokenID = tokComma do + begin + Lexer.InitAhead; + if Lexer.AheadTokenID = tokColon then + AttributeTargetSpecifier; + AttributeList; + end; + Expected(tokSquareClose); +end; + +procedure TmwSimplePasPar.AttributeTargetSpecifier; +begin + AttributeTarget; + Expected(tokColon); +end; + +procedure TmwSimplePasPar.AttributeTarget; +begin + case TokenID of + tokProperty: + Expected(tokProperty); + tokType: + Expected(tokType); + else + Expected(tokIdentifier); + end; +end; + +procedure TmwSimplePasPar.AttributeList; +begin + Attribute; + while TokenID = tokComma do + begin + Expected(tokComma); + AttributeList; + end; +end; + +procedure TmwSimplePasPar.Attribute; +begin + AttributeName; + if TokenID = tokRoundOpen then + AttributeArguments; +end; + +procedure TmwSimplePasPar.AttributeName; +begin + case TokenID of + tokIn, tokOut, tokConst, tokVar: + NextToken; + else + Expected(tokIdentifier); + end; +end; + +procedure TmwSimplePasPar.AttributeArguments; +begin + Expected(tokRoundOpen); + if TokenID <> tokRoundClose then + begin + Lexer.InitAhead; + if Lexer.AheadTokenID = tokEqual then + NamedArgumentList + else + PositionalArgumentList; + if Lexer.TokenID = tokEqual then + NamedArgumentList; + end; + Expected(tokRoundClose); +end; + +procedure TmwSimplePasPar.PositionalArgumentList; +begin + PositionalArgument; + while TokenID = tokComma do + begin + Expected(tokComma); + PositionalArgument; + end; +end; + +procedure TmwSimplePasPar.PositionalArgument; +begin + AttributeArgumentExpression; +end; + +procedure TmwSimplePasPar.NamedArgumentList; +begin + NamedArgument; + while TokenID = tokComma do + begin + Expected(tokComma); + NamedArgument; + end; +end; + +procedure TmwSimplePasPar.NamedArgument; +begin + Expected(tokIdentifier); + Expected(tokEqual); + AttributeArgumentExpression; +end; + +procedure TmwSimplePasPar.AttributeArgumentExpression; +begin + Expression; +end; + +procedure TmwSimplePasPar.CustomAttribute; +begin + AttributeSection;//TODO: Global vs. Local attributes +{ Lexer.InitAhead; + if (Lexer.AheadToken = 'assembly') or (Lexer.AheadToken = 'module') then + GlobalAttributeSections + else} + AttributeSections; + +end; +{$ENDIF} + +end. + diff --git a/Projects/Code Insight/CastaliaSimplePasParTypes.pas b/Projects/Code Insight/CastaliaSimplePasParTypes.pas new file mode 100644 index 0000000..20027f4 --- /dev/null +++ b/Projects/Code Insight/CastaliaSimplePasParTypes.pas @@ -0,0 +1,330 @@ +{--------------------------------------------------------------------------- +The contents of this file are subject to the Mozilla Public License Version +1.1 (the "License"); you may not use this file except in compliance with the +License. You may obtain a copy of the License at +http://www.mozilla.org/NPL/NPL-1_1Final.html + +Software distributed under the License is distributed on an "AS IS" basis, +WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for +the specific language governing rights and limitations under the License. + +The Original Code is: mwSimplePasParTypes, released November 14, 1999. + +The Initial Developer of the Original Code is Martin Waldenburg +unit CastaliaPasLexTypes; + +----------------------------------------------------------------------------} + +unit CastaliaSimplePasParTypes; + +{$include ValistusDefines.inc} + +interface + +uses SysUtils, TypInfo; + +type + TmwParseError = ( + InvalidAdditiveOperator, + InvalidAccessSpecifier, + InvalidCharString, + InvalidClassMethodHeading, + InvalidConstantDeclaration, + InvalidConstSection, + InvalidDeclarationSection, + InvalidDirective16Bit, + InvalidDirectiveBinding, + InvalidDirectiveCalling, + InvalidExportedHeading, + InvalidForStatement, + InvalidInitializationSection, + InvalidInterfaceDeclaration, + InvalidInterfaceType, + InvalidLabelId, + InvalidLabeledStatement, + InvalidMethodHeading, + InvalidMultiplicativeOperator, + InvalidNumber, + InvalidOrdinalIdentifier, + InvalidParameter, + InvalidParseFile, + InvalidProceduralDirective, + InvalidProceduralType, + InvalidProcedureDeclarationSection, + InvalidProcedureMethodDeclaration, + InvalidRealIdentifier, + InvalidRelativeOperator, + InvalidStorageSpecifier, + InvalidStringIdentifier, + InvalidStructuredType, + InvalidTryStatement, + InvalidTypeKind, + InvalidVariantIdentifier, + InvalidVarSection, + vchInvalidClass, //vch + vchInvalidMethod, //vch + vchInvalidProcedure,//vch + vchInvalidCircuit, //vch + vchInvalidIncludeFile //vch + ); + + TmwPasCodeInfo = ( + ciNone, //: @BUG heresy ! + ciAccessSpecifier, + ciAdditiveOperator, + ciArrayConstant, + ciArrayType, + ciAsmStatement, + ciBlock, + ciCaseLabel, + ciCaseSelector, + ciCaseStatement, + ciCharString, + ciClassClass, //DR 2001-07-16 + ciClassField, + ciClassForward, + ciClassFunctionHeading, + ciClassHeritage, + ciClassMemberList, + ciClassMethodDirective, + ciClassMethodHeading, + ciClassMethodOrProperty, + ciClassMethodResolution, + ciClassProcedureHeading, + ciClassProperty, + ciClassReferenceType, + ciClassType, + ciClassTypeEnd, // DR 2001-07-31 + ciClassVisibility, + ciCompoundStatement, + ciConstantColon, + ciConstantDeclaration, + ciConstantEqual, + ciConstantExpression, + ciConstantName, + ciConstantValue, + ciConstantValueTyped, + ciConstParameter, + ciConstructorHeading, + ciConstructorName, + ciConstSection, + ciContainsClause, + ciContainsExpression, + ciContainsIdentifier, + ciContainsStatement, + ciDeclarationSection, + ciDesignator, + ciDestructorHeading, + ciDestructorName, + ciDirective16Bit, + ciDirectiveBinding, + ciDirectiveCalling, + ciDirectiveDeprecated, // DR 2001-10-20 + ciDirectiveLibrary, // DR 2001-10-20 + ciDirectiveLocal, // DR 2001-11-14 + ciDirectivePlatform, // DR 2001-10-20 + ciDirectiveVarargs, // DR 2001-11-14 + ciDispIDSpecifier, // DR 2001-07-26 + ciDispInterfaceForward, + ciEmptyStatement, + ciEnumeratedType, + ciEnumeratedTypeItem, // DR 2001-10-29 + ciExceptBlock, + ciExceptionBlockElseBranch, + ciExceptionClassTypeIdentifier, + ciExceptionHandler, + ciExceptionHandlerList, + ciExceptionIdentifier, + ciExceptionVariable, + ciExpliciteType, + ciExportedHeading, + ciExportsClause, + ciExportsElement, + ciExpression, + ciExpressionList, + ciExternalDirective, + ciExternalDirectiveThree, + ciExternalDirectiveTwo, + ciFactor, + ciFieldDeclaration, + ciFieldList, + ciFileType, + ciFormalParameterList, + ciFormalParameterSection, + ciForStatement, + ciForwardDeclaration, // DR 2001-07-23 + ciFunctionHeading, + ciFunctionMethodDeclaration, + ciFunctionMethodName, + ciFunctionProcedureBlock, + ciFunctionProcedureName, + ciHandlePtCompDirect, //XM 20001125 + ciHandlePtDefineDirect, //XM 20001125 + ciHandlePtElseDirect, //XM 20001125 + ciHandlePtIfDefDirect, //XM 20001125 + ciHandlePtEndIfDirect, //XM 20001125 + ciHandlePtIfNDefDirect, //XM 20001125 + ciHandlePtIfOptDirect, //XM 20001125 + ciHandlePtIncludeDirect,//XM 20001125 + ciHandlePtResourceDirect,//XM 20001125 + ciHandlePtUndefDirect, //XM 20001125 + ciIdentifier, + ciIdentifierList, + ciIfStatement, + ciImplementationSection, + ciIncludeFile, + ciIndexSpecifier, // DR 2001-07-26 + ciInheritedStatement, + ciInitializationSection, + ciInlineStatement, + ciInterfaceDeclaration, + ciInterfaceForward, + ciInterfaceGUID, + ciInterfaceHeritage, + ciInterfaceMemberList, + ciInterfaceSection, + ciInterfaceType, + ciLabelDeclarationSection, + ciLabeledStatement, + ciLabelId, + ciLibraryFile, + ciMainUsedUnitExpression, + ciMainUsedUnitName, + ciMainUsedUnitStatement, + ciMainUsesClause, + ciMultiplicativeOperator, + ciNewFormalParameterType, + ciNumber, + ciNextToken, //XM 20002512 + ciObjectConstructorHeading, + ciObjectDestructorHeading, + ciObjectField, + ciObjectForward, + ciObjectFunctionHeading, + ciObjectHeritage, + ciObjectMemberList, + ciObjectMethodDirective, + ciObjectMethodHeading, + ciObjectNameOfMethod, + ciObjectProcedureHeading, + ciObjectProperty, // DR 2001-08-07 + ciObjectPropertySpecifiers, // DR 2001-08-07 + ciObjectType, + ciObjectTypeEnd, // DR 2001-08-07 + ciObjectVisibility, + ciOldFormalParameterType, + ciOrdinalIdentifier, + ciOrdinalType, + ciOutParameter, + ciPackageFile, + ciParameterFormal, + ciParameterName, + ciParameterNameList, + ciParseFile, + ciPointerType, + ciProceduralDirective, + ciProceduralType, + ciProcedureDeclarationSection, + ciProcedureHeading, + ciProcedureMethodDeclaration, + ciProcedureMethodName, + ciProgramBlock, + ciProgramFile, + ciPropertyDefault, // DR 2001-07-16 + ciPropertyInterface, + ciPropertyName, + ciPropertyParameterConst, + ciPropertyParameterList, + ciPropertySpecifiers, + ciQualifiedIdentifier, + ciQualifiedIdentifierList, + ciRaiseStatement, + ciReadAccessIdentifier, + ciRealIdentifier, + ciRealType, + ciRecordConstant, + ciRecordFieldConstant, + ciRecordType, + ciRecordVariant, + ciRelativeOperator, + ciRepeatStatement, + ciRequiresClause, + ciRequiresIdentifier, + ciResolutionInterfaceName, + ciResourceDeclaration, + ciReturnType, + ciSEMICOLON, //XM 20002512 + ciSetConstructor, + ciSetElement, + ciSetType, + ciSimpleExpression, + ciSimpleStatement, + ciSimpleType, + ciSkipAnsiComment, + ciSkipBorComment, + ciSkipSlashesComment, + ciSkipSpace, //XM 20002511 + ciSkipCRLFco, //XM 20002511 + ciSkipCRLF, //XM 20002511 + ciStatement, + ciStatementList, + ciStorageExpression, + ciStorageIdentifier, + ciStorageDefault, + ciStorageNoDefault, + ciStorageSpecifier, + ciStorageStored, + ciStringIdentifier, + ciStringStatement, + ciStringType, + ciStructuredType, + ciSubrangeType, + ciTagField, + ciTagFieldName, + ciTagFieldTypeName, + ciTerm, + ciTryStatement, + ciTypedConstant, + ciTypeDeclaration, + ciTypeId, + ciTypeKind, + ciTypeName, + ciTypeSection, + ciUnitFile, + ciUnitId, + ciUsedUnitName, + ciUsedUnitsList, + ciUsesClause, + ciVarAbsolute, + ciVarEqual, + ciVarDeclaration, + ciVariable, + ciVariableList, + ciVariableReference, + ciVariableTwo, + ciVariantIdentifier, + ciVariantSection, + ciVarParameter, + ciVarSection, + ciVisibilityAutomated, + ciVisibilityPrivate, + ciVisibilityProtected, + ciVisibilityPublic, + ciVisibilityPublished, + ciVisibilityUnknown, + ciWhileStatement, + ciWithStatement, + ciWriteAccessIdentifier + ); + +function ParserErrorName(Value: TmwParseError): string; + +implementation + +function ParserErrorName(Value: TmwParseError): string; +begin + result := GetEnumName(TypeInfo(TmwParseError), Integer(Value)); +end; + +end. + diff --git a/Projects/Code Insight/Valistus.ico b/Projects/Code Insight/Valistus.ico new file mode 100644 index 0000000000000000000000000000000000000000..0341321b5d952e1662a3d9444a73cf9f42a7db37 GIT binary patch literal 137040 zcmXV11ymH@_upNX?(Rmq1f;tg1O*8J5$Q%sVwXk)X#uIFK~f~8LAtwP>F%!GKi~8F z&pC5u?!1{dciz44#^=5P0Du5Az<(PMzyMf}2LP;}&!N!&(d-yNfNBB&AS?U-v^)Ud z`V$D?=l>sF`~m<-U3z|!;s0rZ=X*gQ0KxO|zy55&0KhI02=G-`TLl-33hTLRTs2ii zz5iPO+cExowW)jY^E=~9)D-33_$(a0M}^W{O+yZxcf7^ac(o(rz~2a$OqQ0TBp4g~ zYmz|S8g96H>?G_4HQgwfjB#-UO&N;=}*&M99jA|))TbitYLr2yi5gvqA6iICRYHE8veV~DP4&szzkxu%D<6`e?i zrnAMX^2@_TDtEomoflmfp^M5(_VGeQdJwda6jVJJ481|}yuHgl@KFC>RXMtot1qNl zv}d|RxDK|tbYw@}Gj{KC014f!yDXub;s4d2 z;~e2fFvCk-IJRp&iD=F$HLB;|(|1LhC+wS_(-#4ompF~lep%6enbB>G2lxKFl7$Ta zf*%uHJ*Zvvw2*@hZQZfs2mfy5ELALb<*{gQZ;`M>fNfR)aNvsF=98syjB#G;HFIY2{R~??Jrxnvua1s4Fpe; zk%6)-@!pTJoPrt34G7DkaqWeBQDJRZE^+N5DnNY1*rm<-Rd$uSeQE7%E*phmStvV}p4O;ZCUD>2_FgQzW85RIdvy zK12fqz$9N@9ABer??PhzXqWlQw%19`xKCNiSm5dfprjf@4!OJ;LEvm$m4hd2{9L}$ zAP6hF^3A}!$DSuvqiY#2RZy@XX~V-@vMc$3fiv8|B?!Ep0qyYte(x5|`L0Avpu`xf zxIv&~iNS~&8WQM??eRds9KkQm7e2Zs97I4N7l{!xGW%Ad{b3e+TBNrB(0Wzb+|8se^tbdbMk%!Rc?lvmA}c=EtPYr4mNW^$sETrrp0Pf z4=R;%)*Rcb%UCwxAnli8#(tp!P-Jlzv$>gUOkhR%gJH!nBIm3WPV$QGQ*smSjxZC{ zHX~Fliv_A0dj0aa&X&F>K$IdFT8Z*##&#Q^je#0)_%etf_jg4ofz1LijbiE5@Ao*B zYaii#a4i;;wyD)4)qfPgd?5QJX@dl1z5eS4uiS^fq+bHVb_~3T%t(Bau`bznzvSWK zpe<1kHLP#^s(c-6P;Sww11Wvm++HdkX4d_^s~qu}-iFn+6f%(nJAl)M2H$5BVZw(2 z)mLGpY4Z<{t1Rg(uyN7)d+!7QmOwmU1y4m31e0>gQ6(7;r2uy=9mz5P0%O0$1LNf* zhcKG6nL{XS)ZuQHZXK&tA!%?Wfm=3LD_QA~hN;y%)sAQT0A#UX7$am}j_hte5(<<(LQHSFPvllYL@*7~%m z?!Ib<|5;>tGFMgh>-0}afaZXx*$7{zh^d-tMPyl5Tp!90(Cq;`5sKIcr+Mvbx zPCGR2bApd}z4>1Wz7^S``ZUq;z~0 zCF5K7{T72#U}8aJ`6a6c9p9ln|L&W9t=>eaL08Fb#u%5Vpj%feo^;GArCGPrNv3oFJ=%-@0y+E4{{pu0C;7X#y zFQzTHtX%IddUN39xp4=&yKgNvQL`}Gi+4iJ*f69qTa4pBZ@W>2iX!;b5rn+I@I9qX zb_WRG_e1aSz_@aoG8W@t0Yb}7?&xP3W&?_FBQXH4Kzs?o*~rBWH@S#El;SiowtAsr z|7olQK@j~YlH&M8j>$F&zCmg5EL~@4XB+h~oswK$oLLl{%lEB$jBqoWNS+wJV_34q z@9n&*4fWVy=c&?pC+*#7_DkCX2eDV?!;<&S=;rg3^(WfpHaldz_M-m!?+4KJ^dgkD z<+(d{NKSJUteGPHQCKd`?&OiqIWA_=}~li{?EU zVNxGOAIqxINFF7ZmcMp-^PUQ%GTk=+tdv_^w&Jh|c2Rn@YO5=lBSI;pxr^I8kX>_@ z2LG1f+x&$Oqg50lQ!r)&t@EqMVJor}Sc}vVSg!#wMypB(zblFbd~H|g9K~S3abEIk z4s@-X4H-1UmxILJVSQl){d(6-p$3=HgU~fbu03IE5c^0VxtEURa|X#X`~<>a`yO2N zWQP8UwHW77Tpf;eL0>VY*lt;wk6)j9YHk_+rf3ZpyU=^<@8*t&vGN5WZpD0iFqiX% zpVE3$kg%H-WQY3NjEjK?LphZUeihcPzyfF1!w8zC1{AdbGm1%dE9BUt6=lUR-^{j4 zU~gnj$5gHzW3dFImB@TE?d*H%z9MFSY=R%Vu&4S(cKLE|d>1D2f3v|eLsUij76vy- z8%tN)^dH_C=?_6v*K$&Az^5rSY&$a zB*u~|nj)Bn100V*6^~)xadN}x_L&G+RSImHd{FRhu`9<9wzahnaz7e96Duw^d9!5tQt)vrFVc2>m)^%H zj5z#>kQvybw(Xa`<*ZqIHPmRRD?rDMM*B{as)|Ak1bdr} z*{U45#wAun_iYi|7il{Eeuqu+m-PCj+@`Fitc@1v4wDH)7@3O}Y&5opDIfqFUbBt3 zF4R)RqRkL)KgU?lfWY*rVY+KyRYAzadmfFT*B1whYuPbP5Llcxp+Nv@wq0+@gYB#d zHmvHiz`}zy>!m>+*^nXtjYt21!!H(`J$Sj1;Q8-U{dHX;&DCR$(?w-c=ldR*5~ls- zx~^T)L$A;5)I&xT6`i-V3+WS;3ATO_aKu6P}lS_Uqfgj+r7wI@*eRU!~$>avi`Qqh7Fd<2kjM z$umcvO8!Pot*5V0IeljognuJV#Otz>mP^tQ*%rVSV}jF!s)C(a0Oz=IMiwq%*V|g~ z3m@^?AX`%!4%<$_jA)kAw5gL<)D*vE-kWVfV*c(&Nj;X;7$|8=GbbgTfDKHf+twW@ zfpG&mX93k$p7w#$^Y6H}Nc>-9tH5j^5X;fUj8Ji^uwQHX@;+t6P`? z^l}kwfO6cn-(w%*ba=kADuf^QHE1k-e?U_2v35j0V&wz#i1ZRRN-U25SjPIQetgV}~O<60r zJm_)4o}IhI(!O;%7d2fi9p~)p#+^Koj*YW4i^E}WoC$1ZE3*;YY}CGx>Sh!+mB!va zOU}Ovh=)o*3xUU(+O{R;_+~ojJJfUIEVjTAzSG}RCxXNjFWan10;#@T(P1H*E7YV+ zO|#!1C@ls@KXSDW=cAMw4MyBdmAz9@UH*hClCa-uyOnaU^*u)=(m!;GJ4AG~pS?qb z1JgrWegbW&SxmMSSd@N^$X6qPQzs}IrC+jO>dwIDRY9W~PtubyglFl>YuV5yBVN#HkzNAA4XH-RC*C@yPRGc&m&czPp0J*EuT^w!3`{0{A|-gk-cc%WO}q*Xq{ zKmjrKn!G!n_!14~*o<)-(Da&hilUSI7Xe!vfJG~K=M=gV9U7eb;lV>?O$N)GFXz-D z^pvLL(f-%8NE$5PU3kvX+WKH|Xd%CauVz#4qP)IuoNa0?78BVQ7N?rzs2 zVD3DW3wG9~W=MqQf_ZS$+sBOu_c7UX87f}L65Wc>9gDIAL8nff*eQO<_(~6{yl8gs znB)_ED8@Ipo7Su{(uz|Vk^aU@xjy-am3F{tRVqg@<$)o5OXX!aP+oHGjjfqFSFwi)=mYw?=0}7`v6?Bu4BX4PKY4ZvD0T0g1}ei z9X7woWbL*ztBkKSPrm~C_Ig9JUHV_p!8)X&zdu2yfbIGEAjET0Qg*X~TNt9HDv>i+6^cA}zQQ~ez-T<2`O_v76By_GEcdP_UbhBeu| z*YeRIPxoKmy5+;Vc))z>X{*&oUg(HnKq-La4Pt=wwk^EFA|h!ho-l+--hhtp8JB4~~6 zA!ym7DUPZOO2qF3mWF~pFrxXR#O{2uy7VSQJg(cbbCz1?v`AW?I2bv%#Z7SWt^?e`O7-Jp`x zo%?;cH7Xl@Ey2R#-%5wq>`AUC%$4nzlufDuX$f++x>z7g#m2Q4mPD>z80pkM?Ps8~ z8`e(!O`>So${OXx2R5fE=@C3VB=kzvL(WxHD3!xrNpWq&Mac%TY{G>dk{ialcW%Bgj0b2qZZ z-dz7Vl+OH#J8RX+XFr+z$3+h`w`dHn+4up+uh}8;Zj=XluRKT&W&BB>O5wu%*QFaa zqM!(3G*BS;v>Xw}#56$4(92*40{)_hoox@%s6MmefpMI2FLf23k%-&+{syV*WAh@6 z9+E`WT3i&p{_KGCGgi6v9;VfGe>F%4d}M6RaznnK?PQ~Goj>r{bVq%>3nI0}8%n-+ ze-TE&N#c%b8%mi>`fV6E0X{q`AFF<{!3YhGW)EEm0*mO~C5303eNo%LnILvoSJ%Dm zCw(G}Sta{*pX48&J)eO7g4kLis~;d-`lI`Pejv89a++Pg>3VajX@KY7#%obTl`laj zy@Sh`t>@{IgZVS|k#wK%B5dv@dn(Eh8~jL zb1}eGy0%udlKA{-D(>!tm6+hBIA|Q(*uoo>>%!qoma%!A_ITBQUUsGr>g7`>1zhgR zX1D8EkSOASVmb6z=j`P_v3-RF4X1l&&l9_1IqyS*XsUlFLu5rCLSMi?UrOPBYzv7E z!>(+2zdx8vBma_6?2gI5=_RiY!;t#duV8UqVq3c<@b%0QL2eIIiI!69cQB2H3B*r^ z>B^6gnN2a=W%rCZ`3h@InkX>S48LH*8<;-)^Yg7y+Ct^p!L7t}AY(lQ=c$WNCIG#j zTO!YVv}Hg1!J;D}B)`?FKc2>jY-8wIPX6-gzpcD;7=)(FL-1OYL|;i#v{7pXIWT^T z`&$!dYVXs8)F45;Zwh~i;_?m;4xX?oYx@(B5_K>-TE9z%77+cxLiA*_pcwUX8I;`_ zf-m(1Bq2*y3+PV>(V*Ub1#E4^(Bdsz01^d8u(caUzjAsalytV4?UN0@L2t$vlLsYe z;1ab5us^00i9YGp>h#=eWeoH2?!CqKxV7>x)>-#a}wRbb>)^v-G4<< z7m3g2cw=PR^!Tn88B{sN*&o|_m)rCX1GmrW<>qf28_qq}qzBFgDI1fsx6jMX6e_q9kjI?V^!fRy({4p6P#ZwE4&>|>#3X@uWJHjAjcJc9n~gu@%Pmppc;P< zp1zVMf}bdI&P;>{+*5=k$%K_UUesiFD6KfYCfClZ=f5{;!&nmONdgn_svn%zh0LWE zo<0$8=PbK?2p$!CvfVQLLuO{GRw*gwZeqXWd*OR}5xaWm3URYTUApmc{xY^`k`A9H zr-Qzd@drv*`pH>?A8GAQiOZ?s-)47)|&)BGA>^?U>@n%%WeB$T`6pj}4y_S_RR6 zo>Z)zaC}#rCmk+lz*jAxnj%Knvlpr!rCZmO$y7#BB9+LyH&1ZfdhzD^wIKdXrv}GH z;mLOJCG&{r7hXkX330DvbyCTPo@dX%_tjMt=cE|{e!STb=@?%T*xl$mZ4!TKKCoze zNu*kci@h;ulpCij5_k9luA*=8%4fNP_7Q0Nl1{JQx;uh_5mQwO;GJ{I_l!H|e5+K( zybIgNDfSm|x$*Wo`Lxz*#g@I~c0288hA;Ad`45BS*+4yPdjCaBkHr{1r11*B%6DV5 zr4WEml2|kxzEv*+w68UoxM6!ml>4E;^gBSt52^}{3YRn;mi;qFKW2wjV>cBwZ_);7 zrDS0WD$^jsLeeZfLBTMB-iH|Lk>mO*w5;Z37r6cXo*Uc9e(@Cs-?+$#?LEdUkb@s>4t(D!s+AMBTqE(t!?X|B@ieA5; z>M$%P)7ly)?cX`8_e<%xF~7-J^XYx?(A>FR=^E*u7(CWF`X^RsBCot7 zN=GFC;-*JZ($an_L=CqKhlU{)_t(U?59XEq_r4`bx4908DC5!fvTO;%=Lp0HC$%?Q z9P6&Q9+vHaMMOBaXaXzn;z<`LA(ao2l{xu$<)?{<+^U^5`=&sq#*hv^6~aQM$#>#^ zI=8E(VlQ1GbtL0@$3yjF!({^dEKq60@aDbmNGtrR;fw#0MNNBvPQcHrgD=}I_3a|a zr+SubOgnG3j7FSmY5p7H908!S(#{uby+VdsDjPNVPFX!FQN0K31{$sR8W90lMpoNK zDu*>sGbS#>KRMz^$K}_|Bb)gCX-RRcv9-KuWftXbm!~HX`rR*Vi^tv=FpBOhe?d z?yl$3z6*(bV8(J~(rcNvGShXK+m?~WyVPhN%fyVl{n&QVHgnRD%TZI36Z&N=>p&6(6`;8!}A2eu1nUK<{6h>Tj&Nz4z zW|-b!gq?%S3f_@cIs?tN7I1~JIIcT(F2MbAbzT6qS`N@3hzQ<@H9)RM8O52u>-_aF zG;~mDE%+eRnQw;LcD_^b*hOl?+r!5{w{yYCrWtWPgJx#3`y^5RQxt{Q?3!UWW?RmD zcJ-u%DA4RFY>FPg>#NOs^l#Tv>idIz;{Wb|on^ptbX}qLExaIVHJIBX{!r*)0(DjS zKdN;7_aqmeLcju?X6%n!4G*MYtL&l(+bfa9sGNLv)<1Xs7cOMaGv>4_%09d!`j~6P z6g;jfdemF6-?TB>Om=O0{~*_bC{Ljej$I9q+mDS15^CLo7y}EohznYi%9zDM;`GAq z#y>h!sg2Y?2}BQ_#`K!Pr?DcbqXs^Gl_BL2UioW3&1uh*^;(}{5`4;iti99eV_J}{ zT@*Bd*_6BBf+py4lkPKZUZD56=fT7D7Sk~6w`+tP^&Thy%@DRHOVuH}R#V?zo`Tfg zk7dKmT*2^`yp(2F**J|4Z75;eHNukRp2N4hM7+|!OkRM_|wEe z8u{oE1QrO6{z_?n_=ghGH(-^BZ@PA&&MNnzAIy47CcPNjjF9h)9h=b*rV)Y)lELCl{(>c0C=9Klpk7+`v0%`zA*D`A7zD{Y=ibc;fM7rYfZ~nf{ zO9*b|J$8As$E(9xQbQ)7mH4Fdi1S0|9{H17d!@2gf!iO1* z(zYL+fg4`I!JTg0dl7m8B|X_#0SV56O=Wa zX&?^Sj+rmLW_n}9R7$*Oq)NPgFhMCPTq8n_n1QE#=ZYmUWIclq9`tplXDci$EMC(N zn8pP4bM;Q1yB48vyQ*9vH4Jb{0I<)R=e>?{e-eCpl}|o6V)U=IOfw|ZdVd6kkMq7) z5E7hhu9`?NMSPB>zINaCsQ;fkMT$}1p7YV%};DhMCv z)-y1h+PUcwp3n1>tKqVzD98U%=vj~l7IvMv)gNZwrp99F`c&Bsdc$uXQpp$;!6enU z<~@7%&eOI+@tUGwK{)_2qKP`JL8ct>r3E;^dfWldmPC?V6jjkD-&I@Ex3-MBu0sp| z4!a_qifpz_Sv91Wd|Z%UZalj;ZcMREgv$oDRVLXuOTELtRX{ZN2UT;u4!+#NW7___ zy&YII13RIG=N#$^YZ?PQFv8zCxSgZVnbd`}_!19d6DWbjv2a%?3x2pZjoU^SE|RF0 z_T`-FUt^UcW~@5!v3$+;Nc#AGS%EFqxSm3%&3T8;G#*s4j3lqxldJ5O2g)+OML8la zcOmFk#`UGR$IaKp851B|w}!PW?{?d2^)IwCmG?L+U-l~DSE7kGMvh^wN12stE_!L# z7nsa_iL{|}%^es%lBxjdb5z}0xHmz5q->c!w(h_NQlxe)FlE^pzi5#$)fv=4=M5pL zM3mJ-u8te_4_vPdJu(CCEVHfVTts=E+QU9OxBAdW+OVU;BusBo>Qhk+VC@cDr!(vR{Ym^ZxMsuUJY$NrmsxBE-om=iui*i$%s3HlOH&5+XWvS}N^zQ?bJ`AnJF+Tv_0|?hUtREz%E^=-q>UMbLY4T;9gs9k-6`lqcSz8o+>8^Hxr*K=s5mxp}}NXEXA? zYgt+tGQQ^ek7H24-Rvy&wE;OU7!u&s}4%?|0U4ieNAYQ;OO;n%jph1}Rj!$fu{jej(!-_=d*NT?hg7BG&l#mRUGCPGNh|FyC0)Mmt|r0lpjIB0w$i=zXj2AsDv zH0fpBejMQn%RQ%byef)uL{^~6bZK5w9yj>6MUw)q!n$<+qHQ1h?!wIcMz2)(&1HFm zgu2t|`T~1dUf$nJbFm)c*u1|x1$>{A!Jv}0QH1@8VBjKi7lW01UEwLo7bwqW$a^%8 z+X|sg=Ahyjfw5VSi>4^P9q7U|{*APCo*P*VbEy*nL?(5TF0!v+rG~k(T`< zE?n#(-&~Ae7SFDD9_0`m=lOmmX;@o{m90n`A@sR9?_#7ly}lK_1N~UNkmj}DtF$8N z`8M7ojv2vZiZ90k5J3Ow&}!3fYH0&gCTt809!B{5t${KQt~JcF(FRBO8kQjrK7V1) zY(P)Fq?*}^`1EvEDpP`7LQlUQ72NQ#>CXOebc3Y44+@7Wp=V+F(fV&g&2M%}@fH09 zij*e>P2GB_VWV+*k`GGfalX z>8C0s#NLk_zkZ^VeT%_t8{5$tu0&LSptvD-oqhFS(|lhkGiHnHI`8Cyqv|=5>~Io= z?eYb6Xhyz&1i9Xol4EzHkv%H05v7uoFWE983tU(408D~9HL)24VFk{(w@cR~g0kh2 z(gGZ-XKb0;JCwi3o)Mj-m~_txBlcmPsE2&V15R>u(ET!Z(?eca_UyO;dTHw;xzMyTv~Jt!$^O9L zl^wb0+T*2;3=zwZ7^+xLag=~f97QJAIuU5g+3YhbtQu2V{SGVCGBUHewa^^G_QOP( z-X|j7!cnc;S~9mZ2+M7!g-&_6!(|D&UwEu?Ki*f%^$e<+y6rq1dS`i^jsrR< z`{aY0`Pz4|WiMu28d`%gtpV?9gY*Z=TXkNeoC*sGf$?P?PvqC-WkZzRa^d~%3U!MLM+*1LnVe1M@k2&Z`~k}vIZ;Rh6C*DlbRWF1KO0h%SE6C> zdKklj`u({Onmic6{c?^fs6#!k%>TMyWIfH9+z%PE4Pq}#9exf1NO#9^V8W}M$#K^b zl403ZPF>!o+kZsV0w^V*lDj*rx3SXM-bmaCt6HBDnYo8kY>SjI73;&>Md6B2k?h8o zPQ8CNlRM`J1tw>8Q@Q%YF;p7Ya;0px7Bzu*;uTTDs3wf?y6vESnbNS`1z-4b#V7S{#8#KEOLN6W2{NRDO4^flg3+~c6 z&di`|KGW?dO8twHENbrc(56;D(s%Y`MlR_)%VCEXFaXarSpn1TE^Og-f6y z^N8$+Perz}sq`%JU*!}5+I~`^>B5CI*!lw>S9Jy)B+x4hq=>#YNYUxo!f+MPlmNC! zBxY=@DGfq!k#iiJI&=tGux+k4rnq>8Q;PVzet@4HJZ;{}d-dru3KcyA(}UbwCfR%N zz7qbFauRn>M2RP{B}^gXSszU!vFqKH2$9a21!d=04wSX5K|c!4azSfxh=%}K0Dm*S znkoMjZo=(H06~W7SRH+o(S}845K6MS-wiLc((+XDKy;|x_^j38ZFaL8 zpX0j=HRV+l9)C9TYZeczLTWWZhLJQNHyZ#G8VSW8ldd zLQiFfpg`jGq-AY^2l;BRpSP2C$WmDT7oD*K&$8W!42ZGxm7z4wVt_Zgu~Amzfno_? zp3b4))U;;b-!AN%EIc#sCaYNkA!h-a05faa5}hSC5=G{m=r(c0Q;uaYWHos{alB6rjObuG7{{*lcMW{JqfpnUxu> z5f>SHOc>@cz=oaV9RD8@JF6`bm z49;%zq<1vtazgorfDav*ot&wt+5P4^mcZ?lGdHLxaD3Dhy?o;?ZEbM7NF~zImi1SF z>qIS@vWX528&BOO+}1`<*Crd#L1J6^6m*3_;E5CNpLw%wnTQNX>L+7?;t8PWqD0Ee z+;p?{ntn$J={yCJjrN4c+dhpAcFjdyPQ=i?6r3SAr%h13{HpVXE@#ASh*K!pD zZem0$HrPT5h(6aj%Im|lB^607f1R2nll8XzepjZJH!g~1iFRoyo_25EIN0CTd(p}` zhpg#5i1F3ceHkH!XqanDz`o-Ggsy*-~}6++?dS;T!m1eMMMKCuGykZtq%e>vjgmYL>|LN}usGIV81#Hpu= z7qP6s-%F6YzG@_@|HInH(}Q0(`K{4r3|*vq^tL~*D#NCKjhaI}xmJ7V->km)9gs!& zsuOdPyi}6Ezn5e6mIHif$m7i z9Rg~SHPI7mLosEF5Z+#h4+=8Msb~bTDj!hofi{9{?(VQ!v|6A33Zi(h{=j4L*v+fy%1j+KsqfHEK5x& zcTji2KyzJm3+ypD+Oa2DyHYQx#x#T!X%}H%774@JCOEQ1T(WY-#A9r|DpCPhoZG?u zj-Q_Ea-YMI;T{K-t*6s|_?_D{o@n2DNqs6;@ukPZ&uRCC1JJb=XREb^&fbN-B}{-VH% zdp)O*0h`;sOVm1epg3{(*LIYn+c%pHWO|C%wMNqWpLYDJjq!EzS!DSRAklhqGd3q7Hk87icpF(SynT~?%wBPzcs=Q-KeE=*<hsy<7@z zM>F{-1V>V}%CX=o>cRVurESI?e?c6i%xrf>Y|lVMJ31ftpzX+=>}#=4`0pMcp4EAW zN%-j&SoSFTH187<^t@6$kM9d>c`wOCaQ_S&h#(h8do8|eyPQFU$zQCH{npqNKhJ*# zkA-HAo-jG@iLcTv<(T|y|EkVc0L3|DnTM1*7Y*K*ILtTr|mfx(s_A^X|zK#6LgKVIWEQ7O4$V{r*U| zMg@hAnzhmXw6B)o)WkV&JqZ}n($#xqvLDOrV7pXDC5^Okej|b{q|rMSPlkMopB$5GDJs<3zoe-?ozQh;F}Od-FtZFzIml9{Gnos zUcun(q=*kKRh11Jw&{R#}QyLEAj$@vr7>N+yJT<)!F~} zRv%I74I=_!K&bdMujnBsdv;CJl#5KMYn@{lzM)k`zE4%^pUuyy!bopB2|9D~fBt~q z>@tcZS^#&nIwvHsQ;x3`lOQs8V*T-(94+GeBOph&xZ8sN^VG}?n%^M$ZX$pk5o;fM z-)nsFMN%hO6tmd&@fbEq*?g6;lMvm+NdgQ-5R|^bG1_~6v4L*X?ngRmZoRtg9 zpbli9Bwb~WKR^g*%HD)nIS1Y+=#e3HY@>#Gq^XDhC3t%Q_2kDxm0$&jGM*{FSGyXX zZgk~JC--&eP*en;WG8jNoV9dbW}k^Pe|l6+xx6L1U3NM>PTbK5pj@_`$Oy4W2^i5j zcsXy`8H@MroE32Qyh_Ol?o_G92>2#^>Xz28m3Lpawi?sGCIfA2ZkCj^1u>voO!0sG zC6aGEXx2^)HFlBrvyrwz7O?>ORbq}-se=Q_%Mh1pwsZGV0=Hv-rY>#mkD7Nd`2+9G z6r^WddmyW~GPWg8YWst`Wcu55BSX;7@{wR&QGTL4Q@{dK*~`e%Pao9<2!0`D3{q)h z`?t=Wd>~Rk_l^QQG559J7(G;;v_5EGnUuN(^8Z5U^=w@WfX1lKVK9H;XF%dszjXUA za=`ZlxqAWnjDH^-h`4`IynHG{R=w|nO6Plx`-6$Sif=i}#0f$Z z)ItP>1IjK)PKcv9S4pS7pdv(T3qgJK^@0@${|A>D07oAo4y363k9vwbiXfh^(_{jGj4Gry3 z6#1Yj^7fM>==I;X&lcgeA~oCGLdnU3fjc<2SvXG&UOn#^lywijRtLy~;VEcc{cEY~ zZXI9-&{&?jJy%xeFF*-)oGvi6pMW7uimI+mk=m6xsMSvnvb(-JvnQA(jnMDB+$v2&r3e(Z`T2h^*DAseP@ls6JoW5y1Qj zd`*VAt7TvW2AG%4AM@U!5VcEL(nDWXVm-$ZM%1nq=&+11w0Swfb^yJkABTrO3m=V+ zfWuh{|0lEi^@@*u@5>OIZgbVwGS3BxO3~ArhxQEf`0EV;;EqN}2}R^9^fUCF+U-&j z&@()I+<)hU586RdRR-yLoL(gnEwKS@39k@QrFm}M!-uH;B<*kb3CmF5!e&d2h~oGG zLi!4_EB>2F&Jt&bzPoRAUw)EP9uW&)>R61;jxmO6JnK85dl=UD#>?dAJjsYO(odL+ zfxz0S)1(f;7X~1y_OVb0ssL_pgp;Q4Tend!S<1OVRnE)e1(SPIPSxZ~QD9dwKPVf( zW8BKB$$bhC2hhdVeW3vrOawjNqx5=9EdQXfiO9H8RhGVexrv9kYsa)jDe@Sz`69=K zlq)KNY|B-1i*_g_MFMQ!v0tIuF5jb4-*QT-uxcn4ZP!ae>m5k2P&F{g)I-OJ+*kB--}34p@j0t*@nRg|&fck}=w0dQ(yvlsHER5%1r{0I?UZ1%B_ z_7SBGY0BAh9L3>*A0p8F&29&=Xb_c9Rx_!)f zE`v1<;c9*bU#bI0K#Es#Z8@(_Ub6s%KWj4pH2Ss6NK^a!UZLb{Ghk89qB9WVoGzHh zhGz*JL~+`5n)NQ#bv>B`-UAk>15xYq=sFHlUN z-^aJz!7=|Q{7ZC!dW?89hE0&7CHyK}3{-rFmm4pO1=JjI2rw;C9fPC0gPjdIlZQEz zf92)mFp64$U<3?A&<~}hmv`^vN8EK#K~+CS6y-R>kKr3$F7y7Sd3qjXo4GAND zo86-!dc#`j1)s-t%o?*W1I%^pE_DS0c@G2owkXqX#lv&D=9?*{jpLhQv`IK|X#(~J zDJ5EAx4K5I&jU|S1eH+~1R2P&>}oSY_az^&sgyoTtt>^g?Ht*HE~&5%;{oj8ckkX6 z%L}&OKD*`YvrxyEezFWuw?7@W1L%og*#J~1BlW;hFlO_`TqFEM3D!G0N9`qZOSH{l zc6COKqTTlPS4~wfV@gLue_m;|vnbSYb@oI;*hUbrbL=5J$tsA-NSn$8oTBVI!2WFt zPzPf@WO9J{SN3lsv`LLLSOHrg_`c4toaq$H=bL5kSe!@zJ30di7A3@q$A=mds;0~a z974^T$Fj~Nt5F3^VX7APnc_oZ4Y|?%HhSpj+4vkg8tlf5A1>lX^xwTi`9b5!Y)`x} z)Exg32kS)I4e0ZJSkJr%4@MQ!g^Zi8v%)m9nr|O-C6P4C0_@Mqi(2R~Le;-*;I?pT zb`$lR0;bk8RneBWLC<<*Uu#VKtvfoMMyc}O`gy@2aAnYiD>H;uR{8>{%OV^98Dt#} zGzdIpa2(W|#6?Z$UwRq|*-v}Gf3opyjx?ia8j8=kwrVvpw~BI{~w){aLFM z&Mq*NwqNFl)MDuL-GsK#3bn=J(s9fqB{dfDuBKG-rCKiA?>i4h^j@EdNJ07kvs!E_V zCC1J3viN-9?cW3JF*acF8_o-BKLmZ(%Wld;R7qeeR$-MQ!ylt>VAuz6yEV`{4%~-# zDN6MmoyoQ9>01VjjKPYY{SS(@yJvF(ImEs*}t{}H56TTl0~L?Rg{%g>1SN=Rj1wtXR|bkzFD7HJ9YyH zgeeufwB2z6Iu1iAh;l&t*)I(!l@81(2k8YF%bYZyvZVgD`Jy2mLA`YS#dhwI7P}tJ zpBDplsm#EqFU^=H$>Jqnew`LCkB6c0r-W|PHwW_ z(w&0FG+;%p%mfUn#VUJ2++j5q++U{l6Htv4K4HhuiLRq6leK8Y6;{CZNWaSyrf06+ zBNzO>X-&g+;T*-mgY0q+T__?pJc+8TTlb|W@UZ5zp$2ng)@2#jvn?=fdbHD6hz?Kk zK)N~k$)B(g2)m<}?eK0K2cM$m1RRhreUt>UZ=J#On`a>FT0e<2_mMNL;wV?@fQ_D* zNwg3-hnPwCI=(XPFA}O_S2ONax>A6j0Mlb;=PtuBv-qkV3usDe{Ry^48?u>dKa7TrEbqQ*aW4ElmGJR zWI;rS=6A}Xvx*E^8VElCYo6Zc1APK4RuQ;J0=7|3r6CE9%1pEu2@9h_fS(ka%w1Ps zT8i4h?N~u$2D%0Y2KFC+r+#Xh^v@M3Yvj5E+hbaDqMGyznLgEWlgk#oc29;bZ`tR^ zlOrw;leq=C4P^;~r6As~lHTBtwm!PCOb*Kg0$v?RM|`jQ>5N?=5cF7GQni~(J+E5M z_+ADJ8A~q%G=bcw;tFVSoqC%|`{K_%RdH3PlTXCpys&DwMgc!E?z*D3AGn3&Ie&^m z(anqYdb4;a)YKXjnk`(QXA~i@By0us< z`HVw6&X+yh)1O{I%==bS#&t-NbRu5#u1Iprhntzsi&Q+4FPyE0tWNS8#pB++DLe{f z`BsfX>-O%VUr^Nw`Ds`o92Az2Fi@BWHy@oh>1x zBJ0k`Oei4{3fV;VxHHPg9@(5PS=qacGs?=|BqJHwd))l_{q_0xGajGk`}KaVcU%E* z+`C7kSx7ew@Ho?DmAwRBjcF{&9sC^bX1GxvqbMoQ=JPVAqc`!NnpPkW?)2Z}Sp2OJ zp}*-E&nMQBSpYWQAF<#hbMuXLk6g7nzPGw-R+Xd@D~Mi$Tukeqg?5`n5G-)o!ajYc-HcH;?E_GLNM?bQo+LnN~9dy9^V_^kRu4LlT4al z@384O4DrnwXBDD=H)K##b`0^`mkFEf#cEzi%T^eW4RgzyN(WcXa9-{&Uxe0+`3@ED z!}I6)Hwm;;m{U3he&(+EHdY1m=4+?X*qW2Qw}9r08)nqv&+F1Zwync`YYp#0 zfn>7)g-_Ic2Tf43Z(^%I5lflg^oQ2ccC$S;OQ91qwG`Ojhx0$>!V4W!u6M#{Rnq5? zImDaJkt$i^xgBbh9yThJr6l@*FV^R9;c1EB^Me)Plm&Tp!bplIOmeNhUlyAKPRSFc}GC_faEXevYhh>gn$ATwb` z{ZS9KTs9Di4Kv-BcYz-{h^f{dwm)tW7EcN@$g`r8y!Z9NgA#NNOI)P-D8hLAXCg$I zbo?fmfhNM}5?@LR=`z&DBGYyF;XY2jkS8^L3Kqo4V}9dvAq?6mJIi2tGyL{}YHn zJIn=(DBE=J2HSKceU$^5Q5iBZJiH#B`WfL23(dhKwGPtj{>&!}D$m6K6cJ_%S7b%` zoWN(-1W3F+(s!&8xb!uOoAjxK{ipjD&2{``o`tLac|Hy4gkMdbGtJ~hK?VNQ-wb;d zvy0$T|LzuPN%Pc4QK_B$A@*=Da`g4%sw9#d+#v(6t;H&mF=}<;FNXjpGN#XNohl=Q zivZkM)7i&V29(98sK*2DR}`fA-Mrpvynveq#d+uqSmU2VYp zDdpdUY>-Gj-H?g0Lqy$*#7&TjDRtZ1gR)GRQI_g+J1xt0@VnwuR@U~53%$;znzviz zgEAS%eO-*{Fu^lBZ7LfP;0$!=Pa;9yx#xkRJXCjLN)*^G8>vTxUNjaAP3T@j98D9q z{AVbzK>t1-Y2)~D_7Zie;}l0q)jLWeXaGnsp`O<42%EkO%*pQTG&(^g~(0cE$7b ze%5L;VXLxrJj7g!p(1DS!ju9j0q~2H2lD6N4a|5PI)_oRKWK2=_q` z*E>tQQc65LXjMyvGnNnJ_`_K=n9B!VuRfy@X=M6RP99 z!D`riZe%QANaAtd9aR1Lg)Z5fyb*L||4Q+9q{($sI{=(aCcX8^TFn4%45d2MGU*sF zI@VR^2#1~(A(OFYj+HwB_FDrjp+-U%gVkAXgsH4ug_034#yb(!sY$t*eQoVf#~rsLvu70blOd z+*nVguvR>j>@o~=SCd@Q(N`tc0H)ZuFSf6_FOq#~!!(ZOfjpw2P_g#ozeQxE(f|&FvZsmYK{da4FMEZ$t&C6jNV7!$Shg?ylCx8}qBJ)XN zHyCq{5eKxGGxw!Hkrqwu{%S;G*X{r7hv$m=+tdS`QNXJ<{K19CHhPpfVy2SV^F!+1 zfU{G`&&_L!KKjmlMD=S3@|REQvi+ihle2U9%}EkLfRpw^cQri(?B60)>HA{jB%&d= z%6FUE`gVBR+sSd7vHCb1aH}!dokt{#NodAvqMzm$;tH%1e6A^mE>R72S{rS_)~mMP z=RWO;;nFI3T~XsHDu3BcZss{11y8`h41l(4J3hK^U7g7ztldX=k_K{fy>{gIB1eKIC`@;J@H`whan+#$a^Bvnp${)m=O1>CGyVvZHz$#B&G zEYuRmM3lIkI;m%&6iJ2{PE%WwQxX+?RRa0hf)xRKt0E}yluqNBBW=xcCc-u(H7N#S z1!x=*Q7{N^1F^m3!3(F(-HN+G1y5ZK!rK+7U%`JEO#oOR(9w! z2qsA7nj;sB@3ZOF3|u{lj*yt=2`w+>0GUY)(OaV?tT)IFg?K_0b0mi!?^vM&m^-dE zt%R@sBct}}l9%7Wbj76*F2dR2&T$QKGF~8KRe9I01Dg?0$(u$kEA#R250Au^-V^%? z^eDU(13d7zImNdZ*TTTq%I_zr3!|@Z6dB=&9pHP(0iB{P$sd!iKk|qrhL2*ju z`%luZo`)=vv|pulNyYT&9iMHo+FjCHS#3@AzxnsZ2Skm+4fVwSnvU2S0fj#Rg_KXM zWCLmQ|LEZk^B86vHgt7O_~pB9&x~)ID^J4mzrGr%5sOF$rz)akH&_3=%d1=drsumq zHk|Tal}$KAjfgJoBfqvb!BWe`t=h$$ASSAoCxzjEqNy{Xoer|dJf^S)TuTkj zW19V#<^wEAgB#a^OQ*}~6bu1msoqEX9Z$SZ^igz*2-jA17enHX#SB$keKWqT9Om5R zn%mA_nIhgSC)yHI4rQ@ufAIxkwwW6eC{&nwY4bKoc`meWE;fM?R6_yWUYt^F@9RQE zs8GVWslH)vC>~DbgMno zEj))4agm!rFX16SjO9J&>%#*i9|C!3d#keL?wUy5FOi>1mcY;IKiT3e@c7@8Cl0l- zeST*!mQbWzRQJK!AL1`W1hPa@7;I>J=rS;Q)l|s+Em1xzLWpl+ZE*ROG=~|5$M0|6 zEON2FzDvB-(E_05;EUW_3=~^qEHwp`hA|q_A=$D-jJ5Ftb$Q4YsN(aa(Rw+!5Do;; zmPRNaXL4D>_h6UMPVQW9(ys!SN%$a3CIH3lbEu@3atx1h(6HU$86I_o-W2xz+h@NxjQCEhm%R>#V(yP|X{(i< z%JDt~QxssJ6rsz*Wkk0?@dkIRALilSbl~XsBI}L83Ec-hu)QFP#Cc+AaIey z=z8{C>Gd*dj(FoDIKD{!?yr-wkL)x*eXPFHY-16a_I$dl)*BK`IGAk*)e?e=cx6Uz z4U^BhA70`uo=ty~1(bQOYvxXhGs)nmbSaW5b^)NYRt^&0^->Us=&-#b%!D$&MSYVA zDVkMN+rG8$r)F<$ptdT)Um{Y_i&N4B0zR?D+9N+5unl>F>$E`QiBJ;>7|Zlc_nDD- zcDCFG?qaD20sVdc`!Vfa+re=xvHA5Z=P;t1W5Y?oCekDSV&)LwKhaaFbE{^OJk4wE=Me14anoXF`oT(3Cz-6!hTEvkr=r zJs5-=H_Bc}+_?GIQ<~Kzywc^)mZNP8DPzk}XAuK3gn z^|~>nz^6?6C=dP0isH(%SrX&Xdyo$6!GWKXZelj45V{1)hkSoU&tO2vC*bdg8A&Tu z8bseK@|EvxO;F?GjBH<^PJmB^#6xkA3;%okDPtn?TI-yK_$l!=fKRVkcmYP^dx59d zwM)IWs*02?=5HeYiw?X4=A(u8)q(F-+=q{W>yo)7)J`_;9TI}suXVM-ZT}y0d!>5T z=c;dt_WYzQ8lhEW>e(T(ANEyqvmSrFxOU>Df5ELy5j~`7RNWIPuZ`lyr|V8j{W;-b z_-YdkJoCve?9Xy4;|83`nht)Ax*zz06#zMI8{XjCW7)WaC-oAoGCvpGu7g-zj8+nIFwiihXeT$4h16mBT$!+^ zTT7%q?N|V}N2-OqWFh!05!jsoPK++-ab5>By`MYu>gvj=K$$}rk_1IH2_6I?G=@)w zH~#iKTS_&h^k!ri$e@Y@}UmP~v>C&#}JfA&eK-%obvFKbvSvXk~c zN^*pq>zP6!DsS|9mwOz3Gze>T{h4$h92saShsFb!bBHl^+py6oL6vs z=C>^hv+K;PExX-cZUelH+<7>My1n(So8im{0lxix|90dgl}1`wh9qQl)X!p^hRc-@b$c?OMu1251lq{yU(_|};*3yC_^x_U~R2YkbT676&k zL$+rv+6Rmpl-SarMkO)=cEtI?H(_6EVg*66?qm+{hdM{xR25Uze7|NrYWnu;5-qpV z=bH~Uc!4o@O4HA#$G-G4(EMn$JrhC+U4#WFfOJ5*RohE8!zs$2sDr0BJV}sThW8)nL=)3Fe!p<}27JE49I1Q)gi?XE+HFHU_nid1l!ZE? z69<%%IxM<1lg@vpFfh}xhll_23{x!n9mf;f8!paLA%C;lNyMFOD-n2ynkY*#M=~(> zlge{7bvH{9NjXC-2R>-hL5$zqOY+b&ZyeAo9w6>G&}5E^1Rm_e;5``k&zKfX+Vl29 zx6-9EWNe-weqf>=5>;2?k}!s`c4%2c7CH1ttfy@@WmksJzEAp|g^%>Lov0;^^Bzm` z4eR>_l$}XP^S*URq7+=@m~^*hn|@Uw68xlgJA^>RITK9n`fEmJ7%B2IraH{TNAE4E z7ektUKE0iy9Zc}xpO_?brFLl`KYd7jPltMMC zjp%Zwb%wT4_S-uXTZPq&%)PYt9RF_0N&T1Y77z_Y@FK5w!_gZ7`R54V*_pMIh#;U2 zR4RRwGwzd-JOebl=0_63M!s0$4-T-n+xg@^?a;$#5<=P`z#t``Bz&MZQY;bD@*Tx( z1o=R!5^#BI?mYNh-MEmk=~%~O7rNX(cO>>tl##?_MqgaXj_^K+pW@CL^d3+RU1$oT zT(y=K#+kbL5S%6=%1-DV0TybvVqRn_c&M4gy?_^~Stv7?jyKqn15vzJb$H>BWLJ6{ zr6EmX9$c)>4eEKh8{KvTel&$EzmlMWn_m;-3n-ff5Erii3+35&U_L`yA+`qJH@XVD zuoO76i{;#sAoUnjC)u5!gPz?34aCEQ=7z5NBCiu@qF{=a@D)dQIPJV*v|>DA4i+4D^dGz&x^%F3;QFy} zrTcnT@t1`cn8<*o=Z=lMHEEHKAX_p9%9}=d46KxKWuSHe&eI-hcF8WNuE!QRmpU5W zDEUU^N*zO=v+{=k&m+ojUL}zANSq{;5lb=5lylA|g*U9BaIsxd;!! zNO6&99wD9(%Rm%a%<&z^#2*|{e}#KOO}YkeZnphW55Z-vZyKvHJRVXJ0V6G_*dC^Q`M(hh@`6;lm~noWm-s(Qz#z!m|9 z?^hm-9=)E4O$N)M+AeKrt0bP zSG-S%M+WTo0MHUa^Z>TZP*m7V#`oLO9KHO3fv$)ETsE^lqy5CHtqfKO`$ihaD=W@u zUmNljZ0vN8#rS|K;A7mw>ow)BEme&@|E*$DX)9!G{!OLs2;WjvSpIA}o({qAS_d}& zLG5#BeV%3RQuuMW%KLcO(76_vLUwhN61a%}mfv~cViWJEik~eL*grDqt8T*>P{NA{ z^@mVlVj{+16=s1_##0h0IT%1=A{ihG=1fp3t2P9g@XXblE$2qO81?(xsw@|Bf73!; z7e{m?;p#$gb&cos4E$0^&1gH=L-}-7qbRv5MbCM`WCg;4;dt}WM{4%&}wSe-~xOSidB2D=p86iSV# zQC<8R5GOV!Atu8^8`TFelOP7udto)}I~OY_T2(ep%N#`{??DM2*xXa@SbE&k+X#Wd zYJ$VER+!C8Jbg_C8Xn1PN<6q;IKqUwWXNM>eR1|P5V2Es&9BFY1F*mNl0z%nL4je2 z3pDD&s?%CS^0PceOIN|r4eczXptaf9wyY$pW_XgUVc9r*HR3nixlWoHc?>poAfve6 z^sqegVfZARD}r|wQg~8BfQhf{ygBH1p*!Wky#I&Ir=TAFW@lKffA#yAAGU!{cuNY) z*@J$dfMN=#tQHixWp`FF9N~+J7 z+bwsH%lTuH9Imv=bqR4pKpQ&Q5p?JII$L0uPEt$vcTezND#P+L>;7u6^FQNjy+a#Z zO1ky+JD-V|c0EK)qI4^ks)qS2Re&$Rx$ZBlhwIDBKnfEyp=K&whKx6I`5Rcbc=X`B zHg(xb3f&G_-V%IxRx%Cau(?NMgl*!eYv&N;4el=}jfBVo=o-liXVWqjn#>whvo4ue z1Bpo@aB&q%mG{K$x69>|{}z>Lfj!!A0YH~Z?UT*08c8TJQ#ayutr@8unWs6Du@P9y z3zJPW4vHae8qATHBAB(nQ+JI=)2UL_4S)Y*NIfb>x{&|l9U9EQ?jBC3GGuyn&*c;ED_etN92TKO^5QD<#{Tp{AQ1#f9dMdEUDd; z2;!@;>hzdi$tfl%tWhW5z0{+9-p)xJI zZVj*#ty$kN5F8@*lsHYsGf8F~KnrF28%QRE2VKV7&bx}`Nd}#6dKH{U8eH3;WTHF{ zhey@tE8d3(-OJzo`3tXBYmhTfXxlb`taPQpI_C-TdoXzaWS0m?2HZ(BK6dcSKiXYc&Uof zyc*^zn%9l^uVI5%*iOQ%au;4EYB|;H(s4afK7C&=Ub%KnN^Kjqblxz7EU`PG`-1rT zqj9{H>PbrirlWQY>Q;Hv>MUrSUKqIdbOY+NLg)VqlaMQIvDQj4L$hM{# zt@?=i@cq5XoyDeLh$OtL0l3FOEsFf=Cs0l5A=KFb6nJwit5l>wE`Rc<#&mjV0Iyj? z9)LL60*+6<7-5a+_kp$>vtN%-$`Kh}xTNredOQikxd5Y|vcx}8CK|O^4F2KQ?@*Q? zt@l3~N$FXcO%Mfp>}B}QGo16v&ye52XZQnZbrC?78r8H~N|`8y0-}*u;6w^-=9|uk zbLZy~jcJ~rcuKAB0aR4fCL<(q15})XZ>UO>8A10>$ZKBlFJuTNiF5Jl6nDl<`h+IV z3SR?CfZ^&wfo~ht!^sWW?K8@%se}tm-@FSNvb-VA8!Kdrh{4MCL6>~);lQeI|pV-cKW%W2YA+7 zmD;d$3f0I`<7v}a^_0Yr+8nsff*XN4vZbR2KWK$n9Zq|(g;lp3ZU5w$M*XlubLB-) z857B4Bm9b?o2P=R_CBym+$x10CYnsG;k8b!(gAco@BBGEe(rb#~L1oCK%LEu+aQ$4c-SPi++tM7jGeOezy!HS0*WS52k^GZL z#eBipy-UWnNj|fZu#P!-j5dp4CQwvkw1RTT7|u`PVfopt5X!fRG$qc`5ofD}zK_>o zOn<`j>1(KNseX2orLh6y+-Odo+?i;KIA<){DcpTb&1VI8FoHORo-|Bnq7m}NbyV}A zLW@rAN$X^#v;nupq6`>K>K1_|7V9{TD>^k#o9`S#)5uj_Qs|QBox4?6*8wPwG(OsQ zXs-MZbq_w0TG?X+K>FZc{eyYP$I3dMtZlqj8i4nQF>b2ar z-0BdvL67^9+vBhBG3Zauut5{7a{JL)Nd(m9tWT1Yf`ACLVsn1(lh=6ex8b#K=4I+@ z+WO0J<+Dw^s7e;A33#Rrr$DVv%xNOmwCqY zpAb5E?68585kKz4UNoW6pltq!M!u-*mW}_}PphZs!(YTpZ7C~^#Cq?lRI~~k?%SB? z+8ry`i`StGXbyGe43F&UtCrCwv=Lr8;KKRK3k0{HSWK|)b3_BeN{Q%z^*->|Ll7)S zPmXW@q((vCvW5VKq_+MZ>souQ*T}=P5K>b zSjDY`Ht+N$tiucur>*SIkbTMlQo$PdOm_nHbbH7S9zkJx`B%cr%k=m~YrYF+-a-#y zf-e!kZ#of|E~ae{R08ofA~zpj+4U_4?hG>qVAU~&Bs3S;Lel3*3H%T8Ll2ew1BE;y zy#!t+PtL_<&Cr%SnGN}%?lwOYpAo1+>cGI+eGys}GQu2*k|F(b9%CN-Z_)(}$7o5u zrO-WLfPFHyk)5njTyH5+{x&+JdU~q$X=oaa(W{1?RA{iTITSYfTjCe3u*CuEo6B#y z(im|8yw!D+^yjTfIPJ^Ozi+@9^EFUUqSi0p{&Pg65HVIqz`*;fyRyZp)jwBs?j|nU z;=r9V1df>`xZcG^oc7UlHk#9_gv}dqh49)b`GTcCciU1~GbP=31WPwmB~p5*Hvk&s z_Ydg5<^Rr?v$DIlL~r&@ecHWh$uL*koy8oko((o4xe@kEO@zlkG6`MpWMw`9MG!wDfK!2~&Co;hOeDRj5qQ|rw115i|NQ2a571IK+VUIcRq z*+2ia{0!?$OuVqU@S01A>baQwQJL1aOpB-CB~G1U(tWHbNMB9p7U7pZ2Ro1i_Fo}B zg&?%P8TY-t((g$W(&2o|?Hm2${`fr#0-yoeBDefpZ-wwhto^JPdO3cp{V}s>(!TQ1ba>S}~@7Wjx_iD%O;KxclTbp30aBi^tO#b#GSSb!5KKerVSe8U+ z$lFd`{{3sY0Iz~2^NW$%yZq_?&Ue|dPd4JJVlAO2v?yOvJLm{kzm_1~AX`-1+$4odMO43Ee+p(2<$wXRWzyID%kt<@LUll-5XSs|bXOLeovkU0hJutSou z+U&Y^8MC`qU*)!f$pB5P^f`HAM8d)sr}f?vd4bL>V3X{7+qv@uJmMZ1CB1G4a)jgb zqf3_smi)2v#CRc{k_8%Ts#3L4NN~&_{CY!N3Sk_4&V|sjBrcjR&tlU@RNmYpv>9US zEnGr)c1Az9nf75D7xJktnMJ}fIo+3^;v-?!lYB2EDrV7)BUq`F-%`tvX{bnN23thf z3Qa>fOfqAWo~|ota`)t`4g#B<;Aj@fC&D7!`P%$Q{~cYJ6i^JbZ%|1((`&Ui`-l#w z$N5?*VqQ&KM8a0QS*L|$N*P}W9O}P#%go!LOzKD(GylPJfK{H}Ei{n0i7q2z6wv_- zC2xzhyznsr|E{4Bb|Q}cy!|D6^sHWAkX}lP0$>f!WB`8QlQ*c-cps|p0iUh`+1MFW z-<7w}ijO=+cki3lVB2kvwg=BI)ar<7rG$oS3$^rhFBpC)#XjFx2;}ffo{(ocSFI4A z2COjPW|}*G=&MH!n4k7oXIQdH0zw}8{JN;NG~bJv4rx7SWjk$PB3B#bb#?FCKPjCj zhQm%E3fgY&!&kY2sGe{pfx9=t^F*mSuPB)bgk^%=*`a`9&0S7s)2ZQnVphNo2i%Ht z0iFcx4Rj8gm&MB@dkHeM1abJ z4Fl)9n7{T=KH&7~XB|xk62Inw`?}U*W5W}6TIf^+dZ+IOXv3obp7*mUN(-0&mN4wH zVeN0Jx}iWI+Usnse7senGocaId5`>+rHTa$ohtR1Mq)ZuR8Bs&$SQ=15USn*^#T!= zsu8MjyuTlWrpUJz*7`ix!&qToKxs}50=we|^Ec!7+&lB<|KwTJ;pAiGUYK>NAD29R zO-!J~A&Tq^gN^XaJ91|3@%yg#v5D6lMnLi08=6GHH3QZO;_X#PBcZi{Zv%$K%%byD z4EmPqE%G*xu67yPeD=&WV8uGHczuvUh~+VOg(1SEW+7kBZ3$Wx6oUsXG6+qbkbSS+ zei^7Y9kBBVxc{J3>k8MB)|oFA+5?jI)|P3o1jIYX~^}TyJ zzD!?^_}~ZICFC}*bMfPo&g2RX>SPc)=c)-XV}h&TTEfu!{9Ad#;#($ZYf0oxS9{=v zbfX`2oO&u*J3r`>^uA-DUEoCU+EEcc>o&*njWNE^ni<32U)IZMbL7-u7oLV0vLBA+)5N{)(EBRoPTr%4YJa|Xr5E@*ds`rJ)*?H zDB9l{>0GWpvC3R!k5f7LR*tBj&tZ7U*0*{oZW*(7IcB%~`VnZMs_*UMa|t%*?>-)2 zPNvRtvi61x>$yNL#7vtF9%NJWhNHaM_@MX2EjMrPNd^ZnZKgx&`8?E6b_1>o4mdWl zN@omwIqs<>g(W*4Tt9sLwZu%#=Pv@&n{T|^NRbY@B3k@)p-<LGW!$V;%dDlyAR7DO%0Gtq&B@2FGx&*+ZZqOx-=mxHDqe^PERR995orNCKY z3b^iky*UIhfV4;{YI0k{(+ub~iG+MHJWXys=#Q)0OVe}}yxrNh6#iM`)eL*W z(a*fGUa9J~5$!?az`^!wzP%qru{)8r93i_VS=eu4JKYd>H6jNHELwK^_)Q#Xn@-ce! zEgRJ#846{Odl$HoT*7uquTJnZdkKntOQN%7{xuT?r?)=f!laQb7R69-mq|5atbz4} zhe`VPdnNwsTmtcd22H%p{k2tmekqag3tjQyA|xQJd3TQeZFok_V#cs9SwKpuIcCN3gBH#fJ;4^Mk(#Q|P9@M4aj zxU3Y?nS;Wq)xyRg*Vmmii>usg=!Gc{|3{Y`kpXFu1Cp+fB=D|k7hdoF50rre96-sE zX7Xe|v*0#Nmp}drK9(7OzNdUiBn-ozz%G4>8v4GxdE5SwvtlPVi>Kn%!C^wU{3mi9 zr<=yX_(4ajyutpT6IM?Gl-G7sJYSNb3(sF1ejKDU=d-Z-{=yILL!h|}p?{f>s-PTgl$+|PJ<Hp zGd@}>o{ug6hPkSqIIGS-7xu$Q%Rc%Q#`}7c9gmGIS=J6QS>4nD`H>NGvIFZx;Kc0x zrDug&6C;5}rFg#NpOwLnHXFmG-sXg8pFM0t(7#u1h|^3o#IBwOYK)#O=`7&)<>R!1 z%3yGNwpS&n33H%n_8(|>D8+icoq#D}X6;q-wPw)WIn;hwnYaBiIAtibc!cKNU1a9~ zTg1l7JR$611d>wqQRtH|GB2L~l_Zkx%dd0h1rm2)Ulf-K^iBs_MAJCvlF7%Tl`=Z& z{T~cJBnAq7($y=@8h@7i|04@;_reR7V+XbTu|shs7Q{u|@Q+pZ7rtU9SFWD)aB)f% z?rlMj%_sBeIxY0^Ds&^)6#JY0&^=QZ z7O-(JaCdp@Fr199@6+CeMEddfj@dKvu^$dhmw`o8u1uZP+J1@k5Xa{vltUAKd*=j< zsO%{Hb5B7f4ksoGF4t*(rl>3)aEL=A@R!1Gmqp^5HVD&NNYM@aCa z1D`C@bGZd7zdP36A4VN9)x23wZ$MBs~s79C1HIBV;xD`L$ z90dWpj#5*4Ku`l4aEd;k z0lo*yu9mi$ez>Gvl0(6C#EXCacn;j0X5FYxFP5IG1b;LA$$K4Y2f-Ur4M@E)hy&Cd z&<2WX)Zi}qDSms85ogS0?7a*1QYxS-nhHkBphrJ)z4fVj>8(4ZTzi%I!BzoOH<^VQ zHc@vrkO!;~>#CWLDwaq7H*RlRdTF@?84UWmk|dPZkIG{J`>7Kt?nAC?y{5$J@Q}Pn z$5k&DHvT=y>9BfQ^FpdQ>5p?)zD}0Z8;qFcAFTGqS@_?+BHjd#4=*caEg*%z+fe2fCWM+gQWJv?KgjPk1Sx}s(Em8zBMlx+mp zo-)*ks21VDujoq0q>?|xI`YwKR%lvRXB1N9x|-?lxu{nz>lPAGDAUqD&#f{MqxnfO8G1`O z5SO;UcU^3f?y>w@oABe6%r~Ds&YW=3?b9#u^@qFWOk3|1WNKgK-Zth+3*QogfTe}_ zDtlGI!;jwY{lYiOy?MSk6AXN>N_Z#s*7@X2;DZwRFnY%de@bR8|VLvmM3CM3{{^TYusrFqsa_pa)gj*#LGBB%%* zLEtUy$nPy3cNj`g93?(j`n(3Cf2t7sU%`=I?1%q&%5JpS-UWTelA~(16RONo7#7+l zt*~?Qm6d*X4p1Y6NhWlM=d;EccSrqB3`i|kLdbSSN4Ov+rUP7@q5U?Z^OXJYXA-#N z#PD`O&o=AXAR_PWUxP*E`kuh;&=TT)(7-5bB3EcN9rfOW_e!@UUtxdz7dkqD=t%Tf zR%-|)CAzE3*<{0VqViPJeLFsdSX=t36*SvCW`!|gZ;e}T-2)O zD(KhBO`bdmU&?*0%zjA{f?I=P9fUQr;5~mStWEffXu>HR;)?k1a_&t$b7nl;z94h1 zre{B+eN89Ls9|`Nq_FtZ^$w+>)`}ji3yh1u-$?*o(`~tC%NsjBuU?5jO)MtB0JMhJldPj967$$RJqAI51~}#SFQ+H?O5>zGzuc$mX5=%r2qB z_Jd$4xF3Vib#bC8XLL&zAV9KnllwoeP^Ps@0?PNgPPc9Q#hIluxS#WMjWZJhHEJ9w z{&ZP&%D#*oVU)fChYs@^KPD^KgYRNVLGrExzd1>EiptrzavQ}%G(VVn{{5PL1v+#V z&DX{@Bw{|lds&K&-k+_egewvL?8$Kg%s}zKtjE()MTDS+FKbwxCtw6Bd0y}LZ|F?; z593aE?hwsmuTXkV-1s6%GL#dTBHWDeArJ40YFJ>_KT)3WhV3z%`8*a;YH4g_oqXs# zMtWBW>7v@e5h>Ow1jkxlLblBI#!F8o&KrWC8pyxWhTj3ADYo0clz%?-UM*>*o?N@(4?=R7R zEl=2?a4AiA8kA;xCAPPs-a`L`2$~A1yYl^a#dAM6zVdR-->A4x~3xl74FbH4ag!x zLH2{v9CPqGQ|KmpJsY-HXUmD?A+ODT>WzTu~$Yf>YvtY^tu@VDV+u0R2mRkJEOKg8YcoZgjnBeR7MNBf&-}2TIEBk#%t(3hl zmH1zw=^_g0H)ZYG56@*U(?*Wf4PfV&JsVo3^eZKH+QqvpwS;=Ikl^9b{hIgc5JJ@L zS1FIeZfnC8s4VZVstOAs8ThrW^WN{ZhA-{ZSIlhqlf=4rMo<-gbFvE1|M7bmd}%KO zVK9v+|2COecfw3&=L+XcNEIZ@OFOOLk%;EaxT1~^&>9&^Sz9VCY3GCCkd8mr{pl`c zML$(@b1fTP_(PjIxR&&&qw~4OL=_t4q>|v>XUu}hn3L6b2Wo}3k{I5Q`OlifbMx1y z8BYU+r%K)hNEs|kdR?mS$wjNsk1}5-ygPV|#nDinV(~50PWQI{{P*KBD+030&_+`U zcVya+D*P-QbiZ#Uw-M7rbtFaGhq^!ID3K_(#YY@7gpK2HDaGJde6v#}CRNO_#nv zPWXdezfE~3w;XvanFUI}{F;`uI}4Z0hG_GXQGU;*9UxDPLW0m@LR8{HeAFp14rDox zC6dA{{v$Kt^5bNb{~hhArFb~_^1J9_ZAwep)oP@8iDPVF_38Z*C3e8n00?>c>2i?m zK>o4H>w{JwbQ)8TXGjK|Zq*b=Avi?71q_4MLLvdUIgqFG8E6Wh!DX|Q3}6u9NY zj_u{y=Q{c&f>!b@QTuLausrVm{re+ImwWgJYdzPl&3t6?omT>3tPbF0VTU@>2hXE~ zJhM9|QHt!M&!<`xciZplIbTopwp_6kErm0j%&La&tc;+Nm@zLbl~OdtV(P2R?!^yu z!{3EJiwzAr%SAYB+`V=PMX)5eDJZ4C&A8>B<8z*vw7Y@0N}g*E$)#J<*~sGuJFiI@ zT|7;?1P3*ar3LBk`pz!NjldpaQwYlUez#XLBPN7z!Gg!vdso`idL8gy!Xorr;8 zm3)b3z5)H%-SSWkZq3za`7?8>a>R>Du%V_ym!P2jaC+a_k z+;bZ;3ntOk4^wpS9JqoZuO@*1w0cJL0-vSuO%15We4!S6wqyD9tdT26zn>1?2LV7g zMKv6vI#W5sGaJpW)_Vn;Sf2~m8*b7|ijs_u6F)9Niqi`MpFNI(lqb|MH;KEhlRi&V z_j~*~kE>Vqv9jnVch&qXS3pJZ6@c<)OfYAmRjllT>FBBe5kSg#Ue+#7LsBGMZ91|H zIqLC@u)lAx{qoM)yLI^VBrJt(sdW3-+b((o1jmQ1on6sjoX&DCHfc=#~fF?g@5=)&pK&J}q>inKNB(kVm4 z^D(o)_a9^0#-hpk7fC))+GL zjg?8X`eiOr!ax0A`a9k@3|POrVEiyBU${NfrKe*9l{I=El9jgLDgFtQNmdD1MJrcd z9~XKDlIU=NP!RP-Y+BwsfK60>d&KFHOf~M122Be}e}Qi`yn4`!mEZX zh3}~i&S5d64Cd|@056VanX~6N|I;Jk&?&*ER`X;T)TU<3$EL=h4}WkYVn&BUMO9pW zNXszmxb2&d0_O|bu7a@79bxKf2?qVG&8XYLE9{)wx3`1EjQWIu*%Ya~;KDz@Jo4Ti zJ|8Q2wW*jF>_XjnJ<-i7R4>beg?$Wm=9hx+EroxBP4=zJ`sbDioTUt;Z4mbCmAC>p zFXZWyF~Wh%B9~)z>JtPR%1o_^={MO(v>pnIN@J(ZpxC6s>E*?E$x2X;{h)Wg+fU;l zpvC~{DqmwqY647Vq^f*sd?Ko;%-=;n*5Ezrjt3>;%pdL?{&%xKJCw~+iS8s&5=bud|+HJVlHKgDCwWYy1e z_VcfIbbXgfE9?~IqLnhaI%K1j;){G=Ux9;oeoA##M|V;l&A)p|>$yjwO(n`F`Eix* z*A?X#>^Gf~UhsvE7t93||XksJOlwh@#FV5lbo;_%=>XTji%rq=-) zulYQE7rr$pyIPHE7w!Ck?g>TM8SI5o2p{=m5V5 z&--4b8pw(%)5iv_&hy(1%G7a=h8ZMo-A40@2Rvra1iS`S1LhkOTMLwU3pFTXYuqNTDp(D#`F7n^-3b;yxe z!+-O)b?}NAIg{#A*1>KS$KtgvqV= z@DO@AQa3@Ts;rwvWD%I9Y{_Qr<@vJWE{YU)F{uy$w)?FzD|u(M%Co2qe7jF z4eJ@R3zs7U&`X#!Uwlh3Frs!kDO-GfD(s6f_5xKd{-}o2(eM?x@2ed_k6ZNA0)`4j z4wD~0TV~#R1WD)k^irVO^G7*nCqG>W6Mf6s`P|TPa=ZIIK+bd-`8(h=Zcyqxq`2gl z$)CUV$Y!3v!IkD8%DZ^0(s^sW;qwE=!@gvORI?NiR#)L%;!Db7W=+2Y_!Zl#20 zAttzg$+d+B0T=pqb&s77)c4Xe10QtIr{%MZ$h^Xx1@IKvY+vm?Q!rR-V@6)lYIAgF z2|_&Rm_T0#DTrrwv_iw4-1tG|K8LOFEZ7V8Dq!p^q(hkA3)^$(?kb{b#{gooZp+G2N7)dZxzt&&u;qOlKh}ST?wcxx0R)8B2Ef zSioTVr_@pK+V1N_t`xW@Htv3+u-EyP!HrAVFN8O}g$J694y`)dgmq2gOYTltgXBC? zmA*6Cfz9S8`E1O8UZ+7(ec&`J3J_0F?`f0RJf1H$qG4oLDdH*~lEdy$<8}CJnQ$LV zx>fuTvaP@!ap&HHY>1f#m$cB>=jLRUYEDQAhdn4%8PzAenA?2+LZtF%G}RvxjTQED zmAhdzsN_;} zBIro`G$%}LGn3BAxdR{LmeO!dYNLDouREn8P!=WmX~*%CqyJXIiIT-wCz-|n?6P(E ze20+|DW9x%7kfhf$KF-IMX`N=qR} zF`nJ+GtU2ehIr@`Tm{=M%C$jFcDE5PyY2#vA>IYsnKQ?HGd}?I3M<16(89u6Ju>6{*R+$cp z&go$tU7}XZ>onHsGAkq)y&9UNy4|54~A$&^4W#@qSUVNo$s+F7I>M=~3TvO^z(6prHNK zW5jc<#{NFbFCTAvGS%fpzph($T&Qg}VX*Ds`n6KbR=>a8@WipZH=oKsf7fw``lIA6 z$CQtY>L2L5-1@J^$Fz*oUVjP>3a?^wNYy+p{!FKRa$P*j_uE$|(SE|@yD~N3mJru- zZJ{JLyF~Euu&8y{cc$ofUiWBHYoFWU=i`qX6&svp`+SL9mAU4puPUw$vMMog(#;R$ z67R&^F_0S{XWqB0cADH(>k@J&i??}{IxBkdj1OL=f*LMLEx&b!-jikz>c^iMX#JPV z>iZFm+F9K8ykFzEC}PJ+8MWY)s%4tr?xc6I-HFEO7K@c;JDMNpqA^6K@~H>=ryZzQ zeDHwRPCK7fJ3XZHgY;9g9-EerNJ@+TbpC3kVNulvb(k~dWuW5TH%sC^I1GI*SE+MV zMf<3YAxYbGb?PX&o8NSsU80$y?8sJQb<3F7yL<9fm4ukbgCZO|SGFjv{ItxF_X&UB zKOWn+?M$W7sZkrEFP4Ze=1?~Hv}ey!e!J$D?KDv$3yN^UqH+*4yzu!a?!n5Hn57t$OV;N*%1EmwIR16|JW;N{XT;JMU0A^w+goPxova zT_?QG+ow;PIaN$|UZHJMY_k5f!7oO-zpEs3Ym-aHhzON=#ZQ#%VC?7bKQX4l!3koG zas!uCS#$4Yuv76(jjFnKO?q&-OL26e#wZTA&IsQVd-Bp89d(yX~0_a1fJa=v}JZ&>EZ)sY*y31>MFUo zb7KXA1yipat?;bI{hj?&Yq=h}r$0qTuAf%DRn_}_jCHv*T=`PkfG7LL-kI|$qMz}d z9sw)#E(ENfyk+p@-r;AoGK?Q>TRY9=UKyj9vrpK<%R1$jehd#C zqS1NHu~TuaWHznYU+SL zbdzytl$h9RT=9i7E)G~x=j7;)NAJvysr^>Qc?-~ShY%>6YY);DcM2x{PiYn zG%rS-sw?+*RprX7nxH-z=ro<3E5f0qNHhYsqf%kE6-x_Ru;zpG<^mObGq9*Z9K zS$c2b0lN|*lkaXH?$~8;7ulB&GkQl&9@Ri)&YaPE2JOG9U(xLRyFTj=^jWl`Nk;3C z2gW`b`x+?d$;GE!=um9lym_Dc7*){p(ELzLqukwVEjE_AUS6zseVjolpS|I63q~wF z7kglX#UgKG^WyRu%iWA-pG(G2%#i7On{BIk&wHeP(-g_*>q}n5JCxowTPAiuh9s6F}@N9L}YvazJaN75g<>piEt+aAaqfvc)m8&d_Reo{r?q+qrQ8RarJ%7=?=`6$Xz3We{ zUv*(%+I9U>d$;V}`cyVi#%I|uMNJh0&lS(-rqn*O^j*A-nwej>T2)FYeqYoDa*ZntTJO(X~p;Pc0>9Po?Rw&La}zTmXR-e z?A`BXOWn(yPkyQRDsg7i7;_!De$~~Edd6-y(vfSbQ+BO)hDrm;`?B#BPE;*(dTjZm zX_CteRC|uks9e`$@!iIEjgN_&z1}%nZf5i8^VGUT%=}>9Qr<{a_3nAvBJo+NnQ{mV zRNKh3zOrK6^q`V`mwPT$FJ*Fevtpfd!{5c%NqhgOgWmHQ1}{wXG$(ZJZn3`4;g+>W zo*CTg_Wp$Kot*VHnY`@psA@jq#GIB(j_XXkG^b+eagPE#i`Q(sdsSRn&rj}8FQs^;MLtWje;v55 zRFF-#V=~1CZk^Kpx=oXS_A(0Z55?9zK6-5jvkuc@D}B&u8W1{XUsOP=8WgihedXWL zZ+m1kl}(O)J~MWQY{cp_b0=D>ynZ-s<*W$bGauXD942%4W>jQqWm!|(`bM#ly|t>W zZT(Va$@#cub%(C55IL8cveVMeR6GL>03u4`sh~gFsk+YC)-Y4`Iu6&+pQJpC(_!v zMIXI?J;bqUMCF#nw%@C&yv1r=53QMZ!UsM!u6-qbnoqG$bV#y<5{THSoEEXglP)&}3#+ z*}=sh=^fg7VS;h>YO*m$qF3s6IF!`&^~C)$FU&hukSi{y6{H+Ja zT1KLla_GeyIpv{Ej(t!(He=CW5i-@3k0i!4joCaot}=V)L%R$ZxXyA@lVVTj6z^~?+A95I*-n-v$H**Q;79O}ztYyYMU*#+P!e=&EVO}bu)a>AElNJA3ra1aspTWgX zSe+{N^6BkRCAomq)h-9p%Vmfzfz$T&8Y-Kg&N#Kq!OSi;T3+0!*rvwCy!P>>ppEi1~$DJo8IA^qv|mKI(HV#d_Ly!9X;>vrf*9=b)VFE_W&6R8+-bWq-sCk z9kpsiRy+~9+<)&gA8&810k6hRf04!58~rW;Eq0H7S$W`olbF#}qa>3p^{Qm3#|)`# zIXt#z>7lwZYlbXvJ0ESm%(1xphJ#Nwh+`UzS&VmRMi1?$cxuaQg(m*96fdosJ!HhP z-Y0bq&VQ-YTrtKwJfL5(PFrJr5-6O#PJq!25MhsMkN?b7pX}SCT7t zHb?I+uV!l3-}YSza~Jc#gY6s1n0gKly;Sb*vGAk^q71GIy6aLW>LKwfi*gr>Yv_gd2LVXinImkuVv*@EmJz*mRoqR;;9BtTAA-2ZhLn? zC)FLYrvB@Wt7Z2UJR<7+9hVzD8*uHEJ`bu zGCJNlYGJ_P&W7@HZ`yw-eps`@CcD&jQQd82?o3x|=^Jg{b7P4Uz1<$Qc)DTv8{b3g z_bzT+JYM7dD48%Nlg1@)ML&$cR?E7xOvcz^r#5fiJUv2m`tJ#jarI+TdfZ)b6c#qE z-ZF8Ud#&QkOP?s;?dtY>EmVq^mvd5#saWE4aNkR7W;CjJRz^dnpR7q|nd29$O*HQ{ z(Ink-ctg>aSC`%$t23mX^NNrzpH$WF+-_X*^vhm)<+S{l&pX{ow=-5SPdlWl9o1c@ z?zSnyX4f@pfv#+qo3&rt`P~Uik~v@!-l(IR z>xEran%2CScK3aP_v#Y5W}WrsUFc(U?C$&*ZL3C<$yj}<*3H?F_56u$NtO1uN!_AZ zr?joS?NHlPl^)@vYL}iae{g8j-8#KuhD=vP`|y z7iL4$yU!cBQ&j52SaGkY`8%6Ec=O(H=vBD}Q+HhHcBkaSxAV)TE;`oJLZ*Fh&nM#> zr@FP&464v8vG0SK`t>WeFw8J0E!R20CH1y$>0%FFz3Q9XwPe%;UAypd_HxGEi(U2= zMSL(gpl3emV_WkBe^-uIzm!sYg+a^G8G|Rbee*!ZFsSx0jbh>r4~s2s739DETqT+G zsEZ9sX4IB3JUd$EV|-|>o8=+c0h;?0E+1IB^L1Rt4w-j`^0kWh&}_MX^neeMJ>K{2 zQ|#PJWf}b0Nu0&&EQ5wM!RILcLYDt2@~8jhKS+Tk@m=)4EVns;bIJbh1 z7=yG~SMZ%O>Zk*%$~uu-ADA!Df4-sU^)LtXEE_M+@&``!fL|jVwSbE`uyV$E8+`5v z>VwY_IF12L#^)JgE2}x6c@l|up;&AcgX0o`#Nx&HK1L!IFTi#4K(j&9QSKxhN8$d# zIQGJ^9qM4+aKO1KK5MYP;aHb_4aX4Xk7Gub9{i^Zh0_IDmL=Oc`(DNz#|EJ0z`z9d z$an|ha}OMc;y4L-&IPthL90OdLZD= zIU8hJiS3JJi=#1)E+F>TgCP5fz-K-v4zv;YCIc(RaF4aM)qY!R@j=ib8yl;`w$@fh z>}exF6*mfZpsy`MXiiPSmjt`mh0fECp&0j&ov zNo>!+XkRAQR)-lwdpq$_7i+V04=cS(KIR%XTbng|;BV68aeztVr-3F7Uj&(`yb3l} zeiLk@^cKh0K_;rN@cr`u)5cHRm^OXnhn+;c%{8yPiw!O~+lWrt3%X);)D}lUFC-$FM3*5=^u;NVcj*49=L za?=I5LT+7fL=3i?4|%Tv=G%bxE*rtVGx2tn7@zUB(6|YVp9CALybd#z|J2^70kt=h zr;aA_)X7wVI+@8+XHXZB0(CK0psp4Q)D6@XpZT1>=im7{zMk*n``e+MFhhk8tTU}m z)gF3TXkT-(7M-%Qg+5q|kHSa5Pe=}ezkT2@1%Ph>&#S;Q#|e%}?LZD7O^#ix*Z=83 zjxyxLpR69w?`qg`%J%tQYN3Pg}zV6l|>Y#?Q3beRoUUEA}>4X@V{Y zF+*|?yzT|x$RETT(1t}gj>fSQe3%paGu8v>Kt+xV|HJu#9Op+IA0d-^+`q!n4YKM9 z;yi8{;_X)0`)>B_cGi~1JYahP#*Lo0HGpjkcxT#i53!PfSA>%aO$45^{M9HXv<0o~ zs6iXMY0~DNTC}CNHf`;rO^HnXv}s#E9ZKrYN1XS~{GNZ`(o0*oetj2BTHZmO76vz` z8Ew>PoL3VX2)$sP>S2|s4;{1gA=E(OLu(VYNA6Yz7onfWSQo(mA?N_dh!nIZ0r)S* zaSV=~k;mBMa|`HuZRi4zDHMlA{IBGQg3WWk9c`}(d8k1aHlU99JdSY(=7|FCw&H_s zR)*(Uwvh41Y|Pmndt1YaZE4%eX_gLEh*LYH<8)ulbdb!qPiJ=!-) zkM@HOjM1ZmOk*=Y?;oA{{l1Zz*YWkcqI7Y;4s9O@JsF@Q=m_gkTt{`96WEN#dN!tT zdu72#u+QmeqJUT-Pa%d%?|jW#-gOe2ozBvO>|7xg?b`%G?jjxm3c+U!5a)^2paVSS znB8y8aghJdKFG4ov+pxAGvhHf6Hox!KNPrgpL`SJ4jVe?ZmEAMz_8&t zlIhE5v~EVLI{kw;W0V@HCt%Fj9v-JpMeU+gnB_0*uD$r!e zp$m>SkV#|Ce>pFJ-Sb%D|A#-p-*cQpJL}=7kNC%9up=OcSZj$S33A!zVqtJT&_Lxi z|Tg~ZlqKF=E1Mv~(kFtK}>-hTn3AjJrjBcZx zzn~{Kp*tBU|MFrJy0E|m{=%3}PB(&|F@$e0K%CL1?Su4?W9ZWA&RT-L_OVqKa>owv zU+fQB8#Q_AAQq*g|8f*nr>V+-JFK~Iw{=-GA)dcMPwUhK4>mnoL?G8L44#OGJL@I8N* z`+NM(*YkZ`#*-wJmk9kpxepS|p%WtLmk7Q@MAw#?(Zv{3=zqxmw^OCL0WB$^ zyB=`YM-FBPTQ{P#sU~!Kju~B8WJXt)i-5T~?AwCwZ?c44TLN#!%95V%6w`|oE8r;x zwpR3dx0v2A?UjJ|D5kgj@}R8Wh3oc6==B~hBeNVXkIQ|&!-}3JSwSDHgnI8KSVH$K zpbO@7C02yEV}|^}6#EXEKwpgrJC9Oge{9^>MTeq&n<0Nu#`uCF`j7GyXrTPY#oXXh zwl4tYyFnPQ7S9549|*(UHmaN}K@a}4{(&5iad50hn_8kR-Z&29+#cBPaI`c{^Ve5> z8K%$UGU%&AE)#s3K~B2Boqeeh9UNx@+|B6BJP}=9YEIWzTF_tXEa_f?7_t{*A9gW4 z+aUqw65uVNSGyTAYkI@9*M{Egvj*0g^lra3z1we70Q%?NH+#9f%yM7vwx*Z6tf32; z^*-G$f$oXncf@peqZRTAEBGW!y13XJ`YJ+G3k ziWG{N;A^Dz$ky624fb&uw!wKpB4iZ<8pt+-c-aJUtju{cl7T;=k0@XdzH4$ULpyjJ z6mxJ^tAT&2n@IOku%5z)c1E1jD^a9#V~TBues^C3+8Jp?2gaFF+B6Yxw*c;zbbXbW zZf}s#{ml}3lxR&)x7)xDZRka+4Y05U?zX_)78rr{WzyUIwj>bFGe6q_d+F&duFWYU zt1O}Hy>`&A%=%v8$o0QSv4I}iAWqoO!>!hIZ<96swO&jaaboC!C8f_XhaQM%?;GM_pd5&hCjo5Opw^6futn(d=c??B`ruwy@gdX~oJjfVv)0B=vPN(Nu z(xs&m;4Y!t@ixHS7B*%_Pj}eC*6o42J>+grulCpjchFvYVDFGg`*6%5e7_I0|2v8A z&7oZ7qOR8hW!BGpyxa}GQtY4ycJySs9X(96g&x?_t#vkZElxrgVyx)YEK52(QAE3j znb5WYMzpT09*y!)gAFKS+(3bX_2fUgo9SdACtw{o2)SWiLA(;jksx364b*Y0_8aSf zEc<-$C}59cC@30j*TG5^|Ez zwUsvXS3Kmm*`6M5vxht#=-EyOdYA^O(^Z&{%x-V;x{W@EgVgS=LM7Ujw}Ix*Hzb;v9dY zqowij06oQbVZgqNxe~_M)o4v;eM%b0HjfxN)r!u{m(b;9Hgt2X9o^l;a&x4|$&Rpj zXL^?644FCuduPZvn_M9C--vcIFPXeCpU+dBpaag}--#Y2InjeHj&ysY16^Nj2j6Cc zm>{OZlPxKAn3-S$vF&s)=g(N}Up*^V^3YFB)e_CuWH0!eU#x zw#tG2+TaLZ??exioMH1W^mL~yuy=(lvuKwqbO5ybHzx4+oGH~s;QJYP=XN|sdme6c zhHg92t@Vy{b%hvbDa-D_gO}iEJH!T-gtd zf)DTpHRGJ{H|Q70G7r4=3B0ugwFXUq&yRO8(>)WYEB}$P?`Ek&v)W+1wm14jL(S>X zBr8gvYeSb}9q7hdC%Tj1LiZD0=~1#9J=x&~nYq)`6gPU7ir05#(Q_OH+J)oqN?AN+ z^UOzX2e;=j+VwEWmF{nGK|bqD8LJ)X!V-HrG1D5hUs??IZuB709oTz7MjrHJrw3%_ z`NQabvO67KY(saqF*ZN0o-fOOg0?;0?hYMrhpxLp=iQ+DE_7*`BW%GIHX)&%QRbA; z(}*T`w?wSW(g7WXzmY$sL%tX{7V?2OeCD-hyv|68*BoZeA^%hz;5re5%EJB?(NDE! zo-m%d(otk^B0xv}W0(QYoj1goxDIXUXG*(ASi#@f(zzJ;zm+a@E8dOnZuX!D+dS!E zvL`*-?gjioJF_Uo3%XD^+8k|8#_BbwM&(jerc^PKlanO~DTicbWvNujVpOGKNm8g& zjnOgpvob#k%!PgdWR3NW!WttB$i6P;-Dua(92*dFeO@0A z+ZTbK-mv{84kF{j!2UxhulOApNp+`GFd@Lj_iZG(e6-wsdoEvj#KSP*88HO!tP|O-yC3Jkc z1F&}i_8xR=qc^bkrhD6b>3)(gJxKP24uG~74KZHQVqDPcN|ul#)dm&G5A!-JN1F@$ z7npCf^+9qg;Gfz4dx<{K0Ux>Btm&^bN$6038_brH+1qG6m~mtWdw< zb8E5HQOJ8g|Ef7`hl!@-11p5-v{+iu(1?v^V3m!gE0)`ugX|| zqeYwh!0ty{)A1Qjz}^ixz9+CpTQ|3&yIWfUe?QoNE66aLaGq2+veK>l!?6FFu5kRQ zUb!?m7&o9DGwlk%e^#5(ewG8vx)JXK9q^tUN zry?)?CXXTW!@wVFPsM9FAH=yM$6=l`1fM^0-dOPasFR<&K)4qV2CeeeYxp<_`q{xm z8F5P!dMl#T5!UeejJ-QuT@4=>?~6A2(VeZ_-qv(Cu{GLWbQBq;`BSm~nm$x0SAv|) z6lm8RN9o!I8L%AgLMC^%_|adRS|K0srOR<%@B{92DB6K`M2cyBHxr6-ZiaayMGDkz zKyJpGHz9xS6QqEaf_lLojd{%d2gZS%z8?F1jy%xj%n?JZq%uJ}ibrXyaDN=x@{3i!)Ozb4FSME zi#7$KeML(lPECJX>~re@f38=f98KtMoWBeptDB%3@&0smO=~(I>q}{~-D%HQ2jo;1 zG{aAu+9S@g&-K=8`~+BV9M}osHAJ03x}2Ls2YAguQT_4Sz49oV*Xjm8h%wa*EeR$Eh9dVuC5E9ODp~9 z^det680|*M5jI%+Y(hOTzQVrOPfOu%#DQbLh3AQuDy?W|Oi4p*!J9j!FKk5@^abxj$GKA0WhiwtbX`X$Y$bSA!Pm{u&K1KcPg?-deP&FXphuxl-CZUplu8 zZ%17Xe%FRTZ-eRTdK`Zsd5atU@%YQi%Fyx=_Ib+*a=fxOm@cgfqBBd|(6O1`=vzBc ze0K{P;?NwqAm)iQ>VL8m8J`9|cs^P10lZg%K@sEua>)70p)7u`J;=t~B(}9?gAZ)` zeZ@_&UQa|jhB?wv@N{NL09}X+qRVSS1pKe84aM=tQhT>Q-~QPTlrCAE(w4$+<|Qx4 z^wR1Oy09XM(igR+gHt?d+aOzt4Kv1=iwgRK4aiqp+_5qXdnb(ae!FIp9FTnAG z*L1+2h)~{O58cLB+i2DoY=2>(0c{PprTvpU=;XpSbZ&VNU0lU{hJwQA(wZMnXW~Mr zSh3%$-=FQ*3wm?{j(N(A<+&;p_7y^BV}mGdjvwtF<4PNQiD|sMCI#yVK7brebT7dN za2^ngBR@Z@3k-QLitm{t=JB4=uzMAh<6~=Kx)6TmBinw2T{DbHSyIYK7dke}4}K|_ z&aVJ}D?_0JVLz2xS^qixzx;HfQu$K(%MG%<5ElwN3!(IwKsq$dhms>5X=Mj9>SC%Y z_y8YmW%dEw7uW>ieQz9qUp?T@>qZOo$2x=idG8G!l+nXOujx6q{SbX6S{TTEeS10( zjq!-m6vU0`n~5t&B&Y1IF~x#mD?HLP95+O^T{ zbZmATN?#10vKhAsD6{IgH%VWK`w+YG$bk|cm&bk$ZTyt(41KJYKw%>|Q z%nzc|OT*|4@ISi@eEnh?-NBsXezSRig6L$3qxv^xcm^^)6B`D*3#H?818DbnFWS)C znnt^-QvhOfYxR0$Z)SJ~_-_Mt(KveWekui7Bf`F)*Yx3D1F@w=xSvLYx2#)zEgRFC zE*7+Ngc}{16+kCrLMeSoTj;>=L-PkX5FFhf=?gl!X-Owb$UJ>X7@b%cLIUR3OfQOO+@lkYb(6?fP7HwE^1Q${5RV18!2j2m^4TFdUek+vG_B1|2eekN|B-!v zgbkk0>@J~QV}0TKLx6usKx<>*U0N!Pc&t3cUZX&DX*aGTRoTA-?#u(P zO)aP_(-s1M*x{iWfwW_|C;Ecs)X4~WAaXU%1A!s0519`?9)x~CV_vU|y7KJ@aGuD% zg2#N^^qVCJz8~XDvwihwbGQ@ji}r`lLGCfH9qQ)#3r2_MhLT>>df$aj#j>Sn<7gkL z>h!T}_FZ-SDt%~Bv!Yb(`cmGH|I!dx$WMhh1sjj60d980FSYf(afC)zzR0J&c%9h%v;z+~K9zDV)# zFjLEy2M2>cqYuD-KXIIYzHRxIybsO*{=g+=Olv$xXhTE9O@LcHp&x+xdVYp@HZb)A z{wnYRdCmuMY~UDy>vhqG+{yR{qTjb9z=#ruc+j3nL9~Aw*Hti@*44g9v1eN>hJ0yH zbV#1O*y^bkd7VY&1DN+(RmxLOPlG)9FQ|<7PYtDA69Q;sUuT-^qAA!d<7aQGe*$E`KWq$}3qeI1c z@?xj^`{2***J)IjLhZC@aX;5Qc`m42|G7Ryz-9M@Alfq6gBGrd70A5?uXSYjUV7KNc|@DX?ZyNP3h(Jz1QxZ6b$+i|z+YJFgFK@8v{0M*CCh_+Svmn+ia6 zt5x`6IEXcs^W}x}L}{=p>T7sC$K(#S`SMl}8A^TaxL`^i?nkRSN@x(q>KQ{G3k3GO zC;15Yb>45b8vA*)`OClTXL}Spbeqi0#J@hx@zF)@=LY)^pq*m^3q*+{{PA4Ij~j~* zv(?I%9~*6zpN>DzKP~I;kuP5bm19A!PafU|eKmU;W!qf9pK-)E0Iv%h5A1D0wb;*p z2|mt+^&YrR*;_|-3*Q%n+%Kk$A#EP$Ny)%+J9J?CDCwz#gU%0=Kg)S(U-x|Z*%akR z70Ucv9}sG-nJ-TTkzawY1wKi@KfbpMMZ2iy;O}Uv$IprIKC@2j-}87zET`}9tEG67 z@$ZD^xR(Z+(&jRv zNIxnl@wk0a%blO6ax-XBAYLYgNYGy_dR}t3tz_|Hv@YDcKztQcp3+>uHNuZJ_V=Vk ztqdqc8+#4|N37kt1;0N7#Cx5R95O1^Z;wziKqC7JGi~Wt!2T&C7 zM<3uZ?0**U_W{OvtqB&^dOH|tix_*R;TZQ_+0m8~26ziPuxXGFNlPY88x)zW+2&pJ z8cAJuemqVJmQX$PNs4NnQ0WrIX|%tERJ`?Y)T3q%s#BBt)kv*=b$qTtE#zxZJ8L{g zQ2^QId+k79+6Y}=8fZqn@SGsy=&Pml0@%-n?eqR|%JA`D8v_*ZcQ$BgpN;=$E?EG`_Qj_u2!Ke&1`31pt_~yH3Bwk+Ekv{udt4Nt^WMJQ>|Tv z*7Wtvm$!wTorO9$KIB&x|1N5#K(XCj^DR%Bwr%L^MX`w6{X`7~{99=%yp{rg!T)2< z*NgGzasTo5EogNYN7~TeN6-P*18HbYZ_j+&nx7o9e-mt8w~8{f_ARGTlPAzG5H)q<=*Bd(ED>b#Z)-G_nvvKERt;*$Tb~^{D z>njLv(q6k3Z64D`Oe0%a(r{l3it;w6IqlgNq?3b(LE+|~m1|X@^-|XLB~R=7c+v8< z5*lLJG^-C#|0A%U4$3$G<8@!&It@Ey<3GhkgI0HSruDtCzO1j0)TD;EmK#rLKXXj> zHEu3-Jq6+EXI>j1Qva^@e<>%`+Eu?#7Vy7}f0S4)rw=HxvgG{VHNXBJ=LJ66Dm?}K zv4&u#o2G#OIst!g@FE>mg8$6j7HRr{4XRb7`5m34u0vX0e#Ld=N)_FhQ*S53g2|+h zH?8aCf#@U+7#ExiPrY;q_w?Ju9TG9-fLj)GyA^T zVGa~#sYw>i6iM7di6;6>a(>Ic=1)Ja?BP+Q__NN8M;;=zTwtqfy1OI)v!*CXvmE=k zva}ch{LSG5@|ypVVZHFuQg+P7f3h?1@8E#)fPYWM-&-om-IwZSr!Un#(w6-vTvt?M z3)%j{Rzp>K83L!(-Q4gzh&AT!fj{CnKf4Fq`CWsCz&Nk@Um2bk^wd%@&BlL%Gv0yP z-i}s7p9K6_2c#gzzh2b}6l|^`)%DVp`6pe&d0RGiMR8Q9UP)>>u7R&!*~OJ&gT*w+ z3i%)KZ>1ss2H1DU_>UH^?FUa^UH`-D068RI^gK0?D&Zl?pV*Px4Fn zWjT52s}+b}NI%c(tCTAvbvqb;&e<0SU>&$|Lm~ge{Lf|J@0icre-`{QGQ2(<&wQO_ z{QH8zO&_|tMYx%xqYb@HZ4`9=AZ3!MSBOD<7&i(j(F(~`1xgWmI{*wd#V|o5382S_AZwC7Z{=j~HzcxRW8X)flQ-vnZ3s%A= ze>VT~JGtjMk5rI$g}aHQ;(cA;)fYGV}En4JbCvs)ug8NYf{~+6{#Y|u6fLj z=b)O&*CL5VBN`WIpXa^bl7~v|YK3mcn*RP$)xW-f0IliegFc%bjdIY!bAXxae{4lY z{OnKmvtQYEp6Ah5y@5XK4eQTDS6##t2f_br0R9^W2LBW)Q?f*%<(3=&hIOj{i|-Jz zp0M{`?(6dUY}QPf)_+Ia#{@VOsvVV)`$;SF_yNElaXJ=be}g2=1^i*luaNhf@LrI4 zto#0#9{7rMN&){DtUp6+)M;5;TLJ%#14AfbNZ1djh24D%C9|(#*r;xe&-m`_U|irj z%46<-Y@p+3gd0JjVEco>*sDMb$uJcgM@K{rNLI%52}&S_ro*Xc+b3bbBy~* zz5fgNk_G;WoC9_-!TXuf2jrYKVQ?sIifm7te=r4F>3z4n@{*~WVapu8XLt7b?)6_h z_AslHcTQQ-$fCEa#do!*R^wkXg z_4{)Uz~wAxBNFtAb$#>DjHp;Wh8(d-j}R#AD3!+yzcUgO7neL={}Oy^%^e_2=V^Ey?f@6QhKv6H&KS^ z{JDS2f*&7cW-qtL1-7E<^mCNw0}ARYczo2>gpY%ygwM7dRx1 z=|!6&+7ZY8!M2*&<38{3+#kOe^1I&+3;QntdcZNDzgQjPz%D}mpFFlN?U*=#c1#NY zA!M&#`1O;O%a^0%318>0sPJd(HjjZU3L%Gbr9Yo1WZpK9=`DSkz#(Z&Pa!tP!uPi` z%Ix=H&3_WF^^msDpO+_q517U=AjCiw@AI`L?qjn5**SS2rA!(8LukpMj{mZWuh~gn z-?0q2jJ)_Os`WWsPhNFM`+bQoo(pNzpiY6xWZmQV&vOowy^M2wzn8XZ5b*!nb3S=N z{nhXNTGrFejsauc41{q2u5V}bAWEGU`NJqL-y;3v3`$ZLN3id$y+{`!xctu1R5*7hM6;SVt&ont^3?5Vc`YqWXH zgYAFU^eEarW7rQN8$FHh#>h`%k}prCzN0S=LHvuKT2(6LThF&-lQ4F`XJxifkuOkr ztb3emaKCJRpqPU7cn^52_tI3DQxvwJ1-}epfPeN_&}45@p&yVut}pGHF_iYq9swFz zIGj%$v!zhe(KjO{Cphi0mqPCb4KM`SAKl(Z(Alukg0|m`h+EDSi4qIm$i597(q`s z26NuO2z~QV1FZFd?fYrSFD*>Y&v<|B5BRrdAHY6lS}SwG=Wq;Q{P!;y|3k<`qu_h^ zswp+dlb6_Gy>sjhZ7kGhkyi6O>-kag$SHUJIN(2mlE?KC)@4LG>So*i2jqRt^Vr|( zYp_cF9q{Kl!M}J;xThsQ7wRF5Pwk#Hoc1rAKnG(c6*(EUEci2&9X#yws^hw&(HScwZ2zsyuWrK@bAe! zhJCU9{BsB829Bq-;9A> zzFJ37w*9MRLB0pk4vrn1fAO5`U^{JLd=9?(qmQPd){nxT^#S;oL_O!(2Xr)TO3OOA zQsT&Nw0HI>0sF(T)9LWCq9cic*1xcq!~82_@TFd~Y^0oT-BbH_{?|QUmLbh~TX(yB z>nY0i|EsLnY4ACdg?<;u{aFFX`Sn$^;(q=4MVa$K7GM2?4v4e+0#VKeLSJC#HgCW}Q=t0Dl`Jop07tl zg{Fv(|MZU;tD03S7phG4#s%LKx=g836gwuOQ1upC7LX_Vg1vLb2=lKo*c+vtag*%z zod^1~4fwA4J;w5T|DXdsg*X5m9Oi0B8wOxs;Hi;xBz6X!Si6W$u3ubeIcZ{Wz@k<2T-!*-xU}HmJYl7d$SWIh;`h5z6VPWru z4%C1T5XJ;Liki_<^aqkKcgebX5_)@j(+WDXd1axfW#h~}w3;_mp@XXy6{@T+c^TiY z`&aRAi8%4)wLkm(^rkpL|Je5T%^NG&)^zNb!M4UW2iYe8zn_xt<)WFs?7ov>3?p1_;N83K5idZ*r60*E$UXw50{_$8+2d@_XpT74R%7G5YHiS zo_cK6T)~dcZCgv{lh^-Nl)PltXSlN-@Yuqp`BQ&6pDeHRgylkik7NFdu3pp)d3M(P z&U?(s8~;pvzf~9TmjelF1$jJTn41Z09281>W{nVXL2l259UFfuYT4x9Yrvzrcl`A{ zZr>pI%wutLh{sk}_41?M*dI1~JwN7R+kXp>U-3Ke$8+QLwrA&qW4uL}n`%#-4{{E3 zJ~^H)rEUgop-a2A{!&^vZun=m&*O>1dw2b%Jh5CZrfed%m9#bUY1gzUTGuat`rGUM z)6ZA07x62wm9|dcUmkQs&;g^yG_jQx@pB10W_4;qEM3^SkuL8}q$_*2(UrYPzl?gd z4a~v6IL4G>CXM=Kya;lDJlG~UM)Fv}?&-sXXKe=|mS(T%fLy0bi^H$H4t#Q-;6k%a)ltXP0~E7pNayEY3l z&p4Dyzluf;=taj8<9}KG-0o`!Q|RixWFhBZyXTyFb>BAB&rUD5-Saz``F$OK)E{`R z106V-oexC0nbHO!Cmbo{1Dp$R`>!9_O*fA2{okS^d+7S%U4jo}yXW};&h_GYwxV7( z+PUNXBFOP;dv*R1x&YoQK?ioR4uoKRQaF6tD(H9WRE(#uo-gP<>%fg;`{?HJ{d6ns z!2f&VcCx;+-{)M9=Xm*fibdEfq#MR{bLMo^>y7;*K>h}k(1FsR_1WVC+{T3+-Gw%D z+s`GfqiY9t(#>Q0>8}%q=&zH9>914&4+-tMm39c&??b###@J{a*3C?yt;4#|m>9Icx;^e1UDg@+b56E z?bFBT>X-KPde;-A+FSy*?zwx=SgWbMm~k{evh1aWNEqrL1}U$B>iD9|dj!m_^&H z5fAQjTe-~xosB52cWXRLFo<}5`$F;tx_)Sv-~;ZSNu#@GPtv_}r~XK~d+sFoKOyKa z+db#|XSS>o=0^B=J@$b;Bw9j_&+!p*IRyDA6hNGR}xG~K^==FcGJ6+E-vvfbZ6u6J=~f-on_^W$s!1<_Cs z5w$gGn(gm-E@v{R#2*RhcQB2%ay*EH9=zo-ZT1Dd(dSv%*)wbYa5A0Qv{L9BaZbQ~ zfboBD=^Q=0%yj-Yq;mp)tgGz1Sbup;hsQp7-NxpjU1&;>19h>~$Zhj?Acz0A{{CC4 zfwrqc2et{hA@-SRhxx524>MZct2Nd-^rJ(IrwH>$*Y@oYV#2-ir!sZm$_09K^%6b4 zcKMeQ^YG~EMS2K+9$Y*t`1@PO576aZiGm;Fd0T!~avpqrU+jY~#ChJ6QM17Zv^^Tc z`!W8{|3MC3(1TkX2RSCRH)~Fj?jnlq=_lyH!9~%+d>F?CmM{AQ_633tT)#q3u3ych z8`tQ`k0#Xh7pb?$d6;X;JvCNdkE{y(^kzF#>q1drqbCFs5$Jpm^4C46CdEHg?<#>(5(d9FR z@wjeyWT;=YW6YvXX1-s0x53B>vZ{NzKJAcvhya?B1>chSIqNp;hqI(-YZ~P%rY=^Rf}dx5_ty~e`U_dO z|FPqEzd}JEvkD;IgYF*N56hFs5Icxkpxl*U3jjJ^Vuvve+vBjg8rC!n_q$Rx9Wuacn=y^=)qdZ^_`F- zz^C#$IL;G#+UnsQjS`yE5$`9!o_xF)N=oz)A?H54WU4UE%;QUJuk0&$yq)`Fmr}3} zf!88n9^>1Yzuf$76Zj73&c{$G}+cnKe>a&$boud_~_tn%>rxB0bEhEBfx7uZHM1 z6m&Do$3FnC(?Gi4YS(|i7hD36YgJH3=)wW$!l!J%z;+jA*hJ8W?s)g;5H~X#*V=|= zv~#1F?tX%wh#%5{Hbr%T-S!arnEbo~_c8c6I^NH0>xgc&5zn!#8{C%S&_`d`)rY2r zI19QJ?qp0|;n#WGlJ$;b65Dwe=5JXy!Iul@f2I##aP*4y4#>JX$Q!bs1G>yUm+@d+ zIOpQIbH<8uFt$_n6&=l6QYZAk*>-!{>QWzjed=kWE5z(hcn2ZJ7RH$KjWDAo!u_mU zTps770^aDmp*|j~8wIig@g6(>{rzGI00#w7AZQ%$i3gnly%l0H_q($712{64tS32? zg>4qTnejWbul5XO904suxsf1e5bvk=-`^h~0bs@JQk6gw5Wm+v7}OOM4nkkE!9*N~ zf%<_uf%x6mZXi=otv{fN|FQU=1pbr2e-ijl0{=>DyN&vR;s$~@05AnW#=0zPE@ETfQFfKWSs zm&HLw_U~B*MrEJNW?r9tDkBrgU*r^@RY6YiGMN=*am#lJ9OqP*Rbj?IJ&(4t(Y%s{T{1%^I57ZK%RM_?!yI|4(w*bx}|@;oDVePA#(zjH7gmHYQE&(VO~ zKQqRkpGSViJ{t7Jx#-LD&zc7WzBpI-^8B;rLjd18|4bYZ(6`PrK5tK{FV2e<_B>VQ zv%g~BIG6q6_uuXOU;Jl$);yU)%j;WsedG6U>c^M*^QFFhaUS`ly?k;0 zh5f<4qH+uLOMAq5YVO~^V&56Le}{+s>>Lj5GXdiKGl3|4asH)0g8%wVK=g$_!+Guo zg5A#=B>2mye;5=TcF> zf%#>=nSX98+GdEh1>$q0L@b^v7F#WnNW`mfTo2j^O2GLB&|0yTRV=QV1sRONeceH} zphlot{C@i%xd&olWy0;|_pqX!%D~y0`A1u3ayzZ9t&(kQtoGPhTOD*1o1Ad5G&<*Q zp?Af{LgR*~h4wX9OT&v!Vw2PMV)Ns6HsXV}HsXDdM+)xUgmRXm%qWmI>kRCrM%H^@ zehXXSb_3sXz)S_a`hxEn5{YGkjkQ&ZlaW}$#* zpOroibZq#szm3Yr?v_fQx|%CcXES-~WTx=3y_w3p)@IEfxLO)qw3S#Lv6fivLAi;L z!E#Vf$X5rtP(4c@3Jcx$-Y?5~&Nhp7y8`RU*4C0O&Xz{$exeq4xDDLafexx4XZowr zvJNe2O;-)t)LV;^2I$a^K{}KgsY^Qt>rgVzxAfJf^*uCcMJIKdAJUA5yEppO-BOV{ znkjt@G;8|U!(8vGwZ!rWbYdrD5Q{oHgIc<}x)%Cf5Cs(gV~)D3q3xF7Wel)MaI`Qy z8D!e%MQ5}*(z(&6xk1e-zNaRoMCj7Nar%@t#eh!DFr+hc4C%rGBf1o0Ojni|)8!>b zbYY9Y*!#8d-1GSPr`57ncs{d8z)yOuQ8tI4OHR?45+nJE43DbmTX5nCR% zva;Ncx)*|lATu*FrSE+gQbF6!I)^&zq5ZAF!!k#)=@EaECXYLrDbi^7CZFPaXw$AJ zeL6he5bfdinb6HuW^^}RME5s|=+PDtJ=tbX&yvmQ`F0E8_;i~EJ>F_g4>p<8y^SLJ zYpoewU1mz>=9|#5Xd~J?(tx%N(52Y{EvP%>5N4wC#?3U+q1U^`^k$EQ-tLpoJEr}a$G3YW!uPN7+bdl2B1KG3w_DM}tyXkmSz1a)eXAi=0 zza72JCYeEQKrk~mx zDSmVo>0g9j*aO~T;EP?^H=;d7CIiMDr!Otoyi}7og{bYi9z z?Tj>`X{}pQ2NOl|Fx9*TKXd@P83#S^;{2m1Y=P|^ZEu2@Gs;z@d%CTW(xFtaZXr{jw?ToUZ z^m%r4W4#;Q-{wJ&wtLd!ou2e0#VcQWu)~7}hczc>v-+f?R*g(GYm$#df%*rk(c1B* z`QDpTHtKo2!;2m!d(iC!ce=2|k@k-h)2c28*t1gglb=E3r(#RXec*Wxa5Dma-#d@b zc}-2U|NqMS4!9_eFJMdTv3G={_s-GF9Y-(H%TW$Eszg*o6h&0*-57g~8hZf?_FkhV zMorNa6BDB`CMN%Aj3$c5z3;t+J+JJ+fhNE2_kH{Oy_?(JnOA0JXJ=<#$&V0vozL+! zl9TM`W(32{b#;!t)mJUE<+@~6YE$I`J6q%{hIeGL>cva;%$cI?m= zVsTD!<%4Jq8bte-!)fqSO)7l5EfMP=5;hI-#8_EI5aZ|iJ@S77>tH;#;UJ`^^Lvr{ zJ&qq{LH_aBy(wg7|bgucyAZs=dnlX%7ZOKeBknXaq!Jn z3H-2E3P0{6$kqvN?aFMCe7e?4mrm_4PDfG$FH*RJe0_&BKV2<`BNZX|ony0op)y?$LqzF6t>FH5$b7KbL&4%06x$yn&9GzixdEmb)Kh;zB zF74q~l~lpg?dlx(W?L3~yf_ioW_w{D;K@V%{jOmhtibOCYieI@6+q8DJ}b6^eOyoE zxEtY|)*r5|OoMN>=fJnS@>&FXeco)$W3IkYEat25c56p2-1s01j#m!G*kRUkvAfkD z*rtaN(s3@Q)i#O7{NR9qgmk{))0r`jaAsy4+}M}{Uv0~SueY}hF0Ph9ySLi>tNp-u zV0R7vzTBDzA1_IT5Ayv`FU$ZUgx;T`{Bv*~r>Cv`@qYgpFUMU{zM*{g$RN0~JOgfQ z%7>eqUk|Eh#AA$##^3#1?W*gwem%Qz@K^w!twTNf$uUq)eZbZ1PkayVz~{hO%QHap z9V^UtzarQgPR~q)>+k2n=Nk$dg_WZtAU)U)BE8I@BEuIhEX(4|zrH-`U+V)VdObO5 zezqYWE-lW0wOKx>`=>7t2@st?8B?O8qiJ5Oa^UqYA^v`e5=Z^I6%sGFyd(>*ug%vA zHM7KEHmE13Owky(g{$np)d$9;cyZFZ{(e4uvML7-jE#hB90#L(_+MlDPp8%6>shKHI9%wC3cC&bd@^7JjuD(Wq^Syx>SNTS%zlHqR`s2AY@<%50QuAuy3I2Y=Sys}5@NWQH<>W0DwsQ^yR&Vti(q#AH? zmbA%!j|dg@!|U5!1xGgeQC7a+od4~xpKmEkP{GH=Bj>f*Qm845gF+9Zx;Rg}@9-H& zZde;&Le5?O;VRjPf;sMEs_~_h25r1A8#S;}1OxiEfq?vs`#}yNbf$@WeDYJV_HA zjC6}%Ph(?(mo+Dj>T$_ni2Z`((iL(7oj7rE@u=1t zzR8vm-X?WbBV%CSSg{6Fk4b8@y=Xj+b+^ zbOpiHqS2?Ej&(cS~}!M~buYgdrZL zwcCb-W87V|IekqzW8JL4dQcx2)T=AFnd-sF2+!BTxp8QWPV&<;z{UH{;qfpn+yT;E zP5#9BuLq5Jtn8GgIvY!K+>Bms&JAVa4p)y7V;sWf1C0}%&<8J~)BqZ*SLQ{v2ruzs zHlXRa!Sp@A#rMwPaWEm!2I%`1$36?>Pi22B#m!ih>0&6~m=lcUlW`15Z8lWIX&)om z`smiF15~#FH}Nw)rRnvwzTLWL@Vy($?i?NqqlH%TBsYsI_`V;2{HPo$P6Lckepo9J zVeCH%>?@Zx8@hDV?Yn3;+Sar9J=;+{(VfY}U#3`$y29ci2^zd` z@kiI@<;0-vvK0DYTWQOaA#&xUT@vH3wG7QWw~W^0y=Ht4Y|IOTEL_)$cel>fvi^hd z-walb5?af4m!`oX^x;Ucz;%T*k(*Y&lx1v(@wN9?4uvs^!A<6`NWr-{2M>L^bALyA zTbpp^-#;N2=Er-{*#F$$-(4U1;XF|OV5ystZ0kEQ3?A}1pesm%blc}CjtgXPrue%z zDgWE}OmNX(IxLN|?2ZXTH1Z#vS;9OIqXTT^Vi)6cjj#W3}<)15k8~yklm3)={K{AG8JXC z(e8n9t#;2X*UX1L`A;vJ04uUW$R55f(Z$%FQ&^6R7N3zdeaG*bi?M_oa8wpZIP)o&wKnD{^0Vc*(p42BIP+axJC})3GE872OLOL} zN8I>$>V9N84XPd!?D&Fwx>Edeihj*5K9 zk;ebG@Ev(<#axv#P0?1lkFh$>ubd8xB|-Gg|0kZ$(^&6sswUFxc_y@fz6QVR$XjmcE_p`v&47KgAXsAMPr{`Rw-@j{SAk`{1aD)|t)*2a84aFAkv}9rBY!ew4^Bo;IMk zp6h2xzyR{uOwT2GY*-Wbt%cV@7ozJ zyj$ZV-CmM^F!JwCF|Wwq6c-drQC~pIJ@xB@2J~avzf;E!7@KgH&gInc&^Z%xVAB#< znHzY5y+x z3VqPEv^?v>j>i6VMG5HF$owVxCS1}Y0d**pWw|i zkD=aQ<6*eGej&V<6(*hb8)-h6Mu5|nSv3ftg=wFq5t&*Qz#)mKY@ofUgKP&m-C4cKQ zzI?uSGaN>LelwCpGW7i>M;(fBeL+6&aDVz@ zhJ(Jx8)p5DqQf~?FNwpT%q(Z#{#*~U=Y>MMmz8loFPG*;!=}+$uxH8$IJR&S#>iQ~ z#6Krr@TZqehyAn0z_#*y#^2{`aiAPyXw=KhH@tzdQ72?L7}&j0M*jn3NnZM$u%AX} zIvKn#bv3$@>u&mUu7~*x@J3Y= z(=+%F*!<5)NS%y&q&p9=$-p@(jvcP_PEAT`S~vSYXY~IAg6LG>dA&yh^si7!E(Xvq z1LK3>46c~aIaLBCjIRP=gVzMZ2ImKu5wkH)g(g#q1(;OfPo}cLYeQv&Zv%WAR*HEoK6!p|lU-i|ls894Eai$d>Sl@Rj#TH`-U^_4siS5D^tOTYY z({5)P+7UBiHYNilSi%s0*n|8;I3Y+8TDLO7-+%w0HF)y*Kzq<+TS)px1oWS-HQb|h z`ev=!{fnG4{wf;y?1B0N&Zt8ch5N`^Xy`u*^+~3L1O?5&^D=~7ydRI?i~H>TNY9Yu zLEdy)dw#<*FgCly2l5phBoa+Po8@Y>r#}}S8h9}>Sold?koOmffv&d_g51B33G)36 zeGq&^{s+kB9&Jj==6)XP%qL-L(x5Z(U&zs#?74|=tmkaxV^2h|=wf1k+pTPY)#G9Q z#$;hVR&^7j&1GXkO=V~!U03L5`aDhG@N-O{&lf1mMZ|F& zaiRQy77cRzTYamIudi=Uq$5Uq)SWQ_USH(-Sv)NXHmRGFY+bh*{Qw**CtGPZxH!ul zuFS8ujla6k13sGL0T-sbGkyW~jdF&SS+??u!R9iw?R=Rou>UnYSab#b3{abtAPt_j zecYDzA;O1sWQsHvM+W#_&Gxf=QXXl6`=MwHGT9xjE=1e?^}cX-hX8&?8}(oI3eaYq zY})L=>oflr6Fdr4f#%JJMRNuuk%M6e6mLmM7!)Dct*D9 z=R?ru906_5pMMy_*rYS(=R(jm5okjmfwG6e?JdFZ@w@(LC+dcN1k7ZKLjI2^ z!&%e^D@PuBDA%X1|LHl!diRg?_q{m8*Q9oJwu}7of&ln_JJLKH&DbkHIYV~PvB*pF zfyxp5iMG{$9FKq6mhxet^_Sj*D=?0&~F4gG@z7vp%*thH`>525@H5kj9+ zL;Or-+loBk>XIGlT!+As&X4?ufFJ%|?>z~WL@ z_~{VZX>*kM1F!w>cq06AC;{!3qu}(E0GJ+cUzhG>^%(2$H1Z;D#`Dk`?b!^_W@Sg7 zmuc;mcRb%S(lP?6vYj^PVSo|7i?q+}C zbFi69PmX+CrMa2kU!IPBdX{6~+nC>Mcz1YEqq;J>$U@J;qLCpgv_D^;2Pdb+LxGp6 zEZpDcW3+Q~P`2};|3N~bYX+YuJBap(*Vg2rjbnidTwPND2|_ETjU%cYLjWM7WPFkf`7!d%cgAN?}%vlRVzb{w_Yp`O1BWzKvo$9TyY}EMK0Tmkw7} zpnV?Nw<$w^v;`&H>UBuZ+^SK76?yH9>-Qej^XYO<_>BhiP~cLg|MBuX*fKN_Bz)t4 z@SV0IDk@50XGQO}G>Wk2()@eq>?-;Ch`bL?k$jJim?jnS;I?a4-0;twVy~%v>p)nU}4AQ**ML zd@jjeg)K8BBcM@Pk)T38;yupCT2Yq8p)EZzJsrmQTguSh^9J%vesGwB#(mtgsNG#0 z3CE^MRG=)u8~J}l6ALKl(|_V2!P{C<=ExKYSn2oCNrpI#;iFEk(etV4sH<)dabEVf zk!NG1kK|jmisJM8;2QYL>XFfKpaN}_l)#>+y+4yqMqaS9N`AI%jJpNUeQmObI+-fU z)gZmXFg_$TY*gYx^?UlqT&{0hn z1hX@BOZEesM`-3(FaIv;d4(abeY$prfoKEaWvLIt!rc@!ib7qP{z-CDTN04X(D*oC zMIL3G%fw!QnN9Bl{Z*XFKqoNr@od3D)g$+_GCq>A7r?jKf-ykA}&pgv*o}X)aTkh zG#c%+&_<^jFdJhSCVALErk^7e1-rq{W|Sp5WPhs6v+{pqw1raTB@q_JdqAqY)sM>K zC#{2Jp$_)8!og^xB1TBj3A`M{qq`1!B-%^swIYv=^6d(;YACsc}Mn#Z)U4om{>V~z)2KHOE%I5PfFG~{w>BR4! znBOGy?yB8Jfu23W5$t5C)IRlc#(O(z;C3+9)2IXDf1es3WPdWm)9j_#!-jMkm}i$2 zAl=DeSb32Bi-VKj;nek4w-?~5clMgez&;EP_FO#;aI{pRu><1}62Hp%Oi`~{o#wV- zainvLwg#`}4p@dcQk{8vXlM1bW_&Kjs2k11siRnR+JL?@u%HIeIKFezP}n#1l@6VH zKGGvq$2&AS0J@;Q8Jl)%J?KGo?+fz^vt7t7>M|Gin=121oW;u{O$y%+}xrJt^9ZD&|WKU>PH(U4p+HP@lLmm6w}=EG0t@q z^JaDa{ry|LCFS$(Zyu4v=zU*WzW}tsIBAkbpY7GHt0KRV9=A<9^{;uwxr%)1_%kB| zHSUqV{ip!@7ZPWqB6XhC&(Y2xVT8cyuXCuw^zoLZs5`Ta6L!pfgI3 z?3y=8k+&_!dx_e|#sq!FX~D^Lopgpb4NoF{>3i658nqE&Wx=uZ=BoTC`6t^}!1bzi zoNyK6T4R3jb#~yq-={}+mG=YjE_8L`%&UzC=|fT77x`K~O>;09%<|V%n&~*mBFD}6 z@$L%r6|{FF>b7pg6aV@#m;> zy(BA4hGXLANw^lS&Yv#l7_V+LJ~vM;zCRysVXXPv=Z`iE>@3Z}%f+c#Wk_$A^rtr# ziviz9zn~shleR&P$$~m7bB776pB!H}0d8M72BZ^7x?BGSkd7VcVK2*$l%c-N&lxTQ ztsCP_*L&%X`jR{^vp=gQ6vFo(9%pp!7`@KVuGH&yzGh1Lk#|4&kkO-`7Vq;cn{RkM zm9N+6TC=Xav-wCr4D00gIpTolA8lF+_diFS%m%$P(miVtH0WMZzub*>cf$oXPo&NU zn+odpwOP_{EX}d((^cwXFh9@J?9Ua2@h`vFzm1WhUT^MO_~XahO#{aNX5zb}ULEPn zo>)8?#)i2(!M^@2=^ec>W*b42;%uOY?}+UM-eyl`CJO)FKf4U$Rae1px4vZfe{}Z; z6}?D0XJgZoe)A>NjayfoE*}+S|0u`RSpBD1Z+Tp3Nt8zFTSy%}*DBI?-d9XAuRyH-x=dWSDR*!PrO&;R=Wks63 zf#ClZ{Vvj1O>;B|Mcbx=Y**u{dG5wr^E^z?<$0JK%5^tcj_?0c9FJ2|9eK8ItOEZZ zK!l1%^?__yH8IpXG9)FUI}K_^XBaIoM*mBpHdgscEs4>05~`_>v1&}1BAQp~O{}_; zddjMoHI*vDExl4ln@srG>y4B@L)q{?lPb}_L)TgLD>hZ)pHagye5H=X%B!rFMQU`U zABX4}0!)P>Vno9fG^CWRUpRwQULB;TWrX05(3<&&f8OlD#B{**)_&}I<(oyXijBUF zgV9HMP*A`O)Xg~<7AU+rSmbjvBEauPNTB~Gs5^5MuP?&&#{}X@wRFqRa6hFR#wRI8 zTA$_z+y6E$((3PN@z%BT#5OONW!cFVNo-}alWl4z$637?6>j}h66A6ZeF$I2{jizH z3$NvrTeTt`k0_DXwc-%#XG=2dWydGFqK=Fg+}Y-XaSr_8;eG+ee<1xCKe)XKV?QkP zggv8N(8j~2Hb2nr59H%2@=@H}_QAS-D>PU%Auqu8(YxsmvWs&tCPfv+R|rPk5Y%@$ zABu4ZLgB@wFpS9%hB_sos3Q}KF&IKnZzKrgIfzi-!V@OO*wl(euB0=vl60JOtc%v@ ze|PDyAe(1<#(2taZw-fshtQut>4Kb#!59Gqv7A8n2_Bz{L0|8K;l`Q}Seof9lZqT3 zA`iQ`)>qVd!aba_;Q`kFoSZ6xJ5{mhuRRI%I>hL&K3M?;apusoTYKo)wLN}gwg)@Y z9L+AtfUdrI+oJD!JJa4w`5*UXp^xcAm=fdsGEC@m7282$ z4jbX`n_d=T_u|^BRQRqc2O(Dju5QRcpZMC>l~FFmcP0I&Z(|3uz6_pQJG0@`^k~TS zvwnhoVZ3@BNW83W?JEn#{qrCpjw4IaBZ5H2W>$72As=F*w;BifP ztxV|S)qA+e_MeZIX2NId^A)hTI0XIscY?k>Izx=Fh2pw4KeAjrbm`bmQSQ@q`EYbH zt~GjDKgN9~ceV~eyso+;e?}kHvi!%g;&lkVX2ruVd+FyPJNuZ%iB4y zJhr^PD)qzCC))cbrYiEWIF-|tnF5IQc0R?@&-F09x2H4#YR2InAA%j?X7N!<^*AQR zTXCPwH!jv2tk4Hw=ML={(C^(9wvS4HO(SApV9&RK>aZvJ(8>vLR4KbII{=cs>^^7d z7kHT5t1eAc?1^&*`ov3^qnV=2s>~or z^|U#`(#Jj4D?5wgV0URMCv3)bzAm^nOJgiE&f*wUnJD7SOE@Mci8T5~gtLVr|B@6T zBzW4*XX)p;@>Xpe5(PCCxtt)f*W8ODUr^%`0+=?YcIx$ZXV^I=OHp3gr&?Rw``TKX zp}03K)>D?iHxsb*aebRVC(-X8@?XLQ-Oxs#>W~Gh14*CJF{xeY|P03hYE*C`6}Y`}RP7Lg@a& z(S<5wU>j`Xg{4DO%2B@4YvwAh9iBA`^4yFxWM_HF z{3+0-QzvGeqK?84&Ok^MN|12^4GDz-RSDcrPJiJrq>u$mK4Fvu_cY> zAv@>w#p(ZG-Rf*-k34kG<@3(&onG?%r)!tsr%yj>5zxBof{gJ0XQfeHQ>*m@4|OykHCQi6JCywbia%B{VtZ(x+kVf9Vq8PT>995Du%f6E{+Rxxiu#v z;{MuE(%)AMPkT5$IpAK2(E4V9EALR2v%VPfHcPKunU1dikw!ZN9zs6^oSwDp0GSZi z7I0+&#}_%qVW(vp9GuCnuEQOKGxaufWXDFfak>EIWue0z#L|xdHG$*@9G;^XnvD z*7t)2J}%0P2wdzsj0m*+jC=<6)iL!~_7p}G6Yagi7&rwH}E-2SHZ1N4I$Rx>k8esjk- zNDZm?tvuM*7A~(F$@tY~>G$g18AhfGf$|Z&KRW(pl%I!drn}kdvn$5I{`X25KSqQ4 z_QY@IT)4JnI!rB0z}Rk<;O%G*JLe3C1tsaQb;eNUUd^mwyhrb71KjKX@cr3v5d8tBxS3DD=Q4Tk^igtlU;4=Fx>4Z{<4-zu}=NE|o!m@3s4MvB%fA;l>8fM?^CZ=YF zJeXEG0!j;{OdI5|A;xKd*l~jW>(CvSVp0bN;q&_%*Xxk$B*vbQH-IF@847Wr?K_7+h4<~F@?Y5 z*e#?o>W9Q>kj*qn_*XYhAC^73e;4X%Wl;B`7JkP)lur&+)s{#3TtK@0)ypZL z0({3z8x!t&3VlW$&T%m)!)va}`Pl!@4XZ?VI#h|yw5<|NZe0(pT2+a-fW1$7smx<6 G`+orYGy**U literal 0 HcmV?d00001 diff --git a/Projects/Code Insight/Valistus.lpi b/Projects/Code Insight/Valistus.lpi new file mode 100644 index 0000000..3194a96 --- /dev/null +++ b/Projects/Code Insight/Valistus.lpi @@ -0,0 +1,519 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/Projects/Code Insight/Valistus.lpr b/Projects/Code Insight/Valistus.lpr new file mode 100644 index 0000000..5bf1468 --- /dev/null +++ b/Projects/Code Insight/Valistus.lpr @@ -0,0 +1,21 @@ +program Valistus; + +{$mode objfpc}{$H+} + +uses + {$IFDEF UNIX}{$IFDEF UseCThreads} + cthreads, + {$ENDIF}{$ENDIF} + Interfaces, // this includes the LCL widgetset + Forms, Main, v_Constants, CastaliaPasLex, CastaliaPasLexTypes, + CastaliaSimplePasPar, CastaliaSimplePasParTypes, + v_ideCodeParser, v_ideCodeInsight, v_MiscFunctions, v_AutoCompleteForm; + +{$R Valistus.res} + +begin + Application.Initialize; + Application.CreateForm(TMainForm, MainForm); + Application.Run; +end. + diff --git a/Projects/Code Insight/Valistus.res b/Projects/Code Insight/Valistus.res new file mode 100644 index 0000000000000000000000000000000000000000..e66ecf85feb5a99d4bc85c4973bd1bb2e918b668 GIT binary patch literal 855 zcma)4OKaOe5O(RUP{^%0E_*CkiWA4QL2@vm1=9yPq%A$JS0j7rzPhvPM87^ANq#6L zlnPeN&dkny-#0TFjYf>l<70oweDb|{xsRVx&WkQ~a&k;5t{;qMTL`F}E%_un;|#2H zm9p!Sf4loQe#aR`VJo4Xg_1Xb{CfWSRUr_;taQVufW?xhV6RYazz7^0C4)m($FX$g zN}$QM6V8mVss@bThux?YJJecMV55r76F}Kn3(5y40nvp;kQ)_2#uNz7Th6R7WZXF8 zg>AmlCA$r-N-}o#PnW{Nd(L9xDeYd_i*ufLT`NEtl#j%G-lj3(y;f4R4mJp~4Ft%F zeBj!>_h1RJY}zX;D(LTVv6H5AKf`VaWe5MuUa{ + Highlighter = hlPas + Keystrokes = < + item + Command = ecUp + ShortCut = 38 + end + item + Command = ecSelUp + ShortCut = 8230 + end + item + Command = ecScrollUp + ShortCut = 16422 + end + item + Command = ecDown + ShortCut = 40 + end + item + Command = ecSelDown + ShortCut = 8232 + end + item + Command = ecScrollDown + ShortCut = 16424 + end + item + Command = ecLeft + ShortCut = 37 + end + item + Command = ecSelLeft + ShortCut = 8229 + end + item + Command = ecWordLeft + ShortCut = 16421 + end + item + Command = ecSelWordLeft + ShortCut = 24613 + end + item + Command = ecRight + ShortCut = 39 + end + item + Command = ecSelRight + ShortCut = 8231 + end + item + Command = ecWordRight + ShortCut = 16423 + end + item + Command = ecSelWordRight + ShortCut = 24615 + end + item + Command = ecPageDown + ShortCut = 34 + end + item + Command = ecSelPageDown + ShortCut = 8226 + end + item + Command = ecPageBottom + ShortCut = 16418 + end + item + Command = ecSelPageBottom + ShortCut = 24610 + end + item + Command = ecPageUp + ShortCut = 33 + end + item + Command = ecSelPageUp + ShortCut = 8225 + end + item + Command = ecPageTop + ShortCut = 16417 + end + item + Command = ecSelPageTop + ShortCut = 24609 + end + item + Command = ecLineStart + ShortCut = 36 + end + item + Command = ecSelLineStart + ShortCut = 8228 + end + item + Command = ecEditorTop + ShortCut = 16420 + end + item + Command = ecSelEditorTop + ShortCut = 24612 + end + item + Command = ecLineEnd + ShortCut = 35 + end + item + Command = ecSelLineEnd + ShortCut = 8227 + end + item + Command = ecEditorBottom + ShortCut = 16419 + end + item + Command = ecSelEditorBottom + ShortCut = 24611 + end + item + Command = ecToggleMode + ShortCut = 45 + end + item + Command = ecCopy + ShortCut = 16429 + end + item + Command = ecPaste + ShortCut = 8237 + end + item + Command = ecDeleteChar + ShortCut = 46 + end + item + Command = ecCut + ShortCut = 8238 + end + item + Command = ecDeleteLastChar + ShortCut = 8 + end + item + Command = ecDeleteLastChar + ShortCut = 8200 + end + item + Command = ecDeleteLastWord + ShortCut = 16392 + end + item + Command = ecUndo + ShortCut = 32776 + end + item + Command = ecRedo + ShortCut = 40968 + end + item + Command = ecLineBreak + ShortCut = 13 + end + item + Command = ecSelectAll + ShortCut = 16449 + end + item + Command = ecCopy + ShortCut = 16451 + end + item + Command = ecBlockIndent + ShortCut = 24649 + end + item + Command = ecLineBreak + ShortCut = 16461 + end + item + Command = ecInsertLine + ShortCut = 16462 + end + item + Command = ecDeleteWord + ShortCut = 16468 + end + item + Command = ecBlockUnindent + ShortCut = 24661 + end + item + Command = ecPaste + ShortCut = 16470 + end + item + Command = ecCut + ShortCut = 16472 + end + item + Command = ecDeleteLine + ShortCut = 16473 + end + item + Command = ecDeleteEOL + ShortCut = 24665 + end + item + Command = ecUndo + ShortCut = 16474 + end + item + Command = ecRedo + ShortCut = 24666 + end + item + Command = ecGotoMarker0 + ShortCut = 16432 + end + item + Command = ecGotoMarker1 + ShortCut = 16433 + end + item + Command = ecGotoMarker2 + ShortCut = 16434 + end + item + Command = ecGotoMarker3 + ShortCut = 16435 + end + item + Command = ecGotoMarker4 + ShortCut = 16436 + end + item + Command = ecGotoMarker5 + ShortCut = 16437 + end + item + Command = ecGotoMarker6 + ShortCut = 16438 + end + item + Command = ecGotoMarker7 + ShortCut = 16439 + end + item + Command = ecGotoMarker8 + ShortCut = 16440 + end + item + Command = ecGotoMarker9 + ShortCut = 16441 + end + item + Command = ecSetMarker0 + ShortCut = 24624 + end + item + Command = ecSetMarker1 + ShortCut = 24625 + end + item + Command = ecSetMarker2 + ShortCut = 24626 + end + item + Command = ecSetMarker3 + ShortCut = 24627 + end + item + Command = ecSetMarker4 + ShortCut = 24628 + end + item + Command = ecSetMarker5 + ShortCut = 24629 + end + item + Command = ecSetMarker6 + ShortCut = 24630 + end + item + Command = ecSetMarker7 + ShortCut = 24631 + end + item + Command = ecSetMarker8 + ShortCut = 24632 + end + item + Command = ecSetMarker9 + ShortCut = 24633 + end + item + Command = EcFoldLevel1 + ShortCut = 41009 + end + item + Command = EcFoldLevel2 + ShortCut = 41010 + end + item + Command = EcFoldLevel1 + ShortCut = 41011 + end + item + Command = EcFoldLevel1 + ShortCut = 41012 + end + item + Command = EcFoldLevel1 + ShortCut = 41013 + end + item + Command = EcFoldLevel6 + ShortCut = 41014 + end + item + Command = EcFoldLevel7 + ShortCut = 41015 + end + item + Command = EcFoldLevel8 + ShortCut = 41016 + end + item + Command = EcFoldLevel9 + ShortCut = 41017 + end + item + Command = EcFoldLevel0 + ShortCut = 41008 + end + item + Command = EcFoldCurrent + ShortCut = 41005 + end + item + Command = EcUnFoldCurrent + ShortCut = 41003 + end + item + Command = EcToggleMarkupWord + ShortCut = 32845 + end + item + Command = ecNormalSelect + ShortCut = 24654 + end + item + Command = ecColumnSelect + ShortCut = 24643 + end + item + Command = ecLineSelect + ShortCut = 24652 + end + item + Command = ecTab + ShortCut = 9 + end + item + Command = ecShiftTab + ShortCut = 8201 + end + item + Command = ecMatchBracket + ShortCut = 24642 + end + item + Command = ecColSelUp + ShortCut = 40998 + end + item + Command = ecColSelDown + ShortCut = 41000 + end + item + Command = ecColSelLeft + ShortCut = 40997 + end + item + Command = ecColSelRight + ShortCut = 40999 + end + item + Command = ecColSelPageDown + ShortCut = 40994 + end + item + Command = ecColSelPageBottom + ShortCut = 57378 + end + item + Command = ecColSelPageUp + ShortCut = 40993 + end + item + Command = ecColSelPageTop + ShortCut = 57377 + end + item + Command = ecColSelLineStart + ShortCut = 40996 + end + item + Command = ecColSelLineEnd + ShortCut = 40995 + end + item + Command = ecColSelEditorTop + ShortCut = 57380 + end + item + Command = ecColSelEditorBottom + ShortCut = 57379 + end> + MouseActions = < + item + Shift = [] + ShiftMask = [ssShift, ssAlt] + Button = mbLeft + ClickCount = ccSingle + ClickDir = cdDown + Command = 1 + MoveCaret = True + Option = 0 + Priority = 0 + end + item + Shift = [ssShift] + ShiftMask = [ssShift, ssAlt] + Button = mbLeft + ClickCount = ccSingle + ClickDir = cdDown + Command = 1 + MoveCaret = True + Option = 1 + Priority = 0 + end + item + Shift = [ssAlt] + ShiftMask = [ssShift, ssAlt] + Button = mbLeft + ClickCount = ccSingle + ClickDir = cdDown + Command = 3 + MoveCaret = True + Option = 0 + Priority = 0 + end + item + Shift = [ssShift, ssAlt] + ShiftMask = [ssShift, ssAlt] + Button = mbLeft + ClickCount = ccSingle + ClickDir = cdDown + Command = 3 + MoveCaret = True + Option = 1 + Priority = 0 + end + item + Shift = [] + ShiftMask = [] + Button = mbRight + ClickCount = ccSingle + ClickDir = cdUp + Command = 12 + MoveCaret = False + Option = 0 + Priority = 0 + end + item + Shift = [] + ShiftMask = [] + Button = mbLeft + ClickCount = ccDouble + ClickDir = cdDown + Command = 6 + MoveCaret = True + Option = 0 + Priority = 0 + end + item + Shift = [] + ShiftMask = [] + Button = mbLeft + ClickCount = ccTriple + ClickDir = cdDown + Command = 7 + MoveCaret = True + Option = 0 + Priority = 0 + end + item + Shift = [] + ShiftMask = [] + Button = mbLeft + ClickCount = ccQuad + ClickDir = cdDown + Command = 8 + MoveCaret = True + Option = 0 + Priority = 0 + end + item + Shift = [] + ShiftMask = [] + Button = mbMiddle + ClickCount = ccSingle + ClickDir = cdDown + Command = 10 + MoveCaret = True + Option = 0 + Priority = 0 + end + item + Shift = [ssCtrl] + ShiftMask = [ssShift, ssAlt, ssCtrl] + Button = mbLeft + ClickCount = ccSingle + ClickDir = cdUp + Command = 11 + MoveCaret = False + Option = 0 + Priority = 0 + end> + MouseSelActions = < + item + Shift = [] + ShiftMask = [] + Button = mbLeft + ClickCount = ccSingle + ClickDir = cdDown + Command = 9 + MoveCaret = False + Option = 0 + Priority = 0 + end> + Lines.Strings = ( + 'program New;' + '' + 'procedure c(d); forward;' + '' + 'function a(b): Boolean;' + 'begin' + 'end;' + '' + 'type' + ' x = (thiz, iz, enum);' + ' y = set of x;' + ' z = TIntegerArray;' + 'var' + ' a: record' + ' b: array of record' + ' c: record' + ' d: string;' + ' end;' + ' end;' + ' end;' + ' b: (ab, bb, cb);' + ' c: string;' + ' d: procedure(test: Integer);' + ' xx: x;' + ' yy: y;' + ' zz: TIntegerArray;' + ' i: Integer;' + 'begin' + ' with a, b[zz[i]], c do' + ' d := ''test'';' + ' ' + ' with a do' + ' begin' + ' with b[i] do' + ' begin' + ' c.d := ''test'';' + ' end;' + ' end;' + ' ' + ' a.b[0].c.d := ''0'';' + ' b := bb;' + ' c := ''Just a test'';' + ' xx := enum;' + ' yy := [thiz, iz, enum];' + ' d(123);' + 'end.' + ) + BracketHighlightStyle = sbhsBoth + OnCommandProcessed = eCommandProcessed + OnProcessUserCommand = eProcessUserCommand + OnStatusChange = eStatusChange + inline SynGutterPartList1: TSynGutterPartList + object SynGutterMarks1: TSynGutterMarks + Width = 23 + end + object SynGutterLineNumber1: TSynGutterLineNumber + Width = 17 + MouseActions = <> + MarkupInfo.Background = clBtnFace + MarkupInfo.Foreground = clNone + DigitCount = 2 + ShowOnlyLineNumbersMultiplesOf = 1 + ZeroStart = False + LeadingZeros = False + end + object SynGutterChanges1: TSynGutterChanges + Width = 4 + ModifiedColor = 59900 + SavedColor = clGreen + end + object SynGutterSeparator1: TSynGutterSeparator + Width = 2 + end + object SynGutterCodeFolding1: TSynGutterCodeFolding + MouseActions = < + item + Shift = [] + ShiftMask = [] + Button = mbRight + ClickCount = ccSingle + ClickDir = cdUp + Command = 16 + MoveCaret = False + Option = 0 + Priority = 0 + end + item + Shift = [] + ShiftMask = [ssShift] + Button = mbMiddle + ClickCount = ccAny + ClickDir = cdDown + Command = 14 + MoveCaret = False + Option = 0 + Priority = 0 + end + item + Shift = [ssShift] + ShiftMask = [ssShift] + Button = mbMiddle + ClickCount = ccAny + ClickDir = cdDown + Command = 14 + MoveCaret = False + Option = 1 + Priority = 0 + end + item + Shift = [] + ShiftMask = [] + Button = mbLeft + ClickCount = ccAny + ClickDir = cdDown + Command = 0 + MoveCaret = False + Option = 0 + Priority = 0 + end> + MarkupInfo.Background = clNone + MarkupInfo.Foreground = clGray + MouseActionsExpanded = < + item + Shift = [] + ShiftMask = [] + Button = mbLeft + ClickCount = ccAny + ClickDir = cdDown + Command = 14 + MoveCaret = False + Option = 0 + Priority = 0 + end> + MouseActionsCollapsed = < + item + Shift = [ssCtrl] + ShiftMask = [ssCtrl] + Button = mbLeft + ClickCount = ccAny + ClickDir = cdDown + Command = 15 + MoveCaret = False + Option = 0 + Priority = 0 + end + item + Shift = [] + ShiftMask = [ssCtrl] + Button = mbLeft + ClickCount = ccAny + ClickDir = cdDown + Command = 15 + MoveCaret = False + Option = 1 + Priority = 0 + end> + end + end + end + object pnlLeft: TPanel + Left = 0 + Height = 448 + Top = 0 + Width = 432 + Align = alLeft + ClientHeight = 448 + ClientWidth = 432 + FullRepaint = False + TabOrder = 1 + object btnParse: TButton + Left = 8 + Height = 25 + Top = 8 + Width = 128 + Caption = 'Parse' + OnClick = btnParseClick + TabOrder = 0 + end + object lstDump: TListBox + Left = 8 + Height = 272 + Top = 168 + Width = 414 + Anchors = [akTop, akLeft, akRight, akBottom] + Columns = 1 + IntegralHeight = True + ItemHeight = 0 + Style = lbOwnerDrawFixed + TabOrder = 1 + end + object txtDebug: TMemo + Left = 8 + Height = 120 + Top = 40 + Width = 414 + Anchors = [akTop, akLeft, akRight] + Lines.Strings = ( + 'Valistus Script Parser' + ) + ScrollBars = ssBoth + TabOrder = 2 + end + object btnComplete: TButton + Left = 152 + Height = 25 + Top = 8 + Width = 128 + Caption = 'Complete' + OnClick = btnCompleteClick + TabOrder = 3 + end + object btnParams: TButton + Left = 296 + Height = 25 + Top = 8 + Width = 128 + Caption = 'Params' + OnClick = btnParamsClick + TabOrder = 4 + end + end + object hlPas: TSynPasSyn + Enabled = False + CompilerMode = pcmDelphi + NestedComments = False + left = 928 + end +end diff --git a/Projects/Code Insight/main.pas b/Projects/Code Insight/main.pas new file mode 100644 index 0000000..49278c8 --- /dev/null +++ b/Projects/Code Insight/main.pas @@ -0,0 +1,446 @@ +unit Main; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + ExtCtrls, StdCtrls, SynHighlighterPas, SynEdit, SynEditHighlighter, SynEditKeyCmds, + + lclintf, ComCtrls, lcltype, + + v_ideCodeInsight, v_ideCodeParser, v_AutoCompleteForm, + CastaliaPasLexTypes, CastaliaSimplePasPar; + +type + + { TMainForm } + + TMainForm = class(TForm) + btnParams: TButton; + btnParse: TButton; + btnComplete: TButton; + e: TSynEdit; + hlPas: TSynPasSyn; + lstDump: TListBox; + txtDebug: TMemo; + pnlLeft: TPanel; + procedure btnCompleteClick(Sender: TObject); + procedure btnParamsClick(Sender: TObject); + procedure btnParseClick(Sender: TObject); + procedure eClickLink(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); + procedure eCommandProcessed(Sender: TObject; var Command: TSynEditorCommand; var AChar: TUTF8Char; Data: pointer); + procedure eKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); + procedure eKeyPress(Sender: TObject; var Key: char); + procedure eMouseLink(Sender: TObject; X, Y: Integer; var AllowMouseLink: Boolean); + procedure eProcessUserCommand(Sender: TObject; var Command: TSynEditorCommand; var AChar: TUTF8Char; Data: pointer); + procedure eStatusChange(Sender: TObject; Changes: TSynStatusChanges); + procedure FormCreate(Sender: TObject); + protected + acp_start: TPoint; + acp: TAutoCompletePopup; + + procedure OnM(Sender: TObject; const Typ: TMessageEventType; const Msg: string; X, Y: Integer); + procedure CompleteCode(Str: string); + function OnFindInclude(Sender: TObject; var FileName: string): Boolean; + public + { public declarations } + end; + +var + MainForm: TMainForm; + +implementation + +{$R *.lfm} + +const + ecAutoComplete = ecUserFirst + 1; + ecParamHint = ecUserFirst + 2; + +function WordAtCaret(e: TSynEdit; var sp, ep: Integer; Start: Integer = -1): string; +var + s: string; + l: Integer; +begin + Result := ''; + if (Start = -1) then + Start := e.CaretX; + sp := Start - 1; + ep := Start - 1; + s := e.Lines[e.CaretY - 1]; + l := Length(s); + //if (sp > l) then + // Dec(sp); + + if (sp < 1) or (sp > l) or (not (s[sp] in ['a'..'z', 'A'..'Z', '0'..'9', '_'])) then + begin + Inc(sp); + Inc(ep); + if (sp < 1) or (sp > l) or (not (s[sp] in ['a'..'z', 'A'..'Z', '0'..'9', '_'])) then + Exit(''); + end; + + while (sp > 1) and (sp <= l) and (s[sp - 1] in ['a'..'z', 'A'..'Z', '0'..'9', '_']) do + Dec(sp); + while (ep >= 1) and (ep < l) and (s[ep + 1] in ['a'..'z', 'A'..'Z', '0'..'9', '_']) do + Inc(ep); + + Result := Copy(s, sp, ep - sp + 1); +end; + +{ TMainForm } + +procedure TMainForm.OnM(Sender: TObject; const Typ: TMessageEventType; const Msg: string; X, Y: Integer); +begin + if (Typ = meNotSupported) then + Exit; + if (Sender is TmwSimplePasPar) then + if (TmwSimplePasPar(Sender).Lexer.TokenID = tok_DONE) then + Exit; + txtDebug.Lines.Add('ERROR: '+Format('%d:%d %s', [Y + 1, X, Msg])+' in '+TCodeInsight(Sender).FileName); +end; + +procedure TMainForm.CompleteCode(Str: string); +var + sp, ep: Integer; + s: string; +begin + if (Str <> '') then + begin + s := WordAtCaret(e, sp, ep); + if (s <> '') then + begin + e.SelStart := e.SelStart + (sp - e.CaretX); + e.SelEnd := e.SelStart + (ep - e.CaretX) + 1; + e.SelText := Str; + end + else + e.InsertTextAtCaret(Str); + end; +end; + +function TMainForm.OnFindInclude(Sender: TObject; var FileName: string): Boolean; +begin + if FileExists('C:\Program Files\SCAR 3.20\includes\'+FileName) then + begin + FileName := 'C:\Program Files\SCAR 3.20\includes\'+FileName; + Result := True; + end + else + Result := False; +end; + +procedure TMainForm.btnParseClick(Sender: TObject); + + procedure PrintDeclaration(Item: TDeclaration; Strings: TStrings; Prefix: string); + var + i: Integer; + begin + Strings.Add(Prefix + '(' + IntToStr(Item.StartPos) +',' + IntToStr(Item.EndPos) + ') ' + Item.CleanText + '(' + Item.ClassName + ') '); + for i := 0 to Item.Items.Count - 1 do + PrintDeclaration(Item.Items[i], Strings, Prefix + '-'); + end; + + procedure PrintCodeInsight(Item: TCodeInsight; Strings: TStrings); + var + i: Integer; + begin + Strings.Add('*START***START***START*'); + for i := 0 to Item.Items.Count - 1 do + PrintDeclaration(Item.Items[i], Strings, ''); + Strings.Add('*INCLUDES***INCLUDES*'); + for i := 0 to High(Item.Includes) do + PrintCodeInsight(Item.Includes[i], Strings); + Strings.Add('*END***END***END***END*'); + end; + +var + mp: TCodeInsight; + ms: TMemoryStream; + t: Integer; +begin + mp := TCodeInsight.Create; + mp.OnMessage := @OnM; + mp.OnFindInclude := @OnFindInclude; + + ms := TMemoryStream.Create; + + t := GetTickCount; + e.Lines.SaveToStream(ms); + + try + lstDump.Items.BeginUpdate; + lstDump.Clear; + + t := GetTickCount; + mp.Run(ms); + txtDebug.Lines.Add(IntToStr(GetTickCount - t) + 'ms'); + + PrintCodeInsight(mp, lstDump.Items); + //mp.FillSynCompletionProposal(lstDump.Items, InsertList); + finally + FreeAndNil(ms); + FreeAndNil(mp); + lstDump.Items.EndUpdate; + end; +end; + +procedure TMainForm.eClickLink(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); +var + mp: TCodeInsight; + ms: TMemoryStream; + d: TDeclaration; + sp, ep: Integer; +begin + mp := TCodeInsight.Create; + mp.OnMessage := @OnM; + mp.OnFindInclude := @OnFindInclude; + + ms := TMemoryStream.Create; + e.Lines.SaveToStream(ms); + + try + e.GetWordBoundsAtRowCol(e.CaretXY, sp, ep); + mp.Run(ms); + mp.Position := e.SelStart + (ep - e.CaretX) - 1; + + d := mp.FindVarBase(mp.GetExpressionAtPos); + if (d <> nil) then + begin + if (TCodeInsight(d.Parser).FileName <> mp.FileName) then + ShowMessage('Declared in "' + TCodeInsight(d.Parser).FileName + '" at ' + IntToStr(d.StartPos)) + else + begin + e.SelStart := d.StartPos + 1; + e.SelEnd := d.StartPos + Length(TrimRight(d.RawText)) + 1; + end; + end; + + finally + FreeAndNil(ms); + FreeAndNil(mp); + end; +end; + +procedure TMainForm.eCommandProcessed(Sender: TObject; var Command: TSynEditorCommand; var AChar: TUTF8Char; Data: pointer); +var + sp, ep: Integer; + s: string; +begin + if acp.Visible then + case Command of + ecDeleteChar, ecDeleteWord, ecDeleteEOL: + begin + if (e.CaretY = acp_start.y) then + begin + //e.GetWordBoundsAtRowCol(acp_start, sp, ep); + s := WordAtCaret(e, sp, ep, acp_start.x); + if (e.CaretX >= acp_start.x) and (e.CaretX <= ep) then + begin + acp.ListBox.Filter := s; + Exit; + end; + end; + + acp.Hide; + end; + end; +end; + +procedure TMainForm.eKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); +begin + acp.HandleKeyDown(Sender, Key, Shift); +end; + +procedure TMainForm.eKeyPress(Sender: TObject; var Key: char); +begin + acp.HandleKeyPress(Sender, Key); +end; + +procedure TMainForm.eMouseLink(Sender: TObject; X, Y: Integer; var AllowMouseLink: Boolean); +var + s: string; + Attri: TSynHighlighterAttributes; +begin + AllowMouseLink := e.GetHighlighterAttriAtRowCol(Point(X, Y), s, Attri) and (Attri.Name = 'Identifier'); +end; + +procedure TMainForm.eProcessUserCommand(Sender: TObject; var Command: TSynEditorCommand; var AChar: TUTF8Char; Data: pointer); +var + s: string; + Attri: TSynHighlighterAttributes; +begin + if (Command = ecAutoComplete) then + begin + if (not e.GetHighlighterAttriAtRowCol(e.CaretXY, s, Attri)) or (Attri.Name = 'Identifier') then + begin + btnCompleteClick(nil); + Command := ecNone; + end; + end + else if (Command = ecParamHint) then + begin + btnParamsClick(nil); + Command := ecNone; + end; +end; + +procedure TMainForm.eStatusChange(Sender: TObject; Changes: TSynStatusChanges); +var + sp, ep: Integer; + s: string; +begin + if acp.Visible then + if (scAll in Changes) or (scTopLine in Changes) then + acp.Visible := False + else if (scCaretX in Changes) or (scCaretY in Changes) or (scSelection in Changes) or (scModified in Changes) then + begin + if (e.CaretY = acp_start.y) then + begin + //e.GetWordBoundsAtRowCol(acp_start, sp, ep); + s := WordAtCaret(e, sp, ep, acp_start.x); + if (e.CaretX >= acp_start.x) and (e.CaretX - 1 <= ep) then + begin + acp.ListBox.Filter := s; + Exit; + end; + end; + + acp.Hide; + end; +end; + +procedure TMainForm.FormCreate(Sender: TObject); +begin + acp_start := Point(-1, -1); + acp := TAutoCompletePopup.Create(Self); + acp.InsertProc := @CompleteCode; + + e.AddKey(ecAutoComplete, VK_SPACE, [ssCtrl], VK_UNKNOWN, []); + e.AddKey(ecParamHint, VK_SPACE, [ssShift, ssCtrl], VK_UNKNOWN, []); +end; + +procedure TMainForm.btnCompleteClick(Sender: TObject); +var + mp: TCodeInsight; + ms: TMemoryStream; + ItemList, InsertList: TStringList; + sp, ep, t: Integer; + p: TPoint; + s, Filter: string; +begin + mp := TCodeInsight.Create; + mp.OnMessage := @OnM; + mp.OnFindInclude := @OnFindInclude; + + ms := TMemoryStream.Create; + ItemList := TStringList.Create; + InsertList := TStringList.Create; + InsertList.Sorted := True; + + e.Lines.SaveToStream(ms); + + try + //e.GetWordBoundsAtRowCol(e.CaretXY, sp, ep); + Filter := WordAtCaret(e, sp, ep); + acp_start := Point(sp, e.CaretY); + //mp.Position := e.SelStart + (ep - e.CaretX) - 1; + + mp.Run(ms, nil, e.SelStart + (ep - e.CaretX) - 1); + + s := mp.GetExpressionAtPos; + if (s <> '') then + begin + sp := LastDelimiter('.', s); + if (sp > 0) then + Delete(s, sp, Length(s) - sp + 1) + else + s := ''; + end; + + t := GetTickCount; + mp.FillSynCompletionProposal(ItemList, InsertList, s); + txtDebug.Lines.Add('Fill: '+IntToStr(GetTickCount - t)+'ms'); + + p := e.ClientToScreen(e.RowColumnToPixels(Point(ep, e.CaretY))); + p.y := p.y + e.LineHeight; + + t := GetTickCount; + acp.Show(p, ItemList, InsertList, Filter, e); + txtDebug.Lines.Add('Show: '+IntToStr(GetTickCount - t)+'ms'); + finally + FreeAndNil(ms); + FreeAndNil(mp); + ItemList.Free; + InsertList.Free; + end; +end; + +procedure TMainForm.btnParamsClick(Sender: TObject); +var + mp: TCodeInsight; + ms: TMemoryStream; + d, dd: TDeclaration; + sp, ep, bcc, bck, cc: Integer; + s: string; +begin + mp := TCodeInsight.Create; + mp.OnMessage := @OnM; + mp.OnFindInclude := @OnFindInclude; + + ms := TMemoryStream.Create; + e.Lines.SaveToStream(ms); + + try + e.GetWordBoundsAtRowCol(e.CaretXY, sp, ep); + mp.Run(ms, nil, e.SelStart + (ep - e.CaretX) - 1); + //mp.Position := e.SelStart + (ep - e.CaretX) - 1; + + bcc := 1; + bck := 0; + cc := 0; + s := mp.GetExpressionAtPos(bcc, bck, cc, True); + if (s <> '') then + Delete(s, Length(s), 1); + + d := mp.FindVarBase(s); + dd := nil; + while (d <> nil) and (d <> dd) and (d.Owner <> nil) and (not ((d is TciProcedureDeclaration) or (d.Owner is TciProcedureDeclaration))) do + begin + dd := d; + d := d.Owner.Items.GetFirstItemOfClass(TciTypeKind); + if (d <> nil) then + begin + d := TciTypeKind(d).GetRealType; + if (d is TciReturnType) then + d := d.Owner; + end; + if (d <> nil) and (d.Owner <> nil) and (not ((d is TciProcedureDeclaration) or (d.Owner is TciProcedureDeclaration))) then + d := mp.FindVarBase(d.CleanText) + else + Break; + end; + if (d <> nil) and (d <> dd) and (d.Owner <> nil) and ((d is TciProcedureDeclaration) or (d.Owner is TciProcedureDeclaration)) then + begin + if (d.Owner is TciProcedureDeclaration) and (not (d is TciProcedureDeclaration)) then + d := d.Owner; + with TParamHint.Create(Self) do + begin + if (TciProcedureDeclaration(d).SynParams <> '') then + //txtDebug.Lines.Add(TciProcedureDeclaration(d).SynParams) + Caption := TciProcedureDeclaration(d).SynParams + else + //txtDebug.Lines.Add(''); + Caption := ''; + end; + end; + finally + FreeAndNil(ms); + FreeAndNil(mp); + end; +end; + +end. + diff --git a/Projects/Code Insight/ps dump/Project1.dpr b/Projects/Code Insight/ps dump/Project1.dpr new file mode 100644 index 0000000..6238a25 --- /dev/null +++ b/Projects/Code Insight/ps dump/Project1.dpr @@ -0,0 +1,14 @@ +program Project1; + +uses + Forms, + Unit1 in 'Unit1.pas' {Form1}; + +{$R *.res} + +begin + Application.Initialize; + Application.MainFormOnTaskbar := True; + Application.CreateForm(TForm1, Form1); + Application.Run; +end. diff --git a/Projects/Code Insight/ps dump/Project1.dproj b/Projects/Code Insight/ps dump/Project1.dproj new file mode 100644 index 0000000..f419eda --- /dev/null +++ b/Projects/Code Insight/ps dump/Project1.dproj @@ -0,0 +1,108 @@ + + + {71405526-EE9C-45F5-8DA4-19347333C34C} + 12.0 + Project1.dpr + Debug + DCC32 + + + true + + + true + Base + true + + + true + Base + true + + + Project1.exe + WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;$(DCC_UnitAlias) + vclx;vcl;dbrtl;Rave76VCL;bdertl;rtl;vclactnband;xmlrtl;vcldb;vcldbx;dsnap;dsnapcon;TeeUI;TeeDB;Tee;adortl;vclib;ibxpress;IndyCore;IndySystem;IndyProtocols;inet;intrawebdb_100_120;Intraweb_100_120;VclSmp;vclie;websnap;webdsnap;inetdbbde;inetdbxpress;soaprtl;vclribbon;dbexpress;DbxCommonDriver;DataSnapIndy10ServerTransport;DataSnapProviderClient;DataSnapServer;DbxClientDriver;DBXInterBaseDriver;DBXMySQLDriver;dbxcds;DBXSybaseASEDriver;DBXSybaseASADriver;DBXOracleDriver;DBXMSSQLDriver;DBXInformixDriver;DBXDb2Driver;tb2k_d12;SpTBXLib_d12;SynEdit_R2009;SynWeb_R2006 + x86 + 00400000 + + + false + RELEASE;$(DCC_Define) + 0 + false + + + DEBUG;$(DCC_Define) + + + + MainSource + + +
Form1
+ + + Base + + + Cfg_2 + Base + + + Cfg_1 + Base + + + + + Delphi.Personality.12 + + + + + False + True + False + + + False + False + 1 + 0 + 0 + 0 + False + False + False + False + False + 1043 + 1252 + + + + + 1.0.0.0 + + + + + + 1.0.0.0 + + + + CodeGear C++Builder Office 2000 Servers Package + CodeGear C++Builder Office XP Servers Package + Microsoft Office 2000 Sample Automation Server Wrapper Components + Microsoft Office XP Sample Automation Server Wrapper Components + + + Project1.dpr + + + + 12 + + diff --git a/Projects/Code Insight/ps dump/Project1.res b/Projects/Code Insight/ps dump/Project1.res new file mode 100644 index 0000000000000000000000000000000000000000..a12aef5cbc24e975affbf742b42c78e1edaf00bf GIT binary patch literal 5280 zcmbVQO>Y}j6n#;UkdS~%uwdtrS13|Gn^u4lOcXv8K>?K-mLu1mq!#u}@Yrdyn*0-Y zfe@NM;jB@XT_UAFp-UD>!#Vf9J2Od~Ho?)=eV_N7bKiY0mYs7hfE9%rnioEQ-m&>b ztXYt`J9j>K%NBi%MgaQ)wjeDuu;>4N+F{$BoSe8k%fz#7_WSeauH9-ou2H{KYuCqZ zzVdJ4Lkz<<&oSeXPji_sz$?$%E(eFY37^>u*XFt@lF9b0&_32)_c4sNkIOj5B@Z*F zsrV&jA!C7m(RGDYhZ}qW`CypiBAk_R^7QPu*Uj|kJuRuxTk-g%6jV0vt0Vj zx65!2ToV%8IM93C3)tYmKIROcS{a*Oc+9+Z#>7}VRNb;>reoy5KF?pUr@(HICwvIs z;6BywvbuKS!#J1m%r(xdzy44TGvy$6HbWek3yF^!J1a^|_Q_T7r&zsa^1WF2UmIrcmo@Ga~Ml>;>rL(boD zXPyJ%^U-I1oKNz{Fq5i;)_gUWn)i1R{ z9OfhRXEfy+$M=gIH5TJhznnkX)GK)k5g+R~FEM9|CG*&8ZzJdIKCmtQY(Bo$ zG>(#KmT|2qt$QN4dsf9NwOH1gy7#aPru z?ZOS(nM2cR?}C1Zs`4-wAGM(G8uddDa2Q`TYW+|jzXS1}%Q*Ucr^?y{FRmdz-$4Ga zVl3l>Bublm=W)2ApY?f;^YZ@(*tWMuY62Xk?tyEyODuVBJg(IsvH3AB^YA&wT9kaZ zs(f4CFZdR9t9HA)yl2ENIb_;qF6tl7^IpA|iUYAOe>g^) zcNdHk&xmW}ooN|f<@Nub$3Z>V_ek?r?-JuO0rWXeGrVj4x&ALTMaoWIY(9O!bW>uld`@vd8M@ows`i*tFr zICZYT;J>hcV6R{=VW-|s;Ayx0oZx2%+NpDkw3p7kjo9x4qXDcIFpJ`JvG~wAw+1VU z_uK=wK@7ZcS8xDe_ zXq5Joc)Pj2vepcuxSRC)@xgYp{pjoEPntnG?!>*$Ac>>x=5drZTc5xC&Q>Q)qv7Mh zaex4Ey4{?N;?L6VlW5pUmxulCC`pt3@p3mAe%48cD@W_iVAzTK`%yanxsHZVK~M(U z>qYUnKR)JQ5R8uxf%vo^-`!~HNZc7>WH;$W-$b2J@NnnL;HUAV*H8R>C1hh|ZRPIf z#@fop`o=mm=>Ee|(v8wI8SRX^Px|AiJD!XXaH+YfJbKY#6oW(eSo&aQBjX*f*H2ta zdOmTED)|SNo0VVsaW8qAuIwhmVG=LzCh>Tb3{o$JJ4!kCp$31osl& 0) and (p2 > 0) do + begin + SetLength(Result, Length(Result) + 1); + Result[High(Result)] := Copy(s, p1, p2 - p1); + p1 := p2 + Length(Sep); + p2 := PosEx(Sep, s, p1 + 1); + end; +end; + +function PrePrepareString(s: string): string; +var + i: Integer; + BraceCount: Integer; +begin + Result := ''; + BraceCount := 0; + for i := 1 to Length(s) do + if (BraceCount = 0) and (s[i] in ['a'..'z', 'A'..'Z', '0'..'9', '_', '.', '[', ']']) then + Result := Result + s[i] + else if (s[i] = '(') then + Inc(BraceCount) + else if (s[i] = ')') then + Dec(BraceCount); +end; + +function PrepareString(s: string; out ArrayCount: Integer): string; overload; +var + i: Integer; + BraceCount, BracketCount: Integer; +begin + Result := ''; + BraceCount := 0; + BracketCount := 0; + ArrayCount := 0; + s := UpperCase(s); + for i := 1 to Length(s) do + if (BraceCount = 0) and (BracketCount = 0) and (s[i] in ['A'..'Z', '0'..'9', '_']) then + Result := Result + s[i] + else if (s[i] = '[') then + begin + if (BracketCount = 0) then + Inc(ArrayCount); + Inc(BracketCount); + end + else if (s[i] = ']') then + Dec(BracketCount) + else if (s[i] = '(') then + Inc(BraceCount) + else if (s[i] = ')') then + Dec(BraceCount); +end; + +function PrepareString(s: string): string; overload; +var + a: Integer; +begin + Result := PrepareString(s, a); +end; + +function GetFirstWord(s: string): string; +var + i: Integer; +begin + i := 1; + while (i <= Length(s)) and (s[i] in ['a'..'z', 'A'..'Z']) do + Inc(i); + Result := Copy(s, 1, i - 1); +end; + +function CompressWhiteSpace(s: string): string; + + function GetNextChar(s: string; i: Integer; out c: Char): Boolean; + begin + Result := True; + c := #0; + + while (i <= Length(s)) and (s[i] in [#10, #11, #13, #32]) do + Inc(i); + if (i <= Length(s)) then + c := s[i] + else + Result := False; + end; + +var + i: Integer; + c: Char; + LastSpace: Boolean; +begin + Result := ''; + i := 1; + LastSpace := False; + while (i <= Length(s)) do + begin + if (s[i] in [#10, #11, #13, #32]) then + begin + if (not LastSpace) and (GetNextChar(s, i, c) and (c in ['a'..'z', 'A'..'Z', '0'..'9', '_'])) then + Result := Result + ' '; + Inc(i); + while (i <= Length(s)) and (s[i] in [#10, #11, #13, #32]) do + Inc(i); + LastSpace := True; + end + else + begin + LastSpace := False; + Result := Result + s[i]; + if (s[i] in [':', ';']) then + begin + Result := Result + ' '; + LastSpace := True; + end; + Inc(i); + end; + end; +end; + +end. diff --git a/Projects/Code Insight/v_autocompleteform.pas b/Projects/Code Insight/v_autocompleteform.pas new file mode 100644 index 0000000..b8021c0 --- /dev/null +++ b/Projects/Code Insight/v_autocompleteform.pas @@ -0,0 +1,581 @@ +unit v_AutoCompleteForm; + +interface + +uses + Classes, SysUtils, Forms, Controls, Graphics, Dialogs, + StdCtrls, ExtCtrls, + + {$IFDEF FPC} + LMessages, + lcltype + {$ELSE} + Windows, + Messages + {$ENDIF}; + +type + TInsertProc = procedure(Str: string) of object; + + TAutoCompleteListBox = class(TListBox) + protected + fIndexList: array of Integer; + fList: TStrings; + fInsertList: TStrings; + fFilter: string; + + procedure setItemList(List: TStrings); + procedure setInsertList(List: TStrings); + procedure setFilter(Filter: string); + + procedure DblClick; override; + procedure DrawItem(Index: Integer; ARect: TRect; State: TOwnerDrawState); override; + {$IFDEF FPC} + procedure WMEraseBkgnd(var message: TLMEraseBkgnd); message LM_ERASEBKGND; + procedure WMVScroll(var message: TLMVScroll); message LM_VSCROLL; + procedure CNChar(var message: TLMessage); message CN_CHAR; + {$ELSE} + procedure WMEraseBkgnd(var message: TWMEraseBkgnd); message WM_ERASEBKGND; + procedure WMVScroll(var message: TWMVScroll); message WM_VSCROLL; + procedure CNChar(var message: TMessage); message CN_CHAR; + {$ENDIF} + public + ColumnSizes: array of Integer; + Redirect: TWinControl; + InsertProc: TInsertProc; + + procedure setLists(ItemList, InsertList: TStrings); + function getInsert: string; + constructor Create(TheOwner: TComponent); override; + destructor Destroy; override; + published + property ItemList: TStrings read fList write setItemList; + property InsertList: TStrings read fInsertList write setInsertList; + property Filter: string read fFilter write setFilter; + end; + + TAutoCompletePopup = class(TForm) + protected + l: TAutoCompleteListBox; + procedure DoShow; override; + + function getRedirect: TWinControl; + procedure setRedirect(Control: TWinControl); + function getInsertProc: TInsertProc; + procedure setInsertProc(Proc: TInsertProc); + public + constructor Create(TheOwner: TComponent); override; + procedure Show(Pos: TPoint; ItemList, InsertList: TStrings; Filter: string = ''; Editor: TWinControl = nil); reintroduce; + procedure DoHide; override; + + procedure HandleKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); + procedure HandleKeyPress(Sender: TObject; var Key: char); + published + property ListBox: TAutoCompleteListBox read l; + property Redirect: TWinControl read getRedirect write setRedirect; + property InsertProc: TInsertProc read getInsertProc write setInsertProc; + end; + + TParamHint = class(THintWindow) + public + constructor Create(TheOwner: TComponent); override; + procedure Paint; override; + end; + +implementation + +uses + StrUtils {$IFDEF FPC}, lclintf{$ENDIF}, Themes; + +procedure TAutoCompleteListBox.setItemList(List: TStrings); +begin + fList.Assign(List); +end; + +procedure TAutoCompleteListBox.setInsertList(List: TStrings); +begin + fInsertList.Assign(List); +end; + +procedure TAutoCompleteListBox.setLists(ItemList, InsertList: TStrings); +var + i: Integer; +begin + //fList.Assign(ItemList); + //fInsertList.Assign(InsertList); + {$IFDEF FPC}LockSelectionChange;{$ENDIF} + + fList.BeginUpdate; + try + fList.Clear; + fList.AddStrings(ItemList); + finally + fList.EndUpdate; + end; + + fInsertList.BeginUpdate; + try + fInsertList.Clear; + fInsertList.AddStrings(InsertList); + finally + fInsertList.EndUpdate; + end; + + Items.BeginUpdate; + try + Items.Clear; + Items.AddStrings(ItemList); + finally + Items.EndUpdate; + end; + + fFilter := ''; + + SetLength(fIndexList, fList.Count); + for i := 0 to fList.Count - 1 do + fIndexList[i] := i; + + if (fList.Count > 0) then + ItemIndex := 0 + else + ItemIndex := -1; + + {$IFDEF FPC}UnlockSelectionChange;{$ENDIF} +end; + +procedure TAutoCompleteListBox.setFilter(Filter: string); +var + i, c, l, del: Integer; +begin + Filter := LowerCase(Filter); + if (Filter = fFilter) then + Exit; + + {$IFDEF FPC}LockSelectionChange;{$ENDIF} + + c := 0; + if (LeftStr(Filter, Length(fFilter)) = fFilter) then + begin + fFilter := Filter; + + Items.BeginUpdate; + try + l := Length(fFilter); + del := 0; + + for i := 0 to Items.Count - 1 do + if (LowerCase(LeftStr(fInsertList[fIndexList[i]], l)) <> fFilter) then + begin + Items.Delete(i - del); + Inc(del); + end + else + begin + if (ItemIndex = i) or (LowerCase(fInsertList[fIndexList[i]]) = fFilter) then + ItemIndex := c; + + fIndexList[c] := fIndexList[i]; + Inc(c); + end; + + SetLength(fIndexList, c + 1); + finally + Items.EndUpdate; + end; + end + else + begin + fFilter := Filter; + + Items.BeginUpdate; + try + Items.Clear; + l := Length(fFilter); + SetLength(fIndexList, fInsertList.Count); + + for i := 0 to fInsertList.Count - 1 do + if (LowerCase(LeftStr(fInsertList[i], l)) = fFilter) then + begin + Items.Append(fList[i]); + + if (LowerCase(fInsertList[i]) = fFilter) then + ItemIndex := i; + + fIndexList[c] := i; + Inc(c); + end; + SetLength(fIndexList, c + 1); + finally + Items.EndUpdate; + end; + end; + + {$IFDEF FPC}UnlockSelectionChange;{$ENDIF} +end; + +function TAutoCompleteListBox.getInsert: string; +begin + if (ItemIndex < 0) or (ItemIndex > Length(fIndexList)) then + Result := '' + else + Result := fInsertList[fIndexList[ItemIndex]]; +end; + +{$IFDEF FPC} +procedure TAutoCompleteListBox.WMEraseBkgnd(var message: TLMEraseBkgnd); +{$ELSE} +procedure TAutoCompleteListBox.WMEraseBkgnd(var message: TWMEraseBkgnd); +{$ENDIF} +begin + if (Count < Round(Height / ItemHeight)) then + begin + Canvas.Brush.Color := clYellow; + FillRect(message.DC, Rect(0, Count * ItemHeight, Width, Height), HBRUSH({$IFDEF FPC}Brush.Reference.Handle{$ELSE}Parent.Brush.Handle{$ENDIF})); + end; + + message.Result := 1; +end; + +{$IFDEF FPC} +procedure TAutoCompleteListBox.WMVScroll(var message: TLMVScroll); +{$ELSE} +procedure TAutoCompleteListBox.WMVScroll(var message: TWMVScroll); +{$ENDIF} +var + c: Integer; +begin + {$IFDEF FPC}LockSelectionChange;{$ENDIF} + if (ItemIndex < TopIndex) then + ItemIndex := TopIndex + else + begin + c := Round(Height / ItemHeight) - 1; + if (ItemIndex > TopIndex + c) then + ItemIndex := TopIndex + c; + end; + {$IFDEF FPC}UnlockSelectionChange;{$ENDIF} +end; + +{$IFDEF FPC} +procedure TAutoCompleteListBox.CNChar(var message: TLMessage); +{$ELSE} +procedure TAutoCompleteListBox.CNChar(var message: TMessage); +{$ENDIF} +begin + inherited; + + {$IFDEF FPC} + if (message.Result = 0) and (Redirect <> nil) and (TLMChar(message).CharCode <> VK_DOWN) and (TLMChar(message).CharCode <> VK_UP) and (TLMChar(message).CharCode <> VK_RETURN) then + {$ELSE} + if (message.Result = 0) and (Redirect <> nil) and (TWMChar(message).CharCode <> VK_DOWN) and (TWMChar(message).CharCode <> VK_UP) and (TWMChar(message).CharCode <> VK_RETURN) then + {$ENDIF} + begin + Redirect.SetFocus; + Application.ProcessMessages; + SendMessage(Redirect.Handle, CN_Char, message.wParam, message.lParam); + end; +end; + +procedure TAutoCompleteListBox.DblClick; +begin + if (Assigned(InsertProc)) then + InsertProc(GetInsert); + if (Owner is TForm) then + TForm(Owner).Hide; +end; + +procedure TAutoCompleteListBox.DrawItem(Index: Integer; ARect: TRect; State: TOwnerDrawState); +var + p1, p2, p3, tl, col: Integer; + s, c: string; +begin + if (ItemIndex = -1) and (Count > 0) then + begin + {$IFDEF FPC}LockSelectionChange;{$ENDIF} + ItemIndex := TopIndex; + {$IFDEF FPC}UnlockSelectionChange;{$ENDIF} + end; + + if {$IFDEF FPC}(odPainted in State) or{$ENDIF} (not Visible) or (ARect.Left > ClientRect.Right) or (ARect.Top > ClientRect.Bottom) or (Index < 0) or (Index >= Items.Count) then + Exit; + + tl := ARect.Left; + col := 0; + with Canvas do + begin + Font.Style := []; + Font.Color := clBlack; + if (odSelected in State) then + Brush.Color := clHighlight + else if (odHotLight in State) then + Brush.Color := clHotLight + else if Odd(Index) then + Brush.Color := $F0F0F0 + else + Brush.Color := clWhite; + FillRect(ARect); + + s := Items[Index]; + p1 := Pos('{', s); + p3 := 1; + while (p1 > 0) do + begin + p2 := PosEx('}', s, p1 + 1); + if (p2 > 0) then + begin + if (s[p2 - 1] <> '\') then + begin + c := Copy(s, p3, p1 - p3); + TextOut(tl, ARect.Top + Round((ItemHeight - TextHeight(c) + 0.001) / 2) , c); + tl := tl + TextWidth(c) + 1; + + p3 := p2 + 1; + if ((p2 - p1 - 2) > 0) then + begin + c := LowerCase(Copy(s, p1 + 2, p2 - p1 - 2)); + case Char(CharUpper({$IFNDEF FPC}PChar{$ELSE}Char{$ENDIF}(s[p1 + 1]))) of + '#', 'C': Font.Color := StringToColor(c); + 'B': + if (c = '+') then + Font.Style := Font.Style + [fsBold] + else + Font.Style := Font.Style - [fsBold]; + 'I': + if (c = '+') then + Font.Style := Font.Style + [fsItalic] + else + Font.Style := Font.Style - [fsItalic]; + 'U': + if (c = '+') then + Font.Style := Font.Style + [fsUnderline] + else + Font.Style := Font.Style - [fsUnderline]; + end; + end + else if (s[p1 + 1] = '|') then + begin + if (ColumnSizes[col] = -1) then + ColumnSizes[col] := Canvas.TextWidth('constructor') + 5; + tl := ColumnSizes[col]; + Inc(Col); + end; + p1 := PosEx('{', s, p2 + 1); + end; + end + else + Break; + end; + + if ((Length(s) - p3 + 1) > 0) then + begin + c := Copy(s, p3, Length(s) - p3 + 1); + TextOut(tl, ARect.Top + Round((ItemHeight - TextHeight(c) + 0.001) / 2), c); + end; + end; +end; + +constructor TAutoCompleteListBox.Create(TheOwner: TComponent); +begin + inherited; + + DoubleBuffered := True; + ControlStyle := ControlStyle + [csOpaque]; + BorderStyle := bsNone; + Style := lbOwnerDrawFixed; + + IntegralHeight := True; + {$IFDEF FPC} + ItemHeight := CalculateStandardItemHeight + 4; + {$ELSE} + ItemHeight := 19; + {$ENDIF} + Constraints.MinHeight := ItemHeight; + + SetLength(ColumnSizes, 1); + ColumnSizes[0] := -1; + Redirect := nil; + InsertProc := nil; + + Items.Clear; + fList := TStringList .Create; + fInsertList := TStringList.Create; + fFilter := ''; +end; + +destructor TAutoCompleteListBox.Destroy; +begin + FreeAndNil(fList); + FreeAndNil(fInsertList); + + inherited; +end; + +procedure TAutoCompletePopup.DoShow; +begin + //ClientHeight := Max(Min(Round(ClientHeight / l.ItemHeight), l.Count), 1) * l.ItemHeight; + //ClientHeight := Max(Round(ClientHeight / l.ItemHeight), 1) * l.ItemHeight; +end; + +function TAutoCompletePopup.getRedirect: TWinControl; +begin + Result := ListBox.Redirect; +end; + +procedure TAutoCompletePopup.setRedirect(Control: TWinControl); +begin + ListBox.Redirect := Control; +end; + +function TAutoCompletePopup.getInsertProc: TInsertProc; +begin + Result := ListBox.InsertProc; +end; + +procedure TAutoCompletePopup.setInsertProc(Proc: TInsertProc); +begin + ListBox.InsertProc := Proc; +end; + +constructor TAutoCompletePopup.Create(TheOwner: TComponent); +begin + inherited; + + l := TAutoCompleteListBox.Create(Self); + with l do + begin + Parent := Self; + Align := alClient; + OnKeyDown := {$IFDEF FPC}@{$ENDIF}HandleKeyDown; + OnKeyPress := {$IFDEF FPC}@{$ENDIF}HandleKeyPress; + end; + + DefaultMonitor := dmMainForm; + FormStyle := fsStayOnTop; + + {$IFDEF FPC} + ShowInTaskBar := stNever; + {$ENDIF} + + BorderStyle := bsSizeToolWin; + BorderIcons := []; + SetWindowLong(Handle, GWL_STYLE, GetWindowLong(Handle, GWL_STYLE) and (not WS_CAPTION) or WS_BORDER); + Height := Height - GetSystemMetrics(SM_CYCAPTION); + + DoubleBuffered := True; + ControlStyle := ControlStyle + [csOpaque]; + + ClientHeight := Round(ClientHeight / l.ItemHeight) * l.ItemHeight; + Constraints.MinHeight := l.ItemHeight; + Constraints.MinWidth := 100; +end; + +procedure TAutoCompletePopup.DoHide; +begin + ListBox.Clear; + inherited; +end; + +procedure TAutoCompletePopup.HandleKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); +begin + if Visible then + begin + case Key of + VK_UP: + if (ListBox.Count > 0) and (ListBox.ItemIndex > 0) then + ListBox.ItemIndex := ListBox.ItemIndex - 1; + VK_DOWN: + if (ListBox.Count > 0) and (ListBox.ItemIndex + 1 < ListBox.Count) then + ListBox.ItemIndex := ListBox.ItemIndex + 1; + VK_RETURN: + ListBox.DblClick; + VK_ESCAPE: + Hide; + else + Exit; + end; + Key := 0; + end; +end; + +procedure TAutoCompletePopup.HandleKeyPress(Sender: TObject; var Key: char); +begin + if Visible and (not (Key in ['a'..'z', 'A'..'Z', '0'..'9', '_'])) then + if (Key in ['.', '(', '[', ';', ':']) then + ListBox.DblClick + else + Hide; +end; + +procedure TAutoCompletePopup.Show(Pos: TPoint; ItemList, InsertList: TStrings; Filter: string = ''; Editor: TWinControl = nil); +begin + ListBox.setLists(ItemList, InsertList); + ListBox.Redirect := Editor; + ListBox.Filter := Filter; + Left := Pos.x; + Top := Pos.y; + + inherited Show; + + if (Editor <> nil) then + Editor.SetFocus; +end; + +constructor TParamHint.Create(TheOwner: TComponent); +begin + inherited; + + {$IFDEF FPC} + AutoHide := False; + {$ENDIF} +end; + +procedure TParamHint.Paint; + + function GetDrawTextFlags: Cardinal; + var + EffectiveAlignment: TAlignment; + begin + Result := DT_NOPREFIX or DT_VCENTER or DT_WORDBREAK; + EffectiveAlignment := Alignment; + if BiDiMode <> bdLeftToRight then + begin + Result := Result or DT_RTLREADING; + //change alignment if is RTL + if BiDiMode = bdRightToLeft then + begin + case Alignment of + taLeftJustify: EffectiveAlignment := taRightJustify; + taRightJustify: EffectiveAlignment := taLeftJustify; + end; + end; + end; + case EffectiveAlignment of + taLeftJustify: Result := Result or DT_LEFT; + taCenter: Result := Result or DT_CENTER; + taRightJustify: Result := Result or DT_RIGHT; + end; +end; + +var + ARect: TRect; + Details: TThemedElementDetails; +begin + ARect := ClientRect; + if Color = clInfoBk then // draw using themes + begin + Details := ThemeServices.GetElementDetails(tttStandardLink); + ThemeServices.DrawElement(Canvas.Handle, Details, ARect); + end + else + begin + Canvas.Brush.Color := Color; + Canvas.Pen.Width := 1; + Canvas.FillRect(ARect); + DrawEdge(Canvas.Handle, ARect, BDR_RAISEDOUTER, BF_RECT); + end; + InflateRect(ARect, - 4, - 4); + Canvas.TextOut(ARect.Left, ARect.Top, Caption); +end; + +end. + diff --git a/Projects/Code Insight/v_ideCodeInsight.pas b/Projects/Code Insight/v_ideCodeInsight.pas new file mode 100644 index 0000000..8455169 --- /dev/null +++ b/Projects/Code Insight/v_ideCodeInsight.pas @@ -0,0 +1,1259 @@ +unit v_ideCodeInsight; + +{$include ValistusDefines.inc} + +interface + +uses + SysUtils, Classes, + CastaliaPasLex, + CastaliaPasLexTypes, + v_ideCodeParser; + +type + TCodeInsight = class; + TCodeInsightArray = array of TCodeInsight; + + TOnFindInclude = function(Sender: TObject; var FileName: string): Boolean of object; + + TCodeInsight = class(TCodeParser) + protected + fFileName: string; + fMemoryStream: TMemoryStream; + fOwnStream: Boolean; + + fPos: Integer; + fDeclarationAtPos: TDeclaration; + + fOnFindInclude: TOnFindInclude; + fIncludes: TCodeInsightArray; + + InFunc: TDeclarationArray; + InWith: TDeclarationArray; + InClassFunction: Integer; + + Proposal_Filled: Boolean; + Proposal_ItemList: TStrings; + Proposal_InsertList: TStrings; + + procedure SetPos(APos: Integer); + + procedure Reset; + procedure Init; + + function FindInclude(var FileName: string): Boolean; + procedure ParseInclude(FileName: string); + procedure OnInclude(Sender: TmwBasePasLex); override; + + function GetVarType(s: string; out Decl: TDeclaration; Return: TVarBase): Boolean; + function GetFuncType(FuncName, FuncClass: string; out Decl: TDeclaration; Return: TVarBase): Boolean; + function FindStruct(s: string; out Decl: TDeclaration; Return: TVarBase; var ArrayCount: Integer): Boolean; + public + function GetExpressionAtPos(var BraceCount, BracketCount, CommaCount: Integer; IgnoreBrackets: Boolean = False): string; overload; + function GetExpressionAtPos: string; overload; + function FindVarBase(s: string; GetStruct: Boolean = False; Return: TVarBase = vbName): TDeclaration; + + constructor Create(FileName: string = ''); reintroduce; + destructor Destroy; override; + procedure Assign(From: TObject); override; + procedure Run(SourceStream: TCustomMemoryStream = nil; BaseDefines: TStringList = nil; MaxPos: Integer = -1); reintroduce; + + procedure Proposal_AddDeclaration(Item: TDeclaration; ItemList, InsertList: TStrings); + procedure FillProposal; + procedure FillSynCompletionProposal(ItemList, InsertList: TStrings; Prefix: string = ''); + + property OnFindInclude: TOnFindInclude read fOnFindInclude write fOnFindInclude; + property FileName: string read fFileName write fFileName; + property Position: Integer read fPos write SetPos; + property DeclarationAtPos: TDeclaration read fDeclarationAtPos; + property Includes: TCodeInsightArray read fIncludes; + end; + + TIncludeBuffer = record + Script: string; + DefinesIn, DefinesOut: TSaveDefinesRec; + LastChanged: Integer; + CodeInsight: TCodeInsight; + end; + TIncludeBufferArray = array of TIncludeBuffer; + +var + CoreBuffer: TCodeInsightArray; + IncludeBuffer: TIncludeBufferArray; + +implementation + +uses + v_Constants, v_MiscFunctions; + +procedure ClearCoreBuffer; +var + i: Integer; +begin + for i := 0 to High(CoreBuffer) do + FreeAndNil(CoreBuffer[i]); + + SetLength(IncludeBuffer, 0); +end; + +procedure DeleteIncludeBufferIndex(Index: Integer); +var + i: Integer; +begin + IncludeBuffer[Index].CodeInsight.Free; + + for i := Index to High(IncludeBuffer) - 1 do + IncludeBuffer[i] := IncludeBuffer[i + 1]; + + SetLength(IncludeBuffer, Length(IncludeBuffer) - 1); +end; + +procedure ClearIncludeBuffer; +var + i: Integer; +begin + for i := 0 to High(IncludeBuffer) do + IncludeBuffer[i].CodeInsight.Free; + + SetLength(IncludeBuffer, 0); +end; + +function GetIncludeBuffer(FileName: string; ci: TCodeInsight): TIncludeBuffer; +var + i, l, lc: Integer; + Defines: TSaveDefinesRec; + DefineMatch: Boolean; +begin + lc := 1;//FileAge(FileName); + Defines := ci.Lexer.SaveDefines; + l := Length(IncludeBuffer); + + for i := l - 1 downto 0 do + begin + if (IncludeBuffer[i].CodeInsight.FileName = FileName) then + begin + DefineMatch := (IncludeBuffer[i].DefinesIn.Defines = Defines.Defines) and (IncludeBuffer[i].DefinesIn.Stack = Defines.Stack); + + if (ci.FileName = IncludeBuffer[i].Script) and (not DefineMatch) then + begin + DeleteIncludeBufferIndex(i); + Dec(l); + Break; + end + else if DefineMatch then + begin + + //if (IncludeBuffer[i].LastChanged = lc) then + begin + ci.Lexer.LoadDefines(IncludeBuffer[i].DefinesOut); + Result := IncludeBuffer[i]; + Exit; + end; + + DeleteIncludeBufferIndex(i); + Dec(l); + Break; + end; + end; + end; + + SetLength(IncludeBuffer, l + 1); + with IncludeBuffer[l] do + begin + Script := ci.FileName; + DefinesIn := Defines; + LastChanged := lc; + CodeInsight := TCodeInsight.Create(FileName); + + with CodeInsight do + begin + Assign(ci); + //Lexer.CloneDefinesFrom(ci.Lexer); + Run; + //DefinesOut := Lexer.SaveDefines; Weird bug, so moved out of the with statement + ci.Lexer.CloneDefinesFrom(Lexer); + end; + + end; + + IncludeBuffer[l].DefinesOut := IncludeBuffer[l].CodeInsight.Lexer.SaveDefines; + Result := IncludeBuffer[l]; +end; + +function TCodeInsight.FindInclude(var FileName: string): Boolean; +var + s: string; +begin + s := FileName; + if Assigned(OnFindInclude) and OnFindInclude(Self, s) then + begin + FileName := s; + Exit(True); + end; + + s := ExtractFilePath(fFileName); + if (s <> '') and FileExists(s + FileName) then + begin + FileName := s + FileName; + Exit(True); + end; + + {s := ExtractFilePath(ParamStr(0)); + if (s <> '') and FileExists(s + FileName) then + begin + FileName := s + FileName; + Exit(True); + end; + + Result := FileExists(FileName);} + + Result := False; +end; + +procedure TCodeInsight.ParseInclude(FileName: string); +var + l: Integer; +begin + l := Length(fIncludes); + SetLength(fIncludes, l + 1); + fIncludes[l] := GetIncludeBuffer(FileName, Self).CodeInsight; +end; + +procedure TCodeInsight.OnInclude(Sender: TmwBasePasLex); +var + Param: string; + i: Integer; +begin + Param := Sender.DirectiveParam; + Param := StringReplace(Param, '/', '\', [rfReplaceAll]); + if (not Sender.IsJunk) and (Param <> '') then + begin + if FindInclude(Param) then + begin + if (LowerCase(Sender.Token) = 'include_once') then + for i := High(fIncludes) downto 0 do + if (fIncludes[i].FileName = Param) then + begin + Param := ''; + Break; + end; + + if (Param <> '') then + ParseInclude(Param); + end + else if Assigned(OnMessage) then + OnMessage(Self, meError, Format(ci_UnknownInclude, [Param]), Sender.PosXY.X, Sender.PosXY.Y); + end; + + inherited; +end; + +procedure TCodeInsight.SetPos(APos: Integer); +begin + if (fPos = APos) then + Exit; + Reset; + fPos := APos; + Init; +end; + +procedure TCodeInsight.Init; +var + a, b: TDeclarationArray; + d: TDeclaration; + i, ii: Integer; + s: string; +begin + if (fPos >= 0) then + fDeclarationAtPos := fItems.GetItemInPos(fPos, fPos, True) + else + fDeclarationAtPos := nil; + + if (fDeclarationatPos is TciJunk) and (fDeclarationatPos.Owner <> nil) {and (fDeclarationatPos.EndPos = fPos)} then + fDeclarationAtPos := fDeclarationatPos.Owner; + + if (fDeclarationAtPos <> nil) and (not (fDeclarationAtPos is TciJunk)) then + begin + InFunc := fDeclarationAtPos.GetOwnersOfClass(TciProcedureDeclaration); + if (fDeclarationAtPos is TciProcedureDeclaration) then + begin + SetLength(InFunc, Length(InFunc) + 1); + InFunc[High(InFunc)] := fDeclarationAtPos; + end; + + if (Length(InFunc) > 0) and (InFunc[0].Owner = nil) then + begin + d := InFunc[0].Items.GetFirstItemOfClass(TciProcedureClassName); + if (d <> nil) then + d := FindVarBase(d.CleanText, True, vbType); + if (d <> nil) and (d is TciStruct) then + begin + SetLength(InWith, Length(InWith) + 1); + InClassFunction := High(InWith); + InWith[InClassFunction] := d; + end; + end; + + a := fDeclarationAtPos.GetOwnersOfClass(TciWithStatement); + if (fDeclarationAtPos is TciWithStateMent) then + begin + SetLength(a, Length(a) + 1); + a[High(a)] := fDeclarationAtPos; + end + else if fDeclarationAtPos.HasOwnerClass(TciClassType, d, True) then + begin + SetLength(InWith, Length(InWith) + 1); + InWith[High(InWith)] := d; + end; + + for i := High(a) downto Low(a) do + begin + b := a[i].Items.GetItemsOfClass(TciVariable); + for ii := Low(b) to High(b) do + begin + if (fDeclarationAtPos is TciVariable) and (b[ii].EndPos >= fPos) then + Continue; + s := b[ii].CleanText; + d := FindVarBase(s, True, vbType); + if (d <> nil) and (d is TciStruct) then + begin + SetLength(InWith, Length(InWith) + 1); + InWith[High(InWith)] := d; + end; + end; + end; + end; +end; + +procedure TCodeInsight.Reset; +begin + Lexer.Init; + + //SetLength(fIncludes, 0); + SetLength(InFunc, 0); + SetLength(InWith, 0); + InClassFunction := -1; + + Proposal_ItemList.Clear; + Proposal_InsertList.Clear; + Proposal_Filled := False; + + fDeclarationAtPos := nil; +end; + +function TCodeInsight.GetVarType(s: string; out Decl: TDeclaration; Return: TVarBase): Boolean; +var + a, b: TDeclarationArray; + i, ii, iii, iiii, FuncOffset, SetOffset: Integer; + c: array [1..3] of TDeclarationClass; + d: TDeclaration; +begin + Result := False; + FuncOffset := 0; + SetOffset := 0; + + if (s = 'RESULT') and (Length(InFunc) > 0) then + begin + Decl := InFunc[Low(InFunc)].Items.GetFirstItemOfClass(TciReturnType); + if (Decl <> nil) then + begin + Result := True; + Exit; + end; + end; + + if (s = 'SELF') and (InClassFunction <> -1) and InWith[InClassFunction].HasOwnerClass(TciTypeDeclaration, d, True) then + begin + Decl := d.Items.GetFirstItemOfClass(TciTypeName); + if (Decl <> nil) then + begin + Result := True; + Exit; + end; + end; + + for i := Low(InFunc) to High(InFunc) + 1 do + begin + for iiii := 1 to 3 do + begin + case iiii of + 1: + begin + c[1] := TciVarDeclaration; + c[2] := TciVarName; + c[3] := TciTypeKind; + end; + 2: + begin + if (Return = vbType) then + Continue; + c[1] := TciConstantDeclaration; + c[2] := TciConstantName; + c[3] := TciExpression; + end; + 3: + begin + if (Return = vbType) then + Continue; + c[1] := TciLabelDeclaration; + c[2] := TciLabelName; + c[3] := nil; + end; + else + Continue; + end; + if (i = High(InFunc) + 1) then + a := fItems.GetItemsOfClass(c[1]) + else + a := InFunc[i].Items.GetItemsOfClass(c[1]); + for ii := Low(a) to High(a) do + begin + b := a[ii].Items.GetItemsOfClass(c[2]); + for iii := Low(b) to High(b) do + if (PrepareString(b[iii].CleanText) = s) then + begin + Result := True; + if (Return = vbType) and (c[3] <> nil) then + Decl := a[ii].Items.GetFirstItemOfClass(c[3]) + else + Decl := b[iii]; + Exit; + end; + end; + end; + + if (Return = vbName) then + begin + if (i = High(InFunc) + 1) then + a := fItems.GetItemsOfClass(TciQualifiedIdentifier, True) + else + a := InFunc[i].Items.GetItemsOfClass(TciQualifiedIdentifier, True); + for ii := Low(a) to High(a) - SetOffset do + begin + if (i = High(InFunc) + 1) then + if a[ii].HasOwnerClass(TciTypeDeclaration, d, True) then + begin + if d.HasOwnerClass(TciProcedureDeclaration, d, True) then + Continue; + end + else if a[ii].HasOwnerClass(TciProcedureDeclaration, d, True) and (d.Owner <> nil) then + Continue; + + if (PrepareString(a[ii].CleanText) = s) then + begin + Result := True; + Decl := a[ii]; + Exit; + end; + end; + SetOffset := Length(a); + end; + + if (i <= High(InFunc)) then + begin + a := InFunc[i].Items.GetItemsOfClass(TciParameterName, True); + for ii := Low(a) to High(a) - FuncOffset do + if (PrepareString(a[ii].CleanText) = s) then + begin + Result := True; + if (Return = vbType) then + Decl := a[ii].Owner.Items.GetFirstItemOfClass(TciParameterType) + else + Decl := a[ii]; + Exit; + end; + FuncOffset := Length(a); + end; + end; +end; + +function TCodeInsight.GetFuncType(FuncName, FuncClass: string; out Decl: TDeclaration; Return: TVarBase): Boolean; +var + a: TDeclarationArray; + b: TDeclaration; + i, ii: Integer; +begin + Result := False; + + for ii := Low(InFunc) to High(InFunc) + 1 do + begin + if (ii = High(InFunc) + 1) then + a := fItems.GetItemsOfClass(TciProcedureDeclaration) + else + a := InFunc[ii].Items.GetItemsOfClass(TciProcedureDeclaration); + for i := Low(a) to High(a) do + begin + b := nil; + if (FuncClass <> '') then + b := a[i].Items.GetFirstItemOfClass(TciProcedureClassName); + if ((FuncClass = '') and (b = nil)) or ((b <> nil) and (PrepareString(b.CleanText) = FuncClass)) then + begin + b := a[i].Items.GetFirstItemOfClass(TciProcedureName); + if (b <> nil) and (PrepareString(b.CleanText) = FuncName) then + begin + Result := True; + if (Return = vbType) then + Decl := a[i].Items.GetFirstItemOfClass(TciReturnType) + else + Decl := b; + + if (a[i].Items.GetFirstItemOfClass(TciForward) = nil) then + Exit; + end; + end; + end; + end; +end; + +function TCodeInsight.FindStruct(s: string; out Decl: TDeclaration; Return: TVarBase; var ArrayCount: Integer): Boolean; +var + a, b: TDeclarationArray; + i, ii: Integer; +begin + Result := False; + s := PrepareString(s); + a := fItems.GetItemsOfClass(TciTypeDeclaration); + + for i := Low(a) to High(a) do + begin + b := a[i].Items.GetItemsOfClass(TciTypeName); + for ii := Low(b) to High(b) do + if (PrepareString(b[ii].CleanText) = s) then + begin + Result := True; + if (Return = vbType) then + begin + Decl := a[i].Items.GetFirstItemOfClass(TciTypeKind); + if (Decl = nil) then + Decl := a[i].Items.GetFirstItemOfClass(TciClassType); + if (Decl is TciTypeKind) then + Decl := TciTypeKind(Decl).GetRealType(ArrayCount); + if (Decl is TciStruct) then + Result := True + else + Result := (Decl <> nil) and FindStruct(Decl.CleanText, Decl, Return, ArrayCount); + end + else + Decl := b[ii]; + if (Decl <> nil) then + Exit; + end; + end; +end; + +function TCodeInsight.GetExpressionAtPos(var BraceCount, BracketCount, CommaCount: Integer; IgnoreBrackets: Boolean = False): string; +var + i, StartPos, EndPos: Integer; + s: string; + a: TDeclarationArray; + d: TDeclaration; + LastWasDot: Boolean; +begin + Result := ''; + d := nil; + if (fDeclarationAtPos = nil) or + (fDeclarationAtPos is TciJunk) or + (not ( + (fDeclarationAtPos.HasOwnerClass(TciCompoundStatement, d, True) or (fDeclarationAtPos is TciCompoundStatement)) or + (fDeclarationAtPos.HasOwnerClass(TciConstantDeclaration, d, True) or (fDeclarationAtPos is TciConstantDeclaration)) or + (fDeclarationAtPos.HasOwnerClass(TciVarDeclaration, d, True) or (fDeclarationAtPos is TciVarDeclaration)) or + (fDeclarationAtPos.HasOwnerClass(TciLabelDeclaration, d, True) or (fDeclarationAtPos is TciLabelDeclaration)) or + (fDeclarationAtPos.HasOwnerClass(TciTypeDeclaration, d, True) or (fDeclarationAtPos is TciTypeDeclaration)) or + (fDeclarationAtPos.HasOwnerClass(TciProcedureDeclaration, d, True) or (fDeclarationAtPos is TciProcedureDeclaration)) + )) then + Exit; + if (d = nil) then + d := fDeclarationAtPos; + a := d.Items.GetItemsOfClass(TciJunk, True); + EndPos := fPos - d.StartPos; + s := d.CleanText; + + for i := Low(a) to High(a) do + if (fPos > a[i].EndPos) then + if (Pos(LineEnding, a[i].RawText) > 0) then + EndPos := EndPos - a[i].EndPos + a[i].StartPos + Length(LineEnding) + else + EndPos := EndPos - a[i].EndPos + a[i].StartPos + 1; + + StartPos := EndPos; + LastWasDot := False; + while (StartPos > 0) do + begin + if (BraceCount = 0) and ((BracketCount = 0) or IgnoreBrackets) and (s[StartPos] in ['a'..'z', 'A'..'Z', '0'..'9', '_']) then + {nothing} + else if (BraceCount = 0) and ((BracketCount = 0) or IgnoreBrackets) and (s[StartPos] in [#10, #11, #13, #32]) then + begin + i := StartPos; + Dec(StartPos); + while (StartPos > 0) and (s[StartPos] in [#10, #11, #13, #32]) do + Dec(StartPos); + if not ((LastWasDot and (s[StartPos] in ['a'..'z', 'A'..'Z', '0'..'9', '_', ']', ')'])) or ((not LastWasDot) and (s[StartPos] = '.'))) then + begin + StartPos := i; + Break; + end; + Inc(StartPos); + end + else if (s[StartPos] = '.') then + begin + LastWasDot := True; + Dec(StartPos); + Continue; + end + else if (s[StartPos] = ']') then + Inc(BracketCount) + else if (s[StartPos] = '[') then + begin + Dec(BracketCount); + LastWasDot := True; + Dec(StartPos); + Continue; + end + else if (s[StartPos] = ')') then + Inc(BraceCount) + else if (s[StartPos] = '(') then + begin + Dec(BraceCount); + LastWasDot := True; + Dec(StartPos); + Continue; + end + else if (BraceCount = 1) and (BracketCount = 0) and (s[StartPos] = ',') then + Inc(CommaCount) + else if (BraceCount = 0) and ((BracketCount = 0) or IgnoreBrackets) then + Break; + + if (BraceCount < 0) or ((BracketCount < 0) and (not IgnoreBrackets)) then + begin + Dec(StartPos, BraceCount); + Dec(StartPos, BracketCount); + Break; + end; + LastWasDot := False; + Dec(StartPos); + end; + + Result := CompressWhiteSpace(Copy(s, StartPos + 1, EndPos - StartPos)); +end; + +function TCodeInsight.GetExpressionAtPos: string; +var + bcc, bkc, cc: Integer; +begin + bcc := 0; + bkc := 0; + cc := 0; + Result := GetExpressionAtPos(bcc, bkc, cc); +end; + +function TCodeInsight.FindVarBase(s: string; GetStruct: Boolean = False; Return: TVarBase = vbName): TDeclaration; + + function PartOfWith(s: string; out Decl: TDeclaration; Return: TVarBase; CheckClass: Boolean): Boolean; + var + i: Integer; + begin + Result := False; + for i := High(InWith) downto Low(InWith) do + if CheckClass xor (i <> InClassFunction) then + if TciStruct(InWith[i]).HasField(s, Decl, Return) then + begin + Result := True; + Break; + end; + end; + + function DoGetVarType(s: string; out Decl: TDeclaration; Return: TVarBase): Boolean; + + function CheckIt(s: string; Item: TCodeInsight; out Decl: TDeclaration; Return: TVarBase): Boolean; + var + i: Integer; + begin + Result := False; + if Item.GetVarType(s, Decl, Return) then + begin + Result := True; + Exit; + end; + + for i := High(Item.Includes) downto Low(Item.Includes) do + if CheckIt(s, Item.Includes[i], Decl, Return) then + begin + Result := True; + Break; + end; + + for i := High(CoreBuffer) downto Low(CoreBuffer) do + if CheckIt(s, CoreBuffer[i], Decl, Return) then + begin + Result := True; + Break; + end; + end; + + begin + Result := CheckIt(s, Self, Decl, Return); + end; + + function DoGetFuncType(FuncName, FuncClass: string; out Decl: TDeclaration; Return: TVarBase): Boolean; + + function CheckIt(FuncName, FuncClass: string; Item: TCodeInsight; out Decl: TDeclaration; Return: TVarBase): Boolean; + var + i: Integer; + begin + Result := False; + if Item.GetFuncType(FuncName, FuncClass, Decl, Return) then + begin + Result := True; + Exit; + end; + + for i := High(Item.Includes) downto Low(Item.Includes) do + if CheckIt(FuncName, FuncClass, Item.Includes[i], Decl, Return) then + begin + Result := True; + Break; + end; + + for i := High(CoreBuffer) downto Low(CoreBuffer) do + if CheckIt(FuncName, FuncClass, CoreBuffer[i], Decl, Return) then + begin + Result := True; + Break; + end; + end; + + begin + Result := CheckIt(FuncName, FuncClass, Self, Decl, Return); + end; + + function DoFindStruct(s: string; out Decl: TDeclaration; Return: TVarBase; var ArrayCount: Integer): Boolean; + + function CheckIt(s: string; Item: TCodeInsight; out Decl: TDeclaration; Return: TVarBase; var ArrayCount: Integer): Boolean; + var + i: Integer; + begin + Result := False; + if Item.FindStruct(s, Decl, Return, ArrayCount) then + begin + Result := True; + Exit; + end; + + for i := High(Item.Includes) downto Low(Item.Includes) do + if CheckIt(s, Item.Includes[i], Decl, Return, ArrayCount) then + begin + Result := True; + Break; + end; + + for i := High(CoreBuffer) downto Low(CoreBuffer) do + if CheckIt(s, CoreBuffer[i], Decl, Return, ArrayCount) then + begin + Result := True; + Break; + end; + end; + + begin + Result := CheckIt(s, Self, Decl, Return, ArrayCount); + end; + +var + f, NameClass: string; + sa: TStringArray; + d: TDeclaration; + i, NeedArrayCount, ArrayCount: Integer; + InStruct: TciStruct; + VarBase: TVarBase; + Found, CheckVar, IsForward: Boolean; +begin + Result := nil; + if (fDeclarationAtPos is TciJunk) or (PrepareString(s) = '') then + Exit; + + InStruct := nil; + NameClass := ''; + IsForward := False; + CheckVar := (fPos < 0); + sa := Explode('.', PrePrepareString(s)); + + if (fDeclarationAtPos <> nil) then + begin + if (fDeclarationAtPos is TciProcedureName) and (fDeclarationAtPos.Owner <> nil) then + begin + if fDeclarationAtPos.HasOwnerClass(TciClassType, d, True) and (d.Owner <> nil) then + begin + d := d.Owner.Items.GetFirstItemOfClass(TciTypeName); + if (d <> nil) then + NameClass := PrepareString(d.CleanText); + end + else if (fDeclarationAtPos.Owner.Items.GetFirstItemOfClass(TciForward) <> nil) then + IsForward := True; + end; + + if (Return = vbName) and ( + (fDeclarationAtPos is TciVarName) or + (fDeclarationAtPos is TciConstantName) or + (fDeclarationAtPos is TciTypeName) or + (fDeclarationAtPos is TciLabelName) or + ((fDeclarationAtPos is TciProcedureName) and + (NameClass = '') and + (fDeclarationAtPos.Owner <> nil) and + (not IsForward) and + (fDeclarationAtPos.Owner.Items.GetFirstItemOfClass(TciProcedureClassName) = nil)) or + (fDeclarationAtPos is TciParameterName) or + (fDeclarationAtPos is TciFieldName) or + (fDeclarationAtPos is TciQualifiedIdentifier)) then + Exit; + CheckVar := (NameClass = '') and (( + (Length(InFunc) > 0) or + (Length(InWith) > 0) or + (fDeclarationAtPos is TciCompoundStatement) or + (fDeclarationAtPos is TciExpression) or + fDeclarationAtPos.HasOwnerClass(TciCompoundStatement, d, True)) or ( + (Return = vbType) and ( + (fDeclarationAtPos is TciTypeKind) or + (fDeclarationAtPos is TciParameterType) or + (fDeclarationAtPos is TciReturnType) or + (fDeclarationAtPos is TciQualifiedIdentifier) or + (fDeclarationAtPos is TciExpression)))); + end; + + for i := Low(sa) to High(sa) do + begin + f := PrepareString(sa[i], ArrayCount); + NeedArrayCount := 0; + + if (Return = vbName) and (i = High(sa)) then + VarBase := vbName + else + VarBase := vbType; + + if (InStruct <> nil) then + Found := InStruct.HasField(f, Result, VarBase) + else + begin + Found := CheckVar and PartOfWith(f, Result, VarBase, False); + if (not Found) and (i = Low(sa)) then + begin + Found := + (CheckVar and DoGetVarType(f, Result, VarBase)) or + ((CheckVar or (NameClass <> '') or IsForward) and DoGetFuncType(f, NameClass, Result, VarBase)) or + DoFindStruct(f, Result, VarBase, NeedArrayCount); + end; + if (not Found) and CheckVar then + Found := PartOfWith(f, Result, VarBase, True); + end; + + if Found and (Result is TciTypeKind) then + Result := TciTypeKind(Result).GetRealType(NeedArrayCount); + + if Found and (Result <> nil) and (not (Result is TciStruct)) and ((i < High(sa)) or GetStruct) then + Found := DoFindStruct(Result.CleanText, Result, VarBase, NeedArrayCount); + + if Found and (Result <> nil) and (ArrayCount <> NeedArrayCount) and ((Result is TciStruct) or (InStruct <> nil)) and ((i < High(sa)) or GetStruct) then + begin + if (InStruct <> nil) then + Result := InStruct.GetDefault(VarBase) + else + Result := TciStruct(Result).GetDefault(VarBase); + + Found := (Result <> nil); + + if Found and (Result is TciTypeKind) then + Result := TciTypeKind(Result).GetRealType(NeedArrayCount); + + if Found and (not (Result is TciStruct)) and ((i < High(sa)) or GetStruct) then + Found := DoFindStruct(Result.CleanText, Result, VarBase, NeedArrayCount); + + if (not Found) then + begin + if Assigned(OnMessage) then + OnMessage(Self, meError, Format(ci_RangeError, [sa[i], s]), -1, -1); + Result := nil; + Exit; + end; + end; + + if (not Found) or (Result = nil) then + begin + if Assigned(OnMessage) then + if (i > Low(sa)) then + OnMessage(Self, meError, Format(ci_UnknownMember, [sa[i], s]), -1, -1) + else + OnMessage(Self, meError, Format(ci_UnknownStruct, [sa[i], s]), -1, -1); + Result := nil; + Exit; + end; + + InStruct := TciStruct(Result); + end; +end; + +constructor TCodeInsight.Create(FileName: string = ''); +begin + inherited Create; + + Proposal_InsertList := TStringList.Create; + //TStringList(Proposal_InsertList).Sorted := True; + Proposal_ItemList := TStringList.Create; + + fOnFindInclude := nil; + fFileName := FileName; + if (fFileName <> '') and (not FileExists(fFileName)) then + fFileName := ''; + fPos := -1; + Reset; + + fOwnStream := (fFileName <> ''); + if fOwnStream then + begin + fMemoryStream := TMemoryStream.Create; + fMemoryStream.LoadFromFile(fFileName); + end + else + fMemoryStream := nil; +end; + +destructor TCodeInsight.Destroy; +begin + if fOwnStream then + FreeAndNil(fMemoryStream); + + FreeAndNil(Proposal_InsertList); + FreeAndNil(Proposal_ItemList); + + inherited; +end; + +procedure TCodeInsight.Assign(From: TObject); +begin + if (From is TCodeInsight) then + with From as TCodeInsight do + begin + Self.OnFindInclude := OnFindInclude; + end; + + inherited; +end; + +procedure TCodeInsight.Run(SourceStream: TCustomMemoryStream = nil; BaseDefines: TStringList = nil; MaxPos: Integer = -1); +begin + if Assigned(BaseDefines) then + begin + Lexer.ClearDefines; + Lexer.Defines.Assign(BaseDefines); + end; + SetLength(fIncludes, 0); + + if fOwnStream then + inherited Run(fMemoryStream, MaxPos - 1) + else if Assigned(SourceStream) then + inherited Run(SourceStream, MaxPos - 1); + + if (MaxPos > -1) then + Position := MaxPos; +end; + +procedure TCodeInsight.Proposal_AddDeclaration(Item: TDeclaration; ItemList, InsertList: TStrings); + + function FormatFirstColumn(s: string): string; inline; + begin + Result := '{#clNavy}' + LowerCase(s) + '{#0} {|}' + end; + + function FormatTypeName(s: string): string; inline; + begin + Result := '{#clBlue}' + s; + end; + + function FormatMainName(s: string): string; inline; + begin + Result := '{B+}' + s + '{B-}'; + end; + + function FormatMainExtra(s: string): string; inline; + begin + Result := '{I+}' + s + '{I-}' + end; + + function GetEnumTypeName(Item: TDeclaration): string; + begin + Result := 'Enumeration'; + if (Item.Items.Count > 0) then + Result := Result + '(' + Item.Items[0].ShortText; + if (Item.Items.Count > 1) then + Result := Result + '..' + Item.Items[Item.Items.Count - 1].ShortText + ')'; + end; + + procedure AddEnums(Item: {TCodeInsight}TDeclaration; ItemList, InsertList: TStrings); overload; + var + {i,} ii, SetOffset: Integer; + a: TDeclarationArray; + d: TDeclaration; + s: string; + begin + SetOffset := 0; + //for i := Low(Item.InFunc) to High(Item.InFunc) + 1 do + begin + //if (i = High(Item.InFunc) + 1) then + a := Item.Items.GetItemsOfClass(TciQualifiedIdentifier, True); + //else + // a := Item.InFunc[i].Items.GetItemsOfClass(TciQualifiedIdentifier, True); + for ii := Low(a) to High(a) - SetOffset do + begin + {if (i = High(Item.InFunc) + 1) then + if a[ii].HasOwnerClass(TciTypeDeclaration, d, True) then + begin + if d.HasOwnerClass(TciProcedureDeclaration, d, True) then + Continue; + end + else if a[ii].HasOwnerClass(TciProcedureDeclaration, d, True) and (d.Owner <> nil) then + Continue;} + + s := FormatFirstColumn('enum') + FormatMainName(a[ii].ShortText); + if a[ii].HasOwnerClass(TciTypeDeclaration, d, True) then + begin + d := d.Items.GetFirstItemOfClass(TciTypeName); + if (d <> nil) then + s := s + ' ' + FormatMainExtra('(' + d.ShortText + ')'); + end; + ItemList.Insert(InsertList.Add(a[ii].ShortText), s); + end; + //SetOffset := Length(a); + end; + end; + + procedure AddEnums(a: TDeclarationArray; ItemList, InsertList: TStrings); overload; + var + i: Integer; + begin + for i := Low(a) to High(a) do + AddEnums(a[i], ItemList, InsertList); + end; + + procedure AddFuncDeclaration(Item: TciProcedureDeclaration; ItemList, InsertList: TStrings); + var + s, n: string; + d: TDeclaration; + begin + s := FormatFirstColumn(Item.ProcType); + d := Item.Items.GetFirstItemOfClass(TciProcedureName); + if (d = nil) then + Exit; + n := d.ShortText; + s := s + FormatMainName(n); + if (Item.Params <> '') then + begin + s := s + FormatMainExtra('(' + Item.Params + ')'); + //n := n {+ '('}; + end; + d := Item.Items.GetFirstItemOfClass(TciReturnType); + if (d <> nil) then + s := s + ': ' + FormatTypeName(d.ShortText) + {else + s := s + ';'}; + ItemList.Insert(InsertList.Add(n), s); + + AddEnums(Item.GetParamDeclarations, ItemList, InsertList); + if (d <> nil) then + AddEnums(d, ItemList, InsertList); + end; + +var + i: Integer; + FirstColumn, s, n: string; + a: TDeclarationArray; + b: array[1..2] of TDeclaration; + c: array[0..2] of TDeclarationClass; +begin + if (Item is TciProcedureDeclaration) then + begin + AddFuncDeclaration(TciProcedureDeclaration(Item), ItemList, InsertList); + Exit; + end; + + c[0] := nil; + c[1] := nil; + c[2] := nil; + if (Item is TciVarDeclaration) then + begin + FirstColumn := FormatFirstColumn('variable'); + c[0] := TciVarName; + c[2] := TciTypeKind; + end + else if (Item is TciConstantDeclaration) then + begin + FirstColumn := FormatFirstColumn('constant'); + c[0] := TciConstantName; + c[1] := TciExpression; + end + else if (Item is TciLabelDeclaration) then + begin + FirstColumn := FormatFirstColumn('label'); + c[0] := TciLabelName; + end + else if (Item is TciTypeDeclaration) then + begin + FirstColumn := FormatFirstColumn('type'); + c[0] := TciTypeName; + c[2] := TciTypeKind; + end + else if (Item is TciClassField) then + begin + FirstColumn := FormatFirstColumn('variable'); + c[0] := TciFieldName; + c[2] := TciTypeKind; + end + else if (Item is TciClassProperty) then + begin + FirstColumn := FormatFirstColumn('property'); + c[0] := TciFieldName; + c[2] := TciTypeKind; + end + else if (Item is TciConstParameter) or + (Item is TciOutParameter) or + (Item is TciFormalParameter) or + (Item is TciInParameter) or + (Item is TciVarParameter) then + begin + FirstColumn := FormatFirstColumn('param'); + c[0] := TciParameterName; + c[2] := TciParameterType; + end; + + if (c[0] = nil) then + Exit; + + a := Item.Items.GetItemsOfClass(c[0]); + if (c[1] <> nil) then + b[1] := Item.Items.GetFirstItemOfClass(c[1]) + else + b[1] := nil; + if (c[2] <> nil) then + begin + b[2] := Item.Items.GetFirstItemOfClass(c[2]); + if (b[2] is TciTypeKind) and (b[2].Items.Count > 0) and (not (b[2].Items[0] is TciArrayType)) then + b[2] := b[2].Items[0]; + end + else + b[2] := nil; + for i := Low(a) to High(a) do + begin + n := a[i].ShortText; + (*{$IFDEF ciCHECKDUPLICATES} + if (InsertList.IndexOf(n) > -1) then + Continue; + {$ENDIF}*) + s := FirstColumn + FormatMainName(n); + if (b[1] <> nil) then + s := s + FormatMainExtra(' = ' + b[1].ShortText); + if (b[2] <> nil) then + if (b[2] is TciEnumType) then + s := s + ': ' + FormatTypeName(GetEnumTypeName(b[2])) + else + s := s + ': ' + FormatTypeName(b[2].ShortText) + {else + s := s + ';'}; + + ItemList.Insert(InsertList.Add(n), s); + if (b[2] <> nil) and (b[2].Items.Count > 0) then + AddEnums(b[2], ItemList, InsertList); + end; +end; + +procedure TCodeInsight.FillProposal; +var + i: Integer; +begin + if (not Proposal_Filled) then + begin + Proposal_ItemList.BeginUpdate; + Proposal_InsertList.BeginUpdate; + + try + for i := 0 to Items.Count - 1 do + Proposal_AddDeclaration(Items[i], Proposal_ItemList, Proposal_InsertList); + Proposal_Filled := True; + finally + Proposal_ItemList.EndUpdate; + Proposal_InsertList.EndUpdate; + end; + end; +end; + +procedure TCodeInsight.FillSynCompletionProposal(ItemList, InsertList: TStrings; Prefix: string = ''); + + procedure AddFile(Item: TCodeInsight; ItemList, InsertList: TStrings); + var + i: Integer; + begin + if (not Item.Proposal_Filled) then + Item.FillProposal; + + {$IFNDEF ciCHECKDUPLICATES} + ItemList.AddStrings(Item.Proposal_ItemList); + InsertList.AddStrings(Item.Proposal_InsertList); + {$ELSE} + for i := 0 to Item.Proposal_InsertList.Count - 1 do + if (InsertList.IndexOf(Item.Proposal_InsertList[i]) = -1) then + begin + ItemList.Insert(InsertList.Add(Item.Proposal_InsertList[i]), Item.Proposal_ItemList[i]); + //ItemList.Add(Item.Proposal_ItemList[i]); + end; + {$ENDIF} + + //AddEnums(Item, ItemList, InsertList); + for i := Low(Item.Includes) to High(Item.Includes) do + AddFile(Item.Includes[i], ItemList, InsertList); + end; + +var + i, ii: Integer; + d: TDeclaration; +begin + ItemList.BeginUpdate; + InsertList.BeginUpdate; + try + ItemList.Clear; + InsertList.Clear; + + if (PrepareString(Prefix) <> '') then + begin + d := FindVarBase(Prefix, True, vbType); + if (d <> nil) then + for i := 0 to d.Items.Count - 1 do + Proposal_AddDeclaration(d.Items[i], ItemList, InsertList); + end + else + begin + for i := High(InWith) downto Low(InWith) do + if (i <> InClassFunction) then + for ii := 0 to InWith[i].Items.Count - 1 do + Proposal_AddDeclaration(InWith[i].Items[ii], ItemList, InsertList); + + for i := Low(InFunc) to High(InFunc) do + for ii := 0 to InFunc[i].Items.Count - 1 do + Proposal_AddDeclaration(InFunc[i].Items[ii], ItemList, InsertList); + + if (InClassFunction <> -1) then + for i := 0 to InWith[InClassFunction].Items.Count - 1 do + Proposal_AddDeclaration(InWith[InClassFunction].Items[i], ItemList, InsertList); + + AddFile(Self, ItemList, InsertList); + for i := 0 to High(CoreBuffer) do + AddFile(CoreBuffer[i], ItemList, InsertList); + end; + finally + ItemList.EndUpdate; + InsertList.EndUpdate; + end; +end; + +initialization + {nothing} +finalization + ClearIncludeBuffer; + ClearCoreBuffer; + +end. diff --git a/Projects/Code Insight/v_ideCodeParser.pas b/Projects/Code Insight/v_ideCodeParser.pas new file mode 100644 index 0000000..7a5751d --- /dev/null +++ b/Projects/Code Insight/v_ideCodeParser.pas @@ -0,0 +1,1663 @@ +unit v_ideCodeParser; + +{$include ValistusDefines.inc} + +interface + +uses + SysUtils, Classes, + CastaliaPasLex, CastaliaSimplePasPar, + v_MiscFunctions; + +type + TDeclaration = class; + TDeclarationArray = array of TDeclaration; + TDeclarationClass = class of TDeclaration; + + TVarBase = (vbName, vbType); + + TDeclarationStack = class + private + fItems: TList; + fTop: TDeclaration; + public + procedure Push(Item: TDeclaration); + function Pop: TDeclaration; + + constructor Create; + destructor Destroy; override; + + property Top: TDeclaration read fTop; + end; + + TDeclarationList = class + private + fItems: TList; + + function GetItem(Index: Integer): TDeclaration; + function GetCount: Integer; + public + procedure AddItem(AItem: TDeclaration); + procedure DeleteItem(AItem: TDeclaration); + function GetItemsOfClass(AClass: TDeclarationClass; SubSearch: Boolean = False): TDeclarationArray; + function GetFirstItemOfClass(AClass: TDeclarationClass; SubSearch: Boolean = False): TDeclaration; + function GetItemsInPos(AStart, AEnd: Integer; SubSearch: Boolean = False): TDeclarationArray; + function GetItemInPos(AStart, AEnd: Integer; SubSearch: Boolean = False): TDeclaration; + + procedure Clear; + + constructor Create; + destructor Destroy; override; + + property Items[Index: Integer]: TDeclaration read GetItem; default; + property Count: Integer read GetCount; + end; + + TDeclaration = class + private + fParser: TmwSimplePasPar; + fOwner: TDeclaration; + fOrigin: PAnsiChar; + fRawText: string; + fCleanText: string; + fShortText: string; + fStartPos: Integer; + fEndPos: Integer; + fItems: TDeclarationList; + + function GetRawText: string; virtual; + function GetCleanText: string; virtual; + function GetShortText: string; virtual; + public + function HasOwnerClass(AClass: TDeclarationClass; out Declaration: TDeclaration; Recursive: Boolean = False): Boolean; + function GetOwnersOfClass(AClass: TDeclarationClass): TDeclarationArray; + + constructor Create(AParser: TmwSimplePasPar; AOwner: TDeclaration; AOrigin: PAnsiChar; AStart: Integer; AEnd: Integer = -1); overload; virtual; + constructor Create(AssignFrom: TDeclaration); overload; virtual; + destructor Destroy; override; + + property Parser: TmwSimplePasPar read fParser; + property Owner: TDeclaration read fOwner; + property Origin: PAnsiChar read fOrigin; + + property RawText: string read GetRawText write fRawText; + property CleanText: string read GetCleanText; + property ShortText: string read GetShortText; + property StartPos: Integer read fStartPos write fStartPos; + property EndPos: Integer read fEndPos write fEndPos; + property Items: TDeclarationList read fItems; + end; + + TciStruct = class(TDeclaration) + private + function GetShortText: string; override; + public + function HasField(Name: string; out Decl: TDeclaration; Return: TVarBase = vbName): Boolean; + function GetDefault(Return: TVarBase = vbName): TDeclaration; + end; + + TciTypeKind = class(TDeclaration) + private + function GetShortText: string; override; + public + function GetRealType(var ArrayCount: Integer): TDeclaration; overload; + function GetRealType: TDeclaration; overload; + end; + + TciProcedureDeclaration = class(TDeclaration) + private + fProcType: string; + fParams: string; + fSynParams: string; + + function GetProcType: string; + function GetParams: string; + function GetSynParams: string; + + function GetShortText: string; override; + public + function GetParamDeclarations: TDeclarationArray; + + property ProcType: string read GetProcType; + property Params: string read GetParams; + property SynParams: string read GetSynParams; + end; + + TciUsedUnit = class(TDeclaration); //Included Units + TciInclude = class(TDeclaration); //Includes + TciJunk = class(TDeclaration); //Junk + + TciCompoundStatement = class(TDeclaration); //Begin-End + TciWithStatement = class(TDeclaration); //With + TciSimpleStatement = class(TDeclaration); //Begin-End + With + TciVariable = class(TDeclaration); //With + + //TciTypeKind = class(TciVarType); //Var + Const + Array + Record + TciTypedConstant = class(TDeclaration); //Var + Procedure/Function Parameters + TciExpression = class(TDeclaration); //Var + Const + Enum + TciProceduralType = class(TciProcedureDeclaration); //Var + Tciype + Procedure/Function Parameters + + TciTypeDeclaration = class(TDeclaration); //Type + TciTypeName = class(TDeclaration); //Type + + TciVarDeclaration = class(TDeclaration); //Var + TciVarName = class(TDeclaration); //Var + + TciConstantDeclaration = class(TDeclaration); //Const + TciConstantName = class(TDeclaration); //Const + + TciLabelDeclaration = class(TDeclaration); //Label + TciLabelName = class(TDeclaration); //Label + + //TciProcedureDeclaration = class(TDeclaration); //Procedure/Function + TciProcedureName = class(TDeclaration); //Procedure/Function + TciProcedureClassName = class(TDeclaration); //Class Procedure/Function + TciReturnType = class(TciTypeKind); //Function Result + TciForward = class(TciTypeKind); //Forwarding + TciConstParameter = class(TDeclaration); //Procedure/Function Parameters + TciOutParameter = class(TDeclaration); //Procedure/Function Parameters + TciFormalParameter = class(TDeclaration); //Procedure/Function Parameters + TciInParameter = class(TDeclaration); //Procedure/Function Parameters + TciVarParameter = class(TDeclaration); //Procedure/Function Parameters + TciParameterName = class(TDeclaration); //Procedure/Function Parameters + TciParameterType = class(TciTypeKind); //Procedure/Function Parameters + + TciArrayType = class(TDeclaration); //Array + TciArrayConstant = class(TDeclaration); //Array + + TciRecordType = class(TciStruct); //Record + TciClassField = class(TDeclaration); //Record + TciFieldName = class(TDeclaration); //Record + TciRecordConstant = class(TDeclaration); //Record + TciRecordFieldConstant = class(TDeclaration); //Record + + TciClassType = class(TciStruct); //Class + TciAncestorId = class(TDeclaration); //Class + TciClassMethodHeading = class(TciProcedureDeclaration); //Record + Class + TciClassProperty = class(TDeclaration); //Record + Class + TciPropertyDefault = class(TDeclaration); //Record + Class + + TciSetType = class(TDeclaration); //Set + TciOrdinalType = class(TDeclaration); //Set + + TciEnumType = class(TDeclaration); //Enum + TciQualifiedIdentifier = class(TDeclaration); //Enum + + TCodeParser = class(TmwSimplePasPar) + protected + fStack: TDeclarationStack; + fItems: TDeclarationList; + + function InDeclaration(AClass: TDeclarationClass): Boolean; + function InDeclarations(AClassArray: array of TDeclarationClass): Boolean; + procedure PushStack(AClass: TDeclarationClass; AStart: Integer = -1); + procedure PopStack(AEnd: Integer = -1); + + procedure ParseFile; override; + procedure OnInclude(Sender: TmwBasePasLex); virtual; //Includes + procedure UsedUnitName; override; //Included Units + procedure NextToken; override; //Junk + procedure OnDirect(Sender: TmwBasePasLex); //Junk + + procedure CompoundStatement; override; //Begin-End + procedure WithStatement; override; //With + procedure SimpleStatement; override; //Begin-End + With + procedure Variable; override; //With + + procedure TypeKind; override; //Var + Const + Array + Record + procedure TypedConstant; override; //Var + Procedure/Function Parameters + procedure Expression; override; //Var + Const + ArrayConst + procedure ProceduralType; override; //Var + Tciype + Procedure/Function Parameters + + procedure TypeDeclaration; override; //Type + procedure TypeName; override; //Type + + procedure VarDeclaration; override; //Var + procedure VarName; override; //Var + + procedure ConstantDeclaration; override; //Const + procedure ConstantName; override; //Const + + procedure LabelDeclarationSection; override; //Label + procedure LabelId; override; //Label + + procedure ProcedureDeclarationSection; override; //Procedure/Function + procedure FunctionProcedureName; override; //Procedure/Function + procedure ObjectNameOfMethod; override; //Class Procedure/Function + procedure ReturnType; override; //Function Result + procedure ForwardDeclaration; override; //Forwarding + procedure ConstParameter; override; //Procedure/Function Parameters + procedure OutParameter; override; //Procedure/Function Parameters + procedure ParameterFormal; override; //Procedure/Function Parameters + procedure InParameter; override; //Procedure/Function Parameters + procedure VarParameter; override; //Procedure/Function Parameters + procedure ParameterName; override; //Procedure/Function Parameters + procedure NewFormalParameterType; override; //Procedure/Function Parameters + + procedure ArrayType; override; //Array + procedure ArrayConstant; override; //Array Const + + procedure RecordType; override; //Record + procedure ClassField; override; //Record + Class + procedure FieldName; override; //Record + Class + procedure RecordConstant; override; //Record Const + procedure RecordFieldConstant; override; //Record Const + + procedure ClassType; override; //Class + procedure AncestorId; override; //Class + procedure ClassMethodHeading; override; //Class + procedure ConstructorName; override; //Class + procedure DestructorName; override; //Class + procedure FunctionMethodName; override; //Class + procedure ProcedureMethodName; override; //Class + procedure ClassProperty; override; //Record + Class + procedure PropertyName; override; //Record + Class + procedure TypeId; override; //Record + Class + procedure PropertyDefault; override; //Record + Class + + procedure SetType; override; //Set + procedure OrdinalType; override; //Set + Array Range + + procedure EnumeratedType; override; //Enum + procedure QualifiedIdentifier; override; //Enum + public + constructor Create; virtual; + destructor Destroy; override; + + property Items: TDeclarationList read fItems; + end; + +implementation + +uses + CastaliaPasLexTypes; + +procedure TDeclarationStack.Push(Item: TDeclaration); +begin + fItems.Add(Item); + fTop := Item; +end; + +function TDeclarationStack.Pop: TDeclaration; +begin + with fItems do + begin + if (Count > 0) then + Delete(Count - 1); + if (Count > 0) then + fTop := TDeclaration(Items[Count - 1]) + else + fTop := nil; + end; + Result := fTop; +end; + +constructor TDeclarationStack.Create; +begin + fItems := TList.Create; + fTop := nil; +end; + +destructor TDeclarationStack.Destroy; +begin + FreeAndNil(fItems); + + inherited; +end; + +function TDeclarationList.GetItem(Index: Integer): TDeclaration; +begin + Result := TDeclaration(fItems[Index]); +end; + +function TDeclarationList.GetCount: Integer; +begin + Result := fItems.Count; +end; + +procedure TDeclarationList.AddItem(AItem: TDeclaration); +begin + fItems.Add(AItem); +end; + +procedure TDeclarationList.DeleteItem(AItem: TDeclaration); +var + i: Integer; +begin + for i := 0 to fItems.Count - 1 do + if (TDeclaration(fItems[i]) = AItem) then + begin + TDeclaration(fItems[i]).Free; + fItems.Delete(i); + Break; + end; +end; + +function TDeclarationList.GetItemsOfClass(AClass: TDeclarationClass; SubSearch: Boolean = False): TDeclarationArray; + + procedure SearchItem( + AClass: TDeclarationClass; + SubSearch: Boolean; + Item: TDeclaration; + var Res: TDeclarationArray; + var ResIndex: Integer); + var + i: Integer; + begin + if (Item is AClass) then + begin + SetLength(Res, ResIndex + 1); + Res[ResIndex] := Item; + Inc(ResIndex); + end; + if SubSearch then + for i := 0 to Item.Items.Count - 1 do + SearchItem(AClass, SubSearch, Item.Items[i], Res, ResIndex); + end; + +var + i, l: Integer; +begin + l := 0; + SetLength(Result, 0); + + for i := 0 to fItems.Count - 1 do + SearchItem(AClass, SubSearch, TDeclaration(fItems[i]), Result, l); +end; + +function TDeclarationList.GetFirstItemOfClass(AClass: TDeclarationClass; SubSearch: Boolean = False): TDeclaration; + + function SearchItem(AClass: TDeclarationClass; SubSearch: Boolean; Item: TDeclaration; out Res: TDeclaration): Boolean; + var + i: Integer; + begin + Result := False; + if (Item is AClass) then + begin + Res := Item; + Result := True; + Exit; + end; + if SubSearch then + for i := 0 to Item.Items.Count - 1 do + if SearchItem(AClass, SubSearch, Item.Items[i], Res) then + begin + Result := True; + Break; + end; + end; + +var + i: Integer; +begin + Result := nil; + for i := 0 to fItems.Count - 1 do + SearchItem(AClass, SubSearch, TDeclaration(fItems[i]), Result); +end; + +function TDeclarationList.GetItemsInPos(AStart, AEnd: Integer; SubSearch: Boolean = False): TDeclarationArray; + + procedure SearchItem( + AStart, AEnd: Integer; + SubSearch: Boolean; + Item: TDeclaration; + var Res: TDeclarationArray; + var ResIndex: Integer); + var + i: Integer; + b: Boolean; + begin + b := False; + if (AStart >= Item.StartPos) and (AEnd <= Item.EndPos) then + begin + SetLength(Res, ResIndex + 1); + Res[ResIndex] := Item; + Inc(ResIndex); + b := True; + end; + if SubSearch and b then + for i := 0 to Item.Items.Count - 1 do + SearchItem(AStart, AEnd, SubSearch, Item.Items[i], Res, ResIndex); + end; + +var + i, l: Integer; +begin + l := 0; + SetLength(Result, 0); + + for i := 0 to fItems.Count - 1 do + SearchItem(AStart, AEnd, SubSearch, TDeclaration(fItems[i]), Result, l); +end; + +function TDeclarationList.GetItemInPos(AStart, AEnd: Integer; SubSearch: Boolean = False): TDeclaration; + + function SearchItem(AStart, AEnd: Integer; SubSearch: Boolean; Item: TDeclaration; out Res: TDeclaration): Boolean; + var + i: Integer; + b: Boolean; + begin + Result := False; + b := (AStart >= Item.StartPos) and (AEnd <= Item.EndPos); + if b and ((Item.Items.Count < 1) or (not SubSearch)) then + begin + Res := Item; + Result := True; + Exit; + end; + if SubSearch and b then + for i := 0 to Item.Items.Count - 1 do + if SearchItem(AStart, AEnd, SubSearch, Item.Items[i], Res) then + begin + Result := True; + Break; + end; + if b and (not Result) then + begin + Res := Item; + Result := True; + end; + end; + +var + i: Integer; +begin + Result := nil; + for i := 0 to fItems.Count - 1 do + SearchItem(AStart, AEnd, SubSearch, TDeclaration(fItems[i]), Result); +end; + +procedure TDeclarationList.Clear; +var + i: Integer; +begin + for i := 0 to fItems.Count - 1 do + if (Assigned(fItems[i])) then + TDeclaration(fItems[i]).Free; + fItems.Clear; +end; + +constructor TDeclarationList.Create; +begin + fItems := TList.Create; +end; + +destructor TDeclarationList.Destroy; +begin + Clear; + + FreeAndNil(fItems); + inherited; +end; + +function TDeclaration.GetRawText: string; +begin + Result := ''; + if (fRawText <> '') then + Result := fRawText + else if (fStartPos <> fEndPos) and (fOrigin <> nil) then + begin + SetString(fRawText, fOrigin + fStartPos, fEndPos - fStartPos); + Result := fRawText; + end; +end; + +function TDeclaration.GetCleanText: string; +var + i: Integer; + a: TDeclarationArray; +begin + Result := ''; + if (fCleanText <> '') then + Result := fCleanText + else if (fStartPos <> fEndPos) and (fOrigin <> nil) then + begin + fCleanText := RawText; + a := Items.GetItemsOfClass(TciJunk, True); + for i := High(a) downto 0 do + begin + Delete(fCleanText, a[i].StartPos - fStartPos + 1, a[i].EndPos - a[i].StartPos); + if (Pos(LineEnding, a[i].GetRawText) > 0) then + Insert(LineEnding, fCleanText, a[i].StartPos - fStartPos + 1) + else + Insert(' ', fCleanText, a[i].StartPos - fStartPos + 1); + end; + Result := fCleanText; + end; +end; + +function TDeclaration.GetShortText: string; +begin + if (fShortText = '') then + fShortText := CompressWhiteSpace(CleanText); + Result := fShortText; +end; + +function TDeclaration.HasOwnerClass(AClass: TDeclarationClass; out Declaration: TDeclaration; Recursive: Boolean = False): Boolean; + + function IsOwner(Item: TDeclaration; AClass: TDeclarationClass; out Decl: TDeclaration; Recursive: Boolean): Boolean; + begin + if (Item.Owner is AClass) then + begin + Result := True; + Decl := Item.Owner; + end + else if (Item.Owner <> nil) and Recursive then + Result := IsOwner(Item.Owner, AClass, Decl, True) + else + Result := False; + end; + +begin + Declaration := nil; + if (AClass = nil) then + Result := True + else + Result := IsOwner(Self, Aclass, Declaration, Recursive); +end; + +function TDeclaration.GetOwnersOfClass(AClass: TDeclarationClass): TDeclarationArray; + + procedure IsOwner( + AClass: TDeclarationClass; + Item: TDeclaration; + var Res: TDeclarationArray; + var ResIndex: Integer); + begin + if (Item.Owner is AClass) then + begin + SetLength(Res, ResIndex + 1); + Res[ResIndex] := Item.Owner; + Inc(ResIndex); + end; + if (Item.Owner <> nil) then + IsOwner(AClass, Item.Owner, Res, ResIndex); + end; + +var + l: Integer; +begin + l := 0; + SetLength(Result, 0); + + IsOwner(AClass, Self, Result, l); +end; + +constructor TDeclaration.Create(AParser: TmwSimplePasPar; AOwner: TDeclaration; AOrigin: PAnsiChar; AStart, AEnd: Integer); +begin + fParser := AParser; + fOwner := AOwner; + fOrigin := AOrigin; + fRawText := ''; + fCleanText := ''; + fStartPos := AStart; + if (AEnd > -1) then + fEndPos := AEnd + else + fEndPos := AStart; + + fItems := TDeclarationList.Create; +end; + +constructor TDeclaration.Create(AssignFrom: TDeclaration); +begin + if (AssignFrom <> nil) then + Create(AssignFrom.Parser, AssignFrom.Owner, AssignFrom.Origin, AssignFrom.StartPos, AssignFrom.EndPos) + else + Create(nil, nil, nil, -1); +end; + +destructor TDeclaration.Destroy; +begin + FreeAndNil(fItems); + + inherited; +end; + +function TciStruct.GetShortText: string; +begin + if (fShortText = '') then + fShortText := GetFirstWord(CleanText); + Result := fShortText; +end; + +function TciStruct.HasField(Name: string; out Decl: TDeclaration; Return: TVarBase = vbName): Boolean; +var + a, b: TDeclarationArray; + i, ii: Integer; +begin + Result := False; + Name := PrepareString(Name); + + a := fItems.GetItemsOfClass(TciClassField); + for i := Low(a) to High(a) do + begin + b := a[i].Items.GetItemsOfClass(TciFieldName); + for ii := Low(b) to High(b) do + begin + if (PrepareString(b[ii].CleanText) = Name) then + begin + Result := True; + if (Return = vbType) then + Decl := b[ii].Owner.Items.GetFirstItemOfClass(TciTypeKind) + else + Decl := b[ii]; + Exit; + end; + end; + end; + + a := fItems.GetItemsOfClass(TciClassProperty); + for i := Low(a) to High(a) do + begin + b := a[i].Items.GetItemsOfClass(TciFieldName); + for ii := Low(b) to High(b) do + begin + if (PrepareString(b[ii].CleanText) = Name) then + begin + Result := True; + if (Return = vbType) then + Decl := b[ii].Owner.Items.GetFirstItemOfClass(TciTypeKind) + else + Decl := b[ii]; + Exit; + end; + end; + end; + + a := fItems.GetItemsOfClass(TciClassMethodHeading); + for i := Low(a) to High(a) do + begin + b := a[i].Items.GetItemsOfClass(TciProcedureName); + for ii := Low(b) to High(b) do + if (PrepareString(b[ii].CleanText) = Name) then + begin + Result := True; + if (Return = vbType) then + Decl := b[ii].Owner + else + Decl := b[ii]; + Exit; + end; + end; +end; + +function TciStruct.GetDefault(Return: TVarBase = vbName): TDeclaration; +var + d: TDeclaration; +begin + Result := nil; + d := fItems.GetFirstItemOfClass(TciPropertyDefault, True); + if (d <> nil) then + if (Return = vbType) then + Result := d.Owner.Items.GetFirstItemOfClass(TciTypeKind) + else + Result := d.Owner.Items.GetFirstItemOfClass(TciFieldName) +end; + +function TciTypeKind.GetShortText: string; +var + d: TDeclaration; +begin + if (fShortText = '') then + begin + d := GetRealType; + if (d = nil) or (not (d is TciStruct)) then + fShortText := CompressWhiteSpace(CleanText) + else + fShortText := CompressWhiteSpace(StringReplace(CleanText, d.CleanText, GetFirstWord(d.CleanText), [])); + end; + Result := fShortText; +end; + +function TciTypeKind.GetRealType(var ArrayCount: Integer): TDeclaration; +var + d, t: TDeclaration; +begin + d := Self; + while (d <> nil) do + begin + if (d.Items.Count > 0) then + begin + d := d.Items[0]; + if (d is TciArrayType) then + begin + d := d.Items.GetFirstItemOfClass(TciTypeKind); + Inc(ArrayCount); + Continue; + end; + + if (d is TciProceduralType) then + begin + t := d.Items.GetFirstItemOfClass(TciReturnType); + if (t <> nil) then + begin + d := t; + Continue; + end + else + Break; + end; + + if (d is TciTypeKind) then + Continue; + end; + + Break; + end; + + Result := d; +end; + +function TciTypeKind.GetRealType: TDeclaration; +var + a: Integer; +begin + Result := GetRealType(a); +end; + +function TciProcedureDeclaration.GetProcType: string; +var + s: string; +begin + if (fProcType = '') then + begin + s := CleanText; + fProcType := GetFirstWord(s); + if (LowerCase(fProcType) = 'class') then + begin + Delete(s, 1, 6); + fProcType := GetFirstWord(s); + end; + end; + + Result := fProcType; +end; + +function TciProcedureDeclaration.GetParams: string; +var + i: Integer; + a: TDeclarationArray; +begin + Result := ''; + if (fParams <> '') then + Result := fParams + else if (fItems.Count > 0) then + begin + a := GetParamDeclarations; + for i := Low(a) to High(a) do + if (fParams <> '') then + fParams := fParams + '; ' + a[i].ShortText + else + fParams := fParams + a[i].ShortText; + Result := fParams; + end; +end; + +function TciProcedureDeclaration.GetSynParams: string; +var + i, ii: Integer; + a, b: TDeclarationArray; + d: TDeclaration; + s, t: string; +begin + Result := ''; + if (fSynParams <> '') then + Result := fSynParams + else if (fItems.Count > 0) then + begin + a := GetParamDeclarations; + for i := Low(a) to High(a) do + begin + if (fItems[i] is TciConstParameter) then + s := 'const ' + else if (fItems[i] is TciOutParameter) then + s := 'out ' + else if (fItems[i] is TciInParameter) then + s := 'in ' + else if (fItems[i] is TciVarParameter) then + s := 'var ' + else + s := ''; + + d := a[i].Items.GetFirstItemOfClass(TciParameterType); + if (d <> nil) then + t := ': ' + d.ShortText + else + t := ''; + b := a[i].Items.GetItemsOfClass(TciParameterName); + for ii := Low(b) to High(b) do + begin + if (fSynParams <> '') then + fSynParams := fSynParams + ';","' + s + b[ii].ShortText + t + else + fSynParams := '"' + s + b[ii].ShortText + t; + end; + end; + if (fSynParams <> '') then + fSynParams := fSynParams + '"'; + Result := fSynParams; + end; +end; + +function TciProcedureDeclaration.GetShortText: string; +begin + if (fShortText = '') then + fShortText := ProcType; + Result := fShortText; +end; + +function TciProcedureDeclaration.GetParamDeclarations: TDeclarationArray; +var + i: Integer; +begin + SetLength(Result, 0); + + for i := 0 to fItems.Count - 1 do + if (fItems[i] is TciConstParameter) or + (fItems[i] is TciOutParameter) or + (fItems[i] is TciFormalParameter) or + (fItems[i] is TciInParameter) or + (fItems[i] is TciVarParameter) then + begin + SetLength(Result, Length(Result) + 1); + Result[High(Result)] := fItems[i]; + end; +end; + +function TCodeParser.InDeclaration(AClass: TDeclarationClass): Boolean; +begin + if (fStack.Top = nil) then + Result := (AClass = nil) + else + Result := (fStack.Top is AClass); +end; + +function TCodeParser.InDeclarations(AClassArray: array of TDeclarationClass): Boolean; +var + i: Integer; + t: TDeclaration; +begin + Result := False; + t := fStack.Top; + if (t = nil) then + begin + for i := Low(AClassArray) to High(AClassArray) do + if (AClassArray[i] = nil) then + begin + Result := True; + Break; + end; + Exit; + end; + for i := Low(AClassArray) to High(AClassArray) do + if (t is AClassArray[i]) then + begin + Result := True; + Break; + end; +end; + +procedure TCodeParser.PushStack(AClass: TDeclarationClass; AStart: Integer = -1); +var + t: TDeclaration; +begin + if (AStart = -1) then + AStart := Lexer.TokenPos; + t := AClass.Create(Self, fStack.Top, Lexer.Origin, AStart); + if (fStack.Top <> nil) then + fStack.Top.Items.AddItem(t) + else + fItems.AddItem(t); + fStack.Push(t); +end; + +procedure TCodeParser.PopStack(AEnd: Integer = -1); +begin + if (AEnd = -1) then + AEnd := Lexer.TokenPos; + if (fStack.Top <> nil) then + fStack.Top.EndPos := AEnd; + fStack.Pop; +end; + +constructor TCodeParser.Create; +begin + inherited; + + fStack := TDeclarationStack.Create; + fItems := TDeclarationList.Create; + + Lexer.OnIncludeDirect := {$IFDEF FPC}@{$ENDIF}OnInclude; + Lexer.OnDefineDirect := {$IFDEF FPC}@{$ENDIF}OnDirect; + Lexer.OnElseDirect := {$IFDEF FPC}@{$ENDIF}OnDirect; + Lexer.OnEndIfDirect := {$IFDEF FPC}@{$ENDIF}OnDirect; + Lexer.OnIfDefDirect := {$IFDEF FPC}@{$ENDIF}OnDirect; + Lexer.OnIfNDefDirect := {$IFDEF FPC}@{$ENDIF}OnDirect; + Lexer.OnUnDefDirect := {$IFDEF FPC}@{$ENDIF}OnDirect; + Lexer.OnIfDirect := {$IFDEF FPC}@{$ENDIF}OnDirect; + Lexer.OnIfEndDirect := {$IFDEF FPC}@{$ENDIF}OnDirect; + Lexer.OnElseIfDirect := {$IFDEF FPC}@{$ENDIF}OnDirect; +end; + +destructor TCodeParser.Destroy; +begin + FreeAndNil(fStack); + FreeAndNil(fItems); + + inherited; +end; + +procedure TCodeParser.ParseFile; +begin + SkipJunk; + case GenID of + TokLibrary: + begin + LibraryFile; + end; + TokPackage: + begin + PackageFile; + end; + TokUnit: + begin + UnitFile; + end; + else + begin + if (Lexer.GenID = TokProgram) then + begin + Expected(TokProgram); + QualifiedIdentifier; + if TokenID = TokRoundOpen then + begin + NextToken; + IdentifierList; + Expected(TokRoundClose); + end; + SEMICOLON; + end; + if (TokenID = TokUses) then + MainUsesClause; + + while TokenID in [TokClass, TokConst, TokConstructor, TokDestructor, TokExports, + TokFunction, TokLabel, TokProcedure, TokResourceString, TokThreadVar, TokType, + TokVar{$IFDEF D8_NEWER}, TokSquareOpen{$ENDIF}] do + begin + DeclarationSection; + end; + + if (TokenID = TokBegin) then + begin + CompoundStatement; + Expected(TokPoint); + end; + end; + end; +end; + +procedure TCodeParser.OnInclude(Sender: TmwBasePasLex); +begin + if (not Sender.IsJunk) then + begin + PushStack(TciInclude, Sender.TokenPos); + fStack.Top.RawText := Sender.DirectiveParam; + PopStack(Sender.TokenPos + Sender.TokenLen); + end; + + Sender.Next; +end; + +procedure TCodeParser.UsedUnitName; +begin + PushStack(TciUsedUnit); + inherited; + PopStack; +end; + +procedure TCodeParser.NextToken; +var + ValidJunk: Boolean; +begin + ValidJunk := False; + Lexer.Next; + if Lexer.IsJunk and (not InDeclaration(TciJunk)) then + begin + if (not InDeclaration(nil)) then + PushStack(TciJunk); + while (Lexer.IsJunk) do + begin + if (not (Lexer.TokenID in [TokCRLF, TokCRLFCo, TokSpace])) then + ValidJunk := True; + Lexer.Next; + end; + if InDeclaration(TciJunk) then + begin + if ValidJunk then + PopStack + else + begin + if (fStack.Top.Owner <> nil) then + fStack.Top.Owner.Items.DeleteItem(fStack.Top) + else + fStack.Top.Free; + fStack.Pop; + end; + end; + end; +end; + +procedure TCodeParser.OnDirect(Sender: TmwBasePasLex); +begin + if (Sender.TokenID = TokElseDirect) then + begin + Sender.Next; + Exit; + end; + if InDeclaration(TciJunk) then + Exit; + if (not InDeclaration(nil)) then + PushStack(TciJunk, Sender.TokenPos); + + if (not (Sender.TokenID in [TokEndIfDirect, TokIfEndDirect])) then + if Sender = Lexer then + NextToken + else + Sender.Next; + + if InDeclaration(TciJunk) then + PopStack(Sender.TokenPos + Sender.TokenLen); +end; + +procedure TCodeParser.CompoundStatement; +begin + if (not InDeclarations([nil, TciProcedureDeclaration, TciWithStatement])) then + begin + inherited; + Exit; + end; + + PushStack(TciCompoundStatement); + inherited; + PopStack; +end; + +procedure TCodeParser.WithStatement; +begin + if (not InDeclarations([TciProcedureDeclaration, TciCompoundStatement])) then + begin + inherited; + Exit; + end; + + PushStack(TciWithStatement); + inherited; + PopStack; +end; + +procedure TCodeParser.SimpleStatement; +begin + if (not InDeclaration(TciWithStatement)) then + begin + inherited; + Exit; + end; + + PushStack(TciSimpleStatement); + inherited; + PopStack; +end; + +procedure TCodeParser.Variable; +begin + if (not InDeclaration(TciWithStatement)) then + begin + inherited; + Exit; + end; + + PushStack(TciVariable); + inherited; + PopStack; +end; + +procedure TCodeParser.TypeKind; +var + n: Boolean; +begin + if (not InDeclarations([TciVarDeclaration, TciConstantDeclaration, TciTypeDeclaration, TciArrayType, TciClassField])) then + begin + inherited; + Exit; + end; + + n := (InDeclaration(TciArrayType)) and (TokenID = tokConst); + PushStack(TciTypeKind); + if n then + NextToken + else + inherited; + PopStack; +end; + +procedure TCodeParser.TypedConstant; +begin + if (not InDeclarations([TciVarDeclaration, TciConstParameter, TciOutParameter, TciFormalParameter, TciInParameter, TciVarParameter])) then + begin + inherited; + Exit; + end; + + PushStack(TciTypedConstant); + inherited; + PopStack; +end; + +procedure TCodeParser.Expression; +begin + if (not InDeclarations([TciVarDeclaration, TciConstantDeclaration, TciOrdinalType])) then + begin + inherited; + Exit; + end; + + PushStack(TciExpression); + inherited; + PopStack; +end; + +procedure TCodeParser.ProceduralType; +begin + if (not InDeclaration(TciTypeKind)) then + begin + inherited; + Exit; + end; + + PushStack(TciProceduralType); + inherited; + PopStack; +end; + +procedure TCodeParser.TypeDeclaration; +begin + PushStack(TciTypeDeclaration); + inherited; + PopStack; +end; + +procedure TCodeParser.TypeName; +begin + if (not InDeclaration(TciTypeDeclaration)) then + Exit; + PushStack(TciTypeName); + inherited; + PopStack; +end; + +procedure TCodeParser.VarDeclaration; +begin + PushStack(TciVarDeclaration); + inherited; + PopStack; +end; + +procedure TCodeParser.VarName; +begin + if (not InDeclaration(TciVarDeclaration)) then + Exit; + PushStack(TciVarName); + inherited; + PopStack; +end; + +procedure TCodeParser.ConstantDeclaration; +begin + PushStack(TciConstantDeclaration); + inherited; + PopStack; +end; + +procedure TCodeParser.ConstantName; +begin + if (not InDeclaration(TciConstantDeclaration)) then + begin + inherited; + Exit; + end; + + PushStack(TciConstantName); + inherited; + PopStack; +end; + +procedure TCodeParser.LabelDeclarationSection; +begin + PushStack(TciLabelDeclaration); + inherited; + PopStack; +end; + +procedure TCodeParser.LabelId; +begin + if (not InDeclaration(TciLabelDeclaration)) then + begin + inherited; + Exit; + end; + + PushStack(TciLabelName); + inherited; + PopStack; +end; + +procedure TCodeParser.ProcedureDeclarationSection; +begin + PushStack(TciProcedureDeclaration); + inherited; + PopStack; +end; + +procedure TCodeParser.FunctionProcedureName; +begin + if (not InDeclaration(TciProcedureDeclaration)) then + begin + inherited; + Exit; + end; + + PushStack(TciProcedureName); + inherited; + PopStack; +end; + +procedure TCodeParser.ObjectNameOfMethod; +begin + if (not InDeclaration(TciProcedureDeclaration)) then + begin + inherited; + Exit; + end; + + PushStack(TciProcedureClassName); + inherited; + PopStack; +end; + +procedure TCodeParser.ReturnType; +begin + if (not InDeclarations([TciProcedureDeclaration, TciProceduralType, TciClassMethodHeading])) then + begin + inherited; + Exit; + end; + + PushStack(TciReturnType); + //inherited; + TypeKind; + PopStack; +end; + +procedure TCodeParser.ForwardDeclaration; +begin + if (not InDeclaration(TciProcedureDeclaration)) then + begin + inherited; + Exit; + end; + + PushStack(TciForward); + inherited; + PopStack; +end; + +procedure TCodeParser.ConstParameter; +begin + if (not InDeclarations([TciProcedureDeclaration, TciProceduralType, TciClassMethodHeading])) then + begin + inherited; + Exit; + end; + + PushStack(TciConstParameter); + inherited; + PopStack; +end; + +procedure TCodeParser.OutParameter; +begin + if (not InDeclarations([TciProcedureDeclaration, TciProceduralType, TciClassMethodHeading])) then + begin + inherited; + Exit; + end; + + PushStack(TciOutParameter); + inherited; + PopStack; +end; + +procedure TCodeParser.ParameterFormal; +begin + if (not InDeclarations([TciProcedureDeclaration, TciProceduralType, TciClassMethodHeading])) then + begin + inherited; + Exit; + end; + + PushStack(TciFormalParameter); + inherited; + PopStack; +end; + +procedure TCodeParser.InParameter; +begin + if (not InDeclarations([TciProcedureDeclaration, TciProceduralType, TciClassMethodHeading])) then + begin + inherited; + Exit; + end; + + PushStack(TciInParameter); + inherited; + PopStack; +end; + +procedure TCodeParser.VarParameter; +begin + if (not InDeclarations([TciProcedureDeclaration, TciProceduralType, TciClassMethodHeading])) then + begin + inherited; + Exit; + end; + + PushStack(TciVarParameter); + inherited; + PopStack; +end; + +procedure TCodeParser.ParameterName; +begin + if (not InDeclarations([TciConstParameter, TciOutParameter, TciFormalParameter, TciInParameter, TciVarParameter])) then + begin + inherited; + Exit; + end; + + PushStack(TciParameterName); + inherited; + PopStack; +end; + +procedure TCodeParser.NewFormalParameterType; +begin + if (not InDeclarations([TciConstParameter, TciOutParameter, TciFormalParameter, TciInParameter, TciVarParameter])) then + begin + inherited; + Exit; + end; + + PushStack(TciParameterType); + //inherited; + TypeKind; + PopStack; +end; + +procedure TCodeParser.ArrayType; +begin + PushStack(TciArrayType); + inherited; + PopStack; +end; + +procedure TCodeParser.ArrayConstant; +begin + if (not InDeclaration(TciTypedConstant)) then + begin + inherited; + Exit; + end; + + PushStack(TciArrayConstant); + inherited; + PopStack; +end; + +procedure TCodeParser.RecordType; +begin + PushStack(TciRecordType); + inherited; + PopStack; +end; + +procedure TCodeParser.ClassField; +begin + if (not InDeclarations([TciRecordType, TciClassType])) then + begin + inherited; + Exit; + end; + + PushStack(TciClassField); + inherited; + PopStack; +end; + +procedure TCodeParser.FieldName; +begin + if (not InDeclaration(TciClassField)) then + begin + inherited; + Exit; + end; + + PushStack(TciFieldName); + inherited; + PopStack; +end; + +procedure TCodeParser.RecordConstant; +begin + if (not InDeclarations([TciTypedConstant, TciArrayConstant])) then + begin + inherited; + Exit; + end; + + PushStack(TciRecordConstant); + inherited; + PopStack; +end; + +procedure TCodeParser.RecordFieldConstant; +begin + if (not InDeclaration(TciRecordConstant)) then + begin + inherited; + Exit; + end; + + PushStack(TciRecordFieldConstant); + inherited; + PopStack; +end; + +procedure TCodeParser.ClassType; +begin + PushStack(TciClassType); + inherited; + PopStack; +end; + +procedure TCodeParser.AncestorId; +begin + if (not InDeclaration(TciClassType)) then + begin + inherited; + Exit; + end; + + PushStack(TciAncestorID); + inherited; + PopStack; +end; + +procedure TCodeParser.ClassMethodHeading; +begin + if (not InDeclarations([TciRecordType, TciClassType])) then + begin + inherited; + Exit; + end; + + PushStack(TciClassMethodHeading); + inherited; + PopStack; +end; + +procedure TCodeParser.ConstructorName; +begin + if (not InDeclaration(TciClassMethodHeading)) then + begin + inherited; + Exit; + end; + + PushStack(TciProcedureName); + inherited; + PopStack; +end; + +procedure TCodeParser.DestructorName; +begin + if (not InDeclaration(TciClassMethodHeading)) then + begin + inherited; + Exit; + end; + + PushStack(TciProcedureName); + inherited; + PopStack; +end; + +procedure TCodeParser.FunctionMethodName; +begin + if (not InDeclaration(TciClassMethodHeading)) then + begin + inherited; + Exit; + end; + + PushStack(TciProcedureName); + inherited; + PopStack; +end; + +procedure TCodeParser.ProcedureMethodName; +begin + if (not InDeclaration(TciClassMethodHeading)) then + begin + inherited; + Exit; + end; + + PushStack(TciProcedureName); + inherited; + PopStack; +end; + +procedure TCodeParser.ClassProperty; +begin + if (not InDeclarations([TciRecordType, TciClassType])) then + begin + inherited; + Exit; + end; + + PushStack(TciClassProperty); + inherited; + PopStack; +end; + +procedure TCodeParser.PropertyName; +begin + if (not InDeclaration(TciClassProperty)) then + begin + inherited; + Exit; + end; + + PushStack(TciFieldName); + inherited; + PopStack; +end; + +procedure TCodeParser.TypeId; +begin + if (not InDeclaration(TciClassProperty)) then + begin + inherited; + Exit; + end; + + PushStack(TciTypeKind); + inherited; + PopStack; +end; + +procedure TCodeParser.PropertyDefault; +begin + if (not InDeclaration(TciClassProperty)) then + begin + inherited; + Exit; + end; + + PushStack(TciPropertyDefault); + inherited; + PopStack; +end; + +procedure TCodeParser.SetType; +begin + PushStack(TciSetType); + inherited; + PopStack; +end; + +procedure TCodeParser.OrdinalType; +begin + if (not InDeclarations([TciSetType, TciArrayType])) then + begin + inherited; + Exit; + end; + + PushStack(TciOrdinalType); + inherited; + PopStack; +end; + +procedure TCodeParser.EnumeratedType; +begin + PushStack(TciEnumType); + inherited; + PopStack; +end; + +procedure TCodeParser.QualifiedIdentifier; +begin + if (not InDeclarations([TciEnumType])) then + begin + inherited; + Exit; + end; + + PushStack(TciQualifiedIdentifier); + inherited; + PopStack; +end; + +end.