mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-08 19:38:09 +02:00
added FindDefaultLazarusSrcDirectory
git-svn-id: trunk@8735 -
This commit is contained in:
parent
01282aa76a
commit
47580b39ef
@ -71,6 +71,7 @@ type
|
||||
TPropertyLinkOption = (
|
||||
ploReadOnIdle,
|
||||
ploAutoSave
|
||||
//ploDisableOnNil // disable control, if link not connected
|
||||
//ToDo: ploReadOnly
|
||||
);
|
||||
TPropertyLinkOptions = set of TPropertyLinkOption;
|
||||
|
@ -49,7 +49,7 @@ type
|
||||
procedure LoadContributors;
|
||||
public
|
||||
procedure Paint; override;
|
||||
constructor Create(THeOwner: TComponent); override;
|
||||
constructor Create(TheOwner: TComponent); override;
|
||||
destructor Destroy; override;
|
||||
end;
|
||||
|
||||
@ -160,8 +160,6 @@ begin
|
||||
,FPixmap.Canvas, Rect(0,0, Width, Height));
|
||||
end;
|
||||
|
||||
|
||||
|
||||
initialization
|
||||
{$I aboutfrm.lrs}
|
||||
{$I lazarus_about_logo.lrs}
|
||||
|
@ -42,6 +42,16 @@ const
|
||||
'/usr/src/fpc',
|
||||
'/vol/src/fpc'
|
||||
);
|
||||
|
||||
DefaultLazarusSrcDirs: array[1..7] of string = (
|
||||
'/usr/share/lazarus',
|
||||
'/usr/local/share/lazarus',
|
||||
'/usr/local/lib/lazarus',
|
||||
'/usr/local/lazarus',
|
||||
'/usr/lib/lazarus',
|
||||
'~/pascal/lazarus',
|
||||
'~/lazarus'
|
||||
);
|
||||
|
||||
var
|
||||
PrimaryConfigPath,
|
||||
|
@ -28,6 +28,10 @@ const
|
||||
'c:\pp\source'
|
||||
);
|
||||
|
||||
DefaultLazarusSrcDirs: array[1..1] of string = (
|
||||
'c:\pp\source'
|
||||
);
|
||||
|
||||
var
|
||||
PrimaryConfigPath,
|
||||
SecondaryConfigPath: string;
|
||||
|
@ -133,8 +133,11 @@ var
|
||||
r: integer;
|
||||
begin
|
||||
CurLazDir:=EnvironmentOptions.LazarusDirectory;
|
||||
if CurLazDir='' then
|
||||
if CurLazDir='' then begin
|
||||
CurLazDir:=ProgramDirectory;
|
||||
if not CheckLazarusDirectory(CurLazDir) then
|
||||
CurLazDir:=FindDefaultLazarusSrcDirectory;
|
||||
end;
|
||||
if not CheckLazarusDirectory(CurLazDir) then begin
|
||||
if not InteractiveSetup then exit;
|
||||
if CurLazDir='' then begin
|
||||
|
@ -90,6 +90,7 @@ const
|
||||
function FindDefaultCompilerPath: string;
|
||||
function FindDefaultMakePath: string;
|
||||
function FindDefaultFPCSrcDirectory: string;
|
||||
function FindDefaultLazarusSrcDirectory: string;
|
||||
function CheckFPCSourceDir(const ADirectory: string): boolean;
|
||||
function CheckLazarusDirectory(const ADirectory: string): boolean;
|
||||
|
||||
@ -241,6 +242,17 @@ begin
|
||||
Result:='';
|
||||
end;
|
||||
|
||||
function FindDefaultLazarusSrcDirectory: string;
|
||||
var
|
||||
i: integer;
|
||||
begin
|
||||
for i:=Low(DefaultLazarusSrcDirs) to High(DefaultLazarusSrcDirs) do begin
|
||||
Result:=DefaultLazarusSrcDirs[i];
|
||||
if CheckLazarusDirectory(Result) then exit;
|
||||
end;
|
||||
Result:='';
|
||||
end;
|
||||
|
||||
function CheckLazarusDirectory(const ADirectory: string): boolean;
|
||||
var
|
||||
Dir: String;
|
||||
@ -251,6 +263,7 @@ begin
|
||||
Result:=DirPathExists(Dir+'lcl')
|
||||
and DirPathExists(Dir+'lcl'+PathDelim+'units')
|
||||
and DirPathExists(Dir+'components')
|
||||
and DirPathExists(Dir+'ideintf')
|
||||
and DirPathExists(Dir+'designer')
|
||||
and DirPathExists(Dir+'debugger');
|
||||
end;
|
||||
|
@ -786,12 +786,18 @@ end;
|
||||
function ProgramDirectory: string;
|
||||
------------------------------------------------------------------------------}
|
||||
function ProgramDirectory: string;
|
||||
var
|
||||
Flags: TSearchFileInPathFlags;
|
||||
begin
|
||||
Result:=ParamStr(0);
|
||||
if ExtractFilePath(Result)='' then begin
|
||||
// program was started via PATH
|
||||
Result:=SearchFileInPath(Result,'',GetEnvironmentVariable('PATH'),':',
|
||||
[sffDontSearchInBasePath]);
|
||||
{$IFDEF windows}
|
||||
Flags:=[];
|
||||
{$ELSE}
|
||||
Flags:=[sffDontSearchInBasePath];
|
||||
{$ENDIF}
|
||||
Result:=SearchFileInPath(Result,'',GetEnvironmentVariable('PATH'),':',Flags);
|
||||
end;
|
||||
// resolve links
|
||||
Result:=ReadAllLinks(Result,false);
|
||||
|
Loading…
Reference in New Issue
Block a user