mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-08 00:02:03 +02:00
IDE: Use a better XML tag format for project etc. info files. Issue #22752, patch from Ondrej.
git-svn-id: trunk@60683 -
This commit is contained in:
juha
parent
8611d4078b
commit
5d46a75ff6
@ -247,7 +247,8 @@ type
|
||||
pfLRSFilesInOutputDirectory, // put .lrs files in output directory
|
||||
pfUseDefaultCompilerOptions, // load users default compiler options
|
||||
pfSaveJumpHistory,
|
||||
pfSaveFoldState
|
||||
pfSaveFoldState,
|
||||
pfCompatibilityMode // use legacy file format to maximize compatibility with old Lazarus versions
|
||||
);
|
||||
TProjectFlags = set of TProjectFlag;
|
||||
|
||||
@ -274,7 +275,8 @@ const
|
||||
'LRSInOutputDirectory',
|
||||
'UseDefaultCompilerOptions',
|
||||
'SaveJumpHistory',
|
||||
'SaveFoldState'
|
||||
'SaveFoldState',
|
||||
'CompatibilityMode'
|
||||
);
|
||||
ProjectSessionStorageNames: array[TProjectSessionStorage] of string = (
|
||||
'InProjectInfo',
|
||||
|
||||
@ -16,6 +16,7 @@
|
||||
}
|
||||
|
||||
{$MODE objfpc}
|
||||
{$modeswitch advancedrecords}
|
||||
{$H+}
|
||||
|
||||
unit Laz2_XMLCfg;
|
||||
@ -50,10 +51,23 @@ type
|
||||
procedure SetFilename(const AFilename: String);
|
||||
protected
|
||||
type
|
||||
TDomNodeArray = array of TDomNode;
|
||||
TNodeCache = record
|
||||
Node: TDomNode;
|
||||
NodeSearchName: string;
|
||||
ChildrenValid: boolean;
|
||||
Children: array of TDomNode; // nodes with NodeName<>'' and sorted
|
||||
Children: TDomNodeArray; // child nodes with NodeName<>'' and sorted
|
||||
|
||||
NodeListName: string;
|
||||
NodeList: TDomNodeArray; // child nodes that are accessed with "name[?]" XPath
|
||||
|
||||
public
|
||||
class procedure GrowArray(var aArray: TDomNodeArray; aCount: Integer); static;
|
||||
procedure RefreshChildren;
|
||||
procedure RefreshChildrenIfNeeded;
|
||||
procedure RefreshNodeList(const ANodeName: string);
|
||||
procedure RefreshNodeListIfNeeded(const ANodeName: string);
|
||||
function AddNodeToList: TDOMNode;
|
||||
end;
|
||||
protected
|
||||
doc: TXMLDocument;
|
||||
@ -68,13 +82,15 @@ type
|
||||
procedure ReadXMLFile(out ADoc: TXMLDocument; const AFilename: String); virtual;
|
||||
procedure WriteXMLFile(ADoc: TXMLDocument; const AFileName: String); virtual;
|
||||
procedure FreeDoc; virtual;
|
||||
procedure SetPathNodeCache(Index: integer; aNode: TDomNode);
|
||||
procedure SetPathNodeCache(Index: integer; aNode: TDomNode; aNodeSearchName: string = '');
|
||||
function GetCachedPathNode(Index: integer): TDomNode; inline;
|
||||
function GetCachedPathNode(Index: integer; out aNodeSearchName: string): TDomNode; inline;
|
||||
procedure InvalidateCacheTilEnd(StartIndex: integer);
|
||||
function InternalFindNode(const APath: String; PathLen: integer;
|
||||
CreateNodes: boolean = false): TDomNode;
|
||||
procedure InternalCleanNode(Node: TDomNode);
|
||||
function FindChildNode(PathIndex: integer; const aName: string): TDomNode;
|
||||
function FindChildNode(PathIndex: integer; const aName: string;
|
||||
CreateNodes: boolean = false): TDomNode;
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override; overload;
|
||||
constructor Create(const AFilename: String); overload; // create and load
|
||||
@ -109,6 +125,12 @@ type
|
||||
// checks if the path has values, set PathHasValue=true to skip the last part
|
||||
function HasPath(const APath: string; PathHasValue: boolean): boolean;
|
||||
function HasChildPaths(const APath: string): boolean;
|
||||
function GetChildCount(const APath: string): Integer;
|
||||
function IsLegacyList(const APath: string): Boolean;
|
||||
function GetListItemCount(const APath, AItemName: string; const aLegacyList: Boolean): Integer;
|
||||
function GetListItemXPath(const AName: string; const AIndex: Integer; const aLegacyList: Boolean;
|
||||
const aLegacyList1Based: Boolean = False): string;
|
||||
procedure SetListItemCount(const APath: string; const ACount: Integer; const ALegacyList: Boolean);
|
||||
property Modified: Boolean read FModified write FModified;
|
||||
procedure InvalidatePathCache;
|
||||
published
|
||||
@ -150,13 +172,119 @@ begin
|
||||
Result:=CompareStr(Node1.NodeName,Node2.NodeName);
|
||||
end;
|
||||
|
||||
{ TXMLConfig.TNodeCache }
|
||||
|
||||
function TXMLConfig.TNodeCache.AddNodeToList: TDOMNode;
|
||||
begin
|
||||
Result:=Node.OwnerDocument.CreateElement(NodeListName);
|
||||
Node.AppendChild(Result);
|
||||
SetLength(NodeList, Length(NodeList)+1);
|
||||
NodeList[High(NodeList)]:=Result;
|
||||
end;
|
||||
|
||||
class procedure TXMLConfig.TNodeCache.GrowArray(var aArray: TDomNodeArray;
|
||||
aCount: Integer);
|
||||
var
|
||||
cCount: Integer;
|
||||
begin
|
||||
cCount:=length(aArray);
|
||||
if aCount>cCount then begin
|
||||
if cCount<8 then
|
||||
cCount:=8
|
||||
else
|
||||
cCount:=cCount*2;
|
||||
if aCount>cCount then
|
||||
cCount := aCount;
|
||||
SetLength(aArray,cCount);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TXMLConfig.TNodeCache.RefreshChildren;
|
||||
var
|
||||
aCount, m: Integer;
|
||||
aChild: TDOMNode;
|
||||
begin
|
||||
// collect all children and sort
|
||||
aCount:=0;
|
||||
aChild:=Node.FirstChild;
|
||||
while aChild<>nil do begin
|
||||
if aChild.NodeName<>'' then begin
|
||||
GrowArray(Children, aCount+1);
|
||||
Children[aCount]:=aChild;
|
||||
inc(aCount);
|
||||
end;
|
||||
aChild:=aChild.NextSibling;
|
||||
end;
|
||||
SetLength(Children,aCount);
|
||||
if aCount>1 then
|
||||
MergeSortWithLen(@Children[0],aCount,@CompareDomNodeNames); // sort ascending [0]<[1]
|
||||
for m:=0 to aCount-2 do
|
||||
if Children[m].NodeName=Children[m+1].NodeName then begin
|
||||
// duplicate found: nodes with same name
|
||||
// -> use only the first
|
||||
Children[m+1]:=Children[m];
|
||||
end;
|
||||
ChildrenValid:=true;
|
||||
end;
|
||||
|
||||
procedure TXMLConfig.TNodeCache.RefreshChildrenIfNeeded;
|
||||
begin
|
||||
if not ChildrenValid then
|
||||
RefreshChildren;
|
||||
end;
|
||||
|
||||
procedure TXMLConfig.TNodeCache.RefreshNodeList(const ANodeName: string);
|
||||
var
|
||||
aCount: Integer;
|
||||
aChild: TDOMNode;
|
||||
begin
|
||||
aCount:=0;
|
||||
aChild:=Node.FirstChild;
|
||||
while aChild<>nil do
|
||||
begin
|
||||
if aChild.NodeName=ANodeName then
|
||||
begin
|
||||
GrowArray(NodeList, aCount+1);
|
||||
NodeList[aCount]:=aChild;
|
||||
inc(aCount);
|
||||
end;
|
||||
aChild:=aChild.NextSibling;
|
||||
end;
|
||||
SetLength(NodeList,aCount);
|
||||
NodeListName := ANodeName;
|
||||
end;
|
||||
|
||||
procedure TXMLConfig.TNodeCache.RefreshNodeListIfNeeded(const ANodeName: string
|
||||
);
|
||||
begin
|
||||
if NodeListName<>ANodeName then
|
||||
RefreshNodeList(ANodeName);
|
||||
end;
|
||||
|
||||
// inline
|
||||
function TXMLConfig.GetCachedPathNode(Index: integer): TDomNode;
|
||||
function TXMLConfig.GetCachedPathNode(Index: integer; out
|
||||
aNodeSearchName: string): TDomNode;
|
||||
begin
|
||||
if Index<length(fPathNodeCache) then
|
||||
Result:=fPathNodeCache[Index].Node
|
||||
else
|
||||
begin
|
||||
Result:=fPathNodeCache[Index].Node;
|
||||
aNodeSearchName:=fPathNodeCache[Index].NodeSearchName;
|
||||
end else
|
||||
begin
|
||||
Result:=nil;
|
||||
aNodeSearchName:='';
|
||||
end;
|
||||
end;
|
||||
|
||||
function TXMLConfig.GetChildCount(const APath: string): Integer;
|
||||
var
|
||||
Node: TDOMNode;
|
||||
begin
|
||||
Node:=FindNode(APath,false);
|
||||
if Node=nil then
|
||||
Result := 0
|
||||
else
|
||||
Result := Node.GetChildCount;
|
||||
end;
|
||||
|
||||
constructor TXMLConfig.Create(const AFilename: String);
|
||||
@ -294,6 +422,41 @@ begin
|
||||
Result:=StrToExtended(GetValue(APath,''),ADefault);
|
||||
end;
|
||||
|
||||
function TXMLConfig.GetListItemCount(const APath, AItemName: string;
|
||||
const aLegacyList: Boolean): Integer;
|
||||
var
|
||||
Node: TDOMNode;
|
||||
NodeLevel: SizeInt;
|
||||
begin
|
||||
if aLegacyList then
|
||||
Result := GetValue(APath+'Count',0)
|
||||
else
|
||||
begin
|
||||
Node:=InternalFindNode(APath,Length(APath));
|
||||
if Node<>nil then
|
||||
begin
|
||||
NodeLevel := Node.GetLevel-1;
|
||||
fPathNodeCache[NodeLevel].RefreshNodeListIfNeeded(AItemName);
|
||||
Result := Length(fPathNodeCache[NodeLevel].NodeList);
|
||||
end else
|
||||
Result := 0;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TXMLConfig.GetListItemXPath(const AName: string;
|
||||
const AIndex: Integer; const aLegacyList: Boolean;
|
||||
const aLegacyList1Based: Boolean): string;
|
||||
begin
|
||||
if ALegacyList then
|
||||
begin
|
||||
if aLegacyList1Based then
|
||||
Result := AName+IntToStr(AIndex+1)
|
||||
else
|
||||
Result := AName+IntToStr(AIndex);
|
||||
end else
|
||||
Result := AName+'['+IntToStr(AIndex+1)+']';
|
||||
end;
|
||||
|
||||
procedure TXMLConfig.SetValue(const APath, AValue: String);
|
||||
var
|
||||
Node: TDOMNode;
|
||||
@ -450,6 +613,11 @@ begin
|
||||
InvalidateCacheTilEnd(0);
|
||||
end;
|
||||
|
||||
function TXMLConfig.IsLegacyList(const APath: string): Boolean;
|
||||
begin
|
||||
Result := GetValue(APath+'Count',-1)>1;
|
||||
end;
|
||||
|
||||
function TXMLConfig.ExtendedToStr(const e: extended): string;
|
||||
begin
|
||||
Result := FloatToStr(e, FPointSettings);
|
||||
@ -478,7 +646,15 @@ begin
|
||||
FreeAndNil(doc);
|
||||
end;
|
||||
|
||||
procedure TXMLConfig.SetPathNodeCache(Index: integer; aNode: TDomNode);
|
||||
function TXMLConfig.GetCachedPathNode(Index: integer): TDomNode;
|
||||
var
|
||||
x: string;
|
||||
begin
|
||||
Result := GetCachedPathNode(Index, x);
|
||||
end;
|
||||
|
||||
procedure TXMLConfig.SetPathNodeCache(Index: integer; aNode: TDomNode;
|
||||
aNodeSearchName: string);
|
||||
var
|
||||
OldLength, NewLength: Integer;
|
||||
begin
|
||||
@ -495,9 +671,13 @@ begin
|
||||
exit
|
||||
else
|
||||
InvalidateCacheTilEnd(Index+1);
|
||||
if aNodeSearchName='' then
|
||||
aNodeSearchName:=aNode.NodeName;
|
||||
with fPathNodeCache[Index] do begin
|
||||
Node:=aNode;
|
||||
NodeSearchName:=aNodeSearchName;
|
||||
ChildrenValid:=false;
|
||||
NodeListName:='';
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -510,6 +690,7 @@ begin
|
||||
if Node=nil then break;
|
||||
Node:=nil;
|
||||
ChildrenValid:=false;
|
||||
NodeListName:='';
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
@ -517,11 +698,9 @@ end;
|
||||
function TXMLConfig.InternalFindNode(const APath: String; PathLen: integer;
|
||||
CreateNodes: boolean): TDomNode;
|
||||
var
|
||||
NodePath: String;
|
||||
NodePath, NdName: String;
|
||||
StartPos, EndPos: integer;
|
||||
PathIndex: Integer;
|
||||
Parent: TDOMNode;
|
||||
NdName: DOMString;
|
||||
NameLen: Integer;
|
||||
begin
|
||||
//debugln(['TXMLConfig.InternalFindNode APath="',copy(APath,1,PathLen),'" CreateNodes=',CreateNodes]);
|
||||
@ -539,25 +718,15 @@ begin
|
||||
NameLen:=EndPos-StartPos;
|
||||
if NameLen=0 then break;
|
||||
inc(PathIndex);
|
||||
Parent:=Result;
|
||||
Result:=GetCachedPathNode(PathIndex);
|
||||
if Result<>nil then
|
||||
NdName:=Result.NodeName;
|
||||
Result:=GetCachedPathNode(PathIndex,NdName);
|
||||
if (Result=nil) or (length(NdName)<>NameLen)
|
||||
or not CompareMem(PChar(NdName),@APath[StartPos],NameLen) then begin
|
||||
// different path => search
|
||||
NodePath:=copy(APath,StartPos,NameLen);
|
||||
Result:=FindChildNode(PathIndex-1,NodePath);
|
||||
if Result=nil then begin
|
||||
if not CreateNodes then exit;
|
||||
// create missing node
|
||||
Result:=Doc.CreateElement(NodePath);
|
||||
Parent.AppendChild(Result);
|
||||
fPathNodeCache[PathIndex-1].ChildrenValid:=false;
|
||||
InvalidateCacheTilEnd(PathIndex);
|
||||
if EndPos>PathLen then exit;
|
||||
end;
|
||||
SetPathNodeCache(PathIndex,Result);
|
||||
Result:=FindChildNode(PathIndex-1,NodePath,CreateNodes);
|
||||
if Result=nil then
|
||||
Exit;
|
||||
SetPathNodeCache(PathIndex,Result,NodePath);
|
||||
end;
|
||||
StartPos:=EndPos+1;
|
||||
if StartPos>PathLen then exit;
|
||||
@ -581,62 +750,56 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function TXMLConfig.FindChildNode(PathIndex: integer; const aName: string
|
||||
): TDomNode;
|
||||
function TXMLConfig.FindChildNode(PathIndex: integer; const aName: string;
|
||||
CreateNodes: boolean): TDomNode;
|
||||
var
|
||||
aParent, aChild: TDOMNode;
|
||||
aCount: Integer;
|
||||
NewLength: Integer;
|
||||
l, r, m: Integer;
|
||||
cmp: Integer;
|
||||
cmp, BrPos: Integer;
|
||||
NodeName: string;
|
||||
begin
|
||||
with fPathNodeCache[PathIndex] do begin
|
||||
if not ChildrenValid then begin
|
||||
// collect all children and sort
|
||||
aParent:=Node;
|
||||
aCount:=0;
|
||||
aChild:=aParent.FirstChild;
|
||||
while aChild<>nil do begin
|
||||
if aChild.NodeName<>'' then begin
|
||||
if aCount=length(Children) then begin
|
||||
NewLength:=length(Children);
|
||||
if NewLength<8 then
|
||||
NewLength:=8
|
||||
else
|
||||
NewLength:=NewLength*2;
|
||||
SetLength(Children,NewLength);
|
||||
end;
|
||||
Children[aCount]:=aChild;
|
||||
inc(aCount);
|
||||
end;
|
||||
aChild:=aChild.NextSibling;
|
||||
end;
|
||||
SetLength(Children,aCount);
|
||||
if aCount>1 then
|
||||
MergeSortWithLen(@Children[0],aCount,@CompareDomNodeNames); // sort ascending [0]<[1]
|
||||
for m:=0 to aCount-2 do
|
||||
if Children[m].NodeName=Children[m+1].NodeName then begin
|
||||
// duplicate found: nodes with same name
|
||||
// -> use only the first
|
||||
Children[m+1]:=Children[m];
|
||||
end;
|
||||
ChildrenValid:=true;
|
||||
BrPos := Pos('[', aName);
|
||||
if (Length(aName)>=BrPos+2) and (aName[Length(aName)]=']')
|
||||
and TryStrToInt(Trim(Copy(aName, BrPos+1, Length(aName)-BrPos-1)), m) then
|
||||
begin
|
||||
// support XPath in format "name[?]"
|
||||
NodeName := Trim(Copy(aName, 1, BrPos-1));
|
||||
fPathNodeCache[PathIndex].RefreshNodeListIfNeeded(NodeName);
|
||||
if m<=0 then
|
||||
raise Exception.CreateFmt('Invalid node index in XPath descriptor "%s".', [aName])
|
||||
else if (m<=Length(fPathNodeCache[PathIndex].NodeList)) then
|
||||
Result:=fPathNodeCache[PathIndex].NodeList[m-1]
|
||||
else if CreateNodes then
|
||||
begin
|
||||
for l := Length(fPathNodeCache[PathIndex].NodeList)+1 to m do
|
||||
Result := fPathNodeCache[PathIndex].AddNodeToList;
|
||||
InvalidateCacheTilEnd(PathIndex+1);
|
||||
end;
|
||||
end else
|
||||
begin
|
||||
fPathNodeCache[PathIndex].RefreshChildrenIfNeeded;
|
||||
|
||||
// binary search
|
||||
l:=0;
|
||||
r:=length(Children)-1;
|
||||
r:=length(fPathNodeCache[PathIndex].Children)-1;
|
||||
while l<=r do begin
|
||||
m:=(l+r) shr 1;
|
||||
cmp:=CompareStr(aName,Children[m].NodeName);
|
||||
cmp:=CompareStr(aName,fPathNodeCache[PathIndex].Children[m].NodeName);
|
||||
if cmp<0 then
|
||||
r:=m-1
|
||||
else if cmp>0 then
|
||||
l:=m+1
|
||||
else
|
||||
exit(Children[m]);
|
||||
exit(fPathNodeCache[PathIndex].Children[m]);
|
||||
end;
|
||||
Result:=nil;
|
||||
if CreateNodes then
|
||||
begin
|
||||
// create missing node
|
||||
Result:=Doc.CreateElement(aName);
|
||||
fPathNodeCache[PathIndex].Node.AppendChild(Result);
|
||||
fPathNodeCache[PathIndex].ChildrenValid:=false;
|
||||
InvalidateCacheTilEnd(PathIndex+1);
|
||||
end else
|
||||
Result:=nil;
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -686,6 +849,13 @@ begin
|
||||
{$IFDEF MEM_CHECK}CheckHeapWrtMemCnt('TXMLConfig.SetFilename END');{$ENDIF}
|
||||
end;
|
||||
|
||||
procedure TXMLConfig.SetListItemCount(const APath: string;
|
||||
const ACount: Integer; const ALegacyList: Boolean);
|
||||
begin
|
||||
if ALegacyList then
|
||||
SetDeleteValue(APath+'Count',ACount,0)
|
||||
end;
|
||||
|
||||
procedure TXMLConfig.CreateConfigNode;
|
||||
var
|
||||
cfg: TDOMElement;
|
||||
|
||||
@ -118,13 +118,13 @@ object ProjectMiscOptionsFrame: TProjectMiscOptionsFrame
|
||||
end
|
||||
object ResourceGroupBox: TGroupBox
|
||||
AnchorSideLeft.Control = Owner
|
||||
AnchorSideTop.Control = LRSInOutputDirCheckBox
|
||||
AnchorSideTop.Control = CompatibilityModeCheckBox
|
||||
AnchorSideTop.Side = asrBottom
|
||||
AnchorSideRight.Control = Owner
|
||||
AnchorSideRight.Side = asrBottom
|
||||
Left = 0
|
||||
Height = 81
|
||||
Top = 231
|
||||
Top = 256
|
||||
Width = 536
|
||||
Anchors = [akTop, akLeft, akRight]
|
||||
BorderSpacing.Top = 6
|
||||
@ -139,7 +139,7 @@ object ProjectMiscOptionsFrame: TProjectMiscOptionsFrame
|
||||
ChildSizing.ControlsPerLine = 1
|
||||
ClientHeight = 61
|
||||
ClientWidth = 532
|
||||
TabOrder = 9
|
||||
TabOrder = 10
|
||||
object UseFPCResourcesRadioButton: TRadioButton
|
||||
Left = 6
|
||||
Height = 25
|
||||
@ -183,7 +183,7 @@ object ProjectMiscOptionsFrame: TProjectMiscOptionsFrame
|
||||
AnchorSideTop.Side = asrCenter
|
||||
Left = 0
|
||||
Height = 15
|
||||
Top = 331
|
||||
Top = 356
|
||||
Width = 83
|
||||
Caption = 'PathDelimLabel'
|
||||
ParentColor = False
|
||||
@ -196,7 +196,7 @@ object ProjectMiscOptionsFrame: TProjectMiscOptionsFrame
|
||||
AnchorSideRight.Side = asrBottom
|
||||
Left = 0
|
||||
Height = 3
|
||||
Top = 318
|
||||
Top = 343
|
||||
Width = 536
|
||||
Anchors = [akTop, akLeft, akRight]
|
||||
BorderSpacing.Top = 6
|
||||
@ -209,12 +209,12 @@ object ProjectMiscOptionsFrame: TProjectMiscOptionsFrame
|
||||
AnchorSideRight.Side = asrBottom
|
||||
Left = 89
|
||||
Height = 23
|
||||
Top = 327
|
||||
Top = 352
|
||||
Width = 259
|
||||
BorderSpacing.Left = 6
|
||||
BorderSpacing.Top = 6
|
||||
ItemHeight = 15
|
||||
TabOrder = 10
|
||||
TabOrder = 11
|
||||
Text = 'PathDelimComboBox'
|
||||
end
|
||||
object MainUnitHasScaledStatementCheckBox: TCheckBox
|
||||
@ -231,4 +231,18 @@ object ProjectMiscOptionsFrame: TProjectMiscOptionsFrame
|
||||
ShowHint = True
|
||||
TabOrder = 4
|
||||
end
|
||||
object CompatibilityModeCheckBox: TCheckBox
|
||||
AnchorSideLeft.Control = Owner
|
||||
AnchorSideTop.Control = LRSInOutputDirCheckBox
|
||||
AnchorSideTop.Side = asrBottom
|
||||
Left = 0
|
||||
Height = 19
|
||||
Top = 231
|
||||
Width = 175
|
||||
BorderSpacing.Top = 6
|
||||
Caption = 'CompatibilityModeCheckBox'
|
||||
ParentShowHint = False
|
||||
ShowHint = True
|
||||
TabOrder = 9
|
||||
end
|
||||
end
|
||||
|
||||
@ -25,6 +25,7 @@ type
|
||||
Bevel2: TBevel;
|
||||
LRSInOutputDirCheckBox: TCheckBox;
|
||||
MainUnitHasCreateFormStatementsCheckBox: TCheckBox;
|
||||
CompatibilityModeCheckBox: TCheckBox;
|
||||
MainUnitHasTitleStatementCheckBox: TCheckBox;
|
||||
MainUnitHasScaledStatementCheckBox: TCheckBox;
|
||||
MainUnitHasUsesSectionForAllUnitsCheckBox: TCheckBox;
|
||||
@ -68,6 +69,8 @@ begin
|
||||
MainUnitHasTitleStatementCheckBox.Hint := lisIdeMaintainsTheTitleInMainUnit;
|
||||
MainUnitHasScaledStatementCheckBox.Caption := lisMainUnitHasApplicationScaledStatement;
|
||||
MainUnitHasScaledStatementCheckBox.Hint := lisIdeMaintainsScaledInMainUnit;
|
||||
CompatibilityModeCheckBox.Caption := lisLPICompatibilityModeCheckBox;
|
||||
CompatibilityModeCheckBox.Hint := lisLPICompatibilityModeCheckBoxHint;
|
||||
RunnableCheckBox.Caption := lisProjectIsRunnable;
|
||||
RunnableCheckBox.Hint := lisProjectIsRunnableHint;
|
||||
UseDesignTimePkgsCheckBox.Caption := lisUseDesignTimePackages;
|
||||
@ -96,6 +99,7 @@ begin
|
||||
MainUnitHasCreateFormStatementsCheckBox.Checked := (pfMainUnitHasCreateFormStatements in Flags);
|
||||
MainUnitHasTitleStatementCheckBox.Checked := (pfMainUnitHasTitleStatement in Flags);
|
||||
MainUnitHasScaledStatementCheckBox.Checked := (pfMainUnitHasScaledStatement in Flags);
|
||||
CompatibilityModeCheckBox.Checked := (pfCompatibilityMode in Flags);
|
||||
RunnableCheckBox.Checked := (pfRunnable in Flags);
|
||||
UseDesignTimePkgsCheckBox.Checked := (pfUseDesignTimePackages in Flags);
|
||||
AlwaysBuildCheckBox.Checked := (pfAlwaysBuild in Flags);
|
||||
@ -140,6 +144,8 @@ begin
|
||||
MainUnitHasTitleStatementCheckBox.Checked);
|
||||
SetProjectFlag(pfMainUnitHasScaledStatement,
|
||||
MainUnitHasScaledStatementCheckBox.Checked);
|
||||
SetProjectFlag(pfCompatibilityMode,
|
||||
CompatibilityModeCheckBox.Checked);
|
||||
SetProjectFlag(pfRunnable, RunnableCheckBox.Checked);
|
||||
SetProjectFlag(pfUseDesignTimePackages, UseDesignTimePkgsCheckBox.Checked);
|
||||
SetProjectFlag(pfAlwaysBuild, AlwaysBuildCheckBox.Checked);
|
||||
|
||||
@ -262,7 +262,7 @@ function TOptsImExport.DoExportBuildModes(const Filename: string): TModalResult;
|
||||
begin
|
||||
Result := OpenXML(Filename);
|
||||
if Result <> mrOK then Exit;
|
||||
Project1.BuildModes.SaveProjOptsToXMLConfig(fXMLConfig, '', False);
|
||||
Project1.BuildModes.SaveProjOptsToXMLConfig(fXMLConfig, '', False, True);
|
||||
fXMLConfig.Flush;
|
||||
ShowMessageFmt(lisSuccessfullyExportedBuildModes, [Project1.BuildModes.Count, Filename]);
|
||||
end;
|
||||
|
||||
@ -2695,6 +2695,8 @@ resourcestring
|
||||
lisIdeMaintainsTheTitleInMainUnit = 'The IDE maintains the title in main unit.';
|
||||
lisMainUnitHasApplicationScaledStatement = 'Main unit has Application.Scaled statement';
|
||||
lisIdeMaintainsScaledInMainUnit = 'The IDE maintains Application.Scaled (Hi-DPI) in main unit.';
|
||||
lisLPICompatibilityModeCheckBox = 'Maximize compatibility of project files (LPI and LPS)';
|
||||
lisLPICompatibilityModeCheckBoxHint = 'Check this if you want to open your project in legacy (2.0 and older) Lazarus versions.';
|
||||
lisProjectIsRunnable = 'Project is runnable';
|
||||
lisProjectIsRunnableHint = 'Generates a binary executable which can be run.';
|
||||
lisUseDesignTimePackages = 'Use design time packages';
|
||||
|
||||
@ -590,7 +590,7 @@ type
|
||||
procedure LoadFromXMLConfig(XMLConfig: TXMLConfig; const Path: string);
|
||||
procedure SaveMacroValuesAtOldPlace(XMLConfig: TXMLConfig; const Path: string);
|
||||
procedure SaveToXMLConfig(XMLConfig: TXMLConfig; const Path: string;
|
||||
IsDefault: Boolean; var Cnt: integer);
|
||||
IsDefault, ALegacyList: Boolean; var Cnt: integer);
|
||||
function GetCaption: string; override;
|
||||
function GetIndex: integer; override;
|
||||
public
|
||||
@ -656,9 +656,9 @@ type
|
||||
procedure LoadSessionFromXMLConfig(XMLConfig: TXMLConfig; const Path: string;
|
||||
LoadAllOptions: boolean);
|
||||
procedure SaveProjOptsToXMLConfig(XMLConfig: TXMLConfig; const Path: string;
|
||||
SaveSession: boolean);
|
||||
SaveSession, ALegacyList: boolean);
|
||||
procedure SaveSessionOptsToXMLConfig(XMLConfig: TXMLConfig; const Path: string;
|
||||
SaveSession: boolean);
|
||||
SaveSession, ALegacyList: boolean);
|
||||
public
|
||||
property Items[Index: integer]: TProjectBuildMode read GetItems; default;
|
||||
property ChangeStamp: integer read FChangeStamp;
|
||||
@ -786,6 +786,7 @@ type
|
||||
function GetSourceDirectories: TFileReferenceList;
|
||||
function GetTargetFilename: string;
|
||||
function GetUnits(Index: integer): TUnitInfo;
|
||||
function GetUseLegacyLists: Boolean;
|
||||
function JumpHistoryCheckPosition(
|
||||
APosition:TProjectJumpHistoryPosition): boolean;
|
||||
function OnUnitFileBackup(const Filename: string): TModalResult;
|
||||
@ -1059,6 +1060,7 @@ type
|
||||
property EnableI18NForLFM: boolean read FEnableI18NForLFM write SetEnableI18NForLFM;
|
||||
property I18NExcludedIdentifiers: TStrings read FI18NExcludedIdentifiers;
|
||||
property I18NExcludedOriginals: TStrings read FI18NExcludedOriginals;
|
||||
property UseLegacyLists: Boolean read GetUseLegacyLists;
|
||||
property ForceUpdatePoFiles: Boolean read FForceUpdatePoFiles write FForceUpdatePoFiles;
|
||||
property FirstAutoRevertLockedUnit: TUnitInfo read GetFirstAutoRevertLockedUnit;
|
||||
property FirstLoadedUnit: TUnitInfo read GetFirstLoadedUnit;
|
||||
@ -1135,7 +1137,7 @@ function dbgs(Flags: TUnitInfoFlags): string; overload;
|
||||
implementation
|
||||
|
||||
const
|
||||
ProjectInfoFileVersion = 11;
|
||||
ProjectInfoFileVersion = 12;
|
||||
ProjOptionsPath = 'ProjectOptions/';
|
||||
|
||||
|
||||
@ -2822,12 +2824,13 @@ var
|
||||
SubPath: String;
|
||||
NewUnitFilename: String;
|
||||
OldUnitInfo: TUnitInfo;
|
||||
MergeUnitInfo: Boolean;
|
||||
MergeUnitInfo, LegacyList: Boolean;
|
||||
begin
|
||||
{$IFDEF IDE_MEM_CHECK}CheckHeapWrtMemCnt('TProject.ReadProject D reading units');{$ENDIF}
|
||||
NewUnitCount:=FXMLConfig.GetValue(Path+'Units/Count',0);
|
||||
LegacyList:=(FFileVersion<=11) or FXMLConfig.IsLegacyList(Path+'Units/');
|
||||
NewUnitCount:=FXMLConfig.GetListItemCount(Path+'Units/', 'Unit', LegacyList);
|
||||
for i := 0 to NewUnitCount - 1 do begin
|
||||
SubPath:=Path+'Units/Unit'+IntToStr(i)+'/';
|
||||
SubPath:=Path+'Units/'+FXMLConfig.GetListItemXPath('Unit', i, LegacyList)+'/';
|
||||
NewUnitFilename:=FXMLConfig.GetValue(SubPath+'Filename/Value','');
|
||||
OnLoadSaveFilename(NewUnitFilename,true);
|
||||
// load unit and add it
|
||||
@ -2876,7 +2879,7 @@ procedure TProject.LoadFromLPI;
|
||||
const
|
||||
Path = ProjOptionsPath;
|
||||
begin
|
||||
if (FFileVersion=0) and (FXMLConfig.GetValue(Path+'Units/Count',0)=0) then
|
||||
if (FFileVersion=0) and (FXMLConfig.GetListItemCount(Path+'Units/', 'Unit', UseLegacyLists)=0) then
|
||||
if IDEMessageDialog(lisStrangeLpiFile,
|
||||
Format(lisTheFileDoesNotLookLikeALpiFile, [ProjectInfoFile]),
|
||||
mtConfirmation,[mbIgnore,mbAbort])<>mrIgnore
|
||||
@ -3158,10 +3161,10 @@ begin
|
||||
for i:=0 to UnitCount-1 do
|
||||
if UnitMustBeSaved(Units[i],FProjectWriteFlags,SaveSession) then begin
|
||||
Units[i].SaveToXMLConfig(FXMLConfig,
|
||||
Path+'Units/Unit'+IntToStr(SaveUnitCount)+'/',True,SaveSession,fCurStorePathDelim);
|
||||
Path+'Units/'+FXMLConfig.GetListItemXPath('Unit', i, UseLegacyLists)+'/',True,SaveSession,fCurStorePathDelim);
|
||||
inc(SaveUnitCount);
|
||||
end;
|
||||
FXMLConfig.SetDeleteValue(Path+'Units/Count',SaveUnitCount,0);
|
||||
FXMLConfig.SetListItemCount(Path+'Units/',SaveUnitCount,UseLegacyLists);
|
||||
end;
|
||||
|
||||
procedure TProject.SaveOtherDefines(const Path: string);
|
||||
@ -3206,6 +3209,7 @@ const
|
||||
var
|
||||
CurFlags: TProjectWriteFlags;
|
||||
begin
|
||||
FFileVersion:=ProjectInfoFileVersion;
|
||||
// format
|
||||
FXMLConfig.SetValue(Path+'Version/Value',ProjectInfoFileVersion);
|
||||
FXMLConfig.SetDeleteValue(Path+'PathDelim/Value',PathDelimSwitchToDelim[fCurStorePathDelim],'/');
|
||||
@ -3241,7 +3245,7 @@ begin
|
||||
// save custom data
|
||||
SaveStringToStringTree(FXMLConfig,CustomData,Path+'CustomData/');
|
||||
// Save the macro values and compiler options
|
||||
BuildModes.SaveProjOptsToXMLConfig(FXMLConfig, Path, FSaveSessionInLPI);
|
||||
BuildModes.SaveProjOptsToXMLConfig(FXMLConfig, Path, FSaveSessionInLPI, UseLegacyLists);
|
||||
BuildModes.SaveSharedMatrixOptions(Path);
|
||||
if FSaveSessionInLPI then
|
||||
BuildModes.SaveSessionData(Path);
|
||||
@ -3296,13 +3300,14 @@ procedure TProject.SaveToSession;
|
||||
const
|
||||
Path = 'ProjectSession/';
|
||||
begin
|
||||
FFileVersion:=ProjectInfoFileVersion;
|
||||
fCurStorePathDelim:=SessionStorePathDelim;
|
||||
FXMLConfig.SetDeleteValue(Path+'PathDelim/Value',
|
||||
PathDelimSwitchToDelim[fCurStorePathDelim],'/');
|
||||
FXMLConfig.SetValue(Path+'Version/Value',ProjectInfoFileVersion);
|
||||
|
||||
// Save the session build modes
|
||||
BuildModes.SaveSessionOptsToXMLConfig(FXMLConfig, Path, True);
|
||||
BuildModes.SaveSessionOptsToXMLConfig(FXMLConfig, Path, True, UseLegacyLists);
|
||||
BuildModes.SaveSessionData(Path);
|
||||
// save all units
|
||||
SaveUnits(Path,true);
|
||||
@ -4462,6 +4467,11 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function TProject.GetUseLegacyLists: Boolean;
|
||||
begin
|
||||
Result := (FFileVersion<=11) or (pfCompatibilityMode in Flags);
|
||||
end;
|
||||
|
||||
function TProject.HasProjectInfoFileChangedOnDisk: boolean;
|
||||
var
|
||||
AnUnitInfo: TUnitInfo;
|
||||
@ -6823,13 +6833,13 @@ begin
|
||||
XMLConfig.SetDeleteValue(Path+'Count',Cnt,0);
|
||||
end;
|
||||
|
||||
procedure TProjectBuildMode.SaveToXMLConfig(XMLConfig: TXMLConfig; const Path: string;
|
||||
IsDefault: Boolean; var Cnt: integer);
|
||||
procedure TProjectBuildMode.SaveToXMLConfig(XMLConfig: TXMLConfig;
|
||||
const Path: string; IsDefault, ALegacyList: Boolean; var Cnt: integer);
|
||||
var
|
||||
SubPath: String;
|
||||
begin
|
||||
SubPath:=Path+'BuildModes/'+XMLConfig.GetListItemXPath('Item', Cnt, ALegacyList, True)+'/';
|
||||
inc(Cnt);
|
||||
SubPath:=Path+'BuildModes/Item'+IntToStr(Cnt)+'/';
|
||||
XMLConfig.SetDeleteValue(SubPath+'Name',Identifier,'');
|
||||
if IsDefault then
|
||||
XMLConfig.SetDeleteValue(SubPath+'Default',True,false)
|
||||
@ -7207,10 +7217,12 @@ var
|
||||
i: Integer;
|
||||
Ident, SubPath: String;
|
||||
CurMode: TProjectBuildMode;
|
||||
LegacyList: Boolean;
|
||||
begin
|
||||
LegacyList := FXMLConfig.IsLegacyList(Path);
|
||||
for i:=FromIndex to ToIndex do
|
||||
begin
|
||||
SubPath:=Path+'Item'+IntToStr(i)+'/';
|
||||
SubPath:=Path+FXMLConfig.GetListItemXPath('Item', i-1, LegacyList, True)+'/';
|
||||
Ident:=FXMLConfig.GetValue(SubPath+'Name','');
|
||||
CurMode:=Add(Ident); // add another mode
|
||||
CurMode.InSession:=InSession;
|
||||
@ -7240,13 +7252,15 @@ procedure TProjectBuildModes.LoadAllMacroValues(const Path: string; Cnt: Integer
|
||||
var
|
||||
i: Integer;
|
||||
SubPath: String;
|
||||
IsLegacyList: Boolean;
|
||||
begin
|
||||
// First default mode.
|
||||
LoadMacroValues(Path+'MacroValues/', Items[0]);
|
||||
IsLegacyList := FXMLConfig.IsLegacyList(Path+'BuildModes/');
|
||||
// Iterate rest of the modes.
|
||||
for i:=2 to Cnt do
|
||||
begin
|
||||
SubPath:=Path+'BuildModes/Item'+IntToStr(i)+'/';
|
||||
SubPath:=Path+'BuildModes/'+FXMLConfig.GetListItemXPath('Item', i-1, IsLegacyList, True);
|
||||
LoadMacroValues(SubPath+'MacroValues/', Items[i-1]);
|
||||
end;
|
||||
end;
|
||||
@ -7288,15 +7302,17 @@ procedure TProjectBuildModes.LoadProjOptsFromXMLConfig(XMLConfig: TXMLConfig; co
|
||||
// Load for project
|
||||
var
|
||||
Cnt: Integer;
|
||||
IsLegacyList: Boolean;
|
||||
begin
|
||||
FXMLConfig := XMLConfig;
|
||||
|
||||
Cnt:=FXMLConfig.GetValue(Path+'BuildModes/Count',0);
|
||||
IsLegacyList := FXMLConfig.IsLegacyList(Path+'BuildModes/');
|
||||
Cnt:=FXMLConfig.GetListItemCount(Path+'BuildModes/', 'Item', IsLegacyList);
|
||||
if Cnt>0 then begin
|
||||
// Project default mode is stored at the old XML path for backward compatibility.
|
||||
// Testing the 'Default' XML attribute is not needed because the first mode
|
||||
// is always default.
|
||||
Items[0].Identifier:=FXMLConfig.GetValue(Path+'BuildModes/Item1/Name', '');
|
||||
Items[0].Identifier:=FXMLConfig.GetValue(Path+'BuildModes/'+XMLConfig.GetListItemXPath('Item', 0, IsLegacyList, True)+'/Name', '');
|
||||
Items[0].CompilerOptions.LoadFromXMLConfig(FXMLConfig, 'CompilerOptions/');
|
||||
LoadOtherCompilerOpts(Path+'BuildModes/', 2, Cnt, False);
|
||||
LoadAllMacroValues(Path+'MacroValues/', Cnt);
|
||||
@ -7312,6 +7328,7 @@ procedure TProjectBuildModes.LoadSessionFromXMLConfig(XMLConfig: TXMLConfig;
|
||||
// Load for session
|
||||
var
|
||||
Cnt: Integer;
|
||||
IsLegacyList: Boolean;
|
||||
begin
|
||||
FXMLConfig := XMLConfig;
|
||||
|
||||
@ -7319,7 +7336,8 @@ begin
|
||||
// load matrix options
|
||||
SessionMatrixOptions.LoadFromXMLConfig(FXMLConfig, Path+'BuildModes/SessionMatrixOptions/');
|
||||
|
||||
Cnt:=FXMLConfig.GetValue(Path+'BuildModes/Count',0);
|
||||
IsLegacyList := FXMLConfig.IsLegacyList(Path+'BuildModes/');
|
||||
Cnt:=FXMLConfig.GetListItemCount(Path+'BuildModes/', 'Item', IsLegacyList);
|
||||
if Cnt>0 then begin
|
||||
// Add a new mode for session compiler options.
|
||||
LoadOtherCompilerOpts(Path+'BuildModes/', 1, Cnt, True);
|
||||
@ -7371,7 +7389,7 @@ end;
|
||||
|
||||
// SaveToXMLConfig itself
|
||||
procedure TProjectBuildModes.SaveProjOptsToXMLConfig(XMLConfig: TXMLConfig;
|
||||
const Path: string; SaveSession: boolean);
|
||||
const Path: string; SaveSession, ALegacyList: boolean);
|
||||
var
|
||||
i, Cnt: Integer;
|
||||
begin
|
||||
@ -7386,12 +7404,12 @@ begin
|
||||
Cnt:=0;
|
||||
for i:=0 to Count-1 do
|
||||
if SaveSession or not Items[i].InSession then
|
||||
Items[i].SaveToXMLConfig(FXMLConfig, Path, i=0, Cnt);
|
||||
FXMLConfig.SetDeleteValue(Path+'BuildModes/Count',Cnt,0);
|
||||
Items[i].SaveToXMLConfig(FXMLConfig, Path, i=0, ALegacyList, Cnt);
|
||||
FXMLConfig.SetListItemCount(Path+'BuildModes',Cnt,ALegacyList);
|
||||
end;
|
||||
|
||||
procedure TProjectBuildModes.SaveSessionOptsToXMLConfig(XMLConfig: TXMLConfig;
|
||||
const Path: string; SaveSession: boolean);
|
||||
const Path: string; SaveSession, ALegacyList: boolean);
|
||||
var
|
||||
i, Cnt: Integer;
|
||||
begin
|
||||
@ -7400,8 +7418,8 @@ begin
|
||||
Cnt:=0;
|
||||
for i:=0 to Count-1 do
|
||||
if Items[i].InSession and SaveSession then
|
||||
Items[i].SaveToXMLConfig(FXMLConfig, Path, false, Cnt);
|
||||
FXMLConfig.SetDeleteValue(Path+'BuildModes/Count',Cnt,0);
|
||||
Items[i].SaveToXMLConfig(FXMLConfig, Path, false, ALegacyList, Cnt);
|
||||
FXMLConfig.SetListItemCount(Path+'BuildModes',Cnt,ALegacyList);
|
||||
end;
|
||||
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user