mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-12-04 05:23:30 +01:00
added ReadAllLinks
git-svn-id: trunk@3837 -
This commit is contained in:
mattias
parent
7795c91d30
commit
086e9810a1
@ -96,7 +96,7 @@ properly:
|
||||
Environment -> Environment Options -> Files
|
||||
|
||||
The 'FPC Source directory' should point to your fpc source directory. This
|
||||
directory ends with /fpc/ (e.g. /usr/include/fpc) and contains directories
|
||||
directory ends with /fpc/ (e.g. /usr/src/fpc) and contains directories
|
||||
like 'compiler', 'docs', 'fcl', 'rtl' and 'packages'.
|
||||
|
||||
ToDo: explain the other paths
|
||||
|
||||
@ -47,7 +47,7 @@ uses
|
||||
Classes, SysUtils, LCLLinux, Forms, Controls, Buttons, StdCtrls, ComCtrls,
|
||||
ExtCtrls, Menus, LResources, Graphics, Dialogs, ImgList, SynEdit, Laz_XMLCfg,
|
||||
DefineTemplates, CodeToolManager, CodeToolsOptions, CodeToolsDefPreview,
|
||||
TransferMacros, InputFileDialog, IDEOptionDefs, LazConf;
|
||||
TransferMacros, InputFileDialog, IDEOptionDefs, LazConf, IDEProcs;
|
||||
|
||||
type
|
||||
TCodeToolsDefinesEditor = class(TForm)
|
||||
@ -915,7 +915,7 @@ begin
|
||||
|
||||
FileTitles[0]:='Lazarus Directory';
|
||||
FileDescs[0]:='The Lazarus main directory.';
|
||||
FileNames[0]:=ExpandFilename(ExtractFilePath(ParamStr(0)));
|
||||
FileNames[0]:=IDEProcs.ProgramDirectory;
|
||||
FileFlags[0]:=[iftDirectory,iftNotEmpty,iftMustExist];
|
||||
|
||||
EndUpdate;
|
||||
|
||||
@ -636,7 +636,7 @@ begin
|
||||
FShowHintsForMainSpeedButtons:=false;
|
||||
|
||||
// files
|
||||
FLazarusDirectory:=ExpandFilename(ExtractFilePath(ParamStr(0)));
|
||||
FLazarusDirectory:=IDEProcs.ProgramDirectory;
|
||||
FLazarusDirsHistory:=TStringList.Create;
|
||||
FCompilerFilename:='';
|
||||
FCompilerFileHistory:=TStringList.Create;
|
||||
@ -855,7 +855,7 @@ begin
|
||||
LoadRecentList(XMLConfig,FLazarusDirsHistory,
|
||||
'EnvironmentOptions/LazarusDirectory/History/');
|
||||
if FLazarusDirsHistory.Count=0 then begin
|
||||
FLazarusDirsHistory.Add(ExtractFilePath(ExpandFilename(ParamStr(0))));
|
||||
FLazarusDirsHistory.Add(ProgramDirectory);
|
||||
end;
|
||||
FCompilerFilename:=XMLConfig.GetValue(
|
||||
'EnvironmentOptions/CompilerFilename/Value',FCompilerFilename);
|
||||
@ -1892,7 +1892,7 @@ begin
|
||||
Height:=25;
|
||||
with Items do begin
|
||||
BeginUpdate;
|
||||
Add(ExtractFilePath(ParamStr(0)));
|
||||
Add(ProgramDirectory);
|
||||
EndUpdate;
|
||||
end;
|
||||
Visible:=true;
|
||||
|
||||
@ -32,11 +32,16 @@ uses
|
||||
|
||||
|
||||
const
|
||||
DefaultFPCSrcDirs: array[1..4] of string = (
|
||||
'/usr/lib/fpc',
|
||||
'/usr/local/lib/fpc',
|
||||
'/vol/fpc',
|
||||
'/vol/lib/fpc'
|
||||
DefaultFPCSrcDirs: array[1..9] of string = (
|
||||
'/usr/share/fpcsrc',
|
||||
'/usr/fpcsrc',
|
||||
'/usr/share/fpc/src',
|
||||
'/usr/fpc/src',
|
||||
'/usr/local/fpc/src',
|
||||
'/usr/lib/fpc/src',
|
||||
'/usr/local/lib/fpc/src',
|
||||
'/vol/fpc/src',
|
||||
'/vol/lib/fpc/src'
|
||||
);
|
||||
|
||||
var
|
||||
@ -144,6 +149,9 @@ end;
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.9 2003/02/07 17:49:21 mattias
|
||||
added ReadAllLinks
|
||||
|
||||
Revision 1.8 2003/02/06 20:46:51 mattias
|
||||
default fpc src dirs and clean ups
|
||||
|
||||
|
||||
@ -31,11 +31,16 @@ uses
|
||||
{$ENDIF}
|
||||
|
||||
const
|
||||
DefaultFPCSrcDirs: array[1..4] of string = (
|
||||
'/usr/lib/fpc',
|
||||
'/usr/local/lib/fpc',
|
||||
'/vol/fpc',
|
||||
'/vol/lib/fpc'
|
||||
DefaultFPCSrcDirs: array[1..9] of string = (
|
||||
'/usr/share/fpcsrc',
|
||||
'/usr/fpcsrc',
|
||||
'/usr/share/fpc/src',
|
||||
'/usr/fpc/src',
|
||||
'/usr/local/fpc/src',
|
||||
'/usr/lib/fpc/src',
|
||||
'/usr/local/lib/fpc/src',
|
||||
'/vol/fpc/src',
|
||||
'/vol/lib/fpc/src'
|
||||
);
|
||||
|
||||
var
|
||||
@ -154,6 +159,9 @@ end;
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.11 2003/02/07 17:49:21 mattias
|
||||
added ReadAllLinks
|
||||
|
||||
Revision 1.10 2003/02/06 20:46:51 mattias
|
||||
default fpc src dirs and clean ups
|
||||
|
||||
|
||||
@ -32,11 +32,16 @@ uses
|
||||
|
||||
|
||||
const
|
||||
DefaultFPCSrcDirs: array[1..4] of string = (
|
||||
'/usr/lib/fpc',
|
||||
'/usr/local/lib/fpc',
|
||||
'/vol/fpc',
|
||||
'/vol/lib/fpc'
|
||||
DefaultFPCSrcDirs: array[1..9] of string = (
|
||||
'/usr/share/fpcsrc',
|
||||
'/usr/fpcsrc',
|
||||
'/usr/share/fpc/src',
|
||||
'/usr/fpc/src',
|
||||
'/usr/local/fpc/src',
|
||||
'/usr/lib/fpc/src',
|
||||
'/usr/local/lib/fpc/src',
|
||||
'/vol/fpc/src',
|
||||
'/vol/lib/fpc/src'
|
||||
);
|
||||
|
||||
var
|
||||
@ -144,6 +149,9 @@ end;
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.6 2003/02/07 17:49:21 mattias
|
||||
added ReadAllLinks
|
||||
|
||||
Revision 1.5 2003/02/06 20:46:51 mattias
|
||||
default fpc src dirs and clean ups
|
||||
|
||||
|
||||
@ -54,6 +54,8 @@ function FileIsText(const AFilename: string): boolean;
|
||||
function FileIsExecutable(const AFilename: string): boolean;
|
||||
function FileIsSymlink(const AFilename: string): boolean;
|
||||
function GetFileDescription(const AFilename: string): string;
|
||||
function ReadAllLinks(const Filename: string;
|
||||
ExceptionOnError: boolean): string;
|
||||
|
||||
// directories
|
||||
function DirectoryExists(const FileName: String): Boolean;
|
||||
@ -110,6 +112,9 @@ end.
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.11 2003/02/07 17:49:21 mattias
|
||||
added ReadAllLinks
|
||||
|
||||
Revision 1.10 2003/01/17 16:28:42 mattias
|
||||
updated translation files
|
||||
|
||||
|
||||
@ -305,7 +305,6 @@ end;
|
||||
{------------------------------------------------------------------------------
|
||||
procedure CheckIfFileIsSymlink(const AFilename: string);
|
||||
------------------------------------------------------------------------------}
|
||||
|
||||
procedure CheckIfFileIsSymlink(const AFilename: string);
|
||||
{$IFNDEF win32}
|
||||
var
|
||||
@ -469,6 +468,51 @@ begin
|
||||
FileDateToDateTime(FileAge(AFilename)));
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
function ReadAllLinks(const Filename: string;
|
||||
ExceptionOnError: boolean): string;
|
||||
------------------------------------------------------------------------------}
|
||||
function ReadAllLinks(const Filename: string;
|
||||
ExceptionOnError: boolean): string;
|
||||
var
|
||||
LinkFilename: string;
|
||||
AText: string;
|
||||
begin
|
||||
Result:=Filename;
|
||||
repeat
|
||||
LinkFilename:={$IFDEF Ver1_0}Linux{$ELSE}Unix{$ENDIF}.ReadLink(Result);
|
||||
if LinkFilename='' then begin
|
||||
AText:='"'+Filename+'"';
|
||||
case LinuxError of
|
||||
{$IFDEF Ver1_0}sys_eacces{$ELSE}ESysEAcces{$ENDIF}:
|
||||
AText:='read access denied for '+AText;
|
||||
{$IFDEF Ver1_0}sys_enoent{$ELSE}ESysENoEnt{$ENDIF}:
|
||||
AText:='a directory component in '+AText
|
||||
+' does not exist or is a dangling symlink';
|
||||
{$IFDEF Ver1_0}sys_enotdir{$ELSE}ESysENotDir{$ENDIF}:
|
||||
AText:='a directory component in '+Atext+' is not a directory';
|
||||
{$IFDEF Ver1_0}sys_enomem{$ELSE}ESysENoMem{$ENDIF}:
|
||||
AText:='insufficient memory';
|
||||
{$IFDEF Ver1_0}sys_eloop{$ELSE}ESysELoop{$ENDIF}:
|
||||
AText:=AText+' has a circular symbolic link';
|
||||
else
|
||||
// not a symbolic link, just a regular file
|
||||
exit;
|
||||
end;
|
||||
if not ExceptionOnError then begin
|
||||
Result:='';
|
||||
exit;
|
||||
end else
|
||||
raise Exception.Create(AText);
|
||||
end else begin
|
||||
if not FilenameIsAbsolute(LinkFilename) then
|
||||
Result:=ExpandFilename(ExtractFilePath(Result)+LinkFilename)
|
||||
else
|
||||
Result:=LinkFilename;
|
||||
end;
|
||||
until false;
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
function ExtractFileNameOnly(const AFilename: string): string;
|
||||
------------------------------------------------------------------------------}
|
||||
@ -722,6 +766,9 @@ end;
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.11 2003/02/07 17:49:21 mattias
|
||||
added ReadAllLinks
|
||||
|
||||
Revision 1.10 2003/01/17 16:28:42 mattias
|
||||
updated translation files
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user