mirror of
https://github.com/moparisthebest/Simba
synced 2024-11-05 17:05:19 -05:00
Merge branch 'master' of ssh://villavu.com:54367/simba
Conflicts: Projects/SAMufasaGUI/ValistusDefines.inc Projects/SAMufasaGUI/v_autocompleteform.pas
This commit is contained in:
Merlijn Wajer
commit
edb2b2194d
2882
Projects/SAMufasaGUI/CastaliaPasLex.pas
Normal file
2882
Projects/SAMufasaGUI/CastaliaPasLex.pas
Normal file
File diff suppressed because it is too large
Load Diff
322
Projects/SAMufasaGUI/CastaliaPasLexTypes.pas
Normal file
322
Projects/SAMufasaGUI/CastaliaPasLexTypes.pas
Normal file
@ -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.
|
||||
|
||||
5955
Projects/SAMufasaGUI/CastaliaSimplePasPar.pas
Normal file
5955
Projects/SAMufasaGUI/CastaliaSimplePasPar.pas
Normal file
File diff suppressed because it is too large
Load Diff
330
Projects/SAMufasaGUI/CastaliaSimplePasParTypes.pas
Normal file
330
Projects/SAMufasaGUI/CastaliaSimplePasParTypes.pas
Normal file
@ -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.
|
||||
|
||||
343
Projects/SAMufasaGUI/PSDump.pas
Normal file
343
Projects/SAMufasaGUI/PSDump.pas
Normal file
@ -0,0 +1,343 @@
|
||||
{
|
||||
@abstract(Component wrapper for IFPS3 compiler and executer)
|
||||
A component wrapper for IFPS3, including debugging support.
|
||||
|
||||
}
|
||||
//{$I PascalScript.inc}
|
||||
|
||||
unit PSDump;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
{$IFNDEF LINUX} Windows, {$ENDIF} SysUtils, Classes, uPSRuntime, uPSUtils, uPSComponent,
|
||||
uPSCompiler, uPSC_dll, typInfo;
|
||||
|
||||
type
|
||||
TPSOnCompCleanup = function (Sender: TObject; aComp: TPSPascalCompiler): Boolean of object;
|
||||
TPSOnException = procedure (Sender: TPSExec; ExError: TPSError; const ExParam: tbtstring; ExObject: TObject; ProcNo, Position: Cardinal) of object;
|
||||
|
||||
TPSScriptExtension = class(TPSScriptDebugger)
|
||||
private
|
||||
FOnBeforeCleanUp: TPSOnCompCleanup;
|
||||
FNeedCompiling: Boolean;
|
||||
FOnScriptChange: TNotifyEvent;
|
||||
FOnException: TPSOnException;
|
||||
fItems: TStrings;
|
||||
|
||||
procedure GetCodeProps;
|
||||
protected
|
||||
function DoBeforeCleanup(Sender: TObject; aComp: TPSPascalCompiler):Boolean;
|
||||
procedure DoScriptChange(sender:TObject);
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
function Compile: Boolean; override;
|
||||
function Execute: Boolean; override;
|
||||
procedure GetValueDefs(aItems: TStrings);
|
||||
procedure CompileIfNeeded;
|
||||
|
||||
property NeedCompiling : Boolean read FNeedCompiling;
|
||||
published
|
||||
property OnBeforeCleanUp: TPSOnCompCleanup read FOnBeforeCleanUp write FOnBeforeCleanUp;
|
||||
Property OnScriptChange: TNotifyEvent read FOnScriptChange write fOnScriptChange;
|
||||
property OnException: TPSOnException read FOnException write FOnException;
|
||||
end;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
function BeforeCleanup(Sender: TPSPascalCompiler): Boolean;
|
||||
begin
|
||||
Result := TPSScriptExtension(Sender.ID).DoBeforeCleanUp(TObject(Sender.ID),Sender);
|
||||
end;
|
||||
|
||||
procedure CEException(Sender: TPSExec; ExError: TIFError; const ExParam: tbtstring; ExObject: TObject; ProcNo, Position: Cardinal);
|
||||
begin
|
||||
if (@TPSScriptExtension(Sender.ID).FOnException <> nil) then
|
||||
TPSScriptExtension(Sender.ID).FOnException(Sender, ExError, ExParam, ExObject, ProcNo, Position);
|
||||
end;
|
||||
|
||||
{ TPSScriptExtension }
|
||||
|
||||
function TPSScriptExtension.Compile: Boolean;
|
||||
begin
|
||||
Result := inherited Compile;
|
||||
FNeedCompiling := not result;
|
||||
end;
|
||||
|
||||
constructor TPSScriptExtension.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
Comp.OnBeforeCleanup := {$IFDEF FPC}@{$ENDIF}BeforeCleanup;
|
||||
Exec.OnException := {$IFDEF FPC}@{$ENDIF}CEException;
|
||||
|
||||
TStringList(script).OnChange := {$IFDEF FPC}@{$ENDIF}DoScriptChange;
|
||||
FNeedCompiling := True;
|
||||
end;
|
||||
|
||||
type
|
||||
_TMyPascalCompiler = class(TPSPascalCompiler);
|
||||
procedure TPSScriptExtension.GetCodeProps;
|
||||
|
||||
function TypeToString(t: TPSType; Definition: Boolean = False): string; forward;
|
||||
|
||||
function FunctionType(f: TObject): string;
|
||||
const
|
||||
FuncStr: array[Boolean] of string = ('procedure', 'function');
|
||||
begin
|
||||
if (f is TPSDelphiClassItemConstructor) then
|
||||
Result := 'constructor'
|
||||
else if (f is TPSDelphiClassItemMethod) then
|
||||
Result := FuncStr[TPSDelphiClassItemMethod(f).Decl.Result <> nil]
|
||||
else if (f is TPSProceduralType) then
|
||||
Result := FuncStr[TPSProceduralType(f).ProcDef.Result <> nil]
|
||||
else if (f is TPSRegProc) then
|
||||
Result := FuncStr[TPSRegProc(f).Decl.Result <> nil]
|
||||
else if (f is TPSInternalProcedure) then
|
||||
Result := FuncStr[TPSInternalProcedure(f).Decl.Result <> nil]
|
||||
else
|
||||
Result := '';
|
||||
end;
|
||||
|
||||
function ParamsToString(d: TPSParametersDecl; CheckResult: Boolean = True): string;
|
||||
const
|
||||
ParamStr: array [pmIn..pmInOut] of tbtstring = ('','out ','var ');
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
Result := '';
|
||||
for i := 0 to d.ParamCount - 1 do
|
||||
begin
|
||||
if (Result <> '') then
|
||||
Result := Result + '; ';
|
||||
Result := Result + ParamStr[d.Params[i].Mode] + d.Params[i].OrgName;
|
||||
if (d.Params[i].aType <> nil) then
|
||||
Result := Result +': '+ TypeToString(d.Params[i].aType);
|
||||
end;
|
||||
|
||||
if (Result <> '') then
|
||||
Result := '('+Result+')';
|
||||
if CheckResult and (d.Result <> nil) then
|
||||
Result := Result + ': ' + TypeToString(d.Result);
|
||||
end;
|
||||
|
||||
function ClassItemsToString(c: TPSCompileTimeClass; DoneList: TStrings = nil): string;
|
||||
var
|
||||
ci: TPSDelphiClassItem;
|
||||
i, ii: Integer;
|
||||
s: string;
|
||||
Def: Cardinal;
|
||||
ListFree: Boolean;
|
||||
begin
|
||||
Result := '';
|
||||
if (c = nil) then
|
||||
Exit;
|
||||
|
||||
if (DoneList = nil) then
|
||||
begin
|
||||
DoneList := TStringList.Create;
|
||||
TStringList(DoneList).Sorted := True;
|
||||
ListFree := True;
|
||||
end
|
||||
else
|
||||
ListFree := False;
|
||||
|
||||
if (not c.Property_Find('', Def)) then
|
||||
Def := 0;
|
||||
|
||||
for i := 0 to c.Count - 1 do
|
||||
begin
|
||||
ci := c.Items[i];
|
||||
If (ci = nil) or (DoneList.IndexOf(ci.OrgName) > -1) then
|
||||
Continue;
|
||||
DoneList.Add(ci.OrgName);
|
||||
|
||||
if (ci is TPSDelphiClassItemConstructor) or (ci is TPSDelphiClassItemMethod) then
|
||||
Result := Result + FunctionType(ci) + ' ' + ci.OrgName + ParamsToString(ci.Decl, not (ci is TPSDelphiClassItemConstructor)) + '; '
|
||||
else if (ci is TPSDelphiClassItemProperty) then
|
||||
begin
|
||||
s := '';
|
||||
for ii := 0 to ci.Decl.ParamCount - 1 do
|
||||
begin
|
||||
if (s <> '') then
|
||||
s := s + ', ';
|
||||
s := s + 'Index';
|
||||
if (ii > 0) then
|
||||
s := s + IntToStr(ii + 1);
|
||||
s := s + ': ' + TypeToString(ci.Decl.Params[ii].aType);
|
||||
end;
|
||||
if (s <> '') then
|
||||
s := '['+s+']';
|
||||
Result := Result + 'property ' + ci.OrgName + s;
|
||||
if (ci.Decl.Result <> nil) then
|
||||
Result := Result + ': '+ TypeToString(ci.Decl.Result);
|
||||
if (Cardinal(ci) = Def) then
|
||||
Result := Result + '; default';
|
||||
Result := Result + '; ';
|
||||
end;
|
||||
end;
|
||||
|
||||
Result := Result + ClassItemsToString(c.ClassInheritsFrom, DoneList);
|
||||
if ListFree then
|
||||
DoneList.Free;
|
||||
end;
|
||||
|
||||
function TypeToString(t: TPSType; Definition: Boolean = False): string;
|
||||
var
|
||||
r: PIFPSRecordFieldTypeDef;
|
||||
i: Integer;
|
||||
begin
|
||||
if (not Definition) and (t.OriginalName <> '') and (t.OriginalName[1] <> '!') then
|
||||
Result := t.OriginalName
|
||||
else if (t is TPSRecordType) then
|
||||
begin
|
||||
Result := 'record ';
|
||||
for i := 0 to (t as TPSRecordType).RecValCount - 1 do
|
||||
begin
|
||||
r := (t as TPSRecordType).RecVal(i);
|
||||
Result := Result + r.FieldOrgName + ': ' + TypeToString(r.aType) + '; ';
|
||||
end;
|
||||
Result := Result + 'end';
|
||||
end
|
||||
else if (t is TPSClassType) then
|
||||
Result := 'class ' + ClassItemsToString((t as TPSClassType).Cl) + 'end'
|
||||
else if (t is TPSProceduralType) then
|
||||
Result := FunctionType(t) + ParamsToString((t as TPSProceduralType).ProcDef)
|
||||
else if (t is TPSArrayType) then
|
||||
Result := 'array of ' + TypeToString((t as TPSArrayType).ArrayTypeNo)
|
||||
else if (t is TPSStaticArrayType) then
|
||||
with (t as TPSStaticArrayType) do
|
||||
Result := 'array[' + IntToStr(StartOffset) + '..' + IntToStr(StartOffset + Length) + ' of ' + TypeToString(ArrayTypeNo)
|
||||
else if (t is TPSSetType) then
|
||||
Result := 'set of ' + TypeToString((t as TPSSetType).SetType)
|
||||
else if (t is TPSTypeLink) then
|
||||
Result := TypeToString((t as TPSTypeLink).LinkTypeNo)
|
||||
else if (t is TPSEnumType) then
|
||||
begin
|
||||
Result := '';
|
||||
for i := 0 to t.Attributes.Count - 1 do
|
||||
begin
|
||||
if (Result <> '') then
|
||||
Result := Result + ', ';
|
||||
Result := Result + TPSConstant(t.Attributes[i].AType).OrgName;
|
||||
end;
|
||||
|
||||
if (Result <> '') then
|
||||
Result := '('+Result+')'
|
||||
else
|
||||
Result := 'enum';
|
||||
end
|
||||
else
|
||||
Result := t.OriginalName;
|
||||
end;
|
||||
|
||||
function IfRVariantToString(v: TIfRVariant): string;
|
||||
begin
|
||||
case v.FType.BaseType of
|
||||
btU8: Result := IntToStr(v.tu8);
|
||||
btS8: Result := IntToStr(v.ts8);
|
||||
btU16: Result := IntToStr(v.tu16);
|
||||
btS16: Result := IntToStr(v.ts16);
|
||||
btU32: Result := IntToStr(v.tu32);
|
||||
btS32: Result := IntToStr(v.ts32);
|
||||
btSingle: Result := FloatToStr(v.tsingle);
|
||||
btDouble: Result := FloatToStr(v.tdouble);
|
||||
btExtended: Result := FloatToStr(v.textended);
|
||||
btString: Result := tbtString(v.tstring);
|
||||
{$IFNDEF PS_NOINT64}
|
||||
btS64: Result := IntToStr(v.ts64);
|
||||
{$ENDIF}
|
||||
btChar: Result := '#' + IntToStr(Ord(v.tchar));
|
||||
{$IFNDEF PS_NOWIDESTRING}
|
||||
btWideString: Result := tbtwidestring(v.twidestring);
|
||||
btWideChar: Result := '#' + IntToStr(Ord(v.twidechar));
|
||||
{$ENDIF}
|
||||
btCurrency: Result := FloatToStr(v.tcurrency);
|
||||
btUnicodeString: Result := tbtunicodestring(v.tunistring);
|
||||
else
|
||||
Result := v.FType.OriginalName;
|
||||
end;
|
||||
end;
|
||||
|
||||
var
|
||||
i : Integer;
|
||||
begin
|
||||
if (fItems = nil) then
|
||||
Exit;
|
||||
|
||||
fItems.BeginUpdate;
|
||||
try
|
||||
fItems.Clear;
|
||||
|
||||
with _TMyPascalCompiler(Comp) do
|
||||
begin
|
||||
for i := 0 to FConstants.Count - 1 do
|
||||
with TPSConstant(FConstants[i]) do
|
||||
if (Value^.FType is TPSEnumType) then
|
||||
Value^.FType.Attributes.Add(TPSAttributeType(FConstants[i]))
|
||||
else
|
||||
fItems.Add('const ' + OrgName + ' = ' + IfRVariantToString(Value^) + ';');
|
||||
|
||||
for i := 0 to FTypes.Count - 1 do
|
||||
with TPSType(FTypes[i]) do
|
||||
if (OriginalName <> '') and (OriginalName[1] <> '!') then
|
||||
fItems.Add('type ' + OriginalName + ' = ' + TypeToString(TPSType(FTypes[i]), True) + ';');
|
||||
|
||||
for i := 0 to FVars.Count - 1 do
|
||||
with TPSVar(FVars[i]) do
|
||||
fItems.Add('var ' + OrgName + ': ' + TypeToString(TPSType(FVars[i]), True) + ';');
|
||||
|
||||
for i := 0 to FRegProcs.Count - 1 do
|
||||
with TPSRegProc(FRegProcs[i]) do
|
||||
fItems.Add(FunctionType(TObject(FRegProcs[i])) + ' ' + OrgName + ParamsToString(Decl) + '; forward;');
|
||||
|
||||
for i := 0 to FProcs.Count - 1 do
|
||||
if (TPSProcedure(FProcs[i]) is TPSInternalProcedure) then
|
||||
with TPSInternalProcedure(FProcs[i]) do
|
||||
if (Name <> '') and (Name[1] <> '!') then
|
||||
fItems.Add(FunctionType(TObject(FProcs[i])) + ' ' + OriginalName + ParamsToString(Decl) + '; forward;');
|
||||
end;
|
||||
finally
|
||||
fItems.EndUpdate;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TPSScriptExtension.GetValueDefs(aItems: TStrings);
|
||||
begin
|
||||
fItems := aItems;
|
||||
try
|
||||
Compile;
|
||||
finally
|
||||
fItems := nil;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TPSScriptExtension.DoBeforeCleanup(Sender: TObject; aComp: TPSPascalCompiler): Boolean;
|
||||
begin
|
||||
Result := True;
|
||||
if (fItems <> nil) then
|
||||
GetCodeProps;
|
||||
if (@FOnBeforeCleanUp <> nil) then
|
||||
Result := FOnBeforeCleanUp(Sender, aComp);
|
||||
end;
|
||||
|
||||
function TPSScriptExtension.Execute: Boolean;
|
||||
begin
|
||||
CompileIfNeeded;
|
||||
Result := inherited Execute;
|
||||
end;
|
||||
|
||||
procedure TPSScriptExtension.DoScriptChange(sender: TObject);
|
||||
begin
|
||||
FNeedCompiling := True;
|
||||
if (@FOnScriptChange <> nil) then
|
||||
FOnScriptChange(sender);
|
||||
end;
|
||||
|
||||
procedure TPSScriptExtension.CompileIfNeeded;
|
||||
begin
|
||||
if FNeedCompiling then
|
||||
Compile;
|
||||
end;
|
||||
|
||||
end.
|
||||
@ -5,3 +5,7 @@
|
||||
{$DEFINE D10_NEWER}
|
||||
{.$DEFINE D11_NEWER}
|
||||
{.$DEFINE D12_NEWER}
|
||||
|
||||
{$IFDEF FPC}
|
||||
{$H+}
|
||||
{$ENDIF}
|
||||
|
||||
@ -2,6 +2,10 @@ unit v_AutoCompleteForm;
|
||||
|
||||
interface
|
||||
|
||||
{$IFDEF FPC}
|
||||
{$mode objfpc}{$H+}
|
||||
{$ENDIF}
|
||||
|
||||
uses
|
||||
Classes, SysUtils, Forms, Controls, Graphics, Dialogs,
|
||||
StdCtrls, ExtCtrls,
|
||||
|
||||
Loading…
Reference in New Issue
Block a user