UNIT Generation.ms.dict USES params.ms.dict ; USES axiom_push.ms.dict ; USES core.ms.dict ; USES Log.ms.dict ; USES WordsRTTI.ms.dict ; USES ElementsRTTI.ms.dict ; USES CompileTimeVar.ms.dict ; USES SaveVarAndDo.ms.dict ; CONST cPathSep '\' FILE CompileTime-VAR g_OutFile nil %REMARK 'Текущий файл' STRING CompileTime-VAR g_Indent '' %REMARK 'Текущий отступ' CONST cIndentChar ' ' STRING FUNCTION IndentStr g_Indent >>> Result ; // IndentStr OBJECT STRING INTEGER ARRAY BOOLEAN TYPE OUTABLE CONST \n #13#10 CONST cQuote '''' CONST cOpenComment '{' CONST cCloseComment '}' CONST cSpace ' ' CONST cUnderline '_' CONST cDot '.' CONST cEmptyStr '' BOOLEAN CompileTime-VAR g_EnableAutoEOL true BOOLEAN CompileTime-VAR g_NeedOutLn false PROCEDURE OutLnToFile \n g_OutFile File:WriteStr ; // OutLnToFile BOOLEAN FUNCTION .Out? OUTABLE IN aValue : .OutToFile if g_NeedOutLn then begin false >>> g_NeedOutLn OutLnToFile end // g_NeedOutLn g_OutFile File:WriteStr ; // .OutToFile VAR l_WasOut VAR l_NeedIndent PROCEDURE .OutValue OUTABLE IN aValue RULES ( aValue .IsValueValid ! ) () ( aValue IsArray ) begin aValue .for> call.me end // aValue IsArray DEFAULT begin STRING VAR l_Value aValue ToPrintable >>> l_Value if ( l_WasOut ! ) then begin true >>> l_WasOut IndentStr .OutToFile false >>> l_NeedIndent end // l_WasOut ! if ( l_NeedIndent ) then begin false >>> l_NeedIndent IndentStr .OutToFile end // l_NeedIndent if ( l_Value \n == ) then begin l_Value .OutToFile true >>> l_NeedIndent end // ( l_Value \n == ) else begin l_Value .OutToFile end // ( l_Value \n == ) end // DEFAULT ; // RULES ; // .OutValue false >>> l_WasOut false >>> l_NeedIndent aValue .OutValue if l_WasOut then if g_EnableAutoEOL then OutLnToFile l_WasOut >>> Result ; // .Out? : .Out .Out? DROP ; // .Out PROCEDURE Indented: ^ IN aLambda TF g_Indent ( g_Indent cIndentChar Cat >>> g_Indent aLambda DO ) ; // Indented: USES axiom:SysUtils ; USES arrays.ms.dict ; USES IsNil.ms.dict ; TtfwWord FUNCTION .FindMemberRecur STRING IN aName TtfwWord IN aGen TtfwKeyWord VAR l_Member aName aGen pop:Word:FindMember >>> l_Member if ( l_Member .IsNil ) then ( nil >>> Result ) else ( l_Member pop:KeyWord:Word >>> Result ) if ( Result .IsNil ) then ( aGen .Inherited.Words .for> ( IN anItem VAR l_Found aName anItem call.me >>> l_Found ( Result .IsNil ) OR ( l_Found .IsNil ) OR ( Result = l_Found ) ?ASSURE [ 'Multiply inheritance. Word: ' aName ' generator ' aGen .WordName ' parent generator ' anItem .WordName ] l_Found >>> Result ) ) ; // .FindMemberRecur ARRAY CompileTime-VAR g_GeneratedFiles [] %REMARK 'Ранее сгенерированные файлы' TtfwWord VAR g_CurrentGenerator %REMARK 'Текущий генератор' : WithGen: ^ IN aGen ^ IN aLambda TF g_CurrentGenerator ( aGen >>> g_CurrentGenerator aLambda DO ) // TF g_CurrentGenerator ; // WithGen: WordAlias .All .True %REMARK 'Функтор определяющий, что все значения подходят.' WordAlias GenCached: CacheMethod %REMARK 'Кеширует значение учитывая текущий генератор. Пока определено как Cached:' : .? ^ IN aWord VAR l_Word aWord |N g_CurrentGenerator .FindMemberRecur >>> l_Word if ( l_Word .IsNil ) then ( aWord DO ) else ( l_Word DO ) ; // .? STRING FUNCTION Ext '.dump' >>> Result ; // Ext PROCEDURE ForceDirectories STRING IN aPath aPath sysutils:ForceDirectories ?ASSURE [ 'Не удалось создать директорию ' aPath ] ; // ForceDirectories FILE FUNCTION TryOpen: STRING IN aFileName ^ IN aOpenLambda %SUMMARY 'Открывает файл aFileName методом aOpenLambda обрабатывая ошибки открытия.' 'Пытается открыть файл повторно несколько раз.' ; VAR l_TryCount 20 >>> l_TryCount while ( l_TryCount > 0 ) begin TRY aFileName aOpenLambda DO >>> Result 0 >>> l_TryCount EXCEPT Dec l_TryCount nil >>> Result if ( l_TryCount 0 == ) then RAISE else begin [ 'Файл ' aFileName ' был занят. Ожидаем его освобождения. Попытка номер: ' l_TryCount IntToStr ] strings:Cat >>std::out 500 SLEEP end // ( l_TryCount 0 == ) END // TRY..EXCEPT end // ( l_TryCount > 0 ) ; // TryOpen: FILE FUNCTION MakePathAndOpenWrite STRING IN aFileName %SUMMARY 'Открывает файл aFileName на запись.' 'Если надо - создаёт полный путь на файловой системе.' ; aFileName sysutils:ExtractFilePath ForceDirectories aFileName TryOpen: File:OpenWrite >>> Result ; // MakePathAndOpenWrite CONST cRoot 'w:' PROCEDURE BackupFile STRING IN aFileName VAR l_To aFileName >>> l_To l_To cRoot 'W:' string:Replace >>> l_To l_To 'W:' 'C:\Temp\GenBackup' string:Replace >>> l_To if ( aFileName sysutils:FileExists ) then begin $20 l_To aFileName CopyFile end // ( aFileName sysutils:FileExists ) else begin FILE VAR l_In l_To MakePathAndOpenWrite >>> l_In // - делаем пустышку TRY FINALLY nil >>> l_In END // TRY..FINALLY end // ( aFileName sysutils:FileExists ) ; // BackupFile PROCEDURE CopyChangedFile STRING IN aTo STRING IN aFrom BOOLEAN IN aNeedBackup aTo .NotIsNil ?ASSURE aFrom aFrom .NotIsNil ?ASSURE aTo if ( ( aTo sysutils:FileExists ! ) OR ( cEmptyStr aTo aFrom CompareFiles ! ) ) then begin if aNeedBackup then begin aTo BackupFile end // aNeedBackup $20 aTo aFrom CopyFile end ; // CopyChangedFile STRING elem_func FinalFileNamePrim cEmptyStr >>> Result ; // FinalFileNamePrim STRING FUNCTION .CutSuffix STRING IN aString STRING IN aSuffix RULES ( aString .IsNil ) '' ( aSuffix .IsNil ) aString DEFAULT begin aString >>> Result if ( aSuffix Result EndsStr ) then begin Result string:Len aSuffix string:Len - 0 Result string:Substring >>> Result end // ( aSuffix Result EndsStr ) Result end // DEFAULT ; // RULES >>> Result ; // .CutSuffix STRING FUNCTION .CutPrefix STRING IN aString STRING IN aPrefix RULES ( aString .IsNil ) '' ( aPrefix .IsNil ) aString DEFAULT begin aString >>> Result if ( aPrefix Result StartsStr ) then begin Result string:Len aPrefix string:Len - aPrefix string:Len Result string:Substring >>> Result end // ( aPrefix Result StartsStr ) Result end // DEFAULT ; // RULES >>> Result ; // .CutPrefix USES CountIt.ms.dict ; STRING elem_func LUID VAR l_UID Self .UID >>> l_UID RULES DEFAULT l_UID ; // RULES >>> Result ; // LUID BOOLEAN elem_func IsSameModelElement ModelElement IN anOther RULES ( Self anOther ?== ) true ( Self .LUID anOther .LUID == ) true DEFAULT false ; // RULES >>> Result ; // IsSameModelElement BOOLEAN elem_func IsArray Self .IsStereotype st_Vector >>> Result ; // IsArray BOOLEAN elem_func IsOpenArray Self .IsArray AND ( Self .GetUP "array type" 'open' == ) >>> Result ; // IsOpenArray USES FirstElement.ms.dict ; ModelElement elem_func FirstAttribute Cached: ( Self .Attributes .FirstElement ) >>> Result ; // FirstAttribute BOOLEAN elem_func IsMixInParamType Self .IsStereotype st_ImpurityParamType >>> Result ; // IsMixInParamType : g_MixInParamTypes @SELF ; // g_MixInParamTypes BOOLEAN elem_func IsIterator Self .IsStereotype st_Iterator >>> Result ; // IsIterator FORWARD .IteratorAction STRING elem_func TypeName Cached: ( RULES ( Self .IsNil ) '' ( Self IsString ) Self ( Self .IsOpenArray ) ( [ 'array of ' Self .FirstAttribute .Target call.me ] strings:Cat ) ( Self .IsIterator ) ( Self .IteratorAction call.me ) DEFAULT ( STRING VAR l_ExtName Self .GetUP 'extprop:pas:TypeName' >>> l_ExtName RULES ( l_ExtName .IsNotNil ) l_ExtName DEFAULT ( Self .Name ) ; // RULES ) ; // RULES ) >>> Result if ( Self .IsMixInParamType ) then begin VAR l_Field @ g_MixInParamTypes %% ( Self .Name ) >>> l_Field if ( l_Field .IsNotNil ) then begin l_Field DO >>> l_Field if ( l_Field .IsNotNil ) then begin l_Field call.me >>> Result end // ( l_Field .IsNotNil ) end // ( l_Field .IsNotNil ) end // ( Self .IsMixInParamType ) ; // TypeName BOOLEAN elem_func IsSameType ModelElement IN anOther RULES ( Self anOther .IsSameModelElement ) true ( Self IsString ) RULES ( anOther IsString ) false DEFAULT ( Self anOther .TypeName == ) ; // RULES ( anOther IsString ) RULES ( Self IsString ) false DEFAULT ( Self .TypeName anOther == ) ; // RULES ( Self .TypeName anOther .TypeName == ) true DEFAULT false ; // RULES >>> Result ; // IsSameType USES GarantModel.ms.dict ; BOOLEAN elem_func IsScriptKeyword Self .IsStereotype st_ScriptKeyword >>> Result ; // IsScriptKeyword WordAlias [[ [ %REMARK 'Начинает определение константного массива. Пока просто мапируется на неконстантный.' WordAlias ]] ] %REMARK 'Заканчивает определение константного массива. Пока просто мапируется на неконстантный.' USES axiom:WordBox ; ModelElement elem_func WeakRef %SUMMARY 'Возвращает СЛАБУЮ ссылку на элемент.' ; RULES ( Self IsIntf ) ( Self pop:WordBox:Boxed ) DEFAULT Self ; // RULES >>> Result ; // WeakRef ARRAY elem_func ElementToArray RULES ( Self .IsNil ) [empty] DEFAULT begin Cached: ( [[ Self .WeakRef ]] ) end // DEFAULT ; // RULES >>> Result ; // ElementToArray WordAlias .ToArray .ElementToArray ARRAY elem_func ElementToArray: ^ IN aLambda Self aLambda DO .ElementToArray >>> Result ; // ElementToArray: WordAlias .ToArray: .ElementToArray: ARRAY FUNCTION ToArray: ^ IN Self VAR l_Value Self DO >>> l_Value RULES ( l_Value IsIntf ) [[ l_Value ]] DEFAULT ( l_Value .ToArray ) ; // RULES >>> Result ; // ToArray: elem_iterator InheritsEx Cached: ( VAR l_Inherits Self .Inherits >>> l_Inherits RULES ( l_Inherits .IsEmpty ) RULES ( Self .IsScriptKeyword ) ( ToArray: GarantModel::TtfwRegisterableWord ) DEFAULT [empty] ; // RULES DEFAULT l_Inherits ; // RULES ) >>> Result ; // InheritsEx BOOLEAN elem_func InheritsFrom ModelElement IN anAncestor anAncestor :Cached: ( RULES ( Self .IsNil ) false ( Self anAncestor .IsSameType ) true ( Self .InheritsEx .filter> ( anAncestor call.me ) .NotEmpty ) true DEFAULT false ; // RULES ) >>> Result ; // InheritsFrom USES UseNewGenExcluded.ms.dict ; BOOLEAN elem_func IsControllerInterfaces ( Self .IsStereotype st_ControllerInterfaces ) >>> Result ; // IsControllerInterfaces USES ForceUseNewGen.ms.dict ; BOOLEAN elem_func IsScriptKeywordsPack Self .IsStereotype st_ScriptKeywordsPack >>> Result ; // IsScriptKeywordsPack BOOLEAN elem_func IsUtilityPack Cached: ( RULES ( Self .IsStereotype st_UtilityPack ) true ( Self .IsScriptKeywordsPack ) true DEFAULT false ; // RULES ) >>> Result ; // IsUtilityPack BOOLEAN elem_func UseNewGenExcluded RULES ( Self .IsControllerInterfaces ) true ( Self GarantModel::vcmData .InheritsFrom ) true ( ( Self .IsUtilityPack ! ) AND ( Self GarantModel::Tl3Tag .InheritsFrom ) //( Self GarantModel::Tl3Variant .InheritsFrom ) //AND ( Self GarantModel::Tl3TagImpl .InheritsFrom ! ) AND ( Self GarantModel::TtfwKeyWordPrim .InheritsFrom ! ) ) true ( Self GarantModel::TddComboBoxConfigItem .InheritsFrom ) true ( Self GarantModel::Tl3ProtoObjectForTie ?== ) false ( Self GarantModel::Tl3ProtoObjectForTie .InheritsFrom ) true ( Self GarantModel::evdTagHolder .InheritsFrom ) true DEFAULT begin if ( g_UseNewGenExcluded .IsNil ) then Init_g_UseNewGenExcluded g_UseNewGenExcluded .IsNil ?FAIL 'Не инициализирован g_UseNewGenExcluded' g_UseNewGenExcluded .filter> ( Self .LUID == ) .NotEmpty end // DEFAULT ; // RULES >>> Result ; // UseNewGenExcluded CONST cNotFinished 'NOT_FINISHED_' CONST cNotCompleted 'NOT_COMPLETED_' STRING FUNCTION .CutFinished STRING IN Self Self cNotFinished .CutPrefix cNotCompleted .CutPrefix >>> Result ; // .CutFinished STRING elem_func CustomFinalFileName BOOLEAN IN aForCopy Self .? .FinalFileNamePrim >>> Result if ( Result .IsNotNil ) then begin Result '\' .CutPrefix >>> Result [ cRoot // - это потому, что в пути нету диска, а для ExtractFileName он нужен Result ] cPathSep strings:CatSep >>> Result end // ( Result .IsNotNil ) if ( Result .IsNotNil ) then begin if aForCopy then if ( Self .UseNewGenExcluded ) then begin VAR l_Path VAR l_Name Result sysutils:ExtractFilePath >>> l_Path Result sysutils:ExtractFileName >>> l_Name l_Name .CutFinished >>> l_Name cNotCompleted l_Name Cat >>> l_Name l_Path l_Name Cat >>> Result end // (Self .UseNewGenExcluded ) end // ( Result .IsNotNil ) ; // CustomFinalFileName STRING elem_func FinalFileName Self true .CustomFinalFileName >>> Result ; // FinalFileName STRING CompileTime-VAR g_TempFileName '' STRING CompileTime-VAR g_RealFileName '' STRING CompileTime-VAR g_FinalFileName '' STRING CompileTime-VAR g_FinalFileNameForUC '' BOOLEAN CompileTime-VAR g_UCRead false ModelElement CompileTime-VAR g_CurrentGeneratedElement nil CONST cGenScriptsFolder 'W:\common\GenScripts\' BOOLEAN elem_func CanCopyToFinalFile false >>> Result ; // CanCopyToFinalFile PROCEDURE DoDeleteFile STRING IN aFileName BOOLEAN IN aNeedBackup if aNeedBackup then begin aFileName BackupFile end // aNeedBackup aFileName DeleteFile DROP ; // DoDeleteFile elem_proc GenerateWordToFileWith: ^ IN aLambda TF g_Indent ( '' >>> g_Indent STRING VAR l_FileName [ Self .WordName .? Ext ] strings:Cat >>> l_FileName STRING VAR l_TempPath 'C:\Temp\GenScripts\' >>> l_TempPath l_TempPath ForceDirectories STRING VAR l_RealPath cGenScriptsFolder >>> l_RealPath l_RealPath ForceDirectories TF g_TempFileName ( [ l_TempPath l_FileName ] cPathSep strings:CatSep >>> g_TempFileName TF g_RealFileName ( [ l_RealPath l_FileName ] cPathSep strings:CatSep >>> g_RealFileName if ( g_TempFileName .TextNotInArray: g_GeneratedFiles ) then begin g_TempFileName .AddToArray: g_GeneratedFiles TF g_FinalFileName ( TF g_FinalFileNameForUC ( Self .FinalFileName >>> g_FinalFileName Self false .CustomFinalFileName >>> g_FinalFileNameForUC TF g_OutFile ( g_TempFileName MakePathAndOpenWrite >>> g_OutFile TF g_UCRead ( TF g_NeedOutLn ( TF g_CurrentGeneratedElement ( Self >>> g_CurrentGeneratedElement Self aLambda DO ) ) // TF g_NeedOutLn ) // TF g_UCRead ) // TF g_OutFile g_RealFileName g_TempFileName false CopyChangedFile if ( g_FinalFileName .IsNotNil ) then begin if ( Self .? .CanCopyToFinalFile ) then begin g_FinalFileName g_TempFileName true CopyChangedFile VAR l_Path VAR l_Name g_FinalFileName sysutils:ExtractFilePath >>> l_Path g_FinalFileName sysutils:ExtractFileName >>> l_Name VAR l_NameToDelete VAR l_FileToDelete if ( cNotCompleted l_Name StartsStr ! ) then begin l_Name cNotFinished .CutPrefix >>> l_NameToDelete [ l_Path cNotCompleted l_NameToDelete ] strings:Cat >>> l_FileToDelete if ( l_FileToDelete g_FinalFileName SameText ! ) then begin if ( l_FileToDelete sysutils:FileExists ) then begin l_FileToDelete true DoDeleteFile end // ( l_FileToDelete sysutils:FileExists ) end // ( l_FileToDelete g_FinalFileName SameText ! ) end // ( cNotCompleted l_Name StartsStr ! ) if ( cNotFinished l_Name StartsStr ! ) then begin l_Name cNotCompleted .CutPrefix >>> l_NameToDelete [ l_Path cNotFinished l_NameToDelete ] strings:Cat >>> l_FileToDelete if ( l_FileToDelete g_FinalFileName SameText ! ) then begin if ( l_FileToDelete sysutils:FileExists ) then begin l_FileToDelete true DoDeleteFile end // ( l_FileToDelete sysutils:FileExists ) end // ( l_FileToDelete g_FinalFileName SameText ! ) end // ( cNotFinished l_Name StartsStr ! ) end // ( Self .? .CanCopyToFinalFile ) end // ( g_FinalFileName .IsNotNil ) ) // TF g_FinalFileNameForUC ) // TF g_FinalFileName end // g_TempFileName .TextNotInArray: g_GeneratedFiles ) // TF g_RealFileName ) // TF g_TempFileName ) // TF g_Indent ; // GenerateWordToFileWith: elem_proc DeleteWordFile STRING VAR l_FileName [ Self .WordName .? Ext ] strings:Cat >>> l_FileName STRING VAR l_RealPath cGenScriptsFolder >>> l_RealPath TF g_RealFileName ( [ l_RealPath l_FileName ] cPathSep strings:CatSep >>> g_RealFileName if ( g_RealFileName sysutils:FileExists ) then begin g_RealFileName true DoDeleteFile end // ( g_RealFileName sysutils:FileExists ) ) // TF g_RealFileName ; // DeleteWordFile BOOLEAN elem_func IsServiceImplementation Self .IsStereotype st_ServiceImplementation >>> Result ; // IsServiceImplementation BOOLEAN elem_func IsService Self .IsStereotype st_Service >>> Result ; // IsService BOOLEAN elem_func IsTestCase Self .IsStereotype st_TestCase >>> Result ; // IsTestCase BOOLEAN elem_func IsTestLibrary Self .IsStereotype st_TestLibrary >>> Result ; // IsTestLibrary BOOLEAN elem_func IsTestUnit Self .IsStereotype st_TestUnit >>> Result ; // IsTestUnit BOOLEAN elem_func IsUnit Self .IsStereotype st_Unit >>> Result ; // IsUnit BOOLEAN elem_func IsImpl Self .IsStereotype st_Impl >>> Result ; // IsImpl BOOLEAN elem_func IsLibrary Self .IsStereotype st_Library >>> Result ; // IsLibrary BOOLEAN elem_func IsVCMModule Self .IsStereotype st_VCMModule >>> Result ; // IsVCMModule BOOLEAN elem_func IsVCMCustomForm Self .IsStereotype st_VCMCustomForm >>> Result ; // IsVCMCustomForm BOOLEAN elem_func IsVCMDataModule Self .IsStereotype st_VCMDataModule >>> Result ; // IsVCMDataModule BOOLEAN elem_func IsVCMForm Self .IsStereotype st_VCMForm >>> Result ; // IsVCMForm BOOLEAN elem_func IsVCMContainer Self .IsStereotype st_VCMContainer >>> Result ; // IsVCMContainer BOOLEAN elem_func IsVCMMainForm Self .IsStereotype st_VCMMainForm >>> Result ; // IsVCMMainForm BOOLEAN elem_func IsGuiControl Self .IsStereotype st_GuiControl >>> Result ; //IsGuiControl BOOLEAN elem_func IsUseCaseController Self .IsStereotype st_UseCaseController >>> Result ; // IsUseCaseController BOOLEAN elem_func IsViewAreaController Self .IsStereotype st_ViewAreaController >>> Result ; // IsViewAreaController BOOLEAN elem_func IsUseCaseControllerImp Self .IsStereotype st_UseCaseControllerImp >>> Result ; // IsUseCaseControllerImp BOOLEAN elem_func IsViewAreaControllerImp Self .IsStereotype st_ViewAreaControllerImp >>> Result ; // IsViewAreaControllerImp BOOLEAN elem_func IsSimpleClass Cached: ( RULES ( Self .IsUseCaseControllerImp ) ( Self .Abstraction at_abstract != ) ( Self .IsViewAreaControllerImp ) ( Self .Abstraction at_abstract != ) ( Self .IsStereotype st_SimpleClass ) true ( Self .IsStereotype st_ObjStub ) true ( Self .IsService ) true ( Self .IsServiceImplementation ) true ( Self .IsScriptKeyword ) true ( Self .IsTestCase ) true ( Self .IsGuiControl ) true ( Self .IsVCMForm ) true ( Self .IsStereotype st_VCMFinalForm ) true ( Self .IsVCMContainer ) true ( Self .IsStereotype st_VCMFinalContainer ) true DEFAULT false ; // RULES ) >>> Result ; // IsSimpleClass BOOLEAN elem_func IsInternalInterfaces Self .IsStereotype st_InternalInterfaces >>> Result ; // IsInternalInterfaces BOOLEAN elem_func IsInterfaces Cached: ( RULES ( Self .IsStereotype st_Interfaces ) true ( Self .IsInternalInterfaces ) true DEFAULT false ; // RULES ) >>> Result ; // IsInterfaces : .SecondElement ARRAY IN anArray ModelElement VAR l_Found nil >>> l_Found INTEGER VAR l_Index 0 >>> l_Index anArray .trunc> ( DROP l_Index < 2 ) .for> ( IN anItem ( l_Index 1 == ) ? ( anItem >>> l_Found ) INC l_Index ) // anArray .trunc> ( DROP l_Index < 2 ) .for> l_Found ; // .SecondElement ModelElement CompileTime-VAR g_DefaultInterfaceAncestor nil BOOLEAN elem_func IsTypedef Self .IsStereotype st_Typedef >>> Result ; // IsTypedef BOOLEAN elem_func IsPointer Self .UPisTrue "isPointer" >>> Result ; // IsPointer ModelElement elem_func MainAncestorPrim Self .InheritsEx .FirstElement >>> Result ; // MainAncestorPrim BOOLEAN elem_func IsInterface Cached: ( RULES ( Self .IsStereotype st_ObjStub ) false ( Self .IsStereotype st_Facet ) true ( Self .IsStereotype st_Interface ) true ( Self .Name 'object' == ) true ( Self .IsTypedef ) RULES ( Self .IsPointer ) false DEFAULT ( Self .MainAncestorPrim call.me ) ; // RULES DEFAULT false ; // RULES ) >>> Result ; // IsInterface BOOLEAN elem_func IsPureMixIn Self .IsStereotype st_PureMixIn >>> Result ; // IsPureMixIn BOOLEAN elem_func IsTestCaseMixIn Self .IsStereotype st_TestCaseMixIn >>> Result ; // IsTestCaseMixIn BOOLEAN elem_func IsMixIn Cached: ( RULES ( Self .IsStereotype st_Impurity ) true ( Self .IsTestCaseMixIn ) true ( Self .IsVCMCustomForm ) RULES ( Self .Abstraction at_abstract == ) RULES ( Self .MainAncestorPrim .IsNil ) true ( Self .MainAncestorPrim call.me ) true DEFAULT false ; // RULES DEFAULT false ; // RULES /*{ ( Self .IsUseCaseController ) ( Self .Abstraction at_abstract == ) ( Self .IsViewAreaController ) ( Self .Abstraction at_abstract == )}*/ ( Self .IsUseCaseControllerImp ) ( Self .Abstraction at_abstract == ) ( Self .IsViewAreaControllerImp ) ( Self .Abstraction at_abstract == ) DEFAULT false ; // RULES ) >>> Result ; // IsMixIn BOOLEAN elem_func IsVCMFormSetFactory Self .IsStereotype st_VCMFormSetFactory >>> Result ; // IsVCMFormSetFactory BOOLEAN elem_func IsVCMFormsPack Self .IsStereotype st_VCMFormsPack >>> Result ; // IsVCMFormsPack ModelElement elem_func DefaultAncestor Cached: ( RULES ( Self .IsMixIn ) nil ( Self .IsVCMFormSetFactory ) GarantModel::TvcmFormSetFactory ( Self .IsVCMFormsPack ) GarantModel::TvcmModule ( Self .IsVCMContainer ) GarantModel::TvcmContainerForm ( Self .IsVCMMainForm ) GarantModel::TvcmMainForm ( Self .IsVCMDataModule ) GarantModel::TDataModule ( Self .IsVCMCustomForm ) GarantModel::TvcmEntityForm ( Self .Abstraction at_abstract == ) nil ( Self .IsViewAreaController ) GarantModel::IvcmViewAreaController ( Self .IsUseCaseController ) GarantModel::IvcmUseCaseController DEFAULT nil ; // RULES ) >>> Result ; // DefaultAncestor ModelElement elem_func MainAncestor Cached: ( RULES ( Self .IsPointer ) ( Self .MainAncestorPrim ) ( Self .IsTypedef ) ( Self .MainAncestorPrim ) ( Self .IsPureMixIn ) ( Self .MainAncestorPrim ) ( Self .IsInterface ) ( RULES ( ( g_DefaultInterfaceAncestor .IsNotNil ) AND ( g_DefaultInterfaceAncestor Self != ) AND ( Self .MainAncestorPrim .IsNil ) ) g_DefaultInterfaceAncestor DEFAULT ( Self .MainAncestorPrim ) ; // RULES ) DEFAULT ( Self .MainAncestorPrim ) ; // RULES >>> Result RULES ( Result .IsNil ) ( Self .DefaultAncestor ) DEFAULT Result ; // RULES ) >>> Result ; // MainAncestor BOOLEAN elem_func IsRange Self .IsStereotype st_Range >>> Result ; // IsRange BOOLEAN elem_func IsEnum Self .IsStereotype st_Enum >>> Result ; // IsEnum BOOLEAN elem_func IsFunction Self .IsStereotype st_Function >>> Result ; // IsFunction BOOLEAN elem_func IsRecord RULES ( Self .IsStereotype st_Struct ) true ( Self .IsTypedef ) RULES ( Self .IsPointer ) false DEFAULT ( Self .MainAncestor call.me ) ; // RULES DEFAULT false ; // RULES >>> Result ; // IsRecord BOOLEAN elem_func IsDefine Self .IsStereotype st_Define >>> Result ; // IsDefine BOOLEAN elem_func IsUndef Self .IsStereotype st_Undef >>> Result ; // IsUndef BOOLEAN elem_func IsUnion Self .IsStereotype st_Union >>> Result ; // IsUnion BOOLEAN elem_func IsRecordOrUnion RULES ( Self .IsRecord ) true ( Self .IsUnion ) true DEFAULT false ; // RULES >>> Result ; // IsRecordOrUnion BOOLEAN elem_func IsStaticObject Self .IsStereotype st_StaticObject >>> Result ; // IsStaticObject BOOLEAN elem_func IsRecordOrUnionOrStaticObject RULES ( Self .IsRecordOrUnion ) true ( Self .IsStaticObject ) true DEFAULT false ; // RULES >>> Result ; // IsRecordOrUnionOrStaticObject BOOLEAN elem_func CannotFinalizeProperty RULES ( Self .IsRecordOrUnionOrStaticObject ) true ( Self .IsMixInParamType ) true ( Self .IsOpenArray ) false ( Self .IsArray ) true DEFAULT false ; // RULES >>> Result ; // CannotFinalizeProperty BOOLEAN elem_func IsElementProxy Self .IsStereotype st_ElementProxy >>> Result ; // IsElementProxy BOOLEAN elem_func IsSetOf Self .IsStereotype st_SetOf >>> Result ; // IsSetOf BOOLEAN elem_func IsException Self .IsStereotype st_Exception >>> Result ; // IsException BOOLEAN elem_func IsTagTable Self .IsStereotype st_TagTable >>> Result ; // IsTagTable BOOLEAN elem_func IsVCMGUI Self .IsStereotype st_VCMGUI >>> Result ; // IsVCMGUI BOOLEAN elem_func IsTestTarget Self .IsStereotype st_TestTarget >>> Result ; // IsTestTarget BOOLEAN elem_func IsVCMUseCaseRealization Self .IsStereotype st_VCMUseCaseRealization >>> Result ; // IsVCMUseCaseRealization BOOLEAN elem_func IsVCMUseCase Self .IsStereotype st_VCMUseCase >>> Result ; // IsVCMUseCase BOOLEAN elem_func IsVCMTestTarget Self .IsStereotype st_VCMTestTarget >>> Result ; // IsVCMTestTarget BOOLEAN elem_func IsExeTarget Self .IsStereotype st_ExeTarget >>> Result ; // IsExeTarget BOOLEAN elem_func IsExe RULES ( Self .IsExeTarget ) true ( Self .IsTestTarget ) true ( Self .IsVCMGUI ) true DEFAULT false ; // RULES >>> Result ; // IsExe BOOLEAN elem_func IsAdapterTarget Self .IsStereotype st_AdapterTarget >>> Result ; // IsAdapterTarget BOOLEAN elem_func IsDLL Self .IsAdapterTarget >>> Result ; // IsDLL BOOLEAN elem_func IsTarget Cached: ( RULES ( Self .IsVCMGUI ) true ( Self .IsExe ) true ( Self .IsDLL ) true DEFAULT false ; // RULES ) >>> Result ; // IsTarget BOOLEAN elem_func IsAtom Self .IsStereotype st_Atom >>> Result ; // IsAtom BOOLEAN elem_func IsTag Self .IsStereotype st_Tag >>> Result ; // IsTag BOOLEAN elem_func IsEvdSchemaElement Self .IsAtom >>> Result ; // IsEvdSchemaElement BOOLEAN elem_func IsClassOrMixIn Cached: ( RULES ( Self .IsSimpleClass ) true ( Self .IsMixIn ) true DEFAULT false ; // RULES ) >>> Result ; // IsClassOrMixIn BOOLEAN elem_func IsTestClass Self .IsStereotype st_TestClass >>> Result ; // IsTestClass BOOLEAN elem_func IsUserType Self .IsStereotype st_UserType >>> Result ; // IsUserType BOOLEAN elem_func IsScriptKeywords Self .IsStereotype st_ScriptKeywords >>> Result ; // IsScriptKeywords BOOLEAN elem_func IsTestResults Self .IsStereotype st_TestResults >>> Result ; // IsTestResults BOOLEAN elem_func NeedOwnFilePrim Cached: ( RULES ( Self .IsNil ) false ( Self .IsScriptKeywords ) false ( Self .IsUserType ) true ( Self .IsTestClass ) true ( Self .IsEvdSchemaElement ) true ( Self .IsTarget ) true ( Self .IsTestResults ) true ( Self .IsTagTable ) true ( Self .IsInterfaces ) true ( Self .IsUtilityPack ) true ( Self .IsMixIn ) true ( Self .IsElementProxy ) true ( Self .IsVCMFormSetFactory ) true ( Self .IsVCMCustomForm ) true ( Self .IsTestLibrary ) RULES ( Self .FinalFileName .IsNil ) false DEFAULT true ; // RULES ( Self .IsTestUnit ) true ( Self .IsUnit ) false ( Self .IsImpl ) false ( Self .IsLibrary ) false ( Self .IsSimpleClass ) begin RULES ( Self .Visibility ProtectedAccess == ) false ( Self .Visibility PrivateAccess == ) RULES ( Self .IsScriptKeyword ) RULES ( Self .Parent .IsVCMModule ) true DEFAULT false ; // RULES DEFAULT false ; // RULES DEFAULT ( ModelElement VAR l_Parent Self .Parent >>> l_Parent RULES ( l_Parent .IsScriptKeywordsPack AND ( Self .IsScriptKeyword ) ) true ( l_Parent .IsClassOrMixIn ) false ( l_Parent .IsUtilityPack ) false ( l_Parent .IsInterfaces ) false DEFAULT true ; // RULES ) ; // RULES end // ( Self .IsSimpleClass ) DEFAULT false ; // RULES ) >>> Result ; // NeedOwnFilePrim elem_proc CurrentGenerator Self g_CurrentGenerator DO ; // CurrentGenerator USES CallInherited.ms.dict ; USES classRelations.ms.dict ; BOOLEAN elem_func NeedOwnFile Self .? .NeedOwnFilePrim >>> Result ; // NeedOwnFile PROCEDURE OutLn if g_NeedOutLn then OutLnToFile true >>> g_NeedOutLn ; // OutLn elem: WithDelim STRING IN aDelim TtfwWord IN aVar TtfwWord IN aLambda [ if ( aVar DO ! ) then begin true aVar pop:Word:SetValue end else begin aDelim end Self ] aLambda DO ; // WithDelim elem: WithComma: ^ IN aVar ^ IN aLambda Self ', ' aVar aLambda .WithDelim ; // WithComma: STRING FUNCTION .CutT STRING IN aName aName 'T' .CutPrefix >>> Result ; // .CutT CONST cProxy '_Proxy' STRING elem_func UnitNamePrim GenCached: ( STRING VAR l_Path Self .FinalFileName >>> l_Path RULES ( l_Path .IsNotNil ) ( l_Path sysutils:ExtractFileName cEmptyStr sysutils:ChangeFileExt ) ( Self .IsNil ) cEmptyStr ( Self .IsElementProxy ) ( Self .Name cProxy Cat ) ( Self .IsTagTable ) ( Self .Name '_Schema' Cat ) ( Self .IsScriptKeyword ) ( Self .Name .CutT ) ( Self .IsSimpleClass ) ( Self .Name .CutT ) DEFAULT ( Self .Name ) ; // RULES >>> Result if ( Self .UseNewGenExcluded ) then begin Result .CutFinished >>> Result cNotCompleted Result Cat >>> Result end // ( Self .UseNewGenExcluded ) Result ) >>> Result ; // UnitNamePrim STRING elem_func UnitName GenCached: ( Self .UnitNamePrim .CutFinished ) >>> Result ; // UnitName ModelElement elem_func UnitProducer GenCached: ( RULES ( Self .IsNil ) nil ( Self IsString ) Self ( Self .NeedOwnFile ) Self DEFAULT ( Self .Parent call.me ) ; // RULES ) >>> Result ; // UnitProducer STRING elem_func EffectiveUnitName GenCached: ( Self .UnitProducer .UnitName ) >>> Result ; // EffectiveUnitName ARRAY FUNCTION .filterNil> ARRAY IN anArray anArray .filter> .IsNotNil >>> Result ; // .filterNil> ARRAY FUNCTION .filterMixIns> ARRAY IN anArray anArray .filter> ( .IsMixIn ! ) // .filter> ( .IsPureMixIn ! ) >>> Result ; // .filterMixIns> BOOLEAN elem_func IsMethod Self .IsStereotype st_method >>> Result ; // IsMethod BOOLEAN elem_func IsMessageOperation Self .IsStereotype st_message::Operation >>> Result ; // IsMessageOperation BOOLEAN elem_func IsMessage Self .IsStereotype st_Message >>> Result ; // IsMessage BOOLEAN elem_func IsLocalMethod Self .IsStereotype st_localmethod >>> Result ; // IsLocalMethod ModelElement elem_func KeywordOperation Self .SpelledFor >>> Result ; // KeywordOperation ModelElement elem_func KeywordImplementationMethod Self .Stub >>> Result ; // KeywordImplementationMethod ModelElement elem_func KeywordObjectToOperate Self .Speller >>> Result ; // KeywordObjectToOperate BOOLEAN elem_func IsKeyWord Self .IsStereotype st_keyword::Operation >>> Result ; // IsKeyWord BOOLEAN elem_func IsGlobalKeyWord Self .IsStereotype st_globalkeyword::Operation >>> Result ; // IsGlobalKeyWord BOOLEAN elem_func IsSomeKeyWord RULES ( Self .IsKeyWord ) true ( Self .IsGlobalKeyWord ) true DEFAULT false ; // RULES >>> Result ; // IsSomeKeyWord USES axiom:CompiledProcedure axiom:KeyValues ; USES KeyValuesCreateAndDo.ms.dict ; elem: DecorateMethodAndDo: ^ IN aLambda KeyValuesCreateAndDo: ( IN aMethod aMethod -> Original := ( Self .WeakRef ) aMethod aLambda DO ) // KeyValuesCreateAndDo: ; // DecorateMethodAndDo: INTERFACE elem_func DecorateMethod: ^ IN aLambda Self .DecorateMethodAndDo: ( IN aMethod aMethod pop:Word:Box >>> Result aMethod aLambda DO ) // Self .DecorateMethodAndDo: ; // DecorateMethod: INTERFACE FUNCTION MakeParam: STRING IN aName ModelElement IN aType ^ IN aLambda KeyValuesCreateAndDo: ( IN l_Param l_Param pop:Word:Box >>> Result l_Param -> Name := aName if ( aType .IsNotNil ) then begin l_Param -> Target := aType end // ( aType .IsNotNil ) l_Param aLambda DO ) // KeyValuesCreateAndDo: ; // MakeParam: INTERFACE FUNCTION MakeParam STRING IN aName ModelElement IN aType aName aType MakeParam: DROP >>> Result ; // MakeParam WordAlias MakeFunction MakeParam WordAlias MakeFunction: MakeParam: WordAlias MakeField MakeParam WordAlias MakeField: MakeParam: WordAlias MakeProperty MakeParam WordAlias MakeProperty: MakeParam: : MakeProcedure nil MakeFunction ; // MakeProcedure MACRO MakeProcedure: 'nil' Ctx:Parser:PushSymbol 'MakeFunction:' Ctx:Parser:PushSymbol ; // MakeProcedure: STRING elem_func SelfName Self .GetUP 'extprop:rc:SelfName' >>> Result if ( Result .IsNil ) then begin Self .TypeName >>> Result end else begin Result ToPrintable >>> Result end // ( Result .IsNil ) ; // SelfName INTERFACE elem_func ValueParam Cached: ( 'aValue' Self MakeParam ) >>> Result ; // ValueParam BOOLEAN FUNCTION .HasSomeOf: ARRAY IN anArray ^ IN aCompareFunc anArray .filter> ( aCompareFunc DO ) .NotEmpty >>> Result ; // .HasSomeOf: BOOLEAN elem_func HasName STRING IN aName Self .Name aName == >>> Result ; // HasName BOOLEAN FUNCTION .HasModelElementWithName ARRAY IN anArray STRING IN aName anArray .HasSomeOf: ( aName .HasName ) >>> Result ; // .HasModelElementWithName ModelElement elem_func OpSelfParam Cached: ( 'a' Self .SelfName Cat Self MakeParam ) >>> Result ; // OpSelfParam ModelElement elem_func CtxParam Cached: ( 'aCtx' Self MakeParam ) >>> Result ; // CtxParam BOOLEAN elem_func IsCreator Self .IsStereotype st_creator::Operation >>> Result ; // IsCreator BOOLEAN elem_func IsVarWorker RULES ( Self .IsStereotype st_varworker::Operation ) true ( Self .IsStereotype st_globalvarworker::Operation ) true DEFAULT false ; // RULES >>> Result ; // IsVarWorker BOOLEAN elem_func IsWordWorker RULES ( Self .IsStereotype st_wordworker::Operation ) true ( Self .IsStereotype st_globalwordworker::Operation ) true DEFAULT false ; // RULES >>> Result ; // IsWordWorker STRING elem_func NameForScript Self .GetUP "NameForScript" ToPrintable >>> Result ; // NameForScript USES string.ms.dict ; STRING FUNCTION RemoveDuplicatedIfDef STRING IN aValue cEmptyStr >>> Result ARRAY VAR l_Outed [] >>> l_Outed aValue ',' string:Split:for> ( IN aSubstr aSubstr string:Trim >>> aSubstr if ( aSubstr .IsNotNil ) if ( aSubstr .TextNotInArray: l_Outed ) then begin aSubstr .AddToArray: l_Outed if ( Result .IsNil ) then ( aSubstr >>> Result ) else ( Result ',' aSubstr Cat Cat >>> Result ) end // ( aSubstr .TextNotInArray: l_Outed ) ) // aValue ',' string:Split:for> ; // RemoveDuplicatedIfDef ModelElement CompileTime-VAR g_Implementor nil FORWARD .MainAncestorThatNotMixIn STRING elem_func IfDefStr Cached: ( Self .GetUP "ifdef" >>> Result VAR l_Parent Self .Parent >>> l_Parent if ( l_Parent .IsNotNil ) then begin VAR l_ParentIfDefStr l_Parent call.me >>> l_ParentIfDefStr if ( l_ParentIfDefStr .IsNotNil ) then begin if ( Result .IsNil ) then begin l_ParentIfDefStr >>> Result end // ( Result .IsNil ) else begin l_ParentIfDefStr ',' Result Cat Cat >>> Result end // ( Result .IsNil ) end // ( l_ParentIfDefStr .IsNotNil ) end // ( l_Parent .IsNotNil ) Result RemoveDuplicatedIfDef ) >>> Result ; // IfDefStr STRING elem_func IfNDefStr Cached: ( Self .GetUP "ifndef" >>> Result VAR l_Parent Self .Parent >>> l_Parent if ( l_Parent .IsNotNil ) then begin VAR l_ParentIfDefStr l_Parent call.me >>> l_ParentIfDefStr if ( l_ParentIfDefStr .IsNotNil ) then begin if ( Result .IsNil ) then begin l_ParentIfDefStr >>> Result end // ( Result .IsNil ) else begin l_ParentIfDefStr ',' Result Cat Cat >>> Result end // ( Result .IsNil ) end // ( l_ParentIfDefStr .IsNotNil ) end // ( l_Parent .IsNotNil ) Result RemoveDuplicatedIfDef ) >>> Result ; // IfNDefStr BOOLEAN elem_func IsControlOverride Self .IsStereotype st_ControlOverride >>> Result ; // IsControlOverride BOOLEAN elem_func IsControlPrim Self .IsStereotype st_ControlPrim >>> Result ; // IsControlPrim BOOLEAN elem_func IsComponent Self .IsStereotype st_Component >>> Result ; // IsComponent elem_iterator ImplementsEx Self .Implements >>> Result ; // ImplementsEx /*{ f _CollectControlsPrim <{}{%C#f_IsControl()=true}{}\ [{%C#f_IsOverride()!=true}\ [{%f_exists_in_list(CONTROLS,C)!=true}\ %f_add_to_list(CONTROLS,C)\ ]\ ]\ %f_CollectControlsPrim(%C)\ > f _CollectControls %f_CollectControlsPrim(%S)\ <%f_CollectControls(%G)>\ <%f_CollectControls(%R)> }*/ elem_iterator CollectControls Cached: ( VAR l_Controls [] >>> l_Controls elem_proc CollectControlsPrim Self .Attributes .filter> .IsControlPrim .filter> ( .IsControlOverride ! ) .filter> ( .NotInArray: l_Controls ) .for> ( IN aControl aControl .AddToArray: l_Controls aControl call.me ) // .for> ; // CollectControlsPrim elem_proc DoCollectControls Self .CollectControlsPrim Self .InheritsEx .for> call.me Self .ImplementsEx .for> call.me ; // DoCollectControls Self .DoCollectControls l_Controls ) >>> Result ; // CollectControls elem_iterator ScriptKeywordsPackProperties Cached: ( VAR l_Properties Self .Attributes .filter> ( .IsStereotype st_property::Attribute ) >>> l_Properties l_Properties Self .InheritsEx .filter> .IsVCMForm .filter> ( .Abstraction at_final == ) .for> ( IN aForm aForm .CollectControls .filter> ( .Visibility PublicAccess == ) .filter> ( .MainAncestor .NotIsNil ) .for> ( IN aControl VAR l_Name aControl .Name >>> l_Name if ( l_Properties l_Name .HasModelElementWithName ! ) then begin .join> ToArray: ( l_Name aControl .MainAncestor MakeProperty: ( IN aMade aMade -> UID := ( [ aForm .LUID '_' aControl .LUID '_Control' ] strings:Cat ) aMade -> Parent := ( Self .WeakRef ) aMade -> %SUM := ( [ 'Контрол ' l_Name ' формы ' aForm .TypeName ] strings:Cat ) aMade -> "NameForScript" := ( [ '.' aForm .TypeName '.' l_Name ] strings:Cat ) aMade -> Stereotype := st_readonly::Attribute aMade -> "mapped" := true aMade -> "ifdef" := ( aControl .GetUP "ifdef" ) aMade -> "ifndef" := ( aControl .GetUP "ifndef" ) ) // MakeProperty: ) // .join> ToArray: end // ( l_Properties l_Name .HasModelElementWithName ! ) ) // .for> ) // .for> ) >>> Result ; // ScriptKeywordsPackProperties elem_iterator OperationsEx Cached: ( VAR l_Operations Self .Operations >>> l_Operations l_Operations RULES ( Self .IsScriptKeyword ) begin VAR l_Op Self .KeywordOperation >>> l_Op if ( ( l_Op .IsNotNil ) AND ( l_Op .IsSomeKeyWord ) ) then begin if ( ( l_Op .GetUP 'extprop:prop_stereo' .IsValueValid ) OR ( l_Op .UPisTrue "lvalue" ) ) then begin if ( ( l_Op .UPisTrue "mapped" ! ) AND ( l_Op .GetUP 'extprop:prop_stereo' 'readonly' ?!= ) ) then begin if ( l_Operations 'DoSetValue' .HasModelElementWithName ! ) then begin .join> ToArray: ( 'DoSetValue' MakeProcedure: ( IN aMade VAR l_Self Self .KeywordObjectToOperate >>> l_Self aMade -> UID := ( Self .LUID '_DoSetValue' Cat ) aMade -> %SUM := ( 'Метод установки значения свойства ' l_Op .Name Cat ) aMade -> Stereotype := st_static::Operation aMade -> Visibility := ProtectedAccess aMade -> Abstraction := at_final aMade -> Parameters := ( ToArray: ( l_Self .OpSelfParam ) .join> ( l_Op .Parameters ) .join> ToArray: ( l_Op .Target .ValueParam ) ) // aMade -> Parameters ) // MakeProcedure: ) // .join> ToArray: end // ( l_Operations 'DoSetValue' .HasModelElementWithName ! ) end // ( l_Op .UPisTrue "mapped" ! ) end // ( l_Op .GetUP 'extprop:prop_stereo' .IsValueValid ) VAR l_Self Self .KeywordObjectToOperate >>> l_Self if ( ( l_Op .UPisTrue "mapped" ) OR ( l_Self .NotIsNil ) OR ( l_Op .Parameters .NotEmpty ) OR ( l_Op .Target .NotIsNil ) OR ( l_Op .IsVarWorker ) ) then begin VAR l_Name l_Op .Name >>> l_Name if ( l_Operations l_Name .HasModelElementWithName ! ) then begin .join> ToArray: ( l_Name if ( l_Op .IsCreator ) then begin l_Self end // ( l_Op .IsCreator ) else begin l_Op .Target end // ( l_Op .IsCreator ) MakeFunction: ( IN aMade aMade -> UID := ( l_Op .LUID ) // - пусть лучше мапируется на порождащую операцию, чтобы при переносе класса - не переделывать aMade -> %SUM := ( 'Реализация слова скрипта ' Self .NameForScript Cat ) aMade -> Visibility := PrivateAccess aMade -> Abstraction := at_final aMade -> IsSummoned := true // - это можно убрать, если перенести сюда вот что: /*{ ( ( Self .OpKind opkind_Normal == ) // - метод новый, а не перекрытый AND ( l_Op .IsNotNil ) AND ( l_Self .IsNotNil ) AND ( l_Implementor .IsSummoned ) AND ( l_Op .UPisTrue "mapped" ) ) Code: ( [ ' ' if ( Self .Target .IsNotNil ) then begin 'Result := ' end 'a' l_Self .SelfName cDot l_Op .Name l_Op .ParametersList ';' ] .Out ) }*/ aMade -> SpelledFor := ( l_Op .WeakRef ) aMade -> Parameters := ( ToArray: ( GarantModel::TtfwContext .CtxParam ) if ( l_Op .IsVarWorker ) then begin .join> [ if ( l_Op .IsWordWorker ) then 'aWord' else 'aVar' GarantModel::TtfwWord MakeParam ] // .join> end // ( l_Op .IsVarWorker ) if ( l_Op .IsCreator ! ) then begin if ( l_Self .NotIsNil ) then begin .join> ToArray: ( l_Self .OpSelfParam ) end // ( l_Self .NotIsNil ) end // ( l_Op .IsCreator ! ) .join> ( l_Op .Parameters ) ) // aMade -> Parameters VAR l_Ref Self .WeakRef >>> l_Ref l_Ref -> Stub := ( aMade .WeakRef ) // - обратная ссылка для l_Call // %{Class_Inst}%f_set_var(Stub,{Op_Instance})\ ) // MakeFunction: ) // .join> ToArray: end // ( l_Operations l_Name .HasModelElementWithName ! ) end // ( l_Op .UPisTrue "mapped" ) end // ( l_Op .IsNotNil ) end // ( Self .IsScriptKeyword ) ( Self .IsScriptKeywordsPack ) begin Self .ScriptKeywordsPackProperties .for> ( IN aProp VAR l_Name aProp .Name >>> l_Name if ( l_Operations l_Name .HasModelElementWithName ! ) then begin .join> ToArray: ( l_Name aProp .Target MakeFunction: ( IN aMade aMade -> UID := ( aProp .LUID ) aMade -> Parent := ( aProp .Parent .WeakRef ) aMade -> Stereotype := st_keyword::Operation aMade -> %SUM := ( aProp .Documentation ) aMade -> "NameForScript" := ( aProp .GetUP "NameForScript" ) if ( aProp .IsStereotype st_readonly::Attribute ) then begin aMade -> 'extprop:prop_stereo' := 'readonly' end // ( aProp .IsStereotype st_readonly::Attribute ) else begin aMade -> 'extprop:prop_stereo' := 'property' end // ( aProp .IsStereotype st_readonly::Attribute ) aMade -> 'extprop:prop_name' := l_Name aMade -> "mapped" := ( aProp .GetUP "mapped" ) aMade -> "is immediate" := ( aProp .GetUP "is immediate" ) aMade -> "ifdef" := ( aProp .GetUP "ifdef" ) aMade -> "ifndef" := ( aProp .GetUP "ifndef" ) ) // MakeFunction: ) // .join> ToArray: end // ( l_Operations l_Name .HasModelElementWithName ! ) ) // .for> end // ( Self .IsScriptKeywordsPack ) ; // RULES ) >>> Result ; // OperationsEx ModelElement elem_func FirstOperation Cached: ( Self .OperationsEx .filter> ( .IsLocalMethod ! ) .FirstElement ) >>> Result ; // FirstOperation BOOLEAN elem_func IsFacetIterator Self .IsStereotype st_facetiterator >>> Result ; // IsFacetIterator BOOLEAN elem_func IsMixInMirror Self .IsStereotype st_MixInMirror >>> Result ; // IsMixInMirror BOOLEAN elem_func IsVCMOperations Self .IsStereotype st_VCMOperations >>> Result ; // IsVCMOperations BOOLEAN elem_func IsClassImplementable Cached: ( RULES ( Self .IsPureMixIn ) false ( Self .IsMixIn ) false ( Self .IsSimpleClass ) false ( Self .IsEvdSchemaElement ) false ( Self .IsMixInMirror ) false ( Self .IsStereotype st_UseCase ) false ( Self .IsVCMOperations ) false ( Self .IsInterface ) true ( Self .IsTypedef ) RULES ( Self .IsPointer ) false DEFAULT ( Self .MainAncestor call.me ) ; // RULES DEFAULT true ; // RULES ) >>> Result ; // IsClassImplementable BOOLEAN elem_func IsImplements Self .IsStereotype st_implements::Dependency >>> Result ; // IsImplements ARRAY FUNCTION .mapToTarget> ARRAY IN anArray anArray .map> .Target >>> Result ; // .mapToTarget> WordAlias .KeepInStack NOP ARRAY FUNCTION array:Copy IN anArray RULES ( anArray .IsNil ) [nil] DEFAULT ( VAR l_Empty true >>> l_Empty [ anArray .for> ( // .KeepInStack // - это теперь не нужно, непустой функтор и так есть false >>> l_Empty ) // anArray .for> ] RULES l_Empty ( DROP [nil] ) ; // RULES ) ; // RULES >>> Result ; // array:Copy ARRAY FUNCTION array:CopyNotNil IN anArray [ anArray .for> .KeepInStack ] >>> Result ; // array:CopyNotNil elem_iterator ImplementsInDependencies Cached: ( Self .Dependencies .filter> .IsImplements .mapToTarget> array:Copy ) >>> Result ; // ImplementsInDependencies elem_iterator ForClassImplements Self .ImplementsEx .filter> .IsClassImplementable >>> Result ; // ForClassImplements elem_iterator ClassImplementsPrim Self .ForClassImplements >>> Result ; // ClassImplementsPrim BOOLEAN elem_func InTie Cached: ( RULES ( Self .IsNil ) false ( Self .GetUP "gui" 'tie' ?== ) true ( Self .Parent call.me ) true DEFAULT false ; // RULES ) >>> Result ; // InTie elem_iterator InterfaceForClassImplements Self .ForClassImplements .filter> ( .InTie ! ) >>> Result ; // InterfaceForClassImplements ARRAY FUNCTION .joinWithLambded> ARRAY IN anArrayToJoin ^ IN anArrayToIterate ^ IN aLambda anArrayToJoin anArrayToIterate DO .for> ( IN aChild VAR l_Other ( aChild aLambda DO ) >>> l_Other if ( l_Other .IsNotNil ) then begin .join> l_Other end // ( l_Other .IsNotNil ) ) >>> Result ; // .joinWithLambded> BOOLEAN elem_func IsMixInOrMixInMirror RULES ( Self .IsMixIn ) true ( Self .IsMixInMirror ) true DEFAULT false ; // RULES >>> Result ; // IsMixInOrMixInMirror BOOLEAN elem_func SomeAncestorImplements ModelElement IN anIntf BOOLEAN elem_func ImplementsLoc Self .ImplementsEx .filter> ( anIntf .IsSameType ) .NotEmpty >>> Result ; // ImplementsLoc anIntf :Cached: ( RULES ( Self .IsTypedef ) RULES ( Self .IsPointer ) false DEFAULT ( Self .MainAncestorPrim anIntf call.me ) ; // RULES ( Self .InheritsEx .filter> ( anIntf .IsSameType ) .NotEmpty ) true ( Self .InheritsEx .filter> .ImplementsLoc .NotEmpty ) true ( Self .InheritsEx .filter> ( anIntf call.me ) .NotEmpty ) true ( Self .ImplementsEx .filter> .IsMixInOrMixInMirror .filter> .ImplementsLoc .NotEmpty ) true ( Self .ImplementsEx .filter> .IsMixInOrMixInMirror .filter> ( anIntf call.me ) .NotEmpty ) true DEFAULT false ; // RULES ) >>> Result ; // SomeAncestorImplements elem_iterator ClassImplements ( Self .ClassImplementsPrim .joinWithLambded> ( Self .ClassImplementsPrim ) .InterfaceForClassImplements ) .filter> ( Self SWAP .SomeAncestorImplements ! ) array:Copy >>> Result ; // ClassImplements INTERFACE elem_func OverrideMethod Cached: ( Self .DecorateMethod: ( IN aMethod aMethod -> OpKind := opkind_Overridden ) // Self .DecorateMethod: ) >>> Result ; // OverrideMethod INTERFACE elem_func ImplementMethod Cached: ( Self .DecorateMethod: ( IN aMethod aMethod -> OpKind := opkind_Implemented ) // Self .DecorateMethod: ) >>> Result ; // ImplementMethod INTERFACE elem_func DecorateType Cached: ( Self .DecorateMethod: ( IN aMethod aMethod -> OpKind := opkind_DecoratedType ) // Self .DecorateMethod: ) >>> Result ; // DecorateType INTERFACE FUNCTION MakeInOutParam STRING IN aName ModelElement IN aType aName aType MakeParam: ( IN aMade aMade -> Stereotype := st_inout ) >>> Result ; // MakeInOutParam INTERFACE FUNCTION MakeClass: STRING IN aName ModelElement IN anAncestor ^ IN aLambda KeyValuesCreateAndDo: ( IN l_Param l_Param pop:Word:Box >>> Result l_Param -> Name := aName if ( anAncestor .IsNotNil ) then begin l_Param -> Inherits := [ anAncestor ] end // ( anAncestor .IsNotNil ) l_Param aLambda DO ) ; // MakeClass: INTERFACE FUNCTION MakeClass STRING IN aName ModelElement IN anAncestor aName anAncestor MakeClass: DROP >>> Result ; // MakeClass CONST cImplementationUserCodeSuffix '_impl' CONST cVarUserCodeSuffix '_var' CONST cEmptyUserCode #1 CONST cUserCodePrefix 'uc:' STRING FUNCTION cImplementationUserCodeName cUserCodePrefix cImplementationUserCodeSuffix Cat >>> Result ; // cImplementationUserCodeName STRING FUNCTION cVarUserCodeName cUserCodePrefix cVarUserCodeSuffix Cat >>> Result ; // cVarUserCodeName INTERFACE elem_func CastMethod Cached: ( VAR l_TypeName Self .TypeName >>> l_TypeName 'As_' l_TypeName Cat Self MakeFunction: ( IN aMade aMade -> %SUM := ( 'Метод приведения нашего интерфейса к ' l_TypeName Cat ) aMade -> Visibility := ProtectedAccess aMade ->^ cVarUserCodeName ^:= cEmptyUserCode aMade ->^ cImplementationUserCodeName ^:= ' Result := Self;' ) ) >>> Result ; // CastMethod BOOLEAN elem_func IsStaticOp Self .IsStereotype st_static::Operation >>> Result ; // IsStaticOp BOOLEAN elem_func IsStaticMethod RULES ( Self .IsStaticOp ) true ( Self .UPisTrue "is static" ) true DEFAULT false ; // RULES >>> Result ; // IsStaticMethod elem_iterator InterfaceOwnOperations Self .OperationsEx .filter> ( .IsStaticMethod ! ) .joinWithLambded> ( Self .InterfaceForClassImplements ) .ToArray: .CastMethod >>> Result ; // InterfaceOwnOperations elem_iterator InterfaceOperationsTotal Cached: ( Self .InterfaceOwnOperations .joinWithLambded> ( Self .ImplementsEx .filter> .IsPureMixIn ) ( IN anItem anItem call.me .joinWithLambded> ( anItem .InheritsEx .filter> .IsPureMixIn ) .InterfaceOwnOperations ) ) >>> Result ; // InterfaceOperationsTotal ModelElement elem_func MainImplements Cached: ( Self .ImplementsEx .FirstElement ) >>> Result ; // MainImplements BOOLEAN elem_func ImplementsIterator Cached: ( RULES ( Self .MainImplements .IsNil ) false ( Self .MainImplements .IsIterator ) true DEFAULT false ; // RULES ) >>> Result ; // ImplementsIterator BOOLEAN elem_func IsMethodAndImplementsIterator RULES ( Self .IsMethod ! ) false ( Self .ImplementsIterator ) true DEFAULT false ; // RULES >>> Result ; // IsMethodAndImplementsIterator BOOLEAN elem_func SomeMethodImplementsThisIterator ModelElement IN anIterator RULES ( Self .OperationsEx .filter> .IsMethodAndImplementsIterator .map> .MainImplements .filter> ( anIterator .IsSameModelElement ) .NotEmpty ) true DEFAULT false ; // RULES >>> Result ; // SomeMethodImplementsThisIterator elem_iterator InterfaceOperationsTotalDeep Self .InterfaceOperationsTotal .joinWithLambded> ( Self .InheritsEx .filter> .IsClassImplementable ) call.me >>> Result ; // InterfaceOperationsTotalDeep elem_iterator ImplementedEx Cached: ( Self .Implemented if ( Self .IsClassOrMixIn ) then begin VAR l_OutedIterators [] >>> l_OutedIterators .joinWithLambded> ( Self .ClassImplements ) ( .InterfaceOperationsTotalDeep .filter> ( .IsFacetIterator ! ) .filter> ( .IsIterator ) .filter> ( Self SWAP .SomeMethodImplementsThisIterator ! ) .filter> ( IN anItem if ( anItem .NotInArray: l_OutedIterators ) then begin anItem .AddToArray: l_OutedIterators true end else false ) // .filter> .filter> ( IN anItem Self .MainAncestor call.me .filter> ( anItem .IsSameModelElement ) .IsEmpty ) // .filter> .map> .ImplementMethod array:Copy ) end // ( Self .IsClassOrMixIn ) ) >>> Result ; // ImplementedEx BOOLEAN elem_func IsFactoryAcceptable RULES ( Self .IsInterface ) true ( Self .IsMixInParamType ) true ( Self .IsArray ) true DEFAULT false ; // RULES >>> Result ; // IsFactoryAcceptable ModelElement elem_func MainImplementsInterface Cached: ( Self .ImplementsEx .filter> .IsFactoryAcceptable .FirstElement ) >>> Result ; // MainImplementsInterface STRING elem_func UIDforUserCode RULES ( Self .IsIterator ) RULES ( ( Self .MainAncestor .IsNotNil ) AND ( Self .MainAncestor .IsIterator ) ) ( Self .MainAncestor .LUID ) DEFAULT ( Self .LUID ) ; // RULES ( Self .IsMethodAndImplementsIterator ) ( Self .MainImplements .LUID ) DEFAULT ( Self .LUID ) ; // RULES >>> Result ; // UIDforUserCode BOOLEAN elem_func IsResultType Self .IsStereotype st_result_type::Attribute >>> Result ; // IsResultType BOOLEAN elem_func IsElementType Self .IsStereotype st_element_type::Attribute >>> Result ; // IsElementType BOOLEAN elem_func IsIndexType Self .IsStereotype st_index_type::Attribute >>> Result ; // IsIndexType BOOLEAN elem_func IsServiceIterator Self .IsStereotype st_serviceiterator >>> Result ; // IsServiceIterator INTERFACE elem_func ItemParam Cached: ( 'anItem' Self MakeParam ) >>> Result ; // ItemParam INTERFACE elem_func IndexParam Cached: ( 'anIndex' Self MakeParam ) >>> Result ; // IndexParam BOOLEAN elem_func IsOverride RULES ( Self .IsControlOverride ) true ( Self .IsIterator ) RULES ( Self .MainAncestor .IsNil ) false DEFAULT true ; // RULES DEFAULT false ; // RULES >>> Result ; // IsOverride ModelElement elem_func IteratorAction Cached: ( VAR l_Action Self .Action >>> l_Action RULES ( l_Action .IsNotNil ) l_Action ( Self .IsOverride ) ( Self .MainAncestor call.me ) DEFAULT begin [ Self .Parent .Name cUnderline Self .Name '_Action' ] strings:Cat nil MakeFunction: ( IN aMade aMade -> UID := ( Self .LUID '_Action' Cat ) aMade -> Parent := ( Self .Parent .WeakRef ) aMade -> Stereotype := st_Function aMade -> %SUM := ( [ 'Тип подитеративной функции для ' Self .Parent .Name '.' Self .Name ] strings:Cat ) //aMade -> Parameters := [ GarantModel::Pointer .ActionParamPrim ] aMade -> Visibility := PublicAccess aMade -> Operations := [ 'DoIt' GarantModel::Boolean MakeFunction: ( IN aMadeOp aMadeOp -> Parameters := [ Self .Attributes .filter> .IsElementType .mapToTarget> .FirstElement .ItemParam if ( Self .UPisTrue "needs index" ) then begin VAR l_IndexType Self .Attributes .filter> .IsIndexType .mapToTarget> .FirstElement >>> l_IndexType if ( l_IndexType .IsNil ) then begin GarantModel::Integer >>> l_IndexType end // ( l_IndexType .IsNil ) l_IndexType .IndexParam end // ( Self .UPisTrue "needs index" ) ] // aMadeOp -> Parameters ) // 'DoIt' GarantModel::Boolean MakeFunction: ] // aMade -> Operations ) // MakeFunction: end // DEFAULT ; // RULES ) >>> Result ; // IteratorAction INTERFACE elem_func ActionParamPrim Cached: ( 'anAction' Self MakeParam ) >>> Result ; // ActionParamPrim INTERFACE elem_func ActionParam Cached: ( Self .IteratorAction .ActionParamPrim ) >>> Result ; // ActionParam ModelElement elem_func IteratorStub Cached: ( VAR l_Stub Self .Stub >>> l_Stub RULES ( l_Stub .IsNotNil ) l_Stub ( Self .IsServiceIterator ) begin VAR l_MixIn Self .Parent .MixIn >>> l_MixIn l_MixIn .OperationsEx .filter> .IsIterator .filter> ( .IsServiceIterator ! ) .filter> ( .Name Self .Name 'F' Cat ?== ) .FirstElement call.me end // ( Self .IsServiceIterator ) ( Self .IsOverride ) ( Self .MainAncestor call.me ) DEFAULT begin [ 'L2_' Self .Parent .Name cUnderline Self .Name '_Action' ] strings:Cat Self .IteratorAction MakeFunction: ( IN aMade aMade -> UID := ( Self .LUID '_Stub' Cat ) aMade -> Parent := ( Self .Parent .WeakRef ) aMade -> Stereotype := st_static::Operation aMade -> %SUM := ( [ 'Функция формирования заглушки для ЛОКАЛЬНОЙ подитеративной функции для ' Self .Parent .Name '.' Self .Name ] strings:Cat ) aMade -> Parameters := [ GarantModel::Pointer .ActionParamPrim ] aMade -> Visibility := PublicAccess aMade -> 'extprop:isGlobal' := true aMade -> 'extprop:isAsm' := true ) // MakeFunction: end // DEFAULT ; // RULES ) >>> Result ; // IteratorStub BOOLEAN elem_func IsInParam Self .IsStereotype st_in::Attribute >>> Result ; // IsInParam BOOLEAN elem_func IsContract Self .IsStereotype st_Contract >>> Result ; // IsContract ModelElement elem_func FriendClass Cached: ( VAR l_TypeName Self .TypeName >>> l_TypeName l_TypeName 'Friend' Cat Self MakeClass: ( IN aMade aMade -> Stereotype := st_SimpleClass aMade -> %SUM := ( 'Друг к классу ' l_TypeName Cat ) aMade -> Visibility := PrivateAccess aMade -> Abstraction := at_abstract aMade -> "ifdef" := ( Self .IfDefStr ) aMade -> "ifndef" := ( Self .IfNDefStr ) aMade -> "register in scripts" := false ) ) >>> Result ; // FriendClass ModelElement elem_func EffectiveType Cached: ( RULES ( Self .UPisTrue "is friend" ) ( Self .MainAncestor .FriendClass ) DEFAULT ( Self .MainAncestor ) ; // RULES ) >>> Result ; // EffectiveType ModelElement elem_func SelfParam Cached: ( 'Self' Self MakeParam ) >>> Result ; // SelfParam CONST opModifyNone 1 CONST opModifySetter 2 CONST opModifyIteratorF 3 CONST opModifyTest 4 CONST opModifyExecute 5 CONST opModifyGetState 6 INTEGER elem_func OpModify Self 'OpModify' opModifyNone .ElemMember >>> Result ; // OpModify BOOLEAN elem_func IsIteratorF Self .OpModify opModifyIteratorF == >>> Result ; // IsIteratorF BOOLEAN elem_func IsWriteonlyProperty Self .IsStereotype st_writeonly::Attribute >>> Result ; // IsWriteonlyProperty BOOLEAN elem_func IsSetter RULES ( Self .IsWriteonlyProperty ) true ( Self .OpModify opModifySetter == ) true DEFAULT false ; // RULES >>> Result ; // IsSetter BOOLEAN elem_func IsTester Self .OpModify opModifyTest == >>> Result ; // IsTester BOOLEAN elem_func IsExecutor Self .OpModify opModifyExecute == >>> Result ; // IsExecutor BOOLEAN elem_func IsGetState Self .OpModify opModifyGetState == >>> Result ; // IsGetState BOOLEAN elem_func IsVCMOperationPrim RULES ( Self .IsStereotype st_VCMOperationPrim ) true ( ( Self .Parent .IsNotNil ) AND ( Self .Parent .IsVCMOperations ) ) true DEFAULT false ; // RULES >>> Result ; // IsVCMOperationPrim BOOLEAN elem_func IsInternalOperation Self .IsStereotype st_InternalOperation::Operation >>> Result ; // IsInternalOperation INTERFACE elem_func ParamsParam Cached: ( 'aParams' Self MakeParam ) >>> Result ; // ParamsParam INTERFACE elem_func StateParam Cached: ( 'State' Self MakeInOutParam ) >>> Result ; // StateParam BOOLEAN elem_func IsFactoryMethod Self .IsStereotype st_Factory >>> Result ; // IsFactoryMethod BOOLEAN elem_func IsFactory RULES ( Self .IsStereotype st_factory::Operation ) true ( Self .IsFactoryMethod ) true DEFAULT false ; //RULES >>> Result ; // IsFactory ARRAY elem_func MethodParameters Cached: ( RULES ( Self .IsVCMOperationPrim ) RULES ( Self .IsTester ) ( GarantModel::IvcmTestParamsPrim .ParamsParam .ToArray ) ( Self .IsExecutor ) RULES ( Self .IsInternalOperation ) ( Self .Parameters ) DEFAULT ( GarantModel::IvcmTestExecutePrim .ParamsParam .ToArray ) ; // RULES ( Self .IsGetState ) ( GarantModel::TvcmOperationStateIndex .StateParam .ToArray ) ( Self .IsInternalOperation ) ( GarantModel::IvcmTestExecutePrim .ParamsParam .ToArray ) DEFAULT ( Self .Parameters ) ; // RULES ( Self .Parent .IsTestClass ) ( [ Self .Parent .EffectiveType .SelfParam ] .join> ( Self .Parameters ) ) ( Self .IsIterator ) ( RULES ( Self .MainAncestor .IsNotNil ) ( Self .MainAncestor call.me ) DEFAULT ( [ Self .ActionParam ] .join> ( Self .Attributes .filter> .IsInParam ) // .join> ) // DEFAULT ; // RULES ) ( Self .IsFactoryMethod ) RULES ( Self .MainAncestor .IsNotNil ) ( Self .MainAncestor call.me ) DEFAULT ( Self .FirstOperation .Parameters ) ; // RULES ( Self .IsMethod ) RULES ( Self .ImplementsIterator ) ( Self .MainImplements call.me ) ( Self .MainAncestor .IsNotNil ) RULES ( Self .FirstOperation .IsNotNil ) RULES ( ( Self .FirstOperation .IsSummoned ) AND ( Self .Abstraction at_regular == ) ) ( Self .MainAncestor call.me ) DEFAULT ( Self .FirstOperation .Parameters ) ; // RULES DEFAULT ( Self .MainAncestor call.me ) ; // RULES DEFAULT ( Self .FirstOperation .Parameters ) ; // ( Self .IsMethod ) ( Self .IsFunction ) ( Self .FirstOperation .Parameters ) DEFAULT ( Self .Parameters ) ; // RULES ) >>> Result ; // MethodParameters elem_iterator PropertyKeys RULES ( Self .Parent .IsTestClass ) ( [ Self .Parent .EffectiveType .SelfParam ] .join> ( Self .Attributes ) ) DEFAULT ( Self .Attributes ) ; // RULES .filter> ( .IsControlPrim ! ) >>> Result ; // PropertyKeys ARRAY FUNCTION .With()> OUTABLE IN aValue ^ IN aLambda RULES ( aValue .IsNil ) [empty] ( aValue IsArray ) ( [ VAR l_WasBracket false >>> l_WasBracket aValue .filterNil> .for> ( IN anItem if ( l_WasBracket ! ) then begin '(' true >>> l_WasBracket end anItem aLambda DO ) // aValue .for> if l_WasBracket then begin ')' end ] ) // ( aValue IsArray ) DEFAULT [ '(' aValue aLambda DO ')' ] ; // RULES >>> Result ; // .With() ARRAY FUNCTION .With() OUTABLE IN aValue aValue .With()> .KeepInStack >>> Result ; // .With() ARRAY FUNCTION .CommaListWith() ARRAY IN aList [ VAR l_WasComma false >>> l_WasComma aList .for> ( .WithComma: l_WasComma .KeepInStack ) ] .With() >>> Result ; // .CommaListWith() ARRAY elem_func ParametersList Cached: ( Self .MethodParameters .map> .Name .CommaListWith() ) >>> Result ; // ParametersList CONST cUCStart '//#UC START# *' CONST cUCEnd '//#UC END# *' PROCEDURE ReadUCFromFile STRING IN aFileName STRING IN aCurrentGeneratedElementPrefix if ( aFileName sysutils:FileExists ) then begin FILE VAR l_In aFileName TryOpen: File:OpenRead >>> l_In TRY VAR l_UCOpened ARRAY VAR l_Accumulated STRING VAR l_Key false >>> l_UCOpened l_In File:ReadLines ( IN aStr VAR l_Pos : Has string:Pos >>> l_Pos l_Pos -1 != ; // Has RULES ( aStr cUCStart Has ) ( l_UCOpened ! ?ASSURE [ 'Секция кода уже открыта. Файл: ' aFileName ' строка:' aStr ] true >>> l_UCOpened aStr string:Trim >>> aStr [] >>> l_Accumulated aStr >>> l_Key '*' string:SplitTo! l_Key DROP ) ( aStr cUCEnd Has ) ( l_UCOpened ?ASSURE [ 'Секция кода не открыта. Файл: ' aFileName ' строка:' aStr ] false >>> l_UCOpened VAR l_Head if ( l_Pos > 0 ) then begin l_Pos 0 aStr string:Substring >>> l_Head if ( l_Head string:TrimLeft .IsNotNil ) then begin l_Head .AddToArray: l_Accumulated aStr string:Len l_Pos - l_Pos aStr string:Substring >>> aStr end // ( l_Head .IsNotNil ) end // ( l_Pos > 0 ) aStr string:Trim >>> aStr g_CurrentGenerator ->^ l_Key ^:= l_Accumulated g_CurrentGenerator ->^ ( aCurrentGeneratedElementPrefix l_Key Cat ) ^:= l_Accumulated nil >>> l_Accumulated ) DEFAULT ( l_UCOpened ? ( aStr .AddToArray: l_Accumulated ) // l_UCOpened ? ) ; // RULES ) // l_In File:ReadLines FINALLY nil >>> l_In END // TRY..FINALLY end // ( aFileName sysutils:FileExists ) ; // ReadUCFromFile CONST cPalka '|' elem_proc OutUserCode: STRING IN aKey ^ IN aOutExisting ^ IN aOutNew BOOLEAN VAR l_Found false >>> l_Found if ( g_UCRead ! ) then begin true >>> g_UCRead STRING VAR l_TempFileName g_TempFileName '.uc.txt' Cat >>> l_TempFileName STRING VAR l_RealFileName g_RealFileName '.uc.txt' Cat >>> l_RealFileName STRING VAR l_CurrentGeneratedElementPrefix [ cUserCodePrefix g_CurrentGeneratedElement .LUID cPalka ] strings:Cat >>> l_CurrentGeneratedElementPrefix l_RealFileName l_CurrentGeneratedElementPrefix ReadUCFromFile g_FinalFileNameForUC l_CurrentGeneratedElementPrefix ReadUCFromFile FILE VAR l_Out l_TempFileName MakePathAndOpenWrite >>> l_Out TRY g_CurrentGenerator MembersIterator .filter> ( .WordName l_CurrentGeneratedElementPrefix SWAP StartsStr ) .for> ( IN anItem STRING VAR l_Key anItem .WordName cPalka string:Split >>> l_Key DROP cUCStart l_Out File:WriteStr l_Key l_Out File:WriteWStrLn anItem DO .for> ( l_Out File:WriteWStrLn ) cUCEnd l_Out File:WriteStr l_Key l_Out File:WriteWStrLn ) // g_CurrentGenerator MembersIterator FINALLY nil >>> l_Out END // TRY..FINALLY l_RealFileName l_TempFileName false CopyChangedFile if ( l_RealFileName FileSize 0 == ) then begin l_RealFileName false DoDeleteFile end // ( l_RealFileName FileSize 0 == ) end //( g_UCRead ! ) l_Found ! ? ( VAR l_Field g_CurrentGenerator %% aKey >>> l_Field if ( l_Field .IsNil ) then begin aKey aOutNew DO end // ( l_Field .IsNil ) else begin aKey l_Field DO aOutExisting DO end // ( l_Field .IsNil ) ) // l_Found ! ? ; // OutUserCode: elem_proc DefaultUserCodePrim: STRING IN aSuffix STRING IN aKey ^ IN aOutNew VAR l_KeyStart Self .UIDforUserCode >>> l_KeyStart l_KeyStart aKey Cat >>> aKey aKey '*' Cat >>> aKey Self aKey .OutUserCode: ( IN aKey IN aValue [ cUCStart aKey ] .Out aValue .for> ( g_OutFile File:WriteWStrLn ) [ cUCEnd aKey ] .Out ) ( IN aKey VAR l_Field nil >>> l_Field if ( aSuffix .NotIsNil ) then begin // - вообще говоря тут затычка для переноса слов скрипта в новый генератор if ( [ l_KeyStart cUnderline l_KeyStart ] strings:Cat aKey StartsStr ) then // - проверяем, что это слово скрипта у которого родитель поменял UID // - тут ещё надо KeywordObjectToOperate проверять begin g_CurrentGenerator MembersIterator .filter> ( .WordName l_KeyStart SWAP StartsStr ) .filter> ( .WordName aSuffix '*' Cat SWAP EndsStr ) .FirstElement >>> l_Field end end // ( aSuffix .NotIsNil ) if ( l_Field .IsNil ) then begin aKey aOutNew DO end // ( l_Field .IsNil ) else begin [ cUCStart aKey ] .Out l_Field DO .for> ( g_OutFile File:WriteWStrLn ) [ cUCEnd aKey ] .Out //l_Field .WordName Msg end // ( l_Field .IsNil ) ) // Self aKey .OutUserCode: ; // DefaultUserCodePrim: elem_proc DefaultUserCode STRING IN aSuffix STRING IN aKey TtfwWord IN aCode Self aSuffix aKey .DefaultUserCodePrim: ( IN aKey [ cUCStart aKey ] .Out [ aCode DO ] .Out [ cUCEnd aKey ] .Out ) // Self aKey .OutUserCode: ; // DefaultUserCode elem_proc PredefinedUserCode: STRING IN aSuffix STRING IN aKey ^ IN aOutLambda ^ IN aCode Self aSuffix aKey .DefaultUserCodePrim: ( IN aKey [ aCode DO ] aOutLambda DO ) // Self aKey .OutUserCode: ; // PredefinedUserCode: elem_proc PredefinedMethodUserCode: STRING IN aSuffix STRING IN aKey TtfwWord IN aCode ^ IN aVarCode ^ IN aImplCode RULES ( aSuffix cVarUserCodeSuffix == ) ( Self aSuffix aKey .PredefinedUserCode: .Out ( aVarCode DO ) ) ( aSuffix cImplementationUserCodeSuffix == ) ( Self aSuffix aKey .PredefinedUserCode: ( IN aValue Indented: ( aValue .Out ) ) ( aImplCode DO ) ) DEFAULT ( Self aSuffix aKey aCode .DefaultUserCode ) ; // RULES ; // PredefinedMethodUserCode: elem_proc PredefinedMethodUserCodeWithoutVar: STRING IN aSuffix STRING IN aKey TtfwWord IN aCode ^ IN aImplCode Self aSuffix aKey aCode .PredefinedMethodUserCode: () ( aImplCode DO ) ; // PredefinedMethodUserCodeWithoutVar: ModelElement elem_func ImplementorOrParent //Cached: ( g_Implementor >>> Result if ( Result .IsNil ) then begin Self .Parent >>> Result end // ( Result .IsNil ) Result ) >>> Result ; // ImplementorOrParent BOOLEAN elem_func IsReadonlyProperty Self .IsStereotype st_readonly::Attribute >>> Result ; // IsReadonlyProperty BOOLEAN elem_func IsProperty Cached: ( RULES ( Self .IsStereotype st_property::Attribute ) true ( Self .IsReadonlyProperty ) true ( Self .IsWriteonlyProperty ) true DEFAULT false ; // RULES ) >>> Result ; // IsProperty INTERFACE elem_func InterfaceLinkField Cached: ( VAR l_TypeName Self .TypeName >>> l_TypeName 'f_' l_TypeName Cat Self MakeField: ( IN aMade aMade -> %SUM := ( 'Ссылка на интерфейс ' l_TypeName Cat ) aMade -> Visibility := PrivateAccess ) ) >>> Result ; // InterfaceLinkField BOOLEAN elem_func IsAutoHelper Self .UPisTrue "IsAutoHelper" >>> Result ; // IsAutoHelper STRING elem_func FieldName RULES ( Self .IsProperty ) ( 'f_' Self .Name Cat ) DEFAULT ( Self .Name ) ; // RULES >>> Result ; // FieldName BOOLEAN elem_func HasFieldName STRING IN aName Self .FieldName aName == >>> Result ; // HasFieldName elem_iterator Properties Cached: ( VAR l_Properties Self .Attributes .filter> .IsProperty .filter> ( .IsControlOverride ! ) >>> l_Properties l_Properties if ( Self .IsService ) then begin VAR l_Facet Self .Facet >>> l_Facet if ( l_Facet .IsNotNil ) then begin if ( l_Properties 'Alien' .HasModelElementWithName ! ) then begin VAR l_TypeName l_Facet .TypeName >>> l_TypeName .join> [ 'Alien' l_Facet MakeProperty: ( IN aMade aMade -> %SUM := ( 'Внешняя реализация сервиса ' l_TypeName Cat ) aMade -> Visibility := PublicAccess aMade -> Stereotype := st_writeonly::Attribute aMade -> Abstraction := at_final aMade -> LinkType := lt_ref aMade -> "pm" := true aMade -> "needs field" := true ) // 'Alien' l_Facet MakeProperty: ] // .join> end // ( l_Properties 'Alien' .HasModelElementWithName ! ) end // ( l_Facet .IsNotNil ) end // ( Self .IsService ) ) >>> Result ; // Properties BOOLEAN elem_func NeedPutToDFM Cached: ( Self .UPisTrue "put to dfm" >>> Result if Result then begin if ( Self .Parent .IsControlPrim ) then begin Self .Parent call.me >>> Result end // ( Self .Parent .IsControlPrim ) end // Result Result ) >>> Result ; // NeedPutToDFM BOOLEAN elem_func ReadsField RULES ( Self .IsControlPrim ) ( Self .NeedPutToDFM ! ) ( Self .IsWriteonlyProperty ) true ( Self .UPisTrue "reads field" ) true DEFAULT false ; // RULES >>> Result ; // elem_func ReadsField BOOLEAN elem_func WritesField RULES ( Self .IsReadonlyProperty ) true ( Self .UPisTrue "writes field" ) true DEFAULT false ; // RULES >>> Result ; // elem_func WritesField BOOLEAN elem_func NeedsField RULES ( Self .IsOverride ) false ( Self .IsControlPrim ) RULES ( Self .NeedPutToDFM ) false DEFAULT true ; // RULES ( Self .UPisTrue "reads field" ) true ( Self .UPisTrue "writes field" ) true ( Self .Parent .IsInterface ) RULES ( Self .UPisTrue "needs field" ) true DEFAULT false ; // RULES ( Self .Abstraction at_abstract == ) false ( Self .UPisTrue "needs field" ) true DEFAULT false ; // RULES >>> Result ; // NeedsField BOOLEAN elem_func CanMapPropertiesToFields RULES ( Self .IsClassOrMixIn ) true ( Self .IsException ) true DEFAULT false ; // RULES >>> Result ; // CanMapPropertiesToFields elem_iterator Fields Cached: ( VAR l_Fields Self .Attributes .filter> ( .IsProperty ! ) .filter> ( .IsStereotype st_impurity_value::Attribute ! ) .filter> ( .IsStereotype st_switch::Attribute ! ) .filter> ( .IsStereotype st_impurity_param::Attribute ! ) .filter> ( .IsStereotype st_static::Attribute ! ) >>> l_Fields if ( Self .CanMapPropertiesToFields ) then begin l_Fields array:Copy >>> l_Fields l_Fields .joinWithLambded> ( Self .Properties .join> ( Self .Implemented .filter> .IsProperty .filter> ( .Parent .IsInterface ) ) // .join> .filter> .NeedsField .filter> ( IN anItem l_Fields .HasSomeOf: ( anItem .FieldName .HasName ) ! // l_Fields .HasSomeOf: ( anItem .FieldName .HasFieldName ) ! ) // .filter> ) .ToArray end // ( Self .CanMapPropertiesToFields ) else l_Fields if ( Self .IsStaticObject ) then begin if ( Self .IsAutoHelper ) then begin .joinWithLambded> ( Self .ImplementsEx ) .ToArray: .InterfaceLinkField end // ( Self .IsAutoHelper ) end // ( Self .IsStaticObject ) ) >>> Result ; // Fields BOOLEAN elem_func IsSingleton Self .UPisTrue "singleton" >>> Result ; // IsSingleton BOOLEAN elem_func HasFactory Cached: ( Self .OperationsEx .filter> .IsFactory .NotEmpty ) >>> Result ; // HasFactory INTERFACE elem_func InstanceField Cached: ( VAR l_TypeName Self .TypeName >>> l_TypeName 'g_' l_TypeName Cat if ( Self .HasFactory ) then GarantModel::Pointer else Self MakeField: ( IN aMade aMade -> %SUM := ( 'Экземпляр синглетона ' l_TypeName Cat ) aMade -> Visibility := PrivateAccess aMade -> 'extprop:pas:Value' := 'nil' aMade -> "ifdef" := ( Self .IfDefStr ) aMade -> "ifndef" := ( Self .IfNDefStr ) ) ) >>> Result ; // InstanceField BOOLEAN elem_func IsLocalVar Self .IsStereotype st_var::Attribute >>> Result ; // IsLocalVar BOOLEAN elem_func IsGlobalVar Self .IsStereotype st_globalvar::Attribute >>> Result ; // IsGlobalVar elem_iterator InnerGlobalVars Self .Attributes .filter> .IsGlobalVar .joinWithLambded> ( Self .OperationsEx ) call.me >>> Result ; // InnerGlobalVars elem_iterator GlobalVars RULES ( Self .IsClassOrMixIn ) ( Self .Attributes .filter> ( .IsStereotype st_static::Attribute ) if ( Self .IsSingleton ) then begin .join> ToArray: ( Self .InstanceField ) end // ( Self .IsSingleton ) .join> ( Self .InnerGlobalVars ) ) ( Self .IsUtilityPack ) ( Self .Attributes .filter> ( .IsProperty ! ) .join> ( Self .InnerGlobalVars ) ) DEFAULT [empty] ; // RULES >>> Result ; // GlobalVars BOOLEAN elem_func IsWideString Cached: ( RULES ( Self .Name 'a-string' == ) false ( Self .Name 'a-wstring' == ) true ( Self .IsTypedef ) RULES ( Self .IsPointer ) false DEFAULT ( Self .MainAncestor call.me ) ; // RULES DEFAULT false ; // RULES ) >>> Result ; // IsWideString BOOLEAN elem_func IsString Cached: ( RULES ( Self .Name 'a-string' == ) true ( Self .IsWideString ) true ( Self .IsTypedef ) RULES ( Self .IsPointer ) false DEFAULT ( Self .MainAncestor call.me ) ; // RULES DEFAULT false ; // RULES ) >>> Result ; // IsString BOOLEAN elem_func IsUntyped Self .Name 'void' == >>> Result ; // IsUntyped BOOLEAN elem_func IsManaged Cached: ( RULES ( Self .IsRecord ) true ( Self .IsUnion ) true ( Self .IsArray ) true ( Self .IsInterface ) true ( Self .IsTypedef ) RULES ( Self .IsPointer ) false DEFAULT ( Self .MainAncestor call.me ) ; // RULES ( Self .IsMixInParamType ) true ( Self .IsString ) true ( Self .IsUntyped ) true DEFAULT false ; // RULES ) >>> Result ; // IsManaged BOOLEAN elem_func IsConstants Self .IsStereotype st_Constants >>> Result ; // IsConstants BOOLEAN elem_func IsSetConst Self .IsStereotype st_SetConst >>> Result ; // IsSetConst BOOLEAN elem_func IsConstantArray Self .IsStereotype st_ConstantArray >>> Result ; // IsConstantArray BOOLEAN elem_func IsLocalConst Self .IsStereotype st_LocalConst >>> Result ; // IsLocalConst BOOLEAN elem_func IsChoices Self .IsStereotype st_Choices >>> Result ; // IsChoices BOOLEAN elem_func IsChoice Self .IsStereotype st_Choice >>> Result ; // IsChoice BOOLEAN elem_func IsConstantsButNotType RULES ( Self .IsRange ) false ( Self .IsConstants ) true ( Self .IsSetConst ) true ( Self .IsConstantArray ) true ( Self .IsLocalConst ) true ( Self .IsMessage ) true ( Self .IsChoices ) true ( Self .IsChoice ) true DEFAULT false ; // RULES >>> Result ; // IsConstantsButNotType BOOLEAN elem_func IsType Cached: ( RULES ( Self .MDAClass class_Operation == ) false ( Self .MDAClass class_Attribute == ) false ( Self .MDAClass class_Parameter == ) false ( Self .MDAClass class_Category == ) false ( Self .MDAClass class_Dependency == ) false DEFAULT RULES ( Self .IsConstantsButNotType ) false ( Self .IsVCMOperations ) false ( Self .IsControlPrim ) false ( Self .IsProperty ) false ( Self .IsMethod ) false ( Self .IsElementProxy ) false ( Self .IsTestClass ) false ( Self .IsUserType ) false ( Self .IsUtilityPack ) false ( Self .IsInterfaces ) false ( Self .IsTarget ) false ( Self .IsEvdSchemaElement ) false ( Self .IsPureMixIn ) false ( Self .IsDefine ) false ( Self .IsMixIn ) false ( Self .IsMixInParamType ) false DEFAULT true ; // RULES ; // RULES ) >>> Result ; // IsType STRING CompileTime-VAR g_IfDefStr '' STRING CompileTime-VAR g_IfNDefStr '' ARRAY CompileTime-VAR g_IfDefArr [] ARRAY CompileTime-VAR g_IfNDefArr [] BOOLEAN CompileTime-VAR g_WasType false ModelElement CompileTime-VAR g_WasTypeOpener nil BOOLEAN CompileTime-VAR g_WasConst false BOOLEAN CompileTime-VAR g_WasForwarded false PROCEDURE DropWasType false >>> g_WasType nil >>> g_WasTypeOpener ; // DropWasType elem: IfDefPrim: IN aElseLambda ^ IN aOutLambda ^ IN aLambda if ( Self IsString ! ) then begin TF g_IfDefStr ( TF g_IfNDefStr ( TF g_IfDefArr ( TF g_IfNDefArr ( VAR l_IfDefStr Self .IfDefStr >>> l_IfDefStr VAR l_IfNDefStr Self .IfNDefStr >>> l_IfNDefStr BOOLEAN VAR l_NeedOut false >>> l_NeedOut ARRAY VAR l_Body nil >>> l_Body : OutIfBody STRING IN anOpen STRING IN aClose VAR l_NeedAND false >>> l_NeedAND : OutItem IN anItem STRING IN aPrefix ARRAY IN anOuted if ( anItem .IsNotNil ) then begin if ( anItem .TextNotInArray: anOuted ) then begin anItem .AddToArray: anOuted true >>> l_NeedOut cSpace if l_NeedAND then begin 'AND' cSpace end else begin true >>> l_NeedAND end // l_NeedAND aPrefix 'Defined(' anItem ')' end // ( anItem .TextNotInArray: anOuted ) end // ( anItem .IsNotNil ) ; // OutItem [ l_IfDefStr ',' string:Split:for> ( cEmptyStr g_IfDefArr OutItem ) l_IfNDefStr ',' string:Split:for> ( 'NOT ' g_IfNDefArr OutItem ) ] >>> l_Body if l_NeedOut then begin [ anOpen l_Body aClose if ( g_EnableAutoEOL ! ) then \n ] aOutLambda DO end // l_NeedOut ; // OutIfBody if ( ( l_IfDefStr .IsNotNil ) OR ( l_IfNDefStr .IsNotNil ) ) then begin if ( ( l_IfDefStr g_IfDefStr != ) OR ( l_IfNDefStr g_IfNDefStr != ) ) then begin g_IfDefArr array:CopyNotNil >>> g_IfDefArr g_IfNDefArr array:CopyNotNil >>> g_IfNDefArr l_IfDefStr >>> g_IfDefStr l_IfNDefStr >>> g_IfNDefStr : IfOut cOpenComment '$If' Cat cCloseComment OutIfBody ; // IfOut if g_NeedOutLn then begin false >>> g_NeedOutLn OutLnToFile end // g_NeedOutLn IfOut end // ( ( l_IfDefStr g_IfDefStr != ) OR ( l_IfNDefStr g_IfNDefStr != ) ) end // ( ( l_IfDefStr .IsNotNil ) OR ( l_IfNDefStr .IsNotNil ) ) aLambda DO if l_NeedOut then begin : IfEndOut false >>> l_NeedOut nil >>> g_IfDefArr nil >>> g_IfNDefArr if ( aElseLambda .IsNotNil ) then begin [ cOpenComment '$Else' l_Body cCloseComment \n ] aOutLambda DO aElseLambda DO end // ( aElseLambda .IsNotNil ) [ cOpenComment '$IfEnd' cCloseComment cSpace '//' l_Body if g_NeedOutLn then begin false >>> g_NeedOutLn \n end // g_NeedOutLn ] aOutLambda DO nil >>> l_Body if ( Self .IsType ) then begin if ( g_WasForwarded ! ) then begin if ( g_WasTypeOpener Self ?== ) then begin DropWasType end // ( g_WasTypeOpener Self ?== ) end // ( g_WasForwarded ! ) end // ( Self .IsType ) ; // IfEndOut IfEndOut end // l_NeedOut ) // TF g_IfNDefArr ) // TF g_IfDefArr ) // // TF g_IfNDefStr ) // TF g_IfDefStr end // ( Self IsString ! ) else begin aLambda DO end // ( Self IsString ! ) ; // IfDefPrim: elem_proc IfDef: ^ IN aLambda Self nil .IfDefPrim: .Out ( aLambda DO ) ; // IfDef: elem_proc IfDefElse: ^ IN aLambda ^ IN aElseLambda Self aElseLambda .IfDefPrim: .Out ( aLambda DO ) ; // IfDefElse: BOOLEAN elem_func IsConstructor RULES ( Self .IsStereotype st_ctor::Operation ) true ( Self .IsStereotype st_Constructor ) true DEFAULT false ; //RULES >>> Result ; // IsConstructor BOOLEAN elem_func IsStaticConstructor RULES ( Self .IsConstructor ) RULES ( Self .Parent .IsRecord ) true DEFAULT false ; // RULES DEFAULT false ; //RULES >>> Result ; // IsStaticConstructor BOOLEAN elem_func NeedsFinalize Cached: ( RULES ( Self .IsNil ) false DEFAULT RULES ( Self .Attributes .mapToTarget> .filter> .IsManaged .NotEmpty ) true ( Self .MainAncestor call.me ) true DEFAULT false ; // RULES ; // RULES ) >>> Result ; // NeedsFinalize BOOLEAN elem_func ParentIsInterface Cached: ( Self .Parent .IsInterface ) >>> Result ; // ParentIsInterface INTEGER elem_func FieldLinkType RULES ( Self .IsProperty ) RULES ( Self .ParentIsInterface ) lt_ref ( Self .LinkType lt_lnk == ) lt_lnk DEFAULT lt_ref ; // RULES DEFAULT ( Self .LinkType ) ; // RULES >>> Result ; // FieldLinkType BOOLEAN elem_func IsFieldForCleanup ( Self .FieldLinkType lt_ref == ) AND ( Self .Target .IsManaged ) AND ( ( Self .GetUP 'extprop:clearViaProperty' .IsNil ) OR ( Self .Target .IsMixInParamType ! ) ) >>> Result ; // IsFieldForCleanup BOOLEAN elem_func IsVCMApplication Self .IsStereotype st_VCMApplication >>> Result ; // IsVCMApplication elem_proc MethodUserCode STRING IN aKey TtfwWord IN aCode STRING VAR l_Key aKey >>> l_Key VAR l_Implementor Self .ImplementorOrParent >>> l_Implementor RULES ( l_Key 'iter' == ) () ( l_Key 'afteriter' == ) () ( l_Key 'iterparam' == ) () DEFAULT ( RULES ( Self .IsSetter ) then ( 'set' l_Key Cat >>> l_Key ) ( Self .IsProperty ) then ( 'get' l_Key Cat >>> l_Key ) ( Self .IsTester ) then ( 'test' l_Key Cat >>> l_Key ) ( Self .IsExecutor ) then ( 'exec' l_Key Cat >>> l_Key ) ( Self .IsGetState ) then ( 'getstate' l_Key Cat >>> l_Key ) ; // RULES if ( l_Implementor .IsNotNil ) then begin [ cUnderline if ( Self .IsLocalMethod ! ) then begin l_Implementor .LUID end // ( Self .IsLocalMethod ! ) l_Key ] strings:Cat >>> l_Key end // ( l_Implementor .IsNotNil ) ) // DEFAULT ; // RULES BOOLEAN elem_func IsSingletonExists Self .Name 'Exists' == AND ( Self .IsStaticOp ) AND ( l_Implementor .IsSingleton ) >>> Result ; // IsSingletonExists : WithoutVar: ^ IN aImplCode Self aKey l_Key aCode .PredefinedMethodUserCodeWithoutVar: ( aImplCode DO ) ; // WithoutVar: RULES ( Self .IsSingletonExists ) ( WithoutVar: ( 'Result := g_' l_Implementor .TypeName ' <> nil;' ) ) // ( Self .IsSingletonExists ) ( Self .Name 'Alien' == AND ( Self .IsSetter ) AND ( l_Implementor .IsService ) ) ( WithoutVar: ( 'Assert((f_Alien = nil) OR (aValue = nil));' \n 'f_Alien := aValue;' ) ) // Self .Name 'Alien' == ( ( Self .LUID GarantModel::TComponent.Loaded .LUID == ) // TComponent.Loaded AND ( l_Implementor .IsVCMApplication ) ) ( WithoutVar: ( 'inherited;' ) ) ( Self .LUID '4C937013031D' == ) // GetFolder ( WithoutVar: ( 'Result := ' cQuote l_Implementor .Parent .Name cQuote ';' ) ) ( Self .LUID '4DAED6F60146' == ) // GetModelElementGUID ( WithoutVar: ( 'Result := ' cQuote l_Implementor .LUID cQuote ';' ) ) ( Self .LUID '4EE1DC8903BB' == // GetInteger AND ( l_Implementor .Parent .IsUserType ) ) WithoutVar: ( 'Result := ' l_Implementor .Parent .Name ';' ) ( Self .LUID GarantModel::TtfwAxiomaticsResNameGetter.ResName .LUID == ) // ResName WithoutVar: ( 'Result := ' cQuote l_Implementor .EffectiveUnitName cQuote ';' ) ( Self .LUID '4DB079E00084' == ) // GetModuleOperationCode ( WithoutVar: ( 'Result := TdmStdRes.mod_opcode_' l_Implementor .Name 'Tkw_' .CutPrefix '_op' cUnderline string:ReplaceFirst ';' ) ) ( Self .LUID GarantModel::TtfwRegisterableWord.GetWordNameForRegister .LUID == ) // GetWordNameForRegister ( WithoutVar: ( 'Result := ' cQuote VAR l_NameForScript l_Implementor .NameForScript >>> l_NameForScript if ( l_NameForScript .IsValueValid ) then begin ANY FUNCTION Mangle IN aValue RULES ( aValue IsBool ) RULES aValue 'true' DEFAULT 'false' ; // RULES DEFAULT aValue ; // RULES >>> Result ; // Mangle l_NameForScript Mangle end // ( l_NameForScript .IsValueValid ) else begin l_Implementor .Parent .GetUP 'extprop:pas:ElementPrefixBase' l_Implementor .Name cUnderline ':' string:Replace end // ( l_NameForScript .IsValueValid ) cQuote ';' ) // ( Self .Name 'GetWordNameForRegister' == ) ) ( Self .LUID GarantModel::l3UnknownPrim.ClearFields .LUID == ) // ClearFields ( WithoutVar: ( l_Implementor .Fields .filter> .IsFieldForCleanup .for> ( IN aField aField nil .IfDefPrim: \n ( VAR l_FieldName aField .GetUP 'extprop:clearViaProperty' >>> l_FieldName if ( ( aField .Target .CannotFinalizeProperty ) OR ( l_FieldName .IsNil ) ) then begin RULES ( ( aField .IsReadonlyProperty ) OR ( aField .Target .CannotFinalizeProperty ) ) ( aField .FieldName >>> l_FieldName ) ( ( aField .IsProperty ) AND ( aField .LinkType lt_agr == ) AND ( aField .Target .IsWideString ) ) // http://mdp.garant.ru/pages/viewpage.action?pageId=594895802&focusedCommentId=620849995#comment-620849995 ( aField .FieldName >>> l_FieldName ) DEFAULT ( aField .Name >>> l_FieldName ) ; // RULES end // ( l_FieldName .IsNil ) RULES ( aField .Target .IsInterface ) ( l_FieldName ' := nil' ) ( aField .Target .IsString ) ( l_FieldName ' := ' cQuote cQuote ) ( aField .Target .IsOpenArray ) ( l_FieldName ' := nil' ) DEFAULT ( 'Finalize(' l_FieldName ')' ) ; // RULES ';' \n ) // aField .IfDef: ) // l_Implementor .Fields 'inherited;' ) ) DEFAULT ( if ( Self .IsStaticConstructor ) then begin if ( aKey cImplementationUserCodeSuffix == ) then begin if ( l_Implementor .NeedsFinalize ) then begin ' Finalize(Result);' .Out end // ( l_Implementor .NeedsFinalize ) ' System.FillChar(Result, SizeOf(Result), 0);' .Out end // ( aKey cImplementationUserCodeSuffix == ) end // ( Self .IsStaticConstructor ) Self aKey l_Key aCode .DefaultUserCode ) ; // RULES ; // MethodUserCode BOOLEAN elem_func IsIni Self .IsStereotype st_ini::Operation >>> Result ; // IsIni BOOLEAN elem_func IsFini Self .IsStereotype st_fini::Operation >>> Result ; // IsFini elem: IfDefBrace: ^ IN aLambda VAR l_WasIf false >>> l_WasIf Self nil .IfDefPrim: ( l_WasIf ! ? ( true >>> l_WasIf \n ) ) ( aLambda DO l_WasIf ? \n ) // Self .IfDefPrim: ; // IfDefBrace: elem: IfDefBraceLn: ^ IN aLambda VAR l_WasIf false >>> l_WasIf Self nil .IfDefPrim: ( true >>> l_WasIf \n ) ( aLambda DO l_WasIf ? \n ) // Self .IfDefPrim: ; // IfDefBraceLn: BOOLEAN elem_func IsClassRef Self .UPisTrue "isClassRef" >>> Result ; // IsClassRef ARRAY STRING TYPE ArrayOrString STRING elem_func TypeInfo RULES ( Self .IsNil ) '@tfw_tiVoid' ( Self .TypeName 'Tl3PCharLen' == ) '@tfw_tiWString' ( Self .IsString ) '@tfw_tiString' ( Self .TypeName 'Il3CString' == ) '@tfw_tiString' ( Self .TypeName 'Tl3WString' == ) '@tfw_tiString' ( Self .TypeName 'Tl3PCharLenPrim' == ) '@tfw_tiString' ( Self .IsRecord ) '@tfw_tiStruct' ( Self .IsClassRef ) '@tfw_tiClassRef' DEFAULT ( [ 'TypeInfo(' Self .TypeName ')' ] strings:Cat ) ; // RULES >>> Result ; // TypeInfo STRING elem_func PopSig RULES ( Self .TypeName 'TClass' == ) 'PopClass' ( Self .TypeName 'TtfwStackValue' == ) 'Pop' ( Self .TypeName 'TClass' == ) 'PopClass' ( Self .TypeName 'ItfwValueList' == ) 'PopList' ( Self .TypeName 'ItfwFile' == ) 'PopFile' ( Self .IsClassRef ) ( [ 'PopClassAs(' Self .TypeName ')' ] strings:Cat ) ( Self .TypeName 'Tl3WString' == ) 'PopWStr' ( Self .TypeName 'Tl3PCharLenPrim' == ) 'PopWStr' ( Self .TypeName 'Tl3PCharLen' == ) 'PopWStr' ( Self .TypeName 'Il3CString' == ) 'PopString' ( Self .IsSimpleClass ) ( [ 'PopObjAs(' Self .TypeName ')' ] strings:Cat ) ( Self .IsInterface ) ( [ 'PopIntf(' Self .TypeName ')' ] strings:Cat ) ( Self .TypeName 'String' == ) 'PopDelphiString' ( Self .TypeName 'Char' == ) 'PopChar' ( Self .TypeName 'AnsiChar' == ) 'PopChar' ( Self .TypeName 'TPoint' == ) 'PopPoint' ( Self .TypeName 'WideString' == ) 'PopWideString' ( Self .TypeName 'AnsiString' == ) 'PopDelphiString' ( Self .TypeName 'Integer' == ) 'PopInt' ( Self .TypeName 'TColor' == ) 'PopInt' ( Self .TypeName 'Cardinal' == ) 'PopInt' ( Self .IsEnum ) 'PopInt' ( Self .TypeName 'THandle' == ) 'PopInt' ( Self .TypeName 'Boolean' == ) 'PopBool' ( Self .IsTypedef ) ( Self .MainAncestor call.me ) DEFAULT ( [ 'Не знаем как снять со стека : ' Self .TypeName ] strings:Cat ) ; // RULES >>> Result ; // PopSig STRING elem_func PushType RULES ( Self .TypeName 'ItfwValueList' == ) '' ( Self .TypeName 'ItfwFile' == ) '' ( Self .TypeName 'Il3CString' == ) '' ( Self .IsInterface ) ( [ ', ' 'TypeInfo(' Self .TypeName ')' ] strings:Cat ) DEFAULT '' ; // RULES >>> Result ; // PushType STRING elem_func PushSig RULES ( Self .IsNil ) '' ( Self .TypeName 'TClass' == ) 'PushClass' ( Self .TypeName 'TtfwStackValue' == ) 'Push' ( Self .TypeName 'TClass' == ) 'PushClass' ( Self .TypeName 'ItfwValueList' == ) 'PushList' ( Self .TypeName 'ItfwFile' == ) 'PushFile' ( Self .IsClassRef ) 'PushClass' ( Self .TypeName 'Tl3WString' == ) 'PushString' ( Self .TypeName 'Tl3PCharLenPrim' == ) 'PushString' ( Self .TypeName 'Tl3PCharLen' == ) 'PushWStr' ( Self .TypeName 'Il3CString' == ) 'PushString' ( Self .IsSimpleClass ) 'PushObj' ( Self .IsInterface ) 'PushIntf' ( Self .TypeName 'String' == ) 'PushString' ( Self .TypeName 'Char' == ) 'PushChar' ( Self .TypeName 'AnsiChar' == ) 'PushChar' ( Self .TypeName 'TPoint' == ) 'PushPoint' ( Self .TypeName 'WideString' == ) 'PushWideString' ( Self .TypeName 'AnsiString' == ) 'PushString' ( Self .TypeName 'Integer' == ) 'PushInt' ( Self .TypeName 'TColor' == ) 'PushInt' ( Self .TypeName 'Cardinal' == ) 'PushInt' ( Self .IsEnum ) 'PushInt' ( Self .TypeName 'THandle' == ) 'PushInt' ( Self .TypeName 'Boolean' == ) 'PushBool' ( Self .IsTypedef ) ( Self .MainAncestor call.me ) DEFAULT ( [ 'Не знаем как положить на стек: ' Self .TypeName ] strings:Cat ) ; // RULES >>> Result ; // PushSig STRING elem_func CastSig RULES ( Self .TypeName 'ItfwValueList' == ) '' ( Self .TypeName 'ItfwFile' == ) '' ( Self .IsClassRef ) ( Self .TypeName ) ( Self .TypeName 'Tl3PCharLen' == ) ( Self .TypeName ) ( Self .IsSimpleClass ) ( Self .TypeName ) ( Self .IsInterface ) ( Self .TypeName ) ( Self .TypeName 'TColor' == ) ( Self .TypeName ) ( Self .TypeName 'Cardinal' == ) ( Self .TypeName ) ( Self .IsEnum ) ( Self .TypeName ) ( Self .TypeName 'THandle' == ) ( Self .TypeName ) ( Self .IsTypedef ) ( Self .MainAncestor call.me ) DEFAULT '' ; // RULES >>> Result ; // CastSig STRING elem_func TypeValue RULES ( Self .TypeName 'TtfwStackValue' == ) '' ( Self .IsSimpleClass ) ( [ '.AsObject(' Self .TypeName ')' ] strings:Cat ) ( Self .TypeName 'Integer' == ) '.AsInt' ( Self .TypeName 'TColor' == ) '.AsInt' ( Self .TypeName 'Cardinal' == ) '.AsInt' ( Self .IsEnum ) '.AsInt' ( Self .TypeName 'String' == ) '.AsDelphiString' ( Self .TypeName 'AnsiString' == ) '.AsDelphiString' ( Self .TypeName 'Char' == ) '.AsChar' ( Self .TypeName 'AnsiChar' == ) '.AsChar' ( Self .TypeName 'Boolean' == ) '.AsBoolean' ( Self .IsTypedef ) ( Self .MainAncestor call.me ) DEFAULT ( [ 'Не знаем как приводить значение типа ' Self .TypeName ] strings:Cat ) ; // RULES >>> Result ; // TypeValue STRING elem_func UnCastSig RULES ( Self .TypeName 'TColor' == ) 'Integer' ( Self .TypeName 'Cardinal' == ) 'Integer' ( Self .IsEnum ) 'Ord' ( Self .TypeName 'THandle' == ) 'Integer' ( Self .IsTypedef ) ( Self .MainAncestor call.me ) DEFAULT '' ; // RULES >>> Result ; // UnCastSig elem_iterator BindServiceImplementationUC [ Self .ImplementsInDependencies .for> ( IN anItem anItem .IfDefBrace: ( cSpace anItem .TypeName '.Instance.Alien := ' Self .TypeName '.Instance;' ) // anItem .IfDefBrace: ) // Self .ImplementsInDependencies ] >>> Result ; // BindServiceImplementationUC elem_iterator RegAxiomUC [ cSpace Self .TypeName '.Register;' ] >>> Result ; // RegAxiomUC BOOLEAN elem_func IsCustomChoice Self .IsStereotype st_CustomChoice::Attribute >>> Result ; // IsCustomChoice BOOLEAN elem_func IsDefaultChoice Self .IsStereotype st_DefaultChoice::Attribute >>> Result ; // IsDefaultChoice elem_iterator AdditionalInitCode STRING IN aName STRING elem_func ChoiceName [ aName //%C%f_pas_Prefix()%C#f_AdditionalPrefix() '_Choice_' Self .Name ] strings:Cat >>> Result ; // ChoiceName [ Self .Children .filter> .IsChoices .for> ( IN aChoices aChoices .Children .filter> .IsChoice .for> ( IN aChoice \n ' ' aName '.AddChoice(' aChoice .ChoiceName ');' ) // .for> ) // .for> Self .Attributes .filter> .IsCustomChoice .for> ( IN aChoice \n ' ' aName '.AddCustomChoice(' aChoice .Target .ChoiceName ');' ) // .for> Self .Attributes .filter> .IsDefaultChoice .for> ( IN aChoice \n ' ' aName '.AddDefaultChoice(' aChoice .Target .ChoiceName ');' ) // .for> if ( Self .UPisTrue "NeedCheck" ) then begin \n ' ' aName '.SetNeedCheck(true);' end // ( Self .UPisTrue "NeedCheck" ) VAR l_Value Self .GetUP "CheckCaption" >>> l_Value if ( l_Value .IsNotNil ) then begin \n ' ' aName '.SetCheckCaption(str_' Self .Name '_CheckCaption);' end // ( l_Value .IsNotNil ) Self .GetUP "SettingsCaption" >>> l_Value if ( l_Value .IsNotNil ) then begin \n ' ' aName '.SetSettingsCaption(str_' Self .Name '_SettingsCaption);' end // ( l_Value .IsNotNil ) Self .GetUP "LongHint" >>> l_Value if ( l_Value .IsNotNil ) then begin \n ' ' aName '.SetLongHint(str_' Self .Name '_LongHint);' end // ( l_Value .IsNotNil ) \n ' ' aName '.SetDlgType(' 'mt' Self .GetUP "DlgType" ');' ] >>> Result ; // AdditionalInitCode PRINTABLE elem_func InitStrUCPrim ModelElement IN aSpeller [ VAR l_Name [ Self .Parent .GetUP 'extprop:pas:ElementPrefix' Self .Name ] strings:Cat >>> l_Name ' ' l_Name '.Init;' if ( aSpeller .IsMessage ) then begin aSpeller l_Name .AdditionalInitCode end // ( aSpeller .IsMessage ) ] >>> Result ; // InitStrUCPrim PRINTABLE elem_func InitStrUC Self .SpelledFor Self .Speller .InitStrUCPrim >>> Result ; // InitStrUC PRINTABLE elem_func GetUserCode STRING IN aKey RULES ( Self .IsIni AND ( Self .IsSummoned ) ) ( VAR l_Parent Self .Parent >>> l_Parent RULES ( l_Parent .IsServiceImplementation ) ( l_Parent .BindServiceImplementationUC ) ( Self .Name 'Ini_Reg' == ) [ cSpace l_Parent .TypeName '.RegisterInEngine;' ] ( Self .Name 'RegAxiom' == ) ( l_Parent .RegAxiomUC ) ( Self .Name 'Ini_Reg_Class' == ) [ if ( l_Parent GarantModel::TtfwWord .InheritsFrom ) then begin ' ' l_Parent .TypeName '.RegisterClass;' end else begin ' TtfwClassRef.Register(' l_Parent .TypeName ');' end ] ( ( 'Init_Str_' Self .Name StartsStr ) AND ( Self .SpelledFor .IsNotNil ) ) ( Self .InitStrUC ) ( ( 'Ini_FormFactory_' Self .Name StartsStr ) AND ( Self .SpelledFor .IsNotNil ) ) [ VAR l_SpelledFor Self .SpelledFor >>> l_SpelledFor ' ' 'fm_' l_SpelledFor .TypeName .CutT '.SetFactory(' l_SpelledFor .TypeName '.Make);' ] ( ( 'Reg_Type_' Self .Name StartsStr ) AND ( Self .SpelledFor .IsNotNil ) ) [ VAR l_SpelledFor Self .SpelledFor >>> l_SpelledFor ' TtfwTypeRegistrator.RegisterType(' l_SpelledFor .TypeInfo ');' ] DEFAULT '!!! Lost ini !!!' ; // RULES ) ( Self .IsFini AND ( Self .IsSummoned ) ) '!!! Lost fini !!!' DEFAULT ( Self aKey cEmptyStr .ElemMember ) ; // RULES >>> Result ; // GetUserCode BOOLEAN elem_func IsConstructorsHolder ( Self .MainAncestor .IsNotNil ) AND ( Self .Attributes .IsEmpty ) AND ( Self .OperationsEx .filter> ( .IsConstructor ! ) .IsEmpty ) >>> Result ; // IsConstructorsHolder ModelElement elem_func MethodType Cached: ( RULES ( Self .InTie ) RULES ( Self .Target .TypeName 'Boolean' == ) GarantModel::ByteBool DEFAULT ( Self .Target ) ; // RULES ( Self .IsInternalOperation ) RULES ( Self .OpModify opModifyExecute == ) ( Self .Target ) DEFAULT nil ; // RULES ( Self .IsVCMOperationPrim ) nil ( Self .IsIterator ) ( RULES ( Self .MainAncestor .IsNotNil ) ( Self .MainAncestor call.me ) ( Self .UPisTrue "needs result" ) ( VAR l_Type Self .Attributes .filter> .IsResultType .mapToTarget> .FirstElement >>> l_Type RULES ( l_Type .IsNotNil ) l_Type DEFAULT GarantModel::Integer ; // RULES ) DEFAULT nil ; // RULES ) ( Self .IsStaticConstructor ) if ( Self .Parent .IsConstructorsHolder ) then ( Self .Parent .MainAncestor ) else ( Self .Parent ) ( Self .IsControlOverride ) ( Self .MainAncestor call.me ) ( Self .IsControlPrim ) ( Self .MainAncestor ) ( Self .IsStereotype st_Area ) ( Self .MainAncestor ) ( Self .IsConstructor ) nil ( Self .IsMethod ) RULES ( Self .ImplementsIterator ) ( Self .MainImplements call.me ) ( Self .MainAncestor .IsNotNil ) ( Self .MainAncestor call.me ) DEFAULT ( Self .FirstOperation .Target ) ; // RULES ( Self .IsFunction ) ( Self .FirstOperation .Target ) DEFAULT ( Self .Target ) ; // RULES VAR l_Type >>> l_Type RULES ( l_Type .IsNil ) begin RULES ( Self .IsStereotype st_factory::Operation ) ( Self .Parent .MainImplementsInterface ) ( Self .IsFactoryMethod ) ( Self .MainImplementsInterface ) DEFAULT l_Type ; // RULES end // ( l_Type .IsNil ) DEFAULT l_Type ; // RULES >>> l_Type RULES ( l_Type .IsNil ) begin RULES ( Self .IsStereotype st_factory::Operation ) ( 'BadFactoryType' ) ( Self .IsFactoryMethod ) ( Self .Parent .MainImplementsInterface ) DEFAULT l_Type ; // RULES end // ( l_Type .IsNil ) DEFAULT l_Type ; // RULES ) >>> Result ; // MethodType BOOLEAN elem_func IsAcceptableForScripts Self .UPisTrue 'extprop:rc:isAcceptableForScripts' >>> Result ; // IsAcceptableForScripts BOOLEAN elem_func InheritsOrImplementsAcceptableForScripts Cached: ( RULES ( Self .InheritsEx .filter> .IsAcceptableForScripts .NotEmpty ) true ( Self .ImplementsEx .filter> .IsAcceptableForScripts .NotEmpty ) true DEFAULT false ; // RULES ) >>> Result ; // InheritsOrImplementsAcceptableForScripts BOOLEAN elem_func HasSelf RULES ( Self .Parent .InheritsOrImplementsAcceptableForScripts ! ) false ( Self .IsCreator ) false ( Self .IsKeyWord ) true DEFAULT false ; // RULES >>> Result ; // HasSelf BOOLEAN elem_func IsOutParam Self .IsStereotype st_out >>> Result ; // IsOutParam ARRAY FUNCTION .filterOutParam> ARRAY IN anArray anArray .filter> ( .IsOutParam ! ) >>> Result ; // .filterOutParam> STRING FUNCTION .UpperFirstChar STRING IN aSubstr RULES ( aSubstr .IsNil ) '' DEFAULT begin [ 1 0 aSubstr string:Substring string:Upper VAR l_Len aSubstr string:Len 1 - >>> l_Len l_Len < 0 ?FAIL 'l_Len < 0' if ( l_Len > 0 ) then begin VAR l_Tail l_Len 1 aSubstr string:Substring >>> l_Tail l_Tail .IsNil ?FAIL 'l_Tail .IsNil' l_Tail end // ( l_Len > 0 ) ] strings:Cat end // DEFAULT ; // RULES >>> Result ; // .UpperFirstChar STRING FUNCTION .FromTie STRING IN aValue '' >>> Result if ( aValue .IsNotNil ) then begin aValue cUnderline string:Split:for> ( IN aSubstr aSubstr .IsNil ?FAIL 'aSubstr .IsNil' [ Result aSubstr .UpperFirstChar ] strings:Cat >>> Result ) // aValue cUnderline string:Split:for> end // ( aValue .IsNotNil ) ; // .FromTie STRING FUNCTION .ToBorland STRING IN aValue '' >>> Result aValue cUnderline string:Split:for> ( IN aSubstr /*{ if ( aSubstr .IsNil ) then begin Result cUnderline Cat >>> Result end else}*/ begin Result aSubstr Cat >>> Result end ) ; // .ToBorland STRING elem_func MethodName STRING elem_func FineName Self .Name '__' cUnderline string:Replace >>> Result ; // FineName Cached: ( RULES ( Self .IsNil ) '' ( Self .InTie ) ( Self .Name .FromTie ) ( Self .IsVCMOperationPrim ) RULES ( Self .IsTester ) ( [ Self .Parent .Name cUnderline Self .Name '_Test' ] strings:Cat ) ( Self .IsExecutor ) ( [ Self .Parent .Name cUnderline Self .Name '_Execute' ] strings:Cat ) ( Self .IsGetState ) ( [ Self .Parent .Name cUnderline Self .Name '_GetState' ] strings:Cat ) DEFAULT ( [ Self .Parent .Name cUnderline Self .Name ] strings:Cat ) ; // RULES ( Self .IsIterator ) ( RULES ( Self .IsIteratorF ) ( Self .Name 'F' Cat ) ( Self .MainAncestor .IsNotNil ) ( Self .MainAncestor call.me ) DEFAULT ( Self .Name ) ; // RULES ) // ( Self .IsIterator ) ( Self .IsStaticConstructor ) if ( Self .Parent .IsConstructorsHolder ) then ( [ Self .Parent .MainAncestor .TypeName cUnderline Self .Name ] strings:Cat ) else ( [ Self .Parent .TypeName cUnderline Self .Name ] strings:Cat ) ( Self .UPisTrue 'extprop:isGlobal' ) ( Self .Name .ToBorland ) ( Self .Parent .IsUtilityPack ) ( VAR l_Prefix Self .Parent .GetUP 'extprop:pas:ElementPrefixBase' >>> l_Prefix if ( l_Prefix .IsNil ) then begin Self .Parent .GetUP 'extprop:pas:ElementPrefix' >>> l_Prefix end // ( l_Prefix .IsNil ) l_Prefix Self .FineName Cat ) ( Self .IsMethodAndImplementsIterator ) RULES ( Self .IsIteratorF ) ( Self .MainImplements call.me 'F' Cat ) DEFAULT ( Self .MainImplements call.me ) ; // RULES ( '__' Self .Name StartsStr ) ( Self .FineName ) DEFAULT ( Self .FineName ) ; // RULES ) >>> Result ; // MethodName elem_proc UserCode: ^ IN aSuffix ^ IN aCode STRING VAR l_Key aSuffix DO >>> l_Key VAR l_Code Self cUserCodePrefix l_Key Cat .GetUserCode >>> l_Code if ( l_Code .IsValueValid ) then begin if ( l_Code cEmptyUserCode ?!= ) then begin l_Code .Out end // ( l_Code cEmptyUserCode ?!= ) end // ( l_Code .IsValueValid ) else begin : AsDefault Self l_Key l_Key aCode .DefaultUserCode ; // AsDefault : AsMethod Self l_Key aCode .MethodUserCode ; // AsMethod VAR l_Implementor Self .ImplementorOrParent >>> l_Implementor BOOLEAN FUNCTION IsUID STRING IN anUID ( Self .LUID anUID == ) AND ( l_Implementor .IsSummoned ) >>> Result ; // IsUID : Pair: ^ IN aVar ^ IN aCode RULES ( l_Key cVarUserCodeSuffix == ) ( aVar DO ) ( l_Key cImplementationUserCodeSuffix == ) ( aCode DO ) DEFAULT AsDefault ; // RULES ; // Pair: : Code: ^ IN aCode Pair: () ( aCode DO ) ; // Code: VAR l_Call // - метод, который собственно надо звать из DoDoIt или DoRun. l_Implementor .KeywordImplementationMethod >>> l_Call VAR l_Op l_Implementor .KeywordOperation >>> l_Op VAR l_Self l_Implementor .KeywordObjectToOperate >>> l_Self elem_iterator ParametersWithoutContext Self .Parameters .filter> ( 'aCtx' .HasName ! ) >>> Result ; // ParametersWithoutContext : .AsVar STRING IN aName ModelElement IN aType 'var' cSpace 'l_' aName ': ' aType .TypeName ';' ; // .AsVar elem: ParamAsVar Self .Name Self .Target .AsVar ; // ParamAsVar : .Pop STRING IN aName ModelElement IN aType 'try' \n ' ' 'l_' aName ' := ' VAR l_CastSig aType .CastSig >>> l_CastSig if ( l_CastSig .IsNotNil ) then begin l_CastSig '(' end 'aCtx.rEngine.' aType .PopSig if ( l_CastSig .IsNotNil ) then begin ')' end ';' \n 'except' \n ' on E: Exception do' \n ' begin' \n ' RunnerError(''Ошибка при получении параметра ' aName ': ' aType .TypeName ' : '' + E.Message, aCtx);' \n ' Exit;' \n ' end;//on E: Exception' \n 'end;//try..except' \n ; // .Pop elem: ParamPop Self .Name Self .Target .Pop ; // ParamPop RULES ( ( Self .IsInternalOperation ) AND ( Self .OpModify opModifyNone == ) ) Code: ( Indented: ( [ if ( ( Self .Target .IsNotNil ) OR ( Self .Parameters .NotEmpty ) ) then begin 'with (aParams.Data As I' Self .Parent .Name cUnderline Self .Name '_Params) do' \n ' ' end // ( Self .Target .IsNotNil ) .. if ( Self .Target .IsNotNil ) then begin 'ResultValue := ' end // ( Self .Target .IsNotNil ) 'Self.' Self .MethodName '_Execute' Self .Parameters .map> ( .Name 'a' .CutPrefix ) .CommaListWith() ';' ] .Out ) ) ( ( Self .LUID '4DB6D7F70155' == ) // IsImmediate AND ( l_Implementor .GetUP "is immediate" IsBool ) ) Code: ( [ ' Result := ' l_Implementor .GetUP "is immediate" ';' ] .Out ) ( ( l_Op .IsNotNil ) AND ( GarantModel::TtfwCompilingWord.SuppressNextImmediate .LUID IsUID ) // SuppressNextImmediate ) Code: ( [ ' Result := ' 'tfw_sni' l_Op .GetUP "SupressNextImmediate" ';' ] .Out ) ( ( l_Op .IsNotNil ) AND ( GarantModel::TtfwString.GetString .LUID IsUID ) // GetString ) Code: ( if ( 'Слово словаря для идентификатора контрола' l_Implementor .Documentation StartsStr ) then begin [ ' Result := ' cQuote l_Op .Name cQuote ';' ] .Out end else begin [ ' Result := ' cQuote l_Op .TypeName .CutT cQuote ';' ] .Out end ) ( ( l_Op .IsNotNil ) AND ( l_Self .IsNotNil ) AND ( GarantModel::TtfwWord.SetValuePrim .LUID IsUID ) // SetValuePrim ) Pair: ( if ( l_Op .GetUP 'extprop:prop_stereo' 'readonly' != ) then begin if ( l_Self .IsNotNil ) then begin [ l_Self .SelfName l_Self .AsVar ] .Out end // ( l_Self .IsNotNil ) l_Op .Parameters .filterOutParam> .for> ( IN aParam [ aParam .ParamAsVar ] .Out ) // .for> end // ( l_Op .GetUP 'extprop:prop_stereo' 'readonly' != ) ) ( if ( l_Op .GetUP 'extprop:prop_stereo' 'readonly' == ) then begin [ ' RunnerError(''Нельзя присваивать значение readonly свойству ' l_Op .GetUP 'extprop:prop_name' ''', aCtx);' ] .Out end // ( l_Op .GetUP 'extprop:prop_stereo' 'readonly' == ) else begin Indented: ( [ if ( l_Self .IsNotNil ) then begin l_Self .SelfName l_Self .Pop end // ( l_Self .IsNotNil ) l_Op .Parameters .filterOutParam> .for> ( IN aParam aParam .ParamPop ) // .for> if ( l_Self .IsNotNil ) then begin if ( l_Op .UPisTrue "mapped" ) then begin 'l_' l_Self .SelfName cDot l_Op .GetUP 'extprop:prop_name' ' := ' VAR l_CastSig l_Op .Target .CastSig >>> l_CastSig if ( l_CastSig .IsNotNil ) then begin l_CastSig '(' end 'aValue' l_Op .Target .TypeValue if ( l_CastSig .IsNotNil ) then ')' end // ( l_Op .UPisTrue "mapped" ) else begin 'DoSetValue' '(' 'l_' l_Self .SelfName l_Op .Parameters .filterOutParam> .for> ( IN aParam ', ' 'l_' aParam .Name ) // .for> ', ' VAR l_CastSig l_Op .Target .CastSig >>> l_CastSig if ( l_CastSig .IsNotNil ) then begin l_CastSig '(' end 'aValue' l_Op .Target .TypeValue if ( l_CastSig .IsNotNil ) then ')' ')' end ';' end // ( l_Self .IsNotNil ) ] .Out ) // Indented: end // ( l_Op .GetUP 'extprop:prop_stereo' 'readonly' == ) ) ( ( l_Call .IsNotNil ) AND ( ( GarantModel::TtfwWordPrim.DoDoIt .LUID IsUID ) // DoDoIt OR ( GarantModel::TtfwAnonimousWord.DoRun .LUID IsUID ) // DoRun ) ) Pair: ( l_Call .ParametersWithoutContext .for> ( IN aParam [ aParam .ParamAsVar ] .Out ) // .for> ) ( Indented: ( [ l_Call .ParametersWithoutContext .filterOutParam> .for> ( IN aParam aParam .ParamPop ) // .for> VAR l_PushSig l_Call .Target .PushSig >>> l_PushSig VAR l_UnCastSig '' >>> l_UnCastSig if ( l_PushSig .IsNotNil ) then begin 'aCtx.rEngine.' l_PushSig '(' l_Call .Target .UnCastSig >>> l_UnCastSig if ( l_UnCastSig .IsNotNil ) then begin l_UnCastSig '(' end // ( l_UnCastSig .IsNotNil ) end l_Call .MethodName '(' 'aCtx' l_Call .ParametersWithoutContext .for> ( IN aParam ', ' 'l_' aParam .Name ) // .for> ')' if ( l_PushSig .IsNotNil ) then begin if ( l_UnCastSig .IsNotNil ) then begin ')' end // ( l_UnCastSig .IsNotNil ) l_Call .Target .PushType ')' end ';' l_Call .ParametersWithoutContext .filter> ( .IsOutParam ) .reverted> .for> ( IN aParam \n 'aCtx.rEngine.' aParam .Target .PushSig '(' 'l_' aParam .Name aParam .Target .PushType ')' ';' ) // .for> ] .Out ) // Indented: ) ( ( l_Op .IsNotNil ) AND ( GarantModel::TtfwRegisterableWordPrim.RegisterInEngine .LUID IsUID ) // RegisterInEngine ) Code: ( [ ' inherited;' \n ' TtfwClassRef.Register(' if ( l_Op .IsControlPrim ) then begin l_Op .MethodType .TypeName end // ( l_Op .IsControlPrim ) else begin l_Op .TypeName end // ( l_Op .IsControlPrim ) ')' ';' ] .Out ) ( ( l_Op .IsNotNil ) AND ( GarantModel::TtfwWordPrim.DoDoIt .LUID IsUID ) // DoDoIt AND ( l_Implementor GarantModel::TkwBynameControlPush .InheritsFrom ) ) Code: ( [ ' aCtx.rEngine.PushString(' cQuote l_Op .Name cQuote ')' ';' \n ' inherited;' ] .Out ) ( GarantModel::TtfwWord.ParamsTypes .LUID IsUID ) // ParamsTypes Code: ( VAR l_NeedComma false >>> l_NeedComma [ ' Result := ' 'OpenTypesToTypes' '(' '[' if ( l_Self .IsNil ) then [empty] else [ l_Self ] .join> ( l_Op .Parameters .filterOutParam> .mapToTarget> ) // .join> .map> .TypeInfo .for> ( .WithComma: l_NeedComma .KeepInStack ) ']' ')' ';' ] .Out ) // ( l_Key cImplementationUserCodeSuffix == ) ( GarantModel::TtfwWord.GetResultTypeInfo .LUID IsUID ) // GetResultTypeInfo Code: ( [ ' Result := ' if ( l_Op .IsCreator ) then begin l_Self .TypeInfo end // ( l_Op .IsCreator ) else begin l_Op .Target .TypeInfo end // ( l_Op .IsCreator ) ';' ] .Out ) // ( l_Key cImplementationUserCodeSuffix == ) ( GarantModel::TtfwWord.GetAllParamsCount .LUID IsUID ) // GetAllParamsCount Code: ( [ ' Result := ' l_Op .Parameters .filterOutParam> .CountIt l_Op .HasSelf ? ( 1 + ) l_Op .IsVarWorker ? ( 1 + ) ';' ] .Out ) // ( l_Key cImplementationUserCodeSuffix == ) ( GarantModel::TtfwWord.RightParamsCount .LUID IsUID ) // RightParamsCount Code: ( ' Result := 1;' .Out ) ( GarantModel::TtfwClassLike.BindParams .LUID IsUID ) Code: ( ' Result := true;' .Out ) ( ( Self .LUID '4B7AB0B6016E' == ) // TTestResultsPlace.CommandLineKey AND ( Self .OpKind opkind_Normal != ) ) Code: ( [ ' Result := ' cQuote '-' l_Implementor .Name 'Release' .CutPrefix cQuote ';' ] .Out ) ( Self .IsFactory ) begin Pair: ( if ( Self .Parent .IsSingleton ! ) then begin 'var' .Out [ ' l_Inst : ' Self .Parent .TypeName ';' ] .Out end // ( Self .Parent .IsSingleton ! ) ) ( if ( Self .Parent .IsSingleton ) then begin Indented: ( [ VAR l_TypeName Self .Parent .TypeName >>> l_TypeName 'if (' 'g_' l_TypeName ' = nil) then' \n 'begin' \n ' l3System.AddExitProc(' l_TypeName 'Free' ');' \n VAR l_Type Self .MethodType .TypeName >>> l_Type ' ' l_Type '(' 'g_' l_TypeName ')' ' := inherited ' Self .Name ';' \n 'end;' \n 'Result := ' l_Type '(' 'g_' l_TypeName ')' ';' ] .Out ) // Indented: end // ( Self .Parent .IsSingleton ) else begin Indented: ( [ 'l_Inst := ' VAR l_CallTo Self .MainAncestor >>> l_CallTo if ( l_CallTo .IsNil ) then 'Create' else begin l_CallTo .Name end // ( l_CallTo .IsNil ) Self .ParametersList ';' ] .Out 'try' .Out [ ' Result := ' if ( ( Self .MethodType .IsMixInParamType ) AND ( Self .Parent .IsMixIn ) ) then '_Instance_R_(l_Inst)' else 'l_Inst' if ( Self .UPisTrue "need As" ) then begin ' As ' Self .MethodType .TypeName end // ( Self .UPisTrue "need As" ) ';' ] .Out 'finally' .Out ' l_Inst.Free;' .Out 'end;//try..finally' .Out ) // Indented: end // ( Self .Parent .IsSingleton ) ) end // ( Self .IsFactory ) ( ( Self .OpKind opkind_Normal == ) // - метод новый, а не перекрытый AND ( l_Op .IsNotNil ) AND ( l_Self .IsNotNil ) AND ( l_Implementor .IsSummoned ) AND ( l_Op .UPisTrue "mapped" ) ) Code: ( [ ' ' if ( Self .Target .IsNotNil ) then begin 'Result := ' end 'a' l_Self .SelfName cDot l_Op .Name l_Op .ParametersList ';' ] .Out ) ( 'ResNameGetter' Self .Name EndsStr AND ( Self .IsSimpleClass ) ) RULES ( l_Key 'impl' == ) ( [ cSpace cOpenComment '$R ' Self .EffectiveUnitName '.res' cCloseComment ] .Out ) DEFAULT () ; // RULES ( Self .IsElementProxy ) AsDefault ( Self .IsClassOrMixIn ) AsDefault ( Self .IsRecord ) AsDefault ( Self .IsUtilityPack ) AsDefault ( Self .IsTarget ) AsDefault ( Self .IsIni ) AsDefault ( Self .IsFini ) AsDefault ( Self .IsInterfaces ) AsDefault DEFAULT AsMethod ; // RULES end // ( l_Code .IsValueValid ) ; // UserCode: ARRAY FUNCTION .mapToUnitProducer> ARRAY IN anArray anArray .map> .UnitProducer .filterNil> .filterMixIns> >>> Result ; // .mapToUnitProducer> elem_proc OutUses: STRING IN aUCPrefix ^ IN aUsed ^ IN aLambda ^ IN anItemTransform ARRAY VAR l_Used aUsed DO >>> l_Used ARRAY FUNCTION .filterUsed> ARRAY IN anArray anArray .filter> ( IN anItem anItem .UnitName >>> anItem if ( anItem .NotInArray: l_Used ) then begin anItem .AddToArray: l_Used true end else begin false end ) >>> Result ; // .filterUsed> 'uses' .Out VAR l_NeedComma false >>> l_NeedComma Indented: ( aLambda DO .mapToUnitProducer> .filter> ( Self ?!= ) .filter> ( .UnitName Self .UnitName ?!= ) .filter> ( .UnitName 'System' ?!= ) .filterUsed> .for> ( IN anItem anItem .IfDef: ( anItem anItemTransform DO .WithComma: l_NeedComma .Out ) ) // .for> if ( ( Self .IsElementProxy ) OR ( Self .UPisTrue "need UC" ) ) then begin Self .UserCode: aUCPrefix () end // ( Self .IsElementProxy ) if ( ( aUCPrefix 'intf_uses' == ) AND ( Self .UPisTrue "need UC in project" ) ) then begin Self .UserCode: 'manualuses' () end // ( Self .IsElementProxy ) ) // Indented: ';' .Out OutLn ; // OutUses: ARRAY FUNCTION .mapToTargetAndValueType> ARRAY IN anArray anArray .mapToTarget> .join> ( anArray .map> .ValueType ) >>> Result ; // .mapToTargetAndValueType> elem_iterator AttributesAndOperations Cached: ( Self .Attributes .join> ( Self .OperationsEx ) .filter> ( .IsSomeKeyWord ! ) .filter> ( .IsStereotype st_link::Attribute ! ) ) >>> Result ; // AttributesAndOperations INTERFACE FUNCTION MakeIniProcedure: STRING IN aName ^ IN aLambda aName MakeProcedure: ( IN aMade aMade -> Stereotype := st_ini::Operation aMade -> Visibility := PrivateAccess aMade aLambda DO ) // MakeProcedure: >>> Result ; // MakeIniProcedure: BOOLEAN elem_func IsFriend Self .IsStereotype st_friend::Dependency >>> Result ; // IsFriend elem_iterator FriendInDependencies Cached: ( Self .Dependencies .filter> .IsFriend .mapToTarget> array:Copy ) >>> Result ; // FriendInDependencies BOOLEAN elem_func NeedsScript RULES ( Self .UPisTrue "needs script" ) true ( Self .UPisTrue "noRegistrator" ) false DEFAULT RULES ( Self .IsScriptKeywordsPack ) RULES ( Self .IsSummoned ) false ( Self .Parent .IsVCMForm ) false ( Self .Parent .IsVCMFormsPack ) false ( Self .UPisTrue "no class name" ) true ( Self .UPisTrue "no_pop" ) true DEFAULT false ; // RULES DEFAULT false ; // RULES ; // RULES >>> Result ; // NeedsScript ModelElement elem_func ClassForKeywordImplementation ModelElement IN aKeywordSelf ModelElement IN aPack VAR l_ClassName [ if ( aKeywordSelf .NotIsNil ) then begin if ( ( aPack .UPisTrue "no_pop" ! ) AND ( Self .IsCreator ! ) ) then begin 'pop_' end // ( Self .UPisTrue "no_pop" ! ) if ( ( aPack .UPisTrue "no class name" ! ) AND ( aKeywordSelf .SelfName 'SV' != ) ) then begin aKeywordSelf .SelfName '_' end // ( Self .UPisTrue "no class name" ! ) end // ( aKeywordSelf .NotIsNil ) Self .Name ] strings:Cat >>> l_ClassName l_ClassName RULES ( Self .IsVarWorker ) GarantModel::TtfwWordWorkerEx ( Self .IsGlobalKeyWord ) GarantModel::TtfwGlobalKeyWord ( Self .GetUP 'extprop:prop_stereo' .IsValueValid ) GarantModel::TtfwPropertyLike DEFAULT GarantModel::TtfwClassLike ; // RULES MakeClass: ( IN aMade VAR l_WordName Self .NameForScript >>> l_WordName if ( l_WordName .IsNil ) then begin l_ClassName cUnderline ':' string:Replace >>> l_WordName end // ( l_WordName .IsNil ) aMade -> UID := ( [ Self .LUID if ( aKeywordSelf .NotIsNil ) then begin cUnderline aKeywordSelf .LUID end // ( aKeywordSelf .NotIsNil ) '_Word' ] strings:Cat ) aMade -> %SUM := ( 'Слово скрипта ' l_WordName Cat ) aMade -> Parent := ( Self .Parent .WeakRef ) aMade -> Stereotype := st_ScriptKeyword aMade -> Visibility := PrivateAccess aMade -> Abstraction := at_final aMade -> SpelledFor := ( Self .WeakRef ) aMade -> Speller := ( aKeywordSelf .WeakRef ) aMade -> "is immediate" := ( Self .GetUP "is immediate" ) aMade -> "ifdef" := ( Self .IfDefStr ) aMade -> "ifndef" := ( Self .IfNDefStr ) aMade -> "NameForScript" := l_WordName aMade -> 'extprop:pas:TypeName' := ( [ 'T' 'kw' //l_ClassName 'kw' .CutPrefix cUnderline '' string:Replace .UpperFirstChar l_ClassName 'kw' .CutPrefix .FromTie ] strings:Cat ) aMade -> IsSummoned := true // - это вообще говоря "времянка", чтобы Override методы выводили код ) // MakeClass: VAR l_Made >>> l_Made if ( Self .Speller .IsNil ) then // - здесь вообще говоря надо массив Speller'ов, и учесть его ниже, где алиасы выводятся begin Self -> Speller := l_Made end // ( Self .Speller .IsNil ) l_Made >>> Result ; // ClassForKeywordImplementation elem_iterator ChildrenEx Cached: ( VAR l_Children Self .Children >>> l_Children Self .FriendInDependencies .filter> ( .IsEvdSchemaElement ! ) .filter> ( .IsInterface ! ) .map> .FriendClass .filter> ( l_Children SWAP .Name .HasModelElementWithName ! ) .for> ( IN aFriend l_Children .join> ToArray: aFriend array:Copy >>> l_Children ) // .for> if ( Self .IsScriptKeywordsPack ) then begin : .OperationsToClasses ARRAY IN anOps ModelElement IN aKeywordSelf anOps //.filter> ( .Name Msg true ) .map> ( aKeywordSelf Self .ClassForKeywordImplementation ) .filter> ( l_Children SWAP .Name .HasModelElementWithName ! ) .for> ( IN aClass l_Children .join> ToArray: aClass array:Copy >>> l_Children ) // .for> ; // .OperationsToClasses Self .OperationsEx .filter> .IsGlobalKeyWord nil .OperationsToClasses Self .InheritsEx .join> ( Self .ImplementsEx ) .filter> .IsAcceptableForScripts .for> ( IN aG Self .OperationsEx .filter> .IsKeyWord aG .OperationsToClasses ) // .for> Self .InheritsEx .filter> .IsVCMForm .filter> ( .Abstraction at_final == ) .for> ( IN aForm begin VAR l_ClassName [ 'Tkw_Form_' aForm .Name ] strings:Cat >>> l_ClassName if ( l_Children l_ClassName .HasModelElementWithName ! ) then begin l_Children .join> ToArray: ( l_ClassName GarantModel::TtfwControlString MakeClass: ( IN aMade aMade -> UID := ( [ aForm .LUID '_Word' ] strings:Cat ) aMade -> Parent := ( Self .WeakRef ) aMade -> "NameForScript" := ( [ 'форма::' aForm .Name ' ' '_' string:Replace ] strings:Cat ) // aMade -> "NameForScript" aMade -> %SUM := ( [ 'Слово словаря для идентификатора формы ' aForm .Name \n '----' \n '*Пример использования*:' \n '{code}' aMade .NameForScript ' TryFocus ASSERT' '{code}' ] strings:Cat ) // aMade -> %SUM aMade -> Visibility := PrivateAccess aMade -> Abstraction := at_final aMade -> SpelledFor := ( aForm .WeakRef ) aMade -> Stereotype := st_ScriptKeyword aMade -> "ifdef" := ( aForm .GetUP "ifdef" ) aMade -> "ifndef" := ( aForm .GetUP "ifndef" ) aMade -> IsSummoned := true aMade -> Overridden := [ GarantModel::TtfwString.GetString .OverrideMethod GarantModel::TtfwRegisterableWordPrim.RegisterInEngine .OverrideMethod ] // aMade -> Overridden ) // MakeClass: ) // .join> ToArray: array:Copy >>> l_Children end // ( l_Children l_ClassName .HasModelElementWithName ! ) end // ( aForm .IsComponent ! ) aForm .CollectControls //.filter> ( .Visibility PublicAccess == ) //.filter> ( .MainAncestor .NotIsNil ) .for> ( IN aControl //if ( aControl .IsComponent ! ) then begin VAR l_ClassName [ 'Tkw_' aForm .Name '_' if ( aControl .IsComponent ) then 'Component' else 'Control' '_' aControl .Name ] strings:Cat >>> l_ClassName if ( l_Children l_ClassName .HasModelElementWithName ! ) then begin l_Children .join> ToArray: ( l_ClassName GarantModel::TtfwControlString MakeClass: ( IN aMade aMade -> UID := ( [ aControl .LUID '_Word' ] strings:Cat ) aMade -> Parent := ( Self .WeakRef ) aMade -> "NameForScript" := ( [ if ( aControl .IsComponent ) then 'компонент' else 'контрол' '::' aControl .Name ' ' '_' string:Replace ] strings:Cat ) // aMade -> "NameForScript" aMade -> %SUM := ( [ 'Слово словаря для идентификатора контрола ' aControl .Name \n '----' \n '*Пример использования*:' \n '{code}' aMade .NameForScript ' TryFocus ASSERT' '{code}' ] strings:Cat ) // aMade -> %SUM aMade -> Visibility := PrivateAccess aMade -> Abstraction := at_final aMade -> SpelledFor := ( aControl .WeakRef ) aMade -> Stereotype := st_ScriptKeyword aMade -> "ifdef" := ( aControl .GetUP "ifdef" ) aMade -> "ifndef" := ( aControl .GetUP "ifndef" ) aMade -> IsSummoned := true aMade -> Overridden := [ GarantModel::TtfwString.GetString .OverrideMethod GarantModel::TtfwRegisterableWordPrim.RegisterInEngine .OverrideMethod ] // aMade -> Overridden ) // MakeClass: ) // .join> ToArray: array:Copy >>> l_Children end // ( l_Children l_ClassName .HasModelElementWithName ! ) end // ( aControl .IsComponent ! ) if ( aControl .IsComponent ! ) then begin VAR l_ClassName [ 'Tkw_' aForm .Name '_' if ( aControl .IsComponent ) then 'Component' else 'Control' '_' aControl .Name '_Push' ] strings:Cat >>> l_ClassName if ( l_Children l_ClassName .HasModelElementWithName ! ) then begin l_Children .join> ToArray: ( l_ClassName GarantModel::TkwBynameControlPush MakeClass: ( IN aMade aMade -> UID := ( [ aControl .LUID '_Word_Push' ] strings:Cat ) aMade -> Parent := ( Self .WeakRef ) aMade -> "NameForScript" := ( [ if ( aControl .IsComponent ) then 'компонент' else 'контрол' '::' aControl .Name ' ' '_' string:Replace ':push' ] strings:Cat ) // aMade -> "NameForScript" aMade -> %SUM := ( [ 'Слово словаря для контрола ' aControl .Name \n '----' \n '*Пример использования*:' \n '{code}' aMade .NameForScript ' pop:control:SetFocus ASSERT' '{code}' ] strings:Cat ) // aMade -> %SUM aMade -> Visibility := PrivateAccess aMade -> Abstraction := at_final aMade -> SpelledFor := ( aControl .WeakRef ) aMade -> Stereotype := st_ScriptKeyword aMade -> "ifdef" := ( aControl .GetUP "ifdef" ) aMade -> "ifndef" := ( aControl .GetUP "ifndef" ) aMade -> IsSummoned := true aMade -> Overridden := [ GarantModel::TtfwWordPrim.DoDoIt .OverrideMethod ] // aMade -> Overridden ) // MakeClass: ) // .join> ToArray: array:Copy >>> l_Children end // ( l_Children l_ClassName .HasModelElementWithName ! ) end // ( aControl .IsComponent ! ) ) // .for> ) // .for> end // ( Self .IsScriptKeywordsPack ) if ( Self .IsVCMForm ) then begin if ( Self .Abstraction at_final == ) then begin VAR l_PackName [ Self .Name 'KeywordsPack' ] strings:Cat >>> l_PackName if ( l_Children l_PackName .HasModelElementWithName ! ) then if ( Self .Parent call.me l_PackName .HasModelElementWithName ! ) then begin l_Children .join> ToArray: ( l_PackName Self MakeClass: ( IN aMade aMade -> UID := ( [ Self .LUID '_Pack' ] strings:Cat ) aMade -> Parent := ( Self .WeakRef ) aMade -> %SUM := ( [ 'Набор слов словаря для доступа к экземплярам контролов формы ' Self .Name ] strings:Cat ) // aMade -> %SUM aMade -> Visibility := PublicAccess aMade -> Abstraction := at_final aMade -> SpelledFor := ( Self .WeakRef ) aMade -> Stereotype := st_ScriptKeywordsPack aMade -> "ifdef" := ( Self .GetUP "ifdef" ) aMade -> "ifndef" := ( [ 'NoScripts' 'NoVCL' Self .GetUP "ifndef" ] ',' strings:CatSep ) // aMade -> "ifndef" aMade -> IsSummoned := true aMade -> "UseNewGen" := true aMade -> "noRegistrator" := true aMade -> "no_pop" := true ) // MakeClass: ) // .join> ToArray: array:Copy >>> l_Children end // ( l_Children l_ClassName .HasModelElementWithName ! ) end // ( Self .Abstraction at_final == ) end // ( Self .IsVCMForm ) l_Children if ( Self .IsTestClass ) then begin if ( Self .UPisTrue "is friend" ) then begin .join> ToArray: ( Self .MainAncestor .FriendClass ) end // ( Self .UPisTrue "is friend" ) end // ( Self .IsTestClass ) if ( Self .NeedsScript ) then begin STRING VAR l_ClassName [ 'T' Self .UnitName 'ResNameGetter' ] strings:Cat >>> l_ClassName if ( l_Children l_ClassName .HasModelElementWithName ! ) then begin .join> [ l_ClassName GarantModel::TtfwAxiomaticsResNameGetter MakeClass: ( IN aMade aMade -> UID := ( Self .LUID '_ResNameGetter' Cat ) aMade -> Parent := ( Self .WeakRef ) aMade -> Stereotype := st_SimpleClass aMade -> %SUM := 'Регистрация скриптованой аксиоматики' aMade -> Visibility := PrivateAccess aMade -> Abstraction := at_final aMade -> "ifdef" := ( Self .IfDefStr ) aMade -> "ifndef" := ( Self .IfNDefStr ) aMade -> "register in scripts" := false aMade -> "need UC" := true aMade -> Operations := [ 'RegAxiom' MakeIniProcedure: ( IN aMadeIni aMadeIni -> %SUM := 'Регистрация скриптованой аксиоматики' aMadeIni .AddMethodWithParams: cUserCodePrefix aMade .RegAxiomUC ) // MakeIniProcedure: ] // aMade -> Operations aMade -> Implemented := [ GarantModel::TtfwAxiomaticsResNameGetter.ResName .ImplementMethod ] // aMade -> Implemented ) // l_ClassName GarantModel::TtfwAxiomaticsResNameGetter MakeClass: ] // .join> end // ( l_Children l_ClassName .HasModelElementWithName ! ) end // ( Self .NeedsScript ) .joinWithLambded> ( Self .OperationsEx .filter> .IsIterator .filter> ( .IsServiceIterator ! ) .filter> ( .IsOverride ! ) .filter> ( l_Children SWAP .IteratorAction .Name .HasModelElementWithName ! ) ) ( .ToArray: .IteratorAction ) array:Copy ) >>> Result ; // ChildrenEx elem_iterator ChildrenWithoutOwnFile Cached: ( Self .ChildrenEx .filter> ( .NeedOwnFile ! ) ) >>> Result ; // ChildrenWithoutOwnFile elem_iterator ChildrenWithOwnFile Cached: ( Self .ChildrenEx .filter> .NeedOwnFile array:Copy ) >>> Result ; // ChildrenWithOwnFile INTERFACE FUNCTION MakeConstants: STRING IN aName ^ IN aLambda aName nil MakeParam: ( IN aMade aMade -> Stereotype := st_Constants aMade aLambda DO ) >>> Result ; // MakeConstants: INTERFACE FUNCTION MakeConstant: STRING IN aName PRINTABLE IN aValue ^ IN aLambda aName nil MakeParam: ( IN aMade aMade -> Class := class_Attribute aMade -> 'extprop:pas:Value' := aValue aMade aLambda DO ) >>> Result ; // MakeConstant: elem_iterator ConstantsEx Cached: ( Self .Constants RULES ( Self .IsTypedef ) begin VAR l_OtherEnum Self .MainAncestor >>> l_OtherEnum RULES ( l_OtherEnum .IsEnum ) RULES ( Self .Name l_OtherEnum .Name == ) RULES ( l_OtherEnum .Attributes .NotEmpty ) begin VAR l_ConstantsName [ Self .Name cUnderline l_OtherEnum .Name cUnderline 'Constants' ] strings:Cat >>> l_ConstantsName RULES ( Self .Parent call.me .filter> ( .Name l_ConstantsName == ) .IsEmpty ) begin .join> [ VAR l_ElementPrefix l_OtherEnum .GetUP 'extprop:pas:ElementPrefix' >>> l_ElementPrefix l_ConstantsName MakeConstants: ( IN aConstants aConstants -> %SUM := ( [ 'Алиасы для значений ' l_OtherEnum .Parent .Name cDot l_OtherEnum .Name ] strings:Cat ) aConstants -> Visibility := PublicAccess //aConstants -> 'extprop:pas:ElementPrefix' := l_ElementPrefix aConstants -> Attributes := [ l_OtherEnum .Attributes .for> ( IN anItem VAR l_Name [ l_ElementPrefix anItem .Name ] strings:Cat >>> l_Name l_Name [ l_OtherEnum .EffectiveUnitName cDot l_Name ] strings:Cat MakeConstant: ( IN aConstant RULES ( anItem .Documentation .IsNotNil ) ( aConstant -> %SUM := ( anItem .Documentation ) ) ; // RULES ) // MakeConstant: ) // l_OtherEnum .Attributes .for> ] // aConstants -> Attributes ) // MakeConstants: ] // .join> end ; // RULES end // ( l_OtherEnum .Attributes .NotEmpty ) ; // RULES ; // RULES ; // RULES end // ( Self .IsTypedef ) ; // RULES array:Copy ) >>> Result ; // ConstantsEx elem_iterator ConstantsAndChildrenWithoutOwnFile Cached: ( Self .ConstantsEx .join> ( Self .ChildrenWithoutOwnFile ) ) >>> Result ; // ConstantsAndChildrenWithoutOwnFile elem_iterator AllOwnChildren Cached: ( Self .ConstantsAndChildrenWithoutOwnFile .join> ( Self .AttributesAndOperations ) ) >>> Result ; // AllOwnChildren ARRAY FUNCTION .OperationsNeededElements ARRAY IN anArray anArray .mapToTargetAndValueType> .join> ( anArray .filter> .IsMessageOperation .filter> ( .GetUP "Message ID" 'CM_' SWAP StartsStr ) .map> ( DROP GarantModel::Controls ) ) // .join> .joinWithLambded> anArray ( .Parameters .mapToTargetAndValueType> ) .joinWithLambded> anArray ( .AttributesAndOperations call.me ) .joinWithLambded> ( anArray .filter> .IsFactoryMethod ) ( .MethodParameters .mapToTargetAndValueType> ) .joinWithLambded> ( anArray .filter> .IsIterator ) ( .MethodParameters .mapToTargetAndValueType> ) .joinWithLambded> ( anArray .filter> .IsFactoryMethod ) ( .ToArray: .MainImplementsInterface ) .joinWithLambded> ( anArray .filter> .IsMethod .map> .MainAncestor .filterNil> ) ( .MethodParameters .mapToTargetAndValueType> ) .joinWithLambded> ( anArray .filter> .IsMethod .map> .MainAncestor .filterNil> .map> .MethodType .filterNil> ) ( .ToArray ) .joinWithLambded> anArray .CanRaise .joinWithLambded> anArray .CanRaiseInSet >>> Result ; // .OperationsNeededElements elem_iterator NeededElementsFromInheritsOrImplements Cached: ( ( Self .InheritsEx ) .join> ( Self .ImplementsEx .filter> ( .IsEvdSchemaElement ! ) ) ) >>> Result ; // NeededElementsFromInheritsOrImplements elem_iterator AttributesAndOperationsNeededElements Self .AttributesAndOperations .OperationsNeededElements >>> Result ; // AttributesAndOperationsNeededElements BOOLEAN elem_func InheritsFromOrSomeAncestorImplements ModelElement IN anIntf RULES ( Self anIntf .InheritsFrom ) true ( Self anIntf .SomeAncestorImplements ) true DEFAULT false ; // RULES >>> Result ; // InheritsFromOrSomeAncestorImplements BOOLEAN elem_func HasManagedAttributes Cached: ( RULES ( Self .IsNil ) false DEFAULT ( Self .Fields .filter> .IsFieldForCleanup .NotEmpty ) ; // RULES ) >>> Result ; // HasManagedAttributes BOOLEAN FUNCTION .HasModelElement ARRAY IN anArray ModelElement IN anElement anArray .HasSomeOf: ( anElement .IsSameModelElement ) >>> Result ; // .HasModelElement elem_iterator OverriddenEx Cached: ( VAR l_Overridden Self .Overridden >>> l_Overridden l_Overridden if ( Self .IsClassOrMixIn ) then begin if ( Self .HasManagedAttributes ) then begin if ( Self GarantModel::l3UnknownPrim .InheritsFromOrSomeAncestorImplements ) then begin if ( l_Overridden GarantModel::l3UnknownPrim.ClearFields .HasModelElement ! ) then begin .join> ToArray: ( GarantModel::l3UnknownPrim.ClearFields .OverrideMethod ) end // ( l_Overridden GarantModel::l3UnknownPrim.ClearFields .HasModelElement ) end // ( Self GarantModel::l3UnknownPrim .InheritsFromOrSomeAncestorImplements ) end // ( Self .HasManagedAttributes ) if ( Self .IsScriptKeyword ) then begin if ( Self .IsMixIn ! ) then begin if ( Self .Abstraction at_abstract != ) then begin if ( Self GarantModel::TtfwRegisterableWord .InheritsFromOrSomeAncestorImplements ) then begin if ( l_Overridden GarantModel::TtfwRegisterableWord.GetWordNameForRegister .HasModelElement ! ) then begin .join> ToArray: ( GarantModel::TtfwRegisterableWord.GetWordNameForRegister .OverrideMethod ) end // ( l_Overridden GarantModel::TtfwRegisterableWord.GetWordNameForRegister .HasModelElement ) end // ( Self GarantModel::TtfwRegisterableWord .InheritsFromOrSomeAncestorImplements ) end // ( Self .Abstraction at_abstract != ) end // ( Self .IsMixIn ! ) BOOLEAN VAR l_HasDoIt ( l_Overridden .join> ( Self .ImplementedEx ) GarantModel::TtfwWordPrim.DoDoIt .HasModelElement ) >>> l_HasDoIt VAR l_Op Self .KeywordOperation >>> l_Op if ( ( l_Op .IsNotNil ) AND ( l_Op .IsSomeKeyWord ) ) then begin if ( ( l_Op .GetUP "SupressNextImmediate" .IsNotNil ) AND ( l_Op .GetUP "SupressNextImmediate" 'None' != ) ) then begin if ( l_Overridden GarantModel::TtfwCompilingWord.SuppressNextImmediate .HasModelElement ! ) then begin .join> ToArray: ( GarantModel::TtfwCompilingWord.SuppressNextImmediate .OverrideMethod ) end // ( l_Overridden GarantModel::TtfwCompilingWord.SuppressNextImmediate .HasModelElement ! ) end // ( l_Op .GetUP "SupressNextImmediate" .IsNotNil ) if ( l_Overridden GarantModel::TtfwWord.GetResultTypeInfo .HasModelElement ! ) then begin .join> ToArray: ( GarantModel::TtfwWord.GetResultTypeInfo .OverrideMethod ) end // ( l_Overridden GarantModel::TtfwWord.GetResultTypeInfo .HasModelElement ! ) if ( l_Overridden GarantModel::TtfwWord.GetAllParamsCount .HasModelElement ! ) then begin .join> ToArray: ( GarantModel::TtfwWord.GetAllParamsCount .OverrideMethod ) end // ( l_Overridden GarantModel::TtfwWord.GetAllParamsCount .HasModelElement ! ) if ( l_Op .IsVarWorker ) then begin if ( l_Overridden GarantModel::TtfwWord.RightParamsCount .HasModelElement ! ) then begin .join> ToArray: ( GarantModel::TtfwWord.RightParamsCount .OverrideMethod ) end // ( l_Overridden GarantModel::TtfwWord.RightParamsCount .HasModelElement ! ) end // ( l_Op .IsVarWorker ) if ( l_Op .UPisTrue "bind params" ) then begin if ( l_Overridden GarantModel::TtfwClassLike.BindParams .HasModelElement ! ) then begin .join> ToArray: ( GarantModel::TtfwClassLike.BindParams .OverrideMethod ) end // ( l_Overridden GarantModel::TtfwClassLike.BindParams .HasModelElement ! ) end // ( l_Op .UPisTrue "bind params" ) if ( l_Overridden GarantModel::TtfwWord.ParamsTypes .HasModelElement ! ) then begin .join> ToArray: ( GarantModel::TtfwWord.ParamsTypes .OverrideMethod ) end // ( l_Overridden GarantModel::TtfwWord.ParamsTypes .HasModelElement ! ) if ( ( l_Op .GetUP 'extprop:prop_stereo' .IsValueValid ) OR ( l_Op .UPisTrue "lvalue" ) ) then begin if ( l_Overridden GarantModel::TtfwWord.SetValuePrim .HasModelElement ! ) then begin .join> ToArray: ( GarantModel::TtfwWord.SetValuePrim .OverrideMethod ) end // ( l_Overridden GarantModel::TtfwWord.SetValuePrim .HasModelElement ! ) end // ( l_Op .GetUP 'extprop:prop_stereo' .IsValueValid ) if ( l_Op .IsVarWorker ) then begin if ( l_Overridden GarantModel::TtfwAnonimousWord.DoRun .HasModelElement ! ) then begin .join> ToArray: ( GarantModel::TtfwAnonimousWord.DoRun .OverrideMethod ) true >>> l_HasDoIt end // ( l_Overridden GarantModel::TtfwAnonimousWord.DoRun .HasModelElement ! ) end // ( l_Op .IsVarWorker ) else begin if ( l_HasDoIt ! ) then begin .join> ToArray: ( GarantModel::TtfwWordPrim.DoDoIt .OverrideMethod ) true >>> l_HasDoIt end // ( l_HasDoIt ! ) end // ( l_Op .IsVarWorker ) end // ( l_Op .IsNotNil ) if ( l_HasDoIt ! ) then begin if ( Self .InheritsEx .filter> ( GarantModel::TtfwRegisterableWord .IsSameModelElement ) .NotEmpty ) then begin //Self .Name Msg .join> ToArray: ( GarantModel::TtfwWordPrim.DoDoIt .OverrideMethod ) end // .filter> ( GarantModel::TtfwRegisterableWord .IsSameModelElement ) end // ( l_HasDoIt ! ) end // ( Self .IsScriptKeyword ) if ( Self .GetUP "is immediate" IsBool ) then begin if ( Self GarantModel::TtfwWord .InheritsFromOrSomeAncestorImplements ) then begin if ( l_Overridden GarantModel::TtfwWord.IsImmediate .HasModelElement ! ) then begin .join> ToArray: ( GarantModel::TtfwWord.IsImmediate .OverrideMethod ) end // ( l_Overridden GarantModel::TtfwWord.IsImmediate .HasModelElement ) end // ( Self GarantModel::TtfwWord .InheritsFromOrSomeAncestorImplements ) end // ( Self .GetUP "is immediate" IsBool ) end // ( Self .IsClassOrMixIn ) if ( Self .IsTestCase ) then begin if ( Self GarantModel::TBaseTest .InheritsFromOrSomeAncestorImplements ) then begin if ( l_Overridden GarantModel::TAbstractTest.GetFolder .HasModelElement ! ) then begin .join> ToArray: ( GarantModel::TAbstractTest.GetFolder .OverrideMethod ) end // ( l_Overridden GarantModel::TAbstractTest.GetFolder .HasModelElement ) if ( l_Overridden GarantModel::TAbstractTest.GetModelElementGUID .HasModelElement ! ) then begin .join> ToArray: ( GarantModel::TAbstractTest.GetModelElementGUID .OverrideMethod ) end // ( l_Overridden GarantModel::TAbstractTest.GetModelElementGUID .HasModelElement ) end // ( Self GarantModel::TBaseTest .InheritsFromOrSomeAncestorImplements ) end // ( Self .IsTestCase ) if ( Self .IsVCMApplication ) then begin .join> ToArray: ( GarantModel::TComponent.Loaded .OverrideMethod ) end // ( Self .IsVCMApplication ) ) >>> Result ; // OverriddenEx elem_iterator ImplementedAndOverridden Cached: ( Self .ImplementedEx .join> ( Self .OverriddenEx ) ) >>> Result ; // ImplementedAndOverridden elem_iterator NeededElements Cached: ( if ( Self .IsScriptKeywordsPack ) then begin [empty] end // ( Self .IsScriptKeywordsPack ) else begin Self .NeededElementsFromInheritsOrImplements end // ( Self .IsScriptKeywordsPack ) .join> ( Self .AttributesAndOperationsNeededElements ) if ( Self .IsTypedef ! ) then begin .join> ( Self .ImplementedAndOverridden .OperationsNeededElements ) end // Self .IsTypedef ! if ( Self .IsClassOrMixIn ) then begin .joinWithLambded> ( Self .ClassImplementsPrim ) .InterfaceForClassImplements end // ( Self .IsClassOrMixIn ) .joinWithLambded> ( Self .NeededElementsFromInheritsOrImplements .filter> .IsMixIn ) call.me Self .NeededElementsFromInheritsOrImplements .filter> .IsMixIn .for> ( IN anItem .joinWithLambded> ( anItem .ConstantsAndChildrenWithoutOwnFile ) call.me ) ) >>> Result ; // NeededElements elem_iterator NeededElements: ^ IN aChildAcceptable if ( Self aChildAcceptable DO ) then begin Self .NeededElements end // ( Self aChildAcceptable DO ) else [empty] >>> Result ; // NeededElements: elem_iterator NeededElementsTotal IN aChildAcceptable [empty] .joinWithLambded> ( Self .ConstantsAndChildrenWithoutOwnFile .filter> ( aChildAcceptable DO ) ) .NeededElements .joinWithLambded> ( Self .ConstantsAndChildrenWithoutOwnFile ) ( aChildAcceptable call.me ) >>> Result ; // NeededElementsTotal elem_iterator NeededElementsTotal: ^ IN aChildAcceptable Self aChildAcceptable .NeededElementsTotal >>> Result ; // NeededElementsTotal: BOOLEAN elem_func IsForInterfacePrim Cached: ( RULES ( Self .Visibility PublicAccess == ) true ( Self .Visibility ProtectedAccess == ) true DEFAULT false ; // RULES ) >>> Result ; // IsForInterfacePrim BOOLEAN elem_func IsForInterface Cached: ( RULES ( Self .Parent .IsNotNil ) RULES ( Self .Parent call.me ) ( Self .IsForInterfacePrim ) DEFAULT false ; // RULES ( Self .IsForInterfacePrim ) true DEFAULT false ; // RULES ) >>> Result ; // IsForInterface BOOLEAN elem_func IsForImplementation Cached: ( Self .IsForInterface ! ) >>> Result ; // IsForImplementation BOOLEAN elem_func IsVCMControls Self .IsStereotype st_VCMControls >>> Result ; // IsVCMControls elem_iterator DependsEx Cached: ( Self .Depends array:Copy ) >>> Result ; // DependsEx elem_iterator IntfUses Cached: ( GarantModel::l3IntfUses .ToArray if ( Self .IsInterfaces ) then begin .join> ( Self .DependsEx .filter> .IsInterfaces ) end // ( Self .IsInterfaces ) .join> ( Self .NeededElements: .IsForInterface ) .join> ( Self .NeededElementsTotal: .IsForInterface ) if ( Self .IsControllerInterfaces ) then begin .join> ToArray: GarantModel::vcmInterfaces .join> ToArray: GarantModel::vcmControllers end // ( Self .IsControllerInterfaces ) if ( Self .IsVCMControls ) then begin .join> ToArray: GarantModel::vcmExternalInterfaces end // ( Self .IsVCMControls ) ) >>> Result ; // IntfUses BOOLEAN elem_func IsInjects Self .IsStereotype st_injects::Dependency >>> Result ; // IsInjects elem_iterator InjectedElements Cached: ( Self .Injected .filter> .IsInjects .map> .Parent array:Copy ) >>> Result ; // InjectedElements BOOLEAN elem_func IsUses Self .IsStereotype st_uses::Dependency >>> Result ; // IsUses elem_iterator UsesInDependencies Cached: ( Self .Dependencies .filter> .IsUses .mapToTarget> array:Copy ) >>> Result ; // UsesInDependencies BOOLEAN elem_func IsFactoryInTie ( Self .IsFactory ) AND ( Self .InTie ) >>> Result ; // IsFactoryInTie INTERFACE elem_func InstanceFreeMethod Cached: ( VAR l_TypeName Self .TypeName >>> l_TypeName l_TypeName 'Free' Cat MakeProcedure: ( IN aMade aMade -> %SUM := ( 'Метод освобождения экземпляра синглетона ' l_TypeName Cat ) aMade -> Visibility := PrivateAccess aMade -> "ifdef" := ( Self .IfDefStr ) aMade -> "ifndef" := ( Self .IfNDefStr ) aMade ->^ cVarUserCodeName ^:= cEmptyUserCode aMade ->^ cImplementationUserCodeName ^:= [ if ( Self .HasFactory ) then begin ' IUnknown(' 'g_' l_TypeName ') := nil;' end else begin ' l3Free(' 'g_' l_TypeName ');' end // ( Self .HasFactory ) ] ) ) >>> Result ; // InstanceFreeMethod elem_iterator GlobalOperationsPrim Cached: ( RULES ( Self .IsInterface ) ( Self .OperationsEx .filter> .IsStaticMethod .filter> ( .IsFactoryInTie ! ) ) ( Self .IsRecord ) ( Self .OperationsEx .filter> .IsConstructor ) ( Self .IsUtilityPack ) ( Self .OperationsEx ) ( Self .IsClassOrMixIn ) ( if ( Self .IsSingleton ) then begin [ Self .InstanceFreeMethod ] end // ( Self .IsSingleton ) else [empty] ) DEFAULT [empty] ; // RULES VAR l_Operations array:Copy >>> l_Operations l_Operations .joinWithLambded> ( Self .OperationsEx .filter> .IsIterator .filter> ( .IsServiceIterator ! ) .filter> ( .IsOverride ! ) .filter> ( l_Operations SWAP .IteratorStub .Name .HasModelElementWithName ! ) ) ( .ToArray: .IteratorStub ) ) >>> Result ; // GlobalOperationsPrim elem_iterator GlobalOperations Self .GlobalOperationsPrim .filter> ( .IsIni ! ) .filter> ( .IsFini ! ) .filter> ( .IsKeyWord ! ) .filter> ( .IsGlobalKeyWord ! ) >>> Result ; // GlobalOperations elem_iterator OperationsUsed [empty] .joinWithLambded> ( Self .OperationsEx ) .UsesInDependencies .joinWithLambded> ( Self .GlobalOperations .filter> .IsStaticOp .filter> ( .UPisTrue 'extprop:isAsm' ) ) ( DROP ToArray: GarantModel::l3LocalStub ) .joinWithLambded> ( Self .OperationsEx ) call.me >>> Result ; // OperationsUsed elem_iterator MixInValues Self .Attributes .filter> ( .IsStereotype st_impurity_value::Attribute ) >>> Result ; // MixInValues BOOLEAN elem_func InheritsOrImplementsMixIn Cached: ( RULES ( Self .InheritsEx .filter> .IsMixIn .NotEmpty ) true ( Self .ImplementsEx .filter> .IsMixIn .NotEmpty ) true DEFAULT false ; // RULES ) >>> Result ; // InheritsOrImplementsMixIn BOOLEAN elem_func ImplementsMixIn Cached: ( RULES //( Self .InheritsEx .filter> .IsMixIn .NotEmpty ) // true ( Self .ImplementsEx .filter> .IsMixIn .NotEmpty ) true DEFAULT false ; // RULES ) >>> Result ; // ImplementsMixIn elem_iterator OtherMixinValuesUses [empty] .joinWithLambded> ( Self .InheritsEx ) ( .MixInValues .mapToTarget> ) .joinWithLambded> ( Self .InheritsEx ) call.me >>> Result ; // OtherMixinValuesUses BOOLEAN elem_func IsClass Self .IsSimpleClass >>> Result ; // IsClass BOOLEAN elem_func NeedRegisterInScriptsPrim Cached: ( RULES ( Self .GetUP "register in scripts" false ?== ) false ( Self .UPisTrue "register in scripts" ) true ( Self .InheritsEx .filter> call.me .NotEmpty ) true ( Self .IsGuiControl ) true DEFAULT false ; // RULES ) >>> Result ; // NeedRegisterInScriptsPrim BOOLEAN elem_func NeedRegisterInScripts Cached: ( RULES ( Self .IsMixIn ) false ( Self .IsVCMCustomForm ) true ( Self .NeedRegisterInScriptsPrim ) RULES ( Self .Name 'Hack' string:Pos -1 != ) false ( Self .IsMixIn ) false ( Self .Abstraction at_abstract == ) true ( Self .IsScriptKeyword ) false ( Self .IsTestClass ) false ( Self .IsClass ) true ( Self .IsEnum ) true ( Self .IsException ) true ( Self .IsInterface ) true DEFAULT false ; // RULES DEFAULT false ; // RULES ) >>> Result ; // NeedRegisterInScripts elem_iterator ImplementsIsInterface Cached: ( Self .ImplementsEx .filter> .IsInterface ) >>> Result ; // ImplementsIsInterface elem_iterator Used Cached: ( Self .UsesInDependencies if ( Self .IsInterface ! ) then begin .join> ( Self .InjectedElements ) .joinWithLambded> ( Self .ImplementsIsInterface ) .InjectedElements end // Self .IsInterface ! .joinWithLambded> ( Self .InheritsEx .filter> .IsMixIn ) call.me .joinWithLambded> ( Self .ImplementsEx .filter> .IsMixIn ) call.me .join> ( Self .OperationsUsed ) if ( Self .InheritsOrImplementsMixIn ) then begin .join> ( Self .OtherMixinValuesUses ) end // ( Self .InheritsOrImplementsMixIn ) if ( Self .IsSingleton ) then begin .join> ToArray: GarantModel::SysUtils .join> ToArray: GarantModel::l3Base end // ( Self .IsSingleton ) if ( Self .IsClassOrMixIn ) then begin if ( Self .ImplementedAndOverridden .filter> .IsIterator .NotEmpty ) then begin .join> ToArray: GarantModel::l3Base end // ( Self .ImplementedAndOverridden .filter> .IsIterator .NotEmpty ) .joinWithLambded> ( Self .ImplementedAndOverridden ) .UsesInDependencies end // ( Self .IsClassOrMixIn ) if ( Self .NeedRegisterInScripts ) then begin RULES ( Self .IsEnum ) begin .join> ToArray: GarantModel::TtfwTypeRegistrator(Proxy) end // ( Self .IsEnum ) ( Self .IsException ) begin .join> ToArray: GarantModel::TtfwTypeRegistrator(Proxy) end // ( Self .IsException ) ( Self .IsInterface ) begin .join> ToArray: GarantModel::TtfwTypeRegistrator(Proxy) end // ( Self .IsInterface ) ( Self GarantModel::TtfwWord .InheritsFrom ! ) begin .join> ToArray: GarantModel::TtfwClassRef(Proxy) end // ( Self GarantModel::TtfwWord .InheritsFrom ! ) ; // RULES end // ( Self .NeedRegisterInScripts ) if ( Self .IsTestCase ) then begin .join> ToArray: GarantModel::TestFrameWork end // ( Self .IsTestCase ) if ( Self .IsScriptKeywordsPack ) then begin if ( Self .InheritsEx .filter> .IsVCMForm .filter> ( .Abstraction at_final == ) .NotEmpty ) then begin Self .InheritsEx .filter> .IsVCMForm .filter> ( .Abstraction at_final == ) .for> ( IN aForm .join> ( aForm .CollectControls .map> .MainAncestor .filterNil> ) // .join> ) // .for> .join> ToArray: GarantModel::TtfwClassRef(Proxy) end // .filter> .IsVCMForm end // ( Self .IsScriptKeywordsPack ) ) >>> Result ; // Used elem_iterator UsedTotal Self .Used .joinWithLambded> ( Self .AllOwnChildren ) call.me >>> Result ; // UsedTotal elem_iterator AbstractUses Cached: ( [empty] ( Self .InheritsEx .filter> .IsSimpleClass .filter> ( .Abstraction at_abstract == ) ) .for> ( IN aG .joinWithLambded> ( aG .ImplementsEx .filter> .IsMixIn ) // .joinWithLambded> .UsesInDependencies .join> ( aG call.me ) ) // .for> ) >>> Result ; // AbstractUses BOOLEAN elem_func IsTestForTestLibrary RULES ( Self .IsTestClass ) true ( Self .IsTestCaseMixIn ) true ( Self .IsTestCase ) RULES ( Self .Abstraction at_abstract == ) false DEFAULT true ; // RULES DEFAULT false ; // RULES >>> Result ; // IsTestForTestLibrary elem_iterator DependsVCMGUI Cached: ( Self .DependsEx .filter> .IsVCMGUI array:Copy ) >>> Result ; // DependsVCMGUI elem_iterator DependsTestLibrary Cached: ( Self .DependsEx .filter> .IsTestLibrary array:Copy ) >>> Result ; // DependsTestLibrary elem_iterator ImplUses Cached: ( GarantModel::l3ImplUses .ToArray if ( Self .IsScriptKeywordsPack ) then begin .join> ( Self .NeededElementsFromInheritsOrImplements ) end // ( Self .IsScriptKeywordsPack ) .join> ( Self .NeededElements: .IsForImplementation ) .join> ( Self .NeededElementsTotal: .IsForImplementation ) .join> ( Self .UsedTotal ) if ( Self .IsScriptKeywordsPack ) then begin .join> ( Self .ChildrenWithOwnFile ) .join> ToArray: GarantModel::SysUtils .join> ToArray: GarantModel::TtfwTypeRegistrator(Proxy) .join> ToArray: GarantModel::TypeInfoExt end // ( Self .IsScriptKeywordsPack ) if ( Self .IsTarget ) then begin .join> ( Self .ChildrenWithOwnFile ) end // ( Self .IsTarget ) if ( Self .IsVCMCustomForm ) then begin .join> ( Self .ChildrenWithOwnFile ) end // ( Self .IsVCMCustomForm ) if ( Self .IsVCMFormsPack ) then begin .join> ( Self .ChildrenWithOwnFile ) end // ( Self .IsVCMFormsPack ) if ( Self .IsVCMFormSetFactory ) then begin .join> ( Self .ChildrenWithOwnFile ) end // ( Self .IsVCMFormSetFactory ) if ( Self .IsVCMApplication ) then begin .join> ( Self .ChildrenWithOwnFile ) .join> ToArray: GarantModel::evExtFormat if ( Self .Abstraction at_final == ) then begin .join> ToArray: GarantModel::StdRes end // ( Self .Abstraction at_final == ) end // ( Self .IsVCMApplication ) if ( Self .IsVCMUseCaseRealization ) then begin .join> ( Self .ChildrenWithOwnFile ) end // ( Self .IsVCMUseCaseRealization ) if ( Self .IsTestLibrary ) then begin .join> ( Self .ChildrenWithOwnFile .filter> .IsTestUnit ) end // ( Self .IsTestLibrary ) if ( Self .IsTestUnit ) then begin .join> ( Self .ChildrenWithOwnFile .filter> .IsTestForTestLibrary ) end // ( Self .IsTestUnit ) if ( Self .IsClassOrMixIn ) then begin .join> ( Self .AbstractUses ) end // ( Self .IsClassOrMixIn ) if ( Self .IsTestClass ) then begin .join> ToArray: GarantModel::Variants .join> ToArray: GarantModel::ActiveX .join> ToArray: GarantModel::tc5OpenAppClasses .join> ToArray: GarantModel::tc5PublicInfo .join> ToArray: GarantModel::tc6OpenAppClasses .join> ToArray: GarantModel::tc6PublicInfo end // ( Self .IsTestClass ) if ( Self .Name 'l3IID' == ) then begin .join> ToArray: GarantModel::Windows .join> ToArray: GarantModel::SysUtils end // ( Self .Name 'l3IID' == ) RULES ( Self .IsTestTarget ) begin .join> ToArray: GarantModel::SysUtils .join> ToArray: GarantModel::l3Base .join> ToArray: GarantModel::TKBridge .join> ToArray: GarantModel::KTestRunner .join> ToArray: GarantModel::TextTestRunner .join> ToArray: GarantModel::GUITestRunner if ( Self .UPisTrue "no scripts" ! ) then begin .join> ToArray: GarantModel::TvcmInsiderTest end // ( Self .UPisTrue "no scripts" ! ) end // ( Self .IsTestTarget ) ; // RULES RULES ( Self .IsVCMTestTarget ) begin RULES ( Self .DependsVCMGUI .filter> ( .GetUP "F1Like" false ?== ) .IsEmpty ) ( .join> ToArray: GarantModel::TF1AutoTestSuite ) DEFAULT ( .join> ToArray: GarantModel::TAutoTestsSuite ) ; // RULES .join> ToArray: GarantModel::StdRes end // ( Self .IsVCMTestTarget ) ( Self .IsTestTarget ) begin if ( Self .UPisTrue "is insider test" ! ) then begin if ( Self .UPisTrue "no scripts" ! ) then begin .join> ToArray: GarantModel::TAutoTestsSuite .join> ToArray: GarantModel::TtfwScriptEngineEX end // ( Self .UPisTrue "no scripts" ! ) end // ( Self .UPisTrue "is insider test" ! ) end // ( Self .IsTestTarget ) ( Self .IsVCMGUI ) ( .join> ToArray: GarantModel::StdRes ) ; // RULES RULES ( Self .IsTestLibrary ) begin .join> ( Self .DependsTestLibrary ) RULES ( Self .ChildrenEx .filter> .IsTestUnit .filter> ( .ChildrenEx .filter> .IsTestClass .NotEmpty ) // .filter> .NotEmpty ) begin .join> ToArray: GarantModel::tc5OpenApp .join> ToArray: GarantModel::tc6OpenApp end ; // RULES end // ( Self .IsTestLibrary ) ( Self .IsTestTarget ) begin VAR l_Parent Self .Parent >>> l_Parent // Сначала перебираем чужие тестовые библиотеки: .join> ( Self .DependsTestLibrary .filter> ( .Parent l_Parent .IsSameModelElement ! ) array:Copy ) // .join> // Потом перебираем свои тестовые библиотеки: .join> ( Self .DependsTestLibrary .filter> ( .Parent l_Parent .IsSameModelElement ) array:Copy ) // .join> end // ( Self .IsTestTarget ) ( Self .IsDLL ) begin VAR l_Parent Self .Parent >>> l_Parent Self .DependsEx .filter> .IsLibrary .filter> ( .Parent l_Parent .IsSameModelElement ) .for> ( IN aLibrary aLibrary .ChildrenEx .for> ( IN aChild .join> ToArray: aChild ) // .for> aLibrary .ChildrenEx .filter> .IsUnit .for> ( IN aUnit aUnit .ChildrenEx .for> ( IN aClass .join> ToArray: aClass ) // .for> ) // .for> ) // .for> end // ( Self .IsDLL ) ( Self .IsVCMGUI ) begin .join> ( Self .DependsTestLibrary ) Self .DependsEx .filter> .IsVCMUseCase .for> ( IN aUseCase aUseCase .ChildrenEx .filter> .IsVCMUseCaseRealization .for> ( IN aUseCaseRealization .join> ToArray: aUseCaseRealization ) // .for> ) // .for> end // ( Self .IsVCMGUI ) ; // RULES ) >>> Result ; // ImplUses elem_iterator IntfAndImplUses Self .IntfUses .join> ( Self .ImplUses ) >>> Result ; // IntfAndImplUses elem_iterator ProjectUsesPrim Cached: ( GarantModel::l3IntfUses .ToArray RULES ( Self .IsVCMGUI ) begin if ( Self .GetUP "F1Like" false ?!= ) then begin .join> ToArray: GarantModel::nsApplication end // ( Self .GetUP "F1Like" false ?!= ) .join> ToArray: GarantModel::Tl3ExceptionsLog .join> ToArray: GarantModel::ControlResizeBugFix end // ( Self .IsVCMGUI ) ( Self .IsVCMTestTarget ) begin .joinWithLambded> ( Self .DependsVCMGUI ) call.me end // ( Self .IsVCMTestTarget ) ( Self .IsExe ) begin .join> ToArray: GarantModel::Tl3ExceptionsLog if ( Self .UPisTrue "console" ! ) then begin .join> ToArray: GarantModel::ControlResizeBugFix end // ( Self .UPisTrue "console" ! ) end // ( Self .IsExe ) ; // RULES .join> ( Self .IntfAndImplUses ) RULES ( Self .IsVCMGUI ) begin .join> ToArray: GarantModel::Tl3MouseWheelHelper end // ( Self .IsVCMGUI ) ; // RULES ARRAY VAR l_Uses [] >>> l_Uses .mapToUnitProducer> //.filter> ( Self ?!= ) .filter> ( .NotInArray: l_Uses ) // - возможно это стоит включить, а также включить сюда фильтрацию дубликатов // чтобы уменьшить повторно выполняемую работу в ProjectUses AccumulateUses .for> ( .AddToArray: l_Uses ) // .for> l_Uses ) >>> Result ; // ProjectUsesPrim elem_iterator ProjectUses ARRAY VAR l_ProjectUses [] >>> l_ProjectUses ARRAY VAR l_InUses [] >>> l_InUses PROCEDURE AccumulateUses ARRAY IN aUses aUses .for> ( IN anItem //if ( l_InUses .filter> ( anItem ?== ) .IsEmpty ) then if ( anItem .NotInArray: l_InUses ) then // - это можно в filter перенести, выше begin anItem .AddToArray: l_InUses anItem .AddToArray: l_ProjectUses RULES ( anItem IsString ) () DEFAULT ( anItem .ProjectUsesPrim call.me ) ; // RULES end // ( anItem .NotInArray: l_InUses ) ) // .for> ; // AccumulateUses Self .ProjectUsesPrim AccumulateUses l_ProjectUses >>> Result ; // ProjectUses ModelElement elem_func SecondAttribute Cached: ( Self .Attributes .SecondElement ) >>> Result ; // SecondAttribute STRING elem_func FineDocumentation Self .Documentation >>> Result if ( Result .IsNotNil ) then begin Result cOpenComment '[' string:Replace >>> Result Result cCloseComment ']' string:Replace >>> Result [ cOpenComment '* ' Result cSpace cCloseComment ] strings:Cat >>> Result end // Result .IsNotNil ; // FineDocumentation elem_proc OutDocumentation STRING VAR l_Doc Self .FineDocumentation >>> l_Doc if ( l_Doc .IsNotNil ) then begin Indented: ( l_Doc .Out ) end // l_Doc .IsNotNil ; // OutDocumentation STRING elem_func MethodCallingConventions RULES ( Self .InTie ) 'stdcall' ( Self .IsMethod ) ( Self .FirstOperation .GetUP "calling conventions" ) ( Self .IsFunction ) ( Self .FirstOperation .GetUP "calling conventions" ) DEFAULT ( Self .GetUP "calling conventions" ) ; // RULES >>> Result if ( Result 'none' == ) then begin cEmptyStr >>> Result end // ( Result 'none' == ) if ( Result .IsNotNil ) then begin cSpace Result ';' Cat Cat >>> Result end // ( Result .IsNotNil ) ; // MethodCallingConventions CONST cConstPrefix 'const ' STRING elem_func InPrefix Cached: ( RULES ( Self .IsNil ) cConstPrefix ( Self .IsRecord ) cConstPrefix ( Self .IsUnion ) cConstPrefix ( Self .IsArray ) cConstPrefix ( Self .IsInterface ) cConstPrefix ( Self .IsTypedef ) RULES ( Self .IsPointer ) cEmptyStr DEFAULT ( Self .MainAncestor call.me ) ; // RULES ( Self .IsMixInParamType ) cConstPrefix ( Self .IsString ) cConstPrefix ( Self .IsUntyped ) cConstPrefix DEFAULT cEmptyStr ; // RULES ) >>> Result ; // InPrefix STRING elem_func ParamPrefix RULES ( Self .IsStereotype st_in ) ( Self .Target .InPrefix ) ( Self .IsStereotype st_const ) cConstPrefix ( Self .IsStereotype st_noconst ) cEmptyStr ( Self .IsOutParam ) 'out ' ( Self .IsStereotype st_inout ) 'var ' DEFAULT ( Self .Target .InPrefix ) ; // RULES >>> Result ; // ParamPrefix BOOLEAN elem_func IsDestructor RULES ( Self .MethodName 'Destroy' == ) true ( Self .MethodName 'destroy' == ) true DEFAULT false ; // RULES >>> Result ; // IsDestructor OUTABLE elem_func MethodKeyword Cached: ( RULES ( Self .IsStaticConstructor ) 'function' ( Self .IsConstructor ) ( 'constructor' ) ( Self .IsFactory ) ( 'class function' ) ( Self .IsDestructor ) ( 'destructor' ) DEFAULT ( ModelElement VAR l_Type Self .MethodType >>> l_Type VAR l_IsFunc ( l_Type .IsNotNil ) AND ( l_Type .TypeName .IsNotNil ) >>> l_IsFunc [ RULES ( Self .ParentIsInterface ) () ( Self .UPisTrue 'extprop:isGlobal' ) () ( Self .IsStaticMethod ) 'class ' ; // RULES if l_IsFunc then begin 'function' end // l_IsFunc else begin 'procedure' end // l_IsFunc ] ) // DEFAULT ; // RULES ) >>> Result ; // MethodKeyword BOOLEAN elem_func IsInline Self .IsStereotype st_inline::Operation >>> Result ; // IsInline BOOLEAN elem_func IsOperationOverride Self .IsStereotype st_override::Operation >>> Result ; // IsOperationOverride INTEGER elem_func MethodAbstraction Cached: ( Self .OpKind CASE opkind_Normal ( RULES ( Self .IsMessageOperation ) at_message ( ( Self .IsIterator ) AND ( Self .MainAncestor .IsNotNil ) ) at_override ( Self .IsStaticConstructor ) at_final ( Self .Parent .IsUtilityPack ) at_final ( Self .Parent .IsStaticObject ) at_final ( Self .ParentIsInterface ) at_final ( Self .IsFunction ) at_final ( Self .IsOperationOverride ) at_override DEFAULT ( Self .Abstraction ) ; // RULES ) // opkind_Normal opkind_Implemented ( RULES ( Self .IsVCMOperationPrim ) at_final ( Self .Parent .IsContract ) at_abstract ( Self .ParentIsInterface ) RULES ( Self .IsIteratorF ) at_final ( Self .IsIterator ) RULES ( 'F' Self .Name EndsStr ) at_final DEFAULT at_virtual ; // RULES DEFAULT at_final ; // RULES ( Self .IsInline ) at_final DEFAULT at_override ; // RULES ) // opkind_Implemented opkind_Overridden RULES ( Self .IsInline ) at_final DEFAULT at_override ; // RULES DEFAULT at_final END // CASE ) >>> Result ; // MethodAbstraction STRING elem_func MethodNamePrefix RULES ( Self .IsSetter ) begin RULES ( Self .InTie ) 'Set' ( Self .UPisTrue "pm" ) 'pm_Set' DEFAULT 'Set_' ; // RULES end // ( Self .IsSetter ) ( Self .IsProperty ) begin RULES ( Self .InTie ) 'Get' ( Self .UPisTrue "pm" ) 'pm_Get' DEFAULT 'Get_' ; // RULES end // ( Self .IsProperty ) DEFAULT cEmptyStr ; // RULES >>> Result ; // MethodNamePrefix STRING CompileTime-VAR g_MethodParentPrefix '' BOOLEAN CompileTime-VAR g_EnableMethodDirectives true BOOLEAN CompileTime-VAR g_EnableMethodDocumentation true ANY elem_func ExtValue Cached: ( Self .GetUP 'extprop:pas:Value' >>> Result if ( Result .IsValueValid ) then begin RULES ( Result IsString ) begin RULES ( '.[]' Result EndsStr ) begin '[]' >>> Result end // ( '.[]' Result EndsStr ) ( '.nil' Result EndsStr ) begin 'nil' >>> Result end // ( '.[]' Result EndsStr ) ( ( ']' Result EndsStr ) AND ( '[' Result StartsStr ! ) ) begin VAR l_Head Result cDot string:Split >>> Result >>> l_Head if ( Result .IsNil ) then begin l_Head >>> Result end // ( Result .IsNil ) end // ( '.[]' Result EndsStr ) ( 'vcmUserControls.vcm_utAny' Result == ) ( 'vcm_utAny' >>> Result ) ( 'evdInterfaces.evDefaultStoreFlags' Result == ) ( 'evDefaultStoreFlags' >>> Result ) DEFAULT begin VAR l_Type Self .ValueType >>> l_Type if ( l_Type .IsNotNil ) then begin VAR l_Target Self .Target >>> l_Target if ( ( l_Target .IsNil ) OR ( l_Target l_Type != ) ) then begin VAR l_Unit l_Type .EffectiveUnitName >>> l_Unit if ( Self .EffectiveUnitName l_Unit != ) then begin l_Unit cDot Cat >>> l_Unit if ( l_Unit Result StartsStr ! ) then begin l_Unit Result Cat >>> Result end // ( l_Unit Result StartsStr ! ) end // ( Self .EffectiveUnitName l_Unit != ) end // ( Self .Target l_Type != ) end // ( l_Type .IsNotNil ) end // DEFAULT ; // RULES end // ( Result IsString ) ; // RULES end // ( Result .IsValueValid ) Result ) >>> Result ; // ExtValue elem_proc MethodInterfacePrim IN aPrefix IN aOverload IN aOfObject IN aBody : OutOverload aOverload DO ; // OutOverload : OutCallingConventions Self .MethodCallingConventions ; // OutCallingConventions : OutReintroduce RULES ( Self .IsStaticConstructor ) () ( Self .ParentIsInterface ) () ( Self .IsConstructor ) ( ' reintroduce;' ) ( Self .IsFactory ) ( ' reintroduce;' ) ; // RULES ; // OutReintroduce RULES ( Self .IsNil ) () DEFAULT begin Self .IfDef: ( [ aPrefix DO ModelElement VAR l_Type Self .MethodType >>> l_Type VAR l_IsFunc RULES ( Self .IsSetter ) ( false >>> l_IsFunc 'procedure' ) DEFAULT ( ( l_Type .IsNotNil ) AND ( l_Type .TypeName .IsNotNil ) >>> l_IsFunc Self .MethodKeyword ) ; // RULES if ( Self .IsFunction ! ) then begin cSpace g_MethodParentPrefix RULES ( Self .IsProperty ) ( Self .MethodNamePrefix Self .MethodName ) DEFAULT ( Self .MethodName ) ; // RULES end // ( Self .IsFunction ! ) VAR l_WasParam false >>> l_WasParam VAR l_MethodAbstraction Self .MethodAbstraction >>> l_MethodAbstraction RULES ( Self .IsSetter ) ( Self .PropertyKeys .join> ToArray: ( l_Type .ValueParam ) ) ( Self .IsProperty ) ( Self .PropertyKeys ) DEFAULT ( Self .MethodParameters ) ; // RULES .for> ( IN aParam if ( l_WasParam ! ) then '(' VAR l_WasIf false >>> l_WasIf elem: IfDefBraceLn: ^ IN aLambda Self nil .IfDefPrim: ( \n l_WasIf ! ? SWAP true >>> l_WasIf ) ( aLambda DO l_WasIf ? \n ) // Self .IfDefPrim: ; // IfDefBraceLn: aParam .IfDefBraceLn: ( if ( l_WasParam ) then begin ';' \n cSpace end true >>> l_WasParam aParam .ParamPrefix aParam .Name VAR l_Type aParam .Target >>> l_Type if ( l_Type .IsNotNil ) then begin ': ' l_Type .TypeName end // ( l_Type .IsNotNil ) //if ( l_MethodAbstraction at_override != ) then begin VAR l_Value aParam .ExtValue >>> l_Value //aParam .GetUP 'Value' >>> l_Value if ( l_Value .IsValueValid ) then begin ' = ' l_Value end // ( l_Value .IsValueValid ) end // ( l_MethodAbstraction at_override != ) VAR l_Doc aParam .FineDocumentation >>> l_Doc if ( l_Doc .IsNotNil ) then begin \n cSpace l_Doc end // ( l_Doc .IsNotNil ) ) // aParam .IfDefBraceLn: ) // Self .MethodParameters .for> if ( l_WasParam ) then ')' if l_IsFunc then begin ': ' l_Type .TypeName end // l_IsFunc aOfObject DO ';' if g_EnableMethodDirectives then begin l_MethodAbstraction CASE at_final ( OutReintroduce OutOverload OutCallingConventions ) at_virtual ( OutReintroduce OutOverload ' virtual;' OutCallingConventions ) at_abstract ( OutReintroduce OutOverload ' virtual; abstract;' OutCallingConventions ) at_override ' override;' at_message ( ' message ' Self .GetUP "Message ID" ';' ) END // CASE end // g_EnableMethodDirectives VAR l_WasComma false >>> l_WasComma VAR l_WasOut false >>> l_WasOut RULES ( Self .IsSetter ) ( Self .CanRaiseInSet ) DEFAULT ( Self .CanRaise ) ; // RULES .for> ( IN anItem if ( l_WasOut ! ) then begin true >>> l_WasOut cSpace cOpenComment ' can raise ' end // ( l_WasOut ! ) anItem .TypeName .WithComma: l_WasComma .KeepInStack ) // Self .CanRaise .for> if l_WasOut then begin cSpace cCloseComment end // l_WasOut ] .Out? ? ( if g_EnableMethodDocumentation then if ( Self .IsProperty ! ) then begin Self .OutDocumentation end // ( Self .IsProperty ! ) Self aBody DO ) // .Out? ? ) // Self .IfDef: end // DEFAULT ; // RULES ; // MethodInterfacePrim elem: AsSetterDo: ^ IN aLambda RULES ( Self .IsWriteonlyProperty ) ( Self aLambda DO ) DEFAULT ( Self .DecorateMethodAndDo: ( IN aMethod aMethod -> OpModify := opModifySetter aMethod aLambda DO ) // Self .DecorateMethodAndDo: ) // DEFAULT ; // RULES ; // AsSetterDo: elem: AsTestDo: ^ IN aLambda Self .DecorateMethodAndDo: ( IN aMethod aMethod -> OpModify := opModifyTest aMethod aLambda DO ) // Self .DecorateMethodAndDo: ; // AsTestDo: elem: AsExecuteDo: ^ IN aLambda Self .DecorateMethodAndDo: ( IN aMethod aMethod -> OpModify := opModifyExecute aMethod aLambda DO ) // Self .DecorateMethodAndDo: ; // AsExecuteDo: elem: AsGetStateDo: ^ IN aLambda Self .DecorateMethodAndDo: ( IN aMethod aMethod -> OpModify := opModifyGetState aMethod aLambda DO ) // Self .DecorateMethodAndDo: ; // AsGetStateDo: elem: AsIteratorFDo: ^ IN aLambda Self .DecorateMethodAndDo: ( IN aMethod aMethod -> OpModify := opModifyIteratorF aMethod ->^ cVarUserCodeName ^:= [ 'var' \n ' Hack : Pointer absolute anAction;' ] aMethod ->^ cImplementationUserCodeName ^:= [ ' try' \n ' ' if ( Self .UPisTrue "needs result" ) then 'Result := ' RULES ( Self .IsMethodAndImplementsIterator ) ( Self .MainImplements .MethodName ) DEFAULT ( Self .Name ) ; // RULES Self .ParametersList ';' \n ' finally' \n ' l3FreeLocalStub(Hack);' \n ' end;//try..finally' ] aMethod aLambda DO ) // Self .DecorateMethodAndDo: ; // AsIteratorFDo: elem_proc MethodInterfaceEx IN aPrefix IN aOverload IN aOfObject IN aBody : NormalCall Self aPrefix aOverload aOfObject aBody .MethodInterfacePrim ; // NormalCall : CallAsGetter if ( Self .ReadsField ! ) then if ( Self .UPisTrue "inherits getter from some ancestor" ! ) then NormalCall ; // CallAsGetter : CallAsSetter if ( Self .WritesField ! ) then if ( Self .UPisTrue "inherits setter from some ancestor" ! ) then ( Self .AsSetterDo: ( aPrefix aOverload aOfObject aBody .MethodInterfacePrim ) ) ; // CallAsSetter RULES ( Self .IsVCMOperationPrim ) ( //if ( Self .IsInternalOperation ! ) then begin if ( ( Self .UPisTrue "is query" ! ) AND ( Self .UPisTrue "no test" ! ) ) then begin Self .AsTestDo: ( aPrefix aOverload aOfObject aBody .MethodInterfacePrim ) end // ( Self .UPisTrue "is query" ! ) .. end // ( Self .IsInternalOperation ! ) if ( ( Self .UPisTrue "is FormActivate" ! ) OR ( Self .IsInternalOperation ) ) then begin Self .AsExecuteDo: ( aPrefix aOverload aOfObject aBody .MethodInterfacePrim ) end // ( Self .UPisTrue "is FormActivate" ! ) if ( Self .IsInternalOperation ! ) then begin if ( Self .UPisTrue "has states" ) then begin Self .AsGetStateDo: ( aPrefix aOverload aOfObject aBody .MethodInterfacePrim ) end // ( Self .UPisTrue "has states" ) end // ( Self .IsInternalOperation ! ) if ( Self .IsInternalOperation ) then NormalCall ) // ( Self .IsVCMOperationPrim ) ( Self .IsReadonlyProperty ) CallAsGetter ( Self .IsWriteonlyProperty ) CallAsSetter ( Self .IsProperty ) ( CallAsGetter CallAsSetter ) // ( Self .IsProperty ) ( Self .IsIterator ) ( NormalCall if ( 'F' Self .Name EndsStr ! ) if ( Self .IsOverride ! ) then begin ( Self .AsIteratorFDo: ( aPrefix aOverload aOfObject aBody .MethodInterfacePrim ) ) end // ( Self .IsOverride ! ) ) // ( Self .IsIterator ) ( Self .IsMethodAndImplementsIterator ) ( NormalCall if ( 'F' Self .Name EndsStr ! ) //if ( Self .IsOverride ! ) then begin ( Self .AsIteratorFDo: ( aPrefix aOverload aOfObject aBody .MethodInterfacePrim ) ) end // ( Self .IsOverride ! ) ) // ( Self .IsIterator ) DEFAULT NormalCall ; // RULES ; // MethodInterfaceEx elem_proc MethodInterfaceEx: ^ IN aPrefix ^ IN aOverload ^ IN aOfObject ^ IN aLambda Self aPrefix aOverload aOfObject aLambda .MethodInterfaceEx ; // MethodInterfaceEx: BOOLEAN elem_func CanBeClassAncestor RULES ( Self .IsClassOrMixIn ) true ( Self .IsException ) true ( Self .IsEvdSchemaElement ) true ( Self .IsTypedef ) RULES ( Self .IsPointer ) false DEFAULT ( Self .MainAncestor call.me ) ; // RULES DEFAULT false ; // RULES >>> Result ; // CanBeClassAncestor ModelElement elem_func MainClassAncestor Cached: ( Self .InheritsEx .filter> .CanBeClassAncestor .FirstElement ) >>> Result ; // MainClassAncestor elem_iterator MixInPropertiesTotal Cached: ( Self .Properties .joinWithLambded> ( Self .ImplementsEx .filter> .IsPureMixIn ) call.me .joinWithLambded> ( Self .InheritsEx .filter> .IsPureMixIn ) call.me ) >>> Result ; // PropertiesTotal elem_iterator InterfacePropertiesTotal Cached: ( Self .Properties .joinWithLambded> ( Self .ImplementsEx .filter> .IsPureMixIn ) .MixInPropertiesTotal ) >>> Result ; // InterfacePropertiesTotal elem_iterator InterfaceProperties Cached: ( RULES ( Self .IsPureMixIn ) ( Self .Properties ) DEFAULT ( Self .InterfacePropertiesTotal ) ; // RULES ) >>> Result ; // InterfaceProperties INTERFACE elem_func InstanceMethod Cached: ( VAR l_TypeName Self .TypeName >>> l_TypeName 'Instance' Self MakeFunction: ( IN aMade aMade -> Stereotype := st_static::Operation aMade -> %SUM := ( 'Метод получения экземпляра синглетона ' l_TypeName Cat ) aMade -> Visibility := PublicAccess aMade ->^ cVarUserCodeName ^:= cEmptyUserCode aMade ->^ cImplementationUserCodeName ^:= [ ' if (' 'g_' l_TypeName ' = nil) then' \n ' begin' \n ' l3System.AddExitProc(' l_TypeName 'Free' ');' \n ' g_' l_TypeName ' := Create;' \n ' end;' \n ' Result := g_' l_TypeName ';' ] ) ) >>> Result ; // InstanceMethod INTERFACE elem_func ExistsMethod Cached: ( VAR l_TypeName Self .TypeName >>> l_TypeName 'Exists' GarantModel::Boolean MakeFunction: ( IN aMade aMade -> Stereotype := st_static::Operation aMade -> %SUM := 'Проверяет создан экземпляр синглетона или нет' aMade -> Visibility := PublicAccess aMade ->^ cVarUserCodeName ^:= cEmptyUserCode aMade ->^ cImplementationUserCodeName ^:= [ ' Result := g_' l_TypeName ' <> nil;' ] ) ) >>> Result ; // ExistsMethod INTERFACE elem_func FakeMethod Cached: ( 'Fake' MakeProcedure: ( IN aMade aMade -> %SUM := 'это нужно чтобы правильно генерировались вызовы методов доступа к свойствам' aMade -> Visibility := PrivateAccess aMade -> Abstraction := at_virtual aMade ->^ cVarUserCodeName ^:= cEmptyUserCode aMade ->^ cImplementationUserCodeName ^:= ' Assert(false);' ) ) >>> Result ; // FakeMethod INTERFACE elem_func InitConstructor Cached: ( 'Init' MakeProcedure: ( IN aMade aMade -> Stereotype := st_ctor::Operation aMade -> Visibility := PublicAccess aMade -> Abstraction := at_final aMade -> UID := ( Self .LUID 'Init' Cat ) if ( Self .IsAutoHelper ) then begin aMade -> Parameters := [ Self .ImplementsEx .for> ( IN aR 'a' aR .TypeName Cat aR MakeParam ) ] aMade ->^ cImplementationUserCodeName ^:= [ Self .ImplementsEx .for> ( IN aR ' ' 'f_' aR .TypeName ' := ' 'a' aR .TypeName ';' ) ] end // ( Self .IsAutoHelper ) aMade ->^ cVarUserCodeName ^:= cEmptyUserCode //aMade ->^ cImplementationUserCodeName ^:= ' Assert(false);' ) ) >>> Result ; // InitConstructor BOOLEAN elem_func NeedsFakeMethod Cached: ( RULES ( Self .IsAutoHelper ) true ( Self .Properties .filter> ( .ReadsField ! ) .NotEmpty ) true DEFAULT false ; // RULES ) >>> Result ; // NeedsFakeMethod BOOLEAN elem_func IsSettingsHolder Self .IsStereotype st_SettingsHolder >>> Result ; // IsSettingsHolder BOOLEAN elem_func IsInterfaceFactory Self .IsStereotype st_InterfaceFactory >>> Result ; // IsInterfaceFactory BOOLEAN elem_func UseNewGen Cached: ( RULES ( Self .IsNil ) false ( Self .IsUserType ) true ( Self .IsElementProxy ) true ( Self .IsTestClass ) true ( Self .IsTestCase ) true ( Self .IsScriptKeyword ) RULES ( Self .Parent .IsVCMControls ) false ( Self .Parent .IsVCMModule ) true DEFAULT true ; // RULES ( Self .IsScriptKeywordsPack ) true ( Self .IsUtilityPack ) true ( Self .IsScriptKeywords ) true ( Self .IsStereotype st_Wrapper ) true ( Self .IsStereotype st_EVD ) false ( Self .UPisTrue "UseNewGen" ) true ( Self .GetUP "finished" false ?== ) true ( Self .ForceUseNewGen ) true ( Self .IsVCMCustomForm ) ( Self .Parent call.me ) ( Self .IsGuiControl ) true ( Self .IsUseCaseControllerImp ) ( Self .Parent call.me ) ( Self .IsViewAreaControllerImp ) ( Self .Parent call.me ) ( Self .IsVCMControls ) ( Self .Parent call.me ) ( Self .IsMixIn ) true ( Self .IsControllerInterfaces ) true ( Self .IsInternalInterfaces ) true ( Self .IsInterfaces ) true ( Self .IsService ) true ( Self .IsServiceImplementation ) true ( Self .IsSettingsHolder ) ( Self .Parent call.me ) ( Self .IsInterfaceFactory ) ( Self .Parent call.me ) ( Self .IsVCMFormSetFactory ) ( Self .Parent call.me ) ( Self .IsVCMFormsPack ) ( Self .Parent call.me ) ( Self .IsVCMApplication ) true ( Self .IsTestResults ) true ( Self .IsSimpleClass ) true ( Self .IsTestLibrary ) true ( Self .IsLibrary ) ( Self .Parent call.me ) ( Self .IsVCMTestTarget ) true ( Self .IsTestTarget ) true ( Self .IsVCMGUI ) true ( Self .IsExeTarget ) true ( Self .IsDLL ) true ( Self .IsTarget ) ( Self .Parent call.me ) DEFAULT ( Self .Parent call.me ) ; // RULES ) >>> Result ; // UseNewGen elem_iterator AllOperationsForOverload Cached: ( RULES ( Self .IsPureMixIn ) ( Self .InterfaceOwnOperations ) ( Self .IsInterface ) ( Self .InterfaceOperationsTotal ) ( Self .IsStaticObject ) ( Self .OperationsEx .filter> ( .IsStaticConstructor ! ) .join> ( Self .ImplementedEx ) if ( Self .NeedsFakeMethod ) then begin .join> ToArray: ( Self .FakeMethod ) .join> ToArray: ( Self .InitConstructor ) end // ( Self .NeedsFakeMethod ) ) ( Self .IsClassOrMixIn ) ( Self .OperationsEx VAR l_CastMethods [] >>> l_CastMethods ( Self .ClassImplementsPrim ) .for> ( IN anItem .joinWithLambded> ( anItem .InterfaceForClassImplements .filter> ( .NotInArray: l_CastMethods ) ) ( IN anItem anItem .AddToArray: l_CastMethods anItem .ToArray: .CastMethod ) ) .filter> ( .IsStereotype st_responsibility::Operation ! ) .filter> ( .IsServiceIterator ! ) .filter> ( .IsIni ! ) .filter> ( .IsFini ! ) ( VAR l_VCMOperations [] >>> l_VCMOperations .join> ( Self .ImplementedEx .filter> ( .IsInline ! ) .filter> ( IN anOp if ( anOp .IsVCMOperationPrim ) then begin VAR l_Name anOp .MethodName >>> l_Name if ( l_Name .StringNotInArray: l_VCMOperations ) then begin l_Name .AddToArray: l_VCMOperations true end // ( l_Name .StringNotInArray: l_VCMOperations ) else false end // .IsVCMOperationPrim else true ) // .filter> array:Copy ) // join> ( Self .ImplementedEx ) ) if ( Self .IsSingleton ) then begin if ( Self .HasFactory ! ) then begin .join> ToArray: ( Self .InstanceMethod ) end // ( Self .HasFactory ! ) //if ( Self .UseNewGen ) then begin if ( Self .OperationsEx 'Exists' .HasModelElementWithName ! ) then begin .join> ToArray: ( Self .ExistsMethod ) end // ( Self .OperationsEx 'Exists' .HasModelElementWithName ! ) end // ( Self .UseNewGen ) end // ( Self .IsSingleton ) ) DEFAULT ( Self .OperationsEx ) ; // RULES ) >>> Result ; // AllOperationsForOverload elem_iterator AllOperationsForDefine Cached: ( RULES ( Self .IsPureMixIn ) ( Self .Properties ) ( Self .IsInterface ) ( Self .InterfacePropertiesTotal ) ( ( Self .IsStaticObject ) OR ( Self .IsClassOrMixIn ) ) ( Self .Properties .filter> ( IN anItem ( anItem .ReadsField ! ) OR ( anItem .WritesField ! ) ) ) DEFAULT [empty] ; // RULES .join> ( Self .AllOperationsForOverload ) RULES ( Self .IsClassOrMixIn ) ( .join> ( Self .OverriddenEx .filter> ( .IsVCMOperationPrim ! ) ) .filter> ( .IsInline ! ) ) ; // RULES ) >>> Result ; // AllOperationsForDefine elem_proc MethodInterfaceForEx: ^ IN anOperations ^ IN aLambda Self .MethodInterfaceEx: () ( ARRAY VAR l_Ops anOperations DO >>> l_Ops if ( l_Ops .IsNotNil ) then begin if ( Self .UPisTrue "force overload" ) then begin ' overload;' end // ( Self .UPisTrue "force overload" ) else begin if ( l_Ops .filter> ( .IsProperty ! ) .filter> ( .IsVCMOperationPrim ! ) .filter> ( .MethodName Self .MethodName == ) .CountIt > 1 ) then begin ' overload;' end // l_Ops .. end // ( Self .UPisTrue "force overload" ) end // ( l_Ops .IsNotNil ) ) () ( aLambda DO ) ; // MethodInterfaceForEx: elem_proc MethodInterfaceFor: ^ IN anOperations Self .MethodInterfaceForEx: ( anOperations DO ) DROP ; // MethodInterfaceFor: STRING elem_func PropertyName Cached: ( RULES ( Self .InTie ) ( Self .Name .FromTie ) DEFAULT ( Self .Name ) ; // RULES ) >>> Result ; // PropertyName elem_proc OutProperty Self .IfDef: ( [ 'property ' Self .PropertyName VAR l_WasParam false >>> l_WasParam Self .PropertyKeys .for> ( IN aParam if l_WasParam then '; ' else begin true >>> l_WasParam '[' end aParam .ParamPrefix aParam .Name ': ' aParam .Target .TypeName ) if l_WasParam then ']' ': ' Self .MethodType .TypeName : OutRead \n cSpace 'read' cSpace if ( Self .ReadsField ) then 'f_' else begin Self .MethodNamePrefix end // ( Self .ReadsField ) Self .MethodName ; // OutRead : OutWrite \n cSpace 'write' cSpace if ( Self .WritesField ) then 'f_' else begin Self .AsSetterDo: .MethodNamePrefix end // ( Self .WritesField ) Self .MethodName ; // OutWrite RULES ( Self .IsReadonlyProperty ) OutRead ( Self .IsWriteonlyProperty ) () ( Self .IsProperty ) OutRead ; // RULES RULES ( Self .IsReadonlyProperty ) () ( Self .IsWriteonlyProperty ) OutWrite ( Self .IsProperty ) OutWrite ; // RULES if ( Self .UPisTrue "needs stored directive" ) then begin \n ' stored ' Self .MethodName 'Stored' end // ( Self .UPisTrue "needs stored directive" ) VAR l_Value Self .ExtValue >>> l_Value if ( l_Value .IsValueValid ) then begin \n ' default ' l_Value end // ( l_Value .IsValueValid ) ';' if ( Self .UPisTrue "is default" ) then begin \n ' default;' end // ( Self .UPisTrue "is default" ) ] .Out? ? ( Self .OutDocumentation ) ) // Self .IfDef: ; // OutProperty PROCEDURE .ByVisibility> ARRAY IN anArray ^ IN aFilter ^ IN aOut BOOLEAN VAR l_WasOut STRING VAR l_Separator PROCEDURE DoOut IN anItem if ( l_WasOut ! ) then begin true >>> l_WasOut l_Separator .Out end // ( l_WasOut ) Indented: ( anItem aOut DO ) ; // DoOut false >>> l_WasOut 'private' >>> l_Separator anArray .filter> ( aFilter DO PrivateAccess == ) .for> DoOut false >>> l_WasOut 'protected' >>> l_Separator anArray .filter> ( aFilter DO ProtectedAccess == ) .for> DoOut false >>> l_WasOut 'public' >>> l_Separator anArray .filter> ( aFilter DO PublicAccess == ) .for> DoOut 'published' >>> l_Separator anArray .filter> ( aFilter DO PublishedAccess == ) .for> DoOut ; // .ByVisibility> elem_proc OutField Self .IfDef: ( [ Self .FieldName ': ' Self .MethodType .TypeName ';' ] .Out? ? ( Self .OutDocumentation ) // .Out? ? ) // Self .IfDef: ; // OutField INTEGER elem_func MethodVisibility Cached: ( RULES ( Self .IsProperty ) ProtectedAccess ( Self .IsStereotype st_Test ) PublishedAccess ( Self .OpKind opkind_Implemented == ) RULES ( Self .Parent .IsPureMixIn ) PublicAccess ( Self .ParentIsInterface ) ProtectedAccess ( Self .IsStaticMethod ) PublicAccess ( ( Self .Visibility PrivateAccess == ) AND ( Self .Abstraction at_abstract == ) ) ProtectedAccess DEFAULT ( Self .Visibility ) ; // RULES ( Self .OpKind opkind_Overridden == ) RULES ( Self .IsStaticMethod AND ( Self .Abstraction at_abstract == ) ) PublicAccess ( Self .Visibility PrivateAccess == ) ProtectedAccess DEFAULT ( Self .Visibility ) ; // RULES DEFAULT ( Self .Visibility ) ; // RULES ) >>> Result ; // MethodVisibility elem_iterator ClassProperties Cached: ( Self .Properties .join> ( ( Self .ImplementedEx ) .filter> .IsProperty .filter> ( .Parent .IsContract ) ) ) >>> Result ; // ClassProperties INTEGER elem_func FieldVisibility RULES ( Self .IsProperty ) PrivateAccess DEFAULT ( Self .Visibility ) ; // RULES >>> Result ; // FieldVisibility elem_proc OutClassInner Indented: ( Self .Fields .ByVisibility> .FieldVisibility .OutField TF g_Implementor ( Self >>> g_Implementor VAR l_AllOps Self .AllOperationsForOverload >>> l_AllOps Self .AllOperationsForDefine .ByVisibility> .MethodVisibility .MethodInterfaceFor: l_AllOps Self .ClassProperties .ByVisibility> .Visibility .OutProperty ) // TF g_Implementor if ( Self .IsStaticObject ) then begin VAR l_WasSection false >>> l_WasSection ( Self .Attributes .filter> ( .Target .IsUnion ) ) .for> ( IN aProp aProp .Target .Attributes .filter> ( .IsStereotype st_switch::Attribute ! ) .filter> ( .Name 'void' SWAP StartsStr ) .for> ( IN aField aField .Target .Attributes .for> ( IN aField if ( l_WasSection ! ) then begin 'public' .Out true >>> l_WasSection end // ( l_WasSection ! ) Indented: ( [ 'property ' aField .Name ': ' aField .Target .TypeName \n cSpace 'read' cSpace aProp .Name cDot aField .Name \n cSpace 'write' cSpace aProp .Name cDot aField .Name ';' ] .Out ) // Indented: ) ) ) end // ( Self .IsStaticObject ) ) // Indented: if ( Self .UPisTrue "need UC" ) then begin Self .UserCode: 'publ' () end // ( Self .UPisTrue "need UC" ) ; // OutClassInner elem_iterator InheritsNotMixIn Cached: ( Self .InheritsEx .filterMixIns> ) >>> Result ; // InheritsNotMixIn BOOLEAN elem_func IsInheritsNotMixInCount Cached: ( Self .InheritsNotMixIn .NotEmpty ) >>> Result ; // IsInheritsNotMixInCount ModelElement elem_func TagClass %SUMMARY 'Класс, реализующий тег.' 'Возможно будет расширяться, когда будем делать генерацию EVD-схемы.' 'И станет полноценным классом с реализуемыми и перекрытыми методами.' ; Cached: ( Self .TypeName 'Class' Cat nil MakeClass ) >>> Result ; // TagClass ModelElement elem_func MainAncestorThatNotMixIn %SUMMARY 'Возвращает имя родительский класс, который не является примесью.' 'Или умолчательного предка'. ; /* [{}{\ %S%f_pas_DefaultAncestor()\ }\ <{}{%G#f_IsMixIn()!=true}\ %f_pas_TypeName(%G)[{%GS=Tag}Class]\ >\ ] */ Cached: ( RULES ( Self .IsInheritsNotMixInCount ! ) ( Self .DefaultAncestor ) ( Self .InheritsNotMixIn .filter> .IsTag .IsEmpty ) ( Self .InheritsNotMixIn .FirstElement ) DEFAULT begin Self .InheritsNotMixIn .filter> .IsTag .map> .TagClass .FirstElement end // DEFAULT ; // RULES ) >>> Result ; // MainAncestorThatNotMixIn ModelElement elem_func MixInParentName %SUMMARY 'Псевдо класс для указания родительсого типа примеси.' ; Cached: ( Self .TypeName 'Parent_' Cat nil MakeClass ) >>> Result ; // MixInParentName STRING elem_func PasPathOnly Cached: ( Self .GetUP 'intf.pas:PathOnly' >>> Result if ( Result .IsNil ) then begin Self .Parent call.me >>> Result end // ( Result .IsNil ) else begin Result '\MDProcess\components\' '\common\components\' string:ReplaceFirst >>> Result end // ( Result .IsNil ) Result ) >>> Result ; // PasPathOnly STRING elem_func PathOnly Cached: ( Self .FinalFileName sysutils:ExtractFilePath >>> Result if ( Result .IsNil ) then begin Self .PasPathOnly >>> Result if ( Result .IsNotNil ) then begin Result '\' .CutPrefix >>> Result [ cRoot // - это потому, что в пути нету диска, а для ExtractFileName он нужен Result ] cPathSep strings:CatSep >>> Result Result cPathSep Cat >>> Result end // ( Result .IsNotNil ) end // ( Result .IsNil ) Result ) >>> Result ; // PathOnly elem_proc OutMixInInclude [ cOpenComment '$Include' ' ' Self .PathOnly Self .UnitName '.pas' cCloseComment ] .Out ; // OutMixInInclude BOOLEAN elem_func HasNonMixInAncestor Cached: ( RULES ( Self .IsInheritsNotMixInCount ) true ( Self .InheritsEx .filter> call.me .NotEmpty ) true DEFAULT false ; // RULES ) >>> Result ; // HasNonMixInAncestor ModelElement elem_func_with_side_effects CalcParentAndInclude RULES ( Self .IsMixIn ) RULES ( Self .IsInheritsNotMixInCount ) ( Self .MainClassAncestor ) DEFAULT ( Self .MixInParentName ) ; // RULES DEFAULT ( Self .MainAncestorThatNotMixIn ) ; // RULES >>> Result : RefG IN aG if ( Result .IsNotNil ) then begin [ aG .MixInParentName .TypeName ' = ' Result .TypeName ';' ] .Out end // ( Result .IsNotNil ) ; // RefG VAR l_WasProlog false >>> l_WasProlog : DoG IN aG aG >>> Result //aG .TypeName >>> Result if ( l_WasProlog ! ) then begin true >>> l_WasProlog if ( aG GarantModel::l3Items .InheritsFrom ) then begin : OutIsProto [ cOpenComment '$Define ' 'l3Items_IsProto' cCloseComment ] .Out ; // OutIsProto RULES ( Self GarantModel::Tl3ProtoObject .InheritsFrom ) OutIsProto ( ( Self GarantModel::Tl3DataContainerWithoutIUnknownPrim .InheritsFrom ) AND NOT ( Self GarantModel::Tl3DataContainerWithoutIUnknown .InheritsFrom ) ) OutIsProto ; // RULES end // ( aG GarantModel::l3Items .InheritsFrom ) end // ( l_WasProlog ! ) aG .OutMixInInclude ; // DoG Self .InheritsEx .filter> .IsMixIn .for> ( IN aG if ( Result .IsNotNil ) then begin if ( aG .HasNonMixInAncestor ! ) then begin aG RefG end // ( aG .HasNonMixInAncestor ! ) end // ( Result .IsNotNil ) aG DoG ) Self .ImplementsEx .filter> .IsMixIn .for> ( IN aG aG RefG aG DoG ) ; // CalcParentAndInclude elem_proc DefineMixInValues Self .MixInValues .for> ( IN aValue g_MixInParamTypes ->^ ( aValue .Name ) ^:= ( aValue .Target ) ) // Self .MixInValues .for> ; // DefineMixInValues elem_proc UndefineMixInValues Self .MixInValues .for> ( IN aValue g_MixInParamTypes ->^ ( aValue .Name ) ^:= nil ) // Self .MixInValues .for> ; // UndefineMixInValues elem_proc DefineImplementedMixInValues Self .ImplementsIsInterface .for> .DefineMixInValues ; // DefineImplementedMixInValues elem_proc UndefineImplementedMixInValues Self .ImplementsIsInterface .for> .UndefineMixInValues ; // DefineImplementedMixInValues ARRAY CompileTime-VAR g_MixInValues nil elem_iterator AllInlinedOperations Cached: ( Self .ImplementedAndOverridden .filter> .IsInline ) >>> Result ; // AllInlinedOperations elem_proc OutOtherMixinValues Self .InheritsEx .for> ( IN aG aG .MixInValues .for> ( IN aValue if ( aValue .Name .TextNotInArray: g_MixInValues ) then begin aValue .Name .AddToArray: g_MixInValues [ '{$If not Declared(' cUnderline aValue .Name cUnderline ')' '}' 'type' ' ' cUnderline aValue .Name cUnderline ' = ' aValue .Target .TypeName ';' '{$IfEnd}' \n ] .Out end // ( aValue .Name .TextNotInArray: g_MixInValues ) ) // aG .MixInValues .for> aG call.me ) // Self .InheritsEx .for> ; // OutOtherMixinValues elem_proc OutClass Self .DefineImplementedMixInValues if ( Self .UPisTrue "need UC" ) then begin Self .UserCode: 'ci' () end // ( Self .UPisTrue "need UC" ) Self .MixInValues .for> ( IN aValue aValue .Name .AddToArray: g_MixInValues [ cUnderline aValue .Name cUnderline ' = ' aValue .Target .TypeName ';' ] .Out ) VAR l_Parent Self .CalcParentAndInclude >>> l_Parent if ( Self .UPisTrue "need UC" ) then begin Self .UserCode: 'cit' () end // ( Self .UPisTrue "need UC" ) [ Self .TypeName ' = ' Self .Abstraction CASE at_abstract [ cOpenComment 'abstract' cCloseComment cSpace ] at_final [ cOpenComment 'final' cCloseComment cSpace ] END // CASE 'class' ARRAY VAR l_Implements [] >>> l_Implements VAR l_WasComma false >>> l_WasComma l_Parent .ToArray .join> ( Self .ClassImplements .filter> ( IN anItem if ( anItem .NotInArray: l_Implements ) then begin anItem .AddToArray: l_Implements true end // ( anItem .NotInArray: l_Implements ) else begin false end // ( anItem .NotInArray: l_Implements ) ) // .filter> ) // .join> .With()> ( IN anItem RULES ( anItem .IsMixIn ) ( anItem .TypeName .WithComma: l_WasComma .KeepInStack ) DEFAULT begin anItem .IfDefBraceLn: ( anItem .TypeName .WithComma: l_WasComma .KeepInStack ) // anItem .IfDefBraceLn: end // DEFAULT ; // RULES ) // .With()> ] .Out Self .OutDocumentation Self .OutClassInner [ 'end;//' Self .TypeName ] .Out Self .UndefineImplementedMixInValues ; // OutClass elem_proc OutInterfaceBody Indented: ( VAR l_Ops Self .AllOperationsForDefine >>> l_Ops VAR l_AllOps Self .AllOperationsForOverload >>> l_AllOps l_Ops .for> .MethodInterfaceFor: l_AllOps Self .InterfaceProperties .for> .OutProperty ) // Indented: ; // OutInterfaceBody elem_proc OutInterface Self .DefineMixInValues Self .MixInValues .for> ( IN aValue [ '//' cUnderline aValue .Name cUnderline ' = ' aValue .Target .TypeName ';' ] .Out ) // Self .MixInValues .for> [ Self .TypeName ' = interface' Self .MainAncestor .TypeName .With() ] .Out Self .OutDocumentation VAR l_GUID Self .GUID >>> l_GUID if ( l_GUID .IsNotNil ) then begin Indented: ( [ '[' cQuote cOpenComment l_GUID cCloseComment cQuote ']' ] .Out ) end // ( l_GUID .IsNotNil ) Self .OutInterfaceBody [ 'end;//' Self .TypeName ] .Out Self .UndefineMixInValues ; // OutInterface elem_proc OutRecord [ Self .TypeName ' = ' Self .UPisTrue "packed" ? 'packed ' 'record' ] .Out Self .OutDocumentation Indented: ( VAR l_Switch Self .Attributes .filter> ( .IsStereotype st_switch::Attribute ) .FirstElement >>> l_Switch if ( l_Switch .IsNotNil ) then begin [ 'Case ' if ( l_Switch .Name 'void' != ) then begin l_Switch .Name ': ' end // ( l_Switch .Name 'void' != ) l_Switch .Target .TypeName ' of' ] .Out Indented: ( Self .Fields .for> ( IN aField [ VAR l_Value aField .GetUP 'Value' >>> l_Value if ( l_Value .IsValueValid ) then l_Value else '!!!' ': ' '(' if ( 'void' aField .Name StartsStr ) then begin VAR l_WasField false >>> l_WasField aField .Target .Fields .for> ( IN aField if l_WasField then '; ' aField .Name ': ' aField .Target .TypeName true >>> l_WasField ) // aField .Target .Fields .for> end // ( 'void' aField .Name StartsStr ) else begin aField .Name ': ' aField .Target .TypeName end // ( 'void' aField .Name StartsStr ) ');' ] .Out? ? ( aField .OutDocumentation ) // .Out? ? ) // Self .Fields .for> ) // Indented: end // ( l_Switch .IsNotNil ) else begin Self .Fields .for> .OutField end // ( l_Switch .IsNotNil ) ) // Indented: if ( Self .UPisTrue "need UC" ) then begin Self .UserCode: 'publ' () end // ( Self .UPisTrue "need UC" ) [ 'end;//' Self .TypeName ] .Out ; // OutRecord elem_proc OutDefine [ cOpenComment '$Define ' Self .Name cCloseComment ] .Out ; // OutDefine elem_proc OutUndef [ cOpenComment '$Undef ' Self .Name cCloseComment ] .Out ; // OutUndef elem_proc OutStaticObject if ( Self .IsConstructorsHolder ! ) then begin if ( Self .UPisTrue "need UC" ) then begin Self .UserCode: 'ci' () end // ( Self .UPisTrue "need UC" ) [ Self .TypeName ' = ' Self .UPisTrue "packed" ? 'packed ' 'object' Self .MainAncestor .TypeName .With() ] .Out Self .OutDocumentation Self .OutClassInner [ 'end;//' Self .TypeName ] .Out end // ( Self .IsConstructorsHolder ! ) ; // OutStaticObject elem_proc OutPureMixIn '(*' .Out Self .OutInterface '*)' .Out ; // OutPureMixIn ANY elem_func ExtValueOrName Self .ExtValue >>> Result if ( Result .IsValueValid ! ) then begin Self .Name >>> Result end // ( Result .IsValueValid ! ; // ExtValueOrName elem_proc OutRange [ Self .TypeName ' = ' VAR l_First Self .FirstAttribute >>> l_First VAR l_Second Self .SecondAttribute >>> l_Second if ( l_Second .IsNil ) then begin l_First >>> l_Second end // ( l_Second .IsNil ) VAR l_ElementPrefix if ( Self .GetUP "elements prefix" '<none>' == ) then begin '' >>> l_ElementPrefix end else begin Self .MainAncestor .GetUP 'extprop:pas:ElementPrefix' >>> l_ElementPrefix end : .ValueWithPrefix IN aValue if ( aValue IsString ! ) then aValue else if ( l_ElementPrefix aValue StartsStr ) then aValue else begin l_ElementPrefix aValue end ; // .ValueWithPrefix l_First .ExtValueOrName .ValueWithPrefix ' .. ' l_Second .ExtValueOrName .ValueWithPrefix ';' ] .Out Self .OutDocumentation ; // OutRange elem_proc OutTypedef ModelElement VAR l_MainAncestor Self .MainAncestor >>> l_MainAncestor [ Self .TypeName ' = ' if ( Self .UPisTrue "newRTTI" ) then 'type ' if ( Self .IsPointer ) then '^' if ( Self .IsClassRef ) then begin true >>> g_WasForwarded 'class of ' end // ( Self .IsClassRef ) if ( Self .IsPointer ! ) then begin STRING VAR l_OtherUnit l_MainAncestor .EffectiveUnitName >>> l_OtherUnit if ( l_OtherUnit .IsNotNil ) then begin if ( Self .TypeName l_MainAncestor .TypeName SameText ) then begin STRING VAR l_OurUnit Self .EffectiveUnitName >>> l_OurUnit if ( l_OurUnit l_OtherUnit != ) then begin l_OtherUnit cDot end // l_OurUnit l_OtherUnit != end // Self .TypeName l_MainAncestor .TypeName == end // l_OtherUnit .IsNotNil end // Self .IsPointer ! l_MainAncestor .TypeName ';' ] .Out Self .OutDocumentation ; // OutTypedef elem_proc OutEnum [ Self .TypeName ' = (' ] .Out Self .OutDocumentation STRING VAR l_Prefix Self .GetUP 'extprop:pas:ElementPrefix' >>> l_Prefix VAR l_NeedComma false >>> l_NeedComma Indented: ( Self .Attributes .for> ( IN aChild aChild .IfDef: ( [ l_Prefix aChild .Name VAR l_Value aChild .ExtValue >>> l_Value if ( l_Value .IsValueValid ) then begin ' = ' l_Value ToPrintable end // ( l_Value .IsValueValid ) ] strings:Cat .WithComma: l_NeedComma .Out aChild .OutDocumentation ) // aChild .IfDef: ) // Self .Attributes .for> ) // Indented: [ ');//' Self .TypeName ] .Out ; // OutEnum elem_proc OutSetOf [ Self .TypeName ' = set of ' Self .MainAncestor .TypeName ';' ] .Out Self .OutDocumentation ; // OutSetOf elem_proc OutFunction Self .MethodInterfaceEx: ( Self .TypeName ' = ' ) () ( if ( Self .UPisTrue "of object" ) then begin ' of object' end // ( Self .UPisTrue "of object" ) ) ( IN aMethod ) ; // OutFunction elem_proc OutArray if ( Self .IsOpenArray ! ) then begin [ Self .TypeName ' = array ' if ( Self .MainAncestor .IsNotNil ) then begin '[' Self .MainAncestor .TypeName '] ' end // ( Self .MainAncestor .IsNotNil ) 'of ' Self .FirstAttribute .Target .TypeName ';' ] .Out Self .OutDocumentation end // ( Self .IsOpenArray ! ) ; // OutArray ARRAY CompileTime-VAR g_OutedTypes nil ARRAY CompileTime-VAR g_ForwardedTypes nil elem_proc OutTypeKeyword : DoOutTypeKeyword if ( g_WasType ! ) then begin 'type' .Out true >>> g_WasType Self >>> g_WasTypeOpener false >>> g_WasConst end // g_WasType ! ; // DoOutTypeKeyword RULES ( Self .IsType ) DoOutTypeKeyword ( Self .IsMixIn ) begin if g_WasConst then DoOutTypeKeyword end // ( Self .IsMixIn ) ; // RULES ; // OutTypeKeyword elem_proc OutForward if ( Self .NotInArray: g_OutedTypes ) then begin if ( Self .NotInArray: g_ForwardedTypes ) then begin Self .AddToArray: g_ForwardedTypes RULES ( Self .IsPureMixIn ) () DEFAULT begin Self .IfDef: ( Self .OutTypeKeyword Indented: ( RULES ( Self .IsClass ) ( true >>> g_WasForwarded [ Self .TypeName ' = class;' ] .Out OutLn ) ( Self .IsInterface ) ( true >>> g_WasForwarded [ Self .TypeName ' = interface;' ] .Out OutLn ) ; // RULES ) // Indented: ) // Self .IfDef: end // DEFAULT ; // RULES end // ( Self .NotInArray: g_ForwardedTypes ) end // ( Self .NotInArray: g_OutedTypes ) ; // OutForward BOOLEAN elem_func SomeOwnChildrenInheritsOrImplementsMixIn RULES ( Self .ChildrenWithoutOwnFile .filter> .InheritsOrImplementsMixIn .NotEmpty ) true DEFAULT false ; // RULES >>> Result ; // SomeOwnChildrenInheritsOrImplementsMixIn elem_iterator ForwardedEx Self .Forwarded RULES ( Self .IsPureMixIn ) () ( Self .IsTypedef ) () ( Self .IsInterface ) begin RULES ( Self .Parent .IsInterface ) ( .join> ToArray: ( Self .Parent ) ) ( Self .Parent .IsClass ) RULES ( Self .Parent .IsService ) () ( Self .Parent .InheritsOrImplementsMixIn ) () ( Self .Parent .SomeOwnChildrenInheritsOrImplementsMixIn ) () DEFAULT ( .join> ToArray: ( Self .Parent ) ) ; // RULES ; // RULES end // ( Self .IsInterface ) ; // RULES //.joinWithLambded> ( Self .AllOwnChildren ) call.me >>> Result ; // ForwardedEx elem_proc OutForwarded Self .ForwardedEx .for> .OutForward ; // OutForwarded elem_proc OutType RULES ( Self .IsElementProxy ) () ( Self .IsUtilityPack ) () ( Self .IsInterfaces ) () ( Self .IsTarget ) () ( Self .IsOpenArray ) () ( ( Self .IsStaticObject ) AND ( Self .IsConstructorsHolder ) ) () ( Self .IsUserType ) () ( Self .IsTestClass ) () ( Self .IsVCMOperations ) () ( Self .IsConstantsButNotType ) () ( Self .IsTestUnit ) () ( Self .IsUnit ) () ( Self .IsImpl ) () ( Self .IsTestLibrary ) () DEFAULT ( if ( Self .NotInArray: g_OutedTypes ) then begin Self .AddToArray: g_OutedTypes Self .OutForwarded Self .IfDef: ( Self .OutTypeKeyword Indented: ( RULES ( Self .IsSetOf ) ( Self .OutSetOf ) ( Self .IsArray ) ( Self .OutArray ) ( Self .IsEnum ) ( Self .OutEnum ) ( Self .IsRange ) ( Self .OutRange ) ( Self .IsTypedef ) ( Self .OutTypedef ) ( Self .IsException ) ( Self .OutClass ) ( Self .IsMixIn ) ( Self .OutClass ) //( Self .IsTestClass ) // ( Self .OutClass ) ( Self .IsClass ) ( Self .OutClass ) ( Self .IsPureMixIn ) ( Self .OutPureMixIn ) ( Self .IsInterface ) ( Self .OutInterface ) ( Self .IsStaticObject ) ( Self .OutStaticObject ) ( Self .IsUnion ) ( Self .OutRecord ) ( Self .IsRecord ) ( Self .OutRecord ) ( Self .IsUndef ) ( Self .OutUndef ) ( Self .IsDefine ) ( Self .OutDefine ) ( Self .IsFunction ) ( Self .OutFunction ) DEFAULT ( [ '// ' Self .TypeName ] .Out ) ; // RULES ) // Indented: OutLn ) // Self .IfDef: end // ( Self .NotInArray: g_OutedTypes ) ) // DEFAULT ; // RULES ; // OutType BOOLEAN elem_func NeedForwarded RULES ( Self .IsType ) true ( Self .IsPureMixIn ) true DEFAULT false ; // RULES >>> Result ; // NeedForwarded elem_proc OutChildrenRecPrim IN aValid IN aOut IN aNeedIfDef elem_proc DoOut if ( aNeedIfDef AND ( Self .NeedForwarded ) AND ( Self aValid DO ) ) then begin Self .OutForwarded Self .IfDef: ( if ( Self .InheritsOrImplementsMixIn ! ) then begin if ( Self .SomeOwnChildrenInheritsOrImplementsMixIn ! ) then begin Self .ConstantsAndChildrenWithoutOwnFile .filter> ( Self .InheritsFrom ) .for> .OutForward end // ( Self .SomeOwnChildrenInheritsOrImplementsMixIn ! ) end // ( Self .InheritsOrImplementsMixIn ! ) Self .ConstantsAndChildrenWithoutOwnFile .filter> ( Self .InheritsFrom ! ) .for> call.me if ( Self aValid DO ) then begin Self aOut DO end // ( Self aValid DO ) Self .ConstantsAndChildrenWithoutOwnFile .filter> ( Self .InheritsFrom ) .for> call.me ) // Self .IfDef: end // ( Self .IsType ) else begin Self .ConstantsAndChildrenWithoutOwnFile .filter> ( Self .InheritsFrom ! ) .for> call.me if ( Self aValid DO ) then begin Self aOut DO end // ( Self aValid DO ) Self .ConstantsAndChildrenWithoutOwnFile .filter> ( Self .InheritsFrom ) .for> call.me end // ( Self .IsType ) ; // DoOut Self .DoOut ; // OutChildrenRecPrim elem_proc OutChildrenRec IN aValid IN aOut Self aValid aOut false .OutChildrenRecPrim ; // OutChildrenRec elem_proc OutTypeRec IN aValid IN aOut Self aValid aOut true .OutChildrenRecPrim ; // OutTypeRec elem_proc OutChildrenRec: ^ IN aValid ^ IN aOut Self aValid aOut .OutChildrenRec ; // OutChildrenRec: WordAlias .ForChildren> .OutChildrenRec: elem_proc OutTypes ^ IN aValid DropWasType : DoOutType IN aChild //aChild .IfDef: ( aChild .OutType ) // aChild .IfDef: ; // DoOutType /*{ Self @ ( IN aChild aChild aValid DO AND ( aChild .IsEnum ) ) @ DoOutType .OutTypeRec Self @ ( IN aChild aChild aValid DO AND ( aChild .IsSetOf ) ) @ DoOutType .OutTypeRec }*/ Self @ ( IN aChild aChild aValid DO AND ( aChild .UPisTrue "is default ancestor" ) ) @ DoOutType .OutTypeRec Self @ ( IN aChild aChild aValid DO AND ( aChild .IsPointer ) ) @ DoOutType .OutTypeRec Self @ ( IN aChild aChild aValid DO AND ( aChild .IsClassRef ) ) @ DoOutType .OutTypeRec /*{ Self @ ( IN aChild aChild aValid DO AND ( aChild .IsPureMixIn ) ) @ DoOutType .OutTypeRec }*/ Self @ ( IN aChild aChild aValid DO ) @ DoOutType .OutTypeRec ; // OutTypes elem_proc OutConstants RULES ( Self .IsConstantArray ) ( VAR l_MainAncestor [ Self .Name ': array ' '[' VAR l_MainImplements Self .MainImplements >>> l_MainImplements if ( l_MainImplements .IsNil ) then begin '0 .. ' Self .Attributes .CountIt 1 - end // ( l_MainImplements .IsNil ) else begin l_MainImplements .TypeName end // ( l_MainImplements .IsNil ) ']' ' of ' Self .MainAncestor >>> l_MainAncestor l_MainAncestor .TypeName ' = (' ] .Out VAR l_WasComma false >>> l_WasComma VAR l_IsPointer l_MainAncestor .IsPointer >>> l_IsPointer Self .Attributes /*{ .map> ( .ExtValue if l_IsPointer then begin '@' SWAP Cat end // l_IsPointer ) }*/ .for> ( IN anItem anItem .IfDef: ( ( anItem .ExtValue if l_IsPointer then begin '@' SWAP Cat end // l_IsPointer ) .WithComma: l_WasComma .Out ) // anItem .IfDef: ) [ ');' ] .Out ) // ( Self .IsConstantArray ) ( Self .IsSetConst ) ( [ Self .Name ' = ' RULES ( Self .Attributes .NotEmpty ) ( STRING VAR l_Prefix Self .MainAncestor .GetUP 'extprop:pas:ElementPrefix' >>> l_Prefix VAR l_WasComma false >>> l_WasComma '[' Self .Attributes .map> .ExtValue .filter> .IsValueValid .map> ( l_Prefix SWAP Cat ) .for> ( .WithComma: l_WasComma .KeepInStack ) // .for> ']' ) ( Self .MainAncestor .IsSetConst ) ( if ( Self .EffectiveUnitName Self .MainAncestor .EffectiveUnitName != ) then begin Self .MainAncestor .EffectiveUnitName cDot end // ( Self .EffectiveUnitName Self .MainAncestor .EffectiveUnitName != ) Self .MainAncestor .Name ) DEFAULT ( VAR l_MainAncestor Self .MainAncestor >>> l_MainAncestor if ( l_MainAncestor .IsSetOf ) then begin l_MainAncestor .MainAncestor >>> l_MainAncestor end // ( l_MainAncestor .IsSetOf ) '[' 'Low(' l_MainAncestor .TypeName ')' ' .. ' 'High(' l_MainAncestor .TypeName ')' ']' ) ; // RULES ';' ] .Out ) // ( Self .IsSetConst ) DEFAULT ( STRING VAR l_Prefix Self .GetUP 'extprop:pas:ElementPrefix' >>> l_Prefix Self .Attributes .for> ( IN anItem anItem .IfDef: ( [ l_Prefix anItem .Name if ( anItem .UPisTrue "is define" ! ) then begin VAR l_Type anItem .Target >>> l_Type l_Type .IsNotNil ? ( ': ' l_Type .TypeName ) end // ( anItem .UPisTrue "is define" ! ) BOOLEAN VAR l_NeedSuffix false >>> l_NeedSuffix VAR l_Value anItem .ExtValue >>> l_Value if ( l_Value .IsValueValid ! ) then begin anItem .GetUP 'Value' >>> l_Value true >>> l_NeedSuffix end ' = ' l_Value if l_NeedSuffix then begin VAR l_Suffix anItem .GetUP "suffix expr" >>> l_Suffix if ( l_Suffix .IsValueValid ) then begin cSpace l_Suffix end // ( l_Suffix .IsValueValid ) end // l_NeedSuffix ';' ] .Out? ? ( anItem .OutDocumentation ) // ] .Out? ? ) // anItem .IfDef: ) // Self .Attributes .for> ) // DEFAULT ; // RULES ; // OutConstants PROCEDURE .OutConstantsList ARRAY IN aList BOOLEAN VAR l_WasConst false >>> l_WasConst aList .for> ( IN anItem RULES ( anItem .IsLocalConst ) () DEFAULT ( if ( l_WasConst ! ) then begin true >>> l_WasConst true >>> g_WasConst DropWasType 'const' .Out end anItem .IfDef: ( anItem .OutDocumentation Indented: ( anItem .OutConstants ) // Indented: ) // anItem .IfDef: ) // DEFAULT ; // RULES ) if l_WasConst then OutLn ; // .OutConstantsList INTEGER elem_func ConstantsListVisibility Cached: ( RULES ( Self .IsNil ) PrivateAccess ( Self .IsConstantArray ) ( INTEGER VAR l_Vis Self .Visibility >>> l_Vis RULES ( l_Vis PublicAccess == ) ( VAR l_MainImplements Self .MainImplements >>> l_MainImplements RULES ( l_MainImplements .IsNotNil ) ( RULES ( Self .UnitProducer l_MainImplements .UnitProducer == ) ProtectedAccess DEFAULT l_Vis ; // RULES ) DEFAULT l_Vis ; // RULES ) // ( l_Vis PublicAccess == ) DEFAULT l_Vis ; // RULES ) // ( Self .IsConstantArray ) ( Self .IsLocalConst ) ( Self .Visibility ) ( Self .IsSetConst ) ( INTEGER VAR l_Vis Self .Visibility >>> l_Vis RULES ( l_Vis PublicAccess == ) ProtectedAccess DEFAULT l_Vis ; // RULES ) // ( Self .IsSetConst ) ( Self .IsConstants ) ( INTEGER VAR l_Vis Self .Visibility >>> l_Vis RULES ( l_Vis PublicAccess == ) ( BOOLEAN VAR l_Protected Self .Attributes .mapToTarget> .filterNil> .filter> ( .UnitProducer Self .UnitProducer .IsSameModelElement ) .NotEmpty >>> l_Protected if ( l_Protected ! ) then begin Self .Attributes .map> .ValueType .filterNil> .filter> ( .UnitProducer Self .UnitProducer .IsSameModelElement ) .NotEmpty >>> l_Protected end // ( l_Protected ! ) RULES l_Protected ProtectedAccess DEFAULT l_Vis ; // RULES ) // ( l_Vis PublicAccess == ) DEFAULT l_Vis ; // RULES ) // ( Self .IsConstants ) DEFAULT ( Self .Visibility ) ; // RULES ) >>> Result ; // ConstantsListVisibility elem_proc OutDefinitionsSection: ^ IN aValid : .Suitable aValid DO ; Self .ForChildren> .Suitable ( .ConstantsEx .filter> ( .ConstantsListVisibility PublicAccess == ) .OutConstantsList ) Self .OutTypes .Suitable Self .ForChildren> .Suitable ( .ConstantsEx .filter> ( .ConstantsListVisibility ProtectedAccess == ) .OutConstantsList ) ; // OutDefinitionsSection: elem_iterator GlobalOperationsForOverload RULES ( ( Self .IsStaticObject ) AND ( Self .IsConstructorsHolder ) ) ( ( Self .MainAncestor .GlobalOperations ) .join> ( Self .GlobalOperations ) ) DEFAULT ( Self .GlobalOperations ) ; // RULES >>> Result ; // GlobalOperationsForOverload elem_proc OutVar Self .IfDef: ( [ 'var ' if ( Self .IsGlobalVar ) then 'g_' else if ( Self .IsLocalVar ) then 'l_' Self .Name ': ' if ( Self .Target .IsMethod ) then begin Self .Target .MainAncestor .TypeName ' = ' Self .Target .MethodName end // ( Self .Target .IsMethod ) else begin Self .Target .TypeName if ( Self .UPisTrue "IsResult" ) then begin ' absolute Result' end // ( Self .UPisTrue "IsResult" ) VAR l_Value Self .ExtValue >>> l_Value if ( l_Value .IsValueValid ) then begin ' = ' l_Value end // ( l_Value .IsValueValid ) end // ( Self .Target .IsMethod ) ';' ] .Out Self .OutDocumentation ) // Self .IfDef: ; // OutVar elem_proc OutInterfaceSection Self .OutDefinitionsSection: .IsForInterface VAR l_WasOut false >>> l_WasOut Self .ForChildren> .IsForInterface ( IN anItem VAR l_GlobalOperations anItem .GlobalOperations >>> l_GlobalOperations VAR l_GlobalOperationsForOverload anItem .GlobalOperationsForOverload >>> l_GlobalOperationsForOverload l_GlobalOperations .filter> ( .Visibility PrivateAccess != ) .for> .MethodInterfaceForEx: l_GlobalOperationsForOverload ( IN aMethod true >>> l_WasOut ) ) l_WasOut ? OutLn false >>> l_WasOut Self .ForChildren> .IsForInterface ( .GlobalVars .filter> ( .Visibility PrivateAccess != ) .for> ( .OutVar true >>> l_WasOut ) ) l_WasOut ? OutLn ; // OutInterfaceSection elem_iterator LocalMethods Self .OperationsEx .filter> .IsLocalMethod >>> Result ; // LocalMethods elem_iterator LocalVars Self .Attributes .filter> .IsLocalVar .filter> ( .IsGlobalVar ! ) >>> Result ; // LocalVars elem_proc MethodBody if ( Self .UPisTrue 'extprop:isAsm' ) then begin 'asm' .Out ' jmp l3LocalStub' .Out end else begin if ( Self .IsIteratorF ! ) then begin TF g_MethodParentPrefix ( '' >>> g_MethodParentPrefix Self .LocalVars .for> .OutVar Indented: ( Self .LocalMethods .for> ( IN aMethod OutLn aMethod .MethodInterfaceForEx: nil ( call.me ) ) // Self .LocalMethods .for> ) // Indented: ) // TF g_MethodParentPrefix end // ( Self .IsIteratorF ! ) Self .UserCode: cVarUserCodeSuffix () 'begin' .Out VAR l_WasOut false >>> l_WasOut if ( Self .IsIteratorF ! ) then begin Indented: ( Self .Dependencies .filter> ( .IsStereotype st_call::Dependency ) .filter> ( .Target .IsIterator ) .for> ( IN aDep Self .UserCode: 'iter' () VAR l_Target aDep .Target >>> l_Target VAR l_NeedsParams aDep .UPisTrue "iterator needs params" >>> l_NeedsParams if l_NeedsParams then begin if ( l_Target .MethodParameters .filter> .IsInParam .IsEmpty ) then begin false >>> l_NeedsParams end // ( l_Target .MethodParameters .filter> .IsInParam .IsEmpty ) end // l_NeedsParams VAR l_NeedsAfter aDep .UPisTrue "needs after iterator UC" >>> l_NeedsAfter [ if ( l_Target .IsServiceIterator ) then begin l_Target .Parent .TypeName '.Instance.' end // ( l_Target .IsServiceIterator ) VAR l_Name l_Target .MethodName >>> l_Name l_Name if ( 'F' l_Name EndsStr ! ) then 'F' '(' l_Target .IteratorStub .MethodName '(' '@' VAR l_IteratorFuncName aDep .GetUP "iterator func name" >>> l_IteratorFuncName if ( l_IteratorFuncName .IsNil ) then begin 'DoIt' >>> l_IteratorFuncName end // ( l_IteratorFuncName .IsNil ) l_IteratorFuncName ')' if ( l_NeedsParams ! ) then begin ')' if ( l_NeedsAfter ! ) then ';' end // ( l_NeedsParams ! ) ] .Out if l_NeedsParams then begin Self .UserCode: 'iterparam' () [ ')' if ( l_NeedsAfter ! ) then ';' ] .Out end // l_NeedsParams if l_NeedsAfter then begin Self .UserCode: 'afteriter' () end // l_NeedsAfter true >>> l_WasOut ) // .for> ) // Indented: end // ( Self .IsIteratorF ! ) if ( l_WasOut ! ) then begin Self .UserCode: cImplementationUserCodeSuffix ( ' !!! Needs to be implemented !!!' ) end // ( l_WasOut ! ) end [ 'end;//' g_MethodParentPrefix Self .MethodNamePrefix Self .MethodName ] .Out OutLn ; // MethodBody BOOLEAN elem_func NeedsInstanceR Cached: ( RULES ( Self .UPisTrue "needs InstanceR" ) true ( Self .InheritsEx .filter> call.me .NotEmpty ) true ( Self .ImplementsEx .filter> call.me .NotEmpty ) true DEFAULT false ; // RULES ) >>> Result ; // NeedsInstanceR elem_proc OutClassImplementation Self .IfDef: ( Self .DefineImplementedMixInValues if ( Self .ImplementsMixIn ) then begin if ( Self .AllInlinedOperations .NotEmpty ) then begin Self .OutOtherMixinValues end // ( Self .AllInlinedOperations .NotEmpty ) end // ( Self .ImplementsMixIn ) TF g_Implementor ( Self >>> g_Implementor BOOLEAN VAR l_WasFirst false >>> l_WasFirst TF g_EnableAutoEOL ( false >>> g_EnableAutoEOL TF g_EnableMethodDocumentation ( false >>> g_EnableMethodDocumentation Self .AllInlinedOperations .filter> ( IN aMethod if l_WasFirst then true else begin true >>> l_WasFirst false end ) // .filter> .for> .MethodInterfaceForEx: nil ( IN aMethod ' forward;' .Out OutLn OutLn ) // .for> .MethodInterfaceForEx: nil ) // TF g_EnableMethodDocumentation ) // TF g_EnableAutoEOL Self .AllInlinedOperations .for> .MethodInterfaceForEx: nil .MethodBody ) // TF g_Implementor VAR l_WasInstanceR Self .IsMixIn >>> l_WasInstanceR Self .InheritsEx .join> ( Self .ImplementsEx ) .filter> .IsMixIn .for> ( IN aG if ( l_WasInstanceR ! ) then begin if ( aG .NeedsInstanceR ) then begin true >>> l_WasInstanceR [ 'type _Instance_R_ = ' Self .TypeName ';' ] .Out OutLn end // ( aG .NeedsInstanceR ) end // ( l_WasInstanceR ! ) aG .OutMixInInclude OutLn ) // .for> TF g_Implementor ( Self >>> g_Implementor TF g_MethodParentPrefix ( Self .TypeName >>> g_MethodParentPrefix g_MethodParentPrefix cDot Cat >>> g_MethodParentPrefix TF g_EnableMethodDirectives ( false >>> g_EnableMethodDirectives Self .AllOperationsForDefine .filter> ( .MethodAbstraction at_abstract != ) .for> .MethodInterfaceForEx: nil .MethodBody ) // TF g_EnableMethodDirectives ) // TF g_MethodParentPrefix ) // TF g_Implementor if ( Self .UPisTrue "need UC" ) then begin Self .UserCode: 'impl' () OutLn end // ( Self .UPisTrue "need UC" ) Self .UndefineImplementedMixInValues ) // Self .IfDef: ; // OutClassImplementation elem_proc OutTestClassImplementation elem_proc MethodBody Self .UserCode: cVarUserCodeSuffix () 'begin' .Out ' with Self do' .Out ' begin' .Out Self .UserCode: cImplementationUserCodeSuffix ( ' !!! Needs to be implemented !!!' ) ' end;//with Self' .Out [ 'end;//' g_MethodParentPrefix Self .MethodNamePrefix Self .MethodName ] .Out OutLn ; // MethodBody elem_iterator ParamsOrKeys if ( Self .IsProperty ) then ( Self .PropertyKeys ) else ( Self .MethodParameters ) .filter> ( 'Self' .HasName ! ) >>> Result ; // ParamsOrKeys elem_iterator OperationsAndProperties Self .OperationsEx .join> ( Self .Properties ) >>> Result ; // OperationsAndProperties TF g_MethodParentPrefix ( Self .TypeName >>> g_MethodParentPrefix g_MethodParentPrefix cUnderline Cat >>> g_MethodParentPrefix Self .OperationsAndProperties .for> .MethodInterfaceForEx: nil .MethodBody [ 5 6 ] .for> ( IN aNum STRING elem_func ToVariant RULES ( Self .IsSimpleClass ) ( [ 'tc' aNum IntToStr 'PublicInfo.VarFromObject' ] strings:Cat ) DEFAULT '' ; // RULES >>> Result ; // ToVariant STRING elem_func FromVariant RULES ( Self .Name 'String' == ) '__coerce_String' ( Self .Name 'AnsiString' == ) '__coerce_String' DEFAULT 'OleVariant' ; // RULES >>> Result ; // ToVariant Self .OperationsAndProperties .for> ( IN aMethod if ( aMethod .IsWriteonlyProperty ! ) then begin VAR l_MethodName [ g_MethodParentPrefix if ( aMethod .IsProperty ) then 'Get_' aMethod .Name ] strings:Cat >>> l_MethodName [ 'procedure ' l_MethodName '_Pub' aNum '(Instance: TObject; Args: PVariantArgList; out Value: OleVariant; Cookie: Cardinal); stdcall;' ] .Out 'begin' .Out [ ' Assert(Instance is ' Self .MainAncestor .TypeName ');' ] .Out ' try' .Out [ ' ' if ( aMethod .MethodType .IsNotNil ) then begin 'Value := ' aMethod .MethodType .ToVariant '(' end // ( aMethod .MethodType .IsNotNil ) l_MethodName '(' Self .EffectiveType .TypeName '(' 'Instance' ')' VAR l_Index 0 >>> l_Index aMethod .ParamsOrKeys .for> ( IN aParam ', ' aParam .Target .FromVariant '(' 'Args^[' l_Index ']' ')' INC l_Index ) // aMethod .ParamsOrKeys .for> ')' if ( aMethod .MethodType .IsNotNil ) then ')' ';' ] .Out ' except' .Out ' // - гасим исключения' .Out if ( aMethod .MethodType .IsNotNil ) then begin ' Value := Unassigned;' .Out end // ( aMethod .MethodType .IsNotNil ) ' end;//try..except' .Out 'end;' .Out OutLn end // ( aMethod .IsWriteonlyProperty ! ) if ( aMethod .IsProperty ) then if ( aMethod .IsReadonlyProperty ! ) then begin VAR l_MethodName [ g_MethodParentPrefix 'Set_' aMethod .Name ] strings:Cat >>> l_MethodName [ 'procedure ' l_MethodName '_Pub' aNum '(Instance: TObject; Args: PVariantArgList; out Value: OleVariant; Cookie: Cardinal); stdcall;' ] .Out 'begin' .Out [ ' Assert(Instance is ' Self .MainAncestor .TypeName ');' ] .Out ' try' .Out [ ' ' l_MethodName '(' Self .EffectiveType .TypeName '(' 'Instance' ')' ', ' aMethod .Target .FromVariant '(' 'Args^[' 0 ']' ')' ')' ';' ] .Out ' except' .Out ' // - гасим исключения' .Out ' end;//try..except' .Out 'end;' .Out OutLn end // ( aMethod .IsReadonlyProperty ! ) ) // Self .OperationsAndProperties .for> [ 'procedure _RegisterPublicInformation' aNum ';' ] .Out 'begin' .Out Self .OperationsAndProperties .for> ( IN aMethod if ( aMethod .IsWriteonlyProperty ! ) then begin VAR l_MethodName [ g_MethodParentPrefix if ( aMethod .IsProperty ) then 'Get_' aMethod .Name '_Pub' aNum IntToStr ] strings:Cat >>> l_MethodName [ ' ' 'tc' aNum 'PublicInfo._RegisterMethod' '(' Self .MainAncestor .TypeName ', ' 'tc' aNum 'OpenAppClasses' cDot if ( aMethod .IsProperty ) then 'mtGet' else 'mtInvoke' ', ' cQuote aMethod .Name cQuote ', ' if ( aMethod .MethodType .IsNil ) then 'nil' else begin 'TypeInfo(' aMethod .MethodType .TypeName ')' end ', ' '[' ( VAR l_WasComma false >>> l_WasComma aMethod .ParamsOrKeys .map> ( .Target .TypeName 'TypeInfo(' SWAP Cat ')' Cat ) .for> ( .WithComma: l_WasComma .KeepInStack ) ) ']' ', ' '[' ( VAR l_WasComma false >>> l_WasComma aMethod .ParamsOrKeys .map> ( .Name cQuote SWAP Cat cQuote Cat ) .for> ( .WithComma: l_WasComma .KeepInStack ) ) ']' ', ' l_MethodName ')' ';' ] .Out end // ( aMethod .IsWriteonlyProperty ! ) if ( aMethod .IsProperty ) then if ( aMethod .IsReadonlyProperty ! ) then begin VAR l_MethodName [ g_MethodParentPrefix 'Set_' aMethod .Name '_Pub' aNum IntToStr ] strings:Cat >>> l_MethodName [ ' ' 'tc' aNum 'PublicInfo._RegisterMethod' '(' Self .MainAncestor .TypeName ', ' 'tc' aNum 'OpenAppClasses' cDot 'mtPut' ', ' cQuote aMethod .Name cQuote ', ' 'nil' ', ' '[' ']' ', ' '[' ']' ', ' l_MethodName ')' ';' ] .Out end // ( aMethod .IsReadonlyProperty ! ) ) // Self .OperationsAndProperties .for> 'end;' .Out OutLn ) // [ 5 6 ] .for> ) // TF g_MethodParentPrefix ; // OutTestClassImplementation elem_proc OutImplementation RULES ( Self .IsClassOrMixIn ) ( Self .OutClassImplementation ) ( Self .IsStaticObject ) ( Self .OutClassImplementation ) ( Self .IsException ) ( Self .OutClassImplementation ) ( Self .IsTestClass ) ( Self .OutTestClassImplementation ) ; // RULES ; // OutImplementation elem_proc OutIniOrFini Self .IfDef: ( Self .UserCode: cEmptyStr () Self .OutDocumentation ) // Self .IfDef: ; // OutIniOrFini INTERFACE elem_func RegisterTestCaseMethod ( 'RegisterTestCase' MakeIniProcedure: ( IN aMade aMade ->^ cUserCodePrefix ^:= [ ' TestFramework.RegisterTest(' Self .TypeName '.Suite);' ] ) // MakeIniProcedure: ) >>> Result ; // RegisterTestCaseMethod INTERFACE elem_func RegisterTestClassMethod ( 'RegisterTestClass' MakeIniProcedure: ( IN aMade aMade ->^ cUserCodePrefix ^:= [ ' _RegisterPublicInformation5;' \n ' _RegisterPublicInformation6;' ] ) // MakeIniProcedure: ) >>> Result ; // RegisterTestClassMethod INTERFACE elem_func RegisterTagTableMethod ( 'RegisterTagTable' MakeIniProcedure: ( IN aMade aMade ->^ cUserCodePrefix ^:= [ cSpace Self .TypeName '.SetAsDefault;' ] ) // MakeIniProcedure: ) >>> Result ; // RegisterTagTableMethod INTERFACE elem_func RegisterServiceImplementationMethod ( 'bind' MakeIniProcedure: ( IN aMade aMade -> %SUM := ( 'Регистрация ' Self .TypeName Cat ) aMade .AddMethodWithParams: cUserCodePrefix Self .BindServiceImplementationUC ) // MakeIniProcedure: ) >>> Result ; // RegisterServiceImplementationMethod INTERFACE elem_func MakeIniStr STRING IN aName ModelElement IN aSpeller STRING IN aPrefix ( aName MakeIniProcedure: ( IN aMade aMade -> %SUM := ( [ 'Инициализация ' aPrefix Self .Name ] strings:Cat ) aMade -> "ifdef" := ( Self .IfDefStr ) aMade -> "ifndef" := ( Self .IfNDefStr ) aMade .AddMethodWithParams: cUserCodePrefix ( Self aSpeller ) .InitStrUCPrim ) // MakeIniProcedure: ) >>> Result ; // MakeIniStr elem_iterator IniOperationsPrim Self .OperationsEx .filter> .IsIni >>> Result ; // IniOperationsPrim ModelElement elem_func ElementOrParentThatCanHaveIniOperations RULES ( Self .IsClassOrMixIn ) Self ( Self .IsUtilityPack ) Self ( Self .Parent .IsNil ) nil DEFAULT ( Self .Parent call.me ) ; // RULES >>> Result ; // ElementOrParentThatCanHaveIniOperations INTERFACE elem_func RegTypeMethod Cached: ( VAR l_TypeName Self .TypeName >>> l_TypeName VAR l_Name 'Reg_Type_' l_TypeName Cat >>> l_Name l_Name MakeIniProcedure: ( IN aMade aMade -> "ifndef" := 'NoScripts' aMade -> %SUM := ( 'Регистрация типа ' l_TypeName Cat ) aMade ->^ cUserCodePrefix ^:= [ ' ' 'TtfwTypeRegistrator.RegisterType(' Self .TypeInfo ');' ] // aMade ->^ cUserCodePrefix ) // MakeIniProcedure: ) >>> Result ; // RegTypeMethod elem_iterator IniOperations VAR l_IniOperations Self .IniOperationsPrim >>> l_IniOperations l_IniOperations RULES ( Self .IsConstants ) begin VAR l_Speller Self .Speller >>> l_Speller RULES ( l_Speller .IsNotNil ) begin VAR l_Parent Self .ElementOrParentThatCanHaveIniOperations >>> l_Parent VAR l_Prefix Self .GetUP 'extprop:pas:ElementPrefix' >>> l_Prefix Self .Attributes .for> ( IN aConst VAR l_Name [ 'Init_Str_' aConst .Name ] strings:Cat >>> l_Name RULES ( l_Parent call.me .filter> ( .Name l_Name == ) .IsEmpty ) ( .join> ToArray: ( aConst l_Name aConst .Speller l_Prefix .MakeIniStr ) ) ; // RULES ) // .for> end // ( l_Speller .IsNotNil ) ; // RULES end // ( Self .IsConstants ) ( ( Self .IsTestCase ) AND ( Self .Abstraction at_abstract != ) AND ( Self .IsMixIn ! ) ) ( .join> ToArray: ( Self .RegisterTestCaseMethod ) ) ( Self .IsTestClass ) ( .join> ToArray: ( Self .RegisterTestClassMethod ) ) ( Self .IsTagTable ) ( .join> ToArray: ( Self .RegisterTagTableMethod ) ) ( ( Self .IsServiceImplementation ) AND ( l_IniOperations 'bind' .HasModelElementWithName ! ) ) ( .join> ToArray: ( Self .RegisterServiceImplementationMethod ) ) ( Self .IsClassOrMixIn ) ( VAR l_WasRegisterInEngine false >>> l_WasRegisterInEngine if ( Self .IsMixIn ! ) then begin if ( Self .Abstraction at_abstract != ) then begin if ( Self GarantModel::TtfwRegisterableWord .InheritsFromOrSomeAncestorImplements ) then begin true >>> l_WasRegisterInEngine if ( l_IniOperations 'Ini_Reg' .HasModelElementWithName ! ) then begin .join> ToArray: ( 'Ini_Reg' MakeIniProcedure: ( IN aMade VAR l_TypeName Self .TypeName >>> l_TypeName aMade -> Parent := ( Self .WeakRef ) aMade -> "ifndef" := 'NoScripts' aMade -> %SUM := ( 'Регистрация ' Self .Name Cat ) aMade ->^ cUserCodePrefix ^:= [ cSpace l_TypeName '.RegisterInEngine;' ] ) // MakeIniProcedure: ) // .join> end // ( l_IniOperations GarantModel::l3UnknownPrim.ClearFields .HasModelElement ) end // ( l_IniOperations 'Ini_Reg' .HasModelElementWithName ! ) end // ( Self .Abstraction at_abstract != ) end // ( Self .IsMixIn ! ) if ( l_WasRegisterInEngine ! ) then begin if ( Self .NeedRegisterInScripts ) then begin if ( l_IniOperations 'Ini_Reg_Class' .HasModelElementWithName ! ) then begin .join> ToArray: ( 'Ini_Reg_Class' MakeIniProcedure: ( IN aMade VAR l_TypeName Self .TypeName >>> l_TypeName aMade -> Parent := ( Self .WeakRef ) aMade -> "ifndef" := 'NoScripts' aMade -> %SUM := ( 'Регистрация ' Self .Name Cat ) aMade ->^ cUserCodePrefix ^:= [ if ( Self GarantModel::TtfwWord .InheritsFrom ) then begin ' ' Self .TypeName '.RegisterClass;' end else begin ' TtfwClassRef.Register(' Self .TypeName ');' end ] // aMade ->^ cUserCodePrefix ) // MakeIniProcedure: ) // .join> end // ( l_IniOperations 'Ini_Reg_Class' .HasModelElementWithName ! ) end // ( Self .NeedRegisterInScripts ) end // ( l_WasRegisterInEngine ! ) ) // ( Self .IsClassOrMixIn ) ( Self .IsEnum ) begin if ( Self .NeedRegisterInScripts ) then begin .join> ToArray: ( Self .RegTypeMethod ) end // ( Self .NeedRegisterInScripts ) end // ( Self .IsEnum ) ( Self .IsException ) begin if ( Self .NeedRegisterInScripts ) then begin .join> ToArray: ( Self .RegTypeMethod ) end // ( Self .NeedRegisterInScripts ) end // ( Self .IsException ) ( Self .IsInterface ) begin if ( Self .NeedRegisterInScripts ) then begin .join> ToArray: ( Self .RegTypeMethod ) end // ( Self .NeedRegisterInScripts ) end // ( Self .IsInterface ) ( Self .IsScriptKeywordsPack ) begin Self .InheritsEx .join> ( Self .ImplementsEx ) .join> ( Self .OperationsEx .filter> .IsSomeKeyWord .mapToTarget> ) // .join> .joinWithLambded> ( Self .OperationsEx ) ( .Parameters .mapToTarget> ) .filter> .IsAcceptableForScripts .map> .RegTypeMethod .filter> ( .Name l_IniOperations SWAP .HasModelElementWithName ! ) .for> ( IN aMethod .join> ToArray: aMethod array:Copy >>> l_IniOperations // - перекопируем массив, чтобы убрать дубликаты l_IniOperations // - кладём его обратно на стек ) // .for> end // ( Self .IsScriptKeywordsPack ) ; // RULES >>> Result ; // IniOperations elem_iterator FiniOperations Self .OperationsEx .filter> .IsFini >>> Result ; // FiniOperations ARRAY CompileTime-VAR g_DeferredInitialization nil elem_proc OutIniFiniSection : OutInitialization if ( g_DeferredInitialization .IsNil ) then begin 'initialization' .Out end // ( g_DeferredInitialization .IsNil ) else begin g_DeferredInitialization .Out nil >>> g_DeferredInitialization end // ( g_DeferredInitialization .IsNil ) ; // OutInitialization VAR l_WasOut false >>> l_WasOut VAR l_WasInitialization false >>> l_WasInitialization Self .ForChildren> .All ( .IniOperations .for> ( if ( l_WasOut ! ) then begin true >>> l_WasOut true >>> l_WasInitialization OutInitialization end // ( l_WasOut ! ) .OutIniOrFini ) // .IniOperations .for> ) // Self .ForChildren> .All l_WasOut ? OutLn false >>> l_WasOut Self .ForChildren> .All ( .FiniOperations .for> ( if ( l_WasOut ! ) then begin true >>> l_WasOut if ( l_WasInitialization ! ) then begin true >>> l_WasInitialization OutInitialization OutLn end // ( l_WasInitialization ! ) 'finalization' .Out end // ( l_WasOut ! ) .OutIniOrFini ) // .FiniOperations .for> ) // Self .ForChildren> .All l_WasOut ? OutLn ; // OutIniFiniSection elem_proc OutImplementationSection Self .OutDefinitionsSection: .IsForImplementation VAR l_WasOut false >>> l_WasOut Self .ForChildren> .IsForImplementation ( .GlobalVars .filter> ( .Visibility PrivateAccess != ) .for> ( .OutVar true >>> l_WasOut ) ) Self .ForChildren> .All ( .GlobalVars .filter> ( .Visibility PrivateAccess == ) .for> ( .OutVar true >>> l_WasOut ) ) l_WasOut ? OutLn Self .ForChildren> .All ( .ConstantsEx .filter> ( .ConstantsListVisibility PrivateAccess == ) .OutConstantsList ) Self .ForChildren> .IsForImplementation ( IN anItem VAR l_GlobalOperations anItem .GlobalOperations >>> l_GlobalOperations VAR l_GlobalOperationsForOverload anItem .GlobalOperationsForOverload >>> l_GlobalOperationsForOverload l_GlobalOperations .for> .MethodInterfaceForEx: l_GlobalOperationsForOverload .MethodBody ) TF g_EnableMethodDirectives ( false >>> g_EnableMethodDirectives Self .ForChildren> .IsForInterface ( IN anItem VAR l_GlobalOperations anItem .GlobalOperations >>> l_GlobalOperations VAR l_GlobalOperationsForOverload anItem .GlobalOperationsForOverload >>> l_GlobalOperationsForOverload l_GlobalOperations .filter> ( .Visibility PrivateAccess == ) .for> .MethodInterfaceForEx: l_GlobalOperationsForOverload .MethodBody l_GlobalOperations .filter> ( .Visibility PrivateAccess != ) .for> .MethodInterfaceForEx: nil .MethodBody ) ) // TF g_EnableMethodDirectives Self .ForChildren> .All .OutImplementation Self .OutIniFiniSection ; // OutImplementationSection STRING elem_func Defines Self .GetUP "defines" >>> Result if ( Result .IsNil ) then begin VAR l_Parent Self .Parent >>> l_Parent if ( l_Parent .IsNotNil ) then begin l_Parent call.me >>> Result end // ( l_Parent .IsNotNil ) end // ( Result .IsNil ) else begin Self .PathOnly Result Cat >>> Result end // ( Result .IsNil ) ; // Defines elem_proc OutUnitHeader [ '// Модуль: "' Self .FinalFileName '"' ] .Out [ '// Стереотип: "' Self .Stereotype .Name '"' ] .Out if ( Self .Name .IsNotNil ) then begin [ '// Элемент модели: "' Self .Name '"' if ( Self .UID .IsNotNil ) then begin ' MUID: (' Self .UID ')' end // ( Self .UID .IsNotNil ) ] .Out if ( Self .TypeName .IsNotNil ) then begin if ( Self .Name Self .TypeName ?!= ) then begin [ '// Имя типа: "' Self .TypeName '"' ] .Out end // ( Self .Name Self .TypeName ?!= ) end // ( Self .TypeName .IsNotNil ) end // ( Self .Name .IsNotNil ) OutLn ; // OutUnitHeader PROCEDURE DoOutUnit ^ IN aLambda TF g_Implementor ( nil >>> g_Implementor TF g_WasTypeOpener ( nil >>> g_WasTypeOpener TF g_WasConst ( false >>> g_WasConst TF g_WasForwarded ( false >>> g_WasForwarded TF g_WasType ( DropWasType TF g_MixInValues ( [] >>> g_MixInValues TF g_OutedTypes ( [] >>> g_OutedTypes TF g_ForwardedTypes ( [] >>> g_ForwardedTypes aLambda DO ) // TF g_ForwardedTypes ) // TF g_OutedTypes ) // TF g_MixInValues ) // TF g_WasType ) // TF g_WasForwarded ) // TF g_WasConst ) // TF g_WasTypeOpener ) // TF g_Implementor ; // DoOutUnit elem_proc OutApplicationBody RULES ( Self .IsTestTarget ) begin [ ' {$IfDef nsTest}' \n ' g_CVSPath := ' cQuote Self .FinalFileName sysutils:ExtractFilePath '\' .CutSuffix cQuote ';' \n ' {$EndIf nsTest}' ] .Out Indented: ( Self .UserCode: 'CVSPath' () ) RULES ( Self .UPisTrue "need UC in project" ) begin Indented: ( Self .UserCode: 'manualcode' () ) end // ( Self .UPisTrue "need UC in project" ) ( Self .IsVCMTestTarget ) begin RULES ( Self .DependsVCMGUI .filter> ( .GetUP "F1Like" false ?== ) .IsEmpty ) ( ' TF1AutoTestSuite.Register;' .Out ) DEFAULT ( ' TAutoTestsSuite.Register;' .Out ) ; // RULES Self .DependsVCMGUI .for> ( IN anItem anItem call.me ) // .for> end // ( Self .IsVCMTestTarget ) DEFAULT begin if ( Self .UPisTrue "no scripts" ! ) then begin ' TAutoTestsSuite.Register;' .Out end // ( Self .UPisTrue "no scripts" ! ) ' try' .Out [ ' if KTestRunner.NeedKTestRunner([' VAR l_WasComma false >>> l_WasComma Self .ChildrenEx .filter> .IsTestResults .map> .TypeName .for> ( .WithComma: l_WasComma .KeepInStack ) ']) then' ] .Out ' KTestRunner.RunRegisteredTests' .Out ' else' .Out ' if System.IsConsole then' .Out ' TextTestRunner.RunRegisteredTests' .Out ' else' .Out ' GUITestRunner.RunRegisteredTests;' .Out ' except' .Out ' on E: Exception do' .Out ' begin' .Out ' {$If defined(MTDORB) AND defined(NoKPageTool)}' .Out ' if TKBridge.Exists then' .Out ' TKBridge.Instance.Logout;' .Out ' {$IfEnd}' .Out ' l3System.Exception2Log(E);' .Out ' Halt(2);' .Out ' end;//Exception' .Out ' end;//try..except' .Out ' if (TestsExitCode <> 0) then' .Out ' Halt(TestsExitCode);' .Out end // DEFAULT ; // RULES end // ( Self .IsTestTarget ) ( Self .IsVCMGUI ) begin [ ' ' 'StdRes.TdmStdRes.Run(str_' Self .Name 'Title' ',' ' ' cQuote Self .GetUP "HelpFile" '.chm' cQuote ');' ] .Out end // ( Self .IsVCMGUI ) DEFAULT begin Indented: ( Self .UserCode: 'manualcode' () ) end // DEFAULT ; // RULES ; // OutApplicationBody STRING elem_func ProjectUnitPath Cached: ( VAR l_Path RULES ( Self IsString ) RULES ( Self GarantModel::StdRes .Name == ) ( GarantModel::StdRes .Name '.pas' Cat ) DEFAULT '' ; // RULES ( Self .Name GarantModel::StdRes .Name == ) ( GarantModel::StdRes .Name '.pas' Cat ) ( Self .InTie ) // - тут надо брать путь для адаптера ( VAR l_pasPath Self .GetUP 'pas:Path' >>> l_pasPath RULES ( l_pasPath .IsNil ) '' DEFAULT ( [ cRoot l_pasPath ] cPathSep strings:CatSep ) ; // RULES ) ( Self .UnitName 'GblAdapter' == ) '' DEFAULT ( Self .FinalFileName ) ; // RULES >>> l_Path if ( l_Path .IsNotNil ) then begin if ( l_Path 'NotFinished\Borland\Delphi\Rtl\Sys' string:Pos -1 != ) then begin '' >>> l_Path end // ( l_Path 'NotFinished\Borland\Delphi\Rtl\Sys' string:Pos -1 != ) end // ( l_Path .IsNotNil ) if ( l_Path .IsNotNil ) then begin l_Path cNotFinished '' string:Replace >>> l_Path l_Path cNotCompleted '' string:Replace >>> l_Path l_Path 'NotFinished\' '' string:Replace >>> l_Path end // ( l_Path .IsNotNil ) l_Path ) >>> Result ; // ProjectUnitPath STRING elem_func ProjectUnitName Self .UnitName VAR l_Path Self .ProjectUnitPath >>> l_Path if ( l_Path .IsNotNil ) then begin [ ' in ' cQuote l_Path cQuote ] strings:Cat Cat end // ( l_Path .IsNotNil ) >>> Result ; // ProjectUnitName elem_proc OutUnit DoOutUnit ( TF g_DefaultInterfaceAncestor ( Self .ChildrenEx .filter> ( .UPisTrue "is default ancestor" ) .FirstElement >>> g_DefaultInterfaceAncestor [ RULES ( Self .IsDLL ) 'library' ( Self .IsExe ) 'program' DEFAULT 'unit' ; // RULES cSpace Self .UnitNamePrim ';' ] .Out Self .OutDocumentation OutLn Self .OutUnitHeader VAR l_Defines Self .Defines >>> l_Defines if ( l_Defines .IsNotNil ) then begin [ cOpenComment '$Include ' l_Defines cCloseComment ] .Out OutLn end // ( l_Defines .IsNotNil ) if ( Self .IsExe ) then begin if ( Self .UPisTrue "console" ) then begin '{$APPTYPE CONSOLE}' .Out OutLn end // ( Self .UPisTrue "console" ) end // ( Self .IsExe ) if ( Self .IsTarget ! ) then begin 'interface' .Out OutLn end // ( Self .IsTarget ! ) ARRAY VAR l_Used [] >>> l_Used Self .IfDef: ( if ( Self .IsTarget ) then begin Self 'intf_uses' .OutUses: l_Used ( Self .ProjectUses ) .ProjectUnitName end // ( Self .IsTarget ) else begin Self 'intf_uses' .OutUses: l_Used ( Self .IntfUses ) .UnitName end // ( Self .IsTarget ) Self .OutInterfaceSection if ( Self .IsElementProxy ) then begin Self .UserCode: 'intf_code' () OutLn end // ( Self .IsElementProxy ) ) // Self .IfDef: if ( Self .IsTarget ! ) then begin 'implementation' .Out OutLn end // ( Self .IsTarget ! ) Self .IfDef: ( if ( Self .IsTarget ! ) then begin Self 'impl_uses' .OutUses: l_Used ( Self .ImplUses ) .UnitName end // ( Self .IsTarget ! ) RULES ( Self .IsTestClass ) ( Self .MainAncestor .IfDef: ( Self .OutImplementationSection ) // Self .MainAncestor .IfDef: ) // ( Self .IsTestClass ) ( Self .IsSimpleClass ) ( Self .MainAncestor .IfDef: ( Self .OutImplementationSection ) // Self .MainAncestor .IfDef: ) // ( Self .IsSimpleClass ) DEFAULT ( Self .OutImplementationSection ) ; // RULES RULES ( Self .IsElementProxy ) ( Self .UserCode: 'impl_code' () OutLn ) ( Self .IsDLL ) ( 'exports' .Out Self .UserCode: 'exports' ( ) ';' .Out OutLn ) ; // RULES ) // Self .IfDef: RULES ( Self .IsExe ) ( if ( Self .UPisTrue "console" ! ) then begin [ '{$R ' Self .UnitName '.res' '}' ] .Out if ( Self .UPisTrue "needs second icon" ) then begin [ '{$R main_icon2.res}' ' // вторая иконка приложения' ] .Out end // ( Self .UPisTrue "needs second icon" ) OutLn end // ( Self .UPisTrue "console" ! ) if ( Self .UPisTrue "need UC in project" ) then begin Self .UserCode: 'manualres' () OutLn end // ( Self .UPisTrue "need UC in project" ) 'begin' .Out Self .OutApplicationBody ) // ( Self .IsExe ) ( Self .IsDLL ) ( [ '{$R ' Self .UnitName '.res' '}' ] .Out OutLn 'begin' .Out ) // ( Self .IsDLL ) ; // RULES 'end.' .Out ) // TF g_DefaultInterfaceAncestor ) // DoOutUnit ; // OutUnit STRING elem_func DefineName Cached: ( Self .UnitName cDot cUnderline string:Replace ) >>> Result ; // DefineName elem_proc OutMixIn DoOutUnit ( VAR l_DefineName Self .DefineName >>> l_DefineName [ cOpenComment '$IfNDef ' l_DefineName cCloseComment \n ] .Out Self .OutUnitHeader [ cOpenComment '$Define ' l_DefineName cCloseComment \n ] .Out Self .IfDefElse: ( Self .OutInterfaceSection ) ( VAR l_Parent Self .CalcParentAndInclude >>> l_Parent [ Self .TypeName ' = ' l_Parent .TypeName ';' \n ] .Out ) // Self .IfDefElse: [ cOpenComment '$Else ' l_DefineName cCloseComment \n ] .Out VAR l_DefineNameImpl [ l_DefineName '_impl' ] >>> l_DefineNameImpl [ cOpenComment '$IfNDef ' l_DefineNameImpl cCloseComment \n ] .Out [ cOpenComment '$Define ' l_DefineNameImpl cCloseComment \n ] .Out TF g_DeferredInitialization ( [ cOpenComment '$Else ' l_DefineNameImpl cCloseComment \n ] >>> g_DeferredInitialization Self .IfDef: ( Self .OutImplementationSection ) // Self .IfDef: ) [ cOpenComment '$EndIf ' l_DefineNameImpl cCloseComment \n ] .Out [ cOpenComment '$EndIf ' l_DefineName cCloseComment \n ] .Out ) // DoOutUnit ; // OutMixIn STRING elem_func PasFinalFileName Self .GetUP 'intf.pas:Path' >>> Result if ( Result .IsNil ) then begin RULES ( Self .IsTestLibrary ) begin Self .PasPathOnly >>> Result if ( Result .IsNotNil ) then begin [ Result [ Self .Name cSpace cUnderline string:Replace '_TestLibrary' '.pas' ] strings:Cat ] cPathSep strings:CatSep >>> Result end // ( Result .IsNotNil ) end // ( Self .IsTestLibrary ) ( Self .IsTestUnit ) begin Self .PasPathOnly >>> Result if ( Result .IsNotNil ) then begin [ Result [ [ Self .Parent .Name cUnderline Self .Name ] strings:Cat cSpace cUnderline string:Replace cDot cUnderline string:Replace '_TestUnit' '.pas' ] strings:Cat ] cPathSep strings:CatSep >>> Result end // ( Result .IsNotNil ) end // ( Self .IsTestUnit ) ( Self .IsElementProxy ) begin Self .PasPathOnly >>> Result if ( Result .IsNotNil ) then begin [ Result [ Self .Name cProxy '.pas' ] strings:Cat ] cPathSep strings:CatSep >>> Result end // ( Result .IsNotNil ) end // ( Self .IsElementProxy ) ( Self .IsScriptKeywordsPack ) begin Self .PasPathOnly >>> Result if ( Result .IsNotNil ) then begin [ Result [ Self .Name '.pas' ] strings:Cat ] cPathSep strings:CatSep >>> Result end // ( Result .IsNotNil ) end // ( Self .IsScriptKeywordsPack ) ; // RULES end // ( Result .IsNil ) ; // PasFinalFileName elem_generator pas CONST Ext '.pas' BOOLEAN elem_func CanCopyToFinalFile RULES ( Self .UseNewGen ) true DEFAULT false ; // RULES >>> Result ; // CanCopyToFinalFile STRING elem_func FinalFileNamePrim Self .PasFinalFileName >>> Result ; // FinalFileNamePrim RULES ( Self .IsMixIn ) ( Self .OutMixIn ) ( Self .IsUserType ) ( Self .OutUnit ) ( Self .IsInterfaces ) ( Self .OutUnit ) ( Self .IsEvdSchemaElement ) ( Self .OutUnit ) ( Self .IsSimpleClass ) ( Self .OutUnit ) ( Self .IsElementProxy ) ( Self .OutUnit ) ( Self .IsUtilityPack ) ( Self .OutUnit ) ( Self .IsTestClass ) ( Self .OutUnit ) ( Self .IsTarget ) ( Self .OutUnit ) ( Self .IsTagTable ) ( Self .OutUnit ) ( Self .IsTestLibrary ) ( Self .OutUnit ) ( Self .IsTestUnit ) ( Self .OutUnit ) DEFAULT ( Self .Name .Out ) ; // RULES ; // pas elem_generator pas_dependent Inherits .pas STRING elem_func FinalFileNamePrim Self .PasFinalFileName >>> Result if ( Result .IsNotNil ) then begin Result .? Ext sysutils:ChangeFileExt >>> Result end // ( Result .IsNotNil ) ; // FinalFileNamePrim ; // pas_dependent STRING elem_func AttrName RULES ( Self .IsOverride ) ( Self .MainAncestor call.me ) DEFAULT ( Self .Name ) ; // RULES >>> Result ; // AttrName ModelElement elem_func AttrType RULES //( Self .IsOverride ) // ( Self .MainAncestor call.me ) DEFAULT ( Self .MethodType ) ; // RULES >>> Result ; // AttrType ARRAY CompileTime-VAR g_FormControls nil elem_proc ToDFM // <%C#f_ToDFM()>\ // <%G#f_ToDFM()>\ // <%R#f_ToDFM()> // [{%S%f_NeedPutToDFM()=true}\ // [{%f_exists_in_list(FORM_CONTROLS,"%S%f_pas_AttrName()")=false}\ // %f_add_to_list(FORM_CONTROLS,"%S%f_pas_AttrName()")\ // \n# object %S%f_pas_AttrName(): %S%f_pas_ResultTypeName()\ // [{"%SD"!=""&%S{need Caption}!=false}\n# Caption = '%SD']\ // <%C#f_ToDFM()>\ // [{%S%f_IsOverride()=true}\ // <{}{}{r}%g<%C#f_ToDFM()>>\ // ] // # end\ // ]\ // ] RULES ( Self .IsVCMCustomForm ) ( Self .Attributes .for> call.me Self .InheritsEx .for> call.me Self .ImplementsEx .for> call.me ) ( Self .IsControlPrim ) ( if ( Self .NeedPutToDFM ) then begin if ( Self .AttrName .TextNotInArray: g_FormControls ) then begin Self .AttrName .AddToArray: g_FormControls Indented: ( [ ' object ' Self .AttrName ': ' Self .AttrType .TypeName ] .Out Self .Attributes .for> call.me if ( Self .IsOverride ) then begin Self .InheritsEx .for> ( .Attributes .for> call.me ) end // ( Self .IsOverride ) [ ' end' ] .Out ) // Indented: end // ( Self .AttrName .TextNotInArray: g_FormControls ) end // ( Self .NeedPutToDFM ) ) ; // RULES ; // ToDFM elem_proc BeforeDFMControls RULES ( Self .IsVCMForm ) ( [ ' Caption = ' cQuote Self .Documentation cQuote ] .Out [ ' Color = $00F9F8FA' ] .Out VAR l_ZoneType Self .GetUP "ZoneType" >>> l_ZoneType if ( l_ZoneType .IsNotNil ) then if ( l_ZoneType 'Any' != ) then begin [ ' ZoneType = vcm_zt' l_ZoneType ] .Out end // ( l_ZoneType 'Any' != ) [ ' PixelsPerInch = 96' ] .Out [ ' TextHeight = 13' ] .Out [ ' object Entities: TvcmEntities' ] .Out [ ' Left = 24' ] .Out [ ' Top = 24' ] .Out [ ' end' ] .Out ) ; // RULES ; // BeforeDFMControls elem_generator dfm Inherits .pas_dependent CONST Ext '.dfm' BOOLEAN elem_func NeedOwnFilePrim Self .IsVCMCustomForm AND ( Self .Abstraction at_final == ) >>> Result ; // NeedOwnFilePrim BOOLEAN elem_func CanCopyToFinalFile Self .GetUP "finished dfm" false ?!= >>> Result ; // CanCopyToFinalFile TF g_FormControls ( [] >>> g_FormControls [ 'object ' Self .TypeName .CutT ': ' Self .TypeName ] .Out [ ' Left = 204' ] .Out [ ' Top = 118' ] .Out [ ' Width = 320' ] .Out [ ' Height = 240' ] .Out Self .BeforeDFMControls Self .ToDFM [ 'end' ] .Out ) // TF g_FormControls ; // dfm elem_generator res.cmd Inherits .pas_dependent CONST Ext '.res.cmd' BOOLEAN elem_func NeedOwnFilePrim Self .NeedsScript >>> Result ; // NeedOwnFilePrim BOOLEAN elem_func CanCopyToFinalFile true >>> Result ; // CanCopyToFinalFile VAR l_Name WithGen: .pas ( Self .EffectiveUnitName >>> l_Name ) [ 'MakeCo ' l_Name '.rc.script' ] .Out [ 'brcc32 ' l_Name '.rc' ] .Out //call.inherited ; // res.cmd BOOLEAN elem_func NeedsWordsAliases Cached: ( RULES ( Self .IsScriptKeywordsPack ! ) false ( Self .UPisTrue "no class name" ) true ( Self .UPisTrue "no_pop" ) true DEFAULT false ; // RULES ) >>> Result ; // NeedsWordsAliases elem_generator rc.script Inherits .res.cmd CONST Ext '.rc.script' BOOLEAN elem_func CanCopyToFinalFile /*{ RULES ( Self .NeedsWordsAliases ! ) true DEFAULT false ; // RULES }*/ true >>> Result ; // CanCopyToFinalFile Self .OutUnitHeader VAR l_WasManUses false >>> l_WasManUses : OutManUses l_WasManUses ! ? ( true >>> l_WasManUses OutLn Self .UserCode: 'man_uses' () OutLn ) // l_WasManUses ! ? ; // OutManUses Self .NeedsWordsAliases ? OutManUses : OutScriptFrameWorkAliases : OutWordAlias IN aG if ( ( Self .UPisTrue "no class name" ! ) AND ( aG .SelfName 'SV' != ) ) then begin 'USES' .Out [ cSpace 'axiom:' aG .SelfName ] .Out ';' .Out OutLn end // ( Self .UPisTrue "no class name" ! ) [ '// Класс ' aG .Name ' - ' aG .SelfName ] .Out Self .OperationsEx .filter> .IsKeyWord .for> ( IN anOp VAR l_NameForScript anOp .NameForScript >>> l_NameForScript [ '// Операция ' anOp .Name if ( l_NameForScript .IsNotNil ) then begin ' - ' l_NameForScript end // ( l_NameForScript .IsNotNil ) ] .Out if ( anOp .Speller .NotIsNil ) then begin anOp .Speller .NameForScript >>> l_NameForScript [ '// Класс реализующий операцию ' anOp .Speller .Name ' - ' l_NameForScript ] .Out if ( anOp .IsCreator ! ) then begin VAR l_CanonicName [ 'pop:' aG .SelfName ':' anOp .Name 'pop_' .CutPrefix [ aG .SelfName string:Lower cUnderline ] strings:Cat .CutPrefix cUnderline ':' string:Replace ] strings:Cat >>> l_CanonicName if ( l_CanonicName l_NameForScript != ) then begin [ 'WordAlias ' l_CanonicName cSpace l_NameForScript ] .Out end // ( l_CanonicName l_NameForScript != ) end // ( anOp .IsCreator ! ) end // ( anOp .Speller .NotIsNil ) ) // Self .OperationsEx OutLn ; // OutWordAlias if ( Self .NeedsWordsAliases ) then begin Self .InheritsEx .join> ( Self .ImplementsEx ) .filter> .IsAcceptableForScripts //.filter> ( DROP Self .NeedsWordsAliases /* Тут надо ещё проверку на SV */ ) .for> OutWordAlias end // ( Self .NeedsWordsAliases ) ; // OutScriptFrameWorkAliases Self .IsScriptKeywordsPack ? OutScriptFrameWorkAliases Self .UserCode: 'impl' () OutLn 'EXPORTS' .Out Self .UserCode: 'exports' ( ' *' ) OutLn ; // rc.script elem_generator rc Inherits .res.cmd CONST Ext '.rc' Self .OutUnitHeader VAR l_Name WithGen: .pas ( Self .EffectiveUnitName >>> l_Name ) [ l_Name ' RCDATA LOADONCALL MOVEABLE DISCARDABLE ' l_Name '.rc.script.co' ] .Out //call.inherited ; // rc ARRAY CompileTime-VAR g_GeneratedElements [] %REMARK 'Ранее сгенерированные элементы' elem_proc GenerateWithChildren Sequence IN aGenerators if ( Self .NotInArray: g_GeneratedElements ) then begin Self .AddToArray: g_GeneratedElements aGenerators CodeIterator .for> ( // - цикл по генераторам для Self TtfwWord IN aGenerator TF g_CurrentGenerator ( aGenerator >>> g_CurrentGenerator if ( Self .NeedOwnFile ) then begin VAR l_Name Self .Name >>> l_Name [ l_Name ' ' g_CurrentGenerator .WordName ] strings:Cat >>> l_Name Log: [ l_Name ' generation start' ] VAR l_Time StartTimer TRY ( Self .GenerateWordToFileWith: .CurrentGenerator ) FINALLY l_Name StopTimerNoLog >>> l_Time END // TRY..FINALLY l_Time 1000 DIV >>> l_Time if ( l_Time > 3 ) then begin Log: [ l_Name ' generation end ' l_Time ' seconds' ] end // ( l_Time > 3 ) end // ( Self .NeedOwnFile ) else ( Self .DeleteWordFile ) ) // TF g_CurrentGenerator ) // aGenerators CodeIterator .for> Self .ChildrenEx .for> ( aGenerators call.me ) // - тут генерируем детей end // Self .NotInArray: g_GeneratedElements ; // GenerateWithChildren elem_proc call.generators.in.list Sequence ^ IN aGenerators Self aGenerators .GenerateWithChildren ; // call.generators.in.list elem_proc Generate g_GeneratedFiles .IsNil ?FAIL 'Массив g_GeneratedFiles не инициализирован' g_GeneratedElements .IsNil ?FAIL 'Массив g_GeneratedElements не инициализирован' Self .call.generators.in.list ( .pas .res.cmd .rc .rc.script .dfm ) ; // Generate
Заметки о тестировании, программировании и прочий "поток сознания", который жалко писать "в стол"
пятница, 20 мая 2016 г.
#1244. Кодогенерация. Только код
Подписаться на:
Сообщения (Atom)