Browse Source

--- Merging r20516 into '.':
U packages/opengl/src/glx.pp
--- Merging r20518 into '.':
G packages/opengl/src/glx.pp
--- Merging r20526 into '.':
G packages/opengl/src/glx.pp
--- Merging r20528 into '.':
G packages/opengl/src/glx.pp
--- Merging r20543 into '.':
A packages/fcl-base/tests
A packages/fcl-base/tests/tests_fptemplate.pp
A packages/fcl-base/tests/fclbase-unittests.pp
U packages/fcl-base/src/fptemplate.pp
--- Merging r20451 into '.':
U utils/importtl/Makefile.fpc
C utils/importtl/Makefile
--- Merging r20544 into '.':
U packages/winunits-base/src/typelib.pas
--- Merging r20603 into '.':
U rtl/inc/systemh.inc
--- Merging r20604 into '.':
G rtl/inc/systemh.inc
--- Merging r20606 into '.':
U rtl/objpas/classes/lists.inc
--- Merging r20616 into '.':
U rtl/objpas/classes/compon.inc
--- Merging r20646 into '.':
U packages/fcl-fpcunit/src/testutils.pp
--- Merging r20655 into '.':
U rtl/win/wininc/unidef.inc
U rtl/win/wininc/ascfun.inc
U rtl/win/wininc/unifun.inc
U rtl/win/wininc/ascdef.inc
--- Merging r20683 into '.':
U rtl/haiku/signal.inc
U rtl/haiku/i386/sighnd.inc
U rtl/haiku/system.pp
--- Merging r20690 into '.':
G rtl/haiku/system.pp
--- Merging r20693 into '.':
U packages/cdrom/src/fpcddb.pp
--- Merging r20702 into '.':
G rtl/haiku/system.pp
--- Merging r20899 into '.':
G packages/winunits-base/src/typelib.pas
Summary of conflicts:
Text conflicts: 1

# revisions: 20516,20518,20526,20528,20543,20451,20544,20603,20604,20606,20616,20646,20655,20683,20690,20693,20702,20899
------------------------------------------------------------------------
r20516 | nickysn | 2012-03-14 01:09:57 +0100 (Wed, 14 Mar 2012) | 6 lines
Changed paths:
M /trunk/packages/opengl/src/glx.pp

+ add support for the GLX_SGI_swap_control extension
* import all GLX procedures and functions via the glXGetProcAddress and
glXGetProcAddressARB functions, if they are available. This is necessary,
because not all GLX extension functions are exported statically by libGL.so


------------------------------------------------------------------------
------------------------------------------------------------------------
r20518 | nickysn | 2012-03-15 00:38:25 +0100 (Thu, 15 Mar 2012) | 1 line
Changed paths:
M /trunk/packages/opengl/src/glx.pp

+ added support for the GLX_MESA_swap_control glx extension
------------------------------------------------------------------------
------------------------------------------------------------------------
r20526 | nickysn | 2012-03-16 21:46:33 +0100 (Fri, 16 Mar 2012) | 4 lines
Changed paths:
M /trunk/packages/opengl/src/glx.pp

* GLX unit converted to use unit ctypes, which fixes some 64-bit issues
* glXReleaseBufferMESA function name changed to the correct one: glXReleaseBuffersMESA


------------------------------------------------------------------------
------------------------------------------------------------------------
r20528 | nickysn | 2012-03-16 22:29:50 +0100 (Fri, 16 Mar 2012) | 1 line
Changed paths:
M /trunk/packages/opengl/src/glx.pp

+ added support for the GLX_EXT_swap_control GLX extension
------------------------------------------------------------------------
------------------------------------------------------------------------
r20543 | joost | 2012-03-20 17:13:14 +0100 (Tue, 20 Mar 2012) | 5 lines
Changed paths:
M /trunk/packages/fcl-base/src/fptemplate.pp
A /trunk/packages/fcl-base/tests
A /trunk/packages/fcl-base/tests/fclbase-unittests.pp
A /trunk/packages/fcl-base/tests/tests_fptemplate.pp

* TTemplateParser: Do not require a space between the tag name and the
ParamStartDelimiter.
* Allow parameters without any name, for example: {uppercase[-this-]}
* Added simple tests for TTemplateParser

------------------------------------------------------------------------
------------------------------------------------------------------------
r20451 | pierre | 2012-03-01 11:28:35 +0100 (Thu, 01 Mar 2012) | 1 line
Changed paths:
M /trunk/utils/importtl/Makefile
M /trunk/utils/importtl/Makefile.fpc

Add indirectly required ppacakges
------------------------------------------------------------------------
------------------------------------------------------------------------
r20544 | marco | 2012-03-20 19:53:38 +0100 (Tue, 20 Mar 2012) | 4 lines
Changed paths:
M /trunk/packages/winunits-base/src/typelib.pas

* Patches from Ludo Brands for typelib
- Mantis #21516 fix range check error
- Mantis #21513 Specific workaround for potentially bugged Office10/MSacc.OLB

------------------------------------------------------------------------
------------------------------------------------------------------------
r20603 | marco | 2012-03-23 18:49:59 +0100 (Fri, 23 Mar 2012) | 2 lines
Changed paths:
M /trunk/rtl/inc/systemh.inc

* Adding Delphi (2010 or XE) equivalents to our ctypes unit. Mantis #21537

------------------------------------------------------------------------
------------------------------------------------------------------------
r20604 | marco | 2012-03-23 18:51:34 +0100 (Fri, 23 Mar 2012) | 2 lines
Changed paths:
M /trunk/rtl/inc/systemh.inc

* int32 is longint in default mode, not integer.

------------------------------------------------------------------------
------------------------------------------------------------------------
r20606 | florian | 2012-03-23 21:16:03 +0100 (Fri, 23 Mar 2012) | 1 line
Changed paths:
M /trunk/rtl/objpas/classes/lists.inc

* patch by cobines to improve speed of TFPList.Move, resolves #21436
------------------------------------------------------------------------
------------------------------------------------------------------------
r20616 | marco | 2012-03-24 18:28:10 +0100 (Sat, 24 Mar 2012) | 2 lines
Changed paths:
M /trunk/rtl/objpas/classes/compon.inc

* Patch for referenceinterface by C. Peterson to properly add to the freenotification list, Mantis #20808

------------------------------------------------------------------------
------------------------------------------------------------------------
r20646 | sergei | 2012-03-28 12:55:17 +0200 (Wed, 28 Mar 2012) | 1 line
Changed paths:
M /trunk/packages/fcl-fpcunit/src/testutils.pp

* fcl-fpcunit/src/testutils.pp, GetMethodList: avoid range errors at runtime if compiled with -Cr.
------------------------------------------------------------------------
------------------------------------------------------------------------
r20655 | marco | 2012-03-29 19:43:38 +0200 (Thu, 29 Mar 2012) | 8 lines
Changed paths:
M /trunk/rtl/win/wininc/ascdef.inc
M /trunk/rtl/win/wininc/ascfun.inc
M /trunk/rtl/win/wininc/unidef.inc
M /trunk/rtl/win/wininc/unifun.inc

* wvsprintf* to stdcall, mantis #21591
--This line, and those below, will be ignored--

M win/wininc/unidef.inc
M win/wininc/ascfun.inc
M win/wininc/ascdef.inc
M win/wininc/unifun.inc

------------------------------------------------------------------------
------------------------------------------------------------------------
r20683 | olivier | 2012-04-01 10:03:12 +0200 (Sun, 01 Apr 2012) | 3 lines
Changed paths:
M /trunk/rtl/haiku/i386/sighnd.inc
M /trunk/rtl/haiku/signal.inc
M /trunk/rtl/haiku/system.pp

* Updated haiku signal definitions to reflect changes made in Haiku
after alpha release 3.

------------------------------------------------------------------------
------------------------------------------------------------------------
r20690 | olivier | 2012-04-02 03:06:09 +0200 (Mon, 02 Apr 2012) | 3 lines
Changed paths:
M /trunk/rtl/haiku/system.pp

* Better signal configuration to handle correctly a second exception
like in test texception10.pp.

------------------------------------------------------------------------
------------------------------------------------------------------------
r20693 | marco | 2012-04-02 13:52:40 +0200 (Mon, 02 Apr 2012) | 2 lines
Changed paths:
M /trunk/packages/cdrom/src/fpcddb.pp

* Fixes newer protocol versions of year and genre, Mantis #21623

------------------------------------------------------------------------
------------------------------------------------------------------------
r20702 | olivier | 2012-04-04 01:59:50 +0200 (Wed, 04 Apr 2012) | 4 lines
Changed paths:
M /trunk/rtl/haiku/system.pp

* Some more signal tuning. Supporting SA_SIGINFO would require changing
types in SignalToRunError. I keep the old thing for now. This help pass
a few more tests that need proper support for floating point exceptions.

------------------------------------------------------------------------
------------------------------------------------------------------------
r20899 | marco | 2012-04-16 09:47:11 +0200 (Mon, 16 Apr 2012) | 3 lines
Changed paths:
M /trunk/packages/winunits-base/src/typelib.pas

* Patch from Ludo that fixes that Event handlers were only created for the first CoClass that used the shared events
Mantis #21779

------------------------------------------------------------------------

git-svn-id: branches/fixes_2_6@20982 -

marco 13 years ago
parent
commit
d99fa3868d

+ 2 - 0
.gitattributes

@@ -1783,6 +1783,8 @@ packages/fcl-base/src/win/fclel.res -text
 packages/fcl-base/src/win/fileinfo.pp svneol=native#text/plain
 packages/fcl-base/src/win/fileinfo.pp svneol=native#text/plain
 packages/fcl-base/src/wince/fileinfo.pp svneol=native#text/plain
 packages/fcl-base/src/wince/fileinfo.pp svneol=native#text/plain
 packages/fcl-base/src/wtex.pp svneol=native#text/plain
 packages/fcl-base/src/wtex.pp svneol=native#text/plain
+packages/fcl-base/tests/fclbase-unittests.pp svneol=native#text/plain
+packages/fcl-base/tests/tests_fptemplate.pp svneol=native#text/plain
 packages/fcl-base/texts/fptemplate.txt svneol=native#text/plain
 packages/fcl-base/texts/fptemplate.txt svneol=native#text/plain
 packages/fcl-db/Makefile svneol=native#text/plain
 packages/fcl-db/Makefile svneol=native#text/plain
 packages/fcl-db/Makefile.fpc svneol=native#text/plain
 packages/fcl-db/Makefile.fpc svneol=native#text/plain

+ 23 - 1
packages/cdrom/src/fpcddb.pp

@@ -12,6 +12,18 @@
     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
 
  **********************************************************************}
  **********************************************************************}
+
+{
+  Some notes:
+
+  Disc.Year and Disc.Genre only have values if proto = 5 or above as specified in the request.
+  With protocol 5 and under the responses are in ISO-8859-1. In version 6 it's UTF-8
+
+  A more complete explanation of the protocol can be found here:
+  http://ftp.freedb.org/pub/freedb/latest/CDDBPROTO
+
+
+}
 unit fpcddb;
 unit fpcddb;
 
 
 {$mode objfpc}{$H+}
 {$mode objfpc}{$H+}
@@ -64,6 +76,7 @@ Type
   private
   private
     FDiskID: Integer;
     FDiskID: Integer;
     FExtra: String;
     FExtra: String;
+    FGenre: String;
     FPerformer: String;
     FPerformer: String;
     FPlayOrder: String;
     FPlayOrder: String;
     FTitle: String;
     FTitle: String;
@@ -81,9 +94,10 @@ Type
     Property IntDiscID : Integer Read FDiskID Write FDiskID;
     Property IntDiscID : Integer Read FDiskID Write FDiskID;
   Published
   Published
     Property PlayOrder : String Read FPlayOrder Write FPlayOrder;
     Property PlayOrder : String Read FPlayOrder Write FPlayOrder;
-    Property Year : Word Read FYear Write FYear;
+    Property Year : Word Read FYear Write FYear; // proto=5
     Property Title : String Read FTitle Write FTitle;
     Property Title : String Read FTitle Write FTitle;
     Property Performer : String Read FPerformer Write FPerformer;
     Property Performer : String Read FPerformer Write FPerformer;
+    Property Genre : String Read FGenre write FGenre; //proto=5
     Property Extra : String Read FExtra Write FExtra;
     Property Extra : String Read FExtra Write FExtra;
     Property DiscID : String Read GetDiskID Write SetDiskID;
     Property DiscID : String Read GetDiskID Write SetDiskID;
     property Tracks : TCDTracks Read FTracks Write SetTracks;
     property Tracks : TCDTracks Read FTracks Write SetTracks;
@@ -444,6 +458,14 @@ begin
               FDisk.Title:=T;
               FDisk.Title:=T;
               FDisk.Performer:=A;
               FDisk.Performer:=A;
               end
               end
+            else if (L='DYEAR') then
+              begin
+              FDisk.Year:=StrToIntDef(Trim(Args),0);
+              end
+            else if (L='DGENRE') then
+              begin
+              FDisk.Genre:=Trim(Args);
+              end
             else if (L='EXTD') then
             else if (L='EXTD') then
               ParseExtraDiskData(Args)
               ParseExtraDiskData(Args)
             else if (Copy(L,1,6)='TTITLE') then
             else if (Copy(L,1,6)='TTITLE') then

+ 16 - 10
packages/fcl-base/src/fptemplate.pp

@@ -410,6 +410,8 @@ begin
         IsFirst := false;
         IsFirst := false;
         I := 1;
         I := 1;
         while not (P[I] in [#0..' ']) do Inc(I);
         while not (P[I] in [#0..' ']) do Inc(I);
+        if i>(TS-SP) then
+          i := TS-SP;
         SetLength(TP, I);
         SetLength(TP, I);
         Move(P^, TP[1], I);
         Move(P^, TP[1], I);
       end;
       end;
@@ -423,16 +425,20 @@ begin
         Move(TS^, PName[1], I);//param name
         Move(TS^, PName[1], I);//param name
         inc(TS, Length(FParamValueSeparator) + I);
         inc(TS, Length(FParamValueSeparator) + I);
         I := TS - P;//index of param value
         I := TS - P;//index of param value
-        TE:=FindDelimiter(TS,FParamEndDelimiter, SLen-I+1);
-        if (TE<>Nil) then
-        begin//Found param end
-          I:=TE-TS;//Param length
-          Setlength(PValue,I);
-          Move(TS^,PValue[1],I);//Param value
+      end;
+
+      TE:=FindDelimiter(TS,FParamEndDelimiter, SLen-I+1);
+      if (TE<>Nil) then
+      begin//Found param end
+        I:=TE-TS;//Param length
+        Setlength(PValue,I);
+        Move(TS^,PValue[1],I);//Param value
+        if TM=nil then
+          TagParams.Add(Trim(PValue))
+        else
           TagParams.Add(Trim(PName) + '=' + PValue);//Param names cannot contain '='
           TagParams.Add(Trim(PName) + '=' + PValue);//Param names cannot contain '='
-          P:=TE+Length(FParamEndDelimiter);
-          TS:=P;
-        end else break;
+        P:=TE+Length(FParamEndDelimiter);
+        TS:=P;
       end else break;
       end else break;
     end else break;
     end else break;
   end;
   end;
@@ -472,6 +478,7 @@ begin
       else
       else
         begin
         begin
         I:=TS-P;
         I:=TS-P;
+        inc(TS,Length(FStartDelimiter));//points to first char of Tag name now
         TE:=FindDelimiter(TS,FEndDelimiter,SLen-I+1);
         TE:=FindDelimiter(TS,FEndDelimiter,SLen-I+1);
         If (TE=Nil) then
         If (TE=Nil) then
           begin//Tag End Delimiter not found
           begin//Tag End Delimiter not found
@@ -483,7 +490,6 @@ begin
           // Add text prior to template tag to result
           // Add text prior to template tag to result
           AddToString(Result,P,I);
           AddToString(Result,P,I);
           // Retrieve the full template tag (only tag name if no params specified)
           // Retrieve the full template tag (only tag name if no params specified)
-          inc(TS,Length(FStartDelimiter));//points to first char of Tag name now
           I:=TE-TS;//full Tag length
           I:=TE-TS;//full Tag length
           Setlength(PN,I);
           Setlength(PN,I);
           Move(TS^,PN[1],I);//full Tag string (only tag name if no params specified)
           Move(TS^,PN[1],I);//full Tag string (only tag name if no params specified)

+ 17 - 0
packages/fcl-base/tests/fclbase-unittests.pp

@@ -0,0 +1,17 @@
+program fclbase_unittests;
+
+{$mode objfpc}{$H+}
+
+uses
+  Classes, consoletestrunner, tests_fptemplate;
+
+var
+  Application: TTestRunner;
+
+begin
+  Application := TTestRunner.Create(nil);
+  Application.Initialize;
+  Application.Title := 'FCL-Base unittests';
+  Application.Run;
+  Application.Free;
+end.

+ 192 - 0
packages/fcl-base/tests/tests_fptemplate.pp

@@ -0,0 +1,192 @@
+unit tests_fptemplate;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, fpcunit, testutils, testregistry;
+
+type
+
+  { TTestTemplateParser }
+
+  TTestTemplateParser= class(TTestCase)
+  private
+    Procedure TestAllowTagParamsBasics_replacetag(Sender : TObject; Const TagString : String; TagParams:TStringList; Out ReplaceText : String);
+    Procedure TestAllowTagParamsFunctionLike_replacetag(Sender : TObject; Const TagString : String; TagParams:TStringList; Out ReplaceText : String);
+    Procedure TestAllowTagParamsDelphiStyle_replacetag(Sender : TObject; Const TagString : String; TagParams:TStringList; Out ReplaceText : String);
+  published
+    procedure TestBasics;
+    procedure TestBasicDelimiters;
+    procedure TestAllowTagParamsBasics;
+    procedure TestAllowTagParamsFunctionLike;
+    procedure TestAllowTagParamsDelphiStyle;
+  end;
+
+implementation
+
+uses
+  fpTemplate;
+
+procedure TTestTemplateParser.TestBasics;
+var
+  templ: TTemplateParser;
+begin
+  templ := TTemplateParser.Create;
+  try
+    templ.Values['dream'] := 'think';
+    templ.Values['test'] := 'template';
+    CheckEquals('This is the simplest template I could think of.',
+                 templ.ParseString('This is the simplest {test} I could {dream} of.'));
+
+    templ.recursive := true;
+    templ.Values['val2'] := 'template';
+    templ.Values['test'] := '{val2} test';
+    CheckEquals('This is the simplest template test I could think of.',
+               templ.ParseString('This is the simplest {test} I could {dream} of.'));
+
+  finally
+    templ.free;
+  end;
+end;
+
+procedure TTestTemplateParser.TestBasicDelimiters;
+var
+  templ: TTemplateParser;
+begin
+  templ := TTemplateParser.Create;
+  try
+    templ.StartDelimiter:='[-';
+    templ.EndDelimiter:=')';
+    templ.Values['dream'] := 'think';
+    templ.Values['test'] := 'template';
+    CheckEquals('This is [the] simplest template I could think (of).',
+                 templ.ParseString('This is [the] simplest [-test) I could [-dream) (of).'));
+
+
+    templ.StartDelimiter:='(';
+    templ.EndDelimiter:='-)';
+    templ.Values['dream'] := 'think';
+    templ.Values['test'] := 'template';
+    CheckEquals('This is [the] simplest template I could think of:-).',
+                 templ.ParseString('This is [the] simplest (test-) I could (dream-) of:-).'));
+
+
+  finally
+    templ.free;
+  end;
+end;
+
+procedure TTestTemplateParser.TestAllowTagParamsBasics;
+var
+  templ: TTemplateParser;
+begin
+  templ := TTemplateParser.Create;
+  try
+    templ.AllowTagParams := true;
+    templ.OnReplaceTag := @TestAllowTagParamsBasics_replacetag;
+    CheckEquals('This is the simplest template I could think of.',
+                 templ.ParseString('This is the simplest {test [- param1=test -]} I could {dream} of.'));
+
+    CheckEquals('This is the simplest template I could think of.',
+                 templ.ParseString('This is the simplest {test[- param1=test -]} I could {dream} of.'));
+
+    templ.ParamValueSeparator:=':';
+    CheckEquals('This is the simplest template I could think of.',
+                 templ.ParseString('This is the simplest {test [- param1:test -]} I could {dream} of.'));
+
+    CheckEquals('This is the simplest template I could think of.',
+                 templ.ParseString('This is the simplest {test [-param1:test -]} I could {dream} of.'));
+
+    CheckEquals('This is the simplest template I could think of.',
+                 templ.ParseString('This is the simplest {test  [-param1:test -]} I could {dream} of.'));
+
+  finally
+    templ.free;
+  end;
+end;
+
+procedure TTestTemplateParser.TestAllowTagParamsFunctionLike;
+var
+  templ: TTemplateParser;
+begin
+  templ := TTemplateParser.Create;
+  try
+    templ.AllowTagParams := true;
+    templ.ParamStartDelimiter:='(';
+    templ.ParamEndDelimiter:=')';
+    templ.OnReplaceTag := @TestAllowTagParamsFunctionLike_replacetag;
+
+    CheckEquals('THIS should be uppercased.',
+                 templ.ParseString('{uppercase(This)} should be uppercased.'));
+  finally
+    templ.free;
+  end;
+end;
+
+procedure TTestTemplateParser.TestAllowTagParamsDelphiStyle;
+var
+  templ: TTemplateParser;
+begin
+  templ := TTemplateParser.Create;
+  try
+    templ.AllowTagParams := true;
+    templ.StartDelimiter:='<#';
+    templ.EndDelimiter:='>';
+    templ.ParamStartDelimiter:=' ';
+    templ.ParamEndDelimiter:='"';
+    templ.ParamValueSeparator:='="';
+    templ.OnReplaceTag := @TestAllowTagParamsDelphiStyle_replacetag;
+
+    CheckEquals('Test for a Delphi parameter.',
+                 templ.ParseString('Test for a <#DelphiTag param1="first param" param2="second param">.'));
+  finally
+    templ.free;
+  end;
+end;
+
+procedure TTestTemplateParser.TestAllowTagParamsBasics_replacetag(
+  Sender: TObject; const TagString: String; TagParams: TStringList; out
+  ReplaceText: String);
+begin
+  if TagString='test' then
+    begin
+    CheckEquals(1,TagParams.Count);
+    CheckEquals('param1',TagParams.Names[0]);
+    CheckEquals('test ',TagParams.ValueFromIndex[0]);
+    ReplaceText := 'template'
+
+    end
+  else if TagString='dream' then ReplaceText := 'think';
+end;
+
+procedure TTestTemplateParser.TestAllowTagParamsFunctionLike_replacetag(
+  Sender: TObject; const TagString: String; TagParams: TStringList; out
+  ReplaceText: String);
+begin
+  if TagString='uppercase' then
+    begin
+    CheckEquals(1,TagParams.Count);
+    ReplaceText:=UpperCase(TagParams[0]);
+    end;
+end;
+
+procedure TTestTemplateParser.TestAllowTagParamsDelphiStyle_replacetag(
+  Sender: TObject; const TagString: String; TagParams: TStringList; out
+  ReplaceText: String);
+begin
+  CheckEquals(2,TagParams.Count);
+  CheckEquals('param1',TagParams.Names[0]);
+  CheckEquals('first param',TagParams.ValueFromIndex[0]);
+  CheckEquals('param2',TagParams.Names[1]);
+  CheckEquals('second param',TagParams.ValueFromIndex[1]);
+  ReplaceText := 'Delphi parameter'
+
+end;
+
+initialization
+
+  RegisterTest(TTestTemplateParser);
+end.
+

+ 6 - 2
packages/fcl-fpcunit/src/testutils.pp

@@ -64,6 +64,7 @@ end;
 
 
 procedure GetMethodList(AClass: TClass; AList: TStrings);
 procedure GetMethodList(AClass: TClass; AList: TStrings);
 type
 type
+  PMethodNameRec = ^TMethodNameRec;
   TMethodNameRec = packed record
   TMethodNameRec = packed record
     name : pshortstring;
     name : pshortstring;
     addr : pointer;
     addr : pointer;
@@ -81,6 +82,7 @@ var
   i : dword;
   i : dword;
   vmt: TClass;
   vmt: TClass;
   idx: integer;
   idx: integer;
+  pmr: PMethodNameRec;
 begin
 begin
   AList.Clear;
   AList.Clear;
   vmt := aClass;
   vmt := aClass;
@@ -89,13 +91,15 @@ begin
     methodTable := pMethodNameTable((Pointer(vmt) + vmtMethodTable)^);
     methodTable := pMethodNameTable((Pointer(vmt) + vmtMethodTable)^);
     if assigned(MethodTable) then
     if assigned(MethodTable) then
     begin
     begin
+      pmr := @methodTable^.entries[0];
       for i := 0 to MethodTable^.count - 1 do
       for i := 0 to MethodTable^.count - 1 do
       begin
       begin
-        idx := aList.IndexOf(MethodTable^.entries[i].name^);
+        idx := aList.IndexOf(pmr^.name^);
         if (idx <> - 1) then
         if (idx <> - 1) then
         //found overridden method so delete it
         //found overridden method so delete it
           aList.Delete(idx);
           aList.Delete(idx);
-        aList.AddObject(MethodTable^.entries[i].name^, TObject(MethodTable^.entries[i].addr));
+        aList.AddObject(pmr^.name^, TObject(pmr^.addr));
+        Inc(pmr);
       end;
       end;
     end;
     end;
     vmt := pClass(pointer(vmt) + vmtParent)^;
     vmt := pClass(pointer(vmt) + vmtParent)^;

+ 139 - 42
packages/opengl/src/glx.pp

@@ -37,7 +37,7 @@ interface
 
 
 {$IFDEF Unix}
 {$IFDEF Unix}
   uses
   uses
-    X, XLib, XUtil;
+    ctypes, X, XLib, XUtil;
   {$DEFINE HasGLX}  // Activate GLX stuff
   {$DEFINE HasGLX}  // Activate GLX stuff
 {$ELSE}
 {$ELSE}
   {$MESSAGE Unsupported platform.}
   {$MESSAGE Unsupported platform.}
@@ -237,50 +237,50 @@ type
   TGLXPbuffer = TXID;
   TGLXPbuffer = TXID;
 
 
 var
 var
-  glXChooseVisual: function(dpy: PDisplay; screen: Integer; attribList: PInteger): PXVisualInfo; cdecl;
-  glXCreateContext: function(dpy: PDisplay; vis: PXVisualInfo; shareList: GLXContext; direct: Boolean): GLXContext; cdecl;
+  glXChooseVisual: function(dpy: PDisplay; screen: cint; attribList: Pcint): PXVisualInfo; cdecl;
+  //glXCreateContext -> internal_glXCreateContext in implementation
   glXDestroyContext: procedure(dpy: PDisplay; ctx: GLXContext); cdecl;
   glXDestroyContext: procedure(dpy: PDisplay; ctx: GLXContext); cdecl;
-  glXMakeCurrent: function(dpy: PDisplay; drawable: GLXDrawable; ctx: GLXContext): Boolean; cdecl;
-  glXCopyContext: procedure(dpy: PDisplay; src, dst: GLXContext; mask: LongWord); cdecl;
+  glXMakeCurrent: function(dpy: PDisplay; drawable: GLXDrawable; ctx: GLXContext): TBoolResult; cdecl;
+  glXCopyContext: procedure(dpy: PDisplay; src, dst: GLXContext; mask: culong); cdecl;
   glXSwapBuffers: procedure(dpy: PDisplay; drawable: GLXDrawable); cdecl;
   glXSwapBuffers: procedure(dpy: PDisplay; drawable: GLXDrawable); cdecl;
   glXCreateGLXPixmap: function(dpy: PDisplay; visual: PXVisualInfo; pixmap: XPixmap): GLXPixmap; cdecl;
   glXCreateGLXPixmap: function(dpy: PDisplay; visual: PXVisualInfo; pixmap: XPixmap): GLXPixmap; cdecl;
   glXDestroyGLXPixmap: procedure(dpy: PDisplay; pixmap: GLXPixmap); cdecl;
   glXDestroyGLXPixmap: procedure(dpy: PDisplay; pixmap: GLXPixmap); cdecl;
-  glXQueryExtension: function(dpy: PDisplay; var errorb, event: Integer): Boolean; cdecl;
-  glXQueryVersion: function(dpy: PDisplay; var maj, min: Integer): Boolean; cdecl;
-  glXIsDirect: function(dpy: PDisplay; ctx: GLXContext): Boolean; cdecl;
-  glXGetConfig: function(dpy: PDisplay; visual: PXVisualInfo; attrib: Integer; var value: Integer): Integer; cdecl;
+  glXQueryExtension: function(dpy: PDisplay; var errorb, event: cint): TBoolResult; cdecl;
+  glXQueryVersion: function(dpy: PDisplay; var maj, min: cint): TBoolResult; cdecl;
+  glXIsDirect: function(dpy: PDisplay; ctx: GLXContext): TBoolResult; cdecl;
+  glXGetConfig: function(dpy: PDisplay; visual: PXVisualInfo; attrib: cint; var value: cint): cint; cdecl;
   glXGetCurrentContext: function: GLXContext; cdecl;
   glXGetCurrentContext: function: GLXContext; cdecl;
   glXGetCurrentDrawable: function: GLXDrawable; cdecl;
   glXGetCurrentDrawable: function: GLXDrawable; cdecl;
   glXWaitGL: procedure; cdecl;
   glXWaitGL: procedure; cdecl;
   glXWaitX: procedure; cdecl;
   glXWaitX: procedure; cdecl;
-  glXUseXFont: procedure(font: XFont; first, count, list: Integer); cdecl;
+  glXUseXFont: procedure(font: XFont; first, count, list: cint); cdecl;
 
 
   // GLX 1.1 and later
   // GLX 1.1 and later
-  glXQueryExtensionsString: function(dpy: PDisplay; screen: Integer): PChar; cdecl;
-  glXQueryServerString: function(dpy: PDisplay; screen, name: Integer): PChar; cdecl;
-  glXGetClientString: function(dpy: PDisplay; name: Integer): PChar; cdecl;
+  glXQueryExtensionsString: function(dpy: PDisplay; screen: cint): PChar; cdecl;
+  glXQueryServerString: function(dpy: PDisplay; screen, name: cint): PChar; cdecl;
+  glXGetClientString: function(dpy: PDisplay; name: cint): PChar; cdecl;
 
 
   // GLX 1.2 and later
   // GLX 1.2 and later
   glXGetCurrentDisplay: function: PDisplay; cdecl;
   glXGetCurrentDisplay: function: PDisplay; cdecl;
 
 
   // GLX 1.3 and later
   // GLX 1.3 and later
-  glXChooseFBConfig: function(dpy: PDisplay; screen: Integer; attribList: PInteger; var nitems: Integer): PGLXFBConfig; cdecl;
-  glXGetFBConfigAttrib: function(dpy: PDisplay; config: TGLXFBConfig; attribute: Integer; var value: Integer): Integer; cdecl;
-  glXGetFBConfigs: function(dpy: PDisplay; screen: Integer; var nelements: Integer): PGLXFBConfig; cdecl;
+  glXChooseFBConfig: function(dpy: PDisplay; screen: cint; attribList: Pcint; var nitems: cint): PGLXFBConfig; cdecl;
+  glXGetFBConfigAttrib: function(dpy: PDisplay; config: TGLXFBConfig; attribute: cint; var value: cint): cint; cdecl;
+  glXGetFBConfigs: function(dpy: PDisplay; screen: cint; var nelements: cint): PGLXFBConfig; cdecl;
   glXGetVisualFromFBConfig: function(dpy: PDisplay; config: TGLXFBConfig): PXVisualInfo; cdecl;
   glXGetVisualFromFBConfig: function(dpy: PDisplay; config: TGLXFBConfig): PXVisualInfo; cdecl;
-  glXCreateWindow: function(dpy: PDisplay; config: TGLXFBConfig; win: X.TWindow; attribList: PInteger): TGLXWindow; cdecl;
+  glXCreateWindow: function(dpy: PDisplay; config: TGLXFBConfig; win: X.TWindow; attribList: Pcint): TGLXWindow; cdecl;
   glXDestroyWindow: procedure (dpy: PDisplay; window: TGLXWindow); cdecl;
   glXDestroyWindow: procedure (dpy: PDisplay; window: TGLXWindow); cdecl;
-  glXCreatePixmap: function(dpy: PDisplay; config: TGLXFBConfig; pixmap: TXPixmap; attribList: PInteger): TGLXPixmap; cdecl;
+  glXCreatePixmap: function(dpy: PDisplay; config: TGLXFBConfig; pixmap: TXPixmap; attribList: Pcint): TGLXPixmap; cdecl;
   glXDestroyPixmap: procedure (dpy: PDisplay; pixmap: TGLXPixmap); cdecl;
   glXDestroyPixmap: procedure (dpy: PDisplay; pixmap: TGLXPixmap); cdecl;
-  glXCreatePbuffer: function(dpy: PDisplay; config: TGLXFBConfig; attribList: PInteger): TGLXPbuffer; cdecl;
+  glXCreatePbuffer: function(dpy: PDisplay; config: TGLXFBConfig; attribList: Pcint): TGLXPbuffer; cdecl;
   glXDestroyPbuffer: procedure (dpy: PDisplay; pbuf: TGLXPbuffer); cdecl;
   glXDestroyPbuffer: procedure (dpy: PDisplay; pbuf: TGLXPbuffer); cdecl;
-  glXQueryDrawable: procedure (dpy: PDisplay; draw: TGLXDrawable; attribute: Integer; value: PLongWord); cdecl;
-  glXCreateNewContext: function(dpy: PDisplay; config: TGLXFBConfig; renderType: Integer; shareList: TGLXContext; direct: boolean): TGLXContext; cdecl;
-  glXMakeContextCurrent: function(dpy: PDisplay; draw: TGLXDrawable; read: GLXDrawable; ctx: TGLXContext): boolean; cdecl;
+  glXQueryDrawable: procedure (dpy: PDisplay; draw: TGLXDrawable; attribute: cint; value: Pcuint); cdecl;
+  //glXCreateNewContext -> internal_glXCreateNewContext in implementation
+  glXMakeContextCurrent: function(dpy: PDisplay; draw: TGLXDrawable; read: GLXDrawable; ctx: TGLXContext): TBoolResult; cdecl;
   glXGetCurrentReadDrawable: function: TGLXDrawable; cdecl;
   glXGetCurrentReadDrawable: function: TGLXDrawable; cdecl;
-  glXQueryContext: function(dpy: PDisplay; ctx: TGLXContext; attribute: Integer; var value: Integer): Integer; cdecl;
-  glXSelectEvent: procedure (dpy: PDisplay; drawable: TGLXDrawable; mask: LongWord); cdecl;
-  glXGetSelectedEvent: procedure (dpy: PDisplay; drawable: TGLXDrawable; mask: PLongWord); cdecl;
+  glXQueryContext: function(dpy: PDisplay; ctx: TGLXContext; attribute: cint; var value: cint): cint; cdecl;
+  glXSelectEvent: procedure (dpy: PDisplay; drawable: TGLXDrawable; mask: culong); cdecl;
+  glXGetSelectedEvent: procedure (dpy: PDisplay; drawable: TGLXDrawable; mask: Pculong); cdecl;
 
 
   // GLX 1.4 and later
   // GLX 1.4 and later
   glXGetProcAddress: function(procname: PChar): Pointer; cdecl;
   glXGetProcAddress: function(procname: PChar): Pointer; cdecl;
@@ -291,23 +291,38 @@ var
   glXGetProcAddressARB: function(procname: PChar): Pointer; cdecl;
   glXGetProcAddressARB: function(procname: PChar): Pointer; cdecl;
 
 
   // GLX_ARB_create_context
   // GLX_ARB_create_context
-  glXCreateContextAttribsARB: function (dpy: PDisplay; config: TGLXFBConfig; share_context: TGLXContext; direct: boolean; attrib_list: PInteger): TGLXContext; cdecl;
+  //glXCreateContextAttribsARB -> internal_glXCreateContextAttribsARB in implementation
+
+  // GLX_EXT_swap_control
+  glXSwapIntervalEXT: function(dpy: PDisplay; drawable: TGLXDrawable; interval: cint): cint; cdecl;
 
 
   // GLX_MESA_pixmap_colormap
   // GLX_MESA_pixmap_colormap
   glXCreateGLXPixmapMESA: function(dpy: PDisplay; visual: PXVisualInfo; pixmap: XPixmap; cmap: XColormap): GLXPixmap; cdecl;
   glXCreateGLXPixmapMESA: function(dpy: PDisplay; visual: PXVisualInfo; pixmap: XPixmap; cmap: XColormap): GLXPixmap; cdecl;
 
 
+  // GLX_MESA_swap_control
+  glXSwapIntervalMESA: function(interval: cuint): cint; cdecl;
+  glXGetSwapIntervalMESA: function: cint; cdecl;
+
   // Unknown Mesa GLX extension (undocumented in current GLX C headers?)
   // Unknown Mesa GLX extension (undocumented in current GLX C headers?)
-  glXReleaseBufferMESA: function(dpy: PDisplay; d: GLXDrawable): Boolean; cdecl;
-  glXCopySubBufferMESA: procedure(dpy: PDisplay; drawbale: GLXDrawable; x, y, width, height: Integer); cdecl;
+  glXReleaseBuffersMESA: function(dpy: PDisplay; d: GLXDrawable): TBoolResult; cdecl;
+  glXCopySubBufferMESA: procedure(dpy: PDisplay; drawable: GLXDrawable; x, y, width, height: cint); cdecl;
+
+  // GLX_SGI_swap_control
+  glXSwapIntervalSGI: function(interval: cint): cint; cdecl;
 
 
   // GLX_SGI_video_sync
   // GLX_SGI_video_sync
-  glXGetVideoSyncSGI: function(var counter: LongWord): Integer; cdecl;
-  glXWaitVideoSyncSGI: function(divisor, remainder: Integer; var count: LongWord): Integer; cdecl;
+  glXGetVideoSyncSGI: function(var count: cuint): cint; cdecl;
+  glXWaitVideoSyncSGI: function(divisor, remainder: cint; var count: cuint): cint; cdecl;
 
 
 // =======================================================
 // =======================================================
 //
 //
 // =======================================================
 // =======================================================
 
 
+// Overloaded functions to handle TBool parameters as actual booleans.
+function glXCreateContext(dpy: PDisplay; vis: PXVisualInfo; shareList: GLXContext; direct: Boolean): GLXContext;
+function glXCreateNewContext(dpy: PDisplay; config: TGLXFBConfig; renderType: cint; shareList: TGLXContext; direct: Boolean): TGLXContext;
+function glXCreateContextAttribsARB(dpy: PDisplay; config: TGLXFBConfig; share_context: TGLXContext; direct: Boolean; attrib_list: Pcint): TGLXContext;
+
 {
 {
   Safe checking of glX version and extension presence.
   Safe checking of glX version and extension presence.
 
 
@@ -344,8 +359,11 @@ function GLX_ARB_create_context(Display: PDisplay; Screen: Integer): boolean;
 function GLX_ARB_create_context_profile(Display: PDisplay; Screen: Integer): boolean;
 function GLX_ARB_create_context_profile(Display: PDisplay; Screen: Integer): boolean;
 function GLX_ARB_create_context_robustness(Display: PDisplay; Screen: Integer): boolean;
 function GLX_ARB_create_context_robustness(Display: PDisplay; Screen: Integer): boolean;
 function GLX_ARB_multisample(Display: PDisplay; Screen: Integer): boolean;
 function GLX_ARB_multisample(Display: PDisplay; Screen: Integer): boolean;
+function GLX_EXT_swap_control(Display: PDisplay; Screen: Integer): boolean;
 function GLX_EXT_visual_info(Display: PDisplay; Screen: Integer): boolean;
 function GLX_EXT_visual_info(Display: PDisplay; Screen: Integer): boolean;
 function GLX_MESA_pixmap_colormap(Display: PDisplay; Screen: Integer): boolean;
 function GLX_MESA_pixmap_colormap(Display: PDisplay; Screen: Integer): boolean;
+function GLX_MESA_swap_control(Display: PDisplay; Screen: Integer): boolean;
+function GLX_SGI_swap_control(Display: PDisplay; Screen: Integer): boolean;
 function GLX_SGI_video_sync(Display: PDisplay; Screen: Integer): boolean;
 function GLX_SGI_video_sync(Display: PDisplay; Screen: Integer): boolean;
 function GLX_SGIS_multisample(Display: PDisplay; Screen: Integer): boolean;
 function GLX_SGIS_multisample(Display: PDisplay; Screen: Integer): boolean;
 
 
@@ -355,6 +373,26 @@ uses GL, dynlibs, GLExt { for glext_ExtensionSupported utility };
 
 
 {$LINKLIB m}
 {$LINKLIB m}
 
 
+var
+  internal_glXCreateContext: function(dpy: PDisplay; vis: PXVisualInfo; shareList: GLXContext; direct: TBool): GLXContext; cdecl;
+  internal_glXCreateNewContext: function(dpy: PDisplay; config: TGLXFBConfig; renderType: cint; shareList: TGLXContext; direct: TBool): TGLXContext; cdecl;
+  internal_glXCreateContextAttribsARB: function (dpy: PDisplay; config: TGLXFBConfig; share_context: TGLXContext; direct: TBool; attrib_list: Pcint): TGLXContext; cdecl;
+
+function glXCreateContext(dpy: PDisplay; vis: PXVisualInfo; shareList: GLXContext; direct: Boolean): GLXContext;
+begin
+  Result := internal_glXCreateContext(dpy, vis, shareList, Ord(direct));
+end;
+
+function glXCreateNewContext(dpy: PDisplay; config: TGLXFBConfig; renderType: cint; shareList: TGLXContext; direct: Boolean): TGLXContext;
+begin
+  Result := internal_glXCreateNewContext(dpy, config, renderType, shareList, Ord(direct));
+end;
+
+function glXCreateContextAttribsARB(dpy: PDisplay; config: TGLXFBConfig; share_context: TGLXContext; direct: Boolean; attrib_list: Pcint): TGLXContext;
+begin
+  Result := internal_glXCreateContextAttribsARB(dpy, config, share_context, Ord(direct), attrib_list);
+end;
+
 function GLX_version_1_0(Display: PDisplay): boolean;
 function GLX_version_1_0(Display: PDisplay): boolean;
 var
 var
   IgnoredErrorb, IgnoredEvent, Major, Minor: Integer;
   IgnoredErrorb, IgnoredEvent, Major, Minor: Integer;
@@ -369,7 +407,7 @@ begin
     (Major >= 1) and
     (Major >= 1) and
     { check entry points assigned }
     { check entry points assigned }
     Assigned(glXChooseVisual) and
     Assigned(glXChooseVisual) and
-    Assigned(glXCreateContext) and
+    Assigned(internal_glXCreateContext) and
     Assigned(glXDestroyContext) and
     Assigned(glXDestroyContext) and
     Assigned(glXMakeCurrent) and
     Assigned(glXMakeCurrent) and
     Assigned(glXCopyContext) and
     Assigned(glXCopyContext) and
@@ -439,7 +477,7 @@ begin
     Assigned(glXCreatePbuffer) and
     Assigned(glXCreatePbuffer) and
     Assigned(glXDestroyPbuffer) and
     Assigned(glXDestroyPbuffer) and
     Assigned(glXQueryDrawable) and
     Assigned(glXQueryDrawable) and
-    Assigned(glXCreateNewContext) and
+    Assigned(internal_glXCreateNewContext) and
     Assigned(glXMakeContextCurrent) and
     Assigned(glXMakeContextCurrent) and
     Assigned(glXGetCurrentReadDrawable) and
     Assigned(glXGetCurrentReadDrawable) and
     Assigned(glXQueryContext) and
     Assigned(glXQueryContext) and
@@ -483,7 +521,7 @@ begin
   begin
   begin
     GlxExtensions := glXQueryExtensionsString(Display, Screen);
     GlxExtensions := glXQueryExtensionsString(Display, Screen);
     Result := glext_ExtensionSupported('GLX_ARB_create_context', GlxExtensions) and
     Result := glext_ExtensionSupported('GLX_ARB_create_context', GlxExtensions) and
-      Assigned(glXCreateContextAttribsARB);
+      Assigned(internal_glXCreateContextAttribsARB);
   end;
   end;
 end;
 end;
 
 
@@ -523,6 +561,19 @@ begin
   end;
   end;
 end;
 end;
 
 
+function GLX_EXT_swap_control(Display: PDisplay; Screen: Integer): boolean;
+var
+  GlxExtensions: PChar;
+begin
+  Result := GLX_version_1_1(Display);
+  if Result then
+  begin
+    GlxExtensions := glXQueryExtensionsString(Display, Screen);
+    Result := glext_ExtensionSupported('GLX_EXT_swap_control', GlxExtensions) and
+      Assigned(glXSwapIntervalEXT);
+  end;
+end;
+
 function GLX_EXT_visual_info(Display: PDisplay; Screen: Integer): boolean;
 function GLX_EXT_visual_info(Display: PDisplay; Screen: Integer): boolean;
 var
 var
   GlxExtensions: PChar;
   GlxExtensions: PChar;
@@ -548,6 +599,33 @@ begin
   end;
   end;
 end;
 end;
 
 
+function GLX_MESA_swap_control(Display: PDisplay; Screen: Integer): boolean;
+var
+  GlxExtensions: PChar;
+begin
+  Result := GLX_version_1_1(Display);
+  if Result then
+  begin
+    GlxExtensions := glXQueryExtensionsString(Display, Screen);
+    Result := glext_ExtensionSupported('GLX_MESA_swap_control', GlxExtensions) and
+      Assigned(glXSwapIntervalMESA) and
+      Assigned(glXGetSwapIntervalMESA);
+  end;
+end;
+
+function GLX_SGI_swap_control(Display: PDisplay; Screen: Integer): boolean;
+var
+  GlxExtensions: PChar;
+begin
+  Result := GLX_version_1_1(Display);
+  if Result then
+  begin
+    GlxExtensions := glXQueryExtensionsString(Display, Screen);
+    Result := glext_ExtensionSupported('GLX_SGI_swap_control', GlxExtensions) and
+      Assigned(glXSwapIntervalSGI);
+  end;
+end;
+
 function GLX_SGI_video_sync(Display: PDisplay; Screen: Integer): boolean;
 function GLX_SGI_video_sync(Display: PDisplay; Screen: Integer): boolean;
 var
 var
   GlxExtensions: PChar;
   GlxExtensions: PChar;
@@ -576,7 +654,13 @@ end;
 
 
 function GetProc(handle: PtrInt; name: PChar): Pointer;
 function GetProc(handle: PtrInt; name: PChar): Pointer;
 begin
 begin
-  Result := GetProcAddress(handle, name);
+  if Assigned(glXGetProcAddress) then
+    Result := glXGetProcAddress(name)
+  else
+    if Assigned(glXGetProcAddressARB) then
+      Result := glXGetProcAddressARB(name)
+    else
+      Result := GetProcAddress(handle, name);
   if (Result = nil) and GLXDumpUnresolvedFunctions then
   if (Result = nil) and GLXDumpUnresolvedFunctions then
     WriteLn('Unresolved: ', name);
     WriteLn('Unresolved: ', name);
 end;
 end;
@@ -596,8 +680,18 @@ begin
   if OurLibGL = 0 then
   if OurLibGL = 0 then
     exit;
     exit;
 
 
+  // glXGetProcAddress and glXGetProcAddressARB are imported first,
+  // so we can use them (when they are available) to resolve all the
+  // other imports
+
+  // GLX 1.4 and later
+  glXGetProcAddress := GetProc(OurLibGL, 'glXGetProcAddress');
+  // GLX_ARB_get_proc_address
+  glXGetProcAddressARB := GetProc(OurLibGL, 'glXGetProcAddressARB');
+
+  // GLX 1.0
   glXChooseVisual := GetProc(OurLibGL, 'glXChooseVisual');
   glXChooseVisual := GetProc(OurLibGL, 'glXChooseVisual');
-  glXCreateContext := GetProc(OurLibGL, 'glXCreateContext');
+  internal_glXCreateContext := GetProc(OurLibGL, 'glXCreateContext');
   glXDestroyContext := GetProc(OurLibGL, 'glXDestroyContext');
   glXDestroyContext := GetProc(OurLibGL, 'glXDestroyContext');
   glXMakeCurrent := GetProc(OurLibGL, 'glXMakeCurrent');
   glXMakeCurrent := GetProc(OurLibGL, 'glXMakeCurrent');
   glXCopyContext := GetProc(OurLibGL, 'glXCopyContext');
   glXCopyContext := GetProc(OurLibGL, 'glXCopyContext');
@@ -631,24 +725,27 @@ begin
   glXCreatePbuffer := GetProc(OurLibGL, 'glXCreatePbuffer');
   glXCreatePbuffer := GetProc(OurLibGL, 'glXCreatePbuffer');
   glXDestroyPbuffer := GetProc(OurLibGL, 'glXDestroyPbuffer');
   glXDestroyPbuffer := GetProc(OurLibGL, 'glXDestroyPbuffer');
   glXQueryDrawable := GetProc(OurLibGL, 'glXQueryDrawable');
   glXQueryDrawable := GetProc(OurLibGL, 'glXQueryDrawable');
-  glXCreateNewContext := GetProc(OurLibGL, 'glXCreateNewContext');
+  internal_glXCreateNewContext := GetProc(OurLibGL, 'glXCreateNewContext');
   glXMakeContextCurrent := GetProc(OurLibGL, 'glXMakeContextCurrent');
   glXMakeContextCurrent := GetProc(OurLibGL, 'glXMakeContextCurrent');
   glXGetCurrentReadDrawable := GetProc(OurLibGL, 'glXGetCurrentReadDrawable');
   glXGetCurrentReadDrawable := GetProc(OurLibGL, 'glXGetCurrentReadDrawable');
   glXQueryContext := GetProc(OurLibGL, 'glXQueryContext');
   glXQueryContext := GetProc(OurLibGL, 'glXQueryContext');
   glXSelectEvent := GetProc(OurLibGL, 'glXSelectEvent');
   glXSelectEvent := GetProc(OurLibGL, 'glXSelectEvent');
   glXGetSelectedEvent := GetProc(OurLibGL, 'glXGetSelectedEvent');
   glXGetSelectedEvent := GetProc(OurLibGL, 'glXGetSelectedEvent');
-  // GLX 1.4 and later
-  glXGetProcAddress := GetProc(OurLibGL, 'glXGetProcAddress');
   // Extensions
   // Extensions
-  // GLX_ARB_get_proc_address
-  glXGetProcAddressARB := GetProc(OurLibGL, 'glXGetProcAddressARB');
   // GLX_ARB_create_context
   // GLX_ARB_create_context
-  glXCreateContextAttribsARB := GetProc(OurLibGL, 'glXCreateContextAttribsARB');
+  internal_glXCreateContextAttribsARB := GetProc(OurLibGL, 'glXCreateContextAttribsARB');
+  // GLX_EXT_swap_control
+  glXSwapIntervalEXT := GetProc(OurLibGL, 'glXSwapIntervalEXT');
   // GLX_MESA_pixmap_colormap
   // GLX_MESA_pixmap_colormap
   glXCreateGLXPixmapMESA := GetProc(OurLibGL, 'glXCreateGLXPixmapMESA');
   glXCreateGLXPixmapMESA := GetProc(OurLibGL, 'glXCreateGLXPixmapMESA');
+  // GLX_MESA_swap_control
+  glXSwapIntervalMESA := GetProc(OurLibGL, 'glXSwapIntervalMESA');
+  glXGetSwapIntervalMESA := GetProc(OurLibGL, 'glXGetSwapIntervalMESA');
   // Unknown Mesa GLX extension
   // Unknown Mesa GLX extension
-  glXReleaseBufferMESA := GetProc(OurLibGL, 'glXReleaseBufferMESA');
+  glXReleaseBuffersMESA := GetProc(OurLibGL, 'glXReleaseBuffersMESA');
   glXCopySubBufferMESA := GetProc(OurLibGL, 'glXCopySubBufferMESA');
   glXCopySubBufferMESA := GetProc(OurLibGL, 'glXCopySubBufferMESA');
+  // GLX_SGI_swap_control
+  glXSwapIntervalSGI := GetProc(OurLibGL, 'glXSwapIntervalSGI');
   // GLX_SGI_video_sync
   // GLX_SGI_video_sync
   glXGetVideoSyncSGI := GetProc(OurLibGL, 'glXGetVideoSyncSGI');
   glXGetVideoSyncSGI := GetProc(OurLibGL, 'glXGetVideoSyncSGI');
   glXWaitVideoSyncSGI := GetProc(OurLibGL, 'glXWaitVideoSyncSGI');
   glXWaitVideoSyncSGI := GetProc(OurLibGL, 'glXWaitVideoSyncSGI');

+ 19 - 17
packages/winunits-base/src/typelib.pas

@@ -475,6 +475,14 @@ var
       end;
       end;
   end;
   end;
 
 
+  function GetName(i:integer):string;  //bug in Office10\MSacc.OLB _WizHook.Key
+  begin
+    if i<cnt then
+      result:=BL[i]
+    else
+      result:='Param'+inttostr(i);
+  end;
+
 begin
 begin
   Propertycnt:=0;
   Propertycnt:=0;
   SetLength(aPropertyDefs,TA^.cFuncs+TA^.cVars);   // worst case, all functions getters or all setters
   SetLength(aPropertyDefs,TA^.cFuncs+TA^.cVars);   // worst case, all functions getters or all setters
@@ -518,8 +526,6 @@ begin
       ((sl='gettypeinfocount') or (sl='gettypeinfo') or (sl='getidsofnames') or (sl='invoke')) then  //IDispatch
       ((sl='gettypeinfocount') or (sl='gettypeinfo') or (sl='getidsofnames') or (sl='invoke')) then  //IDispatch
       continue;
       continue;
     // get return type
     // get return type
-    if iname='DocumentProperty' then
-      sl:=sl;   //remove
     if bIsDispatch and ((FD^.invkind=INVOKE_PROPERTYGET) or (FD^.invkind=INVOKE_FUNC)) then
     if bIsDispatch and ((FD^.invkind=INVOKE_PROPERTYGET) or (FD^.invkind=INVOKE_FUNC)) then
       begin
       begin
       sType:=TypeToString(TI,FD^.elemdescFunc.tdesc);
       sType:=TypeToString(TI,FD^.elemdescFunc.tdesc);
@@ -590,8 +596,6 @@ begin
           sl:=TypeToString(TI,FD^.lprgelemdescParam[k].tdesc);
           sl:=TypeToString(TI,FD^.lprgelemdescParam[k].tdesc);
           bParamByRef:=(FD^.lprgelemdescParam[k].tdesc.vt=VT_PTR) and                         // by ref
           bParamByRef:=(FD^.lprgelemdescParam[k].tdesc.vt=VT_PTR) and                         // by ref
             not((FD^.lprgelemdescParam[k].tdesc.lptdesc^.vt=VT_USERDEFINED) and bIsInterface);// but not pointer to interface
             not((FD^.lprgelemdescParam[k].tdesc.lptdesc^.vt=VT_USERDEFINED) and bIsInterface);// but not pointer to interface
-          if BL[k+1]='pFormat' then
-            sl:=sl; //remove
           if bParamByRef then
           if bParamByRef then
              delete(sl,1,1);
              delete(sl,1,1);
           if bIsDispatch and not bIsAutomatable then
           if bIsDispatch and not bIsAutomatable then
@@ -606,8 +610,8 @@ begin
             PARAMFLAG_FOUT:sPar:='out ';
             PARAMFLAG_FOUT:sPar:='out ';
             PARAMFLAG_FIN:sPar:='var '; //constref in safecall? TBD
             PARAMFLAG_FIN:sPar:='var '; //constref in safecall? TBD
             end;
             end;
-          if not MakeValidId(BL[k+1],sVarName) then
-            AddToHeader('//  Warning: renamed parameter ''%s'' in %s.%s to ''%s''',[BL[k+1],iname,sMethodName,sVarName],True);
+          if not MakeValidId(GetName(k+1),sVarName) then
+            AddToHeader('//  Warning: renamed parameter ''%s'' in %s.%s to ''%s''',[GetName(k+1),iname,sMethodName,sVarName],True);
           sPar:=sPar+format('%s:%s;',[sVarName,sl]);
           sPar:=sPar+format('%s:%s;',[sVarName,sl]);
           sFunc:=sFunc+sPar;
           sFunc:=sFunc+sPar;
           if bCreateEvents then
           if bCreateEvents then
@@ -696,8 +700,8 @@ begin
         sPropParam2:='';
         sPropParam2:='';
         if bPropHasParam then
         if bPropHasParam then
           begin
           begin
-          if not MakeValidId(BL[1],sPropParam) then
-            AddToHeader('//  Warning: renamed property index  ''%s'' in %s.%s to ''%s''',[BL[1],iname,sMethodName,sPropParam]);
+          if not MakeValidId(GetName(1),sPropParam) then
+            AddToHeader('//  Warning: renamed property index  ''%s'' in %s.%s to ''%s''',[GetName(1),iname,sMethodName,sPropParam]);
           sPropParam:=sPropParam+':'+TypeToString(TI,FD^.lprgelemdescParam[0].tdesc);
           sPropParam:=sPropParam+':'+TypeToString(TI,FD^.lprgelemdescParam[0].tdesc);
           end;
           end;
         if bIsDispatch then
         if bIsDispatch then
@@ -734,8 +738,6 @@ begin
             sPropParam3:=sPropParam+'; const par'+sMethodName;
             sPropParam3:=sPropParam+'; const par'+sMethodName;
             sPropParam:='['+sPropParam+']';
             sPropParam:='['+sPropParam+']';
             end;
             end;
-          if sMethodName='SelectedItem' then
-            sl:=sl; //remove
           if FD^.invkind=INVOKE_PROPERTYGET then
           if FD^.invkind=INVOKE_PROPERTYGET then
             begin
             begin
             s:=s+format('   function Get_%s%s : %s; %s;'#13#10,[sMethodName,sPropParam2,sType,sConv]);
             s:=s+format('   function Get_%s%s : %s; %s;'#13#10,[sMethodName,sPropParam2,sType,sConv]);
@@ -752,8 +754,8 @@ begin
             end
             end
           else
           else
             begin
             begin
-            if not MakeValidId(BL[1],sVarName) then
-              AddToHeader('//  Warning: renamed parameter ''%s'' in %s.Set_%s to ''%s''',[BL[1],iname,sMethodName,sVarName]);
+            if not MakeValidId(GetName(1),sVarName) then
+              AddToHeader('//  Warning: renamed parameter ''%s'' in %s.Set_%s to ''%s''',[GetName(1),iname,sMethodName,sVarName]);
             with aPropertyDefs[findProperty(FD^.memid)] do
             with aPropertyDefs[findProperty(FD^.memid)] do
               begin
               begin
               if FD^.invkind=INVOKE_PROPERTYPUT then
               if FD^.invkind=INVOKE_PROPERTYPUT then
@@ -1350,7 +1352,7 @@ begin
           if (TA^.wTypeFlags and TYPEFLAG_FDUAL)=TYPEFLAG_FDUAL then
           if (TA^.wTypeFlags and TYPEFLAG_FDUAL)=TYPEFLAG_FDUAL then
             begin
             begin
             //get TKIND_INTERFACE
             //get TKIND_INTERFACE
-            OleCheck(TI.GetRefTypeOfImplType(-1,RTIT));
+            OleCheck(TI.GetRefTypeOfImplType($ffffffff,RTIT));
             OleCheck(TI.GetRefTypeInfo(RTIT,TIref));
             OleCheck(TI.GetRefTypeInfo(RTIT,TIref));
             //get its ancestor
             //get its ancestor
             OleCheck(TIref.GetRefTypeOfImplType(0,RTIT));
             OleCheck(TIref.GetRefTypeOfImplType(0,RTIT));
@@ -1478,10 +1480,10 @@ begin
             end;
             end;
           end;
           end;
         end;
         end;
-      if bIsDispatch and (sDefEvents<>'') then //add event signatures
+      if bIsDispatch and (sDefEvents<>'') and (FEventSignatures[idx]<>'already defined') then //add event signatures
         begin
         begin
         AddToInterface(FEventSignatures[idx]);
         AddToInterface(FEventSignatures[idx]);
-        FEventSignatures[idx]:='';  // add event signatures only once. Multiple coclasses can use same events
+        FEventSignatures[idx]:='already defined';  // add event signatures only once. Multiple coclasses can use same events
         AddToInterface('');
         AddToInterface('');
         end;
         end;
       AddToInterFace('  Co%s = Class',[BstrName]);
       AddToInterFace('  Co%s = Class',[BstrName]);
@@ -1554,7 +1556,7 @@ begin
         AddToInterFace('  end;');
         AddToInterFace('  end;');
         AddToInterFace('');
         AddToInterFace('');
         end
         end
-      else if bIsDispatch and (sDefEvents<>'') then //add function variables
+      else if bIsDispatch and (sDefEvents<>'') then //add event sink descendant
         begin
         begin
         if FUses.IndexOf('Eventsink')<0 then
         if FUses.IndexOf('Eventsink')<0 then
           FUses.Add('EventSink');
           FUses.Add('EventSink');
@@ -1676,7 +1678,7 @@ begin
                   if ((il mod 16)=0) and (il>0) then
                   if ((il mod 16)=0) and (il>0) then
                     sl:=sl+'+'#13#10;
                     sl:=sl+'+'#13#10;
                   end;
                   end;
-                sl:=format('LazarusResources.Add(''T%s'',''BMP'',['#13#10,[BstrName])
+                sl:=format('LazarusResources.Add(''TAxc%s'',''BMP'',['#13#10,[BstrName])
                     + sl + #13#10']);'#13#10;
                     + sl + #13#10']);'#13#10;
                 FAXImages.Add(sl);
                 FAXImages.Add(sl);
                 end;
                 end;

+ 3 - 3
rtl/haiku/i386/sighnd.inc

@@ -16,7 +16,7 @@
  **********************************************************************}
  **********************************************************************}
 
 
 
 
-procedure SignalToRunerror(sig : longint; SigContext: PSigContextRec; uContext: Pvregs);public name '_FPC_DEFAULTSIGHANDLER';cdecl;
+procedure SignalToRunerror(sig : longint; SigContext: PSigInfo; uContext: PSigContext);public name '_FPC_DEFAULTSIGHANDLER';cdecl;
 var
 var
   res,fpustate : word;
   res,fpustate : word;
 begin
 begin
@@ -53,10 +53,10 @@ begin
         end;
         end;
         SysResetFPU;
         SysResetFPU;
       end;
       end;
-(*    SIGBUS: {Same as SIGSEGV under BeOS}
+    SIGBUS:
       begin
       begin
         res:=214;
         res:=214;
-      end; *)
+      end;
     SIGILL:
     SIGILL:
       begin
       begin
       if sse_check then
       if sse_check then

+ 33 - 14
rtl/haiku/signal.inc

@@ -17,7 +17,7 @@ Const   { For sending a signal }
 
 
   SA_NOCLDSTOP = $01;
   SA_NOCLDSTOP = $01;
   SA_NOCLDWAIT = $02;
   SA_NOCLDWAIT = $02;
-  SA_RESETHAND = $03;
+  SA_RESETHAND = $04;
   SA_NODEFER   = $08;
   SA_NODEFER   = $08;
   SA_RESTART   = $10;
   SA_RESTART   = $10;
   SA_ONSTACK   = $20;
   SA_ONSTACK   = $20;
@@ -78,8 +78,9 @@ Const   { For sending a signal }
   SIGVTALRM  = 27;
   SIGVTALRM  = 27;
   SIGXCPU    = 28;
   SIGXCPU    = 28;
   SIGXFSZ    = 29;
   SIGXFSZ    = 29;
-  
-  SIGBUS     = SIGSEGV;
+  SIGBUS     = 30;
+  SIGRESERVED1 = 31;
+  SIGRESERVED2 = 32;
   
   
 {
 {
    Signal numbers 23-32 are currently free but may be used in future
    Signal numbers 23-32 are currently free but may be used in future
@@ -234,7 +235,9 @@ type
   
   
   Pvregs = ^vregs;
   Pvregs = ^vregs;
 
 
-  sigset_t = array[0..0] of Longint;
+  sigset_t = array[0..1] of Cardinal;
+
+    PSigContext = ^vregs;
 
 
     PSigContextRec = ^SigContextRec;
     PSigContextRec = ^SigContextRec;
     SigContextRec = record
     SigContextRec = record
@@ -277,21 +280,37 @@ type
        fpr_ex_sw    : cardinal;
        fpr_ex_sw    : cardinal;
        fpr_pad      : array[0..63] of char;
        fpr_pad      : array[0..63] of char;
        end;
        end;
+
+  Sigval = Record
+            Case Boolean OF
+        { Members as suggested by Annex C of POSIX 1003.1b. }
+                false : (sigval_int : Longint);
+                True  : (sigval_ptr : Pointer);
+            End;
+
+
+  PSigInfo   = ^SigInfo_t;
+  PSigInfo_t = ^SigInfo_t;
+  SigInfo_t = packed record
+                si_signo,                       { signal number }
+                si_code,                        { signal code }
+                si_errno,                       { errno association }
+                si_pid          : pid_t;      { sending process }
+                si_uid          : uid_t;     { sender's ruid }
+                si_addr         : Pointer;      { faulting instruction }                
+                si_status       : Longint;      { exit value }
+                si_band         : Cardinal;     { band event for SIGPOLL }                
+                si_value        : SigVal;       { signal value }
+                end;
+  TSigInfo = SigInfo_t;
+  TSigInfo_t = TSigInfo;       
        
        
   SignalHandler   = Procedure(Sig : Longint);cdecl;
   SignalHandler   = Procedure(Sig : Longint);cdecl;
   PSignalHandler  = ^SignalHandler;
   PSignalHandler  = ^SignalHandler;
   SignalRestorer  = Procedure;cdecl;
   SignalRestorer  = Procedure;cdecl;
   PSignalRestorer = ^SignalRestorer;
   PSignalRestorer = ^SignalRestorer;
-  {$WARNING TODO : check with signal.h}
-  { Note: As of R1alpha3, sa_handler still was of SignalHandler type, with one parameter,
-    but the Signal stack has a second parameter that is set to zero
-    and a third that is of type pvregs }
-  sigActionHandler = procedure(Sig: Longint; SigContext: PSigContextRec; uContext : Pvregs);cdecl;
+  sigActionHandler = procedure(Sig: Longint; SigInfo: PSigInfo; uContext : PSigContext);cdecl;
 
 
-  { Add those type definition to obtain same declaration as for other unix targets 
-    but do not forget the PSigInfo field is currently nil for Haiku as of R1alpha3. }
-  PSigInfo = PSigContextRec;
-  PSigContext = Pvregs;
 
 
   Sigset=sigset_t;
   Sigset=sigset_t;
   TSigset=sigset_t;
   TSigset=sigset_t;
@@ -314,7 +333,7 @@ type
 
 
   {$PACKRECORDS C}
   {$PACKRECORDS C}
   pstack_t = ^stack_t;
   pstack_t = ^stack_t;
-  stack_t = record
+  stack_t = packed record
     ss_sp: pChar;                       {* signal stack base *}
     ss_sp: pChar;                       {* signal stack base *}
     ss_size: size_t;                    {* signal stack length *}
     ss_size: size_t;                    {* signal stack length *}
     ss_flags: cInt;                     {* SS_DISABLE and/or SS_ONSTACK *}
     ss_flags: cInt;                     {* SS_DISABLE and/or SS_ONSTACK *}

+ 2 - 2
rtl/haiku/system.pp

@@ -322,7 +322,7 @@ end;
 //int		sigaltstack(const stack_t *ss, stack_t *oss);
 //int		sigaltstack(const stack_t *ss, stack_t *oss);
 
 
 procedure set_signal_stack(ptr : pointer; size : size_t); cdecl; external 'root' name 'set_signal_stack';
 procedure set_signal_stack(ptr : pointer; size : size_t); cdecl; external 'root' name 'set_signal_stack';
-function sigaltstack(const ss : pstack_t; oss : pstack_t) : integer; cdecl; external 'root' name 'sigaltstack'; 
+function sigaltstack(const stack : pstack_t; oldStack : pstack_t) : integer; cdecl; external 'root' name 'sigaltstack'; 
 
 
 type
 type
   {$PACKRECORDS C}
   {$PACKRECORDS C}
@@ -360,7 +360,7 @@ begin
   { initialize handler                    }
   { initialize handler                    }
   act.sa_mask[0] := 0;
   act.sa_mask[0] := 0;
   act.sa_handler := SigActionHandler(@SignalToRunError);
   act.sa_handler := SigActionHandler(@SignalToRunError);
-  act.sa_flags := SA_ONSTACK or SA_NODEFER or SA_RESETHAND;
+  act.sa_flags := SA_ONSTACK;
   FpSigAction(signum,@act,@oldact);
   FpSigAction(signum,@act,@oldact);
 end;
 end;
 
 

+ 9 - 0
rtl/inc/systemh.inc

@@ -268,6 +268,15 @@ Type
   NativeInt  = PtrInt;
   NativeInt  = PtrInt;
   NativeUint = PtrUint;
   NativeUint = PtrUint;
 
 
+  Int8    = ShortInt;
+  Int16   = SmallInt;
+  Int32   = Longint;
+  IntPtr  = PtrInt;
+  UInt8   = Byte;
+  UInt16  = Word;
+  UInt32  = Cardinal;
+  UIntPtr = PtrUInt;
+
 { Zero - terminated strings }
 { Zero - terminated strings }
   PChar               = ^Char;
   PChar               = ^Char;
   PPChar              = ^PChar;
   PPChar              = ^PChar;

+ 4 - 1
rtl/objpas/classes/compon.inc

@@ -78,7 +78,10 @@ begin
  if assigned(intf) and supports(intf,IInterfaceComponentReference,ref) then
  if assigned(intf) and supports(intf,IInterfaceComponentReference,ref) then
    begin
    begin
     comp:=ref.getcomponent;
     comp:=ref.getcomponent;
-    comp.notification(self,op); 
+    if op = opInsert then
+      comp.FreeNotification(Self)
+    else
+      comp.RemoveFreeNotification(Self); 
    end;
    end;
 end;
 end;
 
 

+ 4 - 3
rtl/objpas/classes/lists.inc

@@ -255,9 +255,10 @@ begin
   if ((NewIndex < 0) or (NewIndex > Count -1)) then
   if ((NewIndex < 0) or (NewIndex > Count -1)) then
     Error(SlistIndexError, NewIndex);
     Error(SlistIndexError, NewIndex);
   Temp := FList^[CurIndex];
   Temp := FList^[CurIndex];
-  FList^[CurIndex] := nil;
-  Self.Delete(CurIndex);
-  Self.Insert(NewIndex, nil);
+  if NewIndex > CurIndex then
+    System.Move(FList^[CurIndex+1], FList^[CurIndex], (NewIndex - CurIndex) * SizeOf(Pointer))
+  else
+    System.Move(FList^[NewIndex], FList^[NewIndex+1], (CurIndex - NewIndex) * SizeOf(Pointer));
   FList^[NewIndex] := Temp;
   FList^[NewIndex] := Temp;
 end;
 end;
 
 

+ 1 - 1
rtl/win/wininc/ascdef.inc

@@ -165,7 +165,7 @@ function GetComputerName(lpBuffer:LPSTR; nSize:LPDWORD):WINBOOL; external 'kerne
 function SetComputerName(lpComputerName:LPCSTR):WINBOOL; external 'kernel32' name 'SetComputerNameA';
 function SetComputerName(lpComputerName:LPCSTR):WINBOOL; external 'kernel32' name 'SetComputerNameA';
 function GetCPInfoEx(Codepage:UINT; dwFlags:DWORD; CPInfoEx:LPCPINFOEX):WINBOOL; external 'kernel32' name 'GetCPInfoExA';
 function GetCPInfoEx(Codepage:UINT; dwFlags:DWORD; CPInfoEx:LPCPINFOEX):WINBOOL; external 'kernel32' name 'GetCPInfoExA';
 function GetUserName(lpBuffer:LPSTR; nSize:LPDWORD):WINBOOL; external 'advapi32' name 'GetUserNameA';
 function GetUserName(lpBuffer:LPSTR; nSize:LPDWORD):WINBOOL; external 'advapi32' name 'GetUserNameA';
-function wvsprintf(_para1:LPSTR; _para2:LPCSTR; arglist:va_list):longint; external 'user32' name 'wvsprintfA';
+function wvsprintf(_para1:LPSTR; _para2:LPCSTR; arglist:va_list):longint; stdcall; external 'user32' name 'wvsprintfA';
 function LoadKeyboardLayout(pwszKLID:LPCSTR; Flags:UINT):HKL; external 'user32' name 'LoadKeyboardLayoutA';
 function LoadKeyboardLayout(pwszKLID:LPCSTR; Flags:UINT):HKL; external 'user32' name 'LoadKeyboardLayoutA';
 function GetKeyboardLayoutName(pwszKLID:LPSTR):WINBOOL; external 'user32' name 'GetKeyboardLayoutNameA';
 function GetKeyboardLayoutName(pwszKLID:LPSTR):WINBOOL; external 'user32' name 'GetKeyboardLayoutNameA';
 function CreateDesktop(lpszDesktop:LPSTR; lpszDevice:LPSTR; pDevmode:LPDEVMODE; dwFlags:DWORD; dwDesiredAccess:DWORD;lpsa:LPSECURITY_ATTRIBUTES):HDESK; external 'user32' name 'CreateDesktopA';
 function CreateDesktop(lpszDesktop:LPSTR; lpszDevice:LPSTR; pDevmode:LPDEVMODE; dwFlags:DWORD; dwDesiredAccess:DWORD;lpsa:LPSECURITY_ATTRIBUTES):HDESK; external 'user32' name 'CreateDesktopA';

+ 1 - 1
rtl/win/wininc/ascfun.inc

@@ -164,7 +164,7 @@ function SetDefaultCommConfigA(lpszName:LPCSTR; lpCC:LPCOMMCONFIG; dwSize:DWORD)
 function GetComputerNameA(lpBuffer:LPSTR; nSize:LPDWORD):WINBOOL; external 'kernel32' name 'GetComputerNameA';
 function GetComputerNameA(lpBuffer:LPSTR; nSize:LPDWORD):WINBOOL; external 'kernel32' name 'GetComputerNameA';
 function SetComputerNameA(lpComputerName:LPCSTR):WINBOOL; external 'kernel32' name 'SetComputerNameA';
 function SetComputerNameA(lpComputerName:LPCSTR):WINBOOL; external 'kernel32' name 'SetComputerNameA';
 function GetUserNameA(lpBuffer:LPSTR; nSize:LPDWORD):WINBOOL; external 'advapi32' name 'GetUserNameA';
 function GetUserNameA(lpBuffer:LPSTR; nSize:LPDWORD):WINBOOL; external 'advapi32' name 'GetUserNameA';
-function wvsprintfA(_para1:LPSTR; _para2:LPCSTR; arglist:va_list):longint; cdecl; external 'user32' name 'wvsprintfA';
+function wvsprintfA(_para1:LPSTR; _para2:LPCSTR; arglist:va_list):longint; stdcall; external 'user32' name 'wvsprintfA';
 function wsprintfA(_para1:LPSTR; _para2:LPCSTR; const args:array of const):longint; cdecl; external 'user32' name 'wsprintfA';
 function wsprintfA(_para1:LPSTR; _para2:LPCSTR; const args:array of const):longint; cdecl; external 'user32' name 'wsprintfA';
 function wsprintfA(_para1:LPSTR; _para2:LPCSTR):longint; cdecl; external 'user32' name 'wsprintfA';
 function wsprintfA(_para1:LPSTR; _para2:LPCSTR):longint; cdecl; external 'user32' name 'wsprintfA';
 function wsprintf(_para1:LPSTR; _para2:LPCSTR; const args:array of const):longint; cdecl; external 'user32' name 'wsprintfA';
 function wsprintf(_para1:LPSTR; _para2:LPCSTR; const args:array of const):longint; cdecl; external 'user32' name 'wsprintfA';

+ 1 - 1
rtl/win/wininc/unidef.inc

@@ -164,7 +164,7 @@ function GetComputerName(lpBuffer:LPWSTR; nSize:LPDWORD):WINBOOL; external 'kern
 function SetComputerName(lpComputerName:LPCWSTR):WINBOOL; external 'kernel32' name 'SetComputerNameW';
 function SetComputerName(lpComputerName:LPCWSTR):WINBOOL; external 'kernel32' name 'SetComputerNameW';
 function GetCPInfoEx(Codepage:UINT; dwFlags:DWORD; CPinfoEx:LPCPINFOEX):BOOL; external 'kernel32' name 'GetCPInfoExW';
 function GetCPInfoEx(Codepage:UINT; dwFlags:DWORD; CPinfoEx:LPCPINFOEX):BOOL; external 'kernel32' name 'GetCPInfoExW';
 function GetUserName(lpBuffer:LPWSTR; nSize:LPDWORD):WINBOOL; external 'advapi32' name 'GetUserNameW';
 function GetUserName(lpBuffer:LPWSTR; nSize:LPDWORD):WINBOOL; external 'advapi32' name 'GetUserNameW';
-function wvsprintf(_para1:LPWSTR; _para2:LPCWSTR; arglist:va_list):longint; external 'user32' name 'wvsprintfW';
+function wvsprintf(_para1:LPWSTR; _para2:LPCWSTR; arglist:va_list):longint; stdcall; external 'user32' name 'wvsprintfW';
 function wsprintf(_para1:LPWSTR; _para2:LPCWSTR; const args:array of const):longint;cdecl; external 'user32' name 'wsprintfW';
 function wsprintf(_para1:LPWSTR; _para2:LPCWSTR; const args:array of const):longint;cdecl; external 'user32' name 'wsprintfW';
 function wsprintf(_para1:LPWSTR; _para2:LPCWSTR):longint;CDECL; external 'user32' name 'wsprintfW';
 function wsprintf(_para1:LPWSTR; _para2:LPCWSTR):longint;CDECL; external 'user32' name 'wsprintfW';
 function LoadKeyboardLayout(pwszKLID:LPCWSTR; Flags:UINT):HKL; external 'user32' name 'LoadKeyboardLayoutW';
 function LoadKeyboardLayout(pwszKLID:LPCWSTR; Flags:UINT):HKL; external 'user32' name 'LoadKeyboardLayoutW';

+ 1 - 1
rtl/win/wininc/unifun.inc

@@ -163,7 +163,7 @@ function SetDefaultCommConfigW(lpszName:LPCWSTR; lpCC:LPCOMMCONFIG; dwSize:DWORD
 function GetComputerNameW(lpBuffer:LPWSTR; nSize:LPDWORD):WINBOOL; external 'kernel32' name 'GetComputerNameW';
 function GetComputerNameW(lpBuffer:LPWSTR; nSize:LPDWORD):WINBOOL; external 'kernel32' name 'GetComputerNameW';
 function SetComputerNameW(lpComputerName:LPCWSTR):WINBOOL; external 'kernel32' name 'SetComputerNameW';
 function SetComputerNameW(lpComputerName:LPCWSTR):WINBOOL; external 'kernel32' name 'SetComputerNameW';
 function GetUserNameW(lpBuffer:LPWSTR; nSize:LPDWORD):WINBOOL; external 'advapi32' name 'GetUserNameW';
 function GetUserNameW(lpBuffer:LPWSTR; nSize:LPDWORD):WINBOOL; external 'advapi32' name 'GetUserNameW';
-function wvsprintfW(_para1:LPWSTR; _para2:LPCWSTR; arglist:va_list):longint; cdecl; external 'user32' name 'wvsprintfW';
+function wvsprintfW(_para1:LPWSTR; _para2:LPCWSTR; arglist:va_list):longint; stdcall; external 'user32' name 'wvsprintfW';
 function wsprintfW(_para1:LPWSTR; _para2:LPCWSTR; const args:array of const):longint;cdecl; external 'user32' name 'wsprintfW';
 function wsprintfW(_para1:LPWSTR; _para2:LPCWSTR; const args:array of const):longint;cdecl; external 'user32' name 'wsprintfW';
 function wsprintfW(_para1:LPWSTR; _para2:LPCWSTR):longint; cdecl; external 'user32' name 'wsprintfW';
 function wsprintfW(_para1:LPWSTR; _para2:LPCWSTR):longint; cdecl; external 'user32' name 'wsprintfW';
 function LoadKeyboardLayoutW(pwszKLID:LPCWSTR; Flags:UINT):HKL; external 'user32' name 'LoadKeyboardLayoutW';
 function LoadKeyboardLayoutW(pwszKLID:LPCWSTR; Flags:UINT):HKL; external 'user32' name 'LoadKeyboardLayoutW';

+ 1 - 1
utils/fpcm/Makefile

@@ -1,5 +1,5 @@
 #
 #
-# Don't edit, this file is generated by FPCMake Version 2.0.0 [2011/12/30]
+# Don't edit, this file is generated by FPCMake Version 2.0.0 [2012/02/11]
 #
 #
 default: all
 default: all
 MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-haiku i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince i386-embedded i386-symbian i386-nativent i386-iphonesim m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos m68k-embedded powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macos powerpc-darwin powerpc-morphos powerpc-embedded powerpc-wii sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd x86_64-solaris x86_64-darwin x86_64-win64 x86_64-embedded arm-linux arm-palmos arm-darwin arm-wince arm-gba arm-nds arm-embedded arm-symbian powerpc64-linux powerpc64-darwin powerpc64-embedded avr-embedded armeb-linux armeb-embedded mipsel-linux
 MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-haiku i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince i386-embedded i386-symbian i386-nativent i386-iphonesim m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos m68k-embedded powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macos powerpc-darwin powerpc-morphos powerpc-embedded powerpc-wii sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd x86_64-solaris x86_64-darwin x86_64-win64 x86_64-embedded arm-linux arm-palmos arm-darwin arm-wince arm-gba arm-nds arm-embedded arm-symbian powerpc64-linux powerpc64-darwin powerpc64-embedded avr-embedded armeb-linux armeb-embedded mipsel-linux

File diff suppressed because it is too large
+ 254 - 430
utils/importtl/Makefile


+ 1 - 1
utils/importtl/Makefile.fpc

@@ -12,4 +12,4 @@ programs=importtl
 fpcdir=../..
 fpcdir=../..
 
 
 [require]
 [require]
-packages=winunits-base
+packages=winunits-base fcl-base fcl-registry

Some files were not shown because too many files changed in this diff