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 '\' USES Chars.ms.dict ; USES Out.ms.dict ; 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 GarantMetaModel.ms.dict ; 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 CachedElementToArray Cached: ( [[ Self .WeakRef ]] ) >>> Result ; // CachedElementToArray ARRAY elem_func ElementToArray RULES ( Self .IsNil ) [empty] ( Self IsIntf ) [[ Self ]] DEFAULT ( Self .CachedElementToArray ) ; // 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: 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 USES Controls.ms.dict ; elem_iterator InheritsEx Cached: ( VAR l_Inherits Self .Inherits >>> l_Inherits RULES ( l_Inherits .IsEmpty ) RULES ( Self .IsControlOverride ) [empty] ( Self .IsControlPrim ) begin VAR l_Name if ( Self .IsComponent ) then begin Self .GetUP "ComponentClass" >>> l_Name end // ( Self .IsComponent ) else begin Self .GetUP "ControlClass" >>> l_Name end // ( Self .IsComponent ) AllModelControls .filter> ( .Name l_Name == ) array:Copy end // ( Self .IsControlPrim ) ( 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 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 GarantModel::TddComboBoxConfigItem .InheritsFrom ) true ( Self GarantModel::Tl3ProtoObjectForTie ?== ) false ( Self GarantModel::Tl3ProtoObjectForTie .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 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 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 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 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 IsVCMOperationPrim RULES ( Self .IsStereotype st_VCMOperationPrim ) true ( ( Self .Parent .IsNotNil ) AND ( Self .Parent .IsVCMOperations ) ) true DEFAULT false ; // RULES >>> Result ; // IsVCMOperationPrim WordAlias .IsVCMOperation .IsVCMOperationPrim 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 .IsVCMOperation ) false ( 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 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 ! ) >>> Result ; // .filterMixIns> 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 ARRAY FUNCTION .mapToTarget> ARRAY IN anArray anArray .map> .Target >>> Result ; // .mapToTarget> elem_iterator ImplementsInDependencies Cached: ( Self .Dependencies .filter> .IsImplements .mapToTarget> array:Copy ) >>> Result ; // ImplementsInDependencies FORWARD .ChildrenEx INTERFACE elem_func DecorateType Cached: ( Self .DecorateMethod: ( IN aMethod aMethod -> OpKind := opkind_DecoratedType ) // Self .DecorateMethod: ) >>> Result ; // DecorateType BOOLEAN FUNCTION .HasModelElement ARRAY IN anArray ModelElement IN anElement anArray .HasSomeOf: ( anElement .IsSameModelElement ) >>> Result ; // .HasModelElement STRING elem_func ServiceFacetName 'I' Self .Name 'T' .CutPrefix Cat >>> Result ; // ServiceFacetName STRING elem_func ServiceMixInName 'M' Self .Name 'T' .CutPrefix Cat >>> Result ; // ServiceMixInName INTERFACE FUNCTION MakeClass: STRING IN aName ModelElement IN anAncestor ^ IN aLambda KeyValuesCreateAndDo: ( IN aMade aMade pop:Word:Box >>> Result aMade -> Name := aName if ( anAncestor .IsNotNil ) then begin aMade -> Inherits := [ anAncestor ] end // ( anAncestor .IsNotNil ) aMade aLambda DO ) // KeyValuesCreateAndDo: ; // MakeClass: INTERFACE FUNCTION MakeFacet: STRING IN aName ModelElement IN anAncestor ^ IN aLambda aName anAncestor MakeClass: ( IN aMade aMade -> Stereotype := st_Facet aMade aLambda DO ) // MakeClass: >>> Result ; // MakeFacet: INTERFACE FUNCTION MakeClass STRING IN aName ModelElement IN anAncestor aName anAncestor MakeClass: DROP >>> Result ; // MakeClass elem_iterator ChildrenExPrim Cached: ( VAR l_Children Self .Children >>> l_Children if ( Self .IsService ) then begin if ( l_Children .filter> .IsInterface .filter> ( .Name Self .ServiceFacetName == ) .FirstElement .IsNil ) then begin VAR l_MixIn l_Children .filter> .IsPureMixIn .filter> ( .Name Self .ServiceMixInName == ) .FirstElement >>> l_MixIn l_Children .join> ToArray: ( Self .ServiceFacetName nil MakeFacet: ( IN aMade aMade -> UID := ( [ Self .LUID '_Facet' ] strings:Cat ) aMade -> %SUM := ( [ 'Интерфейс сервиса ' Self .Name ] strings:Cat ) aMade -> Parent := ( Self .WeakRef ) aMade -> Visibility := PublicAccess aMade -> Implements := [ l_MixIn ] ) // MakeFacet: ) // l_Children .join> ToArray: >>> l_Children end end // ( Self .IsService ) l_Children ) >>> Result ; // ChildrenExPrim ModelElement elem_func FacetEx Cached: ( RULES ( Self .Facet .IsNil ) begin Self .ChildrenExPrim .filter> .IsInterface .filter> ( .Name Self .ServiceFacetName == ) .FirstElement end // ( Self .Facet .IsNil ) DEFAULT ( Self .Facet ) ; // RULES ) >>> Result ; // FacetEx ModelElement elem_func MixInEx Cached: ( RULES ( Self .MixIn .IsNil ) begin Self .ChildrenExPrim .filter> .IsPureMixIn .filter> ( .Name Self .ServiceMixInName == ) .FirstElement end // ( Self .MixIn .IsNil ) DEFAULT ( Self .MixIn ) ; // RULES ) >>> Result ; // MixInEx elem_iterator ImplementsEx Cached: ( VAR l_Implements Self .Implements >>> l_Implements if ( Self .IsServiceImplementation ) then begin Self .ImplementsInDependencies .for> ( IN aService VAR l_Facet aService .FacetEx >>> l_Facet if ( l_Facet .NotIsNil ) then begin if ( l_Implements l_Facet .HasModelElement ! ) then begin l_Implements .join> ( l_Facet .DecorateType .ToArray ) // l_Implements .join> >>> l_Implements end // ( l_Implements l_Facet .HasModelElement ! ) end // ( l_Facet .NotIsNil ) ) // .for> end // ( Self .IsServiceImplementation ) if ( Self .IsService ) then begin VAR l_MixIn Self .MixInEx >>> l_MixIn if ( l_MixIn .NotIsNil ) then begin if ( l_Implements l_MixIn .HasModelElement ! ) then begin l_Implements .join> ( l_MixIn .DecorateType .ToArray ) // l_Implements .join> >>> l_Implements end // ( l_Implements l_MixIn .HasModelElement ! ) end // ( l_MixIn .NotIsNil ) end // ( Self .IsService ) if ( Self .IsInterface ) then begin if ( Self .Parent .IsService ) then begin if ( Self .Name Self .Parent .ServiceFacetName == ) then begin VAR l_MixIn Self .Parent .MixInEx >>> l_MixIn if ( l_MixIn .NotIsNil ) then begin if ( l_Implements l_MixIn .HasModelElement ! ) then begin l_Implements .join> ( l_MixIn .DecorateType .ToArray ) // l_Implements .join> >>> l_Implements end // ( l_Implements l_MixIn .HasModelElement ! ) end // ( l_MixIn .NotIsNil ) end // ( Self .Name Self .Parent .ServiceFacetName == ) end // ( Self .Parent .IsService ) end // ( Self .IsInterface ) l_Implements ) >>> Result ; // ImplementsEx elem_iterator OwnControls Cached: ( VAR l_Controls [] >>> l_Controls elem_proc CollectOwnControlsPrim Self .Attributes .filter> .IsControlPrim .filter> .AddToArray?: l_Controls .for> ( IN aControl aControl call.me ) // .for> ; // CollectOwnControlsPrim Self .CollectOwnControlsPrim l_Controls ) >>> Result ; // OwnControls FORWARD .MethodType ModelElement elem_func AttrType RULES //( Self .IsOverride ) // ( Self .MainAncestor call.me ) //( Self .IsStereotype st_VCMController ) DEFAULT ( Self .MethodType ) ; // RULES >>> Result ; // AttrType elem_iterator AllControls Cached: ( VAR l_Controls [] >>> l_Controls elem_proc CollectControlsPrim Self .Attributes .filter> .IsControlPrim .filter> .AddToArray?: l_Controls .for> ( IN aControl 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 ; // AllControls elem_iterator ScriptKeywordsPackProperties Cached: ( VAR l_Properties Self .Attributes .filter> ( .IsStereotype st_property::Attribute ) >>> l_Properties l_Properties Self .InheritsEx .filter> .IsVCMCustomForm .filter> ( .Abstraction at_final == ) .for> ( IN aForm aForm .AllControls .filter> ( .IsControlOverride ! ) .filter> ( .Visibility PublicAccess == ) .filter> ( .AttrType .NotIsNil ) .for> ( IN aControl VAR l_Name aControl .Name >>> l_Name if ( l_Properties l_Name .HasModelElementWithName ! ) then begin .join> ToArray: ( l_Name aControl .AttrType 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 BOOLEAN elem_func IsUses RULES ( Self .IsStereotype st_uses::Dependency ) true ( Self .IsStereotype st_ContextMenuWeight::Dependency ) true DEFAULT false ; // RULES >>> Result ; // IsUses elem_iterator UsesInDependencies Cached: ( Self .Dependencies .filter> .IsUses .mapToTarget> array:Copy ) >>> Result ; // UsesInDependencies elem: IterateVCMFormsPacksFromApplication IN aLambda RULES ( Self .IsVCMFormsPack ) begin Self aLambda DO Self .InheritsEx .for> ( aLambda call.me ) end // ( Self .IsVCMFormsPack ) ( Self .IsVCMApplication ) begin Self .Children .for> ( aLambda call.me ) Self .UsesInDependencies .for> ( aLambda call.me ) end // ( Self .IsVCMApplication ) ; // RULES ; // IterateVCMFormsPacksFromApplication elem: OutRecall IN aLambda RULES ( Self .IsVCMFormsPack ) begin Self .Operations .for> ( aLambda call.me ) Self .InheritsEx .for> ( aLambda call.me ) Self .ImplementsEx .for> ( aLambda call.me ) end // ( Self .IsVCMFormsPack ) ( ( Self .IsFormSetFactory ) AND ( Self .Visibility PublicAccess == ) ) begin Self aLambda DO end // ( Self .IsModuleOperationPrim ) ( Self .IsVCMApplication ) begin Self .Children .for> ( aLambda call.me ) Self .UsesInDependencies .for> ( aLambda call.me ) end // ( Self .IsVCMApplication ) ; // RULES ; // OutRecall CONST cNeedsToBeImplemented ' !!! Needs to be implemented !!!' 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 STRING FUNCTION cSetterImplementationUserCodeName [ cUserCodePrefix 'set' cImplementationUserCodeSuffix ] strings:Cat >>> Result ; // cSetterImplementationUserCodeName STRING FUNCTION cSetterVarUserCodeName [ cUserCodePrefix 'set' cVarUserCodeSuffix ] strings:Cat >>> Result ; // cSetterVarUserCodeName STRING FUNCTION cGetterImplementationUserCodeName [ cUserCodePrefix 'get' cImplementationUserCodeSuffix ] strings:Cat >>> Result ; // cGetterImplementationUserCodeName STRING FUNCTION cGetterVarUserCodeName [ cUserCodePrefix 'get' cVarUserCodeSuffix ] strings:Cat >>> Result ; // cGetterVarUserCodeName FORWARD .Properties FORWARD .MethodParameters 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 .CommaList ARRAY IN aList [ VAR l_WasComma false >>> l_WasComma aList .for> ( .WithComma: l_WasComma .KeepInStack ) ] >>> Result ; // .CommaList ARRAY FUNCTION .CommaListWith() ARRAY IN aList aList .CommaList .With() >>> Result ; // .CommaListWith() ARRAY elem_func ParametersList Cached: ( Self .MethodParameters .map> .Name .CommaListWith() ) >>> Result ; // ParametersList 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 Self .Properties .filter> ( .UPisTrue "needs stored directive" ) .for> ( IN aProp VAR l_Name aProp .Name 'Stored' Cat >>> l_Name if ( l_Operations l_Name .HasModelElementWithName ! ) then begin .join> ToArray: ( l_Name GarantModel::Boolean MakeFunction: ( IN aMade aMade -> UID := ( aProp .LUID 'Stored' Cat ) aMade -> %SUM := ( [ 'Функция определяющая, что свойство ' aProp .Name ' сохраняется' ] strings:Cat ) //aMade -> Stereotype := st_static::Operation aMade -> Visibility := ProtectedAccess aMade -> Abstraction := at_final ) // MakeProcedure: ) // .join> ToArray: end // ( l_Operations l_Name .HasModelElementWithName ! ) ) // .for> if ( Self .IsUseCaseControllerImp ) then begin Self .ImplementsEx .filter> .IsUseCaseController .for> ( IN aController aController .Parent .ChildrenEx .filter> ( .UPisTrue 'extprop:isSynchroEnum' ) .filter> ( .GetUP 'extprop:SDS_CASTER' aController .LUID ?== ) .for> ( IN aEnum if ( l_Operations 'ChangeSynchroForm' .HasModelElementWithName ! ) then begin .join> ToArray: ( 'ChangeSynchroForm' MakeProcedure: ( IN aMade aMade -> UID := ( [ Self .LUID '_' aEnum .LUID '_' 'ChangeSynchroForm' ] strings:Cat ) aMade -> %SUM := 'Переключает форму синхронного просмотра' //aMade -> Stereotype := st_static::Operation aMade -> Visibility := ProtectedAccess aMade -> Abstraction := at_final aMade -> Parameters := [ 'aSynchroForm' aEnum MakeParam 'aDoSaveToHistory' GarantModel::Boolean MakeParam: ( IN aMade aMade -> 'extprop:pas:Value' := true ) // 'aDoSaveToHistory' GarantModel::Boolean MakeParam: 'aNeedRefresh' GarantModel::Boolean MakeParam: ( IN aMade aMade -> 'extprop:pas:Value' := true ) // 'aNeedRefresh' GarantModel::Boolean MakeParam: ] // aMade -> Parameters ) // 'ChangeSynchroForm' MakeProcedure: ) // .join> ToArray: end // ( l_Operations 'ChangeSynchroForm' .HasModelElementWithName ! ) ) // .for> ) // .for> end // ( Self .IsUseCaseControllerImp ) if ( Self .IsVCMApplication ) then begin >>> l_Operations Self .Children .join> ( Self .UsesInDependencies ) .filter> .IsVCMFormsPack .filter> ( .Abstraction at_final == ) .for> ( IN aModule VAR l_ModuleName aModule .Name >>> l_ModuleName elem_proc DoModule Self .Operations .filter> .IsModuleOperationPrim .for> ( IN anOp VAR l_Name VAR l_Type [ 'mod_opcode_' l_ModuleName '_' anOp .Name ] strings:Cat >>> l_Name GarantModel::TvcmMOPID >>> l_Type if ( l_Operations l_Name .HasModelElementWithName ! ) then begin l_Operations .join> ToArray: ( l_Name l_Type MakeFunction: ( IN aMade aMade -> Visibility := PublicAccess aMade -> Stereotype := st_static::Operation aMade ->^ cVarUserCodeName ^:= cEmptyUserCode aMade .AddMethodWithParams: cImplementationUserCodeName ( anOp l_ModuleName ) ( IN anOp IN aModuleName VAR l_Name [ 'g_module_opcode_' aModuleName '_' anOp .Name ] strings:Cat >>> l_Name [ ' Result := ' l_Name ';' \n ' Assert((Result.rMoID > 0) AND (Result.rOpID > 0));' ] ) // aMade .AddMethodWithParams: cImplementationUserCodeName anOp ) // MakeFunction: ) //.join> ToArray: array:Copy >>> l_Operations end // ( l_Operations l_Name .HasModelElementWithName ! ) ) // .for> Self .InheritsEx .for> call.me ; // DoModule aModule .DoModule ) // .for> Self @ ( IN anOp VAR l_Name anOp .Name >>> l_Name //if ( l_Operations l_Name .HasModelElementWithName ! ) then begin l_Operations .join> ToArray: ( anOp .DecorateMethod: ( IN aMade aMade -> Visibility := PublicAccess aMade -> Attributes := [empty] aMade -> Operations := ( anOp .Operations .filter> ( .IsLocalMethod ! ) ) aMade -> Dependencies := [empty] aMade -> "NO_FACTORY_BRACKECTS" := true aMade ->^ cVarUserCodeName ^:= cEmptyUserCode aMade .AddMethodWithParams: cImplementationUserCodeName anOp ( IN anOp [ ' ' if ( anOp .MethodType .NotIsNil ) then begin 'Result := ' end // ( anOp .MethodType .NotIsNil ) anOp .Parent .TypeName '.' anOp .Name anOp .ParametersList ';' ] ) // aMade .AddMethodWithParams: cImplementationUserCodeName anOp ) // .DecorateMethod: ) //.join> ToArray: array:Copy >>> l_Operations end // ( l_Operations l_Name .HasModelElementWithName ! ) ) .OutRecall l_Operations end // ( Self .IsVCMApplication ) if ( Self .IsPureMixIn ) then begin >>> l_Operations l_Operations end // ( Self .IsPureMixIn ) ) >>> 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 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 ARRAY FUNCTION array:CopyWithoutDuplicates IN anArray RULES ( anArray .IsNil ) [nil] DEFAULT ( VAR l_Copy [] >>> l_Copy VAR l_Empty true >>> l_Empty anArray .filter> .AddToArray?: l_Copy .for> ( IN anElement false >>> l_Empty ) // anArray .for> RULES l_Empty [nil] DEFAULT l_Copy ; // RULES ) ; // RULES >>> Result ; // array:CopyWithoutDuplicates elem_iterator ForClassImplements Cached: ( 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 Cached: ( 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 Cached: ( ( Self .ClassImplementsPrim .joinWithLambded> ( Self .ClassImplementsPrim ) .InterfaceForClassImplements ) .filter> ( Self SWAP .SomeAncestorImplements ! ) array:CopyWithoutDuplicates ) >>> Result ; // ClassImplements INTERFACE elem_func OverrideMethod: ^ IN aLambda Self .DecorateMethod: ( IN aMethod aMethod -> OpKind := opkind_Overridden aMethod aLambda DO ) // Self .DecorateMethod: >>> Result ; // OverrideMethod: INTERFACE elem_func OverrideMethod Cached: ( Self .OverrideMethod: DROP ) >>> Result ; // OverrideMethod INTERFACE elem_func ImplementMethod: ^ IN aLambda Self .DecorateMethod: ( IN aMethod aMethod -> OpKind := opkind_Implemented aMethod aLambda DO ) // Self .DecorateMethod: >>> Result ; // ImplementMethod: INTERFACE elem_func ImplementMethod Cached: ( Self .ImplementMethod: DROP ) >>> Result ; // ImplementMethod INTERFACE FUNCTION MakeInOutParam STRING IN aName ModelElement IN aType aName aType MakeParam: ( IN aMade aMade -> Stereotype := st_inout ) >>> Result ; // MakeInOutParam 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 .IsModuleOperationPrim ) false ( ( Self .IsMethod ) AND ( Self .GetUP "is static" false ?!= ) AND ( Self .Parent .IsVCMFormsPack ) ) true ( Self .IsFormSetFactory ) true ( 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> ( IN anAncestor RULES ( anAncestor .IsPureMixIn ) true DEFAULT ( anAncestor .IsClassImplementable ) ; // RULES ) // .filter> ) 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> .AddToArray?: l_OutedIterators .filter> ( IN anItem Self .MainAncestor call.me .filter> ( anItem .IsSameModelElement ) .IsEmpty ) // .filter> .map> .ImplementMethod array:Copy ) end // ( Self .IsClassOrMixIn ) if ( Self .IsUseCaseControllerImp ) then begin .joinWithLambded> ( //Self .ImplementsEx Self .ClassImplements .filter> .IsUseCaseController ) ( .Properties .filter> ( .Name 'Ref' SWAP EndsStr ) .filter> ( .MethodType GarantModel::IvcmViewAreaControllerRef .IsSameModelElement ) ) end // ( Self .IsUseCaseControllerImp ) Self .ImplementsEx .filter> ( .OpKind opkind_DecoratedType == ) .for> ( IN aFacet VAR l_Implemented >>> l_Implemented aFacet .InterfaceOperationsTotalDeep .filter> ( l_Implemented SWAP .HasModelElement ! ) .for> ( IN anOp l_Implemented .join> ( anOp .ImplementMethod .ToArray ) // l_Implemented .join> >>> l_Implemented ) // .for> l_Implemented ) // .for> ) >>> 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 .MixInEx >>> 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 CONST opModifyArea 7 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 IsAreaGetter Self .OpModify opModifyArea == >>> Result ; // IsAreaGetter 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 BOOLEAN elem_func NeedAggregate Self .UPisTrue "need Aggregate" >>> Result ; // NeedAggregate BOOLEAN elem_func IsMakeSingleChild ( Self .Name 'MakeSingleChild' == ) >>> Result ; // IsMakeSingleChild BOOLEAN elem_func FirstParamIsViewAreaController VAR l_Params RULES ( Self .IsFactoryMethod ) ( Self .FirstOperation .Parameters ) DEFAULT ( Self .Parameters ) ; // RULES >>> l_Params RULES ( l_Params .IsEmpty ) false ( l_Params .mapToTarget> .filter> .IsViewAreaController .NotEmpty ) true DEFAULT false ; // RULES >>> Result ; // FirstParamIsViewAreaController elem_iterator PropertyKeys RULES ( Self .Parent .IsTestClass ) ( [ Self .Parent .EffectiveType .SelfParam ] .join> ( Self .Attributes ) ) DEFAULT ( Self .Attributes ) ; // RULES .filter> ( .IsControlPrim ! ) .filter> ( .IsStereotype st_after::Attribute ! ) >>> Result ; // PropertyKeys 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 ARRAY elem_func MethodParameters Cached: ( RULES ( ( Self .IsVCMOperationPrim ) OR ( Self .IsModuleOperationPrim ) ) RULES ( Self .IsTester ) ( GarantModel::IvcmTestParamsPrim .ParamsParam .ToArray ) ( Self .IsExecutor ) RULES ( Self .IsInternalOperation ) ( Self .Parameters ) DEFAULT ( GarantModel::IvcmExecuteParamsPrim .ParamsParam .ToArray ) ; // RULES ( Self .IsGetState ) ( GarantModel::TvcmOperationStateIndex .StateParam .ToArray ) ( Self .IsInternalOperation ) ( GarantModel::IvcmExecuteParams .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 .IsFactory ) AND ( Self .Parent .IsVCMForm ) ) begin RULES ( Self .IsFactoryMethod ) ( Self .FirstOperation .Parameters ) DEFAULT ( Self .Parameters ) ; // RULES if ( Self .IsMakeSingleChild ) then begin .join> [ 'aCont' GarantModel::IvcmContainer MakeParam if ( Self .NeedAggregate ) then begin 'anAgg' GarantModel::IvcmAggregate MakeParam end // ( Self .NeedAggregate ) ] // .join> end // ( Self .IsMakeSingleChild ) else begin .join> [ 'aParams' GarantModel::IvcmMakeParams MakeParam: ( IN aMade aMade -> 'extprop:pas:Value' := 'nil' ) // 'aParams' GarantModel::IvcmMakeParams MakeParam: ] // .join> end // ( Self .IsMakeSingleChild ) .join> ( ( GarantModel::TvcmEntityForm.Make call.me ) .filter> ( IN aParam RULES ( aParam .Name 'aZoneType' == ) true ( aParam .Name 'aUserType' == ) true ( aParam .Name 'aDataSource' == ) RULES ( Self .FirstParamIsViewAreaController ) false DEFAULT true ; // RULES DEFAULT false ; // RULES ) // .filter> ) // .join> array:Copy end // ( Self .IsFactory ) ( 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 ) ( Self .IsProperty ) ( Self .PropertyKeys ) DEFAULT ( Self .Parameters ) ; // RULES ) >>> Result ; // MethodParameters 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> ( ToOut \n ToOut ) [ 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> ( ToOut \n ToOut ) [ 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 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 BOOLEAN elem_func IsVCMController RULES ( Self .IsStereotype st_UseCase::Attribute ) true ( Self .IsStereotype st_VCMController ) true DEFAULT false ; // RULES >>> Result ; // IsVCMController STRING elem_func AttrName RULES ( ( Self .IsStereotype st_UseCase::Attribute ) AND ( Self .Parent .IsViewAreaControllerImp ) ) begin if ( Self .Name .NotIsNil ) then begin if ( Self .Name 'SDS' == ) then begin Self .Name end // ( Self .Name 'SDS' == ) else begin if ( Self .Target .IsUseCaseController ) then begin 'ucc_' Self .Name Cat end // ( Self .Target .IsUseCaseController ) else begin Self .Name end // ( Self .Target .IsUseCaseController ) end // ( Self .Name 'SDS' == ) end // ( Self .Name .NotIsNil ) else begin if ( Self .Target .IsUseCaseController ) then begin 'ucc_' Self .Target .TypeName Cat end // ( Self .Target .IsUseCaseController ) else begin 'ucp_' Self .Target .TypeName Cat end // ( Self .Target .IsUseCaseController ) end // ( Self .Name .NotIsNil ) end // ( Self .IsStereotype st_UseCase::Attribute ) ( Self .IsOverride ) begin VAR l_Name Self .MainAncestor call.me >>> l_Name RULES ( l_Name .IsNil ) ( Self .Name ) DEFAULT l_Name ; // RULES end // ( Self .IsOverride ) ( Self .IsVCMController ) RULES ( Self .Name .IsNil ) ( Self .Stereotype .Name '::' string:Split DROP ) DEFAULT ( Self .Name ) ; // RULES DEFAULT ( Self .Name ) ; // RULES >>> Result ; // AttrName STRING elem_func FieldName RULES ( Self .IsProperty ) ( 'f_' Self .Name Cat ) ( Self .IsVCMController ) ( Self .AttrName ) DEFAULT ( Self .Name ) ; // RULES >>> Result ; // FieldName BOOLEAN elem_func HasFieldName STRING IN aName Self .FieldName aName == >>> Result ; // HasFieldName BOOLEAN elem_func IsWrapper Self .IsStereotype st_Wrapper >>> Result ; // IsWrapper ARRAY elem_func LoadList STRING IN anExt STRING IN aFuncSuffix [empty] >>> Result VAR l_FileName Self .LUID anExt Cat >>> l_FileName l_FileName Ctx:ResolveIncludedFilePath >>> l_FileName if ( l_FileName sysutils:FileExists ) then begin STRING VAR l_Code [ 'INCLUDE ' cQuote l_FileName cQuote ' ' 'ME_' Self .LUID aFuncSuffix ] strings:Cat >>> l_Code l_Code script:CompileStringAndProcess ( DO >>> Result ) // l_Code script:CompileStringAndProcess end // ( l_FileName sysutils:FileExists ) ; // LoadList elem_iterator ImplementorsEx Cached: ( Self .Implementors .join> ( Self '.pas.ms.script.impl' '_Implementors' .LoadList ) array:Copy ) >>> Result ; // ImplementorsEx ModelElement elem_func TagAttrType //Cached: ( VAR l_Target Self .Target >>> l_Target RULES ( l_Target .Name 'String' == ) GarantModel::String ( l_Target .Name 'Long' == ) GarantModel::Integer ( l_Target .Name 'ULong' == ) GarantModel::Cardinal ( l_Target .Name 'Int64' == ) GarantModel::Int64 ( l_Target .Name 'DateTime' == ) GarantModel::TDateTime ( l_Target .Name 'DateTimeNotNull' == ) GarantModel::TDateTime ( l_Target .Name 'Bool' == ) GarantModel::Boolean ( l_Target .Name 'RawData' == ) GarantModel::Tk2RawData ( Self .IsStereotype st_array::Attribute ) begin VAR l_Implementor l_Target .ImplementorsEx .filter> .IsInterface .filter> ( .Name Self .Name 'Helper' Cat == ) .FirstElement >>> l_Implementor RULES ( l_Implementor .NotIsNil ) l_Implementor DEFAULT GarantModel::Tl3Tag ; // RULES end // ( Self .IsStereotype st_array::Attribute ) ( l_Target .IsTag ) GarantModel::Tl3Tag ( l_Target .IsAtom ) GarantModel::Tl3Tag DEFAULT l_Target ; // RULES ) >>> Result ; // TagAttrType STRING elem_func TagAttrAccessor Cached: ( RULES ( Self .Name 'String' == ) 'Str' ( Self .Name 'Long' == ) 'Int' ( Self .Name 'ULong' == ) 'Int' ( Self .Name 'Int64' == ) 'Int64' ( Self .Name 'DateTime' == ) 'DateTime' ( Self .Name 'DateTimeNotNull' == ) 'DateTime' ( Self .Name 'Bool' == ) 'Bool' ( Self .Name 'RawData' == ) 'cAtom' ( Self .IsTag ) 'Attr' ( Self .IsAtom ) 'Attr' DEFAULT 'Int' ; // RULES ) >>> Result ; // TagAttrAccessor STRING elem_func TagAttrGetType //Cached: ( VAR l_Target Self .Target >>> l_Target RULES ( l_Target .Name 'String' == ) '' ( l_Target .Name 'Long' == ) '' ( l_Target .Name 'ULong' == ) 'Cardinal' ( l_Target .Name 'Int64' == ) '' ( l_Target .Name 'DateTime' == ) '' ( l_Target .Name 'DateTimeNotNull' == ) '' ( l_Target .Name 'Bool' == ) '' ( l_Target .Name 'RawData' == ) ( GarantModel::Tk2RawData .TypeName ) ( l_Target .IsTag ) '' ( l_Target .IsAtom ) '' ( l_Target .IsSetOf ) ( [ 'k2_typ' Self .GetUP 'extprop:evd:NewTypeName' '_ToSet' ] strings:Cat ) DEFAULT ( l_Target .TypeName ) ; // RULES ) >>> Result ; // TagAttrGetType STRING elem_func TagAttrSetType //Cached: ( VAR l_Target Self .Target >>> l_Target RULES ( l_Target .Name 'String' == ) '' ( l_Target .Name 'Long' == ) '' ( l_Target .Name 'ULong' == ) 'Integer' ( l_Target .Name 'Int64' == ) '' ( l_Target .Name 'DateTime' == ) '' ( l_Target .Name 'DateTimeNotNull' == ) '' ( l_Target .Name 'Bool' == ) '' // ( l_Target .Name 'RawData' == ) // ( GarantModel::Tk2RawData .TypeName ) ( l_Target .IsTag ) '' ( l_Target .IsAtom ) '' ( l_Target .IsSetOf ) ( [ 'k2_typ' Self .GetUP 'extprop:evd:NewTypeName' '_FromSet' ] strings:Cat ) DEFAULT ( 'Ord' ) ; // RULES ) >>> Result ; // TagAttrSetType BOOLEAN elem_func IsArea Self .IsStereotype st_Area >>> Result ; // IsArea BOOLEAN elem_func IsAreaAttr Self .IsStereotype st_area::Attribute >>> Result ; // IsAreaAttr BOOLEAN elem_func IsVCMArea RULES ( Self .IsArea ) true ( Self .IsAreaAttr ) true DEFAULT false ; // RULES >>> Result ; // IsVCMArea BOOLEAN elem_func IsVCMAreaRef RULES ( Self .IsArea ) ( Self .UPisTrue "is reference" ) ( Self .IsAreaAttr ) ( Self .LinkType lt_ref == ) DEFAULT false ; // RULES >>> Result ; // IsVCMAreaRef BOOLEAN elem_func IsVCMAreaLink RULES ( Self .IsArea ) ( Self .UPisTrue "is reference" ! ) ( Self .IsAreaAttr ) ( Self .LinkType lt_ref != ) DEFAULT false ; // RULES >>> Result ; // IsVCMAreaLink elem_iterator Properties Cached: ( VAR l_Properties Self .Attributes .filter> .IsProperty .filter> ( .IsControlOverride ! ) >>> l_Properties l_Properties if ( Self .IsClassOrMixIn ) then begin RULES ( Self .IsInterfaceFactory ) () ( Self .IsWrapper ) () DEFAULT begin Self .ImplementsEx .filter> .IsTag .for> ( IN aTag aTag .Attributes .filter> ( .IsStereotype st_override::Attribute ! ) .filter> ( .IsStereotype st_default_child::Attribute ! ) .filter> ( .IsStereotype st_disabled_child::Attribute ! ) .filter> ( .IsStereotype st_children_override::Attribute ! ) .filter> ( .Stereotype st_children::Attribute ?!= ) .filter> ( .TagAttrType .NotIsNil ) .for> ( IN anAttr .join> ToArray: ( anAttr .Name anAttr .TagAttrType MakeProperty: ( IN aMade aMade -> %SUM := ( anAttr .Documentation ) aMade -> Visibility := PublicAccess aMade -> Stereotype := ( RULES ( anAttr .UPisTrue "ReadOnly" ) st_readonly::Attribute ( anAttr .IsStereotype st_array::Attribute ) st_readonly::Attribute DEFAULT st_property::Attribute ; // RULES ) // aMade -> Stereotype aMade -> Abstraction := at_final aMade -> LinkType := lt_ref aMade -> "pm" := true aMade -> "needs field" := false aMade -> "ifdef" := ( anAttr .GetUP "ifdef" ) aMade -> "ifndef" := ( anAttr .GetUP "ifndef" ) aMade ->^ cGetterVarUserCodeName ^:= cEmptyUserCode aMade .AddMethodWithParams: cGetterImplementationUserCodeName ( anAttr aMade ) ( IN anAttr IN aMade [ ' Assert(Self <> nil);' \n ' Assert(TaggedData <> nil);' \n if ( anAttr .Target .Name 'DateTimeNotNull' == ) then begin ' if not TaggedData.HasSubAtom(k2_attr' aMade .Name ') then' \n ' if not Tk2Type(TaggedData.TagType).Prop[k2_attr' aMade .Name '].ReadOnly then' \n ' begin' \n ' pm_Set' aMade .Name '(Now);' \n ' end;' '//not Tk2Type(TaggedData.TagType).Prop[k2_attr' aMade .Name '].ReadOnly then' \n end // ( anAttr .Target .Name 'DateTimeNotNull' == ) ' Result := ' if ( anAttr .IsStereotype st_array::Attribute ) then begin if ( aMade .Target GarantModel::Tl3Tag .IsSameModelElement ) then begin 'TaggedData.cAtom(k2_attr' anAttr .Name ')' end // ( aMade .Target GarantModel::Tl3Tag .IsSameModelElement ) else begin 'T' aMade .Target .TypeName '.Make(TaggedData.cAtom(k2_attr' anAttr .Name '))' end // ( aMade .Target GarantModel::Tl3Tag .IsSameModelElement ) end // ( anAttr .IsStereotype st_array::Attribute ) else begin anAttr .TagAttrGetType '(' 'TaggedData.' anAttr .Target .TagAttrAccessor if ( anAttr .Target .TagAttrAccessor 'cAtom' == ) then begin '(k2_attr' anAttr .Name ')' end // ( anAttr .Target .TagAttrAccessor 'cAtom' == ) else begin if ( anAttr .Target .TagAttrAccessor 'Attr' != ) then 'A' '[k2_attr' anAttr .Name ']' end // ( anAttr .Target .TagAttrAccessor 'cAtom' == ) ')' end // ( anAttr .IsStereotype st_array::Attribute ) ';' ] ) // aMade .AddMethodWithParams: cGetterImplementationUserCodeName ( anAttr aMade ) aMade ->^ cSetterVarUserCodeName ^:= cEmptyUserCode aMade .AddMethodWithParams: cSetterImplementationUserCodeName ( anAttr aMade ) ( IN anAttr IN aMade [ ' TaggedData.' if ( anAttr .Target .TagAttrAccessor 'cAtom' == ) then begin 'Attr' end // ( anAttr .Target .TagAttrAccessor 'cAtom' == ) else begin anAttr .Target .TagAttrAccessor end // ( anAttr .Target .TagAttrAccessor 'cAtom' == ) 'W' '[k2_attr' anAttr .Name ', nil]' ' := ' anAttr .TagAttrSetType '(' 'aValue' ')' ';' ] ) // aMade .AddMethodWithParams: cSetterImplementationUserCodeName ( anAttr aMade ) ) // anAttr .Name anAttr .TagAttrType MakeProperty: ) // .join> ToArray: ) // .for> ) // .for> end // DEFAULT ; // RULES end // ( Self .IsClassOrMixIn ) if ( Self .IsService ) then begin VAR l_Facet Self .FacetEx >>> 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 aMade ->^ cSetterVarUserCodeName ^:= cEmptyUserCode aMade .AddMethodWithParams: cSetterImplementationUserCodeName () ( [ ' Assert((f_Alien = nil) OR (aValue = nil));' \n ' f_Alien := aValue;' ] ) // aMade .AddMethodWithParams: cSetterImplementationUserCodeName ) // 'Alien' l_Facet MakeProperty: ] // .join> end // ( l_Properties 'Alien' .HasModelElementWithName ! ) end // ( l_Facet .IsNotNil ) end // ( Self .IsService ) if ( Self .IsVCMCustomForm ) then begin //if ( Self .Abstraction at_final == ) then begin .join> ( Self .OwnControls .filter> ( .IsControlOverride ! ) .filter> ( .NotInArray: l_Properties ) array:Copy ) end // ( Self .Abstraction at_final == ) end // ( Self .IsVCMCustomForm ) if ( Self .IsUseCaseController ) then begin l_Properties .filter> .IsVCMAreaRef .for> ( IN aRef .join> ToArray: ( aRef .Name 'Ref' Cat GarantModel::IvcmViewAreaControllerRef MakeProperty: ( IN aMade aMade -> UID := ( aRef .LUID 'Ref' Cat ) aMade -> Parent := ( Self .WeakRef ) aMade -> %SUM := ( [ 'Ссылка на ' '"' aRef .Documentation '"' ] strings:Cat ) aMade -> Visibility := PublicAccess aMade -> Stereotype := st_readonly::Attribute aMade -> Abstraction := at_final aMade -> LinkType := lt_lnk aMade -> "pm" := true //aMade -> "needs field" := false aMade -> "ifdef" := ( aRef .GetUP "ifdef" ) aMade -> "ifndef" := ( aRef .GetUP "ifndef" ) aMade ->^ cGetterVarUserCodeName ^:= cEmptyUserCode aMade .AddMethodWithParams: cGetterImplementationUserCodeName aMade ( IN aMade [ ' Result := SetData.' aMade .Name ';' ] ) // aMade .AddMethodWithParams: cGetterImplementationUserCodeName ) // ... MakeProperty: ) // .join> ToArray: ) // .for> end // ( Self .IsUseCaseController ) ) >>> 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 ) true 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 ! ) .filter> ( .IsStereotype st_link::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 ) if ( Self .IsUseCaseControllerImp ) then begin Self .ImplementedEx .filter> .IsVCMAreaLink .for> ( IN aProp VAR l_Name [ 'f_' aProp .Name ] strings:Cat >>> l_Name if ( l_Fields l_Name .HasModelElementWithName ! ) then begin .join> ToArray: ( l_Name GarantModel::IvcmViewAreaControllerRef MakeField: ( IN aMade aMade -> LinkType := lt_ref aMade -> Visibility := PrivateAccess aMade -> %SUM := ( [ 'Поле для области вывода ' aProp .Name ] strings:Cat ) aMade -> "ifdef" := ( aProp .GetUP "ifdef" ) aMade -> "ifndef" := ( aProp .GetUP "ifndef" ) ) // MakeField: ) // .join> ToArray: end // ( l_Fields l_Name .HasModelElementWithName ! ) ) // .for> end // ( Self .IsUseCaseControllerImp ) ) >>> Result ; // Fields BOOLEAN elem_func IsSingleton RULES ( Self .IsVCMFormSetFactory ) ( Self .Abstraction at_final == ) ( Self .IsService ) true ( Self .IsServiceImplementation ) true DEFAULT ( Self .UPisTrue "singleton" ) ; // RULES >>> 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 Cached: ( 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 ) if ( Self .IsVCMFormsPack ) then begin if ( Self .Abstraction at_final == ) then begin VAR l_Vars VAR l_ModuleName Self .Name >>> l_ModuleName elem_proc AddModuleOperationToVars Self .OperationsEx .filter> .IsModuleOperationPrim .for> ( IN anOp VAR l_Name VAR l_Type [ 'g_module_opcode_' l_ModuleName '_' anOp .Name ] strings:Cat >>> l_Name GarantModel::TvcmMOPID >>> l_Type if ( l_Vars l_Name .HasModelElementWithName ! ) then begin l_Vars .join> ToArray: ( l_Name l_Type MakeField: ( IN aMade aMade -> Visibility := PublicAccess aMade -> 'extprop:pas:Value' := '(rMoID : -1; rOpID : -1)' ) // MakeField: ) //.join> ToArray: >>> l_Vars end // ( l_Vars l_Name .HasModelElementWithName ! ) ) // .for> Self .InheritsEx .for> call.me ; // AddModuleOperationToVars >>> l_Vars Self .AddModuleOperationToVars l_Vars end // ( Self .Abstraction at_final == ) end // ( Self .IsVCMFormsPack ) ) // ( Self .IsClassOrMixIn ) ( Self .IsUtilityPack ) ( Self .Attributes .filter> ( .IsProperty ! ) .join> ( Self .InnerGlobalVars ) ) ( Self .IsVCMControls ) begin VAR l_Vars elem_proc AddOperationToVars VAR l_Name VAR l_Type [ 'opcode_' Self .Parent .Name '_' Self .Name ] strings:Cat >>> l_Name GarantModel::TvcmOPID >>> l_Type if ( l_Vars l_Name .HasModelElementWithName ! ) then begin l_Vars .join> ToArray: ( l_Name l_Type MakeField: ( IN aMade aMade -> Visibility := PublicAccess aMade -> 'extprop:pas:Value' := '(rEnID : -1; rOpID : -1)' ) // MakeField: ) //.join> ToArray: >>> l_Vars end // ( l_Vars l_Name .HasModelElementWithName ! ) ; // AddOperationToVars [empty] >>> l_Vars Self .ChildrenEx .filter> .IsVCMOperations .for> ( IN anEntity anEntity .OperationsEx .filter> .IsVCMOperation .for> ( IN anOperation anOperation .AddOperationToVars anOperation .ChildrenEx .filter> .IsVCMOperationState .for> ( IN aState l_Vars .join> ToArray: ( [ 'st_user_' anEntity .Name '_' anOperation .Name '_' aState .Name ] strings:Cat GarantModel::TvcmOperationStateIndex MakeField: ( IN aMade aMade -> Visibility := PublicAccess aMade -> 'extprop:pas:Value' := '(rID : -1)' aMade -> %SUM := ( [ anEntity .Documentation ' -> ' anOperation .Documentation ' <-> ' aState .Documentation ] strings:Cat ) aMade -> "ifdef" := ( aState .GetUP "ifdef" ) aMade -> "ifndef" := ( aState .GetUP "ifndef" ) ) // MakeField: ) // .join> ToArray: >>> l_Vars ) // .for> ) // .for> ) // .for> l_Vars end // ( Self .IsVCMControls ) 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 IsExcludeUserTypes Self .IsStereotype st_ExcludeUserTypes >>> Result ; // IsExcludeUserTypes BOOLEAN elem_func IsIncludeUserTypes Self .IsStereotype st_IncludeUserTypes >>> Result ; // IsIncludeUserTypes 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 .IsExcludeUserTypes ) false ( 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 ( Self .IsVCMFormZone ) false ( Self .IsVCMZone ) 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 //false >>> g_WasConst 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 ) false >>> g_WasConst ; // 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 STRING elem_func MethodUserCodeModifier RULES ( Self .IsAreaGetter ) 'area' ( Self .IsSetter ) 'set' ( Self .IsProperty ) 'get' ( Self .IsTester ) 'test' ( Self .IsExecutor ) 'exec' ( Self .IsGetState ) 'getstate' DEFAULT '' ; // RULES >>> Result ; // MethodUserCodeModifier 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' == ) () ( l_Key 'NeedMake_impl' == ) () DEFAULT ( Self .MethodUserCodeModifier l_Key Cat >>> l_Key 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::TAbstractTest.GetFolder .LUID == ) // GetFolder ( WithoutVar: ( 'Result := ' cQuote l_Implementor .Parent .Name cQuote ';' ) ) ( Self .LUID GarantModel::TAbstractTest.GetModelElementGUID .LUID == ) // GetModelElementGUID ( WithoutVar: ( 'Result := ' cQuote l_Implementor .LUID cQuote ';' ) ) ( Self .LUID GarantModel::TtfwInteger.GetInteger .LUID == // 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 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 ) ( ( aField .IsProperty ) AND ( aField .ParentIsInterface ) ) ( 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 ( RULES ( Self .IsStaticConstructor ) 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 ) ; // RULES 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: elem: IfDefBraceLnBefore: ^ IN aLambda VAR l_WasIf false >>> l_WasIf Self nil .IfDefPrim: ( \n l_WasIf ! ? SWAP true >>> l_WasIf ) ( aLambda DO l_WasIf ? \n ) // Self .IfDefPrim: ; // IfDefBraceLnBefore: 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 .ChildrenExPrim .filter> .IsChoices .for> ( IN aChoices aChoices .ChildrenExPrim .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 .IsFormFactory ) GarantModel::IvcmEntityForm ( ( Self .IsFactory ) AND ( Self .Parent .IsVCMForm ) ) GarantModel::IvcmEntityForm ( 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 .IsArea ) ( 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 ) nil //( 'BadFactoryType' ) ( Self .IsFactoryMethod ) ( Self .Parent .MainImplementsInterface ) DEFAULT l_Type ; // RULES end // ( l_Type .IsNil ) DEFAULT l_Type ; // RULES ) >>> Result ; // MethodType 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 .IsModuleOperationPrim ) RULES ( Self .IsTester ) ( [ //if ( Self .UPisTrue "no prefix" ! ) then 'op' Self .Name 'Test' ] strings:Cat ) ( Self .IsExecutor ) ( [ //if ( Self .UPisTrue "no prefix" ! ) then 'op' Self .Name 'Execute' ] strings:Cat ) DEFAULT ( Self .Name ) ; // RULES ( 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 ) ( 'Обработчик события' Self .Documentation StartsStr ) ( Self .Name .FromTie ) ( '_NeedMakeForm' Self .Name EndsStr ) ( Self .Name .FromTie ) ( 'GetFormCount' Self .Name EndsStr ) ( Self .Name .FromTie ) ( Self .Parent .IsUseCaseController ) ( Self .Name .FromTie ) ( Self .Parent .Parent .IsControllerInterfaces ) ( Self .Name .FromTie ) DEFAULT ( Self .FineName ) ; // RULES ) >>> Result ; // MethodName BOOLEAN elem_func NeedAfterCreate RULES ( Self .GetUP "need AfterCreate" false ?== ) false ( Self .IsFactoryMethod ) ( Self .FirstOperation .Parameters .NotEmpty ) DEFAULT ( Self .Parameters .NotEmpty ) ; // RULES >>> Result ; // NeedAfterCreate elem_proc UserCode: ^ IN aSuffix ^ IN aCode STRING VAR l_Key aSuffix DO >>> l_Key VAR l_Code Self [ cUserCodePrefix Self .MethodUserCodeModifier l_Key ] strings: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 ' 'I' Self .Parent .Name cUnderline Self .Name '_Params' '(aParams.Data' ') 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 GarantModel::TtfwWord.IsImmediate .LUID == ) // 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 .LUID GarantModel::TvcmFormSetFactoryPrim.GetInstance .LUID == ) AND ( Self .OpKind opkind_Normal != ) ) Code: ( ' Result := Self.Instance;' .Out ) ( ( '_NeedMakeForm' Self .Name EndsStr ) AND ( l_Implementor .IsVCMFormSetFactory ) ) STRING elem_func UseCaseType RULES ( Self .MainImplements .IsVCMArea ) ( Self .MainImplements .Parent .TypeName ) DEFAULT ( Self .MainImplements .TypeName ) ; // RULES >>> Result ; // UseCaseType begin Pair: ( [ 'var' \n ' l_UseCase : ' Self .Speller .UseCaseType ';' ] .Out ) ( [ ' if Supports(aDataSource, ' Self .Speller .UseCaseType ', l_UseCase) then' \n ' try' \n if ( Self .Speller .MainImplements .IsVCMArea ) then begin ' aNew := l_UseCase' '.' Self .Speller .MainImplements .Name ';' \n end // ( Self .Speller .MainImplements .IsVCMArea ) else begin HookOut: ( Indented: Indented: ( Self .Speller 'NeedMake_impl' @ cNeedsToBeImplemented .MethodUserCode ) ) // HookOut: end // ( Self .Speller .MainImplements .IsVCMArea ) ' finally' \n ' l_UseCase := nil;' \n ' end;//try..finally' \n ' Result := (aNew <> nil);' ] .Out ) end // ( '_NeedMakeForm' Self .Name EndsStr ) ( ( Self .LUID GarantModel::l3UnknownPrim.InitFields .LUID == ) AND ( Self .OpKind opkind_Normal != ) AND ( l_Implementor .IsVCMFormSetFactory ) ) Code: ( [ l_Implementor .GetUP 'extprop:pas:InitFields' // ' inherited;' \n // 'XXX' ] .Out ) ( Self .IsFactory ) begin Pair: ( RULES ( Self .Parent .IsVCMForm ) begin if ( Self .NeedAfterCreate ) then begin OutLn Indented: ( [ 'procedure AfterCreate(aForm : ' Self .Parent .TypeName ');' ] .Out 'begin' .Out ' with aForm do' .Out ' begin' .Out Indented: ( Self cImplementationUserCodeSuffix @ cNeedsToBeImplemented .MethodUserCode ) // Indented: ( ' end;//with aForm' .Out 'end;' .Out ) // Indented: OutLn 'var' .Out ' l_AC : TvcmInitProc;' .Out ' l_ACHack : Pointer absolute l_AC;' .Out end // ( Self .NeedAfterCreate ) end // ( Self .Parent .IsVCMForm ) ( Self .Parent .IsSingleton ! ) begin 'var' .Out [ ' l_Inst : ' Self .Parent .TypeName ';' ] .Out end // ( Self .Parent .IsSingleton ! ) ; // RULES ) ( RULES ( Self .Parent .IsVCMForm ) begin if ( Self .NeedAfterCreate ) then begin ' l_AC := l3LocalStub(@AfterCreate);' .Out ' try' .Out end // ( Self .NeedAfterCreate ) [ if ( Self .NeedAfterCreate ) then ' ' ' Result := inherited ' Self .MethodName '(' if ( Self .IsMakeSingleChild ) then begin 'aCont, ' if ( Self .NeedAggregate ) then begin 'vcmSetAggregate(anAgg, vcmMakeParams), ' end // ( Self .NeedAggregate ) else begin 'vcmMakeParams, ' end // ( Self .NeedAggregate ) end // ( Self .IsMakeSingleChild ) else begin 'aParams, ' end // ( Self .IsMakeSingleChild ) 'aZoneType, aUserType, nil, ' if ( Self .FirstParamIsViewAreaController ) then begin Self .MethodParameters .FirstElement .Name end // ( Self .FirstParamIsViewAreaController ) else begin 'aDataSource' end // ( Self .FirstParamIsViewAreaController ) if ( Self .NeedAfterCreate ) then begin ', ' 'vcm_utAny, l_AC' end // ( Self .NeedAfterCreate ) ')' ';' ] .Out if ( Self .NeedAfterCreate ) then begin ' finally' .Out ' l3FreeLocalStub(l_ACHack);' .Out ' end;//try..finally' .Out end // ( Self .NeedAfterCreate ) end // ( Self .Parent .IsVCMForm ) ( Self .Parent .IsSingleton ) 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 ) DEFAULT 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 ) ; // RULES ) 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 ) ( ( Self .Name 'FillStrings' == ) AND ( l_Implementor .IsSummoned ) AND ( 'Helper' l_Implementor .Name EndsStr ) ) Pair: ( [ 'var' \n ' ' 'l_Index: ' l_Implementor .SpelledFor .MainImplements .TypeName ';' ] .Out ) ( [ ' aStrings.Clear;' \n ' for l_Index := Low(l_Index) to High(l_Index) do' \n ' aStrings.Add(' l_Implementor .SpelledFor .Name '[l_Index].AsCStr);' ] .Out ) ( ( Self .Name 'DisplayNameToValue' == ) AND ( l_Implementor .IsSummoned ) AND ( 'Helper' l_Implementor .Name EndsStr ) ) Pair: ( [ 'var' \n ' ' 'l_Index: ' l_Implementor .SpelledFor .MainImplements .TypeName ';' ] .Out ) ( [ ' for l_Index := Low(l_Index) to High(l_Index) do' \n ' if l3Same(aDisplayName, ' l_Implementor .SpelledFor .Name '[l_Index].AsCStr) then' \n ' begin' \n ' Result := l_Index;' \n ' Exit;' \n ' end;//l3Same..' \n ' raise Exception.CreateFmt(''Display name "%s" not found in map "' l_Implementor .SpelledFor .Name '"'', [l3Str(aDisplayName)]);' ] .Out ) ( ( Self .Name 'MapID' == ) AND ( l_Implementor .IsSummoned ) AND ( 'ImplPrim' l_Implementor .Name EndsStr ) ) Code: ( [ ' l3FillChar(Result, SizeOf(Result));' \n ' Assert(false);' ] .Out ) ( ( Self .Name 'GetDisplayNames' == ) AND ( l_Implementor .IsSummoned ) AND ( 'ImplPrim' l_Implementor .Name EndsStr ) ) Code: ( [ ' ' l_Implementor .SpelledFor .Name 'Helper' '.FillStrings(aList);' ] .Out ) ( ( Self .Name 'MapSize' == ) AND ( l_Implementor .IsSummoned ) AND ( 'ImplPrim' l_Implementor .Name EndsStr ) ) Code: ( [ ' Result := Ord(High(' l_Implementor .SpelledFor .MainImplements .TypeName ')) - Ord(Low(' l_Implementor .SpelledFor .MainImplements .TypeName '));' ] .Out ) ( ( Self .Name 'DisplayNameToValue' == ) AND ( l_Implementor .IsSummoned ) AND ( 'ImplPrim' l_Implementor .Name EndsStr ) ) Code: ( [ ' Result := Ord(' l_Implementor .SpelledFor .Name 'Helper' '.DisplayNameToValue(aDisplayName));' ] .Out ) ( ( Self .Name 'ValueToDisplayName' == ) AND ( l_Implementor .IsSummoned ) AND ( 'ImplPrim' l_Implementor .Name EndsStr ) ) Code: ( [ ' Assert(aValue >= Ord(Low(' l_Implementor .SpelledFor .MainImplements .TypeName ')));' \n ' Assert(aValue <= Ord(High(' l_Implementor .SpelledFor .MainImplements .TypeName ')));' \n ' Result := ' l_Implementor .SpelledFor .Name '[' l_Implementor .SpelledFor .MainImplements .TypeName '(aValue)].AsCStr;' ] .Out ) ( ( Self GarantModel::vcmFormSetDataSource.ClearAreas .IsSameModelElement ) AND ( Self .OpKind opkind_Overridden == ) AND ( l_Implementor .IsUseCaseControllerImp ) ) Code: ( [ l_Implementor .ImplementedEx .filter> .IsVCMArea .for> ( IN anArea [ if ( anArea .IsVCMAreaRef ) then begin ' ' 'pm_Get' anArea .Name 'Ref' end // ( anArea .IsVCMAreaRef ) else begin ' if (f_' anArea .Name ' <> nil) then' ' f_' anArea .Name end // ( anArea .IsVCMAreaRef ) '.Referred := nil;' \n ] ) // .for> ' inherited;' ] .Out ) // Code: ( ( Self .IsVCMArea ) AND ( Self .OpKind opkind_Implemented == ) AND ( l_Implementor .IsUseCaseControllerImp ) AND ( Self .IsAreaGetter ! ) ) Pair: AsMethod ( [ if ( Self .IsVCMAreaRef ) then begin ' with ' 'pm_Get' Self .Name 'Ref' ' do' \n ' begin' \n ' if IsEmpty' \n HookOut: ( Indented: Indented: ( Self '_need' @ '// - условие создания ViewArea' .MethodUserCode ) ) // HookOut: ' then' \n ' ' 'Referred := ' 'DoGet_' Self .Name Self .ParametersList ';' \n ' Result := ' Self .MethodType .TypeName '(' 'Referred' ');' \n ' end;// with ' 'pm_Get' Self .Name 'Ref' end // ( Self .IsVCMAreaRef ) else begin ' if (f_' Self .Name ' = nil) then' \n ' begin' \n ' f_' Self .Name ' := TvcmViewAreaControllerRef.Make;' \n HookOut: ( Indented: Indented: ( Self '_init' @ '// - код инициализации ссылки на ViewArea' .MethodUserCode ) ) // HookOut: ' end;//' 'f_' Self .Name ' = nil' \n if ( Self .MethodParameters .NotEmpty ) then begin ' if (f_' Self .Name '.NeedMake = vcm_nmNo) and ' Self .MethodParameters .FirstElement .Name ' then' \n ' f_' Self .Name '.NeedMake := vcm_nmYes;' \n end // ( Self .MethodParameters .NotEmpty ) ' if f_' Self .Name '.IsEmpty' \n HookOut: ( Indented: Indented: ( Self '_need' @ '// - условие создания ViewArea' .MethodUserCode ) ) // HookOut: ' then' \n ' f_' Self .Name '.Referred := ' 'DoGet_' Self .Name Self .ParametersList ';' \n ' Result := ' Self .MethodType .TypeName '(' 'f_' Self .Name '.Referred' ');' end // ( Self .IsVCMAreaRef ) ] .Out ) // Pair: ( '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 ( Self .IsVCMFormZone ) AsDefault ( Self .IsVCMZone ) 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> ( .UnitName .AddToArray?: l_Used ) >>> 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" ) OR ( ( aUCPrefix 'impl_uses' == ) AND ( ( ( Self .IsVCMForm ) AND ( Self .Abstraction at_final != ) ) OR ( ( Self .IsVCMFormsPack ) AND ( Self .Abstraction at_final != ) ) OR ( ( Self .IsVCMApplication ) //AND ( Self .Abstraction at_final != ) ) OR ( Self .Name 'nsMainMenuNew' == ) OR ( Self .Name 'nsPostingsLine' == ) ) ) ) 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 ) .join> ( anArray .map> .AttrType ) >>> 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 .ChildrenExPrim >>> 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> .IsVCMCustomForm .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 .AllControls .filter> ( .IsControlOverride ! ) .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 .IsVCMCustomForm ) 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 .IsVCMCustomForm ) if ( Self .IsUserType ) then begin VAR l_ClassName [ 'Tkw_FormUserType_' Self .Name ] strings:Cat >>> l_ClassName if ( l_Children l_ClassName .HasModelElementWithName ! ) then begin l_Children .join> ToArray: ( l_ClassName GarantModel::TtfwInteger MakeClass: ( IN aMade aMade -> UID := ( [ Self .LUID '_Word' ] strings:Cat ) aMade -> Parent := ( Self .WeakRef ) aMade -> "NameForScript" := ( [ 'тип_формы::' Self .Name ' ' '_' string:Replace ] strings:Cat ) // aMade -> "NameForScript" aMade -> %SUM := ( [ 'Слово словаря для типа формы ' Self .Name ] strings:Cat ) // aMade -> %SUM aMade -> Visibility := PrivateAccess aMade -> Abstraction := at_final aMade -> Stereotype := st_ScriptKeyword aMade -> "ifndef" := 'NoScripts' aMade -> IsSummoned := true aMade -> Overridden := [ GarantModel::TtfwInteger.GetInteger .OverrideMethod ] // aMade -> Overridden ) // MakeClass: ) // .join> ToArray: array:Copy >>> l_Children end // ( l_Children l_ClassName .HasModelElementWithName ! ) end // ( Self .IsUserType ) 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 .AddMethodWithParams: ( cUserCodePrefix 'impl' Cat ) aMade ( IN aMade [ cOpenComment '$R ' aMade .EffectiveUnitName '.res' cCloseComment ] ) // aMade .AddMethodWithParams: ( cUserCodePrefix 'impl' Cat ) aMade aMade -> Operations := [ 'RegAxiom' MakeIniProcedure: ( IN aMadeIni aMadeIni -> %SUM := 'Регистрация скриптованой аксиоматики' aMadeIni .AddMethodWithParams: cUserCodePrefix aMade .RegAxiomUC ) // MakeIniProcedure: ] // aMade -> Operations aMade -> Implemented := [ GarantModel::TtfwAxiomaticsResNameGetter.ResName .ImplementMethod: ( IN aMethod aMethod ->^ cVarUserCodeName ^:= cEmptyUserCode aMethod .AddMethodWithParams: cImplementationUserCodeName aMade ( IN aMade [ ' Result := ' cQuote aMade .EffectiveUnitName cQuote ';' ] ) // aMethod .AddMethodWithParams: cImplementationUserCodeName aMade ) // GarantModel::TtfwAxiomaticsResNameGetter.ResName .ImplementMethod: ] // aMade -> Implemented ) // l_ClassName GarantModel::TtfwAxiomaticsResNameGetter MakeClass: ] // .join> end // ( l_Children l_ClassName .HasModelElementWithName ! ) end // ( Self .NeedsScript ) if ( Self .IsVCMControls ) then begin l_Children .filter> .IsVCMOperations .for> ( IN anEntity anEntity .OperationsEx .filter> .IsVCMOperation .filter> .IsInternalOperation .for> ( IN anOperation VAR l_ParamsFacet nil >>> l_ParamsFacet VAR l_ParamsClass nil >>> l_ParamsClass if ( ( anOperation .Parameters .NotEmpty ) OR ( anOperation .Target .NotIsNil ) ) then begin .join> ToArray: ( [ 'I' anEntity .Name '_' anOperation .Name '_Params' ] strings:Cat nil MakeFacet: ( IN aMade aMade -> UID := ( [ Self .LUID '_Params' ] strings:Cat ) aMade -> %SUM := ( [ 'Параметры для операции ' anEntity .Name '.' anOperation .Name ] strings:Cat ) aMade -> Parent := ( anOperation .WeakRef ) aMade -> Visibility := PublicAccess aMade -> Attributes := [ elem_proc TuneProp Self -> Visibility := PublicAccess Self -> Parent := ( aMade .WeakRef ) Self -> "needs field" := true Self -> Stereotype := st_property::Attribute Self ->^ cGetterVarUserCodeName ^:= cEmptyUserCode Self ->^ cSetterVarUserCodeName ^:= cEmptyUserCode Self ->^ cGetterImplementationUserCodeName ^:= [ ' Result := ' 'f_' Self .Name ';' ] Self ->^ cSetterImplementationUserCodeName ^:= [ ' ' 'f_' Self .Name ' := ' 'aValue' ';' ] ; // TuneProp anOperation .Parameters .for> ( IN aParam aParam .Name 'a' .CutPrefix aParam .Target MakeProperty: ( IN aProp aProp .TuneProp RULES ( aParam .IsStereotype st_in ) ( aProp -> Stereotype := st_readonly::Attribute ) ; // RULES ) // MakeProperty: ) // .for> if ( anOperation .Target .NotIsNil ) then begin 'ResultValue' anOperation .Target MakeProperty: ( IN aProp aProp .TuneProp ) // MakeProperty: end // ( anOperation .Target .NotIsNil ) ] // aMade -> Attributes ) // MakeFacet: >>> l_ParamsFacet l_ParamsFacet ) // .join> ToArray: .join> ToArray: ( [ 'T' anEntity .Name '_' anOperation .Name '_Params' ] strings:Cat GarantModel::Tl3CProtoObject MakeClass: ( IN aMade aMade -> %SUM := ( [ 'Реализация ' l_ParamsFacet .Name ] strings:Cat ) aMade -> Parent := ( anOperation .WeakRef ) aMade -> Visibility := PrivateAccess aMade -> Stereotype := st_SimpleClass aMade -> Implements := [ l_ParamsFacet ] aMade -> Implemented := ( l_ParamsFacet -> Attributes ) aMade -> Operations := [ if ( anOperation .Parameters .NotEmpty ) then begin 'Create' MakeProcedure: ( IN aConstructor aConstructor -> Parent := ( aMade .WeakRef ) aConstructor -> Visibility := PublicAccess aConstructor -> Stereotype := st_ctor::Operation aConstructor -> Parameters := ( anOperation .Parameters ) aConstructor ->^ cVarUserCodeName ^:= cEmptyUserCode aConstructor ->^ cImplementationUserCodeName ^:= [ ' inherited Create;' aConstructor .Parameters .for> ( IN aParam \n ' ' 'f_' aParam .Name 'a' .CutPrefix ' := ' aParam .Name ';' ) // for> ] // aConstructor ->^ cImplementationUserCodeName ) // MakeProcedure: end // ( anOperation .Parameters .NotEmpty ) 'Make' l_ParamsFacet MakeFunction: ( IN aConstructor aConstructor -> Parent := ( aMade .WeakRef ) aConstructor -> Visibility := PublicAccess aConstructor -> Stereotype := st_factory::Operation aConstructor -> Parameters := ( anOperation .Parameters ) ) // MakeFunction: ] // aMade -> Operations ) // MakeClass: >>> l_ParamsClass l_ParamsClass ) // .join> ToArray: end // ( anOperation .Parameters .NotEmpty ) .join> ToArray: ( [ 'Op_' anEntity .Name '_' anOperation .Name ] strings:Cat nil MakeClass: ( IN aMade aMade -> %SUM := ( [ 'Класс для вызова операции ' anEntity .Name '.' anOperation .Name ] strings:Cat ) aMade -> Parent := ( anOperation .WeakRef ) aMade -> Visibility := PublicAccess aMade -> Stereotype := st_SimpleClass aMade -> Operations := [ : MakeCallPrimPrim: IN aType IN aTargetType IN aDocSuffix ^ IN aLambda if ( aTargetType .NotIsNil ) then 'Call' else 'Broadcast' aType MakeFunction: ( IN aFunc aFunc -> %SUM := ( [ 'Вызов операции ' anEntity .Name '.' anOperation .Name ' ' aDocSuffix ] strings:Cat ) aFunc -> Stereotype := st_static::Operation aFunc -> Visibility := PublicAccess aFunc -> Abstraction := at_final aFunc -> Parameters := ( if ( aTargetType .NotIsNil ) then begin [ 'aTarget' aTargetType MakeParam ] .join> ( anOperation .Parameters ) end // ( aTargetType .NotIsNil ) else begin anOperation .Parameters end // ( aTargetType .NotIsNil ) ) // aFunc -> Parameters aFunc -> UsedElements := [ GarantModel::l3Base GarantModel::vcmBase ] // aFunc -> UsedElements aFunc aLambda DO ) // MakeFunction: ; // MakeCallPrimPrim: : MakeCallPrim: IN aTargetType IN aDocSuffix ^ IN aLambda if ( anOperation .Target .IsNil ) then GarantModel::Boolean else ( anOperation .Target ) aTargetType aDocSuffix MakeCallPrimPrim: ( IN aFunc aFunc aLambda DO ) // MakeCallPrimPrim: ; // MakeCallPrim : MakeCall IN aTargetType IN aDocSuffix aTargetType aDocSuffix MakeCallPrim: ( IN aFunc aFunc ->^ cVarUserCodeName ^:= [ 'var' \n ' l_Params : IvcmExecuteParams;' ] aFunc ->^ cImplementationUserCodeName ^:= [ ' l3FillChar(Result, SizeOf(Result));' \n ' if (aTarget <> nil) then' \n ' begin' \n ' l_Params := ' if ( l_ParamsFacet .IsNil ) then 'vcmParams' else begin 'TvcmExecuteParams.MakeForInternal' '(' l_ParamsClass .TypeName '.Make' anOperation .Parameters .map> .Name .CommaListWith() ')' end // ( l_ParamsFacet .IsNil ) ';' \n ' aTarget.Operation(opcode_' anEntity .Name '_' anOperation .Name ', l_Params);' \n ' with l_Params do' \n ' begin' \n ' if Done then' \n ' begin' \n ' ' 'Result := ' if ( anOperation .Target .IsNil ) then 'true' else begin l_ParamsFacet .TypeName '(Data).ResultValue' end // ( anOperation .Target .IsNil ) ';' \n ' end;//Done' \n ' end;//with l_Params' \n ' end;//aTarget <> nil' ] // aFunc ->^ cImplementationUserCodeName // aFunc -> UsedElements := ( // aFunc -> UsedElements // .join> ToArray: GarantModel::StdRes // ) // aFunc -> UsedElements ) // MakeCallPrim: ; // MakeCall GarantModel::IvcmEntity 'у сущности' MakeCall GarantModel::IvcmAggregate 'у агрегации' MakeCall GarantModel::IvcmEntityForm 'у формы' MakeCallPrim: ( IN aFunc aFunc ->^ cVarUserCodeName ^:= cEmptyUserCode aFunc ->^ cImplementationUserCodeName ^:= [ ' l3FillChar(Result, SizeOf(Result));' \n ' if (aTarget <> nil) then' \n ' Result := Call(aTarget.Entity' if ( anOperation .Parameters .NotEmpty ) then begin ', ' anOperation .Parameters .map> .Name .CommaList end // ( anOperation .Parameters .NotEmpty ) ')' ';' ] // aFunc ->^ cImplementationUserCodeName ) // MakeCallPrim: GarantModel::IvcmContainer 'у контейнера' MakeCallPrim: ( IN aFunc aFunc ->^ cVarUserCodeName ^:= cEmptyUserCode aFunc ->^ cImplementationUserCodeName ^:= [ ' l3FillChar(Result, SizeOf(Result));' \n ' if (aTarget <> nil) then' \n ' Result := Call(aTarget.AsForm' if ( anOperation .Parameters .NotEmpty ) then begin ', ' anOperation .Parameters .map> .Name .CommaList end // ( anOperation .Parameters .NotEmpty ) ')' ';' ] // aFunc ->^ cImplementationUserCodeName ) // MakeCallPrim: if ( ( anOperation .Target .IsNil ) AND ( anOperation .UPisTrue "Needs Broadcast" ) ) then begin nil nil 'у всех зарегистрированных сущностей' MakeCallPrimPrim: ( IN aFunc aFunc ->^ cVarUserCodeName ^:= [ 'var' \n ' l_Params : IvcmExecuteParams;' ] aFunc ->^ cImplementationUserCodeName ^:= [ ' if (vcmDispatcher <> nil) then' \n ' begin' \n ' l_Params := ' if ( l_ParamsFacet .IsNil ) then 'vcmParams' else begin 'TvcmExecuteParams.MakeForInternal' '(' l_ParamsClass .TypeName '.Make' anOperation .Parameters .map> .Name .CommaListWith() ')' end // ( l_ParamsFacet .IsNil ) ';' \n ' vcmDispatcher.EntityOperationBroadcast(opcode_' anEntity .Name '_' anOperation .Name ', l_Params);' \n ' end//vcmDispatcher <> nil' ] // aFunc ->^ cImplementationUserCodeName // aFunc -> UsedElements := ( // aFunc -> UsedElements // .join> ToArray: GarantModel::StdRes // ) // aFunc -> UsedElements ) // MakeCallPrimPrim: end ] // aMade -> Operations := ) // MakeClass: ) // .join> ToArray: ) // .for> ) // .for> end // ( Self .IsVCMControls ) .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 if ( aValue .NotIsNil ) then begin aMade -> 'extprop:pas:Value' := aValue end // ( aValue .NotIsNil ) aMade aLambda DO ) >>> Result ; // MakeConstant: ModelElement elem_func ElementOrParentThatCanHaveIniOperations RULES ( Self .IsClassOrMixIn ) Self ( Self .IsUtilityPack ) Self ( Self .IsUserType ) Self ( Self .Parent .IsNil ) nil DEFAULT ( Self .Parent call.me ) ; // RULES >>> Result ; // ElementOrParentThatCanHaveIniOperations elem_iterator ConstantsEx Cached: ( VAR l_Constants Self .Constants >>> l_Constants l_Constants RULES ( Self .IsLocalConst ) begin VAR l_ConstantsName [ 'LCImpl' if ( Self .IsChoices ) then begin '_' Self .Parent .Name '_' end // ( Self .IsChoices ) Self .Name ] strings:Cat >>> l_ConstantsName if ( Self .ElementOrParentThatCanHaveIniOperations call.me l_ConstantsName .HasModelElementWithName ! ) then begin .join> ToArray: ( l_ConstantsName MakeConstants: ( IN aConstants if ( Self .IsChoices ) then begin aConstants -> %SUM := ( [ 'Варианты выбора для диалога ' Self .Parent .Name ] strings:Cat ) end // ( Self .IsChoices ) else begin aConstants -> %SUM := ( [ 'Локализуемые строки ' Self .Name ] strings:Cat ) end // ( Self .IsChoices ) aConstants -> Visibility := ( Self .Visibility ) aConstants -> Speller := ( Self .WeakRef ) aConstants -> Parent := ( Self .WeakRef ) aConstants -> "ifdef" := ( Self .GetUP "ifdef" ) aConstants -> "ifndef" := ( Self .GetUP "ifndef" ) aConstants -> "children prefix" := ( Self .GetUP "children prefix" ) aConstants -> "elements prefix" := ( [ 'str_' Self .GetUP "elements prefix" ] strings:Cat ) aConstants -> Attributes := [ Self .Attributes .join> ( Self .ChildrenEx ) .for> ( IN anItem STRING FUNCTION ItemValue anItem .GetUP 'Value' >>> Result if ( Result .IsNil ) then begin anItem .GetUP "Value" >>> Result end // ( Result .IsNil ) if ( Result .IsNil ) then begin anItem .GetUP 'extprop:pas:Value' >>> Result end // ( Result .IsNil ) if ( Result .IsNil ) then begin anItem .Documentation >>> Result end // ( Result .IsNil ) Result '\\"' '"' string:Replace >>> Result Result '\\' '\' string:Replace >>> Result ; // ItemValue VAR l_Name [ Self .GetUP 'extprop:pas:ElementPrefix' if ( anItem .IsChoice ) then begin Self .Parent .Name '_Choice_' end // ( anItem .IsChoice ) anItem .Name ] strings:Cat >>> l_Name [ 'str_' l_Name ] strings:Cat [ '(' 'rS : -1;' ' rLocalized : false;' ' rKey : ' cQuote l_Name cQuote ';' ' rValue : ' ItemValue ')' ] strings:Cat MakeConstant: ( IN aConstant if ( anItem .IsMessage ) then begin aConstant -> Target := GarantModel::Tl3MessageID end // ( anItem .IsMessage ) else begin aConstant -> Target := GarantModel::Tl3StringIDEx end // ( anItem .IsMessage ) aConstant -> Visibility := ( anItem .Visibility ) aConstant -> Speller := ( anItem .WeakRef ) aConstant -> %SUM := ( if ( anItem .Documentation .IsNil ) then begin ItemValue end // ( anItem .Documentation .IsNil ) else begin anItem .Documentation end // ( anItem .Documentation .IsNil ) ) // aConstant -> %SUM aConstant -> "ifdef" := ( anItem .GetUP "ifdef" ) aConstant -> "ifndef" := ( anItem .GetUP "ifndef" ) ) // MakeConstant: ) // .for> ] // aConstants -> Attributes ) // l_ConstantsName MakeConstants: ) // .join> ToArray: end // end // ( Self .IsLocalConst ) ( 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 ) ( Self .IsVCMFormDefinition ) begin VAR l_PublishedForms [] >>> l_PublishedForms Self .ImplementorsEx .filter> .IsVCMForm .for> ( IN aForm VAR l_ConstantsName [ aForm .Name 'IDs' ] strings:Cat >>> l_ConstantsName if ( l_Constants l_ConstantsName .HasModelElementWithName ! ) then begin VAR l_Name [ 'fm_' aForm .TypeName 'T' .CutPrefix ] strings:Cat >>> l_Name if ( l_Name .AddToArray?: l_PublishedForms ) then begin .join> ToArray: ( l_ConstantsName MakeConstants: ( IN aConstants aConstants -> Visibility := PublicAccess aConstants -> Attributes := [ l_Name [ '(rFormID : (rName : ' cQuote aForm .TypeName 'T' .CutPrefix cQuote '; rID : 0); rFactory : nil)' ] strings:Cat MakeConstant: ( IN aConstant aConstant -> Visibility := PublicAccess aConstant -> %SUM := ( [ 'Идентификатор формы ' aForm .TypeName ] strings:Cat ) aConstant -> Target := GarantModel::TvcmFormDescriptor ) // MakeConstant: ] // aConstants -> Attributes ) // l_ConstantsName MakeConstants: ) // .join> ToArray: end // ( l_Name .AddToArray?: l_PublishedForms ) end // ( l_Constants l_ConstantsName .HasModelElementWithName ! ) ) // .for> end // ( Self .IsVCMFormDefinition ) ( Self .IsUserType ) begin VAR l_ConstantsName [ Self .Name 'Constants' ] strings:Cat >>> l_ConstantsName if ( l_Constants l_ConstantsName .HasModelElementWithName ! ) then begin .join> ToArray: ( l_ConstantsName MakeConstants: ( IN aConstants aConstants -> %SUM := ( [ 'Константы для типа формы ' Self .Name ] strings:Cat ) aConstants -> Visibility := PublicAccess aConstants -> Attributes := [ [ Self .Name 'Name' ] strings:Cat nil MakeConstant: ( IN aConstant aConstant -> Visibility := PublicAccess aConstant -> %SUM := ( [ 'Строковый идентификатор пользовательского типа "' Self .Documentation '"' ] strings:Cat ) aConstant -> Value := ( [ cQuote Self .Name cQuote ] strings:Cat ) ) // MakeConstant: Self .Name if ( Self .MainAncestor .IsNil ) then begin 'TvcmUserType(0)' end // ( Self .MainAncestor .IsNil ) else begin [ 'TvcmUserType(' Self .MainAncestor .Name ' + 1)' ] strings:Cat end // ( Self .MainAncestor .IsNil ) MakeConstant: ( IN aConstant aConstant -> Visibility := PublicAccess aConstant -> Target := GarantModel::TvcmUserType aConstant -> %SUM := ( Self .Documentation ) aConstant -> "is define" := true aConstant -> "no unit prefix" := true ) // MakeConstant: ] // aConstants -> Attributes ) // l_ConstantsName MakeConstants: ) // .join> ToArray: end // ( l_Constants l_ConstantsName .HasModelElementWithName ! ) [ Self .Name 'LocalConstants' ] strings:Cat >>> l_ConstantsName if ( l_Constants l_ConstantsName .HasModelElementWithName ! ) then begin .join> ToArray: ( l_ConstantsName MakeConstants: ( IN aConstants aConstants -> %SUM := ( [ 'Локализуемые константы для типа формы ' Self .Name ] strings:Cat ) aConstants -> Stereotype := st_LocalConst aConstants -> Visibility := PublicAccess aConstants -> Attributes := [ [ Self .Name 'Caption' ] strings:Cat [ cQuote Self .Documentation cQuote ] strings:Cat MakeConstant: ( IN aConstant aConstant -> Visibility := PublicAccess aConstant -> %SUM := ( [ 'Заголовок пользовательского типа "' Self .Documentation '"' ] strings:Cat ) ) // MakeConstant: if ( Self .GetUP "SettingsCaption" .NotIsNil ) then begin [ Self .Name 'SettingsCaption' ] strings:Cat [ cQuote Self .GetUP "SettingsCaption" cQuote ] strings:Cat MakeConstant: ( IN aConstant aConstant -> Visibility := PublicAccess aConstant -> %SUM := ( [ 'Заголовок пользовательского типа "' Self .Documentation '"' ' для настройки панелей инструментов' ] strings:Cat ) ) // MakeConstant: end // ( Self .GetUP "SettingsCaption" .NotIsNil ) ] // aConstants -> Attributes ) // l_ConstantsName MakeConstants: ) // .join> ToArray: end // ( l_Constants l_ConstantsName .HasModelElementWithName ! ) end // ( Self .IsUserType ) ( Self .IsVCMControls ) begin RULES ( Self .ChildrenEx .filter> .IsVCMOperations .NotEmpty ) begin VAR l_PublishedEntities [] >>> l_PublishedEntities VAR l_PublishedOperations [] >>> l_PublishedOperations .join> ToArray: ( 'EntitiesConsts' MakeConstants: ( IN aConstants aConstants -> Visibility := ProtectedAccess aConstants -> Parent := ( Self .WeakRef ) aConstants -> Attributes := [ Self .ChildrenEx .filter> .IsVCMOperations .for> ( IN anEntity VAR l_Name anEntity .Name >>> l_Name if ( l_Name .AddToArray?: l_PublishedEntities ) then begin [ 'en_' l_Name ] strings:Cat if ( l_Name anEntity .MainAncestor .Name == ) then begin [ anEntity .MainAncestor .EffectiveUnitName '.' 'en_' l_Name ] strings:Cat end else begin [ cQuote l_Name cQuote ] strings:Cat end MakeConstant: ( IN aConstant aConstant -> Visibility := PublicAccess aConstant -> Parent := ( aConstants .WeakRef ) ) // MakeConstant: [ 'en_cap' l_Name ] strings:Cat if ( l_Name anEntity .MainAncestor .Name == ) then begin [ anEntity .MainAncestor .EffectiveUnitName '.' 'en_cap' l_Name ] strings:Cat end else begin [ cQuote anEntity .Documentation \n cSpace string:Replace cQuote ] strings:Cat end MakeConstant: ( IN aConstant aConstant -> Visibility := PublicAccess aConstant -> Parent := ( aConstants .WeakRef ) ) // MakeConstant: end // ( l_Name .AddToArray?: l_PublishedEntities ) anEntity .OperationsEx .filter> .IsVCMOperation .for> ( IN anOperation if ( anOperation .Name .AddToArray?: l_PublishedOperations ) then begin [ 'op_' anOperation .Name ] strings:Cat [ cQuote anOperation .Name cQuote ] strings:Cat MakeConstant: ( IN aConstant aConstant -> Visibility := PublicAccess aConstant -> Parent := ( aConstants .WeakRef ) ) // MakeConstant: [ 'op_cap' anOperation .Name ] strings:Cat [ cQuote anOperation .Documentation \n cSpace string:Replace cQuote ] strings:Cat MakeConstant: ( IN aConstant aConstant -> Visibility := PublicAccess aConstant -> Parent := ( aConstants .WeakRef ) ) // MakeConstant: end // ( anOperation .Name .AddToArray?: l_PublishedOperations ) ) // .for> ) // .for> ] // aConstants -> Attributes ) // 'EntitiesConsts' MakeConstants: ) // join> ToArray: end // .IsVCMOperations .NotEmpty ; // RULES end // ( Self .IsVCMControls ) ; // 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 .join> ( Self .Properties ) .join> ( Self .Fields ) array:CopyWithoutDuplicates .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 elem_func NeedsInitEntities Self .UPisTrue 'extprop:NeedsInitEntities' >>> Result ; // NeedsInitEntities BOOLEAN elem_func HasAnyVCMController Cached: ( //Self .Children //.join> ( Self .Attributes ) Self .Attributes .filter> .IsVCMController .NotEmpty //Self .UPisTrue 'extprop:HasAnyVCMController' ) >>> Result ; // HasAnyVCMController elem_iterator UserTypes Self .ChildrenEx .filter> .IsUserType >>> Result ; // UserTypes BOOLEAN elem_func NeedsMakeControls Cached: ( Self .UserTypes .join> ( Self .OwnControls ) // .join> .NotEmpty ) >>> Result ; // NeedsMakeControls /*{ // Реализует ли хоть одну операцию VCM %f _ImplementsSomeVCMOperation // возвращаемый результат: boolean @ %SU [{<{}{%R#f_IsVCMOperations()=true}{C}>!=0}{\ %f_set_var(RESULT,"false")\ <{}{%O#f_IsVCMOperation()=true}\ [{"%O{ShowInContextMenu}"!=""|%O{ShowInContextMenu}!=undefined|"%O{ContextMenuWeight}"!=""|"%O{ShowInToolbar}"!=""|%O{ShowInToolbar}!=undefined}\ %f_set_var(RESULT,"true")\ %f_cycle_break(%S)\ ]\ >\ [{%{RESULT}N!=true}\ <{}{%C#f_IsControl()=true}{%C}\ [{%C<{}{%R#f_IsVCMOperations()=true}{C}>!=0}\ %f_set_var(RESULT,"true")\ %f_cycle_break(%S)\ ]\ >\ ]\ %{RESULT}N\ }\ true\ ] }*/ BOOLEAN elem_func ImplementsSomeVCMOperation Cached: ( RULES ( Self .ImplementsEx .filter> .IsVCMOperations .NotEmpty ) true ( Self .ImplementedEx .join> ( Self .Overridden ) .filter> .IsVCMOperation .NotEmpty ) true DEFAULT false ; // RULES ) >>> Result ; // ImplementsSomeVCMOperation elem: AsExecuteDo: ^ IN aLambda Self .DecorateMethodAndDo: ( IN aMethod aMethod -> OpModify := opModifyExecute aMethod aLambda DO ) // Self .DecorateMethodAndDo: ; // AsExecuteDo: elem: AsAreaDo: ^ IN aLambda Self .DecorateMethodAndDo: ( IN aMethod aMethod -> OpModify := opModifyArea aMethod aLambda DO ) // Self .DecorateMethodAndDo: ; // AsAreaDo: elem: AsTestDo: ^ IN aLambda Self .DecorateMethodAndDo: ( IN aMethod aMethod -> OpModify := opModifyTest aMethod aLambda DO ) // Self .DecorateMethodAndDo: ; // AsTestDo: elem: AsGetStateDo: ^ IN aLambda Self .DecorateMethodAndDo: ( IN aMethod aMethod -> OpModify := opModifyGetState aMethod aLambda DO ) // Self .DecorateMethodAndDo: ; // AsGetStateDo: elem_iterator AllUserTypes Cached: ( Self .UserTypes .joinWithLambded> ( Self .InheritsEx ) call.me .joinWithLambded> ( Self .ImplementsEx ) call.me ) >>> Result ; // AllUserTypes BOOLEAN elem_func HasStates Self .UPisTrue "has states" >>> Result ; // HasStates BOOLEAN FUNCTION .IsIntEx IN Self RULES ( Self IsInt ) true ( Self IsString ) RULES ( '-' Self StartsStr ) true DEFAULT false ; // RULES DEFAULT false ; // RULES >>> Result ; // .IsIntEx elem_iterator InitEntitiesUC [ ' inherited;' elem: EntityNamePrim 'en_' Self .Name ; // EntityNamePrim elem: EntityName Self .EntityNamePrim ', ' ; // EntityName elem: OperationFullName Self .Parent .EntityName 'op_' Self .Name ', ' ; // OperationFullName if ( Self .ImplementsSomeVCMOperation ) then begin [ \n ' with Entities.Entities do' \n ] [ ' begin' ] VAR l_PublishedEntities [] >>> l_PublishedEntities STRING elem_func OnGetTarget IN anEntity VAR l_Implementor Self .Operations .filter> ( .Implements .filter> ( anEntity .IsSameModelElement ) .NotEmpty ) .FirstElement >>> l_Implementor RULES ( l_Implementor .NotIsNil ) ( l_Implementor .MethodName ) DEFAULT 'nil' ; // RULES >>> Result ; // OnGetTarget elem: PublishFormEntity IN anEntity anEntity .IfDefBraceLnBefore: [ \n ' PublishFormEntity(' anEntity .EntityName Self anEntity .OnGetTarget ');' ] ; // PublishFormEntity Self .ImplementsEx .filter> .IsVCMOperations .filter> ( .Name .AddToArray?: l_PublishedEntities ) .for> ( IN anEntity Self anEntity .PublishFormEntity ) // .for> Self .Dependencies .filter> .IsStereotype st_GroupItemsInContextMenu::Dependency .filter> ( .Target .IsVCMOperations ) .for> ( IN aDep [ \n ' GroupItemsInContextMenu(' aDep .Target .EntityNamePrim ');' ] ) // .for> Self .Dependencies .filter> .IsStereotype st_ToolbarAtBottom::Dependency .filter> ( .Target .IsVCMOperations ) .for> ( IN aDep [ \n ' ToolbarAtBottom(' aDep .Target .EntityNamePrim ');' ] ) // .for> Self .Dependencies .filter> .IsStereotype st_ContextMenuWeight::Dependency .filter> ( .Target .IsVCMOperations ) .filter> ( .GetUP "Value" .IsIntEx ) .for> ( IN aDep [ \n ' ContextMenuWeight(' aDep .Target .EntityName aDep .GetUP "Value" ');' ] ) // .for> Self .OwnControls .for> ( IN aControl aControl .ImplementsEx .filter> .IsVCMOperations .filter> ( .Name .AddToArray?: l_PublishedEntities ) .for> ( IN anEntity Self anEntity .PublishFormEntity ) // .for> aControl .ImplementsEx .filter> .IsVCMOperations .for> ( IN anEntity [ \n ' MakeEntitySupportedByControl(' anEntity .EntityName aControl .Name ');' ] ) // .for> ) // .for> STRING elem_func PrefixParam if ( Self .UPisTrue "no prefix" ) then ', true' else '' >>> Result ; // PrefixParam elem: OperationOptions if ( Self .GetUP "ShowInContextMenu" IsBool ) then begin [ \n ' ShowInContextMenu(' Self .OperationFullName Self .GetUP "ShowInContextMenu" Self .PrefixParam ');' ] end // ( Self .GetUP "ShowInContextMenu" IsBool ) if ( Self .GetUP "ShowInToolbar" IsBool ) then begin [ \n ' ShowInToolbar(' Self .OperationFullName Self .GetUP "ShowInToolbar" Self .PrefixParam ');' ] end // ( Self .GetUP "ShowInToolbar" IsBool ) if ( Self .GetUP "ContextMenuWeight" .IsIntEx ) then begin [ \n ' ContextMenuWeight(' Self .OperationFullName Self .GetUP "ContextMenuWeight" Self .PrefixParam ');' ] end // ( Self .GetUP "ContextMenuWeight" .IsIntEx ) ; // OperationOptions VAR l_PublishedOperations [] >>> l_PublishedOperations Self .ImplementedEx .filter> .IsVCMOperation .filter> ( IN anOperation anOperation .Parent .Name anOperation .Name Cat .AddToArray?: l_PublishedOperations ) .for> ( IN anOperation anOperation .IfDefBraceLnBefore: [ \n ' ' if ( anOperation .IsInternalOperation ) then 'PublishOpWithResult' else 'PublishOp' '(' anOperation .OperationFullName if ( ( anOperation .UPisTrue "is FormActivate" ! ) OR ( anOperation .IsInternalOperation ) ) then begin if ( anOperation .IsInternalOperation ) then begin anOperation .MethodName // %o%f_pas_MethodName("callgate") end // ( anOperation .IsInternalOperation ) else begin anOperation .AsExecuteDo: .MethodName end // ( anOperation .IsInternalOperation ) end else 'nil' ', ' if ( anOperation .UPisTrue "is query" ! ) then begin anOperation .AsTestDo: .MethodName end // ( anOperation .UPisTrue "is query" ! ) else 'nil' ', ' if ( anOperation .HasStates ) then begin anOperation .AsGetStateDo: .MethodName end // ( anOperation .HasStates ) else 'nil' anOperation .PrefixParam ');' ] anOperation .OperationOptions ) // .for> Self .Overridden .filter> .IsVCMOperation .for> ( IN anOperation anOperation .IfDefBraceLnBefore: ( anOperation .OperationOptions ) ) // .for> [ \n ' end;//with Entities.Entities' ] end // ( Self .ImplementsSomeVCMOperation ) VAR l_PublishedExludes [] >>> l_PublishedExludes Self .ChildrenEx .filter> .IsExcludeUserTypes .filter> ( .IsIncludeUserTypes ! ) .for> ( IN anExclude VAR l_Excludes [] >>> l_Excludes elem_proc CollectExcludedUserTypes Self .InheritsEx .filter> .IsUserType .filter> .AddToArray?: l_Excludes .for> DROP Self .InheritsEx .filter> .IsExcludeUserTypes .filter> ( .IsIncludeUserTypes ! ) .for> call.me ; // CollectExcludedUserTypes anExclude .CollectExcludedUserTypes l_Excludes .for> ( IN aUserType anExclude .ImplementedEx .filter> .IsVCMOperation .filter> ( IN anOperation [ aUserType .Name anOperation .Parent .Name anOperation .Name ] strings:Cat .AddToArray?: l_PublishedExludes ) .for> ( IN anOperation anOperation .IfDefBraceLnBefore: [ \n ' AddUserTypeExclude(' aUserType .Name 'Name' ', ' anOperation .OperationFullName anOperation .UPisTrue "no prefix" ');' ] ) // .for> ) // .for> ) // .for> Self .ChildrenEx .filter> .IsIncludeUserTypes .for> ( IN anInclude VAR l_Includes [] >>> l_Includes elem_proc CollectIncludedUserTypes Self .InheritsEx .filter> .IsUserType .filter> .AddToArray?: l_Includes .for> DROP Self .InheritsEx .filter> .IsIncludeUserTypes .for> call.me ; // CollectIncludedUserTypes anInclude .CollectIncludedUserTypes Self .AllUserTypes .filter> ( .NotInArray: l_Includes ) .for> ( IN aUserType anInclude .ImplementedEx .filter> .IsVCMOperation .filter> ( IN anOperation [ aUserType .Name anOperation .Parent .Name anOperation .Name ] strings:Cat .AddToArray?: l_PublishedExludes ) .for> ( IN anOperation anOperation .IfDefBraceLnBefore: [ \n ' AddUserTypeExclude(' aUserType .Name 'Name' ', ' anOperation .OperationFullName anOperation .UPisTrue "no prefix" ');' ] ) // .for> ) // .for> ) // .for> ] >>> Result ; // InitEntitiesUC elem_iterator SignalDataSourceChangedUC [ ' inherited;' \n ' if (aNew = nil) then' \n ' begin' \n Self .Attributes .filter> .IsVCMController .for> ( IN anAttr [ ' ' anAttr .AttrName ' := ' 'nil' ';' \n ] ) // .for> ' end//aNew = nil' \n ' else' \n ' begin' \n Self .Attributes .filter> .IsVCMController .for> ( IN anAttr RULES ( ( anAttr .IsUseCaseController ) OR ( anAttr .AttrType .IsUseCaseController ) ) [ ' ' 'aNew.CastUCC(' anAttr .AttrType .TypeName ', ' anAttr .AttrName if ( anAttr .Name .IsNil ) then ', true' ')' ';' \n ] ( anAttr .Name .IsNil ) [ ' ' anAttr .AttrName ' := aNew As ' anAttr .AttrType .TypeName ';' \n ] DEFAULT [ ' ' 'Supports(aNew, ' anAttr .AttrType .TypeName ', ' anAttr .AttrName ');' \n ] ; // RULES ) // .for> ' end;//aNew = nil' ] >>> Result ; // SignalDataSourceChangedUC 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 ) RULES ( Self .IsInterfaceFactory ) () ( Self .IsWrapper ) () DEFAULT begin VAR l_Tag Self .ImplementsEx .filter> .IsTag .FirstElement >>> l_Tag if ( l_Tag .NotIsNil ) then begin VAR l_GetTaggedDataType l_Overridden .join> ( Self .ImplementedEx ) .filter> ( GarantModel::k2TaggedDataHolder.GetTaggedDataType .IsSameModelElement ) .FirstElement >>> l_GetTaggedDataType if ( l_GetTaggedDataType .IsNil ) then begin .join> ToArray: ( GarantModel::k2TaggedDataHolder.GetTaggedDataType .OverrideMethod: ( IN aMade aMade ->^ cVarUserCodeName ^:= cEmptyUserCode aMade .AddMethodWithParams: cImplementationUserCodeName l_Tag ( IN aTag [ ' Result := k2_typ' aTag .Name ';' ] ) // aMade .AddMethodWithParams: cImplementationUserCodeName Self ) // GarantModel::k2TaggedDataHolder.GetTaggedDataType .OverrideMethod: ) // .join> ToArray: end // ( l_GetTaggedDataType .IsNil ) else begin l_GetTaggedDataType ->^ cVarUserCodeName ^:= cEmptyUserCode l_GetTaggedDataType .AddMethodWithParams: cImplementationUserCodeName l_Tag ( IN aTag [ ' Result := k2_typ' aTag .Name ';' ] ) // aMade .AddMethodWithParams: cImplementationUserCodeName Self end // ( l_GetTaggedDataType .IsNil ) end // ( l_Tag .NotIsNil ) end // DEFAULT ; // RULES 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 .IsVCMFormsPack ) then begin if ( Self .OperationsEx .filter> .IsModuleOperationPrim .NotEmpty ) then begin .join> ToArray: ( GarantModel::TComponent.Loaded .OverrideMethod: ( IN aMade aMade ->^ cVarUserCodeName ^:= cEmptyUserCode aMade .AddMethodWithParams: cImplementationUserCodeName Self ( IN Self [ ' inherited;' Self .OperationsEx .filter> .IsModuleOperationPrim .for> ( IN anOp anOp .IfDefBraceLnBefore: ( [ \n ' PublishOp(' cQuote if ( anOp .UPisTrue "no prefix" ! ) then 'op' anOp .Name cQuote ', ' anOp .AsExecuteDo: .MethodName ', ' if ( anOp .UPisTrue "no test" ) then 'nil' else begin anOp .AsTestDo: .MethodName end // ( anOp .UPisTrue "no test" ) ');' if ( anOp .GetUP "ShowInToolbar" IsBool ) then begin \n ' ShowInToolbar(' cQuote if ( anOp .UPisTrue "no prefix" ! ) then 'op' anOp .Name cQuote ', ' anOp .GetUP "ShowInToolbar" ');' end // ( anOp .GetUP "ShowInToolbar" IsBool ) if ( anOp .GetUP "ShortCut" .NotIsNil ) then begin \n ' SetShortCut(' cQuote if ( anOp .UPisTrue "no prefix" ! ) then 'op' anOp .Name cQuote ', ' cQuote anOp .GetUP "ShortCut" cQuote ');' end // ( anOp .GetUP "ShortCut" .NotIsNil ) ] ) // anOp .IfDefBraceLnBefore: ) // .for> ] ) // aMade .AddMethodWithParams: cImplementationUserCodeName Self ( ) // GarantModel::TComponent.Loaded .OverrideMethod: ) // .join> ToArray: end // Loaded if ( Self .ChildrenEx .filter> .IsVCMForm .filter> ( .Abstraction at_final == ) .NotEmpty ) then begin .join> ToArray: ( GarantModel::TvcmModule.GetEntityForms .OverrideMethod: ( IN aMade aMade ->^ cVarUserCodeName ^:= cEmptyUserCode aMade .AddMethodWithParams: cImplementationUserCodeName Self ( IN Self [ ' inherited;' Self .ChildrenEx .filter> .IsVCMForm .filter> ( .Abstraction at_final == ) .for> ( IN aForm [ \n ' aList.Add(' aForm .TypeName ');' ] ) // .for> ] ) // aMade .AddMethodWithParams: cImplementationUserCodeName Self ( ) // GarantModel::TvcmModule.GetEntityForms .OverrideMethod: ) // .join> ToArray: ( end // GetEntityForms end // ( Self .IsVCMFormsPack ) if ( Self .IsViewAreaControllerImp ) then begin if ( Self .HasAnyVCMController ) then begin .join> ToArray: ( GarantModel::vcmFormDataSourcePrimWithFlexUseCaseControllerType.InitRefs .OverrideMethod: ( IN aMade aMade ->^ cVarUserCodeName ^:= cEmptyUserCode aMade .AddMethodWithParams: cImplementationUserCodeName Self ( IN Self [ ' inherited;' Self .Attributes .filter> .IsVCMController .for> ( IN anAttr \n ' ' if ( ( anAttr .Name .IsNil ) OR ( anAttr .Name 'SDS' == ) ) then begin anAttr .AttrName ' := aDS As ' anAttr .AttrType .TypeName ';' end else begin 'Supports(aDS, ' anAttr .AttrType .TypeName ', ' anAttr .AttrName ');' end ) // .for> ] ) // aMade .AddMethodWithParams: cImplementationUserCodeName Self ) // GarantModel::vcmFormDataSourcePrimWithFlexUseCaseControllerType.InitRefs .OverrideMethod: ) // .join> ToArray: .join> ToArray: ( GarantModel::vcmFormDataSourcePrimWithFlexUseCaseControllerType.ClearRefs .OverrideMethod: ( IN aMade aMade ->^ cVarUserCodeName ^:= cEmptyUserCode aMade .AddMethodWithParams: cImplementationUserCodeName Self ( IN Self [ ' inherited;' Self .Attributes .filter> .IsVCMController .for> ( IN anAttr \n ' ' anAttr .AttrName ' := nil;' ) // .for> ] ) // aMade .AddMethodWithParams: cImplementationUserCodeName Self ) // GarantModel::vcmFormDataSourcePrimWithFlexUseCaseControllerType.ClearRefs .OverrideMethod: ) // .join> ToArray: end // ( Self .HasAnyVCMController ) end // ( Self .IsViewAreaControllerImp ) if ( Self .IsVCMForm ) then begin if ( Self .HasAnyVCMController ) then begin .join> ToArray: ( GarantModel::vcmLayout.SignalDataSourceChanged .OverrideMethod: ( IN aMade aMade ->^ cVarUserCodeName ^:= cEmptyUserCode aMade .AddMethodWithParams: cImplementationUserCodeName Self .SignalDataSourceChangedUC ) // GarantModel::vcmLayout.SignalDataSourceChanged .OverrideMethod: ) // .join> ToArray: end // ( Self .HasAnyVCMController ) if ( Self .NeedsInitEntities ) then begin .join> ToArray: ( GarantModel::vcmLayout.InitEntities .OverrideMethod: ( IN aMade aMade ->^ cVarUserCodeName ^:= cEmptyUserCode aMade .AddMethodWithParams: cImplementationUserCodeName Self .InitEntitiesUC ) // GarantModel::vcmLayout.InitEntities .OverrideMethod: ) // .join> ToArray: end // ( Self .NeedsInitEntities ) if ( Self .NeedsMakeControls ) then begin .join> ToArray: ( GarantModel::vcmLayout.MakeControls .OverrideMethod: ( IN aMade aMade ->^ cVarUserCodeName ^:= cEmptyUserCode aMade .AddMethodWithParams: cImplementationUserCodeName Self ( IN aForm [ ' inherited;' aForm .UserTypes .for> ( IN aUserType [ \n ' with AddUsertype(' aUserType .Name 'Name,' \n ] [ ' ' 'str_' aUserType .Name 'Caption,' \n ] [ ' ' 'str_' aUserType .Name if ( aUserType .GetUP "SettingsCaption" .NotIsNil ) then 'Settings' 'Caption,' \n ] [ ' ' aUserType .GetUP "VisibleToUser" false ?!= ',' \n ] [ ' ' aUserType .GetUP "ImageIndex" ',' \n ] [ ' ' aUserType .GetUP "Weight" ',' \n ] [ ' ' VAR l_UseToolbar aUserType .Attributes .filter> ( .Name 'UseToolbarOfUserTypeName' == ) .FirstElement >>> l_UseToolbar if ( l_UseToolbar .IsNil ) then begin cQuote cQuote end // ( l_UseToolbar .IsNil ) else begin l_UseToolbar .Target .Name 'Name' end // ( l_UseToolbar .IsNil ) ',' \n ] [ ' ' if ( aUserType .UPisTrue "NeedOnQueryMaximized" ) then begin aUserType .Name 'QueryMaximized' Cat .FromTie end // ( aUserType .UPisTrue "NeedOnQueryMaximized" ) else 'nil' ',' \n ] [ ' ' if ( aUserType .UPisTrue "NeedOnQueryOpen" ) then begin aUserType .Name 'QueryOpen' Cat .FromTie end // ( aUserType .UPisTrue "NeedOnQueryOpen" ) else 'nil' ',' \n ] [ ' ' if ( aUserType .UPisTrue "NeedOnQueryClose" ) then begin aUserType .Name 'QueryClose' Cat .FromTie end // ( aUserType .UPisTrue "NeedOnQueryClose" ) else 'nil' ',' \n ] [ ' ' RULES ( aUserType .UPisTrue "CanClose" ) 'vcm_ccEnable' ( aUserType .GetUP "CanClose" false ?== ) 'vcm_ccDisable' DEFAULT 'vcm_ccNone' ; // RULES ] [ ') do' \n ] [ ' begin' \n ] if ( aUserType .GetUP "CanHaveToolbars" false ?== ) then begin [ ' ' 'CanHaveToolbars := false;' \n ] end // ( aUserType .GetUP "CanHaveToolbars" false ?== ) [ ' end;//with AddUsertype(' aUserType .Name 'Name' ] ) // .for> STRING elem_func ControlParentName RULES ( Self .IsVCMCustomForm ) 'Self' DEFAULT ( Self .AttrName ) ; // RULES >>> Result ; // ControlParentName aForm .OwnControls .for> ( IN aControl aControl .IfDefBraceLnBefore: ( if ( aControl .NeedPutToDFM ! ) then begin if ( aControl .IsControlOverride ! ) then begin [ \n ' ' aControl .FieldName ' := ' aControl .AttrType .TypeName '.Create' '(' if ( aControl GarantModel::TvgReminder .InheritsFrom ) then begin aControl .Parent .ControlParentName end // ( aControl GarantModel::TvgReminder .InheritsFrom ) else 'Self' ')' ';' ] [ \n ' ' aControl .FieldName '.Name' ' := ' cQuote aControl .Name cQuote ';' ] end // ( aControl .IsControlOverride ! ) if ( aControl GarantModel::TvgReminder .InheritsFrom ! ) then begin if ( aControl .IsComponent ! ) then begin [ \n ' ' if ( aControl .IsControlOverride ) then begin aControl .AttrName end // ( aControl .IsControlOverride ) else begin aControl .FieldName end // ( aControl .IsControlOverride ) '.Parent' ' := ' aControl .Parent .ControlParentName ';' ] VAR l_Doc aControl .Documentation >>> l_Doc if ( l_Doc .NotIsNil ) then begin if ( aControl .GetUP "need Caption" false ?!= ) then begin [ \n ' ' aControl .FieldName '.Caption' ' := ' cQuote l_Doc cQuote ';' ] end // ( aControl .GetUP "need Caption" false ?!= ) end // if ( l_Doc .NotIsNil ) end // ( aControl .IsComponent ! ) end // ( aControl GarantModel::TvgReminder .InheritsFrom ! ) end // ( aControl .NeedPutToDFM ! ) aControl .Zones .for> ( IN aZone [ \n ' with DefineZone(vcm_zt' aZone .GetUP "ZoneType" ', ' if ( aControl .NeedPutToDFM ) then begin aControl .AttrName end // ( aControl .NeedPutToDFM ) else begin aControl .AttrName //aControl .FieldName end // ( aControl .NeedPutToDFM ) ] [ ') do' \n ] [ ' begin' \n ] if ( aZone .UPisTrue "MergeTopTollbarWithContainer" ) then begin [ ' FormStyle.Toolbars.Top.MergeWithContainer := vcm_bTrue;' \n ] end // ( aZone .UPisTrue "MergeTopTollbarWithContainer" ) if ( aZone .UPisTrue "MergeBottomTollbarWithContainer" ) then begin [ ' FormStyle.Toolbars.Bottom.MergeWithContainer := vcm_bTrue;' \n ] end // ( aZone .UPisTrue "MergeBottomTollbarWithContainer" ) RULES ( aZone .UPisTrue "CanClose" ) [ ' CanClose := vcm_ccEnable;' \n ] ( aZone .GetUP "CanClose" false ?== ) [ ' CanClose := vcm_ccDisable;' \n ] ; // RULES if ( aZone .UPisTrue "Need UC" ) then begin HookOut: ( Indented: Indented: ( aZone .UserCode: '' '!!!' ) ) // HookOut: end // ( aZone .UPisTrue "Need UC" ) [ ' end;//with DefineZone(vcm_zt' aZone .GetUP "ZoneType" ] ) // .for> ) // aControl .IfDefBraceLnBefore: ) // .for> ] ) // aMade .AddMethodWithParams: cImplementationUserCodeName Self ) // GarantModel::vcmLayout.MakeControls .OverrideMethod: ) // .join> ToArray: end // MakeControls end // ( Self .IsVCMForm ) if ( Self .IsUseCaseControllerImp ) then begin if ( Self .ImplementedEx .filter> .IsVCMArea .NotEmpty ) then begin if ( l_Overridden GarantModel::vcmFormSetDataSource.ClearAreas .HasModelElement ! ) then begin .join> ToArray: ( GarantModel::vcmFormSetDataSource.ClearAreas .OverrideMethod ) end // ( l_Overridden GarantModel::vcmFormSetDataSource.ClearAreas .HasModelElement ! ) end // ( Self .ImplementedEx .filter> .IsVCMArea .NotEmpty ) end // ( Self .IsUseCaseControllerImp ) ) >>> 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 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 ) if ( Self .IsVCMCustomForm ) then begin if ( Self .NeedsInitEntities ) then begin .join> ToArray: GarantModel::vcmInterfaces end // ( Self .NeedsMakeControls ) if ( Self .Abstraction at_final != ) then begin .join> ToArray: GarantModel::vcmExternalInterfaces // - вообще это надо только для Internal операций end // ( Self .Abstraction at_final != ) if ( Self .IsMixIn ! ) then begin //.join> ToArray: ( Self .DefaultAncestor ) .join> ToArray: ( Self .MainAncestorThatNotMixIn ) end // ( Self .IsMixIn ! ) if ( Self .Abstraction at_final == ) then begin if ( Self .IsVCMForm ) then begin .join> ToArray: GarantModel::TvcmEntities end // ( Self .IsVCMForm ) .join> ( Self .AllControls .filter> .NeedPutToDFM .join> ( Self .OwnControls ) .map> .AttrType .filterNil> ) // .join> end // ( Self .Abstraction at_final == ) else begin .join> ( Self .OwnControls .map> .AttrType .filterNil> ) // .join> end // ( Self .Abstraction at_final == ) end // ( Self .IsVCMCustomForm ) if ( Self .IsVCMFormsPack ) then begin .join> ToArray: GarantModel::vcmExternalInterfaces .join> ToArray: GarantModel::TvcmModule end // ( Self .IsVCMFormsPack ) ) >>> Result ; // IntfUses BOOLEAN elem_func IsInjects Self .IsStereotype st_injects::Dependency >>> Result ; // IsInjects elem_iterator InjectedElements Cached: ( Self .Injected .filter> .IsInjects .map> .Parent .join> ( Self '.pas.ms.script.inj' '_InjectedElements' .LoadList ) array:Copy ) >>> Result ; // InjectedElements 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 ModelElement elem_func SetType Cached: ( Self .ImplementsEx .filter> .IsUseCaseController .FirstElement >>> Result if ( Result .IsNil ) then begin Self .InheritsEx .filter> .IsUseCaseControllerImp .filter> ( DROP Result .IsNil ) .for> ( IN aG aG .ImplementsEx .filter> .IsUseCaseController .FirstElement >>> Result ) // .for> end // ( Result .IsNil ) Result ) >>> Result ; // SetType ModelElement elem_func FormDataSourceType Cached: ( Self .ImplementsEx .filter> .IsViewAreaController .filter> ( .Abstraction at_abstract != ) .FirstElement >>> Result if ( Result .IsNil ) then begin Self .InheritsEx // .filter> .IsViewAreaControllerImp .filter> ( DROP Result .IsNil ) .for> ( IN aG aG .ImplementsEx .filter> .IsViewAreaController .filter> ( .Abstraction at_abstract != ) .FirstElement >>> Result ) // .for> end // ( Result .IsNil ) Result ) >>> Result ; // FormDataSourceType elem_iterator MixInValues Cached: ( Self .Attributes .filter> ( .IsStereotype st_impurity_value::Attribute ) if ( Self .IsUseCaseControllerImp ) then begin if ( Self .Abstraction at_abstract != ) then begin VAR l_MixInValues DUP >>> l_MixInValues if ( l_MixInValues 'SetType' .HasModelElementWithName ! ) then begin VAR l_SetType Self .SetType >>> l_SetType if ( l_SetType .NotIsNil ) then begin .join> ToArray: ( 'SetType' l_SetType MakeField ) // .join> ToArray: end // ( l_SetType .NotIsNil ) end // ( l_MixInValues 'SetType' .HasModelElementWithName ! ) end // ( Self .Abstraction at_abstract != ) end // ( Self .IsUseCaseControllerImp ) if ( Self .IsViewAreaControllerImp ) then begin if ( Self .Abstraction at_final == ) then begin VAR l_MixInValues DUP >>> l_MixInValues if ( l_MixInValues 'FormDataSourceType' .HasModelElementWithName ! ) then begin VAR l_SetType Self .FormDataSourceType >>> l_SetType if ( l_SetType .NotIsNil ) then begin .join> ToArray: ( 'FormDataSourceType' l_SetType MakeField ) // .join> ToArray: end // ( l_SetType .NotIsNil ) end // ( l_MixInValues 'SetType' .HasModelElementWithName ! ) end // ( Self .Abstraction at_abstract != ) end // ( Self .IsViewAreaControllerImp ) ) >>> 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 .IsVCMForm ) then begin .joinWithLambded> ( Self .OwnControls ) ( .ImplementsEx .filter> .IsVCMOperations ) .joinWithLambded> ( Self .ChildrenEx .filter> .IsExcludeUserTypes ) ( .ImplementedEx .filter> .IsVCMOperation ) .join> ( Self .OverriddenEx .filter> .IsVCMOperation ) .join> ( Self .ImplementedEx .filter> .IsVCMOperation ) if ( Self .HasFactory ) then begin .join> ToArray: GarantModel::vcmBase .join> ToArray: GarantModel::l3Base end // ( Self .HasFactory ) end // ( Self .IsVCMForm ) if ( Self .IsFormSetFactory ) then begin .join> ToArray: GarantModel::vcmBase end // ( Self .IsFormSetFactory ) 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 .IsViewAreaControllerImp ) then begin if ( Self .HasAnyVCMController ) then begin .join> ToArray: GarantModel::SysUtils end // ( Self .HasAnyVCMController ) end // ( Self .IsViewAreaControllerImp ) if ( Self .IsMessage ) then begin .join> ToArray: GarantModel::Dialogs end // ( Self .IsMessage ) 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 .join> ( Self .ImplementsEx .filter> .IsTag ) 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> .IsVCMCustomForm .filter> ( .Abstraction at_final == ) .NotEmpty ) then begin Self .InheritsEx .filter> .IsVCMCustomForm .filter> ( .Abstraction at_final == ) .for> ( IN aForm .join> ( aForm .AllControls .map> .AttrType .filterNil> ) // .join> ) // .for> .join> ToArray: GarantModel::TtfwClassRef(Proxy) end // .filter> .IsVCMCustomForm end // ( Self .IsScriptKeywordsPack ) if ( Self .IsVCMCustomForm ) then begin if ( ( Self .NeedsMakeControls ) OR ( Self .NeedsInitEntities ) ) then begin .join> ToArray: GarantModel::vcmInterfaces end // ( Self .NeedsMakeControls ) end // ( Self .IsVCMCustomForm ) .joinWithLambded> ( Self .UsesInDependencies .filter> .IsVCMCustomForm ) ( .UserTypes ) if ( Self .IsVCMCustomForm ) then begin .join> ( Self .ChildrenWithOwnFile ) if ( Self .HasAnyVCMController ) then begin .join> ToArray: GarantModel::SysUtils end // ( Self .HasAnyVCMController ) end // ( Self .IsVCMCustomForm ) if ( Self .IsUseCaseControllerImp ) then begin if ( Self .ImplementedEx .filter> .IsVCMArea .NotEmpty ) then begin .join> ToArray: GarantModel::TvcmViewAreaControllerRef end // ( Self .ImplementedEx .filter> .IsVCMArea .NotEmpty ) end // ( Self .IsUseCaseControllerImp ) if ( Self .IsScriptKeyword ) then begin if ( Self GarantModel::TtfwModuleOperationWord .InheritsFromOrSomeAncestorImplements ) then begin .join> ToArray: GarantModel::StdRes end // ( Self GarantModel::TtfwModuleOperationWord .InheritsFromOrSomeAncestorImplements ) end // ( Self .IsScriptKeyword ) if ( Self .IsVCMApplication ) then begin Self @ ( IN anOp .join> ToArray: anOp ) .IterateVCMFormsPacksFromApplication Self @ ( IN anOp .join> ToArray: anOp ) .OutRecall end // ( Self .IsVCMApplication ) if ( Self .IsVCMControls ) then begin .join> ToArray: GarantModel::TvcmOperationsForRegister .join> ToArray: GarantModel::TvcmOperationStateForRegister end // ( Self .IsVCMControls ) if ( Self .IsVCMFormsPack ) then begin if ( Self .Abstraction at_final == ) then begin .join> ToArray: GarantModel::TvcmModulesForRegister .join> ToArray: GarantModel::TvcmModuleOperationsForRegister end // ( Self .Abstraction at_final == ) end // ( Self .IsVCMFormsPack ) .join> ( Self .UsedElements ) array:CopyWithoutDuplicates ) >>> 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 ARRAY FUNCTION .fold> ARRAY IN anArray %SUMMARY 'Преобразует список списков в один плоский список.' ; [empty] anArray .for> ( SWAP JOIN ) >>> Result ; // .fold> ARRAY FUNCTION .transform> ARRAY IN anArray ^ IN aLambda %SUMMARY 'Применяет aLambda к каждому элементу anArray.' 'Предполагается, что aLambda возвращает список.' 'Результатом явлется объединённый список результатов aLambda.' ; anArray .map> ( aLambda DO ) .fold> >>> Result ; // .transform> 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 .IsVCMFormsPack ) then begin .join> ( Self .ChildrenWithOwnFile ) .join> ( Self .ChildrenWithOwnFile .map> .ImplementsEx .fold> .filter> .IsVCMFormDefinition ) // .join> end // ( Self .IsVCMFormsPack ) if ( Self .IsVCMForm ) then begin if ( Self .Abstraction at_final != ) then begin .join> ToArray: GarantModel::StdRes end // ( Self .Abstraction at_final != ) end // ( Self .IsVCMForm ) if ( Self .IsVCMFormSetFactory ) then begin .join> ToArray: GarantModel::SysUtils .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 .filter> .AddToArray?: l_InUses .for> ( IN anItem anItem .AddToArray: l_ProjectUses RULES ( anItem IsString ) () DEFAULT ( anItem .ProjectUsesPrim call.me ) ; // RULES ) // .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 .IsAreaGetter ) 'DoGet_' ( 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 ) ( '1.0' Result EndsStr ) () ( '.0' Result EndsStr ) // - вообще тут надо проверять, что впереди буква begin '0' >>> 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 ) ( 'vcm_ztvcm_ztAny' Result == ) ( 'vcm_ztAny' >>> 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 '(' aParam .IfDefBraceLnBefore: ( 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 .IfDefBraceLnBefore: ) // 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: 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 .IsModuleOperationPrim ) begin if ( Self .UPisTrue "no test" ! ) then begin Self .AsTestDo: ( aPrefix aOverload aOfObject aBody .MethodInterfacePrim ) end // ( Self .UPisTrue "no test" ! ) Self .AsExecuteDo: ( aPrefix aOverload aOfObject aBody .MethodInterfacePrim ) end // ( Self .IsModuleOperationPrim ) ( 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 .HasStates ) then begin Self .AsGetStateDo: ( aPrefix aOverload aOfObject aBody .MethodInterfacePrim ) end // ( Self .HasStates ) end // ( Self .IsInternalOperation ! ) if ( Self .IsInternalOperation ) then NormalCall ) // ( Self .IsVCMOperationPrim ) ( Self .IsVCMArea ) begin CallAsGetter if ( g_Implementor .NotIsNil ) then begin ( Self .AsAreaDo: ( aPrefix aOverload aOfObject aBody .MethodInterfacePrim ) ) end // ( g_Implementor .NotIsNil ) end // ( Self .IsVCMArea ) ( 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' if ( Self .IsVCMCustomForm ) then begin '(' 'nil' ')' end // ( Self .IsVCMCustomForm ) ';' \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 UseNewGen Cached: ( RULES ( Self .IsNil ) false ( Self .IsUserType ) true ( Self .IsElementProxy ) true ( Self .IsTestClass ) true ( Self .IsTestCase ) true ( Self .IsScriptKeyword ) true ( Self .IsScriptKeywordsPack ) true ( Self .IsUtilityPack ) true ( Self .IsScriptKeywords ) true ( Self .IsWrapper ) true ( Self .IsTagTable ) false ( Self .IsInterfaceFactory ) false ( Self .IsEVD ) true ( Self .UPisTrue "UseNewGen" ) true ( Self .GetUP "finished" false ?== ) true ( Self .ForceUseNewGen ) true ( Self .IsVCMForm ) true ( Self .IsVCMDataModule ) true ( Self .IsVCMCustomForm ) true ( Self .IsGuiControl ) true ( Self .IsUseCaseControllerImp ) true //( Self .Parent call.me ) ( Self .IsViewAreaControllerImp ) true //( Self .Parent call.me ) ( Self .IsVCMControls ) true ( 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 .IsVCMFormSetFactory ) true //( Self .Parent call.me ) ( Self .IsVCMFormsPack ) true //( 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 ) true 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> ( .AddToArray?: l_CastMethods ) ) ( IN anItem 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 .OperationsEx 'Exists' .HasModelElementWithName ! ) then begin .join> ToArray: ( Self .ExistsMethod ) end // ( Self .OperationsEx 'Exists' .HasModelElementWithName ! ) 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 .filter> ( .Visibility UnknownAccess != ) ) >>> 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> ( .IsModuleOperationPrim ! ) .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: ( if ( Self .IsVCMCustomForm ) then begin if ( Self .Abstraction at_final == ) then begin Indented: ( if ( Self .IsVCMForm ) then begin 'Entities : TvcmEntities;' .Out end // ( Self .IsVCMForm ) Self .AllControls .filter> ( .IsControlOverride ! ) .filter> .NeedPutToDFM .for> ( IN aControl [ aControl .AttrName ' : ' aControl .AttrType .TypeName ';' ] .Out ) // .for> ) // Indented: end // ( Self .Abstraction at_final == ) end // ( Self .IsVCMCustomForm ) 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> .AddToArray?: l_Implements ) // .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 .IsMixIn ) begin if g_WasConst then DoOutTypeKeyword end // ( Self .IsMixIn ) ( Self .IsType ) DoOutTypeKeyword ; // 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 ) () ( Self .IsVCMFormZone ) () ( Self .IsVCMZone ) () ( Self .IsExcludeUserTypes ) () 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 PROCEDURE OutConstKeyword if ( g_WasConst ! ) then begin DropWasType true >>> g_WasConst 'const' .Out end // ( g_WasConst ! ) ; // OutConstKeyword 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 FUNCTION .OutConstantsList ARRAY IN aList VAR l_WasConst false >>> Result aList .for> ( IN anItem RULES ( anItem .IsLocalConst ) () DEFAULT ( anItem .IfDef: ( true >>> Result OutConstKeyword anItem .OutDocumentation Indented: ( anItem .OutConstants ) // Indented: ) // anItem .IfDef: ) // DEFAULT ; // RULES ) ; // .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 ; VAR l_WasConst false >>> l_WasConst Self .ForChildren> .Suitable ( .ConstantsEx .filter> ( .ConstantsListVisibility PublicAccess == ) if .OutConstantsList ( true >>> l_WasConst ) ) if l_WasConst then OutLn Self .OutTypes .Suitable false >>> l_WasConst Self .ForChildren> .Suitable ( .ConstantsEx .filter> ( .ConstantsListVisibility ProtectedAccess == ) if .OutConstantsList ( true >>> l_WasConst ) ) if l_WasConst then OutLn ; // 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 ' RULES ( Self .IsGlobalVar ) 'g_' ( Self .IsLocalVar ) 'l_' ; // RULES 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 // ( Self .UPisTrue 'extprop:isAsm' ) else begin if ( Self .IsControlPrim ! ) then begin if ( Self .IsIteratorF ! ) then begin TF g_MethodParentPrefix ( '' >>> g_MethodParentPrefix Self .LocalVars .for> .OutVar Indented: ( elem_proc OutLocalMethod: ^ IN aLambda OutLn Self .MethodInterfaceForEx: nil ( aLambda DO ) ; // OutLocalMethod: Self .LocalMethods .filter> ( .MethodVisibility PrivateAccess == ) .for> .OutLocalMethod: ( call.me ) Self .LocalMethods .filter> ( .MethodVisibility ProtectedAccess == ) .for> .OutLocalMethod: ( call.me ) Self .LocalMethods .filter> ( .MethodVisibility PublicAccess == ) .for> .OutLocalMethod: ( call.me ) ) // Indented: ) // TF g_MethodParentPrefix end // ( Self .IsIteratorF ! ) if ( Self .IsFormSetFactory ) then begin if ( Self .UPisTrue "NO_FACTORY_BRACKECTS" ! ) then begin 'var' .Out ' __WasEnter : Boolean;' .Out end // ( Self .UPisTrue "NO_FACTORY_BRACKECTS" ! ) end // ( Self .IsFormSetFactory ) Self .UserCode: cVarUserCodeSuffix () end // ( Self .IsControlPrim ! ) 'begin' .Out if ( Self .IsFormSetFactory ) then begin if ( Self .UPisTrue "NO_FACTORY_BRACKECTS" ! ) then begin ' __WasEnter := vcmEnterFactory;' .Out ' try' .Out end // ( Self .UPisTrue "NO_FACTORY_BRACKECTS" ! ) end // ( Self .IsFormSetFactory ) VAR l_WasOut false >>> l_WasOut RULES ( Self .IsControlPrim ) begin Indented: ( [ 'if (' Self .FieldName ' = nil) then' ] .Out [ ' ' Self .FieldName ' := FindComponent(' cQuote Self .Name cQuote ') As ' Self .AttrType .TypeName ';' ] .Out [ 'Result := ' Self .FieldName ';' ] .Out ) // Indented: true >>> l_WasOut end // ( Self .IsControlPrim ) ( Self .IsIteratorF ! ) 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 ! ) ; // RULES if ( l_WasOut ! ) then begin Self .UserCode: cImplementationUserCodeSuffix cNeedsToBeImplemented end // ( l_WasOut ! ) if ( Self .IsFormSetFactory ) then begin if ( Self .UPisTrue "NO_FACTORY_BRACKECTS" ! ) then begin ' finally' .Out ' if __WasEnter then' .Out ' vcmLeaveFactory;' .Out ' end;//try..finally' .Out end // ( Self .UPisTrue "NO_FACTORY_BRACKECTS" ! ) end // ( Self .IsFormSetFactory ) end // ( Self .UPisTrue 'extprop:isAsm' ) [ '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 if ( Self .IsVCMCustomForm ) then begin if ( Self .Abstraction at_final == ) then begin [ '{$R *.DFM}' \n ] .Out end // ( Self .Abstraction at_final == ) end // ( Self .IsVCMCustomForm ) 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 cNeedsToBeImplemented ' 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 ModelElement IN aParent ( aName MakeIniProcedure: ( IN aMade aMade -> %SUM := ( [ 'Инициализация ' aPrefix Self .Name ] strings:Cat ) aMade -> Parent := ( aParent .WeakRef ) 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 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 Cached: ( 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 Self .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> ( l_IniOperations SWAP .Name .HasModelElementWithName ! ) .for> ( IN aMethod .join> ToArray: aMethod array:Copy >>> l_IniOperations // - перекопируем массив, чтобы убрать дубликаты l_IniOperations // - кладём его обратно на стек ) // .for> end // ( Self .IsScriptKeywordsPack ) ( Self .IsVCMControls ) begin .join> ToArray: ( 'RegisterOperations' MakeIniProcedure: ( IN aMade aMade -> Parent := ( Self .WeakRef ) aMade .AddMethodWithParams: cUserCodePrefix Self ( IN Self [ Self .ChildrenEx .filter> .IsVCMOperations .for> ( IN anEntity anEntity .OperationsEx .filter> .IsVCMOperation .for> ( IN anOperation HookOut: ( Indented: ( [ 'with ' 'TvcmOperationsForRegister.AddOperation(' 'TvcmOperationForRegister_C(' 'en_' anEntity .Name ', ' 'op_' anOperation .Name ', ' 'en_cap' anEntity .Name ', ' 'op_cap' anOperation .Name ', ' anOperation .IsInternalOperation ', ' anOperation .UPisTrue "no prefix" ', ' [ 'opcode_' anEntity .Name '_' anOperation .Name ] ')' ')' ' do' \n 'begin' \n if ( anOperation .GetUP "ImageIndex" .IsIntEx ) then begin ' SetImageIndex(' anOperation .GetUP "ImageIndex" ')' ';' \n end // ( anOperation .GetUP "ImageIndex" .IsIntEx ) anOperation .ChildrenEx .filter> .IsVCMOperationState .for> ( IN aState HookOut: ( aState .IfDef: ( [ 'with ' 'AddState(' 'TvcmOperationStateForRegister_C(' cQuote aState .Name cQuote ', ' [ 'st_user_' anEntity .Name '_' anOperation .Name '_' aState .Name ] ')' ')' '^' ' do' \n 'begin' \n if ( aState .Documentation .NotIsNil ) then begin ' rCaption := ' cQuote aState .Documentation cQuote ';' \n end // ( aState .Documentation .NotIsNil ) if ( aState .GetUP "Hint" .NotIsNil ) then begin ' rHint := ' cQuote aState .GetUP "Hint" cQuote ';' \n end // ( aState .GetUP "Hint" .NotIsNil ) if ( aState .GetUP "ImageIndex" .IsIntEx ) then begin ' rImageIndex := ' aState .GetUP "ImageIndex" ';' \n end // ( aState .GetUP "ImageIndex" .IsIntEx ) if ( aState .GetUP "Enabled" IsBool ) then begin ' rEnabled := ' 'vcm_osf' aState .GetUP "Enabled" ';' \n end // ( aState .GetUP "Enabled" IsBool ) if ( aState .GetUP "Visible" IsBool ) then begin ' rVisible := ' 'vcm_osf' aState .GetUP "Visible" ';' \n end // ( aState .GetUP "Visible" IsBool ) if ( aState .GetUP "Checked" IsBool ) then begin ' rChecked := ' 'vcm_osf' aState .GetUP "Checked" ';' \n end // ( aState .GetUP "Checked" IsBool ) 'end' ';' ] .Out ) // aState .IfDef: ) // HookOut: ) // .for> 'end' ';' ] .Out ) // Indented: ) // HookOut: ) // .for> ) // .for> ] ) // aMade .AddMethodWithParams: cUserCodePrefix Self ) // MakeIniProcedure: ) // .join> ToArray: end // ( Self .IsVCMControls ) ; // RULES RULES ( Self .IsVCMFormsPack ) begin if ( Self .Abstraction at_final == ) then begin .join> ToArray: ( 'RegisterModule' MakeIniProcedure: ( IN aMade aMade -> Parent := ( Self .WeakRef ) aMade .AddMethodWithParams: cUserCodePrefix Self ( IN Self [ VAR l_ModuleTypeName Self .TypeName >>> l_ModuleTypeName VAR l_ModuleName Self .Name >>> l_ModuleName ' ' 'TvcmModulesForRegister.AddModule(' 'TvcmModuleForRegister_C(' l_ModuleTypeName ', ' cQuote Self .Documentation cQuote ')' ')' ';' elem: RegisterModuleOperations Self .OperationsEx .filter> .IsModuleOperationPrim .for> ( IN anOp \n ' ' 'TvcmModuleOperationsForRegister.AddOperation(' 'TvcmModuleOperationForRegister_C(' l_ModuleTypeName ', ' cQuote anOp .Name cQuote ', ' cQuote anOp .Documentation cQuote ', ' anOp .UPisTrue "no prefix" ', ' 'g_module_opcode_' l_ModuleName '_' anOp .Name ')' ')' ';' ) // .for> Self .InheritsEx .for> call.me ; // RegisterModuleOperations Self .RegisterModuleOperations ] ) // aMade .AddMethodWithParams: cUserCodePrefix Self ) // MakeIniProcedure: ) // .join> ToArray: end // ( Self .Abstraction at_final == ) end // ( Self .IsVCMFormsPack ) ; // RULES if ( Self .IsClassOrMixIn ) then begin Self .InheritsEx .join> ( Self .ImplementsEx ) .filter> .IsMixIn .for> ( IN aMixIn VAR l_HasIni false >>> l_HasIni //aMixIn call.me .NotEmpty >>> l_HasIni if ( l_HasIni ! ) then begin aMixIn .ForChildren> .All ( IN aChild if ( aChild call.me .NotEmpty ) then begin true >>> l_HasIni end // ( aChild call.me .NotEmpty ) ) // aMixIn .ForChildren> .All end // ( l_HasIni ! ) if l_HasIni then begin .join> ToArray: ( aMixIn .Name '_Include' Cat MakeIniProcedure: ( IN aMade aMade .AddMethodWithParams: cUserCodePrefix aMixIn ( IN aMixIn [ HookOut: ( aMixIn .OutMixInInclude ) // HookOut: ] ) // aMade .AddMethodWithParams: cUserCodePrefix aMixIn ) // aMixIn .Name 'Include' Cat MakeIniProcedure: ) // .join> ToArray: end // l_HasIni ) // .for> end // ( Self .IsClassOrMixIn ) ) >>> 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> ( IN anIni if ( l_WasOut ! ) then begin true >>> l_WasOut true >>> l_WasInitialization OutInitialization end // ( l_WasOut ! ) Self .IfDef: ( anIni .OutIniOrFini ) // Self .IfDef: ) // .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 VAR l_WasConst false >>> l_WasConst Self .ForChildren> .All ( .ConstantsEx .filter> ( .ConstantsListVisibility PrivateAccess == ) if .OutConstantsList ( true >>> l_WasConst ) ) if l_WasConst then OutLn 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.TvcmApplicationRunner.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 .MainAncestorThatNotMixIn .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 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 TransformWord //Self .Name Msg ; // TransformWord elem_proc DoTransformWord RULES ( Self .MDAClass class_Dependency == ) () ( Self .MDAClass class_Parameter == ) () ( Self %% 'WasTransformed' NotValid ) begin Self -> WasTransformed := true Self .TransformWord end // ( Self %% '#Transformed' NotValid ) ; // RULES ; // DoTransformWord elem_proc Generate g_GeneratedFiles .IsNil ?FAIL 'Массив g_GeneratedFiles не инициализирован' g_GeneratedElements .IsNil ?FAIL 'Массив g_GeneratedElements не инициализирован' TF g_TransformWord ( @ .DoTransformWord >>> g_TransformWord Self .DoTransformWord Self .call.generators.in.list ( .pas .res.cmd .rc .rc.script .dfm ) ) // TF g_TransformWord ; // Generate
Заметки о тестировании, программировании и прочий "поток сознания", который жалко писать "в стол"