paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-08 22:58:50 +02:00
Code Issues Packages Projects Releases Wiki Activity

IDE: TXMLConfig.Flush does not save if Filename empty, TLazPackage extended to save to string, package system extended to revert packages not edited and to check changed packages on disk, disk diff dlg extended to show changes of packages

Browse Source 
git-svn-id: trunk@13913 -
This commit is contained in:
mattias 2008-01-29 17:52:05 +00:00
parent 50a0e12b0d
commit 999e8b059d
17 changed files with 369 additions and 81 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
components/codetools/codecache.pas
View File

@ -980,7 +980,7 @@ end;
function TCodeBuffer.FileOnDiskHasChanged: boolean;
begin
if LoadDateValid and FileExists(Filename) then
if LoadDateValid and FileExistsCached(Filename) then
Result:=(FileDateOnDisk<>LoadDate)
else
Result:=false;

2
components/codetools/laz_xmlcfg.pas
View File

@ -133,7 +133,7 @@ end;
procedure TXMLConfig.Flush;
begin
if Modified then
if Modified and (Filename<>'') then
begin
WriteXMLFile(doc, Filename);
FModified := False;

8
components/fpweb/weblaz.lpk
View File

@ -1,6 +1,6 @@
<?xml version="1.0"?>
<CONFIG>
<Package Version="2">
<Package Version="3">
<Name Value="weblaz"/>
<CompilerOptions>
<Version Value="5"/>
@ -102,14 +102,14 @@
<Type Value="RunAndDesignTime"/>
<RequiredPkgs Count="3">
<Item1>
<PackageName Value="LCL"/>
<PackageName Value="FCL"/>
<MinVersion Major="1" Valid="True"/>
</Item1>
<Item2>
<PackageName Value="IDEIntf"/>
</Item2>
<Item3>
<PackageName Value="FCL"/>
<MinVersion Major="1" Valid="True"/>
<PackageName Value="LCL"/>
</Item3>
</RequiredPkgs>
<UsageOptions>

7
components/opengl/example/testopenglcontext1.lpi
View File

@ -23,10 +23,10 @@
</RunParams>
<RequiredPackages Count="2">
<Item1>
<PackageName Value="LazOpenGLContext"/>
<PackageName Value="LCL"/>
</Item1>
<Item2>
<PackageName Value="LCL"/>
<PackageName Value="LazOpenGLContext"/>
</Item2>
</RequiredPackages>
<Units Count="2">
@ -46,9 +46,6 @@
</ProjectOptions>
<CompilerOptions>
<Version Value="5"/>
<SearchPaths>
<LCLWidgetType Value="gtk"/>
</SearchPaths>
<CodeGeneration>
<Generate Value="Faster"/>
</CodeGeneration>

1
debugger/debugger.pp
View File

@ -3167,6 +3167,7 @@ end;
function TBaseCallStack.IndexError(AIndex: Integer): TCallStackEntry;
begin
Result:=nil;
raise EInvalidOperation.CreateFmt('Index out of range (%d)', [AIndex]);
end;

2
examples/anchordocking/dockform1unit.lrs
View File

@ -1,5 +1,3 @@
{ This is an automatically generated lazarus resource file }
LazarusResources.Add('TMainForm','FORMDATA',[
'TPF0'#9'TMainForm'#8'MainForm'#4'Left'#3'$'#1#6'Height'#3','#1#3'Top'#3#209#0
+#5'Width'#3#144#1#18'HorzScrollBar.Page'#3#143#1#18'VertScrollBar.Page'#3'+'

4
examples/anchordocking/docking1.lpi
View File

@ -22,14 +22,14 @@
</RunParams>
<RequiredPackages Count="3">
<Item1>
<PackageName Value="FCL"/>
<PackageName Value="SynEdit"/>
<MinVersion Major="1" Valid="True"/>
</Item1>
<Item2>
<PackageName Value="LCL"/>
</Item2>
<Item3>
<PackageName Value="SynEdit"/>
<PackageName Value="FCL"/>
<MinVersion Major="1" Valid="True"/>
</Item3>
</RequiredPackages>

8
ide/compileroptions.pp
View File

@ -1185,9 +1185,9 @@ begin
fModified:=false;
end;
{------------------------------------------------------------------------------}
{ TfrmCompilerOptions SaveTheCompilerOptions }
{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------
TfrmCompilerOptions SaveTheCompilerOptions
------------------------------------------------------------------------------}
procedure TBaseCompilerOptions.SaveTheCompilerOptions(const Path: string);
var
P: string;
@ -1307,8 +1307,6 @@ begin
CreateMakefileOnBuild,false);
// write
InvalidateFileStateCache;
XMLConfigFile.Flush;
FModified := False;
end;

66
ide/dialogprocs.pas
View File

@ -38,7 +38,7 @@ interface
uses
Classes, SysUtils, LCLProc, LResources, Forms, Controls, Dialogs, FileUtil,
CodeCache, CodeToolManager, AVL_Tree,
Laz_XMLCfg, Laz_XMLWrite, Laz_XMLRead, CodeCache, CodeToolManager, AVL_Tree,
LazIDEIntf,
IDEProcs, LazarusIDEStrConsts, IDEDialogs;
@ -72,7 +72,12 @@ function SaveCodeBufferToFile(ACodeBuffer: TCodeBuffer;
function LoadStringListFromFile(const Filename, ListTitle: string;
var sl: TStrings): TModalResult;
function SaveStringListToFile(const Filename, ListTitle: string;
var sl: TStrings): TModalResult;
var sl: TStrings): TModalResult;
function LoadXMLConfigFromCodeBuffer(const Filename: string; Config: TXMLConfig;
out ACodeBuffer: TCodeBuffer; Flags: TLoadBufferFlags
): TModalResult;
function SaveXMLConfigToCodeBuffer(const Filename: string; Config: TXMLConfig;
var ACodeBuffer: TCodeBuffer): TModalResult;
function CreateEmptyFile(const Filename: string;
ErrorButtons: TMsgDlgButtons): TModalResult;
function CheckCreatingFile(const AFilename: string;
@ -290,6 +295,63 @@ begin
end;
end;
function LoadXMLConfigFromCodeBuffer(const Filename: string;
Config: TXMLConfig; out ACodeBuffer: TCodeBuffer; Flags: TLoadBufferFlags
): TModalResult;
var
ms: TMemoryStream;
begin
Result:=LoadCodeBuffer(ACodeBuffer,Filename,Flags);
if Result<>mrOk then begin
Config.Clear;
exit;
end;
ms:=TMemoryStream.Create;
try
ACodeBuffer.SaveToStream(ms);
ms.Position:=0;
try
ReadXMLFile(Config.Document,ms);
except
on E: Exception do begin
Result:=MessageDlg('XML Error',
'XML parser error in file '+Filename+#13
+'Error: '+E.Message,mtError,[mbCancel],0);
end;
end;
finally
ms.Free;
end;
end;
function SaveXMLConfigToCodeBuffer(const Filename: string;
Config: TXMLConfig; var ACodeBuffer: TCodeBuffer): TModalResult;
var
ms: TMemoryStream;
begin
if ACodeBuffer=nil then begin
ACodeBuffer:=CodeToolBoss.CreateFile(Filename);
if ACodeBuffer=nil then
exit(mrCancel);
end;
ms:=TMemoryStream.Create;
try
try
WriteXMLFile(Config.Document,ms);
except
on E: Exception do begin
Result:=MessageDlg('XML Error',
'Unable to write xml stream to '+Filename+#13
+'Error: '+E.Message,mtError,[mbCancel],0);
end;
end;
ms.Position:=0;
ACodeBuffer.LoadFromStream(ms);
Result:=SaveCodeBuffer(ACodeBuffer);
finally
ms.Free;
end;
end;
function CreateEmptyFile(const Filename: string; ErrorButtons: TMsgDlgButtons
): TModalResult;

140
ide/diskdiffsdialog.pas
View File

@ -33,15 +33,17 @@ unit DiskDiffsDialog;
interface
uses
Classes, SysUtils, Forms, Controls, Buttons, StdCtrls, LResources, Project,
SynEdit, LCLType, DiffPatch, LazarusIDEStrConsts, ComCtrls, ExtCtrls,
EnvironmentOpts;
Classes, SysUtils, LCLProc, Forms, Controls, Buttons, StdCtrls,
LResources, SynEdit, LCLType, ComCtrls, ExtCtrls,
FileProcs, CodeToolManager, CodeCache, Laz_XMLCfg, Laz_XMLWrite,
Project, DiffPatch, LazarusIDEStrConsts, EnvironmentOpts, PackageDefs;
type
PDiffItem = ^TDiffItem;
TDiffItem = record
Valid: boolean;
UnitInfo: TUnitInfo;
Code: TCodeBuffer;
Owner: TObject;
Diff: string;
TxtOnDisk: string;
end;
@ -61,29 +63,40 @@ type
Shift: TShiftState; X, Y: Integer);
procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
private
FPackageList: TFPList;
FUnitList: TFPList;
FCachedDiffs: TFPList; // List of PDiffItem
procedure FillFilesListBox;
procedure SetPackageList(const AValue: TFPList);
procedure SetUnitList(const AValue: TFPList);
procedure ShowDiff;
function GetCachedDiff(AnUnitInfo: TUnitInfo): PDiffItem;
function GetCachedDiff(FileOwner: TObject): PDiffItem;
procedure ClearCache;
public
property UnitList: TFPList read FUnitList write SetUnitList; // list of TUnitInfo
property PackageList: TFPList read FPackageList write SetPackageList; // list of TLazPackage
constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;
end;
function ShowDiskDiffsDialog(AnUnitList: TFPList): TModalResult;
function ShowDiskDiffsDialog(AnUnitList, APackageList: TFPList): TModalResult;
implementation
var
DiskDiffsDlg: TDiskDiffsDlg = nil;
function ShowDiskDiffsDialog(AnUnitList: TFPList): TModalResult;
function ShowDiskDiffsDialog(AnUnitList, APackageList: TFPList): TModalResult;
procedure CheckWithLoading;
function ListsAreEmpty: boolean;
begin
Result:=((AnUnitList=nil) or (AnUnitList.Count=0))
and ((APackageList=nil) or (APackageList.Count=0));
end;
procedure CheckUnitsWithLoading;
var
i: Integer;
CurUnit: TUnitInfo;
@ -91,6 +104,7 @@ function ShowDiskDiffsDialog(AnUnitList: TFPList): TModalResult;
UnitDidNotChange: Boolean;
s: string;
begin
if AnUnitList=nil then exit;
for i:=AnUnitList.Count-1 downto 0 do begin
CurUnit:=TUnitInfo(AnUnitList[i]);
UnitDidNotChange:=false;
@ -117,18 +131,60 @@ function ShowDiskDiffsDialog(AnUnitList: TFPList): TModalResult;
end;
end;
procedure CheckPackagesWithLoading;
var
i: Integer;
CurPackage: TLazPackage;
PackageDidNotChange: Boolean;
fs: TFileStream;
CurSource, DiskSource: string;
begin
if APackageList=nil then exit;
for i:=APackageList.Count-1 downto 0 do begin
CurPackage:=TLazPackage(APackageList[i]);
PackageDidNotChange:=false;
if CurPackage.LPKSource=nil then
continue;// this package was not loaded/saved
try
CurPackage.SaveToString(CurSource);
fs:=TFileStream.Create(CurPackage.Filename,fmOpenRead);
try
if fs.Size=length(CurSource) then begin
// size has not changed => load to see difference
SetLength(DiskSource,fs.Size);
fs.Read(DiskSource[1],length(DiskSource));
if DiskSource=CurSource then
PackageDidNotChange:=true;
end;
finally
fs.Free;
end;
except
// unable to load
on E: Exception do begin
DebugLn(['CheckPackagesWithLoading Filename=',CurPackage.Filename,' Error=',E.Message]);
end;
end;
if PackageDidNotChange then begin
APackageList.Delete(i);
end;
end;
end;
begin
if (DiskDiffsDlg<>nil) or (AnUnitList=nil) then begin
if (DiskDiffsDlg<>nil) or ListsAreEmpty then begin
Result:=mrIgnore;
exit;
end;
if EnvironmentOptions.CheckDiskChangesWithLoading then begin
CheckWithLoading;
if AnUnitList.Count=0 then exit;
CheckUnitsWithLoading;
CheckPackagesWithLoading;
if ListsAreEmpty then exit;
end;
DiskDiffsDlg:=TDiskDiffsDlg.Create(nil);
DiskDiffsDlg.UnitList:=AnUnitList;
DiskDiffsDlg.PackageList:=APackageList;
DiskDiffsDlg.FillFilesListBox;
Result:=DiskDiffsDlg.ShowModal;
DiskDiffsDlg.Free;
DiskDiffsDlg:=nil;
@ -161,15 +217,25 @@ var i: integer;
begin
FilesListBox.Items.BeginUpdate;
FilesListBox.Items.Clear;
for i:=0 to UnitList.Count-1 do
FilesListBox.Items.Add(TUnitInfo(UnitList[i]).ShortFilename);
if UnitList<>nil then
for i:=0 to UnitList.Count-1 do
FilesListBox.Items.AddObject(TUnitInfo(UnitList[i]).ShortFilename,
TUnitInfo(UnitList[i]));
if PackageList<>nil then
for i:=0 to PackageList.Count-1 do
FilesListBox.Items.AddObject(TLazPackage(PackageList[i]).Filename,
TLazPackage(PackageList[i]));
FilesListBox.Items.EndUpdate;
end;
procedure TDiskDiffsDlg.SetPackageList(const AValue: TFPList);
begin
FPackageList:=AValue;
end;
procedure TDiskDiffsDlg.SetUnitList(const AValue: TFPList);
begin
FUnitList:=AValue;
FillFilesListBox;
end;
procedure TDiskDiffsDlg.ShowDiff;
@ -178,34 +244,64 @@ var
DiffItem: PDiffItem;
begin
i:=FilesListBox.ItemIndex;
if i>=0 then begin
DiffItem:=GetCachedDiff(TUnitInfo(FUnitList[i]));
DiffItem:=nil;
if (i>=0) and (UnitList<>nil) then begin
if i<UnitList.Count then
DiffItem:=GetCachedDiff(TUnitInfo(UnitList[i]))
else
dec(i,UnitList.Count);
end;
if (i>=0) and (PackageList<>nil) then begin
if i<PackageList.Count then
DiffItem:=GetCachedDiff(TLazPackage(PackageList[i]))
else
dec(i,PackageList.Count);
end;
if DiffItem<>nil then begin
DiffSynEdit.Lines.Text:=DiffItem^.Diff;
end else begin
DiffSynEdit.Lines.Clear;
end;
end;
function TDiskDiffsDlg.GetCachedDiff(AnUnitInfo: TUnitInfo): PDiffItem;
function TDiskDiffsDlg.GetCachedDiff(FileOwner: TObject): PDiffItem;
var
i: integer;
fs: TFileStream;
Filename: String;
AnUnitInfo: TUnitInfo;
APackage: TLazPackage;
Source: String;
begin
if FCachedDiffs=nil then
FCachedDiffs:=TFPList.Create;
for i:=0 to FCachedDiffs.Count-1 do begin
Result:=PDiffItem(FCachedDiffs[i]);
if (Result<>nil) and (Result^.UnitInfo=AnUnitInfo) then exit;
if (Result<>nil) and (Result^.Owner=FileOwner) then exit;
end;
New(Result);
Result^.UnitInfo:=AnUnitInfo;
Result^.Owner:=FileOwner;
try
fs:=TFileStream.Create(AnUnitInfo.Filename,fmOpenRead);
if FileOwner is TUnitInfo then begin
// compare disk and codetools
AnUnitInfo:=TUnitInfo(FileOwner);
Filename:=AnUnitInfo.Source.Filename;
Source:=AnUnitInfo.Source.Source;
end else if FileOwner is TLazPackage then begin
// compare disk and package
APackage:=TLazPackage(FileOwner);
Filename:=APackage.LPKSource.Filename;
APackage.SaveToString(Source);
end else begin
Filename:='';
Source:='';
end;
fs:=TFileStream.Create(Filename,fmOpenRead);
SetLength(Result^.TxtOnDisk,fs.Size);
if Result^.TxtOnDisk<>'' then
fs.Read(Result^.TxtOnDisk[1],length(Result^.TxtOnDisk));
fs.Free;
Result^.Diff:=CreateTextDiff(AnUnitInfo.Source.Source,Result^.TxtOnDisk,[],
Result^.Diff:=CreateTextDiff(Source,Result^.TxtOnDisk,[],
tdoContext);
except
On E: Exception do

52
ide/main.pp
View File

@ -9619,6 +9619,7 @@ end;
function TMainIDE.DoCheckFilesOnDisk(Instantaneous: boolean): TModalResult;
var
AnUnitList: TFPList; // list of TUnitInfo
APackageList: TFPList; // list of TLazPackage
i: integer;
CurUnit: TUnitInfo;
begin
@ -9635,35 +9636,48 @@ begin
//debugln('TMainIDE.DoCheckFilesOnDisk');
FCheckingFilesOnDisk:=true;
AnUnitList:=nil;
APackageList:=nil;
try
InvalidateFileStateCache;
Project1.GetUnitsChangedOnDisk(AnUnitList);
if AnUnitList=nil then exit;
Result:=ShowDiskDiffsDialog(AnUnitList);
PkgBoss.GetPackagesChangedOnDisk(APackageList);
if (AnUnitList=nil) and (APackageList=nil) then exit;
Result:=ShowDiskDiffsDialog(AnUnitList,APackageList);
if Result in [mrYesToAll] then
Result:=mrOk;
for i:=0 to AnUnitList.Count-1 do begin
CurUnit:=TUnitInfo(AnUnitList[i]);
//DebugLn(['TMainIDE.DoCheckFilesOnDisk revert ',CurUnit.Filename,' EditorIndex=',CurUnit.EditorIndex]);
if Result=mrOk then begin
if CurUnit.EditorIndex>=0 then begin
Result:=DoOpenEditorFile(CurUnit.Filename,CurUnit.EditorIndex,[ofRevert]);
//DebugLn(['TMainIDE.DoCheckFilesOnDisk DoOpenEditorFile=',Result]);
end else if CurUnit.IsMainUnit then begin
Result:=DoRevertMainUnit;
//DebugLn(['TMainIDE.DoCheckFilesOnDisk DoRevertMainUnit=',Result]);
end else
Result:=mrIgnore;
if Result=mrAbort then exit;
end else begin
//DebugLn(['TMainIDE.DoCheckFilesOnDisk IgnoreCurrentFileDateOnDisk']);
CurUnit.IgnoreCurrentFileDateOnDisk;
// reload units
if AnUnitList<>nil then begin
for i:=0 to AnUnitList.Count-1 do begin
CurUnit:=TUnitInfo(AnUnitList[i]);
//DebugLn(['TMainIDE.DoCheckFilesOnDisk revert ',CurUnit.Filename,' EditorIndex=',CurUnit.EditorIndex]);
if Result=mrOk then begin
if CurUnit.EditorIndex>=0 then begin
Result:=DoOpenEditorFile(CurUnit.Filename,CurUnit.EditorIndex,[ofRevert]);
//DebugLn(['TMainIDE.DoCheckFilesOnDisk DoOpenEditorFile=',Result]);
end else if CurUnit.IsMainUnit then begin
Result:=DoRevertMainUnit;
//DebugLn(['TMainIDE.DoCheckFilesOnDisk DoRevertMainUnit=',Result]);
end else
Result:=mrIgnore;
if Result=mrAbort then exit;
end else begin
//DebugLn(['TMainIDE.DoCheckFilesOnDisk IgnoreCurrentFileDateOnDisk']);
CurUnit.IgnoreCurrentFileDateOnDisk;
end;
end;
end;
// reload packages
Result:=PkgBoss.RevertPackages(APackageList);
if Result<>mrOk then exit;
Result:=mrOk;
AnUnitList.Free;
finally
FCheckingFilesOnDisk:=false;
AnUnitList.Free;
APackageList.Free;
end;
end;

2
ide/uniteditor.pp
View File

@ -538,7 +538,7 @@ type
var Abort: boolean): string;
private
// for docking
FDockPanels: array[TAlign] of TPanel;
//FDockPanels: array[TAlign] of TPanel;
FDockSplitters: array[TAlign] of TSplitter;
procedure DockPanelGetSiteInfo(Sender: TObject; DockClient: TControl;
var InfluenceRect: TRect; MousePos: TPoint; var CanDock: Boolean);

3
ideintf/ideimagesintf.pas
View File

@ -174,6 +174,9 @@ begin
end;
Stream.Free;
except
on E: Exception do begin
DebugLn(['TIDEImages.LoadImage Image="',ImageName,' Error=',E.Message]);
end;
end;
end;
end;

2
packager/basepkgmanager.pas
View File

@ -83,6 +83,8 @@ type
InObject: TObject): TPkgFile; virtual; abstract;
function AddDependencyToUnitOwners(const OwnedFilename,
RequiredUnitname: string): TModalResult; virtual; abstract;
procedure GetPackagesChangedOnDisk(var ListOfPackages: TFPList); virtual; abstract;
function RevertPackages(APackageList: TFPList): TModalResult; virtual; abstract;
// project
function OpenProjectDependencies(AProject: TProject;

59
packager/packagedefs.pas
View File

@ -45,10 +45,10 @@ unit PackageDefs;
interface
uses
Classes, SysUtils, LCLProc, LResources, Graphics,
AVL_Tree, Laz_XMLCfg,
DefineTemplates, CodeToolManager, EditDefineTree, CompilerOptions, Forms,
FileUtil,
Classes, SysUtils, LCLProc, LResources, Graphics, Forms, FileUtil,
AVL_Tree,
DefineTemplates, CodeToolManager, Laz_XMLWrite, Laz_XMLCfg, CodeCache,
EditDefineTree, CompilerOptions,
PropEdits, LazIDEIntf, MacroIntf,
LazarusIDEStrConsts, IDEProcs, ComponentReg,
TransferMacros, FileReferenceList, PublishModule;
@ -592,6 +592,8 @@ type
FLastCompilerParams: string;
FLazDocPaths: string;
FLicense: string;
FLPKSource: TCodeBuffer;
FLPKSourceChangeStep: integer;
FMacros: TTransferMacroList;
FMissing: boolean;
FModifiedLock: integer;
@ -631,6 +633,8 @@ type
procedure SetInstalled(const AValue: TPackageInstallType);
procedure SetLazDocPaths(const AValue: string);
procedure SetLicense(const AValue: string);
procedure SetLPKSource(const AValue: TCodeBuffer);
procedure SetLPKSourceChangeStep(const AValue: integer);
procedure SetOutputStateFile(const AValue: string);
procedure SetProvides(const AValue: TStrings);
procedure SetPOOutputDirectory(const AValue: string);
@ -661,6 +665,7 @@ type
// streaming
procedure LoadFromXMLConfig(XMLConfig: TXMLConfig; const Path: string);
procedure SaveToXMLConfig(XMLConfig: TXMLConfig; const Path: string);
procedure SaveToString(out s: string);
// consistency
procedure CheckInnerDependencies;
function MakeSense: boolean;
@ -672,9 +677,9 @@ type
function GetResolvedFilename: string;
function GetSourceDirs(WithPkgDir, WithoutOutputDir: boolean): string;
procedure GetInheritedCompilerOptions(var OptionsList: TFPList);
function GetCompileSourceFilename: string;
function GetOutputDirectory: string;
function GetStateFilename: string;
function GetCompileSourceFilename: string;// as GetSrcFilename without directory
function GetSrcFilename: string;
function GetCompilerFilename: string;
function GetPOOutDirectory: string;
@ -760,7 +765,7 @@ type
property DefineTemplates: TLazPackageDefineTemplates read FDefineTemplates
write FDefineTemplates;
property Description: string read FDescription write SetDescription;
property Directory: string read FDirectory; // the path of the .lpk file
property Directory: string read FDirectory; // the directory of the .lpk file
property Editor: TBasePackageEditor read FPackageEditor
write SetPackageEditor;
property EnableI18N: Boolean read FEnableI18N write SetEnableI18N;
@ -785,6 +790,8 @@ type
write FLastCompilerParams;
property LazDocPaths: string read FLazDocPaths write SetLazDocPaths;
property License: string read FLicense write SetLicense;
property LPKSource: TCodeBuffer read FLPKSource write SetLPKSource;
property LPKSourceChangeStep: integer read FLPKSourceChangeStep write SetLPKSourceChangeStep;
property Macros: TTransferMacroList read FMacros;
property Missing: boolean read FMissing write FMissing;
property Modified: boolean read GetModified write SetModified;
@ -2264,6 +2271,24 @@ begin
Modified:=true;
end;
procedure TLazPackage.SetLPKSource(const AValue: TCodeBuffer);
begin
if FLPKSource=AValue then exit;
FLPKSource:=AValue;
if FLPKSource<>nil then
FLPKSourceChangeStep:=FLPKSource.ChangeStep;
// do not change Filename here.
// See TPkgManager.DoSavePackage and TPkgManager.DoOpenPackageFile
// the LPKSource is the codebuffer last used during load/save, so it is not valid
// for packages that were not yet loaded/saved or during renaming/loading/saving.
end;
procedure TLazPackage.SetLPKSourceChangeStep(const AValue: integer);
begin
if FLPKSourceChangeStep=AValue then exit;
FLPKSourceChangeStep:=AValue;
end;
procedure TLazPackage.SetOutputStateFile(const AValue: string);
var
NewStateFile: String;
@ -2637,6 +2662,28 @@ begin
Modified:=false;
end;
procedure TLazPackage.SaveToString(out s: string);
var
XMLConfig: TXMLConfig;
ms: TMemoryStream;
begin
s:='';
XMLConfig:=TXMLConfig.Create(nil);
ms:=TMemoryStream.Create;
try
XMLConfig.Clear;
SaveToXMLConfig(XMLConfig,'Package/');
WriteXMLFile(XMLConfig.Document,ms);
ms.Position:=0;
SetLength(s,ms.Size);
if s<>'' then
ms.Read(s[1],length(s));
finally
XMLConfig.Free;
ms.Free;
end;
end;
function TLazPackage.IsVirtual: boolean;
begin
Result:=(not FilenameIsAbsolute(Filename));

33
packager/packagesystem.pas
View File

@ -234,6 +234,7 @@ type
Policies: TPackageUpdatePolicies): TFPList;
function GetBrokenDependenciesWhenChangingPkgID(APackage: TLazPackage;
const NewName: string; NewVersion: TPkgVersion): TFPList;
procedure GetPackagesChangedOnDisk(var ListOfPackages: TFPList);
procedure CalculateTopologicalLevels;
procedure SortDependencyListTopologically(
var FirstDependency: TPkgDependency; TopLevelFirst: boolean);
@ -425,9 +426,11 @@ var
AFilename: String;
NewPackage: TLazPackage;
XMLConfig: TXMLConfig;
Code: TCodeBuffer;
begin
Result:=false;
NewPackage:=nil;
XMLConfig:=nil;
BeginUpdate(false);
try
AFilename:=PkgLink.Filename;
@ -439,11 +442,13 @@ begin
try
PkgLink.FileDate:=FileDateToDateTime(FileAge(AFilename));
PkgLink.FileDateValid:=true;
XMLConfig:=TXMLConfig.Create(AFilename);
XMLConfig:=TXMLConfig.Create(nil);
NewPackage:=TLazPackage.Create;
NewPackage.Filename:=AFilename;
if LoadXMLConfigFromCodeBuffer(AFilename,XMLConfig,
Code,[lbfUpdateFromDisk,lbfRevert])<>mrOk then exit;
NewPackage.LoadFromXMLConfig(XMLConfig,'Package/');
XMLConfig.Free;
NewPackage.LPKSource:=Code;
except
on E: Exception do begin
DebugLn('unable to read file "'+AFilename+'" ',E.Message);
@ -462,6 +467,7 @@ begin
if not Result then
NewPackage.Free;
EndUpdate;
FreeAndNil(XMLConfig);
end;
end;
@ -3060,6 +3066,29 @@ begin
end;
end;
procedure TLazPackageGraph.GetPackagesChangedOnDisk(
var ListOfPackages: TFPList);
// if package source is changed in IDE (codetools)
// then changes on disk are ignored
var
APackage: TLazPackage;
i: Integer;
begin
MarkNeededPackages;
for i:=FItems.Count-1 downto 0 do begin
APackage:=TLazPackage(FItems[i]);
if (not (lpfNeeded in APackage.Flags))
or APackage.ReadOnly or APackage.Modified
or (APackage.LPKSource=nil) then
continue;
if (not APackage.LPKSource.FileNeedsUpdate) then
continue;
if ListOfPackages=nil then
ListOfPackages:=TFPList.Create;
ListOfPackages.Add(APackage);
end;
end;
procedure TLazPackageGraph.CalculateTopologicalLevels;
procedure GetTopologicalOrder(CurDependency: TPkgDependency;

59
packager/pkgmanager.pas
View File

@ -224,6 +224,8 @@ type
InObject: TObject): TPkgFile; override;
function AddDependencyToUnitOwners(const OwnedFilename,
RequiredUnitname: string): TModalResult; override;
procedure GetPackagesChangedOnDisk(var ListOfPackages: TFPList); override;
function RevertPackages(APackageList: TFPList): TModalResult; override;
// package graph
function AddPackageToGraph(APackage: TLazPackage; Replace: boolean): TModalResult;
@ -2307,6 +2309,8 @@ var
APackage: TLazPackage;
XMLConfig: TXMLConfig;
AlternativePkgName: String;
Code: TCodeBuffer;
OpenEditor: Boolean;
procedure DoQuestionDlg(const Caption, Message: string);
begin
@ -2326,7 +2330,8 @@ begin
AFilename:=CleanAndExpandFilename(AFilename);
// check file extension
if CompareFileExt(AFilename,'.lpk',false)<>0 then begin
if (CompareFileExt(AFilename,'.lpk',false)<>0)
and (not (pofRevert in Flags)) then begin
DoQuestionDlg(lisPkgMangInvalidFileExtension,
Format(lisPkgMangTheFileIsNotALazarusPackage, ['"', AFilename, '"']));
RemoveFromRecentList(AFilename,EnvironmentOptions.RecentPackageFiles);
@ -2336,8 +2341,9 @@ begin
// check filename
AlternativePkgName:=ExtractFileNameOnly(AFilename);
if (AlternativePkgName='') or (not IsValidIdent(AlternativePkgName)) then
begin
if (not (pofRevert in Flags))
and ((AlternativePkgName='') or (not IsValidIdent(AlternativePkgName)))
then begin
DoQuestionDlg(lisPkgMangInvalidPackageFilename,
Format(lisPkgMangThePackageFileNameInIsNotAValidLazarusPackageName, ['"',
AlternativePkgName, '"', #13, '"', AFilename, '"']));
@ -2353,10 +2359,15 @@ begin
SetRecentPackagesMenu;
end;
OpenEditor:=true;
// check if package is already loaded
APackage:=PackageGraph.FindPackageWithFilename(AFilename,true);
if (APackage=nil) or (pofRevert in Flags) then begin
// package not yet loaded
// package not yet loaded or it should be reloaded
if (pofRevert in Flags) and (APackage.Editor=nil) then
OpenEditor:=false;
if not FileExists(AFilename) then begin
IDEMessageDialog(lisFileNotFound,
@ -2375,9 +2386,13 @@ begin
// load the package file
try
XMLConfig:=TXMLConfig.Create(AFilename);
XMLConfig:=TXMLConfig.Create(nil);
try
APackage.Filename:=AFilename;
Result:=LoadXMLConfigFromCodeBuffer(AFilename,XMLConfig,
Code,[lbfUpdateFromDisk,lbfRevert]);
if Result<>mrOk then exit;
APackage.LPKSource:=Code;
APackage.LoadFromXMLConfig(XMLConfig,'Package/');
finally
XMLConfig.Free;
@ -2412,7 +2427,10 @@ begin
end;
end;
Result:=DoOpenPackage(APackage,[]);
if OpenEditor then
Result:=DoOpenPackage(APackage,[])
else
Result:=mrOk;
end;
function TPkgManager.DoSavePackage(APackage: TLazPackage;
@ -2420,6 +2438,7 @@ function TPkgManager.DoSavePackage(APackage: TLazPackage;
var
XMLConfig: TXMLConfig;
PkgLink: TPackageLink;
Code: TCodeBuffer;
begin
// do not save during compilation
if not (MainIDE.ToolStatus in [itNone,itDebugger]) then begin
@ -2470,12 +2489,14 @@ begin
// save
try
XMLConfig:=TXMLConfig.CreateClean(APackage.Filename);
XMLConfig:=TXMLConfig.Create(nil);
try
XMLConfig.Clear;
APackage.SaveToXMLConfig(XMLConfig,'Package/');
InvalidateFileStateCache;
XMLConfig.Flush;
Code:=nil;
Result:=SaveXMLConfigToCodeBuffer(APackage.Filename,XMLConfig,Code);
if Result<>mrOk then exit;
APackage.LPKSource:=Code;
PkgLink:=PkgLinks.AddUserLink(APackage);
if PkgLink<>nil then begin
PkgLink.FileDate:=FileDateToDateTime(FileAge(APackage.Filename));
@ -3311,6 +3332,26 @@ begin
end;
end;
procedure TPkgManager.GetPackagesChangedOnDisk(var ListOfPackages: TFPList);
begin
if PackageGraph=nil then exit;
PackageGraph.GetPackagesChangedOnDisk(ListOfPackages);
end;
function TPkgManager.RevertPackages(APackageList: TFPList): TModalResult;
var
i: Integer;
APackage: TLazPackage;
begin
if APackageList=nil then exit(mrOk);
for i:=0 to APackageList.Count-1 do begin
APackage:=TLazPackage(APackageList[i]);
Result:=DoOpenPackageFile(APackage.Filename,[pofRevert]);
if Result=mrAbort then exit;
end;
Result:=mrOk;
end;
function TPkgManager.DoAddActiveUnitToAPackage: TModalResult;
var
ActiveSourceEditor: TSourceEditor;