//TH-Header //***************************************************************************************** // Copyright (c) 2014 KURANT Project // All rights reserved. // // $FileName : readsrc.bp // $ProjectName : The Hammer 2.0 // $Authors : Wil van Antwerpen, Michael Kurz, Sergey V. Natarov, Bernhard Ponemayr // $Created : 01.25.2014 01:08 // $Type : LGPL // // Contents: // // Read the source file and look for Class properties // //***************************************************************************************** //TH-RevisionStart //TH-RevisionEnd Use cReadsrc.pkg Object oClass_Array Is An Array Procedure pAdd_Class string sClassname string sSuperClassName integer ic get item_count to ic set array_value item ic to sClassName set array_value item (ic+1) to sSuperClassName End_Procedure // Return classname Function fGetClassName integer iRow Returns string Function_Return (string_value(self,(iRow*2))) End_Function // Return SuperClass Function fGetSuperClassName integer iRow Returns string Function_Return (string_value(self,((iRow*2)+1))) End_Function // Return how any classes in source Function fCount_Classes Returns integer Function_Return (item_count(self)/2) End_Function End_Object Object oProperty_Array Is An Array Function fFind_property string sClassName string sPropName Returns integer integer icount iItem iMax move (item_count(self)-1) to iMax For iCount from 0 to iMax move (iCount*6) to iItem if (Uppercase(string_value(self,iItem))=uppercase(sClassname) and Uppercase(string_value(self,(iItem+1)))=Uppercase(sPropName)) function_return iCount Loop Function_Return -1 End_Function Procedure pAdd_Property string sClassName string sPropName string sPropType string sGenType string sValues string sComment integer iSource integer ic iItem iMax iRow string sOldGenType sOldPropType get item_count to ic get fFind_property sClassName sPropname to iRow // property already defined if iRow ge 0 Begin move (iRow*6) to iItem if iSource eq 1 begin // If it is a property definition set array_value item (iItem+2) to sPropType set array_value item (iItem+5) to sComment end else Begin // if it is a set statement // Value of a set statement is a better choice for default value set array_value item (iItem+4) to sValues get string_value item (iItem+2) to sOldPropType // try a better guess if (sOldPropType='Integer' and sPropType='Boolean') set array_value item (iItem+2) to 'Boolean' else if (sOldPropType='Integer' and sPropType='Complex') set array_value item (iItem+2) to 'Complex' else if (sOldPropType='' and sPropType <> '') set array_value item (iItem+2) to sPropType End get string_value item (iItem+3) to sOldGenType set array_value item (iItem+3) to (trim(sOldGenType+' ' + sGenType)) procedure_return End set array_value item ic to sClassName set array_value item (ic+1) to sPropName set array_value item (ic+2) to sPropType set array_value item (ic+3) to sGenType set array_value item (ic+4) to sValues set array_value item (ic+5) to sComment End_Procedure End_Object Object oReadSource is A cReadSource Procedure onProcess string sOrgLine sLine sClassName sSuperClassName sTmp sPropname sArg sPropType sGenType sComm integer iInClass iInConstruct iStartClass iItem hArr hArrClass hArrProp hArrSet iMax iIsItem iPos // If using an existing array with source (for Hammer) get phSourceArray to hArr get item_count of hArr to iMax // If reading from file if (hArr=0) begin // Read from sourcefile get fReadFile (psFileName(self)) to iMax // Source is put in oScrCode_Array for temporary use get oSrcCode_Array to hArr end get oClass_Array to hArrClass get oProperty_Array to hArrProp send delete_data to hArrClass send delete_data to hArrProp repeat get string_value of hArr item iItem to sLine // join lines if (right(trim(fStripComment(self,sLine)),1)) eq ';' begin trim sLine to sTmp move '' to sLine repeat move (sLine * left(sTmp, (pos(';', sTmp)-1))) to sLine increment iItem get string_value of hArr item iItem to sTmp until (right(trim(fStripComment(self, sTmp)),1)) ne ';' append sLine sTmp end move (fIsFirstKeyword(self, sLine ,'Class')) to iStartClass if iStartClass begin // move iItem to iStartClass get fClassName sLine to sClassName get fSuperClassName sLine to sSuperClassName send pAdd_Class to hArrClass sClassName sSuperClassName end if not iInclass move iStartClass to iInClass // Start Class definition else move (if(fIsFirstKeyword(self, sLine ,'End_Class'),0,1)) to iInClass // End of Class definition // Is inside a class definition if iInClass Begin if not iInConstruct begin //Check if we are in procedure construct_object move (fIsProcedure(self, sLine, 'Construct_Object')) to iInConstruct end else move (if(fIsFirstKeyword(self, sLine, 'End_Procedure'),0,1)) to iInConstruct // End of construct_object // LOOK FOR DEFINITIONS IF WE ARE IN CONSTRUCT_OBJECT if iInConstruct Begin // Check if it is a set statement get fFindKeyword sLine 'Set' to iPos if (iPos and not(fFindKeyWord(self, sLine, 'Object', 1 ))) Begin // get property name get fNextkeywordPos sLine iPos to iPos get fKeywordAtPos sLine iPos to sPropName get fProperString sPropName to sPropName get fNextkeywordPos sLine iPos to iPos get fKeywordAtPos sLine iPos to sTmp // Skip if next word is "OF" if (uppercase(sTmp)) ne 'OF' Begin // if it is item then the property type should be item if (uppercase(sTmp)='ITEM') move 'Item' to sGenType else move '' to sGenType // skip everything until to While (uppercase(sTmp)) ne 'TO' get fNextkeywordPos sLine iPos to iPos get fKeywordAtPos sLine iPos to sTmp Loop get fNextkeywordPos sLine iPos to iPos get fStripComment sLine to sTmp move (right(sTmp,(length(sTmp)-iPos+1))) to sArg get fExtractComment sLine to sComm get fGuessDataType sArg to sPropType send pAdd_Property to hArrprop sClassName sPropName sPropType sGenType sArg sComm 2 End End // Check if it is a property statement get fFindKeyword sLine 'property' to iPos if iPos begin // get type of property move '' to sGenType get fNextkeywordPos sLine iPos to iPos get fKeywordAtPos sLine iPos to sPropType get fProperString sProptype to sPropType // get property name get fNextkeywordPos sLine iPos to iPos get fKeywordAtPos sLine iPos to sPropName // public/private get fNextkeywordPos sLine iPos to iPos get fKeywordAtPos sLine iPos to sTmp // Skip if private if (uppercase(sTmp)='PUBLIC') Begin get fNextkeywordPos sLine iPos to iPos get fStripComment sLine to sTmp move (right(sTmp,(length(sTmp)-iPos+1))) to sArg get fExtractComment sLine to sComm move 'No_Execute' to sGenType // try a better guess get fGuessDataType sArg to sTmp if (sProptype='Integer' and (sTmp='Boolean' or sTmp='Complex')) move sTmp to sPropType send pAdd_Property to hArrProp sClassName sPropName sPropType sGenType sArg sComm 1 End ELSE if (uppercase(sTmp) <> 'PRIVATE' ) Begin // Neither public or private, then this keyword is not used get fStripComment sLine to sTmp move (right(sTmp,(length(sTmp)-iPos+1))) to sArg get fExtractComment sLine to sComm move 'No_Execute' to sGenType // try a better guess get fGuessDataType sArg to sTmp if (sProptype='Integer' and (sTmp='Boolean' or sTmp='Complex')) move sTmp to sPropType send pAdd_Property to hArrProp sClassName sPropName sPropType sGenType sArg sComm 1 End End End End increment iItem until iItem ge iMax End_Procedure // Read source from file Function fReadSourceFile string sFileName integer iStatusPanel0 Returns integer integer iRet iStatusPanel // If we should use a status panel or not if (NUM_ARGUMENTS=2) move iStatusPanel0 to iStatusPanel else move (true) to iStatusPanel set psFileName to sFileName set status_panel_state to iStatusPanel send doProcess get fCount_Classes of (oClass_Array(self)) to iRet Function_Return iRet End_Function // read source from array (for Hammer) Function fReadSourceArray integer hArrId integer iStatusPanel0 Returns integer integer iRet iStatusPanel set phSourceArray to hArrId // If we should use a status panel or not. Default is off when reading from array if (NUM_ARGUMENTS=2) move iStatusPanel0 to iStatusPanel else move (false) to iStatusPanel set status_panel_state to iStatusPanel send doProcess get fCount_Classes of (oClass_Array(self)) to iRet Function_Return iret End_Function End_Object