fixed calling widgetset dependant DestroyHandle

git-svn-id: trunk@8526 -

components/opengl/glcarbonaglcontext.pas

@@ -22,7 +22,7 @@ interface
 uses
   Classes, SysUtils, LCLProc, LCLType, gl, Forms,
   FPCMacOSAll, CarbonInt, AGL, CarbonProc, CarbonDef, CarbonPrivate,
-  WSLCLClasses, CarbonUtils,
+  WSLCLClasses, CarbonWSControls, CarbonUtils,
   Controls;
 
 procedure LOpenGLViewport(Left, Top, Width, Height: integer);
@@ -34,23 +34,10 @@ function LOpenGLCreateContext(AWinControl: TWinControl;
 procedure LOpenGLDestroyContextInfo(AWinControl: TWinControl);
 function CreateOpenGLContextAttrList(DoubleBuffered: boolean;
   RGBA: boolean): PInteger;
-
-const
-  DefaultOpenGLContextInitAttrList: array [0..14] of LongInt = (
-    AGL_WINDOW,
-    AGL_RGBA,
-    AGL_NO_RECOVERY,
-    AGL_MAXIMUM_POLICY,
-    AGL_DOUBLEBUFFER,
-    AGL_SINGLE_RENDERER,
-    AGL_RED_SIZE,1,
-    AGL_GREEN_SIZE,1,
-    AGL_BLUE_SIZE,1,
-    AGL_DEPTH_SIZE,1,
-    AGL_NONE
-    );
-    
+  
 type
+  TWidgetSetWSWinControl = TCarbonWSWinControl;
+
   TAGLControlInfo = record
     Control: ControlRef;
     AGLContext: TAGLContext;

components/opengl/glgtkglxcontext.pas

@@ -23,7 +23,7 @@ interface
 
 uses
   Classes, SysUtils, LCLProc, LCLType, X, XUtil, XLib, gl, InterfaceBase,
-  WSLCLClasses,
+  WSLCLClasses, GtkWSControls,
   {$IFDEF LCLGTK2}
   gdk2x, glib2, gdk2, gtk2, Gtk2Int,
   {$ENDIF}
@@ -135,6 +135,8 @@ procedure LOpenGLDestroyContextInfo(AWinControl: TWinControl);
 function CreateOpenGLContextAttrList(DoubleBuffered: boolean;
   RGBA: boolean): PInteger;
 
+type
+  TWidgetSetWSWinControl = TGtkWSWinControl;
 
 implementation
 

components/opengl/glwin32wglcontext.pas

@@ -36,6 +36,8 @@ procedure InitOpenGLContextGLWindowClass;
 
 
 type
+  TWidgetSetWSWinControl = TWin32WSWinControl;
+
   TWGLControlInfo = record
     Window: HWND;
     DC: HDC;

components/opengl/openglcontext.pas

@@ -24,12 +24,46 @@ unit OpenGLContext;
 
 {$mode objfpc}{$H+}
 
+{$IFDEF LCLGTK}
+  {$DEFINE UseGtkGLX}
+  {$DEFINE OpenGLTargetDefined}
+{$ENDIF}
+{$IFDEF LCLGnome}
+  {$DEFINE UseGtkGLX}
+  {$DEFINE OpenGLTargetDefined}
+{$ENDIF}
+{$IFDEF LCLGTK2}
+  {$DEFINE UseGtkGLX}
+  {$DEFINE OpenGLTargetDefined}
+{$ENDIF}
+{$IFDEF LCLCarbon}
+  {$DEFINE UseCarbonAGL}
+  {$DEFINE OpenGLTargetDefined}
+{$ENDIF}
+{$IFDEF LCLWin32}
+  {$DEFINE UseWin32WGL}
+  {$DEFINE OpenGLTargetDefined}
+{$ENDIF}
+{$IFNDEF OpenGLTargetDefined}
+  {$ERROR this target is not yet supported}
+{$ENDIF}
+
 interface
 
 uses
   Classes, SysUtils, LCLProc, Forms, Controls, LCLType, LCLIntf, LResources,
-  Graphics, LMessages, WSLCLClasses, WSControls;
-  
+  Graphics, LMessages, WSLCLClasses, WSControls,
+{$IFDEF UseGtkGLX}
+  GLGtkGlxContext;
+{$ENDIF}
+{$IFDEF UseCarbonAGL}
+  GLCarbonAGLContext;
+{$ENDIF}
+{$IFDEF UseWin32WGL}
+  GLWin32WGLContext;
+{$ENDIF}
+
+
 type
   TOpenGlCtrlMakeCurrentEvent = procedure(Sender: TObject;
                                           var Allow: boolean) of object;
@@ -130,7 +164,7 @@ type
 
   { TWSOpenGLControl }
 
-  TWSOpenGLControl = class(TWSWinControl)
+  TWSOpenGLControl = class(TWidgetSetWSWinControl)
   public
     class function CreateHandle(const AWinControl: TWinControl;
                                 const AParams: TCreateParams): HWND; override;
@@ -144,42 +178,6 @@ procedure Register;
 
 implementation
 
-
-{$IFDEF LCLGTK}
-  {$DEFINE UseGtkGLX}
-  {$DEFINE OpenGLTargetDefined}
-{$ENDIF}
-{$IFDEF LCLGnome}
-  {$DEFINE UseGtkGLX}
-  {$DEFINE OpenGLTargetDefined}
-{$ENDIF}
-{$IFDEF LCLGTK2}
-  {$DEFINE UseGtkGLX}
-  {$DEFINE OpenGLTargetDefined}
-{$ENDIF}
-{$IFDEF LCLCarbon}
-  {$DEFINE UseCarbonAGL}
-  {$DEFINE OpenGLTargetDefined}
-{$ENDIF}
-{$IFDEF LCLWin32}
-  {$DEFINE UseWin32WGL}
-  {$DEFINE OpenGLTargetDefined}
-{$ENDIF}
-{$IFNDEF OpenGLTargetDefined}
-  {$ERROR this target is not yet supported}
-{$ENDIF}
-
-uses
-{$IFDEF UseGtkGLX}
-  GLGtkGlxContext;
-{$ENDIF}
-{$IFDEF UseCarbonAGL}
-  GLCarbonAGLContext;
-{$ENDIF}
-{$IFDEF UseWin32WGL}
-  GLWin32WGLContext;
-{$ENDIF}
-
 var
   OpenGLControlStack: TList = nil;
 

lcl/interfaces/gtk/gtkcallback.inc

@@ -738,16 +738,33 @@ end;
 function gtkdestroyCB(widget: PGtkWidget; data: gPointer) : GBoolean; cdecl;
 var
   Mess: TLMessage;
+  Info: PWidgetInfo;
 begin
   Result := CallBackDefaultReturn;
+  
+  Info:=GetWidgetInfo(Widget,false);
+  if Info=nil then begin
+    // this widget is already destroyed
+    exit;
+  end;
+  if (Info^.LCLObject<>TObject(Data)) then begin
+    // this LCLObject does not use this widget anymore
+    exit;
+  end;
+  if (TObject(Data) is TWinControl)
+  and ((not TWinControl(Data).HandleAllocated)
+       or (PGtkWidget(TWinControl(Data).Handle)<>Widget))
+  then begin
+    // the TWinControl does not use this widget anymore.
+    exit;
+  end;
 
   EventTrace('destroy', data);
+  //DebugLn('gtkdestroyCB Data="',DbgSName(TObject(Data)),'" LCLObject="',DbgSName(Info^.LCLObject),'" ',GetWidgetDebugReport(Widget));
   FillChar(Mess,SizeOf(Mess),0);
   Mess.msg := LM_DESTROY;
   DeliverMessage(Data, Mess);
 
-  Result := CallBackDefaultReturn;
-
   // NOTE: if the destroy message is posted
   // we should post an info destroy message as well
 

lcl/interfaces/gtk/gtkproc.inc

@@ -3917,8 +3917,8 @@ begin
     gdk_pixmap_unref(Info^.DoubleBuffer);
 
   if (Info^.UserData <> nil) and (Info^.DataOwner) then begin
-     FreeMem(Info^.UserData);
-     Info^.UserData := nil;
+    FreeMem(Info^.UserData);
+    Info^.UserData := nil;
   end;
   gtk_object_set_data(AWidget,'widgetinfo',nil);
 
@@ -3928,10 +3928,37 @@ end;
 {-------------------------------------------------------------------------------
   procedure DestroyWidget(Widget: PGtkWidget);
 
+  - sends LM_DESTROY
+  - frees the WidgetInfo
+  - destroys the widget in the gtk
+  
+  IMPORTANT:
+    The above order must be kept, to avoid callbacks working with danging
+    pointers.
+    
+  Some widgets have a LM_DESTROY set, so if the gtk or some other code
+  destroys those widget, the above is done in gtkdestroyCB.
 -------------------------------------------------------------------------------}
 procedure DestroyWidget(Widget: PGtkWidget);
+var
+  Info: PWidgetInfo;
+  AWinControl: TWinControl;
+  Mess: TLMessage;
 begin
-  FreeWidgetInfo(Widget);
+  Info:=GetWidgetInfo(Widget);
+  if Info<>nil then begin
+    if (Info^.LCLObject is TWinControl) then begin
+      AWinControl:=TWinControl(Info^.LCLObject);
+      if AWinControl.HandleAllocated
+      and (PGtkWidget(AWinControl.Handle)=Widget) then begin
+        // send the LM_DESTROY message before destroying the widget
+        FillChar(Mess,SizeOf(Mess),0);
+        Mess.msg := LM_DESTROY;
+        DeliverMessage(Info^.LCLObject, Mess);
+      end;
+    end;
+    FreeWidgetInfo(Widget);
+  end;
   gtk_widget_destroy(Widget);
 end;
 

lcl/interfaces/gtk/gtkwscontrols.pp

@@ -249,6 +249,7 @@ end;
 
 procedure TGtkWSWinControl.DestroyHandle(const AWinControl: TWinControl);
 begin
+  //DebugLn('TGtkWSWinControl.DestroyHandle ',DbgSName(AWinControl));
   TGtkWidgetSet(WidgetSet).DestroyLCLComponent(AWinControl);
 end;