1
0
mirror of https://github.com/moparisthebest/Simba synced 2024-11-25 10:42:20 -05:00

Merge branch 'master' of ssh://villavu.com:54367/simba

This commit is contained in:
Raymond 2010-04-25 18:53:49 +02:00
commit bd97c9162c
27 changed files with 101 additions and 15197 deletions

File diff suppressed because it is too large Load Diff

View File

@ -1,322 +0,0 @@
{---------------------------------------------------------------------------
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.

File diff suppressed because it is too large Load Diff

View File

@ -1,330 +0,0 @@
{---------------------------------------------------------------------------
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.

Binary file not shown.

Before

Width:  |  Height:  |  Size: 134 KiB

View File

@ -1,429 +0,0 @@
<?xml version="1.0"?>
<CONFIG>
<ProjectOptions>
<PathDelim Value="\"/>
<Version Value="7"/>
<General>
<Flags>
<UseDefaultCompilerOptions Value="True"/>
</Flags>
<MainUnit Value="0"/>
<TargetFileExt Value=".exe"/>
<ResourceType Value="res"/>
<UseXPManifest Value="True"/>
<Icon Value="0"/>
<ActiveEditorIndexAtStart Value="0"/>
</General>
<VersionInfo>
<Language Value=""/>
<CharSet Value=""/>
<StringTable Comments="" CompanyName="" FileDescription="" FileVersion="" InternalName="" LegalCopyright="" LegalTrademarks="" OriginalFilename="" ProductName="" ProductVersion=""/>
</VersionInfo>
<PublishOptions>
<Version Value="2"/>
<IgnoreBinaries Value="False"/>
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
<ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
<LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
</local>
</RunParams>
<RequiredPackages Count="2">
<Item1>
<PackageName Value="SynEdit"/>
<MinVersion Major="1" Valid="True"/>
</Item1>
<Item2>
<PackageName Value="LCL"/>
</Item2>
</RequiredPackages>
<Units Count="45">
<Unit0>
<Filename Value="Valistus.lpr"/>
<IsPartOfProject Value="True"/>
<UnitName Value="Valistus"/>
<CursorPos X="31" Y="4"/>
<TopLine Value="1"/>
<EditorIndex Value="3"/>
<UsageCount Value="140"/>
<Loaded Value="True"/>
</Unit0>
<Unit1>
<Filename Value="main.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="MainForm"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="Main"/>
<CursorPos X="38" Y="26"/>
<TopLine Value="10"/>
<EditorIndex Value="0"/>
<UsageCount Value="140"/>
<Loaded Value="True"/>
</Unit1>
<Unit2>
<Filename Value="..\v_Constants.pas"/>
<UnitName Value="v_Constants"/>
<UsageCount Value="9"/>
</Unit2>
<Unit3>
<Filename Value="..\v_SynPlugins.pas"/>
<UnitName Value="v_SynPlugins"/>
<UsageCount Value="9"/>
</Unit3>
<Unit4>
<Filename Value="..\v_ideCodeParser.pas"/>
<UnitName Value="v_ideCodeParser"/>
<UsageCount Value="9"/>
</Unit4>
<Unit5>
<Filename Value="..\v_ideCodeInsight.pas"/>
<UnitName Value="v_ideCodeInsight"/>
<UsageCount Value="9"/>
</Unit5>
<Unit6>
<Filename Value="..\v_MiscFunctions.pas"/>
<UnitName Value="v_MiscFunctions"/>
<UsageCount Value="9"/>
</Unit6>
<Unit7>
<Filename Value="v_Constants.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="v_Constants"/>
<CursorPos X="5" Y="7"/>
<TopLine Value="1"/>
<UsageCount Value="140"/>
</Unit7>
<Unit8>
<Filename Value="CastaliaPasLex.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="CastaliaPasLex"/>
<CursorPos X="20" Y="2241"/>
<TopLine Value="2222"/>
<UsageCount Value="140"/>
</Unit8>
<Unit9>
<Filename Value="CastaliaPasLexTypes.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="CastaliaPasLexTypes"/>
<CursorPos X="26" Y="308"/>
<TopLine Value="284"/>
<UsageCount Value="140"/>
</Unit9>
<Unit10>
<Filename Value="CastaliaSimplePasPar.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="CastaliaSimplePasPar"/>
<CursorPos X="40" Y="4617"/>
<TopLine Value="4679"/>
<UsageCount Value="140"/>
</Unit10>
<Unit11>
<Filename Value="CastaliaSimplePasParTypes.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="CastaliaSimplePasParTypes"/>
<CursorPos X="54" Y="10"/>
<TopLine Value="1"/>
<UsageCount Value="140"/>
</Unit11>
<Unit12>
<Filename Value="v_SynPlugins.pas"/>
<UnitName Value="v_SynPlugins"/>
<CursorPos X="15" Y="27"/>
<TopLine Value="8"/>
<UsageCount Value="9"/>
</Unit12>
<Unit13>
<Filename Value="v_ideCodeParser.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="v_ideCodeParser"/>
<CursorPos X="17" Y="208"/>
<TopLine Value="189"/>
<UsageCount Value="140"/>
</Unit13>
<Unit14>
<Filename Value="v_ideCodeInsight.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="v_ideCodeInsight"/>
<CursorPos X="31" Y="19"/>
<TopLine Value="4"/>
<EditorIndex Value="2"/>
<UsageCount Value="140"/>
<Loaded Value="True"/>
</Unit14>
<Unit15>
<Filename Value="v_MiscFunctions.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="v_MiscFunctions"/>
<CursorPos X="27" Y="5"/>
<TopLine Value="1"/>
<UsageCount Value="140"/>
</Unit15>
<Unit16>
<Filename Value="ValistusDefines.inc"/>
<IsPartOfProject Value="True"/>
<CursorPos X="2" Y="2"/>
<TopLine Value="1"/>
<UsageCount Value="140"/>
</Unit16>
<Unit17>
<Filename Value="..\..\..\FPC\Source\rtl\inc\objpash.inc"/>
<CursorPos X="23" Y="192"/>
<TopLine Value="173"/>
<UsageCount Value="7"/>
</Unit17>
<Unit18>
<Filename Value="..\..\..\FPC\Source\rtl\inc\systemh.inc"/>
<CursorPos X="11" Y="825"/>
<TopLine Value="806"/>
<UsageCount Value="5"/>
</Unit18>
<Unit19>
<Filename Value="..\..\..\FPC\Source\rtl\objpas\classes\classesh.inc"/>
<CursorPos X="25" Y="598"/>
<TopLine Value="1"/>
<UsageCount Value="6"/>
</Unit19>
<Unit20>
<Filename Value="..\..\..\LazSVN\lcl\stdctrls.pp"/>
<UnitName Value="StdCtrls"/>
<CursorPos X="20" Y="33"/>
<TopLine Value="16"/>
<UsageCount Value="7"/>
</Unit20>
<Unit21>
<Filename Value="..\..\..\LazSVN\lcl\lcltype.pp"/>
<UnitName Value="LCLType"/>
<CursorPos X="17" Y="607"/>
<TopLine Value="579"/>
<UsageCount Value="8"/>
</Unit21>
<Unit22>
<Filename Value="v_autocompleteform.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="Form1"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="v_AutoCompleteForm"/>
<CursorPos X="46" Y="574"/>
<TopLine Value="1"/>
<EditorIndex Value="1"/>
<UsageCount Value="136"/>
<Loaded Value="True"/>
</Unit22>
<Unit23>
<Filename Value="..\..\..\LazSVN\lcl\include\winapih.inc"/>
<CursorPos X="18" Y="235"/>
<TopLine Value="3"/>
<UsageCount Value="6"/>
</Unit23>
<Unit24>
<Filename Value="..\..\..\LazSVN\lcl\controls.pp"/>
<UnitName Value="Controls"/>
<CursorPos X="15" Y="1800"/>
<TopLine Value="1781"/>
<UsageCount Value="14"/>
</Unit24>
<Unit25>
<Filename Value="..\..\..\LazSVN\lcl\graphics.pp"/>
<UnitName Value="Graphics"/>
<CursorPos X="3" Y="92"/>
<TopLine Value="82"/>
<UsageCount Value="1"/>
</Unit25>
<Unit26>
<Filename Value="..\..\..\LazSVN\lcl\forms.pp"/>
<UnitName Value="Forms"/>
<CursorPos X="15" Y="582"/>
<TopLine Value="527"/>
<UsageCount Value="12"/>
</Unit26>
<Unit27>
<Filename Value="..\..\..\LazSVN\lcl\lclclasses.pp"/>
<UnitName Value="LCLClasses"/>
<CursorPos X="31" Y="38"/>
<TopLine Value="22"/>
<UsageCount Value="2"/>
</Unit27>
<Unit28>
<Filename Value="..\..\..\LazSVN\lcl\lmessages.pp"/>
<UnitName Value="LMessages"/>
<CursorPos X="3" Y="327"/>
<TopLine Value="83"/>
<UsageCount Value="6"/>
</Unit28>
<Unit29>
<Filename Value="..\..\..\FPC\Source\packages\fcl-image\src\fpcanvas.pp"/>
<UnitName Value="FPCanvas"/>
<CursorPos X="32" Y="78"/>
<TopLine Value="59"/>
<UsageCount Value="10"/>
</Unit29>
<Unit30>
<Filename Value="..\..\..\FPC\Source\rtl\objpas\objpas.pp"/>
<UnitName Value="objpas"/>
<CursorPos X="8" Y="36"/>
<TopLine Value="17"/>
<UsageCount Value="1"/>
</Unit30>
<Unit31>
<Filename Value="..\..\..\LazSVN\lcl\stringhashlist.pas"/>
<UnitName Value="StringHashList"/>
<CursorPos X="44" Y="57"/>
<TopLine Value="40"/>
<UsageCount Value="1"/>
</Unit31>
<Unit32>
<Filename Value="..\..\..\FPC\Source\rtl\objpas\strutils.pp"/>
<UnitName Value="strutils"/>
<CursorPos X="10" Y="72"/>
<TopLine Value="53"/>
<UsageCount Value="1"/>
</Unit32>
<Unit33>
<Filename Value="..\..\..\FPC\Source\rtl\objpas\sysutils\syspchh.inc"/>
<CursorPos X="18" Y="32"/>
<TopLine Value="11"/>
<UsageCount Value="1"/>
</Unit33>
<Unit34>
<Filename Value="..\..\..\LazSVN\components\synedit\synedit.pp"/>
<UnitName Value="SynEdit"/>
<CursorPos X="45" Y="5647"/>
<TopLine Value="5621"/>
<UsageCount Value="13"/>
</Unit34>
<Unit35>
<Filename Value="..\..\..\LazSVN\components\synedit\synedithighlighter.pp"/>
<UnitName Value="SynEditHighlighter"/>
<CursorPos X="33" Y="230"/>
<TopLine Value="303"/>
<UsageCount Value="6"/>
</Unit35>
<Unit36>
<Filename Value="..\..\..\FPC\Source\rtl\win32\system.pp"/>
<UnitName Value="System"/>
<CursorPos X="2" Y="35"/>
<TopLine Value="16"/>
<UsageCount Value="6"/>
</Unit36>
<Unit37>
<Filename Value="..\..\..\LazSVN\components\synedit\syneditkeycmds.pp"/>
<UnitName Value="SynEditKeyCmds"/>
<CursorPos X="11" Y="261"/>
<TopLine Value="135"/>
<UsageCount Value="8"/>
</Unit37>
<Unit38>
<Filename Value="..\..\..\LazSVN\components\synedit\syneditmiscclasses.pp"/>
<UnitName Value="SynEditMiscClasses"/>
<CursorPos X="34" Y="996"/>
<TopLine Value="1007"/>
<UsageCount Value="9"/>
</Unit38>
<Unit39>
<Filename Value="..\..\..\FPC\Source\rtl\objpas\sysutils\sysstrh.inc"/>
<CursorPos X="10" Y="223"/>
<TopLine Value="204"/>
<UsageCount Value="4"/>
</Unit39>
<Unit40>
<Filename Value="..\..\..\LazSVN\components\synedit\syneditautocomplete.pp"/>
<UnitName Value="SynEditAutoComplete"/>
<CursorPos X="13" Y="182"/>
<TopLine Value="157"/>
<UsageCount Value="5"/>
</Unit40>
<Unit41>
<Filename Value="..\..\..\LazSVN\lcl\extendedstrings.pas"/>
<UnitName Value="ExtendedStrings"/>
<CursorPos X="34" Y="42"/>
<TopLine Value="31"/>
<UsageCount Value="7"/>
</Unit41>
<Unit42>
<Filename Value="..\..\..\LazSVN\lcl\widgetset\wsreferences.pp"/>
<UnitName Value="WSReferences"/>
<CursorPos X="14" Y="90"/>
<TopLine Value="71"/>
<UsageCount Value="7"/>
</Unit42>
<Unit43>
<Filename Value="..\..\..\LazSVN\lcl\lresources.pp"/>
<UnitName Value="LResources"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="1"/>
<UsageCount Value="8"/>
</Unit43>
<Unit44>
<Filename Value="..\..\..\LazSVN\components\synedit\synhighlighterpas.pp"/>
<UnitName Value="SynHighlighterPas"/>
<CursorPos X="32" Y="2760"/>
<TopLine Value="2741"/>
<UsageCount Value="10"/>
</Unit44>
</Units>
<JumpHistory Count="5" HistoryIndex="4">
<Position1>
<Filename Value="Valistus.lpr"/>
<Caret Line="17" Column="21" TopLine="1"/>
</Position1>
<Position2>
<Filename Value="v_ideCodeInsight.pas"/>
<Caret Line="19" Column="31" TopLine="4"/>
</Position2>
<Position3>
<Filename Value="main.pas"/>
<Caret Line="414" Column="114" TopLine="408"/>
</Position3>
<Position4>
<Filename Value="main.pas"/>
<Caret Line="27" Column="29" TopLine="10"/>
</Position4>
<Position5>
<Filename Value="main.pas"/>
<Caret Line="26" Column="79" TopLine="10"/>
</Position5>
</JumpHistory>
</ProjectOptions>
<CompilerOptions>
<Version Value="8"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="Valistus"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)\"/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Parsing>
<SyntaxOptions>
<UseAnsiStrings Value="True"/>
</SyntaxOptions>
</Parsing>
<Linking>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
<Other>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
<Debugging>
<Exceptions Count="3">
<Item1>
<Name Value="EAbort"/>
</Item1>
<Item2>
<Name Value="ECodetoolError"/>
</Item2>
<Item3>
<Name Value="EFOpenError"/>
</Item3>
</Exceptions>
</Debugging>
</CONFIG>

View File

@ -1,21 +0,0 @@
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.

Binary file not shown.

View File

@ -1,7 +0,0 @@
//Code Insight
{$DEFINE ciCHECKDUPLICATES}
{$DEFINE D8_NEWER1}
{$DEFINE D9_NEWER}
{$DEFINE D10_NEWER}
{.$DEFINE D11_NEWER}
{.$DEFINE D12_NEWER}

View File

@ -1,827 +0,0 @@
object MainForm: TMainForm
Left = 409
Height = 448
Top = 230
Width = 956
Caption = 'MainForm'
ClientHeight = 448
ClientWidth = 956
OnCreate = FormCreate
LCLVersion = '0.9.29'
inline e: TSynEdit
Left = 432
Height = 448
Top = 0
Width = 524
Align = alClient
Font.Height = -13
Font.Name = 'Courier New'
Font.Pitch = fpFixed
Font.Quality = fqNonAntialiased
ParentColor = False
ParentFont = False
TabOrder = 0
OnKeyDown = eKeyDown
OnKeyPress = eKeyPress
OnClickLink = eClickLink
OnMouseLink = eMouseLink
Gutter.Width = 57
Gutter.MouseActions = <
item
Shift = []
ShiftMask = []
Button = mbLeft
ClickCount = ccAny
ClickDir = cdDown
Command = 13
MoveCaret = False
Option = 0
Priority = 0
end
item
Shift = []
ShiftMask = []
Button = mbRight
ClickCount = ccSingle
ClickDir = cdUp
Command = 12
MoveCaret = False
Option = 0
Priority = 0
end>
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 TestingTest(a: Integer = 2; b: string = ''test'');'
'begin'
'end;'
''
'var'
' TIA: array of Integer = (1, 2, 3);'
''
'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 = 123;'
' stringetiestring: string = ''test'';'
'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

View File

@ -1,446 +0,0 @@
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('<no parameters expected>');
//Caption := '<no parameters expected>';
//end;
end;
finally
FreeAndNil(ms);
FreeAndNil(mp);
end;
end;
end.

View File

@ -1,14 +0,0 @@
program Project1;
uses
Forms,
Unit1 in 'Unit1.pas' {Form1};
{$R *.res}
begin
Application.Initialize;
Application.MainFormOnTaskbar := True;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.

View File

@ -1,108 +0,0 @@
 <Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{71405526-EE9C-45F5-8DA4-19347333C34C}</ProjectGuid>
<ProjectVersion>12.0</ProjectVersion>
<MainSource>Project1.dpr</MainSource>
<Config Condition="'$(Config)'==''">Debug</Config>
<DCC_DCCCompiler>DCC32</DCC_DCCCompiler>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Base' or '$(Base)'!=''">
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Release' or '$(Cfg_1)'!=''">
<Cfg_1>true</Cfg_1>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Debug' or '$(Cfg_2)'!=''">
<Cfg_2>true</Cfg_2>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Base)'!=''">
<DCC_DependencyCheckOutputName>Project1.exe</DCC_DependencyCheckOutputName>
<DCC_UnitAlias>WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;$(DCC_UnitAlias)</DCC_UnitAlias>
<DCC_UsePackage>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</DCC_UsePackage>
<DCC_Platform>x86</DCC_Platform>
<DCC_ImageBase>00400000</DCC_ImageBase>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_1)'!=''">
<DCC_LocalDebugSymbols>false</DCC_LocalDebugSymbols>
<DCC_Define>RELEASE;$(DCC_Define)</DCC_Define>
<DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo>
<DCC_DebugInformation>false</DCC_DebugInformation>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2)'!=''">
<DCC_Define>DEBUG;$(DCC_Define)</DCC_Define>
</PropertyGroup>
<ItemGroup>
<DelphiCompile Include="Project1.dpr">
<MainSource>MainSource</MainSource>
</DelphiCompile>
<DCCReference Include="Unit1.pas">
<Form>Form1</Form>
</DCCReference>
<BuildConfiguration Include="Base">
<Key>Base</Key>
</BuildConfiguration>
<BuildConfiguration Include="Debug">
<Key>Cfg_2</Key>
<CfgParent>Base</CfgParent>
</BuildConfiguration>
<BuildConfiguration Include="Release">
<Key>Cfg_1</Key>
<CfgParent>Base</CfgParent>
</BuildConfiguration>
</ItemGroup>
<Import Project="$(BDS)\Bin\CodeGear.Delphi.Targets" Condition="Exists('$(BDS)\Bin\CodeGear.Delphi.Targets')"/>
<ProjectExtensions>
<Borland.Personality>Delphi.Personality.12</Borland.Personality>
<Borland.ProjectType/>
<BorlandProject>
<Delphi.Personality>
<Parameters>
<Parameters Name="UseLauncher">False</Parameters>
<Parameters Name="LoadAllSymbols">True</Parameters>
<Parameters Name="LoadUnspecifiedSymbols">False</Parameters>
</Parameters>
<VersionInfo>
<VersionInfo Name="IncludeVerInfo">False</VersionInfo>
<VersionInfo Name="AutoIncBuild">False</VersionInfo>
<VersionInfo Name="MajorVer">1</VersionInfo>
<VersionInfo Name="MinorVer">0</VersionInfo>
<VersionInfo Name="Release">0</VersionInfo>
<VersionInfo Name="Build">0</VersionInfo>
<VersionInfo Name="Debug">False</VersionInfo>
<VersionInfo Name="PreRelease">False</VersionInfo>
<VersionInfo Name="Special">False</VersionInfo>
<VersionInfo Name="Private">False</VersionInfo>
<VersionInfo Name="DLL">False</VersionInfo>
<VersionInfo Name="Locale">1043</VersionInfo>
<VersionInfo Name="CodePage">1252</VersionInfo>
</VersionInfo>
<VersionInfoKeys>
<VersionInfoKeys Name="CompanyName"/>
<VersionInfoKeys Name="FileDescription"/>
<VersionInfoKeys Name="FileVersion">1.0.0.0</VersionInfoKeys>
<VersionInfoKeys Name="InternalName"/>
<VersionInfoKeys Name="LegalCopyright"/>
<VersionInfoKeys Name="LegalTrademarks"/>
<VersionInfoKeys Name="OriginalFilename"/>
<VersionInfoKeys Name="ProductName"/>
<VersionInfoKeys Name="ProductVersion">1.0.0.0</VersionInfoKeys>
<VersionInfoKeys Name="Comments"/>
</VersionInfoKeys>
<Excluded_Packages>
<Excluded_Packages Name="$(BDS)\bin\bcboffice2k120.bpl">CodeGear C++Builder Office 2000 Servers Package</Excluded_Packages>
<Excluded_Packages Name="$(BDS)\bin\bcbofficexp120.bpl">CodeGear C++Builder Office XP Servers Package</Excluded_Packages>
<Excluded_Packages Name="$(BDS)\bin\dcloffice2k120.bpl">Microsoft Office 2000 Sample Automation Server Wrapper Components</Excluded_Packages>
<Excluded_Packages Name="$(BDS)\bin\dclofficexp120.bpl">Microsoft Office XP Sample Automation Server Wrapper Components</Excluded_Packages>
</Excluded_Packages>
<Source>
<Source Name="MainSource">Project1.dpr</Source>
</Source>
</Delphi.Personality>
</BorlandProject>
<ProjectFileVersion>12</ProjectFileVersion>
</ProjectExtensions>
</Project>

View File

@ -1,39 +0,0 @@
object Form1: TForm1
Left = 0
Top = 0
Caption = 'Form1'
ClientHeight = 292
ClientWidth = 554
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
DesignSize = (
554
292)
PixelsPerInch = 96
TextHeight = 13
object Button1: TButton
Left = 8
Top = 8
Width = 75
Height = 25
Caption = 'Button1'
TabOrder = 0
OnClick = Button1Click
end
object Memo1: TMemo
Left = 8
Top = 39
Width = 538
Height = 245
Anchors = [akLeft, akTop, akRight, akBottom]
Lines.Strings = (
'Memo1')
ScrollBars = ssBoth
TabOrder = 1
end
end

View File

@ -1,59 +0,0 @@
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, uPSComponentExt, uPSCompiler;
type
TForm1 = class(TForm)
Button1: TButton;
Memo1: TMemo;
procedure Button1Click(Sender: TObject);
private
procedure CompImport(Sender: TObject; x: TPSPascalCompiler);
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
uses
uPSC_std,
uPSC_classes;
{$R *.dfm}
procedure TForm1.CompImport(Sender: TObject; x: TPSPascalCompiler);
begin
SIRegister_Std(x);
SIRegister_Classes(x, true);
end;
procedure TForm1.Button1Click(Sender: TObject);
var
a: TPSScriptExtension;
InsertList, ItemList: TStrings;
begin
a := TPSScriptExtension.Create(Self);
a.OnCompImport := CompImport;
ItemList := TStringList.Create;
InsertList := TStringList.Create;
try
//a.Script.Text := 'const zzz=''test''; type a = record b: (test, jwz); end; begin end.';
a.GetValueDefs(ItemList);
Memo1.Lines.Text := ItemList.Text;
finally
FreeAndNil(a);
FreeAndNil(ItemList);
FreeAndNil(InsertList);
end;
end;
end.

View File

@ -1,18 +0,0 @@
unit v_Constants;
interface
//Code Insight Constants
const
{$IFNDEF FPC}
LineEnding = #13#10;
{$ENDIF}
ci_RangeError = 'Array range error at "%s" in statement: "%s"';
ci_UnknownMember = 'Unknown member "%s" in statement: "%s"';
ci_UnknownStruct = 'Cannot find proper structure for "%s" in statement: "%s"';
ci_UnknownInclude = 'Unknown include "%s"';
implementation
end.

View File

@ -1,145 +0,0 @@
unit v_MiscFunctions;
interface
type
TStringArray = array of string;
function Explode(Sep, s: string): TStringArray;
function PrePrepareString(s: string): string;
function PrepareString(s: string; out ArrayCount: Integer): string; overload;
function PrepareString(s: string): string; overload;
function GetFirstWord(s: string): string;
function CompressWhiteSpace(s: string): string;
implementation
uses
SysUtils, StrUtils;
function Explode(Sep, s: string): TStringArray;
var
p1, p2: Integer;
begin
SetLength(Result, 0);
s := s + Sep;
p1 := 1;
p2 := Pos(Sep, s);
while (p1 > 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.

View File

@ -1,581 +0,0 @@
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.

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

View File

@ -12,11 +12,11 @@ object FunctionListFrame: TFunctionListFrame
DesignTop = 219 DesignTop = 219
object FunctionList: TTreeView object FunctionList: TTreeView
Left = 0 Left = 0
Height = 483 Height = 479
Top = 18 Top = 20
Width = 182 Width = 182
Align = alClient Align = alClient
DefaultItemHeight = 15 DefaultItemHeight = 17
ReadOnly = True ReadOnly = True
ScrollBars = ssAutoBoth ScrollBars = ssAutoBoth
TabOrder = 0 TabOrder = 0
@ -28,8 +28,8 @@ object FunctionListFrame: TFunctionListFrame
end end
object editSearchList: TEdit object editSearchList: TEdit
Left = 0 Left = 0
Height = 21 Height = 23
Top = 501 Top = 499
Width = 182 Width = 182
Align = alBottom Align = alBottom
OnChange = editSearchListChange OnChange = editSearchListChange
@ -37,7 +37,7 @@ object FunctionListFrame: TFunctionListFrame
end end
object FunctionListLabel: TLabel object FunctionListLabel: TLabel
Left = 2 Left = 2
Height = 14 Height = 16
Top = 2 Top = 2
Width = 178 Width = 178
Align = alTop Align = alTop

View File

@ -113,7 +113,8 @@ end;
procedure TFunctionListFrame.FunctionListDblClick(Sender: TObject); procedure TFunctionListFrame.FunctionListDblClick(Sender: TObject);
var var
Node : TTreeNode; Node : TTreeNode;
MethodInfo : TMethodInfo;
begin begin
if FilterTree.Visible then if FilterTree.Visible then
Node := FilterTree.Selected Node := FilterTree.Selected
@ -122,10 +123,27 @@ begin
if node<> nil then if node<> nil then
if node.Level > 0 then if node.Level > 0 then
if node.Data <> nil then if node.Data <> nil then
begin; if InCodeCompletion then
Form1.CurrScript.SynEdit.InsertTextAtCaret( GetMethodName(PMethodInfo(node.Data)^.MethodStr,true)); begin
Form1.RefreshTab; Form1.CurrScript.SynEdit.InsertTextAtCaret( GetMethodName(PMethodInfo(node.Data)^.MethodStr,true));
end; Form1.RefreshTab;
end
else
begin
MethodInfo := PMethodInfo(node.Data)^;
if DraggingNode = node then
if (MethodInfo.BeginPos > 0) then
begin;
if MethodInfo.Filename <> nil then
if MethodInfo.Filename <> '' then
begin;
// Writeln(MethodInfo.filename);
Form1.LoadScriptFile(MethodInfo.Filename,true,true);
end;
Form1.CurrScript.SynEdit.SelStart := MethodInfo.BeginPos + 1;
Form1.CurrScript.SynEdit.SelEnd := MethodInfo.EndPos + 1;
end;
end;
end; end;
procedure TFunctionListFrame.FunctionListDeletion(Sender: TObject; procedure TFunctionListFrame.FunctionListDeletion(Sender: TObject;

View File

@ -1,12 +1,12 @@
object Form1: TForm1 object Form1: TForm1
Left = 423 Left = 0
Height = 557 Height = 240
Top = 159 Top = 0
Width = 666 Width = 320
AllowDropFiles = True AllowDropFiles = True
Caption = 'THA FUKING SIMBA' Caption = 'THA FUKING SIMBA'
ClientHeight = 537 ClientHeight = 220
ClientWidth = 666 ClientWidth = 320
KeyPreview = True KeyPreview = True
Menu = MainMenu Menu = MainMenu
OnClose = FormClose OnClose = FormClose
@ -20,7 +20,7 @@ object Form1: TForm1
Left = 0 Left = 0
Height = 24 Height = 24
Top = 0 Top = 0
Width = 666 Width = 320
Caption = 'ToolBar1' Caption = 'ToolBar1'
Images = Mufasa_Image_List Images = Mufasa_Image_List
ParentShowHint = False ParentShowHint = False
@ -82,40 +82,40 @@ object Form1: TForm1
Action = ActionClearDebug Action = ActionClearDebug
end end
object TB_PickColour: TToolButton object TB_PickColour: TToolButton
Left = 316 Left = 1
Hint = 'Pick a color' Hint = 'Pick a color'
Top = 2 Top = 24
Caption = 'TB_PickColour' Caption = 'TB_PickColour'
ImageIndex = 0 ImageIndex = 0
OnClick = ButtonPickClick OnClick = ButtonPickClick
end end
object TB_SelectClient: TToolButton object TB_SelectClient: TToolButton
Left = 339 Left = 24
Hint = 'Select a client' Hint = 'Select a client'
Top = 2 Top = 24
Caption = 'TB_SelectClient' Caption = 'TB_SelectClient'
ImageIndex = 2 ImageIndex = 2
OnMouseDown = ButtonSelectorDown OnMouseDown = ButtonSelectorDown
end end
object ToolButton8: TToolButton object ToolButton8: TToolButton
Left = 362 Left = 47
Top = 2 Top = 24
Width = 4 Width = 4
Caption = 'ToolButton8' Caption = 'ToolButton8'
Style = tbsDivider Style = tbsDivider
end end
object TB_ReloadPlugins: TToolButton object TB_ReloadPlugins: TToolButton
Left = 366 Left = 51
Hint = 'Reload plugins' Hint = 'Reload plugins'
Top = 2 Top = 24
Caption = 'TB_ReloadPlugins' Caption = 'TB_ReloadPlugins'
Enabled = False Enabled = False
ImageIndex = 13 ImageIndex = 13
end end
object TB_Tray: TToolButton object TB_Tray: TToolButton
Left = 389 Left = 74
Hint = 'Minimize to tray' Hint = 'Minimize to tray'
Top = 2 Top = 24
Caption = 'TB_Tray' Caption = 'TB_Tray'
ImageIndex = 17 ImageIndex = 17
OnClick = ButtonTrayClick OnClick = ButtonTrayClick
@ -157,16 +157,16 @@ object Form1: TForm1
Enabled = False Enabled = False
end end
object ToolButton3: TToolButton object ToolButton3: TToolButton
Left = 435 Left = 120
Top = 2 Top = 24
Width = 4 Width = 4
Caption = 'ToolButton3' Caption = 'ToolButton3'
Style = tbsDivider Style = tbsDivider
end end
object TT_Update: TToolButton object TT_Update: TToolButton
Left = 439 Left = 124
Hint = 'A new update is available' Hint = 'A new update is available'
Top = 2 Top = 24
Caption = 'TT_Update' Caption = 'TT_Update'
ImageIndex = 1 ImageIndex = 1
OnClick = TT_UpdateClick OnClick = TT_UpdateClick
@ -198,17 +198,17 @@ object Form1: TForm1
Style = tbsDivider Style = tbsDivider
end end
object TT_Console: TToolButton object TT_Console: TToolButton
Left = 412 Left = 97
Hint = 'Hide/Show Console' Hint = 'Hide/Show Console'
Top = 2 Top = 24
Action = ActionConsole Action = ActionConsole
end end
end end
object StatusBar: TStatusBar object StatusBar: TStatusBar
Left = 0 Left = 0
Height = 23 Height = 22
Top = 514 Top = 198
Width = 666 Width = 320
Panels = < Panels = <
item item
Width = 60 Width = 60
@ -229,17 +229,17 @@ object Form1: TForm1
object PanelMemo: TPanel object PanelMemo: TPanel
Left = 0 Left = 0
Height = 154 Height = 154
Top = 360 Top = 44
Width = 666 Width = 320
Align = alBottom Align = alBottom
ClientHeight = 154 ClientHeight = 154
ClientWidth = 666 ClientWidth = 320
TabOrder = 2 TabOrder = 2
object Memo1: TMemo object Memo1: TMemo
Left = 1 Left = 1
Height = 152 Height = 152
Top = 1 Top = 1
Width = 664 Width = 318
Align = alClient Align = alClient
Font.Height = -13 Font.Height = -13
Font.Name = 'Courier New' Font.Name = 'Courier New'
@ -252,29 +252,29 @@ object Form1: TForm1
Cursor = crVSplit Cursor = crVSplit
Left = 0 Left = 0
Height = 5 Height = 5
Top = 355 Top = 39
Width = 666 Width = 320
Align = alBottom Align = alBottom
ResizeAnchor = akBottom ResizeAnchor = akBottom
end end
object ScriptPanel: TPanel object ScriptPanel: TPanel
Left = 0 Left = 0
Height = 331 Height = 15
Top = 24 Top = 24
Width = 666 Width = 320
Align = alClient Align = alClient
BevelOuter = bvNone BevelOuter = bvNone
ClientHeight = 331 ClientHeight = 15
ClientWidth = 666 ClientWidth = 320
DockSite = True DockSite = True
TabOrder = 4 TabOrder = 4
OnDockDrop = ScriptPanelDockDrop OnDockDrop = ScriptPanelDockDrop
OnDockOver = ScriptPanelDockOver OnDockOver = ScriptPanelDockOver
object PageControl1: TPageControl object PageControl1: TPageControl
Left = 155 Left = 155
Height = 296 Height = 0
Top = 0 Top = 0
Width = 511 Width = 165
Align = alClient Align = alClient
Images = Mufasa_Image_List Images = Mufasa_Image_List
PopupMenu = TabPopup PopupMenu = TabPopup
@ -291,12 +291,12 @@ object Form1: TForm1
object SearchPanel: TPanel object SearchPanel: TPanel
Left = 0 Left = 0
Height = 35 Height = 35
Top = 296 Top = -20
Width = 666 Width = 320
Align = alBottom Align = alBottom
BevelOuter = bvSpace BevelOuter = bvSpace
ClientHeight = 35 ClientHeight = 35
ClientWidth = 666 ClientWidth = 320
TabOrder = 1 TabOrder = 1
Visible = False Visible = False
object SpeedButtonSearch: TSpeedButton object SpeedButtonSearch: TSpeedButton
@ -387,7 +387,7 @@ object Form1: TForm1
end end
object LabeledEditSearch: TLabeledEdit object LabeledEditSearch: TLabeledEdit
Left = 104 Left = 104
Height = 21 Height = 23
Top = 6 Top = 6
Width = 174 Width = 174
EditLabel.AnchorSideLeft.Control = LabeledEditSearch EditLabel.AnchorSideLeft.Control = LabeledEditSearch
@ -395,10 +395,10 @@ object Form1: TForm1
EditLabel.AnchorSideTop.Side = asrCenter EditLabel.AnchorSideTop.Side = asrCenter
EditLabel.AnchorSideRight.Control = LabeledEditSearch EditLabel.AnchorSideRight.Control = LabeledEditSearch
EditLabel.AnchorSideBottom.Control = LabeledEditSearch EditLabel.AnchorSideBottom.Control = LabeledEditSearch
EditLabel.Left = 73 EditLabel.Left = 71
EditLabel.Height = 14 EditLabel.Height = 16
EditLabel.Top = 9 EditLabel.Top = 9
EditLabel.Width = 28 EditLabel.Width = 30
EditLabel.Caption = 'Find: ' EditLabel.Caption = 'Find: '
EditLabel.ParentColor = False EditLabel.ParentColor = False
LabelPosition = lpLeft LabelPosition = lpLeft
@ -411,9 +411,9 @@ object Form1: TForm1
end end
object CheckBoxMatchCase: TCheckBox object CheckBoxMatchCase: TCheckBox
Left = 320 Left = 320
Height = 17 Height = 19
Top = 7 Top = 7
Width = 72 Width = 80
Caption = 'Match case' Caption = 'Match case'
OnClick = CheckBoxMatchCaseClick OnClick = CheckBoxMatchCaseClick
TabOrder = 1 TabOrder = 1
@ -421,34 +421,36 @@ object Form1: TForm1
end end
object SplitterFunctionList: TSplitter object SplitterFunctionList: TSplitter
Left = 150 Left = 150
Height = 296 Height = 0
Top = 0 Top = 0
Width = 5 Width = 5
OnCanResize = SplitterFunctionListCanResize OnCanResize = SplitterFunctionListCanResize
Visible = False Visible = False
end end
inline frmFunctionList: TFunctionListFrame inline frmFunctionList: TFunctionListFrame
Height = 296 Height = 0
Width = 150 Width = 150
ClientHeight = 296 ClientHeight = 0
ClientWidth = 150 ClientWidth = 150
OnEndDock = nil OnEndDock = nil
TabOrder = 3 TabOrder = 3
inherited FunctionList: TTreeView inherited FunctionList: TTreeView
Height = 257 Height = 0
Top = 1
Width = 150 Width = 150
OnChange = FunctionListChange OnChange = FunctionListChange
OnEnter = FunctionListEnter OnEnter = FunctionListEnter
OnExit = FunctionListExit OnExit = FunctionListExit
end end
inherited editSearchList: TEdit inherited editSearchList: TEdit
Top = 275 Top = -23
Width = 150 Width = 150
OnExit = editSearchListExit OnExit = editSearchListExit
OnKeyDown = editSearchListKeyDown OnKeyDown = editSearchListKeyDown
OnKeyPress = editSearchListKeyPress OnKeyPress = editSearchListKeyPress
end end
inherited FunctionListLabel: TLabel inherited FunctionListLabel: TLabel
Top = 0
Width = 146 Width = 146
end end
end end

View File

@ -1846,18 +1846,6 @@ begin
begin begin
MethodInfo := PMethodInfo(node.Data)^; MethodInfo := PMethodInfo(node.Data)^;
StatusBar.Panels[Panel_ScriptPath].Text := MethodInfo.MethodStr; StatusBar.Panels[Panel_ScriptPath].Text := MethodInfo.MethodStr;
if frmFunctionList.DraggingNode = node then
if (MethodInfo.BeginPos > 0) then
begin;
if MethodInfo.Filename <> nil then
if MethodInfo.Filename <> '' then
begin;
// Writeln(MethodInfo.filename);
LoadScriptFile(MethodInfo.Filename,true,true);
end;
CurrScript.SynEdit.SelStart := MethodInfo.BeginPos + 1;
CurrScript.SynEdit.SelEnd := MethodInfo.EndPos + 1;
end;
end; end;
end; end;
@ -1994,9 +1982,12 @@ begin
a.OnCompile := OnCompile; a.OnCompile := OnCompile;
a.OnCompImport := OnCompImport; a.OnCompImport := OnCompImport;
a.OnExecImport := OnExecImport; a.OnExecImport := OnExecImport;
a.Defines.Assign(Defines);
end; end;
a.GetValueDefs(b); a.GetValueDefs(b);
CoreDefines.AddStrings(a.Defines);
SetLength(CoreBuffer, 1); SetLength(CoreBuffer, 1);
CoreBuffer[0] := TCodeInsight.Create; CoreBuffer[0] := TCodeInsight.Create;
with CoreBuffer[0] do with CoreBuffer[0] do
@ -2004,7 +1995,7 @@ begin
OnMessage := @form1.OnCCMessage; OnMessage := @form1.OnCCMessage;
b.SaveToStream(ms); b.SaveToStream(ms);
Run(ms, nil, -1, True); Run(ms, nil, -1, True);
FileName := '!PSCORE!'; FileName := '"PSCORE"';
end; end;
finally finally
b.Free; b.Free;

View File

@ -27,7 +27,7 @@ unit os_windows;
interface interface
uses uses
Classes, SysUtils, mufasatypes, windows, graphics, LCLType, bitmaps, LCLIntf, IOManager, WinKeyInput; Classes, SysUtils, mufasatypes, windows, graphics, LCLType, bitmaps, IOManager, WinKeyInput;
type type
@ -88,6 +88,7 @@ interface
constructor Create(DesktopHandle : HWND); constructor Create(DesktopHandle : HWND);
function WindowRect(out Rect : TRect) : Boolean;override; function WindowRect(out Rect : TRect) : Boolean;override;
end; end;
TIOManager = class(TIOManager_Abstract) TIOManager = class(TIOManager_Abstract)
public public
constructor Create; constructor Create;
@ -250,7 +251,7 @@ implementation
function TWindow.WindowRect(out Rect : TRect) : boolean; function TWindow.WindowRect(out Rect : TRect) : boolean;
begin begin
result := GetWindowRect(self.handle,rect) <> 0; result := Windows.GetWindowRect(self.handle,rect);
end; end;
function TWindow.ReturnData(xs, ys, width, height: Integer): TRetData; function TWindow.ReturnData(xs, ys, width, height: Integer): TRetData;
@ -262,8 +263,9 @@ implementation
ValidateBuffer(w,h); ValidateBuffer(w,h);
if (xs < 0) or (xs + width > w) or (ys < 0) or (ys + height > h) then if (xs < 0) or (xs + width > w) or (ys < 0) or (ys + height > h) then
raise Exception.CreateFMT('TMWindow.ReturnData: The parameters passed are wrong; xs,ys %d,%d width,height %d,%d',[xs,ys,width,height]); raise Exception.CreateFMT('TMWindow.ReturnData: The parameters passed are wrong; xs,ys %d,%d width,height %d,%d',[xs,ys,width,height]);
BitBlt(self.buffer.Canvas.Handle,0,0, width, height, self.dc, xs,ys, SRCCOPY); Windows.BitBlt(self.buffer.Canvas.Handle,0,0, width, height, self.dc, xs,ys, SRCCOPY);
Result.Ptr:= self.buffer_raw; Result.Ptr:= self.buffer_raw;
Result.IncPtrWith:= w - width; Result.IncPtrWith:= w - width;
Result.RowLen:= w; Result.RowLen:= w;
end; end;
@ -420,6 +422,8 @@ begin
end; end;
function TDesktopWindow.WindowRect(out Rect : TRect) : Boolean; function TDesktopWindow.WindowRect(out Rect : TRect) : Boolean;
begin begin
Rect.Left:= GetSystemMetrics(SM_XVIRTUALSCREEN); Rect.Left:= GetSystemMetrics(SM_XVIRTUALSCREEN);

View File

@ -83,6 +83,7 @@ type
var var
CoreBuffer: TCodeInsightArray; CoreBuffer: TCodeInsightArray;
IncludeBuffer: TIncludeBufferArray; IncludeBuffer: TIncludeBufferArray;
CoreDefines: TStringList;
implementation implementation
@ -903,6 +904,8 @@ begin
fPos := -1; fPos := -1;
Reset; Reset;
Lexer.Defines.AddStrings(CoreDefines);
fOwnStream := (fFileName <> ''); fOwnStream := (fFileName <> '');
if fOwnStream then if fOwnStream then
begin begin
@ -943,7 +946,8 @@ begin
if Assigned(BaseDefines) then if Assigned(BaseDefines) then
begin begin
Lexer.ClearDefines; Lexer.ClearDefines;
Lexer.Defines.Assign(BaseDefines); Lexer.Defines.AddStrings(CoreDefines);
Lexer.Defines.AddStrings(BaseDefines);
end; end;
SetLength(fIncludes, 0); SetLength(fIncludes, 0);
@ -1313,8 +1317,10 @@ end;
initialization initialization
{nothing} {nothing}
CoreDefines := TStringList.Create;
finalization finalization
ClearIncludeBuffer; ClearIncludeBuffer;
ClearCoreBuffer; ClearCoreBuffer;
CoreDefines.Free;
end. end.