From 5d46a75ff6714fbeaab4084541d7afafe2bc6ec5 Mon Sep 17 00:00:00 2001 From: juha Date: Fri, 15 Mar 2019 16:15:21 +0000 Subject: [PATCH] IDE: Use a better XML tag format for project etc. info files. Issue #22752, patch from Ondrej. git-svn-id: trunk@60683 - --- components/ideintf/projectintf.pas | 6 +- components/lazutils/laz2_xmlcfg.pas | 302 ++++++++++++++++++++++------ ide/frames/project_misc_options.lfm | 28 ++- ide/frames/project_misc_options.pas | 6 + ide/imexportcompileropts.pas | 2 +- ide/lazarusidestrconsts.pas | 2 + ide/project.pp | 70 ++++--- 7 files changed, 314 insertions(+), 102 deletions(-) diff --git a/components/ideintf/projectintf.pas b/components/ideintf/projectintf.pas index 3f25f84c69..c2b6f315c1 100644 --- a/components/ideintf/projectintf.pas +++ b/components/ideintf/projectintf.pas @@ -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', diff --git a/components/lazutils/laz2_xmlcfg.pas b/components/lazutils/laz2_xmlcfg.pas index 65f4180b58..4cbab28f70 100644 --- a/components/lazutils/laz2_xmlcfg.pas +++ b/components/lazutils/laz2_xmlcfg.pas @@ -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 Indexnil 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; diff --git a/ide/frames/project_misc_options.lfm b/ide/frames/project_misc_options.lfm index 18b19b4727..e7f9311be0 100644 --- a/ide/frames/project_misc_options.lfm +++ b/ide/frames/project_misc_options.lfm @@ -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 diff --git a/ide/frames/project_misc_options.pas b/ide/frames/project_misc_options.pas index 20eb997ddd..5926c9ea91 100644 --- a/ide/frames/project_misc_options.pas +++ b/ide/frames/project_misc_options.pas @@ -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); diff --git a/ide/imexportcompileropts.pas b/ide/imexportcompileropts.pas index 4028e8b286..56a1335f6f 100644 --- a/ide/imexportcompileropts.pas +++ b/ide/imexportcompileropts.pas @@ -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; diff --git a/ide/lazarusidestrconsts.pas b/ide/lazarusidestrconsts.pas index eafc5bf841..c1f6e94221 100644 --- a/ide/lazarusidestrconsts.pas +++ b/ide/lazarusidestrconsts.pas @@ -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'; diff --git a/ide/project.pp b/ide/project.pp index e6a51849ad..1559600c08 100644 --- a/ide/project.pp +++ b/ide/project.pp @@ -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;