//***************************************************************************************** // Copyright (c) 2000 Michael Kurz // All rights reserved. // If you want to use this source in your applications conatct: // // $FileName : cParser.pkg // $ProjectName : TheTool 1.0 // $Author : Michael Kurz // $Created : 01-25-2001 @ 19:00 // // Contents: // Covers the use of PARSER.DLL which parses TextBuffers for // -Object - End_Object (also CD_End_Object CD_Popup_Object) // -Class - End_Class // -Procedure - End_Procedure // -Function - End_Function // -Use // -#Include // -Local Vars // -Parameters of Procedures and Functions // // also the Compiler directive #IFDEF, #ELSE, #ENDIF // are searched to allow to scan some DAF packages which // are conditional with these statements. // (If not the Parser would see 2 Class Statement where only // one is really used) // // $Rev History // //***************************************************************************************** Use VdfBase.pkg Use MessageQueueHelpers.pkg Global_Variable Integer ghoCompilerMessages // Define a global integer for the compiler-output target window Global_Variable Integer ghoParserControl Register_Function SC_LineCount Returns Integer // Name of the Parameter that contains the return type of a function. Define MK_RETVAL For "@RETVAL@" // Element types. Define MK_VARIABLE For 0 // Only for internal use. Define MK_OBJECT For 1 Define MK_PROCEDURE For 2 Define MK_FUNCTION For 4 Define MK_CLASS For 8 Define MK_PROPERTY For 16 Define MK_LOCALVAR For 32 Define MK_SETPROCEDURE For 64 Define MK_COMMAND For 128 Define MK_STRUCT For 256 // Variable Types Define MK_INTEGER For 1 Define MK_NUMBER For 2 Define MK_STRING For 3 Define MK_HANDLE For 4 Define MK_POINTER For 5 Define MK_BOOLEAN For 6 Define MK_DWORD For 7 // New Types Define MK_REAL For 8 Define MK_DATE For 9 Define MK_TIME For 10 Define MK_TIMESPAN For 11 Define MK_DATETIME For 12 Define MK_ADDRESS For 13 Define MK_BIGINT For 14 Define MK_CHAR For 15 Define MK_CURRENCY For 16 Define MK_DECIMAL For 17 Define MK_FLOAT For 18 Define MK_SHORT For 19 Define MK_UBIGINT For 20 Define MK_UCHAR For 21 Define MK_UINTEGER For 22 Define MK_USHORT For 23 // Fancy New Types Define MK_ROWID For 24 Define MK_VARIANT For 25 Define MK_WSTRING For 26 Define MK_LONGPTR For 27 Define MK_ULONGPTR For 28 // Converts a variable type constant to a string name of it. Function fVarTypToString Global Integer iType Returns String If iType Eq MK_INTEGER Function_Return "Integer" If iType Eq MK_BOOLEAN Function_Return "Boolean" If iType Eq MK_NUMBER Function_Return "Number" If iType Eq MK_STRING Function_Return "String" If iType Eq MK_HANDLE Function_Return "Handle" If iType Eq MK_POINTER Function_Return "Pointer" If iType Eq MK_DWORD Function_Return "DWord" If iType Eq MK_REAL Function_Return "Real" If iType Eq MK_DATE Function_Return "Date" If iType Eq MK_TIME Function_Return "Time" If iType Eq MK_TIMESPAN Function_Return "TimeSpan" If iType Eq MK_DATETIME Function_Return "DateTime" If iType Eq MK_ADDRESS Function_Return "Address" If iType Eq MK_BIGINT Function_Return "BigInt" If iType Eq MK_CHAR Function_Return "Char" If iType Eq MK_CURRENCY Function_Return "Currency" If iType Eq MK_DECIMAL Function_Return "Decimal" If iType Eq MK_FLOAT Function_Return "Float" If iType Eq MK_SHORT Function_Return "Short" If iType Eq MK_UBIGINT Function_Return "UBigInt" If iType Eq MK_UCHAR Function_Return "UChar" If iType Eq MK_UINTEGER Function_Return "UInteger" If iType Eq MK_USHORT Function_Return "UShort" If iType Eq MK_ROWID Function_Return "RowID" If iType Eq MK_VARIANT Function_Return "Variant" If iType Eq MK_WSTRING Function_Return "WString" If iType Eq MK_LONGPTR Function_Return "LongPtr" If iType Eq MK_ULONGPTR Function_Return "ULongPtr" Function_Return "" End_Function // Converts a string to a variable type constant Function fStringToVarTyp Global String sType Returns Integer Move (lowercase(sType)) To sType If sType Eq "integer" Function_Return MK_INTEGER If sType Eq "boolean" Function_Return MK_BOOLEAN If sType Eq "number" Function_Return MK_NUMBER If sType Eq "string" Function_Return MK_STRING If sType Eq "handle" Function_Return MK_HANDLE If sType Eq "pointer" Function_Return MK_POINTER If sType Eq "dword" Function_Return MK_DWORD If sType Eq "real" Function_Return MK_REAL If sType Eq "date" Function_Return MK_DATE If sType Eq "time" Function_Return MK_TIME If sType Eq "timespan" Function_Return MK_TIMESPAN If sType Eq "datetime" Function_Return MK_DATETIME If sType Eq "address" Function_Return MK_ADDRESS If sType Eq "bigint" Function_Return MK_BIGINT If sType Eq "char" Function_Return MK_CHAR If sType Eq "currency" Function_Return MK_CURRENCY If sType Eq "decimal" Function_Return MK_DECIMAL If sType Eq "float" Function_Return MK_FLOAT If sType Eq "short" Function_Return MK_SHORT If sType Eq "ubigint" Function_Return MK_UBIGINT If sType Eq "uchar" Function_Return MK_UCHAR If sType Eq "uinteger" Function_Return MK_UINTEGER If sType Eq "ushort" Function_Return MK_USHORT If sType Eq "rowid" Function_Return MK_ROWID If sType Eq "variant" Function_Return MK_VARIANT If sType Eq "wstring" Function_Return MK_WSTRING If sType Eq "longptr" Function_Return MK_LONGPTR If sType Eq "ulongptr" Function_Return MK_ULONGPTR Function_Return 0 End_Function Use Bitmaps.pkg // Contains a function for converting ClassNames to BMPs // These are userdefined Window Messages which are sent by the // parsing thread to allow rebuild of Lists or whatever. // (To display the parsed Elements) Define WM_USER_MK For (WM_USER+5000) Define MK_STARTFILLLIST For (WM_USER_MK+99 ) // Löscht die Liste(n) Define MK_NEWLISTENTRY For (WM_USER_MK+100) // Fngt neue EintrSge hinzu. Define MK_ENDFILLLIST For (WM_USER_MK+101) // Done with filling the list. Define MK_NEWUSEDFILE For (WM_USER_MK+102) // New file entry found. Define MK_GETEDITWINDOW For (WM_USER_MK+103) // Current Edit window Define MK_PARSINGERROR For (WM_USER_MK+104) // We've bumped in a parsing error, stop parsing and gobbling up memory Define FF_NEWENTRY For (WM_USER+5500) // New FileFinder entry Define FF_STARTFILEFIND For (WM_USER+5501) // New FileFinder entry Define FF_FINISHFILEFIND For (WM_USER+5502) // New FileFinder entry Define MK_SPYLINE For (WM_USER+5510) // Compiler Line Define MK_SPYNEW For (WM_USER+5511) // New compile started // Easy access to first and last commands // 28.1.2003 BP Define MK_CMDFIRST For MK_STARTFILLLIST Define MK_CMDLAST For MK_GETEDITWINDOW // A Structure which is used to transfer the Data from DLL to VDF Struct tCElement Pointer pNext // next Element in the List //TYPE: cElement Pointer pPrev // Previous //TYPE: cElement Pointer pParent // Parent //TYPE: cElement Pointer pFirstChild // 1.Child //TYPE: cElement Pointer pLastChild // last Child //TYPE: cElement Integer pItemNr // Is used internally for filling a tree list. //TYPE: int Integer piLine // LineNr. //TYPE: int Integer piEndLine // Endline Integer piType // LineNr. //TYPE: int UChar[200] psName // Name of the Elements //TYPE: char UChar[200] psClass // Name of the BaseClass //TYPE: char UChar[2000] psRef // Complete Reference. seperated with a "." //TYPE: char End_Struct // Also used for transferring the Data from DLL to VDF Struct tElementData UChar[200] sName UChar[200] sClass UChar[2000] sReferenz Dword iPrevious Dword iParent Dword iLineNr Dword iType Pointer pElem End_Struct #IFDEF IS$WIN64 Define PARSER_DLL For PARSER64.DLL #ELSE Define PARSER_DLL For PARSER32.DLL #ENDIF // DLL Calls External_function MKInit "MKInit" PARSER_DLL Handle hWnd Returns Handle External_function MKUnInit "MKUnInit" PARSER_DLL Returns Integer External_function MKCreateParseTask "MKCreateParseTask" PARSER_DLL Handle hwndTreeView Handle hwndEdit Returns Pointer External_function MKDestroyParseTask "MKDestroyParseTask" PARSER_DLL Pointer pTask Returns Integer External_function MKSetCurrentParseTask "MKSetCurrentParseTask" PARSER_DLL Pointer pTask Returns Integer External_function MKGetFirstObject "MKGetFirstObject" PARSER_DLL Pointer pTask Returns Pointer External_function MKGetNextObject "MKGetNextObject" PARSER_DLL Pointer pObj Returns Pointer External_function MKGetPreviousObject "MKGetPreviousObject" PARSER_DLL Pointer pObj Returns Pointer External_function MKGetFirstChild "MKGetFirstChild" PARSER_DLL Pointer pObj Returns Pointer External_function MKGetObjectInfo "MKGetObjectInfo" PARSER_DLL Pointer pObj Pointer pName Pointer pClass Returns Integer External_function MKGetObjectInfoEx "MKGetObjectInfoEx" PARSER_DLL Pointer pObj Pointer pData Returns Integer External_function MKFillList "MKFillList" PARSER_DLL Pointer pTask Handle hwnd Returns Integer External_function MKParseBuffer "MKParseBuffer" PARSER_DLL Pointer pBuff Integer iLen Handle hwnd Returns Integer External_function MKLineToElement "MKLineToElement" PARSER_DLL Pointer pTask Integer iForceType Integer iLn Pointer pData Returns Integer External_function MKLineToElementObj "MKLineToElementObj" PARSER_DLL Pointer pTask Integer iLn Returns Pointer External_function MKSetLanguage "MKSetLanguage" PARSER_DLL Pointer sLanguage Returns Integer External_function MKVariablenCount "MKVariablenCount" PARSER_DLL Pointer pElement Returns Integer External_function MKGetVariableInfo "MKGetVariableInfo" PARSER_DLL Pointer pElement Integer iNr Pointer pType Pointer pName Returns Integer External_function MKParameterCount "MKParameterCount" PARSER_DLL Pointer pElement Returns Integer External_function MKGetParameterInfo "MKGetParameterInfo" PARSER_DLL Pointer pElement Integer iNr Pointer pType Pointer pName Returns Integer External_function MKReplyToMessage "MKReplyToMessage" PARSER_DLL Integer iVal Returns Integer External_function MKGetVersionInformation "MKGetVersionInformation" PARSER_DLL Pointer pVersion Pointer pBuild Returns Integer External_function MKCreateBuffer "MKCreateBuffer" PARSER_DLL Integer iSize Returns Pointer External_function MKCancelCurrentParseTask "MKCancelCurrentParseTask" PARSER_DLL Returns Integer External_function MKSearchText "MKSearchText" PARSER_DLL Handle hWnd Pointer pSearch Integer iSearchLen Pointer pFound Returns Integer External_function SciSearchText "SciSearchText" PARSER_DLL Handle hWnd Pointer pSearch Integer iSearchLen Pointer pFound Returns Integer External_function FFStartFileSearch "FFStartFileSearch" PARSER_DLL Pointer pPath Pointer pFilePattern Pointer pFindText Integer bSubDirs Integer bMatchCase Integer bMatchWord Handle hTargetWindow Integer bShowAll Integer bRegExp Returns Integer External_function FFReplyToMessage "FFReplyToMessage" PARSER_DLL Returns Integer External_function FFCancelFileSearch "FFCancelFileSearch" PARSER_DLL Returns Integer //**ToDo MKSpyCompiler threadID is LPDWORD, change in DLL External_function MKSpyCompiler "MKSpyCompiler" PARSER_DLL Integer iThreadID Handle hProcess Integer bHideCompiler Returns Integer External_function MKReplyToSpyMessage "MKReplyToSpyMessage" PARSER_DLL Returns Integer External_function MKAbortCurrentCompile "MKAbortCurrentCompile" PARSER_DLL Returns Integer External_function FFBrowseFolder "FFBrowseFolder" PARSER_DLL Handle hParent Pointer sTitle Pointer sInitDir Pointer pRet Returns Integer //external_function WaitForSingleObjectEf "WaitForSingleObject" kernel32.dll Handle hObject Integer iTimeout Returns Integer Struct tParseObject String sObject String sObjectLabel // short name String sClass Handle pElement End_Struct Struct tParseClass String sClass String sClassLabel // short name String sParentClass Handle pElement End_Struct Struct tParseParam String sName // should be in front (so we can sort) Integer iType String sType // custom struct type Boolean bByRef // true if byref variable End_Struct Struct tParseVar String sName // Should be in front (so we can sort) Integer iType String sType // custom struct type End_Struct Struct tParseMethod String sName Integer iType String sClass Pointer pElement End_Struct Struct tParseProperty String sName String sType String sObject Pointer pElement End_Struct // This is a source parser that must be inside a GUI container // because it needs a window_handle for receiving the WindowMessages // from the parsing Thread. // // The class is not visible or focusable. Class cParser is a array Procedure Construct_Object Forward Send Construct_Object Property Pointer ppBuffer 0 // For external Buffer Handling Property Integer piBufferLen 0 // Size for this Buffer Property Handle phThread 0 // Create Thread if not created. Property Pointer ppParseTask 0 Property Pointer ppCurrObj 0 Property Boolean pbParseOnFileLoad False // On the first parse task we need this to identify duplicates Property String psObjName "" Property String psClsName "" Property Integer piListID 0 Property Integer piEditID 0 Property Integer piLastLineCount -1 //Property Integer piTextLenRequested PUBLIC 0 // Properties receiving the data of an parsing element. Property Pointer ppCEl_pNext 0 Property Pointer ppCEl_pPrev 0 Property Pointer ppCEl_pParent 0 Property Pointer ppCEl_pFirstChild 0 Property Pointer ppCEl_pLastChild 0 Property Integer piCEl_pItemNr 0 Property Integer piCEl_piLine 0 Property Integer piCEl_piEndLine 0 Property Integer piCEl_piType 0 Property String psCEl_psName "" Property String psCEl_psClass "" Property String psCEl_psRef "" Property tParseObject[] pParseObjects // List of all Objects. Property tParseClass[] pParseClasses // List of all Classes Property tParseVar[] pParseVars // List of the Variables Property tParseMethod[] pParseMethods // List of all Procedures, Functions, ... Property tParseProperty[] pParseProperties // List of all Properties End_Procedure Procedure End_Construct_Object Forward Send End_Construct_Object Object oFunctionCodeTip is a Array End_Object End_Procedure Function SearchBufferForText String sText Returns String Boolean bIsUtf8 Boolean bIsOem String sVar1 sVar2 Integer iRet iSize Handle hoEditWindow Boolean bCanParse Move "" To sVar2 Get piEditID To hoEditWindow If (hoEditWindow<>0) Begin Get CanParseCurrentLanguage Of hoEditWindow To bCanParse If (bCanParse) Begin Get pbUtf8Mode to bIsUtf8 Get pbOemMode to bIsOem If (bIsUtf8) Begin Move (SizeOfString(sText)) to iSize End Else Begin Move (Length(sText)) to iSize End Move (sText + (Character(0))) To sVar1 Move (ZeroString(1024)) To sVar2 Move (SciSearchText(window_handle(hoEditWindow),AddressOf(sVar1),iSize,AddressOf(sVar2))) To iRet Move (CString(sVar2)) To sVar2 End End Function_Return sVar2 End_Function // Gets all parameters of a procedure, function. Procedure FillInParameter Pointer pElement tParseParam[] ByRef ParseParams Integer iCount iC iType iRet iItem String sName sType Move (MKParameterCount(pElement)) To iCount Move (ResizeArray(ParseParams,0)) To ParseParams For iC From 0 To (iCount-1) Move (Repeat(Character(0),100)) To sName Move (Repeat(Character(0),4)) To sType Move (MKGetParameterInfo(pElement,iC,AddressOf(sType),AddressOf(sName))) To iRet #IF (!@ >= 200) Move (oemtoutf8(sName)) To sName Move (oemtoutf8(sType)) To sType #ENDIF Move (CString(sName)) To sName Move (BytesToDWord(sType,1)) To iType If sName Ne MK_RETVAL Begin Move (SizeOfArray(ParseParams)) To iItem Move sName To ParseParams[iItem].sName Move iType To ParseParams[iItem].iType End Loop Move (SortArray(ParseParams)) To ParseParams End_Procedure // Gets all parameters of a function including retval and unsorted Procedure FillInAllParametersUnsorted Pointer pElement tParseParam[] ByRef ParseParams Integer iCount iC iType iRet iItem String sName sType sVal Move (MKParameterCount(pElement)) To iCount Move (ResizeArray(ParseParams,0)) To ParseParams For iC From 0 To (iCount-1) Move (Repeat(Character(0),100)) To sName Move (Repeat(Character(0),4)) To sType Move (MKGetParameterInfo(pElement,iC,AddressOf(sType),AddressOf(sName))) To iRet #IF (!@ >= 200) Move (oemtoutf8(sName)) To sName Move (oemtoutf8(sType)) To sType #ENDIF Move (CString(sName)) To sName Move (BytesToDWord(sType,1)) To iType Move sName To sVal Move (SizeOfArray(ParseParams)) To iItem Move sName To ParseParams[iItem].sName Move iType To ParseParams[iItem].iType Loop End_Procedure // Gets the ParameterList from a Line. Function GetParameterListFromLine Integer iLine Returns tParseParam[] Pointer pElement tParseParam[] ParseParams Move (MKLineToElementObj(ppParseTask(Self),iLine)) To pElement Send FillInParameter pElement (&ParseParams) Function_Return ParseParams End_Function // Gets a list of the parameters from an Element (if its an Procedure,Function) // all other its is empty of course. Function GetParameterList Pointer pElement Returns tParseParam[] tParseParam[] ParseParams Send FillInParameter pElement (&ParseParams) Function_Return ParseParams End_Function // Gets all local variable of an Element and fills it into an array. Procedure FillInVariablen Pointer pElement Integer iCount iC hoID iType iItem iRet String sName sType tParseVar[] ParseVars Move (MKVariablenCount(pElement)) To iCount Move (ResizeArray(ParseVars,0)) To ParseVars For iC From 0 To (iCount-1) Move (Repeat(Character(0),100)) To sName Move (Repeat(Character(0),4)) To sType Move (MKGetVariableInfo(pElement,iC,AddressOf(sType),AddressOf(sName))) To iRet #IF (!@ >= 200) Move (oemtoutf8(sName)) To sName Move (oemtoutf8(sType)) To sType #ENDIF Move (CString(sName)) To sName Move (BytesToDWord(sType,1)) To iType If (sName <> "") Begin Move (SizeOfArray(ParseVars)) To iItem Move sName To ParseVars[iItem].sName Move iType To ParseVars[iItem].iType End Loop Move (SortArray(ParseVars)) To ParseVars Set pParseVars To ParseVars End_Procedure // Gets the VariablenList from a Line. Function GetVariablenListFromLine Integer iLine Returns tParseVar[] Pointer pElement tParseVar[] ParseVars Move (MKLineToElementObj(ppParseTask(Self),iLine)) To pElement Send FillInVariablen pElement Get pParseVars To ParseVars Function_Return ParseVars End_Function // Fills in all SubElements of an Element. Procedure FillInElementsEx Pointer pElement Integer iType Integer iC iSelect tParseMethod[] ParseMethods If pElement Eq 0 Procedure_Return Move (ResizeArray(ParseMethods,0)) To ParseMethods Move (MKGetFirstChild(pElement)) To pElement While (pElement<>0) Move 1 To iSelect Move (SizeOfArray(ParseMethods)) To iC Send FillObjectInfoEx pElement If Not (piCEl_piType(Self) Iand iType) Move 0 To iSelect //If (piCEl_piType(Self)) Ne MK_Object Move 0 To iSelect If iSelect Begin Move (psCEl_psName(Self)) To ParseMethods[iC].sName Move (piCEl_piType(Self)) To ParseMethods[iC].iType Move (psCEl_psClass(Self)) To ParseMethods[iC].sClass Move pElement To ParseMethods[iC].pElement End Move (MKGetNextObject(pElement)) To pElement Loop Set pParseMethods To ParseMethods End_Procedure Procedure FillInElements Pointer pElement Send FillInElementsEx pElement (MK_PROCEDURE+MK_FUNCTION+MK_CLASS+MK_PROPERTY+MK_SETPROCEDURE+MK_COMMAND+MK_STRUCT) End_Procedure // Delivers a List Of all SubElements Of an Element which Is got From // the given line. Function GetElementsListEx Pointer pElement Integer iType Returns tParseMethod[] tParseMethod[] ParseMethods Send FillInElementsEx pElement iType Get pParseMethods To ParseMethods Function_Return ParseMethods End_Function Function GetElementsList Pointer pElement Returns tParseMethod[] Function_Return (GetElementsListEx(self,pElement,(MK_PROCEDURE+MK_FUNCTION+MK_CLASS+MK_PROPERTY+MK_SETPROCEDURE+MK_COMMAND+MK_STRUCT))) End_Function // Delivers a List of all SubElements of an Element which is got from // the given line. Function GetElementsListFromLine Integer iLine Returns tParseMethod[] Pointer pElement tParseMethod[] ParseMethods Move (MKLineToElementObj(ppParseTask(Self),iLine)) To pElement Send FillInElements pElement Get pParseMethods To ParseMethods Function_Return ParseMethods End_Function // Delivers an Element from a given line, the data of // the Element is Function LineToItemEx Integer iForceType Integer iLn Returns Integer Integer iRet iItem String sName sClass sRef tCElement CElement Move 0 To CElement.piLine Move (MKLineToElement(ppParseTask(Self),iForceType,iLn,AddressOf(CElement))) To iRet If iRet Begin Set ppCEl_pNext To CElement.pNext Set ppCEl_pPrev To CElement.pPrev Set ppCEl_pParent To CElement.pParent Set ppCEl_pFirstChild To CElement.pFirstChild Set ppCEl_pLastChild To CElement.pLastChild Set piCEl_pItemNr To CElement.pItemNr Set piCEl_piLine To CElement.piLine Set piCEl_piEndLine To CElement.piEndLine Set piCEl_piType To CElement.piType Move (UCharArrayToString(CElement.psName)) To sName Move (UCharArrayToString(CElement.psClass)) To sClass Move (UCharArrayToString(CElement.psRef)) To sRef #IF (!@ >= 200) Move (oemtoutf8(sName)) To sName Move (oemtoutf8(sClass)) To sClass Move (oemtoutf8(sRef)) To sRef #ENDIF Set psCEl_psName To (CString(sName)) Set psCEl_psClass To (CString(sClass)) Set psCEl_psRef To (CString(sRef)) End Function_Return iRet End_Function // Doesnt check the type of the current element. Function LineToItem Integer iLn Returns Integer Function_Return (LineToItemEx(Self,0,iLn)) End_Function // Doesnt check the type of the current element. // better name. Function LineToElement Integer iLn Returns Integer Function_Return (LineToItemEx(Self,0,iLn)) End_Function // Löst ein neu Befnllen der Listen aus. Procedure FillLists Integer iRet Move (MKFillList(ppParseTask(Self),Window_Handle(Self))) To iRet End_Procedure // Adding new List Entries. Procedure onStartFillList Longptr wParam Longptr lParam Integer iRet tParseObject[] EmptyObjects tParseClass[] EmptyClasses tParseProperty[] EmptyProperties Move (ResizeArray(EmptyObjects,0)) To EmptyObjects Move (ResizeArray(EmptyClasses,0)) To EmptyClasses Move (ResizeArray(EmptyProperties,0)) To EmptyProperties Set pParseObjects To EmptyObjects Set pParseClasses To EmptyClasses Set pParseProperties To EmptyProperties Send delete_data To (oFunctionCodeTip(Self)) If (piListID(Self)) Get msg_StartFillList Of (piListID(Self)) To iRet Procedure_Return iRet End_Procedure Procedure onEndFillList Longptr wParam Longptr lParam Integer iRet Set pbParseOnFileLoad to False If (piListID(Self)) Get msg_EndFillList Of (piListID(Self)) To iRet Procedure_Return iRet End_Procedure Procedure onParsingError Longptr wParam Longptr lParam Integer iRet Procedure_Return 1 End_Procedure Procedure AddNewListEntry String sName String sClass String sRef Integer iParent Integer iPrev Integer iLine Integer iType Integer pElement Integer iItemNr iItemCount iC iVarType Integer hoIDParas String sVarName sFunction tParseObject[] ParseObjects tParseClass[] ParseClasses tParseProperty[] ParseProperties If iType Eq MK_OBJECT Begin Get pParseObjects To ParseObjects Move (SizeOfArray(ParseObjects)) To iItemCount Move (CString(sRef)) To ParseObjects[iItemCount].sObject Move (CString(sClass)) To ParseObjects[iItemCount].sClass Move pElement To ParseObjects[iItemCount].pElement Set pParseObjects To ParseObjects End Else If (iType = MK_CLASS) Begin Get pParseClasses to ParseClasses Move (SizeOfArray(ParseClasses)) to iItemCount Move (CString(sRef)) to ParseClasses[iItemCount].sClass Move (CString(sClass)) to ParseClasses[iItemCount].sParentClass Move pElement to ParseClasses[iItemCount].pElement Set pParseClasses to ParseClasses End Else If (iType = MK_PROPERTY) Begin Get pParseProperties To ParseProperties Move (SizeOfArray(ParseProperties)) To iItemCount Move (CString(sName)) To ParseProperties[iItemCount].sName Move (CString(sClass)) to ParseProperties[iItemCount].sType Move (CString(sRef)) to ParseProperties[iItemCount].sObject Move pElement to ParseProperties[iItemCount].pElement Set pParseProperties to ParseProperties End // test for parsing local functions for tooltip // If iType Eq MK_FUNCTION Begin // Move sName to sFunction // Move (oParameter(self)) to hoIDParas // Send FillInAllParametersUnsorted pElement hoIDParas // If (item_count(hoIDParas)) Gt 1 Move (sFunction + " (") to sFunction // Else Move (sFunction + " ( ) ") to sFunction // FOR iC From 0 to (Item_Count(hoIDParas)-1) // Get value2D Of hoIDParas Item iC 0 to sVarName // Get value2D Of hoIDParas Item iC 1 to iVarType // If sVarName Ne MK_RETVAL Begin // If iC Ne 0 Move (sFunction + ", ") to sFunction // Move (sFunction + (fVarTypToString(iVarType)) + " " + sVarName) to sFunction // End // End // If (item_count(hoIDParas)) Gt 1 Move (sFunction + ") ") to sFunction // Set value Of (oFunctionCodeTip(self)) Item (item_count(oFunctionCodeTip(self))) to sFunction // End If (piListID(Self)) Begin Get Msg_AddNewListEntry Of (piListID(Self)) sName sClass sRef iParent iPrev iLine iType pElement To iItemNr End Procedure_Return iItemNr End_Procedure Procedure onNewListEntry Longptr wParam Longptr lParam Integer iResult iParent iPrev iLine iType String sData sName sClass sRef Pointer pElement tElementData ElementData Move 0 To ElementData.iLineNr Move (CopyMemory(AddressOf(ElementData),wParam,SizeOfType(tElementData))) To iResult Move (UCharArrayToString(ElementData.sName)) To sName Move (UCharArrayToString(ElementData.sClass)) To sClass Move (UCharArrayToString(ElementData.sReferenz)) To sRef #IF (!@ >= 200) Move (utf8tooem(sName)) To sName Move (utf8tooem(sClass)) To sClass Move (utf8tooem(sRef)) To sRef #ENDIF Move ElementData.iParent To iParent Move ElementData.iPrevious To iPrev Move ElementData.iLineNr To iLine Move ElementData.iType To iType Move ElementData.pElem To pElement Move (CString(sName)) To sName Move (CString(sClass)) To sClass Move (CString(sRef)) To sRef Get Msg_AddNewListEntry sName sClass sRef iParent iPrev iLine iType pElement To iResult Procedure_Return iResult End_Procedure Procedure NewUsedFile String sFile End_Procedure Procedure onNewUsedFile Longptr wParam Longptr lParam Integer iRet String sName2 String sName Move (Repeat(Character(0),lParam+1)) To sName Move (CopyMemory(AddressOf(sName),wParam,lParam)) To iRet Move (CString(sName)) To sName If Not "." In sName Append sName ".Pkg" Get FindFileForWorkspace of ghoWorkspaceHandlerEx sName To sName2 If (sName2="") Get FindFirstFileInTHWorkspaceFolder of ghoApplication sName to sName2 If sName2 Ne "" Move sName2 To sName Else Move ("~FOUND "+sName) To sName If (piListID(Self)) Get msg_NewUsedFile Of (piListID(Self)) sName To iRet Procedure_Return iRet End_Procedure // Saves the Info of a given Object. Procedure FillObjectInfo Pointer pObj Integer iRet String sName String sClass If pObj Eq 0 Procedure_Return Move (Repeat(Character(0),200)) To sName Move (Repeat(Character(0),200)) To sClass Move (MKGetObjectInfo(pObj,AddressOf(sName),AddressOf(sClass))) To iRet #IF (!@ >= 200) Move (utf8tooem(sName)) To sName Move (utf8tooem(sClass)) To sClass #ENDIF Set psObjName To sName Set psClsName To sClass End_Procedure // Fills in all Info of an Element. Procedure FillObjectInfoEx Pointer pElement Integer iRet iItem String sName sClass sRef tCElement CElement If pElement Le 0 Procedure_Return False Move 0 To CElement.piLine Move (MKGetObjectInfoEx(pElement,AddressOf(CElement))) To iRet If iRet Begin Set ppCEl_pNext To CElement.pNext Set ppCEl_pPrev To CElement.pPrev Set ppCEl_pParent To CElement.pParent Set ppCEl_pFirstChild To CElement.pFirstChild Set ppCEl_pLastChild To CElement.pLastChild Set piCEl_pItemNr To CElement.pItemNr Set piCEl_piLine To CElement.piLine Set piCEl_piEndLine To CElement.piEndLine Set piCEl_piType To CElement.piType Move (UCharArrayToString(CElement.psClass)) To sClass Move (UCharArrayToString(CElement.psName)) To sName Move (UCharArrayToString(CElement.psRef)) To sRef #IF (!@ >= 200) Move (utf8tooem(sName)) To sName Move (utf8tooem(sClass)) To sClass Move (utf8tooem(sRef)) To sRef #ENDIF Set psCEl_psName To sName Set psCEl_psClass To sClass Set psCEl_psRef To sRef End Procedure_Return iRet End_Procedure Function FindFirstObject Returns Pointer Pointer pObj Move (MKGetFirstObject(ppParseTask(Self))) To pObj Set ppCurrObj To pObj Function_Return pObj End_Function // For Debugging issues. Shows all Objects in the List. Procedure ShowObject Pointer pObj Integer iLevel Send FillObjectInfo pObj Showln (Repeat(" ",iLevel*3)) (psObjName(Self)) " Class: " (psClsName(Self)) If (MKGetFirstChild(pObj)) Ne 0 Send ShowObject (MKGetFirstChild(pObj)) (iLevel+1) If (MKGetNextObject(pObj)) Ne 0 Send ShowObject (MKGetNextObject(pObj)) (iLevel) End_Procedure Procedure ShowObjects Integer iRoot iObj iObj2 Get FindFirstObject To iRoot Send ShowObject iRoot 0 End_Procedure // Tell the parser what language to parse, currently supported is: // - DataFlex // - Pascal // - Javascript Procedure Set Language String sLanguage Integer iVoid Move (sLanguage+character(0)) To sLanguage Move (MKSetLanguage(AddressOf(sLanguage))) To iVoid End_Procedure // Erzeugt den Task. Procedure CreateParseTask Integer iEditID Handle hwndEdit Pointer pParseTask If (Not(piEditID(Self))) Set piEditID To iEditID If (piEditID(Self)) Get Window_Handle Of (piEditID(Self)) To hwndEdit If (ppParseTask(Self)) Ne 0 Procedure_Return Move (MKCreateParseTask(Window_Handle(Self),hwndEdit)) To pParseTask Set ppParseTask To pParseTask End_Procedure // Parses the Buffer. Procedure DoParsing Integer iRet Send ChangeParseWindow To ghoParserControl (piEditID(Self)) End_Procedure Procedure destroy_object Integer iRet If ghoParserControl Ne 0 Set phoEditObject Of ghoParserControl To 0 If (ppParseTask(Self)) Ne 0 Begin Move (MKDestroyParseTask(ppParseTask(Self))) To iRet Set ppParseTask To 0 End Forward Send destroy_object End_Procedure End_Class Class cParserControl is a DFControl Register_Procedure OnGetEditWindow Longptr wParam Longptr lParam Register_Procedure onNewListEntry Register_Procedure onStartFillList Register_Procedure onEndFillList Register_Procedure onParsingError Register_Procedure onNewUsedFile Register_Procedure onCompilerLine Register_Procedure onNewCompile Procedure Construct_Object Set External_Class_Name "cParserControl" To "#32770" Set external_message MK_GETEDITWINDOW To OnGetEditWindow Set external_message MK_NEWLISTENTRY To onNewListEntry Set external_message MK_STARTFILLLIST To onStartFillList Set external_message MK_ENDFILLLIST To onEndFillList Set external_message MK_PARSINGERROR To onParsingError Set external_message MK_NEWUSEDFILE To onNewUsedFile Set external_message MK_SPYLINE To onCompilerLine Set external_message MK_SPYNEW To onNewCompile Forward Send Construct_object Property Handle phParseHandle 0 Property Handle phoEditObject 0 Property Integer piLineCountToSet 0 Set focus_mode To nonfocusable End_Procedure Procedure page_object Integer iPage Handle hThread hSignal Forward Send page_object iPage If (iPage) Begin Move (MKInit(window_handle(Self))) To hThread If (hThread Eq 0) Send stop_box "Create Parser Thread failed" Set phParseHandle To hThread End End_Procedure Procedure destroy_object Integer iRet Move (MKUninit()) To iRet Set phoEditObject To 0 Forward Send destroy_object End_Procedure // ToDo: Seems this is not used anymore? // Removes all Messages from PARSER_DLL that are already posted on the message-queue // Important to do so when the parsing thread is changed // 28.1.2003 BP Procedure RemoveQueuedMessages Procedure_Return Integer iRet tMSG WinMsg Move 0 To WinMsg.ptX While ( (PeekMessage(AddressOf(WinMsg),0,MK_CMDFIRST,MK_CMDLAST,1)) ) Move (MKReplyToMessage(-1)) To iRet Loop End_Procedure // hoEdit is the DataFlex object that holds the code Editor. Procedure ChangeParseWindow Integer hoEdit Integer iRet Set phoEditObject To 0 Move (MKCancelCurrentParseTask()) To iRet Send RemoveQueuedMessages Set phoEditObject To hoEdit End_Procedure // // This is an event that is called from the parser DLL // Procedure OnGetEditWindow Longptr wParam Longptr lParam Integer iRet iLines iSize Boolean bCanParse Pointer pBuffer Handle hoParser Handle hoEditWindow Handle hWndEditWindow Get phoEditObject To hoEditWindow If (hoEditWindow = 0) Begin Move (MKReplyToMessage(0)) To iRet Procedure_Return End Get SC_Linecount of hoEditWindow To iLines Get phoParser Of hoEditWindow To hoParser If (iLines = (piLastLineCount(hoParser)) ) Begin Move (MKReplyToMessage(0)) To iRet Procedure_Return End Get CanParseCurrentLanguage Of hoEditWindow To bCanParse If (bCanParse=false) Begin Move (MKReplyToMessage(0)) To iRet Procedure_Return End Set piLineCountToSet To iLines Get Window_Handle Of hoEditWindow To hWndEditWindow Move (SendMessage(hWndEditWindow, SCI_GETLENGTH,0,0)) to iSize Move (MKCreateBuffer(iSize)) To pBuffer // Creates the buffer straight in the parser DLL, the parser also frees the memory Move (SendMessage(hWndEditWindow, SCI_GETTEXT,(iSize+1),pBuffer)) to iRet Move (MKSetCurrentParseTask(ppParseTask(hoParser))) To iRet Move (MKReplyToMessage(hWndEditWindow)) To iRet End_Procedure Procedure onNewListEntry Longptr wParam Longptr lParam Integer iRet hoParser If (phoEditObject(Self)) Eq 0 Begin Move (MKReplyToMessage(-1)) To iRet Procedure_Return End Get phoParser Of (phoEditObject(Self)) To hoParser Get msg_onNewListEntry Of hoParser wParam lParam To iRet Move (MKReplyToMessage(iRet)) To iRet End_Procedure Procedure onStartFillList Longptr wParam Longptr lParam Integer iRet hoParser If (phoEditObject(Self)) Eq 0 Begin Move (MKReplyToMessage(-1)) To iRet Procedure_Return End Get phoParser Of (phoEditObject(Self)) To hoParser Get msg_onStartFillList Of hoParser wParam lParam To iRet Move (MKReplyToMessage(iRet)) To iRet End_Procedure Procedure onEndFillList Longptr wParam Longptr lParam Integer iRet hoParser If (phoEditObject(Self)) Eq 0 Begin Move (MKReplyToMessage(-1)) To iRet Procedure_Return End Get phoParser Of (phoEditObject(Self)) To hoParser Get msg_onEndFillList Of hoParser wParam lParam To iRet Set piLastLineCount Of hoParser To (piLineCountToSet(Self)) Move (MKReplyToMessage(iRet)) To iRet End_Procedure Procedure onParsingError Longptr wParam Longptr lParam Integer iRet hoParser If (phoEditObject(Self)) Eq 0 Begin Move (MKReplyToMessage(-1)) To iRet Procedure_Return End Get phoParser Of (phoEditObject(Self)) To hoParser Get msg_onParsingError Of hoParser wParam lParam To iRet Set piLastLineCount Of hoParser To (piLineCountToSet(Self)) Move (MKReplyToMessage(iRet)) To iRet End_Procedure Procedure onNewUsedFile Longptr wParam Longptr lParam Integer iRet hoParser If (phoEditObject(Self)) Eq 0 Begin Move (MKReplyToMessage(-1)) To iRet Procedure_Return End Get phoParser Of (phoEditObject(Self)) To hoParser Get msg_onNewUsedFile Of hoParser wParam lParam To iRet Move (MKReplyToMessage(iRet)) To iRet End_Procedure Procedure OnCompilerLine Longptr wParam Longptr lParam Integer iRet String sBuff Move (ZeroString(1024)) To sBuff Move (CopyMemory(AddressOf(sBuff),wParam,1024)) To iRet #IF (!@ < 200) Move (ToOem(sBuff)) To sBuff #ELSE Move (oemtoutf8(sBuff)) To sBuff #ENDIF Move (cString(sBuff)) To sBuff //If ( (ghoCompilerMessages Ne 0) And ((Pos("INCLUDING FILE:",sBuff)) Eq 0) ) Send AddLine to ghoCompilerMessages sBuff If (ghoCompilerMessages Ne 0) Send AddLine To ghoCompilerMessages sBuff Move (MKReplyToSpyMessage()) To iRet End_Procedure Procedure OnNewCompile Longptr wParam Longptr lParam Integer iRet If (ghoCompilerMessages Ne 0) Send delete_data To ghoCompilerMessages Move (MKReplyToSpyMessage()) To iRet End_Procedure End_Class Class cFileFinder Is a DFControl Register_Procedure FFNewEntry Register_Procedure FFStart Register_Procedure FFFinish Procedure Construct_Object Set External_Class_Name "cFileFinder" To "#32770" Set external_message FF_NEWENTRY To FFNewEntry Set external_message FF_STARTFILEFIND To FFStart Set external_message FF_FINISHFILEFIND To FFFinish Property Boolean pbExcludeComments False Forward Send Construct_object Set focus_mode To nonfocusable End_Procedure Procedure AddLine String sVal End_Procedure Procedure OnStart End_Procedure Procedure OnFinish End_Procedure Procedure FFNewEntry Longptr wParam Longptr lParam String sVal Integer iRet Move (ZeroString(wParam)) To sVal Move (CopyMemory(AddressOf(sVal),lParam,wParam)) To iRet #IF (!@ < 200) Move (ToOem(sVal)) To sVal #ELSE Move (oemtoutf8(sVal)) To sVal // ToDo: Check if not already in UTF8 #ENDIF Move (cString(sVal)) To sVal Send AddLine sVal Move (FFReplyToMessage()) To iRet End_Procedure Procedure FFStart Longptr wParam Longptr lParam Integer iRet Send OnStart Move (FFReplyToMessage()) To iRet End_Procedure Procedure FFFinish Longptr wParam Longptr lParam Integer iRet Send OnFinish Move (FFReplyToMessage()) To iRet End_Procedure Procedure RemoveQueuedMessages Procedure_Return Integer iRet tMSG WinMsg Move 0 To WinMsg.ptX While ( (PeekMessage(AddressOf(WinMsg),0,FF_NEWENTRY,FF_NEWENTRY,1)) ) Move (FFReplyToMessage()) To iRet Loop End_Procedure Procedure CancelFileFind Integer iRet Move (FFCancelFileSearch()) To iRet Send RemoveQueuedMessages End_Procedure Procedure StartFileFind String sPath String sFilePattern String sFindText Integer bSubFolders Integer bMatchCase Integer bMatchWord Integer bShowAll Integer bRegExp Boolean bExcludeComments Integer iRet hoResult Set pbExcludeComments To bExcludeComments Move (sPath + (Character(0)) ) To sPath Move (sFindText + (Character(0)) ) To sFindText Move (sFilePattern + (Character(0)) ) To sFilePattern #IF (!@ < 200) Move (ToAnsi(sPath)) To sPath Move (ToAnsi(sFindText)) To sFindText Move (ToAnsi(sFilePattern)) To sFilePattern #ELSE Move (Utf8ToAnsi(sPath)) To sPath Move (Utf8ToAnsi(sFindText)) To sFindText Move (Utf8ToAnsi(sFilePattern)) To sFilePattern #ENDIF Move (FFStartFileSearch(AddressOf(sPath),AddressOf(sFilePattern),AddressOf(sFindText),bSubFolders,bMatchCase,bMatchWord,(window_handle(Self)),bShowAll,bRegExp)) To iRet End_Procedure End_Class // Calls the Windows Browse for Folder Window and preselects the passed Directory // since this can only be done by a callback it must reside in a c dll. // 28.02.2003 BP Function SelectFolderWithInit GLOBAL String sTitleText String sInitDir Returns String String sDir sTitle sRet Integer iRet Move (sTitleText + (Character(0)) ) To sTitle Move (sInitDir + (Character(0)) ) To sDir #IF (!@ < 200) Move (ToAnsi(sTitle)) To sTitle Move (ToAnsi(sDir)) To sDir #ELSE Move (Utf8ToAnsi(sTitle)) To sTitle Move (Utf8ToAnsi(sDir)) To sDir #ENDIF Move (ZeroString(260)) To sRet Move (FFBrowseFolder(window_handle(focus(desktop)),AddressOf(sTitle),AddressOf(sDir),AddressOf(sRet))) To iRet If (iRet) Begin #IF (!@ < 200) Move (ToOem(sRet)) To sRet #ELSE Move (AnsiToUtf8(sRet)) To sRet #ENDIF Move (CString(sRet)) To sRet Function_Return sRet End Function_Return "" End_Function