mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-19 22:29:25 +02:00
implemented multiple source directories for project
git-svn-id: trunk@8153 -
This commit is contained in:
mattias
parent
9a450654ae
commit
5d59178cc3
@ -26,7 +26,7 @@
|
||||
Author: Mattias Gaertner
|
||||
|
||||
Abstract:
|
||||
- procs to transfer the compiler options to the CodeTools
|
||||
- procedures to transfer the compiler options to the CodeTools
|
||||
}
|
||||
unit EditDefineTree;
|
||||
|
||||
@ -42,10 +42,11 @@ uses
|
||||
// global
|
||||
procedure SetAdditionalGlobalSrcPathToCodeToolBoss(const SrcPath: string);
|
||||
|
||||
// current project
|
||||
function FindCurrentProjectTemplate: TDefineTemplate;
|
||||
function CreateProjectTemplate(var ProjectDirTemplate: TDefineTemplate
|
||||
): TDefineTemplate;
|
||||
// projects
|
||||
function FindProjectsTemplate: TDefineTemplate;
|
||||
function FindProjectTemplateWithID(const ProjectID: string): TDefineTemplate;
|
||||
function CreateProjectsTemplate: TDefineTemplate;
|
||||
function CreateProjectTemplateWithID(const ProjectID: string): TDefineTemplate;
|
||||
|
||||
// packages
|
||||
function FindPackagesTemplate: TDefineTemplate;
|
||||
@ -66,9 +67,11 @@ function RemoveAutoGeneratedDefine(ParentTemplate: TDefineTemplate;
|
||||
const
|
||||
ProjectDefTemplName = 'Current Project';
|
||||
ProjectDirDefTemplName = 'Current Project Directory';
|
||||
ProjectsDefTemplName = 'Projects';
|
||||
ProjectDirSrcPathDefTemplName = 'Project SrcPath';
|
||||
ProjectDirUnitPathDefTemplName = 'Project UnitPath';
|
||||
ProjectDirIncPathDefTemplName = 'Project IncPath';
|
||||
ProjectOutputDirDefTemplName = 'Project Output Directory';
|
||||
|
||||
PackagesDefTemplName = 'Packages';
|
||||
PkgOutputDirDefTemplName = 'Output Directory';
|
||||
@ -104,75 +107,55 @@ begin
|
||||
Result:=PkgTempl.FindChildByName(PkgID);
|
||||
end;
|
||||
|
||||
function FindCurrentProjectTemplate: TDefineTemplate;
|
||||
function FindProjectsTemplate: TDefineTemplate;
|
||||
begin
|
||||
if (CodeToolBoss<>nil) then
|
||||
Result:=CodeToolBoss.DefineTree.FindDefineTemplateByName(
|
||||
ProjectDefTemplName,true)
|
||||
ProjectsDefTemplName,true)
|
||||
else
|
||||
Result:=nil;
|
||||
end;
|
||||
|
||||
function CreateProjectTemplate(var ProjectDirTemplate: TDefineTemplate
|
||||
): TDefineTemplate;
|
||||
function FindProjectTemplateWithID(const ProjectID: string): TDefineTemplate;
|
||||
var
|
||||
ProjectDir, ProjectSrcPath, ProjectIncPath,
|
||||
ProjectUnitPath: TDefineTemplate;
|
||||
ProjectTempl: TDefineTemplate;
|
||||
begin
|
||||
if (CodeToolBoss=nil) then begin
|
||||
Result:=nil;
|
||||
exit;
|
||||
end;
|
||||
Result:=FindCurrentProjectTemplate;
|
||||
if (Result<>nil) then begin
|
||||
ProjectDirTemplate:=Result.FindChildByName(ProjectDirDefTemplName);
|
||||
exit;
|
||||
end;
|
||||
|
||||
// create the main template for the project
|
||||
Result:=TDefineTemplate.Create(ProjectDefTemplName, lisEdtDefCurrentProject,
|
||||
'', '',
|
||||
da_Block);
|
||||
ProjectTempl:=FindProjectsTemplate;
|
||||
if ProjectTempl=nil then
|
||||
Result:=nil
|
||||
else
|
||||
Result:=ProjectTempl.FindChildByName(ProjectID);
|
||||
end;
|
||||
|
||||
// create the template for the project directory
|
||||
ProjectDir:=TDefineTemplate.Create(ProjectDirDefTemplName,
|
||||
lisEdtDefCurrentProjectDirectory, '', '$(#ProjPath)', da_Directory);
|
||||
Result.AddChild(ProjectDir);
|
||||
ProjectDirTemplate:=ProjectDir;
|
||||
|
||||
// create the template for the SrcPath
|
||||
ProjectSrcPath:=TDefineTemplate.Create(ProjectDirSrcPathDefTemplName,
|
||||
lisEdtDefProjectSrcPath, ExternalMacroStart+'SrcPath',
|
||||
'$Project(SrcPath);$('+ExternalMacroStart+'SrcPath)',
|
||||
da_DefineRecurse);
|
||||
ProjectDir.AddChild(ProjectSrcPath);
|
||||
|
||||
// create the template for the IncPath
|
||||
ProjectIncPath:=TDefineTemplate.Create(ProjectDirIncPathDefTemplName,
|
||||
lisEdtDefProjectIncPath, ExternalMacroStart+'IncPath',
|
||||
'$Project(IncPath);$('+ExternalMacroStart+'IncPath)',
|
||||
da_DefineRecurse);
|
||||
ProjectDir.AddChild(ProjectIncPath);
|
||||
|
||||
// create the template for the UnitPath
|
||||
ProjectUnitPath:=TDefineTemplate.Create(ProjectDirUnitPathDefTemplName,
|
||||
lisEdtDefProjectUnitPath, ExternalMacroStart+'UnitPath',
|
||||
'$Project(UnitPath);$('+ExternalMacroStart+'UnitPath)',
|
||||
da_DefineRecurse);
|
||||
ProjectDir.AddChild(ProjectUnitPath);
|
||||
|
||||
Result.SetFlags([dtfAutoGenerated],[],false);
|
||||
function CreateProjectsTemplate: TDefineTemplate;
|
||||
begin
|
||||
Result:=FindProjectsTemplate;
|
||||
if Result<>nil then exit;
|
||||
Result:=TDefineTemplate.Create(ProjectsDefTemplName, lisEdtDefsAllProjects,
|
||||
'', '', da_Block);
|
||||
Result.Flags:=[dtfAutoGenerated];
|
||||
// insert behind all
|
||||
CodeToolBoss.DefineTree.ReplaceRootSameName(Result);
|
||||
end;
|
||||
|
||||
function CreateProjectTemplateWithID(const ProjectID: string): TDefineTemplate;
|
||||
var
|
||||
ProjTempl: TDefineTemplate;
|
||||
begin
|
||||
ProjTempl:=CreateProjectsTemplate;
|
||||
Result:=ProjTempl.FindChildByName(ProjectID);
|
||||
if Result<>nil then exit;
|
||||
Result:=TDefineTemplate.Create(ProjectID,ProjectID,'','',da_Block);
|
||||
Result.Flags:=[dtfAutoGenerated];
|
||||
ProjTempl.AddChild(Result);
|
||||
end;
|
||||
|
||||
function CreatePackagesTemplate: TDefineTemplate;
|
||||
begin
|
||||
Result:=FindPackagesTemplate;
|
||||
if Result<>nil then exit;
|
||||
Result:=TDefineTemplate.Create(PackagesDefTemplName, lisEdtDefAllPackages,
|
||||
'', '',
|
||||
da_Block);
|
||||
'', '', da_Block);
|
||||
Result.Flags:=[dtfAutoGenerated];
|
||||
// insert behind all
|
||||
CodeToolBoss.DefineTree.ReplaceRootSameName(Result);
|
||||
|
||||
@ -148,14 +148,18 @@ begin
|
||||
CurFileLen:=length(CurFileName);
|
||||
if CurFileLen>0 then begin
|
||||
// add semicolon
|
||||
FSearchPath[StartPos]:=';';
|
||||
inc(StartPos);
|
||||
if StartPos>1 then begin
|
||||
FSearchPath[StartPos]:=';';
|
||||
inc(StartPos);
|
||||
end;
|
||||
// add path
|
||||
Move(CurFileName[1],FSearchPath[StartPos],CurFileLen);
|
||||
inc(StartPos,CurFileLen);
|
||||
end;
|
||||
ANode:=FTree.FindSuccessor(ANode);
|
||||
end;
|
||||
if StartPos<>length(FSearchPath)+1 then
|
||||
RaiseException('TFileReferenceList.UpdateSearchPath');
|
||||
end;
|
||||
Include(FFlags,frfSearchPathValid);
|
||||
end;
|
||||
@ -170,7 +174,7 @@ end;
|
||||
|
||||
procedure TFileReferenceList.Invalidate;
|
||||
begin
|
||||
if frfSearchPathValid in FFlags then exit;
|
||||
if not (frfSearchPathValid in FFlags) then exit;
|
||||
Exclude(FFlags,frfSearchPathValid);
|
||||
IncreaseTimeStamp;
|
||||
if FUpdateLock>0 then
|
||||
|
||||
@ -98,6 +98,7 @@ resourcestring
|
||||
lisProjectSrcPath = 'Project Src Path';
|
||||
lisMakeExe = 'Make Executable';
|
||||
lisProjectMakroProperties = 'Project makro properties';
|
||||
lisProjectMakroUnitPath = 'makro ProjectUnitPath';
|
||||
lisConfigDirectory = 'Lazarus config directory';
|
||||
|
||||
// main bar menu
|
||||
@ -2085,6 +2086,7 @@ resourcestring
|
||||
lisEdtDefProjectIncPath = 'Project IncPath';
|
||||
lisEdtDefProjectUnitPath = 'Project UnitPath';
|
||||
lisEdtDefAllPackages = 'All packages';
|
||||
lisEdtDefsAllProjects = 'All projects';
|
||||
lisEdtDefsetFPCModeToDELPHI = 'set FPC mode to DELPHI';
|
||||
lisEdtDefsetFPCModeToTP = 'set FPC mode to TP';
|
||||
lisEdtDefsetFPCModeToGPC = 'set FPC mode to GPC';
|
||||
@ -2359,17 +2361,18 @@ resourcestring
|
||||
+'components are outdated.';
|
||||
lisPkgSysRegisterProcedureIsNil = 'Register procedure is nil';
|
||||
lisPkgSysThisPackageIsInstalledButTheLpkFileWasNotFound = 'This package is '
|
||||
+'installed, but the lpk file was not found.All its components are '
|
||||
+'installed, but the lpk file was not found. All its components are '
|
||||
+'deactivated. Please fix this.';
|
||||
lisPkgSysPackageFileNotFound = 'Package file not found';
|
||||
lisPkgSysThePackageIsInstalledButNoValidPackageFileWasFound = 'The package %'
|
||||
+'s%s%s is installed, but no valid package file was found.%sA broken '
|
||||
+'s%s%s is installed, but no valid package file (.lpk) was found.%sA broken '
|
||||
+'dummy package was created.';
|
||||
|
||||
// package defs
|
||||
lisPkgDefsOutputDirectory = 'Output directory';
|
||||
lisPkgDefsCompiledSrcPathAddition = 'CompiledSrcPath addition';
|
||||
lisPkgDefsUnitPath = 'Unit Path';
|
||||
lisProjProjectSourceDirectoryMark = 'Project Source Directory Mark';
|
||||
lisPkgDefsSrcDirMark = 'Package Source Directory Mark';
|
||||
|
||||
// add active file to package dialog
|
||||
|
||||
54
ide/main.pp
54
ide/main.pp
@ -785,6 +785,9 @@ type
|
||||
function OnMacroPromptFunction(const s:string; var Abort: boolean): string;
|
||||
function OnMacroFuncMakeExe(const Filename:string; var Abort: boolean): string;
|
||||
function OnMacroFuncProject(const Param: string; var Abort: boolean): string;
|
||||
function OnMacroFuncProjectUnitPath(Data: Pointer): boolean;
|
||||
function OnMacroFuncProjectIncPath(Data: Pointer): boolean;
|
||||
function OnMacroFuncProjectSrcPath(Data: Pointer): boolean;
|
||||
procedure OnCmdLineCreate(var CmdLine: string; var Abort: boolean);
|
||||
procedure GetIDEFileState(Sender: TObject; const AFilename: string;
|
||||
NeededFlags: TIDEFileStateFlags; var ResultFlags: TIDEFileStateFlags); override;
|
||||
@ -1553,6 +1556,14 @@ begin
|
||||
|
||||
MacroList.OnSubstitution:=@OnMacroSubstitution;
|
||||
CompilerOptions.OnParseString:=@OnSubstituteCompilerOption;
|
||||
|
||||
// projects macro functions
|
||||
CodeToolBoss.DefineTree.MacroFunctions.AddExtended(
|
||||
'PROJECTUNITPATH',nil,@OnMacroFuncProjectUnitPath);
|
||||
CodeToolBoss.DefineTree.MacroFunctions.AddExtended(
|
||||
'PROJECTINCPATH',nil,@OnMacroFuncProjectIncPath);
|
||||
CodeToolBoss.DefineTree.MacroFunctions.AddExtended(
|
||||
'PROJECTSRCPATH',nil,@OnMacroFuncProjectSrcPath);
|
||||
end;
|
||||
|
||||
procedure TMainIDE.SetupCodeMacros;
|
||||
@ -4016,7 +4027,7 @@ function TMainIDE.DoRenameUnit(AnUnitInfo: TUnitInfo;
|
||||
var ResourceCode: TCodeBuffer): TModalresult;
|
||||
var
|
||||
NewLFMFilename: String;
|
||||
OldSource: String;
|
||||
OldSourceCode: String;
|
||||
NewSource: TCodeBuffer;
|
||||
NewFilePath: String;
|
||||
NewResFilePath: String;
|
||||
@ -4070,9 +4081,9 @@ begin
|
||||
end;
|
||||
|
||||
// create new source with the new filename
|
||||
OldSource:=AnUnitInfo.Source.Source;
|
||||
OldSourceCode:=AnUnitInfo.Source.Source;
|
||||
NewSource:=CodeToolBoss.CreateFile(NewFilename);
|
||||
NewSource.Source:=OldSource;
|
||||
NewSource.Source:=OldSourceCode;
|
||||
if NewSource=nil then begin
|
||||
Result:=MessageDlg(lisUnableToCreateFile,
|
||||
Format(lisCanNotCreateFile, ['"', NewFilename, '"']),
|
||||
@ -4953,6 +4964,7 @@ begin
|
||||
PkgBoss.OpenProjectDependencies(Project1,true);
|
||||
|
||||
Project1.DefineTemplates.AllChanged;
|
||||
Project1.DefineTemplates.Active:=true;
|
||||
Result:=mrOk;
|
||||
end;
|
||||
|
||||
@ -8852,6 +8864,42 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function TMainIDE.OnMacroFuncProjectUnitPath(Data: Pointer): boolean;
|
||||
var
|
||||
FuncData: PReadFunctionData;
|
||||
begin
|
||||
FuncData:=PReadFunctionData(Data);
|
||||
Result:=false;
|
||||
if Project1<>nil then begin
|
||||
FuncData^.Result:=Project1.CompilerOptions.GetUnitPath(false);
|
||||
Result:=true;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TMainIDE.OnMacroFuncProjectIncPath(Data: Pointer): boolean;
|
||||
var
|
||||
FuncData: PReadFunctionData;
|
||||
begin
|
||||
FuncData:=PReadFunctionData(Data);
|
||||
Result:=false;
|
||||
if Project1<>nil then begin
|
||||
FuncData^.Result:=Project1.CompilerOptions.GetIncludePath(false);
|
||||
Result:=true;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TMainIDE.OnMacroFuncProjectSrcPath(Data: Pointer): boolean;
|
||||
var
|
||||
FuncData: PReadFunctionData;
|
||||
begin
|
||||
FuncData:=PReadFunctionData(Data);
|
||||
Result:=false;
|
||||
if Project1<>nil then begin
|
||||
FuncData^.Result:=Project1.CompilerOptions.GetSrcPath(false);
|
||||
Result:=true;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TMainIDE.OnCmdLineCreate(var CmdLine: string; var Abort:boolean);
|
||||
// replace all transfer macros in command line
|
||||
begin
|
||||
|
||||
459
ide/project.pp
459
ide/project.pp
@ -122,6 +122,7 @@ type
|
||||
fUserReadOnly: Boolean;
|
||||
FSourceDirectoryReferenced: boolean;
|
||||
FSourceDirNeedReference: boolean;
|
||||
fLastDirectoryReferenced: string;
|
||||
|
||||
function GetHasResources:boolean;
|
||||
function GetNextAutoRevertLockedUnit: TUnitInfo;
|
||||
@ -150,6 +151,7 @@ type
|
||||
procedure SetFilename(const AValue: string); override;
|
||||
procedure SetIsPartOfProject(const AValue: boolean); override;
|
||||
procedure UpdateList(ListType: TUnitInfoList; Add: boolean);
|
||||
procedure SetInternalFilename(const NewFilename: string);
|
||||
public
|
||||
constructor Create(ACodeBuffer: TCodeBuffer);
|
||||
destructor Destroy; override;
|
||||
@ -158,6 +160,7 @@ type
|
||||
function IsAutoRevertLocked: boolean;
|
||||
function IsMainUnit: boolean;
|
||||
function IsVirtual: boolean;
|
||||
function GetDirectory: string;
|
||||
function NeedsSaveToDisk: boolean;
|
||||
function ReadOnly: boolean;
|
||||
function ReadUnitSource(ReadUnitName,Revert:boolean): TModalResult;
|
||||
@ -266,6 +269,14 @@ type
|
||||
|
||||
procedure SetTargetCPU(const AValue: string); override;
|
||||
procedure SetTargetOS(const AValue: string); override;
|
||||
procedure SetCustomOptions(const AValue: string); override;
|
||||
procedure SetIncludeFiles(const AValue: string); override;
|
||||
procedure SetLibraries(const AValue: string); override;
|
||||
procedure SetLinkerOptions(const AValue: string); override;
|
||||
procedure SetObjectPath(const AValue: string); override;
|
||||
procedure SetSrcPath(const AValue: string); override;
|
||||
procedure SetOtherUnitFiles(const AValue: string); override;
|
||||
procedure SetUnitOutputDir(const AValue: string); override;
|
||||
procedure UpdateGlobals; virtual;
|
||||
public
|
||||
constructor Create(const AOwner: TObject); override;
|
||||
@ -275,8 +286,10 @@ type
|
||||
procedure GetInheritedCompilerOptions(var OptionsList: TList); override;
|
||||
procedure Assign(Source: TPersistent); override;
|
||||
function IsEqual(CompOpts: TBaseCompilerOptions): boolean; override;
|
||||
procedure InvalidateOptions;
|
||||
public
|
||||
property OwnerProject: TProject read FOwnerProject;
|
||||
property Project: TProject read FOwnerProject;
|
||||
property Globals: TGlobalCompilerOptions read FGlobals;
|
||||
property CompileReasons: TCompileReasons read FCompileReasons write FCompileReasons;
|
||||
end;
|
||||
@ -285,19 +298,35 @@ type
|
||||
{ TProjectDefineTemplates }
|
||||
|
||||
TProjectDefineTemplatesFlag = (
|
||||
ptfFlagsChanged
|
||||
ptfFlagsChanged,
|
||||
ptfIDChanged,
|
||||
ptfSourceDirsChanged,
|
||||
ptfOutputDirChanged,
|
||||
ptfCustomDefinesChanged
|
||||
);
|
||||
TProjectDefineTemplatesFlags = set of TProjectDefineTemplatesFlag;
|
||||
|
||||
TProjectDefineTemplates = class
|
||||
private
|
||||
FActive: boolean;
|
||||
FCustomDefines: TDefineTemplate;
|
||||
FFlags: TProjectDefineTemplatesFlags;
|
||||
FMain: TDefineTemplate;
|
||||
FOutputDir: TDefineTemplate;
|
||||
FOutPutSrcPath: TDefineTemplate;
|
||||
FProjectDir: TDefineTemplate;
|
||||
FProject: TProject;
|
||||
FOwnerProject: TProject;
|
||||
FUpdateLock: integer;
|
||||
fLastSourceDirectories: TStringList;
|
||||
fLastOutputDirSrcPathIDAsString: string;
|
||||
fLastSourceDirsIDAsString: string;
|
||||
fLastSourceDirStamp: integer;
|
||||
FLastCustomOptions: string;
|
||||
procedure SetActive(const AValue: boolean);
|
||||
procedure UpdateMain;
|
||||
procedure UpdateDefinesForOutputDirectory;
|
||||
procedure UpdateDefinesForSourceDirectories;
|
||||
procedure UpdateDefinesForCustomDefines;
|
||||
public
|
||||
constructor Create(OwnerProject: TProject);
|
||||
destructor Destroy; override;
|
||||
@ -306,11 +335,19 @@ type
|
||||
procedure EndUpdate;
|
||||
procedure CompilerFlagsChanged;
|
||||
procedure AllChanged;
|
||||
procedure ProjectIDChanged;
|
||||
procedure SourceDirectoriesChanged;
|
||||
procedure OutputDirectoryChanged;
|
||||
procedure CustomDefinesChanged;
|
||||
procedure UpdateGlobalValues;
|
||||
public
|
||||
property Owner: TProject read FProject;
|
||||
property Owner: TProject read FOwnerProject;
|
||||
property Project: TProject read FOwnerProject;
|
||||
property Main: TDefineTemplate read FMain;
|
||||
property OutputDir: TDefineTemplate read FOutputDir;
|
||||
property OutPutSrcPath: TDefineTemplate read FOutPutSrcPath;
|
||||
property CustomDefines: TDefineTemplate read FCustomDefines;
|
||||
property Active: boolean read FActive write SetActive;
|
||||
end;
|
||||
|
||||
|
||||
@ -402,7 +439,6 @@ type
|
||||
fPathDelimChanged: boolean;
|
||||
fProjectDirectory: string;
|
||||
fProjectInfoFile: String; // the lpi filename
|
||||
//fProjectType: TProjectType;
|
||||
FPublishOptions: TPublishProjectOptions;
|
||||
FRunParameterOptions: TRunParamsOptions;
|
||||
FSourceDirectories: TFileReferenceList;
|
||||
@ -460,6 +496,7 @@ type
|
||||
procedure BeginUpdate(Change: boolean);
|
||||
procedure EndUpdate;
|
||||
procedure UnitModified(AnUnitInfo: TUnitInfo);
|
||||
function NeedsDefineTemplates: boolean;
|
||||
|
||||
// load/save
|
||||
function IsVirtual: boolean;
|
||||
@ -473,6 +510,8 @@ type
|
||||
// title
|
||||
function GetDefaultTitle: string;
|
||||
function TitleIsDefault: boolean;
|
||||
function IDAsString: string;
|
||||
function IDAsWord: string;
|
||||
|
||||
// units
|
||||
function UnitCount:integer;
|
||||
@ -656,7 +695,7 @@ begin
|
||||
exit;
|
||||
end;
|
||||
if Assigned(fOnFileBackup) then begin
|
||||
Result:=fOnFileBackup(fFilename,IsPartOfProject);
|
||||
Result:=fOnFileBackup(Filename,IsPartOfProject);
|
||||
if Result=mrAbort then exit;
|
||||
end;
|
||||
repeat
|
||||
@ -685,7 +724,7 @@ begin
|
||||
exit;
|
||||
end;
|
||||
if Assigned(fOnFileBackup) then begin
|
||||
Result:=fOnFileBackup(fFilename,false);
|
||||
Result:=fOnFileBackup(Filename,false);
|
||||
if Result=mrAbort then exit;
|
||||
end;
|
||||
repeat
|
||||
@ -712,10 +751,10 @@ var
|
||||
NewSource: TCodeBuffer;
|
||||
begin
|
||||
repeat
|
||||
NewSource:=CodeToolBoss.LoadFile(fFilename,true,Revert);
|
||||
NewSource:=CodeToolBoss.LoadFile(Filename,true,Revert);
|
||||
if NewSource=nil then begin
|
||||
ACaption:=lisCodeToolsDefsReadError;
|
||||
AText:=Format(lisUnableToReadFile2, ['"', fFilename, '"']);
|
||||
AText:=Format(lisUnableToReadFile2, ['"', Filename, '"']);
|
||||
Result:=Application.MessageBox(PChar(AText),PChar(ACaption)
|
||||
,MB_ABORTRETRYIGNORE);
|
||||
if Result in [mrAbort,mrIgnore] then
|
||||
@ -783,7 +822,8 @@ begin
|
||||
fFilename := '';
|
||||
fFileReadOnly := false;
|
||||
fHasResources := false;
|
||||
FIgnoreFileDateOnDiskValid:=false;
|
||||
FIgnoreFileDateOnDiskValid := false;
|
||||
fAutoReferenceSourceDir := true;
|
||||
inherited SetIsPartOfProject(false);
|
||||
fModified := false;
|
||||
FSessionModified := false;
|
||||
@ -906,10 +946,29 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TUnitInfo.SetInternalFilename(const NewFilename: string);
|
||||
begin
|
||||
if fFileName=NewFilename then exit;
|
||||
//DebugLn('TUnitInfo.SetInternalFilename Old=',fFileName,' New=',NewFilename);
|
||||
|
||||
// if directory changed then remove the old directory reference
|
||||
if SourceDirectoryReferenced
|
||||
and (Project<>nil)
|
||||
and (fLastDirectoryReferenced<>GetDirectory) then begin
|
||||
Project.SourceDirectories.RemoveFilename(fLastDirectoryReferenced);
|
||||
FSourceDirectoryReferenced:=false;
|
||||
end;
|
||||
|
||||
fFileName:=NewFilename;
|
||||
UpdateSourceDirectoryReference;
|
||||
end;
|
||||
|
||||
function TUnitInfo.GetFileName: string;
|
||||
begin
|
||||
if fSource<>nil then Result:=fSource.Filename
|
||||
else Result:=fFileName;
|
||||
if fSource<>nil then
|
||||
Result:=fSource.Filename
|
||||
else
|
||||
Result:=fFileName;
|
||||
end;
|
||||
|
||||
procedure TUnitInfo.SetFilename(const AValue: string);
|
||||
@ -917,7 +976,7 @@ begin
|
||||
if fSource<>nil then
|
||||
RaiseException('TUnitInfo.SetFilename Source<>nil')
|
||||
else
|
||||
fFileName:=AValue;
|
||||
SetInternalFilename(AValue);
|
||||
end;
|
||||
|
||||
function TUnitInfo.IsVirtual: boolean;
|
||||
@ -928,6 +987,18 @@ begin
|
||||
Result:=(fFileName<>ExpandFileName(fFileName));
|
||||
end;
|
||||
|
||||
function TUnitInfo.GetDirectory: string;
|
||||
begin
|
||||
if IsVirtual then begin
|
||||
if Project<>nil then
|
||||
Result:=Project.ProjectDirectory
|
||||
else
|
||||
Result:='';
|
||||
end else begin
|
||||
Result:=ExtractFilePath(Filename);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TUnitInfo.IsMainUnit: boolean;
|
||||
begin
|
||||
Result:=(Project<>nil) and (Project.MainUnitInfo=Self);
|
||||
@ -1018,15 +1089,19 @@ end;
|
||||
|
||||
procedure TUnitInfo.UpdateSourceDirectoryReference;
|
||||
begin
|
||||
FSourceDirNeedReference:=IsPartOfProject and (FilenameIsPascalUnit(Filename));
|
||||
if (not AutoReferenceSourceDir) or (FProject=nil) then exit;
|
||||
if FSourceDirNeedReference then begin
|
||||
if not SourceDirectoryReferenced then begin
|
||||
//Project.SourceDirectories.AddFilename(FDirectory);
|
||||
fLastDirectoryReferenced:=GetDirectory;
|
||||
Project.SourceDirectories.AddFilename(fLastDirectoryReferenced);
|
||||
//DebugLn('TUnitInfo.UpdateSourceDirectoryReference ADD File="',Filename,' Path="',Project.SourceDirectories.CreateSearchPathFromAllFiles,'"');
|
||||
FSourceDirectoryReferenced:=true;
|
||||
end;
|
||||
end else begin
|
||||
if SourceDirectoryReferenced then begin
|
||||
//Project.SourceDirectories.RemoveFilename(FDirectory);
|
||||
Project.SourceDirectories.RemoveFilename(fLastDirectoryReferenced);
|
||||
//DebugLn('TUnitInfo.UpdateSourceDirectoryReference REMOVE File="',Filename,' Path="',Project.SourceDirectories.CreateSearchPathFromAllFiles,'"');
|
||||
FSourceDirectoryReferenced:=false;
|
||||
end;
|
||||
end;
|
||||
@ -1057,7 +1132,7 @@ begin
|
||||
if (fSource<>nil) then begin
|
||||
if IsAutoRevertLocked then
|
||||
fSource.LockAutoDiskRevert;
|
||||
fFileName:=fSource.FileName;
|
||||
SetInternalFilename(fSource.FileName);
|
||||
if (fProject<>nil) and (fProject.MainUnitInfo=Self) then
|
||||
fProject.MainSourceFilenameChanged;
|
||||
end;
|
||||
@ -1148,8 +1223,7 @@ procedure TUnitInfo.SetAutoReferenceSourceDir(const AValue: boolean);
|
||||
begin
|
||||
if FAutoReferenceSourceDir=AValue then exit;
|
||||
FAutoReferenceSourceDir:=AValue;
|
||||
if FSourceDirNeedReference then
|
||||
UpdateSourceDirectoryReference;
|
||||
UpdateSourceDirectoryReference;
|
||||
end;
|
||||
|
||||
procedure TUnitInfo.SetBuildFileIfActive(const AValue: boolean);
|
||||
@ -1188,6 +1262,7 @@ begin
|
||||
inherited SetIsPartOfProject(AValue);
|
||||
UpdateList(uilPartOfProject,IsPartOfProject);
|
||||
if IsPartOfProject then UpdateUsageCount(uuIsPartOfProject,0);
|
||||
UpdateSourceDirectoryReference;
|
||||
if Project<>nil then Project.EndUpdate;
|
||||
end;
|
||||
|
||||
@ -1227,6 +1302,7 @@ begin
|
||||
if IsAutoRevertLocked then Project.AddToList(Self,uilAutoRevertLocked);
|
||||
if IsPartOfProject then Project.AddToList(Self,uilPartOfProject);
|
||||
end;
|
||||
UpdateSourceDirectoryReference;
|
||||
end;
|
||||
|
||||
procedure TUnitInfo.SetRunFileIfActive(const AValue: boolean);
|
||||
@ -1276,6 +1352,7 @@ end;
|
||||
------------------------------------------------------------------------------}
|
||||
destructor TProject.Destroy;
|
||||
begin
|
||||
FDefineTemplates.Active:=false;
|
||||
fDestroying:=true;
|
||||
Clear;
|
||||
FreeThenNil(FBookmarks);
|
||||
@ -1472,6 +1549,16 @@ begin
|
||||
Result:=(Title='') or (Title=GetDefaultTitle);
|
||||
end;
|
||||
|
||||
function TProject.IDAsString: string;
|
||||
begin
|
||||
Result:='Project'; // TODO: see TLazPackage
|
||||
end;
|
||||
|
||||
function TProject.IDAsWord: string;
|
||||
begin
|
||||
Result:='Project'; // TODO: see TLazPackage
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
TProject ReadProject
|
||||
------------------------------------------------------------------------------}
|
||||
@ -1490,7 +1577,6 @@ var
|
||||
Path: String;
|
||||
OldProjectType: TOldProjectType;
|
||||
xmlconfig: TXMLConfig;
|
||||
SourceDirectoriesUpdated: Boolean;
|
||||
SubPath: String;
|
||||
NewUnitFilename: String;
|
||||
|
||||
@ -1578,7 +1664,6 @@ begin
|
||||
exit;
|
||||
end;
|
||||
|
||||
SourceDirectoriesUpdated:=true;
|
||||
try
|
||||
Path:='ProjectOptions/';
|
||||
fPathDelimChanged:=
|
||||
@ -1602,7 +1687,6 @@ begin
|
||||
OldSrcPath := xmlconfig.GetValue(Path+'General/SrcPath/Value','');
|
||||
|
||||
{$IFDEF IDE_MEM_CHECK}CheckHeapWrtMemCnt('TProject.ReadProject D reading units');{$ENDIF}
|
||||
SourceDirectoriesUpdated:=false;
|
||||
NewUnitCount:=xmlconfig.GetValue(Path+'Units/Count',0);
|
||||
for i := 0 to NewUnitCount - 1 do begin
|
||||
SubPath:=Path+'Units/Unit'+IntToStr(i)+'/';
|
||||
@ -1618,8 +1702,6 @@ begin
|
||||
AddFile(NewUnitInfo,false);
|
||||
NewUnitInfo.LoadFromXMLConfig(xmlconfig,SubPath);
|
||||
end;
|
||||
UpdateSourceDirectories;
|
||||
SourceDirectoriesUpdated:=true;
|
||||
|
||||
//lazdoc
|
||||
LazDocPathList.Text := xmlconfig.GetValue(Path+'LazDoc/Paths', '');
|
||||
@ -1652,8 +1734,6 @@ begin
|
||||
if Assigned(OnLoadProjectInfo) then OnLoadProjectInfo(Self,XMLConfig);
|
||||
|
||||
finally
|
||||
if not SourceDirectoriesUpdated then
|
||||
UpdateSourceDirectories;
|
||||
{$IFDEF IDE_MEM_CHECK}CheckHeapWrtMemCnt('TProject.ReadProject freeing xml');{$ENDIF}
|
||||
fPathDelimChanged:=false;
|
||||
try
|
||||
@ -1808,6 +1888,7 @@ procedure TProject.BeginUpdate(Change: boolean);
|
||||
begin
|
||||
inc(FUpdateLock);
|
||||
FDefineTemplates.BeginUpdate;
|
||||
FSourceDirectories.BeginUpdate;
|
||||
if FUpdateLock=1 then begin
|
||||
fChanged:=Change;
|
||||
if Assigned(OnBeginUpdate) then OnBeginUpdate(Self);
|
||||
@ -1819,6 +1900,7 @@ procedure TProject.EndUpdate;
|
||||
begin
|
||||
if FUpdateLock<=0 then RaiseException('TProject.EndUpdate');
|
||||
dec(FUpdateLock);
|
||||
FSourceDirectories.EndUpdate;
|
||||
FDefineTemplates.EndUpdate;
|
||||
if FUpdateLock=0 then begin
|
||||
if Assigned(OnEndUpdate) then OnEndUpdate(Self,fChanged);
|
||||
@ -1833,6 +1915,11 @@ begin
|
||||
SessionModified:=true;
|
||||
end;
|
||||
|
||||
function TProject.NeedsDefineTemplates: boolean;
|
||||
begin
|
||||
Result:=not Destroying;
|
||||
end;
|
||||
|
||||
function TProject.GetUnits(Index:integer):TUnitInfo;
|
||||
begin
|
||||
Result:=TUnitInfo(FUnitList[Index]);
|
||||
@ -2675,7 +2762,7 @@ begin
|
||||
end;
|
||||
|
||||
function TProject.JumpHistoryCheckPosition(
|
||||
APosition:TProjectJumpHistoryPosition): boolean;
|
||||
APosition: TProjectJumpHistoryPosition): boolean;
|
||||
var i: integer;
|
||||
begin
|
||||
i:=IndexOfFilename(APosition.Filename);
|
||||
@ -3050,6 +3137,66 @@ begin
|
||||
FGlobals.TargetOS:=TargetOS;
|
||||
end;
|
||||
|
||||
procedure TProjectCompilerOptions.SetCustomOptions(const AValue: string);
|
||||
begin
|
||||
if CustomOptions=AValue then exit;
|
||||
InvalidateOptions;
|
||||
inherited SetCustomOptions(AValue);
|
||||
if Project<>nil then
|
||||
Project.DefineTemplates.CustomDefinesChanged;
|
||||
end;
|
||||
|
||||
procedure TProjectCompilerOptions.SetIncludeFiles(const AValue: string);
|
||||
begin
|
||||
if IncludeFiles=AValue then exit;
|
||||
InvalidateOptions;
|
||||
inherited SetIncludeFiles(AValue);
|
||||
end;
|
||||
|
||||
procedure TProjectCompilerOptions.SetLibraries(const AValue: string);
|
||||
begin
|
||||
if Libraries=AValue then exit;
|
||||
InvalidateOptions;
|
||||
inherited SetLibraries(AValue);
|
||||
end;
|
||||
|
||||
procedure TProjectCompilerOptions.SetLinkerOptions(const AValue: string);
|
||||
begin
|
||||
if LinkerOptions=AValue then exit;
|
||||
InvalidateOptions;
|
||||
inherited SetLinkerOptions(AValue);
|
||||
end;
|
||||
|
||||
procedure TProjectCompilerOptions.SetObjectPath(const AValue: string);
|
||||
begin
|
||||
if ObjectPath=AValue then exit;
|
||||
InvalidateOptions;
|
||||
inherited SetObjectPath(AValue);
|
||||
end;
|
||||
|
||||
procedure TProjectCompilerOptions.SetSrcPath(const AValue: string);
|
||||
begin
|
||||
if SrcPath=AValue then exit;
|
||||
InvalidateOptions;
|
||||
inherited SetSrcPath(AValue);
|
||||
end;
|
||||
|
||||
procedure TProjectCompilerOptions.SetOtherUnitFiles(const AValue: string);
|
||||
begin
|
||||
if OtherUnitFiles=AValue then exit;
|
||||
InvalidateOptions;
|
||||
inherited SetOtherUnitFiles(AValue);
|
||||
end;
|
||||
|
||||
procedure TProjectCompilerOptions.SetUnitOutputDir(const AValue: string);
|
||||
begin
|
||||
if UnitOutputDirectory=AValue then exit;
|
||||
InvalidateOptions;
|
||||
inherited SetUnitOutputDir(AValue);
|
||||
if Project<>nil then
|
||||
Project.DefineTemplates.OutputDirectoryChanged;
|
||||
end;
|
||||
|
||||
procedure TProjectCompilerOptions.Assign(Source: TPersistent);
|
||||
begin
|
||||
inherited Assign(Source);
|
||||
@ -3067,6 +3214,12 @@ begin
|
||||
and inherited IsEqual(CompOpts);
|
||||
end;
|
||||
|
||||
procedure TProjectCompilerOptions.InvalidateOptions;
|
||||
begin
|
||||
if (Project=nil) then exit;
|
||||
// TODO: propagate change to all dependants projects
|
||||
end;
|
||||
|
||||
procedure TProjectCompilerOptions.UpdateGlobals;
|
||||
begin
|
||||
FGlobals.TargetCPU:=TargetCPU;
|
||||
@ -3127,15 +3280,207 @@ end;
|
||||
|
||||
{ TProjectDefineTemplates }
|
||||
|
||||
procedure TProjectDefineTemplates.SetActive(const AValue: boolean);
|
||||
begin
|
||||
if FActive=AValue then exit;
|
||||
FActive:=AValue;
|
||||
if not FActive then Clear else AllChanged;
|
||||
end;
|
||||
|
||||
procedure TProjectDefineTemplates.UpdateMain;
|
||||
begin
|
||||
//DebugLn('TProjectDefineTemplates.UpdateMain ',Project.IDAsString,' Active=',dbgs(Active));
|
||||
// update the package block define template (the container for all other
|
||||
// define templates of the project)
|
||||
if (FMain=nil) and (not Project.Destroying) then begin
|
||||
// create the main project template
|
||||
FMain:=CreateProjectTemplateWithID(Project.IDAsWord);
|
||||
FMain.SetDefineOwner(Owner,false);
|
||||
FMain.SetFlags([dtfAutoGenerated],[],false);
|
||||
end else
|
||||
FMain.Name:=Project.IDAsWord;
|
||||
// ClearCache is here unnessary, because it is only a block
|
||||
end;
|
||||
|
||||
procedure TProjectDefineTemplates.UpdateDefinesForOutputDirectory;
|
||||
begin
|
||||
//DebugLn('TProjectDefineTemplates.UpdateDefinesForOutputDirectory ',Project.IDAsString);
|
||||
if (not Project.NeedsDefineTemplates) or (not Active) then exit;
|
||||
if FMain=nil then UpdateMain;
|
||||
|
||||
if FOutputDir=nil then begin
|
||||
//DebugLn('TProjectDefineTemplates.UpdateDefinesForOutputDirectory ',Project.IDAsString,' creating FOutputDir');
|
||||
FOutputDir:=TDefineTemplate.Create(ProjectOutputDirDefTemplName,
|
||||
'Output directoy of project', '', Project.GetOutputDirectory, da_Directory
|
||||
);
|
||||
FOutputDir.SetDefineOwner(Project,false);
|
||||
FOutputDir.SetFlags([dtfAutoGenerated],[],false);
|
||||
FMain.AddChild(FOutputDir);
|
||||
end else begin
|
||||
FOutputDir.Value:=Project.GetOutputDirectory;
|
||||
end;
|
||||
|
||||
if (FOutPutSrcPath=nil)
|
||||
or (fLastOutputDirSrcPathIDAsString<>Project.IDAsString) then begin
|
||||
fLastOutputDirSrcPathIDAsString:=Project.IDAsString;
|
||||
FOutputSrcPath:=TDefineTemplate.Create('CompiledSrcPath',
|
||||
lisPkgDefsCompiledSrcPathAddition, CompiledSrcPathMacroName,
|
||||
'$PkgSrcPath('+fLastOutputDirSrcPathIDAsString+');'
|
||||
+'$('+CompiledSrcPathMacroName+')',
|
||||
da_Define);
|
||||
FOutputSrcPath.SetDefineOwner(Project,false);
|
||||
FOutputSrcPath.SetFlags([dtfAutoGenerated],[],false);
|
||||
CodeToolBoss.DefineTree.ReplaceChild(FOutputDir,FOutputSrcPath,
|
||||
FOutputSrcPath.Name);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TProjectDefineTemplates.UpdateDefinesForSourceDirectories;
|
||||
var
|
||||
NewSourceDirs: TStringList;
|
||||
i: Integer;
|
||||
SrcDirDefTempl: TDefineTemplate;
|
||||
UnitPathDefTempl: TDefineTemplate;
|
||||
IncPathDefTempl: TDefineTemplate;
|
||||
IDHasChanged: Boolean;
|
||||
SrcDirMarkDefTempl: TDefineTemplate;
|
||||
SrcPathDefTempl: TDefineTemplate;
|
||||
begin
|
||||
//DebugLn('TProjectDefineTemplates.UpdateDefinesForSourceDirectories ',Project.IDAsString,' Active=',dbgs(Active));
|
||||
if (not Project.NeedsDefineTemplates) or (not Active) then exit;
|
||||
|
||||
// quick check if something has changed
|
||||
IDHasChanged:=fLastSourceDirsIDAsString<>Project.IDAsString;
|
||||
if (fLastSourceDirectories<>nil)
|
||||
and (fLastSourceDirStamp=Project.SourceDirectories.TimeStamp)
|
||||
and (not IDHasChanged) then
|
||||
exit;
|
||||
fLastSourceDirStamp:=Project.SourceDirectories.TimeStamp;
|
||||
fLastSourceDirsIDAsString:=Project.IDAsString;
|
||||
|
||||
NewSourceDirs:=Project.SourceDirectories.CreateFileList;
|
||||
try
|
||||
// real check if something has changed
|
||||
if (fLastSourceDirectories<>nil)
|
||||
and (NewSourceDirs.Count=fLastSourceDirectories.Count)
|
||||
and (not IDHasChanged) then begin
|
||||
i:=NewSourceDirs.Count-1;
|
||||
while (i>=0)
|
||||
and (CompareFilenames(NewSourceDirs[i],fLastSourceDirectories[i])=0) do
|
||||
dec(i);
|
||||
if i<0 then exit;
|
||||
end;
|
||||
|
||||
// clear old define templates
|
||||
if fLastSourceDirectories<>nil then begin
|
||||
for i:=0 to fLastSourceDirectories.Count-1 do begin
|
||||
SrcDirDefTempl:=TDefineTemplate(fLastSourceDirectories.Objects[i]);
|
||||
SrcDirDefTempl.Unbind;
|
||||
SrcDirDefTempl.Free;
|
||||
end;
|
||||
fLastSourceDirectories.Clear;
|
||||
end else
|
||||
fLastSourceDirectories:=TStringList.Create;
|
||||
|
||||
// build source directory define templates
|
||||
fLastSourceDirectories.Assign(NewSourceDirs);
|
||||
if (FMain=nil) and (fLastSourceDirectories.Count>0) then UpdateMain;
|
||||
for i:=0 to fLastSourceDirectories.Count-1 do begin
|
||||
// create directory template
|
||||
SrcDirDefTempl:=TDefineTemplate.Create('Source Directory '+IntToStr(i+1),
|
||||
fLastSourceDirectories[i],'',fLastSourceDirectories[i],da_Directory);
|
||||
fLastSourceDirectories.Objects[i]:=SrcDirDefTempl;
|
||||
// add project source directory marker
|
||||
SrcDirMarkDefTempl:=TDefineTemplate.Create('ProjectSrcDirMark',
|
||||
lisProjProjectSourceDirectoryMark, '#ProjectSrcMark'+Project.IDAsWord,
|
||||
'',
|
||||
da_Define);
|
||||
SrcDirDefTempl.AddChild(SrcDirMarkDefTempl);
|
||||
|
||||
// create unit path template for this directory
|
||||
UnitPathDefTempl:=TDefineTemplate.Create('UnitPath', lisPkgDefsUnitPath,
|
||||
'#UnitPath','$(#UnitPath);$ProjectUnitPath('+Project.IDAsString+')',
|
||||
da_Define);
|
||||
SrcDirDefTempl.AddChild(UnitPathDefTempl);
|
||||
|
||||
// create include path template for this directory
|
||||
IncPathDefTempl:=TDefineTemplate.Create('IncPath','Include Path',
|
||||
'#IncPath','$(#IncPath);$ProjectIncPath('+Project.IDAsString+')',
|
||||
da_Define);
|
||||
SrcDirDefTempl.AddChild(IncPathDefTempl);
|
||||
|
||||
// create src path template for this directory
|
||||
SrcPathDefTempl:=TDefineTemplate.Create('SrcPath','Src Path',
|
||||
'#SrcPath','$(#SrcPath);$ProjectSrcPath('+Project.IDAsString+')',
|
||||
da_Define);
|
||||
SrcDirDefTempl.AddChild(SrcPathDefTempl);
|
||||
|
||||
SrcDirDefTempl.SetDefineOwner(Project,false);
|
||||
SrcDirDefTempl.SetFlags([dtfAutoGenerated],[],false);
|
||||
// add directory
|
||||
FMain.AddChild(SrcDirDefTempl);
|
||||
end;
|
||||
CodeToolBoss.DefineTree.ClearCache;
|
||||
|
||||
finally
|
||||
NewSourceDirs.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TProjectDefineTemplates.UpdateDefinesForCustomDefines;
|
||||
var
|
||||
OptionsDefTempl: TDefineTemplate;
|
||||
NewCustomOptions: String;
|
||||
begin
|
||||
if (not Project.NeedsDefineTemplates) or (not Active) then exit;
|
||||
|
||||
// check if something has changed
|
||||
NewCustomOptions:=Project.CompilerOptions.GetCustomOptions;
|
||||
if FLastCustomOptions=NewCustomOptions then exit;
|
||||
|
||||
FLastCustomOptions:=NewCustomOptions;
|
||||
OptionsDefTempl:=CodeToolBoss.DefinePool.CreateFPCCommandLineDefines(
|
||||
'Custom Options',FLastCustomOptions,false,Project);
|
||||
if OptionsDefTempl=nil then begin
|
||||
// no custom options -> delete old template
|
||||
if FCustomDefines<>nil then begin
|
||||
FCustomDefines.UnBind;
|
||||
FCustomDefines.Free;
|
||||
FCustomDefines:=nil;
|
||||
end;
|
||||
exit;
|
||||
end;
|
||||
|
||||
// create custom options
|
||||
// The custom options are enclosed by an
|
||||
// IFDEF #ProjectSrcMark<PckId> template.
|
||||
// Each source directory defines this variable, so that the settings can be
|
||||
// activated for each source directory by a simple DEFINE.
|
||||
if (FMain=nil) then UpdateMain;
|
||||
if FCustomDefines=nil then begin
|
||||
FCustomDefines:=TDefineTemplate.Create('Source Directory Additions',
|
||||
'Additional defines for project source directories',
|
||||
'#ProjectSrcMark'+Project.IDAsWord,'',
|
||||
da_IfDef);
|
||||
FMain.AddChild(FCustomDefines);
|
||||
end else begin
|
||||
FCustomDefines.Value:='#ProjectSrcMark'+Project.IDAsWord;
|
||||
end;
|
||||
FCustomDefines.ReplaceChild(OptionsDefTempl);
|
||||
|
||||
CodeToolBoss.DefineTree.ClearCache;
|
||||
end;
|
||||
|
||||
constructor TProjectDefineTemplates.Create(OwnerProject: TProject);
|
||||
begin
|
||||
inherited Create;
|
||||
FProject:=OwnerProject;
|
||||
FOwnerProject:=OwnerProject;
|
||||
end;
|
||||
|
||||
destructor TProjectDefineTemplates.Destroy;
|
||||
begin
|
||||
Clear;
|
||||
fLastSourceDirectories.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
@ -3161,27 +3506,12 @@ begin
|
||||
dec(FUpdateLock);
|
||||
if FUpdateLock=0 then begin
|
||||
if ptfFlagsChanged in FFlags then CompilerFlagsChanged;
|
||||
if ptfSourceDirsChanged in FFlags then SourceDirectoriesChanged;
|
||||
if ptfOutputDirChanged in FFlags then OutputDirectoryChanged;
|
||||
if ptfCustomDefinesChanged in FFlags then CustomDefinesChanged;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TProjectDefineTemplates.UpdateMain;
|
||||
begin
|
||||
// update the package block define template (the container for all other
|
||||
// define templates of the package)
|
||||
if (FMain=nil) and (not Owner.Destroying) then begin
|
||||
// create the main project template
|
||||
FMain:=CreateProjectTemplate(FProjectDir);
|
||||
FMain.SetDefineOwner(Owner,false);
|
||||
FMain.SetFlags([dtfAutoGenerated],[],false);
|
||||
end;
|
||||
// ClearCache is here unnessary, because it is only a block
|
||||
end;
|
||||
|
||||
procedure TProjectDefineTemplates.UpdateDefinesForSourceDirectories;
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
procedure TProjectDefineTemplates.CompilerFlagsChanged;
|
||||
begin
|
||||
if FUpdateLock>0 then begin
|
||||
@ -3204,9 +3534,50 @@ begin
|
||||
CodeToolBoss.DefineTree.ClearCache;
|
||||
end;
|
||||
|
||||
procedure TProjectDefineTemplates.ProjectIDChanged;
|
||||
begin
|
||||
if FUpdateLock>0 then begin
|
||||
Include(FFlags,ptfIDChanged);
|
||||
exit;
|
||||
end;
|
||||
Exclude(FFlags,ptfIDChanged);
|
||||
UpdateMain;
|
||||
UpdateDefinesForOutputDirectory;
|
||||
UpdateDefinesForSourceDirectories;
|
||||
UpdateDefinesForCustomDefines;
|
||||
end;
|
||||
|
||||
procedure TProjectDefineTemplates.SourceDirectoriesChanged;
|
||||
begin
|
||||
if FUpdateLock>0 then begin
|
||||
Include(FFlags,ptfSourceDirsChanged);
|
||||
exit;
|
||||
end;
|
||||
Exclude(FFlags,ptfSourceDirsChanged);
|
||||
UpdateDefinesForSourceDirectories;
|
||||
CodeToolBoss.DefineTree.ClearCache;
|
||||
end;
|
||||
|
||||
procedure TProjectDefineTemplates.OutputDirectoryChanged;
|
||||
begin
|
||||
if FUpdateLock>0 then begin
|
||||
Include(FFlags,ptfOutputDirChanged);
|
||||
exit;
|
||||
end;
|
||||
Exclude(FFlags,ptfOutputDirChanged);
|
||||
UpdateDefinesForOutputDirectory;
|
||||
CodeToolBoss.DefineTree.ClearCache;
|
||||
end;
|
||||
|
||||
procedure TProjectDefineTemplates.CustomDefinesChanged;
|
||||
begin
|
||||
if FUpdateLock>0 then begin
|
||||
Include(FFlags,ptfCustomDefinesChanged);
|
||||
exit;
|
||||
end;
|
||||
Exclude(FFlags,ptfCustomDefinesChanged);
|
||||
UpdateDefinesForCustomDefines;
|
||||
CodeToolBoss.DefineTree.ClearCache;
|
||||
end;
|
||||
|
||||
procedure TProjectDefineTemplates.UpdateGlobalValues;
|
||||
|
||||
@ -874,11 +874,11 @@ msgstr "Schreibweise ignorieren"
|
||||
|
||||
#: lazarusidestrconsts:dlgcasesensitive
|
||||
msgid "Case Sensitive"
|
||||
msgstr "Klein/Groß beachten"
|
||||
msgstr "Klein/Gross beachten"
|
||||
|
||||
#: lazarusidestrconsts:lisfindfilecasesensitive
|
||||
msgid "Case sensitive"
|
||||
msgstr "Klein/Groß beachten"
|
||||
msgstr "Klein/Gross beachten"
|
||||
|
||||
#: lazarusidestrconsts:rslanguagecatalan
|
||||
msgid "Catalan"
|
||||
@ -2078,7 +2078,7 @@ msgstr ""
|
||||
|
||||
#: lazarusidestrconsts:lisenclose
|
||||
msgid "Enclose"
|
||||
msgstr "Einschließen"
|
||||
msgstr "Einschliessen"
|
||||
|
||||
#: lazarusidestrconsts:uemencloseselection
|
||||
msgid "Enclose Selection"
|
||||
@ -2238,7 +2238,7 @@ msgstr "Beispiel"
|
||||
|
||||
#: lazarusidestrconsts:lisexcludefilter
|
||||
msgid "Exclude Filter"
|
||||
msgstr "Ausschließender Filter"
|
||||
msgstr "Ausschliessender Filter"
|
||||
|
||||
#: lazarusidestrconsts:srvk_execute
|
||||
msgid "Execute"
|
||||
|
||||
@ -243,6 +243,7 @@ ResourceString
|
||||
ifsVK_NUMPAD = 'Numpad %d';
|
||||
ifsVK_NUMLOCK = 'Numlock';
|
||||
ifsVK_SCROLL = 'Scroll';
|
||||
rsDocking = 'Docking';
|
||||
|
||||
implementation
|
||||
|
||||
|
||||
@ -31,7 +31,8 @@ unit LDockTree;
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, LCLProc, LCLType, Forms, Controls, ExtCtrls;
|
||||
Classes, SysUtils, LCLProc, LCLType, Forms, Controls, ExtCtrls, Menus,
|
||||
LCLStrConsts;
|
||||
|
||||
type
|
||||
TLazDockPages = class;
|
||||
@ -154,7 +155,7 @@ type
|
||||
out AControlBounds: TRect); override;
|
||||
procedure DockControl(Control: TControl; InsertAt: TAlign;
|
||||
DropCtl: TControl);
|
||||
procedure UndockControl(Control: TControl);
|
||||
procedure UndockControl(Control: TControl; Float: boolean);
|
||||
procedure InsertControl(Control: TControl; InsertAt: TAlign;
|
||||
DropCtl: TControl); override;
|
||||
procedure LoadFromStream(Stream: TStream); override;
|
||||
@ -168,6 +169,66 @@ type
|
||||
procedure ReplaceAnchoredControl(OldControl, NewControl: TControl);
|
||||
property SplitterSize: integer read FSplitterSize write FSplitterSize default 5;
|
||||
end;
|
||||
|
||||
|
||||
TCustomLazControlDocker = class;
|
||||
|
||||
{ TCustomLazDockingManager }
|
||||
|
||||
TCustomLazDockingManager = class(TComponent)
|
||||
private
|
||||
FDockerCount: Integer;
|
||||
FDockers: TFPList;
|
||||
FManager: TAnchoredDockManager;
|
||||
function GetDockers(Index: Integer): TCustomLazControlDocker;
|
||||
protected
|
||||
procedure Remove(Docker: TCustomLazControlDocker);
|
||||
function Add(Docker: TCustomLazControlDocker): Integer;
|
||||
public
|
||||
constructor Create(TheOwner: TComponent); override;
|
||||
destructor Destroy; override;
|
||||
property Manager: TAnchoredDockManager read FManager;
|
||||
property DockerCount: Integer read FDockerCount;
|
||||
property Dockers[Index: Integer]: TCustomLazControlDocker read GetDockers;
|
||||
end;
|
||||
|
||||
{ TLazDockingManager }
|
||||
|
||||
TLazDockingManager = class(TCustomLazDockingManager)
|
||||
published
|
||||
end;
|
||||
|
||||
{ TCustomLazControlDocker - a component to mark a form for the TLazDockingManager }
|
||||
|
||||
TCustomLazControlDocker = class(TComponent)
|
||||
procedure PopupMenuItemClick(Sender: TObject);
|
||||
private
|
||||
FControl: TControl;
|
||||
FExtendPopupMenu: boolean;
|
||||
FManager: TCustomLazDockingManager;
|
||||
FPopupMenuItem: TMenuItem;
|
||||
procedure SetControl(const AValue: TControl);
|
||||
procedure SetExtendPopupMenu(const AValue: boolean);
|
||||
procedure SetManager(const AValue: TCustomLazDockingManager);
|
||||
protected
|
||||
procedure UpdatePopupMenu;
|
||||
procedure Loaded; override;
|
||||
public
|
||||
constructor Create(TheOwner: TComponent); override;
|
||||
property Control: TControl read FControl write SetControl;
|
||||
property Manager: TCustomLazDockingManager read FManager write SetManager;
|
||||
property ExtendPopupMenu: boolean read FExtendPopupMenu write SetExtendPopupMenu;
|
||||
property PopupMenuItem: TMenuItem read FPopupMenuItem;
|
||||
end;
|
||||
|
||||
{ TLazControlDocker }
|
||||
|
||||
TLazControlDocker = class(TCustomLazControlDocker)
|
||||
published
|
||||
property Control;
|
||||
property Manager;
|
||||
property ExtendPopupMenu;
|
||||
end;
|
||||
|
||||
const
|
||||
DockAlignOrientations: array[TAlign] of TDockOrientation = (
|
||||
@ -827,14 +888,14 @@ end;
|
||||
procedure TAnchoredDockManager.DeletePages(Pages: TLazDockPages);
|
||||
begin
|
||||
if Pages.Parent<>nil then
|
||||
UndockControl(Pages);
|
||||
UndockControl(Pages,false);
|
||||
Pages.Free;
|
||||
end;
|
||||
|
||||
procedure TAnchoredDockManager.DeleteDockForm(ADockForm: TLazDockForm);
|
||||
begin
|
||||
if ADockForm.Parent<>nil then
|
||||
UndockControl(ADockForm);
|
||||
UndockControl(ADockForm,false);
|
||||
ADockForm.Free;
|
||||
end;
|
||||
|
||||
@ -1088,7 +1149,7 @@ end;
|
||||
It removes TLazDockSplitter, TLazDockPage and TLazDockPages if they are no
|
||||
longer needed.
|
||||
-------------------------------------------------------------------------------}
|
||||
procedure TAnchoredDockManager.UndockControl(Control: TControl);
|
||||
procedure TAnchoredDockManager.UndockControl(Control: TControl; Float: boolean);
|
||||
{
|
||||
|
||||
Examples:
|
||||
@ -1166,6 +1227,11 @@ var
|
||||
var
|
||||
OldParentControl: TWinControl;
|
||||
begin
|
||||
if Float then begin
|
||||
Control.ManualFloat(Control.BoundsRect);
|
||||
end else begin
|
||||
Control.Parent:=nil;
|
||||
end;
|
||||
if ParentControl<>nil then begin
|
||||
OldParentControl:=ParentControl;
|
||||
ParentControl:=nil;
|
||||
@ -1286,7 +1352,7 @@ end;
|
||||
|
||||
procedure TAnchoredDockManager.RemoveControl(Control: TControl);
|
||||
begin
|
||||
UndockControl(Control);
|
||||
UndockControl(Control,false);
|
||||
end;
|
||||
|
||||
procedure TAnchoredDockManager.ResetBounds(Force: Boolean);
|
||||
@ -1353,5 +1419,114 @@ begin
|
||||
Result:=Parent as TLazDockPages;
|
||||
end;
|
||||
|
||||
{ TCustomLazControlDocker }
|
||||
|
||||
procedure TCustomLazControlDocker.SetManager(
|
||||
const AValue: TCustomLazDockingManager);
|
||||
begin
|
||||
if FManager=AValue then exit;
|
||||
if FManager<>nil then FManager.Remove(Self);
|
||||
FManager:=AValue;
|
||||
if FManager<>nil then FManager.Add(Self);
|
||||
end;
|
||||
|
||||
procedure TCustomLazControlDocker.UpdatePopupMenu;
|
||||
// creates or deletes the PopupMenuItem to the PopupMenu of Control
|
||||
begin
|
||||
if [csDestroying,csDesigning]*ComponentState<>[] then exit;
|
||||
if csLoading in ComponentState then exit;
|
||||
|
||||
if ExtendPopupMenu and (Control.PopupMenu<>nil) then begin
|
||||
if (PopupMenuItem<>nil) and (PopupMenuItem.Parent<>Control.PopupMenu.Items)
|
||||
then begin
|
||||
// PopupMenuItem is in the old PopupMenu -> delete it
|
||||
FreeAndNil(FPopupMenuItem);
|
||||
end;
|
||||
if (PopupMenuItem=nil) then begin
|
||||
// create a new PopupMenuItem
|
||||
FPopupMenuItem:=TMenuItem.Create(Self);
|
||||
PopupMenuItem.Caption:=rsDocking;
|
||||
PopupMenuItem.OnClick:=@PopupMenuItemClick;
|
||||
end;
|
||||
if PopupMenuItem.Parent=nil then begin
|
||||
// add PopupMenuItem to Control.PopupMenu
|
||||
Control.PopupMenu.Items.Add(PopupMenuItem);
|
||||
end;
|
||||
end else begin
|
||||
// delete PopupMenuItem
|
||||
FreeAndNil(FPopupMenuItem);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCustomLazControlDocker.Loaded;
|
||||
begin
|
||||
inherited Loaded;
|
||||
UpdatePopupMenu;
|
||||
end;
|
||||
|
||||
constructor TCustomLazControlDocker.Create(TheOwner: TComponent);
|
||||
begin
|
||||
inherited Create(TheOwner);
|
||||
if (not (csLoading in ComponentState))
|
||||
and (TheOwner is TControl) then
|
||||
// use as default
|
||||
Control:=TControl(TheOwner);
|
||||
ExtendPopupMenu:=true;
|
||||
end;
|
||||
|
||||
procedure TCustomLazControlDocker.PopupMenuItemClick(Sender: TObject);
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
procedure TCustomLazControlDocker.SetControl(const AValue: TControl);
|
||||
begin
|
||||
if FControl=AValue then exit;
|
||||
FControl:=AValue;
|
||||
end;
|
||||
|
||||
procedure TCustomLazControlDocker.SetExtendPopupMenu(const AValue: boolean);
|
||||
begin
|
||||
if FExtendPopupMenu=AValue then exit;
|
||||
FExtendPopupMenu:=AValue;
|
||||
UpdatePopupMenu;
|
||||
end;
|
||||
|
||||
{ TCustomLazDockingManager }
|
||||
|
||||
procedure TCustomLazDockingManager.Remove(Docker: TCustomLazControlDocker);
|
||||
begin
|
||||
FDockers.Remove(Docker);
|
||||
end;
|
||||
|
||||
function TCustomLazDockingManager.Add(Docker: TCustomLazControlDocker): Integer;
|
||||
begin
|
||||
Result:=FDockers.Add(Docker);
|
||||
end;
|
||||
|
||||
function TCustomLazDockingManager.GetDockers(Index: Integer
|
||||
): TCustomLazControlDocker;
|
||||
begin
|
||||
Result:=TCustomLazControlDocker(FDockers[Index]);
|
||||
end;
|
||||
|
||||
constructor TCustomLazDockingManager.Create(TheOwner: TComponent);
|
||||
begin
|
||||
inherited Create(TheOwner);
|
||||
FDockers:=TFPList.Create;
|
||||
FManager:=TAnchoredDockManager.Create;
|
||||
end;
|
||||
|
||||
destructor TCustomLazDockingManager.Destroy;
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
for i:=FDockers.Count-1 downto 0 do
|
||||
Dockers[i].Manager:=nil;
|
||||
FreeAndNil(FDockers);
|
||||
FreeAndNil(FManager);
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
|
||||
@ -3531,11 +3531,11 @@ begin
|
||||
// update the package block define template (the container for all other
|
||||
// define templates of the package)
|
||||
if FMain=nil then begin
|
||||
FMain:=CreatePackageTemplateWithID(LazPackage.IDAsString);
|
||||
FMain:=CreatePackageTemplateWithID(LazPackage.IDAsWord);
|
||||
FMain.SetDefineOwner(LazPackage,false);
|
||||
FMain.SetFlags([dtfAutoGenerated],[],false);
|
||||
end else
|
||||
FMain.Name:=LazPackage.IDAsString;
|
||||
FMain.Name:=LazPackage.IDAsWord;
|
||||
// ClearCache is here unnessary, because it is only a block
|
||||
end;
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user