paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-06 20:46:05 +02:00
Code Issues Packages Projects Releases Wiki Activity

extended Load/Save events for project sessions

Browse Source 
git-svn-id: trunk@8680 -
This commit is contained in:
mattias 2006-01-31 16:40:59 +00:00
parent 17d9a51c28
commit a7173f4a7a
5 changed files with 59 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
ide/basedebugmanager.pas
View File

@ -40,7 +40,7 @@ uses
{$IFDEF IDE_MEM_CHECK}
MemCheck,
{$ENDIF}
Classes, SysUtils, Forms, Project, SourceMarks, Debugger,
Classes, SysUtils, Forms, Project, SourceMarks, Debugger, ProjectDefs,
Laz_XMLCfg;
type
@ -74,8 +74,10 @@ type
procedure SetupMainBarShortCuts; virtual; abstract;
procedure UpdateButtonsAndMenuItems; virtual; abstract;
procedure LoadProjectSpecificInfo(XMLConfig: TXMLConfig); virtual; abstract;
procedure SaveProjectSpecificInfo(XMLConfig: TXMLConfig); virtual; abstract;
procedure LoadProjectSpecificInfo(XMLConfig: TXMLConfig;
Merge: boolean); virtual; abstract;
procedure SaveProjectSpecificInfo(XMLConfig: TXMLConfig;
Flags: TProjectWriteFlags); virtual; abstract;
function DebuggerCount: Integer;

37
ide/debugmanager.pas
View File

@ -47,7 +47,7 @@ uses
MenuIntf, IDECommands, LazIDEIntf,
LazConf, DebugOptionsFrm,
CompilerOptions, EditorOptions, EnvironmentOpts, KeyMapping, UnitEditor,
Project, IDEProcs, InputHistory, Debugger,
ProjectDefs, Project, IDEProcs, InputHistory, Debugger,
IDEOptionDefs, LazarusIDEStrConsts,
MainBar, MainIntf, MainBase, BaseDebugManager,
SourceMarks,
@ -132,8 +132,10 @@ type
procedure SetupMainBarShortCuts; override;
procedure UpdateButtonsAndMenuItems; override;
procedure LoadProjectSpecificInfo(XMLConfig: TXMLConfig); override;
procedure SaveProjectSpecificInfo(XMLConfig: TXMLConfig); override;
procedure LoadProjectSpecificInfo(XMLConfig: TXMLConfig;
Merge: boolean); override;
procedure SaveProjectSpecificInfo(XMLConfig: TXMLConfig;
Flags: TProjectWriteFlags); override;
procedure DoRestoreDebuggerMarks(AnUnitInfo: TUnitInfo); override;
procedure ClearDebugOutputLog;
@ -1506,12 +1508,17 @@ begin
end;
{------------------------------------------------------------------------------
procedure TDebugManager.LoadProjectSpecificInfo(XMLConfig: TXMLConfig);
procedure TDebugManager.LoadProjectSpecificInfo(XMLConfig: TXMLConfig;
Merge: boolean);
Called when the main project is loaded from the XMLConfig.
------------------------------------------------------------------------------}
procedure TDebugManager.LoadProjectSpecificInfo(XMLConfig: TXMLConfig);
procedure TDebugManager.LoadProjectSpecificInfo(XMLConfig: TXMLConfig;
Merge: boolean);
begin
if Merge then begin
// keep it simple: just load from the session and don't merge
end;
FBreakPointGroups.LoadFromXMLConfig(XMLConfig,
'Debugging/'+XMLBreakPointGroupsNode+'/');
FBreakPoints.LoadFromXMLConfig(XMLConfig,'Debugging/'+XMLBreakPointsNode+'/',
@ -1522,18 +1529,22 @@ begin
end;
{------------------------------------------------------------------------------
procedure TDebugManager.SaveProjectSpecificInfo(XMLConfig: TXMLConfig);
procedure TDebugManager.SaveProjectSpecificInfo(XMLConfig: TXMLConfig;
Flags: TProjectWriteFlags);
Called when the main project is saved to an XMLConfig.
------------------------------------------------------------------------------}
procedure TDebugManager.SaveProjectSpecificInfo(XMLConfig: TXMLConfig);
procedure TDebugManager.SaveProjectSpecificInfo(XMLConfig: TXMLConfig;
Flags: TProjectWriteFlags);
begin
FBreakPointGroups.SaveToXMLConfig(XMLConfig,
'Debugging/'+XMLBreakPointGroupsNode+'/');
FBreakPoints.SaveToXMLConfig(XMLConfig,'Debugging/'+XMLBreakPointsNode+'/',
@Project1.ShortenFilename);
FWatches.SaveToXMLConfig(XMLConfig,'Debugging/'+XMLWatchesNode+'/');
FExceptions.SaveToXMLConfig(XMLConfig,'Debugging/'+XMLExceptionsNode+'/');
if not (pwfDoNotSaveSessionInfo in Flags) then begin
FBreakPointGroups.SaveToXMLConfig(XMLConfig,
'Debugging/'+XMLBreakPointGroupsNode+'/');
FBreakPoints.SaveToXMLConfig(XMLConfig,'Debugging/'+XMLBreakPointsNode+'/',
@Project1.ShortenFilename);
FWatches.SaveToXMLConfig(XMLConfig,'Debugging/'+XMLWatchesNode+'/');
FExceptions.SaveToXMLConfig(XMLConfig,'Debugging/'+XMLExceptionsNode+'/');
end;
end;
procedure TDebugManager.DoRestoreDebuggerMarks(AnUnitInfo: TUnitInfo);

9
ide/main.pp
View File

@ -552,7 +552,8 @@ type
function CreateProjectObject(ProjectDesc,
FallbackProjectDesc: TProjectDescriptor): TProject;
procedure OnLoadProjectInfoFromXMLConfig(TheProject: TProject;
XMLConfig: TXMLConfig);
XMLConfig: TXMLConfig;
Merge: boolean);
procedure OnSaveProjectInfoToXMLConfig(TheProject: TProject;
XMLConfig: TXMLConfig; WriteFlags: TProjectWriteFlags);
procedure OnProjectGetTestDirectory(TheProject: TProject;
@ -4813,10 +4814,10 @@ begin
end;
procedure TMainIDE.OnLoadProjectInfoFromXMLConfig(TheProject: TProject;
XMLConfig: TXMLConfig);
XMLConfig: TXMLConfig; Merge: boolean);
begin
if TheProject=Project1 then
DebugBoss.LoadProjectSpecificInfo(XMLConfig);
DebugBoss.LoadProjectSpecificInfo(XMLConfig,Merge);
end;
procedure TMainIDE.OnSaveProjectInfoToXMLConfig(TheProject: TProject;
@ -4824,7 +4825,7 @@ procedure TMainIDE.OnSaveProjectInfoToXMLConfig(TheProject: TProject;
begin
if (TheProject=Project1) and (not (pwfSkipDebuggerSettings in WriteFlags))
then
DebugBoss.SaveProjectSpecificInfo(XMLConfig);
DebugBoss.SaveProjectSpecificInfo(XMLConfig,WriteFlags);
end;
procedure TMainIDE.OnProjectGetTestDirectory(TheProject: TProject;

31
ide/project.pp
View File

@ -63,8 +63,8 @@ type
const OldUnitName, NewUnitName: string;
CheckIfAllowed: boolean;
var Allowed: boolean) of object;
TOnLoadProjectInfo = procedure(TheProject: TProject;
XMLConfig: TXMLConfig) of object;
TOnLoadProjectInfo = procedure(TheProject: TProject; XMLConfig: TXMLConfig;
Merge: boolean) of object;
TOnSaveProjectInfo = procedure(TheProject: TProject;
XMLConfig: TXMLConfig; WriteFlags: TProjectWriteFlags) of object;
TOnProjectGetTestDirectory = procedure(TheProject: TProject;
@ -1525,6 +1525,7 @@ var
xmlconfig: TXMLConfig;
SaveSessionInfoInLPI: Boolean;
CurSessionFilename: String;
CurFlags: TProjectWriteFlags;
begin
Result := mrCancel;
@ -1603,8 +1604,12 @@ begin
SaveSessionInfo(XMLConfig,Path);
end;
if Assigned(OnSaveProjectInfo) then
OnSaveProjectInfo(Self,XMLConfig,ProjectWriteFlags);
if Assigned(OnSaveProjectInfo) then begin
CurFlags:=ProjectWriteFlags;
if not SaveSessionInfoInLPI then
CurFlags:=CurFlags+[pwfDoNotSaveSessionInfo];
OnSaveProjectInfo(Self,XMLConfig,CurFlags);
end;
InvalidateFileStateCache;
xmlconfig.Flush;
@ -1675,6 +1680,11 @@ begin
// save session
SaveSessionInfo(XMLConfig,Path);
if Assigned(OnSaveProjectInfo) then begin
CurFlags:=ProjectWriteFlags+[pwfDoNotSaveProjectInfo];
OnSaveProjectInfo(Self,XMLConfig,CurFlags);
end;
Result:=mrOk;
except
on E: Exception do begin
@ -1887,8 +1897,9 @@ begin
Path+'General/ActiveEditorIndexAtStart/Value', -1);
FJumpHistory.LoadFromXMLConfig(xmlconfig,Path+'');
if Assigned(OnLoadProjectInfo) then OnLoadProjectInfo(Self,XMLConfig);
if Assigned(OnLoadProjectInfo) then begin
OnLoadProjectInfo(Self,XMLConfig,false);
end;
finally
{$IFDEF IDE_MEM_CHECK}CheckHeapWrtMemCnt('TProject.ReadProject freeing xml');{$ENDIF}
fPathDelimChanged:=false;
@ -1899,19 +1910,24 @@ begin
xmlconfig:=nil;
end;
// load session file (if available)
if (SessionStorage in [pssInProjectDir,pssInIDEConfig])
and (CompareFilenames(ProjectInfoFile,ProjectSessionFile)<>0)
and FileExists(ProjectSessionFile) then begin
try
xmlconfig := TXMLConfig.Create(ProjectSessionFile);
Path:='ProjectOptions/';
fPathDelimChanged:=
XMLConfig.GetValue(Path+'PathDelim/Value', PathDelim)<>PathDelim;
FJumpHistory.LoadFromXMLConfig(xmlconfig,Path+'');
if Assigned(OnLoadProjectInfo) then begin
OnLoadProjectInfo(Self,XMLConfig,true);
end;
except
MessageDlg('Unable to read the project info file'#13'"'+ProjectInfoFile+'".'
,mtError,[mbOk],0);
@ -1933,6 +1949,7 @@ begin
end;
end;
finally
EndUpdate;
end;

1
ide/projectdefs.pas
View File

@ -50,6 +50,7 @@ type
pwfSaveOnlyProjectUnits,
pwfSkipDebuggerSettings,
pwfSkipJumpPoints,
pwfDoNotSaveProjectInfo,
pwfDoNotSaveSessionInfo
);
TProjectWriteFlags = set of TProjectWriteFlag;