mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-31 04:42:11 +02:00
TXMLConfig: implemented path cache
git-svn-id: trunk@25649 -
This commit is contained in:
mattias
parent
2ba8bc1ae2
commit
bc526dfe8e
@ -63,12 +63,20 @@ type
|
||||
FModified: Boolean;
|
||||
fDoNotLoadFromFile: boolean;
|
||||
fAutoLoadFromSource: string;
|
||||
fPathCache: string;
|
||||
fPathNodeCache: array of TDomNode; // starting with doc.DocumentElement, then first child node of first sub path
|
||||
procedure Loaded; override;
|
||||
function ExtendedToStr(const e: extended): string;
|
||||
function StrToExtended(const s: string; const ADefault: extended): extended;
|
||||
procedure ReadXMLFile(out ADoc: TXMLDocument; const AFilename: String); virtual;
|
||||
procedure WriteXMLFile(ADoc: TXMLDocument; const AFileName: String); virtual;
|
||||
procedure FreeDoc; virtual;
|
||||
procedure SetPathNodeCache(Index: integer; Node: TDomNode);
|
||||
function GetPathNodeCache(Index: integer): TDomNode;
|
||||
procedure InvalidateCacheTilEnd(StartIndex: integer);
|
||||
function InternalFindNode(const APath: String; PathLen: integer;
|
||||
CreateNodes: boolean = false): TDomNode;
|
||||
procedure InternalCleanNode(Node: TDomNode);
|
||||
public
|
||||
constructor Create(const AFilename: String); overload; // create and load
|
||||
constructor CreateClean(const AFilename: String); // create new
|
||||
@ -96,8 +104,9 @@ type
|
||||
procedure DeletePath(const APath: string);
|
||||
procedure DeleteValue(const APath: string);
|
||||
function FindNode(const APath: String; PathHasValue: boolean): TDomNode;
|
||||
function HasPath(const APath: string; PathHasValue: boolean): boolean;
|
||||
function HasPath(const APath: string; PathHasValue: boolean): boolean; // checks if the path has values, set PathHasValue=true to skip the last part
|
||||
property Modified: Boolean read FModified write FModified;
|
||||
procedure InvalidatePathCache;
|
||||
published
|
||||
property Filename: String read FFilename write SetFilename;
|
||||
property Document: TXMLDocument read doc;
|
||||
@ -124,12 +133,8 @@ end;
|
||||
constructor TXMLConfig.CreateClean(const AFilename: String);
|
||||
begin
|
||||
//DebugLn(['TXMLConfig.CreateClean ',AFilename]);
|
||||
{$IFDEF NewXMLCfg}
|
||||
FReadFlags:=[xrfAllowLowerThanInAttributeValue,xrfAllowSpecialCharsInAttributeValue];
|
||||
{$ENDIF}
|
||||
inherited Create(nil);
|
||||
fDoNotLoadFromFile:=true;
|
||||
SetFilename(AFilename);
|
||||
Create(AFilename);
|
||||
FModified:=FileExistsCached(AFilename);
|
||||
end;
|
||||
|
||||
@ -201,48 +206,25 @@ end;
|
||||
|
||||
function TXMLConfig.GetValue(const APath, ADefault: String): String;
|
||||
var
|
||||
Node, Child, Attr: TDOMNode;
|
||||
Node, Attr: TDOMNode;
|
||||
NodeName: String;
|
||||
PathLen: integer;
|
||||
StartPos, EndPos: integer;
|
||||
StartPos: integer;
|
||||
begin
|
||||
//CheckHeapWrtMemCnt('TXMLConfig.GetValue A '+APath);
|
||||
Result:=ADefault;
|
||||
PathLen:=length(APath);
|
||||
Node := doc.DocumentElement;
|
||||
StartPos:=1;
|
||||
while True do begin
|
||||
EndPos:=StartPos;
|
||||
while (EndPos<=PathLen) and (APath[EndPos]<>'/') do inc(EndPos);
|
||||
if EndPos>PathLen then break;
|
||||
if EndPos>StartPos then begin
|
||||
NodeName:='';
|
||||
SetLength(NodeName,EndPos-StartPos);
|
||||
//UniqueString(NodeName);
|
||||
Move(APath[StartPos],NodeName[1],EndPos-StartPos);
|
||||
Child := Node.FindNode(NodeName);
|
||||
//writeln('TXMLConfig.GetValue C NodeName="',NodeName,'" ',
|
||||
// PCardinal(Cardinal(NodeName)-8)^,' ',PCardinal(Cardinal(NodeName)-4)^);
|
||||
//CheckHeapWrtMemCnt('TXMLConfig.GetValue B2');
|
||||
if not Assigned(Child) then exit;
|
||||
Node := Child;
|
||||
end;
|
||||
StartPos:=EndPos+1;
|
||||
//CheckHeapWrtMemCnt('TXMLConfig.GetValue D');
|
||||
end;
|
||||
if StartPos>PathLen then exit;
|
||||
|
||||
StartPos:=length(APath)+1;
|
||||
while (StartPos>1) and (APath[StartPos-1]<>'/') do dec(StartPos);
|
||||
if StartPos>length(APath) then exit;
|
||||
Node:=InternalFindNode(APath,StartPos-1);
|
||||
if Node=nil then
|
||||
exit;
|
||||
//CheckHeapWrtMemCnt('TXMLConfig.GetValue E');
|
||||
NodeName:='';
|
||||
SetLength(NodeName,PathLen-StartPos+1);
|
||||
//CheckHeapWrtMemCnt('TXMLConfig.GetValue F '+IntToStr(length(NodeName))+' '+IntToStr(StartPos)+' '+IntToStr(length(APath))+' '+APath[StartPos]);
|
||||
//UniqueString(NodeName);
|
||||
Move(APath[StartPos],NodeName[1],length(NodeName));
|
||||
NodeName:=copy(APath,StartPos,length(APath));
|
||||
//CheckHeapWrtMemCnt('TXMLConfig.GetValue G');
|
||||
//writeln('TXMLConfig.GetValue G2 NodeName="',NodeName,'"');
|
||||
Attr := Node.Attributes.GetNamedItem(NodeName);
|
||||
if Assigned(Attr) then
|
||||
Result := Attr.NodeValue;
|
||||
//CheckHeapWrtMemCnt('TXMLConfig.GetValue H');
|
||||
//writeln('TXMLConfig.GetValue END Result="',Result,'"');
|
||||
end;
|
||||
|
||||
@ -278,33 +260,17 @@ end;
|
||||
|
||||
procedure TXMLConfig.SetValue(const APath, AValue: String);
|
||||
var
|
||||
Node, Child: TDOMNode;
|
||||
Node: TDOMNode;
|
||||
NodeName: String;
|
||||
PathLen: integer;
|
||||
StartPos, EndPos: integer;
|
||||
StartPos: integer;
|
||||
begin
|
||||
Node := Doc.DocumentElement;
|
||||
PathLen:=length(APath);
|
||||
StartPos:=1;
|
||||
while True do begin
|
||||
EndPos:=StartPos;
|
||||
while (EndPos<=PathLen) and (APath[EndPos]<>'/') do inc(EndPos);
|
||||
if EndPos>PathLen then break;
|
||||
SetLength(NodeName,EndPos-StartPos);
|
||||
Move(APath[StartPos],NodeName[1],EndPos-StartPos);
|
||||
StartPos:=EndPos+1;
|
||||
Child := Node.FindNode(NodeName);
|
||||
if not Assigned(Child) then
|
||||
begin
|
||||
Child := Doc.CreateElement(NodeName);
|
||||
Node.AppendChild(Child);
|
||||
end;
|
||||
Node := Child;
|
||||
end;
|
||||
|
||||
if StartPos>PathLen then exit;
|
||||
SetLength(NodeName,PathLen-StartPos+1);
|
||||
Move(APath[StartPos],NodeName[1],length(NodeName));
|
||||
StartPos:=length(APath)+1;
|
||||
while (StartPos>1) and (APath[StartPos-1]<>'/') do dec(StartPos);
|
||||
if StartPos>length(APath) then exit;
|
||||
Node:=InternalFindNode(APath,StartPos-1,true);
|
||||
if Node=nil then
|
||||
exit;
|
||||
NodeName:=copy(APath,StartPos,length(APath));
|
||||
if (not Assigned(TDOMElement(Node).GetAttributeNode(NodeName))) or
|
||||
(TDOMElement(Node)[NodeName] <> AValue) then
|
||||
begin
|
||||
@ -368,13 +334,8 @@ begin
|
||||
end;
|
||||
|
||||
procedure TXMLConfig.DeletePath(const APath: string);
|
||||
var
|
||||
Node: TDomNode;
|
||||
begin
|
||||
Node:=FindNode(APath,false);
|
||||
if (Node=nil) or (Node.ParentNode=nil) then exit;
|
||||
Node.ParentNode.RemoveChild(Node);
|
||||
FModified := True;
|
||||
InternalCleanNode(InternalFindNode(APath,length(APath)));
|
||||
end;
|
||||
|
||||
procedure TXMLConfig.DeleteValue(const APath: string);
|
||||
@ -382,7 +343,6 @@ var
|
||||
Node: TDomNode;
|
||||
StartPos: integer;
|
||||
NodeName: string;
|
||||
ParentNode: TDOMNode;
|
||||
begin
|
||||
Node:=FindNode(APath,true);
|
||||
if (Node=nil) then exit;
|
||||
@ -393,15 +353,7 @@ begin
|
||||
TDOMElement(Node).RemoveAttribute(NodeName);
|
||||
FModified := True;
|
||||
end;
|
||||
while (Node.FirstChild=nil) and (Node.ParentNode<>nil)
|
||||
and (Node.ParentNode.ParentNode<>nil) do begin
|
||||
if (Node is TDOMElement) and (not TDOMElement(Node).IsEmpty) then break;
|
||||
ParentNode:=Node.ParentNode;
|
||||
//writeln('TXMLConfig.DeleteValue APath="',APath,'" NodeName=',Node.NodeName,' ',Node.ClassName);
|
||||
ParentNode.RemoveChild(Node);
|
||||
Node:=ParentNode;
|
||||
FModified := True;
|
||||
end;
|
||||
InternalCleanNode(Node);
|
||||
end;
|
||||
|
||||
procedure TXMLConfig.Loaded;
|
||||
@ -414,25 +366,14 @@ end;
|
||||
function TXMLConfig.FindNode(const APath: String;
|
||||
PathHasValue: boolean): TDomNode;
|
||||
var
|
||||
NodePath: String;
|
||||
StartPos, EndPos: integer;
|
||||
PathLen: integer;
|
||||
PathLen: Integer;
|
||||
begin
|
||||
Result := doc.DocumentElement;
|
||||
PathLen:=length(APath);
|
||||
StartPos:=1;
|
||||
while (Result<>nil) do begin
|
||||
EndPos:=StartPos;
|
||||
while (EndPos<=PathLen) and (APath[EndPos]<>'/') do inc(EndPos);
|
||||
if (EndPos>PathLen) and PathHasValue then exit;
|
||||
if EndPos=StartPos then break;
|
||||
SetLength(NodePath,EndPos-StartPos);
|
||||
Move(APath[StartPos],NodePath[1],length(NodePath));
|
||||
Result := Result.FindNode(NodePath);
|
||||
StartPos:=EndPos+1;
|
||||
if StartPos>PathLen then exit;
|
||||
if PathHasValue then begin
|
||||
while (PathLen>0) and (APath[PathLen]<>'/') do dec(PathLen);
|
||||
while (PathLen>0) and (APath[PathLen]='/') do dec(PathLen);
|
||||
end;
|
||||
Result:=nil;
|
||||
Result:=InternalFindNode(APath,PathLen);
|
||||
end;
|
||||
|
||||
function TXMLConfig.HasPath(const APath: string; PathHasValue: boolean
|
||||
@ -441,6 +382,12 @@ begin
|
||||
Result:=FindNode(APath,PathHasValue)<>nil;
|
||||
end;
|
||||
|
||||
procedure TXMLConfig.InvalidatePathCache;
|
||||
begin
|
||||
fPathCache:='';
|
||||
InvalidateCacheTilEnd(0);
|
||||
end;
|
||||
|
||||
function TXMLConfig.ExtendedToStr(const e: extended): string;
|
||||
var
|
||||
OldDecimalSeparator: Char;
|
||||
@ -473,6 +420,7 @@ end;
|
||||
procedure TXMLConfig.ReadXMLFile(out ADoc: TXMLDocument; const AFilename: String
|
||||
);
|
||||
begin
|
||||
InvalidatePathCache;
|
||||
{$IFDEF NewXMLCfg}
|
||||
Laz2_XMLRead.ReadXMLFile(ADoc,AFilename,ReadFlags);
|
||||
{$ELSE}
|
||||
@ -491,9 +439,108 @@ end;
|
||||
|
||||
procedure TXMLConfig.FreeDoc;
|
||||
begin
|
||||
InvalidatePathCache;
|
||||
FreeAndNil(doc);
|
||||
end;
|
||||
|
||||
procedure TXMLConfig.SetPathNodeCache(Index: integer; Node: TDomNode);
|
||||
var
|
||||
OldLength: Integer;
|
||||
i: LongInt;
|
||||
NewSize: Integer;
|
||||
begin
|
||||
OldLength:=length(fPathNodeCache);
|
||||
if OldLength<=Index then begin
|
||||
NewSize:=OldLength*2+4;
|
||||
if NewSize<Index then NewSize:=Index;
|
||||
SetLength(fPathNodeCache,NewSize);
|
||||
for i:=OldLength to length(fPathNodeCache)-1 do
|
||||
fPathNodeCache[i]:=nil;
|
||||
end;
|
||||
fPathNodeCache[Index]:=Node;
|
||||
end;
|
||||
|
||||
function TXMLConfig.GetPathNodeCache(Index: integer): TDomNode;
|
||||
begin
|
||||
if Index<length(fPathNodeCache) then
|
||||
Result:=fPathNodeCache[Index]
|
||||
else
|
||||
Result:=nil;
|
||||
end;
|
||||
|
||||
procedure TXMLConfig.InvalidateCacheTilEnd(StartIndex: integer);
|
||||
var
|
||||
i: LongInt;
|
||||
begin
|
||||
for i:=StartIndex to length(fPathNodeCache)-1 do begin
|
||||
if fPathNodeCache[i]=nil then break;
|
||||
fPathNodeCache[i]:=nil;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TXMLConfig.InternalFindNode(const APath: String; PathLen: integer;
|
||||
CreateNodes: boolean): TDomNode;
|
||||
var
|
||||
NodePath: String;
|
||||
StartPos, EndPos: integer;
|
||||
PathIndex: Integer;
|
||||
Parent: TDOMNode;
|
||||
NameLen: Integer;
|
||||
begin
|
||||
//debugln(['TXMLConfig.InternalFindNode APath="',copy(APath,1,PathLen),'" CreateNodes=',CreateNodes]);
|
||||
PathIndex:=0;
|
||||
Result:=GetPathNodeCache(PathIndex);
|
||||
if Result=nil then begin
|
||||
Result := doc.DocumentElement;
|
||||
SetPathNodeCache(PathIndex,Result);
|
||||
end;
|
||||
StartPos:=1;
|
||||
while (Result<>nil) do begin
|
||||
EndPos:=StartPos;
|
||||
while (EndPos<=PathLen) and (APath[EndPos]<>'/') do inc(EndPos);
|
||||
NameLen:=EndPos-StartPos;
|
||||
if NameLen=0 then break;
|
||||
inc(PathIndex);
|
||||
Parent:=Result;
|
||||
Result:=GetPathNodeCache(PathIndex);
|
||||
if (Result<>nil) and (length(Result.NodeName)=NameLen)
|
||||
and CompareMem(PChar(Result.NodeName),@APath[StartPos],NameLen) then begin
|
||||
// cache valid
|
||||
end else begin
|
||||
// different path => search
|
||||
InvalidateCacheTilEnd(PathIndex);
|
||||
NodePath:=copy(APath,StartPos,NameLen);
|
||||
Result:=Parent.FindNode(NodePath);
|
||||
if Result=nil then begin
|
||||
if not CreateNodes then exit;
|
||||
// create missing node
|
||||
Result := Doc.CreateElement(NodePath);
|
||||
Parent.AppendChild(Result);
|
||||
if EndPos>PathLen then exit;
|
||||
end;
|
||||
SetPathNodeCache(PathIndex,Result);
|
||||
end;
|
||||
StartPos:=EndPos+1;
|
||||
if StartPos>PathLen then exit;
|
||||
end;
|
||||
Result:=nil;
|
||||
end;
|
||||
|
||||
procedure TXMLConfig.InternalCleanNode(Node: TDomNode);
|
||||
var
|
||||
ParentNode: TDOMNode;
|
||||
begin
|
||||
if (Node=nil) then exit;
|
||||
while (Node.FirstChild=nil) and (Node.ParentNode<>nil)
|
||||
and (Node.ParentNode.ParentNode<>nil) do begin
|
||||
if (Node is TDOMElement) and (not TDOMElement(Node).IsEmpty) then break;
|
||||
ParentNode:=Node.ParentNode;
|
||||
ParentNode.RemoveChild(Node);
|
||||
Node:=ParentNode;
|
||||
FModified := True;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TXMLConfig.SetFilename(const AFilename: String);
|
||||
var
|
||||
cfg: TDOMElement;
|
||||
@ -502,6 +549,7 @@ begin
|
||||
{$IFDEF MEM_CHECK}CheckHeapWrtMemCnt('TXMLConfig.SetFilename A '+AFilename);{$ENDIF}
|
||||
if FFilename = AFilename then exit;
|
||||
FFilename := AFilename;
|
||||
InvalidatePathCache;
|
||||
|
||||
if csLoading in ComponentState then
|
||||
exit;
|
||||
|
||||
@ -753,7 +753,9 @@ var
|
||||
DockSiblingBounds: TRect;
|
||||
Offset: TPoint;
|
||||
begin
|
||||
{$IFDEF VerboseIDEDocking}
|
||||
debugln(['TSimpleWindowLayoutList.ApplyAndShow Form=',DbgSName(AForm)]);
|
||||
{$ENDIF}
|
||||
try
|
||||
ALayout:=ItemByFormID(AForm.Name);
|
||||
if ALayout<>nil then
|
||||
|
||||
@ -8345,7 +8345,9 @@ end;
|
||||
procedure TSourceEditorManager.CreateSourceWindow(Sender: TObject;
|
||||
aFormName: string; var AForm: TCustomForm);
|
||||
begin
|
||||
{$IFDEF VerboseIDEDocking}
|
||||
debugln(['TSourceEditorManager.CreateSourceWindow Sender=',DbgSName(Sender),' FormName="',aFormName,'"']);
|
||||
{$ENDIF}
|
||||
AForm := CreateNewWindow(false);
|
||||
AForm.Name:=aFormName;
|
||||
end;
|
||||
@ -8359,7 +8361,9 @@ begin
|
||||
i:=StrToIntDef(
|
||||
copy(aFormName,length(NonModalIDEWindowNames[nmiwSourceNoteBookName])+1,
|
||||
length(aFormName)),0);
|
||||
{$IFDEF VerboseIDEDocking}
|
||||
debugln(['TSourceEditorManager.GetDefaultLayout ',aFormName,' i=',i]);
|
||||
{$ENDIF}
|
||||
aBounds:=Bounds(250+30*i,160+30*i,
|
||||
Min(1000,(Screen.Width*7) div 10),(Screen.Height*7) div 10);
|
||||
end;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user