mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-27 17:20:29 +02:00
MG: clean ups for main.pp, many minor fixes
git-svn-id: trunk@1544 -
This commit is contained in:
parent
5d76031986
commit
3f5788bc3f
@ -285,13 +285,28 @@ var
|
||||
p, StartPos, l: integer;
|
||||
CurPath, Base: string;
|
||||
begin
|
||||
if (Filename='')
|
||||
or (FilenameIsAbsolute(Filename) and FileExists(Filename))
|
||||
then begin
|
||||
//writeln('[SearchFileInPath] Filename="',Filename,'" BasePath="',BasePath,'" SearchPath="',SearchPath,'" Delimiter="',Delimiter,'"');
|
||||
if (Filename='') then begin
|
||||
Result:=Filename;
|
||||
exit;
|
||||
end;
|
||||
// check if filename absolute
|
||||
if FilenameIsAbsolute(Filename) then begin
|
||||
if FileExists(Filename) then begin
|
||||
Result:=Filename;
|
||||
exit;
|
||||
end else begin
|
||||
Result:='';
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
Base:=ExpandFilename(AppendPathDelim(BasePath));
|
||||
// search in current directory
|
||||
if FileExists(Base+Filename) then begin
|
||||
Result:=Base+Filename;
|
||||
exit;
|
||||
end;
|
||||
// search in search path
|
||||
StartPos:=1;
|
||||
l:=length(SearchPath);
|
||||
while StartPos<=l do begin
|
||||
|
1535
ide/main.pp
1535
ide/main.pp
File diff suppressed because it is too large
Load Diff
@ -142,7 +142,7 @@ type
|
||||
fModified: boolean;
|
||||
fOnFileBackup: TOnFileBackup;
|
||||
fOutputDirectory: String;
|
||||
fProjectFile: String; // the lpi filename
|
||||
fProjectInfoFile: String; // the lpi filename
|
||||
fProjectType: TProjectType;
|
||||
fSrcPath: string; // source path addition for units in ProjectDir
|
||||
fTargetFileExt: String;
|
||||
@ -150,12 +150,13 @@ type
|
||||
fUnitList: TList; // list of TUnitInfo
|
||||
fUnitOutputDirectory: String;
|
||||
fRunParameterOptions: TRunParamsOptions;
|
||||
|
||||
|
||||
function GetMainFilename: String;
|
||||
function GetMainUnitInfo: TUnitInfo;
|
||||
function GetProjectInfoFile: string;
|
||||
function GetTargetFilename: string;
|
||||
function GetUnits(Index:integer):TUnitInfo;
|
||||
procedure SetUnits(Index:integer; AUnitInfo: TUnitInfo);
|
||||
procedure SetProjectFile(const NewProjectFilename: string);
|
||||
procedure SetProjectInfoFile(const NewFilename:string);
|
||||
procedure SetTargetFilename(const NewTargetFilename: string);
|
||||
procedure OnLoadSaveFilename(var AFilename:string; Load:boolean);
|
||||
@ -215,10 +216,11 @@ type
|
||||
read fJumpHistory write fJumpHistory;
|
||||
property MainUnit: Integer //this is the unit index of the program file
|
||||
read fMainUnit write fMainUnit;
|
||||
property MainUnitInfo: TUnitInfo read GetMainUnitInfo;
|
||||
property Modified: boolean read fModified write fModified;
|
||||
property OnFileBackup: TOnFileBackup read fOnFileBackup write fOnFileBackup;
|
||||
property OutputDirectory: String read fOutputDirectory write fOutputDirectory;
|
||||
property ProjectFile: String read fProjectFile write SetProjectFile;
|
||||
property MainFilename: String read GetMainFilename;
|
||||
property ProjectInfoFile: string
|
||||
read GetProjectInfoFile write SetProjectInfoFile;
|
||||
property ProjectType: TProjectType read fProjectType write fProjectType;
|
||||
@ -244,6 +246,7 @@ const
|
||||
+'A graphical lcl/freepascal program. The program file is '
|
||||
+'automatically maintained by lazarus.'#13
|
||||
+#13
|
||||
+#13
|
||||
+'WARNING:'#13
|
||||
+'Form editing is under development and should not be used.'
|
||||
|
||||
@ -629,7 +632,7 @@ begin
|
||||
fMainUnit := -1;
|
||||
fModified := false;
|
||||
fOutputDirectory := '.';
|
||||
fProjectFile := '';
|
||||
fProjectInfoFile := '';
|
||||
fRunParameterOptions:=TRunParamsOptions.Create;
|
||||
fSrcPath := '';
|
||||
fTargetFileExt := DefaultTargetFileExt;
|
||||
@ -707,7 +710,7 @@ var
|
||||
begin
|
||||
Result := mrCancel;
|
||||
|
||||
confPath := ChangeFileExt(ProjectFile,'.lpi');
|
||||
confPath := ProjectInfoFile;
|
||||
if Assigned(fOnFileBackup) then begin
|
||||
Result:=fOnFileBackup(confPath,true);
|
||||
if Result=mrAbort then exit;
|
||||
@ -816,7 +819,7 @@ begin
|
||||
|
||||
// Load the compiler options
|
||||
CompilerOptions.XMLConfigFile := xmlconfig;
|
||||
CompilerOptions.ProjectFile := ProjectFile;
|
||||
CompilerOptions.ProjectFile := MainFilename;
|
||||
CompilerOptions.LoadCompilerOptions(true);
|
||||
CreateProjectDefineTemplate(CompilerOptions,FSrcPath);
|
||||
|
||||
@ -824,7 +827,7 @@ begin
|
||||
RunParameterOptions.Load(xmlconfig,'ProjectOptions/');
|
||||
|
||||
CodeToolBoss.GlobalValues.Variables[ExternalMacroStart+'ProjectDir']:=
|
||||
ExtractFilePath(ProjectFile);
|
||||
ProjectDirectory;
|
||||
CodeToolBoss.DefineTree.ClearCache;
|
||||
finally
|
||||
xmlconfig.Free;
|
||||
@ -915,7 +918,7 @@ begin
|
||||
fMainUnit := -1;
|
||||
fModified := false;
|
||||
fOutputDirectory := '.';
|
||||
fProjectFile := '';
|
||||
fProjectInfoFile := '';
|
||||
fSrcPath := '';
|
||||
fTargetFileExt := {$IFDEF win32}'.exe'{$ELSE}''{$ENDIF};
|
||||
fTitle := '';
|
||||
@ -941,11 +944,8 @@ end;
|
||||
function TProject.NewUniqueUnitName(NewUnitType:TNewUnitType):string;
|
||||
|
||||
function ExpandedUnitname(const AnUnitName:string):string;
|
||||
var Ext:string;
|
||||
begin
|
||||
Result:=uppercase(ExtractFileName(AnUnitName));
|
||||
Ext:=ExtractFileExt(Result);
|
||||
Result:=copy(Result,1,length(Result)-length(Ext));
|
||||
Result:=uppercase(ExtractFileNameOnly(AnUnitName));
|
||||
end;
|
||||
|
||||
function UnitNameExists(const AnUnitName:string):boolean;
|
||||
@ -954,7 +954,7 @@ function TProject.NewUniqueUnitName(NewUnitType:TNewUnitType):string;
|
||||
begin
|
||||
Result:=true;
|
||||
ExpName:=ExpandedUnitName(AnUnitName);
|
||||
if ExpandedUnitname(fProjectFile)=Expname then exit;
|
||||
if ExtractFileNameOnly(fProjectInfoFile)=Expname then exit;
|
||||
for i:=0 to UnitCount-1 do
|
||||
if (Units[i].IsPartOfProject)
|
||||
and (ExpandedUnitName(Units[i].FileName)=ExpName) then
|
||||
@ -1189,26 +1189,31 @@ begin
|
||||
fCompilerOptions.TargetFilename:=NewTargetFilename;
|
||||
end;
|
||||
|
||||
procedure TProject.SetProjectFile(const NewProjectFilename: string);
|
||||
function TProject.GetMainFilename: String;
|
||||
begin
|
||||
if (AnsiCompareText(fTitle,ExtractFileNameOnly(fProjectFile))=0)
|
||||
or (fProjectFile='') then
|
||||
fTitle:=ExtractFileNameOnly(NewProjectFilename);
|
||||
fProjectFile:=NewProjectFilename;
|
||||
|
||||
Modified:=true;
|
||||
if MainUnit>=0 then Result:=Units[MainUnit].Filename
|
||||
else Result:='';
|
||||
end;
|
||||
|
||||
function TProject.GetMainUnitInfo: TUnitInfo;
|
||||
begin
|
||||
if MainUnit>=0 then Result:=Units[MainUnit] else Result:=nil;
|
||||
end;
|
||||
|
||||
function TProject.GetProjectInfoFile:string;
|
||||
begin
|
||||
Result:=fProjectFile;
|
||||
if Result<>'' then Result:=ChangeFileExt(Result,'.lpi');
|
||||
Result:=fProjectInfoFile;
|
||||
end;
|
||||
|
||||
procedure TProject.SetProjectInfoFile(const NewFilename:string);
|
||||
begin
|
||||
if NewFilename='' then exit;
|
||||
ProjectFile:=ChangeFileExt(NewFilename,ProjectDefaultExt[ProjectType]);
|
||||
fProjectInfoFile:=NewFilename;
|
||||
if (AnsiCompareText(fTitle,ExtractFileNameOnly(fProjectInfoFile))=0)
|
||||
or (fProjectInfoFile='') then
|
||||
fTitle:=ExtractFileNameOnly(NewFilename);
|
||||
|
||||
Modified:=true;
|
||||
end;
|
||||
|
||||
function TProject.OnUnitFileBackup(const Filename:string;
|
||||
@ -1223,7 +1228,7 @@ end;
|
||||
procedure TProject.OnLoadSaveFilename(var AFilename:string; Load:boolean);
|
||||
var ProjectPath:string;
|
||||
begin
|
||||
ProjectPath:=ExtractFilePath(ProjectFile);
|
||||
ProjectPath:=ProjectDirectory;
|
||||
if ProjectPath='' then ProjectPath:=GetCurrentDir;
|
||||
DoDirSeparators(AFilename);
|
||||
if Load then begin
|
||||
@ -1244,7 +1249,7 @@ function TProject.RemoveProjectPathFromFilename(
|
||||
const AFilename: string): string;
|
||||
var ProjectPath:string;
|
||||
begin
|
||||
ProjectPath:=ExtractFilePath(ProjectFile);
|
||||
ProjectPath:=ProjectDirectory;
|
||||
if ProjectPath='' then ProjectPath:=GetCurrentDir;
|
||||
Result:=AFilename;
|
||||
DoDirSeparators(Result);
|
||||
@ -1258,7 +1263,7 @@ end;
|
||||
|
||||
function TProject.ProjectDirectory: string;
|
||||
begin
|
||||
Result:=ExtractFilePath(ProjectFile);
|
||||
Result:=ExtractFilePath(ProjectInfoFile);
|
||||
end;
|
||||
|
||||
function TProject.FileIsInProjectDir(const AFilename: string): boolean;
|
||||
@ -1350,6 +1355,9 @@ end.
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.56 2002/03/25 16:48:26 lazarus
|
||||
MG: clean ups for main.pp, many minor fixes
|
||||
|
||||
Revision 1.55 2002/03/25 07:29:23 lazarus
|
||||
MG: added TOpen/SaveFlags and splittet some methods
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user