diff --git a/converter/convcodetool.pas b/converter/convcodetool.pas index f500e51f3d..26f3a9a1b3 100644 --- a/converter/convcodetool.pas +++ b/converter/convcodetool.pas @@ -101,8 +101,6 @@ type function FindApptypeConsole: boolean; function FixMainClassAncestor(const AClassName: string; AReplaceTypes: TStringToStringTree): boolean; - function CheckTopOffsets(LFMBuf: TCodeBuffer; LFMTree: TLFMTree; - VisOffsets: TVisualOffsets; ValueNodes: TObjectList): boolean; public property HasFormFile: boolean read fHasFormFile write fHasFormFile; property LowerCaseRes: boolean read fLowerCaseRes write fLowerCaseRes; @@ -723,320 +721,5 @@ begin Result:=true; end; // ReplaceFuncCalls -function TConvDelphiCodeTool.CheckTopOffsets(LFMBuf: TCodeBuffer; LFMTree: TLFMTree; - VisOffsets: TVisualOffsets; ValueNodes: TObjectList): boolean; -// Collect a list of coord attributes for components that are inside -// a visual container component. An offset will be added to those attributes. -// Parameters: VisOffsets has names of parent container types. -// ValueNodes - the found coord attributes are added here as TSrcPropOffset objects. -// Based on function CheckLFM. -var - RootContext: TFindContext; - - function CheckLFMObjectValues(LFMObject: TLFMObjectNode; - const ClassContext: TFindContext; GrandClassName: string): boolean; forward; - - function FindLFMIdentifier(LFMNode: TLFMTreeNode; const IdentName: string; - const ClassContext: TFindContext; out IdentContext: TFindContext): boolean; - var - Params: TFindDeclarationParams; - IsPublished: Boolean; - begin - Result:=false; - IdentContext:=CleanFindContext; - IsPublished:=false; - if (ClassContext.Node=nil) or (not (ClassContext.Node.Desc in AllClasses)) then - exit; - Params:=TFindDeclarationParams.Create; - try - Params.Flags:=[fdfSearchInAncestors,fdfExceptionOnNotFound, - fdfExceptionOnPredefinedIdent,fdfIgnoreMissingParams, - fdfIgnoreOverloadedProcs]; - Params.ContextNode:=ClassContext.Node; - Params.SetIdentifier(ClassContext.Tool,PChar(Pointer(IdentName)),nil); - try - if ClassContext.Tool.FindIdentifierInContext(Params) then begin - Result:=true; - repeat - IdentContext:=CreateFindContext(Params); - if (not IsPublished) - and (IdentContext.Node.HasParentOfType(ctnClassPublished)) then - IsPublished:=true; - if (IdentContext.Node<>nil) - and (IdentContext.Node.Desc=ctnProperty) - and (IdentContext.Tool.PropNodeIsTypeLess(IdentContext.Node)) then - begin - // this is a typeless property -> search further - Params.Clear; - Params.Flags:=[fdfSearchInAncestors, fdfIgnoreMissingParams, - fdfIgnoreCurContextNode, fdfIgnoreOverloadedProcs]; - Params.ContextNode:=IdentContext.Node.Parent; - while (Params.ContextNode<>nil) - and (not (Params.ContextNode.Desc in AllClasses)) do - Params.ContextNode:=Params.ContextNode.Parent; - if Params.ContextNode<>nil then begin - Params.SetIdentifier(ClassContext.Tool,PChar(Pointer(IdentName)),nil); - if not IdentContext.Tool.FindIdentifierInContext(Params) then - break; - end; - end else - break; - until false; - end; - except - on E: ECodeToolError do ; // ignore search/parse errors - end; - finally - Params.Free; - end; - end; - - function FindClassNodeForLFMObject(LFMNode: TLFMTreeNode; - StartTool: TFindDeclarationTool; DefinitionNode: TCodeTreeNode): TFindContext; - var - Params: TFindDeclarationParams; - Identifier: PChar; - OldInput: TFindDeclarationInput; - begin - Result:=CleanFindContext; - if (DefinitionNode.Desc=ctnIdentifier) then - Identifier:=@StartTool.Src[DefinitionNode.StartPos] - else if DefinitionNode.Desc=ctnProperty then - Identifier:=StartTool.GetPropertyTypeIdentifier(DefinitionNode) - else - Identifier:=nil; - if Identifier=nil then exit; - Params:=TFindDeclarationParams.Create; - try - Params.Flags:=[fdfSearchInAncestors, fdfExceptionOnNotFound, - fdfSearchInParentNodes, fdfExceptionOnPredefinedIdent, - fdfIgnoreMissingParams, fdfIgnoreOverloadedProcs]; - Params.ContextNode:=DefinitionNode; - Params.SetIdentifier(StartTool,Identifier,nil); - try - Params.Save(OldInput); - if StartTool.FindIdentifierInContext(Params) then begin - Params.Load(OldInput,true); - Result:=Params.NewCodeTool.FindBaseTypeOfNode(Params,Params.NewNode); - if (Result.Node=nil) - or (not (Result.Node.Desc in AllClasses)) then - Result:=CleanFindContext; - end; - except - on E: ECodeToolError do ; // ignore search/parse errors - end; - finally - Params.Free; - end; - end; - - function FindClassContext(const ClassName: string): TFindContext; - var - Params: TFindDeclarationParams; - Identifier: PChar; - OldInput: TFindDeclarationInput; - StartTool: TStandardCodeTool; - begin - Result:=CleanFindContext; - Params:=TFindDeclarationParams.Create; - StartTool:=fCTLink.CodeTool; - Identifier:=PChar(Pointer(ClassName)); - try - Params.Flags:=[fdfExceptionOnNotFound, fdfSearchInParentNodes, - fdfExceptionOnPredefinedIdent,fdfIgnoreMissingParams, - fdfIgnoreOverloadedProcs]; - with fCTLink.CodeTool do begin - Params.ContextNode:=FindInterfaceNode; - if Params.ContextNode=nil then - Params.ContextNode:=FindMainUsesSection; - Params.SetIdentifier(StartTool,Identifier,nil); - try - Params.Save(OldInput); - if FindIdentifierInContext(Params) then begin - Params.Load(OldInput,true); - Result:=Params.NewCodeTool.FindBaseTypeOfNode(Params,Params.NewNode); - if (Result.Node=nil) - or (not (Result.Node.Desc in AllClasses)) then - Result:=CleanFindContext; - end; - except - on E: ECodeToolError do ; // ignore search/parse errors - end; - end; - finally - Params.Free; - end; - end; - - procedure CheckLFMChildObject(LFMObject: TLFMObjectNode; const ParentName: string); - var - VarTypeName: String; - ChildContext: TFindContext; - ClassContext: TFindContext; - DefinitionNode: TCodeTreeNode; - begin - // find variable for object - if LFMObject.Name='' then exit; - if FindLFMIdentifier(LFMObject, LFMObject.Name, RootContext, ChildContext) then begin - if ChildContext.Node=nil then exit; - // check if identifier is a variable or property - VarTypeName:=''; - if (ChildContext.Node.Desc=ctnVarDefinition) then begin - DefinitionNode:=ChildContext.Tool.FindTypeNodeOfDefinition(ChildContext.Node); - if DefinitionNode=nil then exit; - VarTypeName:=ChildContext.Tool.ExtractDefinitionNodeType(ChildContext.Node); - end else if (ChildContext.Node.Desc=ctnProperty) then begin - DefinitionNode:=ChildContext.Node; - VarTypeName:=ChildContext.Tool.ExtractPropType(ChildContext.Node,false,false); - end else - exit; - // check if variable/property has a compatible type - if (VarTypeName<>'') and (LFMObject.TypeName<>'') - and (CompareIdentifiers(PChar(VarTypeName), - PChar(LFMObject.TypeName))<>0) then exit; - // find class node - ClassContext:=FindClassNodeForLFMObject(LFMObject, ChildContext.Tool, DefinitionNode); - end else - ClassContext:=FindClassContext(LFMObject.TypeName); // try the object type - // check child LFM nodes - // ClassContext.Node=nil when the parent class is not found in source. - if ClassContext.Node<>nil then - CheckLFMObjectValues(LFMObject, ClassContext, ParentName); - end; - - function FindClassNodeForPropertyType(LFMProperty: TLFMPropertyNode; - const PropertyContext: TFindContext): TFindContext; - var - Params: TFindDeclarationParams; - begin - Result:=CleanFindContext; - Params:=TFindDeclarationParams.Create; - try - Params.Flags:=[fdfSearchInAncestors, fdfExceptionOnNotFound, - fdfSearchInParentNodes,fdfExceptionOnPredefinedIdent, - fdfIgnoreMissingParams,fdfIgnoreOverloadedProcs]; - Params.ContextNode:=PropertyContext.Node; - Params.SetIdentifier(PropertyContext.Tool,nil,nil); - try - Result:=PropertyContext.Tool.FindBaseTypeOfNode(Params, PropertyContext.Node); - except - on E: ECodeToolError do ; // ignore search/parse errors - end; - finally - Params.Free; - end; - end; - - procedure CheckLFMProperty(LFMProperty: TLFMPropertyNode; const ParentContext: TFindContext; - const GrandClassName, ParentClassName: string); - // Check properties. Stores info about Top and Left properties for later adjustment. - // Parameters: LFMProperty is the property node - // ParentContext is the context, where properties are searched (class or property). - // GrandClassName and ParentClassName are the class type names. - var - i, ind: Integer; - ValNode: TLFMValueNode; - CurName, Prop: string; - CurPropContext: TFindContext; - SearchContext: TFindContext; - begin - // find complete property name - Prop:=LFMProperty.CompleteName; - if Prop='' then exit; - if (Prop='Top') or (Prop='Left') then begin - if (GrandClassName<>'') and VisOffsets.Find(GrandClassName, ind) then begin - if LFMProperty.FirstChild is TLFMValueNode then begin - ValNode:=LFMProperty.FirstChild as TLFMValueNode; - ValueNodes.Add(TSrcPropOffset.Create(GrandClassName,ParentClassName, - Prop,ValNode.StartPos)); - end; - end; - end; - // find every part of the property name - SearchContext:=ParentContext; - for i:=0 to LFMProperty.NameParts.Count-1 do begin - if SearchContext.Node.Desc=ctnProperty then begin - // get the type of the property and search the class node - SearchContext:=FindClassNodeForPropertyType(LFMProperty, SearchContext); - if SearchContext.Node=nil then exit; - end; - CurName:=LFMProperty.NameParts.Names[i]; - if not FindLFMIdentifier(LFMProperty, CurName, SearchContext, CurPropContext) then - break; - if CurPropContext.Node=nil then break; - SearchContext:=CurPropContext; - end; - end; - - function CheckLFMObjectValues(LFMObject: TLFMObjectNode; - const ClassContext: TFindContext; GrandClassName: string): boolean; - var - CurLFMNode: TLFMTreeNode; - ParentName: string; - begin - ParentName:=ClassContext.Tool.ExtractClassName(ClassContext.Node, False); - CurLFMNode:=LFMObject.FirstChild; - while CurLFMNode<>nil do begin - case CurLFMNode.TheType of - lfmnObject: - CheckLFMChildObject(TLFMObjectNode(CurLFMNode), ParentName); - lfmnProperty: - CheckLFMProperty(TLFMPropertyNode(CurLFMNode), ClassContext, - GrandClassName, ParentName); - end; - CurLFMNode:=CurLFMNode.NextSibling; - end; - Result:=true; - end; - - function CheckLFMRoot(RootLFMNode: TLFMTreeNode): boolean; - var - LookupRootLFMNode: TLFMObjectNode; - LookupRootTypeName: String; - RootClassNode: TCodeTreeNode; - begin - Result:=false; - // get root object node - if (RootLFMNode=nil) or (not (RootLFMNode is TLFMObjectNode)) then exit; - LookupRootLFMNode:=TLFMObjectNode(RootLFMNode); - - // get type name of root object - LookupRootTypeName:=UpperCaseStr(LookupRootLFMNode.TypeName); - if LookupRootTypeName='' then exit; - - // find root type - RootClassNode:=fCTLink.CodeTool.FindClassNodeInUnit(LookupRootTypeName, - true,false,false,false); - RootContext:=CleanFindContext; - RootContext.Node:=RootClassNode; - RootContext.Tool:=fCTLink.CodeTool; - if RootClassNode=nil then exit; - Result:=CheckLFMObjectValues(LookupRootLFMNode, RootContext, ''); - end; - -var - CurRootLFMNode: TLFMTreeNode; -begin - Result:=false; - // create tree from LFM file - LFMTree:=DefaultLFMTrees.GetLFMTree(LFMBuf,true); - fCTLink.CodeTool.ActivateGlobalWriteLock; - try - if not LFMTree.ParseIfNeeded then exit; - // parse unit and find LookupRoot - fCTLink.CodeTool.BuildTree(true); - // find every identifier - CurRootLFMNode:=LFMTree.Root; - while CurRootLFMNode<>nil do begin - if not CheckLFMRoot(CurRootLFMNode) then exit; - CurRootLFMNode:=CurRootLFMNode.NextSibling; - end; - finally - fCTLink.CodeTool.DeactivateGlobalWriteLock; - end; - Result:=LFMTree.FirstError=nil; -end; // CheckTopOffsets - - end. diff --git a/converter/convertertypes.pas b/converter/convertertypes.pas index a26de5a3a0..17cb15dc63 100644 --- a/converter/convertertypes.pas +++ b/converter/convertertypes.pas @@ -12,7 +12,7 @@ type TAddUnitEvent = procedure(AUnitName: string) of object; TCheckUnitEvent = function (AUnitName: string): Boolean of object; - { TopOffset } + { TSrcPropOffset } // Used when fixing top coordinates of controls inside a visual container. TSrcPropOffset = class @@ -32,7 +32,7 @@ type { TVisualOffset } - // User defined settings. + // User defined settings of visual offsets. TVisualOffset = class private fParentType: string; @@ -50,6 +50,7 @@ type { TVisualOffsets } + // Collection of TVisualOffset items. TVisualOffsets = class(TObjectList) private function GetVisualOffset(Index: Integer): TVisualOffset; @@ -63,7 +64,23 @@ type write SetVisualOffset; default; end; - // types for errors + { TAddPropEntry } + + // A new property to be added to lfm form file. + TAddPropEntry = class + private + fStartPos: integer; + fEndPos: integer; + fNewText: string; + fParentType: string; + public + constructor Create(aStartPos, aEndPos: Integer; const aNewText, aParentType: string); + destructor Destroy; override; + property StartPos: integer read fStartPos; + property EndPos: integer read fEndPos; + property NewText: string read fNewText; + property ParentType: string read fParentType; + end; { EConverterError } @@ -74,15 +91,7 @@ type implementation -{ EConverterError } - -constructor EDelphiConverterError.Create(const AMessage: string); -begin - inherited Create('Converter: '+AMessage); -end; - - -{ TopOffset } +{ TSrcPropOffset } constructor TSrcPropOffset.Create(aParentType, aChildType, aPropName: string; aStartPos: integer); begin @@ -97,7 +106,6 @@ begin inherited Destroy; end; - { TVisualOffset } constructor TVisualOffset.Create(const aParentType: string; aTop, aLeft: Integer); @@ -122,7 +130,6 @@ begin Result:=0 end; - { TVisualOffsets } constructor TVisualOffsets.Create; @@ -172,6 +179,28 @@ begin Inherited Items[Index]:=AValue; end; +{ TAddPropEntry } + +constructor TAddPropEntry.Create(aStartPos, aEndPos: Integer; const aNewText, aParentType: string); +begin + inherited Create; + fStartPos:=aStartPos; + fEndPos:=aEndPos; + fNewText:=aNewText; + fParentType:=aParentType; +end; + +destructor TAddPropEntry.Destroy; +begin + inherited Destroy; +end; + +{ EConverterError } + +constructor EDelphiConverterError.Create(const AMessage: string); +begin + inherited Create('Converter: '+AMessage); +end; end. diff --git a/converter/missingpropertiesdlg.pas b/converter/missingpropertiesdlg.pas index 085ff91fcd..55c1ebe0b1 100644 --- a/converter/missingpropertiesdlg.pas +++ b/converter/missingpropertiesdlg.pas @@ -78,6 +78,7 @@ type fTypeReplaceGrid: TStringGrid; function ReplaceAndRemoveAll: TModalResult; function ReplaceTopOffsets(aSrcOffsets: TList): TModalResult; + function AddNewProps(aNewProps: TList): TModalResult; // Fill StringGrids with missing properties and types from fLFMTree. procedure FillReplaceGrids; protected @@ -134,6 +135,8 @@ implementation {$R *.lfm} +uses FormFileConv; + function ConvertDfmToLfm(const DfmFilename: string): TModalResult; var DFMConverter: TDFMConverter; @@ -347,15 +350,14 @@ end; function TLFMFixer.ReplaceTopOffsets(aSrcOffsets: TList): TModalResult; // Replace top coordinates of controls in visual containers. -// Returns mrOK if no types were changed, and mrCancel if there was an error. var TopOffs: TSrcPropOffset; VisOffs: TVisualOffset; - OldNum, Ofs, NewNum, Len, ind, i: integer; + OldNum, NewNum, Len, ind, i: integer; begin Result:=mrOK; // Add offset to top coordinates. - for i := aSrcOffsets.Count-1 downto 0 do begin + for i:=aSrcOffsets.Count-1 downto 0 do begin TopOffs:=TSrcPropOffset(aSrcOffsets[i]); if fSettings.CoordOffsets.Find(TopOffs.ParentType, ind) then begin VisOffs:=fSettings.CoordOffsets[ind]; @@ -367,8 +369,7 @@ begin except on EConvertError do OldNum:=0; end; - Ofs:=VisOffs.ByProperty(TopOffs.PropName); - NewNum:=OldNum-Ofs; + NewNum:=OldNum-VisOffs.ByProperty(TopOffs.PropName); if NewNum<0 then NewNum:=0; fLFMBuffer.Replace(TopOffs.StartPos, Len, IntToStr(NewNum)); @@ -378,6 +379,21 @@ begin end; end; +function TLFMFixer.AddNewProps(aNewProps: TList): TModalResult; +// Add new property to the lfm file. +var + Entry: TAddPropEntry; + i: integer; +begin + Result:=mrOK; + for i:=aNewProps.Count-1 downto 0 do begin + Entry:=TAddPropEntry(aNewProps[i]); + fLFMBuffer.Replace(Entry.StartPos, Entry.EndPos-Entry.StartPos,Entry.NewText); + IDEMessagesWindow.AddMsg(Format('Added property "%s" for %s.', + [Entry.NewText, Entry.ParentType]),'',-1); + end; +end; + procedure TLFMFixer.FillReplaceGrids; var PropUpdater: TGridUpdater; @@ -454,7 +470,9 @@ end; function TLFMFixer.Repair: TModalResult; var ConvTool: TConvDelphiCodeTool; - ValueTreeNodes: TObjectList; + FormFileTool: TFormFileConverter; + SrcCoordOffs: TObjectList; + SrcNewProps: TObjectList; LoopCount: integer; begin Result:=mrCancel; @@ -462,33 +480,44 @@ begin if not fLFMTree.ParseIfNeeded then exit; // Change a type that main form inherits from to a fall-back type if needed. ConvTool:=TConvDelphiCodeTool.Create(fCTLink); - ValueTreeNodes:=TObjectList.Create; try if not ConvTool.FixMainClassAncestor(TLFMObjectNode(fLFMTree.Root).TypeName, fSettings.ReplaceTypes) then exit; - LoopCount:=0; - repeat - if CodeToolBoss.CheckLFM(fPascalBuffer,fLFMBuffer,fLFMTree, - fRootMustBeClassInUnit,fRootMustBeClassInIntf,fObjectsMustExists) then - Result:=mrOk - else // Rename/remove properties and types interactively. - Result:=ShowRepairLFMWizard; // Can return mrRetry. - Inc(LoopCount); - until (Result in [mrOK, mrCancel]) or (LoopCount=10); - // Show remaining errors to user. - WriteLFMErrors; - if (Result=mrOK) and (fSettings.CoordOffsMode=rsEnabled) then begin - // Fix top offsets of some components in visual containers - if ConvTool.CheckTopOffsets(fLFMBuffer, fLFMTree, - fSettings.CoordOffsets, ValueTreeNodes) then - Result:=ReplaceTopOffsets(ValueTreeNodes) - else - Result:=mrCancel; - end; finally - ValueTreeNodes.Free; ConvTool.Free; end; + LoopCount:=0; + repeat + if CodeToolBoss.CheckLFM(fPascalBuffer,fLFMBuffer,fLFMTree, + fRootMustBeClassInUnit,fRootMustBeClassInIntf,fObjectsMustExists) then + Result:=mrOk + else // Rename/remove properties and types interactively. + Result:=ShowRepairLFMWizard; // Can return mrRetry. + Inc(LoopCount); + until (Result in [mrOK, mrCancel]) or (LoopCount=10); + // Show remaining errors to user. + WriteLFMErrors; + if (Result=mrOK) and (fSettings.CoordOffsMode=rsEnabled) then begin + // Fix top offsets of some components in visual containers + FormFileTool:=TFormFileConverter.Create(fCTLink, fLFMBuffer); + SrcCoordOffs:=TObjectList.Create; + SrcNewProps:=TObjectList.Create; + try + FormFileTool.VisOffsets:=fSettings.CoordOffsets; + FormFileTool.SrcCoordOffs:=SrcCoordOffs; + FormFileTool.SrcNewProps:=SrcNewProps; + Result:=FormFileTool.Convert; + if Result=mrOK then begin + Result:=ReplaceTopOffsets(SrcCoordOffs); + if Result=mrOK then + Result:=AddNewProps(SrcNewProps); + end; + finally + SrcNewProps.Free; + SrcCoordOffs.Free; + FormFileTool.Free; + end; + end; end;