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

View File

@ -113,7 +113,8 @@ end;
procedure TFunctionListFrame.FunctionListDblClick(Sender: TObject);
var
Node : TTreeNode;
Node : TTreeNode;
MethodInfo : TMethodInfo;
begin
if FilterTree.Visible then
Node := FilterTree.Selected
@ -122,10 +123,27 @@ begin
if node<> nil then
if node.Level > 0 then
if node.Data <> nil then
begin;
Form1.CurrScript.SynEdit.InsertTextAtCaret( GetMethodName(PMethodInfo(node.Data)^.MethodStr,true));
Form1.RefreshTab;
end;
if InCodeCompletion then
begin
Form1.CurrScript.SynEdit.InsertTextAtCaret( GetMethodName(PMethodInfo(node.Data)^.MethodStr,true));
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;
procedure TFunctionListFrame.FunctionListDeletion(Sender: TObject;

View File

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

View File

@ -1846,18 +1846,6 @@ begin
begin
MethodInfo := PMethodInfo(node.Data)^;
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;
@ -1994,9 +1982,12 @@ begin
a.OnCompile := OnCompile;
a.OnCompImport := OnCompImport;
a.OnExecImport := OnExecImport;
a.Defines.Assign(Defines);
end;
a.GetValueDefs(b);
CoreDefines.AddStrings(a.Defines);
SetLength(CoreBuffer, 1);
CoreBuffer[0] := TCodeInsight.Create;
with CoreBuffer[0] do
@ -2004,7 +1995,7 @@ begin
OnMessage := @form1.OnCCMessage;
b.SaveToStream(ms);
Run(ms, nil, -1, True);
FileName := '!PSCORE!';
FileName := '"PSCORE"';
end;
finally
b.Free;

View File

@ -27,7 +27,7 @@ unit os_windows;
interface
uses
Classes, SysUtils, mufasatypes, windows, graphics, LCLType, bitmaps, LCLIntf, IOManager, WinKeyInput;
Classes, SysUtils, mufasatypes, windows, graphics, LCLType, bitmaps, IOManager, WinKeyInput;
type
@ -88,6 +88,7 @@ interface
constructor Create(DesktopHandle : HWND);
function WindowRect(out Rect : TRect) : Boolean;override;
end;
TIOManager = class(TIOManager_Abstract)
public
constructor Create;
@ -250,7 +251,7 @@ implementation
function TWindow.WindowRect(out Rect : TRect) : boolean;
begin
result := GetWindowRect(self.handle,rect) <> 0;
result := Windows.GetWindowRect(self.handle,rect);
end;
function TWindow.ReturnData(xs, ys, width, height: Integer): TRetData;
@ -262,8 +263,9 @@ implementation
ValidateBuffer(w,h);
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]);
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.IncPtrWith:= w - width;
Result.RowLen:= w;
end;
@ -420,6 +422,8 @@ begin
end;
function TDesktopWindow.WindowRect(out Rect : TRect) : Boolean;
begin
Rect.Left:= GetSystemMetrics(SM_XVIRTUALSCREEN);

View File

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