{%MainUnit gtkproc.pp}

{******************************************************************************
                        Misc Support Functs  
 ******************************************************************************
   used by:
     GTKObject
     GTKWinAPI
     GTKCallback
 ******************************************************************************
 *****************************************************************************
 *                                                                           *
 *  This file is part of the Lazarus Component Library (LCL)                 *
 *                                                                           *
 *  See the file COPYING.modifiedLGPL, included in this distribution,        *
 *  for details about the copyright.                                         *
 *                                                                           *
 *  This program is distributed in the hope that it will be useful,          *
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of           *
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                     *
 *                                                                           *
 *****************************************************************************
}

{$IFOPT C-}
// Uncomment for local trace
  //{$C+}
  //{$DEFINE ASSERT_IS_ON}
{$ENDIF}

function gtk_widget_get_xthickness(Style : PGTKStyle) : gint;
begin  
  If (Style <> nil) then begin
    {$IfNDef GTK2}
      If (Style^.klass = nil) then
        result := 0
      else
    {$EndIf}
        result := Style^.{$IfNDef GTK2}klass^.{$EndIF}xthickness
  end else
    result := 0;
end;

function gtk_widget_get_ythickness(Style : PGTKStyle) : gint;
begin  
  If (Style <> nil) then begin
    {$IfNDef GTK2}
      If (Style^.klass = nil) then
        result := 0
      else
    {$EndIf}
        result := Style^.{$IfNDef GTK2}klass^.{$EndIF}ythickness
  end else
    result := 0;
end;

function gtk_widget_get_xthickness(Widget : PGTKWidget) : gint; overload;
begin
  result := gtk_widget_get_xthickness(gtk_widget_get_style(Widget));
end;

function gtk_widget_get_ythickness(Widget : PGTKWidget) : gint; overload;
begin
  result := gtk_widget_get_ythickness(gtk_widget_get_style(Widget));
end;

function GetGtkContainerBorderWidth(Widget: PGtkContainer): gint;
begin
  Result:=(Widget^.flag0 and bm_TGtkContainer_border_width)
          shr bp_TGtkContainer_border_width;
end;

procedure gdk_event_key_get_string(Event : PGDKEventKey; var theString : Pointer);
begin
  {$IfDef GTK2}
  theString := Pointer(Event^._String);
  {$Else}
  theString := Pointer(Event^.TheString);
  {$EndIF}
end;

procedure gdk_event_key_set_string(Event: PGDKEventKey; const NewString: PChar
  );
var
  OldString: PChar;
begin
  {$IfDef GTK2}
  OldString := Pointer(Event^._String);
  {$Else}
  OldString := Pointer(Event^.TheString);
  {$EndIF}
  // MG: should we set Event^.length := 0; or is this used for mem allocation?
  if (OldString<>nil) then begin
    if (NewString<>nil) then
      OldString[0]:=NewString[0]
    else
      OldString[0]:=#0;
  end;
end;

function gdk_event_get_type(Event : Pointer) : TGdkEventType;
begin
  {$IfDef GTK2}
  result := PGdkEvent(Event)^._type;
  {$Else}
  result := PGdkEvent(Event)^.TheType;
  {$EndIF}
end;

procedure RememberKeyEventWasHandledByLCL(Event: PGdkEventKey;
  BeforeEvent: boolean);
var
  HandledEvent: TLCLHandledKeyEvent;
  EventList: TFPList;
begin
  if KeyEventWasHandledByLCL(Event,BeforeEvent) then exit;
  if BeforeEvent then begin
    if LCLHandledKeyEvents=nil then
      LCLHandledKeyEvents:=TFPList.Create;
    EventList:=LCLHandledKeyEvents;
  end else begin
    if LCLHandledKeyAfterEvents=nil then
      LCLHandledKeyAfterEvents:=TFPList.Create;
    EventList:=LCLHandledKeyAfterEvents;
  end;
  HandledEvent:=TLCLHandledKeyEvent.Create(Event);
  EventList.Add(HandledEvent);
  while EventList.Count>10 do begin
    HandledEvent:=TLCLHandledKeyEvent(EventList[0]);
    HandledEvent.Free;
    EventList.Delete(0);
  end;
end;

function KeyEventWasHandledByLCL(Event: PGdkEventKey; BeforeEvent: boolean
  ): boolean;
var
  i: Integer;
  HandledEvent: TLCLHandledKeyEvent;
  EventList: TFPList;
begin
  Result:=false;
  if BeforeEvent then
    EventList:=LCLHandledKeyEvents
  else
    EventList:=LCLHandledKeyAfterEvents;
  if EventList=nil then exit;
  for i:=0 to EventList.Count-1 do begin
    HandledEvent:=TLCLHandledKeyEvent(EventList[i]);
    if HandledEvent.IsEqual(Event) then begin
      Result:=true;
      exit;
    end;
  end;
end;

{$IfNdef GTK2}
function gtk_class_get_type(aclass : Pointer) : TGtkType;
begin
  If (aclass <> nil) then
    result := PGtkTypeClass(aclass)^.thetype
  else
    result := 0;
end;

function gtk_object_get_class(anobject : Pointer) : Pointer;
begin
  If (anobject <> nil) then
    result := PGtkTypeObject(anobject)^.klass
  else
    result := nil;
end;

function gtk_window_get_modal(window:PGtkWindow):gboolean;
begin
  if assigned(Window) then
    result := (Window^.flag0 and bm_modal)<>0
  else
    result := False;
end;

function gtk_bin_get_child(bin : PGTKBin) : PGTKWidget;
begin
  if (bin <> nil) then
    result := bin^.Child
  else
    result := nil;
end;

Procedure gtk_menu_item_set_right_justified(menu_item : PGtkMenuItem; right_justified : gboolean);
begin
  if right_justified then
    menu_item^.flag0:=menu_item^.flag0 or bm_right_justify
  else
    menu_item^.flag0:=menu_item^.flag0 and (not bm_right_justify);
end;

Function gtk_check_menu_item_get_active(menu_item : PGtkCheckMenuItem) : gboolean;
begin
   Result:=(menu_item^.flag0 and bm_checkmenuitem_active <> 0);
end;

Procedure gtk_menu_append(menu : PGTKWidget; Item : PGtkWidget);
begin
  gtk.gtk_menu_append(PGTKMenu(menu), Item);
end;

Procedure gtk_menu_insert(menu : PGtkWidget; Item : PGTKWidget; Index : gint);
begin
  gtk.gtk_menu_insert(PGTKMenu(menu), Item, Index);
end;

Procedure gtk_menu_bar_insert(menubar : PGtkWidget; Item : PGTKWidget; Index : gint);
begin
  gtk.gtk_menu_bar_insert(PGtkMenuBar(menubar), Item, Index);
end;

Function gtk_image_new :PGTKWidget;
begin
  result := gtk.gtk_image_new(nil,nil);
end;

Function gtk_toolbar_new : PGTKWidget;
begin
  result := gtk.gtk_toolbar_new(GTK_ORIENTATION_HORIZONTAL,GTK_TOOLBAR_BOTH);
end;

Procedure gtk_color_selection_get_current_color(colorsel : PGTKColorSelection; Color : PGDKColor);
var
  colorArray : array[0..2] of double;
begin
  gtk_color_selection_get_color(colorsel, @colorArray[0]);
  Color^.pixel := 0;
  Color^.red := gushort(TruncToCardinal(colorArray[0] * $FFFF));
  Color^.green := gushort(TruncToCardinal(colorArray[1] * $FFFF));
  Color^.blue := gushort(TruncToCardinal(colorArray[2] * $FFFF));
  {$IFDEF VerboseColorDialog}
  DebugLn('gtk_color_selection_get_current_color ',
    ' Red=',DbgS(Color^.Red),
    ' Green=',DbgS(Color^.Green),
    ' Blue=',DbgS(Color^.Blue),
    '');
  {$ENDIF}
end;

Procedure gtk_color_selection_set_current_color(colorsel : PGTKColorSelection;
  Color : PGDKColor);
var
  SelectionColor: PGDouble;
begin
  {$IFDEF VerboseColorDialog}
  DebugLn('gtk_color_selection_set_current_color ',
    ' Red=',DbgS(Color^.Red),
    ' Green=',DbgS(Color^.Green),
    ' Blue=',DbgS(Color^.Blue),
    '');
  {$ENDIF}
  GetMem(SelectionColor,4*SizeOf(GDouble));
  try
    SelectionColor[0]:=gdouble(Color^.Red)/65535;
    SelectionColor[1]:=gdouble(Color^.Green)/65535;
    SelectionColor[2]:=gdouble(Color^.Blue)/65535;
    SelectionColor[3]:=0.0;
    gtk_color_selection_set_color(colorSel,SelectionColor);
  finally
    FreeMem(SelectionColor);
  end;
end;

procedure gdk_image_unref(Image : PGdkImage);
begin
  gdk_window_unref(PGdkWindow(Image));
end;

Procedure gdk_colormap_query_color(colormap : PGDKColormap; Pixel : gulong; Result : PGDKColor);
var
  GdkColorContext: PGdkColorContext;
begin
  if (Colormap = nil) or (Result = nil) then exit;
  GdkColorContext:= gdk_color_context_new(gdk_colormap_get_visual(colormap),colormap);
  Result^.Pixel := Pixel;
  gdk_color_context_query_color(GdkColorContext, Result);
  gdk_color_context_free(GdkColorContext);
end;

Function gdk_region_intersect(source1:PGdkRegion; source2:PGdkRegion) : PGdkRegion;
begin
  result := gdk_regions_intersect(source1, source2);
end;

Function gdk_region_union(source1:PGdkRegion; source2:PGdkRegion) : PGdkRegion;
begin
  result := gdk_regions_union(source1, source2);
end;

Function gdk_region_subtract(source1:PGdkRegion; source2:PGdkRegion) : PGdkRegion;
begin
  result := gdk_regions_subtract(source1, source2);
end;

Function gdk_region_xor(source1:PGdkRegion; source2:PGdkRegion) : PGdkRegion;
begin
  result := gdk_regions_xor(source1, source2);
end;

function gdk_region_copy(region: PGDKRegion): PGDKRegion;
var
  EmptyRegion: PGdkRegion;
begin
  EmptyRegion := gdk_region_new;
  Result := gdk_regions_union(region, EmptyRegion);
  gdk_region_destroy(EmptyRegion);
end;

function gdk_region_rectangle(rect: PGdkRectangle): PGDKRegion;
var
  EmptyRegion: PGdkRegion;
begin
  EmptyRegion := gdk_region_new;
  Result := gdk_region_union_with_rect(EmptyRegion,Rect);
  gdk_region_destroy(EmptyRegion);
end;

Function gdk_pixmap_create_from_xpm_d (window : PGdkWindow; var mask : PGdkBitmap; transparent_color : PGdkColor; data : PPgchar) : PGdkPixmap;
begin
  result := gdk.gdk_pixmap_create_from_xpm_d(window, @mask, transparent_color, data)
end;

Function gdk_pixmap_colormap_create_from_xpm_d (window : PGdkWindow; colormap: PGdkColormap; var mask : PGdkBitmap; transparent_color : PGdkColor; data : PPgchar) : PGdkPixmap;
begin
  result := gdk.gdk_pixmap_colormap_create_from_xpm_d(window, colormap, @mask, transparent_color, data)
end;

Function gdk_pixmap_colormap_create_from_xpm (window : PGdkWindow; colormap: PGdkColormap; var mask : PGdkBitmap; transparent_color : PGdkColor; filename : Pgchar) : PGdkPixmap;
begin
  result := gdk.gdk_pixmap_colormap_create_from_xpm(window, colormap, @mask, transparent_color, filename)
end;

{$IfNDef NoGdkPixbufLib}
Procedure gdk_pixbuf_render_pixmap_and_mask(pixbuf : PGdkPixbuf; var pixmap_return : PGdkPixmap; var mask_return : PGdkBitmap; alpha_threshold : gint);
begin
  {$IFDEF VerboseGdkPixbuf}
  debugln('gdk_pixbuf_render_pixmap_and_mask A1');
  {$ENDIF}
  gdkpixbuf.gdk_pixbuf_render_pixmap_and_mask(pixbuf, @pixmap_return, @mask_return, alpha_threshold);
  {$IFDEF VerboseGdkPixbuf}
  debugln('gdk_pixbuf_render_pixmap_and_mask A2');
  {$ENDIF}
end;
{$EndIf}

Function gdk_drawable_get_depth(Drawable : PGDKDrawable) : gint;
begin
  gdk_window_get_geometry(Drawable, nil, nil, nil, nil, @result);
end;

Procedure gdk_drawable_get_size(Drawable : PGDKDrawable; Width, Height : PGInt);
begin
  gdk_window_get_geometry(Drawable, nil, nil, Width, Height, nil);
end;

Function gdk_drawable_get_image(Drawable : PGDKDrawable; x, y, width, height : gint) : PGdkImage;
begin
  result := gdk_image_get(Drawable, x, y, width, height);
end;

Function gdk_drawable_get_colormap(Drawable : PGDKDrawable) : PGdkColormap;
begin
  result := gdk_window_get_colormap(Drawable);
end;

{$EndIf}

{$Ifdef GTK2}
function gtk_class_get_type(aclass : Pointer) : TGtkType;
begin
  If (aclass <> nil) then
    result := PGtkTypeClass(aclass)^.g_Type
  else
    result := 0;
end;

function gtk_object_get_class(anobject : Pointer) : Pointer;
begin
  If (anobject <> nil) then
    result := PGtkTypeObject(anobject)^.g_Class
  else
    result := nil;
end;

function gtk_window_get_modal(window:PGtkWindow):gboolean;
begin
  if assigned(Window) then
    result := GTK2.gtk_window_get_modal(window)
  else
    result := False;
end;

Function gdk_region_union_with_rect(region:PGdkRegion; rect:PGdkRectangle) : PGdkRegion;
begin
  result := gdk_region_copy(region);
  GDK2.gdk_region_union_with_rect(result, rect);
end;

Function gdk_region_intersect(source1:PGdkRegion; source2:PGdkRegion) : PGdkRegion;
begin
  result := gdk_region_copy(source1);
  GDK2.gdk_region_intersect(result, source2);
end;

Function gdk_region_union(source1:PGdkRegion; source2:PGdkRegion) : PGdkRegion;
begin
  result := gdk_region_copy(source1);
  GDK2.gdk_region_union(result, source2);
end;

Function gdk_region_subtract(source1:PGdkRegion; source2:PGdkRegion) : PGdkRegion;
begin
  result := gdk_region_copy(source1);
  GDK2.gdk_region_subtract(result, source2);
end;

Function gdk_region_xor(source1:PGdkRegion; source2:PGdkRegion) : PGdkRegion;
begin
  result := gdk_region_copy(source1);
  GDK2.gdk_region_xor(result, source2);
end;

Procedure gdk_text_extents(FontDesc : PPangoFontDescription; Str : PChar;
  LineLength : Longint; lbearing, rbearing, width, ascent, descent : Pgint);
var
  Layout : PPangoLayout;
  AttrList : PPangoAttrList;
  Attr : PPangoAttribute;
  Extents : TPangoRectangle;
begin
  GetStyle(lgsDefault);
  Layout := gtk_widget_create_pango_layout (GetStyleWidget(lgsDefault), nil);
  pango_layout_set_font_description(Layout, FontDesc);
  AttrList := pango_layout_get_attributes(Layout);

  If (AttrList = nil) then
    AttrList := pango_attr_list_new();

  Attr := pango_attr_underline_new(PANGO_UNDERLINE_NONE);

  pango_attr_list_change(AttrList,Attr);

  Attr := pango_attr_strikethrough_new(False);
  pango_attr_list_change(AttrList,Attr);

  pango_layout_set_attributes(Layout, AttrList);

  pango_layout_set_single_paragraph_mode(Layout, TRUE);
  pango_layout_set_width(Layout, -1);

  pango_layout_set_alignment(Layout, PANGO_ALIGN_LEFT);

  //fix me... and what about UTF-8 conversion?
  //this could be a massive problem since we
  //will need to know before hand what the current
  //locale is, and if we stored UTF-8 string this would break
  //cross-compatibility with GTK1.2 and win32 interfaces.....

  pango_layout_set_text(Layout,  Str, Linelength);

  if Assigned(width) then
    pango_layout_get_pixel_size(Layout, width, nil);

  pango_layout_get_extents(Layout, nil, @Extents);
  g_object_unref(Layout);

  if Assigned(lbearing) then
    lbearing^ := PANGO_LBEARING(extents) div PANGO_SCALE;

  if Assigned(rbearing) then
    rBearing^ := PANGO_RBEARING(extents) div PANGO_SCALE;

  if Assigned(ascent) then
    ascent^ := PANGO_ASCENT(extents) div PANGO_SCALE;

  if Assigned(descent) then
    descent^ := PANGO_DESCENT(extents) div PANGO_SCALE;
end;

{$EndIf Gtk2}

procedure BeginGDKErrorTrap;
begin
  Inc(GdkTrapCalls);
  if GdkTrapIsSet then
    exit;

  gdk_error_trap_push; //try to prevent GDK Bad Drawable/X Windows Errors
                         // from killing us...

  {$IfDef GDK_ERROR_TRAP_FLUSH}
  gdk_flush; //only for debugging purposes DO NOT enable by default.
               // slows things down intolerably for actual use, if we ever
               // have a real need for it, it should be called from that
               // specific function, since this gets called constantly during
               // drawing.
  {$EndIf}
  
  GdkTrapIsSet:=true;
end;

procedure EndGDKErrorTrap;
var
  Xerror : gint;
begin
  Dec(GdkTrapCalls);
  if (not GdkTrapIsSet) then
    RaiseGDBException('EndGDKErrorTrap without BeginGDKErrorTrap');
  if (GdkTrapCalls > 0) then
    exit;
    
  Xerror := gdk_error_trap_pop;

  GdkTrapIsSet:=false;

  {$IfDef REPORT_GDK_ERRORS}
  If (Xerror<>0) then
    RaiseGDBException('A GDK/X Error occured, this is normally fatal. The error code was : ' + IntToStr(Xerror));
  {$EndIf}
end;

function dbgGRect(const ARect: PGDKRectangle): string;
begin
  if ARect=nil then begin
    Result:='nil';
  end else begin
    Result:='x='+dbgs(ARect^.x)+',y='+dbgs(ARect^.y)
           +',w='+dbgs(ARect^.width)+',h='+dbgs(ARect^.height);
  end;
end;


{------------------------------------------------------------------------------
  function CreatePChar(const s: string): PChar;

  Allocates a new PChar
 ------------------------------------------------------------------------------}
function CreatePChar(const s: string): PChar;
begin
  Result:=StrAlloc(length(s) + 1);
  StrPCopy(Result, s);
end;

{------------------------------------------------------------------------------
  function ComparePChar(P1, P2: PChar): boolean;

  Checks if P1 and P2 have the same content.
 ------------------------------------------------------------------------------}
function ComparePChar(P1, P2: PChar): boolean;
begin
  if (P1<>P2) then begin
    if (P1<>nil) and (P2<>nil) then begin
      while (P1^=P2^) do begin
        if P1^<>#0 then begin
          inc(P1);
          inc(P2);
        end else begin
          Result:=true;
          exit;
        end;
      end;
    end;
    Result:=false;
  end else begin
    Result:=true;
  end;
end;

{------------------------------------------------------------------------------
  function FindChar(c: char; p:PChar; Max: integer): integer;
 ------------------------------------------------------------------------------}
function FindChar(c: char; p:PChar; Max: integer): integer;
begin
  Result:=0;
  while (Result<Max) do begin
    if p[Result]<>c then
      inc(Result)
    else
      exit;
  end;
  Result:=-1;
end;

{------------------------------------------------------------------------------
  function FindLineLen(p: PChar; Max: integer): integer;
  
  Find line end
 ------------------------------------------------------------------------------}
function FindLineLen(p: PChar; Max: integer): integer;
begin
  Result:=0;
  while (Result<Max) do begin
    if not (p[Result] in [#10,#13]) then
      inc(Result)
    else
      exit;
  end;
  Result:=-1;
end;


{------------------------------------------------------------------------------
  function GtkWidgetIsA(Widget: PGtkWidget; AType: TGtkType): boolean;

  The GTK_IS_XXX macro functions in the fpc gtk1.x bindings are not correct.
  They just test the highest level.
  This function checks as the real C macros.
 ------------------------------------------------------------------------------}
function GtkWidgetIsA(Widget: PGtkWidget; AType: TGtkType): boolean;
begin
  Result:=(Widget<>nil)
    and (gtk_object_get_class(Widget)<>nil)
    and gtk_type_is_a(gtk_class_get_type(gtk_object_get_class(Widget)), AType);
end;

{------------------------------------------------------------------------------
  function GetWidgetClassName(Widget: PGtkWidget): string;

  Returns the gtk class name of Widget.
 ------------------------------------------------------------------------------}
function GetWidgetClassName(Widget: PGtkWidget): string;
var
  AType: TGtkType;
  ClassPGChar: Pgchar;
  ClassLen: Integer;
begin
  Result:='';
  if (gtk_object_get_class(Widget)=nil) then begin
    Result:='<Widget without class>';
    exit;
  end;
  AType:=gtk_class_get_type(gtk_object_get_class(Widget));
  ClassPGChar:=gtk_type_name(AType);
  if ClassPGChar=nil then begin
    Result:='<Widget without classname>';
    exit;
  end;
  ClassLen:=strlen(ClassPGChar);
  SetLength(Result,ClassLen);
  if ClassLen>0 then
    Move(ClassPGChar[0],Result[1],ClassLen);
end;

function GetWidgetDebugReport(Widget: PGtkWidget): string;
var
  LCLObject: TObject;
  AWinControl: TWinControl;
  MainWidget: PGtkWidget;
  WinWidgetInfo: PWinWidgetInfo;
  FixedWidget: PGTKWidget;
begin
  if Widget = nil
  then begin
    Result := 'nil';
    exit;
  end;
  Result := Format('%p=%s %s', [Pointer(Widget), GetWidgetClassName(Widget), WidgetFlagsToString(Widget)]);
  LCLObject:=GetNearestLCLObject(Widget);
  Result := Result + Format(' LCLObject=%p', [Pointer(LCLObject)]);
  if LCLObject=nil then exit;
  if LCLObject is TControl then
    Result:=Result+'='+TControl(LCLObject).Name+':'+LCLObject.ClassName
  else
    Result:=Result+'='+LCLObject.ClassName;
  if LCLObject is TWinControl then begin
    AWinControl:=TWinControl(LCLObject);
    if AWinControl.HandleAllocated then begin
      MainWidget:=PGTKWidget(AWinControl.Handle);
      if MainWidget=Widget
      then Result:=Result+'<Is MainWidget>'
      else Result:=Result+Format('<MainWidget=%p=%s>', [Pointer(MainWidget), GetWidgetClassName(MainWidget)]);
      FixedWidget:=GetFixedWidget(MainWidget);
      if FixedWidget=Widget then
        Result:=Result+'<Is FixedWidget>';
      WinWidgetInfo:=GetWidgetInfo(MainWidget,false);
      if WinWidgetInfo<>nil then begin
        if WinWidgetInfo^.CoreWidget = Widget then
          Result:=Result+'<Is CoreWidget>';
      end;
    end
    else begin
      Result:=Result+'<NOT HandleAllocated>'
    end;
  end;
end;

function GetWindowDebugReport(AWindow: PGDKWindow): string;
var
  p: Pgpointer;
  Widget: PGtkWidget;
  WindowType: TGdkWindowType;
  Width: Integer;
  Height: Integer;
  {$ifdef gtk1}
  Visual: PGdkVisual;
  {$endif}
  TypeAsStr: String;
begin
  Result:=DbgS(AWindow);
  if AWindow=nil then exit;
  
  // window type
  WindowType:=gdk_window_get_type(AWindow);
  case WindowType of
  GDK_WINDOW_ROOT: TypeAsStr:='Root';
  GDK_WINDOW_TOPLEVEL: TypeAsStr:='TopLvl';
  GDK_WINDOW_CHILD: TypeAsStr:='Child';
  GDK_WINDOW_DIALOG: TypeAsStr:='Dialog';
  GDK_WINDOW_TEMP: TypeAsStr:='Temp';
  {$ifdef gtk1}
  GDK_WINDOW_PIXMAP: TypeAsStr:='Pixmap';
  {$endif gtk1}
  GDK_WINDOW_FOREIGN: TypeAsStr:='Foreign';
  else TypeAsStr:='Unknown';
  end;
  Result:=Result+' Type='+TypeAsStr;
  
  DebugLn(Result);
  // user data
  if WindowType in [GDK_WINDOW_ROOT,GDK_WINDOW_TOPLEVEL,GDK_WINDOW_CHILD,
    GDK_WINDOW_DIALOG]
  then begin
    p:=nil;
    gdk_window_get_user_data(AWindow,p);
    if GtkWidgetIsA(PGTKWidget(p),GTKAPIWidget_GetType) then begin
      Widget:=PGTKWidget(p);
      Result:=Result+'<Widget['+GetWidgetDebugReport(Widget)+']>';
    end else begin
      Result:=Result+'<UserData='+DbgS(p)+']>';
    end;
  end;

  // size
  gdk_window_get_size(AWindow,@Width,@Height);
  Result:=Result+' Size='+IntToStr(Width)+'x'+IntToStr(Height);

  {$ifdef gtk1}
  // visual
  Visual:=gdk_window_get_visual(AWindow);
  if Visual<>nil then begin
    if WindowType in [GDK_WINDOW_PIXMAP] then begin
      Result:=Result+' Depth='+IntToStr(Visual^.bits_per_rgb);
    end;
  end;
  {$endif gtk1}
end;

function GetStyleDebugReport(AStyle: PGTKStyle): string;
begin
  Result:='[';
  if AStyle=nil then
    Result:=Result+'nil'
  else begin
    Result:=Result+'FG[N]:='+GdkColorToStr(@AStyle^.fg[GTK_STATE_NORMAL])+' ';
    Result:=Result+'BG[N]:='+GdkColorToStr(@AStyle^.bg[GTK_STATE_NORMAL])+' ';
    Result:=Result+'Base[N]:='+GdkColorToStr(@AStyle^.base[GTK_STATE_NORMAL])+' ';
    Result:=Result+'BG_Pixmap[N]:='+DbgS(AStyle^.bg_pixmap[GTK_STATE_NORMAL])+' ';
    Result:=Result+'rc_style='+GetRCStyleDebugReport(AStyle^.rc_style);
  end;
  Result:=Result+']';
end;

function GetRCStyleDebugReport(AStyle: PGtkRcStyle): string;
begin
  Result:='[';
  if AStyle=nil then
    Result:=Result+'nil'
  else begin
    Result:=Result+'name="'+AStyle^.name+'" ';
{$IFDEF GTK1}
    Result:=Result+'font_name="'+AStyle^.font_name+'" ';
    Result:=Result+'fontset_name="'+AStyle^.fontset_name+'" ';
    Result:=Result+'FG[N]='+GdkColorToStr(@AStyle^.fg[GTK_STATE_NORMAL])+' ';
    Result:=Result+'BG[N]='+GdkColorToStr(@AStyle^.bg[GTK_STATE_NORMAL])+' ';
    Result:=Result+'Base[N]='+GdkColorToStr(@AStyle^.base[GTK_STATE_NORMAL])+' ';
    Result:=Result+'flagi='+intTostr(AStyle^.color_flags[GTK_STATE_NORMAL])+' ';
{$ELSE GTK2}
    Result:=Result+'font_desc=['+GetPangoDescriptionReport(AStyle^.font_desc)+'] ';
{$ENDIF GTK2}
    Result:=Result+'bg_pixmap_name[N]="'+AStyle^.bg_pixmap_name[GTK_STATE_NORMAL]+'" ';
{$IFDEF GTK1}
    Result:=Result+'engine='+DbgS(AStyle^.engine);
{$ENDIF GTK1}
  end;
  Result:=Result+']';
end;

{$IFDEF Gtk2}
function GetPangoDescriptionReport(Desc: PPangoFontDescription): string;
begin
  if Desc=nil then begin
    Result:='nil';
  end else begin
    Result:='family='+pango_font_description_get_family(Desc);
    Result:=Result+' size='+IntToStr(pango_font_description_get_size(Desc));
    Result:=Result+' weight='+IntToStr(pango_font_description_get_weight(Desc));
    Result:=Result+' variant='+IntToStr(pango_font_description_get_variant(Desc));
    Result:=Result+' style='+IntToStr(pango_font_description_get_style(Desc));
    Result:=Result+' stretch='+IntToStr(pango_font_description_get_stretch(Desc));
  end;
end;
{$ENDIF}

function WidgetFlagsToString(Widget: PGtkWidget): string;
begin
  Result:='[';
  if Widget=nil then
    Result:=Result+'nil'
  else begin
    if GTK_WIDGET_REALIZED(Widget) then
      Result:=Result+'R';
    if GTK_WIDGET_MAPPED(Widget) then
      Result:=Result+'M';
    if GTK_WIDGET_VISIBLE(Widget) then
      Result:=Result+'V';
    if GTK_WIDGET_DRAWABLE(Widget) then
      Result:=Result+'D';
    if GTK_WIDGET_CAN_FOCUS(Widget) then
      Result:=Result+'F';
    if GTK_WIDGET_RC_STYLE(Widget) then
      Result:=Result+'St';
    if  GTK_WIDGET_PARENT_SENSITIVE(Widget) then
      Result:=Result+'Pr';
  end;
  Result:=Result+']';
end;

function GdkColorToStr(Color: PGDKColor): string;
begin
  if Color=nil then
    Result:='nil'
  else
    Result:='R'+HexStr(Color^.Red,4)+'G'+HexStr(Color^.Green,4)
           +'B'+HexStr(Color^.Blue,4);
end;

function GetWidgetStyleReport(Widget: PGtkWidget): string;
var
  AStyle: PGtkStyle;
  ARCStyle: PGtkRcStyle;
begin
  Result:='';
  if Widget=nil then exit;
  AStyle:=gtk_widget_get_style(Widget);
  if AStyle=nil then begin
    Result:='nil';
    exit;
  end;
  Result:=Result+'attach_count='+dbgs(AStyle^.attach_count);
  ARCStyle:=AStyle^.rc_style;
  if ARCStyle=nil then begin
    Result:=Result+' rc_style=nil';
  end else begin
    Result:=Result+' rc_style=[';
{$IFDEF GTK1}
    Result:=Result+ARCStyle^.font_name+',';
    Result:=Result+ARCStyle^.fontset_name+',';
{$ELSE GTK1}
    Result:=Result+GetPangoDescriptionReport(AStyle^.font_desc);
{$ENDIF GTK1}
    Result:=Result+']';
  end;
end;

{------------------------------------------------------------------------------
  function WidgetIsDestroyingHandle(Widget: PGtkWidget): boolean;

  Tests if Destruction Mark is set.
 ------------------------------------------------------------------------------}
function WidgetIsDestroyingHandle(Widget: PGtkWidget): boolean;
begin
  Result:=gtk_object_get_data(PGtkObject(Widget),'LCLDestroyingHandle')<>nil;
end;

{------------------------------------------------------------------------------
  procedure SetWidgetIsDestroyingHandle(Widget: PGtkWidget);

  Marks widget for destruction.
 ------------------------------------------------------------------------------}
procedure SetWidgetIsDestroyingHandle(Widget: PGtkWidget);
begin
  gtk_object_set_data(PGtkObject(Widget),'LCLDestroyingHandle',Widget);
end;

{------------------------------------------------------------------------------
  function ComponentIsDestroyingHandle(AWinControl: TWinControl): boolean;

  Tests if Destruction Mark is set.
 ------------------------------------------------------------------------------}
function ComponentIsDestroyingHandle(AWinControl: TWinControl): boolean;
begin
  Result:=
    (AWinControl<>nil) and (AWinControl is TWinControl)
    and (AWinControl.HandleAllocated)
    and WidgetIsDestroyingHandle(PGtkWidget(AWinControl.Handle));
end;

{------------------------------------------------------------------------------
  function LockOnChange(GtkObject: PGtkObject; LockOffset: integer): integer;

  Adds LockOffset to the OnChangeLock and returns the result.
 ------------------------------------------------------------------------------}
function LockOnChange(GtkObject: PGtkObject; LockOffset: integer): integer; 
var
  Info: PWidgetInfo;
begin
  Info := GetWidgetInfo(GtkObject, True);
  if Info = nil
  then begin
    Result := 0;
    Exit;
  end;
  
  Inc(Info^.ChangeLock, LockOffset);
  Result := Info^.ChangeLock;
end;

{------------------------------------------------------------------------------
  procedure HideCaretOfWidgetGroup(ChildWidget: PGtkWidget;
    var MainWidget: PGtkWidget; var CaretWasVisible: boolean);

  Find main widget and if it is a API widget, hide caret.
 ------------------------------------------------------------------------------}
procedure HideCaretOfWidgetGroup(ChildWidget: PGtkWidget;
  var MainWidget: PGtkWidget; var CaretWasVisible: boolean);
var
  LCLObject: TObject;
  IsAPIWidget: Boolean;
begin
  MainWidget:=ChildWidget;
  LCLObject:=GetNearestLCLObject(ChildWidget);
  if (LCLObject is TWinControl) then
    MainWidget:=PGtkWidget(TWinControl(LCLObject).Handle);
  IsAPIWidget:=GtkWidgetIsA(MainWidget,GTKAPIWidget_GetType);
  CaretWasVisible:=false;
  if IsAPIWidget then
    GTKAPIWidget_HideCaret(PGTKAPIWidget(MainWidget),CaretWasVisible);
end;

procedure SetFormShowInTaskbar(AForm: TCustomForm;
  const AValue: TShowInTaskbar);
var
  Enable: boolean;
  Widget: PGtkWidget;
begin
  if (AForm.Parent<>nil) or not (AForm.HandleAllocated) then exit;
  Widget:=PGtkWidget(AForm.Handle);
  if Widget^.Window=nil then begin
    // widget not yet realized
    exit;
  end;

  Enable := AValue <> stNever;
  if (AValue = stDefault)
  and (Application<>nil) and (Application.MainForm <> nil)
  and (Application.MainForm <> AForm) then
    Enable := false;

  //debugln('SetGtkWindowShowInTaskbar ',DbgSName(AForm),' ',dbgs(Enable));
  SetGtkWindowShowInTaskbar(PGtkWindow(Widget),Enable);
end;

procedure SetGtkWindowShowInTaskbar(AGtkWindow: PGtkWindow; Value: boolean);
begin
  {$IFDEF GTK1}
  if PgtkWidget(AGtkWindow)^.Window=nil then begin
    // widget not yet realized
    exit;
  end;
  GDK_WINDOW_SHOW_IN_TASKBAR(PGdkWindowPrivate(PGtkWidget(AGtkWindow)^.Window),
                             Value);
  {$ELSE}
  gtk_window_set_skip_taskbar_hint(AGtkWindow, not Value);
  {$ENDIF}
end;

procedure SetWindowFullScreen(AForm: TCustomForm; const AValue: Boolean);
{$IFDEF GTK1}
var
  XDisplay: PDisplay;
  XScreen: PScreen;
  XRootWindow,
  XWindow: TWindow;
  XEvent: TXClientMessageEvent;
  _NET_WM_STATE: Integer;
  //_NET_WM_STATE_MODAL: Integer;
  //_NET_WM_STATE_ABOVE: Integer;
  //_NET_WM_STATE_FULLSCREEN: Integer;
  _NET_WM_STATE_ATOMS: array [0..2] of Integer;
  I: Integer;
{$ENDIF}
begin
  {$IFDEF GTK2}
   If AValue then
   GTK_Window_FullScreen(PGTKWindow(AForm.Handle)) else
   GTK_Window_UnFullScreen(PGTKWindow(AForm.Handle));
  {$ENDIF}
  {$IFDEF GTK1}
  XDisplay := gdk_display;
  XScreen := XDefaultScreenOfDisplay(xdisplay);
  XRootWindow := XRootWindowOfScreen(xscreen);
  XWindow := FormToX11Window(AForm);

  _NET_WM_STATE := XInternAtom(xdisplay, '_NET_WM_STATE', false);
  //_NET_WM_STATE_MODAL := XInternAtom(xdisplay, '_NET_WM_STATE_MODAL', false);
  //_NET_WM_STATE_ABOVE := XInternAtom(xdisplay, '_NET_WM_STATE_ABOVE', false);
  //_NET_WM_STATE_FULLSCREEN := XInternAtom(xdisplay, '_NET_WM_STATE_FULLSCREEN', false);
  _NET_WM_STATE_ATOMS[0] := XInternAtom(xdisplay, '_NET_WM_STATE_MODAL', false);
  _NET_WM_STATE_ATOMS[1] := XInternAtom(xdisplay, '_NET_WM_STATE_ABOVE', false);
  _NET_WM_STATE_ATOMS[2] := XInternAtom(xdisplay, '_NET_WM_STATE_FULLSCREEN', false);

  for I := 0 to 2 do begin
    XEvent._type := ClientMessage;
    XEvent.window := XWindow;
    XEvent.message_type := _NET_WM_STATE;
    XEvent.format := 32;
    XEvent.data.l[0] := Ord(AValue);// 0=Remove 1=Add 2=Toggle
    XEvent.data.l[1] := _NET_WM_STATE_ATOMS[I];

    XSendEvent(XDisplay, XRootWindow, False, SubstructureNotifyMask, PXEvent(@XEvent));
  end;
   {$ENDIF}
end;

procedure GrabKeyBoardToForm(AForm: TCustomForm);
begin
  {$IFDEF HasGtkX}
  XGrabKeyboard(gdk_display, FormToX11Window(AForm), true, GrabModeASync,
                GrabModeASync, CurrentTime);
  {$ENDIF}
end;

procedure ReleaseKeyBoardFromForm(AForm: TCustomForm);
begin
  {$IFDEF HasGtkX}
  XUngrabKeyboard(gdk_display, CurrentTime);
  {$ENDIF}
end;

procedure GrabMouseToForm(AForm: TCustomForm);
{$IFDEF HasGtkX}
var
  eventMask: LongInt;
begin
  eventMask := ButtonPressMask or ButtonReleaseMask
               or PointerMotionMask or PointerMotionHintMask;

  XGrabPointer(gdk_display, FormToX11Window(AForm), true,
               eventMask, GrabModeASync, GrabModeAsync,  FormToX11Window(AForm),
               None, CurrentTime);
end;
{$ELSE}
begin
end;
{$ENDIF}

procedure ReleaseMouseFromForm(AForm: TCustomForm);
begin
  {$IFDEF HasGtkX}
  XUngrabPointer(gdk_display, CurrentTime);
  {$ENDIF}
end;

{$IFDEF HasGtkX}
function FormToX11Window(const AForm: TCustomForm): X.TWindow;
var
  GdkWindow: PGdkWindowPrivate;
  Widget: PGtkWidget;
begin
  Result:=0;
  if (AForm=nil) or (not AForm.HandleAllocated) then exit;
  Widget:=PGtkWidget(AForm.Handle);
  GdkWindow := PGdkWindowPrivate(Widget^.window);
  if GdkWindow=nil then exit;
  Result := GdkWindow^.xwindow;
end;
{$ENDIF}

{------------------------------------------------------------------------------
  procedure SetComboBoxText(ComboWidget: PGtkCombo; const NewText: string);

  Sets the text of the combobox entry.
 ------------------------------------------------------------------------------}
procedure SetComboBoxText(ComboWidget: PGtkCombo; NewText: PChar);
begin
  //DebugLn('SetComboBoxText ',DbgS(ComboWidget),' "',NewText,'"');
  // lock combobox, so that no OnChange event is fired
  LockOnChange(PGtkObject(ComboWidget^.entry),+1);
  LockOnChange(PGtkObject(ComboWidget^.list),+1);
  // set text
  if NewText = nil then NewText:=#0; // gtk expects at least a #0
  gtk_entry_set_text(PGtkEntry(ComboWidget^.entry), NewText);
  // unlock combobox
  LockOnChange(PGtkObject(ComboWidget^.list),-1);
  LockOnChange(PGtkObject(ComboWidget^.entry),-1);
end;

function GetComboBoxText(ComboWidget: PGtkCombo): string;
begin
  Result:=StrPas(gtk_entry_get_text(PGtkEntry(ComboWidget^.entry)));
end;

{------------------------------------------------------------------------------
  function GetComboBoxItemIndex(ComboBox: TCustomComboBox): integer;

  Returns the current ItemIndex of a TComboBox
 ------------------------------------------------------------------------------}
function GetComboBoxItemIndex(ComboBox: TCustomComboBox): integer;
var
  ComboWidget: PGtkCombo;
  ComboStrings: TStrings;
  CurText: String;
begin
  if not ComboBox.HandleAllocated then
    RaiseGDBException('');
  ComboWidget:=PGtkCombo(ComboBox.Handle);
  ComboStrings:=ComboBox.items;
//  TStrings(gtk_object_get_data(PGtkObject(ComboWidget),GtkListItemLCLListTag));
  CurText:=GetComboBoxText(ComboWidget);
  Result:=ComboStrings.IndexOf(CurText);
end;

{------------------------------------------------------------------------------
  procedure SetComboBoxItemIndex(ComboBox: TCustomComboBox; Index: integer);

  Returns the current ItemIndex of a TComboBox
 ------------------------------------------------------------------------------}
procedure SetComboBoxItemIndex(ComboBox: TCustomComboBox; Index: integer);
var
  ComboWidget: PGtkCombo;
  ComboStrings: TStrings;
begin
  ComboWidget:=PGtkCombo(ComboBox.Handle);
  LockOnChange(PGtkObject(ComboWidget),+1);
  gtk_list_select_item(PGtkList(ComboWidget^.list),Index);
  if Index>=0 then begin
    ComboStrings:=TStrings(gtk_object_get_data(PGtkObject(ComboWidget),GtkListItemLCLListTag));
    if Index < ComboStrings.Count
    then SetComboBoxText(ComboWidget, PChar(ComboStrings[Index]))
    else SetComboBoxText(ComboWidget, '#error#');
  end;
  LockOnChange(PGtkObject(ComboWidget),-1);
end;

procedure SetLabelAlignment(LabelWidget: PGtkLabel;
  const NewAlignment: TAlignment);
const
  cLabelAlignX : array[TAlignment] of gfloat = (0.0, 1.0, 0.5);
  cLabelAlignY : array[TTextLayout] of gfloat = (0.0, 0.5, 1.0);
  cLabelAlign : array[TAlignment] of TGtkJustification =
    (GTK_JUSTIFY_LEFT, GTK_JUSTIFY_RIGHT, GTK_JUSTIFY_CENTER);
begin
  gtk_label_set_justify(LabelWidget, cLabelAlign[NewAlignment]);
  gtk_misc_set_alignment(GTK_MISC(LabelWidget), cLabelAlignX[NewAlignment],
                        cLabelAlignY[tlTop]);
end;

{------------------------------------------------------------------------------
  function GtkPaintMessageToPaintMessage(var GtkPaintMsg: TLMGtkPaint;
    FreeGtkPaintMsg: boolean): TLMPaint;

  Converts a LM_GtkPaint message to a LM_PAINT message
 ------------------------------------------------------------------------------}
function GtkPaintMessageToPaintMessage(var GtkPaintMsg: TLMGtkPaint;
  FreeGtkPaintMsg: boolean): TLMPaint;
var
  PS : PPaintStruct;
  Widget: PGtkWidget;
begin
  Result.Msg:=LM_PAINT;
  New(PS);
  PS^.hDC:=0;
  Widget:=GtkPaintMsg.Data.Widget;
  If GtkPaintMsg.Data.RepaintAll then
    PS^.rcPaint := Rect(0,0,Widget^.Allocation.Width,Widget^.Allocation.Height)
  else
    PS^.rcPaint := GtkPaintMsg.Data.Rect;

  Result.DC:=BeginPaint(THandle(Widget), PS^);
  Result.PaintStruct:=PS;
  Result.Result:=0;
  if FreeGtkPaintMsg then
    FreeThenNil(GtkPaintMsg.Data);
end;

procedure FinalizePaintMessage(Msg: PLMessage);
var
  PS : PPaintStruct;
  DC : TDeviceContext;
begin
  if (Msg^.Msg=LM_PAINT) or (Msg^.Msg=LM_INTERNALPAINT) then begin
    If Msg^.LParam <> 0 then begin
       PS := PPaintStruct(Msg^.LParam);
       If Msg^.WParam<>0 then
         DC := TDeviceContext(Msg^.WParam)
       else
         DC := TDeviceContext(PS^.hdc);
       EndPaint(THandle(DC.wnd), PS^);
       Dispose(PS);
       Msg^.LParam:=0;
       Msg^.WParam:=0;
    end else
      if Msg^.WParam<>0 then begin
        ReleaseDC(0,Msg^.WParam);
        Msg^.WParam:=0;
      end;
  end else
  if Msg^.Msg=LM_GtkPAINT then begin
    FreeThenNil(TLMGtkPaintData(Msg^.WParam));
  end;
end;

procedure FinalizePaintTagMsg(Msg: PMsg);
var
  PS : PPaintStruct;
  DC : TDeviceContext;
begin
  if (Msg^.Message=LM_PAINT) or (Msg^.Message=LM_INTERNALPAINT) then begin
    If Msg^.LParam <> 0 then begin
       PS := PPaintStruct(Msg^.LParam);
       If Msg^.WParam<>0 then
         DC := TDeviceContext(Msg^.WParam)
       else
         DC := TDeviceContext(PS^.hdc);
       EndPaint(THandle(DC.wnd), PS^);
       Dispose(PS);
       Msg^.LParam:=0;
       Msg^.WParam:=0;
    end else
      if Msg^.WParam<>0 then begin
        ReleaseDC(0,Msg^.WParam);
        Msg^.WParam:=0;
      end;
  end else
  if Msg^.Message=LM_GtkPAINT then begin
    FreeThenNil(TObject(Msg^.WParam));
  end;
end;

procedure SetGCRasterOperation(TheGC: PGDKGC; Rop: Cardinal);
begin
  Case ROP of
    WHITENESS,
    BLACKNESS,
    SRCCOPY :
      GDK_GC_Set_Function(TheGC, GDK_Copy);
    SRCPAINT :
      GDK_GC_Set_Function(TheGC, GDK_NOOP);
    SRCAND :
      GDK_GC_Set_Function(TheGC, GDK_Clear);
    SRCINVERT :
      GDK_GC_Set_Function(TheGC, GDK_XOR);
    SRCERASE :
      GDK_GC_Set_Function(TheGC, GDK_AND);
    NOTSRCCOPY :
      GDK_GC_Set_Function(TheGC, GDK_OR_REVERSE);
    NOTSRCERASE :
      GDK_GC_Set_Function(TheGC, GDK_AND);
    MERGEPAINT :
      GDK_GC_Set_Function(TheGC, GDK_Copy_Invert);
    DSTINVERT :
      GDK_GC_Set_Function(TheGC, GDK_INVERT);
    else begin
      gdk_gc_set_function(TheGC, GDK_COPY);
      DebugLn('WARNING: [SetRasterOperation] Got unknown/unsupported CopyMode!!');
    end;
  end;
end;

procedure MergeClipping(DestinationDC: TDeviceContext; DestinationGC: PGDKGC;
  X, Y, Width, Height: integer; ClipMergeMask: PGdkPixmap;
  ClipMergeMaskX, ClipMergeMaskY: integer;
  var NewClipMask: PGdkPixmap);
// merge ClipMergeMask into the destination clipping mask at the
// destination rectangle
var
  temp_gc : PGDKGC;
  temp_color : TGDKColor;
  Region: PGdiObject;
  RGNType : Longint;
  OffsetXY: TPoint;
  //ClipMergeMaskWidth, ClipMergeMaskHeight: integer;
begin
  {$IFDEF VerboseStretchCopyArea}
  DebugLn('MergeClipping START DestinationDC=',DbgS(DestinationDC),
    ' DestinationGC=',DbgS(DestinationGC),
    ' X='+dbgs(X),' Y='+dbgs(Y),' Width='+dbgs(Width),' Height='+dbgs(Height),
    ' ClipMergeMask=',DbgS(ClipMergeMask),
    ' ClipMergeMaskX=',dbgs(ClipMergeMaskX),' ClipMergeMaskY=',dbgs(ClipMergeMaskY));
  {$ENDIF}

  // activate clipping region of destination
  SelectGDIRegion(HDC(DestinationDC));
  NewClipMask := nil;
  if (ClipMergeMask = nil) then exit;

  BeginGDKErrorTrap;
  // create temporary mask with the size of the destination rectangle
  NewClipMask := PGdkBitmap(gdk_pixmap_new(nil, width, height, 1));
  // create temporary GC for combination mask
  temp_gc := gdk_gc_new(NewClipMask);
  gdk_gc_set_clip_region(temp_gc, nil); // no default clipping
  gdk_gc_set_clip_rectangle(temp_gc, nil);

  // clear mask
  temp_color.pixel := 0;
  gdk_gc_set_foreground(temp_gc, @temp_color);
  gdk_draw_rectangle(NewClipMask, temp_gc, 1, 0, 0, width, height);
  gdk_draw_rectangle(NewClipMask, temp_gc, 0, 0, 0, width, height);

  // copy the destination clipping mask into the temporary mask
  with DestinationDC do begin
    If (ClipRegion <> 0) then begin
      Region:=PGDIObject(ClipRegion);
      RGNType := RegionType(Region^.GDIRegionObject);
      If (RGNType <> ERROR) and (RGNType <> NULLREGION) then begin
        // destination has a clipping mask
        {$IFDEF VerboseStretchCopyArea}
        DebugLn('MergeClipping Destination has clipping mask -> apply to temp GC');
        {$ENDIF}
        // -> copy the destination clipping mask to the temporary mask
        //    The X,Y coordinate in the destination relates to
        //    0,0 in the temporary mask.
        //    The clip region of dest is always at 0,0 in dest
        OffsetXY:=Point(-X,-Y);
        // 1. Move the region
        gdk_region_offset(Region^.GDIRegionObject,OffsetXY.X,OffsetXY.Y);
        // 2. Apply region to temporary mask
        gdk_gc_set_clip_region(temp_gc, Region^.GDIRegionObject);
        // 3. Undo moving the region
        gdk_region_offset(Region^.GDIRegionObject,-OffsetXY.X,-OffsetXY.Y);
      end;
    end;
  end;

  // merge the source clipping mask into the temporary mask
  //gdk_window_get_size(ClipMergeMask,@ClipMergeMaskWidth,@ClipMergeMaskHeight);
  //DebugLn('MergeClipping A MergeMask Size=',ClipMergeMaskWidth,',',ClipMergeMaskHeight);
  gdk_draw_pixmap(NewClipMask, temp_gc,
                  ClipMergeMask, ClipMergeMaskX, ClipMergeMaskY,
                  0, 0, Width, Height);

  // free the temporary GC
  gdk_gc_destroy(temp_gc);

  // apply the new mask to the destination GC
  // The new mask has only the size of the destination rectangle, not of
  // the whole destination. Apply it to destination and move it to the right
  // position.
  gdk_gc_set_clip_mask(DestinationGC, NewClipMask);
  gdk_gc_set_clip_origin(DestinationGC, x, y);
  EndGDKErrorTrap;
end;

procedure ResetGCClipping(DC: HDC; GC: PGDKGC);
begin
  BeginGDKErrorTrap;
  gdk_gc_set_clip_mask(GC, nil);
  gdk_gc_set_clip_origin (GC, 0,0);
  SelectGDIRegion(DC);
  EndGDKErrorTrap;
end;

function ScalePixmap(ScaleGC: PGDKGC;
  SrcPixmap: PGdkPixmap; SrcX, SrcY, SrcWidth, SrcHeight: integer;
  SrcColorMap: PGdkColormap;
  NewWidth, NewHeight: integer;
  var NewPixmap: PGdkPixmap) : Boolean;
{$Ifndef NoGdkPixbufLib}
var
  ScaleSrc, ScaleDest: PGDKPixbuf;
  ShrinkWidth,
  ShrinkHeight : Boolean;
  ScaleMethod : TGDKINTERPTYPE;
  DummyMask: PGdkPixmap;
  SrcWholeWidth, SrcWholeHeight: integer;
  {$IFDEF VerboseStretchCopyArea}
  NewWholeWidth, NewWholeHeight: integer;
  {$ENDIF}
begin
  {$IFDEF VerboseStretchCopyArea}
  DebugLn('ScalePixmap ScaleGC=',DbgS(ScaleGC),
    ' SrcPixmap=[',GetWindowDebugReport(SrcPixmap),']',
    ' SrcX='+dbgs(SrcX),' SrcY='+dbgs(SrcY),' SrcWidth='+dbgs(SrcWidth),' SrcHeight='+dbgs(SrcHeight),
    ' NewPixmap=[',GetWindowDebugReport(NewPixmap),']',
    ' NewWidth='+dbgs(NewWidth),' NewHeight='+dbgs(NewHeight));
  {$ENDIF}
  Result := False;
  if SrcPixmap=nil then begin
    DebugLn('WARNING: ScalePixmap SrcPixmap=nil');
    exit;
  end;
  if NewPixmap<>nil then begin
    DebugLn('WARNING: ScalePixmap NewPixmap<>nil');
    exit;
  end;

  ScaleSRC := nil;
  ScaleDest := nil;

  gdk_window_get_size(PGDKWindow(SrcPixmap),@SrcWholeWidth,@SrcWholeHeight);
  if SrcX+SrcWidth>SrcWholeWidth then begin
    DebugLn('WARNING: ScalePixmap SrcX+SrcWidth>SrcWholeWidth');
  end;
  if SrcY+SrcHeight>SrcWholeHeight then begin
    DebugLn('WARNING: ScalePixmap SrcY+SrcHeight>SrcWholeHeight');
  end;

  // calculate ScaleMethod
  ShrinkWidth := NewWidth < SrcWidth;
  ShrinkHeight := NewHeight < SrcHeight;
  //GDKPixbuf Scaling is not done in the same way as Windows
  //but by rights ScaleMethod should really be chosen based
  //on the destination device's internal flag
  {GDK_INTERP_NEAREST,GDK_INTERP_TILES,
  GDK_INTERP_BILINEAR,GDK_INTERP_HYPER);}
  If ShrinkWidth and ShrinkHeight then
    ScaleMethod := GDK_INTERP_TILES
  else
    If ShrinkWidth or ShrinkHeight then
      ScaleMethod := GDK_INTERP_BILINEAR//GDK_INTERP_HYPER
    else
      ScaleMethod := GDK_INTERP_BILINEAR;

  // Creating PixBuf from pixmap
  {$IFDEF VerboseStretchCopyArea}
  DebugLn('ScalePixmap Creating PixBuf from pixmap SrcWhole='+dbgs(SrcWholeWidth),','+dbgs(SrcWholeHeight));
  {$ENDIF}
  ScaleSRC := gdk_pixbuf_get_from_drawable(nil,SrcPixmap,
    SrcColorMap,0,0,SrcX,SrcY,SrcWidth,SrcHeight);
  If ScaleSRC = nil then begin
    DebugLn('WARNING: ScalePixmap ScaleSRC=nil');
    exit;
  end;

  // Scaling PixBuf
  {$IFDEF VerboseStretchCopyArea}
  DebugLn('ScalePixmap Scaling PixBuf ',
    ' Width='+dbgs(gdk_pixbuf_get_width(ScaleSrc)),
    ' Height='+dbgs(gdk_pixbuf_get_height(ScaleSrc)),
    ' HasAlpha='+dbgs(gdk_pixbuf_get_has_alpha(ScaleSrc)),
    ' RowStride='+dbgs(gdk_pixbuf_get_rowstride(ScaleSrc)),
    '');
  {$ENDIF}
  ScaleDest := gdk_pixbuf_scale_simple(ScaleSRC,NewWidth,NewHeight,ScaleMethod);
  GDK_Pixbuf_Unref(ScaleSRC);
  If ScaleDest = nil then begin
    DebugLn('WARNING: ScalePixmap ScaleDest=nil');
    exit;
  end;
  BeginGDKErrorTrap;

  // Creating pixmap from scaled pixbuf
  {$IFDEF VerboseStretchCopyArea}
  DebugLn('ScalePixmap Creating pixmap from scaled pixbuf',
    ' Width='+dbgs(gdk_pixbuf_get_width(ScaleDest)),
    ' Height='+dbgs(gdk_pixbuf_get_height(ScaleDest)),
    ' HasAlpha='+dbgs(gdk_pixbuf_get_has_alpha(ScaleDest)),
    ' RowStride='+dbgs(gdk_pixbuf_get_rowstride(ScaleDest)),
    '');
  {$ENDIF}
  DummyMask:=nil;
  {$IFDEF VerboseGdkPixbuf}
  debugln('ScalePixmap A1');
  {$ENDIF}
  gdk_pixbuf_render_pixmap_and_mask(ScaleDest,NewPixmap,DummyMask,0);
  {$IFDEF VerboseGdkPixbuf}
  debugln('ScalePixmap A2');
  {$ENDIF}

  // clean up
  {$IFDEF VerboseStretchCopyArea}
  gdk_window_get_size(PGDKWindow(NewPixmap),@NewWholeWidth,@NewWholeHeight);
  DebugLn('ScalePixmap RESULT NewPixmap=',DbgS(NewPixmap),
    ' DummyMask=',DbgS(DummyMask),
    ' NewWidth='+dbgs(NewWholeWidth),' NewHeight='+dbgs(NewWholeHeight),
    '');
  {$ENDIF}
  if DummyMask<>nil then gdk_pixmap_unref(DummyMask);
  EndGDKErrorTrap;
  GDK_Pixbuf_Unref(ScaleDest);
  Result := True;
{$Else not NoGdkPixbufLib}
begin
  DebugLn('ScalePixmap GDKPixbuf support has been disabled, no stretching is available!');
  Result := True;
{$EndIf}
end;

procedure DrawImageListIconOnWidget(ImgList: TCustomImageList;
  Index: integer; DestWidget: PGTKWidget);
begin
  DrawImageListIconOnWidget(ImgList,Index,DestWidget,true,true,0,0);
end;

procedure DrawImageListIconOnWidget(ImgList: TCustomImageList;
  Index: integer; DestWidget: PGTKWidget;
  CenterHorizontally, CenterVertically: boolean;
  DestLeft, DestTop: integer);
// draw icon of imagelist centered on gdkwindow
var
  Bitmap, MaskBitmap: TBitmap;
  ImageRect: TRect;
  ImageWidth: Integer;
  ImageHeight: Integer;
  WindowWidth, WindowHeight: integer;
  DestDC: HDC;
begin
  //DebugLn('DrawImageListIconOnWidget A ',ImgList.Name,':',ImgList.ClassName,
  //  ' Index=',Index,
  //  ' DestWindow=[',GetWidgetDebugReport(DestWidget),']');
  if ImgList=nil then exit;
  if (Index<0) or (Index>=ImgList.Count) then exit;
  if (DestWidget=nil) then exit;
  ImgList.GetInternalImage(Index,Bitmap,MaskBitmap,ImageRect);
  ImageWidth:=ImageRect.Right-ImageRect.Left;
  ImageHeight:=ImageRect.Bottom-ImageRect.Top;
  if (ImageWidth<1) or (ImageHeight<1) then exit;
  
  WindowWidth:=DestWidget^.allocation.width;
  WindowHeight:=DestWidget^.allocation.height;
  if CenterHorizontally then
    DestLeft:=DestWidget^.allocation.x+((WindowWidth-ImageWidth) div 2);
  if CenterVertically then
    DestTop:=DestWidget^.allocation.y+((WindowHeight-ImageHeight) div 2);
  DestDC:=GetDC(HDC(DestWidget));

  //DebugLn('DrawImageListIconOnWidget B DestXY=',DestLeft,',',DestTop,
  //  ' DestWindowSize=',WindowWidth,',',WindowWidth,
  //  ' SrcRect=',ImageRect.Left,',',ImageRect.Top,',',ImageWidth,'x',ImageHeight);
  StretchBlt(DestDC, DestLeft,DestTop, ImageWidth, ImageHeight,
    Bitmap.Canvas.Handle,ImageRect.Left,ImageRect.Top,ImageWidth,ImageHeight,
    SRCCOPY);
  ReleaseDC(HDC(DestWidget),DestDC);
end;

function GetPGdkImageBitsPerPixel(Image: PGdkImage): cardinal;
begin
  Result:=Image^.bpp;
  if Result<Image^.Depth then
    Result:=Result*8;
end;

function CreateGdkBitmap(Window: PGdkWindow;
  Width, Height: integer): PGdkBitmap;
var
  DummyData: Pointer;
begin
  // I didn't found a simple gdk_bitmap_new function. So, I create some
  // dummy data and use gdk_bitmap_create_from_data
  GetMem(DummyData,(((Width*Height)+7) shr 3)+1);
  Result:=gdk_bitmap_create_from_data(Window,DummyData,Width,Height);
  FreeMem(DummyData);
end;

function ExtractGdkBitmap(Bitmap: PGdkBitmap; const SrcRect: TRect): PGdkBitmap;
var
  MaxRect: TRect;
  SourceRect: TRect;
  SrcWidth: Integer;
  SrcHeight: Integer;
  GC: PGdkGC;
begin
  Result:=nil;
  if Bitmap=nil then exit;
  MaxRect:=Rect(0,0,0,0);
  gdk_window_get_size(Bitmap,@MaxRect.Right,@MaxRect.Bottom);
  IntersectRect(SourceRect,SrcRect,MaxRect);
  SrcWidth:=SourceRect.Right-SourceRect.Left;
  SrcHeight:=SourceRect.Bottom-SourceRect.Top;
  DebugLn('ExtractGdkBitmap SourceRect=',dbgs(SourceRect));
  if (SrcWidth<1) or (SrcHeight<1) then exit;
  Result:=CreateGdkBitmap(nil,SrcWidth,SrcHeight);
  GC := GDK_GC_New(Result);
  gdk_window_copy_area(Result,GC,0,0,Bitmap,
                       SourceRect.Left,SourceRect.Top,SrcWidth,SrcHeight);
  GDK_GC_Unref(GC);
end;

{$IfDef Win32}
Procedure gdk_window_copy_area(Dest : PGDKWindow; GC : PGDKGC; DestX,
  DestY : Longint; SRC : PGDKWindow; XSRC, YSRC, Width, Height : Longint);
begin
  gdk_draw_pixmap(Dest, GC, Src, XSrc, YSrc, DestX, DestY, Width, Height);
End;
{$EndIf}

{------------------------------------------------------------------------------
  Function: AllocGDKColor
  Params:  AColor: A RGB color (TColor)
  Returns: an Allocated GDKColor

  Allocated a GDKColor from a winapi color
 ------------------------------------------------------------------------------}
function AllocGDKColor(const AColor: LongInt): TGDKColor;
begin
  with Result do
  begin
    Red :=   ((AColor shl 8) and $00FF00) or ((AColor       ) and $0000FF);
    Green := ((AColor      ) and $00FF00) or ((AColor shr 8 ) and $0000FF);
    Blue :=  ((AColor shr 8) and $00FF00) or ((AColor shr 16) and $0000FF);
  end;
  {$IFDEF DebugGDK}
  BeginGDKErrorTrap;
  {$ENDIF}
  gdk_colormap_alloc_color(gdk_colormap_get_system, @Result, False, True);
  {$IFDEF DebugGDK}
  EndGDKErrorTrap;
  {$ENDIF}
end;

{------------------------------------------------------------------------------
  Function: CopyDCData
  Params:  DestinationDC:  a dc to copy data to
           SourceDC: a dc to copy data from
  Returns: True if succesful

  Creates a copy DC from the given DC
 ------------------------------------------------------------------------------}
function CopyDCData(DestinationDC, SourceDC: TDeviceContext): Boolean;
var
  GCValues: TGDKGCValues;
begin
//  Assert(False, Format('Trace:> [CopyDCData] DestDC:0x%x, SourceDC:0x%x', [Integer(DestinationDC), Integer(SourceDC)]));
  Result := (DestinationDC <> nil) and (SourceDC <> nil);
  if Result
  then begin
    with DestinationDC do
    begin
      Wnd := SourceDC.Wnd;
      Drawable := SourceDC.Drawable;
      if GC<>nil then begin
        BeginGDKErrorTrap;
        gdk_gc_unref(GC);
        EndGDKErrorTrap;
        GC:=nil;
        DCFlags:=DCFlags-[dcfPenSelected];
      end;
      if (SourceDC.GC <> nil) and (Drawable <> nil) then begin
        BeginGDKErrorTrap;
        gdk_gc_get_values(SourceDC.GC, @GCValues);
        GC := gdk_gc_new_with_values(Drawable, @GCValues, 3 { $3FF});
        EndGDKErrorTrap;
        DCFlags:=DCFlags-[dcfPenSelected];
      end;
      
      Origin := SourceDC.Origin;
      SpecialOrigin := SourceDC.SpecialOrigin;
      PenPos := SourceDC.PenPos;
      
      if (dcfTextMetricsValid in SourceDC.DCFlags) then begin
        Include(DCFlags,dcfTextMetricsValid);
        DCTextMetric := SourceDC.DCTextMetric;
      end else
        Exclude(DCFlags,dcfTextMetricsValid);
      CurrentBitmap := SourceDC.CurrentBitmap;
      CurrentFont := SourceDC.CurrentFont;
      CurrentPen := SourceDC.CurrentPen;
      CurrentBrush := SourceDC.CurrentBrush;
      //CurrentPalette := SourceDC.CurrentPalette;
      CopyGDIColor(SourceDC.CurrentTextColor,CurrentTextColor);
      CopyGDIColor(SourceDC.CurrentBackColor,CurrentBackColor);
      ClipRegion := SourceDC.ClipRegion;

      SelectedColors := dcscCustom;
      SavedContext := nil;
    end;
  end;
//  Assert(False, Format('Trace:< [CopyDCData] DestDC:0x%x, SourceDC:0x%x --> %d', [Integer(DestinationDC), Integer(SourceDC), Integer(Result)]));
end;

Function RegionType(RGN: PGDKRegion) : Longint;
var
  aRect : TGDKRectangle;
  SimpleRGN: PGdkRegion;
begin
  {$IFDEF DebugGDK}
  BeginGDKErrorTrap;
  {$ENDIF}
  If RGN = nil then
    Result := ERROR
  else
    If gdk_region_empty(RGN) then
      Result := NULLREGION
  else begin
    gdk_region_get_clipbox(RGN,@aRect);
    SimpleRGN := gdk_region_rectangle(@aRect);
    if gdk_region_equal(SimpleRGN, RGN) then
      Result := SIMPLEREGION
    else
      Result := COMPLEXREGION;
    gdk_region_destroy(SimpleRGN);
  end;
  {$IFDEF DebugGDK}
  EndGDKErrorTrap;
  {$ENDIF}
end;

{------------------------------------------------------------------------------
  Procedure SelectGDIRegion(const DC: HDC);

  Applies the current clipping region of the DC (DeviceContext) to the
  gc (GDK Graphic context - pgdkGC)
 ------------------------------------------------------------------------------}
Procedure SelectGDIRegion(const DC: HDC);
var
  Region: PGdiObject;
  RGNType : Longint;
begin
  with TDeviceContext(DC) do
  begin
    {$IFDEF DebugGDK}
    BeginGDKErrorTrap;
    {$ENDIF}
    gdk_gc_set_clip_region(gc,  nil);
    gdk_gc_set_clip_rectangle (gc,  nil);
    If (ClipRegion <> 0) then begin
      Region:=PGDIObject(ClipRegion);
      RGNType := RegionType(Region^.GDIRegionObject);
      If (RGNType <> ERROR) and (RGNType <> NULLREGION) then begin
        gdk_gc_set_clip_region(gc,  PGDIObject(ClipRegion)^.GDIRegionObject);
      end;
    end;
    {$IFDEF DebugGDK}
    EndGDKErrorTrap;
    {$ENDIF}
   end;
end;

function GDKRegionAsString(RGN: PGDKRegion): string;
var
  aRect: TGDKRectangle;
begin
  Result:=DbgS(RGN);
  BeginGDKErrorTrap;
  gdk_region_get_clipbox(RGN,@aRect);
  EndGDKErrorTrap;
  Result:=Result+'(x='+IntToStr(Integer(aRect.x))+',y='+IntToStr(Integer(aRect.y))+',w='
                    +IntToStr(aRect.Width)+',h='+IntToStr(aRect.Height)+' '
                    +'Type='+IntToStr(RegionType(RGN))+')';
end;

function CreateRectGDKRegion(const ARect: TRect): PGDKRegion;
var
  GDkRect: TGDKRectangle;
begin
  GDkRect.x:=ARect.Left;
  GDkRect.y:=ARect.Top;
  GDkRect.Width:=ARect.Right-ARect.Left;
  GDkRect.Height:=ARect.Bottom-ARect.Top;
  {$IFDEF DebugGDK}
  BeginGDKErrorTrap;
  {$ENDIF}
  Result:=gdk_region_rectangle(@GDKRect);
  {$IFDEF DebugGDK}
  EndGDKErrorTrap;
  {$ENDIF}
end;

Procedure FreeGDIColor(GDIColor: PGDIColor);
begin
  if (cfColorAllocated in GDIColor^.ColorFlags) then begin
    if (GDIColor^.Colormap <> nil) then begin
      BeginGDKErrorTrap;
      gdk_colormap_free_colors(GDIColor^.Colormap,@(GDIColor^.Color), 1);
      EndGDKErrorTrap;
    end;
    //GDIColor.Color.Pixel := -1;
    Exclude(GDIColor^.ColorFlags,cfColorAllocated);
  end;
end;

procedure SetGDIColorRef(var GDIColor: TGDIColor; NewColorRef: TColorRef);
begin
  if GDIColor.ColorRef=NewColorRef then exit;
  FreeGDIColor(@GDIColor);
  GDIColor.ColorRef:=NewColorRef;
end;

Procedure AllocGDIColor(DC: hDC; GDIColor: PGDIColor);
var
  RGBColor : Longint;
begin
  if DC=0 then ;
  if not (cfColorAllocated in GDIColor^.ColorFlags) then begin
    RGBColor := ColorToRGB(GDIColor^.ColorRef);

    With GDIColor^.Color do begin
      Red := gushort(GetRValue(RGBColor)) shl 8;
      Green := gushort(GetGValue(RGBColor)) shl 8;
      Blue := gushort(GetBValue(RGBColor)) shl 8;
      Pixel := 0;
    end;

    {with TDeviceContext(DC) do
      If CurrentPalette <> nil then
        GDIColor.Colormap := CurrentPalette^.PaletteColormap
      else}
        GDIColor^.Colormap := GDK_Colormap_get_system;

    gdk_colormap_alloc_color(GDIColor^.Colormap, @(GDIColor^.Color),True,True);

    Include(GDIColor^.ColorFlags,cfColorAllocated);
  end;
end;

procedure BuildColorRefFromGDKColor(var GDIColor: TGDIColor);
begin
  GDIColor.ColorRef:=TGDKColorToTColor(GDIColor.Color);
  Include(GDIColor.ColorFlags,cfColorAllocated);
end;

Procedure EnsureGCColor(DC: hDC; ColorType: TDevContextsColorType;
  IsSolidBrush, AsBackground: Boolean);
var
  GC: PGDKGC;
  GDIColor: PGDIColor;

  procedure WarnAllocFailed(const foreground : TGdkColor);
  begin
    DebugLn('NOTE: EnsureGCColor.EnsureAsGCValues gdk_colormap_alloc_color failed ',
      ' Foreground=',
      DbgS(Foreground.red),',',
      DbgS(Foreground.green),',',
      DbgS(Foreground.blue),
      ' GDIColor^.ColorRef=',DbgS(GDIColor^.ColorRef)
      );
  end;

  Procedure EnsureAsGCValues;
  var
    AllocFG : Boolean;
    SysGCValues: TGdkGCValues;
  begin
    FreeGDIColor(GDIColor);
    SysGCValues:=GetSysGCValues(GDIColor^.ColorRef,
                               PGtkWidget(TDeviceContext(DC).Wnd));
    {$IFDEF DebugGDK}BeginGDKErrorTrap;{$ENDIF}
    With SysGCValues do begin
      gdk_gc_set_fill(GC, fill);
      AllocFG := Foreground.Pixel = 0;
      If AllocFG then
        if not gdk_colormap_alloc_color(GDK_Colormap_get_system,@Foreground,
                                        True,True)
        then begin
          WarnAllocFailed(Foreground);
        end;
      gdk_gc_set_foreground(GC, @foreground);
      Case Fill of
        GDK_TILED :
          If Tile <> nil then
          begin
            gdk_gc_set_ts_origin(GC, ts_x_origin, ts_y_origin);
            gdk_gc_set_tile(GC, Tile);
          end;
        GDK_STIPPLED,
        GDK_OPAQUE_STIPPLED:
          If stipple <> nil then begin
            gdk_gc_set_background(GC, @background);
            gdk_gc_set_ts_origin(GC, ts_x_origin, ts_y_origin);
            gdk_gc_set_stipple(GC, stipple);
          end;
      end;
      If AllocFG then
        gdk_colormap_free_colors(GDK_Colormap_get_system, @Foreground,1);
    end;
    {$IFDEF DebugGDK}EndGDKErrorTrap;{$ENDIF}
  end;

  Procedure EnsureAsColor;
  begin
    AllocGDIColor(DC, GDIColor);
    //DebugLn('EnsureAsColor ',DbgS(GDIColor^.ColorRef),' AsBackground=',AsBackground);
    {$IFDEF DebugGDK}BeginGDKErrorTrap;{$ENDIF}
    If AsBackground then
      gdk_gc_set_background(GC, @(GDIColor^.Color))
    else begin
      gdk_gc_set_fill(GC, GDK_SOLID);
      gdk_gc_set_foreground(GC, @(GDIColor^.Color));
    end;
    {$IFDEF DebugGDK}EndGDKErrorTrap;{$ENDIF}
  end;

begin
  GC:=TDeviceContext(DC).GC;
  GDIColor:=nil;
  with TDeviceContext(DC) do
  begin
    case ColorType of
    dccCurrentBackColor: GDIColor:=@CurrentBackColor;
    dccCurrentTextColor: GDIColor:=@CurrentTextColor;
    dccGDIBrushColor   : GDIColor:=@(CurrentBrush^.GDIBrushColor);
    dccGDIPenColor     : GDIColor:=@(CurrentPen^.GDIPenColor);
    end;
  end;
  if GDIColor=nil then exit;
  
  // FPC bug workaround:
  // clScrollbar = $80000000 can't be used in case statements
  if TColor(GDIColor^.ColorRef)=clScrollbar then begin
    //often have a BK Pixmap
    If IsSolidBrush then
      EnsureAsGCValues
    else
      EnsureAsColor;//GC's with Pixmaps can't work w/Hatch's (yet)
    exit;
  end;
  
  Case TColor(GDIColor^.ColorRef) of
    //clScrollbar: see above
    clInfoBk,
    clMenu,
    clHighlight,
    clHighlightText,
    clBtnFace,
    clWindow,
    clForm:
      //often have a BK Pixmap
      If IsSolidBrush then
        EnsureAsGCValues
      else
        EnsureAsColor;//GC's with Pixmaps can't work w/Hatch's (yet)

    clBtnShadow,
    clBtnHighlight,
    clBtnText,
    clInfoText,
    clWindowText,
    clMenuText,
    clGrayText:
      //should never have a BK Pixmap
      EnsureAsGCValues;
    else
      EnsureAsColor;
  end;
end;

procedure CopyGDIColor(var SourceGDIColor, DestGDIColor: TGDIColor);
begin
  SetGDIColorRef(DestGDIColor,SourceGDIColor.ColorRef);
end;

function IsBackgroundColor(Color: TColor): boolean;
begin
  Result:=(Color=clForm) or (Color=clInfoBk) or (Color=clBackground);
end;

function CompareGDIColor(const Color1, Color2: TGDIColor): boolean;
begin
  Result:=Color1.ColorRef=Color2.ColorRef;
end;

function CompareGDIFill(const Fill1, Fill2: TGdkFill): boolean;
begin
  Result:=Fill1=Fill2;
end;

function CompareGDIBrushes(Brush1, Brush2: PGdiObject): boolean;
begin
  Result:=Brush1^.IsNullBrush=Brush2^.IsNullBrush;
  if Result then begin
    Result:=CompareGDIColor(Brush1^.GDIBrushColor,Brush2^.GDIBrushColor);
    if Result then begin
      Result:=CompareGDIFill(Brush1^.GDIBrushFill,Brush2^.GDIBrushFill);
      if Result then begin
        Result:=Brush1^.GDIBrushPixMap=Brush2^.GDIBrushPixMap;
      end;
    end;
  end;
end;

//-----------------------------------------------------------------------------

{ Palette Index<->RGB Hash Functions }

type
  TIndexRGB = record
    Index: longint;
    RGB: longint;
  end;
  PIndexRGB = ^TIndexRGB;

function GetIndexAsKey(p: pointer): pointer;
begin
  Result:=Pointer(PIndexRGB(p)^.Index + 1);
end;

function GetRGBAsKey(p: pointer): pointer;
begin
  Result:=Pointer(PIndexRGB(p)^.RGB + 1);
end;

function PaletteIndexToIndexRGB(Pal : PGDIObject; I : longint): PIndexRGB;
var
  HashItem: PDynHashArrayItem;
begin
  Result := nil;
  HashItem:=Pal^.IndexTable.FindHashItemWithKey(Pointer(I + 1));
  if HashItem<>nil then
    Result:=PIndexRGB(HashItem^.Item);
end;

function PaletteRGBToIndexRGB(Pal : PGDIObject; RGB : longint): PIndexRGB;
var
  HashItem: PDynHashArrayItem;
begin
  Result := nil;
  HashItem:=Pal^.RGBTable.FindHashItemWithKey(Pointer(RGB + 1));
  if HashItem<>nil then
    Result:=PIndexRGB(HashItem^.Item);
end;

{ Palette Index<->RGB lookup Functions }

function PaletteIndexExists(Pal : PGDIObject; I : longint): Boolean;
begin
  Result := Pal^.IndexTable.ContainsKey(Pointer(I + 1));
end;

function PaletteRGBExists(Pal : PGDIObject; RGB : longint): Boolean;
begin
  Result := Pal^.RGBTable.ContainsKey(Pointer(RGB + 1));
end;

function PaletteAddIndex(Pal : PGDIObject; I, RGB : Longint): Boolean;
var
  IndexRGB: PIndexRGB;
begin
  New(IndexRGB);
  IndexRGB^.Index:=I;
  IndexRGB^.RGB:=RGB;
  Pal^.IndexTable.Add(IndexRGB);
  Result := PaletteIndexExists(Pal, I);
  If Not Result then
    Dispose(IndexRGB)
  else begin
    Pal^.RGBTable.Add(IndexRGB);
    Result := PaletteRGBExists(Pal, RGB);
    If not Result then begin
      Pal^.IndexTable.Remove(IndexRGB);
      Dispose(IndexRGB);
    end;
  end;
end;

function PaletteDeleteIndex(Pal : PGDIObject; I : Longint): Boolean;
var
  RGBIndex : PIndexRGB;
begin
  RGBIndex := PaletteIndextoIndexRGB(Pal,I);
  Result := RGBIndex = nil;
  If not Result then begin
    Pal^.IndexTable.Remove(RGBIndex);
    If PaletteRGBExists(Pal, RGBIndex^.RGB) then
      Pal^.RGBTable.Remove(RGBIndex);
    Dispose(RGBIndex);
  end;
end;

function PaletteIndexToRGB(Pal : PGDIObject; I : longint): longint;
var
  RGBIndex : PIndexRGB;
begin
  RGBIndex := PaletteIndextoIndexRGB(Pal,I);
  if RGBIndex = nil then
    Result := -1//InvalidRGB
  else
    Result := RGBIndex^.RGB;
end;

function PaletteRGBToIndex(Pal : PGDIObject; RGB : longint): longint;
var
  RGBIndex : PIndexRGB;
begin
  RGBIndex := PaletteRGBtoIndexRGB(Pal,RGB);
  if RGBIndex = nil then
    Result:=-1//InvalidIndex
  else
    Result := RGBIndex^.Index;
end;

procedure InitializePalette(const Pal: PGDIObject; const Entries: PPaletteEntry; const RGBCount: Longint);
var
  I: Integer;
  RGBValue: Longint;
begin
  for I := 0 to RGBCount - 1 do
  begin
    if PaletteIndexExists(Pal, I) then
      PaletteDeleteIndex(Pal, I);
    with Entries[I] do
      RGBValue := RGB(peRed, peGreen, peBlue) {or (peFlags shl 32)??};
    if not PaletteRGBExists(Pal, RGBValue) then
      PaletteAddIndex(Pal, I, RGBValue);
  end;
end;

{------------------------------------------------------------------------------
  Procedure: KeySymToVKeyArray
  Params:    AKeySym: The keysym the array is requested for
             ACreate: True if the array should be created if it does not exist
  Returns:   PVKeyArray: The VKey array for the LSByte of KeySym

  Retrieves or constructs a VKeyArray for VK lookup on KeySyms.
 ------------------------------------------------------------------------------}
function KeySymToVKeyArray(const AKeySym: Cardinal; const ACreate: Boolean): PVKeyArray1;
var
  K: Byte;
  P2: PVKeyArray2;
  P3: PVKeyArray3;
begin
  Result := nil;

  K := Byte(AKeySym shr 24);
  P3 := MKeySymToVK[K];
  if P3 = nil
  then begin
    if not ACreate then Exit;
    New(P3);
    FillChar(P3^, SizeOf(P3^), 0);
    MKeySymToVK[K] := P3;
  end;

  K := Byte(AKeySym shr 16);
  P2 := P3^[K];
  if P2 = nil
  then begin
    if not ACreate then Exit;
    New(P2);
    FillChar(P2^, SizeOf(P2^), 0);
    P3^[K] := P2;
  end;

  K := Byte(AKeySym shr 8);
  Result := P2^[K];
  if Result = nil
  then begin
    if not ACreate then Exit;
    New(Result);
    FillChar(Result^, SizeOf(Result^), 0);
    P2^[K] := Result;
  end;
end;

{------------------------------------------------------------------------------
  Procedure: KeySymToVKey
  Params:    AKeySym: The keysym the array is requested for
  Returns:   The VKey for the KeySym

  Retrieves a VKey for a KeySyms.
 ------------------------------------------------------------------------------}
function KeySymToVKey(const AKeySym: Cardinal): TVKeyRecord;
var
  P: PVKeyArray1;
begin
  P := KeySymToVKeyArray(AKeySym, False);
  if P = nil
  then begin
    Result.VKey := $FF;
    Result.Flags := $FF;
  end
  else begin
    Result := P^[AKeySym and $FF];
  end;
end;

function HandleGTKKeyUpDown(Widget: PGtkWidget; Event: PGdkEventKey;
  Data: gPointer; BeforeEvent: boolean) : GBoolean;
{off $DEFINE VerboseKeyboard}
var
  Msg: TLMKey;
  EventStopped: Boolean;
  EventString: PChar; // GTK1 and GTK2 workaround
                      // (and easy access to bytes)
  Character: TUTF8Char;
  SysKey: Boolean;

  VKey: TVKeyRecord;
  CommonKeyData: Integer;
  Flags: Integer;
  FocusedWidget: PGtkWidget;
  LCLObject: TObject;
  FocusedWinControl: TWinControl;
  HandledByLCL: Boolean;
  TargetWidget: PGtkWidget;
  TargetData: gPointer;
  KeyPressesChar: char;

  procedure StopKeyEvent(const AnEventName: PChar);
  begin
    {$IFDEF VerboseKeyboard}
    DebugLn('StopKeyEvent AnEventName="',AnEventName,'" BeforeEvent=',dbgs(BeforeEvent));
    {$ENDIF}
    if not EventStopped
    then begin
      g_signal_stop_emission_by_name(PGtkObject(Widget), AnEventName);
      EventStopped := True;
    end;

    //MWE: still need to skip on win32 ?
    {MWE:.$IfNDef Win32}
    if EventString <> nil
    then begin
      gdk_event_key_set_string(Event,#0);
      Event^.length:=0;
    end;
    {MWE:.$EndIf}

    Event^.KeyVal := 0;
  end;

  function CanSendChar: Boolean;
  begin
    Result := False;
    //debugln('GDK_KEY_PRESS CanSendChar BeforeEvent=',dbgs(BeforeEvent),' Event^.Length=',dbgs(Event^.Length),' Event^.KeyVal=',dbgs(Event^.KeyVal),'=$',HexStr(Event^.KeyVal,4),' ',binStr(Event^.State,16));
    if Event^.Length > 1 then Exit;

    // to be delphi compatible we should not send a space here
    if Event^.KeyVal = GDK_KEY_KP_SPACE then Exit;

    // Check if CTRL is pressed
    if ((Event^.State and GDK_CONTROL_MASK) <> 0)
    then begin
      // Check if we pressed ^@
      if (Event^.Length = 0)
      and (Event^.KeyVal = GDK_KEY_AT)
      then begin
        Result := True;
        Exit;
      end;
      // check if we send the ^Char subset
      if (Event^.Length = 1) and (EventString <> nil)
      then begin
        Result := (EventString^ > #0) and (EventString^ < ' ');
      end;
      Exit;
    end;
    Result := (Event^.Length>0);
              //and (not (Event^.KeyVal in [0..$F000,GDK_KP_0..GDK_KP_9]);
  end;
  
  function KeyAlreadyHandledByGtk: boolean;
  begin
    Result:=false;
    if Widget=nil then exit;
    
    if GtkWidgetIsA(Widget,gtk_entry_get_type) then begin
      // the gtk_entry handles the following keys
      if (event^.keyval=GDK_Key_Return)
      or (event^.keyval=GDK_Key_Escape)
      or (event^.keyval=GDK_Key_Tab) then
        exit;
      if (event^.length > 0)
      or (event^.keyval=GDK_Key_BackSpace)
      or (event^.keyval=GDK_Key_Clear)
      or (event^.keyval=GDK_Key_Insert)
      or (event^.keyval=GDK_Key_Delete)
      or (event^.keyval=GDK_Key_Home)
      or (event^.keyval=GDK_Key_End)
      or (event^.keyval=GDK_Key_Left)
      or (event^.keyval=GDK_Key_Right)
      or ((event^.keyval >= $20) and (event^.keyval <= $FF))
      then
        Result:=true;
      exit;
    end;
    
    if GtkWidgetIsA(Widget,gtk_text_get_type) then begin
      // the gtk_text handles the following keys
      if (event^.keyval=GDK_Key_Escape) then
        exit;
      if (event^.length > 0)
      or (event^.keyval=GDK_Key_Return)
      or (event^.keyval=GDK_Key_Tab)
      or (event^.keyval=GDK_Key_BackSpace)
      or (event^.keyval=GDK_Key_Clear)
      or (event^.keyval=GDK_Key_Insert)
      or (event^.keyval=GDK_Key_Delete)
      or (event^.keyval=GDK_Key_Home)
      or (event^.keyval=GDK_Key_End)
      or (event^.keyval=GDK_Key_Left)
      or (event^.keyval=GDK_Key_Right)
      or (event^.keyval=GDK_Key_Up)
      or (event^.keyval=GDK_Key_Down)
      or ((event^.keyval >= $20) and (event^.keyval <= $FF))
      then
        Result:=true;
      exit;
    end;
  end;
  
  function KeyActivatedAccelerator: boolean;
  //var
  //  AComponent: TComponent;
  begin
    Result:=false;
    //debugln('KeyActivatedAccelerator A');
    if not SysKey then exit;
    // it is a system key -> try menus
    if (Msg.CharCode in [VK_A..VK_Z])
    and (TObject(TargetData) is TComponent) then begin
      {AComponent:=TComponent(TargetData);
      if AComponent is TControl then begin
        debugln('KeyActivatedAccelerator call TControl.DialogChar');
        if TControl(AComponent).DialogChar(Msg.CharCode) then begin
          debugln('KeyActivatedAccelerator C handled by LCL');
          StopKeyEvent('key_press_event');
          Result:=true;
        end;
      end;}
    end;
  end;
  
  procedure EmulateKeysEatenByGtk;
  begin
    // some widgets eats keys, but do not do anything useful for the LCL
    // emulate the keys
    if not BeforeEvent then exit;

    //DebugLn(['EmulateKeysEatenByGtk ',GetWidgetDebugReport(TargetWidget),' gdk_event_get_type(Event)=',gdk_event_get_type(Event),' GDK_KEY_PRESS=',GDK_KEY_PRESS,' VKey.VKey=',VKey.VKey]);
    {$IFDEF Gtk2}
    // the gtk2 gtkentry handles the return key and emits an activate signal
    // The LCL does not use that and needs the return key event
    // => emulate it
    if GtkWidgetIsA(TargetWidget,gtk_type_entry)
    and (gdk_event_get_type(Event)=GDK_KEY_PRESS)
    and (VKey.VKey=13) then begin
      //DebugLn(['EmulateKeysEatenByGtk ']);
      FillChar(Msg,SizeOf(Msg),0);
      Msg.CharCode := VKey.VKey;
      if SysKey then
        Msg.msg := LM_SYSKEYDOWN
      else
        Msg.msg := LM_KEYDOWN;
      Msg.KeyData := CommonKeyData or (Flags shl 16) or $0001 {TODO:  repeatcount};

      // send the (Sys)KeyDown message directly to the LCL
      NotifyApplicationUserInput(Msg.Msg);
      Result := DeliverMessage(TargetData, Msg) = 0;
    end;
    {$ENDIF}
  end;

begin
  Result := CallBackDefaultReturn;

  EventStopped := False;
  HandledByLCL:=KeyEventWasHandledByLCL(Event,BeforeEvent);

  {$IFDEF VerboseKeyboard}
  DebugLn('[HandleGTKKeyUpDown] ',DbgSName(TControl(Data)),
    ' ',dbgs(Event^.{$IFDEF GTK1}theType{$ELSE}_Type{$ENDIF}),' Widget=',GetWidgetClassName(Widget),
    ' Before=',dbgs(BeforeEvent),' HandledByLCL=',dbgs(HandledByLCL));
  {$ENDIF}
  
  // handle every key event only once
  if HandledByLCL then exit;

  TargetWidget:=Widget;
  TargetData:=Data;
  FocusedWinControl:=nil;

  // The gtk sends keys first to the gtkwindow and then to the focused control.
  // The LCL expects only once to the focused control.
  // And some gtk widgets (combo) eats keys, so that the LCL has no chance to
  // handle it. Therefore keys to the form are immediately redirected to the
  // focused control without changing the normal gtk event path.
  if GtkWidgetIsA(Widget,gtk_window_get_type) then begin
    FocusedWidget:=PGtkWindow(Widget)^.focus_widget;
    if FocusedWidget<>nil then begin
      LCLObject:=GetNearestLCLObject(FocusedWidget);
      if LCLObject is TWinControl then begin
        FocusedWinControl:=TWinControl(LCLObject);
        if FocusedWidget<>Widget then begin
          {$IFDEF VerboseKeyboard}
          DebugLn('[HandleGTKKeyUpDown] REDIRECTING ',
            ' FocusedWidget=',GetWidgetClassName(FocusedWidget),
            ' Control=',FocusedWinControl.Name,':',FocusedWinControl.ClassName);
          {$ENDIF}
          // redirect key to lcl control
          TargetWidget:=FocusedWidget;
          TargetData:=FocusedWinControl;
        end;
      end;
    end;
  end;

  // remember this event
  RememberKeyEventWasHandledByLCL(Event,BeforeEvent);

  if TargetWidget=nil then exit;

  gdk_event_key_get_string(Event, EventString);
  FillChar(Msg,SizeOf(Msg),0);

  VKey := KeySymToVKey(Event^.keyval);

  Flags := 0;
  if (VKey.Flags and VKEY_FLAG_EXT) <> 0
  then Flags := KF_EXTENDED;

  SysKey := False;
  if (VKey.Flags and VKEY_FLAG_ALT) = 0
  then begin
    // VKey is without ALT so Alt is syskey
    SysKey := (Event^.State and GDK_MOD1_MASK) <> 0;
  end
  else begin
    // VKey is with ALT so SHIFT Alt is syskey
    SysKey := (Event^.State and (GDK_MOD1_MASK or GDK_SHIFT_MASK))
               = (GDK_MOD1_MASK or GDK_SHIFT_MASK);
  end;

  if SysKey
  then Flags := Flags or KF_ALTDOWN;
  CommonKeyData := MVKeyInfo[VKey.VKey].KeyCode shl 16; // ScanCode

  case gdk_event_get_type(Event) of
  GDK_KEY_RELEASE:
    begin
      {$IFDEF VerboseKeyboard}
      DebugLn('[HandleGTKKeyUpDown] GDK_KEY_RELEASE VKey=',dbgs(VKey.VKey));
      {$ENDIF}

      Msg.CharCode := VKey.VKey;
      if BeforeEvent then begin
        if SysKey then
          Msg.msg := CN_SYSKEYUP
        else
          Msg.msg := CN_KEYUP;
      end else begin
        if SysKey then
          Msg.msg := LM_SYSKEYUP
        else
          Msg.msg := LM_KEYUP;
      end;

      Flags := Flags or KF_UP or KF_REPEAT;

      Msg.KeyData := CommonKeyData or (Flags shl 16) or $0001 {always};

      // send the message directly to the LCL
      Msg.Result:=0;
      NotifyApplicationUserInput(Msg.Msg);
      Result := DeliverMessage(TargetData, Msg) = 0;

      if Msg.CharCode <> VKey.VKey
      then begin
        // key was handled by LCL
        StopKeyEvent('key_release_event');
      end;
    end;

  GDK_KEY_PRESS:
    begin
      {$IFDEF VerboseKeyboard}
      DebugLn('[HandleGTKKeyUpDown] GDK_KEY_PRESS VKey=',dbgs(VKey.VKey),' SysKey=',dbgs(SysKey));
      {$ENDIF}

      Msg.CharCode := VKey.VKey;

      if BeforeEvent then begin
        if SysKey then
          Msg.msg := CN_SYSKEYDOWN
        else
          Msg.msg := CN_KEYDOWN;
      end else begin
        if SysKey then
          Msg.msg := LM_SYSKEYDOWN
        else begin
          Msg.msg := LM_KEYDOWN;
          // some widgets handle keys, but do not eat it.
          // To avoid, that the LCL also reacts stop here
          //if KeyAlreadyHandledByGtk then exit;
        end;
      end;

      // todo  repeat
      // Flags := Flags or KF_REPEAT;

      Msg.KeyData := CommonKeyData or (Flags shl 16) or $0001 {TODO:  repeatcount};

      if not KeyAlreadyHandledByGtk then begin
        // send the (Sys)KeyDown message directly to the LCL
        NotifyApplicationUserInput(Msg.Msg);
        Result := DeliverMessage(TargetData, Msg) = 0;
        //debugln('[HandleGTKKeyUpDown] GDK_KEY_PRESS After KeyDown message CharCode=',dbgs(Msg.CharCode));
      end;

      if Msg.CharCode <> Vkey.Vkey
      then begin
        // key was changed by LCL
        StopKeyEvent('key_press_event');
      end;
      
      if (not EventStopped) and BeforeEvent then begin
        if KeyActivatedAccelerator then exit;
      end;

      if (not EventStopped) {and (not BeforeEvent)} then begin
        // send the UTF8 keypress
        // try to get the UTF8 representation of the key
        {$IFDEF GTK1}
        Character:='';
        if (Event^.length>0) and (Event^.length<7) then begin
          SetLength(Character,Event^.length);
          System.Move(Event^.thestring^,Character[1],length(Character));
        end;
        {$ELSE GTK2}
        Character := UnicodeToUTF8(gdk_keyval_to_unicode(Event^.KeyVal));
        {$ENDIF GTK2}
        {$IFDEF VerboseKeyboard}
        debugln('[HandleGTKKeyUpDown] GDK_KEY_PRESS UTF8="',DbgStr(Character),'"');
        {$ENDIF}
        if Character<>'' then begin
          LCLObject:=GetNearestLCLObject(TargetWidget);
          if LCLObject is TWinControl then begin
            //debugln('[HandleGTKKeyUpDown] GDK_KEY_PRESS before IntfUTF8KeyPress UTF8="',DbgStr(Character),'"');
            Result:=TWinControl(LCLObject).IntfUTF8KeyPress(Character,1,SysKey);
            //debugln('[HandleGTKKeyUpDown] GDK_KEY_PRESS after IntfUTF8KeyPress UTF8="',DbgStr(Character),'"');
            if Result or (Character='') then
              StopKeyEvent('key_press_event');
          end;
        end;
      end;


      if (not EventStopped) {and (not BeforeEvent)} and CanSendChar
      then begin
       {$IFDEF EventTrace}
        EventTrace('char', data);
        {$ENDIF}

        KeyPressesChar:=#0;
        if Event^.Length = 1 then begin
          // ASCII key was pressed
          KeyPressesChar := EventString^;
        end else if Event^.KeyVal<128 then begin
          // non ASCII key was pressed
          //{$IFDEF GTK2}
          //Msg.CharCode := gdk_keyval_to_unicode(Event^.KeyVal);
          //{$ELSE}
          KeyPressesChar := chr(byte(Event^.KeyVal));
          //{$ENDIF}
        end;
        //debugln('GDK_KEY_PRESS ',dbgs(ord(KeyPressesChar)),' BeforeEvent=',dbgs(BeforeEvent),' ',DbgSName(TObject(TargetData)),' SysKey=',dbgs(SysKey));

        if KeyPressesChar<>#0 then begin
          // ASCII key: send a normal KeyPress Event for Delphi compatibility
          FillChar(Msg,SizeOf(Msg),0);

          Msg.KeyData := CommonKeyData;

          if BeforeEvent then begin
            if SysKey then
              Msg.msg := CN_SYSCHAR
            else
              Msg.msg := CN_CHAR
          end else begin
            if SysKey then
              Msg.msg := LM_SYSCHAR
            else
              Msg.msg := LM_CHAR;
          end;

          // send the (Sys)Char message directly (not queued) to the LCL
          Msg.Result:=0;
          Msg.CharCode:=ord(KeyPressesChar);
          //debugln('GDK_KEY_PRESS ',DbgSName(TObject(TargetData)),' ',dbgs(Msg.msg));
          Result := DeliverMessage(TargetData, Msg) = 0;

          if (ord(KeyPressesChar)<>Msg.CharCode)
          then begin
            // key was changed by lcl
            //DebugLn('HandleGTKKeyUpDown A ',Msg.CharCode,' BeforeEvent=',BeforeEvent);
            if (Msg.CharCode=0) or (Msg.CharCode>=128) then
              // key set to invalid => just stop
              StopKeyEvent('key_press_event')
            else begin
              // try to change the key
              EventString^:=chr(Msg.CharCode);
              EventString[1]:=#0;
              Event^.KeyVal:=Msg.CharCode;
              gdk_event_key_set_string(Event,EventString);
            end;
          end;
        end;
        
      end;

    end;
  end;
  
  EmulateKeysEatenByGtk;
  
  {$IFDEF Gtk1}
  Result:=true;
  {$ELSE}
  Result:=EventStopped;
  {$ENDIF}
  //DebugLn('[HandleGTKKeyUpDown] ',DbgSName(TObject(Data)),' Result=',dbgs(Result),' EventStopped=',dbgs(EventStopped));
end;

{------------------------------------------------------------------------------
  Procedure: InitKeyboardTables
  Params:    none
  Returns:   none

  Initializes the CharToVK and CKeyToVK tables
 ------------------------------------------------------------------------------}
{$IFDEF UNIX}
{$DEFINE InitKeyboardTables}
procedure InitKeyboardTables;

  procedure FindVKeyInfo(const AKeySym: TKeySym; var AVKey: Byte;
    var AExtended, AHasMultiVK: Boolean);
  var
    ByteKey: Byte;
  begin
    AExtended := False;
    AHasMultiVK := False;
    AVKey := $FF;

    case AKeySym of
      32..255: begin
        ByteKey:=Byte(AKeySym);
        case Chr(ByteKey) of // Normal ASCII chars
          // only unshifted is needed for first match
          // 'A'..'Z',
          '0'..'9',
          ' ':      AVKey := ByteKey;
          'a'..'z': AVKey := ByteKey - Ord('a') + Ord('A');
          '+': AVKey := VK_OEM_PLUS;
          ',': AVKey := VK_OEM_COMMA;
          '-': AVKey := VK_OEM_MINUS;
          '.': AVKey := VK_OEM_PERIOD;

          // try the US keycodes first
          ';': AVKey := VK_OEM_1;
          '/': AVKey := VK_OEM_2;
          '`': AVKey := VK_OEM_3;
          '[': AVKey := VK_OEM_4;
          '\': AVKey := VK_OEM_5;
          ']': AVKey := VK_OEM_6;
          '''': AVKey := VK_OEM_7;
        end;
      end;

      GDK_KEY_Tab,
      GDK_KEY_ISO_Left_Tab,
      GDK_KEY_KP_Tab:       AVKey := VK_TAB;
      GDK_KEY_RETURN:       AVKey := VK_RETURN;
//    GDK_KEY_LINEFEED;     AVKey := $0A;

      // Cursor block / keypad
      GDK_KEY_INSERT:
      begin
        AExtended := True;
        AVKey := VK_INSERT;
      end;
      GDK_KEY_HOME:
      begin
        AExtended := True;
        AVKey := VK_HOME;
      end;
      GDK_KEY_LEFT:
      begin
        AExtended := True;
        AVKey := VK_LEFT;
      end;
      GDK_KEY_UP:
      begin
        AExtended := True;
        AVKey := VK_UP;
      end;
      GDK_KEY_RIGHT:
      begin
        AExtended := True;
        AVKey := VK_RIGHT;
      end;
      GDK_KEY_DOWN:
      begin
        AExtended := True;
        AVKey := VK_DOWN;
      end;
      GDK_KEY_PAGE_UP:
      begin
        AExtended := True;
        AVKey := VK_PRIOR;
      end;
      GDK_KEY_PAGE_DOWN:
      begin
        AExtended := True;
        AVKey := VK_NEXT;
      end;
      GDK_KEY_END:
      begin
        AExtended := True;
        AVKey := VK_END;
      end;
      
      // Keypad
      GDK_KEY_KP_ENTER:
      begin
        AExtended := True;
        AVKey := VK_Return;
      end;
      GDK_KEY_KP_Space, GDK_KEY_KP_Begin:
      begin
        AVKey := VK_CLEAR;
        AHasMultiVK := True;
      end;
      GDK_KEY_KP_INSERT:
      begin
        // Keypad key is not extended
        AVKey := VK_INSERT;
        AHasMultiVK := True;
      end;
      GDK_KEY_KP_HOME:
      begin
        // Keypad key is not extended
        AVKey := VK_HOME;
        AHasMultiVK := True;
      end;
      GDK_KEY_KP_LEFT:
      begin
        // Keypad key is not extended
        AVKey := VK_LEFT;
        AHasMultiVK := True;
      end;
      GDK_KEY_KP_UP:
      begin
        // Keypad key is not extended
        AVKey := VK_UP;
        AHasMultiVK := True;
      end;
      GDK_KEY_KP_RIGHT:
      begin
        // Keypad key is not extended
        AVKey := VK_RIGHT;
        AHasMultiVK := True;
      end;
      GDK_KEY_KP_DOWN:
      begin
        // Keypad key is not extended
        AVKey := VK_DOWN;
        AHasMultiVK := True;
      end;
      GDK_KEY_KP_PAGE_UP:
      begin
        // Keypad key is not extended
        AVKey := VK_PRIOR;
        AHasMultiVK := True;
      end;
      GDK_KEY_KP_PAGE_DOWN:
      begin
        // Keypad key is not extended
        AVKey := VK_NEXT;
        AHasMultiVK := True;
      end;
      GDK_KEY_KP_END:
      begin
        // Keypad key is not extended
        AVKey := VK_END;
        AHasMultiVK := True;
      end;
      GDK_KEY_Num_Lock:
      begin
        AExtended := True;
        AVKey := VK_NUMLOCK;
      end;
      GDK_KEY_KP_F1..GDK_KEY_KP_F4:
      begin
        // I guess it is extended to differentiate between normal Fn
        AExtended := True;
        AVKey := VK_F1 + AKeySym - GDK_KEY_KP_F1;
      end;
      GDK_KEY_KP_Multiply:
      begin
        // Keypad key is not extended
        AVKey := VK_MULTIPLY;
      end;
      GDK_KEY_KP_Add:
      begin
        // Keypad key is not extended
        AVKey := VK_ADD;
      end;
      GDK_KEY_KP_Separator:
      begin
        // Keypad key is not extended
        AVKey := VK_SEPARATOR;
        AHasMultiVK := True;
      end;
      GDK_KEY_KP_Subtract:
      begin
        // Keypad key is not extended
        AVKey := VK_SUBTRACT;
      end;
      GDK_KEY_KP_Decimal:
      begin
        // Keypad key is not extended
        AVKey := VK_DECIMAL;
        AHasMultiVK := True;
      end;
      GDK_KEY_KP_Delete:
      begin
        // Keypad key is not extended
        AVKey := VK_DELETE;
        AHasMultiVK := True;
      end;
      GDK_KEY_KP_Divide:
      begin
        AExtended := True;
        AVKey := VK_DIVIDE;
      end;
      GDK_KEY_KP_0..GDK_KEY_KP_9:
      begin
        // Keypad key is not extended, it is identified by VK
        AVKey := VK_NUMPAD0 + AKeySym - GDK_KEY_KP_0;
        AHasMultiVK := True;
      end;
      
      GDK_KEY_BackSpace:    AVKey := VK_BACK;
      GDK_KEY_Clear:        AVKey := VK_CLEAR;
      GDK_KEY_Pause:        AVKey := VK_PAUSE;
      GDK_KEY_Scroll_Lock:  AVKey := VK_SCROLL;
      GDK_KEY_Sys_Req:      AVKey := VK_SNAPSHOT;
      GDK_KEY_Escape:       AVKey := VK_ESCAPE;
      GDK_KEY_Delete:       AVKey := VK_DELETE;

      GDK_KEY_Kanji:        AVKey := VK_KANJI;

      GDK_Key_Select:       AVKey := VK_SELECT;
      GDK_Key_Print:        AVKey := VK_PRINT;
      GDK_Key_Execute:      AVKey := VK_EXECUTE;
      GDK_Key_Cancel:       AVKey := VK_CANCEL;
      GDK_Key_Help:         AVKey := VK_HELP;
      GDK_Key_Break:        AVKey := VK_CANCEL;
      GDK_Key_Mode_switch:  AVKey := VK_MODECHANGE;
      GDK_Key_Caps_Lock:    AVKey := VK_CAPITAL;
      GDK_Key_Shift_L:      AVKey := VK_SHIFT;
      GDK_Key_Shift_R:      AVKey := VK_SHIFT;
      GDK_Key_Control_L:    AVKey := VK_CONTROL;
      GDK_Key_Control_R:    AVKey := VK_CONTROL;
//      GDK_Key_Meta_L:       AVKey := VK_MENU;  //shifted alt, so it is found by alt
//      GDK_Key_Meta_R:       AVKey := VK_MENU;
      GDK_Key_Alt_L:        AVKey := VK_MENU;
      GDK_Key_Alt_R:        AVKey := VK_MENU;
      GDK_Key_Super_L:      AVKey := VK_LWIN;
      GDK_Key_Super_R:      AVKey := VK_RWIN;
      GDK_Key_Menu:         AVKey := VK_APPS;

      // Function keys
      GDK_KEY_F1..GDK_KEY_F24:  AVKey := VK_F1 + AKeySym - GDK_Key_F1;
      
      // Extra keys on a "internet" keyboard
      GDKX_KEY_Sleep:
      begin
        AExtended := True;
        AVKey := VK_SLEEP;
      end;
      GDKX_KEY_AudioLowerVolume:
      begin
        AExtended := True;
        AVKey := VK_VOLUME_DOWN;
      end;
      GDKX_KEY_AudioMute:
      begin
        AExtended := True;
        AVKey := VK_VOLUME_MUTE;
      end;
      GDKX_KEY_AudioRaiseVolume:
      begin
        AExtended := True;
        AVKey := VK_VOLUME_UP;
      end;
      GDKX_KEY_AudioPlay:
      begin
        AExtended := True;
        AVKey := VK_MEDIA_PLAY_PAUSE;
      end;
      GDKX_KEY_AudioStop:
      begin
        AExtended := True;
        AVKey := VK_MEDIA_STOP;
      end;
      GDKX_KEY_AudioPrev:
      begin
        AExtended := True;
        AVKey := VK_MEDIA_PREV_TRACK;
      end;
      GDKX_KEY_AudioNext:
      begin
        AExtended := True;
        AVKey := VK_MEDIA_NEXT_TRACK;
      end;
      GDKX_KEY_Mail:
      begin
        AExtended := True;
        AVKey := VK_LAUNCH_MAIL;
      end;
      GDKX_KEY_HomePage:
      begin
        AExtended := True;
        AVKey := VK_BROWSER_HOME;
      end;
      GDKX_KEY_Back:
      begin
        AExtended := True;
        AVKey := VK_BROWSER_BACK;
      end;
      GDKX_KEY_Forward:
      begin
        AExtended := True;
        AVKey := VK_BROWSER_FORWARD;
      end;
      GDKX_KEY_Stop:
      begin
        AExtended := True;
        AVKey := VK_BROWSER_STOP;
      end;
      GDKX_KEY_Refresh:
      begin
        AExtended := True;
        AVKey := VK_BROWSER_REFRESH;
      end;
      GDKX_KEY_WWW:
      begin
        AExtended := True;
        AVKey := VK_BROWSER_HOME;
      end;
      GDKX_KEY_Favorites:
      begin
        AExtended := True;
        AVKey := VK_BROWSER_FAVORITES;
      end;
      GDKX_KEY_AudioMedia:
      begin
        AExtended := True;
        AVKey := VK_LAUNCH_MEDIA_SELECT;
      end;
      GDKX_KEY_MyComputer:
      begin
        AExtended := True;
        AVKey := VK_LAUNCH_APP1;
      end;
      GDKX_KEY_Calculator:
      begin
        AExtended := True;
        AVKey := VK_LAUNCH_APP2;
      end;                    
      
      // For faster cases, group by families
      $400..$4FF: begin
        // Katakana
      end;

      $500..$5FF: begin
        // Arabic
        case AKeySym of
          GDK_KEY_arabic_hamza:                  AVKey := VK_X;
          GDK_KEY_arabic_hamzaonwaw:             AVKey := VK_C;
          GDK_KEY_arabic_hamzaonyeh:             AVKey := VK_Z;
          GDK_KEY_arabic_alef:                   AVKey := VK_H;
          GDK_KEY_arabic_beh:                    AVKey := VK_F;
          GDK_KEY_arabic_tehmarbuta:             AVKey := VK_M;
          GDK_KEY_arabic_teh:                    AVKey := VK_J;
          GDK_KEY_arabic_theh:                   AVKey := VK_E;
          GDK_KEY_arabic_jeem:                   AVKey := VK_OEM_4;
          GDK_KEY_arabic_hah:                    AVKey := VK_P;
          GDK_KEY_arabic_khah:                   AVKey := VK_O;
          GDK_KEY_arabic_dal:                    AVKey := VK_OEM_6;
          GDK_KEY_arabic_thal:                   AVKey := VK_OEM_3;
          GDK_KEY_arabic_ra:                     AVKey := VK_V;
          GDK_KEY_arabic_zain:                   AVKey := VK_OEM_PERIOD;
          GDK_KEY_arabic_seen:                   AVKey := VK_S;
          GDK_KEY_arabic_sheen:                  AVKey := VK_A;
          GDK_KEY_arabic_sad:                    AVKey := VK_W;
          GDK_KEY_arabic_dad:                    AVKey := VK_Q;
          GDK_KEY_arabic_tah:                    AVKey := VK_OEM_7;
          GDK_KEY_arabic_zah:                    AVKey := VK_OEM_2;
          GDK_KEY_arabic_ain:                    AVKey := VK_U;
          GDK_KEY_arabic_ghain:                  AVKey := VK_Y;
          GDK_KEY_arabic_feh:                    AVKey := VK_T;
          GDK_KEY_arabic_qaf:                    AVKey := VK_R;
          GDK_KEY_arabic_kaf:                    AVKey := VK_OEM_1;
          GDK_KEY_arabic_lam:                    AVKey := VK_G;
          GDK_KEY_arabic_meem:                   AVKey := VK_L;
          GDK_KEY_arabic_noon:                   AVKey := VK_K;
          GDK_KEY_arabic_heh:                    AVKey := VK_I;
          GDK_KEY_arabic_waw:                    AVKey := VK_OEM_COMMA;
          GDK_KEY_arabic_alefmaksura:            AVKey := VK_N;
          GDK_KEY_arabic_yeh:                    AVKey := VK_D;
        end;
      end;

      $600..$6FF: begin
        // Cyrillic

        // MWE:
        // These VK codes are not compatible with all cyrillic KBlayouts
        // Example:
        // VK_A on a russian layout generates a cyrillic_EF
        // VK_A on a serbian layout generates a cyrillic_A
        //
        // Mapping cyrillic_A to VK_A is easier so that encoding is used.
        // Maybe in future we can take the KBLayout into account
        case AKeySym of
          GDK_KEY_cyrillic_a..GDK_KEY_cyrillic_ze:
          begin
            AVKey := VK_A + AKeySym - GDK_KEY_cyrillic_a;
          end;
          // Capital is not needed, the lower will match
          //GDK_KEY_cyrillic_A..GDK_KEY_cyrillic_ZE:
          //begin
          //  AVKey := VK_A + AKeySym - GDK_KEY_cyrillic_A;
          //end;
        end;
      end;

      $700..$7FF: begin
        // Greek
        case AKeySym of
          // Capital is not needed, the lower will match
          GDK_KEY_greek_alpha:           AVKey := VK_A;
          GDK_KEY_greek_beta:            AVKey := VK_B;
          GDK_KEY_greek_gamma:           AVKey := VK_G;
          GDK_KEY_greek_delta:           AVKey := VK_D;
          GDK_KEY_greek_epsilon:         AVKey := VK_E;
          GDK_KEY_greek_zeta:            AVKey := VK_Z;
          GDK_KEY_greek_eta:             AVKey := VK_H;
          GDK_KEY_greek_theta:           AVKey := VK_U;
          GDK_KEY_greek_iota:            AVKey := VK_I;
          GDK_KEY_greek_kappa:           AVKey := VK_K;
          GDK_KEY_greek_lamda:           AVKey := VK_L;
          GDK_KEY_greek_mu:              AVKey := VK_M;
          GDK_KEY_greek_nu:              AVKey := VK_N;
          GDK_KEY_greek_xi:              AVKey := VK_J;
          GDK_KEY_greek_omicron:         AVKey := VK_O;
          GDK_KEY_greek_pi:              AVKey := VK_P;
          GDK_KEY_greek_rho:             AVKey := VK_R;
          GDK_KEY_greek_sigma:           AVKey := VK_S;
          GDK_KEY_greek_finalsmallsigma: AVKey := VK_W;
          GDK_KEY_greek_tau:             AVKey := VK_T;
          GDK_KEY_greek_upsilon:         AVKey := VK_Y;
          GDK_KEY_greek_phi:             AVKey := VK_F;
          GDK_KEY_greek_chi:             AVKey := VK_X;
          GDK_KEY_greek_psi:             AVKey := VK_C;
          GDK_KEY_greek_omega:           AVKey := VK_V;
        end;
      end;
      
      $C00..$CFF: begin
        // Hebrew
        // Shifted keys will produce A..Z so the VK codes will be assigned there
      end;
      
      $D00..$DFF: begin
        // Thai
        // To many differences to assign VK codes through lookup 
        // Thai Kedmanee and Thai Pattachote are complete different layouts
      end;
      
      $E00..$EFF: begin
        // Korean
      end;
    end;
  end;
  
  function IgnoreShifted(const AUnshiftKeySym: TKeySym): Boolean;
  begin
    case AUnshiftKeySym of
      GDK_KEY_END,
      GDK_KEY_HOME,
      GDK_KEY_LEFT,
      GDK_KEY_RIGHT,
      GDK_KEY_UP,
      GDK_KEY_DOWN,
      GDK_KEY_PAGE_UP,
      GDK_KEY_PAGE_DOWN: Result := True;
    else
      Result := False;
    end;
  end;

  procedure NextFreeVK(var AFreeVK: Byte);
  begin
    case AFreeVK of
      $96: AFreeVK := $E1;
      $E1: AFreeVK := $E3;
      $E4: AFreeVK := $E6;
      $E6: AFreeVK := $E9;
      $F5: begin
        DebugLn('[WARNING] Out of OEM specific VK codes, changing to unassigned');
        AFreeVK := $88;
      end;
      $8F: AFreeVK := $97;
      $9F: AFreeVK := $D8;
      $DA: AFreeVK := $E5;
      $E5: AFreeVK := $E8;
      $E8: begin
        DebugLn('[WARNING] Out of unassigned VK codes, assigning $FF');
        AFreeVK := $FF;
      end;
      $FF: AFreeVK := $FF; // stay there
    else
      Inc(AFreeVK);
    end;
  end;
  
const
  KEYFLAGS: array[0..3] of Byte = (
    $00,
    VKEY_FLAG_SHIFT,
    VKEY_FLAG_ALT,
    VKEY_FLAG_SHIFT or VKEY_FLAG_ALT
  );
  EXTFLAG: array[Boolean] of Byte = (
    $00,
    VKEY_FLAG_EXT
  );
  MULTIFLAG: array[Boolean] of Byte = (
    $00,
    VKEY_FLAG_MULTI_VK
  );
  XEVENTSTATE: array[0..3] of DWord = (
    0,
    GDK_SHIFT_MASK,
    GDK_MOD1_MASK,
    GDK_MOD1_MASK or GDK_SHIFT_MASK
  );

var
  Display: Pointer;
  ByteKey: Byte;
  n, m: Integer;
  LoKey, HiKey: Integer;
  KeySym: array[0..3] of TKeySym;
  VKey, FreeVK, Flags, idx: Byte;
  HasMultiVK, DoMultiVK, Extended, HasKey, ComputeVK, WarningShown: Boolean;
  K: PVKeyArray1;
  KeySymChars: array[0..16] of Char;
  KeySymCharLen: Integer;
  XKeyEvent: TXKeyEvent;
begin
  Display := gdk_display;
  if Display = nil then Exit;
  
  // Init dummy XEvent to retrieve the char corresponding to a key
  FillChar(XKeyEvent, SizeOf(XKeyEvent), 0);
  XKeyEvent._Type := GDK_KEY_PRESS;
  XKeyEvent.Display := Display;
  XKeyEvent.Same_Screen := True;

  // Retrieve the KeyCode bounds
  XDisplayKeyCodes(Display, @LoKey, @HiKey);

  Assert((LoKey >= 0) and (HiKey <= 255)); // perdef
  FreeVK := $92; // first OEM specific VK
  WarningShown := False;
  FillChar(KeySym,SizeOf(KeySym),0);
  for n := LoKey to HiKey do
  begin
    VKey := $FF;
    HasKey := False;
    for m := 0 to 3 do
    begin
      ByteKey:=Byte(n);
      
      // don't allow a keysym for shifted navigation keys
      // somehow the default keymap on OSX combines U/ D= L+ R*
      // As a simple hack I think we can ignore keysyms for shifted
      // navigation keys
      if ((m and 1) = 1) and IgnoreShifted(KeySym[m - 1])
      then KeySym[m] := 0
      else KeySym[m] := XKeyCodeToKeysym(Display, ByteKey, m);
      
      if (VKey = $FF) and (KeySym[m] <> 0)
      then begin
        HasKey := True;
        FindVKeyInfo(KeySym[m], VKey, Extended, HasMultiVK);
      end;
    end;
    // Continue if there is no keysym found
    if not HasKey then Continue;
    
    ComputeVK := VKey = $FF;
    if ComputeVK
    then begin
      VKey := FreeVK;
      NextFreeVK(FreeVK);
    end;

    // The keypadkeys have 2 VK_keycodes :(
    // In that case we have to FIndKeyInfo for every keysym
    DoMultiVK := HasMultiVK;
    
    for m := 0 to 3 do
    begin
      if KeySym[m] = 0 then Continue;
      if (m > 1) and (KeySym[m] = KeySym[m - 2]) then Continue;

      if DoMultiVK
      then FindVKeyInfo(KeySym[m], VKey, Extended, HasMultiVK);

      if VKey = $FF
      then Flags := $FF
      else begin
        Flags := KEYFLAGS[m] or EXTFLAG[Extended] or MULTIFLAG[DoMultiVK];
        MVKeyInfo[VKey].KeySym[m] := KeySym[m];
      end;

      K := KeySymToVKeyArray(KeySym[m], True);
      idx := KeySym[m] and $FF;

      // some X servers define separate keycodes for "dead-key" chars.
      // So we might have already a VK assigned
      if K^[idx].VKey <> 0
      then begin
        // VK assigned
        // if the current VK is computed then return it to the pool
        // else use the new VK. If the assigned VK was computed, bad luck.
        // Some day we might this do smarter, but since those extra keys
        // are at the end, we probably wont hit the situation.
        if ComputeVK
        then begin
          FreeVK := VKey;
          VKey := K^[idx].VKey;
          Flags := K^[idx].Flags;
        end;
      end;
      K^[idx].VKey := VKey;
      K^[idx].Flags := Flags;

      // Retrieve the chars for this KeySym
      XKeyEvent.KeyCode := n;
      XKeyEvent.State := XEVENTSTATE[m];
      KeySymCharLen := XLookupString(@XKeyEvent, KeySymChars, SizeOf(KeySymChars) - 1, nil, nil);
      if (KeySymCharLen > 0) and (KeySymChars[KeySymCharLen - 1] = #0)
      then Dec(KeySymCharLen)
      else KeySymChars[KeySymCharLen] := #0;
      if (KeySymCharLen <= 0) then Continue;

      // Warn if the KeySymChar is longer than 1.
      if KeySymCharLen > 1
      then begin
        if not WarningShown
        then begin
          WarningShown := True;
          DebugLn('[WARNING] *******************************************************');
          DebugLn('[WARNING] **                                                   **');
          DebugLn('[WARNING] ** Multibyte character encodings (like UTF8) are not **');
          DebugLn('[WARNING] ** supported at the moment.                          **');
          DebugLn('[WARNING] ** For full keyboard event support, make sure that   **');
          DebugLn('[WARNING] ** the LANG environment var has no UTF8              **');
          DebugLn('[WARNING] **                                                   **');
          DebugLn('[WARNING] *******************************************************');
        end;
        Continue;
      end;

      // If we are here length(KeySymChars) = 1

      MCharToVK[KeySymChars[0]].VKey := VKey;
      MCharToVK[KeySymChars[0]].Flags := Flags;

      if VKey <> $FF
      then MVKeyInfo[VKey].KeyChar[m] := KeySymChars[0];
    end;
    MKeyCodeToVK[n] := VKey;
    if VKey <> $FF
    then MVKeyInfo[VKey].KeyCode := Byte(n);
  end;
end;
{$ENDIF}

{$IFDEF WIN32}
{$DEFINE InitKeyboardTables}
procedure InitKeyboardTables;
var
  n: Integer;
  VKey: Byte;
begin
  for n := 0 to 255 do
  begin
    MCharToVK[Chr(n)] := TVKeyRecord(Windows.VkKeyScan(Chr(n)));
    VKey := MapVirtualKey(n, 3);
    MKeyCodeToVK[n] := VKey;
    if VKey <> $FF
      then MVKeyInfo[VKey].KeyCode := Byte(n);
    //WARNING: the other fields of MVKeyInfo are not set.
    //At this moment it is not clear, what they should be.
    //This is code is to be removed when the keyboard handling is updated for
    //gtk2, (gtk1 won't be supported on windows), so it will be obsolete soon
  end
end;
{$ENDIF}

{$IFNDEF InitKeyboardTables}
procedure InitKeyboardTables;
begin
  DebugLn('[WARNING] Keyboardtables not initialized (platform not supported)');
end;
{$ENDIF}

{------------------------------------------------------------------------------
  Procedure: DoneKeyboardTables
  Params:    none
  Returns:   none

  Frees the dynamic keyboard tables
 ------------------------------------------------------------------------------}
procedure DoneKeyboardTables;
var
  n1, n2, n3: Byte;
  K1: PVKeyArray1;
  K2: PVKeyArray2;
  K3: PVKeyArray3;
  i: Integer;
begin
  for n3 := 0 to 255 do
  begin
    K3 := MKeySymToVK[n3];
    if K3 = nil then Continue;
    for n2 := 0 to 255 do
    begin
      K2 := K3^[n2];
      if K2 = nil then Continue;
      for n1 := 0 to 255 do
      begin
        K1 := K2^[n1];
        if K1 = nil then Continue;
        Dispose(K1);
      end;
      Dispose(K2);
    end;
    Dispose(K3);
  end;
  
  if LCLHandledKeyEvents<>nil then begin
    for i:=0 to LCLHandledKeyEvents.Count-1 do
      TObject(LCLHandledKeyEvents[i]).Free;
    LCLHandledKeyEvents.Free;
    LCLHandledKeyEvents:=nil;
  end;
  if LCLHandledKeyAfterEvents<>nil then begin
    for i:=0 to LCLHandledKeyAfterEvents.Count-1 do
      TObject(LCLHandledKeyAfterEvents[i]).Free;
    LCLHandledKeyAfterEvents.Free;
    LCLHandledKeyAfterEvents:=nil;
  end;
end;

{------------------------------------------------------------------------------
  Function:  CharToVKandFlags
  Params:    AChar: A character to translate
  Returns:   LoByte: The VK code
             HiByte: The A|C|S conbination the get this key

 ------------------------------------------------------------------------------}
function CharToVKandFlags(const AChar: Char): Word;
begin
  Result := MCharToVK[AChar].VKey
         or (MCharToVK[AChar].Flags and VKEY_FLAG_KEY_MASK) shl 8;
end;

{------------------------------------------------------------------------------
  Function:  GetVKeyInfo
  Params:    AVKey: A virtual key to get the info for
  Returns:   A Info record

  This function is more a safety to make sure MVkeyInfo isn't accessed out of
  it's bounds
 ------------------------------------------------------------------------------}
function GetVKeyInfo(const AVKey: Byte): TVKeyInfo;
begin
  Result := MVKeyInfo[AVKey];
end;

{------------------------------------------------------------------------------
  Function:  IsToggleKey
  Params:    AVKey: A Virtual key
  Returns:   True if the requeste dkey is a toggle key

 ------------------------------------------------------------------------------}
function IsToggleKey(const AVKey: Byte): Boolean;
begin
  Result := AVKey in [VK_CAPITAL, VK_SCROLL, VK_NUMLOCK];
end;

{------------------------------------------------------------------------------
  Procedure: GTKEventState2ShiftState
  Params:    KeyState: The gtk keystate
  Returns:   the TShiftState for the given KeyState

  GTKEventState2ShiftState converts a GTK event state to a LCL/Delphi TShiftState
 ------------------------------------------------------------------------------}
function GTKEventState2ShiftState(KeyState: Word): TShiftState;
begin
  result:=[];
  if (KeyState and GDK_SHIFT_MASK)   <> 0 then Result := Result + [ssShift];
  if (KeyState and GDK_LOCK_MASK)    <> 0 then Result := Result + [ssCaps];
  if (KeyState and GDK_CONTROL_MASK) <> 0 then Result := Result + [ssCtrl];
  if (KeyState and GDK_MOD1_MASK)    <> 0 then Result := Result + [ssAlt];
//if (KeyState and GDK_MOD2_MASK)    <> 0 then Result := Result + [??ssWindows??];
  if (KeyState and GDK_MOD3_MASK)    <> 0 then Result := Result + [ssNum];
  if (KeyState and GDK_MOD4_MASK)    <> 0 then Result := Result + [ssSuper];
  if (KeyState and GDK_MOD5_MASK)    <> 0 then Result := Result + [ssScroll];
  if (KeyState and GDK_BUTTON1_MASK) <> 0 then Result := Result + [ssLeft];
  if (KeyState and GDK_BUTTON2_MASK) <> 0 then Result := Result + [ssMiddle];
  if (KeyState and GDK_BUTTON3_MASK) <> 0 then Result := Result + [ssRight];
//if (KeyState and GDK_BUTTON4_MASK) <> 0 then Result := Result + [??WheelMouse??];
//if (KeyState and GDK_BUTTON5_MASK) <> 0 then Result := Result + [??WheelMouse??];
  if (KeyState and GDK_RELEASE_MASK) <> 0 then Result := Result + [ssAltGr];
end;

{------------------------------------------------------------------------------
  Procedure: StoreCommonDialogSetup
  Params:    ADialog: TCommonDialog
  Returns:   none

  Stores the size of a TCommonDialog.
 ------------------------------------------------------------------------------}
procedure StoreCommonDialogSetup(ADialog: TCommonDialog);
var DlgWindow: PGtkWidget;
begin
  if (ADialog=nil) or (ADialog.Handle=0) then exit;
  DlgWindow:=PGtkWidget(ADialog.Handle);
  if DlgWindow^.Allocation.Width>0 then
    ADialog.Width:=DlgWindow^.Allocation.Width;
  if DlgWindow^.Allocation.Height>0 then
    ADialog.Height:=DlgWindow^.Allocation.Height;
end;

{------------------------------------------------------------------------------
  Procedure: DestroyCommonDialogAddOns
  Params:    ADialog: TCommonDialog
  Returns:   none

  Free the memory of additional data of a TCommonDialog
 ------------------------------------------------------------------------------}
procedure DestroyCommonDialogAddOns(ADialog: TCommonDialog);
var
  DlgWindow: PGtkWidget;
  HistoryList: TFPList; // list of TFileSelHistoryListEntry
  AHistoryEntry: PFileSelHistoryEntry;
  i: integer;
  FileSelWidget: PGtkFileSelection;
  LCLHistoryMenu: PGTKWidget;
  {$IFDEF Gtk1}
  AFilterEntry: PFileSelFilterEntry;
  FilterList: TFPList; // list of TFileSelFilterListEntry
  LCLFilterMenu: PGTKWidget;
  {$ENDIF}
begin

  if (ADialog=nil) or (not ADialog.HandleAllocated) then exit;
  DlgWindow:=PGtkWidget(ADialog.Handle);
  {$IFDEF VerboseTransient}
  DebugLn('DestroyCommonDialogAddOns ',ADialog.Name,':',ADialog.ClassName);
  {$ENDIF}
  gtk_window_set_transient_for(PGtkWindow(DlgWindow),nil);
  if ADialog is TOpenDialog then begin
    {$IFDEF GTK2}
    FileSelWidget:=GTK_FILE_CHOOSER(DlgWindow);
    {$ELSE}
    FileSelWidget:=GTK_FILE_SELECTION(DlgWindow);
    FreeWidgetInfo(FileSelWidget^.selection_entry);
    FreeWidgetInfo(FileSelWidget^.dir_list);
    FreeWidgetInfo(FileSelWidget^.file_list);
    LCLFilterMenu:=PGTKWidget(gtk_object_get_data(PGtkObject(FileSelWidget),
                                       'LCLFilterMenu'));
    if LCLFilterMenu<>nil then FreeWidgetInfo(LCLFilterMenu);
    {$ENDIF}
    LCLHistoryMenu:=PGTKWidget(gtk_object_get_data(PGtkObject(FileSelWidget),
                                       'LCLHistoryMenu'));
    if LCLHistoryMenu<>nil then FreeWidgetInfo(LCLHistoryMenu);

    // free history
    HistoryList:=TFPList(gtk_object_get_data(PGtkObject(DlgWindow),
                                             'LCLHistoryList'));
    if HistoryList<>nil then begin
      for i:=0 to HistoryList.Count-1 do begin
        AHistoryEntry:=PFileSelHistoryEntry(HistoryList[i]);
        StrDispose(AHistoryEntry^.Filename);
        AHistoryEntry^.Filename:=nil;
        Dispose(AHistoryEntry);
      end;
      HistoryList.Free;
      gtk_object_set_data(PGtkObject(DlgWindow),'LCLHistoryList',nil);
    end;

    {$IFDEF GTK1}
    // free filter
    FilterList:=TFPList(gtk_object_get_data(PGtkObject(DlgWindow),
                                            'LCLFilterList'));
    if FilterList<>nil then begin
      for i:=0 to FilterList.Count-1 do begin
        AFilterEntry:=PFileSelFilterEntry(FilterList[i]);
        StrDispose(AFilterEntry^.Description);
        AFilterEntry^.Description:=nil;
        StrDispose(AFilterEntry^.Mask);
        AFilterEntry^.Mask:=nil;
        Dispose(AFilterEntry);
      end;
      FilterList.Free;
      gtk_object_set_data(PGtkObject(DlgWindow),'LCLFilterList',nil);
    end;
    {$ENDIF}

    // free preview handle
    if ADialog is TPreviewFileDialog then begin
      if TPreviewFileDialog(ADialog).PreviewFileControl<>nil then
        TPreviewFileDialog(ADialog).PreviewFileControl.Handle:=0;
    end;
  end;
end;

{------------------------------------------------------------------------------
  Procedure: PopulateFileAndDirectoryLists
  Params:    FileSelection: PGtkFileSelection;
              Mask: string (File mask, such as *.txt)
  Returns:   none

  Populate the directory and file lists according to the given mask
 ------------------------------------------------------------------------------}
procedure PopulateFileAndDirectoryLists(FileSelection: PGtkFileSelection;
  const Mask: string);
var
  Dirs, Files: PGtkCList;
  Text: array [0..1] of Pgchar;
  Info: TSearchRec;
  DirName: PChar;
  Dir: string;
  StrList: TStringList;
  CurFileMask: String;
  
  procedure Add(List: PGtkCList; const s: string);
  begin
    Text[0] := PChar(s);
    gtk_clist_append(List, Text);
  end;
  
  procedure AddList(List: PGtkCList);
  var
    i: integer;
  begin
    StrList.Sorted := True;
    for i:=0 to StrList.Count-1 do
      Add(List, StrList[i]);
    StrList.Sorted := False;
  end;
  
begin
  StrList := TStringList.Create;
  dirs := PGtkCList(FileSelection^.dir_list);
  files := PGtkCList(FileSelection^.file_list);
  DirName := gtk_file_selection_get_filename(FileSelection);
  if DirName <> nil then begin
    SetString(Dir, DirName, strlen(DirName));
    SetLength(Dir, LastDelimiter(PathDelim,Dir));
  end else
    Dir := '';
  Text[1] := nil;
  gtk_clist_freeze(Dirs);
  gtk_clist_clear(Dirs);
  gtk_clist_freeze(Files);
  gtk_clist_clear(Files);
  { Add all directories }
  Strlist.Add('..'+PathDelim);
  if FindFirst(AppendPathDelim(Dir)+GetAllFilesMask, faAnyFile and faDirectory,
    Info) = 0
  then
    repeat
      if ((Info.Attr and faDirectory) = faDirectory) and (Info.Name <> '.')
      and (Info.Name <> '..') and (Info.Name<>'') then
        StrList.Add(AppendPathDelim(Info.Name));
    until FindNext(Info) <> 0;
  FindClose(Info);
  AddList(Dirs);
  // add required files
  StrList.Clear;
  CurFileMask:=Mask;
  if CurFileMask='' then CurFileMask:=GetAllFilesMask;
  if FindFirst(AppendPathDelim(Dir)+GetAllFilesMask, faAnyFile, Info) = 0 then
  begin
    repeat
      if ((Info.Attr and faDirectory) <> faDirectory) then begin
        //debugln('PopulateFileAndDirectoryLists CurFileMask="',CurFileMask,'" Info.Name="',Info.Name,'" ',dbgs(FileInFilenameMasks(Info.Name,CurFileMask)));
        if (CurFileMask='') or (FileInFilenameMasks(Info.Name,CurFileMask)) then
        begin
          Strlist.Add(Info.Name);
        end;
      end;
    until FindNext(Info) <> 0;
  end;
  FindClose(Info);
  AddList(Files);
  StrList.Free;
  gtk_clist_thaw(Dirs);
  gtk_clist_thaw(Files);
end;

{------------------------------------------------------------------------------
  Procedure: DeliverMessage
  Params:    Message: the message to process
  Returns:   True if handled

  Generic function which calls the WindowProc if defined, otherwise the
  dispatcher
 ------------------------------------------------------------------------------}
function DeliverMessage(const Target: Pointer; var AMessage): PtrInt;
begin
  if Target=nil then DebugLn('[DeliverMessage] Target = nil');
  {$IFDEF VerboseDeliverMessage}
  if  (TLMessage(AMessage).Msg <>LM_MOUSEMOVE)
    and (TLMessage(AMessage).Msg <>LM_PAINT)
    and (TLMessage(AMessage).Msg <>LM_KEYDOWN)
    and (TLMessage(AMessage).Msg <>LM_KEYUP)
    and (TLMessage(AMessage).Msg <  CN_KEYDOWN ) then
    DebugLn('DeliverMessage ',DbgS(Target),
    ' ',TComponent(Target).Name,':',TObject(Target).ClassName,
    ' Message=',GetMessageName(TLMessage(AMessage).Msg));
  {$ENDIF}
  if (TLMessage(AMessage).Msg=LM_PAINT)
  or (TLMessage(AMessage).Msg=LM_INTERNALPAINT)
  or (TLMessage(AMessage).Msg=LM_GtkPaint) then
    CurrentSentPaintMessageTarget:=TObject(Target);
  try
    if TObject(Target) is TControl
    then TControl(Target).WindowProc(TLMessage(AMessage))
    else TObject(Target).Dispatch(TLMessage(AMessage));
  except
    Application.HandleException(nil);
  end;

  Result := TLMessage(AMessage).Result;
  CurrentSentPaintMessageTarget:=nil;
end;

{------------------------------------------------------------------------------
  Function: ObjectToGTKObject
  Params: AnObject: A LCL Object
  Returns:  The GTKObject of the given object

  Returns the GTKObject of the given object, nil if no object available
 ------------------------------------------------------------------------------}
function ObjectToGTKObject(const AnObject: TObject): PGtkObject;
var
  handle : HWND;
begin
  Handle := 0;
  if not assigned(AnObject) then
  begin
    assert (false, 'TRACE:  [ObjectToGtkObject] Object not assigned');
  end
  else if (AnObject is TWinControl) then
  begin
    if TWinControl(AnObject).HandleAllocated then
      handle := TWinControl(AnObject).Handle;
  end
  else if (AnObject is TMenuItem) then
  begin 
    if TMenuItem(AnObject).HandleAllocated then
      handle := TMenuItem(AnObject).Handle;
  end
  else if (AnObject is TMenu) then
  begin 
    if TMenu(AnObject).HandleAllocated then
      handle := TMenu(AnObject).Items.Handle;
  end
  else if (AnObject is TCommonDialog) then
  begin
    {if TCommonDialog(AObject).HandleAllocated then }
    handle := TCommonDialog(AnObject).Handle;
  end
  else begin
    Assert(False, Format('Trace:  [ObjectToGtkObject] Message received with unhandled class-type <%s>', [AnObject.ClassName]));
  end;
  Result := PGTKObject(handle);
  if handle = 0 then
    Assert (false, 'Trace:  [ObjectToGtkObject]****** Warning: handle = 0 *******');
end;


(***********************************************************************
  Widget member functions
************************************************************************)

// ----------------------------------------------------------------------
// the main widget is the widget passed as handle to the winAPI
// main data is stored in the fixed form to get a reference to its parent
// ----------------------------------------------------------------------
function GetMainWidget(const Widget: Pointer): Pointer;
begin
  if Widget = nil
  then raise EInterfaceException.Create('GetMainWidget Widget=nil');
  
  Result := gtk_object_get_data(Widget, 'Main');
  if Result = nil then Result := Widget; // the widget is the main widget itself.
end;

procedure SetMainWidget(const ParentWidget, ChildWidget: Pointer);
begin
  if ParentWidget = nil
  then raise EInterfaceException.Create('SetMainWidget ParentWidget=nil');
  if ChildWidget = nil
  then raise EInterfaceException.Create('SetMainWidget ChildWidget=nil');
  if ParentWidget = ChildWidget
  then raise EInterfaceException.Create('SetMainWidget ParentWidget=ChildWidget');

  gtk_object_set_data(ChildWidget, 'Main', ParentWidget)
end;

{ ------------------------------------------------------------------------------
 Get the fixed widget of a widget.
 Every LCL control with a clientarea, has at least a main widget for the control
 and a fixed widget for the client area. If the Fixed widget is not set, use
 try to get it trough WinWidgetInfo
------------------------------------------------------------------------------ }
//TODO: remove when WinWidgetInfo implementation is complete
function GetFixedWidget(const Widget: Pointer): Pointer;
var
  WidgetInfo: PWinWidgetInfo;
begin
  if Widget = nil
  then raise EInterfaceException.Create('GetFixedWidget Widget=nil');

  WidgetInfo := GetWidgetInfo(Widget, False);
  if WidgetInfo <> nil
  then Result := WidgetInfo^.ClientWidget
  else Result := nil;
  if Result <> nil then Exit;
  
  Result := gtk_object_get_data(Widget, 'Fixed');
  // A last resort
  if Result = nil then Result := Widget;
end;

{ ------------------------------------------------------------------------------
 Set the fixed widget of a widget.
 Every LCL control with a clientarea, has at least a main widget for the control
 and a fixed widget for the client area.
------------------------------------------------------------------------------ }
procedure SetFixedWidget(const ParentWidget, FixedWidget: Pointer);
var
  WidgetInfo: PWinWidgetInfo;
begin
  if ParentWidget = nil
  then raise EInterfaceException.Create('SetFixedWidget ParentWidget=nil');
  
  WidgetInfo := GetWidgetInfo(ParentWidget, True);
  WidgetInfo^.ClientWidget := FixedWidget;
  //TODO: remove old compatebility
  gtk_object_set_data(ParentWidget, 'Fixed', FixedWidget)
end;

{-------------------------------------------------------------------------------
  Set the LCLobject which created this widget.

-------------------------------------------------------------------------------}
procedure SetLCLObject(const Widget: Pointer; const AnObject: TObject);
var
  WidgetInfo: PWinWidgetInfo;
begin
  if Widget = nil
  then raise EInterfaceException.Create('SetLCLObject Widget=nil');
  if AnObject = nil
  then raise EInterfaceException.Create('SetLCLObject AnObject=nil');

  WidgetInfo := GetWidgetInfo(Widget, True);
  WidgetInfo^.LCLObject := AnObject;
  //TODO: remove old compatebility
  gtk_object_set_data(Widget, 'Class', Pointer(AnObject));
end;

//TODO: cleanup when WidgetInfo is fully implemented
function GetLCLObject(const Widget: Pointer): TObject;
var
  WidgetInfo: PWinWidgetInfo;
begin
  if Widget = nil
  then raise EInterfaceException.Create('GetLCLObject Widget=nil');

  WidgetInfo := GetWidgetInfo(Widget);
  if WidgetInfo <> nil
  then Result := WidgetInfo^.LCLObject
  else Result := nil;

  // Fallback;
  if Result = nil
  then Result := TObject(gtk_object_get_data(Widget, 'Class'));
end;

{-------------------------------------------------------------------------------
 Some need the HiddenLCLobject which created a parent of this widget.

 MWE: is this obsolete ?
-------------------------------------------------------------------------------}
procedure SetHiddenLCLObject(const Widget: Pointer; const AnObject: TObject);
begin
  if (Widget <> nil) then
    gtk_object_set_data(Widget, 'LCLHiddenClass', Pointer(AnObject));
end;

function GetHiddenLCLObject(const Widget: Pointer): TObject;
begin
  Result := TObject(gtk_object_get_data(Widget, 'LCLHiddenClass'));
end;

{-------------------------------------------------------------------------------
  function GetNearestLCLObject(Widget: PGtkWidget): TObject;
  
  Retrieves the LCLObject belonging to the widget. If the widget is created as
  child of a main widget, the parent is queried.
  
  This function probably obsoletes Get/SetMainWidget
-------------------------------------------------------------------------------}
//TODO: check if Get/SetMainWidget is still required
function GetNearestLCLObject(Widget: PGtkWidget): TObject;
begin
  while (Widget<>nil) do begin
    Result:=GetLCLObject(Widget);
    if Result<>nil then exit;
    Widget:=Widget^.Parent;
  end;
  Result:=nil;
end;

function CreateFixedClientWidget: PGTKWidget;
begin
  Result := gtk_fixed_new();
  {$IFDEF GTK2}
  gtk_fixed_set_has_window(PGtkFixed(Result), True);
  {$ENDIF}
end;

{------------------------------------------------------------------------------
  Procedure FixedMoveControl(Parent, Child : PGTKWIdget; Left, Top : Longint);
  
  Move a childwidget on a client area (fixed or layout widget).
------------------------------------------------------------------------------}
Procedure FixedMoveControl(Parent, Child : PGTKWIdget; Left, Top : Longint);
begin
  If GTKWidgetIsA(Parent, GTK_Layout_Get_Type) then
    // parent is layout
    gtk_Layout_move(PGtkLayout(Parent), Child, Left, Top)
  else If GTKWidgetIsA(Parent, GTK_Fixed_Get_Type) then begin
    // parent is fixed
    gtk_fixed_move(PGtkFixed(Parent), Child, gint16(Left), gint16(Top))
  end else
    // parent is invalid
    DebugLn('[FixedMoveControl] WARNING: Invalid Fixed Widget');
end;

{------------------------------------------------------------------------------
  Procedure FixedPutControl(Parent, Child : PGTKWIdget; Left, Top : Longint);

  Add a childwidget onto a client area (fixed or layout widget).
------------------------------------------------------------------------------}
Procedure FixedPutControl(Parent, Child : PGTKWidget; Left, Top : Longint);

  procedure RaiseInvalidFixedWidget;
  begin
    // this is in a separate procedure for optimisation
    DebugLn('[FixedPutControl] WARNING: Invalid Fixed Widget.',
      ' Parent=',DbgS(Parent),
      ' Child=',DbgS(Child)
      );
  end;

begin
  //DebugLn('FixedPutControl Parent=[',GetWidgetDebugReport(Parent),']',
  //  ' Child=[',GetWidgetDebugReport(Child),']');
  If GTKWidgetIsA(Parent, GTK_Fixed_Get_Type) then
    gtk_fixed_put(PGtkFixed(Parent), Child, gint16(Left), gint16(Top))
  else If GTKWidgetIsA(Parent, GTK_Layout_Get_Type) then
    gtk_Layout_Put(PGtkLayout(Parent), Child, Left, Top)
  else
    RaiseInvalidFixedWidget;
end;

function GetWinControlWidget(Child: PGtkWidget): PGtkWidget;
// return the first widget, which is associated with a TWinControl handle
var
  LCLParent: TObject;
begin
  Result:=nil;
  LCLParent:=GetNearestLCLObject(Child);
  if (LCLParent=nil) or (not (LCLParent is TWinControl))
  or (not TWinControl(LCLParent).HandleAllocated)
  then exit;
  Result:=PGtkWidget(TWinControl(LCLParent).Handle);
end;

function GetWinControlFixedWidget(Child: PGtkWidget): PGtkWidget;
begin
  Result:=GetWinControlWidget(Child);
  if Result=nil then exit;
  Result:=GetFixedWidget(Result);
end;

function FindFixedChildListItem(ParentFixed: PGtkFixed; Child: PGtkWidget): PGList;
begin
  Result:=ParentFixed^.children;
  while (Result<>nil) do begin
    if (Result^.Data<>nil) and (PGtkFixedChild(Result^.Data)^.Widget=Child) then
      exit;
    Result:=Result^.Next;
  end;
end;

function FindFixedLastChildListItem(ParentFixed: PGtkFixed): PGList;
begin
  Result:=g_list_last(ParentFixed^.children);
end;

function GetFixedChildListWidget(Item: PGList): PGtkWidget;
begin
  Result:=PGtkFixedChild(Item^.Data)^.Widget;
end;

{------------------------------------------------------------------------------
  procedure MoveGListLinkBehind(First, Item, After: PGList);

  Move the list item 'Item' behind the list item 'After'.
  If After=nil then insert as first item.
------------------------------------------------------------------------------}
procedure MoveGListLinkBehind(First, Item, After: PGList);
var
  Data: Pointer;
  NewPos: Integer;
begin
  if (Item=After) or (Item^.Next=After) then exit;
  if (g_list_position(First,Item)<0) then
    RaiseGDBException('MoveGListLinkBehind Item not found');
  if (After<>nil) and (g_list_position(First,After)<0) then
    RaiseGDBException('MoveGListLinkBehind After not found');
  Data:=Item^.Data;
  g_list_remove_link(First,Item);
  if After<>nil then begin
    NewPos:=g_list_position(First,After)+1;
  end else begin
    NewPos:=0;
  end;
  g_list_insert(First,Data,NewPos);
end;

procedure MoveGListLink(First: PGList; FromIndex, ToIndex: integer);
var
  Item: PGList;
  InsertAfter: PGList;
  i: Integer;
begin
  if (FromIndex=ToIndex) then exit;
  Item:=First;
  i:=0;
  while (i<FromIndex) do begin
    Item:=Item^.next;
    inc(i);
  end;
  // unbind
  if Item^.next<>nil then Item^.next^.prev:=Item^.prev;
  if Item^.prev<>nil then Item^.prev^.next:=Item^.next;
  Item^.next:=nil;
  Item^.prev:=nil;
  // insert
  if ToIndex=0 then begin
    Item^.next:=First;
    First^.prev:=Item;
  end else begin
    i:=0;
    InsertAfter:=First;
    while (i<ToIndex-1) do begin
      if InsertAfter^.next=nil then break;
      InsertAfter:=InsertAfter^.next;
      inc(i);
    end;
    Item^.prev:=InsertAfter;
    Item^.next:=InsertAfter^.next;
    InsertAfter^.next:=Item;
    if Item^.next<>nil then Item^.next^.prev:=Item;
  end;
end;

{------------------------------------------------------------------------------
  Function GetControlWindow(Widget: Pointer) : PGDKWindow;

  Get the gdkwindow of a widget.
------------------------------------------------------------------------------}
Function GetControlWindow(Widget: Pointer) : PGDKWindow;
begin
  If Widget <> nil then begin
    If not GTKWidgetIsA(PGTKWidget(Widget), GTK_Layout_Get_Type) then
      Result := PGTKWidget(Widget)^.Window
    else
      Result := PGtkLayout(Widget)^.bin_window;
  end else
    RaiseGDBException('GetControlWindow Widget=nil');
end;

{------------------------------------------------------------------------------
  function GetDCOffset(DC: TDeviceContext): TPoint;

  Returns the DC offset for the DC Origin.
 ------------------------------------------------------------------------------}
function GetDCOffset(DC: TDeviceContext): TPoint;
var
  Fixed : PGTKWIdget;
  Adjustment: PGtkAdjustment;
begin
  if (DC<>nil) then begin
    Result:=DC.Origin;
    {$Ifdef GTK2}
      if (DC.Wnd<>0) and GTK_WIDGET_NO_WINDOW(PGTKWidget(DC.Wnd))
        and (not GtkWidgetIsA(PGTKWidget(DC.Wnd),GTKAPIWidget_GetType))
      then begin
        Inc(Result.X, PGTKWidget(DC.Wnd)^.Allocation.x);
        Inc(Result.y, PGTKWidget(DC.Wnd)^.Allocation.y);
      end;
    {$EndIf}
    if (DC.SpecialOrigin) and (DC.Wnd<>0) then begin
      Fixed := GetFixedWidget(PGTKWidget(DC.Wnd));
      if GtkWidgetIsA(Fixed,GTK_LAYOUT_GET_TYPE) then begin
        Adjustment:=gtk_layout_get_hadjustment(PGtkLayout(Fixed));
        if Adjustment<>nil then
          dec(Result.X,TruncToInt(Adjustment^.Value-Adjustment^.Lower));
        Adjustment:=gtk_layout_get_vadjustment(PGtkLayout(Fixed));
        if Adjustment<>nil then
          dec(Result.Y,TruncToInt(Adjustment^.Value-Adjustment^.Lower));
      end;
    end;
  end else begin
    Result.X:=0;
    Result.Y:=0;
  end;
end;



{------------------------------------------------------------------------------
  function CreateWidgetInfo(const AWidget: Pointer): PWidgetInfo;

 Creates a WidgetInfo structure for the given widget
 Info needed by the API of a HWND (=Widget)

 This structure obsoletes all other object data, like
   "core-child", "fixed", "class"
 ------------------------------------------------------------------------------}
function CreateWidgetInfo(const AWidget: Pointer): PWidgetInfo;
begin
  if AWidget = nil then Result:= nil
  else begin
    New(Result);
    FillChar(Result^, SizeOf(Result^), 0);
    gtk_object_set_data(AWidget, 'widgetinfo', Result);
  end;
end;

function CreateWidgetInfo(const AWidget: Pointer; const AObject: TObject;
  const AParams: TCreateParams): PWidgetInfo;
begin
  Result := CreateWidgetInfo(AWidget);
  if Result = nil then Exit;
  
  Result^.LCLObject := AObject;
  // in most cases the created widget is the core widget
  // so default to it
  Result^.CoreWidget := AWidget;
  Result^.Style := AParams.Style;
  Result^.ExStyle := AParams.ExStyle;
  Result^.WndProc := PtrInt(AParams.WindowClass.lpfnWndProc);
end;

function GetWidgetInfo(const AWidget: Pointer {; const Create: Boolean = False}): PWidgetInfo;
begin
  Result := GetWidgetInfo(AWidget, False);
end;

function GetWidgetInfo(const AWidget: Pointer;
  const ACreate: Boolean): PWidgetInfo;
var
  MainWidget: PGtkObject;
begin
  if AWidget <> nil then begin
    MainWidget := GetMainWidget(AWidget);
    Result := gtk_object_get_data(MainWidget, 'widgetinfo');
    if (Result = nil) and ACreate then begin
      Result := CreateWidgetInfo(MainWidget);
      // use the main widget as default
      Result^.CoreWidget := PGtkWidget(MainWidget);
    end;
  end
  else Result := nil;
end;

procedure FreeWidgetInfo(AWidget: Pointer);
var
  Info: PWidgetInfo;
begin
  if AWidget = nil then Exit;
  Info := gtk_object_get_data(AWidget, 'widgetinfo');
  if Info = nil then Exit;

  if Info^.DoubleBuffer <> nil then
    gdk_pixmap_unref(Info^.DoubleBuffer);

  if (Info^.UserData <> nil) and (Info^.DataOwner) then begin
    FreeMem(Info^.UserData);
    Info^.UserData := nil;
  end;
  gtk_object_set_data(AWidget,'widgetinfo',nil);

  Dispose(Info);
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
  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;
  {$IFDEF DebugLCLComponents}
  DebugGtkWidgets.MarkDestroyed(Widget);
  {$ENDIF}
  gtk_widget_destroy(Widget);
end;

{-------------------------------------------------------------------------------
  function GetGtkNoteBookDummyPage(ANoteBookWidget: PGtkNoteBook): PGtkWidget;

  Retrieves the DummyWidget associated with the ANoteBookWidget
-------------------------------------------------------------------------------}
function GetGtkNoteBookDummyPage(ANoteBookWidget: PGtkNoteBook): PGtkWidget;
begin
  Result:=gtk_object_get_data(PGtkObject(ANoteBookWidget),'LCLDummyPage');
end;

{-------------------------------------------------------------------------------
  procedure SetGtkNoteBookDummyPage(ANoteBookWidget: PGtkNoteBook;
    DummyWidget: PGtkWidget): PGtkWidget;

  Associates the DummyWidget with the ANoteBookWidget
-------------------------------------------------------------------------------}
procedure SetGtkNoteBookDummyPage(ANoteBookWidget: PGtkNoteBook;
  DummyWidget: PGtkWidget);
begin
  gtk_object_set_data(PGtkObject(ANoteBookWidget),'LCLDummyPage',DummyWidget);
end;

{------------------------------------------------------------------------------
  UpdateNoteBookClientWidget
  Params: ANoteBook: TObject

  This procedure updates the 'Fixed' object data.
  * obsolete *
------------------------------------------------------------------------------}
procedure UpdateNoteBookClientWidget(ANoteBook: TObject);
var
  ClientWidget: PGtkWidget;
  NoteBookWidget: PGtkNotebook;
begin
  if not TCustomNotebook(ANoteBook).HandleAllocated then exit;
  NoteBookWidget:=PGtkNotebook(TCustomNotebook(ANoteBook).Handle);
  ClientWidget:=nil;
  SetFixedWidget(NoteBookWidget,ClientWidget);
end;

{-------------------------------------------------------------------------------
  function GetGtkNoteBookPageCount(ANoteBookWidget: PGtkNoteBook): integer;

  Returns the number of pages in a PGtkNotebook
-------------------------------------------------------------------------------}
function GetGtkNoteBookPageCount(ANoteBookWidget: PGtkNoteBook): integer;
var
  AListItem: PGList;
begin
  Result:=0;
  if ANoteBookWidget=nil then exit;
  AListItem:=ANoteBookWidget^.children;
  while AListItem<>nil do begin
    inc(Result);
    AListItem:=AListItem^.Next;
  end;
end;

var
  {$IFDef GTK1}
  NoteBookCloseBtnPixmapImg: PGdkPixmap = nil;
  NoteBookCloseBtnPixmapMask: PGdkPixmap = nil;
  {$Else}
  NoteBookCloseBtnPixbuf: PGdkPixbuf = nil;
  {$EndIf}

{-------------------------------------------------------------------------------
  procedure RemoveDummyNoteBookPage(NoteBookWidget: PGtkNotebook);

  Removes the dummy page.
  See also AddDummyNoteBookPage
-------------------------------------------------------------------------------}
procedure RemoveDummyNoteBookPage(NoteBookWidget: PGtkNotebook);
var
  DummyWidget: PGtkWidget;
begin
  DummyWidget:=GetGtkNoteBookDummyPage(NoteBookWidget);
  if DummyWidget=nil then exit;
  gtk_notebook_remove_page(NoteBookWidget,
                           gtk_notebook_page_num(NoteBookWidget,DummyWidget));
  DummyWidget:=nil;
  SetGtkNoteBookDummyPage(NoteBookWidget,DummyWidget);
end;

{-------------------------------------------------------------------------------
  method GetNoteBookCloseBtnImage
  Params:
  Result: none

  Loads the image for the close button in the tabs of the TCustomNoteBook(s).
-------------------------------------------------------------------------------}
{$IfDef GTK1}
procedure GetNoteBookCloseBtnImage(Window: PGdkWindow;
  var Img, Mask: PGdkPixmap);
begin
  if (NoteBookCloseBtnPixmapImg=nil)
  and (Window<>nil) then begin
    LoadXPMFromLazResource('tnotebook_close_tab',Window,
                        NoteBookCloseBtnPixmapImg,NoteBookCloseBtnPixmapMask);
  end;
  Img:=NoteBookCloseBtnPixmapImg;
  Mask:=NoteBookCloseBtnPixmapMask;
end;
{$Else}
procedure GetNoteBookCloseBtnImage(var Img: PGdkPixbuf);
begin
  if (NoteBookCloseBtnPixbuf=nil) then
    LoadPixbufFromLazResource('tnotebook_close_tab', NoteBookCloseBtnPixbuf);
  Img:=NoteBookCloseBtnPixbuf;
end;
{$EndIF}

{-------------------------------------------------------------------------------
  method UpdateNotebookPageTab
  Params: ANoteBook: TCustomNotebook; APage: TCustomPage
  Result: none

  Updates the tab of a page of a notebook. This contains the image to the left
  side, the label, the close button, the menu image and the menu label.
-------------------------------------------------------------------------------}
procedure UpdateNotebookPageTab(ANoteBook, APage: TObject);
var
  TheNoteBook: TCustomNotebook;
  ThePage: TCustomPage;

  NoteBookWidget: PGtkWidget;  // the notebook
  PageWidget: PGtkWidget;      // the page (content widget)
  TabWidget: PGtkWidget;       // the tab (hbox containing a pixmap, a label
                               //          and a close button)
  TabImageWidget: PGtkWidget;  // the icon widget in the tab (a fixed widget)
  TabLabelWidget: PGtkWidget;  // the label in the tab
  TabCloseBtnWidget: PGtkWidget;// the close button in the tab
  TabCloseBtnImageWidget: PGtkWidget; // the pixmap in the close button
  MenuWidget: PGtkWidget;      // the popup menu (hbox containing a pixmap and
                               // a label)
  MenuImageWidget: PGtkWidget; // the icon widget in the popup menu item (a fixed widget)
  MenuLabelWidget: PGtkWidget; // the label in the popup menu item

  procedure UpdateTabImage;
  var
    HasIcon: Boolean;
    IconSize: TPoint;
  begin
    HasIcon:=false;
    IconSize:=Point(0,0);
    if (TheNoteBook.Images<>nil)
    and (ThePage.ImageIndex>=0)
    and (ThePage.ImageIndex<TheNoteBook.Images.Count) then begin
      // page has valid image
      IconSize:=Point(TheNoteBook.Images.Width,TheNoteBook.Images.Height);
      HasIcon:=(IconSize.X>0) and (IconSize.Y>0);
    end;

    if HasIcon then begin
      // page has an image
      if TabImageWidget<>nil then begin
        // there is already an icon widget for the image in the tab
        // -> resize the icon widget
        gtk_widget_set_usize(TabImageWidget,IconSize.X,IconSize.Y);
      end else begin
        // there is no pixmap for the image in the tab
        // -> insert one ot the left side of the label
        TabImageWidget:= gtk_label_new(#0);
        g_signal_connect(PgtkObject(TabImageWidget), 'expose_event',
                           TGTKSignalFunc(@PageIconWidgetExposeAfter), ThePage);
        {$IFNDEF GTK2}
        g_signal_connect(PgtkObject(TabImageWidget), 'draw',
                             TGTKSignalFunc(@PageIconWidgetDrawAfter), ThePage);
        {$ENDIF}
        gtk_object_set_data(PGtkObject(TabWidget),'TabImage',TabImageWidget);
        gtk_widget_set_usize(TabImageWidget,IconSize.X,IconSize.Y);
        gtk_widget_show(TabImageWidget);
        gtk_box_pack_start_defaults(PGtkBox(TabWidget),TabImageWidget);
        gtk_box_reorder_child(PGtkBox(TabWidget),TabImageWidget,0);
      end;
      if MenuImageWidget<>nil then begin
        // there is already an icon widget for the image in the menu
        // -> resize the icon widget
        gtk_widget_set_usize(MenuImageWidget,IconSize.X,IconSize.Y);
      end else begin
        // there is no icon widget for the image in the menu
        // -> insert one at the left side of the label
        MenuImageWidget:=gtk_label_new(#0);
        g_signal_connect_after(PgtkObject(MenuImageWidget), 'expose_event',
                          TGTKSignalFunc(@PageIconWidgetExposeAfter), ThePage);
        {$IFNDEF GTK2}
        g_signal_connect_after(PgtkObject(MenuImageWidget), 'draw',
                             TGTKSignalFunc(@PageIconWidgetDrawAfter), ThePage);
        {$ENDIF}
        gtk_widget_set_usize(MenuImageWidget,IconSize.X,IconSize.Y);
        gtk_object_set_data(PGtkObject(MenuWidget),'TabImage',MenuImageWidget);
        gtk_widget_show(MenuImageWidget);
        gtk_box_pack_start_defaults(PGtkBox(MenuWidget),MenuImageWidget);
        gtk_box_reorder_child(PGtkBox(MenuWidget),MenuImageWidget,0);
      end;
    end else begin
      // page does not have an image
      if TabImageWidget<>nil then begin
        // there is a pixmap for an old image in the tab
        // -> remove the icon widget
        DestroyWidget(TabImageWidget);
        gtk_object_set_data(PGtkObject(TabWidget), 'TabImage', nil);
        TabImageWidget:=nil;
      end;
      if MenuImageWidget<>nil then begin
        // there is a pixmap for an old image in the menu
        // -> remove the icon widget
        DestroyWidget(MenuImageWidget);
        gtk_object_set_data(PGtkObject(MenuWidget), 'TabImage', nil);
        MenuImageWidget:=nil;
      end;
    end;
  end;

  procedure UpdateTabLabel;
  var
    TheCaption: PChar;
    CaptionStr: String;
    Pattern: String;
    AccelKey: Char;
  begin
    CaptionStr:=ThePage.Caption;
    LabelFromAmpersands(CaptionStr, Pattern, AccelKey);
    TheCaption:=PChar(CaptionStr);
    if TheCaption=nil then
      TheCaption:=#0;
    gtk_label_set_text(PGtkLabel(TabLabelWidget), PChar(TheCaption));
    {$ifdef gtk1}
    gtk_label_set_pattern(PGtkLabel(TabLabelWidget), PChar(Pattern));
    {$endif gtk1}
    // update the Accelerator
    {if AccelKey = #0
    then Accelerate(ThePage, PageWidget, GDK_VOIDSYMBOL, 0, 'clicked')
    else Accelerate(ThePage, PageWidget, Ord(AccelKey), 0, 'clicked');}

    if MenuLabelWidget<>nil then begin
      gtk_label_set_text(PGtkLabel(MenuLabelWidget),TheCaption);
      {$ifdef gtk1}
      gtk_label_set_pattern(PGtkLabel(MenuLabelWidget), PChar(Pattern));
      {$endif gtk1}
    end;
  end;

  procedure UpdateTabCloseBtn;
  var
    {$IfDef GTK1}
    Img: PGdkPixmap;
    Mask: PGdkBitmap;
    {$Else}
    Img: PGdkPixbuf;
    {$EndIf}
  begin
    {$IfDef GTK1}
    //debugln('UpdateTabCloseBtn ',GetWidgetDebugReport(NoteBookWidget));
    GetNoteBookCloseBtnImage(GetControlWindow(NoteBookWidget),Img,Mask);
    {$Else}
    GetNoteBookCloseBtnImage(Img);
    {$EndIf}
    //debugln('UpdateTabCloseBtn ',dbgs(nboShowCloseButtons in TheNotebook.Options),' ',dbgs(Img<>nil));
    if (nboShowCloseButtons in TheNotebook.Options) and (Img<>nil) then begin
      // close buttons enabled
      if TabCloseBtnWidget=nil then begin
        // there is no close button yet
        // -> add one to the right side of the label in the tab
        TabCloseBtnWidget:=gtk_button_new;
        gtk_object_set_data(PGtkObject(TabWidget), 'TabCloseBtn',
                            TabCloseBtnWidget);
        begin
          // put a pixmap into the button
         {$IfDef GTK1}
          TabCloseBtnImageWidget:=gtk_pixmap_new(Img,Mask);
         {$Else}
          TabCloseBtnImageWidget:=gtk_image_new_from_pixbuf(Img);
         {$EndIf}
          gtk_object_set_data(PGtkObject(TabCloseBtnWidget),'TabCloseBtnImage',
                              TabCloseBtnImageWidget);
          gtk_widget_show(TabCloseBtnImageWidget);
          gtk_container_add(PGtkContainer(TabCloseBtnWidget),
                            TabCloseBtnImageWidget);
        end;
        gtk_widget_show(TabCloseBtnWidget);
        g_signal_connect(PGtkObject(TabCloseBtnWidget), 'clicked',
          TGTKSignalFunc(@gtkNoteBookCloseBtnClicked), APage);
        gtk_box_pack_start_defaults(PGtkBox(TabWidget),TabCloseBtnWidget);
      end;
    end else begin
      // close buttons disabled
      if TabCloseBtnWidget<>nil then begin
        // there is a close button
        // -> remove it
        gtk_object_set_data(PGtkObject(TabWidget), 'TabCloseBtn',
                            nil);
        DestroyWidget(TabCloseBtnWidget);
        TabCloseBtnWidget:=nil;
      end;
    end;
  end;

begin
  ThePage:=TCustomPage(APage);
  TheNoteBook:=TCustomNotebook(ANoteBook);
  if (APage=nil) or (not ThePage.HandleAllocated) then exit;
  if TheNoteBook=nil then begin
    TheNoteBook:=TCustomNotebook(ThePage.Parent);
    if TheNoteBook=nil then exit;
  end;
  NoteBookWidget:=PGtkWidget(TWinControl(TheNoteBook).Handle);
  PageWidget:=PGtkWidget(TWinControl(ThePage).Handle);

  // get the tab container and the tab components: pixmap, label and closebtn
  TabWidget:=gtk_notebook_get_tab_label(PGtkNoteBook(NotebookWidget),
                                        PageWidget);
  if TabWidget<>nil then begin
    TabImageWidget:=gtk_object_get_data(PGtkObject(TabWidget), 'TabImage');
    TabLabelWidget:=gtk_object_get_data(PGtkObject(TabWidget), 'TabLabel');
    TabCloseBtnWidget:=gtk_object_get_data(PGtkObject(TabWidget),'TabCloseBtn');
  end else begin
    TabImageWidget:=nil;
    TabLabelWidget:=nil;
    TabCloseBtnWidget:=nil;
  end;

  // get the menu container and its components: pixmap and label
  MenuWidget:=gtk_notebook_get_menu_label(PGtkNoteBook(NotebookWidget),
                                          PageWidget);
  if MenuWidget<>nil then begin
    MenuImageWidget:=gtk_object_get_data(PGtkObject(MenuWidget), 'TabImage');
    MenuLabelWidget:=gtk_object_get_data(PGtkObject(MenuWidget), 'TabLabel');
  end else begin
    MenuImageWidget:=nil;
    MenuLabelWidget:=nil;
  end;

  UpdateTabImage;
  UpdateTabLabel;
  UpdateTabCloseBtn;
end;


{-------------------------------------------------------------------------------
  GetWidgetScreenPos

  Returns the absolute left top position of a widget on the screen.
-------------------------------------------------------------------------------}
function GetWidgetOrigin(TheWidget: PGtkWidget): TPoint;
var
  TheWindow: PGdkWindow;
  {$IFDEF RaiseExceptionOnNilPointers}
  LCLObject: TObject;
  {$ENDIF}
begin
  TheWindow:=GetControlWindow(TheWidget);
  if TheWindow<>nil then begin
    BeginGDKErrorTrap;
    gdk_window_get_origin(TheWindow,@Result.X,@Result.Y);
    EndGDKErrorTrap;
  end else begin
    {$IFDEF RaiseExceptionOnNilPointers}
    LCLobject:=GetLCLObject(TheWidget);
    DbgOut('GetWidgetOrigin ');
    if LCLObject=nil then
      DbgOut(' LCLObject=nil')
    else if LCLObject is TControl then
      DbgOut(' LCLObject=',TControl(LCLObject).Name,':',TControl(LCLObject).ClassName)
    else
      DbgOut(' LCLObject=',TControl(LCLObject).ClassName);
    DebugLn('');
    RaiseException('GetWidgetOrigin Window=nil');
    {$ENDIF}
    Result.X:=0;
    Result.Y:=0;
  end;
  // check if the gdkwindow is the clientwindow of the parent
  if gtk_widget_get_parent_window(TheWidget)=TheWindow then begin
    // the widget is using its parent window
    // -> adjust the coordinates
    inc(Result.X,TheWidget^.Allocation.X);
    inc(Result.Y,TheWidget^.Allocation.Y);
  end;
end;

{-------------------------------------------------------------------------------
  GetWidgetClientScreenPos

  Returns the absolute left top position of a widget's client area
  on the screen.
-------------------------------------------------------------------------------}
function GetWidgetClientOrigin(TheWidget: PGtkWidget): TPoint;
var
  ClientWidget: PGtkWidget;
  ClientWindow: PGdkWindow;
begin
  ClientWidget:=GetFixedWidget(TheWidget);
  if ClientWidget<>TheWidget then begin
    ClientWindow:=GetControlWindow(ClientWidget);
    if ClientWindow<>nil then begin
      BeginGDKErrorTrap;
      gdk_window_get_origin(ClientWindow,@Result.X,@Result.Y);
      {$Ifdef GTK2}
      if GTK_WIDGET_NO_WINDOW(ClientWidget)
      then begin
        Inc(Result.X, ClientWidget^.Allocation.X);
        Inc(Result.Y, ClientWidget^.Allocation.Y);
      end;
      {$EndIf}
      EndGDKErrorTrap;
      exit;
    end;
  end;
  Result:=GetWidgetOrigin(TheWidget);
end;

{-------------------------------------------------------------------------------
  TranslateGdkPointToClientArea

  Translates SourcePos relative to SourceWindow to a coordinate relative to the
  client area of the LCL WinControl.
-------------------------------------------------------------------------------}
function TranslateGdkPointToClientArea(SourceWindow: PGdkWindow;
  SourcePos: TPoint;  DestinationWidget: PGtkWidget): TPoint;
var
  SrcWindowOrigin: TPoint;
  ClientAreaWindowOrigin: TPoint;
  Src2ClientAreaVector: TPoint;
begin
  if SourceWindow=nil then begin
    {$IFDEF RaiseExceptionOnNilPointers}
    RaiseException('TranslateGdkPointToClientArea Window=nil');
    {$ENDIF}
    DebugLn('WARNING: TranslateGdkPointToClientArea SourceWindow=nil');
  end;
  gdk_window_get_origin(SourceWindow,@SrcWindowOrigin.X,@SrcWindowOrigin.Y);

  ClientAreaWindowOrigin:=GetWidgetClientOrigin(DestinationWidget);
  Src2ClientAreaVector.X:=ClientAreaWindowOrigin.X-SrcWindowOrigin.X;
  Src2ClientAreaVector.Y:=ClientAreaWindowOrigin.Y-SrcWindowOrigin.Y;
  Result.X:=SourcePos.X-Src2ClientAreaVector.X;
  Result.Y:=SourcePos.Y-Src2ClientAreaVector.Y;
end;

{------------------------------------------------------------------------------
  Function: UpdateMouseCaptureControl
  Params: none
  Returns:  none

  Sets MCaptureControl to the current capturing widget.
 ------------------------------------------------------------------------------}
procedure UpdateMouseCaptureControl;
var
  OldMouseCaptureWidget,
  CurMouseCaptureWidget: PGtkWidget;
begin
  OldMouseCaptureWidget:=MouseCaptureWidget;
  CurMouseCaptureWidget:=gtk_grab_get_current;

  if OldMouseCaptureWidget<>CurMouseCaptureWidget then begin
    // the mouse grab changed
    // -> this means the gtk itself has changed the mouse grab
    {$IFDEF VerboseMouseCapture}
    DebugLn('UpdateMouseCaptureControl Capture changed from ',
      '[',GetWidgetDebugReport(OldMouseCaptureWidget),']',
      ' to [',GetWidgetDebugReport(CurMouseCaptureWidget),']');
    if CurMouseCaptureWidget<>nil then
    DebugLn('parent ',    GetWidgetDebugReport(CurMouseCaptureWidget^.Parent));

    {$ENDIF}

    // notify the new capture control
    MouseCaptureWidget:=CurMouseCaptureWidget;
    MouseCaptureType:=mctGTK;
    if MouseCaptureWidget<>nil then begin
      // the MouseCaptureWidget is probably not a main widget
      SendMessage(HWnd(MouseCaptureWidget), LM_CAPTURECHANGED, 0,
        HWnd(OldMouseCaptureWidget));
    end;
  end;
end;

procedure IncreaseMouseCaptureIndex;
begin
  if MouseCaptureIndex<$ffffffff then
    inc(MouseCaptureIndex)
  else
    MouseCaptureIndex:=0;
end;

procedure CaptureMouseForWidget(Widget: PGtkWidget; Owner: TMouseCaptureType);
var
  CaptureWidget: PGtkWidget;
  NowIndex: Cardinal;
begin
  {$IFDEF VerboseMouseCapture}
  DebugLn('CaptureMouseForWidget START ',GetWidgetDebugReport(Widget));
  {$ENDIF}
  if not (Owner in [mctGTKIntf,mctLCL]) then exit;
  // not every widget can capture the mouse
  CaptureWidget:=GetDefaultMouseCaptureWidget(Widget);
  if CaptureWidget=nil then exit;

  UpdateMouseCaptureControl;
  if (MouseCaptureType<>mctGTK) then begin
    // we are capturing
    if (MouseCaptureWidget=CaptureWidget) then begin
      // we are already capturing this widget
      exit;
    end;
    // release old capture
    ReleaseMouseCapture;
  end;

  {$IFDEF VerboseMouseCapture}
  DebugLn('CaptureMouseForWidget Start Capturing for ',GetWidgetDebugReport(CaptureWidget));
  {$ENDIF}
  IncreaseMouseCaptureIndex;
  NowIndex:=MouseCaptureIndex;
  if not gtk_widget_has_focus(CaptureWidget) then
    gtk_widget_grab_focus(CaptureWidget);
  if NowIndex=MouseCaptureIndex then begin
    {$IFDEF VerboseMouseCapture}
    DebugLn('CaptureMouseForWidget Commit Capturing for ',GetWidgetDebugReport(CaptureWidget));
    {$ENDIF}
    MouseCaptureWidget:=CaptureWidget;
    MouseCaptureType:=Owner;
    gtk_grab_add(CaptureWidget);
  end;
end;

function GetDefaultMouseCaptureWidget(Widget: PGtkWidget
  ): PGtkWidget;
var
  WidgetInfo: PWinWidgetInfo;
  LCLObject: TObject;
begin
  Result:=nil;
  if Widget=nil then exit;
  if GtkWidgetIsA(Widget,GTKAPIWidget_GetType) then begin
    WidgetInfo:=GetWidgetInfo(Widget,false);
    if WidgetInfo<>nil then
      Result:=WidgetInfo^.CoreWidget;
    exit;
  end;
  LCLObject:=GetNearestLCLObject(Widget);
  if LCLObject=nil then exit;
  if ((TWinControl(LCLObject) is TCustomSplitter)
  or (TWinControl(LCLObject) is TToolButton))
  and (TWinControl(LCLObject).HandleAllocated)
  then begin
    WidgetInfo:=GetWidgetInfo(PGtkWidget(TWinControl(LCLObject).Handle),false);
    if WidgetInfo<>nil then
      Result:=WidgetInfo^.CoreWidget;
  end;
end;

{------------------------------------------------------------------------------
  procedure ReleaseMouseCapture;

  If the current mouse capture was captured by the LCL or the gtk intf, release
  the capture. Don't release mouse captures of the gtk, because captures must
  be balanced and this is already done by the gtk.
 ------------------------------------------------------------------------------}
procedure ReleaseMouseCapture;
var
  OldMouseCaptureWidget: PGtkWidget;
begin
  {$IFDEF VerboseMouseCapture}
  DebugLn('ReleaseMouseCapture ',dbgs(ord(MouseCaptureType)),' MouseCaptureWidget=[',GetWidgetDebugReport(MouseCaptureWidget),']');
  {$ENDIF}
  if MouseCaptureType=mctGTK then exit;
  OldMouseCaptureWidget:=MouseCaptureWidget;
  MouseCaptureWidget:=nil;
  MouseCaptureType:=mctGTK;
  if OldMouseCaptureWidget<>nil then
    gtk_grab_remove(OldMouseCaptureWidget);
  // tell the LCL
  SetCaptureControl(nil);
end;

procedure ReleaseCaptureWidget(Widget : PGtkWidget);
begin
  if (Widget=nil)
  or ((MouseCaptureWidget<>Widget) and (MouseCaptureWidget<>Widget^.parent))
  then
    exit;
  DebugLn('ReleaseCaptureWidget ',GetWidgetDebugReport(Widget));
  ReleaseMouseCapture;
end;

{------------------------------------------------------------------------------
  procedure: SetCursor
  Params:  AWinControl : TWinControl
  Returns: Nothing

  Sets the cursor for a widget.
 ------------------------------------------------------------------------------}
procedure SetCursor(AWinControl : TWinControl; ACursor: TCursor);

  procedure DoSetCursor(AWindow: PGdkWindow; Cursor: pGDKCursor);
  begin
    if Cursor <> nil then begin
      gdk_window_set_cursor(AWindow, Cursor);
    end;
  end;

  procedure SetCursorRecursive(AWindow: PGdkWindow; Cursor: PGdkCursor);
  var
    ChildWindows, ListEntry: PGList;
  begin
    DoSetCursor(AWindow, Cursor);
    
    ChildWindows:=gdk_window_get_children(AWindow);

    ListEntry:=ChildWindows;
    while ListEntry<>nil do begin
      SetCursorRecursive(PGdkWindow(ListEntry^.Data), Cursor);
      ListEntry:=ListEntry^.Next;
    end;
    g_list_free(ChildWindows);
  end;

var
  AWidget, FixWidget: PGtkWidget;
  AWindow: PGdkWindow;
  NewCursor: PGdkCursor;
begin
  if not ((AWinControl is TWinControl) and AWinControl.HandleAllocated)
  then exit;
  
  AWidget:= PGtkWidget(AWinControl.Handle);

  if csDesigning in AWinControl.ComponentState then begin

    AWindow:=GetControlWindow(AWidget);
    if AWindow = nil then exit;
    if ACursor = crDefault then
      SetCursorRecursive(AWindow, GetGDKMouseCursor(crDefault))
    else begin
      NewCursor:= GetGDKMouseCursor(ACursor);
      if NewCursor <> nil then SetCursorRecursive(AWindow, NewCursor);
    end;  
    
  end else begin

    FixWidget:= GetFixedWidget(AWidget);
    AWindow:= GetControlWindow(FixWidget);
    if AWindow = nil then exit;
    
    NewCursor:= GetGDKMouseCursor(AWinControl.Cursor);
    if NewCursor <> nil then DoSetCursor(AWindow, NewCursor);
  end;
end;

{-------------------------------------------------------------------------------
  procedure: SignalConnect
  Params:  AWidget: PGTKWidget
           ASignal: PChar
           AProc:   Pointer
           AInfo:   PWidgetInfo
  Returns: Nothing

  Connects a gtk signal handler.
  This is a wrapper to get around gtk casting
-------------------------------------------------------------------------------}
procedure SignalConnect(const AWidget: PGTKWidget; const ASignal: PChar;
  const AProc: Pointer; const AInfo: PWidgetInfo);
begin
  g_signal_connect(PGtkObject(AWidget), ASignal, TGTKSignalFunc(AProc), AInfo);
end;

{-------------------------------------------------------------------------------
  procedure: SignalConnectAfter
  Params:  AWidget: PGTKWidget
           ASignal: PChar
           AProc:   Pointer
           AInfo:   PGtkWSWidgetInfo
  Returns: Nothing

  Connects a gtk signal after handler. 
  This is a wrapper to get around gtk casting
-------------------------------------------------------------------------------}
procedure SignalConnectAfter(const AWidget:PGTKWidget; const ASignal: PChar;
  const AProc: Pointer; const AInfo: PWidgetInfo);
begin
  g_signal_connect_after(PGTKObject(AWidget), ASignal, TGTKSignalFunc(AProc), AInfo);
end;

{-------------------------------------------------------------------------------
  procedure ConnectSignal(const AnObject:PGTKObject; const ASignal: PChar;
    const ACallBackProc: Pointer; const ReqSignalMask: TGdkEventMask;
    Flags: TConnectSignalFlags);
    
  Connects a gtk signal handler.
-------------------------------------------------------------------------------}
procedure InitDesignSignalMasks;
var
  SignalType: TDesignSignalType;
begin
  DesignSignalMasks[dstUnknown]:=0;
  for SignalType:=Low(TDesignSignalType) to High(TDesignSignalType) do
    DesignSignalMasks[SignalType]:=1 shl ord(SignalType);
end;

function DesignSignalNameToType(Name: PChar; After: boolean): TDesignSignalType;
begin
  for Result:=Low(TDesignSignalType) to High(TDesignSignalType) do
    if ComparePChar(DesignSignalNames[Result],Name)
    and (DesignSignalAfter[Result]=After) then exit;
  Result:=dstUnknown;
end;

function GetDesignSignalMask(Widget: PGtkWidget): TDesignSignalMask;
begin
  Result:=TDesignSignalMask(PtrInt(gtk_object_get_data(PGtkObject(Widget),
                                                'LCLDesignMask')));
end;

procedure SetDesignSignalMask(Widget: PGtkWidget; NewMask: TDesignSignalMask);
begin
  gtk_object_set_data(PGtkObject(Widget),'LCLDesignMask',Pointer(PtrInt(NewMask)));
end;

function GetDesignOnlySignalFlag(Widget: PGtkWidget;
  DesignSignalType: TDesignSignalType): boolean;
begin
  Result:=(GetDesignSignalMask(Widget)
          and DesignSignalMasks[DesignSignalType])<>0;
end;

function SignalConnected(const AnObject:PGTKObject; const ASignal: PChar;
  const ACallBackProc: Pointer; const ALCLObject: TObject;
  const ASFlags: TConnectSignalFlags): boolean;
{$IFDEF Gtk1}
var
  Handler: PGTKHandler;
  SignalID: guint;
begin
  Handler := gtk_object_get_data_by_id (AnObject, gtk_handler_quark);
  SignalID := g_signal_lookup(ASignal, GTK_OBJECT_TYPE(AnObject));
  if SignalID<0 then
    RaiseGDBException('SignalConnected');

  while (Handler <> nil) do begin
    with Handler^ do
    begin
      // check if signal is already connected
      //debugln('ConnectSignal Id=',dbgs(Id));
      if  (Id > 0)
      and (Signal_ID = SignalID)
      and (Func = TGTKSignalFunc(ACallBackProc))
      and (func_data = Pointer(ALCLObject))
      and (((flags and bmSignalAfter)<>0)=(csfAfter in ASFlags))
      then begin
        // signal is already connected
        Result:=true;
        Exit;
      end;

      Handler := Next;
    end;
  end;
  Result:=false;
end;
{$ELSE}
begin
  Result:=g_signal_handler_find(AnObject,
    G_SIGNAL_MATCH_FUNC or G_SIGNAL_MATCH_DATA,
    0,0,nil,ACallBackProc,ALCLObject)<>0;
end;
{$ENDIF}

procedure ConnectSignal(const AnObject:PGTKObject; const ASignal: PChar;
  const ACallBackProc: Pointer; const ALCLObject: TObject;
  const AReqSignalMask: TGdkEventMask; const ASFlags: TConnectSignalFlags);
var
  WinWidgetInfo: PWinWidgetInfo;
  MainWidget: PGtkWidget;
  OldDesignMask, NewDesignMask: TDesignSignalMask;
  DesignSignalType: TDesignSignalType;
  RealizeConnected: Boolean;
  HasRealizeSignal: Boolean;
begin
  if ACallBackProc = nil then
    RaiseGDBException('ConnectSignal');

  // first loop through the handlers to:
  // - check if a handler already exists
  // - Find the realize handler to change data
  DesignSignalType:=DesignSignalNameToType(ASignal,csfAfter in ASFlags);
  if SignalConnected(AnObject,ASignal,ACallBackProc,ALCLObject,ASFlags) then
  begin
    // signal is already connected
    // update the DesignSignalMask
    if (DesignSignalType <> dstUnknown)
    and (not (csfDesignOnly in ASFlags))
    then begin
      OldDesignMask := GetDesignSignalMask(PGtkWidget(AnObject));
      NewDesignMask :=OldDesignMask and not DesignSignalMasks[DesignSignalType];
      if OldDesignMask <> NewDesignMask
      then SetDesignSignalMask(PGtkWidget(AnObject),NewDesignMask);
    end;
    Exit;
  end;
  
  // if we are here, then no handler was defined yet
  // -> register handler
  //if (Msg=LM_LBUTTONUP) then DebugLn('CONNECT ',ReqSignalMask,' Widget=',DbgS(AnObject));
  //debugln('ConnectSignal ',DbgSName(ALCLObject),' ',ASignal,' After=',dbgs(csfAfter in ASFlags));
  if csfAfter in ASFlags then
    g_signal_connect_after(AnObject, ASignal,
                           TGTKSignalFunc(ACallBackProc), ALCLObject)
  else
    g_signal_connect      (AnObject, ASignal,
                           TGTKSignalFunc(ACallBackProc), ALCLObject);

  // update signal mask which will be set in the realize handler
  if (csfUpdateSignalMask in ASFlags) and (AReqSignalMask <> 0)
  then begin
    MainWidget := GetMainWidget(PGtkWidget(AnObject));
    if MainWidget=nil
    then MainWidget := PGtkWidget(AnObject);
    WinWidgetInfo := GetWidgetInfo(MainWidget,true);
    WinWidgetInfo^.EventMask := WinWidgetInfo^.EventMask or AReqSignalMask;
  end;
  
  // -> register realize handler
  if (csfConnectRealize in ASFlags) then begin
    HasRealizeSignal:=g_signal_lookup('realize', GTK_OBJECT_TYPE(AnObject))>0;
    if HasRealizeSignal then begin
      RealizeConnected:=SignalConnected(AnObject,'realize',@GTKRealizeCB,
                                        ALCLObject,[]);
      if not RealizeConnected then begin
        g_signal_connect(AnObject, 'realize',
          TGTKSignalFunc(@GTKRealizeCB), ALCLObject);
        g_signal_connect_after(AnObject, 'realize',
          TGTKSignalFunc(@GTKRealizeAfterCB), ALCLObject);
      end;
    end;
  end;

  // update the DesignSignalMask
  if (DesignSignalType <> dstUnknown)
  then begin
    OldDesignMask:=GetDesignSignalMask(PGtkWidget(AnObject));
    if csfDesignOnly in ASFlags then
      NewDesignMask:=OldDesignMask or DesignSignalMasks[DesignSignalType]
    else
      NewDesignMask:=OldDesignMask and not DesignSignalMasks[DesignSignalType];
    if OldDesignMask<>NewDesignMask then
      SetDesignSignalMask(PGtkWidget(AnObject),NewDesignMask);
  end;
end;

procedure ConnectSignal(const AnObject:PGTKObject; const ASignal: PChar;
  const ACallBackProc: Pointer; const ALCLObject: TObject;
  const AReqSignalMask: TGdkEventMask);
begin
  ConnectSignal(AnObject,ASignal,ACallBackProc, ALCLObject, AReqSignalMask,
                [csfConnectRealize,csfUpdateSignalMask]);
end;

procedure ConnectSignalAfter(const AnObject:PGTKObject; const ASignal: PChar;
  const ACallBackProc: Pointer; const ALCLObject: TObject;
  const AReqSignalMask: TGdkEventMask);
begin
  ConnectSignal(AnObject,ASignal,ACallBackProc, ALCLObject, AReqSignalMask,
                [csfConnectRealize,csfUpdateSignalMask,csfAfter]);
end;

procedure ConnectSignal(const AnObject:PGTKObject; const ASignal: PChar;
  const ACallBackProc: Pointer; const ALCLObject: TObject);
begin
  ConnectSignal(AnObject,ASignal,ACallBackProc, ALCLObject, 0);
end;

procedure ConnectSignalAfter(const AnObject:PGTKObject; const ASignal: PChar;
  const ACallBackProc: Pointer; const ALCLObject: TObject);
begin
  ConnectSignalAfter(AnObject,ASignal,ACallBackProc, ALCLObject, 0);
end;

{------------------------------------------------------------------------------
  procedure: ConnectInternalWidgetsSignals
  Params:  AWidget: PGtkWidget; AWinControl: TWinControl
  Returns: Nothing

  Connects hidden child widgets signals.
  Many gtk widgets create internally child widgets (e.g. scrollbars). In
  Design mode these widgets should not auto react themselves, but instead send
  messages to the lcl. Therefore these widgets are connected also to our
  signal handlers.
  This procedure is called by the realize-after handler of all LCL widgets
  and each time the design mode of a LCL control changes.
 ------------------------------------------------------------------------------}
procedure ConnectInternalWidgetsSignals(AWidget: PGtkWidget;
  AWinControl: TWinControl);

  function WidgetIsInternal(TheWidget: PGtkWidget): boolean;
  begin
    Result:=(TheWidget<>nil)
      and (PGtkWidget(AWinControl.Handle)<>TheWidget)
      and (GetMainWidget(TheWidget)=nil);
  end;

  procedure ConnectSignals(TheWidget: PGtkWidget); forward;

  procedure ConnectChilds(TheWidget: PGtkWidget);
  var
    ScrolledWindow: PGtkScrolledWindow;
    BinWidget: PGtkBin;
    {$IFDEF Gtk2}
    ChildEntry2: PGList;
    {$ELSE}
    ChildEntry: PGSList;
    {$ENDIF}
    ChildWidget: PGtkWidget;
  begin
    //if AWinControl is TListView then DebugLn('ConnectChilds A ',DbgS(TheWidget));
    if GtkWidgetIsA(TheWidget,GTK_TYPE_CONTAINER) then begin
      //if AWinControl is TListView then DebugLn('ConnectChilds B ');
      // this is a container widget -> connect all childs
      {$IFDEF Gtk2}
      ChildEntry2:=gtk_container_get_children(PGtkContainer(TheWidget));
      while ChildEntry2<>nil do begin
        ChildWidget:=PGtkWidget(ChildEntry2^.Data);
        if ChildWidget<>TheWidget then
          ConnectSignals(ChildWidget);
        ChildEntry2:=ChildEntry2^.Next;
      end;
      {$ELSE}
      ChildEntry:=PGtkContainer(TheWidget)^.resize_widgets;
      while ChildEntry<>nil do begin
        ChildWidget:=PGtkWidget(ChildEntry^.Data);
        ConnectSignals(ChildWidget);
        ChildEntry:=ChildEntry^.Next;
      end;
      {$endif}
    end;
    if GtkWidgetIsA(TheWidget,GTK_TYPE_BIN) then begin
      //if AWinControl is TListView then DebugLn('ConnectChilds C ');
      BinWidget:=PGtkBin(TheWidget);
      ConnectSignals(BinWidget^.child);
    end;
    if GtkWidgetIsA(TheWidget,GTK_TYPE_SCROLLED_WINDOW) then begin
      //if AWinControl is TListView then DebugLn('ConnectChilds D ');
      ScrolledWindow:=PGtkScrolledWindow(TheWidget);
      ConnectSignals(ScrolledWindow^.hscrollbar);
      ConnectSignals(ScrolledWindow^.vscrollbar);
    end;
    if GtkWidgetIsA(TheWidget,GTK_TYPE_COMBO) then begin
      //if AWinControl is TListView then DebugLn('ConnectChilds E ');
      ConnectSignals(PGtkCombo(TheWidget)^.entry);
      ConnectSignals(PGtkCombo(TheWidget)^.button);
    end;
  end;

  procedure ConnectSignals(TheWidget: PGtkWidget);
  var
    LCLObject, HiddenLCLObject: TObject;
    DesignSignalType: TDesignSignalType;
    DesignFlags: TConnectSignalFlags;
  begin
    //if AWinControl is TListView then DebugLn('ConnectSignals A ',DbgS(TheWidget));
    if TheWidget=nil then exit;
    
    // check if TheWidget belongs to another LCL object
    LCLObject:=GetLCLObject(TheWidget);
    HiddenLCLObject:=GetHiddenLCLObject(TheWidget);
    if (LCLObject<>nil) and (LCLObject<>AWinControl) then begin
      exit;
    end;
    if (HiddenLCLObject<>nil) and (HiddenLCLObject<>AWinControl) then begin
      exit;
    end;

    //if AWinControl is TListView then DebugLn('ConnectSignals B ',DbgS(TheWidget));
    // connect signals needed for design mode:
    for DesignSignalType:=Low(TDesignSignalType) to High(TDesignSignalType) do
    begin
      if DesignSignalType=dstUnknown then continue;
      if (not DesignSignalBefore[DesignSignalType])
      and (not DesignSignalAfter[DesignSignalType]) then
        continue;

      DesignFlags:=[csfDesignOnly];
      if DesignSignalAfter[DesignSignalType] then
        Include(DesignFlags,csfAfter);
      ConnectSignal(PGtkObject(TheWidget),DesignSignalNames[DesignSignalType],
                    DesignSignalFuncs[DesignSignalType],AWinControl,0,
                    DesignFlags);
    end;

    if WidgetIsInternal(TheWidget) then
      // mark widget as 'hidden' connected
      SetHiddenLCLObject(TheWidget,AWinControl);

    // connect recursively ...
    ConnectChilds(TheWidget);
  end;
  
begin
  if (AWinControl=nil) or (AWidget=nil)
  or (not (csDesigning in AWinControl.ComponentState)) then exit;
  ConnectSignals(AWidget);
end;

// ----------------------------------------------------------------------
// The Accelgroup and AccelKey is needed by menus
// ----------------------------------------------------------------------
function GetAccelGroup(const Widget: PGtkWidget;
  CreateIfNotExists: boolean): PGTKAccelGroup;
begin
  Result := PGTKAccelGroup(gtk_object_get_data(PGtkObject(Widget),'AccelGroup'));
  if (Result=nil) and CreateIfNotExists then begin
    {$IFDEF VerboseAccelerator}
    DebugLn('GetAccelGroup CREATING  Widget=',DbgS(Widget),' CreateIfNotExists=',dbgs(CreateIfNotExists));
    {$ENDIF}
    Result:=gtk_accel_group_new;
    SetAccelGroup(Widget,Result);
    if GtkWidgetIsA(Widget,GTK_TYPE_WINDOW) then
      ShareWindowAccelGroups(Widget);
  end;
end;

procedure SetAccelGroup(const Widget: PGtkWidget;
  const AnAccelGroup: PGTKAccelGroup);
begin
  if (Widget = nil) then exit;
  gtk_object_set_data(PGtkObject(Widget), 'AccelGroup', AnAccelGroup);
  if AnAccelGroup<>nil then begin
    // attach group to widget
    {$IFDEF VerboseAccelerator}
    DebugLn('SetAccelGroup AnAccelGroup=',DbgS(AnAccelGroup),' IsMenu=',dbgs(GtkWidgetIsA(Widget,GTK_MENU_TYPE)));
    {$ENDIF}
    if GtkWidgetIsA(Widget,GTK_TYPE_MENU) then
      gtk_menu_set_accel_group(PGtkMenu(Widget), AnAccelGroup)
    else begin
      {$IfDef GTK2}
      Assert(GtkWidgetIsA(Widget,GTK_TYPE_WINDOW));
      gtk_window_add_accel_group(GTK_WINDOW(widget), AnAccelGroup);
      {$else}
      gtk_accel_group_attach(AnAccelGroup, PGtkObject(Widget));
      {$endif}
    end;
  end;
end;

procedure FreeAccelGroup(const Widget: PGtkWidget);
var
  AccelGroup: PGTKAccelGroup;
begin
  AccelGroup:=GetAccelGroup(Widget,false);
  if AccelGroup<>nil then begin
    {$IFDEF VerboseAccelerator}
    DebugLn('FreeAccelGroup  AccelGroup=',DbgS(AccelGroup));
    {$ENDIF}
    gtk_accel_group_unref(AccelGroup);
    SetAccelGroup(Widget,nil);
  end;
end;

procedure ShareWindowAccelGroups(AWindow: PGtkWidget);

  procedure AttachUnique(TheWindow: PGtkWidget; TheAccelGroup: PGTKAccelGroup);
  begin
    {$IfDef GTK2}
    if (TheWindow=nil) or (TheAccelGroup=nil)
      or (TheAccelGroup^.acceleratables=nil)
      or (g_slist_find(TheAccelGroup^.acceleratables, TheWindow)=nil)
    then
      exit;
    gtk_window_add_accel_group(GTK_WINDOW(TheWindow), TheAccelGroup);
    {$else}
    if (TheAccelGroup=nil)
    or ((TheAccelGroup^.attach_objects<>nil)
      and (g_slist_find(TheAccelGroup^.attach_objects, TheWindow)<>nil))
    then
      exit;
    gtk_accel_group_attach(TheAccelGroup, PGtkObject(TheWindow));
    {$endif}
  end;

var
  TheForm, CurForm: TCustomForm;
  i: integer;
  TheAccelGroup, CurAccelGroup: PGTKAccelGroup;
  CurWindow: PGtkWidget;
begin
  TheForm:=TCustomForm(GetLCLObject(AWindow));

  // check if visible TCustomForm (not frame)
  if (TheForm=nil) or (not (TheForm is TCustomForm))
  or (not TheForm.Visible) or (TheForm.Parent<>nil)
  or (csDesigning in TheForm.ComponentState)
  then
    exit;
  
  // check if modal form
  if fsModal in TheForm.FormState then begin
    // a modal form does not share accelerators
    exit;
  end;

  // check if there is an accelerator group
  TheAccelGroup:=GetAccelGroup(AWindow,false);

  // this is a normal form
  // -> share accelerators with all other visible normal forms
  for i:=0 to Screen.FormCount-1 do begin
    CurForm:=Screen.Forms[i];
    if (CurForm=TheForm)
    or (not CurForm.HandleAllocated)
    or (not CurForm.Visible)
    or (fsModal in CurForm.FormState)
    or (CurForm.Parent<>nil)
    or (csDesigning in CurForm.ComponentState)
    then continue;
    
    CurWindow:=PGtkWidget(CurForm.Handle);
    CurAccelGroup:=GetAccelGroup(CurWindow,false);
    {$IFDEF VerboseAccelerator}
    DebugLn('ShareWindowAccelGroups ',TheForm.Name,':',TheForm.ClassName,
            ' <-> ',CurForm.Name,':',CurForm.ClassName);
    {$ENDIF}

    // cross connect
    AttachUnique(CurWindow,TheAccelGroup);
    AttachUnique(AWindow,CurAccelGroup);
  end;
end;

procedure UnshareWindowAccelGroups(AWindow: PGtkWidget);

  procedure Detach(TheWindow: PGtkWidget; TheAccelGroup: PGTKAccelGroup);
  begin
    {$IfDef GTK2}
    if (TheWindow=nil) or (TheAccelGroup=nil)
      or (TheAccelGroup^.acceleratables=nil)
      or (g_slist_find(TheAccelGroup^.acceleratables, TheWindow)=nil)
    then
      exit;
    gtk_window_remove_accel_group(GTK_WINDOW(TheWindow), TheAccelGroup);
    {$else}
    if (TheAccelGroup=nil)
    or (TheAccelGroup^.attach_objects=nil)
    or (g_slist_find(TheAccelGroup^.attach_objects, TheWindow)=nil)
    then
      exit;
    gtk_accel_group_detach(TheAccelGroup, PGtkObject(TheWindow));
    {$endif}
  end;

var
  TheForm, CurForm: TCustomForm;
  i: integer;
  TheAccelGroup, CurAccelGroup: PGTKAccelGroup;
  CurWindow: PGtkWidget;
begin
  TheForm:=TCustomForm(GetLCLObject(AWindow));

  // check if TCustomForm
  if (TheForm=nil) or (not (TheForm is TCustomForm))
  then exit;

  TheAccelGroup:=GetAccelGroup(AWindow,false);

  // -> unshare accelerators with all other forms
  for i:=0 to Screen.FormCount-1 do begin
    CurForm:=Screen.Forms[i];
    if (CurForm=TheForm)
    or (not CurForm.HandleAllocated)
    then continue;

    CurWindow:=PGtkWidget(CurForm.Handle);
    CurAccelGroup:=GetAccelGroup(CurWindow,false);
    {$IFDEF VerboseAccelerator}
    DebugLn('UnshareWindowAccelGroups ',TheForm.Name,':',TheForm.ClassName,
            ' <-> ',CurForm.Name,':',CurForm.ClassName);
    {$ENDIF}

    // unlink
    Detach(CurWindow,TheAccelGroup);
    Detach(AWindow,CurAccelGroup);
  end;
end;

function GetAccelGroupForComponent(Component: TComponent;
  CreateIfNotExists: boolean): PGTKAccelGroup;
var
  Control: TControl;
  MenuItem: TMenuItem;
  Form: TCustomForm;
  Menu: TMenu;
begin
  Result:=nil;
  if Component=nil then exit;
  
  if Component is TMenuItem then begin
    MenuItem:=TMenuItem(Component);
    Menu:=MenuItem.GetParentMenu;
    if (Menu=nil) or (Menu.Parent=nil) then exit;
    {$IFDEF VerboseAccelerator}
    DebugLn('GetAccelGroupForComponent A ',Component.Name,':',Component.ClassName);
    {$ENDIF}
    Result:=GetAccelGroupForComponent(Menu.Parent,CreateIfNotExists);
  end else if Component is TControl then begin
    Control:=TControl(Component);
    while Control.Parent<>nil do Control:=Control.Parent;
    if Control is TCustomForm then begin
      Form:=TCustomForm(Control);
      if Form.HandleAllocated then begin
        Result:=GetAccelGroup(PGtkWidget(Form.Handle),CreateIfNotExists);
        {$IFDEF VerboseAccelerator}
        DebugLn('GetAccelGroupForComponent C ',Component.Name,':',Component.ClassName);
        {$ENDIF}
      end;
    end;
  end;
  {$IFDEF VerboseAccelerator}
  DebugLn('GetAccelGroupForComponent END ',Component.Name,':',Component.ClassName,' Result=',DbgS(Result));
  {$ENDIF}
end;

function GetAccelKey(Widget: PGtkWidget): PAcceleratorKey;
begin
  Result := PAcceleratorKey(gtk_object_get_data(PGtkObject(Widget),'AccelKey'));
end;

function SetAccelKey(const Widget: PGtkWidget;
  Key: guint; Mods: TGdkModifierType; const Signal: string): PAcceleratorKey;
begin
  if (Widget = nil) then exit;
  Result:=GetAccelKey(Widget);
  if Result=nil then begin
    if Key<>GDK_VOIDSYMBOL then begin
      New(Result);
      FillChar(Result^,SizeOf(Result),0);
    end;
  end else begin
    if Key=GDK_VOIDSYMBOL then begin
      Dispose(Result);
      Result:=nil;
    end;
  end;
  if (Result<>nil) then begin
    Result^.Key:=Key;
    Result^.Mods:=Mods;
    Result^.Signal:=Signal;
    Result^.Realized:=false;
  end;
  {$IFDEF VerboseAccelerator}
  DebugLn('SetAccelKey Widget=',DbgS(Widget),
    ' Key=',dbgs(Key),' Mods=',DbgS(Mods),
    ' Signal="',Signal,'" Result=',DbgS(Result));
  {$ENDIF}
  gtk_object_set_data(PGtkObject(Widget), 'AccelKey', Result);
end;

procedure ClearAccelKey(Widget: PGtkWidget);
begin
  SetAccelKey(Widget,GDK_VOIDSYMBOL,0,'');
end;

procedure RealizeAccelerator(Component: TComponent; Widget : PGtkWidget);
var
  AccelKey: PAcceleratorKey;
  AccelGroup: PGTKAccelGroup;
begin
  if (Component=nil) or (Widget=nil) then
    RaiseGDBException('RealizeAccelerate: invalid input');

  // Set the accelerator
  AccelKey:=GetAccelKey(Widget);
  if (AccelKey=nil) or (AccelKey^.Realized) then exit;
  
  if AccelKey^.Key<>GDK_VOIDSYMBOL then begin
    AccelGroup:=GetAccelGroupForComponent(Component,true);
    if AccelGroup<>nil then begin
      {$IFDEF VerboseAccelerator}
      DebugLn('RealizeAccelerator Add Accelerator ',
        Component.Name,':',Component.ClassName,
        ' Widget=',DbgS(Widget),
        ' Signal=',AccelKey^.Signal,
        ' Key=',dbgs(AccelKey^.Key),' Mods=',dbgs(AccelKey^.Mods),
        '');
      {$ENDIF}
      gtk_widget_add_accelerator(Widget, PChar(AccelKey^.Signal),
        AccelGroup, AccelKey^.Key, AccelKey^.Mods, GTK_ACCEL_VISIBLE);
      AccelKey^.Realized:=true;
    end else begin
      AccelKey^.Realized:=false;
    end;
  end else begin
    AccelKey^.Realized:=true;
  end;
end;

procedure UnrealizeAccelerator(Widget : PGtkWidget);
var
  AccelKey: PAcceleratorKey;
begin
  if (Widget=nil) then
    RaiseGDBException('UnrealizeAccelerate: invalid input');
    
  AccelKey:=GetAccelKey(Widget);
  if (AccelKey=nil) or (not AccelKey^.Realized) then exit;

  if AccelKey^.Signal<>'' then begin
    {$IFDEF VerboseAccelerator}
    DebugLn('UnrealizeAccelerator  ',
      ' Widget=',DbgS(Widget),
      ' Signal=',AccelKey^.Signal,
      ' Key=',dbgs(AccelKey^.Key),' Mods=',dbgs(AccelKey^.Mods),
      '');
    {$ENDIF}
    {$Ifdef GTK2}
       DebugLn('ToDo: gtkproc.inc UnrealizeAccelerator');
    {$else}
    gtk_widget_remove_accelerators(Widget, PChar(AccelKey^.Signal), false);
    {$EndIf}
  end;
  AccelKey^.Realized:=false;
end;

procedure RegroupAccelerator(Widget: PGtkWidget);
begin
  UnrealizeAccelerator(Widget);
  RealizeAccelerator(TComponent(GetLCLObject(Widget)),Widget);
end;

procedure Accelerate(Component: TComponent; const Widget : PGtkWidget;
  const Key: guint; Mods: TGdkModifierType; const Signal : string);
var
  OldAccelKey: PAcceleratorKey;
begin
  if (Component=nil) or (Widget=nil) or (Signal='') then
    RaiseGDBException('Accelerate: invalid input');
  {$IFDEF VerboseAccelerator}
  DebugLn('Accelerate ',DbgSName(Component),' Key=',dbgs(Key),' Mods=',DbgS(Mods),' Signal=',Signal);
  {$ENDIF}
  
  // delete old accelerator key
  OldAccelKey:=GetAccelKey(Widget);
  if (OldAccelKey <> nil) then begin
    if (OldAccelKey^.Key=Key) and (OldAccelKey^.Mods=Mods)
    and (OldAccelKey^.Signal=Signal)
    then begin
      // no change
      exit;
    end;
      
    UnrealizeAccelerator(Widget);
  end;

  // Set the accelerator
  SetAccelKey(Widget,Key,Mods,Signal);
  if (Key<>GDK_VOIDSYMBOL) and (not (csDesigning in Component.ComponentState))
  then
    RealizeAccelerator(Component,Widget);
end;

procedure Accelerate(Component: TComponent; const Widget : PGtkWidget;
  const NewShortCut: TShortCut; const Signal : string);
var
  GDKModifier: TGdkModifierType;
  GDKKey: guint;
  NewKey: word;
  NewModifier: TShiftState;
begin
  { Map the shift states }
  GDKModifier:= 0;
  ShortCutToKey(NewShortCut, NewKey, NewModifier);
  if ssShift in NewModifier then GDKModifier:= GDKModifier + GDK_SHIFT_MASK;
  if ssAlt in NewModifier then GDKModifier:= GDKModifier + GDK_MOD1_MASK;
  if ssCtrl in NewModifier then GDKModifier:= GDKModifier + GDK_CONTROL_MASK;

  // Send the unmodified keysym ?
  if (ssShift in NewModifier)
  and ((NewKey < VK_F1) or (NewKey > VK_F24))
  then GDKKey := GetVKeyInfo(NewKey).KeySym[1]
  else GDKKey := GetVKeyInfo(NewKey).KeySym[0];

  Accelerate(Component,Widget,GDKKey,GDKModifier,Signal);
end;

{-------------------------------------------------------------------------------
  method TGtkWidgetSet LoadPixbufFromLazResource
  Params: const ResourceName: string;
          var Pixbuf: PGdkPixbuf
  Result: none

  Loads a pixbuf from a lazarus resource. The resource must be a XPM file.
-------------------------------------------------------------------------------}
{$IfNDef NoGdkPixbufLib}
procedure LoadPixbufFromLazResource(const ResourceName: string;
  var Pixbuf: PGdkPixbuf);
var
  ImgData: PPChar;
begin
  Pixbuf:=nil;
  try
    ImgData:=LazResourceXPMToPPChar(ResourceName);
  except
    on e: Exception do
      DebugLn('WARNING: TGtkWidgetSet.LoadXPMFromLazResource: '+e.Message);
  end;
  {$IFDEF DebugGDK}BeginGDKErrorTrap;{$ENDIF}
  {$IFDEF VerboseGdkPixbuf}
  debugln('LoadPixbufFromLazResource A1');
  {$ENDIF}
  pixbuf:=gdk_pixbuf_new_from_xpm_data(ImgData);
  {$IFDEF VerboseGdkPixbuf}
  debugln('LoadPixbufFromLazResource A2');
  {$ENDIF}
  {$IFDEF DebugGDK}EndGDKErrorTrap;{$ENDIF}
  FreeMem(ImgData);
end;
{$EndIF}

{-------------------------------------------------------------------------------
  method LoadXPMFromLazResource
  Params: const ResourceName: string;
          Window: PGdkWindow;
          var PixmapImg, PixmapMask: PGdkPixmap
  Result: none

  Loads a pixmap from a lazarus resource. The resource must be a XPM file.
-------------------------------------------------------------------------------}
procedure LoadXPMFromLazResource(const ResourceName: string;
  Window: PGdkWindow; var PixmapImg, PixmapMask: PGdkPixmap);
var
  ImgData: PPGChar;
begin
  PixmapImg:=nil;
  PixmapMask:=nil;
  try
    ImgData:=PPGChar(LazResourceXPMToPPChar(ResourceName));
  except
    on e: Exception do
      DebugLn('WARNING: TGtkWidgetSet.LoadXPMFromLazResource: '+e.Message);
  end;
  {$IFDEF DebugGDK}BeginGDKErrorTrap;{$ENDIF}
  PixmapImg:=gdk_pixmap_create_from_xpm_d(Window,PixmapMask,nil,ImgData);
  {$IFDEF DebugGDK}EndGDKErrorTrap;{$ENDIF}
  FreeMem(ImgData);
end;

{------------------------------------------------------------------------------
  procedure GetGdkPixmapFromGraphic(LCLGraphic: TGraphic;
    var IconImg, IconMask: PGdkPixmap; var Width, Height: integer);

 ------------------------------------------------------------------------------}
procedure GetGdkPixmapFromGraphic(LCLGraphic: TGraphic;
  var IconImg, IconMask: PGdkPixmap; var Width, Height: integer);
var
  GDIObject: PGdiObject;
begin
  IconImg:=nil;
  IconMask:=nil;
  Width:=0;
  Height:=0;
  if (LCLGraphic=nil) then exit;
  if LCLGraphic is TBitmap then
    GDIObject:=PgdiObject(TBitmap(LCLGraphic).Handle)
  else
    GDIObject:=nil;
  if GDIObject<>nil then begin
    IconImg:=GDIObject^.GDIBitmapObject;
    IconMask:=GDIObject^.GDIBitmapMaskObject;
    if IconImg<>nil then
      gdk_window_get_size(IconImg, @Width, @Height);
  end;
end;

{------------------------------------------------------------------------------
  procedure GetGdkPixmapFromMenuItem(LCLMenuItem: TMenuItem;
    var IconImg, IconMask: PGdkPixmap; var Width, Height: integer);
 ------------------------------------------------------------------------------}
procedure GetGdkPixmapFromMenuItem(LCLMenuItem: TMenuItem;
  var IconImg, IconMask: PGdkPixmap; var Width, Height: integer);
begin
  IconImg:=nil;
  IconMask:=nil;
  Width:=0;
  Height:=0;
  if LCLMenuItem=nil then exit;
  if LCLMenuItem.HasIcon then
    GetGdkPixmapFromGraphic(LCLMenuItem.Bitmap,IconImg,IconMask,Width,Height);
end;

{------------------------------------------------------------------------------
  function MENU_ITEM_CLASS(widget: PGtkWidget): PGtkMenuItemClass;

  Returns the gtk klass of a menuitem widget.
 ------------------------------------------------------------------------------}
function MENU_ITEM_CLASS(widget: PGtkWidget): PGtkMenuItemClass;
begin
  Result:=GTK_MENU_ITEM_CLASS(gtk_object_get_class(widget));
end;

{------------------------------------------------------------------------------
  function CHECK_MENU_ITEM_CLASS(widget: PGtkWidget): PGtkCheckMenuItemClass;

  Returns the gtk klass of a checkmenuitem widget.
 ------------------------------------------------------------------------------}
function CHECK_MENU_ITEM_CLASS(widget: PGtkWidget): PGtkCheckMenuItemClass;
begin
  Result:=GTK_CHECK_MENU_ITEM_CLASS(gtk_object_get_class(widget));
end;

{------------------------------------------------------------------------------
  procedure LockRadioGroupOnChange(RadioGroup: PGSList; const ADelta: Integer);

  Calls LockOnChange for all groupmembers
 ------------------------------------------------------------------------------}
procedure LockRadioGroupOnChange(RadioGroup: PGSList; const ADelta: Integer);
begin
  while RadioGroup <> nil do
  begin
    if RadioGroup^.Data <> nil
    then LockOnChange(PgtkObject(RadioGroup^.Data), ADelta);
    RadioGroup := RadioGroup^.Next;
  end;
end;

{------------------------------------------------------------------------------
  procedure UpdateRadioGroupChecks(RadioGroup: PGSList);

  Set 'checked' for all menuitems in the group
 ------------------------------------------------------------------------------}
procedure UpdateRadioGroupChecks(RadioGroup: PGSList);
var
  CurListItem: PGSList;
  MenuItem: PGtkCheckMenuItem;
  LCLMenuItem: TMenuItem;
begin
  // Check if it is a single entry
  if (RadioGroup = nil) or (RadioGroup^.Next = nil)
  then Exit;
  
  // Lock whole group for update
  LockRadioGroupOnChange(RadioGroup, +1);
  CurListItem := RadioGroup;
  try
    // set active radiomenuitem
    while CurListItem <> nil do
    begin
      MenuItem := PGtkCheckMenuItem(CurListItem^.Data);
      if MenuItem<>nil
      then begin
        LCLMenuItem := TMenuItem(GetLCLObject(MenuItem));
        if  (LCLMenuItem <> nil)
        and (gtk_check_menu_item_get_active(MenuItem) <> LCLMenuItem.Checked)
        then gtk_check_menu_item_set_active(MenuItem, LCLMenuItem.Checked);
      end;
      CurListItem := CurListItem^.Next;
    end;
  finally
    // Unlock whole group for update
    LockRadioGroupOnChange(RadioGroup, -1);
  end;
end;

{------------------------------------------------------------------------------
  procedure DrawMenuItemIcon(MenuItem: PGtkCheckMenuItem;
    area: PGdkRectangle); cdecl;

  Handler for drawing the icon of a menuitem.
 ------------------------------------------------------------------------------}
procedure DrawMenuItemIcon(MenuItem: PGtkCheckMenuItem;
  Area: PGdkRectangle); cdecl;
var
  Widget: PGtkWidget;
  Container: PgtkContainer;
  ALeft, ATop, BorderWidth: gint;
  LCLMenuItem: TMenuItem;
  IconImg, IconMask: PGdkPixmap;
  AWindow: PGdkWindow;
  IconWidth, IconHeight: integer;
  IconSize: TPoint;
begin
  if (MenuItem=nil) then exit;
  if not (GTK_WIDGET_DRAWABLE (PGtkWidget(MenuItem))) then exit;

  // get icon
  LCLMenuItem:=TMenuItem(GetLCLObject(MenuItem));
  if not LCLMenuItem.HasIcon then begin
    // call default draw function
    OldCheckMenuItemDrawProc(MenuItem,Area);
    exit;
  end;
  IconSize:=LCLMenuItem.GetIconSize;
  IconWidth:=IconSize.X;
  IconHeight:=IconSize.Y;

  // calculate left and top
  Widget := PGtkWidget(MenuItem);
  AWindow:=GetControlWindow(Widget);
  if AWindow=nil then exit;
  Container := GTK_CONTAINER (MenuItem);
  BorderWidth := Container^.flag0 and bm_TGtkContainer_border_width;
  ALeft := {$Ifdef GTK2}Widget^.Allocation.x + {$EndIf}
           (BorderWidth + gtk_widget_get_xthickness(gtk_widget_get_style(Widget)) + 2)
           +((PGtkMenuItem(MenuItem)^.toggle_size-IconWidth) div 2);
  ATop := {$Ifdef GTK2} Widget^.Allocation.y + {$EndIf}
          (Widget^.Allocation.Height - IconHeight) div 2;

  // draw icon
  if (LCLMenuItem.HasBitmap) then begin
    GetGdkPixmapFromMenuItem(LCLMenuItem,IconImg,IconMask,IconWidth,IconHeight);
    gdk_gc_set_clip_mask(gtk_widget_get_style(Widget)^.Black_gc, IconMask);
    gdk_gc_set_clip_origin(gtk_widget_get_style(Widget)^.Black_gc,ALeft,ATop);
    gdk_draw_pixmap(AWindow,gtk_widget_get_style(Widget)^.Black_gc,
       IconImg,0,0,ALeft,ATop,-1,-1);
    gdk_gc_set_clip_mask(gtk_widget_get_style(Widget)^.Black_gc, nil);
  end else begin
    DrawImageListIconOnWidget(LCLMenuItem.GetImageList,LCLMenuItem.ImageIndex,
      Widget,false,false,ALeft,ATop);
  end;
end;

{------------------------------------------------------------------------------
  procedure MenuSizeRequest(widget:PGtkWidget;
    requisition:PGtkRequisition); cdecl;

  SizeAllocate Handler for check menuitem widgets.
 ------------------------------------------------------------------------------}
procedure MenuSizeRequest(widget:PGtkWidget; requisition:PGtkRequisition); cdecl;
var
  CurToggleSize, MaxToggleSize: integer;
  MenuShell: PGtkMenuShell;
  ListItem: PGList;
  MenuItem: PGtkMenuItem;
  CheckMenuItem: PGtkMenuItem;
  LCLMenuItem: TMenuItem;
  IconSize: TPoint;
begin
  MaxToggleSize:=0;
  MenuShell:=GTK_MENU_SHELL(widget);
  ListItem:=MenuShell^.Children;
  CheckMenuItem:=nil;
  while ListItem<>nil do begin
    MenuItem:=PGtkMenuItem(ListItem^.Data);
    if GTK_IS_CHECK_MENU_ITEM(PGtkWidget(MenuItem)) then begin
      CheckMenuItem:=MenuItem;
      CurToggleSize:=OldCheckMenuItemToggleSize;
      LCLMenuItem:=TMenuItem(GetLCLObject(MenuItem));
      if LCLMenuItem<>nil then begin
        IconSize:=LCLMenuItem.GetIconSize;
        {if IconSize.X>100 then
          debugln('MenuSizeRequest LCLMenuItem=',LCLMenuItem.Name,' ',LCLMenuItem.Caption,
            ' ');}
        if CurToggleSize<IconSize.X then
          CurToggleSize:=IconSize.X;
      end;
      if MaxToggleSize<CurToggleSize then
        MaxToggleSize:=CurToggleSize;
    end;
    ListItem:=ListItem^.Next;
  end;
  //DebugLn('MenuSizeRequest A MaxToggleSize=',MaxToggleSize);
  {$IFDEF Gtk2}
  // Gtk2ToDo
  if CheckMenuItem<>nil then begin
    GTK_MENU_ITEM(CheckMenuItem)^.toggle_size := 0;
    gtk_menu_item_toggle_size_allocate(GTK_MENU_ITEM(CheckMenuItem),MaxToggleSize);
    GTK_MENU_ITEM(CheckMenuItem)^.toggle_size := MaxToggleSize;
  end;
  {$ELSE}
  if CheckMenuItem<>nil then
    MENU_ITEM_CLASS(PGtkWidget(CheckMenuItem))^.toggle_size:=MaxToggleSize;
  {$ENDIF}
  //DebugLn('MenuSizeRequest B ',GetWidgetDebugReport(widget),' ',requisition^.width,',',requisition^.height);
  OldMenuSizeRequestProc(Widget,requisition);
  //DebugLn('MenuSizeRequest C ',GetWidgetDebugReport(widget),' ',requisition^.width,',',requisition^.height);
end;

{------------------------------------------------------------------------------
  procedure UpdateInnerMenuItem(LCLMenuItem: TMenuItem;
    MenuItemWidget: PGtkWidget);

  Update the inner widgets of a menuitem widget.
 ------------------------------------------------------------------------------}
procedure UpdateInnerMenuItem(LCLMenuItem: TMenuItem;
  MenuItemWidget: PGtkWidget);
var
  HBoxWidget: PGtkWidget;
  LabelWidget: PGtkAccelLabel;

  procedure SetMenuItemLabelText(LCLMenuItem: TMenuItem;
    MenuItemWidget: PGtkWidget);
  var
    ShortCutPos: integer;
    s: string;
    LabelWidget: PGtkLabel;
  begin
    if (MenuItemWidget=nil) or (LCLMenuItem=nil) then exit;
    LabelWidget:=gtk_object_get_data(PGtkObject(MenuItemWidget), 'LCLLabel');
    if LabelWidget=nil then begin
    end;
    //Check for a shortcut key
    s:=LCLMenuItem.Caption;
    ShortCutPos := pos('&', s);
    if ShortCutPos <> 0 then begin
      if (LCLMenuItem.Parent<>nil)
      and (LCLMenuItem.Parent.HandleAllocated)
      and GtkWidgetIsA(PGtkWidget(LCLMenuItem.Parent.Handle),GTK_TYPE_MENU_BAR)
      then begin
        // this is a menu item in the main bar of a form
        // -> accelerator should be Alt+Key
        s[ShortCutPos] := '_';
        Accelerate(LCLMenuItem,MenuItemWidget,
          gtk_label_parse_uline(LabelWidget,PChar(s)),
          GDK_MOD1_MASK,{$Ifdef GTK2}'activate'{$Else}'activate_item'{$EndIF});
      end else begin
        // Because gnome changes menuitem shortcuts via keyboard, we can't
        // set the accelerator.
        // It would be cool, to know if a window manager with the gnome feature
        // is running, but there is probably no reliable code to do that, so we
        // simply delete all ampersands and don't set the letter shortcut.
        // DeleteAmpersands(s);
        // gtk_label_set_text(LabelWidget,PChar(s));

        // Do not use gtk_label_parse_uline as it mangles underscore characters
        System.Delete(s,ShortCutPos,1);
        gtk_label_set_text(LabelWidget,PChar(s));
        gtk_label_set_pattern(LabelWidget, PChar(StringOfChar(' ', ShortCutPos-1)+'_'));
        //Accelerate(LCLMenuItem,MenuItemWidget,
          //gtk_label_parse_uline(LabelWidget,PChar(s)),
          //0,{$Ifdef GTK2}'activate'{$Else}'activate_item'{$EndIF});
      end;
    end
    else begin
      gtk_label_set_text(LabelWidget,PChar(s));
      gtk_label_set_pattern(LabelWidget, #0);  // Ensure any underlines removed
    end;
  end;

  procedure CreateIcon;
  var
    IconWidth, IconHeight: integer;
    MinHeightWidget: PGtkWidget;
    IconSize: TPoint;
  begin
    // the icon will be painted instead of the toggle
    // of a normal gtkcheckmenuitem

    // get the icon
    //GetGdkPixmapFromMenuItem(LCLMenuItem,IconImg,IconMask,IconWidth,IconHeight);
    if LCLMenuItem.HasIcon then begin
      IconSize:=LCLMenuItem.GetIconSize;
      IconWidth:=IconSize.X;
      IconHeight:=IconSize.Y;
      // set the toggle width
      GTK_MENU_ITEM(MenuItemWidget)^.toggle_size:=guint16(IconWidth);
      
      GTK_MENU_ITEM(MenuItemWidget)^.flag0:=
        PGtkMenuItem(MenuItemWidget)^.flag0 or
          {$IFDEF Gtk2}
          bm_TGtkCheckMenuItem_always_show_toggle;
          {$ELSE}
          bm_show_toggle_indicator;
          {$ENDIF}

      // set our own draw handler
      if OldCheckMenuItemDrawProc=nil then
        OldCheckMenuItemDrawProc:=
          CHECK_MENU_ITEM_CLASS(MenuItemWidget)^.draw_indicator;
      CHECK_MENU_ITEM_CLASS(MenuItemWidget)^.draw_indicator:=@DrawMenuItemIcon;

      // add a dummy widget for the icon height
      MinHeightWidget:=gtk_label_new('');
      gtk_widget_show(MinHeightWidget);
      gtk_widget_set_usize(MinHeightWidget,1,IconHeight);
      gtk_box_pack_start(GTK_BOX(HBoxWidget),MinHeightWidget,false,false,0);
    end else
      MinHeightWidget:=nil;
    gtk_object_set_data(PGtkObject(MenuItemWidget),
                        'LCLMinHeight',MinHeightWidget);
  end;

  procedure CreateLabel;
  begin
    // create a label for the Caption
    LabelWidget:=PGtkAccelLabel(gtk_accel_label_new(''));
    gtk_misc_set_alignment(GTK_MISC (LabelWidget), 0.0, 0.5);
    gtk_object_set_data(PGtkObject(MenuItemWidget), 'LCLLabel', LabelWidget);
    gtk_container_add(GTK_CONTAINER(HBoxWidget),PgtkWidget(LabelWidget));
    SetMenuItemLabelText(LCLMenuItem,MenuItemWidget);
    gtk_accel_label_set_accel_widget(GTK_ACCEL_LABEL(LabelWidget),MenuItemWidget);
    gtk_widget_show(PGtkWidget(LabelWidget));
  end;

begin
  HBoxWidget:=gtk_object_get_data(PGtkObject(MenuItemWidget), 'LCLHBox');
  if HBoxWidget=nil then begin
    // create inner widgets
    if LCLMenuItem.Caption='-' then begin
      // a separator is an empty gtkmenuitem
      exit;
    end;
    HBoxWidget:=gtk_hbox_new(false,0);
    gtk_object_set_data(PGtkObject(MenuItemWidget), 'LCLHBox', HBoxWidget);
    CreateIcon;
    CreateLabel;
    gtk_container_add(GTK_CONTAINER(MenuItemWidget),HBoxWidget);
    gtk_widget_show(HBoxWidget);
  end else begin
    // there are already inner widgets
    if LCLMenuItem.Caption='-' then begin
      // a separator is an empty gtkmenuitem -> delete the inner widgets
      DestroyWidget(HBoxWidget);
      gtk_object_set_data(PGtkObject(MenuItemWidget), 'LCLHBox', nil);
    end else begin
      // just update the content
      SetMenuItemLabelText(LCLMenuItem,MenuItemWidget);
    end;
  end;
end;

{------------------------------------------------------------------------------
  function CreateMenuItem(LCLMenuItem: TMenuItem): Pointer;

  Creates a new menuitem widget.
 ------------------------------------------------------------------------------}
function CreateMenuItem(LCLMenuItem: TMenuItem): Pointer;
var
  MenuItemWidget: PGtkWidget;
begin
  // create the menuitem widget (normal, check or radio)
  if LCLMenuItem.Caption='-' then
    // create separator
    MenuItemWidget:=gtk_menu_item_new
  else if LCLMenuItem.RadioItem and not LCLMenuItem.HasIcon then begin
    MenuItemWidget:=gtk_radio_menu_item_new(nil);
  end else if LCLMenuItem.IsCheckItem or LCLMenuItem.HasIcon then begin
    MenuItemWidget:=gtk_check_menu_item_new;
  end else
    MenuItemWidget:=gtk_menu_item_new;
    
  if GtkWidgetIsA(MenuItemWidget,GTK_TYPE_CHECK_MENU_ITEM) then begin
    // set 'ShowAlwaysCheckable'
    gtk_check_menu_item_set_show_toggle(PGtkCheckMenuItem(MenuItemWidget),
      LCLMenuItem.ShowAlwaysCheckable);
    // set 'Checked'
    gtk_check_menu_item_set_active(PGtkCheckMenuItem(MenuItemWidget),
      LCLMenuItem.Checked);
    {$ifdef GTK2}
    if (OldCheckMenuItemToggleSize=0) then begin
      gtk_menu_item_toggle_size_request(GTK_MENU_ITEM(MenuItemWidget), @OldCheckMenuItemToggleSize);
      OldCheckMenuItemToggleSize := GTK_MENU_ITEM(MenuItemWidget)^.toggle_size;
    end;
    {$else}
    if (OldCheckMenuItemToggleSize=0) then
      OldCheckMenuItemToggleSize:=MENU_ITEM_CLASS(MenuItemWidget)^.toggle_size;
    {$endif}
    g_signal_connect_after(PGTKObject(MenuItemWidget), 'toggled',
      TGTKSignalFunc(@GTKCheckMenuToggeledCB), Pointer(LCLMenuItem));
  end;


  // set attributes (enabled and rightjustify)
  gtk_widget_set_sensitive(MenuItemWidget,
                           LCLMenuItem.Enabled and (LCLMenuItem.Caption<>'-'));
  if LCLMenuItem.RightJustify then
    gtk_menu_item_right_justify(PGtkMenuItem(MenuItemWidget));

  // create the hbox containing the label and the control
  UpdateInnerMenuItem(LCLMenuItem,MenuItemWidget);

  gtk_widget_show(MenuItemWidget);
  Result:=MenuItemWidget;
end;

function CreateStatusBarPanel(StatusBar: TObject; Index: integer): PGtkWidget;
begin
  Result:=gtk_statusbar_new;
  gtk_widget_show(Result);
  // other properties are set in UpdateStatusBarPanels
end;

procedure UpdateStatusBarPanels(StatusBar: TObject;
  StatusBarWidget: PGtkWidget);
var
  AStatusBar: TStatusBar;
  HBox: PGtkWidget;
  CurPanelCount: integer;
  NewPanelCount: Integer;
  CurStatusPanelWidget: PGtkWidget;
  ListItem: PGList;
  i: Integer;
  ExpandItem: boolean;
begin
  //DebugLn('UpdateStatusBarPanels ',DbgS(StatusBar));

  AStatusBar:=StatusBar as TStatusBar;
  HBox:=PGtkWidget(StatusBarWidget);
  if (not GtkWidgetIsA(StatusBarWidget,GTK_HBOX_GET_TYPE)) then
    RaiseGDBException('');

  // create needed panels
  CurPanelCount:=integer(g_list_length(PGtkBox(HBox)^.children));
  if AStatusBar.SimplePanel or (AStatusBar.Panels.Count<1) then
    NewPanelCount:=1
  else
    NewPanelCount:=AStatusBar.Panels.Count;
  while CurPanelCount<NewPanelCount do begin
    CurStatusPanelWidget:=CreateStatusBarPanel(StatusBar,CurPanelCount);
    ExpandItem:=(CurPanelCount=NewPanelCount-1);
    gtk_box_pack_start(PGtkBox(HBox),CurStatusPanelWidget,
                       ExpandItem,ExpandItem,0);
    inc(CurPanelCount);
  end;

  // remove unneeded panels
  while CurPanelCount>NewPanelCount do begin
    CurStatusPanelWidget:=PGtkBoxChild(
              g_list_nth_data(PGtkBox(HBox)^.children,CurPanelCount-1))^.Widget;
    DestroyConnectedWidgetCB(CurStatusPanelWidget,true);
    dec(CurPanelCount);
  end;

  // check new panel count
  CurPanelCount:=integer(g_list_length(PGtkBox(HBox)^.children));
  //DebugLn('TGtkWidgetSet.UpdateStatusBarPanels B ',Dbgs(StatusBar),' NewPanelCount=',dbgs(NewPanelCount),' CurPanelCount=',dbgs(CurPanelCount));
  if CurPanelCount<>NewPanelCount then
    RaiseGDBException('');

  // set panel properties
  ListItem:=PGTKBox(HBox)^.children;
  i:=0;
  while ListItem<>nil do begin
    CurStatusPanelWidget:=PGtkBoxChild(PGTKWidget(ListItem^.data))^.widget;
    ExpandItem:=(ListItem^.next=nil);
    gtk_box_set_child_packing(PGtkBox(HBox),CurStatusPanelWidget,
      ExpandItem,ExpandItem,0,GTK_PACK_START);
    UpdateStatusBarPanel(StatusBar,i,CurStatusPanelWidget);
    inc(i);
    ListItem:=ListItem^.next;
    {$IFDEF GTK2}
    if ListItem <> nil then begin
      if gtk_statusbar_get_has_resize_grip(PGtkStatusBar(CurStatusPanelWidget)) then
        gtk_statusbar_set_has_resize_grip(PGtkStatusBar(CurStatusPanelWidget), False);
    end
    else begin
      if not gtk_statusbar_get_has_resize_grip(PGtkStatusBar(CurStatusPanelWidget)) then
        gtk_statusbar_set_has_resize_grip(PGtkStatusBar(CurStatusPanelWidget), True);
    end;
    {$ENDIF}
  end;
end;

procedure UpdateStatusBarPanel(StatusBar: TObject; Index: integer;
  StatusPanelWidget: PGtkWidget);
var
  AStatusBar: TStatusBar;
  CurPanel: TStatusPanel;
  FrameWidget: PGtkWidget;
  LabelWidget: PGtkLabel;
  PanelText: String;
  ContextID: LongWord;
  NewShadowType: TGtkShadowType;
  NewJustification: TGtkJustification;
begin
  //DebugLn('UpdateStatusBarPanel ',DbgS(StatusBar),' Index=',dbgs(Index));
  AStatusBar:=StatusBar as TStatusBar;

  CurPanel:=nil;
  if (not AStatusBar.SimplePanel) and (AStatusBar.Panels.Count>Index) then
    CurPanel:=AStatusBar.Panels[Index];
  //DebugLn('Panel ',Index,' ',GetWidgetClassName(StatusPanelWidget),
  //  ' frame=',GetWidgetClassName(PGTKStatusBar(StatusPanelWidget)^.frame),
  //  ' thelabel=',GetWidgetClassName(PGTKStatusBar(StatusPanelWidget)^.thelabel),
  // '');
  FrameWidget:=PGTKStatusBar(StatusPanelWidget)^.frame;
  LabelWidget:=PGtkLabel({$ifdef gtk2}PGTKStatusBar(StatusPanelWidget)^._label{$else}PGTKStatusBar(StatusPanelWidget)^.thelabel{$endif});

  // Text
  if AStatusBar.SimplePanel then
    PanelText:=AStatusBar.SimpleText
  else if CurPanel<>nil then
    PanelText:=CurPanel.Text
  else
    PanelText:='';
  ContextID:=gtk_statusbar_get_context_id(PGTKStatusBar(StatusPanelWidget),
                                          'state');
  //DebugLn('  PanelText="',PanelText,'"');
  if PanelText<>'' then
    gtk_statusbar_push(PGTKStatusBar(StatusPanelWidget),ContextID,
                       PGChar(PanelText))
  else
    gtk_statusbar_push(PGTKStatusBar(StatusPanelWidget),ContextID,'');


  // Alignment
  if CurPanel<>nil then begin
    //DebugLn('  Alignment="',ord(CurPanel.Alignment),'"');
    case CurPanel.Alignment of
    taLeftJustify: NewJustification:=GTK_JUSTIFY_LEFT;
    taRightJustify: NewJustification:=GTK_JUSTIFY_RIGHT;
    taCenter: NewJustification:=GTK_JUSTIFY_CENTER;
    else
      NewJustification:=GTK_JUSTIFY_LEFT;
    end;
    gtk_label_set_justify(LabelWidget,NewJustification);
  end;

  // Bevel
  if CurPanel<>nil then begin
    case CurPanel.Bevel of
    pbNone: NewShadowType:=GTK_SHADOW_NONE;
    pbLowered: NewShadowType:=GTK_SHADOW_IN;
    pbRaised: NewShadowType:=GTK_SHADOW_OUT;
    else
      NewShadowType:=GTK_SHADOW_IN;
    end;
    gtk_frame_set_shadow_type(PGtkFrame(FrameWidget),NewShadowType);
  end;

  // Width
  if (CurPanel<>nil) then begin
    //DebugLn('  CurPanel.Width="',CurPanel.Width,'"');
    gtk_widget_set_usize(StatusPanelWidget,CurPanel.Width,
      StatusPanelWidget^.allocation.height);
  end;
end;

{------------------------------------------------------------------------------
  SaveSizeNotification
  Params: Widget: PGtkWidget  A widget that is the handle of a lcl control.

  When the gtk sends a size signal, it is not send directly to the LCL. All gtk
  size/move messages are collected and only the last one for each widget is sent
  to the LCL.
  This is neccessary, because the gtk sends size messages several times and
  it replays resizes. Since the LCL reacts to every size notification and
  resizes child controls, this results in a perpetuum mobile.
 ------------------------------------------------------------------------------}
procedure SaveSizeNotification(Widget: PGtkWidget);
{$IFDEF VerboseSizeMsg}
var
  LCLControl: TWinControl;
{$ENDIF}
begin
  {$IFDEF VerboseSizeMsg}
  DbgOut('SaveSizeNotification Widget=',DbgS(Widget));
  LCLControl:=TWinControl(GetLCLObject(Widget));
  if (LCLControl<>nil) then begin
    if LCLControl is TWinControl then
      DebugLn(' ',LCLControl.Name,':',LCLControl.ClassName)
    else
      DebugLn(' ERROR: ',LCLControl.ClassName);
  end else begin
    DebugLn(' ERROR: LCLControl=nil');
  end;
  {$ENDIF}
  if not FWidgetsResized.Contains(Widget) then
    FWidgetsResized.Add(Widget);
end;

{------------------------------------------------------------------------------
  SaveClientSizeNotification
  Params: FixWidget: PGtkWidget  A widget that is the fixed widget
                                 of a lcl control.

  When the gtk sends a size signal, it is not sent directly to the LCL. All gtk
  size/move messages are collected and only the last one for each widget is sent
  to the LCL.
  This is neccessary, because the gtk sends size messages several times and
  it replays resizes. Since the LCL reacts to every size notification and
  resizes child controls, this results in a perpetuum mobile.
 ------------------------------------------------------------------------------}
procedure SaveClientSizeNotification(FixWidget: PGtkWidget);
{$IFDEF VerboseSizeMsg}
var
  LCLControl: TWinControl;
  MainWidget: PGtkWidget;
{$ENDIF}
begin
  {$IFDEF VerboseSizeMsg}
  MainWidget:=GetMainWidget(FixWidget);
  //write('SaveClientSizeNotification',
  //  ' FixWidget=',DbgS(FixWidget),
  //  ' MainWIdget=',DbgS(MainWidget));
  LCLControl:=TWinControl(GetLCLObject(MainWidget));
  if (LCLControl<>nil) then begin
    if LCLControl is TWinControl then begin
      //DebugLn('SaveClientSizeNotification ',LCLControl.Name,':',LCLControl.ClassName,
      //  ' FixWidget=',DbgS(FixWidget),
      //  ' MainWidget=',DbgS(MainWidget));
    end else begin
      DbgOut('ERROR: SaveClientSizeNotification ',
        ' LCLControl=',LCLControl.ClassName,
        ' FixWidget=',DbgS(FixWidget),
        ' MainWidget=',DbgS(MainWidget));
      RaiseGDBException('SaveClientSizeNotification');
    end;
  end else begin
    DbgOut('ERROR: SaveClientSizeNotification LCLControl=nil',
      ' FixWidget=',DbgS(FixWidget),
      ' MainWIdget=',DbgS(MainWidget));
    RaiseGDBException('SaveClientSizeNotification');
  end;
  {$ENDIF}
  if not FFixWidgetsResized.Contains(FixWidget) then
    FFixWidgetsResized.Add(FixWidget);
end;

{-------------------------------------------------------------------------------
  CreateTopologicalSortedWidgets
  Params: HashArray: TDynHashArray  of PGtkWidget
  
  Creates a topologically sorted TFPList of PGtkWidget.
-------------------------------------------------------------------------------}
function CreateTopologicalSortedWidgets(HashArray: TDynHashArray): TFPList;
type
  PTopologicalEntry = ^TTopologicalEntry;
  TTopologicalEntry = record
      Widget: PGtkWidget;
      ParentLevel: integer;
    end;
    
  function GetParentLevel(AControl: TControl): integer;
  // nil has lvl -1
  // a control without parent has lvl 0
  begin
    Result:=-1;
    while AControl<>nil do begin
      inc(Result);
      AControl:=AControl.Parent;
    end;
  end;
  
var
  TopologicalList: PTopologicalEntry;
  HashItem: PDynHashArrayItem;
  i, Lvl, MaxLevel: integer;
  LCLControl: TControl;
  LevelCounts: PInteger;
begin
  //DebugLn(' KKK0');
  Result:=TFPList.Create;
  if HashArray.Count=0 then exit;
  
  // put all widgets into an array and calculate their parent levels
  GetMem(TopologicalList,SizeOf(TTopologicalEntry)*HashArray.Count);
  HashItem:=HashArray.FirstHashItem;
  i:=0;
  MaxLevel:=0;
  //DebugLn(' KKK1 HashArray.Count=',HashArray.Count);
  while HashItem<>nil do begin
    TopologicalList[i].Widget:=HashItem^.Item;
    //DebugLn(' KKK21 i=',i,' Widget=',DbgS(TopologicalList[i].Widget));
    LCLControl:=TControl(GetLCLObject(TopologicalList[i].Widget));
    if (LCLControl=nil) or (not (LCLControl is TControl)) then
      RaiseGDBException('CreateTopologicalSortedWidgets: '
                             +'Widget without LCL control');
    Lvl:=GetParentLevel(LCLControl);
    TopologicalList[i].ParentLevel:=Lvl;
    if MaxLevel<Lvl then
      MaxLevel:=Lvl;
    //DebugLn(' KKK2 i=',i,' Lvl=',Lvl,' MaxLvl=',MaxLevel,' LCLControl=',LCLControl.Name,':',LCLControl.ClassName);
    inc(i);
    HashItem:=HashItem^.Next;
  end;
  inc(MaxLevel);
  
  // bucket sort the widgets
  
  // count each number of levels (= bucketsizes)
  GetMem(LevelCounts,SizeOf(Integer)*MaxLevel);
  FillChar(LevelCounts^,SizeOf(Integer)*MaxLevel,0);
  for i:=0 to HashArray.Count-1 do
    inc(LevelCounts[TopologicalList[i].ParentLevel]);

  // calculate bucketends
  for i:=1 to MaxLevel-1 do
    inc(LevelCounts[i],LevelCounts[i-1]);

  // bucket sort the widgets in Result
  Result.Count:=HashArray.Count;
  for i:=0 to HashArray.Count-1 do
    Result[i]:=nil;
  for i:=0 to HashArray.Count-1 do begin
    Lvl:=TopologicalList[i].ParentLevel;
    dec(LevelCounts[Lvl]);
    //DebugLn(' KKK5 i=',i,' Lvl=',Lvl,' LevelCounts[Lvl]=',LevelCounts[Lvl],
    //  ' Widget=',DbgS(TopologicalList[i].Widget));
    Result[LevelCounts[Lvl]]:=TopologicalList[i].Widget;
  end;
  
  FreeMem(LevelCounts);
  FreeMem(TopologicalList);
end;

procedure GetGTKDefaultWidgetSize(AWinControl: TWinControl;
  var PreferredWidth, PreferredHeight: integer; WithThemeSpace: Boolean);
var
  Widget: PGtkWidget;
  Requisition: TGtkRequisition;
begin
  Widget := PGtkWidget(AWinControl.Handle);
  // set size to default
  gtk_widget_set_usize(Widget,-1,-1);
  // ask default size
  gtk_widget_size_request(Widget,@Requisition);
  PreferredWidth:=Requisition.width;
  PreferredHeight:=Requisition.height;
  if not WithThemeSpace then begin
    //DebugLn('GetGTKDefaultWidgetSize ',DbgSName(AWinControl),' ',dbgs(gtk_widget_get_xthickness(Widget)),' ythickness=',dbgs(gtk_widget_get_ythickness(Widget)));
    //DebugLn(['GetGTKDefaultWidgetSize ',GetWidgetDebugReport(Widget)]);
    //dec(PreferredWidth,gtk_widget_get_xthickness(Widget));
    {$IFDEF Gtk1}
    if not GtkWidgetIsA(Widget,GTK_ENTRY_TYPE) then
      dec(PreferredHeight,2*gtk_widget_get_ythickness(Widget));
    {$ENDIF}
  end;
  {DebugLn(['GetGTKDefaultWidgetSize Allocation=',Widget^.allocation.x,',',Widget^.allocation.y,',',Widget^.allocation.width,',',Widget^.allocation.height,
   ' requisition=',Widget^.requisition.width,',',Widget^.requisition.height,
   ' PreferredWidth=',PreferredWidth,' PreferredHeight=',PreferredHeight,
   ' WithThemeSpace=',WithThemeSpace]);}
  // set new size
  gtk_widget_set_usize(Widget,AWinControl.Width,AWinControl.Height);
  //debugln('GetGTKDefaultSize PreferredWidth=',dbgs(PreferredWidth),' PreferredHeight=',dbgs(PreferredHeight));
end;

Procedure ReportNotObsolete(const Texts : String);
Begin
  DebugLn('*********************************************');
  DebugLn('*********************************************');
  DebugLn('*************Non-Obsolete report*************');
  DebugLn('*********************************************');
  DebugLn('*************'+Texts+'*is being used yet.****');
  DebugLn('*******Please remove this function from******');
  DebugLn('*******the obsolete section in gtkproc.inc***');
  DebugLn('*********************************************');
  DebugLn('*********************************************');
  DebugLn('*********************************************');
  DebugLn('*********************************************');
end;

function TGDKColorToTColor(const value : TGDKColor) : TColor;
begin
  Result := ((Value.Blue shr 8) shl 16) + ((Value.Green shr 8) shl 8)
           + (Value.Red shr 8);
end;

function TColortoTGDKColor(const value : TColor) : TGDKColor;
var
  newColor : TGDKColor;
begin
  if Value<0 then begin
    FillChar(Result,SizeOf(Result),0);
    exit;
  end;

  newColor.pixel := 0;
  newColor.red   := (value and $ff) * 257;
  newColor.green := ((value shr 8) and $ff) * 257;
  newColor.blue  := ((value shr 16) and $ff) * 257;

  Result := newColor;
end;

{------------------------------------------------------------------------------
  Function: UpdateSysColorMap
  Params:  none
  Returns: none

  Reads the system colors.
 ------------------------------------------------------------------------------}
procedure UpdateSysColorMap(Widget: PGtkWidget);
{ $DEFINE VerboseUpdateSysColorMap}
{$IFDEF VerboseUpdateSysColorMap}
  function GdkColorAsString(c: TgdkColor): string;
  begin
    Result:='LCL='+DbgS(TGDKColorToTColor(c))
             +' Pixel='+DbgS(c.Pixel)
             +' Red='+DbgS(c.Red)
             +' Green='+DbgS(c.Green)
             +' Blue='+DbgS(c.Blue)
             ;
  end;
{$ENDIF}
var
  MainStyle: PGtkStyle;
begin
  if Widget=nil then exit;
  {$IFDEF NoStyle}
  exit;
  {$ENDIF}
  //debugln('UpdateSysColorMap ',GetWidgetDebugReport(Widget));
  gtk_widget_set_rc_style(Widget);
  MainStyle:=gtk_widget_get_style(Widget);
  if MainStyle=nil then exit;
  with MainStyle^ do begin
  
    {$IFDEF VerboseUpdateSysColorMap}
    if rc_style<>nil then begin
      with rc_style^ do begin
        DebugLn('rc_style:');
        DebugLn(' FG GTK_STATE_NORMAL ',GdkColorAsString(fg[GTK_STATE_NORMAL]));
        DebugLn(' FG GTK_STATE_ACTIVE ',GdkColorAsString(fg[GTK_STATE_ACTIVE]));
        DebugLn(' FG GTK_STATE_PRELIGHT ',GdkColorAsString(fg[GTK_STATE_PRELIGHT]));
        DebugLn(' FG GTK_STATE_SELECTED ',GdkColorAsString(fg[GTK_STATE_SELECTED]));
        DebugLn(' FG GTK_STATE_INSENSITIVE ',GdkColorAsString(fg[GTK_STATE_INSENSITIVE]));
        DebugLn('');
        DebugLn(' BG GTK_STATE_NORMAL ',GdkColorAsString(bg[GTK_STATE_NORMAL]));
        DebugLn(' BG GTK_STATE_ACTIVE ',GdkColorAsString(bg[GTK_STATE_ACTIVE]));
        DebugLn(' BG GTK_STATE_PRELIGHT ',GdkColorAsString(bg[GTK_STATE_PRELIGHT]));
        DebugLn(' BG GTK_STATE_SELECTED ',GdkColorAsString(bg[GTK_STATE_SELECTED]));
        DebugLn(' BG GTK_STATE_INSENSITIVE ',GdkColorAsString(bg[GTK_STATE_INSENSITIVE]));
        DebugLn('');
        DebugLn(' TEXT GTK_STATE_NORMAL ',GdkColorAsString(text[GTK_STATE_NORMAL]));
        DebugLn(' TEXT GTK_STATE_ACTIVE ',GdkColorAsString(text[GTK_STATE_ACTIVE]));
        DebugLn(' TEXT GTK_STATE_PRELIGHT ',GdkColorAsString(text[GTK_STATE_PRELIGHT]));
        DebugLn(' TEXT GTK_STATE_SELECTED ',GdkColorAsString(text[GTK_STATE_SELECTED]));
        DebugLn(' TEXT GTK_STATE_INSENSITIVE ',GdkColorAsString(text[GTK_STATE_INSENSITIVE]));
        DebugLn('');
      end;
    end;

    DebugLn('MainStyle:');
    DebugLn(' FG GTK_STATE_NORMAL ',GdkColorAsString(fg[GTK_STATE_NORMAL]));
    DebugLn(' FG GTK_STATE_ACTIVE ',GdkColorAsString(fg[GTK_STATE_ACTIVE]));
    DebugLn(' FG GTK_STATE_PRELIGHT ',GdkColorAsString(fg[GTK_STATE_PRELIGHT]));
    DebugLn(' FG GTK_STATE_SELECTED ',GdkColorAsString(fg[GTK_STATE_SELECTED]));
    DebugLn(' FG GTK_STATE_INSENSITIVE ',GdkColorAsString(fg[GTK_STATE_INSENSITIVE]));
    DebugLn('');
    DebugLn(' BG GTK_STATE_NORMAL ',GdkColorAsString(bg[GTK_STATE_NORMAL]));
    DebugLn(' BG GTK_STATE_ACTIVE ',GdkColorAsString(bg[GTK_STATE_ACTIVE]));
    DebugLn(' BG GTK_STATE_PRELIGHT ',GdkColorAsString(bg[GTK_STATE_PRELIGHT]));
    DebugLn(' BG GTK_STATE_SELECTED ',GdkColorAsString(bg[GTK_STATE_SELECTED]));
    DebugLn(' BG GTK_STATE_INSENSITIVE ',GdkColorAsString(bg[GTK_STATE_INSENSITIVE]));
    DebugLn('');
    DebugLn(' TEXT GTK_STATE_NORMAL ',GdkColorAsString(text[GTK_STATE_NORMAL]));
    DebugLn(' TEXT GTK_STATE_ACTIVE ',GdkColorAsString(text[GTK_STATE_ACTIVE]));
    DebugLn(' TEXT GTK_STATE_PRELIGHT ',GdkColorAsString(text[GTK_STATE_PRELIGHT]));
    DebugLn(' TEXT GTK_STATE_SELECTED ',GdkColorAsString(text[GTK_STATE_SELECTED]));
    DebugLn(' TEXT GTK_STATE_INSENSITIVE ',GdkColorAsString(text[GTK_STATE_INSENSITIVE]));
    DebugLn('');
    DebugLn(' LIGHT GTK_STATE_NORMAL ',GdkColorAsString(light[GTK_STATE_NORMAL]));
    DebugLn(' LIGHT GTK_STATE_ACTIVE ',GdkColorAsString(light[GTK_STATE_ACTIVE]));
    DebugLn(' LIGHT GTK_STATE_PRELIGHT ',GdkColorAsString(light[GTK_STATE_PRELIGHT]));
    DebugLn(' LIGHT GTK_STATE_SELECTED ',GdkColorAsString(light[GTK_STATE_SELECTED]));
    DebugLn(' LIGHT GTK_STATE_INSENSITIVE ',GdkColorAsString(light[GTK_STATE_INSENSITIVE]));
    DebugLn('');
    DebugLn(' DARK GTK_STATE_NORMAL ',GdkColorAsString(dark[GTK_STATE_NORMAL]));
    DebugLn(' DARK GTK_STATE_ACTIVE ',GdkColorAsString(dark[GTK_STATE_ACTIVE]));
    DebugLn(' DARK GTK_STATE_PRELIGHT ',GdkColorAsString(dark[GTK_STATE_PRELIGHT]));
    DebugLn(' DARK GTK_STATE_SELECTED ',GdkColorAsString(dark[GTK_STATE_SELECTED]));
    DebugLn(' DARK GTK_STATE_INSENSITIVE ',GdkColorAsString(dark[GTK_STATE_INSENSITIVE]));
    DebugLn('');
    DebugLn(' MID GTK_STATE_NORMAL ',GdkColorAsString(mid[GTK_STATE_NORMAL]));
    DebugLn(' MID GTK_STATE_ACTIVE ',GdkColorAsString(mid[GTK_STATE_ACTIVE]));
    DebugLn(' MID GTK_STATE_PRELIGHT ',GdkColorAsString(mid[GTK_STATE_PRELIGHT]));
    DebugLn(' MID GTK_STATE_SELECTED ',GdkColorAsString(mid[GTK_STATE_SELECTED]));
    DebugLn(' MID GTK_STATE_INSENSITIVE ',GdkColorAsString(mid[GTK_STATE_INSENSITIVE]));
    DebugLn('');
    DebugLn(' BASE GTK_STATE_NORMAL ',GdkColorAsString(base[GTK_STATE_NORMAL]));
    DebugLn(' BASE GTK_STATE_ACTIVE ',GdkColorAsString(base[GTK_STATE_ACTIVE]));
    DebugLn(' BASE GTK_STATE_PRELIGHT ',GdkColorAsString(base[GTK_STATE_PRELIGHT]));
    DebugLn(' BASE GTK_STATE_SELECTED ',GdkColorAsString(base[GTK_STATE_SELECTED]));
    DebugLn(' BASE GTK_STATE_INSENSITIVE ',GdkColorAsString(base[GTK_STATE_INSENSITIVE]));
    DebugLn('');
    DebugLn(' BLACK ',GdkColorAsString(black));
    DebugLn(' WHITE ',GdkColorAsString(white));
    {$ENDIF}
    
    {$IFDEF NewSysColors}
    SysColorMap[COLOR_SCROLLBAR] := TGDKColorToTColor(bg[GTK_STATE_ACTIVE]);
    SysColorMap[COLOR_BACKGROUND] := TGDKColorToTColor(bg[GTK_STATE_PRELIGHT]);
    SysColorMap[COLOR_ACTIVECAPTION] := TGDKColorToTColor(text[GTK_STATE_ACTIVE]);
    SysColorMap[COLOR_INACTIVECAPTION] := TGDKColorToTColor(text[GTK_STATE_INSENSITIVE]);
    SysColorMap[COLOR_MENU] := TGDKColorToTColor(bg[GTK_STATE_NORMAL]);
    SysColorMap[COLOR_WINDOW] := TGDKColorToTColor(white);
    SysColorMap[COLOR_WINDOWFRAME] := TGDKColorToTColor(black);
    SysColorMap[COLOR_MENUTEXT] := TGDKColorToTColor(text[GTK_STATE_NORMAL]);
    SysColorMap[COLOR_WINDOWTEXT] := TGDKColorToTColor(text[GTK_STATE_NORMAL]);
    SysColorMap[COLOR_CAPTIONTEXT] := TGDKColorToTColor(text[GTK_STATE_SELECTED]);
    SysColorMap[COLOR_ACTIVEBORDER] := TGDKColorToTColor(bg[GTK_STATE_ACTIVE]);
    SysColorMap[COLOR_INACTIVEBORDER] := TGDKColorToTColor(bg[GTK_STATE_NORMAL]);
    SysColorMap[COLOR_APPWORKSPACE] := TGDKColorToTColor(bg[GTK_STATE_NORMAL]);
    SysColorMap[COLOR_HIGHLIGHT] := TGDKColorToTColor(bg[GTK_STATE_SELECTED]);
    SysColorMap[COLOR_HIGHLIGHTTEXT] := TGDKColorToTColor(text[GTK_STATE_SELECTED]);
    SysColorMap[COLOR_BTNFACE] := TGDKColorToTColor(bg[GTK_STATE_NORMAL]);
    SysColorMap[COLOR_BTNSHADOW] := TGDKColorToTColor(fg[GTK_STATE_INSENSITIVE]);
    SysColorMap[COLOR_GRAYTEXT] := TGDKColorToTColor(text[GTK_STATE_INSENSITIVE]);
    SysColorMap[COLOR_BTNTEXT] := TGDKColorToTColor(text[GTK_STATE_NORMAL]);
    SysColorMap[COLOR_INACTIVECAPTIONTEXT] := TGDKColorToTColor(text[GTK_STATE_INSENSITIVE]);
    SysColorMap[COLOR_BTNHIGHLIGHT] := TGDKColorToTColor(fg[GTK_STATE_SELECTED]);
    SysColorMap[COLOR_3DDKSHADOW] := TGDKColorToTColor(black);
    SysColorMap[COLOR_3DLIGHT] := TGDKColorToTColor(fg[GTK_STATE_SELECTED]);
    SysColorMap[COLOR_INFOTEXT] := TGDKColorToTColor(text[GTK_STATE_NORMAL]);
    SysColorMap[COLOR_INFOBK] := TGDKColorToTColor(bg[GTK_STATE_PRELIGHT]);
    SysColorMap[COLOR_HOTLIGHT] := TGDKColorToTColor(fg[GTK_STATE_NORMAL]);
    SysColorMap[COLOR_GRADIENTACTIVECAPTION] := TGDKColorToTColor(bg[GTK_STATE_NORMAL]);
    SysColorMap[COLOR_GRADIENTINACTIVECAPTION] := TGDKColorToTColor(bg[GTK_STATE_NORMAL]);
    SysColorMap[COLOR_FORM] := TGDKColorToTColor(bg[GTK_STATE_NORMAL]);
    {$ENDIF}
  end;
(*
    $C0C0C0,     {COLOR_SCROLLBAR}
    $808000,     {COLOR_BACKGROUND}
    $800000,     {COLOR_ACTIVECAPTION}
    $808080,     {COLOR_INACTIVECAPTION}
    $C0C0C0,     {COLOR_MENU}
    $FFFFFF,     {COLOR_WINDOW}
    $000000,     {COLOR_WINDOWFRAME}
    $000000,     {COLOR_MENUTEXT}
    $000000,     {COLOR_WINDOWTEXT}
    $FFFFFF,     {COLOR_CAPTIONTEXT}
    $C0C0C0,     {COLOR_ACTIVEBORDER}
    $C0C0C0,     {COLOR_INACTIVEBORDER}
    $808080,     {COLOR_APPWORKSPACE}
    $800000,     {COLOR_HIGHLIGHT}
    $FFFFFF,     {COLOR_HIGHLIGHTTEXT}
    $D0D0D0,     {COLOR_BTNFACE}
    $808080,     {COLOR_BTNSHADOW}
    $808080,     {COLOR_GRAYTEXT}
    $000000,     {COLOR_BTNTEXT}
    $C0C0C0,     {COLOR_INACTIVECAPTIONTEXT}
    $F0F0F0,     {COLOR_BTNHIGHLIGHT}
    $000000,     {COLOR_3DDKSHADOW}
    $C0C0C0,     {COLOR_3DLIGHT}
    $000000,     {COLOR_INFOTEXT}
    $E1FFFF,     {COLOR_INFOBK}
    $000000,     {unasigned}
    $000000,     {COLOR_HOTLIGHT}
    $000000,     {COLOR_GRADIENTACTIVECAPTION}
    $000000      {COLOR_GRADIENTINACTIVECAPTION}
  *)

end;


{------------------------------------------------------------------------------
  Function: WaitForClipbrdAnswerDummyTimer
  
  this is a helper function for WaitForClipboardAnswer
 ------------------------------------------------------------------------------}
function WaitForClipbrdAnswerDummyTimer(Client: Pointer): {$IFDEF Gtk2}gboolean{$ELSE}gint{$ENDIF}; cdecl;
begin
  if CLient=nil then ;
  Result:=GdkTrue; // go on, make sure getting a message at least every second
end;

{------------------------------------------------------------------------------
  Function: WaitForClipboardAnswer
  Params: none
  Returns: true, if clipboard data arrived

  waits til clipboard/selection answer arrived (max 1 second)
  ! While waiting the messagequeue will be processed !
 ------------------------------------------------------------------------------}
function WaitForClipboardAnswer(c: PClipboardEventData): boolean;
var
  StartTime, CurTime: TSystemTime;
  Timer: cardinal;

  function ValidDateSelection : boolean;
  begin
    result := c^.Data.Selection<>0;
  end;
  
begin
  Result:=false;
  {$IFDEF DEBUG_CLIPBOARD}
  DebugLn('[WaitForClipboardAnswer] A');
  {$ENDIF}
  if (ValidDateSelection) or (c^.Waiting) or (c^.Stopping) then begin
    {$IFDEF DEBUG_CLIPBOARD}
    DebugLn('[WaitForClipboardAnswer] ValidDateSelection=',dbgs(ValidDateSelection),' Waiting=',dbgs(c^.Waiting),' Stopping=',dbgs(c^.Stopping));
    {$ENDIF}
    Result:=(ValidDateSelection);
    exit;
  end;
  c^.Waiting:=true;
  DateTimeToSystemTime(Time,StartTime);
  //DebugLn('[WaitForClipboardAnswer] C');
  Application.ProcessMessages;
  //DebugLn('[WaitForClipboardAnswer] D');
  if (ValidDateSelection) or (c^.Stopping) then begin
    {$IFDEF DEBUG_CLIPBOARD}
    DebugLn('[WaitForClipboardAnswer] E  Yeah, Response received after processing messages');
    {$ENDIF}
    Result:=(ValidDateSelection);
    exit;
  end;
  //DebugLn('[WaitForClipboardAnswer] F');
  // start a timer to make sure not waiting forever
  Timer := gtk_timeout_add(500, @WaitForClipbrdAnswerDummyTimer, nil);
  try
    repeat
      // just wait ...
      {$IFDEF DEBUG_CLIPBOARD}
      DebugLn('[WaitForClipboardAnswer] G');
      {$ENDIF}
      Application.HandleMessage;
      if (ValidDateSelection) or (c^.Stopping) then begin
        {$IFDEF DEBUG_CLIPBOARD}
        DebugLn('[WaitForClipboardAnswer] H  Yeah, Response received after waiting with timer');
        {$ENDIF}
        Result:=(ValidDateSelection);
        exit;
      end;
      DateTimeToSystemTime(Time,CurTime);
    until (CurTime.Second*1000+CurTime.MilliSecond
           -StartTime.Second*1000-StartTime.MilliSecond
           >1000);
  finally
    {$IFDEF DEBUG_CLIPBOARD}
    DebugLn('[WaitForClipboardAnswer] H');
    {$ENDIF}
    // stop the timer
    gtk_timeout_remove(Timer);
//DebugLn('[WaitForClipboardAnswer] END');
  end;
  { $IFDEF DEBUG_CLIPBOARD}
  DebugLn('[WaitForClipboardAnswer] WARNING: no answer received in time');
  { $ENDIF}
end;

{------------------------------------------------------------------------------
  Function: RequestSelectionData
  Params: ClipboardWidget - widget with connected signals 'selection_get'
                            and 'selection_clear_event'
          ClipboardType
          FormatID - the selection target format wanted
  Returns: the TGtkSelectionData record

  requests the format FormatID of clipboard of type ClipboardType and
  waits til clipboard/selection answer arrived (max 1 second)
  ! While waiting the messagequeue will be processed !
 ------------------------------------------------------------------------------}
function RequestSelectionData(ClipboardWidget: PGtkWidget;
  ClipboardType: TClipboardType;  FormatID: cardinal): TGtkSelectionData;
  
  function TimeIDExists(TimeID: cardinal): boolean;
  var
    i: Integer;
  begin
    i:=ClipboardSelectionData.Count-1;
    while (i>=0) do begin
      if (PClipboardEventData(ClipboardSelectionData[i])^.TimeID=TimeID) then
        exit(true);
      dec(i);
    end;
    Result:=false;
  end;
  
var
  TimeID: cardinal;
  c: PClipboardEventData;
  sanity: Integer = 0;
begin
  {$IFDEF DEBUG_CLIPBOARD}
  DebugLn('[RequestSelectionData] FormatID=',dbgs(FormatID));
  {$ENDIF}
  FillChar(Result,SizeOf(TGtkSelectionData),0);
  if (ClipboardWidget=nil) or (FormatID=0) 
  or (ClipboardTypeAtoms[ClipboardType]=0) then exit;

  TimeID:= gdk_event_get_time(gtk_get_current_event);
             // IMPORTANT: To retrieve data from xterm or kde applications
             //            the time id must be 0 or event^.time
  repeat
    while TimeIDExists(TimeID) do begin
      inc(TimeID);
      if TimeID>1010 then exit;
    end;
    New(c);
    c^.TimeID:=TimeID;
    FillChar(c^.Data,SizeOf(TGtkSelectionData),0);
    ClipboardSelectionData.Add(c);
    {$IFDEF DEBUG_CLIPBOARD}
    DebugLn('[RequestSelectionData] TimeID=',dbgs(TimeID),' Type=',GdkAtomToStr(ClipboardTypeAtoms[ClipboardType]),' FormatID=',GdkAtomToStr(FormatID));
    {$ENDIF}
    if gtk_selection_convert(ClipboardWidget, ClipboardTypeAtoms[ClipboardType],
                             FormatID, TimeID)<>GdkFalse
    then
      break;
    ClipboardSelectionData.Remove(c);
    Dispose(c);
    Inc(sanity);
  until false or (sanity > 1000000);
  try
    if not WaitForClipboardAnswer(c) then exit;
    Result:=c^.Data;
  finally
    ClipboardSelectionData.Remove(c);
    Dispose(c);
  end;
end;

{------------------------------------------------------------------------------
  Function: FreeClipboardTargetEntries
  Params: ClipboardType
  Returns: -

  frees the memory of a ClipboardTargetEntries list
 ------------------------------------------------------------------------------}
procedure FreeClipboardTargetEntries(ClipboardType: TClipboardType);
var i: integer;
begin
  if ClipboardTargetEntries[ClipboardType]<>nil then begin
    for i:=0 to ClipboardTargetEntryCnt[ClipboardType]-1 do
      StrDispose(ClipboardTargetEntries[ClipboardType][i].Target);
    FreeMem(ClipboardTargetEntries[ClipboardType]);
  end;
end;


{------------------------------------------------------------------------------
  function GdkAtomToStr(const Atom: TGdkAtom): string;

  Returns the associated string
 ------------------------------------------------------------------------------}
function GdkAtomToStr(const Atom: TGdkAtom): string;
var
  p: Pgchar;
begin
  p:=gdk_atom_name(Atom);
  Result:=p;
  if p<>nil then g_free(p);
end;

{-------------------------------------------------------------------------------
  Function CreateFormContents(AForm: TCustomForm;
    var FormWidget: Pointer): Pointer;

  Creates the contents for the form (normally a hbox plus a client area.
  The hbox is needed for the menu.) The FormWidget is the main widget, for which
  the client area is associated. If FormWidget=nil then the hbox will be used
  as main widget.
-------------------------------------------------------------------------------}
Function CreateFormContents(AForm: TCustomForm;
  var FormWidget: Pointer): Pointer;
var
  ScrolledWidget, ClientAreaWidget: PGtkWidget;
  WindowStyle: PGtkStyle;
  Adjustment: PGtkAdjustment;
begin
  // Create the VBox. We need that to place controls outside
  // the client area (like menu)
  Result := gtk_vbox_new(False, 0);
  If FormWidget = nil then
    FormWidget := Result;

  // Create the form client area (a scrolled window with a gtklayout
  // with the style of a window)
  ScrolledWidget := gtk_scrolled_window_new(nil,nil);
  gtk_box_pack_end(Result, ScrolledWidget, True, True, 0);
  gtk_widget_show(ScrolledWidget);
  ClientAreaWidget := gtk_layout_new(nil, nil);
  WindowStyle:=GetStyle(lgsWindow);
  gtk_widget_set_style(ClientAreaWidget,WindowStyle);
  //debugln('CreateFormContents Style=',GetStyleDebugReport(WindowStyle));
  gtk_container_add(PGtkContainer(ScrolledWidget), ClientAreaWidget);

  gtk_object_set_data(FormWidget,odnScrollArea,ScrolledWidget);

  gtk_widget_show(ClientAreaWidget);
  SetFixedWidget(FormWidget, ClientAreaWidget);
  SetMainWidget(FormWidget, ClientAreaWidget);

  if ScrolledWidget<>nil then begin
    GTK_WIDGET_UNSET_FLAGS(PGtkScrolledWindow(ScrolledWidget)^.hscrollbar,
                           GTK_CAN_FOCUS);
    GTK_WIDGET_UNSET_FLAGS(PGtkScrolledWindow(ScrolledWidget)^.vscrollbar,
                           GTK_CAN_FOCUS);
    gtk_scrolled_window_set_policy(PGtkScrolledWindow(ScrolledWidget),
                                   GTK_POLICY_NEVER,GTK_POLICY_NEVER);
                                   
    Adjustment := gtk_scrolled_window_get_vadjustment(PGTKScrolledWindow(ScrolledWidget));
    if Adjustment <> nil
    then gtk_object_set_data(PGTKObject(Adjustment), odnScrollBar,
                             PGTKScrolledWindow(ScrolledWidget)^.vscrollbar);

    Adjustment := gtk_scrolled_window_get_hadjustment(PGTKScrolledWindow(ScrolledWidget));
    if Adjustment <> nil
    then gtk_object_set_data(PGTKObject(Adjustment), odnScrollBar,
                             PGTKScrolledWindow(ScrolledWidget)^.hscrollbar);

  end;
end;

function IndexOfStyle(aStyle: TLazGtkStyle): integer;
begin
  Result:=IndexOfStyleWithName(LazGtkStyleNames[aStyle]);
end;

{------------------------------------------------------------------------------
  Function: IndexOfWithNameStyle
  Params: WName
  Returns: Index of Style

  Returns the Index within the Styles property of WNAME
 ------------------------------------------------------------------------------}
function IndexOfStyleWithName(const WName : String): integer;
begin
  if Styles<>nil then begin
    for Result:=0 to Styles.Count-1 do
      if AnsiCompareText(WName,Styles[Result])=0 then exit;
  end;
  Result:=-1;
end;

{------------------------------------------------------------------------------
  Function: ReleaseStyle
  Params: WName
  Returns: nothing

  Tries to release a Style corresponding to the Widget Name passed, aka 'button',
  'default', checkbox', etc. This should only be called on theme change or on
  application terminate.
 ------------------------------------------------------------------------------}
Type
  PStyleObject = ^TStyleObject;
  TStyleObject = Record
    Style : PGTKStyle;
    Widget : PGTKWidget;
  end;
  
var
  StandardStyles: array[TLazGtkStyle] of PStyleObject;

Function NewStyleObject : PStyleObject;
begin
  New(Result);
  Result^.Widget := nil;
  Result^.Style := nil;
end;

Procedure FreeStyleObject(var StyleObject : PStyleObject);
// internal function to dispose a styleobject
// it does *not* remove it from the style lists
begin
  If StyleObject <> nil then begin
    If StyleObject^.Widget <> nil then begin
      // first unref
      gtk_widget_unref(StyleObject^.Widget);
      // then destroy
      GTK_Widget_Destroy(StyleObject^.Widget);
    end;
    If StyleObject^.Style <> nil then
      If StyleObject^.Style^.{$IFDEF Gtk2}attach_count{$ELSE}Ref_Count{$ENDIF}>0
      then
        GTK_Style_Unref(StyleObject^.Style);
    Dispose(StyleObject);
    StyleObject := nil;
  end;
end;

procedure ReleaseAllStyles;
var
  StyleObject: PStyleObject;
  lgs: TLazGtkStyle;
  i: Integer;
begin
  if Styles=nil then exit;
  {$IFDEF Gtk2}
  if DefaultPangoLayout<>nil then begin
    g_object_unref(DefaultPangoLayout);
    DefaultPangoLayout:=nil;
  end;
  {$ENDIF}
  for i:=Styles.Count-1 downto 0 do begin
    StyleObject:=PStyleObject(Styles.Objects[i]);
    FreeStyleObject(StyleObject);
  end;
  Styles.Clear;
  for lgs:=Low(TLazGtkStyle) to High(TLazGtkStyle) do
    StandardStyles[lgs]:=nil;
end;

procedure ReleaseStyle(aStyle: TLazGtkStyle);
var
  StyleObject: PStyleObject;
  l: Integer;
begin
  if Styles=nil then exit;
  if aStyle in [lgsUserDefined] then
    RaiseGDBException('');// user styles are defined by name
  StyleObject:=StandardStyles[aStyle];
  if StyleObject<>nil then begin
    l:=IndexOfStyle(aStyle);
    Styles.Delete(l);
    StandardStyles[aStyle]:=nil;
    FreeStyleObject(StyleObject);
  end;
end;

Procedure ReleaseStyleWithName(const WName : String);
var
  l : Longint;
  s : PStyleObject;
begin
  if Styles=nil then exit;
  l := IndexOfStyleWithName(WName);
  If l >= 0 then begin
    If Styles.Objects[l] <> nil then
      Try
        s := PStyleObject(Styles.Objects[l]);
        FreeStyleObject(S);
      Except
        DebugLn('[ReleaseStyle] : Unable To Unreference Style');
      end;
    Styles.Delete(l);
  end;
end;

function GetStyle(aStyle: TLazGtkStyle): PGTKStyle;
begin
  if Styles=nil then exit(nil);
  if aStyle in [lgsUserDefined] then
    RaiseGDBException('');// user styles are defined by name
  if StandardStyles[aStyle]<>nil then
    // already created
    Result:=StandardStyles[aStyle]^.Style
  else
    // create it
    Result:=GetStyleWithName(LazGtkStyleNames[aStyle]);
end;

{------------------------------------------------------------------------------
  Function: GetStyleWithName
  Params: none
  Returns: Returns a Corresponding Style

  Tries to get the Style corresponding to the Widget Name passed, aka 'button',
  'default', checkbox', etc. for use within such routines as DrawFrameControl
  to attempt to supply theme dependent drawing. Styles are stored in a TStrings
  list which is only updated on theme change, to ensure fast efficient retrieval
  of Styles.
 ------------------------------------------------------------------------------}
function GetStyleWithName(const WName: String) : PGTKStyle;

  function CreateStyleNotebook: PGTKWidget;
  var
    NoteBookWidget: PGtkNotebook;
    //NoteBookPageWidget: PGtkWidget;
    NoteBookPageClientAreaWidget: PGtkWidget;
    NoteBookTabLabel: PGtkWidget;
    NoteBookTabMenuLabel: PGtkWidget;
  begin
    Result:=gtk_notebook_new;
    NoteBookWidget := PGtkNoteBook(Result);
    //NoteBookPageWidget := gtk_hbox_new(false, 0);
    NoteBookPageClientAreaWidget := CreateFixedClientWidget;
    gtk_widget_show(NoteBookPageClientAreaWidget);
    //gtk_container_add(GTK_CONTAINER(NoteBookPageWidget),
    //                  NoteBookPageClientAreaWidget);
    //gtk_widget_show(NoteBookPageWidget);
    NoteBookTabLabel:=gtk_label_new('Lazarus');
    gtk_widget_show(NoteBookTabLabel);
    NoteBookTabMenuLabel:=gtk_label_new('Lazarus');
    gtk_widget_show(NoteBookTabMenuLabel);
    gtk_notebook_append_page_menu(NoteBookWidget,NoteBookPageClientAreaWidget,
                                  NoteBookTabLabel,NoteBookTabMenuLabel);
    gtk_widget_set_usize(Result,200,200);
  end;

var
  Tp : Pointer;
  l : Longint;
  StyleObject : PStyleObject;
  NoName: PGChar;
  lgs: TLazGtkStyle;
  WidgetName: String;
  //VBox: PGtkWidget;
  AddToStyleWindow: Boolean;
  StyleWindowWidget: PGtkWidget;
  Requisition: TGtkRequisition;
  WindowFixedWidget: PGtkWidget;
begin
  Result := nil;
  if Styles=nil then exit;
  {$IFDEF NoStyle}
  exit;
  {$ENDIF}
  
  If (WName='') then exit;
  l:=IndexOfStyleWithName(WName);
  //DebugLn('GetStyleWithName START ',WName,' ',l);

  If l >= 0 then begin
    StyleObject:=PStyleObject(Styles.Objects[l]);
    Result := StyleObject^.Style;

  end else begin
    // create a new style object
    StyleObject := NewStyleObject;
    lgs:=lgsUserDefined;
    Tp:=nil;
    AddToStyleWindow:=true;
    // create a style widget
    If CompareText(WName,LazGtkStyleNames[lgsButton])=0 then begin
        StyleObject^.Widget := GTK_BUTTON_NEW;
        lgs:=lgsButton;
      end
    else
      If CompareText(WName,LazGtkStyleNames[lgsLabel])=0 then begin
        StyleObject^.Widget := GTK_LABEL_NEW('StyleLabel');
        lgs:=lgsLabel;
      end
    else
      If CompareText(WName,LazGtkStyleNames[lgsDefault])=0 then begin
        lgs:=lgsDefault;
        AddToStyleWindow:=false;
        NoName:=nil;
        StyleObject^.Widget :=
          // GTK2 does not allow to instantiate the abstract base Widget
          // so we use the "invisible" widget, which should never be defined
          // by the theme
          GTK_WIDGET_NEW(
            {$IFDEF Gtk2}GTK_TYPE_INVISIBLE{$ELSE}GTK_WIDGET_TYPE{$ENDIF},
            NoName,[]);
      end
    else
      If CompareText(WName,LazGtkStyleNames[lgsWindow])=0 then begin
        lgs:=lgsWindow;
        StyleObject^.Widget := GTK_WINDOW_NEW(GTK_WINDOW_TOPLEVEL);
        AddToStyleWindow:=false;
        gtk_widget_hide(StyleObject^.Widget);
        // create the fixed widget
        // (where to put all style widgets, that need a parent for realize)
        //VBox:=gtk_vbox_new(false,0);
        //gtk_widget_show(VBox);
        //gtk_container_add(PGtkContainer(StyleObject^.Widget), VBox);
        //gtk_object_set_data(PGtkObject(StyleObject^.Widget),'vbox',VBox);
        WindowFixedWidget:=CreateFixedClientWidget;
        gtk_widget_show(WindowFixedWidget);
        gtk_container_add(PGtkContainer(StyleObject^.Widget), WindowFixedWidget);
        gtk_object_set_data(PGtkObject(StyleObject^.Widget),'fixedwidget',WindowFixedWidget);
        gtk_widget_realize(StyleObject^.Widget);
      end
    else
      If CompareText(WName,LazGtkStyleNames[lgsCheckbox])=0 then begin
        lgs:=lgsCheckbox;
        StyleObject^.Widget := GTK_CHECK_BUTTON_NEW;
      end
    else
      If CompareText(WName,LazGtkStyleNames[lgsRadiobutton])=0 then begin
        lgs:=lgsRadiobutton;
        StyleObject^.Widget := GTK_RADIO_BUTTON_NEW(nil);
      end
    else
      If CompareText(WName,LazGtkStyleNames[lgsMenu])=0 then begin
        lgs:=lgsMenu;
        AddToStyleWindow:=false;
        StyleObject^.Widget := GTK_MENU_NEW;
      end
    else
      If CompareText(WName,LazGtkStyleNames[lgsMenuitem])=0 then begin
        lgs:=lgsMenuitem;
        AddToStyleWindow:=false;
        StyleObject^.Widget := GTK_MENU_ITEM_NEW;
      end
    else
      If CompareText(WName,LazGtkStyleNames[lgsStatusBar])=0 then begin
        lgs:=lgsStatusBar;
        AddToStyleWindow:=true;
        StyleObject^.Widget := gtk_statusbar_new;
      end
    else
      If CompareText(WName,LazGtkStyleNames[lgsList])=0 then begin
        lgs:=lgsList;
        StyleObject^.Widget := GTK_LIST_NEW;
      end
    else
      If CompareText(WName,LazGtkStyleNames[lgsVerticalScrollbar])=0 then begin
        lgs:=lgsVerticalScrollbar;
        StyleObject^.Widget := gtk_vscrollbar_new(nil);
      end
    else
      If CompareText(WName,LazGtkStyleNames[lgsHorizontalScrollbar])=0 then begin
        lgs:=lgsHorizontalScrollbar;
        StyleObject^.Widget := gtk_hscrollbar_new(nil);
      end
    else
      If CompareText(WName,LazGtkStyleNames[lgsVerticalPaned])=0 then begin
        lgs:=lgsVerticalPaned;
        StyleObject^.Widget := gtk_vpaned_new;
      end
    else
      If CompareText(WName,LazGtkStyleNames[lgsHorizontalPaned])=0 then begin
        lgs:=lgsHorizontalPaned;
        StyleObject^.Widget := gtk_hpaned_new;
      end
    else
      If CompareText(WName,LazGtkStyleNames[lgsNotebook])=0 then begin
        lgs:=lgsNotebook;
        StyleObject^.Widget := CreateStyleNotebook;
      end
    else
      If CompareText(WName,LazGtkStyleNames[lgsTooltip])=0 then begin
        lgs:=lgsTooltip;
        AddToStyleWindow:=false;
        TP := gtk_tooltips_new;
        StyleObject^.Widget := nil;
        GTK_Tooltips_Force_Window(TP);
        gtk_widget_ensure_style(PGTKTooltips(TP)^.Tip_Window);
        StyleObject^.Style:=gtk_widget_get_style(PGTKTooltips(TP)^.Tip_Window);
      end
    else
      If CompareText(WName,LazGtkStyleNames[lgsHScale])=0 then begin
        lgs:=lgsHScale;
        AddToStyleWindow:=true;
        TP := PGtkWidget( gtk_adjustment_new (0, 0, 100, 1, 10, 0));
        StyleObject^.Widget := gtk_hscale_new (PGTKADJUSTMENT (TP));
      end
    else
      If CompareText(WName,LazGtkStyleNames[lgsVScale])=0 then begin
        lgs:=lgsVScale;
        AddToStyleWindow:=true;
        TP := PGtkWidget( gtk_adjustment_new (0, 0, 100, 1, 10, 0));
        StyleObject^.Widget := gtk_vscale_new (PGTKADJUSTMENT (TP));
      end
    else
      If CompareText(WName,LazGtkStyleNames[lgsGTK_Default])=0 then begin
        lgs:=lgsGTK_Default;
        AddToStyleWindow:=false;
        StyleObject^.Widget := nil;
        StyleObject^.Style := gtk_style_new;
      end
    else begin
      // unknown style name -> bug
      FreeStyleObject(StyleObject);
      AddToStyleWindow:=false;
      RaiseGDBException('');
    end;
    
    if (lgs<>lgsUserDefined) and (StandardStyles[lgs]<>nil) then begin
      // consistency error
      RaiseGDBException('');
    end;
    
    // ensure style of the widget
    If (StyleObject^.Widget <> nil) then begin
      gtk_widget_ref(StyleObject^.Widget);

      // put style widget on style window, so that it can be realized
      if AddToStyleWindow then begin
        gtk_widget_show_all(StyleObject^.Widget);
        StyleWindowWidget:=GetStyleWidget(lgsWindow);
        WindowFixedWidget:=PGTKWidget(
               gtk_object_get_data(PGtkObject(StyleWindowWidget),'fixedwidget'));
        //DebugLn('AddToStyleWindow A ',GetWidgetDebugReport(StyleObject^.Widget));
        //gtk_box_pack_end(PGTKBox(VBox), WindowFixedWidget, True, True, 0);
        gtk_fixed_put(PGtkFixed(WindowFixedWidget),StyleObject^.Widget,0,0);
        gtk_widget_set_usize(StyleObject^.Widget,200,200);
      end;

      WidgetName:='LazStyle'+WName;
      gtk_widget_set_name(StyleObject^.Widget,PChar(WidgetName));
      gtk_widget_ensure_style(StyleObject^.Widget);
      gtk_widget_size_request(StyleObject^.Widget, @Requisition);
      StyleObject^.Style:=gtk_widget_get_style(StyleObject^.Widget);
      // ToDo: find out, why sometimes the style is not initialized.
      // for example: why the following occurs:
      If CompareText(WName,'button')=0 then begin
        if StyleObject^.Style^.light_gc[GTK_STATE_NORMAL]=nil then begin
          //DebugLn('GetStyleWithName ',WName);
          if not GtkWidgetIsA(StyleObject^.Widget,GTK_WINDOW_GET_TYPE) then begin
            gtk_widget_realize(StyleObject^.Widget);
          end;
        end;
      end;
    end;
    
    // increase refcount of style
    If StyleObject^.Style <> nil then
      If AnsiCompareText(WName,LazGtkStyleNames[lgsGTK_Default])<>0 then
        StyleObject^.Style:=GTK_Style_Ref(StyleObject^.Style);
        
    // if successful add to style objects list
    if StyleObject^.Style <> nil then begin
      Styles.AddObject(WName, TObject(StyleObject));
      if lgs<>lgsUserDefined then
        StandardStyles[lgs]:=StyleObject;
      Result:=StyleObject^.Style;
      If (StyleObject^.Widget <> nil)
      and (AnsiCompareText(WName,LazGtkStyleNames[lgsWindow])=0) then
        UpdateSysColorMap(StyleObject^.Widget);
        
      // ToDo: create all gc of the style
      //gtk_widget_set_rc_style(StyleObject^.Widget);
    end
    else begin
      // no success, clean up
      FreeStyleObject(StyleObject);
      DebugLn('WARNING: GetStyleWithName ',WName,' failed');
    end;
    
    // clean up
    If Tp<>nil then
      GTK_Object_Destroy(Tp);
      
  end;
end;

function GetStyleWidget(aStyle: TLazGtkStyle) : PGTKWidget;
begin
  if aStyle in [lgsUserDefined] then
    RaiseGDBException('');// user styles are defined by name
  if StandardStyles[aStyle]<>nil then
    // already created
    Result:=StandardStyles[aStyle]^.Widget
  else
    // create it
    Result:=GetStyleWidgetWithName(LazGtkStyleNames[aStyle]);
end;

Function GetStyleWidgetWithName(const WName : String) : PGTKWidget;
var
  l : Longint;
begin
  Result := nil;
  // init style
  GetStyleWithName(WName);
  // return widget
  l:=IndexOfStyleWithName(WName);
  If l>=0 then
    Result := PStyleObject(Styles.Objects[l])^.Widget;
end;

{------------------------------------------------------------------------------
  Function: LoadDefaultFont(Desc)
  Params: none
  Returns: Returns the default Font

  For Text/Font Routines: if the Font is invalid, this can be used instead, or
  if the DT_internal flag is used(aka use system font) this is used. This is
  also the font returned by GetStockObject(SYSTEM_FONT).

  It attempts to get the font from the default Style, or if none is available,
  a new style(aka try and get GTK builtin values), if that fails tries to get
  a generic fixed font, if THAT fails, it gets whatever font is available.
  If the result is not nil it MUST be GDK_FONT_UNREF'd when done.
 ------------------------------------------------------------------------------}
function LoadDefaultFont: TGtkIntfFont;
{$IFDEF Gtk1}
var
  Style : PGTKStyle;
{$ENDIF}
begin
  {$IFDEF Gtk2}
  Result:=gtk_widget_create_pango_layout(GetStyleWidget(lgsdefault), nil);
  {$ELSE Gtk1}
  Result := nil;
  Style := GetStyle(lgsDefault);
  if Style = nil then
    Style := GetStyle(lgsGTK_Default);
  if Style <> nil then begin
    Result := Style^.Font;
    if Result = nil then
      {$IFNDEF NoStyle}
      if (Style^.RC_Style <> nil) then begin
        if (Style^.RC_Style^.font_name <> nil) then
          Result := gdk_font_load(Style^.RC_Style^.font_name);
      end;
      {$ENDIF}
  end;

  If Result = nil then
    Result := gdk_fontset_load('-*-fixed-*-*-*-*-*-120-*-*-*-*-*-*');
  if Result = nil then
    Result := gdk_fontset_load('-*-*-*-*-*-*-*-*-*-*-*-*-*-*');
  {$ENDIF}

  If Result <> nil then
    ReferenceGtkIntfFont(Result);
end;

{$Ifdef GTK2}
function LoadDefaultFontDesc: PPangoFontDescription;
var
  Style : PGTKStyle;
begin
  Result := nil;
  
  {$WARNING ToDo LoadDefaultFontDesc: get a working default pango font description}
  Result := pango_font_description_from_string('sans 12');

  exit;
  
  Style := GetStyle(lgsLabel);
  if Style = nil then
    Style := GetStyle(lgsDefault);
  if Style = nil then
    Style := GetStyle(lgsGTK_Default);

  If (Style <> nil) then begin
    Result := pango_font_description_copy(Style^.font_desc);
  end;

  If Result = nil then
    Result := pango_font_description_from_string('sans 12');

  if Result = nil then
    Result := pango_font_description_from_string('12');
end;
{$ENDIF}

function GetDefaultFontName: string;
var
  Style: PGtkStyle;
  {$IFDEF GTK2}
  PangoFontDesc: PPangoFontDescription;
  {$ENDIF}
begin
  Result:='';
  Style := GetStyle(lgsDefault);
  if Style = nil then
    Style := GetStyle(lgsGTK_Default);

  If Style <> nil then begin
    {$IFDEF GTK1}
      {$IFNDEF NoStyle}
      If (Style^.RC_Style <> nil) then begin
        if (Style^.RC_Style^.font_name <> nil) then
          Result := Style^.RC_Style^.font_name;
      end;
      {$ENDIF}
    {$ENDIF}
    {$IFDEF GTK2}
    If (Style <> nil) then begin
      PangoFontDesc := pango_font_description_copy(Style^.font_desc);
      if PangoFontDesc<>nil then begin
        Result:=pango_font_description_get_family(PangoFontDesc);
      end;
    end;
    {$ENDIF}
  end;
end;

procedure RealizeGDKColor(ColorMap: PGdkColormap; Color: PGDKColor);
var
  AllocResult: gboolean;
begin
  if ColorMap=nil then ColorMap:=gdk_colormap_get_system;
  if (Color^.pixel = 0)
  and ((Color^.red<>0) or (Color^.blue<>0) or (Color^.green<>0)) then
    gdk_colormap_alloc_colors(ColorMap, Color, 1, false, true, @AllocResult)
  else
    gdk_colormap_query_color(ColorMap,Color^.pixel, Color);
end;

procedure RealizeGtkStyleColor(Style: PGTKStyle; Color: PGDKColor);
begin
  if (Style<>nil) then
    RealizeGDKColor(Style^.ColorMap,Color)
  else
    RealizeGDKColor(nil,Color);
end;

Function GetSysGCValues(Color: TColorRef;
  ThemeWidget: PGtkWidget): TGDKGCValues;
// ThemeWidget can be nil

  function GetWidgetWithBackgroundWindow(Widget: PGtkWidget): PGtkWidget;
  // returns the gtk widget which has the background gdk window
  var
    WindowOwnerWidget: PGtkWidget;
  begin
    Result:=Widget;
    if Result=nil then exit;
    if Result^.window=nil then exit;
    gdk_window_get_user_data(Result^.window,PGPointer(@WindowOwnerWidget));
    Result:=WindowOwnerWidget;
    if Result=nil then exit;
  end;

var
  Style: PGTKStyle;
  GC: PGDKGC;
  Pixmap: PGDKPixmap;
  SysColor: TColorRef;
  BaseColor: TColorRef;
  Red, Green, Blue: byte;
begin
  BaseColor := Color and $FF;

  {Set defaults in case something goes wrong}
  FillChar(Result, SizeOf(Result), 0);
  Style:=nil;
  GC:=nil;
  Pixmap:=nil;

  SysColor := ColorToRGB(BaseColor);
  Result.Fill := GDK_Solid;
  RedGreenBlue(TColor(SysColor),Red,Green,Blue);
  Result.foreground.Red:=gushort(Red) shl 8+Red;
  Result.foreground.Green:=gushort(Green) shl 8+Green;
  Result.foreground.Blue:=gushort(Blue) shl 8+Blue;

  {$IfDef Disable_GC_SysColors}
  exit;
  {$EndIf}
  Case BaseColor of
    {These are WM/X defined, but might be possible to get

    COLOR_CAPTIONTEXT
    COLOR_INACTIVECAPTIONTEXT}

    {These Are incompatible or WM defined
    
    COLOR_ACTIVECAPTION
    COLOR_INACTIVECAPTION
    COLOR_GRADIENTACTIVECAPTION
    COLOR_GRADIENTINACTIVECAPTION
    COLOR_WINDOWFRAME
    COLOR_ACTIVEBORDER
    COLOR_INACTIVEBORDER}
    
    COLOR_BACKGROUND:
      begin
        Style := GetStyle(lgsDefault);
        If Style = nil then
          Style := GetStyle(lgsWindow);
        If Style = nil then
          exit;
        Pixmap := Style^.bg_pixmap[GTK_STATE_NORMAL];
        If Pixmap <> nil then begin
          Result.Fill := GDK_Tiled;
          Result.Tile := Pixmap;
        end else begin
          GC := Style^.bg_gc[GTK_STATE_NORMAL];
          If GC = nil then begin
            Result.Fill := GDK_Solid;
            Result.foreground := Style^.bg[GTK_STATE_PRELIGHT];
          end
          else
            GDK_GC_Get_Values(GC, @Result);
        end;
      end;

    COLOR_INFOBK :
      begin
        Style := GetStyle(lgsTooltip);
        If Style = nil then
          Style := GetStyle(lgsWindow);
        If Style = nil then
          exit;

        Pixmap := Style^.bg_pixmap[GTK_STATE_NORMAL];
        If Pixmap <> nil then begin
          Result.Fill := GDK_Tiled;
          Result.Tile := Pixmap;
        end else begin
          GC := Style^.bg_gc[GTK_STATE_NORMAL];
          If GC = nil then begin
            Result.Fill := GDK_Solid;
            Result.foreground := Style^.bg[GTK_STATE_PRELIGHT];
          end
          else
            GDK_GC_Get_Values(GC, @Result);
        end;
      end;

    COLOR_INFOTEXT :
      begin
        Style := GetStyle(lgsTooltip);

        If Style = nil then
          Style := GetStyle(lgsWindow);

        If Style = nil then
          exit;

        GC := Style^.fg_gc[GTK_STATE_NORMAL];
        If GC = nil then begin
          Result.Fill := GDK_Solid;
          Result.foreground := Style^.fg[GTK_STATE_NORMAL];
        end
        else
          GDK_GC_Get_Values(GC, @Result);
      end;

    COLOR_FORM,
    COLOR_MENU,
    COLOR_SCROLLBAR,
    COLOR_BTNFACE :
      begin
        Case BaseColor of
          COLOR_FORM: Style := GetStyle(lgsWindow);
          COLOR_BTNFACE: Style := GetStyle(lgsButton);
          COLOR_MENU: Style := GetStyle(lgsMenu);
          COLOR_SCROLLBAR: Style := GetStyle(lgsHorizontalScrollbar);
        end;
        If Style = nil then
          exit;
        Pixmap := Style^.bg_pixmap[GTK_STATE_NORMAL];
        If Pixmap <> nil then begin
          Result.Fill := GDK_Tiled;
          Result.Tile := Pixmap;
        end else begin
          GC := Style^.bg_gc[GTK_STATE_NORMAL];
          If GC = nil then begin
            Result.Fill := GDK_Solid;
            Result.foreground := Style^.bg[GTK_STATE_NORMAL];
          end
          else
            GDK_GC_Get_Values(GC, @Result);
        end;
      end;

    COLOR_3DDKSHADOW,
    COLOR_BTNSHADOW :
      begin
        Style := GetStyle(lgsButton);
        If Style = nil then
          exit;
        GC := Style^.dark_gc[GTK_STATE_NORMAL];
        If GC = nil then begin
          Result.Fill := GDK_Solid;
          Result.foreground := Style^.dark[GTK_STATE_NORMAL];
        end
        else
          GDK_GC_Get_Values(GC, @Result);
      end;

    COLOR_GRAYTEXT :
      begin
        Style := GetStyle(lgsDefault);
        If Style = nil then
          exit;
        GC := Style^.text_gc[GTK_STATE_INSENSITIVE];
        if GC=nil then begin
          Result.Fill := GDK_Solid;
          Result.foreground := Style^.text[GTK_STATE_NORMAL];
        end else
          GDK_GC_Get_Values(GC, @Result);
      end;

    COLOR_MENUTEXT,
    COLOR_BTNTEXT :
      begin
        Case BaseColor of
          COLOR_BTNTEXT : Style := GetStyle(lgsButton);
          COLOR_MENUTEXT : Style := GetStyle(lgsMenuitem);
        end;
        If Style = nil then
          exit;
        GC := Style^.fg_gc[GTK_STATE_NORMAL];
        If GC = nil then begin
          Result.Fill := GDK_Solid;
          Result.foreground := Style^.fg[GTK_STATE_NORMAL];
        end
        else
          GDK_GC_Get_Values(GC, @Result);
      end;

    COLOR_WINDOWTEXT:
      begin
        Style := GetStyle(lgsDefault);
        If Style = nil then
          exit;
        GC := Style^.text_gc[GTK_STATE_NORMAL];
        If GC = nil then begin
          Result.Fill := GDK_Solid;
          Result.foreground := Style^.text[GTK_STATE_NORMAL];
        end
        else
          GDK_GC_Get_Values(GC, @Result);
      end;

    COLOR_3DLIGHT,
    COLOR_BTNHIGHLIGHT :
      begin
        Style := GetStyle(lgsButton);
        If Style = nil then
          exit;
        GC := Style^.light_gc[GTK_STATE_NORMAL];
        If GC = nil then begin
          Result.Fill := GDK_Solid;
          Result.foreground := Style^.light[GTK_STATE_NORMAL];
        end
        else
          GDK_GC_Get_Values(GC, @Result);
      end;

    COLOR_WINDOW :
      begin
        ThemeWidget:=GetWidgetWithBackgroundWindow(ThemeWidget);
        if ThemeWidget<>nil then begin
          if GtkWidgetIsA(ThemeWidget,GTK_TYPE_LIST_ITEM) then
            Style:=GetStyle(lgsList);
          if Style=nil then
            Style:=PGtkStyle(gtk_widget_get_style(ThemeWidget));
        end;
        if Style=nil then
          Style := GetStyle(lgsDefault);
        If Style = nil then
          exit;
        GC := Style^.base_gc[GTK_STATE_NORMAL];
        If (GC = nil) then begin
          Result.Fill := GDK_Solid;
          if Style^.base[GTK_STATE_NORMAL].Pixel<>0 then begin
            Result.foreground := Style^.base[GTK_STATE_NORMAL];
            Result.background := Style^.base[GTK_STATE_NORMAL];
          end;
        end
        else
          GDK_GC_Get_Values(GC, @Result);
      end;

    COLOR_HIGHLIGHT :
      begin
        Style := GetStyle(lgsDefault);
        If Style = nil then
          exit;
        GC := Style^.bg_gc[GTK_STATE_SELECTED];
        If GC = nil then begin
          Result.Fill := GDK_Solid;
          Result.foreground := Style^.bg[GTK_STATE_SELECTED];
        end
        else
          GDK_GC_Get_Values(GC, @Result);
      end;

    COLOR_HIGHLIGHTTEXT :
      begin
        Style := GetStyle(lgsDefault);
        If Style = nil then
          exit;
        GC := Style^.bg_gc[GTK_STATE_PRELIGHT];
        If GC = nil then begin
          Result.Fill := GDK_Solid;
          Result.foreground := Style^.bg[GTK_STATE_PRELIGHT];
        end
        else
          GDK_GC_Get_Values(GC, @Result);
      end;

    {?????????????
    COLOR_HOTLIGHT :
      begin
      end;
    ?????????????}

    {?????????????????
    COLOR_APPWORKSPACE :
      begin
      end;
    ?????????????????}
  end;

  RealizeGtkStyleColor(Style,@Result.foreground);
end;

Function StyleForegroundColor(Color: TColorRef;
  DefaultColor: PGDKColor): PGDKColor;
var
  style : PGTKStyle;
begin
  style := nil;
  Result := DefaultColor;

  Case TColor(Color) of
    clINFOTEXT :
      begin
        Style := GetStyle(lgsTooltip);

        If Style = nil then
          exit;

        Result := @Style^.fg[GTK_STATE_NORMAL];
      end;

    cl3DDKSHADOW,
    clBTNSHADOW :
      begin
        Style := GetStyle(lgsButton);
        If Style = nil then
          exit;
        Result := @Style^.dark[GTK_STATE_NORMAL];
      end;

    clGRAYTEXT :
      begin
        Style := GetStyle(lgsDefault);
        If Style = nil then
          exit;
        Result := @Style^.text[GTK_STATE_INSENSITIVE];
      end;

    clMENUTEXT,
    clBTNTEXT :
      begin
        Case TColor(Color) of
          clBTNTEXT : Style := GetStyle(lgsButton);
          clMENUTEXT : Style := GetStyle(lgsMenuitem);
        end;
        If Style = nil then
          exit;
        Result := @Style^.fg[GTK_STATE_NORMAL];
      end;

    clWINDOWTEXT:
      begin
        Style := GetStyle(lgsDefault);
        If Style = nil then
          exit;
        Result := @Style^.text[GTK_STATE_NORMAL];
      end;

    cl3DLIGHT,
    clBTNHIGHLIGHT :
      begin
        Style := GetStyle(lgsButton);
        If Style = nil then
          exit;
        Result := @Style^.light[GTK_STATE_NORMAL];
      end;

    clHIGHLIGHTTEXT :
      begin
        Style := GetStyle(lgsDefault);
        If Style = nil then
          exit;
        Result := @Style^.bg[GTK_STATE_PRELIGHT];
      end;
  end;

  If Result = nil then
    Result := DefaultColor;

  if (Result <> nil) and (Result <> DefaultColor) then
    RealizeGtkStyleColor(Style,Result);
end;

procedure StyleFillRectangle(drawable : PGDKDrawable; GC : PGDKGC; Color : TColorRef; x, y, width, height : gint);
var
  style : PGTKStyle;
  widget : PGTKWidget;
  state : TGTKStateType;
  detail : pgchar;
begin
  style := nil;
  
  Case TColor(Color) of
   { clMenu:
      begin
        Style := GetStyle('menuitem');
        widget := GetStyleWidget('menuitem');
        state := GTK_STATE_NORMAL;
        detail := 'menuitem';
      end;

    clBtnFace :
      begin
        Style := GetStyle('button');
        widget := GetStyleWidget('button');
        state := GTK_STATE_NORMAL;
        detail := 'button';
      end;

    clWindow :
      begin
        Style := GetStyle('default');
        widget := GetStyleWidget('default');
        state := GTK_STATE_NORMAL;
        detail := 'list';
      end;   }

    clBackground:
      begin
        Style := GetStyle(lgsWindow);
        widget := GetStyleWidget(lgsWindow);
        state := GTK_STATE_NORMAL;
        detail := 'window';
      end;

    clInfoBk :
      begin
        Style := GetStyle(lgsWindow);
        widget := GetStyleWidget(lgsWindow);
 //       Style := GetStyle('tooltip');
        state := GTK_STATE_NORMAL;
        detail := 'tooltip';
      end;

    clForm :
      begin
        Style := GetStyle(lgsWindow);
        widget := GetStyleWidget(lgsWindow);
        state := GTK_STATE_NORMAL;
        detail := 'window';
      end;
  end;

  if Assigned(Style) then
    gtk_paint_flat_box(style, drawable, state, GTK_SHADOW_NONE, nil, widget,
                       detail, x, y, width, height)
  else
    gdk_draw_rectangle(drawable, GC, 1, x, y, width, height);
end;

procedure UpdateWidgetStyleOfControl(AWinControl: TWinControl);
var
  RCStyle : PGtkRCStyle;
  Widget, FixWidget : PGTKWidget;
  MainWidget: PGtkWidget;
  FreeFontName: boolean;
  FreeFontSetName: boolean;

  procedure CreateRCStyle;
  begin
    if RCStyle=nil then
      RCStyle:=gtk_rc_style_new;
  end;
  
  procedure SetRCFont(FontGdiObject: PGdiObject);
  {$IFDEF GTK1}
  var
    FontDesc: TGtkFontCacheDescriptor;
  {$ENDIF}
  begin
    {$IFDEF GTK1}
    CreateRCStyle;
    FontDesc:=FontCache.FindADescriptor(FontGdiObject^.GDIFontObject);
    if (FontDesc<>nil) and (FontDesc.xlfd<>'') then begin
      RCStyle:=gtk_rc_style_new;
      g_free(RCStyle^.font_name);
      RCStyle^.font_name:=g_strdup(PChar(FontDesc.xlfd));
      g_free(RCStyle^.fontset_name);
      RCStyle^.fontset_name:=g_strdup(PChar(FontDesc.xlfd));
      FreeFontName:=true;

      //DebugLn('UpdateWidgetStyleOfControl.SetRCFont ',DbgSName(AWinControl),' Widget=',GetWidgetDebugReport(Widget),' Style=',GetWidgetStyleReport(Widget));
    end;
    {$ENDIF}
  end;

begin
  {$IFDEF NoStyle}
  exit;
  {$ENDIF}

  if not AWinControl.HandleAllocated then exit;

  MainWidget:=PGtkWidget(AWinControl.Handle);
  FixWidget:=GetFixedWidget(MainWidget);
  If (FixWidget <> nil) and (FixWidget<>MainWidget) then
    Widget := FixWidget
  else begin
    Widget := MainWidget;
  end;

  RCStyle:=nil;
  FreeFontName:=false;
  FreeFontSetName:=false;
  try
    // set default background
    if (AWinControl.Color=clNone) then begin
      // clNone => remove default background
      if (FixWidget<>nil) and (FixWidget^.Window<>nil) then begin
        gdk_window_set_back_pixmap(FixWidget^.Window,nil,GdkFalse);
      end;
    end
    else
    if AWinControl.ColorIsStored
    and ((AWinControl.Color and SYS_COLOR_BASE)=0) then begin
      // set background to user defined color

      // don't set background for custom controls, which paint themselves
      // (this prevents flickering)
      if (csOpaque in AWinControl.ControlStyle)
      and GtkWidgetIsA(MainWidget,GTKAPIWidget_GetType) then exit;

      {for i:=0 to 4 do begin
        RCStyle^.bg[i]:=NewColor;

        // Indicate which colors the GtkRcStyle will affect;
        // unflagged colors will follow the theme
        RCStyle^.color_flags[i]:=
          RCStyle^.color_flags[i] or GTK_RC_BG;
      end;}
      
      //DebugLn('UpdateWidgetStyleOfControl ',DbgSName(AWinControl),' Color=',DbgS(AWinControl.Color));
    end;
    
    {if (AWinControl is TCustomForm) then begin
      gdk_window_set_back_pixmap(FixWidget^.Window,nil,GdkFalse);

      NewColor:=TColorToTGDKColor(clRed);

      CreateRCStyle;
      for i:=0 to 4 do begin
        debugln('UpdateWidgetStyleOfControl i=',dbgs(i),' ',RCStyle^.bg_pixmap_name[i],' ',RCStyle^.Name);
        RCStyle^.bg[i]:=NewColor;

        // Indicate which colors the GtkRcStyle will affect;
        // unflagged colors will follow the theme
        RCStyle^.color_flags[i]:=
          RCStyle^.color_flags[i] or GTK_RC_BG;
      end;
    end;}
    
    // set font color

    // set font (currently only TCustomLabel)
    if (GtkWidgetIsA(Widget,gtk_label_get_type)
    or GtkWidgetIsA(Widget,gtk_editable_get_type)
    or GtkWidgetIsA(Widget,gtk_check_button_get_type))
    and (not AWinControl.Font.IsDefault)
    then begin
       // allocate font (just read it)
       if AWinControl.Font.Handle=0 then ;
    end;
    
  finally
    if RCStyle<>nil then begin
      //DebugLn('UpdateWidgetStyleOfControl Apply Modifications ',AWinControl.Name,' ',GetWidgetClassName(Widget));
      gtk_widget_modify_style(Widget,RCStyle);

      if FreeFontName then begin
        {$ifdef gtk1}
        g_free(RCStyle^.font_name);
        RCStyle^.font_name:=nil;
        {$else}
        pango_font_description_free(RCStyle^.font_desc);
        RCStyle^.font_desc:=nil;
        {$endif}
      end;
      if FreeFontSetName then begin
        {$ifdef gtk1}
        g_free(RCStyle^.fontset_name);
        RCStyle^.fontset_name:=nil;
        {$endif}
      end;
      //DebugLn('UpdateWidgetStyleOfControl END ',DbgSName(AWinControl),' Widget=',GetWidgetDebugReport(Widget),' Style=',GetWidgetStyleReport(Widget));
      gtk_rc_style_unref(RCStyle);
    end;
  end;
end;

{$IFDEF GTK1}
function G_OBJECT(p: Pointer): PGtkObject;
begin
  Result:=PGtkObject(p);
end;

function G_CALLBACK(p: Pointer): TGTKSignalFunc;
begin
  Result:=TGTKSignalFunc(p);
end;
{$ENDIF}

Function DeleteAmpersands(var Str : String) : Longint;
// convert double ampersands to single & and delete single &
// return the position of the letter after the first deleted single ampersand
// in the new string
var
  Tmp : String;
  SrcPos, DestPos, SrcLen: integer;
begin
  Result := -1;
  
  // for speedup reasons check if Str must be changed
  SrcLen:=length(Str);
  SrcPos:=SrcLen;
  while (SrcPos>=1) and (Str[SrcPos]<>'&') do dec(SrcPos);
  if SrcPos<1 then exit;

  // copy Str to Tmp and convert ampersands on the fly
  SetLength(Tmp,SrcLen);
  SrcPos:=1;
  DestPos:=1;
  while (SrcPos<=SrcLen) do begin
    if Str[SrcPos]<>'&' then begin
      // copy normal char
      Tmp[DestPos]:=Str[SrcPos];
      inc(SrcPos);
      inc(DestPos);
    end else begin
      inc(SrcPos);
      if (SrcPos<=SrcLen) and (Str[SrcPos]='&') then begin
        // double ampersand
        Tmp[DestPos]:='&';
        inc(DestPos);
        inc(SrcPos);
      end else begin
        // single ampersand
        if Result<1 then Result:=DestPos;
      end;
    end;
  end;
  SetLength(Tmp,DestPos-1);
  Str:=Tmp;
end;

{-------------------------------------------------------------------------------
  Function Ampersands2Underscore(Src: PChar) : PChar;

  Creates a new PChar. Deletes escaping ampersands, replaces the first single
  ampersand with an underscore and deleting all other single ampersands.
-------------------------------------------------------------------------------}
function Ampersands2Underscore(Src: PChar) : PChar;
var
  i, j: Longint;
  ShortenChars, FirstAmpersand, NewLength, SrcLength: integer;
begin
  // count ampersands and find first ampersand
  ShortenChars:= 0;  // chars to delete
  FirstAmpersand:= -1;
  SrcLength:= StrLen(Src);

  { Look for amperands. If found, check if it is an escaped ampersand.
    If it is, don't count it in. }
  i:=0;
  while i<SrcLength do begin
    if Src[i] = '&' then begin
      if (i < SrcLength - 1) and (Src[i+1] = '&') then begin
        // escaping ampersand found
        inc(ShortenChars);
        inc(i,2);
        Continue;
      end else begin
        // single ampersand found
        if (FirstAmpersand < 0) then
          // the first will be replaced ...
          FirstAmpersand:= i
        else
          // ... and all others will be deleted
          inc(ShortenChars);
      end; 
    end;
    inc(i);
  end;
  // create new PChar
  NewLength:= SrcLength - ShortenChars;

  Result:=StrAlloc(NewLength+1); // +1 for #0 char at end

  // copy string without ampersands
  i:=0;
  j:=0;
  while (j < NewLength) do begin
    if Src[i] <> '&' then begin
      // copy normal char
      Result[j]:= Src[i];
    end else begin
      // ampersand
      if (i < (SrcLength - 1)) and (Src[i+1] = '&') then begin
        // escaping ampersand found
        inc(i);
        Result[j]:='&';
      end else begin
        // single ampersand found
        if i = FirstAmpersand then begin
          // replace first single ampersand with underscore
          Result[j]:='_';
        end else begin
          // delete single ampersand
          dec(j);
        end;
      end;
    end;
    Inc(i);
    Inc(j);
  end;
  Result[NewLength]:=#0;
end;

{-------------------------------------------------------------------------------
  function Ampersands2Underscore(const ASource: String): String;

  Deletes escaping ampersands, replaces the first single
  ampersand with an underscore and deleting all other single ampersands.
-------------------------------------------------------------------------------}
function Ampersands2Underscore(const ASource: String): String;
var
  n: Integer;
  FirstFound: Boolean;
begin
  //TODO: escape underscores
  FirstFound := False;
  Result := ASource;
  n := 1;
  while n <= Length(Result) do
  begin
    if Result[n] = '&'
    then begin
      if (n < Length(Result))
      and (Result[n + 1] = '&')
      then begin
        // we got a &&, remove the first
        Delete(Result, n, 1);
        Inc(n);
        Continue;
      end;
      if FirstFound
      then begin
        // simply remove it
        Delete(Result, n, 1);
        Continue;
      end;
      // if we are here it's our first
      FirstFound := True;
      Result[n] := '_';
    end;
    Inc(n);
  end;
end;

{-------------------------------------------------------------------------------
  Function RemoveAmpersands(Src: PChar; LineLength : Longint) : PChar;

  Creates a new PChar removing all escaping ampersands.
-------------------------------------------------------------------------------}
function RemoveAmpersands(Src: PChar; LineLength : Longint) : PChar;
var
  i, j: Longint;
  ShortenChars, NewLength, SrcLength: integer;
begin
  // count ampersands and find first ampersand
  ShortenChars:= 0;  // chars to delete
  SrcLength:= LineLength;

  { Look for amperands. If found, check if it is an escaped ampersand.
    If it is, don't count it in. }
  i:=0;
  while i<SrcLength do begin
    if Src[i] = '&' then begin
      if (i < SrcLength - 1) and (Src[i+1] = '&') then begin
        // escaping ampersand found
        inc(ShortenChars);
        inc(i,2);
        Continue;
      end
      else
        inc(ShortenChars);
    end;
    inc(i);
  end;
  // create new PChar
  NewLength:= SrcLength - ShortenChars;

  Result:=StrAlloc(NewLength+1); // +1 for #0 char at end

  // copy string without ampersands
  i:=0;
  j:=0;
  while (j < NewLength) do begin
    if Src[i] <> '&' then begin
      // copy normal char
      Result[j]:= Src[i];
    end else begin
      // ampersand
      if (i < (SrcLength - 1)) and (Src[i+1] = '&') then begin
        // escaping ampersand found
        inc(i);
        Result[j]:='&';
      end else
        // delete single ampersand
        dec(j);
    end;
    Inc(i);
    Inc(j);
  end;
  Result[NewLength]:=#0;
end;

{-------------------------------------------------------------------------------
  function RemoveAmpersands(const ASource: String): String;

  Removing all escaping ampersands.
-------------------------------------------------------------------------------}
function RemoveAmpersands(const ASource: String): String;
var
  n: Integer;
begin
  Result := ASource;
  n := 1;
  while n <= Length(Result) do
  begin
    if Result[n] = '&'
    then begin
      if (n < Length(Result))
      and (Result[n + 1] = '&')
      then begin
        // we got a &&, remove the first
        Delete(Result, n, 1);
        Inc(n);
        Continue;
      end;
      // simply remove it
      Delete(Result, n, 1);
      Continue;
    end;
    Inc(n);
  end;
end;

{-------------------------------------------------------------------------------
  procedure LabelFromAmpersands(var AText, APattern: String; var AAccelChar: Char)

  Removes all escaping ampersands, creates an underscore pattern and returns
  the first ampersand char as accelerator char
-------------------------------------------------------------------------------}
procedure LabelFromAmpersands(var AText, APattern: String; var AAccelChar: Char);
var
  n: Integer;
  FirstFound: Boolean;
begin
  //TODO: escape underscores
  FirstFound := False;
  APattern := StringOfChar(' ', Length(AText));
  AAccelChar := #0;
  n := 1;
  while n <= Length(AText) do
  begin
    case AText[n] of
      '&': begin
        if (n < Length(AText))
        and (AText[n + 1] = '&')
        then begin
          // we got a &&, remove the first
          Delete(AText, n, 1);
          Delete(APattern, n, 1);
          Inc(n);
          Continue;
        end;

        Delete(AText, n, 1);
        Delete(APattern, n, 1);
        if FirstFound
        then Continue; // simply remove it

        // if we are here it's our first
        FirstFound := True;
        AAccelChar := System.lowerCase(AText[n]);
        // is there a next char we can underline ?
        if n <= Length(APattern)
        then APattern[n] := '_';
      end;
      '_': begin
        AText[n] := ' ';
        APattern[n] := '_';
      end;
    end;
    Inc(n);
  end;
end;


{-------------------------------------------------------------------------------
  Function GetTextExtentIgnoringAmpersands(Font : PGDKFont; Str : PChar;
                    LineLength : Longint; lbearing, rbearing, width, ascent, descent : Pgint);

  Gets text extent of a string, ignoring escaped Ampersands.
  That means, ampersands are not counted.
-------------------------------------------------------------------------------}
{$Ifdef GTK2}
Procedure GetTextExtentIgnoringAmpersands(FontDesc : PPangoFontDescription; Str : PChar;
  LineLength : Longint; lbearing, rbearing, width, ascent, descent : Pgint);
{$Else}
Procedure GetTextExtentIgnoringAmpersands(FontDesc : PGDKFont; Str : PChar;
  LineLength : Longint; lbearing, rbearing, width, ascent, descent : Pgint);
{$EndIf}
var
  NewStr : PChar;
  i: integer;
begin
  NewStr:=Str;
  // first check if Str contains an ampersand:
  if (Str<>nil) then begin
    i:=0;
    while (not (Str[i] in [#0,'&'])) do inc(i);
    if Str[i]='&' then begin
      NewStr := RemoveAmpersands(Str, LineLength);
      LineLength:=StrLen(NewStr);
    end;
  end;
  gdk_text_extents(FontDesc, NewStr, LineLength,
                   lbearing, rBearing, width, ascent, descent);
  if NewStr<>Str then
    StrDispose(NewStr);
end;

{------------------------------------------------------------------------------
  function FontIsDoubleByteCharsFont(TheFont: PGdkFont): boolean;

  This is only a heuristic
 ------------------------------------------------------------------------------}
function FontIsDoubleByteCharsFont(TheFont: PGdkFont): boolean;
var
  SingleCharLen, DoubleCharLen: integer;
begin
  SingleCharLen:=gdk_text_width(TheFont, 'A', 1);
  DoubleCharLen:=gdk_text_width(TheFont, #0'A', 2);
  Result:=(SingleCharLen=0) and (DoubleCharLen>0);
end;

{------------------------------------------------------------------------------
  function FontIsMonoSpaceFont(TheFont: PGdkFont): boolean;

  This is only a heuristic
 ------------------------------------------------------------------------------}
function FontIsMonoSpaceFont(TheFont: PGdkFont): boolean;
var
  SingleCharLen: LongInt;
  MWidth: LongInt;
  IWidth: LongInt;
begin
  SingleCharLen:=gdk_text_width(TheFont, 'A', 1);
  if SingleCharLen=0 then begin
    // assume a double byte character font
    MWidth:=gdk_text_width(TheFont, '#0m', 2);
    IWidth:=gdk_text_width(TheFont, '#0i', 2);
  end else begin
    // assume a single byte character font
    MWidth:=gdk_text_width(TheFont, 'm', 1);
    IWidth:=gdk_text_width(TheFont, 'i', 1);
  end;
  Result:=MWidth=IWidth;
end;

{$Ifdef GTK2}
function FontIsDoubleByteCharsFont(TheFont: PPangoFontDescription): boolean;
var
  Font: PGdkFont;
begin
  Font:=gdk_font_from_description(TheFont);
  Result:=FontIsDoubleByteCharsFont(Font);
  gdk_font_unref(Font);
end;

function FontIsMonoSpaceFont(TheFont: PPangoFontDescription): boolean;
var
  Font: PGdkFont;
begin
  Font:=gdk_font_from_description(TheFont);
  Result:=FontIsMonoSpaceFont(Font);
  gdk_font_unref(Font);
end;
{$ENDIF Gtk2}

{------------------------------------------------------------------------------
  Method:   GDKPixel2GDIRGB
  Params:
            Pixel - a GDK Pixel, refers to Index in Colormap/Visual
            Visual - a GDK Visual, if nil, the System Default is used
            Colormap - a GDK Colormap, if nil, the System Default is used
  Returns:  TGDIRGB

  A convenience function for use with GDK Image's. It takes a pixel value
  retrieved from gdk_image_get_pixel, and uses the passed Visual and Colormap
  to try and look up actual RGB values.
 ------------------------------------------------------------------------------}
Function GDKPixel2GDIRGB(Pixel: Longint; Visual: PGDKVisual;
  Colormap: PGDKColormap) : TGDIRGB;
var
  Color: TGDKColor;
begin
  FillChar(Result, SizeOf(TGDIRGB),0);

  If (Visual = nil) or (Colormap = nil) then begin
    Visual := GDK_Visual_Get_System;
    Colormap := GDK_Colormap_Get_System;
  end;
  
  gdk_colormap_query_color(colormap, pixel, @color);

  Result.Red := Color.Red shr 8;
  Result.Green := Color.Green shr 8;
  Result.Blue := Color.Blue shr 8;
end;

{------------------------------------------------------------------------------
  Function GetWindowDecorations(AForm : TCustomForm) : Longint;
  
 ------------------------------------------------------------------------------}
Function GetWindowDecorations(AForm : TCustomForm) : Longint;
var
  ABorderStyle: TFormBorderStyle;
begin
  if not (csDesigning in AForm.ComponentState) then
    ABorderStyle:=AForm.BorderStyle
  else
    ABorderStyle:=bsSizeable;
    
  Case ABorderStyle of
    bsNone : Result := 0;

    bsSingle : Result := GDK_DECOR_BORDER or GDK_DECOR_TITLE or
                 GDK_DECOR_MENU or GDK_DECOR_MINIMIZE or
                 GDK_DECOR_MAXIMIZE;

    bsSizeable : Result := GDK_DECOR_BORDER or GDK_DECOR_TITLE or
                 GDK_DECOR_MENU or GDK_DECOR_MINIMIZE or GDK_DECOR_MAXIMIZE
                 or GDK_DECOR_RESIZEH;

    bsDialog : Result := GDK_DECOR_BORDER or GDK_DECOR_TITLE or
                 GDK_DECOR_MENU or GDK_DECOR_MINIMIZE;

    bsToolWindow : Result := GDK_DECOR_BORDER or GDK_DECOR_TITLE or
                 GDK_DECOR_MENU or GDK_DECOR_MINIMIZE;

    bsSizeToolWin :Result := GDK_DECOR_BORDER or GDK_DECOR_TITLE or
                   GDK_DECOR_MENU or GDK_DECOR_MINIMIZE or GDK_DECOR_RESIZEH;
  else
    Result :=  GDK_DECOR_BORDER or GDK_DECOR_TITLE or
               GDK_DECOR_MENU or GDK_DECOR_MINIMIZE;
  end;
  
  //DebugLn('GetWindowDecorations ',DbgSName(AForm),' ',dbgs(ord(ABorderStyle)),' ',binStr(Result,8));
end;

{------------------------------------------------------------------------------
  Function GetWindowFunction(AForm : TCustomForm) : Longint;

 ------------------------------------------------------------------------------}
Function GetWindowFunction(AForm : TCustomForm) : Longint;
var
  ABorderStyle: TFormBorderStyle;
begin
  if not (csDesigning in AForm.ComponentState) then
    ABorderStyle:=AForm.BorderStyle
  else
    ABorderStyle:=bsSizeable;

  Case ABorderStyle of
    bsNone : Result := GDK_FUNC_RESIZE or GDK_FUNC_MOVE or GDK_FUNC_CLOSE;

    bsSingle : Result := GDK_FUNC_RESIZE or GDK_FUNC_MOVE or
                GDK_FUNC_MINIMIZE or GDK_FUNC_CLOSE;

    bsSizeable : Result := GDK_FUNC_RESIZE or GDK_FUNC_MOVE or
                GDK_FUNC_MINIMIZE or GDK_FUNC_CLOSE or GDK_FUNC_MAXIMIZE;

    bsDialog : Result := GDK_FUNC_RESIZE or GDK_FUNC_CLOSE or GDK_FUNC_MINIMIZE
                or GDK_FUNC_MOVE;

    bsToolWindow : Result := GDK_FUNC_RESIZE or GDK_FUNC_MOVE or
                GDK_FUNC_MINIMIZE or GDK_FUNC_CLOSE;

    bsSizeToolWin : Result := GDK_FUNC_RESIZE or GDK_FUNC_MOVE or
                GDK_FUNC_MINIMIZE or GDK_FUNC_CLOSE or GDK_FUNC_MAXIMIZE;
  end;

  // X warns if marking a fixed size window resizeable:
  if ((AForm.Constraints.MinWidth>0)
  and (AForm.Constraints.MinWidth=AForm.Constraints.MaxWidth))
  or ((AForm.Constraints.MinHeight>0)
  and (AForm.Constraints.MinHeight=AForm.Constraints.MaxHeight)) then
    Result:=Result-GDK_FUNC_RESIZE;

  //DebugLn('GetWindowFunction ',DbgSName(AForm),' ',dbgs(ord(ABorderStyle)),' ',binStr(Result,8));
end;

function GetGDKMouseCursor(Cursor: TCursor): PGdkCursor;
begin
  if (Cursor<crLow) or (Cursor>crHigh) then
    Cursor:=crDefault;
  if GDKMouseCursors[Cursor]=nil then
    GDKMouseCursors[Cursor]:=gdk_cursor_new(CursorToGDKCursor[Cursor]);
  Result:=GDKMouseCursors[Cursor];
end;

Procedure FreeGDKCursors;
var
  i: integer;
begin
  for i:=Low(GDKMouseCursors) to High(GDKMouseCursors) do begin
    if GDKMouseCursors[i]<>nil then begin
      gdk_Cursor_Destroy(GDKMouseCursors[i]);
      GDKMouseCursors[i]:=nil;
    end;
  end;
end;

Procedure FillScreenFonts(ScreenFonts : TStrings);
var
  {$IFDEF GTK1}
  {$IFDEF UNIX}
  theFonts : PPChar;
  {$ENDIF UNIX}
  {$Else}
  Widget : PGTKWidget;
  Context : PPangoContext;
  families : PPPangoFontFamily;
  {$EndIf}
  Tmp: AnsiString;
  I, N: Integer;
begin
  ScreenFonts.Clear;
  {$IFDEF GTK1}
  {$IFDEF UNIX}
  theFonts := XListFonts(gdk_display,PChar('-*-*-*-*-*-*-*-*-*-*-*-*-*-*'), 10000, @N);
  debugln('FillScreenFonts N=',dbgs(N));
  for I := 0 to N - 1 do
    if theFonts[I] <> nil then begin
      Tmp := ExtractFamilyFromXLFDName(theFonts[I]);
      if Tmp <> '' then
        if ScreenFonts.IndexOf(Tmp) < 0 then
          ScreenFonts.Append(Tmp);
    end;
   XFreeFontNames(theFonts);
  {$ENDIF UNIX}
  {$ELSE}
   Widget := GetStyleWidget(lgsDefault);
   if Widget = nil then begin
     exit;//raise an error here I guess
   end;
   Context := gtk_widget_get_pango_context(Widget);
   if Context = nil then begin
     exit;//raise an error here I guess
   end;
   families := nil;
   pango_context_list_families(Context, @families, @n);

   for I := 0 to N - 1 do
     if families[I] <> nil then begin
       Tmp := StrPas(pango_font_family_get_name(families[I]));
       if Tmp <> '' then
         if ScreenFonts.IndexOf(Tmp) < 0 then
           ScreenFonts.Append(Tmp);
    end;
   if (families <> nil) then
     g_free(families);
  {$ENDIF GTK2}
end;

function GetTextHeight(DCTextMetric: TDevContextTextMetric): integer;
// IMPORTANT: Before this call:  UpdateDCTextMetric(TDeviceContext(DC));
begin
  {$IfDef Win32}
  Result := DCTextMetric.TextMetric.tmHeight div 2;
  {$Else}
  Result := DCTextMetric.TextMetric.tmAscent;
  {$EndIf}
end;

{$IFDEF GTK1}
{ Compile with UseXinerama defined to use the Xinerama extension to avoid dialog
  boxes straddling two monitors. This is only required for GTK1, as it is built
  into GTK2. The Xinerama library is not always available, so the libraries will
  be dynamically loaded. (A single monitor is assumed if the load fails.) On
  some systems only a static Xinerama library is available, so define
  StaticXinerama also. MAC OSX is in this latter category, but it crashed the
  X server when I tried it on a real two monitor display.
}
var
  FirstScreenCalled: Boolean = False;
  FirstScreenResult: Boolean = False;
{$IFDEF UseXinerama}
{$IFDEF StaticXinerama}
{$LINKLIB Xinerama}
{$ENDIF}
{ Copy record definition from Xinerama unit.
  Can't use the unit itself, as it forces the executable to
  refer to the libraray }
type
   TXineramaScreenInfo = record
        screen_number : cint;
        x_org         : cshort;
        y_org         : cshort;
        width         : cshort;
        height        : cshort;
     end;
   PXineramaScreenInfo = ^TXineramaScreenInfo;

function GetFirstScreen: Boolean;
var
  nMonitors: cint;
  XineramaScreenInfo: PXineramaScreenInfo;
  opcode, firstevent, firsterror: cint;
  XineramaLib: TLibHandle;
  pXineramaIsActive: function (dpy: PDisplay):TBool;cdecl;
  pXineramaQueryScreens: function (dpy: PDisplay;
    number: Pcint): PXineramaScreenInfo;cdecl;
begin
  if not FirstScreenCalled then begin
    if XQueryExtension(gdk_display, 'XINERAMA', @opcode, @firstevent,
      @firsterror)
    then begin
      XineramaLib := {$IFDEF StaticXinerama} 1 {Flag present} {$ELSE} LoadLibrary('libXinerama.so') {$ENDIF};
      if XineramaLib <> 0 then begin
        {$IFDEF StaticXinerama}
          Pointer(pXineramaIsActive) := @XineramaIsActive;
          Pointer(pXineramaQueryScreens) := @XineramaQueryScreens;
        {$ELSE}
          Pointer(pXineramaIsActive) :=
                            GetProcAddress(XineramaLib, 'XineramaIsActive');
          Pointer(pXineramaQueryScreens) :=
                            GetProcAddress(XineramaLib, 'XineramaQueryScreens');
        {$ENDIF}
        if (pXineramaIsActive <> nil) and (pXineramaQueryScreens <> nil) and
          pXineramaIsActive(gdk_display)
        then begin
          XineramaScreenInfo := pXineramaQueryScreens(gdk_display, @nMonitors);
          if XineramaScreenInfo <> nil then begin
            if (nMonitors > 0) and (nMonitors < 10) then begin
              FirstScreen.x := XineramaScreenInfo^.width;
              FirstScreen.y := XineramaScreenInfo^.height;
              FirstScreenResult := True;
            end;
            XFree(XineramaScreenInfo);
          end;
        end;
        // Do not FreeLibrary(XineramaLib) because it causes the X11 library to
        // crash on exit
      end;
    end;
    FirstScreenCalled := True;
  end;
  Result := FirstScreenResult;
end;
{$ENDIF UseXinerama}
{$ENDIF Gtk1}

{$IFDEF HasX}
function  XGetWorkarea(var ax,ay,awidth,aheight:gint): gint;

var
  XDisplay: PDisplay;
  XScreen: PScreen;
  XWindow: TWindow;
  AtomType: x.TAtom;
  Format: gint;
  nitems: gulong;
  bytes_after: gulong;
  current_desktop: pguint;
  res   : Integer;
begin
  Result := -1;
  xdisplay := gdk_display;
  xscreen := XDefaultScreenOfDisplay(xdisplay);
  xwindow := XRootWindowOfScreen(xscreen);
  res:=XGetWindowProperty (xdisplay, xwindow,
             XInternAtom(xdisplay, '_NET_WORKAREA', false),
             0, MaxInt, False, XA_CARDINAL, @atomtype, @format, @nitems,
             @bytes_after, gpointer(@current_desktop));
  if (atomtype = XA_CARDINAL) and (format = 32) and  (nitems > 0) then begin
    result:=res;
    ax:=current_desktop[0];
    ay:=current_desktop[1];
    awidth:=current_desktop[2];
    aheight:=current_desktop[3];
    XFree (current_desktop);
  end;
end;
{$ENDIF}




{$IFDEF ASSERT_IS_ON}
  {$UNDEF ASSERT_IS_ON}
  {$C-}
{$ENDIF}

// included by gtkproc.pp
