mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-18 05:19:14 +02:00
improved delphi conversion, include paths and error handling
git-svn-id: trunk@8969 -
This commit is contained in:
mattias
parent
380fa81917
commit
ae450142cf
@ -291,7 +291,7 @@ type
|
||||
function AddResourceDirective(Code: TCodeBuffer; const Filename: string
|
||||
): boolean;
|
||||
function FixIncludeFilenames(Code: TCodeBuffer;
|
||||
Recursive: boolean): boolean;
|
||||
Recursive: boolean; out MissingIncludeFilesCodeXYPos: TFPList): boolean;
|
||||
|
||||
// keywords and comments
|
||||
function IsKeyword(Code: TCodeBuffer; const KeyWord: string): boolean;
|
||||
@ -565,6 +565,10 @@ type
|
||||
var CodeToolBoss: TCodeToolManager;
|
||||
|
||||
|
||||
function CreateDefinesForFPCMode(const Name: string;
|
||||
CompilerMode: TCompilerMode): TDefineTemplate;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
|
||||
@ -601,6 +605,23 @@ begin
|
||||
DebugLn(BackTraceStrFunc(Frames[FrameNumber]));
|
||||
end;
|
||||
|
||||
function CreateDefinesForFPCMode(const Name: string; CompilerMode: TCompilerMode
|
||||
): TDefineTemplate;
|
||||
var
|
||||
cm: TCompilerMode;
|
||||
NewMode: String;
|
||||
begin
|
||||
Result:=TDefineTemplate.Create(Name,'set FPC compiler mode',
|
||||
'','',da_Block);
|
||||
for cm:=Low(TCompilerMode) to High(TCompilerMode) do begin
|
||||
Result.AddChild(TDefineTemplate.Create(CompilerModeVars[cm],
|
||||
CompilerModeVars[cm],CompilerModeVars[cm],'',da_Undefine));
|
||||
end;
|
||||
NewMode:=CompilerModeVars[CompilerMode];
|
||||
Result.AddChild(TDefineTemplate.Create(NewMode,
|
||||
NewMode,NewMode,'1',da_Define));
|
||||
end;
|
||||
|
||||
|
||||
{ TCodeToolManager }
|
||||
|
||||
@ -2182,9 +2203,22 @@ begin
|
||||
end;
|
||||
|
||||
function TCodeToolManager.FixIncludeFilenames(Code: TCodeBuffer;
|
||||
Recursive: boolean): boolean;
|
||||
Recursive: boolean; out MissingIncludeFilesCodeXYPos: TFPList): boolean;
|
||||
|
||||
procedure CreateErrorForMissingIncludeFile;
|
||||
var
|
||||
CodePos: PCodeXYPosition;
|
||||
begin
|
||||
ClearError;
|
||||
CodePos:=PCodeXYPosition(MissingIncludeFilesCodeXYPos[0]);
|
||||
fErrorCode:=CodePos^.Code;
|
||||
fErrorLine:=CodePos^.Y;
|
||||
fErrorColumn:=CodePos^.X;
|
||||
FErrorMsg:='missing include file';
|
||||
end;
|
||||
|
||||
var
|
||||
FoundIncludeFiles, MissingIncludeFiles: TStrings;
|
||||
FoundIncludeFiles: TStrings;
|
||||
i: Integer;
|
||||
AFilename: string;
|
||||
ToFixIncludeFiles: TStringList;
|
||||
@ -2194,6 +2228,7 @@ begin
|
||||
{$IFDEF CTDEBUG}
|
||||
DebugLn('TCodeToolManager.FixIncludeFilenames A ',Code.Filename,' Recursive=',Recursive);
|
||||
{$ENDIF}
|
||||
MissingIncludeFilesCodeXYPos:=nil;
|
||||
if not InitCurCodeTool(Code) then exit;
|
||||
try
|
||||
FixedIncludeFiles:=nil;
|
||||
@ -2211,14 +2246,14 @@ begin
|
||||
end;
|
||||
// fix file
|
||||
FoundIncludeFiles:=nil;
|
||||
MissingIncludeFiles:=nil;
|
||||
try
|
||||
Result:=FCurCodeTool.FixIncludeFilenames(Code,SourceChangeCache,
|
||||
FoundIncludeFiles,MissingIncludeFiles);
|
||||
if (MissingIncludeFiles<>nil)
|
||||
and (MissingIncludeFiles.Count>0) then begin
|
||||
DebugLn('TCodeToolManager.FixIncludeFilenames Missing: ',MissingIncludeFiles.Text);
|
||||
FoundIncludeFiles,MissingIncludeFilesCodeXYPos);
|
||||
if (MissingIncludeFilesCodeXYPos<>nil)
|
||||
and (MissingIncludeFilesCodeXYPos.Count>0) then begin
|
||||
DebugLn('TCodeToolManager.FixIncludeFilenames Missing: ',dbgs(MissingIncludeFilesCodeXYPos.Count));
|
||||
Result:=false;
|
||||
CreateErrorForMissingIncludeFile;
|
||||
exit;
|
||||
end;
|
||||
if not Recursive then begin
|
||||
@ -2243,7 +2278,6 @@ begin
|
||||
//DebugLn('TCodeToolManager.FixIncludeFilenames FixedIncludeFiles=',FixedIncludeFiles.Text,' ToFixIncludeFiles=',ToFixIncludeFiles.Text);
|
||||
finally
|
||||
FoundIncludeFiles.Free;
|
||||
MissingIncludeFiles.Free;
|
||||
end;
|
||||
end;
|
||||
finally
|
||||
|
||||
@ -462,7 +462,7 @@ procedure SplitLazarusCPUOSWidgetCombo(const Combination: string;
|
||||
|
||||
// functions to quickly setup some defines
|
||||
function CreateDefinesInDirectories(const SourcePaths, FlagName: string
|
||||
): TDefineTemplate;
|
||||
): TDefineTemplate;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
@ -1265,6 +1265,10 @@ function TPascalParserTool.ReadTilProcedureHeadEnd(
|
||||
procedure Intf.Method = ImplementingMethodName;
|
||||
function CommitUrlCacheEntry; // only Delphi
|
||||
procedure MacProcName(c: char; ...); external;
|
||||
|
||||
Delphi mode:
|
||||
Function TPOSControler.Logout; // missing function type
|
||||
|
||||
|
||||
proc specifiers without parameters:
|
||||
stdcall, virtual, abstract, dynamic, overload, override, cdecl, inline
|
||||
|
||||
@ -213,7 +213,8 @@ type
|
||||
SourceChangeCache: TSourceChangeCache): boolean;
|
||||
function FixIncludeFilenames(Code: TCodeBuffer;
|
||||
SourceChangeCache: TSourceChangeCache;
|
||||
out FoundIncludeFiles, MissingIncludeFiles: TStrings): boolean;
|
||||
out FoundIncludeFiles: TStrings;
|
||||
var MissingIncludeFilesCodeXYPos: TFPList): boolean;
|
||||
|
||||
// search & replace
|
||||
function ReplaceIdentifiers(IdentList: TStrings;
|
||||
@ -4324,13 +4325,33 @@ end;
|
||||
|
||||
function TStandardCodeTool.FixIncludeFilenames(Code: TCodeBuffer;
|
||||
SourceChangeCache: TSourceChangeCache;
|
||||
out FoundIncludeFiles, MissingIncludeFiles: TStrings): boolean;
|
||||
out FoundIncludeFiles: TStrings;
|
||||
var MissingIncludeFilesCodeXYPos: TFPList): boolean;
|
||||
var
|
||||
ASource: String;
|
||||
|
||||
procedure Add(const AFilename: string; Found: boolean);
|
||||
{procedure WriteMissingIncludeFilesCodeXYPos;
|
||||
var
|
||||
CodePos: PCodeXYPosition;
|
||||
i: Integer;
|
||||
begin
|
||||
if MissingIncludeFilesCodeXYPos<>nil then begin
|
||||
for i:=0 to MissingIncludeFilesCodeXYPos.Count-1 do begin
|
||||
CodePos:=PCodeXYPosition(MissingIncludeFilesCodeXYPos[i]);
|
||||
DebugLn('TStandardCodeTool.FixMissingUnits ',dbgs(CodePos));
|
||||
DebugLn('TStandardCodeTool.FixMissingUnits ',CodePos^.Code.Filename);
|
||||
debugln(CodePos^.Code.Filename
|
||||
+'('+IntToStr(CodePos^.y)+','+IntToStr(CodePos^.x)+')'
|
||||
+' missing include file');
|
||||
end;
|
||||
end;
|
||||
end;}
|
||||
|
||||
procedure Add(FilenameSrcPos: integer; const AFilename: string;
|
||||
Found: boolean);
|
||||
var
|
||||
NewFilename: String;
|
||||
p: PCodeXYPosition;
|
||||
begin
|
||||
if Found then begin
|
||||
if FoundIncludeFiles=nil then
|
||||
@ -4339,13 +4360,19 @@ var
|
||||
if FoundIncludeFiles.IndexOf(NewFilename)<0 then
|
||||
FoundIncludeFiles.Add(NewFilename);
|
||||
end else begin
|
||||
if MissingIncludeFiles=nil then
|
||||
MissingIncludeFiles:=TStringList.Create;
|
||||
MissingIncludeFiles.Add(AFilename);
|
||||
if MissingIncludeFilesCodeXYPos=nil then
|
||||
MissingIncludeFilesCodeXYPos:=TFPList.Create;
|
||||
New(p);
|
||||
p^.Code:=Code;
|
||||
Code.AbsoluteToLineCol(FilenameSrcPos,p^.y,p^.x);
|
||||
MissingIncludeFilesCodeXYPos.Add(p);
|
||||
///DebugLn('TStandardCodeTool.FixIncludeFilenames.Add "',p^.Code.Filename,'" ',dbgs(p),' X=',dbgs(p^.X),' Y=',dbgs(p^.Y));
|
||||
//WriteMissingIncludeFilesCodeXYPos;
|
||||
end;
|
||||
end;
|
||||
|
||||
function SearchIncludeFilename(const AFilename: string): string;
|
||||
function SearchIncludeFilename(FilenameSrcPos: integer;
|
||||
const AFilename: string): string;
|
||||
var
|
||||
AFilePath: String;
|
||||
BaseDir: String;
|
||||
@ -4357,7 +4384,7 @@ var
|
||||
Result:=TrimFilename(AFilename);
|
||||
if FilenameIsAbsolute(Result) then begin
|
||||
Result:=FindDiskFilename(Result);
|
||||
Add(Result,FileExistsCached(Result));
|
||||
Add(FilenameSrcPos,Result,FileExistsCached(Result));
|
||||
//DebugLn('SearchIncludeFilename AbsoluteFilename="',Result,'"');
|
||||
end else begin
|
||||
BaseDir:=ExtractFilePath(MainFilename);
|
||||
@ -4370,9 +4397,9 @@ var
|
||||
CurFilename:=FindDiskFilename(BaseDir+Result);
|
||||
Result:=copy(CurFilename,length(BaseDir)+1,length(CurFilename));
|
||||
if FileExistsCached(CurFilename) then
|
||||
Add(CurFilename,true)
|
||||
Add(FilenameSrcPos,CurFilename,true)
|
||||
else
|
||||
Add(Result,false);
|
||||
Add(FilenameSrcPos,Result,false);
|
||||
//DebugLn('SearchIncludeFilename relative filename="',CurFilename,'"');
|
||||
end else begin
|
||||
// search in path
|
||||
@ -4388,10 +4415,10 @@ var
|
||||
if CurFilename<>'' then begin
|
||||
// found
|
||||
Result:=CreateRelativePath(CurFilename,BaseDir);
|
||||
Add(CurFilename,true);
|
||||
Add(FilenameSrcPos,CurFilename,true);
|
||||
end else begin
|
||||
// not found
|
||||
Add(Result,false);
|
||||
Add(FilenameSrcPos,Result,false);
|
||||
end;
|
||||
//DebugLn('SearchIncludeFilename search in include path="',IncludePath,'" Result="',Result,'"');
|
||||
end;
|
||||
@ -4400,9 +4427,9 @@ var
|
||||
ACodeBuf:=TCodeBuffer(Scanner.LoadSourceCaseLoUp(Result));
|
||||
if ACodeBuf<>nil then begin
|
||||
Result:=ACodeBuf.Filename;
|
||||
Add(Result,true);
|
||||
Add(FilenameSrcPos,Result,true);
|
||||
end else begin
|
||||
Add(Result,false);
|
||||
Add(FilenameSrcPos,Result,false);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
@ -4423,7 +4450,7 @@ var
|
||||
else
|
||||
AFilename:=AFilename+'.pp';
|
||||
end;
|
||||
AFilename:=SearchIncludeFilename(AFilename);
|
||||
AFilename:=SearchIncludeFilename(StartPos,AFilename);
|
||||
if OldFilename<>AFilename then begin
|
||||
DebugLn('FixFilename replacing in '+Code.Filename+' include directive "',OldFilename,'" with "',AFilename,'"');
|
||||
SourceChangeCache.ReplaceEx(gtNone,gtNone,0,0,Code,StartPos,EndPos,AFilename);
|
||||
@ -4437,7 +4464,6 @@ var
|
||||
begin
|
||||
Result:=false;
|
||||
FoundIncludeFiles:=nil;
|
||||
MissingIncludeFiles:=nil;
|
||||
if (Scanner=nil) or (Scanner.MainCode=nil) then exit;
|
||||
ASource:=Code.Source;
|
||||
Scanner.Scan(lsrInit,false);
|
||||
@ -4455,6 +4481,8 @@ begin
|
||||
p:=FindCommentEnd(ASource,p,NestedComments);
|
||||
//DebugLn('TStandardCodeTool.FixIncludeFilenames ',dbgs(p));
|
||||
until false;
|
||||
//WriteMissingIncludeFilesCodeXYPos;
|
||||
|
||||
Result:=SourceChangeCache.Apply;
|
||||
end;
|
||||
|
||||
|
||||
@ -46,12 +46,16 @@ interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, LCLProc, Forms, Controls, Dialogs, FileProcs, FileUtil,
|
||||
ExprEval, DefineTemplates, CodeCache, CodeToolManager,
|
||||
ExprEval, DefineTemplates, CodeCache, CodeToolManager, CodeToolsStructs,
|
||||
LinkScanner,
|
||||
SrcEditorIntf, MsgIntf, MainIntf, LazIDEIntf, ProjectIntf,
|
||||
IDEProcs, DelphiUnit2Laz, Project, DialogProcs, CheckLFMDlg,
|
||||
EditorOptions, ProjectInspector, CompilerOptions,
|
||||
BasePkgManager, PkgManager;
|
||||
|
||||
|
||||
const
|
||||
SettingDelphiModeTemplName = 'Setting Delphi Mode';
|
||||
|
||||
function ConvertDelphiToLazarusProject(const ProjectFilename: string
|
||||
): TModalResult;
|
||||
function FindAllDelphiProjectUnits(AProject: TProject): TModalResult;
|
||||
@ -60,7 +64,8 @@ type
|
||||
TConvertDelphiToLazarusUnitFlag = (
|
||||
cdtlufRenameLowercase, // rename the unit lowercase
|
||||
cdtlufIsSubProc, // this is part of a big conversion -> add Abort button to all questions
|
||||
cdtlufCheckLFM // check and fix LFM
|
||||
cdtlufCheckLFM, // check and fix LFM
|
||||
cdtlufDoNotSetDelphiMode // do not set delphi mode for project directories
|
||||
);
|
||||
TConvertDelphiToLazarusUnitFlags = set of TConvertDelphiToLazarusUnitFlag;
|
||||
|
||||
@ -76,6 +81,8 @@ function CreateDelphiToLazarusMainSourceFile(AProject: TProject;
|
||||
function FindDPRFilename(const StartFilename: string): string;
|
||||
function ReadDelphiProjectConfigFiles(AProject: TProject): TModalResult;
|
||||
procedure CleanUpProjectSearchPaths(AProject: TProject);
|
||||
procedure SetCompilerModeForProjectSrcDirs(AProject: TProject);
|
||||
procedure UnsetCompilerModeForProjectSrcDirs(AProject: TProject);
|
||||
|
||||
|
||||
implementation
|
||||
@ -131,34 +138,41 @@ begin
|
||||
|
||||
// we have now enough information to parse the .dpr file,
|
||||
// but not enough to parse the units
|
||||
|
||||
// set Delphi mode for all project source directories
|
||||
SetCompilerModeForProjectSrcDirs(Project1);
|
||||
try
|
||||
|
||||
// init codetools
|
||||
if not LazarusIDE.BeginCodeTools then begin
|
||||
DebugLn('ConvertDelphiToLazarusProject failed BeginCodeTools');
|
||||
Result:=mrCancel;
|
||||
exit;
|
||||
// init codetools
|
||||
if not LazarusIDE.BeginCodeTools then begin
|
||||
DebugLn('ConvertDelphiToLazarusProject failed BeginCodeTools');
|
||||
Result:=mrCancel;
|
||||
exit;
|
||||
end;
|
||||
|
||||
// fix .lpr
|
||||
ConvertUnitFlags:=[cdtlufIsSubProc,cdtlufDoNotSetDelphiMode];
|
||||
Result:=ConvertDelphiToLazarusUnit(LPRCode.Filename,ConvertUnitFlags);
|
||||
if Result=mrAbort then begin
|
||||
DebugLn('ConvertDelphiToLazarusProject failed converting unit ',LPRCode.Filename);
|
||||
exit;
|
||||
end;
|
||||
|
||||
// get all options from .lpr (the former .dpr)
|
||||
Result:=ExtractOptionsFromDPR(LPRCode,Project1);
|
||||
if Result<>mrOk then exit;
|
||||
|
||||
// find and convert all project files
|
||||
Result:=FindAllDelphiProjectUnits(Project1);
|
||||
if Result<>mrOk then exit;
|
||||
|
||||
// convert all project files
|
||||
Result:=ConvertAllDelphiProjectUnits(Project1,[cdtlufIsSubProc,cdtlufCheckLFM]);
|
||||
if Result<>mrOk then exit;
|
||||
finally
|
||||
UnsetCompilerModeForProjectSrcDirs(Project1);
|
||||
end;
|
||||
|
||||
// fix .lpr
|
||||
ConvertUnitFlags:=[cdtlufIsSubProc];
|
||||
Result:=ConvertDelphiToLazarusUnit(LPRCode.Filename,ConvertUnitFlags);
|
||||
if Result=mrAbort then begin
|
||||
DebugLn('ConvertDelphiToLazarusProject failed converting unit ',LPRCode.Filename);
|
||||
exit;
|
||||
end;
|
||||
|
||||
// get all options from .lpr (the former .dpr)
|
||||
Result:=ExtractOptionsFromDPR(LPRCode,Project1);
|
||||
if Result<>mrOk then exit;
|
||||
|
||||
// find and convert all project files
|
||||
Result:=FindAllDelphiProjectUnits(Project1);
|
||||
if Result<>mrOk then exit;
|
||||
|
||||
// convert all project files
|
||||
Result:=ConvertAllDelphiProjectUnits(Project1,[cdtlufIsSubProc]);
|
||||
if Result<>mrOk then exit;
|
||||
|
||||
debugln('ConvertDelphiToLazarusProject Done');
|
||||
Result:=mrOk;
|
||||
end;
|
||||
@ -170,7 +184,7 @@ var
|
||||
NotFoundUnits: String;
|
||||
i: Integer;
|
||||
CurUnitInfo: TUnitInfo;
|
||||
NewUnitPath: String;
|
||||
NewSearchPath: String;
|
||||
CurFilename: string;
|
||||
p: LongInt;
|
||||
OffendingUnit: TUnitInfo;
|
||||
@ -201,64 +215,79 @@ begin
|
||||
if Result<>mrIgnore then exit;
|
||||
end;
|
||||
|
||||
// add all units to the project
|
||||
debugln('ConvertDelphiToLazarusProject adding all project units to project ...');
|
||||
|
||||
for i:=0 to FoundInUnits.Count-1 do begin
|
||||
CurFilename:=FoundInUnits[i];
|
||||
p:=System.Pos(' in ',CurFilename);
|
||||
if p>0 then
|
||||
CurFilename:=copy(CurFilename,p+4,length(CurFilename));
|
||||
if CurFilename='' then continue;
|
||||
if not FilenameIsAbsolute(CurFilename) then
|
||||
CurFilename:=AppendPathDelim(Project1.ProjectDirectory)+CurFilename;
|
||||
CurFilename:=TrimFilename(CurFilename);
|
||||
if not FileExists(CurFilename) then begin
|
||||
DebugLn('ConvertDelphiToLazarusProject file not found: "',CurFilename,'"');
|
||||
continue;
|
||||
end;
|
||||
CurUnitInfo:=Project1.UnitInfoWithFilename(CurFilename);
|
||||
if CurUnitInfo<>nil then begin
|
||||
CurUnitInfo.IsPartOfProject:=true;
|
||||
end else begin
|
||||
if FilenameIsPascalUnit(CurFilename) then begin
|
||||
// check unitname
|
||||
OffendingUnit:=Project1.UnitWithUnitname(
|
||||
ExtractFileNameOnly(CurFilename));
|
||||
if OffendingUnit<>nil then begin
|
||||
Result:=QuestionDlg('Unitname exists twice',
|
||||
'There are two units with the same unitname:'#13
|
||||
+OffendingUnit.Filename+#13
|
||||
+CurFilename+#13,
|
||||
mtWarning,[mrYes,'Remove first',mrNo,'Remove second',
|
||||
mrIgnore,'Keep both',mrAbort],0);
|
||||
case Result of
|
||||
mrYes: OffendingUnit.IsPartOfProject:=false;
|
||||
mrNo: continue;
|
||||
mrIgnore: ;
|
||||
else
|
||||
Result:=mrAbort;
|
||||
exit;
|
||||
try
|
||||
// add all units to the project
|
||||
debugln('ConvertDelphiToLazarusProject adding all project units to project ...');
|
||||
|
||||
for i:=0 to FoundInUnits.Count-1 do begin
|
||||
CurFilename:=FoundInUnits[i];
|
||||
p:=System.Pos(' in ',CurFilename);
|
||||
if p>0 then
|
||||
CurFilename:=copy(CurFilename,p+4,length(CurFilename));
|
||||
if CurFilename='' then continue;
|
||||
if not FilenameIsAbsolute(CurFilename) then
|
||||
CurFilename:=AppendPathDelim(Project1.ProjectDirectory)+CurFilename;
|
||||
CurFilename:=TrimFilename(CurFilename);
|
||||
if not FileExists(CurFilename) then begin
|
||||
DebugLn('ConvertDelphiToLazarusProject file not found: "',CurFilename,'"');
|
||||
continue;
|
||||
end;
|
||||
CurUnitInfo:=Project1.UnitInfoWithFilename(CurFilename);
|
||||
if CurUnitInfo<>nil then begin
|
||||
CurUnitInfo.IsPartOfProject:=true;
|
||||
end else begin
|
||||
if FilenameIsPascalUnit(CurFilename) then begin
|
||||
// check unitname
|
||||
OffendingUnit:=Project1.UnitWithUnitname(
|
||||
ExtractFileNameOnly(CurFilename));
|
||||
if OffendingUnit<>nil then begin
|
||||
Result:=QuestionDlg('Unitname exists twice',
|
||||
'There are two units with the same unitname:'#13
|
||||
+OffendingUnit.Filename+#13
|
||||
+CurFilename+#13,
|
||||
mtWarning,[mrYes,'Remove first',mrNo,'Remove second',
|
||||
mrIgnore,'Keep both',mrAbort],0);
|
||||
case Result of
|
||||
mrYes: OffendingUnit.IsPartOfProject:=false;
|
||||
mrNo: continue;
|
||||
mrIgnore: ;
|
||||
else
|
||||
Result:=mrAbort;
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
// add new unit to project
|
||||
CurUnitInfo:=TUnitInfo.Create(nil);
|
||||
CurUnitInfo.Filename:=CurFilename;
|
||||
CurUnitInfo.IsPartOfProject:=true;
|
||||
Project1.AddFile(CurUnitInfo,false);
|
||||
end;
|
||||
|
||||
// add new unit to project
|
||||
CurUnitInfo:=TUnitInfo.Create(nil);
|
||||
CurUnitInfo.Filename:=CurFilename;
|
||||
CurUnitInfo.IsPartOfProject:=true;
|
||||
Project1.AddFile(CurUnitInfo,false);
|
||||
end;
|
||||
end;
|
||||
// set search paths to find all project units
|
||||
NewUnitPath:=MergeSearchPaths(Project1.CompilerOptions.OtherUnitFiles,
|
||||
|
||||
finally
|
||||
// set unit paths to find all project units
|
||||
NewSearchPath:=MergeSearchPaths(Project1.CompilerOptions.OtherUnitFiles,
|
||||
Project1.SourceDirectories.CreateSearchPathFromAllFiles);
|
||||
NewUnitPath:=RemoveSearchPaths(NewUnitPath,
|
||||
'.;'+VirtualDirectory+';'+VirtualTempDir
|
||||
+';'+Project1.ProjectDirectory);
|
||||
Project1.CompilerOptions.OtherUnitFiles:=MinimizeSearchPath(
|
||||
RemoveNonExistingPaths(NewUnitPath,Project1.ProjectDirectory));
|
||||
DebugLn('ConvertDelphiToLazarusProject UnitPath="',Project1.CompilerOptions.OtherUnitFiles,'"');
|
||||
NewSearchPath:=RemoveSearchPaths(NewSearchPath,
|
||||
'.;'+VirtualDirectory+';'+VirtualTempDir
|
||||
+';'+Project1.ProjectDirectory);
|
||||
Project1.CompilerOptions.OtherUnitFiles:=MinimizeSearchPath(
|
||||
RemoveNonExistingPaths(NewSearchPath,Project1.ProjectDirectory));
|
||||
// set include path
|
||||
NewSearchPath:=MergeSearchPaths(Project1.CompilerOptions.IncludeFiles,
|
||||
Project1.SourceDirectories.CreateSearchPathFromAllFiles);
|
||||
NewSearchPath:=RemoveSearchPaths(NewSearchPath,
|
||||
'.;'+VirtualDirectory+';'+VirtualTempDir
|
||||
+';'+Project1.ProjectDirectory);
|
||||
Project1.CompilerOptions.IncludeFiles:=MinimizeSearchPath(
|
||||
RemoveNonExistingPaths(NewSearchPath,Project1.ProjectDirectory));
|
||||
// clear caches
|
||||
Project1.DefineTemplates.SourceDirectoriesChanged;
|
||||
CodeToolBoss.DefineTree.ClearCache;
|
||||
DebugLn('ConvertDelphiToLazarusProject UnitPath="',Project1.CompilerOptions.OtherUnitFiles,'"');
|
||||
end;
|
||||
|
||||
// save project
|
||||
debugln('ConvertDelphiToLazarusProject Saving project ...');
|
||||
@ -279,34 +308,47 @@ end;
|
||||
|
||||
function ConvertAllDelphiProjectUnits(AProject: TProject;
|
||||
Flags: TConvertDelphiToLazarusUnitFlags): TModalResult;
|
||||
var
|
||||
i: Integer;
|
||||
CurUnitInfo: TUnitInfo;
|
||||
begin
|
||||
// convert all units
|
||||
i:=0;
|
||||
while i<Project1.UnitCount do begin
|
||||
CurUnitInfo:=Project1.Units[i];
|
||||
if CurUnitInfo.IsPartOfProject and not (CurUnitInfo.IsMainUnit) then begin
|
||||
Result:=ConvertDelphiToLazarusUnit(CurUnitInfo.Filename,
|
||||
Flags+[cdtlufIsSubProc]);
|
||||
if Result=mrAbort then exit;
|
||||
if Result=mrCancel then begin
|
||||
Result:=QuestionDlg('Failed converting unit',
|
||||
'Failed to convert unit'+#13
|
||||
+CurUnitInfo.Filename+#13,
|
||||
mtWarning,[mrIgnore,'Ignore and continue',mrAbort],0);
|
||||
|
||||
function Convert(CurFlags: TConvertDelphiToLazarusUnitFlags): TModalResult;
|
||||
var
|
||||
i: Integer;
|
||||
CurUnitInfo: TUnitInfo;
|
||||
begin
|
||||
// convert all units
|
||||
i:=0;
|
||||
while i<Project1.UnitCount do begin
|
||||
CurUnitInfo:=Project1.Units[i];
|
||||
if CurUnitInfo.IsPartOfProject then begin
|
||||
Result:=ConvertDelphiToLazarusUnit(CurUnitInfo.Filename,
|
||||
CurFlags+[cdtlufIsSubProc]);
|
||||
if Result=mrAbort then exit;
|
||||
if Result=mrCancel then begin
|
||||
Result:=QuestionDlg('Failed converting unit',
|
||||
'Failed to convert unit'+#13
|
||||
+CurUnitInfo.Filename+#13,
|
||||
mtWarning,[mrIgnore,'Ignore and continue',mrAbort],0);
|
||||
if Result=mrAbort then exit;
|
||||
end;
|
||||
if LazarusIDE.DoCloseEditorFile(CurUnitInfo.Filename,
|
||||
[cfSaveFirst,cfQuiet]) = mrAbort
|
||||
then
|
||||
exit;
|
||||
end;
|
||||
if LazarusIDE.DoCloseEditorFile(CurUnitInfo.Filename,[cfSaveFirst])
|
||||
=mrAbort
|
||||
then
|
||||
exit;
|
||||
inc(i);
|
||||
end;
|
||||
inc(i);
|
||||
Result:=mrOk;
|
||||
end;
|
||||
|
||||
begin
|
||||
// first convert all units
|
||||
Result:=Convert(Flags-[cdtlufCheckLFM]);
|
||||
if Result<>mrOk then exit;
|
||||
// now the units can be parsed
|
||||
if cdtlufCheckLFM in Flags then begin
|
||||
// fix the .lfm files
|
||||
Result:=Convert(Flags);
|
||||
if Result<>mrOk then exit;
|
||||
end;
|
||||
|
||||
Result:=mrOk;
|
||||
end;
|
||||
|
||||
function ConvertDelphiToLazarusUnit(const DelphiFilename: string;
|
||||
@ -320,7 +362,7 @@ var
|
||||
LFMFilename: String;
|
||||
begin
|
||||
// check file and directory
|
||||
DebugLn('ConvertDelphiToLazarusUnit A ',DelphiFilename);
|
||||
DebugLn('ConvertDelphiToLazarusUnit A ',DelphiFilename,' FixLFM=',dbgs(cdtlufCheckLFM in Flags));
|
||||
Result:=CheckFileIsWritable(DelphiFilename,[mbAbort]);
|
||||
if Result<>mrOk then exit;
|
||||
|
||||
@ -350,7 +392,7 @@ begin
|
||||
|
||||
// convert .dfm file to .lfm file (without context type checking)
|
||||
if HasDFMFile then begin
|
||||
DebugLn('ConvertDelphiToLazarusUnit Convert dfm format to lfm "',LFMFilename,'"');
|
||||
DebugLn('ConvertDelphiToLazarusUnit Rename dfm to lfm "',LFMFilename,'"');
|
||||
Result:=ConvertDFMFileToLFMFile(LFMFilename);
|
||||
if Result<>mrOk then exit;
|
||||
end;
|
||||
@ -395,30 +437,31 @@ begin
|
||||
cdtlufIsSubProc in Flags,Result)
|
||||
then exit;
|
||||
|
||||
|
||||
// check the LFM file and the pascal unit
|
||||
DebugLn('ConvertDelphiToLazarusUnit Check new .lfm and .pas file');
|
||||
Result:=LoadUnitAndLFMFile(LazarusUnitFilename,UnitCode,LFMCode,HasDFMFile);
|
||||
if Result<>mrOk then exit;
|
||||
if HasDFMFile and (LFMCode=nil) then
|
||||
DebugLn('WARNING: ConvertDelphiToLazarusUnit unable to load LFMCode');
|
||||
if (LFMCode<>nil)
|
||||
and (CheckLFMBuffer(UnitCode,LFMCode,@IDEMessagesWindow.AddMsg,true,true)<>mrOk)
|
||||
then begin
|
||||
LazarusIDE.DoJumpToCompilerMessage(-1,true);
|
||||
exit(mrAbort);
|
||||
end;
|
||||
|
||||
if LFMCode<>nil then begin
|
||||
// save LFM file
|
||||
DebugLn('ConvertDelphiToLazarusUnit Save LFM');
|
||||
Result:=MainIDEInterface.DoSaveCodeBufferToFile(LFMCode,LFMCode.Filename,false);
|
||||
if cdtlufCheckLFM in Flags then begin
|
||||
// check the LFM file and the pascal unit
|
||||
DebugLn('ConvertDelphiToLazarusUnit Check new .lfm and .pas file');
|
||||
Result:=LoadUnitAndLFMFile(LazarusUnitFilename,UnitCode,LFMCode,HasDFMFile);
|
||||
if Result<>mrOk then exit;
|
||||
if HasDFMFile and (LFMCode=nil) then
|
||||
DebugLn('WARNING: ConvertDelphiToLazarusUnit unable to load LFMCode');
|
||||
if (LFMCode<>nil)
|
||||
and (CheckLFMBuffer(UnitCode,LFMCode,@IDEMessagesWindow.AddMsg,true,true)<>mrOk)
|
||||
then begin
|
||||
LazarusIDE.DoJumpToCompilerMessage(-1,true);
|
||||
exit(mrAbort);
|
||||
end;
|
||||
|
||||
// convert lfm to lrs
|
||||
DebugLn('ConvertDelphiToLazarusUnit Convert lfm to lrs');
|
||||
Result:=ConvertLFMtoLRSfile(LFMCode.Filename);
|
||||
if Result<>mrOk then exit;
|
||||
if LFMCode<>nil then begin
|
||||
// save LFM file
|
||||
DebugLn('ConvertDelphiToLazarusUnit Save LFM');
|
||||
Result:=MainIDEInterface.DoSaveCodeBufferToFile(LFMCode,LFMCode.Filename,false);
|
||||
if Result<>mrOk then exit;
|
||||
|
||||
// convert lfm to lrs
|
||||
DebugLn('ConvertDelphiToLazarusUnit Convert lfm to lrs');
|
||||
Result:=ConvertLFMtoLRSfile(LFMCode.Filename);
|
||||
if Result<>mrOk then exit;
|
||||
end;
|
||||
end;
|
||||
|
||||
Result:=mrOk;
|
||||
@ -535,5 +578,24 @@ begin
|
||||
CleanProjectSearchPath(AProject.CompilerOptions.SrcPath);
|
||||
end;
|
||||
|
||||
procedure SetCompilerModeForProjectSrcDirs(AProject: TProject);
|
||||
begin
|
||||
if AProject.DefineTemplates.CustomDefines.FindChildByName(
|
||||
SettingDelphiModeTemplName)<>nil
|
||||
then exit;
|
||||
AProject.DefineTemplates.CustomDefines.ReplaceChild(
|
||||
CreateDefinesForFPCMode(SettingDelphiModeTemplName,cmDELPHI));
|
||||
CodeToolBoss.DefineTree.ClearCache;
|
||||
end;
|
||||
|
||||
procedure UnsetCompilerModeForProjectSrcDirs(AProject: TProject);
|
||||
begin
|
||||
if AProject.DefineTemplates.CustomDefines.FindChildByName(
|
||||
SettingDelphiModeTemplName)=nil
|
||||
then exit;
|
||||
AProject.DefineTemplates.CustomDefines.DeleteChild(SettingDelphiModeTemplName);
|
||||
CodeToolBoss.DefineTree.ClearCache;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
|
||||
@ -42,7 +42,7 @@ uses
|
||||
Classes, SysUtils, LCLProc, LResources, Forms, Controls, Graphics,
|
||||
Dialogs, Buttons, StdCtrls, FileUtil, IniFiles,
|
||||
// Components
|
||||
SynEdit, CodeCache, CodeToolManager, DefineTemplates,
|
||||
SynEdit, CodeAtom, CodeCache, CodeToolManager, DefineTemplates,
|
||||
// IDEIntf
|
||||
LazIDEIntf, MsgIntf,
|
||||
// IDE
|
||||
@ -319,6 +319,8 @@ var
|
||||
i: Integer;
|
||||
Msg: String;
|
||||
CurDir: String;
|
||||
CodePos: PCodeXYPosition;
|
||||
MissingIncludeFilesCodeXYPos: TFPList;
|
||||
begin
|
||||
Result:=LoadCodeBuffer(LazUnitCode,LazarusUnitFilename,
|
||||
[lbfCheckIfText,lbfUpdateFromDisk]);
|
||||
@ -326,10 +328,28 @@ begin
|
||||
|
||||
// fix include filenames
|
||||
DebugLn('FixMissingUnits fixing include directives ...');
|
||||
if not CodeToolBoss.FixIncludeFilenames(LazUnitCode,true)
|
||||
then begin
|
||||
Result:=JumpToCodetoolErrorAndAskToAbort(IsSubProc);
|
||||
exit;
|
||||
MissingIncludeFilesCodeXYPos:=nil;
|
||||
try
|
||||
if not CodeToolBoss.FixIncludeFilenames(LazUnitCode,true,
|
||||
MissingIncludeFilesCodeXYPos)
|
||||
then begin
|
||||
DebugLn('FixMissingUnits Error="',CodeToolBoss.ErrorMessage,'"');
|
||||
if MissingIncludeFilesCodeXYPos<>nil then begin
|
||||
for i:=0 to MissingIncludeFilesCodeXYPos.Count-1 do begin
|
||||
CodePos:=PCodeXYPosition(MissingIncludeFilesCodeXYPos[i]);
|
||||
Msg:=CodePos^.Code.Filename
|
||||
+'('+IntToStr(CodePos^.y)+','+IntToStr(CodePos^.x)+')'
|
||||
+' missing include file';
|
||||
DebugLn('FixMissingUnits "',Msg,'"');
|
||||
IDEMessagesWindow.AddMsg(Msg,'',-1);
|
||||
end;
|
||||
end;
|
||||
DebugLn('FixMissingUnits 2 Error="',CodeToolBoss.ErrorMessage,'"');
|
||||
Result:=JumpToCodetoolErrorAndAskToAbort(IsSubProc);
|
||||
exit;
|
||||
end;
|
||||
finally
|
||||
CodeToolBoss.FreeListOfPCodeXYPosition(MissingIncludeFilesCodeXYPos);
|
||||
end;
|
||||
|
||||
MissingUnits:=nil;
|
||||
@ -545,7 +565,7 @@ begin
|
||||
AProject.CompilerOptions.DebugPath:=
|
||||
MergeSearchPaths(AProject.CompilerOptions.DebugPath,SearchPath);
|
||||
end;
|
||||
|
||||
|
||||
// debug source dirs
|
||||
DebugSourceDirs:=ReadSearchPath('Directories','DebugSourceDirs');
|
||||
if DebugSourceDirs<>'' then begin
|
||||
@ -642,8 +662,9 @@ begin
|
||||
// can mean, that the relative path is 'folder'
|
||||
|
||||
ProjectDir:=AProject.ProjectDirectory;
|
||||
ShortProjectDir:='\'+ExtractFileName(ChompPathDelim(ProjectDir))+'\';
|
||||
ShortProjectDir:=PathDelim+ExtractFileName(ChompPathDelim(ProjectDir))+PathDelim;
|
||||
p:=System.Pos(ShortProjectDir,Filename);
|
||||
//DebugLn('ConvertDelphiAbsoluteToRelativeFile ShortProjectDir="',ShortProjectDir,'" ',Filename,' ',dbgs(p));
|
||||
if (p>0) then begin
|
||||
Result:=copy(Filename,p+length(ShortProjectDir),length(Filename));
|
||||
exit;
|
||||
@ -664,6 +685,7 @@ begin
|
||||
|
||||
// check for $(Delphi) makro
|
||||
p:=System.Pos('$(DELPHI)',Result);
|
||||
//DebugLn('ExpandDelphiFilename Result="',Result,'" ',dbgs(p));
|
||||
if p>0 then begin
|
||||
// Delphi features are provided by FPC and Lazarus
|
||||
// -> ignore
|
||||
@ -696,12 +718,14 @@ var
|
||||
j: Integer;
|
||||
begin
|
||||
Result:='';
|
||||
//DebugLn('ExpandDelphiSearchPath SearchPath="',SearchPath,'"');
|
||||
Paths:=SplitString(SearchPath,';');
|
||||
if Paths=nil then exit;
|
||||
try
|
||||
// expand Delphi paths
|
||||
for i:=0 to Paths.Count-1 do
|
||||
Paths[i]:=ExpandDelphiFilename(Paths[i],AProject);
|
||||
DebugLn(Paths.Text);
|
||||
// remove doubles
|
||||
for i:=Paths.Count-1 downto 0 do begin
|
||||
CurPath:=Paths[i];
|
||||
@ -719,6 +743,7 @@ begin
|
||||
if i>0 then Result:=Result+';';
|
||||
Result:=Result+Paths[i];
|
||||
end;
|
||||
//DebugLn('ExpandDelphiSearchPath Result="',Result,'"');
|
||||
finally
|
||||
Paths.Free;
|
||||
end;
|
||||
|
||||
@ -365,12 +365,15 @@ end;
|
||||
|
||||
function JumpToCodetoolErrorAndAskToAbort(Ask: boolean): TModalResult;
|
||||
// returns mrCancel or mrAbort
|
||||
var
|
||||
ErrMsg: String;
|
||||
begin
|
||||
ErrMsg:=CodeToolBoss.ErrorMessage;
|
||||
LazarusIDE.DoJumpToCodeToolBossError;
|
||||
if Ask then begin
|
||||
Result:=QuestionDlg('Error',
|
||||
'The codetools found an error:'#13
|
||||
+CodeToolBoss.ErrorMessage+#13,
|
||||
+ErrMsg+#13,
|
||||
mtWarning,[mrIgnore,'Ignore and continue',mrAbort],0);
|
||||
if Result=mrIgnore then Result:=mrCancel;
|
||||
end else begin
|
||||
|
||||
46
ide/main.pp
46
ide/main.pp
@ -5644,16 +5644,20 @@ begin
|
||||
// if SaveFirst then save the source
|
||||
if (cfSaveFirst in Flags) and (not ActiveUnitInfo.ReadOnly)
|
||||
and ((ActiveSrcEdit.Modified) or (ActiveUnitInfo.Modified)) then begin
|
||||
if ActiveUnitInfo.Filename<>'' then
|
||||
AText:=Format(lisFileHasChangedSave, ['"', ActiveUnitInfo.Filename, '"'])
|
||||
else if ActiveUnitInfo.UnitName<>'' then
|
||||
AText:=Format(lisUnitHasChangedSave, ['"', ActiveUnitInfo.Unitname, '"'])
|
||||
else
|
||||
AText:=Format(lisSourceOfPageHasChangedSave, ['"',
|
||||
ActiveSrcEdit.PageName, '"']);
|
||||
ACaption:=lisSourceModified;
|
||||
Result:=Messagedlg(ACaption, AText,
|
||||
mtConfirmation, [mbYes, mbNo, mbAbort], 0);
|
||||
if not (cfQuiet in Flags) then begin
|
||||
// ask user
|
||||
if ActiveUnitInfo.Filename<>'' then
|
||||
AText:=Format(lisFileHasChangedSave, ['"', ActiveUnitInfo.Filename, '"'])
|
||||
else if ActiveUnitInfo.UnitName<>'' then
|
||||
AText:=Format(lisUnitHasChangedSave, ['"', ActiveUnitInfo.Unitname, '"'])
|
||||
else
|
||||
AText:=Format(lisSourceOfPageHasChangedSave, ['"',
|
||||
ActiveSrcEdit.PageName, '"']);
|
||||
ACaption:=lisSourceModified;
|
||||
Result:=Messagedlg(ACaption, AText,
|
||||
mtConfirmation, [mbYes, mbNo, mbAbort], 0);
|
||||
end else
|
||||
Result:=mrYes;
|
||||
if Result=mrYes then begin
|
||||
Result:=DoSaveEditorFile(PageIndex,[sfCheckAmbiguousFiles]);
|
||||
end;
|
||||
@ -8127,16 +8131,32 @@ end;
|
||||
|
||||
function TMainIDE.DoConvertDelphiUnit(const DelphiFilename: string
|
||||
): TModalResult;
|
||||
var
|
||||
OldChange: Boolean;
|
||||
begin
|
||||
InputHistories.LastConvertDelphiUnit:=DelphiFilename;
|
||||
Result:=DelphiProject2Laz.ConvertDelphiToLazarusUnit(DelphiFilename,[]);
|
||||
OldChange:=FOpenEditorsOnCodeToolChange;
|
||||
FOpenEditorsOnCodeToolChange:=true;
|
||||
try
|
||||
Result:=DelphiProject2Laz.ConvertDelphiToLazarusUnit(DelphiFilename,[]);
|
||||
finally
|
||||
FOpenEditorsOnCodeToolChange:=OldChange;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TMainIDE.DoConvertDelphiProject(const DelphiFilename: string
|
||||
): TModalResult;
|
||||
var
|
||||
OldChange: Boolean;
|
||||
begin
|
||||
InputHistories.LastConvertDelphiProject:=DelphiFilename;
|
||||
Result:=DelphiProject2Laz.ConvertDelphiToLazarusProject(DelphiFilename);
|
||||
OldChange:=FOpenEditorsOnCodeToolChange;
|
||||
FOpenEditorsOnCodeToolChange:=true;
|
||||
try
|
||||
Result:=DelphiProject2Laz.ConvertDelphiToLazarusProject(DelphiFilename);
|
||||
finally
|
||||
FOpenEditorsOnCodeToolChange:=OldChange;
|
||||
end;
|
||||
end;
|
||||
|
||||
{-------------------------------------------------------------------------------
|
||||
@ -10696,10 +10716,10 @@ begin
|
||||
|
||||
// jump to error in source editor
|
||||
if CodeToolBoss.ErrorCode<>nil then begin
|
||||
SourceNotebook.AddJumpPointClicked(Self);
|
||||
ErrorCaret:=Point(CodeToolBoss.ErrorColumn,CodeToolBoss.ErrorLine);
|
||||
ErrorFilename:=CodeToolBoss.ErrorCode.Filename;
|
||||
ErrorTopLine:=CodeToolBoss.ErrorTopLine;
|
||||
SourceNotebook.AddJumpPointClicked(Self);
|
||||
OpenFlags:=[ofOnlyIfExists,ofUseCache];
|
||||
if CodeToolBoss.ErrorCode.IsVirtual then
|
||||
Include(OpenFlags,ofVirtualFile);
|
||||
|
||||
135
ide/project.pp
135
ide/project.pp
@ -316,7 +316,8 @@ type
|
||||
TProjectDefineTemplates = class
|
||||
private
|
||||
FActive: boolean;
|
||||
FCustomDefines: TDefineTemplate;
|
||||
FSrcDirectories: TDefineTemplate;
|
||||
FSrcDirIfDef: TDefineTemplate;
|
||||
FFlags: TProjectDefineTemplatesFlags;
|
||||
FMain: TDefineTemplate;
|
||||
FOutputDir: TDefineTemplate;
|
||||
@ -331,8 +332,9 @@ type
|
||||
FLastCustomOptions: string;
|
||||
procedure SetActive(const AValue: boolean);
|
||||
procedure UpdateMain;
|
||||
procedure UpdateSrcDirIfDef;
|
||||
procedure UpdateDefinesForOutputDirectory;
|
||||
procedure UpdateDefinesForSourceDirectories;
|
||||
procedure UpdateSourceDirectories;
|
||||
procedure UpdateDefinesForCustomDefines;
|
||||
public
|
||||
constructor Create(OwnerProject: TProject);
|
||||
@ -343,17 +345,18 @@ type
|
||||
procedure CompilerFlagsChanged;
|
||||
procedure AllChanged;
|
||||
procedure ProjectIDChanged;
|
||||
procedure SourceDirectoriesChanged;
|
||||
procedure OutputDirectoryChanged;
|
||||
procedure CustomDefinesChanged;
|
||||
procedure SourceDirectoriesChanged;// a source directory was added/deleted
|
||||
procedure CustomDefinesChanged;// the defines of the source dirs changed
|
||||
procedure OutputDirectoryChanged;// the path or the defines of the output dir changed
|
||||
procedure UpdateGlobalValues;
|
||||
public
|
||||
property Owner: TProject read FOwnerProject;
|
||||
property Project: TProject read FOwnerProject;
|
||||
property Main: TDefineTemplate read FMain;
|
||||
property SrcDirectories: TDefineTemplate read FSrcDirectories;
|
||||
property OutputDir: TDefineTemplate read FOutputDir;
|
||||
property OutPutSrcPath: TDefineTemplate read FOutPutSrcPath;
|
||||
property CustomDefines: TDefineTemplate read FCustomDefines;
|
||||
property CustomDefines: TDefineTemplate read FSrcDirIfDef;
|
||||
property Active: boolean read FActive write SetActive;
|
||||
end;
|
||||
|
||||
@ -3797,6 +3800,64 @@ begin
|
||||
end else
|
||||
FMain.Name:=Project.IDAsWord;
|
||||
// ClearCache is here unnessary, because it is only a block
|
||||
|
||||
|
||||
end;
|
||||
|
||||
procedure TProjectDefineTemplates.UpdateSrcDirIfDef;
|
||||
var
|
||||
NewValue: String;
|
||||
Changed: Boolean;
|
||||
UnitPathDefTempl: TDefineTemplate;
|
||||
IncPathDefTempl: TDefineTemplate;
|
||||
SrcPathDefTempl: TDefineTemplate;
|
||||
begin
|
||||
// The 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 FSrcDirectories=nil then begin
|
||||
FSrcDirectories:=TDefineTemplate.Create('Source Directories',
|
||||
'Source Directories','','',
|
||||
da_Block);
|
||||
FMain.AddChild(FSrcDirectories);
|
||||
end;
|
||||
if FSrcDirIfDef=nil then begin
|
||||
FSrcDirIfDef:=TDefineTemplate.Create('Source Directory Additions',
|
||||
'Additional defines for project source directories',
|
||||
'#ProjectSrcMark'+Project.IDAsWord,'',
|
||||
da_IfDef);
|
||||
FMain.AddChild(FSrcDirIfDef);
|
||||
|
||||
// create unit path template for this directory
|
||||
UnitPathDefTempl:=TDefineTemplate.Create('UnitPath', lisPkgDefsUnitPath,
|
||||
'#UnitPath','$(#UnitPath);$ProjectUnitPath('+Project.IDAsString+')',
|
||||
da_Define);
|
||||
FSrcDirIfDef.AddChild(UnitPathDefTempl);
|
||||
|
||||
// create include path template for this directory
|
||||
IncPathDefTempl:=TDefineTemplate.Create('IncPath','Include Path',
|
||||
'#IncPath','$(#IncPath);$ProjectIncPath('+Project.IDAsString+')',
|
||||
da_Define);
|
||||
FSrcDirIfDef.AddChild(IncPathDefTempl);
|
||||
|
||||
// create src path template for this directory
|
||||
SrcPathDefTempl:=TDefineTemplate.Create('SrcPath','Src Path',
|
||||
'#SrcPath','$(#SrcPath);$ProjectSrcPath('+Project.IDAsString+')',
|
||||
da_Define);
|
||||
FSrcDirIfDef.AddChild(SrcPathDefTempl);
|
||||
|
||||
Changed:=true;
|
||||
end else begin
|
||||
NewValue:='#ProjectSrcMark'+Project.IDAsWord;
|
||||
if FSrcDirIfDef.Value<>NewValue then begin
|
||||
FSrcDirIfDef.Value:='#ProjectSrcMark'+Project.IDAsWord;
|
||||
Changed:=true;
|
||||
end;
|
||||
end;
|
||||
if Changed then
|
||||
CodeToolBoss.DefineTree.ClearCache;
|
||||
end;
|
||||
|
||||
procedure TProjectDefineTemplates.UpdateDefinesForOutputDirectory;
|
||||
@ -3832,16 +3893,13 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TProjectDefineTemplates.UpdateDefinesForSourceDirectories;
|
||||
procedure TProjectDefineTemplates.UpdateSourceDirectories;
|
||||
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),' TimeStamp=',dbgs(fLastSourceDirStamp),' Project.TimeStamp=',dbgs(Project.SourceDirectories.TimeStamp));
|
||||
if (not Project.NeedsDefineTemplates) or (not Active) then exit;
|
||||
@ -3883,7 +3941,8 @@ begin
|
||||
|
||||
// build source directory define templates
|
||||
fLastSourceDirectories.Assign(NewSourceDirs);
|
||||
if (FMain=nil) and (fLastSourceDirectories.Count>0) then UpdateMain;
|
||||
if (FSrcDirIfDef=nil) and (fLastSourceDirectories.Count>0) then
|
||||
UpdateSrcDirIfDef;
|
||||
for i:=0 to fLastSourceDirectories.Count-1 do begin
|
||||
// create directory template
|
||||
SrcDirDefTempl:=TDefineTemplate.Create('Source Directory '+IntToStr(i+1),
|
||||
@ -3896,28 +3955,10 @@ begin
|
||||
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);
|
||||
FSrcDirectories.AddChild(SrcDirDefTempl);
|
||||
end;
|
||||
CodeToolBoss.DefineTree.ClearCache;
|
||||
|
||||
@ -3942,30 +3983,16 @@ begin
|
||||
'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;
|
||||
if FSrcDirIfDef<>nil then begin
|
||||
FSrcDirIfDef.UnBind;
|
||||
FSrcDirIfDef.Free;
|
||||
FSrcDirIfDef:=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);
|
||||
UpdateSrcDirIfDef;
|
||||
FSrcDirIfDef.ReplaceChild(OptionsDefTempl);
|
||||
|
||||
CodeToolBoss.DefineTree.ClearCache;
|
||||
end;
|
||||
@ -3990,6 +4017,10 @@ begin
|
||||
CodeToolBoss.DefineTree.RemoveDefineTemplate(FMain);
|
||||
FMain:=nil;
|
||||
FProjectDir:=nil;
|
||||
FSrcDirIfDef:=nil;
|
||||
FSrcDirectories:=nil;
|
||||
FOutPutSrcPath:=nil;
|
||||
FOutputDir:=nil;
|
||||
FFlags:=FFlags+[ptfFlagsChanged];
|
||||
end;
|
||||
end;
|
||||
@ -4042,7 +4073,7 @@ begin
|
||||
Exclude(FFlags,ptfIDChanged);
|
||||
UpdateMain;
|
||||
UpdateDefinesForOutputDirectory;
|
||||
UpdateDefinesForSourceDirectories;
|
||||
UpdateSourceDirectories;
|
||||
UpdateDefinesForCustomDefines;
|
||||
end;
|
||||
|
||||
@ -4053,7 +4084,7 @@ begin
|
||||
exit;
|
||||
end;
|
||||
Exclude(FFlags,ptfSourceDirsChanged);
|
||||
UpdateDefinesForSourceDirectories;
|
||||
UpdateSourceDirectories;
|
||||
CodeToolBoss.DefineTree.ClearCache;
|
||||
end;
|
||||
|
||||
|
||||
@ -71,6 +71,7 @@ type
|
||||
// close file flags
|
||||
TCloseFlag = (
|
||||
cfSaveFirst, // check if modified and save
|
||||
cfQuiet,
|
||||
cfProjectClosing
|
||||
);
|
||||
TCloseFlags = set of TCloseFlag;
|
||||
|
||||
@ -1011,6 +1011,7 @@ end;
|
||||
control is passed to event processor.
|
||||
------------------------------------------------------------------------------}
|
||||
procedure TApplication.RunLoop;
|
||||
|
||||
procedure RunMessage;
|
||||
begin
|
||||
HandleMessage;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user