From 30801f5f8b67c7f411de0a18b29aa317da46599a Mon Sep 17 00:00:00 2001 From: graemeg Date: Wed, 2 Apr 2008 11:48:22 +0000 Subject: * Applied patch from Vladimir removing all IFDEFs from gui_grid. * Fixed compiler error under Linux. * Fixed painting of shortcut / symlink symbol overlay. --- src/corelib/gdi/gfx_gdi.pas | 34 +++++++++++++++++ src/corelib/gfxbase.pas | 45 ++++++++++++++-------- src/corelib/x11/gfx_x11.pas | 93 +++++++++++++++++++++++++++++++++++++++++---- 3 files changed, 150 insertions(+), 22 deletions(-) (limited to 'src/corelib') diff --git a/src/corelib/gdi/gfx_gdi.pas b/src/corelib/gdi/gfx_gdi.pas index e620ac26..b2f6970b 100644 --- a/src/corelib/gdi/gfx_gdi.pas +++ b/src/corelib/gdi/gfx_gdi.pas @@ -209,7 +209,12 @@ type end; + { TfpgFileListImpl } + TfpgFileListImpl = class(TfpgFileListBase) + function EncodeAttributesString(attrs: longword): TFileModeString; + constructor Create; override; + function InitializeEntry(sr: TSearchRec): TFileEntry; override; procedure PopulateSpecialDirs(const aDirectory: TfpgString); override; end; @@ -2020,6 +2025,35 @@ end; { TfpgFileListImpl } +function TfpgFileListImpl.EncodeAttributesString(attrs: longword + ): TFileModeString; +begin + Result := ''; + //if (attrs and FILE_ATTRIBUTE_ARCHIVE) <> 0 then s := s + 'a' else s := s + ' '; + if (attrs and FILE_ATTRIBUTE_HIDDEN) <> 0 then Result := Result + 'h'; + if (attrs and FILE_ATTRIBUTE_READONLY) <> 0 then Result := Result + 'r'; + if (attrs and FILE_ATTRIBUTE_SYSTEM) <> 0 then Result := Result + 's'; + if (attrs and FILE_ATTRIBUTE_TEMPORARY) <> 0 then Result := Result + 't'; + if (attrs and FILE_ATTRIBUTE_COMPRESSED) <> 0 then Result := Result + 'c'; +end; + +constructor TfpgFileListImpl.Create; +begin + inherited Create; + FHasFileMode := false; +end; + +function TfpgFileListImpl.InitializeEntry(sr: TSearchRec): TFileEntry; +begin + Result := inherited InitializeEntry(sr); + if Assigned(Result) then + begin + // using sr.Attr here is incorrect and needs to be improved! + Result.Attributes := EncodeAttributesString(sr.Attr); + Result.IsExecutable := (LowerCase(Result.Extension) = '.exe'); + end; +end; + procedure TfpgFileListImpl.PopulateSpecialDirs(const aDirectory: TfpgString); const MAX_DRIVES = 25; diff --git a/src/corelib/gfxbase.pas b/src/corelib/gfxbase.pas index e7a9bfe1..8cf82b06 100644 --- a/src/corelib/gfxbase.pas +++ b/src/corelib/gfxbase.pas @@ -450,22 +450,28 @@ type TFileEntryType = (etFile, etDir); TFileListSortOrder = (soNone, soFileName, soCSFileName, soFileExt, soSize, soTime); + TFileModeString = string[9]; // A simple data object TFileEntry = class(TObject) private - FAttributes: longword; FEntryType: TFileEntryType; FExtension: string; - FGroupID: integer; // unix + FName: string; + FModTime: TDateTime; + FSize: int64; FIsLink: boolean; FLinkTarget: string; - FMode: longword; // unix - FModTime: TDateTime; - FName: string; + FIsExecutable: boolean; + FModeString: TFileModeString; + FOwner: TfpgString; + FGroup: TfpgString; + FAttrString: TFileModeString; + {FMode: longword; // unix FOwnerID: integer; // unix - FSize: int64; + FGroupID: integer; // unix + FAttributes: longword; // windows} public constructor Create; property Name: string read FName write FName; @@ -473,12 +479,17 @@ type property Size: int64 read FSize write FSize; property EntryType: TFileEntryType read FEntryType write FEntryType; property IsLink: boolean read FIsLink write FIsLink; - property Attributes: longword read FAttributes write FAttributes; - property Mode: longword read FMode write FMode; // only used by unix OS's + property LinkTarget: string read FLinkTarget write FLinkTarget; + property IsExecutable: boolean read FIsExecutable write FIsExecutable; property ModTime: TDateTime read FModTime write FModTime; + property Mode: TFileModeString read FModeString write FModeString; + property Owner: TfpgString read FOwner write FOwner; + property Group: TfpgString read FGroup write FGroup; + property Attributes: TFileModeString read FAttrString write FAttrString; + {property Attributes: longword read FAttributes write FAttributes; + property Mode: longword read FMode write FMode; // only used by unix OS's property OwnerID: integer read FOwnerID write FOwnerID; - property GroupID: integer read FGroupID write FGroupID; - property LinkTarget: string read FLinkTarget write FLinkTarget; + property GroupID: integer read FGroupID write FGroupID;} end; @@ -494,13 +505,15 @@ type function HasAttrib(fileAttrib, testAttrib: Integer): Boolean; protected FSpecialDirs: TStringList; + FHasFileMode: boolean; function InitializeEntry(sr: TSearchRec): TFileEntry; virtual; procedure PopulateSpecialDirs(const aDirectory: TfpgString); virtual; public - constructor Create; + constructor Create; virtual; destructor Destroy; override; function Count: integer; function CurrentSpecialDir: integer; + property HasFileMode: boolean read FHasFileMode; function ReadDirectory(const aDirectory: TfpgString = ''): boolean; procedure Clear; procedure Sort(AOrder: TFileListSortOrder); @@ -1961,10 +1974,13 @@ end; constructor TFileEntry.Create; begin - FAttributes := 0; - FMode := 0; + {FAttributes := 0; + FMode := 0;} + FAttrString := ''; + FModeString := ''; FSize := 0; FIsLink := False; + FIsExecutable := false; FEntryType := etFile; end; @@ -2002,8 +2018,7 @@ begin e.Name := sr.Name; e.Extension := ExtractFileExt(e.Name); e.Size := sr.Size; - e.Attributes := sr.Attr; // this is incorrect and needs to improve! - e.EntryType := etFile; + // e.Attributes := sr.Attr; // this is incorrect and needs to improve! e.ModTime := FileDateToDateTime(sr.Time); if HasAttrib(sr.Attr, faDirectory) then diff --git a/src/corelib/x11/gfx_x11.pas b/src/corelib/x11/gfx_x11.pas index 67d85e7b..ca0f5a90 100644 --- a/src/corelib/x11/gfx_x11.pas +++ b/src/corelib/x11/gfx_x11.pas @@ -260,7 +260,13 @@ type end; + { TfpgFileListImpl } + TfpgFileListImpl = class(TfpgFileListBase) + function EncodeModeString(FileMode: longword): TFileModeString; + function GetUserName(uid: integer): string; + function GetGroupName(gid: integer): string; + constructor Create; override; function InitializeEntry(sr: TSearchRec): TFileEntry; override; procedure PopulateSpecialDirs(const aDirectory: TfpgString); override; end; @@ -270,6 +276,8 @@ implementation uses baseunix, + // Graeme: temporary. libc is not available for FreeBSD. + {$if defined(linux) and defined(cpu386)}libc,{$endif} fpgfx, gfx_widget, gui_form, // remove this!!!!! @@ -805,7 +813,7 @@ var wa: TXWindowAttributes; mcode: integer; msgp: TfpgMessageParams; - rfds: TFDSet; + rfds: baseunix.TFDSet; xfd: integer; KeySym: TKeySym; Popup: TfpgWidget; @@ -2228,6 +2236,74 @@ end; { TfpgFileListImpl } +function TfpgFileListImpl.EncodeModeString(FileMode: longword): TFileModeString; +const + modestring: string[9] = 'xwrxwrxwr'; // must be in reverse order +var + b: integer; + n: integer; +begin + // rights + //rwx rwx rwx + b := 1; + n := 1; + Result := ''; + while n <= 9 do + begin + if (FileMode and b) = 0 then + Result := '-' + Result + else + Result := modestring[n] + Result; + inc(n); + b := b shl 1; + end; +end; + +{$if defined(linux) and defined(cpu386)} +function TfpgFileListImpl.GetUserName(uid: integer): string; +var + p: PPasswd; +begin + p := getpwuid(uid); + if p <> nil then + result := p^.pw_name + else + result := ''; +end; +{$else} +// Still need to find an alternative for FreeBSD as we can't use the libc unit. +function TfpgFileListImpl.GetUserName(uid: integer): string; +begin + result := IntToStr(uid); +end; +{$endif} + +constructor TfpgFileListImpl.Create; +begin + inherited Create; + FHasFileMode := true; +end; + +{$if defined(linux) and defined(cpu386)} +function TfpgFileListImpl.GetGroupName(gid: integer): string; +var + p: PGroup; +begin + p := getgrgid(gid); + if p <> nil then + result := p^.gr_name; +end; + +{$else} +// Still need to find an alternative for FreeBSD as we can't use the libc unit. +function TfpgFileListImpl.GetGroupName(gid: integer): string; +begin + result := IntToStr(gid); +end; + + +{$endif} + function TfpgFileListImpl.InitializeEntry(sr: TSearchRec): TFileEntry; var info: Tstat; @@ -2236,13 +2312,16 @@ begin Result := inherited InitializeEntry(sr); if Assigned(Result) then begin - fullname := DirectoryName + Result.Name; - Result.LinkTarget := ExtractTargetSymLinkPath(fullname); - Result.IsLink:=(Result.LinkTarget<>''); - Result.mode := sr.Mode; + fullname := DirectoryName + Result.Name; + Result.LinkTarget := ExtractTargetSymLinkPath(fullname); + Result.IsLink := (Result.LinkTarget<>''); + Result.IsExecutable := ((sr.Mode and $40) <> 0); + Result.mode := EncodeModeString(sr.Mode); Fpstat(PChar(fullname), info); - Result.GroupID := info.st_gid; - Result.OwnerID := info.st_uid; + {Result.GroupID := info.st_gid; + Result.OwnerID := info.st_uid;} + Result.Owner := GetUserName(info.st_uid); + Result.Group := GetGroupName(info.st_uid); end; end; -- cgit v1.2.3-70-g09d2