1{  $Id$  }
2{
3 /***************************************************************************
4                             GTKWinapiWindow.pp
5                             -------------------
6                       gtkimplementation for basic window
7                   Initial Revision  : Sun Jan 9 16:00:00 GMT+1 2000
8
9
10 ***************************************************************************/
11
12 *****************************************************************************
13  This file is part of the Lazarus Component Library (LCL)
14
15  See the file COPYING.modifiedLGPL.txt, included in this distribution,
16  for details about the license.
17 *****************************************************************************
18}
19{
20@abstract(A GTK widget to support controls derived from a wincontrol)
21@author(TGTKWinapiWindow - Marc Weustink <marc@@freepascal.org>)
22@created(2000)
23@lastmod(2004)
24}
25unit GTKWinapiWindow;
26
27{$mode objfpc}{$H+}
28
29interface
30
31uses
32  SysUtils, LCLProc,
33  {$IFDEF gtk2}
34  GtkExtra, glib2, gdk2pixbuf, gdk2, gtk2,
35  {$ELSE}
36  glib, gdk, gtk, gdkpixbuf, gtkextra,
37  {$ENDIF}
38  Controls, GTKProc, GtkDef;
39
40{ $Define VerboseCaret}
41// the gtk has a function to draw the cursor, but it does not support xor
42// so it does not work with synedit and twilight hightlighter settings
43{$IFNDEF GTK1}{off $DEFINE Has_gtk_draw_insertion_cursor}{$ENDIF}
44
45type
46  PGTKAPIWidget = ^TGTKAPIWidget;
47  TGTKAPIWidget = record
48    // ! the ScrolledWindow must be the first attribute of this record !
49    ScrolledWindow: TGTKScrolledWindow;
50    Reserved1: Word; // workaround gtk2 win32 fpc bug: SizeOf(TGTKScrolledWindow) is less than in real
51    Frame: PGtkFrame;
52    Client: PGtkWidget;
53  end;
54
55  PGTKAPIWidgetClass = ^TGTKAPIWidgetClass;
56  TGTKAPIWidgetClass = record
57    ParentClass: TGTKScrolledWindowClass;
58  end;
59
60procedure HideCaretOfWidgetGroup(ChildWidget: PGtkWidget;
61  var MainWidget: PGtkWidget; var CaretWasVisible: boolean);
62
63function GTKAPIWidget_GetType: GType;
64function GTKAPIWidget_New: PGTKWidget;
65procedure GTKAPIWidget_CreateCaret(APIWidget: PGTKAPIWidget;
66                                 AWidth, AHeight: Integer; ABitmap: PGDKPixmap);
67procedure GTKAPIWidget_DestroyCaret(APIWidget: PGTKAPIWidget);
68procedure GTKAPIWidget_InvalidateCaret(APIWidget: PGTKAPIWidget);
69procedure GTKAPIWidget_HideCaret(APIWidget: PGTKAPIWidget; var OldVisible: boolean);
70procedure GTKAPIWidget_ShowCaret(APIWidget: PGTKAPIWidget);
71procedure GTKAPIWidget_SetCaretPos(APIWidget: PGTKAPIWidget; X, Y: Integer);
72procedure GTKAPIWidget_GetCaretPos(APIWidget: PGTKAPIWidget; var X, Y: Integer);
73procedure GTKAPIWidget_SetCaretRespondToFocus(APIWidget: PGTKAPIWidget;
74  ShowHideOnFocus: boolean);
75procedure GTKAPIWidget_GetCaretRespondToFocus(APIWidget: PGTKAPIWidget;
76  var ShowHideOnFocus: boolean);
77
78procedure GTKAPIWidget_SetShadowType(APIWidget: PGTKAPIWidget; AShadowType: TGtkShadowType);
79
80function GTK_APIWIDGETCLIENT_TYPE: GType;
81
82implementation
83
84const
85  CURSOR_ON_MULTIPLIER    = 2;
86  CURSOR_OFF_MULTIPLIER   = 1;
87  CURSOR_DIVIDER          = 3;
88
89//---------------------------------------------------------------------------
90// gtk_winapiwindow_internal
91//---------------------------------------------------------------------------
92type
93  TCaretInfo = record
94    X: Integer;
95    Y: Integer;
96    Width: Integer;
97    Height: Integer;
98    Visible: Boolean;   // Caret is on (can be visible/invisible due to Blinking)
99    IsDrawn: Boolean;   // Caret is visible at the moment
100    Blinking: Boolean;  // Caret should blink
101    BlinkTime: Integer; // Blink time = show + hide time
102    BlinkTimeout: Integer; // Time after which if there is no user interaction happened blinking must finish
103    BlinkHide: boolean; // current blinking phase is Hide
104    Pixmap: PGDKPixMap;
105    BackPixmap: PGDKPixMap;
106    Timer: guint;
107    ShowHideOnFocus: boolean; // true = hide on loose focus, show on get focus
108    Invalidated: boolean;
109  end;
110
111  PGTKAPIWidgetClient = ^TGTKAPIWidgetClient;
112  TGTKAPIWidgetClient = record
113    // ! the Widget must be the first attribute of the record !
114    Widget: TGtkFixed;
115    Caret: TCaretInfo;
116    {$IFNDEF gtk2}
117    // the IC is only implemented for GKT1. GTK2 needs different code.
118    ic: TGdkIC;
119    ic_attr: PGdkICAttr;
120    {$ENDIF}
121  end;
122
123  PGTKAPIWidgetClientClass = ^TGTKAPIWidgetClientClass;
124  TGTKAPIWidgetClientClass = record
125    ParentClass: TGTKFixedClass;
126//    ParentClass: TGTKWidgetClass;
127
128    set_scroll_adjustments: procedure(Widget: PGTKWidget;
129                               HAdjustment, VAdjustment: PGTKAdjustment); cdecl;
130  end;
131
132{------------------------------------------------------------------------------
133  procedure HideCaretOfWidgetGroup(ChildWidget: PGtkWidget;
134    var MainWidget: PGtkWidget; var CaretWasVisible: boolean);
135
136  Find main widget and if it is a API widget, hide caret.
137 ------------------------------------------------------------------------------}
138procedure HideCaretOfWidgetGroup(ChildWidget: PGtkWidget;
139  var MainWidget: PGtkWidget; var CaretWasVisible: boolean);
140var
141  LCLObject: TObject;
142  IsAPIWidget: Boolean;
143begin
144  MainWidget:=ChildWidget;
145  LCLObject:=GetNearestLCLObject(ChildWidget);
146  if (LCLObject is TWinControl) then
147    MainWidget:=PGtkWidget(TWinControl(LCLObject).Handle);
148  IsAPIWidget:=GtkWidgetIsA(MainWidget,GTKAPIWidget_GetType);
149  CaretWasVisible:=false;
150  if IsAPIWidget then
151    GTKAPIWidget_HideCaret(PGTKAPIWidget(MainWidget),CaretWasVisible);
152end;
153
154{$IFDEF gtk2}
155////////////////////////////////////////////////////
156// TEMP solution until gtkmarshal.inc is implemeted
157//      to get this compiled
158////////////////////////////////////////////////////
159procedure gtk_marshal_VOID__POINTER_POINTER (closure: PGClosure;
160                                             return_value: PGValue;
161                                             n_param_values: guint;
162                                             param_values: PGValue;
163                                             invocation_hint: gpointer;
164                                             marshal_data: gpointer); cdecl; external gtklib;
165////////////////////////////////////////////////////
166{$ELSE}
167////////////////////////////////////////////////////
168// TEMP solution until attr is defined as PGdkICAttr
169////////////////////////////////////////////////////
170function  _gdk_ic_new(attr:PGdkICAttr; mask:TGdkICAttributesType):TGdkIC;cdecl;external gdkdll name 'gdk_ic_new';
171function  _gdk_ic_attr_new:PGdkICAttr;cdecl;external gdkdll name 'gdk_ic_attr_new';
172procedure _gdk_ic_attr_destroy(attr:PGdkICAttr);cdecl;external gdkdll name 'gdk_ic_attr_destroy';
173function  _gdk_ic_set_attr(ic:TGdkIC; attr:PGdkICAttr; mask:TGdkICAttributesType):TGdkICAttributesType;cdecl;external gdkdll name 'gdk_ic_set_attr';
174////////////////////////////////////////////////////
175{$ENDIF}
176
177type
178  {$IFDEF gtk2}
179  GTKEventResult = gboolean;
180  {$ELSE}
181  GTKEventResult = gint;
182  {$ENDIF}
183
184var
185  MParentClass: PGtkFixedClass;
186
187function GTKAPIWidgetClient_Timer(Client: Pointer): GTKEventResult; cdecl; forward;
188procedure GTKAPIWidgetClient_Realize(AWidget: PGTKWidget); cdecl; forward;
189procedure GTKAPIWidgetClient_UnRealize(AWidget: PGTKWidget); cdecl; forward;
190procedure GTKAPIWidgetClient_SizeAllocate (AWidget: PGTKWidget; AAllocation: PGtkAllocation); cdecl; forward;
191
192
193function GTKAPIWidgetClient_KeyPress(Widget: PGTKWidget;
194  Event: PGDKEventKey): GTKEventResult; cdecl; forward;
195function GTKAPIWidgetClient_ButtonPress(Widget: PGTKWidget;
196  Event: PGDKEventButton): GTKEventResult; cdecl; forward;
197function GTKAPIWidgetClient_FocusIn(AWidget: PGTKWidget;
198  Event: PGdkEventFocus): GTKEventResult; cdecl; forward;
199function GTKAPIWidgetClient_FocusOut(AWidget: PGTKWidget;
200  Event: PGdkEventFocus): GTKEventResult; cdecl; forward;
201
202procedure GTKAPIWidgetClient_ClassInit(theClass: Pointer);cdecl; forward;
203{$ifdef gtk2}
204procedure GTKAPIWidgetClient_Init(Client:PGTypeInstance; theClass: Pointer); cdecl; forward;
205{$else}
206procedure GTKAPIWidgetClient_Init(Client, theClass: Pointer); cdecl; forward;
207{$endif}
208function GTKAPIWidgetClient_GetType: GType; forward;
209function GTKAPIWidgetClient_New: PGTKWidget; forward;
210
211procedure GTKAPIWidgetClient_HideCaret(Client: PGTKAPIWidgetClient;
212                                       var OldVisible: boolean); forward;
213procedure GTKAPIWidgetClient_ShowCaret(Client: PGTKAPIWidgetClient); forward;
214procedure GTKAPIWidgetClient_DrawCaret(Client: PGTKAPIWidgetClient; CalledByTimer: boolean); forward;
215procedure GTKAPIWidgetClient_CreateCaret(Client: PGTKAPIWidgetClient;
216  AWidth, AHeight: Integer; ABitmap: PGDKPixmap); forward;
217procedure GTKAPIWidgetClient_DestroyCaret(Client: PGTKAPIWidgetClient); forward;
218procedure GTKAPIWidgetClient_InvalidateCaret(Client: PGTKAPIWidgetClient); forward;
219function GTKAPIWidgetClient_IsPainting(Client: PGTKAPIWidgetClient): boolean; forward;
220procedure GTKAPIWidgetClient_SetCaretPos(Client: PGTKAPIWidgetClient;
221  AX, AY: Integer); forward;
222procedure GTKAPIWidgetClient_GetCaretPos(Client: PGTKAPIWidgetClient;
223  var X, Y: Integer); forward;
224procedure GTKAPIWidgetClient_SetCaretRespondToFocus(Client: PGTKAPIWidgetClient;
225  ShowHideOnFocus: boolean); forward;
226procedure GTKAPIWidgetClient_GetCaretRespondToFocus(Client: PGTKAPIWidgetClient;
227  var ShowHideOnFocus: boolean); forward;
228
229function GTKAPIWidgetClient_GetCursorBlink(Client: PGTKAPIWidgetClient): gboolean; forward;
230function GTKAPIWidgetClient_GetCursorBlinkTime(Client: PGTKAPIWidgetClient): gint; forward;
231function GTKAPIWidgetClient_GetCursorBlinkTimeout(Client: PGTKAPIWidgetClient): gint; forward;
232//-----------------------------
233
234procedure GTKAPIWidget_SetShadowType(APIWidget: PGTKAPIWidget;
235  AShadowType: TGtkShadowType);
236begin
237  if (APIWidget^.Frame <> nil) then
238    gtk_frame_set_shadow_type(APIWidget^.Frame, AShadowType)
239{$ifdef gtk2}
240  else
241    gtk_scrolled_window_set_shadow_type(PGtkScrolledWindow(APIWidget), AShadowType);
242{$endif}
243end;
244
245function GTK_APIWIDGETCLIENT_TYPE: GType;
246begin
247  GTK_APIWIDGETCLIENT_TYPE := GTKAPIWidgetClient_GetType;
248end;
249
250
251function GTKAPIWidgetClient_GetType: GType;
252const
253  TYPE_NAME = 'LCLWinapiClient';
254  TheType: GType = 0;
255  Info: TGTKTypeInfo = (
256    type_name: TYPE_NAME;
257    object_size: SizeOf(TGTKAPIWidgetClient){+100};
258    class_size:  SizeOf(TGTKAPIWidgetClientClass){+100};
259    class_init_func:  @GTKAPIWidgetClient_ClassInit;
260    object_init_func: @GTKAPIWidgetClient_Init;
261    reserved_1: nil;
262    reserved_2: nil;
263    base_class_init_func: nil;
264  );
265begin
266  if (TheType = 0)
267  then begin
268    TheType := gtk_type_from_name(TYPE_NAME);
269    {$IFDEF gtk2}
270    if TheType = 0 then TheType := gtk_type_unique(GTK_TYPE_FIXED, @Info);
271    {$ELSE}
272    if TheType = 0 then TheType := gtk_type_unique(gtk_fixed_type, @Info);
273    {$ENDIF}
274  end;
275  Result := TheType;
276end;
277
278procedure GTKAPIWidgetClient_ClassInit(theClass: Pointer);cdecl;
279// theClass: PGTKAPIWidgetClientClass
280var
281  ObjectClass: PGTKObjectClass;
282  WidgetClass: PGTKWidgetClass;
283  ClientClass: PGTKAPIWidgetClientClass;
284  SignalID: Guint;
285begin
286  ObjectClass := PGTKObjectClass(theClass);
287  WidgetClass := PGTKWidgetClass(theClass);
288  ClientClass := PGTKAPIWidgetClientClass(theClass);
289
290  MParentClass := gtk_type_class(gtk_fixed_get_type);
291  SignalID := gtk_signal_new(
292    'set_scroll_adjustments',
293    GTK_RUN_FIRST,
294    {$IFDEF gtk2}
295    gtk_class_type(ObjectClass),
296    {$ELSE}
297    ObjectClass^.thetype,
298    {$ENDIF}
299    (@ClientClass^.set_scroll_adjustments - Pointer(theClass)),
300    {$IFDEF gtk2}
301    @gtk_marshal_VOID__POINTER_POINTER,
302    {$ELSE}
303    @gtk_marshal_NONE__POINTER_POINTER,
304    {$ENDIF}
305    GTK_TYPE_NONE,
306    2,
307    [gtk_adjustment_get_type, gtk_adjustment_get_type]
308  );
309
310  ClientClass^.set_scroll_adjustments := nil;
311
312  with WidgetClass^ do
313  begin
314    set_scroll_adjustments_signal := SignalID;
315    realize := @GTKAPIWidgetClient_Realize;
316    unrealize := @GTKAPIWidgetClient_UnRealize;
317    size_allocate := @GTKAPIWidgetClient_SizeAllocate;
318    button_press_event := @GTKAPIWidgetClient_ButtonPress;
319    key_press_event := @GTKAPIWidgetClient_KeyPress;
320    focus_in_event := @GTKAPIWidgetClient_FocusIn;
321    focus_out_event := @GTKAPIWidgetClient_FocusOut;
322  end;
323end;
324
325{$ifdef gtk2}
326procedure GTKAPIWidgetClient_Init(Client:PGTypeInstance; theClass: Pointer); cdecl;
327{$else}
328procedure GTKAPIWidgetClient_Init(Client, theClass: Pointer); cdecl;
329{$endif}
330// Client: PGTKAPIWidgetClient
331// theClass: PGTKAPIWidgetClientClass
332begin
333  if theClass=nil then ;
334  gtk_widget_set_flags(PGTKWidget(Client), GTK_CAN_FOCUS);
335  gtk_widget_set_flags(PGTKWidget(Client), GTK_CAN_DEFAULT);
336  {$IfDef GTK2}
337  gtk_widget_unset_flags(PGTKWidget(Client), GTK_NO_WINDOW);
338  {$EndIf}
339  with PGTKAPIWidgetClient(Client)^.Caret do
340  begin
341    Visible := False;
342    IsDrawn := False;
343    Blinking := GTKAPIWidgetClient_GetCursorBlink(PGTKAPIWidgetClient(Client));
344    BlinkTime := GTKAPIWidgetClient_GetCursorBlinkTime(PGTKAPIWidgetClient(Client));
345    BlinkTimeout := GTKAPIWidgetClient_GetCursorBlinkTimeout(PGTKAPIWidgetClient(Client));
346    X := 0;
347    Y := 0;
348    Width := 1;
349    Height := 10;
350    Pixmap := nil;
351    BackPixmap := nil;
352    Timer := 0;
353    ShowHideOnFocus := true;
354  end;
355
356  {$IFNDEF NoStyle}
357  gtk_widget_set_app_paintable(PGTKWidget(Client),true);
358  {$ENDIF}
359end;
360
361function GTKAPIWidgetClient_New: PGTKWidget;
362begin
363  Result := PGTKWidget(gtk_type_new(GTKAPIWidgetClient_GetType()));
364end;
365
366function GTKAPIWidgetClient_Timer(Client: Pointer): GTKEventResult; cdecl;
367// returning 0 would stop the timer, 1 will restart it
368var
369  WClient: PGTKAPIWidgetClient;
370begin
371  WClient := PGTKAPIWidgetClient(Client);
372  if WClient^.Caret.Timer <= 0 then
373  begin
374    Result := gtk_false;
375    exit;
376  end;
377  WClient^.Caret.BlinkHide := not WClient^.Caret.BlinkHide;
378  GTKAPIWidgetClient_DrawCaret(Client,true);
379  if WClient^.Caret.Timer <> 0 then
380    Result := gtk_true
381  else
382    Result := gtk_false;
383end;
384
385procedure GTKAPIWidgetClient_Realize(AWidget: PGTKWidget); cdecl;
386{$IFNDEF gtk2}
387  procedure RealizeIC; // MG: it isn't called, why that?
388  var
389    width, height: GInt;
390    mask: TGdkEventMask;
391    colormap: PGdkColormap;
392    attrmask: TGdkICAttributesType;
393    style, supported_style: TGdkIMStyle;
394    ic: PGdkIC;
395    ic_attr: PGdkICAttr;
396  begin
397    // Note: code is based on gtkentry implementation
398    // don't know if all is needed
399    // MWE
400
401    if gdk_im_ready = 0 then Exit;
402
403    ic_attr := _gdk_ic_attr_new;
404    PGTKAPIWidgetClient(AWidget)^.ic_attr := ic_attr;
405    if ic_attr = nil then Exit;
406
407    attrmask := GDK_IC_ALL_REQ;
408    supported_style := GDK_IM_PREEDIT_NONE or
409                       GDK_IM_PREEDIT_NOTHING or
410                       GDK_IM_PREEDIT_POSITION or
411                       GDK_IM_STATUS_NONE or
412                       GDK_IM_STATUS_NOTHING;
413
414    if  (AWidget^.thestyle <> nil)
415    and (PGtkStyle(AWidget^.thestyle)^.font^.theType <> GDK_FONT_FONTSET)
416    then supported_style := supported_style and not GDK_IM_PREEDIT_POSITION;
417
418    style := gdk_im_decide_style(supported_style);
419    ic_attr^.style := style;
420    ic_attr^.client_window := AWidget^.window;
421
422    colormap := gtk_widget_get_colormap(AWidget);
423    if colormap <> gtk_widget_get_default_colormap
424    then begin
425      attrmask := attrmask or GDK_IC_PREEDIT_COLORMAP;
426      ic_attr^.preedit_colormap := colormap;
427    end;
428    attrmask := attrmask or GDK_IC_PREEDIT_FOREGROUND or GDK_IC_PREEDIT_BACKGROUND;
429    ic_attr^.preedit_foreground := PGtkStyle(AWidget^.thestyle)^.fg[GTK_STATE_NORMAL];
430    ic_attr^.preedit_background := PGtkStyle(AWidget^.thestyle)^.base[GTK_STATE_NORMAL];
431
432    if (style and GDK_IM_PREEDIT_MASK) = GDK_IM_PREEDIT_POSITION
433    then begin
434      if  (AWidget^.thestyle <> nil)
435      and (PGtkStyle(AWidget^.thestyle)^.font^.thetype <> GDK_FONT_FONTSET)
436      then begin
437        DebugLn('[WAWc] over-the-spot style requires fontset');
438      end
439      else begin
440        gdk_window_get_size(AWidget^.window, @width, @height);
441
442        attrmask := attrmask or GDK_IC_PREEDIT_POSITION_REQ;
443        ic_attr^.spot_location.x := 0;
444        ic_attr^.spot_location.y := guint16(height);
445        ic_attr^.preedit_area.x := 0;
446        ic_attr^.preedit_area.y := 0;
447        ic_attr^.preedit_area.width := guint16(width);
448        ic_attr^.preedit_area.height := guint16(height);
449        ic_attr^.preedit_fontset := PGtkStyle(AWidget^.thestyle)^.font;
450      end;
451    end;
452
453    ic := _gdk_ic_new(ic_attr, attrmask);
454    PGTKAPIWidgetClient(AWidget)^.ic := ic;
455    if ic = nil
456    then begin
457      DebugLn('[WAWc] Can''t create input context.')
458    end
459    else begin
460      mask := gdk_window_get_events(AWidget^.Window);
461      mask := mask or gdk_ic_get_events(ic);
462      gdk_window_set_events(AWidget^.Window, mask);
463
464      if GTK_WIDGET_HAS_FOCUS(Awidget)
465      then gdk_im_begin(ic, AWidget^.Window);
466    end;
467  end;
468{$ENDIF}
469
470// All //@ marked lines are already set by the inherited realize
471// we only have to (re)set the event mask
472
473var
474  Info: PWidgetInfo;
475//@  Attributes: TGdkWindowAttr;
476//@  AttributesMask: gint;
477begin
478  PGTKWidgetClass(MParentClass)^.realize(AWidget);
479
480//@  gtk_widget_set_flags(AWidget, GTK_REALIZED);
481
482  {$IFNDEF GTK1}
483  gtk_widget_set_double_buffered(AWidget, True); // True bites caret => ToDo
484  gtk_widget_set_redraw_on_allocate(AWidget, False);
485  {$ENDIF}
486
487//@  with Attributes do
488//@  begin
489//@    Window_type := gdk_window_child;
490//@    X := AWidget^.allocation.x;
491//@    Y := AWidget^.allocation.y;
492//@    Width := AWidget^.allocation.width;
493//@    Height := AWidget^.allocation.height;
494//@    WClass := GDK_INPUT_OUTPUT;
495//@    Visual := gtk_widget_get_visual(AWidget);
496//@    Colormap := gtk_widget_get_colormap(AWidget);
497//@    Event_mask := gtk_widget_get_events(AWidget)
498//@      or GDK_EXPOSURE_MASK or GDK_BUTTON_PRESS_MASK or GDK_BUTTON_RELEASE_MASK
499//@      or GDK_BUTTON_MOTION_MASK or GDK_ENTER_NOTIFY_MASK or GDK_LEAVE_NOTIFY_MASK
500//@      or GDK_KEY_PRESS_MASK or GDK_KEY_RELEASE_MASK;
501//@  end;
502//@  AttributesMask := GDK_WA_X or GDK_WA_Y or GDK_WA_VISUAL or GDK_WA_COLORMAP;
503//@
504//@  AWidget^.Window := gdk_window_new(gtk_widget_get_parent_window(AWidget),
505//@                                    @Attributes, AttributesMask);
506//@
507//@  gdk_window_set_user_data(AWidget^.Window, AWidget);
508
509  gdk_window_set_events(AWidget^.Window, gdk_window_get_events(AWidget^.Window)
510    or GDK_EXPOSURE_MASK or GDK_BUTTON_PRESS_MASK or GDK_BUTTON_RELEASE_MASK
511    or GDK_BUTTON_MOTION_MASK or GDK_ENTER_NOTIFY_MASK or GDK_LEAVE_NOTIFY_MASK
512    or GDK_KEY_PRESS_MASK or GDK_KEY_RELEASE_MASK);
513
514//@  AWidget^.Style := gtk_style_attach(AWidget^.Style, AWidget^.Window);
515//@  gtk_style_set_background(AWidget^.Style, AWidget^.Window, GTK_STATE_NORMAL);
516  Info := GetWidgetInfo(AWidget);
517  if (Info = nil) or ([wwiNoEraseBkgnd] * Info^.Flags = []) then
518    gdk_window_set_back_pixmap(AWidget^.Window, nil, GdkFalse);
519end;
520
521procedure GTKAPIWidgetClient_UnRealize(AWidget: PGTKWidget); cdecl;
522begin
523  with PGTKAPIWidgetClient(AWidget)^.Caret do
524  begin
525    if Timer <> 0
526    then begin
527      gtk_timeout_remove(Timer);
528      Timer := 0;
529    end;
530  end;
531
532  {$IFNDEF GTK2}
533  with PGTKAPIWidgetClient(AWidget)^ do
534  begin
535    if ic <> nil
536    then begin
537      gdk_ic_destroy(ic);
538      ic := nil;
539    end;
540    if ic_attr <> nil
541    then begin
542      _gdk_ic_attr_destroy(ic_attr);
543      ic_attr := nil;
544    end;
545  end;
546  {$ENDIF}
547
548  PGTKWidgetClass(MParentClass)^.unrealize(AWidget);
549end;
550
551procedure GTKAPIWidgetClient_SizeAllocate(AWidget: PGTKWidget;
552  AAllocation: PGtkAllocation); cdecl;
553{$IFNDEF GTK2}
554var
555  width, height: GInt;
556  ic: PGdkIC;
557  ic_attr: PGdkICAttr;
558{$ENDIF}
559begin
560  PGTKWidgetClass(MParentClass)^.size_allocate(AWidget, AAllocation);
561
562  {$IFNDEF GTK2}
563  ic := PGTKAPIWidgetClient(AWidget)^.ic;
564  ic_attr := PGTKAPIWidgetClient(AWidget)^.ic_attr;
565
566  if  (ic <> nil)
567  and (gdk_ic_get_style(ic) and GDK_IM_PREEDIT_POSITION <> 0)
568  then begin
569    gdk_window_get_size(AWidget^.Window, @width, @height);
570    ic_attr^.preedit_area.width := guint16(width);
571    ic_attr^.preedit_area.height := guint16(height);
572    _gdk_ic_set_attr(ic, ic_attr, GDK_IC_PREEDIT_AREA);
573  end;
574  {$ENDIF}
575end;
576
577
578function GTKAPIWidgetClient_KeyPress(Widget: PGTKWidget;
579  Event: PGDKEventKey): GTKEventResult; cdecl;
580begin
581  if (Widget=nil) or (Event=nil) then ;
582
583
584  // DO NOT supress further processing. The next one who changes that please do the debugging too.
585  // just do not.
586
587{$ifdef gtk2}
588  Result := gtk_False;
589{$else}
590  Result := gtk_True;
591{$endif}
592end;
593
594function GTKAPIWidgetClient_ButtonPress(Widget: PGTKWidget;
595  Event: PGDKEventButton): GTKEventResult; cdecl;
596begin
597  {$IFDEF VerboseFocus}
598  DebugLn('GTKAPIWidgetClient_ButtonPress ',DbgS(Widget));
599  {$ENDIF}
600  if Event=nil then ;
601  Result := gtk_False;
602end;
603
604function GTKAPIWidgetClient_FocusIn(AWidget: PGTKWidget;
605  Event: PGdkEventFocus): GTKEventResult; cdecl;
606begin
607  {$IFDEF VerboseFocus}
608  DebugLn('GTKAPIWidgetClient_FocusIn ',DbgS(AWidget),' ',dbgs(event^.{$ifdef gtk1}thein{$else}_in{$endif}));
609  {$ENDIF}
610
611  gtk_widget_set_flags(AWidget, GTK_HAS_FOCUS);
612  GTKAPIWidgetClient_DrawCaret(PGTKAPIWidgetClient(AWidget), False);
613
614  {$IFNDEF GTK2}
615  if PGTKAPIWidgetClient(AWidget)^.ic <> nil
616  then gdk_im_begin(PGTKAPIWidgetClient(AWidget)^.ic, AWidget^.Window);
617  {$ENDIF}
618
619  Result := gtk_False;
620end;
621
622function GTKAPIWidgetClient_FocusOut(AWidget: PGTKWidget;
623  Event: PGdkEventFocus): GTKEventResult; cdecl;
624begin
625  {$IFDEF VerboseFocus}
626  DebugLn('GTKAPIWidgetClient_FocusOut ',DbgS(AWidget),' ',dbgs(event^.{$ifdef gtk1}thein{$else}_in{$endif}));
627  {$ENDIF}
628
629  gtk_widget_unset_flags(AWidget, GTK_HAS_FOCUS);
630  GTKAPIWidgetClient_DrawCaret(PGTKAPIWidgetClient(AWidget), False);
631
632  {$IFNDEF GTK2}
633  gdk_im_end;
634  {$ENDIF}
635
636  Result := gtk_False;
637end;
638
639procedure GTKAPIWidgetClient_HideCaret(Client: PGTKAPIWidgetClient;
640  var OldVisible: boolean);
641begin
642  if Client = nil
643  then begin
644    DebugLn('WARNING: [GTKAPIWidgetClient_HideCaret] Got nil client');
645    Exit;
646  end;
647  {$IFDEF VerboseCaret}
648  DebugLn(['GTKAPIWidgetClient_HideCaret ',DbgS(Client),' ShowHideOnFocus=',Client^.Caret.ShowHideOnFocus]);
649  {$ENDIF}
650  OldVisible:=Client^.Caret.Visible;
651  Client^.Caret.Visible := False;
652  GTKAPIWidgetClient_DrawCaret(Client,false);
653
654  {if (Client^.Caret.IsDrawn) then begin
655    with Client^.Caret do begin
656      DebugLn('GTKAPIWidgetClient_ShowCaret IsDrawn=',dbgs(IsDrawn),' Visible=',dbgs(Visible),
657        ' Blinking='+dbgs(Blinking),' HasFocus=',dbgs(gtk_widget_has_focus(PGtkWidget(Client))),
658        ' ShowHideOnFocus='+dbgs(ShowHideOnFocus),
659        ' Window='+dbgs(PGtkWidget(Client)^.Window<>nil),
660        ' Style='+dbgs(gtk_widget_get_style(PGtkWidget(Client))<>nil));
661    end;
662  end;}
663end;
664
665function GTKAPIWidgetClient_GetCursorBlink(Client: PGTKAPIWidgetClient): gboolean;
666{$ifndef GTK1}
667var
668  settings: PGtkSettings;
669{$endif}
670begin
671{$ifdef GTK1}
672  Result := True;
673{$else}
674  settings := gtk_widget_get_settings(PGtkWidget(Client));
675  g_object_get(settings, 'gtk-cursor-blink', @Result, nil);
676{$endif}
677end;
678
679function GTKAPIWidgetClient_GetCursorBlinkTime(Client: PGTKAPIWidgetClient): gint;
680{$ifndef GTK1}
681var
682  settings: PGtkSettings;
683{$endif}
684begin
685{$ifdef GTK1}
686  Result := 1200;
687{$else}
688  settings := gtk_widget_get_settings(PGtkWidget(Client));
689  g_object_get(settings, 'gtk-cursor-blink-time', @Result, nil);
690{$endif}
691end;
692
693function GTKAPIWidgetClient_GetCursorBlinkTimeout(Client: PGTKAPIWidgetClient): gint;
694{$ifndef GTK1}
695var
696  settings: PGtkSettings;
697{$endif}
698begin
699{$ifdef GTK1}
700  Result := $7FFFFFFF;
701{$else}
702  settings := gtk_widget_get_settings(PGtkWidget(Client));
703  g_object_get(settings, 'gtk-cursor-blink-timeout', @Result, nil);
704{$endif}
705end;
706
707procedure GTKAPIWidgetClient_DrawCaret(Client: PGTKAPIWidgetClient; CalledByTimer: boolean);
708{ ShowCaret/HideCaret are used in winapi like:
709   ShowCaret (paint xor)
710   Blinking (restore)
711   StartPaintEvent
712   HideCaret
713   Painting
714   ShowCaret
715   EndPaintEvent
716   Blinking
717
718   Moving a caret works like this: HideCaret, move, ShowCaret
719
720   The gtk2 uses double buffering with clipping.
721   This means, during a paint event you can only paint in the clipping area,
722   which does not need to be rectangular.
723   => If the caret would be painted outside the paint event, then we can not hide
724   it if the clipping area does not completely contain the old position.
725   => Therefore we can only paint either inside or outside the paint event.
726   Painting outside the paint event means that between painting and showing
727   caret there are other events, so continuus painting will hardly show the
728   caret. It appears to be almost invisible.
729   => Therefore we must paint only inside the paint event
730   Algorithm:
731     InvalidateRect automatically invalidates the caret
732     Hide
733       outside paint event: invalidate and IsDrawn:=false
734       inside paint event: IsDrawn:=false
735     Show
736       outside paint event: invalidate
737       inside paint event: draw and IsDrawn:=true
738
739     Blinking makes it more complicated, because a Hide triggers an OnPaint,
740     which triggers in synedit code HideCaret+ShowCaret.
741}
742var
743  Widget: PGTKWidget;
744  WidgetStyle: PGTKStyle;
745  HasFocus: boolean;
746  WidgetIsPainting: Boolean;
747{$IFDEF Has_gtk_draw_insertion_cursor}
748  location: TGdkRectangle;
749{$ENDIF}
750
751  procedure DrawCursor(Pixmap: PGdkPixmap; X, Y, Width, Height: Integer);
752  const
753    GC_STATE: array[Boolean] of TGtkStateType =
754   (
755     GTK_STATE_INSENSITIVE,
756     GTK_STATE_NORMAL
757   );
758  var
759    ForeGroundGC: PGdkGC;
760  begin
761    // set draw function to xor
762    ForeGroundGC := WidgetStyle^.fg_gc[GC_STATE[PtrUInt(Pixmap) <> 1]];
763    //gdk_gc_get_values(ForeGroundGC,@ForeGroundGCValues);
764    //OldGdkFunction:=ForeGroundGCValues.thefunction;
765    {$IFDEF VerboseCaret}
766    DebugLn(['GTKAPIWidgetClient_DrawCaret Real Draw ',X,',',Y]);
767    {$ENDIF}
768    gdk_gc_set_function(ForeGroundGC,GDK_invert);
769    try
770      // draw the caret
771      //DebugLn('DRAWING');
772      gdk_draw_rectangle(
773        Widget^.Window,
774        ForeGroundGC,
775        1,
776        X, Y-1,  // Y-1 for Delphi compatibility
777        Width, Height
778      );
779    finally
780      // restore draw function
781      gdk_gc_set_function(ForeGroundGC, GDK_COPY);
782    end;
783  end;
784
785begin
786  if Client = nil then
787  begin
788    DebugLn('WARNING: [GTKAPIWidgetClient_DrawCaret] Got nil client');
789    Exit;
790  end;
791
792  Widget := PGTKWidget(Client);
793  WidgetStyle := gtk_widget_get_style(Widget);
794  WidgetIsPainting := GTKAPIWidgetClient_IsPainting(Client);
795
796  with Client^.Caret do
797  begin
798    HasFocus := gtk_widget_has_focus(Widget);
799    if WidgetIsPainting then
800      Invalidated := false;
801
802    {$IFDEF VerboseCaret}
803    DebugLn(['GTKAPIWidgetClient_DrawCaret START Client=',DbgS(Client),' Timer=',Timer,' Blink=',Blinking,' BlinkHide=',BlinkHide,' Visible=',Visible,' ShowHideOnFocus=',ShowHideOnFocus,' Focus=',gtk_widget_has_focus(Widget),' IsDrawn=',IsDrawn,' W=',Width,' H=',Height,' WidgetIsPainting=',WidgetIsPainting]);
804    {$ENDIF}
805
806    if IsDrawn and
807       (
808         (not Visible) or
809         (Blinking and BlinkHide)
810       ) then
811    begin
812      // hide caret (restore background)
813      if WidgetIsPainting then
814      begin
815        if (BackPixmap <> nil) and (Widget<>nil) and (WidgetStyle<>nil) then
816        begin
817          gdk_draw_pixmap(
818            Widget^.Window,
819            WidgetStyle^.bg_gc[GTK_STATE_NORMAL],
820            BackPixmap, 0, 0,
821            X, Y-1, // Y-1 for Delphi compatibility
822            Width, Height
823          );
824          {$IFDEF VerboseCaret}
825          DebugLn(['GTKAPIWidgetClient_DrawCaret Real Hide ',X,',',Y]);
826          {$ENDIF}
827        end;
828        IsDrawn := False;
829        Invalidated:=false;
830      end else
831      begin
832        // paint only during painting, otherwise invalidate
833        {$IFDEF VerboseCaret}
834        DebugLn(['GTKAPIWidgetClient_DrawCaret Invalidate Hide ',X,',',Y]);
835        {$ENDIF}
836        GTKAPIWidgetClient_InvalidateCaret(Client);
837        IsDrawn := false;
838      end;
839    end
840    else
841    if Visible
842    and (HasFocus or (not ShowHideOnFocus))
843    and (not IsDrawn)
844    and (not (Blinking and BlinkHide))
845    and (Widget^.Window<>nil)
846    and (WidgetStyle<>nil)
847    then begin
848      //if Pixmap <> nil then
849        //DebugLn('Trace:TODO: [GTKAPIWidgetClient_DrawCaret] Implement bitmap');
850
851      if WidgetIsPainting then
852      begin
853        //Create backbitmap if needed
854        if (BackPixmap = nil)
855        and (Widget^.Window<>nil)
856        and (Width>0)
857        and (Height>0)
858        then
859          BackPixmap := gdk_pixmap_new(Widget^.Window, Width, Height, -1);
860
861        // store background
862        if (BackPixmap <> nil)
863        and (Widget<>nil)
864        and (WidgetStyle<>nil)
865        and (Width>0) and (Height>0)
866        then begin
867          {$IFDEF VerboseCaret}
868          DebugLn(['GTKAPIWidgetClient_DrawCaret Store ',X,',',Y]);
869          {$ENDIF}
870          gdk_draw_pixmap(
871            BackPixmap,
872            WidgetStyle^.bg_gc[GTK_STATE_NORMAL],
873            Widget^.Window,
874              X, Y-1, // Y-1 for Delphi compatibility
875              0, 0,
876              Width, Height
877          );
878        end;
879
880        // draw caret
881        {$IFDEF VerboseCaret}
882        DebugLn(['GTKAPIWidgetClient_DrawCaret SHOWING Client=',DbgS(Client)
883        ,' ',cardinal(WidgetStyle)
884        ,' ',cardinal(Widget^.Window)
885        ,' X=',X,' Y=',Y
886        ,' W=',Width
887        ,' H=',Height
888        ]);
889        {$ENDIF}
890        if (WidgetStyle<>nil)
891        and (Widget^.Window<>nil)
892        and (Width>0)
893        and (Height>0)
894        then begin
895          {$IFDEF Has_gtk_draw_insertion_cursor}
896          if Width <= 3 then
897          begin
898            location.x := X;
899            location.y := Y - 1;
900            location.width := 0;
901            location.height := Height;
902            gtk_draw_insertion_cursor(Widget, Widget^.Window, nil, @location, PtrUInt(Pixmap) <> 1,
903               GTK_TEXT_DIR_LTR, false);
904          end
905          else
906          {$ENDIF}
907            DrawCursor(Pixmap, X, Y, Width, Height);
908        end else
909          DebugLn('***: Draw Caret failed: Client=',DbgS(Client),
910            ' X='+dbgs(X)+' Y='+dbgs(Y)+' W='+dbgs(Width)+' H='+dbgs(Height),
911            ' ',dbgs(Pixmap<>nil),',',dbgs(Widget^.Window),',',dbgs(WidgetStyle));
912        IsDrawn := True;
913        Invalidated:=false;
914      end else begin
915        // not in a paint event => use only invalidate
916        {$IFDEF VerboseCaret}
917        DebugLn(['GTKAPIWidgetClient_DrawCaret Invalidate Show']);
918        {$ENDIF}
919        GTKAPIWidgetClient_InvalidateCaret(Client);
920      end;
921    end;
922
923    // stop, start timer
924    if Visible and Blinking and ((not ShowHideOnFocus) or HasFocus) then
925    begin
926      if Timer = 0 then
927        if IsDrawn then
928          Timer := gtk_timeout_add(BlinkTime * CURSOR_ON_MULTIPLIER div CURSOR_DIVIDER,
929            @GTKAPIWidgetClient_Timer, Client)
930        else
931          Timer := gtk_timeout_add(BlinkTime * CURSOR_OFF_MULTIPLIER div CURSOR_DIVIDER,
932            @GTKAPIWidgetClient_Timer, Client)
933    end else
934    begin
935      if Timer <> 0 then
936      begin
937        gtk_timeout_remove(Timer);
938        Timer := 0;
939      end;
940    end;
941
942    {$IFDEF VerboseCaret}
943    DebugLn(['GTKAPIWidgetClient_DrawCaret END Client=',DbgS(Client),' Timer=',Timer,' Blink=',Blinking,' BlinkHide=',BlinkHide,' Visible=',Visible,' ShowHideOnFocus=',ShowHideOnFocus,' Focus=',gtk_widget_has_focus(Widget),' IsDrawn=',IsDrawn,' W=',Width,' H=',Height,' WidgetIsPainting=',WidgetIsPainting]);
944    {$ENDIF}
945  end;
946end;
947
948procedure GTKAPIWidgetClient_ShowCaret(Client: PGTKAPIWidgetClient);
949begin
950  //DebugLn('[GTKAPIWidgetClient_ShowCaret] A Client=',DbgS(Client));
951  if Client = nil
952  then begin
953    DebugLn('WARNING: [GTKAPIWidgetClient_ShowCaret] Got nil client');
954    Exit;
955  end;
956
957  {$IFDEF VerboseCaret}
958  DebugLn('GTKAPIWidgetClient_ShowCaret ',DbgS(Client));
959  {$ENDIF}
960
961  Client^.Caret.Visible := True;
962  GTKAPIWidgetClient_DrawCaret(Client,false);
963end;
964
965procedure GTKAPIWidgetClient_CreateCaret(Client: PGTKAPIWidgetClient;
966  AWidth, AHeight: Integer; ABitmap: PGDKPixmap);
967var
968  IsVisible: Boolean;
969  WasVisible: boolean;
970begin
971  {$IFDEF VerboseCaret}
972  DebugLn(['********** [GTKAPIWidgetClient_CreateCaret] A Client=',DbgS(Client),' Width=',AWidth,' Height=',AHeight,' Bitmap=',ABitmap<>nil]);
973  {$ENDIF}
974  if Client = nil
975  then begin
976    DebugLn('WARNING: [GTKAPIWidgetClient_CreateCaret] Got nil client');
977    Exit;
978  end;
979
980  with Client^.Caret do
981  begin
982    IsVisible := Visible;
983    if IsVisible then GTKAPIWidgetClient_HideCaret(Client,WasVisible);
984
985    if (Width <> AWidth) or (Height <> AHeight)
986    then begin
987      if BackPixmap <> nil then gdk_pixmap_unref(BackPixmap);
988      BackPixmap := nil;
989      Width := AWidth;
990      Height := AHeight;
991    end;
992
993    Pixmap := ABitmap;
994
995    if IsVisible then GTKAPIWidgetClient_ShowCaret(Client);
996  end;
997end;
998
999procedure GTKAPIWidgetClient_DestroyCaret(Client: PGTKAPIWidgetClient);
1000var
1001  WasVisible: boolean;
1002begin
1003  {$IFDEF VerboseCaret}
1004  DebugLn('********** [GTKAPIWidgetClient_DestroyCaret] A Client=',DbgS(Client));
1005  {$ENDIF}
1006  if Client = nil
1007  then begin
1008    DebugLn('WARNING: [GTKAPIWidgetClient_DestroyCaret] Got nil client');
1009    Exit;
1010  end;
1011
1012  with Client^.Caret do begin
1013    if Visible then begin
1014      Visible:=false;
1015      GTKAPIWidgetClient_HideCaret(Client,WasVisible);
1016    end;
1017
1018    if Timer<>0 then begin
1019      gtk_timeout_remove(Timer);
1020      Timer:=0;
1021    end;
1022
1023    if BackPixmap <> nil then begin
1024      gdk_pixmap_unref(BackPixmap);
1025      BackPixmap := nil;
1026    end;
1027    Pixmap := nil;
1028  end;
1029  {$IFDEF VerboseCaret}
1030  DebugLn('********** B[GTKAPIWidgetClient_DestroyCaret] A Client=',DbgS(Client));
1031  {$ENDIF}
1032end;
1033
1034procedure GTKAPIWidgetClient_InvalidateCaret(Client: PGTKAPIWidgetClient);
1035begin
1036  {$IFDEF VerboseCaret}
1037  DebugLn('********** [GTKAPIWidgetClient_InvalidateCaret] A Client=',DbgS(Client));
1038  {$ENDIF}
1039  with Client^.Caret do begin
1040    if not Invalidated then begin
1041      {$IFDEF VerboseCaret}
1042      DebugLn(['GTKAPIWidgetClient_InvalidateCaret invalidate caret: X=',X,' Y=',Y-1,' ',Width,'x',Height]);
1043      {$ENDIF}
1044      gtk_widget_queue_draw_area(PGtkWidget(Client),
1045          X, Y-1, // Y-1 for Delphi compatibility
1046          Width,Height);
1047      Invalidated:=true;
1048    end;
1049  end;
1050  {$IFDEF VerboseCaret}
1051  DebugLn('********** B[GTKAPIWidgetClient_InvalidateCaret] A Client=',DbgS(Client));
1052  {$ENDIF}
1053end;
1054
1055function GTKAPIWidgetClient_IsPainting(Client: PGTKAPIWidgetClient): boolean;
1056{$IFNDEF Gtk1}
1057var
1058  Info: PWidgetInfo;
1059{$ENDIF}
1060begin
1061  {$IFDEF Gtk1}
1062  // the gtk1 has no double buffering, there is no difference between
1063  // painting outside/inside OnPaint
1064  Result:=true;
1065  {$ELSE}
1066  Info:=GetWidgetInfo(Client,false);
1067  Result:=(Info<>nil) and (Info^.PaintDepth>0);
1068  {$ENDIF}
1069end;
1070
1071procedure GTKAPIWidgetClient_SetCaretPos(Client: PGTKAPIWidgetClient;
1072  AX, AY: Integer);
1073var
1074  IsVisible, WasVisible: Boolean;
1075begin
1076  {$IFDEF VerboseCaret}
1077  DebugLn('[GTKAPIWIDGETCLIENT] SetCaretPos '+inttostr(ax)+','+Inttostr(ay));
1078  {$ENDIF}
1079
1080  if Client = nil
1081  then begin
1082    DebugLn('WARNING: [GTKAPIWidgetClient_SetCaretPos] Got nil client');
1083    Exit;
1084  end;
1085
1086  with Client^.Caret do
1087  begin
1088    if (X=AX) and (Y=AY) then exit;
1089    IsVisible := Visible;
1090    if IsVisible then GTKAPIWidgetClient_HideCaret(Client,WasVisible);
1091    X := AX;
1092    Y := AY;
1093    BlinkHide:=false;// start show phase
1094    Invalidated:=false;
1095    if Timer<>0 then begin
1096      // reset timer
1097      gtk_timeout_remove(Timer);
1098      Timer:=0;
1099    end;
1100    if IsVisible then GTKAPIWidgetClient_ShowCaret(Client);
1101  end;
1102end;
1103
1104procedure GTKAPIWidgetClient_GetCaretPos(Client: PGTKAPIWidgetClient;
1105  var X, Y: Integer);
1106begin
1107  if Client = nil
1108  then begin
1109    DebugLn('WARNING: [GTKAPIWidgetClient_GetCaretPos] Got nil client');
1110    Exit;
1111  end;
1112
1113  X := Client^.Caret.X;
1114  Y := Client^.Caret.Y;
1115end;
1116
1117procedure GTKAPIWidgetClient_SetCaretRespondToFocus(Client: PGTKAPIWidgetClient;
1118  ShowHideOnFocus: boolean);
1119begin
1120  {$IFDEF VerboseCaret}
1121  DebugLn(['[GTKAPIWidgetClient_SetCaretRespondToFocus] A ',ShowHideOnFocus]);
1122  {$ENDIF}
1123  if Client = nil
1124  then begin
1125    DebugLn(
1126      'WARNING: [GTKAPIWidgetClient_SetCaretRespondToFocus] Got nil client');
1127    Exit;
1128  end;
1129
1130  Client^.Caret.ShowHideOnFocus:=ShowHideOnFocus;
1131end;
1132
1133procedure GTKAPIWidgetClient_GetCaretRespondToFocus(Client: PGTKAPIWidgetClient;
1134  var ShowHideOnFocus: boolean);
1135begin
1136  if Client = nil
1137  then begin
1138    DebugLn(
1139      'WARNING: [GTKAPIWidgetClient_GetCaretRespondToFocus] Got nil client');
1140    Exit;
1141  end;
1142
1143  ShowHideOnFocus:=Client^.Caret.ShowHideOnFocus;
1144end;
1145
1146//---------------------------------------------------------------------------
1147// GTKAPIWidget
1148//---------------------------------------------------------------------------
1149
1150function GTKAPIWidget_FocusIn(Widget: PGTKWidget;
1151  Event: PGdkEventFocus): GTKEventResult; cdecl;
1152var
1153  TopLevel: PGTKWidget;
1154begin
1155  //DebugLn('Trace:[GTKAPIWidget_FocusIn]');
1156
1157  if Event=nil then ;
1158  TopLevel := gtk_widget_get_toplevel(Widget);
1159  if gtk_type_is_a(gtk_object_type(PGTKObject(TopLevel)), gtk_window_get_type)
1160  then gtk_window_set_focus(PGTKWindow(TopLevel), PGTKAPIWidget(Widget)^.Client);
1161
1162  Result := gtk_True;
1163end;
1164
1165function GTKAPIWidget_FocusOut(Widget: PGTKWidget;
1166  Event: PGdkEventFocus): GTKEventResult; cdecl;
1167begin
1168  if (Event=nil) or (Widget=nil) then ;
1169  //DebugLn('Trace:[GTKAPIWidget_FocusOut]');
1170  Result := gtk_True;
1171end;
1172
1173
1174procedure GTKAPIWidget_ClassInit(wawClass: Pointer); cdecl;
1175//wawClass: PGTKAPIWidgetClass
1176var
1177  WidgetClass: PGTKWidgetClass;
1178begin
1179  WidgetClass := PGTKWidgetClass(wawClass);
1180
1181  WidgetClass^.focus_in_event := @GTKAPIWidget_FocusIn;
1182  WidgetClass^.focus_out_event := @GTKAPIWidget_FocusOut;
1183end;
1184
1185{$ifdef gtk2}
1186procedure GTKAPIWidget_Init(waw:PGTypeInstance; theClass: Pointer); cdecl;
1187{$else}
1188procedure GTKAPIWidget_Init(waw, theClass: Pointer); cdecl;
1189{$endif}
1190// waw: PGTKAPIWidget;
1191// theClass: PGTKAPIWidgetClass
1192var
1193  Widget: PGTKWidget;
1194begin
1195  if theClass=nil then ;
1196  Widget := PGTKWidget(waw);
1197  gtk_widget_set_flags(Widget, GTK_CAN_FOCUS);
1198end;
1199
1200function GTKAPIWidget_GetType: GType;
1201const
1202  WAW_NAME = 'LCLWinapiWidget';
1203  wawInfo: TGTKTypeInfo = (
1204    type_name: WAW_NAME;
1205    object_size: SizeOf(TGTKAPIWidget)+100; // a TGTKScrolledWindow
1206    class_size: SizeOf(TGTKAPIWidgetClass)+100;
1207    class_init_func: @GTKAPIWidget_ClassInit;
1208    object_init_func : @GTKAPIWidget_Init;
1209    reserved_1: nil;
1210    reserved_2: nil;
1211    base_class_init_func: nil;
1212  );
1213begin
1214  if (GTKAPIWidget_Type = 0)
1215  then begin
1216    GTKAPIWidget_Type := gtk_type_from_name(WAW_NAME);
1217    if GTKAPIWidget_Type = 0
1218    then GTKAPIWidget_Type := gtk_type_unique(gtk_scrolled_window_get_type, @wawInfo);
1219  end;
1220  Result := GTKAPIWidget_Type;
1221end;
1222
1223{$IFDEF GTK1}
1224function Laz_GTK_OBJECT_CONSTRUCTED(AnObject: PGtkObject): gboolean; cdecl;external gtkdll name 'gtk_object_constructed';
1225{$ENDIF GTK1}
1226
1227function GTKAPIWidget_new: PGTKWidget;
1228var
1229  APIWidget: PGTKAPIWidget;
1230{$IFDEF gtk1}
1231var
1232  NewArgs: array[0..1] of TGTKArg;
1233{$ENDIF}
1234begin
1235{$IFDEF gtk1}
1236  FillChar(NewArgs[0],SizeOf(TGTKArg)*(High(NewArgs)-Low(NewArgs)+1),0);
1237  NewArgs[0].theType:=GTK_ADJUSTMENT_TYPE;
1238  NewArgs[0].name:='hadjustment';
1239  NewArgs[1].theType:=GTK_ADJUSTMENT_TYPE;
1240  NewArgs[1].name:='vadjustment';
1241
1242  // something is rotten with gtk_widget_newv on some platforms
1243  //Result := gtk_widget_newv(GTKAPIWidget_GetType, 2, @ARGS[0]);
1244
1245  // do it step by step
1246  Result:=gtk_type_new(GTKAPIWidget_GetType);
1247  gtk_object_arg_set (PGtkObject(Result), @NewArgs[0], NULL);
1248  gtk_object_arg_set (PGtkObject(Result), @NewArgs[1], NULL);
1249  if (not Laz_GTK_OBJECT_CONSTRUCTED (PGtkObject(Result))) then
1250    gtk_object_default_construct (PGtkObject(Result));
1251{$ELSE}
1252  // MWE: IMO the arguments can't work since we supply the adjustments as nil
1253  //      for gtk2 newv doesn't exist so the decision is easy
1254  //      TODO: check if we still need to pass the args in gtk1
1255  Result := gtk_widget_new(GTKAPIWidget_GetType, nil, []);
1256{$ENDIF}
1257
1258  APIWidget := PGTKAPIWidget(Result);
1259  gtk_container_set_border_width(PGTKContainer(APIWidget),0);
1260
1261  // create client widget
1262  APIWidget^.Client := GTKAPIWidgetClient_New;
1263  gtk_object_set_data(PGTKObject(Result), 'Fixed', APIWidget^.Client);
1264  gtk_object_set_data(PGTKObject(APIWidget^.Client), 'Main', Result);
1265  gtk_widget_show(APIWidget^.Client);
1266  gtk_container_add(PGTKContainer(APIWidget), APIWidget^.Client);
1267end;
1268
1269procedure GTKAPIWidget_CreateCaret(APIWidget: PGTKAPIWidget;
1270  AWidth, AHeight: Integer; ABitmap: PGDKPixmap);
1271begin
1272  if APIWidget = nil
1273  then begin
1274    DebugLn('WARNING: [GTKAPIWidget_CreateCaret] Got nil client');
1275    Exit;
1276  end;
1277  GTKAPIWidgetClient_CreateCaret(PGTKAPIWidgetClient(APIWidget^.Client),
1278    AWidth, AHeight, ABitmap);
1279end;
1280
1281procedure GTKAPIWidget_DestroyCaret(APIWidget: PGTKAPIWidget);
1282begin
1283  if APIWidget = nil
1284  then begin
1285    DebugLn('WARNING: [GTKAPIWidget_DestroyCaret] Got nil client');
1286    Exit;
1287  end;
1288  GTKAPIWidgetClient_DestroyCaret(PGTKAPIWidgetClient(APIWidget^.Client));
1289end;
1290
1291procedure GTKAPIWidget_InvalidateCaret(APIWidget: PGTKAPIWidget);
1292begin
1293  {$IFDEF VerboseCaret}
1294  DebugLn('[GTKAPIWidget_InvalidateCaret] A');
1295  {$ENDIF}
1296  if APIWidget = nil
1297  then begin
1298    DebugLn('WARNING: [GTKAPIWidget_InvalidateCaret] Got nil client');
1299    Exit;
1300  end;
1301  GTKAPIWidgetClient_InvalidateCaret(PGTKAPIWidgetClient(APIWidget^.Client));
1302end;
1303
1304procedure GTKAPIWidget_HideCaret(APIWidget: PGTKAPIWidget;
1305  var OldVisible: boolean);
1306begin
1307  {$IFDEF VerboseCaret}
1308  DebugLn('[GTKAPIWidget_HideCaret] A');
1309  {$ENDIF}
1310  if APIWidget = nil
1311  then begin
1312    DebugLn('WARNING: [GTKAPIWidget_HideCaret] Got nil client');
1313    Exit;
1314  end;
1315  GTKAPIWidgetClient_HideCaret(PGTKAPIWidgetClient(APIWidget^.Client),OldVisible);
1316end;
1317
1318procedure GTKAPIWidget_ShowCaret(APIWidget: PGTKAPIWidget);
1319begin
1320  {$IFDEF VerboseCaret}
1321  DebugLn('[GTKAPIWidget_ShowCaret] A');
1322  {$ENDIF}
1323  if APIWidget = nil
1324  then begin
1325    DebugLn('WARNING: [GTKAPIWidget_ShowCaret] Got nil client');
1326    Exit;
1327  end;
1328  GTKAPIWidgetClient_ShowCaret(PGTKAPIWidgetClient(APIWidget^.Client));
1329end;
1330
1331procedure GTKAPIWidget_SetCaretPos(APIWidget: PGTKAPIWidget; X, Y: Integer);
1332begin
1333  {$IFDEF VerboseCaret}
1334  DebugLn('[GTKAPIWidget_SetCaretPos] A');
1335  {$ENDIF}
1336  if APIWidget = nil
1337  then begin
1338    DebugLn('WARNING: [GTKAPIWidget_SetCaretPos] Got nil client');
1339    Exit;
1340  end;
1341  GTKAPIWidgetClient_SetCaretPos(PGTKAPIWidgetClient(APIWidget^.Client), X, Y);
1342end;
1343
1344procedure GTKAPIWidget_GetCaretPos(APIWidget: PGTKAPIWidget; var X, Y: Integer);
1345begin
1346  if APIWidget = nil
1347  then begin
1348    DebugLn('WARNING: [GTKAPIWidget_GetCaretPos] Got nil client');
1349    Exit;
1350  end;
1351  GTKAPIWidgetClient_GetCaretPos(PGTKAPIWidgetClient(APIWidget^.Client), X, Y);
1352end;
1353
1354procedure GTKAPIWidget_SetCaretRespondToFocus(APIWidget: PGTKAPIWidget;
1355  ShowHideOnFocus: boolean);
1356begin
1357  {$IFDEF VerboseCaret}
1358  DebugLn(['[GTKAPIWidget_SetCaretRespondToFocus] A ',ShowHideOnFocus]);
1359  {$ENDIF}
1360  if APIWidget = nil
1361  then begin
1362    DebugLn('WARNING: [GTKAPIWidget_SetCaretRespondToFocus] Got nil client');
1363    Exit;
1364  end;
1365  GTKAPIWidgetClient_SetCaretRespondToFocus(
1366    PGTKAPIWidgetClient(APIWidget^.Client), ShowHideOnFocus);
1367end;
1368
1369procedure GTKAPIWidget_GetCaretRespondToFocus(APIWidget: PGTKAPIWidget;
1370  var ShowHideOnFocus: boolean);
1371begin
1372  if APIWidget = nil
1373  then begin
1374    DebugLn('WARNING: [GTKAPIWidget_GetCaretRespondToFocus] Got nil client');
1375    Exit;
1376  end;
1377  GTKAPIWidgetClient_GetCaretRespondToFocus(
1378    PGTKAPIWidgetClient(APIWidget^.Client), ShowHideOnFocus);
1379end;
1380
1381initialization
1382  MParentClass := nil;
1383
1384end.
1385
1386
1387