Thread: [Jcl-checkins-diff] SF.net SVN: jcl: [2009] trunk/jcl/source/common (Page 2)

SourceForge Headquarters 1320 Columbia Street Suite 310 San Diego, CA 92101 +1 (858) 422-6466

Revision: 2009
          http://svn.sourceforge.net/jcl/?rev=2009&view=rev
Author:   marquardt
Date:     2007-05-15 01:06:05 -0700 (Tue, 15 May 2007)

Log Message:
-----------
modifications for FPC

Modified Paths:
--------------
    trunk/jcl/source/common/JclFileUtils.pas
    trunk/jcl/source/common/JclSysInfo.pas
    trunk/jcl/source/common/JclWideStrings.pas

Modified: trunk/jcl/source/common/JclFileUtils.pas
===================================================================

--- trunk/jcl/source/common/JclFileUtils.pas	2007-05-15 06:49:51 UTC (rev 2008)
+++ trunk/jcl/source/common/JclFileUtils.pas	2007-05-15 08:06:05 UTC (rev 2009)
@@ -16,10 +16,10 @@
 { Portions created by Marcel van Brakel are Copyright (C) Marcel van Brakel. All rights reserved.  }
 {                                                                                                  }
 { Contributors:                                                                                    }
-{   Andr\xE9 Snepvangers (asnepvangers)                                                               }
+{   Andre Snepvangers (asnepvangers)                                                               }
 {   Andreas Hausladen (ahuser)                                                                     }
 {   Anthony Steele                                                                                 }
-{   Rik Barker    (rikbarker)                                                                      }
+{   Rik Barker (rikbarker)                                                                         }
 {   Azret Botash                                                                                   }
 {   Charlie Calvert                                                                                }
 {   David Hervieux                                                                                 }
@@ -1570,14 +1570,14 @@
       while P < FEnd do
       begin
         case P^ of
-          AnsiLineFeed :
+          AnsiLineFeed:
             begin
               Inc(FLineCount);
               Inc(P);
               if (P < FEnd) and (P^ = AnsiCarriageReturn) then
                 Inc(P);
             end;
-          AnsiCarriageReturn :
+          AnsiCarriageReturn:
             begin
               Inc(FLineCount);
               Inc(P);
@@ -1680,14 +1680,14 @@
       while (Result < FEnd) and (LineOffset > 0) do
       begin
         case Result^ of
-          AnsiLineFeed :
+          AnsiLineFeed:
             begin
               Dec(LineOffset);
               Inc(Result);
               if (Result < FEnd) and (Result^ = AnsiCarriageReturn) then
                 Inc(Result);
             end;
-          AnsiCarriageReturn :
+          AnsiCarriageReturn:
             begin
               Dec(LineOffset);
               Inc(Result);
@@ -1695,7 +1695,7 @@
                 Inc(Result);
             end;
         else
-          Inc(Result);  
+          Inc(Result);
         end;
       end;
     end
@@ -1707,7 +1707,7 @@
       begin
         Dec(Result);
         case Result^ of
-          AnsiLineFeed :
+          AnsiLineFeed:
             begin
               Inc(LineOffset);
               if LineOffset >= 1 then
@@ -1716,7 +1716,7 @@
               if (Result > FContent) and ((Result-1)^ = AnsiCarriageReturn) then
                 Dec(Result);
             end;
-          AnsiCarriageReturn :
+          AnsiCarriageReturn:
             begin
               Inc(LineOffset);
               if LineOffset >= 1 then
@@ -1769,18 +1769,18 @@
     if P < FEnd then
     begin
       case P^ of
-        AnsiLineFeed :
+        AnsiLineFeed:
           begin
             Inc(P);
             if (P < FEnd) and (P^ = AnsiCarriageReturn) then
               Inc(P);
           end;
-        AnsiCarriageReturn :
+        AnsiCarriageReturn:
           begin
             Inc(P);
             if (P < FEnd) and (P^ = AnsiLineFeed) then
               Inc(P);
-          end;   
+          end;
       end;
     end;
     StartPos := P;
@@ -2441,7 +2441,7 @@
   if realpath(PChar(Path), PChar(FullPath)) = nil then
     RaiseLastOSError;
   StrResetLength(FullPath);
-  
+
   FsTypes := TStringList.Create;
   try
     GetAvailableFileSystems(FsTypes);
@@ -2689,10 +2689,11 @@
           List.Add(SearchRec.Name);
           Break;
         end;
-        
+
         case FindNext(SearchRec) of
-          0 : ;
-          ERROR_NO_MORE_FILES :
+          0:
+            ;
+          ERROR_NO_MORE_FILES:
             Break;
           else
             Result := False;
@@ -3237,12 +3238,14 @@
 {$ENDIF UNIX}
 {$ENDIF ~CLR}
 
+{$IFDEF MSWINDOWS}
 {$IFDEF FPC}
 { TODO : Move this over to JclWin32 when JclWin32 gets overhauled. }
 function GetTempFileName(lpPathName, lpPrefixString: PChar;
   uUnique: UINT; lpTempFileName: PChar): UINT; stdcall;
 external kernel32 name 'GetTempFileNameA';
 {$ENDIF FPC}
+{$ENDIF MSWINDOWS}
 
 function FileGetTempName(const Prefix: string): string;
 {$IFDEF CLR}
@@ -3752,12 +3755,16 @@
 begin
   L := MAX_PATH + 1;
   SetLength(Result, L);
-{$IFDEF MSWINDOWS}
+  {$IFDEF MSWINDOWS}
   L := Windows.GetModuleFileName(Module, Pointer(Result), L);
-{$ENDIF MSWINDOWS}
-{$IFDEF UNIX}
+  {$ENDIF MSWINDOWS}
+  {$IFDEF UNIX}
+  {$IFDEF FPC}
+  L := 0; // FIXME
+  {$ELSE}
   L := GetModuleFileName(Module, Pointer(Result), L);
-{$ENDIF UNIX}
+  {$ENDIF FPC}
+  {$ENDIF UNIX}
   SetLength(Result, L);
 end;
 {$ENDIF ~CLR}
@@ -5488,7 +5495,11 @@
   Priority := tpIdle;
   {$ENDIF MSWINDOWS}
   {$IFDEF UNIX}
+  {$IFDEF FPC}
+  Priority := tpIdle;
+  {$ELSE}
   Priority := 0;
+  {$ENDIF FPC}
   {$ENDIF UNIX}
   {$ENDIF ~CLR}
   FreeOnTerminate := True;
@@ -6100,7 +6111,7 @@
       for IndexNew := 0 to NewItems.Count - 1 do
       begin
         Item := NewItems.Strings[IndexNew];
-        
+
         Duplicate := False;
         for IndexList := 0 to StrList.Count - 1 do
           if SamePath(Item, StrList.Strings[IndexList]) then

Modified: trunk/jcl/source/common/JclSysInfo.pas
===================================================================
--- trunk/jcl/source/common/JclSysInfo.pas	2007-05-15 06:49:51 UTC (rev 2008)
+++ trunk/jcl/source/common/JclSysInfo.pas	2007-05-15 08:06:05 UTC (rev 2009)
@@ -17,7 +17,7 @@
 {                                                                                                  }
 { Contributors:                                                                                    }
 {   Alexander Radchenko                                                                            }
-{   Andr\xE9 Snepvangers (asnepvangers)                                                               }
+{   Andre Snepvangers (asnepvangers)                                                               }
 {   Azret Botash                                                                                   }
 {   Bryan Coutch                                                                                   }
 {   Carl Clark                                                                                     }
@@ -32,7 +32,7 @@
 {   Nick Hodges                                                                                    }
 {   Olivier Sannier (obones)                                                                       }
 {   Peter Friese                                                                                   }
-{   Peter Th\xF6rnquist (peter3)                                                                      }
+{   Peter Thornquist (peter3)                                                                      }
 {   Petr Vones (pvones)                                                                            }
 {   Rik Barker                                                                                     }
 {   Robert Marquardt (marquardt)                                                                   }
@@ -138,7 +138,9 @@
 function GetStartmenuFolder: string;
 function GetDesktopDirectoryFolder: string;
 {$IFNDEF CLR}
+{$IFNDEF FPC}
 function GetCommonDocumentsFolder: string;
+{$ENDIF ~FPC}
 function GetNethoodFolder: string;
 function GetFontsFolder: string;
 function GetCommonStartmenuFolder: string;
@@ -418,7 +420,7 @@
     LinePerSector: Byte;  // for L3 Normal Cache
     Entries: Cardinal;        // for TLB
     I: string;
-  end; 
+  end;
 
   TFreqInfo = record
     RawFreq: Cardinal;
@@ -664,7 +666,7 @@
   EINTEL64_BIT_26 = BIT_26; // Reserved, do not count on value
   EINTEL64_BIT_27 = BIT_27; // Reserved, do not count on value
   EINTEL64_BIT_28 = BIT_28; // Reserved, do not count on value
-  EINTEL64_EM64T  = BIT_29; // Intel\xAE Extended Memory 64 Technology
+  EINTEL64_EM64T  = BIT_29; // Intel Extended Memory 64 Technology
   EINTEL64_BIT_30 = BIT_30; // Reserved, do not count on value
   EINTEL64_BIT_31 = BIT_31; // Reserved, do not count on value
 
@@ -1312,7 +1314,9 @@
   JclBase, JclFileUtils, JclStrings;
 
 {$IFDEF FPC}
+{$IFDEF MSWINDOWS}
 {$I JclSysInfo.fpc}
+{$ENDIF MSWINDOWS}
 {$ENDIF FPC}
 
 //=== Environment ============================================================
@@ -1445,13 +1449,13 @@
 end;
 {$ENDIF UNIX}
 
-{$IFDEF MSWINDOWS}
-
 function GetEnvironmentVars(const Vars: TStrings): Boolean;
 begin
   Result := GetEnvironmentVars(Vars, True);
 end;
 
+{$IFDEF MSWINDOWS}
+
 function GetEnvironmentVars(const Vars: TStrings; Expand: Boolean): Boolean;
 {$IFDEF CLR}
 var
@@ -1661,7 +1665,11 @@
       StrResetLength(Result);
       Exit;
     end;
+    {$IFDEF FPC}
+    if GetLastOSError <> ERANGE then
+    {$ELSE}
     if GetLastError <> ERANGE then
+    {$ENDIF FPC}
       RaiseLastOSError;
     Size := Size * 2;
   end;
@@ -1843,10 +1851,12 @@
 end;
 
 {$IFNDEF CLR}
+{$IFNDEF FPC}
 function GetCommonDocumentsFolder: string;
 begin
   Result := GetSpecialFolderLocation(CSIDL_COMMON_DOCUMENTS);
 end;
+{$ENDIF ~FPC}
 {$ENDIF ~CLR}
 
 {$IFNDEF CLR}
@@ -2171,13 +2181,22 @@
       while IfList^.if_index <> 0 do
       begin
         //copy in the interface name to look up address of
+        {$IFDEF FPC}
+        strncpy(IfReq.ifr_ifrn.ifrn_name, IfList^.if_name, IFNAMSIZ);
+        {$ELSE}
         strncpy(IfReq.ifrn_name, IfList^.if_name, IFNAMSIZ);
+        {$ENDIF FPC}
         //get the address for this interface
         if ioctl(Sock, SIOCGIFADDR, @IfReq) <> 0 then
           RaiseLastOSError;
         //print out the address
+        {$IFDEF FPC}
+        SockAddrPtr := PSockAddrIn(@IfReq.ifr_ifru.ifru_addr);
+        Results.Add(Format('%s=%s', [IfReq.ifr_ifrn.ifrn_name, inet_ntoa(SockAddrPtr^.sin_addr)]));
+        {$ELSE}
         SockAddrPtr := PSockAddrIn(@IfReq.ifru_addr);
         Results.Add(Format('%s=%s', [IfReq.ifrn_name, inet_ntoa(SockAddrPtr^.sin_addr)]));
+        {$ENDIF FPC}
         Inc(IfList);
       end;
     finally
@@ -2422,8 +2441,13 @@
   if ProcDir <> nil then
   begin
     PtrDirEnt := nil;
+    {$IFDEF FPC}
+    if readdir_r(ProcDir, @Scratch, @PtrDirEnt) <> 0 then
+      Exit;
+    {$ELSE}
     if readdir_r(ProcDir, @Scratch, PtrDirEnt) <> 0 then
       Exit;
+    {$ENDIF FPC}
     List.BeginUpdate;
     try
       while PtrDirEnt <> nil do
@@ -2455,8 +2479,13 @@
 
           List.AddObject(FileName, Pointer(ProcID));
         end;
+        {$IFDEF FPC}
+        if readdir_r(ProcDir, @Scratch, @PtrDirEnt) <> 0 then
+          Break;
+        {$ELSE}
         if readdir_r(ProcDir, @Scratch, PtrDirEnt) <> 0 then
           Break;
+        {$ENDIF FPC}
       end;
     finally
       List.EndUpdate;
@@ -2921,7 +2950,7 @@
   if GetWindowThreadProcessId(Wnd, @PID) <> 0 then
     Result := TerminateApp(PID, Timeout)
   else
-    Result := taError;  
+    Result := taError;
 end;
 
 function GetProcessNameFromWnd(Wnd: THandle): string;
@@ -4052,7 +4081,7 @@
       POP  EDI
     end;
   end;
-  
+
   procedure ProcessStandard(var CPUInfo: TCpuInfo; HiVal: Cardinal);
   var
     VersionInfo, AdditionalInfo, ExFeatures: Cardinal;
@@ -4141,36 +4170,36 @@
             if IntelCacheDescription[J].D = CPUInfo.IntelSpecific.CacheDescriptors[I] then
               with IntelCacheDescription[J] do
         case Family of
-          //cfInstructionTLB :
-          //cfDataTLB :
-          cfL1InstructionCache :
+          //cfInstructionTLB:
+          //cfDataTLB:
+          cfL1InstructionCache:
             begin
               Inc(CPUInfo.L1InstructionCacheSize,Size);
               CPUInfo.L1InstructionCacheLineSize := LineSize;
               CPUInfo.L1InstructionCacheAssociativity := WaysOfAssoc;
             end;
-          cfL1DataCache :
+          cfL1DataCache:
             begin
               Inc(CPUInfo.L1DataCacheSize,Size);
               CPUInfo.L1DataCacheLineSize := LineSize;
               CPUInfo.L1DataCacheAssociativity := WaysOfAssoc;
             end;
-          cfL2Cache :
+          cfL2Cache:
             if (CPUInfo.IntelSpecific.L2Cache = 0) then
             begin
               Inc(CPUInfo.L2CacheSize,Size);
               CPUInfo.L2CacheLineSize := LineSize;
               CPUInfo.L2CacheAssociativity := WaysOfAssoc;
             end;
-          cfL3Cache :
+          cfL3Cache:
             begin
               Inc(CPUInfo.L3CacheSize,Size);
               CPUInfo.L3CacheLineSize := LineSize;
               CPUInfo.L3CacheAssociativity := WaysOfAssoc;
               CPUInfo.L3LinesPerSector := LinePerSector;
             end;
-          //cfTrace :    // no numeric informations
-          //cfOther :
+          //cfTrace:    // no numeric informations
+          //cfOther:
         end;
     end;
     if not CPUInfo.HasExtendedInfo then
@@ -4402,7 +4431,7 @@
             10:
               CPUInfo.CpuName := 'AMD Athlon\x99 XP (Model 10)';
             else
-              StrFmt(CPUInfo.CpuName,PChar(RsUnknownAMDModel),[CPUInfo.Model]);
+              StrFmt(CPUInfo.CpuName, PChar(RsUnknownAMDModel), [CPUInfo.Model]);
           end;
         8:
 
@@ -4428,7 +4457,7 @@
     CPUInfo.Is64Bits := CPUInfo.HasExtendedInfo and ((CPUInfo.AMDSpecific.ExFeatures and EAMD_LONG) <> 0);
     CPUInfo.DEPCapable := CPUInfo.HasExtendedInfo and ((CPUInfo.AMDSpecific.ExFeatures and EAMD_NX) <> 0);
   end;
-  
+
   procedure ProcessCyrix(var CPUInfo: TCpuInfo; HiVal: Cardinal);
   var
     ExHiVal, Unused, VersionInfo, AdditionalInfo: Cardinal;
@@ -4546,7 +4575,7 @@
       else CPUInfo.SSE := 0;
     CPUInfo._3DNow := (CPUInfo.Features and VIA_3DNOW) <> 0;
   end;
-  
+
   procedure ProcessTransmeta(var CPUInfo: TCpuInfo; HiVal: Cardinal);
   var
     ExHiVal, Unused, VersionInfo: Cardinal;
@@ -4629,14 +4658,14 @@
     end;
     CPUInfo.MMX := (CPUInfo.Features and TRANSMETA_MMX) <> 0;
   end;
-  
+
 var
   HiVal: Cardinal;
 begin
   FillChar(Result, sizeof(Result), 0);
   Result.LogicalCore := 1;
   Result.PhysicalCore := 1;
-  
+
   if HasCPUIDInstruction then
   begin
     Result.HasInstruction := True;
@@ -4874,7 +4903,11 @@
 var
   SystemInf: TSysInfo ;
 begin
+  {$IFDEF FPC}
+  SysInfo(@SystemInf);
+  {$ELSE}
   SysInfo(SystemInf);
+  {$ENDIF FPC}
   with SystemInf do
     Result := 100 - Round(100 * freeram / totalram);
 end;
@@ -4895,7 +4928,11 @@
 var
   SystemInf: TSysInfo;
 begin
+  {$IFDEF FPC}
+  SysInfo(@SystemInf);
+  {$ELSE}
   SysInfo(SystemInf);
+  {$ENDIF FPC}
   Result := SystemInf.totalswap;
 end;
 {$ENDIF UNIX}
@@ -4916,7 +4953,11 @@
 var
   SystemInf: TSysInfo;
 begin
+  {$IFDEF FPC}
+  SysInfo(@SystemInf);
+  {$ELSE}
   SysInfo(SystemInf);
+  {$ENDIF FPC}
   with SystemInf do
     Result := 100 - Trunc(100 * FreeSwap / TotalSwap);
 end;
@@ -4941,7 +4982,11 @@
 var
   SystemInf: TSysInfo;
 begin
+  {$IFDEF FPC}
+  SysInfo(@SystemInf);
+  {$ELSE}
   SysInfo(SystemInf);
+  {$ENDIF FPC}
   Result := SystemInf.totalram;
 end;
 {$ENDIF UNIX}
@@ -4961,7 +5006,11 @@
 var
   SystemInf: TSysInfo;
 begin
+  {$IFDEF FPC}
+  SysInfo(@SystemInf);
+  {$ELSE}
   SysInfo(SystemInf);
+  {$ENDIF FPC}
   Result := SystemInf.freeram;
 end;
 {$ENDIF UNIX}
@@ -5078,7 +5127,7 @@
       @MyGetFreeSystemResources := GetProcAddress(ResmeterLibHandle, '_MyGetFreeSystemResources32@4');
       if not Assigned(MyGetFreeSystemResources) then
         UnloadSystemResourcesMeterLib;
-    end;    
+    end;
   end;
 
 begin

Modified: trunk/jcl/source/common/JclWideStrings.pas
===================================================================
--- trunk/jcl/source/common/JclWideStrings.pas	2007-05-15 06:49:51 UTC (rev 2008)
+++ trunk/jcl/source/common/JclWideStrings.pas	2007-05-15 08:06:05 UTC (rev 2009)
@@ -111,7 +111,7 @@
     procedure DefineProperties(Filer: TFiler); override;
     function ExtractName(const S: WideString): WideString;
     function GetP(Index: Integer): PWideString; virtual; abstract;
-    function Get(Index: Integer): WideString; 
+    function Get(Index: Integer): WideString;
     function GetCapacity: Integer; virtual;
     function GetCount: Integer; virtual; abstract;
     function GetObject(Index: Integer): TObject; virtual;
@@ -288,8 +288,10 @@
 function TrimLeftLengthW(const S: WideString): Integer;
 function TrimRightLengthW(const S: WideString): Integer;
 
+{$IFNDEF FPC}
 function WideStartsText(const SubStr, S: WideString): Boolean;
 function WideStartsStr(const SubStr, S: WideString): Boolean;
+{$ENDIF ~FPC}
 
 {$IFDEF UNITVERSIONING}
 const
@@ -995,8 +997,12 @@
     Result := CompareStringW(LOCALE_USER_DEFAULT, 0,
       PWideChar(S1), Length(S1), PWideChar(S2), Length(S2)) - 2;
   {$ELSE ~MSWINDOWS}
-  { TODO : Don't cheat here }
-  Result := CompareString(S1, S2);
+    {$IFDEF FPC}
+    Result := SysUtils.WideCompareStr(S1, S2);
+    {$ELSE}
+    { TODO : Don't cheat here }
+    Result := CompareString(S1, S2);
+    {$ENDIF FPC}
   {$ENDIF ~MSWINDOWS}
 end;
 
@@ -1044,6 +1050,8 @@
     Dec(Result);
 end;
 
+{$IFNDEF FPC}
+
 function WideStartsText(const SubStr, S: WideString): Boolean;
 var
   Len: Integer;
@@ -1060,6 +1068,7 @@
   Result := (Len <= Length(S)) and (StrLCompW(PWideChar(SubStr), PWideChar(S), Len) = 0);
 end;
 
+{$ENDIF ~FPC}
 
 //=== { TWStrings } ==========================================================
 


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.




Thread: [Jcl-checkins-diff] SF.net SVN: jcl: [2009] trunk/jcl/source/common (Page 2)

jcl-checkins-diff