xref: /dports/editors/lazarus-qt5-devel/lazarus-6df7e8756882f7d7f28f662011ee72f21746c580/lcl/interfaces/gtk/gtkproc.inc

{%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.txt, included in this distribution,
  for details about the license.
 *****************************************************************************
}

{off $DEFINE VerboseAccelerator}
{off $DEFINE VerboseUpdateSysColorMap}

{$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;


{$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(TheFont: TGtkIntfFont;
  Str: PChar; StrLength: integer;
  lbearing, rbearing, width, ascent, descent: Pgint);
var
  Layout : PPangoLayout;
  Extents : TPangoRectangle;
begin
  //DebugLn(['gdk_text_extents Str="',Str,'" StrLength=',StrLength,' lbearing=',lbearing<>nil,' rbearing=',rbearing<>Nil,' width=',width<>nil,' ascent=',ascent<>nil,' descent=',descent<>Nil,' ',TheFont<>Nil]);
  Layout:=TheFont;
  pango_layout_set_single_paragraph_mode(Layout, TRUE);
  pango_layout_set_width(Layout, -1);
  pango_layout_set_text(Layout, Str, StrLength);
  if Assigned(width) then
    pango_layout_get_pixel_size(Layout, width, nil);
  if Assigned(lbearing) or Assigned(rbearing)
  or Assigned(ascent) or Assigned(descent) then begin
    pango_layout_get_extents(Layout, nil, @Extents);

    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;
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 VerboseGtkToDos}{$note TODO: enable standard error_log handling}{$ENDIF}
  {$IfDef REPORT_GDK_ERRORS}
  If (Xerror<>0) then
    RaiseGDBException('A GDK/X Error occurred, 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;


{------------------------------------------------------------------------------
  Allocates a new PChar
 ------------------------------------------------------------------------------
function CreatePChar(const s: string): PChar;
begin
  Result:=StrAlloc(length(s) + 1);
  StrPCopy(Result, s);
end;
}
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 RectFromGdkRect(const AGdkRect: TGdkRectangle): TRect;
begin
  with Result do
  begin
    Left := AGdkRect.x;
    Top := AGdkRect.y;
    Right := AGdkRect.Width + AGdkRect.x;
    Bottom := AGdkRect.Height + AGdkRect.y;
  end;
end;

function GdkRectFromRect(const R: TRect): TGdkRectangle;
begin
  with Result do
  begin
    x := R.Left;
    y := R.Top;
    width := R.Right-R.Left;
    height := R.Bottom-R.Top;
  end;
end;

function AlignToGtkAlign(Align: TAlignment): gfloat;
begin
  case Align of
    taLeftJustify : AlignToGtkAlign := 0.0;
    taCenter      : AlignToGtkAlign := 0.5;
    taRightJustify: AlignToGtkAlign := 1.0;
  end;
end;

{$ifdef gtk2}
function GtkScrollTypeToScrollCode(ScrollType: TGtkScrollType): LongWord;
begin
  case ScrollType of
      GTK_SCROLL_NONE          : Result := SB_ENDSCROLL;
      GTK_SCROLL_JUMP          : Result := SB_THUMBPOSITION;
      GTK_SCROLL_STEP_BACKWARD : Result := SB_LINELEFT;
      GTK_SCROLL_STEP_FORWARD  : Result := SB_LINERIGHT;
      GTK_SCROLL_PAGE_BACKWARD : Result := SB_PAGELEFT;
      GTK_SCROLL_PAGE_FORWARD  : Result := SB_PAGERIGHT;
      GTK_SCROLL_STEP_UP       : Result := SB_LINEUP;
      GTK_SCROLL_STEP_DOWN     : Result := SB_LINEDOWN;
      GTK_SCROLL_PAGE_UP       : Result := SB_PAGEUP;
      GTK_SCROLL_PAGE_DOWN     : Result := SB_PAGEDOWN;
      GTK_SCROLL_STEP_LEFT     : Result := SB_LINELEFT;
      GTK_SCROLL_STEP_RIGHT    : Result := SB_LINERIGHT;
      GTK_SCROLL_PAGE_LEFT     : Result := SB_PAGELEFT;
      GTK_SCROLL_PAGE_RIGHT    : Result := SB_PAGERIGHT;
      GTK_SCROLL_START         : Result := SB_TOP;
      GTK_SCROLL_END           : Result := SB_BOTTOM;
    end;
end;
{$endif}

{------------------------------------------------------------------------------
  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 Widget=nil then begin
    Result:='nil';
    exit;
  end;
  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: gpointer;
  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), gtk_widget_get_type) then
    begin
      Widget := PGTKWidget(p);
      Result := Result + '<Widget[' + GetWidgetDebugReport(Widget) + ']>';
    end
    else
      Result := Result + '<UserData=' + DbgS(p) + ']>';
  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
    if WindowType in [GDK_WINDOW_PIXMAP] then
      Result := Result + ' Depth=' + IntToStr(Visual^.bits_per_rgb);
  {$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';
    {$IFDEF Gtk2}
    if GTK_WIDGET_NO_WINDOW(Widget) then
      Result:=Result+'Nw';
    if GTK_WIDGET_COMPOSITE_CHILD(Widget) then
      Result:=Result+'Cc';
    if GTK_WIDGET_APP_PAINTABLE(Widget) then
      Result:=Result+'Ap';
    if GTK_WIDGET_DOUBLE_BUFFERED(Widget) then
      Result:=Result+'Db';
    {$ENDIF}
  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 SetFormShowInTaskbar(AForm: TCustomForm;
  const AValue: TShowInTaskbar);
var
  Enable: boolean;
  Widget: PGtkWidget;
begin
  if (AForm.Parent <> nil) or
     (AForm.ParentWindow <> 0) or
     not (AForm.HandleAllocated) then Exit;

  Widget := PGtkWidget(AForm.Handle);
  // if widget not yet realized then exit
  if Widget^.Window = nil then
    Exit;

  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));
  // The button reappears in some (still unknown) situations, but has the
  //'skip-taskbar-hint' property still set to True, so invoking the function
  //doesn't have an effect. Resetting the property makes it work.
  {$IFNDEF GTK1}
  if (not Enable) and gtk_window_get_skip_taskbar_hint(PGtkWindow(Widget)) then
    gtk_window_set_skip_taskbar_hint(PGtkWindow(Widget), False);
  {$ENDIF}
  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}
  //DebugLn(['SetGtkWindowShowInTaskbar ',GetWidgetDebugReport(PGtkWidget(AGtkWindow)),' ',Value]);
  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 HasX}
  XGrabKeyboard(gdk_display, FormToX11Window(AForm), true, GrabModeASync,
                GrabModeASync, CurrentTime);
  {$ENDIF}
end;

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

procedure GrabMouseToForm(AForm: TCustomForm);
{$IFDEF HasX}
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 HasX}
  XUngrabPointer(gdk_display, CurrentTime);
  {$ENDIF}
end;

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

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
  FillByte(Result,SizeOf(Result),0);
  Result.Msg := LM_PAINT;
  New(PS);
  FillChar(PS^, SizeOf(TPaintStruct), 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(PtrUInt(Widget)), PS^);
  Result.PaintStruct := PS;
  Result.Result := 0;
  if FreeGtkPaintMsg then
    FreeThenNil(GtkPaintMsg.Data);
end;

procedure FinalizePaintMessage(Msg: PLMessage);
var
  PS: PPaintStruct;
  DC: TGtkDeviceContext;
begin
  if (Msg^.Msg = LM_PAINT) then
  begin
    if Msg^.LParam <> 0 then
    begin
      PS := PPaintStruct(Msg^.LParam);
      if Msg^.WParam <> 0 then
        DC := TGtkDeviceContext(Msg^.WParam)
      else
        DC := TGtkDeviceContext(PS^.hdc);
      EndPaint(THandle(PtrUInt(DC.Widget)), 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
    FreeThenNil(TLMGtkPaintData(Msg^.WParam));
end;

procedure FinalizePaintTagMsg(Msg: PMsg);
var
  PS: PPaintStruct;
  DC: TGtkDeviceContext;
begin
  if (Msg^.Message = LM_PAINT) then
  begin
    if Msg^.LParam <> 0 then
    begin
      PS := PPaintStruct(Msg^.LParam);
      if Msg^.WParam<>0 then
        DC := TGtkDeviceContext(Msg^.WParam)
      else
        DC := TGtkDeviceContext(PS^.hdc);
      EndPaint(THandle(PtrUInt(DC.Widget)), 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
    FreeThenNil(TObject(Msg^.WParam));
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: TGtkDeviceContext; DestinationGC: PGDKGC;
  X,Y,Width,Height: integer; ClipMergeMask: PGdkBitmap;
  ClipMergeMaskX, ClipMergeMaskY: integer;
  var NewClipMask: PGdkBitmap);
// merge ClipMergeMask into the destination clipping mask at the
// destination rectangle
var
  temp_gc : PGDKGC;
  temp_color : TGDKColor;
  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
  DestinationDC.SelectRegion;
  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+1, height+1);

  // copy the destination clipping mask into the temporary mask
  with DestinationDC do begin
    If (ClipRegion <> nil) then begin
      RGNType := RegionType(ClipRegion^.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(ClipRegion^.GDIRegionObject,OffsetXY.X,OffsetXY.Y);
        // 2. Apply region to temporary mask
        gdk_gc_set_clip_region(temp_gc, ClipRegion^.GDIRegionObject);
        // 3. Undo moving the region
        gdk_region_offset(ClipRegion^.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, -1, -1);

  // 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;

function CreatePixbufFromImageAndMask(ASrc: PGdkDrawable; ASrcX, ASrcY, ASrcWidth,
  ASrcHeight: integer; ASrcColorMap: PGdkColormap; ASrcMask: PGdkBitmap): PGdkPixbuf;

  procedure Warn(const AText: String);
  begin
    DebugLn('[WARNING] ScalePixmapAndMask: ' + AText);
  end;

  procedure ApplyMask(APixels, AMask: pguchar);
  type
    TPixbufPixel = record
      R,G,B,A: Byte;
    end;
  var
    RGBA: ^TPixbufPixel absolute APixels;
    Mask: ^TPixbufPixel absolute AMask;
    n: Integer;
  begin
    for n := 0 to (ASrcHeight * ASrcWidth) - 1 do
    begin
      if (Mask^.B = 0) and (Mask^.G = 0) and (Mask^.R = 0)
      then RGBA^.A := 0;
      inc(RGBA);
      inc(Mask);
    end;
  end;

var
  Msk: PGdkPixbuf;
  FullSrcWidth, FullSrcHeight: integer;
begin
  Result := nil;
  if ASrc = nil then Exit;

  gdk_window_get_size(PGDKWindow(ASrc), @FullSrcWidth, @FullSrcHeight);
  if ASrcX + ASrcWidth > FullSrcWidth
  then begin
    Warn('ASrcX+ASrcWidth>FullSrcWidth');
  end;
  if ASrcY + ASrcHeight > FullSrcHeight
  then begin
    Warn('ASrcY+ASrcHeight>FullSrcHeight');
  end;

  // Creating PixBuf from pixmap
  Result := CreatePixbufFromDrawable(ASrc, ASrcColorMap, ASrcMask <> nil, ASrcX, ASrcY, 0, 0, ASrcWidth, ASrcHeight);
  if Result = nil
  then begin
    Warn('Result=nil');
    Exit;
  end;
  //DbgDumpPixbuf(Result, 'Pixbuf from Source');

  // Apply mask if present
  if ASrcMask <> nil
  then begin
    if gdk_pixbuf_get_rowstride(Result) <> ASrcWidth shl 2
    then begin
      Warn('rowstride <> 4*width');
      gdk_pixbuf_unref(Result);
      Result := nil;
      Exit;
    end;

    Msk := CreatePixbufFromDrawable(ASrcMask, nil, True, ASrcX, ASrcY, 0, 0, ASrcWidth, ASrcHeight);
    ApplyMask(gdk_pixbuf_get_pixels(Result), gdk_pixbuf_get_pixels(Msk));
    gdk_pixbuf_unref(Msk);
  end;
end;

function ScalePixmapAndMask(AScaleGC: PGDKGC; AScaleMethod: TGdkInterpType;
  ASrc: PGdkPixmap; ASrcX, ASrcY, ASrcWidth, ASrcHeight: integer;
  ASrcColorMap: PGdkColormap; ASrcMask: PGdkBitmap;
  ADstWidth, ADstHeight: Integer; FlipHorz, FlipVert: Boolean;
  out ADst, ADstMask: PGdkPixmap) : Boolean;

  procedure Warn(const AText: String);
  begin
    DebugLn('[WARNING] ScalePixmapAndMask: ' + AText);
  end;

var
  ScaleSrc, ScaleDst: PGdkPixbuf;
begin
  Result := False;
  ADst:=nil;
  ADstMask:=nil;

  // Creating PixBuf from pixmap
  ScaleSrc := CreatePixbufFromImageAndMask(ASrc, ASrcX, ASrcY, ASrcWidth, ASrcHeight,
    ASrcColorMap, ASrcMask);

  // Scaling PixBuf
  ScaleDst := gdk_pixbuf_scale_simple(ScaleSrc, ADstWidth, ADstHeight, AScaleMethod);
  gdk_pixbuf_unref(ScaleSrc);
  if ScaleDst = nil
  then begin
    Warn('ScaleDst=nil');
    exit;
  end;

  // flip if needed
  if FlipHorz then
  begin
    {$IFNDEF GTK1}
    ScaleSrc := ScaleDst;
    ScaleDst := gdk_pixbuf_flip(ScaleSrc, True);
    gdk_pixbuf_unref(ScaleSrc);
    if ScaleDst = nil
    then begin
      Warn('ScaleDst=nil');
      exit;
    end;
    {$ELSE}
    // TODO: implement flipping for gtk1
    {$ENDIF}
  end;

  if FlipVert then
  begin
    {$IFNDEF GTK1}
    ScaleSrc := ScaleDst;
    ScaleDst := gdk_pixbuf_flip(ScaleSrc, False);
    gdk_pixbuf_unref(ScaleSrc);
    if ScaleDst = nil
    then begin
      Warn('ScaleDst=nil');
      exit;
    end;
    {$ELSE}
    // TODO: implement flipping for gtk1
    {$ENDIF}
  end;

//  BeginGDKErrorTrap;

  // Creating pixmap from scaled pixbuf
  gdk_pixbuf_render_pixmap_and_mask(ScaleDst, ADst, ADstMask, $80);

//  EndGDKErrorTrap;
  gdk_pixbuf_unref(ScaleDst);
  Result := True;
end;

{$IFDEF VerboseGtkToDos}{$note remove when gtk native imagelist will be ready}{$ENDIF}
procedure DrawImageListIconOnWidget(ImgList: TCustomImageList;
  Index: integer; AEffect: TGraphicsDrawEffect; DestWidget: PGTKWidget;
  CenterHorizontally, CenterVertically: boolean;
  DestLeft, DestTop: integer);
// draw icon of imagelist centered on gdkwindow
var
  Bitmap: TBitmap;
  ImageWidth: Integer;
  ImageHeight: Integer;
  WindowWidth, WindowHeight: integer;
  DestDC: HDC;
  Offset: TPoint;
  {$ifdef gtk2}
  FixedWidget: PGtkWidget;
  {$ENDIF}
begin
  if ImgList=nil then exit;
  if (Index<0) or (Index>=ImgList.Count) then exit;
  if (DestWidget=nil) then exit;
  ImageWidth:=ImgList.Width;
  ImageHeight:=ImgList.Height;
  Bitmap := TBitmap.Create;
  ImgList.GetBitmap(Index, Bitmap, AEffect);
  if (ImageWidth<1) or (ImageHeight<1) then exit;

  WindowWidth := DestWidget^.allocation.width;
  WindowHeight := DestWidget^.allocation.height;

  Offset := Point(0, 0);
  {$ifdef gtk2}
  // if our widget is placed on non-window fixed then we should substract its allocation here
  // since in GetDC we will get this difference in offset
  FixedWidget := GetFixedWidget(DestWidget);
  if (FixedWidget <> nil) and GTK_WIDGET_NO_WINDOW(FixedWidget) then
    Offset := Point(FixedWidget^.allocation.x, FixedWidget^.allocation.y);
  {$endif}

  if CenterHorizontally then
    DestLeft := DestWidget^.allocation.x - Offset.x + ((WindowWidth-ImageWidth) div 2);
  if CenterVertically then
    DestTop := DestWidget^.allocation.y - Offset.y +  ((WindowHeight-ImageHeight) div 2);
  DestDC := GetDC(HDC(PtrUInt(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, 0, 0, ImageWidth, ImageHeight,
    SRCCOPY);
  ReleaseDC(HDC(PtrUInt(DestWidget)),DestDC);
  Bitmap.Free;
end;

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

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

{------------------------------------------------------------------------------
  Function: CreateGtkBitmapMask
  Params:  AImageMask: Then internal gtkBitmap for imagemask
           AMask: External gtkbitmap
  Returns: A GdkBitmap

  This function returns a bitmap based on the internal alpha bitmap and the
  maskhandle passed.
  If both internal mask and the given mask is valid, then a new bitmap is created
  else either internal mask or given mask (with increased reference)
 ------------------------------------------------------------------------------}
function CreateGdkMaskBitmap(AImageMask, AMask: PGdkBitmap): PGdkBitmap;
var
  W, H: Integer;
  GC: PGdkGc;
begin
  Result := nil;
  if (AImageMask = nil) and (AMask = nil) then Exit;

  if AMask = nil
  then begin
    Result := AImageMask;
    gdk_pixmap_ref(Result);
    Exit;
  end;

  if AImageMask = nil
  then begin
    Result := AMask;
    gdk_pixmap_ref(Result);
    Exit;
  end;

  // if we are here we need a combination (=AND) of both masks
  gdk_window_get_size(AImageMask, @W, @H);
  Result := gdk_pixmap_new(nil, W, H, 1);
  GC := gdk_gc_new(Result);
  // copy image mask
  gdk_draw_pixmap(Result, GC, AImageMask, 0, 0, 0, 0, -1, -1);
  // and with mask
  gdk_gc_set_function(GC, GDK_AND);
  gdk_draw_pixmap(Result, GC, AMask, 0, 0, 0, 0, -1, -1);
  gdk_gc_unref(GC);
end;

{------------------------------------------------------------------------------
  Function: CreateGdkMaskBitmap
  Params:  AImage: Handle to the (LCL) bitmap image
           AMask: Handle to the (LCL) bitmap mask
  Returns: A GdkBitmap

  This function returns a bitmap based on the internal alpha bitmap of the
  image handle and the maskhandle passed.
  If only internal mask is valid, then that one is returned (with increased reference)
  Otherwise a new bitmap is created.
 ------------------------------------------------------------------------------}
function CreateGdkMaskBitmap(AImage, AMask: HBITMAP): PGdkBitmap;
var
  GdiImage: PGdiObject absolute AImage;
  GdiMask: PGdiObject absolute AMask;
  W, H: Integer;
  GC: PGdkGc;
begin
  Result := nil;
  if (AImage = 0) and (AMask = 0) then Exit;

  if GdiMask = nil
  then begin
    if GdiImage^.GDIBitmapType = gbPixmap
    then Result := GdiImage^.GDIPixmapObject.Mask;
    if Result <> nil
    then gdk_pixmap_ref(Result);
//    DbgDumpBitmap(Result, 'CreateGdkMaskBitmap - Internal mask');
    Exit;
  end;

  if GdiMask^.GDIBitmapType <> gbBitmap
  then begin
    DebugLN('[WARNING] CreateGtkBitmapMask: GDIBitmapType <> dbBitmap');
    Exit;
  end;

  if (GdiImage = nil)
  or (GdiImage^.GDIBitmapType <> gbPixmap)
  or (GdiImage^.GDIPixmapObject.Mask = nil)
  then begin
    gdk_window_get_size(GdiMask^.GDIBitmapObject, @W, @H);
    Result := gdk_pixmap_new(nil, W, H, 1);
    GC := gdk_gc_new(Result);
    gdk_gc_set_function(GC, {$ifdef gtk1}11{$else}GDK_COPY_INVERT{$endif});
    gdk_draw_pixmap(Result, GC, GdiMask^.GDIBitmapObject, 0, 0, 0, 0, -1, -1);
    gdk_gc_unref(GC);

    //DbgDumpBitmap(Result, 'CreateGdkMaskBitmap - Mask');
    Exit;
  end;

  // if we are here we need a combination (=AND) of both masks
  gdk_window_get_size(GdiImage^.GDIPixmapObject.Mask, @W, @H);
  Result := gdk_pixmap_new(nil, W, H, 1);
  GC := gdk_gc_new(Result);
  // copy image mask
  gdk_draw_pixmap(Result, GC, GdiImage^.GDIPixmapObject.Mask, 0, 0, 0, 0, -1, -1);
  // and with mask
  gdk_gc_set_function(GC, {$ifdef gtk1}6{$else}GDK_AND_INVERT{$endif});
  gdk_draw_pixmap(Result, GC, GdiMask^.GDIBitmapObject, 0, 0, 0, 0, -1, -1);
  gdk_gc_unref(GC);

//  DbgDumpBitmap(Result, 'CreateGdkMaskBitmap - Combi');
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:= gdk_pixmap_new(nil, SrcWidth, SrcHeight, 1);
  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;

procedure CheckGdkImageBitOrder(AImage: PGdkImage; AData: PByte; ADataCount: Integer);
var
  b, count: Byte;
  c: Cardinal;

{$ifdef hasx}
  XImage: XLib.PXimage;
{$endif}
begin
{$ifdef hasx}
  if AImage = nil then Exit;

  XImage := gdk_x11_image_get_ximage(AImage);
  if XImage^.bitmap_bit_order = LSBFirst then Exit;
{$endif}

  // on windows or bigendian servers the bits need to be swapped

  // align dataptr first
  count := PtrUint(AData) and 3;
  if count > ADataCount then count := ADataCount;
  Dec(ADataCount, Count);

  while (Count > 0) do
  begin
    // reduce dereferences
    b      := AData^;
    b      := ((b shr 4) and $0F) or ((b shl 4) and $F0);
    b      := ((b shr 2) and $33) or ((b shl 2) and $CC);
    AData^ := ((b shr 1) and $55) or ((b shl 1) and $AA);

    Dec(Count);
    Inc(AData);
  end;

  // get remainder
  Count := ADataCount and 3;

  // now swap bits with 4 in a row
  ADataCount := ADataCount shr 2;
  while (ADataCount > 0) do
  begin
    // reduce dereferences
    c                 := PCardinal(AData)^;
    c                 := ((c shr 4) and $0F0F0F0F) or ((c shl 4) and $F0F0F0F0);
    c                 := ((c shr 2) and $33333333) or ((c shl 2) and $CCCCCCCC);
    PCardinal(AData)^ := ((c shr 1) and $55555555) or ((c shl 1) and $AAAAAAAA);

    Dec(ADataCount);
    Inc(AData, 4);
  end;

  // process remainder
  while (Count > 0) do
  begin
    // reduce dereferences
    b      := AData^;
    b      := ((b shr 4) and $0F) or ((b shl 4) and $F0);
    b      := ((b shr 2) and $33) or ((b shl 2) and $CC);
    AData^ := ((b shr 1) and $55) or ((b shl 1) and $AA);

    Dec(Count);
    Inc(AData);
  end;

end;


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

  Allocated a GDKColor from a winapi color
 ------------------------------------------------------------------------------}
function AllocGDKColor(const AColor: TColorRef): 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 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;


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 : TColorRef;
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 TGtkDeviceContext(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,
                                TGtkDeviceContext(DC).Widget);
    {$IFDEF DebugGDK}BeginGDKErrorTrap;{$ENDIF}
    with SysGCValues do
    begin
      AllocFG := Foreground.Pixel = 0;
      if AllocFG then
        if not gdk_colormap_alloc_color(GDK_Colormap_get_system, @Foreground,
                                        True, True) then
          WarnAllocFailed(Foreground);
      gdk_gc_set_fill(GC, fill);
      if AsBackground then
        gdk_gc_set_background(GC, @foreground)
      else
        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:=TGtkDeviceContext(DC).GC;
  GDIColor:=nil;
  with TGtkDeviceContext(DC) do
  begin
    case ColorType of
      dccCurrentBackColor: GDIColor:=@CurrentBackColor;
      dccCurrentTextColor: GDIColor:=@CurrentTextColor;
      dccGDIBrushColor   : GDIColor:=@(GetBrush^.GDIBrushColor);
      dccGDIPenColor     : GDIColor:=@(GetPen^.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,
    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)

    clHighlightText,
    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;

function HandleGTKKeyUpDown(AWidget: PGtkWidget; AEvent: PGdkEventKey;
  AData: gPointer; ABeforeEvent, AHandleDown: Boolean;
  const AEventName: PGChar) : GBoolean;
// returns CallBackDefaultReturn if event can continue in gtk's message system
{off $DEFINE VerboseKeyboard}
const
  KEYUP_MAP: array[Boolean {syskey}, Boolean {before}] of Cardinal = (
    (LM_KEYUP, CN_KEYUP),
    (LM_SYSKEYUP, CN_SYSKEYUP)
  );

  KEYDOWN_MAP: array[Boolean {syskey}, Boolean {before}] of Cardinal = (
    (LM_KEYDOWN, CN_KEYDOWN),
    (LM_SYSKEYDOWN, CN_SYSKEYDOWN)
  );

  CHAR_MAP: array[Boolean {syskey}, Boolean {before}] of Cardinal = (
    (LM_CHAR, CN_CHAR),
    (LM_SYSCHAR, CN_SYSCHAR)
  );
var
  Msg: TLMKey;
  EventStopped: Boolean;
  EventString: PChar; // GTK1 and GTK2 workaround
                      // (and easy access to bytes)
  KeyCode: Word;
  KCInfo: TKeyCodeInfo;
  VKey: Byte;
  ShiftState: TShiftState;

  Character: TUTF8Char;
  SysKey: Boolean;

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

  procedure StopKeyEvent;
  begin
    {$IFDEF VerboseKeyboard}
    DebugLn('StopKeyEvent AEventName="',AEventName,'" ABeforeEvent=',dbgs(ABeforeEvent));
    {$ENDIF}
    if not EventStopped
    then begin
      g_signal_stop_emission_by_name(PGtkObject(AWidget), AEventName);
      EventStopped := True;
    end;

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

    AEvent^.KeyVal := 0;
  end;

  function DeliverKeyMessage(const Target: Pointer; var AMessage): boolean;
  begin
    Result:=DeliverMessage(Target,AMessage)=0;
    if not Result then StopKeyEvent;
  end;

  function GetSpecialChar: Char;
  begin
    if (AEvent^.keyval > $FF00) and (AEvent^.keyval < $FF20) and
       (AEvent^.keyval <> GDK_KEY_Tab) then
      Result := Chr(AEvent^.keyval xor $FF00)
    else
      Result := #0;
  end;

  function CanSendChar: Boolean;
  begin
    Result := False;
    if AEvent^.Length > 1 then Exit;

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

    // Check if CTRL is pressed
    if ssCtrl in ShiftState
    then begin
      // Check if we pressed ^@
      if  (AEvent^.Length = 0)
      and (AEvent^.KeyVal = GDK_KEY_AT)
      then begin
        Result := True;
        Exit;
      end;
      // check if we send the ^Char subset
      if (AEvent^.Length = 1) and (EventString <> nil)
      then begin
        Result := (EventString^ > #0) and (EventString^ < ' ');
      end;
      Exit;
    end;
    Result := (AEvent^.Length > 0) or (GetSpecialChar <> #0);
  end;

  function KeyAlreadyHandledByGtk: boolean;
  begin
    Result := false;
    if AWidget = nil then exit;

    if GtkWidgetIsA(AWidget, gtk_entry_get_type)
    then begin
      // the gtk_entry handles the following keys
      case Aevent^.keyval of
        GDK_Key_Return,
        GDK_Key_Escape,
        GDK_Key_Tab: Exit;
      end;

      Result := AEvent^.length > 0;
      if Result then Exit;

      case AEvent^.keyval of
        GDK_Key_BackSpace,
        GDK_Key_Clear,
        GDK_Key_Insert,
        GDK_Key_Delete,
        GDK_Key_Home,
        GDK_Key_End,
        GDK_Key_Left,
        GDK_Key_Right,
        $20..$FF: Result := True;
      end;
      exit;
    end;

    if GtkWidgetIsA(AWidget, gtk_text_get_type)
    then begin
      // the gtk_text handles the following keys
      case AEvent^.keyval of
        GDK_Key_Escape: Exit;
      end;

      Result := AEvent^.length > 0;
      if Result then Exit;

      case AEvent^.keyval of
        GDK_Key_Return,
        GDK_Key_Tab,
        GDK_Key_BackSpace,
        GDK_Key_Clear,
        GDK_Key_Insert,
        GDK_Key_Delete,
        GDK_Key_Home,
        GDK_Key_End,
        GDK_Key_Left,
        GDK_Key_Right,
        GDK_Key_Up,
        GDK_Key_Down,
        $20..$FF: Result := True;
      end;
      exit;
    end;
  end;

  procedure CharToKeyVal(C: Char; out KeyVal: guint; out Length: gint);
  begin
    Length := 1;
    {$ifndef gtk1}
    if C in [#$01..#$1B] then
    begin
      KeyVal := $FF00 or Ord(C);
      if KeyVal = GDK_KEY_BackSpace then
        Length := 0;
    end
    else
    {$endif}
      KeyVal := Ord(C);
  end;

  function KeyActivatedAccelerator: boolean;

    function CheckMenuChilds(AMenuItem: TMenuItem): boolean;
    var
      i: Integer;
      Item: TMenuItem;
      MenuItemWidget: PGtkWidget;
    begin
      Result:=false;
      if (AMenuItem=nil) or (not AMenuItem.HandleAllocated) then exit;
      for i:=0 to AMenuItem.Count-1 do begin
        Item:=AMenuItem[i];
        if not Item.HandleAllocated then continue;
        if not GTK_WIDGET_SENSITIVE(PGTKWidget(Item.Handle)) then continue;
        if IsAccel(Msg.CharCode,Item.Caption) then begin
          // found
          Result:=true;
          MenuItemWidget:=PGTKWidget(Item.Handle);
          if GtkWidgetIsA(MenuItemWidget,gtk_menu_item_get_type) then begin
            //DebugLn(['CheckMenuChilds popup: ',dbgsName(Item)]);
            // popup the submenu
            gtk_signal_emit_by_name(PGtkObject(MenuItemWidget),'activate-item');
          end;
          exit;
        end;
      end;
    end;

  var
    AComponent: TComponent;
    AControl: TControl;
    AForm: TCustomForm;
  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]) then begin
      if (TObject(TargetObj) is TComponent) then begin
        AComponent:=TComponent(TargetObj);
        //DebugLn(['KeyActivatedAccelerator ',dbgsName(AComponent)]);
        if AComponent is TControl then begin
          AControl:=TControl(AComponent);
          repeat
            AForm:=GetFirstParentForm(AControl);
            if AForm<>nil then begin
              if AForm.Menu<>nil then begin
                Result:=CheckMenuChilds(AForm.Menu.Items);
                if Result then exit;
              end;
            end;
            AControl:=AForm.Parent;
          until AControl=nil;

          {$IFDEF Gtk2}
          // check main menu of MainForm
          if (Application.MainForm<>nil) then begin
            AControl:=TControl(AComponent);
            AForm:=GetParentForm(AControl);
            if (AForm<>nil)
            and (not (fsModal in AForm.FormState))
            and (not Application.MainForm.IsParentOf(AControl))
            and (Application.MainForm.Menu<>nil) then begin
              Result:=CheckMenuChilds(Application.MainForm.Menu.Items);
              if Result then exit;
            end;
          end;
          {$ENDIF}
        end;
      end;
    end;
  end;

  procedure EmulateEatenKeys;
  begin
    // some widgets eats keys, but do not do anything useful for the LCL
    // emulate the keys
    if not ABeforeEvent then Exit;
    if EventStopped then Exit;

    //DebugLn(['EmulateEatenKeys TargetWidget=',dbghex(PtrInt(TargetWidget))]);
    //DebugLn(['EmulateEatenKeys ',GetWidgetDebugReport(TargetWidget),' gdk_event_get_type(AEvent)=',gdk_event_get_type(AEvent),' GDK_KEY_PRESS=',GDK_KEY_PRESS,' 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(AEvent) = GDK_KEY_PRESS)
    and (VKey=13)
    then begin
      //DebugLn(['EmulateKeysEatenByGtk ']);
      FillChar(Msg, SizeOf(Msg), 0);
      Msg.CharCode := 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(TControl(TargetObj), Msg.Msg);
      DeliverKeyMessage(TargetObj, Msg);
    end;
    {$ENDIF}
  end;

  procedure CheckDeadKey;
  begin
    if ABeforeEvent then begin
      {$IFDEF Gtk2}
      if im_context_widget<>TargetWidget then begin
        //DebugLn(['CheckDeadKey init im_context ',GetWidgetDebugReport(TargetWidget)]);
        ResetDefaultIMContext;
        im_context_widget:=TargetWidget;
        gtk_im_context_set_client_window(im_context,GetControlWindow(TargetWidget));
        //DebugLn(['CheckDeadKey im_context initialized']);
      end;
      // Note: gtk_im_context_filter_keypress understands keypress and keyrelease
      gtk_im_context_filter_keypress (im_context, AEvent);
      //DebugLn(['CheckDeadKey DeadKey=',DeadKey,' str="',im_context_string,'"']);
      {$ENDIF}
    end;
  end;

begin
  Result := CallBackDefaultReturn;

  EventStopped := False;
  HandledByLCL := KeyEventWasHandledByLCL(AEvent, ABeforeEvent);

  {$IFDEF VerboseKeyboard}
  DebugLn(['[HandleGTKKeyUpDown] ',DbgSName(TControl(AData)),
    ' ',(AEvent^.{$IFDEF GTK1}theType{$ELSE}_Type{$ENDIF}),' Widget=',GetWidgetClassName(AWidget),
    ' Before=',ABeforeEvent,' Down=',AHandleDown,' HandledByLCL=',HandledByLCL]);
  {$ENDIF}

  // handle every key event only once
  if HandledByLCL then Exit;

  TargetWidget := AWidget;
  TargetObj := AData;
  FocusedWinControl := nil;
  FocusedWidget := 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(AWidget, gtk_window_get_type)
  then begin
    FocusedWidget := PGtkWindow(AWidget)^.focus_widget;
    if FocusedWidget <> nil
    then begin
      LCLObject := GetNearestLCLObject(FocusedWidget);
      if LCLObject is TWinControl
      then begin
        FocusedWinControl := TWinControl(LCLObject);
        if FocusedWidget <> AWidget
        then begin
          {$IFDEF VerboseKeyboard}
          DebugLn('[HandleGTKKeyUpDown] REDIRECTING ',
            ' FocusedWidget=',GetWidgetClassName(FocusedWidget),
            ' Control=',FocusedWinControl.Name,':',FocusedWinControl.ClassName);
          {$ENDIF}
          // redirect key to lcl control
          TargetWidget := FocusedWidget;
          TargetObj := FocusedWinControl;
        end;
      end;
    end;
  end;

  // remember this event
  RememberKeyEventWasHandledByLCL(AEvent, ABeforeEvent);

  if TargetWidget = nil then Exit;

  //DebugLn(['HandleGTKKeyUpDown TargetWidget=',GetWidgetDebugReport(TargetWidget)]);


  //DebugLn(['HandleGTKKeyUpDown TargetWidget=',GetWidgetDebugReport(TargetWidget),' ',DbgStr(EventString),' state=',AEvent^.state,' keyval=',AEvent^.keyval]);
  FillChar(Msg, SizeOf(Msg), 0);

  gdk_event_key_get_string(AEvent, EventString);
  //DebugLn(['HandleGTKKeyUpDown TargetWidget=',GetWidgetDebugReport(TargetWidget),' ',DbgStr(EventString),' state=',AEvent^.state,' keyval=',AEvent^.keyval]);
  CheckDeadKey;
  Flags := 0;
  SysKey := False;
  ShiftState := GTKEventStateToShiftState(AEvent^.state);
  {$ifdef gtk1}
    KeyCode := XKeysymToKeycode(gdk_display, AEvent^.keyval);
  {$else}
    KeyCode := AEvent^.hardware_keycode;
  {$endif}

  if (KeyCode = 0)
  or (KeyCode > High(MKeyCodeInfo))
  or (MKeyCodeInfo[KeyCode].VKey1 = 0)
  then begin
    // no VKey defined, maybe composed char ?
    CommonKeyData := 0;
  end
  else begin
    KCInfo := MKeyCodeInfo[KeyCode];

    if (KCInfo.Flags and KCINFO_FLAG_SHIFT_XOR_NUM <> 0)
    and ((ssShift in ShiftState) xor (ssNum in ShiftState))
    then VKey := KCInfo.VKey2
    else VKey := KCInfo.VKey1;

    if (KCInfo.Flags and KCINFO_FLAG_EXT) <> 0
    then Flags := KF_EXTENDED;


    // ssAlt + a key pressed is always a syskey
    // ssAltGr + a key is only a syskey when the key pressed has no levelshift or when ssHift is pressed to0
    SysKey := (ssAlt in ShiftState);
    if not SysKey
    then begin
      // Check ssAltGr
      if (KCInfo.Flags and KCINFO_FLAG_ALTGR) = 0
      then begin
        // VKey has no levelshift char so AltGr is syskey
        SysKey := ssAltGr in ShiftState;
      end
      else begin
        // VKey has levelshift char so AltGr + Shift is syskey
        SysKey := ShiftState * [ssShift, ssAltGr] = [ssShift, ssAltGr]
      end;
    end;
    if SysKey
    then Flags := Flags or KF_ALTDOWN;

    CommonKeyData := KeyCode shl 16; // Not really scancode, but will do

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

      Msg.CharCode := VKey;
      Msg.Msg := KEYDOWN_MAP[SysKey, ABeforeEvent];

      // 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(TControl(TargetObj), Msg.Msg);
        if DeliverKeyMessage(TargetObj, Msg)
        and (Msg.CharCode <> Vkey) then
          StopKeyEvent;
      end;

      if (not EventStopped) and ABeforeEvent
      then begin
        if KeyActivatedAccelerator then exit;
      end;
    end
    else begin
      {$IFDEF VerboseKeyboard}
      DebugLn('[HandleGTKKeyUpDown] GDK_KEY_RELEASE VKey=',dbgs(VKey));
      {$ENDIF}

      Msg.CharCode := VKey;
      Msg.Msg := KEYUP_MAP[SysKey, ABeforeEvent];
      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(TControl(TargetObj), Msg.Msg);

      if DeliverKeyMessage(TargetObj, Msg)
      and (Msg.CharCode <> VKey)
      then begin
        // key was handled by LCL
        StopKeyEvent;
      end;
    end;
  end;

  // send keypresses
  if not EventStopped and AHandleDown then begin

    // send the UTF8 keypress
    if ABeforeEvent then begin
      // try to get the UTF8 representation of the key
      {$IFDEF GTK1}
        Character := '';
        if (AEvent^.length > 0) and (AEvent^.length <= 8) //max composed UTF8 char has lenght 8
        then begin
          SetLength(Character, AEvent^.length);
          System.Move(AEvent^.thestring^, Character[1], length(Character));
        end;
      {$ELSE GTK2}
        if im_context_string <> '' then
        begin
          Character := UTF8Copy(im_context_string,1,1);
          im_context_string:='';// clear, to avoid sending again
        end
        else
        begin
          KeyPressesChar := GetSpecialChar;
          if KeyPressesChar <> #0 then
            Character := KeyPressesChar
          else
            Character := '';
        end;
      {$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
          // send the key after navigation keys were handled
          Result := TWinControl(LCLObject).IntfUTF8KeyPress(Character, 1, SysKey);
          if Result or (Character = '')
          then StopKeyEvent
          else if (Length(Character) = 1)
          {$IFDEF Gtk1}
          // GTK1 only supports normal ASCII characters (Note: #127 is delete)
          and (Character[1] in [#32..#126])
          {$ENDIF}
          then begin
            CharToKeyVal(Character[1], AEvent^.KeyVal, AEvent^.length);
            if AEvent^.length = 1 then
            begin
              EventString^ := Character[1];
              EventString[1] := #0;
            end
            else
              EventString^ := #0;
          end;
        end;
      end;
    end;

    //  send a normal KeyPress Event for Delphi compatibility
    if not EventStopped and CanSendChar
    then begin
      {$IFDEF EventTrace}
      EventTrace('char', data);
      {$ENDIF}

      KeyPressesChar := #0;
      if AEvent^.Length = 1
      then begin
        // ASCII key was pressed
        KeyPressesChar := EventString^;
      end
      else
        KeyPressesChar := GetSpecialChar;

      if KeyPressesChar <> #0
      then begin
        FillChar(Msg, SizeOf(Msg), 0);

        Msg.KeyData := CommonKeyData;
        Msg.Msg := CHAR_MAP[SysKey, ABeforeEvent];

        // send the (Sys)Char message directly (not queued) to the LCL
        Msg.Result:=0;
        Msg.CharCode := Ord(KeyPressesChar);
        if DeliverKeyMessage(TargetObj, Msg)
        and (Ord(KeyPressesChar) <> Msg.CharCode)
        then begin
          // key was changed by lcl
          if (Msg.CharCode=0) or (Msg.CharCode>=128)
          then begin
            // key set to invalid => just stop
            StopKeyEvent;
          end
          else begin
            // try to change the key
            CharToKeyVal(chr(Msg.CharCode), AEvent^.KeyVal, AEvent^.length);
            if AEvent^.length = 1 then
            begin
              EventString^ := Character[1];
              EventString[1] := #0;
            end
            else
              EventString^ := #0;
            gdk_event_key_set_string(AEvent, EventString);
          end;
        end;
      end;
    end;
  end;

  EmulateEatenKeys;

  {$IFDEF Gtk1}
  Result:=true;
  {$ELSE}
  Result:=EventStopped;
  {$ENDIF}
end;

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

  Initializes the CharToVK and CKeyToVK tables
 ------------------------------------------------------------------------------}
procedure InitKeyboardTables;

  procedure FindVKeyInfo(const AKeySym: Cardinal; var AVKey: Byte;
    var AExtended, AHasMultiVK, ASecondKey: Boolean);
  var
    ByteKey: Byte;
  begin
    AExtended := False;
    AHasMultiVK := False;
    AVKey := VK_UNDEFINED;
    ASecondKey := False;

    case AKeySym of
      32..255: begin
        ByteKey:=Byte(AKeySym);
        case Chr(ByteKey) of // Normal ASCII chars
          //only unshifted values are checked
          //'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: 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_DELETE:
      begin
        AExtended := True;
        AVKey := VK_DELETE;
      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
        // not on "normal" keyboard so defined extended to differentiate between normal Fn
        AExtended := True;
        AVKey := VK_F1 + AKeySym - GDK_KEY_KP_F1;
      end;
      GDK_KEY_KP_TAB:
      begin
        // not on "normal" keyboard so defined extended to differentiate between normal TAB
        AExtended := True;
        AVKey := VK_TAB;
      end;
      GDK_KEY_KP_Multiply:
      begin
        AVKey := VK_MULTIPLY;
      end;
      GDK_KEY_KP_Add:
      begin
        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
        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_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:
      begin
        AVKey := VK_SHIFT;
        ASecondKey := True;
      end;
      GDK_Key_Control_L:    AVKey := VK_CONTROL;
      GDK_Key_Control_R:
      begin
        AVKey := VK_CONTROL;
        ASecondKey := True;
      end;
  //      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:
      begin
        AVKey := VK_MENU;
        ASecondKey := True;
      end;
      GDK_Key_Super_L:      AVKey := VK_LWIN;
      GDK_Key_Super_R: begin
        AVKey := VK_RWIN;
        ASecondKey := True;
      end;
      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: Cardinal): 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
        {$ifndef HideKeyTableWarnings}
        DebugLn('[WARNING] Out of OEM specific VK codes, changing to unassigned');
        {$endif}
        AFreeVK := $88;
      end;
      $8F: AFreeVK := $97;
      $9F: AFreeVK := $D8;
      $DA: AFreeVK := $E5;
      $E5: AFreeVK := $E8;
      $E8: begin
        {$ifndef HideKeyTableWarnings}
        DebugLn('[WARNING] Out of unassigned VK codes, assigning $FF');
        {$endif}
        AFreeVK := $FF;
      end;
      $FF: AFreeVK := $FF; // stay there
    else
      Inc(AFreeVK);
    end;
  end;


const
  KEYFLAGS: array[0..3] of Byte = (
    $00,
    KCINFO_FLAG_SHIFT,
    KCINFO_FLAG_ALTGR,
    KCINFO_FLAG_ALTGR or KCINFO_FLAG_SHIFT
  );
  EXTFLAG: array[Boolean] of Byte = (
    $00,
    KCINFO_FLAG_EXT
  );
  MULTIFLAG: array[Boolean] of Byte = (
    $00,
    KCINFO_FLAG_SHIFT_XOR_NUM
  );

{$ifdef HasX}
{
 Starting gdk 2.10 Alt, meta, hyper are reported by a own mask. Since we support
 older versions, we need to create the modifiermap ourselves for X and we cannot
 ise them
}
type
  TModMap = array[Byte] of Cardinal;

  procedure SetupModifiers(ADisplay: Pointer; var AModMap: TModMap);
  const
    MODIFIERS: array[0..7] of Cardinal = (
      GDK_SHIFT_MASK,
      GDK_LOCK_MASK,
      GDK_CONTROL_MASK,
      GDK_MOD1_MASK,
      GDK_MOD2_MASK,
      GDK_MOD3_MASK,
      GDK_MOD4_MASK,
      GDK_MOD5_MASK
    );
  var
    Map: PXModifierKeymap;
    KeyCode: PKeyCode;
    Modifier, n: Integer;
  begin
    FillByte(AModMap, SizeOf(AModMap), 0);

    Map := XGetModifierMapping(ADisplay);
    KeyCode := Map^.modifiermap;

    for Modifier := Low(MODIFIERS) to High(MODIFIERS) do
    begin
      for n := 1 to Map^.max_keypermod do
      begin
        if KeyCode^ <> 0
        then begin
          AModMap[KeyCode^] := MODIFIERS[Modifier];
          {$ifdef VerboseModifiermap}
          DebugLn('Mapped keycode=%u to modifier=$%2.2x', [KeyCode^, MODIFIERS[Modifier]]);
          {$endif}
        end;
        Inc(KeyCode);
      end;
    end;

    XFreeModifiermap(Map);
  end;

  procedure UpdateModifierMap(const AModMap: TModMap; AKeyCode: Byte; AKeySym: Cardinal);
  var
  {$ifdef VerboseModifiermap}
    s: string;
  {$endif}
    ShiftState: TShiftStateEnum;
  begin
    if AModMap[AKeyCode] = 0 then Exit;

    case AKeySym of
      GDK_KEY_Caps_Lock,
      GDK_KEY_Shift_Lock: ShiftState := ssCaps;
      GDK_KEY_Num_Lock: ShiftState := ssNum;
      GDK_KEY_Scroll_Lock: ShiftState := ssScroll;
      GDK_Key_Shift_L,
      GDK_Key_Shift_R: ShiftState := ssShift;
      GDK_KEY_Control_L,
      GDK_KEY_Control_R: ShiftState := ssCtrl;
      {$ifndef UseOwnShiftState}
      // UseOwnShiftState will track these, so we don't have to put them in the modmap
      GDK_KEY_Meta_L,
      GDK_KEY_Meta_R: ShiftState := ssMeta;
      GDK_KEY_Alt_L,
      GDK_KEY_Alt_R: ShiftState := ssAlt;
      GDK_KEY_Super_L,
      GDK_KEY_Super_R: ShiftState := ssSuper;
      GDK_KEY_Hyper_L,
      GDK_KEY_Hyper_R: ShiftState := ssHyper;
      GDK_KEY_ISO_Level3_Shift{,
      GDK_KEY_Mode_switch}: ShiftState := ssAltGr;
      {$endif}
    else
      Exit;
    end;

    MModifiers[ShiftState].Mask := AModMap[AKeyCode];
    MModifiers[ShiftState].UseValue := False;

    {$ifdef VerboseModifiermap}
    WriteStr(s, ShiftState);
    DebugLn('Mapped keycode=%u, keysym=$%x, modifier=$%2.2x to shiftstate %s',
            [AKeyCode, AKeySym, AModMap[AKeyCode], s]);
    {$endif}

  end;

  {$ifdef UseOwnShiftState}
  procedure UpdateKeyStateMap(var AIndex: integer; AKeyCode: Byte; AKeySym: Cardinal);
  var
    Enum: TShiftStateEnum;
  begin
    case AKeySym of
      GDK_KEY_Alt_L, GDK_KEY_Alt_R:     Enum := ssAlt;
      GDK_KEY_Meta_L, GDK_KEY_Meta_R:   Enum := ssMeta;
      GDK_KEY_Super_L, GDK_KEY_Super_R: Enum := ssSuper;
      GDK_KEY_Hyper_L, GDK_KEY_Hyper_R: Enum := ssHyper;
      GDK_KEY_ISO_Level3_Shift:         Enum := ssAltGr;
    else
      Exit;
    end;

    if High(MKeyStateMap) < AIndex
    then SetLength(MKeyStateMap, AIndex + 8);

    MKeyStateMap[AIndex].Index := AKeyCode shr 3;
    MKeyStateMap[AIndex].Mask := 1 shl (AKeyCode and 7);
    MKeyStateMap[AIndex].Enum := Enum;
    Inc(AIndex)
  end;
  {$endif UseOwnShiftState}

{$endif HasX}

const
  // first OEM specific VK
  VK_FIRST_OEM = $92;

var
{$ifdef gtk1}
  XKeyEvent: TXKeyEvent;
  KeySymStart, KeySymNext: PKeySym;
  UpKeySym, LoKeySym: TKeySym;
  KeySyms: array of TKeySym;
{$else}
  KeySyms: array of guint;
  KeyVals: Pguint;
  KeymapKeys: PGdkKeymapKey;
  UniChar: gunichar;
{$endif}
  KeySymCount: Integer;
  KeySymChars: array[0..16] of Char;
  KeySymCharLen: Integer;

{$ifdef HasX}
  XDisplay: Pointer;
  ModMap: TModMap;
{$endif}
{$ifdef UseOwnShiftState}
  KeyStateMapIndex: Integer;
{$endif}

  KeyCode: Byte;
  m: Integer;
  LoKey, HiKey: Integer;

  VKey, FreeVK: Byte;
  HasMultiVK, DummyBool, Extended, SecondKey, HasKey, ComputeVK: Boolean;
begin
{$ifdef HasX}
  XDisplay := gdk_display;
  if XDisplay = nil then Exit;

  FillByte(MKeyStateMap, SizeOF(MKeyStateMap), 0);
  SetupModifiers(XDisplay, ModMap);
{$endif}

{$ifdef gtk1}
  // Init dummy XEvent to retrieve the char corresponding to a key
  FillChar(XKeyEvent, SizeOf(XKeyEvent), 0);
  XKeyEvent._Type := GDK_KEY_PRESS;
  XKeyEvent.Display := XDisplay;
  XKeyEvent.Same_Screen := 1;

  // Retrieve the KeyCode bounds
  XDisplayKeyCodes(XDisplay, @LoKey, @HiKey);
  if LoKey < 0
  then begin
    DebugLn('[WARNING] Low keycode (%d) negative, adjusting to 0', [LoKey]);
    LoKey := 0;
  end;
  if HiKey > 255
  then begin
    DebugLn('[WARNING] High keycode (%d) larget than 255, adjusting to 255', [HiKey]);
    HiKey := 255;
  end;

  KeySymCount := 0;
  KeySymStart := XGetKeyboardMapping(XDisplay, LoKey, HiKey - LoKey + 1, @KeySymCount);
  KeySymNext := KeySymStart;

  if (KeySymCount = 0) or (KeySymStart = nil)
  then begin
    DebugLn('[WARNING] failed to retrieve keyboardmapping');
    if KeySymStart <> nil
    then XFree(KeySymStart);
    Exit;
  end;
  if KeySymCount > Length(MVKeyInfo[0].KeySym)
  then DebugLn('[WARNING] keysymcount=%u larger than expected=%u', [KeySymCount, Length(MVKeyInfo[0].KeySym)]);
  SetLength(KeySyms, KeySymCount);
{$else gtk1}
  LoKey := 0;
  HiKey := 255;
{$endif}

{$ifdef UseOwnShiftState}
  KeyStateMapIndex := 0;
{$endif}
  FreeVK := VK_FIRST_OEM;
  for KeyCode := LoKey to HiKey do
  begin
  {$ifdef gtk1}
    Move(KeySymNext^, KeySyms[0], SizeOf(KeySyms[0]) * KeySymCount);
    Inc(KeySymNext, KeySymCount);

    HasKey := False;
    m := 0;
    while m < KeySymCount do
    begin
      // there might be only uppercase chars are in the map,
      // so we have to add the lowercase ourselves
      // when a group consists of one char(next =0)
      if KeySyms[m] <> 0
      then begin
        HasKey := True;
        if KeySyms[m+1] = 0
        then begin
          XConvertCase(KeySyms[m], @LoKeySym, @UpKeySym);
          if LoKeySym <> UpKeySym
          then begin
            KeySyms[m] := LoKeySym;
            KeySyms[m+1] := UpKeySym;
          end;
        end;
      end;
      Inc(m, 2);
    end;

  {$else}
    if not gdk_keymap_get_entries_for_keycode(nil, KeyCode, KeymapKeys, KeyVals, @KeySymCount) then Continue;
    SetLength(KeySyms, KeySymCount);
    Move(KeyVals^, KeySyms[0], SizeOf(KeySyms[0]) * KeySymCount);
    g_free(KeymapKeys); // unused but we cannot pass a nil as param
    g_free(KeyVals);
    HasKey := KeySyms[0] <> 0;
    //DebugLn(['InitKeyboardTables ',KeyCode,' ',HasKey,' ',KeySyms[0]]);
  {$endif}

  {$ifdef HasX}
    // Check if this keycode is in the modifiers map
    // loop through all keysyms till one found.
    // Some maps have a modifier with an undefined first keysym. It is checked for
    // modifiers, but not for vkeys
    for m := 0 to KeySymCount - 1 do
    begin
      if KeySyms[m] = 0 then Continue;
      UpdateModifierMap(ModMap, KeyCode, KeySyms[m]);
      {$ifdef UseOwnShiftState}
      UpdateKeyStateMap(KeyStateMapIndex, KeyCode, KeySyms[m]);
      {$endif}
      Break;
    end;
  {$endif}

    // Continue if there is no keysym found
    if not HasKey then Continue;

    // Start looking for a VKcode
    VKey := VK_UNDEFINED;
    for m := 0 to KeySymCount - 1 do
    begin
      if KeySyms[m] = 0 then Continue;
      FindVKeyInfo(KeySyms[m], VKey, Extended, HasMultiVK, SecondKey);
    {$ifdef Windows}
      // on windows, the keycode is perdef the VK,
      // we only enter this loop to set the correct flags
      VKey := KeyCode;
      Break;
    {$else}
      if HasMultiVK then Break; // has VK per def
      if VKey = VK_UNDEFINED then Continue;
      if MVKeyInfo[VKey].KeyCode[SecondKey or Extended] = 0 then Break; // found unused VK

      // already in use
      VKey := VK_UNDEFINED;
    {$endif}
    end;

    ComputeVK := VKey = VK_UNDEFINED;
    if ComputeVK and not HasMultiVK
    then begin
      VKey := FreeVK;
      NextFreeVK(FreeVK);
    end;

    if VKey = VK_UNDEFINED
    then begin
      MKeyCodeInfo[KeyCode].Flags := $FF
    end
    else begin
      MKeyCodeInfo[KeyCode].Flags := EXTFLAG[Extended] or MULTIFLAG[HasMultiVK];
      MVKeyInfo[VKey].KeyCode[SecondKey] := KeyCode;
    end;
    MKeyCodeInfo[KeyCode].VKey1 := VKey;

    for m := 0 to Min(High(MVKeyInfo[0].KeyChar), KeySymCount - 1) do
    begin
      if KeySyms[m] = 0 then Continue;
      if (m >= 2) and (KeySyms[m] = KeySyms[m - 2]) then Continue;

      if HasMultiVK
      then begin
        if m >= 2 then Break; // Only process shift

        // The keypadkeys have 2 VK_keycodes :(
        // In that case we have to FIndKeyInfo for every keysym
        if m = 1
        then begin
          FindVKeyInfo(KeySyms[m], VKey, Extended, DummyBool, DummyBool);
          MKeyCodeInfo[KeyCode].VKey2 := VKey;
        end;
      end;
      if VKey = VK_UNDEFINED then Continue;

      MKeyCodeInfo[KeyCode].Flags := MKeyCodeInfo[KeyCode].Flags or KEYFLAGS[m];

      FillByte(KeySymChars, SizeOf(KeySymChars), 0);
    {$ifdef gtk1}
      // Retrieve the chars for this KeySym
      XKeyEvent.KeyCode := KeyCode;
      case m of
        0: XKeyEvent.State := 0;
        1: XKeyEvent.State := MModifiers[ssShift].Mask;
        2: XKeyEvent.State := MModifiers[ssAltGr].Mask;
        3: XKeyEvent.State := MModifiers[ssAltGr].Mask or MModifiers[ssShift].Mask;
      else
        // TODO: m > 3 ??
        Continue;
      end;

      KeySymCharLen := XLookupString(@XKeyEvent, KeySymChars, SizeOf(KeySymChars), nil, nil);
      if (KeySymCharLen > 0) and (KeySymChars[KeySymCharLen - 1] = #0)
      then Dec(KeySymCharLen);
      if (KeySymCharLen <= 0) then Continue;
    {$else gtk1}
      UniChar := gdk_keyval_to_unicode(KeySyms[m]);
      if UniChar = 0 then Continue;
      KeySymCharLen := g_unichar_to_utf8(UniChar, @KeySymChars[0]);
    {$endif}
      if (KeySymCharLen > SizeOf(TVKeyUTF8Char))
      then DebugLn('[WARNING] InitKeyboardTables - Keysymstring for keycode=%u longer than %u bytes: %s', [KeyCode, SizeOf(TVKeyUTF8Char), KeySymChars]);
      Move(KeySymChars[0], MVKeyInfo[VKey].KeyChar[m], SizeOf(TVKeyUTF8Char));
    end;
  end;
{$ifdef UseOwnShiftState}
  SetLength(MKeyStateMap, KeyStateMapIndex);
{$endif}

{$ifdef gtk1}
  XFree(KeySymStart);
{$endif}
end;

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

  Frees the dynamic keyboard tables
 ------------------------------------------------------------------------------}
procedure DoneKeyboardTables;
var
  i: Integer;
begin
  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:  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;

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

  GTKEventStateToShiftState converts a GTK event state to a LCL/Delphi TShiftState
 ------------------------------------------------------------------------------}
function GTKEventStateToShiftState(KeyState: Word): TShiftState;
  {$ifdef HasX}
  function GetState: TShiftState;
  var
    Keys: chararr32;
    n: Integer;
  begin
    Result := [];
    keys:='';
    XQueryKeyMap(gdk_display, Keys);
    for n := Low(MKeyStateMap) to High(MKeyStateMap) do
    begin
      if Ord(Keys[MKeyStateMap[n].Index]) and MKeyStateMap[n].Mask = 0 then Continue;
      Include(Result, MKeyStateMap[n].Enum);
      Break;
    end;
  end;
  {$else}
  {$ifdef windows}
  function GetState: TShiftState;
  begin
    Result := [];
    if GetKeyState(VK_MENU) < 0 then Include(Result, ssAlt);
    if (GetKeyState(VK_LWIN) < 0) or (GetKeyState(VK_RWIN) < 0) then Include(Result, ssMeta);
  end;
  {$else}
  function GetState: TShiftState;
  begin
    Result := [];
  end;
  {$endif}
  {$endif}

var
  State: TShiftStateEnum;
begin
  {$ifdef UseOwnShiftState}
  Result := GetState;
  {$else}
  Result := [];
  {$endif}
  for State := Low(State) to High(State) do
  begin
    if MModifiers[State].Mask = 0 then Continue;
    if MModifiers[State].UseValue
    then begin
      if KeyState and MModifiers[State].Mask = MModifiers[State].Value
      then Include(Result, State);
    end
    else begin
      if KeyState and MModifiers[State].Mask <> 0
      then Include(Result, State);
    end;
  end;
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: TFileSelFilterEntry;
  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
        TObject(FilterList[i]).Free;
      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;
    //DebugLn(['AddList ',StrList.Text]);
    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 := '';
  //DebugLn(['PopulateFileAndDirectoryLists ',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 FindFirstUTF8(AppendPathDelim(Dir)+GetAllFilesMask, faAnyFile and faDirectory,
    Info) = 0
  then begin
    repeat
      if ((Info.Attr and faDirectory) = faDirectory) and (Info.Name <> '.')
      and (Info.Name <> '..') and (Info.Name<>'') then
        StrList.Add(AppendPathDelim(Info.Name));
    until FindNextUTF8(Info) <> 0;
  end;
  FindCloseUTF8(Info);
  AddList(Dirs);
  // add required files
  StrList.Clear;
  CurFileMask:=Mask;
  if CurFileMask='' then CurFileMask:=GetAllFilesMask;
  if FindFirstUTF8(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(MatchesMaskList(Info.Name,CurFileMask)));
        if (CurFileMask='') or (MatchesMaskList(Info.Name,CurFileMask)) then
        begin
          Strlist.Add(Info.Name);
        end;
      end;
    until FindNextUTF8(Info) <> 0;
  end;
  FindCloseUTF8(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 (TLMessage(AMessage).Msg = LM_PAINT) or
     (TLMessage(AMessage).Msg = LM_GTKPAINT) then
    CurrentSentPaintMessageTarget := TObject(Target);

  Result := LCLMessageGlue.DeliverMessage(TObject(Target), AMessage);

  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
    //DebugLn(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');
  {$IFDEF Gtk2}
  if PGtkWidget(ParentWidget)^.parent=ChildWidget
  then raise EInterfaceException.Create('SetMainWidget Parent^.Parent=ChildWidget');
  {$ENDIF}

  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;
end;

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;
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(WithWindow: Boolean = True): PGTKWidget;
begin
  Result := gtk_fixed_new();
  {$IFDEF GTK2}
  if WithWindow then
    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 begin
    // parent is layout
    gtk_Layout_move(PGtkLayout(Parent), Child, Left, Top)
  end 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 begin
    // parent is invalid
    DebugLn('[FixedMoveControl] WARNING: Invalid Fixed Widget');
  end;
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
  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;
    {$IFDEF Gtk2}
    if (Result=nil) and (GTK_WIDGET_NO_WINDOW(Widget)) then
      Result:=gtk_widget_get_parent_window(Widget);
    {$ENDIF}
  end else
    RaiseGDBException('GetControlWindow Widget=nil');
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);
    Result^.DefaultCursor := HCursor(-1);
  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 := PtrUInt(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;
  //DebugLn(['FreeWidgetInfo ',GetWidgetDebugReport(AWidget)]);
  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; // see below the whole memory is cleared by Fillchar
  end;
  gtk_object_set_data(AWidget,'widgetinfo',nil);

  // Set WidgetInfo memory to nil. This will expose bugs that use widgetinfo after
  // it has been freed and is still referenced by something!
  FillChar(Info^, SizeOf(TWidgetInfo), 0);

  Dispose(Info);
  //DebugLn(['FreeWidgetInfo END']);
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 dangling
    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
  //DebugLn(['DestroyWidget A ',GetWidgetDebugReport(Widget)]);
  {$IFDEF DebugLCLComponents}
  if DebugGtkWidgets.FindInfo(Widget)=nil then
    DebugLn(['DestroyWidget ',GetWidgetDebugReport(Widget)]);
  {$ENDIF}
  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);
  //DebugLn(['DestroyWidget B']);
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 TCustomTabControl(ANoteBook).HandleAllocated then exit;
  NoteBookWidget := PGtkNotebook(TCustomTabControl(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;

{$IFDef GTK1}
var
  NoteBookCloseBtnPixmapImg: PGdkPixmap = nil;
  NoteBookCloseBtnPixmapMask: PGdkPixmap = 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 TCustomTabControl(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;
{$EndIF}

{-------------------------------------------------------------------------------
  method UpdateNotebookPageTab
  Params: ANoteBook: TCustomTabControl; 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: TCustomTabControl;
  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;
    ImageIndex: Integer;
  begin
    HasIcon:=false;
    IconSize:=Point(0,0);
    ImageIndex := TheNoteBook.GetImageIndex(ThePage.PageIndex);
    if (TheNoteBook.Images<>nil)
    and (ImageIndex >= 0)
    and (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
    ACaption: String;
  begin
    ACaption := ThePage.Caption;
    GTKWidgetSet.SetLabelCaption(PGtkLabel(TabLabelWidget), ACaption);

    if MenuLabelWidget <> nil then
      GTKWidgetSet.SetLabelCaption(PGtkLabel(MenuLabelWidget), ACaption);
  end;

  procedure UpdateTabCloseBtn;
  var
    {$IfDef GTK1}
    Img: PGdkPixmap;
    Mask: PGdkBitmap;
    {$Else}
    style: PGtkRcStyle;
    {$EndIf}
  begin
    {$IfDef GTK1}
    //debugln('UpdateTabCloseBtn ',GetWidgetDebugReport(NoteBookWidget));
    Img:=nil;
    Mask:=nil;
    GetNoteBookCloseBtnImage(GetControlWindow(NoteBookWidget), Img, Mask);
    {$EndIf}
    //debugln('UpdateTabCloseBtn ',dbgs(nboShowCloseButtons in TheNotebook.Options),' ',dbgs(Img<>nil));
    if (nboShowCloseButtons in TheNotebook.Options)
       {$ifdef GTK1}and (Img <> nil){$ENDIF} 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_button_set_relief(PGtkButton(TabCloseBtnWidget), GTK_RELIEF_NONE);
        {$ifdef gtk2}
        gtk_button_set_focus_on_click(PGtkButton(TabCloseBtnWidget), False);
        style := gtk_widget_get_modifier_style(TabCloseBtnWidget);
        style^.xthickness := 0;
        style^.ythickness := 0;
        gtk_widget_modify_style(TabCloseBtnWidget, style);
        {$endif}
        gtk_object_set_data(PGtkObject(TabWidget), 'TabCloseBtn',
                            TabCloseBtnWidget);
        // put a pixmap into the button
       {$IfDef GTK1}
        TabCloseBtnImageWidget:=gtk_pixmap_new(Img,Mask);
       {$Else}
        TabCloseBtnImageWidget:=gtk_image_new_from_stock(GTK_STOCK_CLOSE, GTK_ICON_SIZE_MENU);
       {$EndIf}
        gtk_object_set_data(PGtkObject(TabCloseBtnWidget),'TabCloseBtnImage',
                            TabCloseBtnImageWidget);
        gtk_widget_show(TabCloseBtnImageWidget);
        gtk_container_add(PGtkContainer(TabCloseBtnWidget),
                          TabCloseBtnImageWidget);
        gtk_widget_show(TabCloseBtnWidget);
        g_signal_connect(PGtkObject(TabCloseBtnWidget), 'clicked',
          TGTKSignalFunc(@gtkNoteBookCloseBtnClicked), APage);
        gtk_box_pack_start(PGtkBox(TabWidget), TabCloseBtnWidget, False, False, 0);
      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 := TCustomTabControl(ANoteBook);
  if (APage=nil) or (not ThePage.HandleAllocated) then exit;
  if TheNoteBook=nil then begin
    TheNoteBook:=TCustomTabControl(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;

  {$IFDEF Gtk2}
  procedure GetNoteBookClientOrigin(NBWidget: PGtkNotebook);
  var
    PageIndex: LongInt;
    PageWidget: PGtkWidget;
    ClientWidget: PGTKWidget;
    FrameBorders: TRect;
  begin
    // get current page
    PageIndex:=gtk_notebook_get_current_page(NBWidget);
    if PageIndex>=0 then
      PageWidget:=gtk_notebook_get_nth_page(NBWidget,PageIndex)
    else
      PageWidget:=nil;

    // get client widget of page
    if (PageWidget<>nil) then
      ClientWidget:=GetFixedWidget(PageWidget)
    else
      ClientWidget:=nil;

    // Be careful while using ClientWidget here, it may be nil
    if (ClientWidget<>nil) and (ClientWidget^.window<>nil) then
    begin
      // get the position of the current page
      gdk_window_get_origin(ClientWidget^.window,@Result.X,@Result.Y);
      if GTK_WIDGET_NO_WINDOW(ClientWidget)
      then begin
        Inc(Result.X, ClientWidget^.Allocation.X);
        Inc(Result.Y, ClientWidget^.Allocation.Y);
      end;
    end
    else
    begin
      // use defaults
      Result:=GetWidgetOrigin(TheWidget);
      FrameBorders:=GetStyleNotebookFrameBorders;
      GetWidgetClientOrigin.x:=Result.x+FrameBorders.Left;
      GetWidgetClientOrigin.y:=Result.y+FrameBorders.Top;
    end;
  end;
  {$ENDIF}

var
  ClientWidget: PGtkWidget;
  ClientWindow: PGdkWindow;
begin
  ClientWidget := GetFixedWidget(TheWidget);
  if ClientWidget <> TheWidget then
  begin
    ClientWindow := GetControlWindow(ClientWidget);
    if ClientWindow <> nil then
    begin
      {$IFDEF DebugGDK}
      BeginGDKErrorTrap;
      {$ENDIF}
      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}
      {$IFDEF DebugGDK}
      EndGDKErrorTrap;
      {$ENDIF}
      exit;
    end;
  {$IFDEF Gtk2}
  end
  else
  if GtkWidgetIsA(TheWidget,GTK_TYPE_NOTEBOOK) then
  begin
    GetNoteBookClientOrigin(PGtkNoteBook(TheWidget));
    Exit;
  {$ENDIF}
  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 SubtractScoll(AWidget: PGtkWidget; APosition: TPoint): TPoint;
begin
  Result := APosition;
  AWidget := gtk_object_get_data(PGTKObject(AWidget), odnScrollArea);
  if GTK_IS_SCROLLED_WINDOW(AWidget) then
  begin
    with gtk_scrolled_window_get_hadjustment(PGtkScrolledWindow(AWidget))^ do
      dec(Result.x, Trunc(value - lower));
    with gtk_scrolled_window_get_vadjustment(PGtkScrolledWindow(AWidget))^ do
      dec(Result.y, Trunc(value - lower));
  end;
end;

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

  Sets MouseCaptureWidget 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),' type=',MouseCaptureTypeNames[MouseCaptureType],']',
      ' to [',GetWidgetDebugReport(CurMouseCaptureWidget),' type=GTK]');
    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(PtrUInt(MouseCaptureWidget)), LM_CAPTURECHANGED, 0,
        HWnd(PtrUInt(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_Type) 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) 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;
  Info: PWidgetInfo;
begin
  {$IFDEF VerboseMouseCapture}
  DebugLn('ReleaseMouseCapture ',dbgs(ord(MouseCaptureType)),' MouseCaptureWidget=[',GetWidgetDebugReport(MouseCaptureWidget),']');
  {$ENDIF}
  if MouseCaptureType=mctGTK then
  begin
    Info := GetWidgetInfo(gtk_grab_get_current, false);
    if (Info <> nil) and (Info^.CoreWidget <> nil) then
    begin
      if GtkWidgetIsA(Info^.CoreWidget, gtk_list_get_type) then
      begin
        // Paul Ishenin:
        // listbox grabs pointer and other control for itself, when we click on listbox item
        // also it changes its state to drag_selection
        // this is not expected in LCL and as result cause bugs, such as 7892
        // so we need end drag selection manually
        OldMouseCaptureWidget := Info^.CoreWidget;
        gtk_list_end_drag_selection(PGtkList(OldMouseCaptureWidget));
      end;
    end;
    exit;
  end;
  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: 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 SamePChar(DesignSignalNames[Result],Name)
    and (DesignSignalAfter[Result]=After) then exit;
  Result:=dstUnknown;
end;

function GetDesignSignalMask(Widget: PGtkWidget): TDesignSignalMask;
begin
  Result:=TDesignSignalMask(PtrUInt(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>$ffffff 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 children
      {$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=',GtkWidgetIsA(Widget,GTK_TYPE_MENU)]);
    {$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(nil);
  Result:=GetAccelKey(Widget);
  if Result=nil then begin
    if Key>0 then begin
      New(Result);
      FillChar(Result^,SizeOf(Result),0);
    end;
  end else begin
    if Key=0 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,0,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>0 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>0) 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;
  Shift: TShiftStateEnum;
begin
  { Map the shift states }
  GDKModifier := 0;
  ShortCutToKey(NewShortCut, NewKey, NewModifier);
  for Shift := Low(Shift) to High(Shift) do
  begin
    if Shift in NewModifier
    then GDKModifier := GDKModifier or MModifiers[Shift].Mask;
  end;

  // 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.
-------------------------------------------------------------------------------}
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;

{-------------------------------------------------------------------------------
  method CreatePixbufFromDrawable
  Params: ASource: The source drawable
          AColorMap: The colormap to use, when nil a matching colormap is passed
          AIncludeAplha: If set, the resulting pixmap has an alpha channel
          ASrcX, ASrcY: Offset within the source
          ADstX, ADstY: Offset within destination
          AWidth, AHeight: Size of the new image
  Result: New Pixbuf with refcount = 1

  Replaces the gdk_pixbuf_get_from_drawable function which is buggy on big endian
  X servers when an alpha channel is requested.
-------------------------------------------------------------------------------}
function CreatePixbufFromDrawable(ASource: PGdkDrawable; AColorMap:PGdkColormap; AIncludeAplha: Boolean; ASrcX, ASrcY, ADstX, ADstY, AWidth, AHeight: longint): PGdkPixbuf;
{$ifndef HasX}
const
  CanRequestAlpha: Boolean = True;
var
{$else}
var
  CanRequestAlpha: Boolean;
{$endif}
  PixBuf: PGdkPixBuf;
{$ifdef Windows}
  Image: PGdkImage;
{$endif}
begin
  {$ifdef HasX}
  CanRequestAlpha := BitmapBitOrder(gdk_display) = LSBFirst;
  {$endif}

  // If Source is GdkBitmap then gdk_pixbuf_get_from_drawable will get
  // pixbuf with 2 colors: transparent and white, but we need only Black and White.
  // If we all alpha at the end then problem is gone.
  CanRequestAlpha := CanRequestAlpha and (gdk_drawable_get_depth(ASource) > 1);

  if CanRequestAlpha and AIncludeAplha
  then Pixbuf := gdk_pixbuf_new(GDK_COLORSPACE_RGB, True, 8, AWidth, AHeight)
  else Pixbuf := nil;

  // gtk1 requires always a colormap and fails when none passed
  // gtk2 fails when the colormap depth is different than the drawable depth.
  //      It wil use the correct system map when none passed.
  //      Bitmaps (depth = 1) don't need a colormap
  {$ifdef gtk1}
  if AColormap = nil
  then AColorMap := gdk_colormap_get_system;
  {$else}
  if  (AColorMap = nil)
  and (gdk_drawable_get_depth(ASource) > 1)
  and (gdk_drawable_get_colormap(ASource) = nil)
  then AColorMap := gdk_colormap_get_system;
  {$endif}
  {$ifdef Windows}
  if gdk_drawable_get_depth(ASource) = 1 then
  begin
    // Fix gdk error in converter. For 1 bit Byte order is not significant
    Image := gdk_drawable_get_image(ASource, ASrcX, ASrcY, AWidth, AHeight);
    Image^.byte_order := GDK_MSB_FIRST;
    Result := gdk_pixbuf_get_from_image(Pixbuf, Image, nil, ASrcX, ASrcY, ADstX, ADstY, AWidth, AHeight);
    gdk_image_unref(Image);
  end
  else
  {$endif}
  Result := gdk_pixbuf_get_from_drawable(Pixbuf, ASource, AColorMap, ASrcX, ASrcY, ADstX, ADstY, AWidth, AHeight);
  //DbgDumpPixbuf(Result, '');

  if CanRequestAlpha then Exit; // we're done
  if not AIncludeAplha then Exit;

  pixbuf := gdk_pixbuf_add_alpha(Result, false, guchar(0),guchar(0),guchar(0));
  gdk_pixbuf_unref(Result);
  Result := pixbuf;
end;

{-------------------------------------------------------------------------------
  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;

{------------------------------------------------------------------------------
  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;
  AWindow: PGdkWindow;
  IconWidth, IconHeight: integer;
  IconSize: TPoint;
  {$IFDEF Gtk2}
  HorizPadding, ToggleSpacing: Integer;
  {$ENDIF}

  AEffect: TGraphicsDrawEffect;
  AImageList: TCustomImageList;
  FreeImageList: Boolean;
  AImageIndex: Integer;
  ItemBmp: TBitmap;
begin
  if (MenuItem=nil) then
    exit;
  if not (GTK_WIDGET_DRAWABLE (PGtkWidget(MenuItem))) then
    exit;

  // get icon
  LCLMenuItem:=TMenuItem(GetLCLObject(MenuItem));
  if LCLMenuItem=nil then begin // needed for gtk2 dialog
    if GtkWidgetIsA(PGtkWidget(MenuItem), gtk_check_menu_item_get_type) then
      OldCheckMenuItemDrawProc(MenuItem, Area);
    Exit;
  end;
  if not LCLMenuItem.HasIcon then
  begin
    // call default draw function
    OldCheckMenuItemDrawProc(MenuItem,Area);
    exit;
  end;
  IconSize:=LCLMenuItem.GetIconSize(0);
  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;

  {$IFDEF Gtk2}
  gtk_widget_style_get(PGtkWidget(MenuItem),
                       'horizontal-padding', @HorizPadding,
                       'toggle-spacing', @ToggleSpacing,
                       nil);

  ALeft := BorderWidth +
           gtk_widget_get_xthickness(gtk_widget_get_style(Widget)) +
           HorizPadding +
           ((PGtkMenuItem(MenuItem)^.toggle_size-ToggleSpacing-IconWidth) div 2);

  if gtk_widget_get_direction(Widget) = GTK_TEXT_DIR_RTL then
    ALeft := Widget^.Allocation.width - IconWidth - ALeft; //not sure it is the correct Width
  {$ELSE}
  ALeft := (BorderWidth + gtk_widget_get_xthickness(gtk_widget_get_style(Widget)) + 2)
           +((PGtkMenuItem(MenuItem)^.toggle_size-IconWidth) div 2);
  {$ENDIF}

  ATop := (Widget^.Allocation.Height - IconHeight) div 2;

  // draw icon
  AImageList := LCLMenuItem.GetImageList;
  if AImageList = nil then
  begin
    AImageList := TImageList.Create(nil);
    // prevent multiple calls to GetBitmap;
    ItemBmp := LCLMenuItem.Bitmap;
    AImageList.Width := ItemBmp.Width; // maybe height to prevent too wide bitmaps?
    AImageList.Height := ItemBmp.Height;
    if ItemBmp.Masked
    then AImageIndex := AImageList.AddMasked(ItemBmp, ItemBmp.TransparentColor)
    else AImageIndex := AImageList.Add(ItemBmp, nil);
    FreeImageList := True;
  end
  else
  begin
    FreeImageList := False;
    AImageIndex := LCLMenuItem.ImageIndex;
  end;

  if not LCLMenuItem.Enabled then
    AEffect := gdeDisabled
  else
    AEffect := gdeNormal;

  if AImageIndex < AImageList.Count then
    {$IFDEF VerboseGtkToDos}{$note reimplement}{$ENDIF}
    DrawImageListIconOnWidget(AImageList, AImageIndex, AEffect,
      Widget, false, false, ALeft, ATop);

  if FreeImageList then
    AImageList.Free;
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(0);
        {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);
begin
  UpdateInnerMenuItem(LCLMenuItem, MenuItemWidget, LCLMenuItem.ShortCut, LCLMenuItem.ShortCutKey2);
end;

{------------------------------------------------------------------------------
  Update the inner widgets of a menuitem widget.
 ------------------------------------------------------------------------------}
procedure UpdateInnerMenuItem(LCLMenuItem: TMenuItem; MenuItemWidget: PGtkWidget;
  NewShortCut, ShortCutKey2: TShortCut);
{$ifdef GTK2}
const
  WidgetDirection : array[boolean] of longint = (GTK_TEXT_DIR_LTR, GTK_TEXT_DIR_RTL);
  {$endif}
  function UseRTL: Boolean;
  begin
    Result := LCLMenuItem.GetIsRightToLeft;
  end;
var
  HBoxWidget: PGtkWidget;

  procedure SetMenuItemLabelText(LCLMenuItem: TMenuItem;
    MenuItemWidget: PGtkWidget);
  var
    LabelWidget: PGtkLabel;
  begin
    if (MenuItemWidget = nil) or (LCLMenuItem = nil) then
      Exit;
    LabelWidget := gtk_object_get_data(PGtkObject(MenuItemWidget), 'LCLLabel');
    GtkWidgetset.SetLabelCaption(LabelWidget, LCLMenuItem.Caption);
    {$ifdef GTK2}
    gtk_widget_set_direction(PGtkWidget(LabelWidget), WidgetDirection[UseRTL]);
    {$endif}
  end;

  procedure UpdateShortCutLabel;
  var
    LabelWidget: PGtkLabel;
    NeedShortCut: Boolean;
    Key, Key2: Word;
    Shift, Shift2: TShiftState;
    s: String;
  begin
    //DebugLn(['UpdateShortCutLabel ',dbgsName(LCLMenuItem),' ',ShortCutToText(NewShortCut)]);
    ShortCutToKey(NewShortCut, Key, Shift);
    ShortCutToKey(ShortCutKey2, Key2, Shift2);

    // Check if shortcut is needed. No shortcut captions for items in menubar
    NeedShortCut := (Key <> 0) and
       not ( (LCLMenuItem.Parent <> nil) and LCLMenuItem.Parent.HandleAllocated and
       GtkWidgetIsA(PGtkWidget(LCLMenuItem.Parent.Handle), GTK_TYPE_MENU_BAR) );

    LabelWidget := PGtkLabel(gtk_object_get_data(PGtkObject(MenuItemWidget),'LCLShortCutLabel'));
    if NeedShortCut then
    begin
      s := GetAcceleratorString(Key, Shift);
      if Key2 <> 0 then
        s := s + ', ' + GetAcceleratorString(Key2, Shift2);
      //  ShortCutToText(NewShortCut);
      if LabelWidget = nil then
      begin
        // create a label for the ShortCut
        LabelWidget := PGtkLabel(gtk_label_new(PChar(Pointer(s))));
        gtk_object_set_data(PGtkObject(MenuItemWidget), 'LCLShortCutLabel', LabelWidget);
        gtk_container_add(GTK_CONTAINER(HBoxWidget), PGtkWidget(LabelWidget));
        gtk_widget_show(PGtkWidget(LabelWidget));
      end
      else
      begin
        gtk_label_set_text(LabelWidget, PChar(Pointer(s)));
      end;
      {$ifdef GTK2}
      gtk_widget_set_direction(PGtkWidget(LabelWidget), GTK_TEXT_DIR_LTR); //Shortcut always LTR
      {$endif}
      if UseRTL then
        gtk_misc_set_alignment(GTK_MISC(LabelWidget), 0.0, 0.5)
      else
        gtk_misc_set_alignment(GTK_MISC (LabelWidget), 1.0, 0.5);
    end else
    if LabelWidget <> nil then
      gtk_widget_destroy(PGtkWidget(LabelWidget));
  end;

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

    if LCLMenuItem.HasIcon then
    begin
      {$IFNDEF Gtk2}
      IconSize := LCLMenuItem.GetIconSize(0);
      IconWidth := IconSize.X;
      IconHeight := IconSize.Y;
      // set the toggle width
      GTK_MENU_ITEM(MenuItemWidget)^.toggle_size := guint16(IconWidth);
      {$ENDIF}

      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;

      {$IFNDEF Gtk2}
      // 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);
      {$ENDIF}
    end
    else
      MinHeightWidget := nil;
    gtk_object_set_data(PGtkObject(MenuItemWidget),
                        'LCLMinHeight', MinHeightWidget);
  end;

  procedure CreateLabel;
  var
    LabelWidget: PGtkLabel;
  begin
    // create a label for the Caption
    LabelWidget := PGtkLabel(gtk_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 = cLineCaption then
    begin
      // a separator is an empty gtkmenuitem
      exit;
    end;
    HBoxWidget := gtk_hbox_new(false, 20);
    {$ifdef GTK2}
    gtk_widget_set_direction(PGtkWidget(HBoxWidget), WidgetDirection[UseRTL]);
    {$endif}
    gtk_object_set_data(PGtkObject(MenuItemWidget), 'LCLHBox', HBoxWidget);
    CreateIcon;
    CreateLabel;
    UpdateShortCutLabel;
    gtk_container_add(GTK_CONTAINER(MenuItemWidget), HBoxWidget);
    gtk_widget_show(HBoxWidget);
  end else
  begin
    // there are already inner widgets
    if LCLMenuItem.Caption = cLineCaption 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
      {$ifdef GTK2}
      gtk_widget_set_direction(PGtkWidget(HBoxWidget), WidgetDirection[UseRTL]);
      {$endif}
      SetMenuItemLabelText(LCLMenuItem, MenuItemWidget);
      UpdateShortCutLabel;
    end;
  end;
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;
{$IFNDEF GTK1}
  ShowSizeGrip: Boolean;
{$ENDIF}
begin
  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;
    {$IFDEF GTK2}
    gtk_object_remove_data(PGtkObject(CurStatusPanelWidget),'lcl_statusbar_id');
    {$ENDIF}
    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
  {$IFNDEF GTK1}
  ShowSizeGrip := AStatusBar.SizeGrip and AStatusBar.SizeGripEnabled;
  {$ENDIF}
  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;
    {$IFNDEF GTK1}
    gtk_statusbar_set_has_resize_grip(PGtkStatusBar(CurStatusPanelWidget),
      (ListItem = nil) and ShowSizeGrip);
    {$ENDIF}
  end;
end;

{$IFDEF GTK2}
function gtk2PaintStatusBarWidget(Widget: PGtkWidget; Event : PGDKEventExpose;
  Data: gPointer): GBoolean; cdecl;
var
  Msg: TLMDrawItems;
  PS : TPaintStruct;
  ItemStruct: PDrawItemStruct;
  ItemID: Integer;
begin
  Result := CallBackDefaultReturn;
  if (Event^.Count > 0) then exit;

  if (csDesigning in TComponent(Data).ComponentState) then
    exit;

  if TStatusBar(Data).SimplePanel then
    exit;

  ItemId := PtrInt(gtk_object_get_data(PGtkObject(Widget), 'lcl_statusbar_id')^);

  if not ((ItemId >= 0) and (ItemId < TStatusBar(Data).Panels.Count)) then
    exit;

  if TStatusBar(Data).Panels[ItemId].Style <> psOwnerDraw then
    exit;

  FillChar(Msg, SizeOf(Msg), #0);
  FillChar(PS, SizeOf(PS), #0);
  FillChar(ItemStruct, SizeOf(ItemStruct), #0);
  New(ItemStruct);
  // we must fill up complete area otherwise gtk2 will do
  // strange paints when item is not fully exposed.
  ItemStruct^.rcItem := Rect(Widget^.allocation.x,
    Widget^.allocation.y,
    Widget^.allocation.width + Widget^.allocation.x,
    Widget^.allocation.height + Widget^.allocation.y);

  OffsetRect(ItemStruct^.rcItem, -ItemStruct^.rcItem.Left, -ItemStruct^.rcItem.Top);

  // take frame borders into account
  with ItemStruct^.rcItem do
  begin
    Left := Left + Widget^.style^.xthickness;
    Top := Top + Widget^.style^.ythickness;
    Right := Right - Widget^.style^.xthickness;
    Bottom := Bottom - Widget^.style^.ythickness;
  end;

  ItemStruct^.itemID := ItemID;
  PS.rcPaint := ItemStruct^.rcItem;
  ItemStruct^._hDC := BeginPaint(THandle(PtrUInt(Widget)), PS);
  Msg.Ctl := TStatusBar(Data).Handle;
  Msg.DrawItemStruct := ItemStruct;
  Msg.Msg := LM_DRAWITEM;
  try
    DeliverMessage(TStatusBar(Data), Msg);
    Result := not CallBackDefaultReturn;
  finally
    PS.hdc := ItemStruct^._hDC;
    EndPaint(THandle(PtrUInt(TGtkDeviceContext(PS.hdc).Widget)), PS);
    Dispose(ItemStruct);
  end;
end;
{$ENDIF}

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;
  {$ifndef gtk1}
  xalign, yalign: gfloat;
  {$endif}
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(
    {$ifndef gtk1}
      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, '');


  if CurPanel <> nil then
  begin
    //DebugLn('  Alignment="',ord(CurPanel.Alignment),'"');
    // Alignment
    NewJustification := aGtkJustification[CurPanel.Alignment];
    if GTK_IS_LABEL(LabelWidget) then
    begin
      {$ifndef gtk1}
        if GTK_IS_MISC(LabelWidget) then
        begin
        {gtk_label_set_justify() has no effect on labels containing
         only a single line !}
        gtk_misc_get_alignment(GTK_MISC(LabelWidget), @xalign, @yalign);
        xalign := AlignToGtkAlign(CurPanel.Alignment);
        gtk_misc_set_alignment(GTK_MISC(LabelWidget), xalign, yalign);
        end else
          gtk_label_set_justify(LabelWidget, NewJustification);
      {$else}
      gtk_label_set_justify(LabelWidget, NewJustification);
      {$endif}
    end;

    // Bevel

    // Paul: this call will not modify frame on gtk2. GtkStatusBar resets frame
    // shadow on every size request. I have tried to modify rcStyle and tried to
    // hook property change event. Both ways are 1) not valid 2) does not give me
    // any result.
    // As a possible solution we can subclass PGtkStatusBar but if gtk developers
    // decided that stausbar should work so whether we need to override that?
    NewShadowType := aGtkShadowFromBevel[CurPanel.Bevel];
    if GTK_IS_FRAME(FrameWidget) then
      gtk_frame_set_shadow_type(PGtkFrame(FrameWidget), NewShadowType);

    // Width
    //DebugLn('  CurPanel.Width="',CurPanel.Width,'"');
    gtk_widget_set_usize(StatusPanelWidget, CurPanel.Width,
      StatusPanelWidget^.allocation.height);
    {$IFDEF GTK2}
    gtk_object_set_data(PGtkObject(StatusPanelWidget),'lcl_statusbar_id',
      @AStatusBar.Panels[Index].ID);
    g_signal_connect_after(StatusPanelWidget, 'expose-event',
      TGtkSignalFunc(@gtk2PaintStatusBarWidget), AStatusBar);
    {$ENDIF}
  end;
end;

function gtkListGetSelectionMode(list: PGtkList): TGtkSelectionMode; cdecl;
begin
  Result:=TGtkSelectionMode(
       (list^.flag0 and bm_TGtkList_selection_mode) shr bp_TGtkList_selection_mode);
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
  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('CreateTopologicalSortedWidgets HashArray.Count=',HashArray.Count);
  while HashItem<>nil do begin
    TopologicalList[i].Widget:=HashItem^.Item;
    //DebugLn('CreateTopologicalSortedWidgets 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('CreateTopologicalSortedWidgets 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('CreateTopologicalSortedWidgets bucket sort 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
  //DebugLn(['GetGTKDefaultWidgetSize ',GetWidgetDebugReport(Widget)]);
  {$IFDEF GTK1}
  gtk_widget_set_usize(Widget, -1, -1); // deprecated in gtk2
  {$ELSE}
  gtk_widget_set_size_request(Widget, -1, -1);
  {$ENDIF}
  // ask default size
  gtk_widget_size_request(Widget,@Requisition);
  PreferredWidth:=Requisition.width;
  PreferredHeight:=Requisition.height;
  if WithThemeSpace then begin
    {$IFDEF Gtk1}
    //DebugLn(['GetGTKDefaultWidgetSize WithThemeSpace ',DbgSName(AWinControl),' ',GtkWidgetIsA(Widget,GTK_BUTTON_TYPE),' ',GetWidgetDebugReport(Widget),' ',2*gtk_widget_get_ythickness(Widget)]);
    if gtk_class_get_type(gtk_object_get_class(Widget))=GTK_BUTTON_TYPE then
      inc(PreferredHeight,2*gtk_widget_get_ythickness(Widget))
    else if not GtkWidgetIsA(Widget,GTK_ENTRY_TYPE) then
      dec(PreferredHeight,2*gtk_widget_get_ythickness(Widget));
    {$ENDIF}
  end else 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));
    {$ELSE}
    //if gtk_class_get_type(gtk_object_get_class(Widget))=GTK_TYPE_BUTTON 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
  {$IFDEF GTK1}
  gtk_widget_set_usize(Widget, AWinControl.Width, AWinControl.Height);
  {$ELSE}
  gtk_widget_set_size_request(Widget, AWinControl.Width, AWinControl.Height);
  {$ENDIF}
  //debugln('GetGTKDefaultSize PreferredWidth=',dbgs(PreferredWidth),' PreferredHeight=',dbgs(PreferredHeight));
end;

procedure SendSizeNotificationToLCL(aWidget: PGtkWidget);
var
  LCLControl: TWinControl;
  LCLLeft, LCLTop, LCLWidth, LCLHeight: integer;
  GtkLeft, GtkTop, GtkWidth, GtkHeight: integer;
  TopLeftChanged, WidthHeightChanged, IsTopLevelWidget: boolean;
  MessageDelivered: boolean;
  SizeMsg: TLMSize;
  MoveMsg: TLMMove;
  PosMsg : TLMWindowPosChanged;
  MainWidget: PGtkWidget;
  FixedWidget: PGtkWidget;

  procedure UpdateLCLPos;
  begin
    LCLLeft:=LCLControl.Left;
    LCLTop:=LCLControl.Top;
    TopLeftChanged:=(LCLLeft<>GtkLeft) or (LCLTop<>GtkTop);
  end;

  procedure UpdateLCLSize;
  begin
    LCLWidth:=LCLControl.Width;
    LCLHeight:=LCLControl.Height;
    WidthHeightChanged:=(LCLWidth<>GtkWidth) or (LCLHeight<>GtkHeight);
    if LCLControl.ClientRectNeedsInterfaceUpdate then begin
      WidthHeightChanged:=true;
      //DebugLn(['UpdateLCLSize InvalidateClientRectCache ',DbgSName(LCLControl)]);
      LCLControl.InvalidateClientRectCache(false);
    end;
  end;

begin
  LCLControl:=TWinControl(GetLCLObject(aWidget));
  if LCLControl=nil then exit;
  {$IFDEF VerboseSizeMsg}
  DebugLn('SendSizeNotificationToLCL checking ... ',DbgSName(LCLControl),' Widget=',WidgetFlagsToString(aWidget));
  {$ENDIF}
  MainWidget:=PGtkWidget(LCLControl.Handle);
  FixedWidget:=PGtkWidget(GetFixedWidget(MainWidget));

  FWidgetsResized.Remove(MainWidget);
  FFixWidgetsResized.Remove(FixedWidget);

  {$IF defined(Gtk1)}
  if not GTK_WIDGET_REALIZED(aWidget) then begin
    // the widget is not yet realized, so this GTK resize was not a user change.
    // => ignore
    {$IFDEF VerboseSizeMsg}
    LCLControl:=TWinControl(GetLCLObject(aWidget));
    DebugLn('SendSizeNotificationToLCL ',DbgSName(LCLControl),' aWidget=',WidgetFlagsToString(aWidget),' Ignored, because not realized ');
    {$ENDIF}
    exit;
  end;
  {$ENDIF}

  GetWidgetRelativePosition(MainWidget,GtkLeft,GtkTop);

  {$ifdef gtk2}
  gtk_widget_get_size_request(MainWidget, @GtkWidth, @GtkHeight);

  if GtkWidth < 0 then
    GtkWidth:=MainWidget^.Allocation.Width
  else
    MainWidget^.Allocation.Width:=GtkWidth;
  if GtkHeight < 0 then
    GtkHeight:=MainWidget^.Allocation.Height
  else
    MainWidget^.Allocation.Height:=GtkHeight;
  //DebugLn(['SendSizeNotificationToLCL ',DbgSName(LCLControl),' gtk=',GtkLeft,',',GtkTop,',',GtkWidth,'x',GtkHeight,' Allocation=',MainWidget^.Allocation.Width,'x',MainWidget^.Allocation.Height]);
  {$else}
  GtkWidth:=MainWidget^.Allocation.Width;
  GtkHeight:=MainWidget^.Allocation.Height;
  {$endif}

  if GtkWidth<0 then GtkWidth:=0;
  if GtkHeight<0 then GtkHeight:=0;

  IsTopLevelWidget:=(LCLControl is TCustomForm) and (LCLControl.Parent=nil);
  if IsTopLevelWidget then begin
    if not GTK_WIDGET_VISIBLE(MainWidget) then begin
      // size/move messages of invisible windows are not reliable
      // -> ignore
      exit;
    end;
    if (GtkWidth=1) and (GtkHeight=1) then begin
      // this is default size of the gtk. Ignore.
      exit;
    end;
    //DebugLn(['SendSizeNotificationToLCL FORM ',GetWidgetDebugReport(MainWidget)]);

    {$IFDEF VerboseFormPositioning}
    DebugLn(['VFP SendSizeNotificationToLCL ',DbgSName(LCLControl),' ',
      GtkLeft,',',GtkTop,',',GtkWidth,'x',GtkHeight,' ',GetWidgetDebugReport(MainWidget)]);
    {$ENDIF}
  end;

  UpdateLCLPos;
  UpdateLCLSize;

  // first send a LM_WINDOWPOSCHANGED message
  if TopLeftChanged or WidthHeightChanged then begin
    {$IFDEF VerboseSizeMsg}
    DebugLn('SendSizeNotificationToLCL ',DbgSName(LCLControl),
      ' GTK=',dbgs(GtkLeft)+','+dbgs(GtkTop)+','+dbgs(GtkWidth)+'x'+dbgs(GtkHeight),
      ' LCL=',dbgs(LCLLeft)+','+dbgs(LCLTop)+','+dbgs(LCLWidth)+'x'+dbgs(LCLHeight)
      );
    {$ENDIF}
    PosMsg.Msg := LM_WINDOWPOSCHANGED; //LM_SIZEALLOCATE;
    PosMsg.Result := 0;
    New(PosMsg.WindowPos);
    try
      with PosMsg.WindowPos^ do begin
        hWndInsertAfter := 0;
        x := GtkLeft;
        y := GtkTop;
        cx := GtkWidth;
        cy := GtkHeight;
        flags:=0;
        // flags := SWP_SourceIsInterface;
      end;
      MessageDelivered := DeliverMessage(LCLControl, PosMsg) = 0;
    finally
      Dispose(PosMsg.WindowPos);
    end;
    if (not MessageDelivered) then exit;
    if FWidgetsWithResizeRequest.Contains(MainWidget) then exit;
    UpdateLCLPos;
    UpdateLCLSize;
  end;

  // then send a LM_SIZE message
  if WidthHeightChanged then begin
    {$IFDEF VerboseSizeMsg}
    DebugLn('Send LM_SIZE To LCL ',LCLControl.Name,':',LCLControl.ClassName);
    {$ENDIF}
    with SizeMsg do
    begin
      Result := 0;
      Msg := LM_SIZE;
      {$IFDEF GTK1}
      if GDK_WINDOW_GET_MAXIMIZED(PGdkWindowPrivate(MainWidget^.window)) then
        SizeType := SIZEFULLSCREEN
      else
        SizeType := SIZENORMAL;
      {$ELSE}
      if LCLControl is TCustomForm then begin
        // if the LCL gets an event without a State it resets it to SIZENORMAL
        // so we send it the state it already is
        case TCustomForm(LCLControl).WindowState of
          wsNormal: SizeType := SIZENORMAL;
          wsMinimized: SizeType := SIZEICONIC;
          wsMaximized: SizeType := SIZEFULLSCREEN;
        end;
      end
      else
        SizeType := 0;
      {$ENDIF}
      SizeType := SizeType or Size_SourceIsInterface;
      Width := SmallInt(GtkWidth);
      Height := SmallInt(GtkHeight);
    end;
    MessageDelivered := (DeliverMessage(LCLControl, SizeMsg) = 0);
    if not MessageDelivered then exit;
    if FWidgetsWithResizeRequest.Contains(MainWidget) then exit;
    UpdateLCLPos;
  end;

  // then send a LM_MOVE message
  if TopLeftChanged then begin
    {$IFDEF VerboseSizeMsg}
    DebugLn('Send LM_MOVE To LCL ',LCLControl.Name,':',LCLControl.ClassName);
    {$ENDIF}
    with MoveMsg do
    begin
      Result := 0;
      Msg := LM_MOVE;
      MoveType := Move_SourceIsInterface;
      XPos := SmallInt(GtkLeft);
      YPos := SmallInt(GtkTop);
    end;
    MessageDelivered := (DeliverMessage(LCLControl,  MoveMsg) = 0);
    if not MessageDelivered then exit;
  end;

  {$ifndef gtk1}
  if GtkWidgetIsA(aWidget, GTKAPIWidget_Type) and
     not (wwiNoEraseBkgnd in GetWidgetInfo(aWidget)^.Flags) then
    gtk_widget_queue_draw(aWidget);
  {$endif}
end;

procedure SendCachedGtkResizeNotifications;
{ This proc sends all cached size messages from the gtk to lcl but in an
  optimized order.
  When sending the LCL a size/move/windowposchanged messages the LCL will
  automatically realign all child controls. This realigning is based on the
  clientrect.
  Therefore, before a size message is sent to the lcl, all clientrect must be
  updated.
  If a size message results in resizing a widget that was also resized, then
  the message for the dependent widget is not sent to the lcl, because the lcl
  resize was after the gtk resize.
}
var
  FixWidget, MainWidget: PGtkWidget;
  LCLControl: TWinControl;
  List: TFPList;
  i: integer;

  procedure RaiseInvalidLCLControl;
  begin
    RaiseGDBException(Format('SendCachedGtkResizeNotifications FixWidget=%p MainWidget=%p LCLControl=%p',
                  [FixWidget, MainWidget, Pointer(LCLControl)]));
  end;

begin
  if (FWidgetsResized.Count=0) and (FFixWidgetsResized.Count=0) then exit;

  List:=TFPList.Create;

  { if any fixed widget was resized then a client area of a LCL control was
    resized
    -> invalidate client rectangles
  }
  {$IFDEF VerboseSizeMsg}
  DebugLn('HHH1 SendCachedGtkClientResizeNotifications Invalidating ClientRects ... '
  ,' FixSizeMsgCount=',dbgs(FFixWidgetsResized.Count));
  {$ENDIF}
  FFixWidgetsResized.AssignTo(List);
  for i:=0 to List.Count-1 do begin
    FixWidget:=List[i];
    MainWidget:=GetMainWidget(FixWidget);
    LCLControl:=TWinControl(GetLCLObject(MainWidget));
    if (LCLControl=nil) or (not (LCLControl is TWinControl)) then
      RaiseInvalidLCLControl;
    LCLControl.InvalidateClientRectCache(false);
  end;

  { if any main widget (= not fixed widget) was resized
    then a LCL control was resized
    -> send WMSize, WMMove, and WMWindowPosChanged messages
  }
  {$IFDEF VerboseSizeMsg}
  if FWidgetsResized.First<>nil then
    DebugLn('HHH2 SendCachedGtkClientResizeNotifications SizeMsgCount=',dbgs(FWidgetsResized.Count));
  {$ENDIF}
  repeat
    MainWidget:=FWidgetsResized.First;
    if MainWidget<>nil then begin
      FWidgetsResized.Remove(MainWidget);
      if not FWidgetsWithResizeRequest.Contains(MainWidget) then begin
        SendSizeNotificationToLCL(MainWidget);
      end;
    end else break;
  until Application.Terminated;

  { if any client area was resized, which MainWidget Size was already in sync
    with the LCL, no message was sent. So, tell each changed client area to
    check its size.
  }
  {$IFDEF VerboseSizeMsg}
  if FFixWidgetsResized.First<>nil then
    DebugLn('HHH3 SendCachedGtkClientResizeNotifications Updating ClientRects ...');
  {$ENDIF}
  repeat
    FixWidget:=FFixWidgetsResized.First;
    if FixWidget<>nil then begin
      FFixWidgetsResized.Remove(FixWidget);
      MainWidget:=GetMainWidget(FixWidget);
      LCLControl:=TWinControl(GetLCLObject(MainWidget));
      LCLControl.DoAdjustClientRectChange(False);
    end else begin
      break;
    end;
  until Application.Terminated;

  List.Free;
  {$IFDEF VerboseSizeMsg}
  DebugLn('HHH4 SendCachedGtkClientResizeNotifications  completed.');
  {$ENDIF}
end;

procedure ResizeHandle(LCLControl: TWinControl);
var
  Widget: PGtkWidget;
  Later: Boolean;
  {$IFDEF Gtk2}
  IsTopLevelWidget: Boolean;
  {$ENDIF}
begin
  Widget := PGtkWidget(LCLControl.Handle);
  if not WidgetSizeIsEditable(Widget) then
    Exit;
  Later := true;
  {$IFDEF Gtk2}
  // add resize request immediately
  IsTopLevelWidget:= (LCLControl is TCustomForm) and
                     (LCLControl.Parent = nil) and
                     (LCLControl.ParentWindow = 0);
  if not IsTopLevelWidget then
  begin
    SetWidgetSizeAndPosition(LCLControl);
    Later := false;
  end;
  {$ENDIF}
  if Later then
    SetResizeRequest(Widget);
end;

procedure SetWidgetSizeAndPosition(LCLControl: TWinControl);
var
  Requisition: TGtkRequisition;
  FixedWidget: PGtkWidget;
  {$IFDEF Gtk2}
  allocation: TGtkAllocation;
  {$ENDIF}
  LCLLeft: LongInt;
  LCLTop: LongInt;
  LCLWidth: LongInt;
  LCLHeight: LongInt;
  Widget: PGtkWidget;
  ParentWidget: PGtkWidget;
  ParentFixed: PGtkWidget;
  WinWidgetInfo: PWidgetInfo;
  {$IFDEF VerboseSizeMsg}
  LCLObject: TObject;
  {$ENDIF}

  procedure WriteBigWarning;
  begin
    DebugLn('WARNING: SetWidgetSizeAndPosition: resizing BIG ',
      ' Control=',LCLControl.Name,':',LCLControl.ClassName,
      ' NewSize=',dbgs(LCLWidth),',',dbgs(LCLHeight));
    //RaiseException('');
  end;

  procedure WriteWarningParentWidgetNotFound;
  begin
    DebugLn('WARNING: SetWidgetSizeAndPosition - '
            ,'Parent''s Fixed Widget not found');
    DebugLn('  Control=',LCLControl.Name,':',LCLControl.ClassName,
      ' Parent=',LCLControl.Parent.Name,':',LCLControl.Parent.ClassName,
      ' ParentWidget=',DbgS(ParentWidget),
      '');
  end;

begin
  {$IFDEF VerboseSizeMsg}
  DebugLn(['SetWidgetSizeAndPosition ',DbgSName(LCLControl)]);
  {$ENDIF}
  Widget:=PGtkWidget(LCLControl.Handle);

  LCLLeft := LCLControl.Left;
  LCLTop := LCLControl.Top;

  // move widget on the fixed widget of parent control
  if ((LCLControl.Parent <> nil) and (LCLControl.Parent.HandleAllocated)) or
     ((LCLControl.Parent = nil) and (LCLControl.ParentWindow <> 0)) then
  begin
    if LCLControl.Parent <> nil then
      ParentWidget := PGtkWidget(LCLControl.Parent.Handle)
    else
      ParentWidget := PGtkWidget(LCLControl.ParentWindow);
    ParentFixed := GetFixedWidget(ParentWidget);
    if GtkWidgetIsA(ParentFixed,GTK_FIXED_GET_TYPE) or
       GtkWidgetIsA(ParentFixed,GTK_LAYOUT_GET_TYPE) then
    begin
      //DebugLn(['SetWidgetSizeAndPosition ',DbgSName(LCLControl),' Widget=[',GetWidgetDebugReport(Widget),'] ParentFixed=[',GetWidgetDebugReport(ParentFixed),']']);
      FixedMoveControl(ParentFixed, Widget, LCLLeft, LCLTop);
    end
    else
    begin
      WinWidgetInfo := GetWidgetInfo(Widget, False);
      if (WinWidgetInfo = nil) or (not (wwiNotOnParentsClientArea in WinWidgetInfo^.Flags)) then
        WriteWarningParentWidgetNotFound;
    end;
  end;

  // resize widget
  LCLWidth := LCLControl.Width;
  if LCLWidth <= 0 then
    LCLWidth := 1;
  LCLHeight := LCLControl.Height;
  if LCLHeight <= 0 then
    LCLHeight := 1;
  if (LCLWidth > 10000) or (LCLHeight > 10000) then
  begin
    WriteBigWarning;
    if LCLWidth > 10000 then
      LCLWidth := 10000;
    if LCLHeight > 10000 then
      LCLHeight := 10000;
  end;

  {$IFDEF VerboseSizeMsg}
  LCLObject:=GetNearestLCLObject(Widget);
  DbgOut('TGtkWidgetSet.SetWidgetSizeAndPosition Widget='+DbgS(Widget)+WidgetFlagsToString(Widget)+
    ' New='+dbgs(LCLWidth)+','+dbgs(LCLHeight));
  if (LCLObject<>nil) and (LCLObject is TControl) then begin
    with TControl(LCLObject) do
      DebugLn(' LCL=',Name,':',ClassName,' ',dbgs(Left),',',dbgs(Top),',',dbgs(Width),',',dbgs(Height));
  end else begin
    DebugLn(' LCL=',DbgS(LCLObject));
  end;
  {$ENDIF}

  if GtkWidgetIsA(Widget,GTK_TYPE_SCROLLBAR) then
  begin
    // the width of a scrollbar is fixed and depends only on the theme
    gtk_widget_size_request(widget, @Requisition);
    if GtkWidgetIsA(Widget, GTK_TYPE_HSCROLLBAR) then
    begin
      LCLHeight:=Requisition.height;
    end else begin
      LCLWidth:=Requisition.width;
    end;
    //DebugLn('TGtkWidgetSet.SetWidgetSizeAndPosition A ',LCLwidth,',',LCLheight);
  end;

  gtk_widget_set_usize(Widget, LCLWidth, LCLHeight);
  //DebugLn(['TGtkWidgetSet.SetWidgetSizeAndPosition ',GetWidgetDebugReport(Widget),' LCLWidth=',LCLWidth,' LCLHeight=',LCLHeight]);

  {$IFDEF Gtk1}
  if GtkWidgetIsA(Widget, GTK_TYPE_COMBO) then
  begin
    // the combobox has an entry, which height is not resized
    // automatically. Do it manually.
    gtk_widget_set_usize(PGtkCombo(Widget)^.entry,
      PGtkCombo(Widget)^.entry^.allocation.width, LCLHeight);
  end;
  {$ENDIF}

  if GtkWidgetIsA(Widget,gtk_toolbar_get_type) then begin
    FixedWidget:=GetFixedWidget(Widget);
    if (FixedWidget<>nil) and (FixedWidget<>Widget) then begin
      //DebugLn('WARNING: ToDo TGtkWidgetSet.SetWidgetSizeAndPosition for TToolBar ',LCLWidth,',',LCLHeight);
      gtk_widget_set_usize(FixedWidget,LCLWidth,LCLHeight);
    end;
  end;

  {$IFDEF Gtk2}
  if (Widget^.parent<>nil)
  and GtkWidgetIsA(Widget^.parent,GTK_TYPE_FIXED)
  and GTK_WIDGET_NO_WINDOW(Widget^.parent)
  then begin
    inc(LCLLeft, Widget^.parent^.allocation.x);
    inc(LCLTop, Widget^.parent^.allocation.y);
  end;

  // commit size and position
  allocation:=Widget^.allocation;
  allocation.x:=LCLLeft;
  allocation.y:=LCLTop;
  allocation.width:=LCLWidth;
  allocation.height:=LCLHeight;
  //DebugLn(['SetWidgetSizeAndPosition ',DbgSName(LCLControl),' LCL=',dbgs(LCLControl.BoundsRect),' allocation=',dbgs(allocation),' ',GetWidgetDebugReport(Widget)]);
  gtk_widget_size_allocate(Widget,@allocation);// Beware: this triggers callbacks
  {$ENDIF}
end;

{------------------------------------------------------------------------------
  Method: SetWindowSizeAndPosition
  Params:  Widget: PGtkWidget; AWinControl: TWinControl
  Returns: Nothing

  Set the size and position of a top level window.
 ------------------------------------------------------------------------------}
procedure SetWindowSizeAndPosition(Window: PGtkWindow;
  AWinControl: TWinControl);
var
  Width, Height: integer;
  {$IFDEF Gtk2}
  allocation: TGtkAllocation;
  {$ENDIF}
  //Info: PGtkWindowGeometryInfo;
begin
  Width:=AWinControl.Width;
  // 0 and negative values have a special meaning, so don't use them
  if Width<=0 then Width:=1;
  Height:=AWinControl.Height;
  if Height<=0 then Height:=1;

  {$IFDEF VerboseSizeMsg}
  DebugLn(['TGtkWidgetSet.SetWindowSizeAndPosition START ',DbgSName(AWinControl),' ',AWinControl.Visible,' Old=',PGtkWidget(Window)^.allocation.Width,',',PGtkWidget(Window)^.allocation.Width,' New=',Width,',',Height]);
  {$ENDIF}
  // set geometry default size
  //Info:=gtk_window_get_geometry_info(Window, TRUE);
  //if (Info^.default_width<>Width) or (Info^.default_height<>Height) then
    gtk_window_set_default_size(Window, Width, Height);

  {$IFDEF Gtk2}
  // resize
  gtk_window_resize(Window, Width, Height);
  // reposition
  gtk_window_move(Window, AWinControl.Left, AWinControl.Top);
  // force early resize
  allocation := PGtkWidget(Window)^.allocation;
  allocation.width := Width;
  allocation.height := Height;
  //DebugLn(['SetWindowSizeAndPosition ',DbgSName(AWinControl),' ',dbgs(allocation)]);
  gtk_widget_size_allocate(PGtkWidget(Window), @allocation);// Beware: this triggers callbacks

  if (PGtkWidget(Window)^.Window <> nil) then
  begin
    // resize gdkwindow directly (sometimes the gtk forgets this)
    gdk_window_move_resize(PGtkWidget(Window)^.Window,AWinControl.Left,
      AWinControl.Top,Width,Height)
  end;
  {$ELSE}
  // resize
  if assigned(PGtkWidget(Window)^.Window) then
    // widget is realized, resize gdkwindow directly
    gdk_window_move_resize(PGtkWidget(Window)^.Window,AWinControl.Left,
      AWinControl.Top,Width,Height)
  else begin
    // widget is not yet realized, force resize needed for shrinking under gtk1
    gtk_widget_set_usize(PGtkWidget(Window), -1,-1);
  end;
  // reposition
  gtk_widget_set_usize(PGtkWidget(Window),Width,Height);
  gtk_widget_set_uposition(PGtkWidget(Window),AWinControl.Left,AWinControl.Top);
  {$ENDIF}

  {$IFDEF VerboseSizeMsg}
  DebugLn(['SetWindowSizeAndPosition B ',DbgSName(AWinControl),
    ' Visible=',AWinControl.Visible,
    ' Cur=',PGtkWidget(Window)^.allocation.X,',',PGtkWidget(Window)^.allocation.Y,
    ' New=',AWinControl.Left,',',AWinControl.Top,',',Width,'x',Height]);
  {$ENDIF}
end;

{-------------------------------------------------------------------------------
  GetWidgetRelativePosition

  Returns the Left, Top, relative to the client origin of its parent
-------------------------------------------------------------------------------}
procedure GetWidgetRelativePosition(aWidget: PGtkWidget; var Left, Top: integer);
var
  GdkWindow: PGdkWindow;
  LCLControl: TWinControl;
  GtkLeft, GtkTop: GInt;
begin
  Left:=aWidget^.allocation.X;
  Top:=aWidget^.allocation.Y;
  {$IFDEF Gtk2}
  if (aWidget^.parent<>nil)
  and (not GtkWidgetIsA(aWidget^.parent,GTK_TYPE_FIXED))
  and (not GtkWidgetIsA(aWidget^.parent,GTK_TYPE_LAYOUT))
  then begin
    // widget is not on a normal client area. e.g. TPage
    Left:=0;
    Top:=0;
  end
  else
  if (aWidget^.parent<>nil)
  and GtkWidgetIsA(aWidget^.parent,GTK_TYPE_FIXED)
  and GTK_WIDGET_NO_WINDOW(aWidget^.parent)
  then begin
    // widget on a fixed, but fixed w/o window
    Dec(Left, PGtkWidget(aWidget^.parent)^.allocation.x);
    Dec(Top, PGtkWidget(aWidget^.parent)^.allocation.y);
  end;
  {$ENDIF}
  if GtkWidgetIsA(aWidget,GTK_TYPE_WINDOW) then begin
    GdkWindow:=GetControlWindow(aWidget);
    if (GdkWindow<>nil) and (GTK_WIDGET_MAPPED(aWidget)) then begin
      // window is mapped = window manager has put the window somewhere
      gdk_window_get_root_origin(GdkWindow, @GtkLeft, @GtkTop);
      Left := GtkLeft;
      Top := GtkTop;
    end else begin
      // the gtk has not yet put the window to the final position
      // => the gtk/gdk position is not reliable
      // => use the LCL coords
      LCLControl:=GetLCLObject(aWidget) as TWinControl;
      Left:=LCLControl.Left;
      Top:=LCLControl.Top;
    end;
    //DebugLn(['TGtkWidgetSet.GetWindowRelativePosition ',GetWidgetDebugReport(aWidget),' Left=',Left,' Top=',Top,' GdkWindow=',GdkWindow<>nil]);
  end;
  //DebugLn(['TGtkWidgetSet.GetWindowRelativePosition ',GetWidgetDebugReport(aWidget),' Left=',Left,' Top=',Top]);
end;

{------------------------------------------------------------------------------
  UnsetResizeRequest
  Params: Widget: PGtkWidget

  Unset the mark for the Widget to send a ResizeRequest to the gtk.
  LCL size requests for a widget are cached and only the last one is sent. Some
  widgets like forms send a resize request immediately. To avoid sending resize
  requests multiple times they can unset the mark with this procedure.
 ------------------------------------------------------------------------------}
procedure UnsetResizeRequest(Widget: PGtkWidget);
begin
  {$IFDEF VerboseSizeMsg}
  if FWidgetsWithResizeRequest.Contains(Widget) then begin
    DebugLn(['UnsetResizeRequest ',GetWidgetDebugReport(Widget)]);
  end;
  {$ENDIF}
  FWidgetsWithResizeRequest.Remove(Widget);
end;

{------------------------------------------------------------------------------
  TGtkWidgetSet SetResizeRequest
  Params: Widget: PGtkWidget

  Marks the widget to send a ResizeRequest to the gtk.
  When the LCL resizes a control the new bounds will not be set directly, but
  cached. This is needed, because it is common behaviour to set the bounds step
  by step. For example: Left:=10; Top:=10; Width:=100; Height:=50; results in
  SetBounds(10,0,0,0);
  SetBounds(10,10,0,0);
  SetBounds(10,10,100,0);
  SetBounds(10,10,100,50);
  Because the gtk puts all size requests into a queue, it will process the
  requests not immediately, but _after_ all requests. This results in changing
  the widget size four times and everytime the LCL gets a message. If the
  control has children, this will resize the children four times.
  Therefore LCL size requests for a widget are cached and only the final one is
  sent in: TGtkWidgetSet.SendCachedLCLMessages.
 ------------------------------------------------------------------------------}
procedure SetResizeRequest(Widget: PGtkWidget);
{$IFDEF VerboseSizeMsg}
var
  LCLControl: TWinControl;
{$ENDIF}
begin
  {$IFDEF Gtk2}
  if not WidgetSizeIsEditable(Widget) then exit;
  {$ENDIF}
  {$IFDEF VerboseSizeMsg}
  LCLControl:=TWinControl(GetLCLObject(Widget));
  DbgOut('SetResizeRequest Widget=',DbgS(Widget));
  if LCLControl is TWinControl then
    DebugLn(' ',DbgSName(LCLControl),' LCLBounds=',dbgs(LCLControl.BoundsRect))
  else
    DebugLn(' ERROR: ',DbgSName(LCLControl));
  {$ENDIF}
  if not FWidgetsWithResizeRequest.Contains(Widget) then
    FWidgetsWithResizeRequest.Add(Widget);
end;

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

  True if the widget can be resized.
  False if the size is under complete control of the gtk.
------------------------------------------------------------------------------}
function WidgetSizeIsEditable(Widget: PGtkWidget): boolean;
begin
  if Widget=nil then exit(false);
  if (GtkWidgetIsA(Widget,GTK_TYPE_WINDOW))
  or (GtkWidgetIsA(Widget^.Parent,gtk_fixed_get_type))
  or (GtkWidgetIsA(Widget^.Parent,gtk_layout_get_type))
  then
    Result:=true
  else
    Result:=false;
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; Lgs: TLazGtkStyle);
{$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;
  if not (Lgs in [lgsButton, lgsWindow, lgsMenuBar, lgsMenuitem,
    lgsVerticalScrollbar, lgsHorizontalScrollbar, lgsTooltip]) 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}

    {$IFNDEF DisableGtkSysColors}
    // this map is taken from this research:
    // http://www.endolith.com/wordpress/2008/08/03/wine-colors/
    case Lgs of
      lgsButton:
        begin
          SysColorMap[COLOR_ACTIVEBORDER] := TGDKColorToTColor(bg[GTK_STATE_INSENSITIVE]);
          SysColorMap[COLOR_INACTIVEBORDER] := TGDKColorToTColor(bg[GTK_STATE_INSENSITIVE]);
          SysColorMap[COLOR_WINDOWFRAME] := TGDKColorToTColor(mid[GTK_STATE_SELECTED]);

          SysColorMap[COLOR_BTNFACE] := TGDKColorToTColor(bg[GTK_STATE_INSENSITIVE]);
          SysColorMap[COLOR_BTNSHADOW] := TGDKColorToTColor(dark[GTK_STATE_INSENSITIVE]);
          SysColorMap[COLOR_BTNTEXT] := TGDKColorToTColor(fg[GTK_STATE_NORMAL]);
          SysColorMap[COLOR_BTNHIGHLIGHT] := TGDKColorToTColor(light[GTK_STATE_INSENSITIVE]);
          SysColorMap[COLOR_3DDKSHADOW] := TGDKColorToTColor(black);
          SysColorMap[COLOR_3DLIGHT] := TGDKColorToTColor(bg[GTK_STATE_INSENSITIVE]);
        end;
      lgsWindow:
        begin
          // colors which can be only retrieved from the window manager (metacity)
          SysColorMap[COLOR_ACTIVECAPTION] := TGDKColorToTColor(dark[GTK_STATE_SELECTED]);
          SysColorMap[COLOR_INACTIVECAPTION] := TGDKColorToTColor(dark[GTK_STATE_NORMAL]);
          SysColorMap[COLOR_GRADIENTACTIVECAPTION] := TGDKColorToTColor(light[GTK_STATE_SELECTED]);
          SysColorMap[COLOR_GRADIENTINACTIVECAPTION] := TGDKColorToTColor(base[GTK_STATE_NORMAL]);
          SysColorMap[COLOR_CAPTIONTEXT] := TGDKColorToTColor(white);
          SysColorMap[COLOR_INACTIVECAPTIONTEXT] := TGDKColorToTColor(white);
          // others
          SysColorMap[COLOR_APPWORKSPACE] := TGDKColorToTColor(base[GTK_STATE_NORMAL]);
          SysColorMap[COLOR_GRAYTEXT] := TGDKColorToTColor(fg[GTK_STATE_INSENSITIVE]);
          SysColorMap[COLOR_HIGHLIGHT] := TGDKColorToTColor(base[GTK_STATE_SELECTED]);
          SysColorMap[COLOR_HIGHLIGHTTEXT] := TGDKColorToTColor(fg[GTK_STATE_SELECTED]);
          SysColorMap[COLOR_WINDOW] := TGDKColorToTColor(base[GTK_STATE_NORMAL]);
          SysColorMap[COLOR_WINDOWTEXT] := TGDKColorToTColor(text[GTK_STATE_NORMAL]);
          SysColorMap[COLOR_HOTLIGHT] := TGDKColorToTColor(light[GTK_STATE_NORMAL]);
          SysColorMap[COLOR_BACKGROUND] := TGDKColorToTColor(bg[GTK_STATE_PRELIGHT]);
          SysColorMap[COLOR_FORM] := TGDKColorToTColor(bg[GTK_STATE_NORMAL]);
        end;
      lgsMenuBar:
        begin
          SysColorMap[COLOR_MENUBAR] := TGDKColorToTColor(bg[GTK_STATE_NORMAL]);
        end;
      lgsMenuitem:
        begin
          SysColorMap[COLOR_MENU] := TGDKColorToTColor(light[GTK_STATE_ACTIVE]);
          SysColorMap[COLOR_MENUTEXT] := TGDKColorToTColor(fg[GTK_STATE_NORMAL]);
          SysColorMap[COLOR_MENUHILIGHT] := TGDKColorToTColor(bg[GTK_STATE_PRELIGHT]);
        end;
      lgsVerticalScrollbar,
      lgsHorizontalScrollbar:
        begin
          SysColorMap[COLOR_SCROLLBAR] := TGDKColorToTColor(bg[GTK_STATE_ACTIVE]);
        end;
      lgsTooltip:
        begin
          SysColorMap[COLOR_INFOTEXT] := TGDKColorToTColor(fg[GTK_STATE_NORMAL]);
          SysColorMap[COLOR_INFOBK] := TGDKColorToTColor(bg[GTK_STATE_NORMAL]);
        end;
    end;
    {$ENDIF}
  end;
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 GetScreenWidthMM(GdkValue: boolean): integer;
begin
  Result:=gdk_screen_width_mm;
  if (Result<=0) and not GdkValue then
    Result:=300; // some TV-out screens don't know there size
end;

function GetScreenHeightMM(GdkValue: boolean): integer;
begin
  Result:=gdk_screen_height_mm;
  if (Result<=0) and not GdkValue then
    Result:=300; // some TV-out screens don't know there size
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.ProcessMessages;
      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: PtrUInt): TGtkSelectionData;

  function TimeIDExists(TimeID: guint32): 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);
    FillChar(c^,SizeOf(TClipboardEventData),0);
    c^.TimeID:=TimeID;
    ClipboardSelectionData.Add(c);
    try
      {$IFDEF DEBUG_CLIPBOARD}
      DebugLn('[RequestSelectionData] TimeID=',dbgs(TimeID),' Type=',GdkAtomToStr(ClipboardTypeAtoms[ClipboardType]),' FormatID=',GdkAtomToStr(FormatID), ' Sanity=', IntToStr(Sanity));
      {$ENDIF}
      if gtk_selection_convert(ClipboardWidget, ClipboardTypeAtoms[ClipboardType],
                               FormatID, TimeID)<>GdkFalse
      then begin
        if not WaitForClipboardAnswer(c) then exit;
        Result:=c^.Data;
        break;
      end;
    finally
      ClipboardSelectionData.Remove(c);
      Dispose(c);
    end;
    Inc(sanity);
    sleep(100);
  until false or (sanity > 10);
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; AWidgetInfo: PWidgetInfo = nil): 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);
    {$ifdef gtk2}
    if (AWidgetInfo <> nil) and
      (gtk_major_version >= 2) and (gtk_minor_version > 8) then
    begin
      g_signal_connect(PGTKScrolledWindow(ScrolledWidget)^.hscrollbar, 'change-value',
        TGCallback(@Gtk2RangeScrollCB), AWidgetInfo);
      g_signal_connect(PGTKScrolledWindow(ScrolledWidget)^.vscrollbar, 'change-value',
        TGCallback(@Gtk2RangeScrollCB), AWidgetInfo);
    end;
    {$endif}
  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 CompareText(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.
 ------------------------------------------------------------------------------}
function NewStyleObject : PStyleObject;
begin
  New(Result);
  FillChar(Result^, SizeOf(TStyleObject), 0);
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^.Obj <> nil then
      gtk_object_destroy(StyleObject^.Obj);
    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;

procedure tooltip_window_style_set(Widget: PGtkWidget; PreviousStyle: PGtkStyle;
          StyleObject: PStyleObject); cdecl;
begin
  StyleObject^.Style := gtk_widget_get_style(Widget);
  UpdateSysColorMap(Widget, lgsToolTip);
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;
var
  StyleObject : PStyleObject;

  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{$IFNDEF GtkFixedWithWindow}(false){$ENDIF};
    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,400,400);
  end;

  procedure ResizeWidget(CurWidget: PGTKWidget; NewWidth, NewHeight: integer);
  {$IFDEF Gtk1}
  begin
    gtk_widget_set_usize(StyleObject^.Widget,NewWidth,NewHeight);
  end;
  {$ELSE}
  var
    allocation: TGtkAllocation;
  begin
    allocation.x:=0;
    allocation.y:=0;
    allocation.width:=NewWidth;
    allocation.height:=NewHeight;
    //gtk_widget_set_usize(StyleObject^.Widget,NewWidth,NewHeight);
    gtk_widget_size_allocate(CurWidget,@allocation);
    StyleObject^.FrameBordersValid:=false;
  end;
  {$ENDIF}

var
  Tp : Pointer;
  l : Longint;
  NoName: PGChar;
  lgs: TLazGtkStyle;
  WidgetName: String;
  //VBox: PGtkWidget;
  AddToStyleWindow: Boolean;
  StyleWindowWidget: PGtkWidget;
  Requisition: TGtkRequisition;
  WindowFixedWidget: PGtkWidget;
  VBox: 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;
    WidgetName := 'LazStyle' + WName;
    // 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);// vbox is needed for menu above and fixed widget below
        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(VBox), 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;
        {$IFDEF Gtk1}
        AddToStyleWindow:=false;
        {$ENDIF}
        StyleObject^.Widget := gtk_menu_new;
      end
    else
      If CompareText(WName,LazGtkStyleNames[lgsMenuBar])=0 then begin
        lgs:=lgsMenuBar;
        {$IFDEF Gtk1}
        AddToStyleWindow:=false;
        {$ENDIF}
        StyleObject^.Widget := gtk_menu_bar_new;
      end
    else
      If CompareText(WName,LazGtkStyleNames[lgsMenuitem])=0 then begin
        lgs:=lgsMenuitem;
        {$IFDEF Gtk1}
        AddToStyleWindow:=false;
        StyleObject^.Widget := gtk_menu_item_new;
        {$ELSE}
        // image menu item is needed to correctly return theme options
        StyleObject^.Widget := gtk_image_menu_item_new;
        {$ENDIF}
      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[lgsCalendar])=0 then begin
        lgs:=lgsCalendar;
        AddToStyleWindow:=true;
        StyleObject^.Widget := gtk_calendar_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;
        Tp := gtk_tooltips_new;
        gtk_tooltips_force_window(Tp);
        StyleObject^.Widget := PGTKTooltips(Tp)^.Tip_Window;
        gtk_widget_ref(StyleObject^.Widget);// MG: why is this needed?
        {$IFNDEF GTK1}
        g_signal_connect(StyleObject^.Widget, 'style-set',
			 TGCallback(@tooltip_window_style_set), StyleObject);
        {$ENDIF}
        WidgetName := 'gtk-tooltip-lcl';
        StyleObject^.Obj := Tp;
        Tp := nil;
        {$IFDEF GTK1}
        AddToStyleWindow := False;
        {$ENDIF}
      end
    else
      If CompareText(WName,LazGtkStyleNames[lgsHScale])=0 then begin
        lgs:=lgsHScale;
        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;
        TP := PGtkWidget( gtk_adjustment_new (0, 0, 100, 1, 10, 0));
        StyleObject^.Widget := gtk_vscale_new (PGTKADJUSTMENT (TP));
      end
    else
      If CompareText(WName,LazGtkStyleNames[lgsGroupBox])=0 then begin
        lgs:=lgsGroupBox;
        StyleObject^.Widget := gtk_frame_new('GroupBox');
        WindowFixedWidget:=CreateFixedClientWidget{$IFNDEF GtkFixedWithWindow}(false){$ENDIF};
        gtk_widget_show(WindowFixedWidget);
        gtk_container_add(PGtkContainer(StyleObject^.Widget), WindowFixedWidget);
        gtk_object_set_data(PGtkObject(StyleObject^.Widget),'fixedwidget',WindowFixedWidget);
      end
{$ifdef gtk2}
    else
      If CompareText(WName,LazGtkStyleNames[lgsTreeView])=0 then begin
        lgs:=lgsTreeView;
        StyleObject^.Widget := gtk_tree_view_new;
        gtk_tree_view_append_column(PGtkTreeView(StyleObject^.Widget), gtk_tree_view_column_new);
      end
{$endif}
    else
      If CompareText(WName,LazGtkStyleNames[lgsToolBar])=0 then begin
        lgs:=lgsToolBar;
        StyleObject^.Widget := gtk_toolbar_new;
      end
    else
      If CompareText(WName,LazGtkStyleNames[lgsToolButton])=0 then begin
        lgs:=lgsToolButton;
        StyleObject^.Widget := gtk_toolbar_append_item(PGtkToolBar(GetStyleWidget(lgsToolBar)), 'B', nil, nil, nil, nil, nil);
      end
    else
      if CompareText(WName,LazGtkStyleNames[lgsScrolledWindow])=0 then begin
        lgs:=lgsScrolledWindow;
        StyleObject^.Widget := gtk_scrolled_window_new(nil, nil);
      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);
        if GtkWidgetIsA(StyleObject^.Widget,GTK_TYPE_MENU) then
        begin
          // attach menu to window
          gtk_menu_attach_to_widget(PGtkMenu(StyleObject^.Widget),
            GetStyleWidget(lgsWindow), nil);
        end
        else
        if GtkWidgetIsA(StyleObject^.Widget,GTK_TYPE_MENU_BAR) then
        begin
          StyleWindowWidget:=GetStyleWidget(lgsWindow);
          // add menu above the forms client area (fixed widget)
          VBox:=PGTKWidget(
                     gtk_object_get_data(PGtkObject(StyleWindowWidget),'vbox'));
          gtk_box_pack_start(PGTKBox(VBox), StyleObject^.Widget, False, False, 0);
        end
        else
        if GtkWidgetIsA(StyleObject^.Widget,GTK_TYPE_MENU_ITEM) then
        begin
          gtk_menu_bar_append({$IFDEF Gtk1}
                              PGtkMenuBar(GetStyleWidget(lgsMenuBar)),
                              {$ELSE}
                              GetStyleWidget(lgsMenuBar),
                              {$ENDIF}
                              StyleObject^.Widget);
        end
        else
{$ifdef gtk2}
        if GtkWidgetIsA(StyleObject^.Widget, GTK_TYPE_TOOL_BUTTON) then
        begin
          //gtk_toolbar_insert();
          gtk_toolbar_append_widget(GTK_TOOLBAR(GetStyleWidget(lgsToolBar)),
            StyleObject^.Widget, nil, nil);
        end
        else
{$endif}
        if (lgs = lgsToolButton) or
           (lgs = lgsTooltip) then
        begin
          // already on a parent => nothing to do
        end
        else
        begin
          StyleWindowWidget:=GetStyleWidget(lgsWindow);
          // add widget on client area of form
          WindowFixedWidget:=PGTKWidget(
                 gtk_object_get_data(PGtkObject(StyleWindowWidget),'fixedwidget'));
          //DebugLn('GetStyleWithName adding on hidden stylewindow ',WName,' ',GetWidgetDebugReport(StyleObject^.Widget));
          if WindowFixedWidget <> nil then
            gtk_fixed_put(PGtkFixed(WindowFixedWidget),StyleObject^.Widget,10,10);
        end;
      end;

      gtk_widget_set_name(StyleObject^.Widget,PChar(WidgetName));
      gtk_widget_ensure_style(StyleObject^.Widget);

      // request default sizing
      FillChar(Requisition,SizeOf(Requisition),0);
      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);
        end;
      end;
      if AddToStyleWindow then begin
        if not GtkWidgetIsA(StyleObject^.Widget,GTK_WINDOW_GET_TYPE) then begin
          //DebugLn(['GetStyleWithName realizing ...']);
          gtk_widget_realize(StyleObject^.Widget);
          //DebugLn('AddToStyleWindow realized: ',WName,' ',GetWidgetDebugReport(StyleObject^.Widget));
        end;
        ResizeWidget(StyleObject^.Widget,200,200);
      end;
    end;

    // increase refcount of style
    if StyleObject^.Style <> nil then
      if CompareText(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;
      UpdateSysColorMap(StyleObject^.Widget, lgs);

      // ToDo: create all gc of the style
      //gtk_widget_set_rc_style(StyleObject^.Widget);

      if lgs = lgsTooltip then
        gtk_widget_hide_all(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;

  {$IFDEF VerboseGtkToDos}{$WARNING ToDo LoadDefaultFontDesc: get a working default pango font description}{$ENDIF}
  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;
  {$ELSE}
  p,t: pchar;
  AFont: PGdkFont;
  {$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
        with style^.RC_Style^ do begin
          if (font_name <> nil) then
            Result := font_name;
          if (Result='') and (fontset_name<>nil) then
          begin
            // fontset_name it's usually a comma separated list of font names
            // try to get the first valid font.
            p := fontset_name;
            while p<>nil do begin
              t := strscan(p, ',');
              if t=nil then
                result := p
              else begin
                result := copy(p, 1, t-p);
                while (t<>nil) and (t^ in [',',' ',#9,#10,#13]) do
                  inc(t);
              end;
              AFont := gdk_font_load(pchar(result));
              if AFont<>nil then begin
                gdk_font_unref(AFont);
                {$IFDEF VerboseFonts}
                debugln('DefaultFont found in fontset: ',result);
                {$ENDIF}
                break;
              end;
              p := t;
            end;
          end;
        end;
      {$ENDIF}
    {$ENDIF}
    {$IFDEF GTK2}
    If (Style <> nil) then begin
      PangoFontDesc := Style^.font_desc;
      if PangoFontDesc<>nil then begin
        Result:=pango_font_description_get_family(PangoFontDesc);
      end;
    end;
    {$ENDIF}
  end;
  {$IFDEF VerboseFonts}
  DebugLn('GetDefaultFontName: DefaultFont=',result);
  {$ENDIF}
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
  // Set defaults in case something goes wrong
  FillChar(Result, SizeOf(Result), 0);
  Style := nil;
  GC := nil;
  Pixmap := nil;

  SysColor := ColorToRGB(Color);
  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}
  BaseColor := Color and $FF;
  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;
            {$IFDEF Gtk1}
            Result.foreground := Style^.bg[GTK_STATE_PRELIGHT];
            {$ELSE}
            Result.foreground := Style^.bg[GTK_STATE_NORMAL];
            {$ENDIF}
          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
        Style := GetStyle(lgsList);
        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;
        {$IFDEF Gtk1}
        GC := Style^.bg_gc[GTK_STATE_PRELIGHT];
        {$ELSE}
        GC := Style^.text_gc[GTK_STATE_SELECTED];
        {$ENDIF}
        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
        DebugLn(['StyleForegroundColor clHIGHLIGHTTEXT']);
        Style := GetStyle(lgsDefault);
        If Style = nil then
          exit;
        Result := @Style^.text[GTK_STATE_PRELIGHT];
        DebugLn(['StyleForegroundColor clHIGHLIGHTTEXT 2 ',Result<>nil]);
      end;
  end;

  If Result = nil then
    Result := DefaultColor;

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

function GetStyleGroupboxFrameBorders: TRect;
const s = 200;
var
  StyleObject: PStyleObject;
  allocation: TGtkAllocation;
  FrameWidget: PGtkFrame;
  f: TRect;
begin
  GetStyleWidget(lgsGroupBox);
  StyleObject:=StandardStyles[lgsGroupBox];
  if not StyleObject^.FrameBordersValid then begin
    allocation.x:=0;
    allocation.y:=0;
    allocation.width:=s;
    allocation.height:=s;
    gtk_widget_size_allocate(StyleObject^.Widget,@allocation);
    FrameWidget:=pGtkFrame(StyleObject^.Widget);
    {$IFDEF Gtk1}
    allocation:=FrameWidget^.bin.child^.allocation;
    {$ELSE}
    GTK_FRAME_GET_CLASS(FrameWidget)^.compute_child_allocation(
      FrameWidget,@allocation);
    {$ENDIF}
    //DebugLn(['GetStyleGroupboxFrame BBB2 ',dbgs(allocation)]);
    f.Left:=Min(s,Max(0,allocation.x));
    f.Top:=Min(s,Max(0,allocation.y));
    f.Right:=Max(0,Min(s-f.Left,s-allocation.x-allocation.width));
    f.Bottom:=Max(0,Min(s-f.Top,s-allocation.x-allocation.width));
    StyleObject^.FrameBorders:=f;
    //DebugLn(['GetStyleGroupboxFrame FrameBorders=',dbgs(StyleObject^.FrameBorders)]);
    StyleObject^.FrameBordersValid:=true;
  end;
  Result:=StyleObject^.FrameBorders;
end;

function GetStyleNotebookFrameBorders: TRect;
const s = 400;
var
  StyleObject: PStyleObject;
  allocation: TGtkAllocation;
  f: TRect;
  PageWidget: PGtkWidget;
begin
  GetStyleWidget(lgsNotebook);
  StyleObject:=StandardStyles[lgsNotebook];
  if not StyleObject^.FrameBordersValid then begin
    allocation.x:=0;
    allocation.y:=0;
    allocation.width:=s;
    allocation.height:=s;
    gtk_widget_size_allocate(StyleObject^.Widget,@allocation);
    PageWidget:=gtk_notebook_get_nth_page(PGtkNoteBook(StyleObject^.Widget),0);
    //DebugLn(['GetStyleNotebookFrameBorders BBB2 ',dbgs(allocation)]);
    allocation:=PageWidget^.allocation;
    f.Left:=Min(s,Max(0,allocation.x));
    f.Top:=Min(s,Max(0,allocation.y));
    f.Right:=Max(0,Min(s-f.Left,s-allocation.x-allocation.width));
    f.Bottom:=Max(0,Min(s-f.Top,s-allocation.x-allocation.width));
    StyleObject^.FrameBorders:=f;
    //DebugLn(['GetStyleNotebookFrameBorders FrameBorders=',dbgs(StyleObject^.FrameBorders)]);
    StyleObject^.FrameBordersValid:=true;
  end;
  Result:=StyleObject^.FrameBorders;
end;

{$IFDEF Gtk2}
function GetStyleFormFrameBorders(WithMenu: boolean): TRect;
const s = 400;
var
  StyleObject: PStyleObject;
  allocation: TGtkAllocation;
  f: TRect;
  InnerWidget: PGtkWidget;
  Outer: TGdkRectangle;
  Inner: TGdkRectangle;
begin
  GetStyleWidget(lgsMenu);
  StyleObject:=StandardStyles[lgsWindow];
  if not StyleObject^.FrameBordersValid then begin
    allocation.x:=0;
    allocation.y:=0;
    allocation.width:=s;
    allocation.height:=s;
    gtk_widget_size_allocate(StyleObject^.Widget,@allocation);
    InnerWidget:=PGTKWidget(
          gtk_object_get_data(PGtkObject(StyleObject^.Widget),'fixedwidget'));
    allocation:=InnerWidget^.allocation;
    //DebugLn(['GetStyleFormFrameBorders BBB2 ',dbgs(allocation),' WithMenu=',WithMenu,' ClientWidget=',GetWidgetDebugReport(InnerWidget)]);
    f.Left:=Min(s,Max(0,allocation.x));
    f.Top:=Min(s,Max(0,allocation.y));
    f.Right:=Max(0,Min(s-f.Left,s-allocation.x-allocation.width));
    f.Bottom:=Max(0,Min(s-f.Top,s-allocation.x-allocation.width));
    StyleObject^.FrameBorders:=f;
    //DebugLn(['GetStyleFormFrameBorders FrameBorders=',dbgs(StyleObject^.FrameBorders)]);
    StyleObject^.FrameBordersValid:=true;
  end;

  if WithMenu then begin
    InnerWidget:=PGTKWidget(
                 gtk_object_get_data(PGtkObject(StyleObject^.Widget),'vbox'));
  end else begin
    InnerWidget:=PGTKWidget(
          gtk_object_get_data(PGtkObject(StyleObject^.Widget),'fixedwidget'));
  end;
  Outer:=StyleObject^.Widget^.allocation;
  Inner:=InnerWidget^.allocation;
  Result.Left:=Min(Outer.width,Max(0,Inner.x));
  Result.Top:=Min(Outer.height,Max(0,Inner.y));
  Result.Right:=Max(0,Min(Outer.width-f.Left,Outer.width-Inner.x-Inner.width));
  Result.Bottom:=Max(0,Min(Outer.height-f.Top,Outer.height-Inner.x-Inner.width));
  //DebugLn(['GetStyleFormFrameBorders BBB3 Inner=',dbgs(Inner),' Outer=',dbgs(Outer),' WithMenu=',WithMenu,' InnerWidget=',GetWidgetDebugReport(InnerWidget),' Result=',dbgs(Result)]);
end;
{$ENDIF}

procedure StyleFillRectangle(drawable : PGDKDrawable; GC : PGDKGC;
  Color : TColorRef; x, y, width, height : gint);
var
  style: PGTKStyle;
  widget: PGTKWidget;
  state: TGTKStateType;
  shadow: TGtkShadowType;
  detail: pgchar;
begin
  style := nil;
  shadow := GTK_SHADOW_NONE;
  state := GTK_STATE_NORMAL;

  case TColor(Color) of
   { clMenu:
      begin
        Style := GetStyle('menuitem');
        widget := GetStyleWidget('menuitem');
        detail := 'menuitem';
      end;

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

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

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

    clInfoBk :
      begin
        Style := GetStyle(lgsToolTip);
        Widget := GetStyleWidget(lgsToolTip);
        shadow := GTK_SHADOW_OUT;
        detail := 'tooltip';
      end;

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

  if Assigned(Style) then
    gtk_paint_flat_box(style, drawable, state, shadow, 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
    Widget := MainWidget;

  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 not IsColorDefault(AWinControl) 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_Type) 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.Reference.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;

{-------------------------------------------------------------------------------
  Creates a new PChar. Deletes escaping ampersands, replaces the first single
  ampersand with an underscore and deletes all other single ampersands.
-------------------------------------------------------------------------------}
function Ampersands2Underscore(Src: PChar) : PChar;
var
  s: String;
begin
  s := StrPas(Src);
  s := Ampersands2Underscore(s);
  Result := StrAlloc(Length(s)+1); // +1 for #0 char at end
  strcopy(Result, PChar(s));
end;

{-------------------------------------------------------------------------------
  Deletes escaping ampersands, replaces the first single
  ampersand with an underscore and deletes 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 FirstFound
      or ( (n < Length(Result)) and (Result[n+1] = '&') ) // got &&
      then begin
        Delete(Result, n, 1);
        if not FirstFound then
          Inc(n);               // Skip the second & of &&
      end
      else begin
        FirstFound := True;
        Result[n] := '_';
      end;
    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
  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);
        end else begin
          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;
      end;
      '_': begin
        AText[n] := ' ';
        APattern[n] := '_';
      end;
    end;
    Inc(n);
  end;
end;


{-------------------------------------------------------------------------------
  function GetTextExtentIgnoringAmpersands(TheFont: PGDKFont;
    Str : PChar; StrLength: integer;
    MaxWidth: Longint; lbearing, rbearing, width, ascent, descent : Pgint);

  Gets text extent of a string, ignoring escaped Ampersands.
  That means, ampersands are not counted.
  Negative MaxWidth means no limit.
-------------------------------------------------------------------------------}
procedure GetTextExtentIgnoringAmpersands(TheFont: TGtkIntfFont;
  Str : PChar; StrLength: integer;
  lbearing, rbearing, width, ascent, descent : Pgint);
var
  NewStr : PChar;
  i: integer;
begin
  NewStr:=Str;
  // first check if Str contains an ampersand:
  if (Str<>nil) then begin
    i:=0;
    while (Str[i]<>'&') and (i<StrLength) do inc(i);
    if i<StrLength then begin
      NewStr := RemoveAmpersands(Str, StrLength);
      StrLength:=StrLen(NewStr);
    end;
  end;
  gdk_text_extents(TheFont, NewStr, StrLength,
                   lbearing, rBearing, width, ascent, descent);
  if NewStr<>Str then
    StrDispose(NewStr);
end;

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

  This is only a heuristic
 ------------------------------------------------------------------------------}
function FontIsDoubleByteCharsFont(TheFont: TGtkIntfFont): boolean;
var
  SingleCharLen, DoubleCharLen: integer;
begin
  {$IFDEF Gtk1}
  SingleCharLen:=gdk_text_width(TheFont, 'A', 1);
  DoubleCharLen:=gdk_text_width(TheFont, #0'A', 2);
  {$ELSE}
  pango_layout_set_single_paragraph_mode(TheFont, TRUE);
  pango_layout_set_width(TheFont, -1);
  pango_layout_set_text(TheFont, 'A', 1);
  pango_layout_get_pixel_size(TheFont, @SingleCharLen, nil);
  pango_layout_set_text(TheFont, #0'A', 2);
  pango_layout_get_pixel_size(TheFont, @DoubleCharLen, nil);
  {$ENDIF}
  Result:=(SingleCharLen=0) and (DoubleCharLen>0);
end;

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

  This is only a heuristic
 ------------------------------------------------------------------------------}
function FontIsMonoSpaceFont(TheFont: TGtkIntfFont): boolean;
var
  {$IFDEF Gtk1}
  SingleCharLen: LongInt;
  {$ENDIF}
  MWidth: LongInt;
  IWidth: LongInt;
begin
  {$IFDEF Gtk1}
  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;
  {$ELSE}
  pango_layout_set_single_paragraph_mode(TheFont, TRUE);
  pango_layout_set_width(TheFont, -1);
  pango_layout_set_text(TheFont, 'm', 1);
  pango_layout_get_pixel_size(TheFont, @MWidth, nil);
  pango_layout_set_text(TheFont, 'i', 1);
  pango_layout_get_pixel_size(TheFont, @IWidth, nil);
  {$ENDIF}
  Result:=MWidth=IWidth;
end;

{------------------------------------------------------------------------------
  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
  Result := 0;

  if not (csDesigning in AForm.ComponentState) then
    ABorderStyle:=AForm.BorderStyle
  else
    ABorderStyle:=bsSizeable;

  {$IFDEF Gtk2}

  case ABorderStyle of
    bsNone: Result := 0;

    bsSingle: Result := 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_TITLE or GDK_DECOR_MENU;

    bsSizeToolWin: Result := GDK_DECOR_BORDER or GDK_DECOR_TITLE or
                   GDK_DECOR_MENU or GDK_DECOR_RESIZEH;
  end;

  if not (csDesigning in AForm.ComponentState) then
  begin
    if not (biMinimize in AForm.BorderIcons) then
      Result := Result and not GDK_DECOR_MINIMIZE;
    if not (biMaximize in AForm.BorderIcons) then
      Result := Result and not GDK_DECOR_MAXIMIZE;
    if not (biSystemMenu in AForm.BorderIcons) then
      Result := Result and not GDK_DECOR_MENU;
  end;

  {$ELSE}
  case ABorderStyle of
    bsNone : Result := 0;

    bsSingle : Result := 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_TITLE or GDK_DECOR_MENU;

    bsSizeToolWin :Result := GDK_DECOR_BORDER or GDK_DECOR_TITLE or
                   GDK_DECOR_MENU or GDK_DECOR_RESIZEH;
  end;
  {$ENDIF}

  //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
  Result:=0;
  if not (csDesigning in AForm.ComponentState) then
    ABorderStyle:=AForm.BorderStyle
  else
    ABorderStyle:=bsSizeable;

  {$IFDEF Gtk2}
  case ABorderStyle of
    bsNone : Result := GDK_FUNC_RESIZE or GDK_FUNC_CLOSE {$ifndef windows}or GDK_FUNC_MOVE{$endif};

    bsSingle : Result := 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_CLOSE or GDK_FUNC_MINIMIZE
                or GDK_FUNC_MOVE;

    bsToolWindow : Result := GDK_FUNC_MOVE or GDK_FUNC_CLOSE;

    bsSizeToolWin : Result := GDK_FUNC_RESIZE or GDK_FUNC_MOVE or GDK_FUNC_CLOSE;
  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;

  if (not (csDesigning in AForm.ComponentState)) then
  begin
    if not (biMinimize in AForm.BorderIcons) then
      Result:=Result and not GDK_FUNC_MINIMIZE;
    if not (biMaximize in AForm.BorderIcons) then
      Result:=Result and not GDK_FUNC_MAXIMIZE;
  end;
  {$ELSE}
  case ABorderStyle of
    bsNone : Result := GDK_FUNC_RESIZE or GDK_FUNC_CLOSE;

    bsSingle : Result := 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_CLOSE or GDK_FUNC_MINIMIZE
                or GDK_FUNC_MOVE;

    bsToolWindow : Result := GDK_FUNC_MOVE or GDK_FUNC_CLOSE;

    bsSizeToolWin : Result := GDK_FUNC_RESIZE or GDK_FUNC_MOVE or GDK_FUNC_CLOSE;
  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;
  {$ENDIF}

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

procedure FillScreenFonts(ScreenFonts : TStrings);
var
  {$ifdef gtk1}
  theFonts : PPChar;
  {$else}
  Widget : PGTKWidget;
  Context : PPangoContext;
  families : PPPangoFontFamily;
  {$endif}
  Tmp: AnsiString;
  I, N: Integer;
begin
  ScreenFonts.Clear;
  {$ifdef gtk1}
  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);
  {$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(TGtkDeviceContext(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.
}
{$IFDEF UseXinerama}
{$IFDEF StaticXinerama}
{$LINKLIB Xinerama}
{$ENDIF}
var
  FirstScreenCalled: Boolean = False;
  FirstScreenResult: Boolean = False;
{ 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];
  end;
  if current_desktop <> nil then
    XFree (current_desktop);
end;
{$ENDIF}

function FindFocusWidget(AWidget: PGtkWidget): PGtkWidget;
var
  WinWidgetInfo: PWinWidgetInfo;
  ImplWidget: PGtkWidget;
  GList: PGlist;
  LastFocusWidget: PGtkWidget;
begin
  // Default to the widget, try to find other
  Result := AWidget;

  // Combo
  if GtkWidgetIsA(AWidget, gtk_combo_get_type)
  then begin
    // handle is a gtk combo
    {$IfDef VerboseFocus}
    DebugLn('  D taking gtkcombo entry');
    {$EndIf}
    Result := PgtkWidget(PGtkCombo(AWidget)^.entry);
    Exit;
  end;

  // check if widget has a WinWidgetInfo record
  WinWidgetInfo := GetWidgetInfo(AWidget, false);
  if WinWidgetInfo = nil then Exit;

  ImplWidget:= WinWidgetInfo^.CoreWidget;
  if ImplWidget = nil then Exit;
  // set default to the implementation widget
  Result := ImplWidget;

  // handle has an ImplementationWidget
  if GtkWidgetIsA(ImplWidget, gtk_list_get_type)
  then begin
    {$IfDef VerboseFocus}
    DebugLn('  E using list');
    {$EndIf}
    // Try the last added selected
    if not (selection_mode(PGtkList(ImplWidget)^) in [GTK_SELECTION_SINGLE, GTK_SELECTION_BROWSE])
    and (PGtkList(ImplWidget)^.last_focus_child <> nil)
    then begin
      LastFocusWidget:=PGtkList(ImplWidget)^.last_focus_child;
      if g_list_find(PGtkList(ImplWidget)^.selection,LastFocusWidget)<>nil
      then begin
        Result := PGtkList(ImplWidget)^.last_focus_child;
        {$IfDef VerboseFocus}
        DebugLn('  E.1 using last_focus_child');
        {$EndIf}
        Exit;
      end;
    end;

    // If there is a selection, try the first
    GList := PGtkList(ImplWidget)^.selection;
    if (GList <> nil) and (GList^.data <> nil)
    then begin
      Result := GList^.data;
      {$IfDef VerboseFocus}
      DebugLn('  E.2 using 1st selection');
      {$EndIf}
      Exit;
    end;

    // If not in browse mode, set focus to the first child
    // in browsemode, the focused item cannot be selected by mouse
//      if selection_mode(PGtkList(ImplWidget)^) = GTK_SELECTION_BROWSE
//      then begin
//        {$IfDef VerboseFocus}
//        DebugLn('  E.3 Browse mode -> using ImplWidget');
//        {$EndIf}
//        Exit;
//      end;

    GList := PGtkList(ImplWidget)^.children;
    if GList = nil then Exit;
    if GList^.Data = nil then Exit;
    Result := GList^.Data;
    {$IfDef VerboseFocus}
    DebugLn('  E.4 using 1st child');
    {$EndIf}

    Exit;
  end;

  {$IfDef VerboseFocus}
  DebugLn('  E taking ImplementationWidget');
  {$EndIf}
end;


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

// included by gtkproc.pp