paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-12-15 23:40:34 +01:00
Code Issues Packages Projects Releases Wiki Activity

codetools: lfmtrees are now kept

Browse Source 
git-svn-id: trunk@14826 -
This commit is contained in:
mattias 2008-04-15 12:08:36 +00:00
parent d4554a0a9b
commit 92e555f7da
6 changed files with 124 additions and 33 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
components/codetools/codetoolmanager.pas
View File

@ -543,7 +543,7 @@ type
write FOnFindDefineProperty;
function FindLFMFileName(Code: TCodeBuffer): string;
function CheckLFM(UnitCode, LFMBuf: TCodeBuffer;
var LFMTree: TLFMTree;
out LFMTree: TLFMTree;
RootMustBeClassInIntf, ObjectsMustExists: boolean): boolean;
function FindNextResourceFile(Code: TCodeBuffer;
var LinkIndex: integer): TCodeBuffer;
@ -779,6 +779,7 @@ begin
IdentifierList:=TIdentifierList.Create;
IdentifierHistory:=TIdentifierHistoryList.Create;
IdentifierList.History:=IdentifierHistory;
DefaultLFMTrees:=TLFMTrees.Create;
end;
destructor TCodeToolManager.Destroy;
@ -790,6 +791,7 @@ begin
{$IFDEF CTDEBUG}
DebugLn('[TCodeToolManager.Destroy] B');
{$ENDIF}
FreeAndNil(DefaultLFMTrees);
FreeAndNil(Positions);
FreeAndNil(IdentifierHistory);
FreeAndNil(IdentifierList);
@ -3778,7 +3780,7 @@ begin
end;
function TCodeToolManager.CheckLFM(UnitCode, LFMBuf: TCodeBuffer;
var LFMTree: TLFMTree; RootMustBeClassInIntf, ObjectsMustExists: boolean
out LFMTree: TLFMTree; RootMustBeClassInIntf, ObjectsMustExists: boolean
): boolean;
begin
Result:=false;

103
components/codetools/lfmtrees.pas
View File

@ -30,7 +30,7 @@ unit LFMTrees;
interface
uses
Classes, SysUtils, FileProcs, CodeCache, CodeAtom, TypInfo;
Classes, SysUtils, AVL_Tree, FileProcs, CodeCache, CodeAtom, TypInfo;
type
{ TLFMTreeNode }
@ -231,6 +231,8 @@ type
function GetNodePath: string;
end;
TLFMTrees = class;
{ TLFMTree }
TLFMTree = class
@ -247,10 +249,13 @@ type
LFMBuffer: TCodeBuffer;
FirstError: TLFMError;
LastError: TLFMError;
Trees: TLFMTrees;
constructor Create(TheTrees: TLFMTrees; aLFMBuf: TCodeBuffer);
constructor Create;
destructor Destroy; override;
procedure Clear;
function Parse(LFMBuf: TCodeBuffer): boolean;
procedure ClearErrors;
function Parse(LFMBuf: TCodeBuffer = nil): boolean;
function PositionToCaret(p: integer): TPoint;
procedure AddError(ErrorType: TLFMErrorType; LFMNode: TLFMTreeNode;
const ErrorMessage: string; ErrorPosition: integer);
@ -260,6 +265,19 @@ type
function FirstErrorAsString: string;
end;
{ TLFMTrees }
TLFMTrees = class
private
FItems: TAVLTree;// tree of TLFMTree sorted for LFMBuffer
public
constructor Create;
destructor Destroy; override;
procedure Clear;
function GetLFMTree(LFMBuffer: TCodeBuffer;
CreateIfNotExists: boolean): TLFMTree;
end;
TInstancePropInfo = record
Instance: TPersistent;
PropInfo: PPropInfo;
@ -281,9 +299,15 @@ const
);
procedure FreeListOfPInstancePropInfo(List: TFPList);
function CompareLFMTreesByLFMBuffer(Data1, Data2: Pointer): integer;
function CompareLFMBufWithTree(Buf, Tree: Pointer): integer;
var
DefaultLFMTrees: TLFMTrees = nil;
implementation
procedure FreeListOfPInstancePropInfo(List: TFPList);
var
i: Integer;
@ -297,6 +321,16 @@ begin
List.Free;
end;
function CompareLFMTreesByLFMBuffer(Data1, Data2: Pointer): integer;
begin
Result:=ComparePointers(TLFMTree(Data1).LFMBuffer,TLFMTree(Data2).LFMBuffer);
end;
function CompareLFMBufWithTree(Buf, Tree: Pointer): integer;
begin
Result:=ComparePointers(Buf,TLFMTree(Tree).LFMBuffer);
end;
{ TLFMTree }
constructor TLFMTree.Create;
@ -306,6 +340,7 @@ end;
destructor TLFMTree.Destroy;
begin
Clear;
if Trees<>nil then Trees.FItems.Remove(Self);
inherited Destroy;
end;
@ -313,18 +348,28 @@ procedure TLFMTree.Clear;
begin
LFMBuffer:=nil;
CurNode:=nil;
while FirstError<>nil do FirstError.Free;
ClearErrors;
while Root<>nil do Root.Free;
end;
function TLFMTree.Parse(LFMBuf: TCodeBuffer): boolean;
procedure TLFMTree.ClearErrors;
begin
while FirstError<>nil do FirstError.Free;
end;
function TLFMTree.Parse(LFMBuf: TCodeBuffer = nil): boolean;
var
LFMStream: TMemoryStream;
Src: String;
begin
Result:=false;
Clear;
LFMBuffer:=LFMBuf;
if LFMBuf<>LFMBuffer then begin
if Trees<>nil then
raise Exception.Create('TLFMTree.Parse: changing LFMBuffer in Tree is not allowed');
LFMBuffer:=LFMBuf;
end;
LFMStream:=TMemoryStream.Create;
Src:=LFMBuffer.Source;
if Src<>'' then begin
@ -644,6 +689,16 @@ begin
CurNode:=CurNode.Parent;
end;
constructor TLFMTree.Create(TheTrees: TLFMTrees; aLFMBuf: TCodeBuffer);
begin
if (TheTrees=nil)
or (aLFMBuf=nil) then
raise Exception.Create('TLFMTree.Create need tree and buffer');
Trees:=TheTrees;
Trees.FItems.Add(Self);
LFMBuffer:=aLFMBuf;
end;
{ TLFMTreeNode }
constructor TLFMTreeNode.CreateVirtual;
@ -987,5 +1042,43 @@ begin
FNames[FCount-1]:=Name;
end;
{ TLFMTrees }
constructor TLFMTrees.Create;
begin
FItems:=TAVLTree.Create(@CompareLFMTreesByLFMBuffer);
end;
destructor TLFMTrees.Destroy;
begin
Clear;
FreeAndNil(FItems);
inherited Destroy;
end;
procedure TLFMTrees.Clear;
begin
FItems.FreeAndClear;
end;
function TLFMTrees.GetLFMTree(LFMBuffer: TCodeBuffer; CreateIfNotExists: boolean
): TLFMTree;
var
AVLNode: TAVLTreeNode;
begin
AVLNode:=FItems.FindKey(LFMBuffer,@CompareLFMBufWithTree);
if AVLNode<>nil then
Result:=TLFMTree(AVLNode.Data)
else if CreateIfNotExists then begin
Result:=TLFMTree.Create;
Result.LFMBuffer:=LFMBuffer;
FItems.Add(Result);
end else
Result:=nil;
end;
finalization
FreeAndNil(DefaultLFMTrees);
end.

6
components/codetools/stdcodetools.pas
View File

@ -135,7 +135,7 @@ type
function RenameInclude(LinkIndex: integer; const NewFilename: string;
KeepPath: boolean;
SourceChangeCache: TSourceChangeCache): boolean;
function CheckLFM(LFMBuf: TCodeBuffer; var LFMTree: TLFMTree;
function CheckLFM(LFMBuf: TCodeBuffer; out LFMTree: TLFMTree;
const OnFindDefineProperty: TOnFindDefinePropertyForContext;
RootMustBeClassInIntf, ObjectsMustExists: boolean): boolean;
@ -1542,7 +1542,7 @@ begin
Result:=true;
end;
function TStandardCodeTool.CheckLFM(LFMBuf: TCodeBuffer; var LFMTree: TLFMTree;
function TStandardCodeTool.CheckLFM(LFMBuf: TCodeBuffer; out LFMTree: TLFMTree;
const OnFindDefineProperty: TOnFindDefinePropertyForContext;
RootMustBeClassInIntf, ObjectsMustExists: boolean): boolean;
var
@ -2075,7 +2075,7 @@ begin
Result:=false;
//DebugLn('TStandardCodeTool.CheckLFM A');
// create tree from LFM file
LFMTree:=TLFMTree.Create;
LFMTree:=DefaultLFMTrees.GetLFMTree(LFMBuf,true);
ActivateGlobalWriteLock;
try
//DebugLn('TStandardCodeTool.CheckLFM parsing LFM ...');

2
designer/changeclassdialog.pas
View File

@ -287,8 +287,8 @@ begin
if not InsertStreamedSelection then exit;
finally
ComponentStream.Free;
LFMTree.Free;
OldParents.Free;
// Note: do not free LFMTree, it is cached by the codetools
end;
Result:=mrOk;
end;

35
ide/checklfmdlg.pas
View File

@ -198,10 +198,8 @@ var
end;
// check LFM again
LFMTree.Free;
LFMTree:=nil;
if CodeToolBoss.CheckLFM(PascalBuffer,LFMBuffer,LFMTree,
RootMustBeClassInIntf,ObjectsMustExists)
RootMustBeClassInIntf,ObjectsMustExists)
then begin
DebugLn(['FixMissingComponentClasses Success: All found errors fixed']);
Result:=mrOk;
@ -260,25 +258,20 @@ begin
exit;
end;
LFMTree:=nil;
try
if CodeToolBoss.CheckLFM(PascalBuffer,LFMBuffer,LFMTree,
RootMustBeClassInIntf,ObjectsMustExists)
then begin
DebugLn(['CheckLFMBuffer no errors found']);
Result:=mrOk;
exit;
end;
Result:=FixMissingComponentClasses;
if Result in [mrAbort,mrOk] then begin
DebugLn(['CheckLFMBuffer all errors fixed']);
exit;
end;
WriteLFMErrors;
Result:=ShowRepairLFMWizard(LFMBuffer,LFMTree);
finally
LFMTree.Free;
if CodeToolBoss.CheckLFM(PascalBuffer,LFMBuffer,LFMTree,
RootMustBeClassInIntf,ObjectsMustExists)
then begin
DebugLn(['CheckLFMBuffer no errors found']);
Result:=mrOk;
exit;
end;
Result:=FixMissingComponentClasses;
if Result in [mrAbort,mrOk] then begin
DebugLn(['CheckLFMBuffer all errors fixed']);
exit;
end;
WriteLFMErrors;
Result:=ShowRepairLFMWizard(LFMBuffer,LFMTree);
end;
function CheckLFMText(PascalBuffer: TCodeBuffer; var LFMText: string;

5
ide/main.pp
View File

@ -5307,7 +5307,7 @@ begin
// close old designer form
Result:=CloseUnitComponent(AnUnitInfo,CloseFlags);
if Result<>mrOk then exit;
// check installed packages
if (AnUnitInfo.Component=nil) and AnUnitInfo.IsPartOfProject
and (not (ofProjectLoading in OpenFlags)) then begin
@ -5414,6 +5414,9 @@ begin
AncestorType:=TForm;
//DebugLn('TMainIDE.DoLoadLFM Filename="',AnUnitInfo.Filename,'" AncestorClassName=',AncestorClassName,' AncestorType=',AncestorType.ClassName);
// check lfm
BinStream:=TExtMemoryStream.Create;
TxtLFMStream:=TExtMemoryStream.Create;
try