1{%MainUnit gtk2proc.pp}
2{
3 *****************************************************************************
4  This file is part of the Lazarus Component Library (LCL)
5
6  See the file COPYING.modifiedLGPL.txt, included in this distribution,
7  for details about the license.
8 *****************************************************************************
9}
10
11function DoDeliverPaintMessage(const Target: TObject; var PaintMsg: TLMPaint): PtrInt;
12var
13  WidgetInfo: PWidgetInfo;
14  IsCustomControl: Boolean;
15begin
16  {
17    erase backgound of custom controls
18    use only for real custom controls that are GTKAPIWidget
19  }
20  IsCustomControl := TObject(Target) is TCustomControl;
21  if IsCustomControl then begin
22    Include(TWinControlAccess(Target).FWinControlFlags, wcfEraseBackground);
23    TWinControl(Target).Perform(LM_ERASEBKGND, PtrInt(PaintMsg.DC), 0);
24    Exclude(TWinControlAccess(Target).FWinControlFlags, wcfEraseBackground);
25  end;
26
27  Result := DeliverMessage(Target, PaintMsg);
28
29  if IsCustomControl then begin
30    WidgetInfo := GetWidgetInfo({%H-}PGtkWidget(TCustomControl(Target).Handle));
31    if WidgetInfo <> nil then
32      WidgetInfo^.UpdateRect := Rect(0,0,0,0);
33  end;
34end;
35
36function DeliverPaintMessage(const Target: Pointer; var TheMessage): GBoolean;
37var
38  PaintMsg: TLMPaint;
39begin
40  if TLMessage(TheMessage).Msg = LM_GTKPAINT then
41    PaintMsg := GtkPaintMessageToPaintMessage(TLMGtkPaint(TheMessage), True)
42  else
43    PaintMsg := TLMPaint(TheMessage);
44
45  Result := DoDeliverPaintMessage(TObject(Target), PaintMsg) = 0;
46
47  FinalizePaintMessage(PLMessage(@PaintMsg));
48end;
49
50{-------------------------------------------------------------------------------
51  function DeliverPostMessage(const Target: Pointer; var TheMessage): GBoolean;
52
53  'TheMessage' is in TLMessage format. Don't confuse this with tagMsg.
54--------------------------------------------------------------------------------}
55function DeliverPostMessage(const Target: Pointer; var TheMessage): GBoolean;
56begin
57  if TObject(Target) is TWinControl then
58  begin
59    // convert TLMessage into a tagMsg and push on the message queue
60    Result := PostMessage(TWinControl(Target).Handle,
61                          TLMessage(TheMessage).Msg,
62                          TLMessage(TheMessage).WParam,
63                          TLMessage(TheMessage).LParam
64                          );
65  end
66  else
67  begin
68    if TLMessage(TheMessage).Msg <> LM_GTKPAINT then
69      Result := DeliverMessage(Target, TheMessage) = 0
70    else
71      Result := DeliverPaintMessage(Target, TheMessage);
72  end;
73end;
74
75function DeliverGtkPaintMessage(Target: Pointer; Widget: PGtkWidget;
76  Area: PGDKRectangle; RepaintAll, IsAfterGtk: boolean): GBoolean;
77var
78  Msg: TLMGtkPaint;
79  AInfo: PWidgetInfo;
80begin
81  //DebugLn(['DeliverGtkPaintMessage ',DbgSName(TObject(Target)),' Widget=',GetWidgetDebugReport(Widget),' RepaintAll=',RepaintAll,' AfterGtk=',IsAfterGtk,' Area=',dbgs(Area)]);
82  // default is, that a control receives the paint message after gtk (including the child paints)
83  // In case of TCustomControl, there is no gtk painting only the
84  // child paintings. Let the TCustomControl paint the background.
85  // ToDo: Eventually there must be a 'before paint message'.
86
87  if (TObject(Target) is TCustomForm) then
88  begin
89    AInfo := GetWidgetInfo(Widget);
90    AInfo^.FirstPaint := True;
91  end;
92
93  if IsAfterGtk then
94  begin
95    if TObject(Target) is TCustomControl then exit(false);
96  end else
97  begin
98    if not (TObject(Target) is TCustomControl) then exit(false);
99  end;
100
101  if (not RepaintAll) and ((Area^.Width<1) or (Area^.Height<1)) then exit(false);
102
103  Msg.Msg := LM_GTKPAINT;
104  Msg.Data := TLMGtkPaintData.Create;
105  Msg.Data.Widget := Widget;
106  Msg.Data.State := GtkPaint_LCLWidget;
107  Msg.Data.Rect := Bounds(Area^.x, Area^.y, Area^.Width, Area^.Height);
108  Msg.Data.RepaintAll := RepaintAll;
109
110  // the gtk2 has a working double buffering and expose event area
111  Result := DeliverPaintMessage(Target, Msg);
112end;
113
114procedure EventTrace(const TheMessage : string; data : pointer);
115begin
116//  if Data = nil then
117    //DebugLn(Format('Trace:Event [%s] fired',[Themessage]))
118//  else
119    //DebugLn(Format('Trace:Event [%s] fired for %s',
120    //  [TheMessage, TObject(data).Classname]));
121end;
122
123{*************************************************************}
124{            callback routines                                }
125{*************************************************************}
126
127{-------------------------------------------------------------------------------
128  function gtkNoteBookCloseBtnClicked
129  Params: Widget: PGtkWidget; Data: Pointer
130  Result: GBoolean
131
132  gtkNoteBookCloseBtnClicked is called by the gtk, whenever a close button in
133  the tab of a notebook page is clicked.
134-------------------------------------------------------------------------------}
135function gtkNoteBookCloseBtnClicked({%H-}Widget: PGtkWidget;
136  Data: Pointer): GBoolean; cdecl;
137var APage: TCustomPage;
138begin
139  Result:=true; // handled = true
140  if ComponentIsDestroyingHandle(TWinControl(Data)) then exit;
141  APage:=TCustomPage(Data);
142  TCustomTabControl(APage.Parent).DoCloseTabClicked(APage);
143end;
144
145function FilterFuc({%H-}xevent: PGdkXEvent; {%H-}event: PGdkEvent; {%H-}data: gpointer): TGdkFilterReturn; cdecl;
146{$ifdef windows}
147var
148  AForm: TCustomForm absolute data;
149{$endif}
150begin
151  Result := GDK_FILTER_CONTINUE;
152  {$ifdef windows}
153  if (PMSG(xevent)^.message = WM_NCLBUTTONDOWN) and
154     (PMSG(xevent)^.wParam = HTCAPTION) and
155     not (csDesigning in AForm.ComponentState) and
156     (TWinControlAccess(TWinControl(AForm)).DragKind = dkDock) and
157     (TWinControlAccess(TWinControl(AForm)).DragMode = dmAutomatic) then
158  begin
159    AForm.BeginDrag(True);
160    Result := GDK_FILTER_REMOVE;
161  end;
162  {$endif}
163end;
164
165{-------------------------------------------------------------------------------
166  function GTKRealizeCB
167  Params: Widget: PGtkWidget; Data: Pointer
168  Result: GBoolean
169
170  GTKRealizeCB is called by the gtk, whenever a widget is realized (ie mapped),
171  but before the widget itself gets the realize signal.
172  That means that the gdk window on the xserver has been created.
173-------------------------------------------------------------------------------}
174function gtkRealizeCB(Widget: PGtkWidget; Data: Pointer): GBoolean; cdecl;
175var
176  decor,Func : Longint;
177  TheWindow: PGdkWindow;
178  TheForm: TCustomForm;
179begin
180  Result := CallBackDefaultReturn;
181
182  {$IFDEF EventTrace}
183  EventTrace('realize', nil);
184  {$ENDIF}
185
186  if (Data<>nil) then begin
187    if TObject(Data) is TCustomForm then begin
188      TheForm:=TCustomForm(Data);
189      if TheForm.Parent=nil then begin
190        TheWindow:=gtk_widget_get_toplevel(Widget)^.window;
191
192        //apart from none and sizeable, this will
193        //only work if WM supports motif flags
194        //properly, which very few actually do.
195
196        Decor := GetWindowDecorations(TheForm);
197        Func := GetWindowFunction(TheForm);
198
199        gdk_window_set_decorations(TheWindow, decor);
200        gdk_window_set_functions(TheWindow, func);
201        {$ifdef windows} // for drag/dock
202        gdk_window_add_filter(TheWindow, @FilterFuc, TheForm)
203        {$endif}
204      end;
205    end;
206
207    if (csDesigning in TComponent(Data).ComponentState) then begin
208      //DebugLn(['gtkRealizeCB ',dbgsName(TComponent(Data)),' ',GetWidgetDebugReport(Widget)]);
209    end else begin
210      RealizeAccelerator(TComponent(Data),Widget);
211    end;
212  end;
213end;
214
215{-------------------------------------------------------------------------------
216  function GTKRealizeAfterCB
217  Params: Widget: PGtkWidget; Data: Pointer
218  Result: GBoolean
219
220  GTKRealizeAfterCB is called by the gtk, whenever a widget is realized
221  (ie mapped), and after the widget itself got the realize signal.
222  That means that the gdk window on the xserver has been created and the widget
223  initialized the gdkwindow. This function is used for the second part of
224  the initialization of a widget.
225
226-------------------------------------------------------------------------------}
227function gtkRealizeAfterCB(Widget: PGtkWidget; Data: Pointer): GBoolean; cdecl;
228var
229  MainWidget, ClientWidget: PGtkWidget;
230  WinWidgetInfo: PWidgetInfo;
231  GdkWidget, GdkClient: PGDKWindow;
232  NewEventMask: TGdkEventMask;
233  LCLObject: TObject;
234  TheWinControl: TWinControl;
235begin
236  Result:=CallBackDefaultReturn;
237  if Data=nil then ;
238  {$IFDEF EventTrace}
239  EventTrace('realizeafter', nil);
240  {$ENDIF}
241  MainWidget:=GetMainWidget(Widget);
242  Assert(Assigned(MainWidget), 'gtkRealizeAfterCB: MainWidget not assigned.');
243  WinWidgetInfo:=g_object_get_data(PGObject(MainWidget), 'widgetinfo');
244  Assert(Assigned(WinWidgetInfo), 'gtkRealizeAfterCB: WinWidgetInfo not assigned.');
245  LCLObject:=GetLCLObject(MainWidget);
246  if LCLObject=nil then exit;
247  if (LCLObject is TWinControl) then
248    TheWinControl:=TWinControl(LCLObject)
249  else
250    TheWinControl:=nil;
251
252  // set extra signal masks after the widget window is created
253  // define extra events we're interrested in
254  //if TheWinControl<>nil then DbgOut(' ',TheWinControl.Name,':',TheWinControl.ClassName,' ',DbgS(TheWinControl.Handle));
255  //DebugLn(' Widget=',DbgS(Widget),' Fixed=',DbgS(GetFixedWidget(Widget)),' Main=',DbgS(GetMainWidget(Widget)));
256  if (TheWinControl<>nil) then begin
257    //DebugLn(['gtkRealizeAfterCB ',GetWidgetDebugReport(Widget)]);
258    {$IFDEF DebugGDK}BeginGDKErrorTrap;{$ENDIF}
259
260    GdkWidget:=GetControlWindow(Widget);
261    NewEventMask:=gdk_window_get_events(GdkWidget) or WinWidgetInfo^.EventMask;
262    gtk_widget_add_events(Widget,NewEventMask);
263    gdk_window_set_events(GdkWidget,NewEventMask);
264
265    ClientWidget:=GetFixedWidget(Widget);
266    GdkClient:=GetControlWindow(ClientWidget);
267    if (ClientWidget<>nil) and (GdkClient<>nil) and (GdkClient<>GdkWidget) then
268    begin
269      //DebugLn(['gtkRealizeAfterCB ClientWindow<>Window']);
270      NewEventMask:=gdk_window_get_events(GdkClient) or WinWidgetInfo^.EventMask;
271      gtk_widget_add_events(ClientWidget,WinWidgetInfo^.EventMask);
272      gdk_window_set_events(GdkClient,NewEventMask);
273    end;
274    //DebugLn('BBB1 ',DbgS(NewEventMask),8),' ',DbgS(Cardinal(gdk_window_get_events(Widget^.Window)));
275    {$IFDEF DebugGDK}EndGDKErrorTrap;{$ENDIF}
276  end;
277
278  if TheWinControl<>nil then
279  begin
280    TheWinControl.CNPreferredSizeChanged;
281    TGtkPrivateWidgetClass(TheWinControl.WidgetSetClass.WSPrivate).UpdateCursor(WinWidgetInfo);
282    ConnectInternalWidgetsSignals(MainWidget,TheWinControl);
283
284    if (TheWinControl is TCustomPage)
285      and not ((TheWinControl.Parent <> nil) and (TheWinControl.Parent is TTabControl))
286    then
287      UpdateNotebookPageTab(nil,TheWinControl);
288
289    if TheWinControl is TCustomForm then
290      SetFormShowInTaskbar(TCustomForm(TheWinControl),
291                           TCustomForm(TheWinControl).ShowInTaskbar);
292  end;
293end;
294
295function gtkshowCB( {%H-}widget: PGtkWidget; data: gPointer) : GBoolean; cdecl;
296var
297  Mess : TLMShowWindow;
298begin
299  Result := True;
300
301  {$IFDEF EventTrace}
302  EventTrace('show', data);
303  {$ENDIF}
304  FillChar(Mess{%H-},SizeOf(Mess),0);
305  Mess.Msg := LM_SHOWWINDOW;
306  Mess.Show := True;
307
308  Result := DeliverMessage(Data, Mess) = 0;
309end;
310
311function gtkHideCB( {%H-}widget: PGtkWidget; data: gPointer) : GBoolean; cdecl;
312var
313  Mess : TLMShowWindow;
314begin
315  Result := True;
316
317  {$IFDEF EventTrace}
318  EventTrace('hide', data);
319  {$ENDIF}
320  FillChar(Mess{%H-},SizeOf(Mess),0);
321  Mess.Msg := LM_SHOWWINDOW;
322  Mess.Show := False;
323  Result := DeliverMessage(Data, Mess) = 0;
324end;
325
326function gtkactivateCB(widget: PGtkWidget; data: gPointer) : GBoolean; cdecl;
327var
328  Mess: TLMActivate;
329begin
330  Result:= True;
331  {$IFDEF EventTrace}
332  EventTrace('activate', data);
333  {$ENDIF}
334
335  ResetDefaultIMContext;
336
337  if LockOnChange(PgtkObject(Widget),0) > 0 then Exit;
338
339  FillChar(Mess{%H-}, SizeOf(Mess), #0);
340  {$IFDEF VerboseIDEDisplayState}
341  debugln(['gtkactivateCB ',DbgSName(TObject(Data))]);
342  {$ENDIF}
343  Mess.Msg := LM_ACTIVATE;
344  Mess.Active := WA_ACTIVE;
345  Mess.Minimized := False;
346  if GtkWidgetIsA(Widget, gtk_window_get_type) then
347    Mess.ActiveWindow := HWnd({%H-}PtrUInt(PGTKWindow(Widget)^.focus_widget))
348  else
349    Mess.ActiveWindow := 0;
350  Mess.Result := 0;
351  //DebugLn('gtkactivateCB ',DbgSName(TObject(Data)));
352  DeliverMessage(Data, Mess);
353
354  Result := CallBackDefaultReturn;
355end;
356
357function GTKCheckMenuToggeledCB(AMenuItem: PGTKCheckMenuItem; AData: gPointer): GBoolean; cdecl;
358// AData --> LCLMenuItem
359var
360  LCLMenuItem: TMenuItem;
361begin
362  Result := CallBackDefaultReturn;
363  {$IFDEF EventTrace}
364  EventTrace('toggled', AData);
365  {$ENDIF}
366
367  LCLMenuItem := TMenuItem(AData);
368  // some sanity checks
369  if LCLMenuItem = nil then Exit;
370  if not LCLMenuItem.IsCheckItem then Exit; // ???
371
372  // the gtk always toggles the check flag
373  // -> restore 'checked' flag if needed
374  if gtk_check_menu_item_get_active(AMenuItem) = LCLMenuItem.Checked then Exit;
375  if LCLMenuItem.AutoCheck then Exit;
376
377  // restore it
378  LockOnChange(PgtkObject(AMenuItem), +1);
379  gtk_check_menu_item_set_active(AMenuItem, LCLMenuItem.Checked);
380  LockOnChange(PgtkObject(AMenuItem), -1);
381end;
382
383function gtkchangedCB( widget: PGtkWidget; data: gPointer) : GBoolean; cdecl;
384var
385  Mess : TLMessage;
386begin
387  Result := CallBackDefaultReturn;
388
389  if ComponentIsDestroyingHandle(TWinControl(Data))
390  or (LockOnChange(PgtkObject(Widget),0)>0) then exit;
391
392  {$IFDEF EventTrace}
393  EventTrace('changed', data);
394  {$ENDIF}
395  FillChar(Mess{%H-}, SizeOf(Mess), 0);
396  Mess.Msg := LM_CHANGED;
397  DeliverMessage(Data, Mess);
398end;
399
400function GtkEntryDelayCursorPos(AGtkWidget: Pointer): GBoolean; cdecl;
401var
402  Info: PWidgetInfo;
403begin
404  Result := AGtkWidget <> nil;
405  if Result then
406  begin
407    g_idle_remove_by_data(AGtkWidget);
408    Info := GetWidgetInfo(AGtkWidget);
409    if Info <> nil then
410      gtkchanged_editbox(PGtkWidget(AGtkWidget),
411        Info^.LCLObject);
412  end;
413end;
414
415function postpone_changed_signal(Widget: PGtkWidget): GBoolean; cdecl;
416begin
417  Result := gtk_false;
418  g_object_set_data(PGObject(Widget), 'lcl-postpone-changed-signal', nil);
419  gtkchanged_editbox(Widget, GetWidgetInfo(Widget)^.LCLObject);
420end;
421
422procedure gtkchanged_editbox_delete_text(Widget: PGtkWidget; AStartPos,
423  AEndPos: gint; data: gPointer); cdecl;
424var
425  id: gPointer;
426begin
427  // delete key pressed, but nothing is deleted (eg. cursor at the end or empty text)
428  if AStartPos = AEndPos then
429  begin
430    g_signal_stop_emission_by_name(Widget, 'delete-text');
431    Exit;
432  end;
433
434  id := g_object_get_data(PGObject(Widget), 'lcl-postpone-changed-signal');
435  if id = nil then
436  begin
437    {%H-}PtrUInt(id) := g_idle_add(TGtkFunction(@postpone_changed_signal), Widget);
438    g_object_set_data(PGObject(Widget), 'lcl-postpone-changed-signal', id);
439  end;
440end;
441
442procedure gtkchanged_editbox_insert_text(Widget: PGtkWidget; ANewText: PgChar;
443  ANewTextLength: gint; APosition: pgint; data: gPointer); cdecl;
444var
445  id: gPointer;
446  EntryText: PgChar;
447  LCLObject: TObject;
448begin
449  EntryText := gtk_entry_get_text(PGtkEntry(Widget));
450  LCLObject := TObject(data);
451  if (widget <> nil) and (LCLObject is TCustomEdit) then
452    { NumbersOnly: stop signal if inserted text is not a number }
453    if TCustomEdit(LCLObject).NumbersOnly and not IsNumber(ANewText) then
454    begin
455      gtk_entry_set_text(PGtkEntry(widget), EntryText);
456      g_signal_stop_emission_by_name(Widget, 'insert-text');
457    end;
458
459  id := g_object_get_data(PGObject(Widget), 'lcl-postpone-changed-signal');
460  if id <> nil then
461  begin
462    g_source_remove({%H-}PtrUInt(id));
463    g_object_set_data(PGObject(Widget), 'lcl-postpone-changed-signal', nil);
464  end;
465  if LockOnChange(PgtkObject(Widget), 0) > 0 then
466    g_object_set_data(PGObject(Widget), 'lcl-lock-changed-signal', gPointer(-1))
467  else
468    g_object_set_data(PGObject(Widget), 'lcl-lock-changed-signal', nil);
469end;
470
471function gtkchanged_editbox( widget: PGtkWidget; data: gPointer) : GBoolean; cdecl;
472var
473  Mess : TLMessage;
474  GStart, GEnd: gint;
475  EntryText: PgChar;
476begin
477  //debugln('gtkchanged_editbox');
478  Result := CallBackDefaultReturn;
479
480  if g_object_get_data(PGObject(Widget), 'lcl-lock-changed-signal') <> nil then
481  begin
482    g_object_set_data(PGObject(Widget), 'lcl-lock-changed-signal', nil);
483    Exit;
484  end;
485  if g_object_get_data(PGObject(Widget), 'lcl-postpone-changed-signal') <> nil then
486    Exit;
487  if LockOnChange(PgtkObject(Widget),0)>0 then exit;
488  {$IFDEF EventTrace}
489  EventTrace('changed_editbox', data);
490  {$ENDIF}
491  if GTK_IS_ENTRY(Widget) then
492  begin
493    {cheat GtkEditable to update cursor pos in gtkEntry. issue #7243}
494    gtk_editable_get_selection_bounds(PGtkEditable(Widget), @GStart, @GEnd);
495    EntryText := gtk_entry_get_text(PGtkEntry(Widget));
496    if (GStart = GEnd) and
497      (UTF8Length(EntryText) >= PGtkEntry(Widget)^.text_length) then
498    begin
499      if g_object_get_data(PGObject(Widget),'lcl-gtkentry-pasted-data') <> nil then
500      begin
501        g_object_set_data(PGObject(Widget),'lcl-gtkentry-pasted-data',nil);
502        gtk_editable_set_position(PGtkEditable(Widget), GStart);
503      end else
504      begin
505        g_object_set_data(PGObject(Widget),'lcl-gtkentry-pasted-data',Widget);
506        g_idle_add(@GtkEntryDelayCursorPos, Widget);
507        exit;
508      end;
509    end;
510  end;
511
512  FillByte(Mess{%H-},SizeOf(Mess),0);
513  Mess.Msg := CM_TEXTCHANGED;
514  //debugln('gtkchanged_editbox B: DeliverMessage(CM_TextChanged)');
515  DeliverMessage(Data, Mess);
516end;
517
518function gtkchanged_editbox_delete(widget: PGtkWidget;
519  AType: TGtkDeleteType; APos: gint; data: gPointer): GBoolean; cdecl;
520begin
521  Result := CallBackDefaultReturn;
522end;
523
524function gtkpaste_editbox(Widget: PGtkWidget; data: gPointer): GBoolean; cdecl;
525var
526  FClipText: string;
527  FClip: gtk2.PGtkClipboard;
528  LCLObject: TObject;
529begin
530  Result := CallBackDefaultReturn;
531
532  LCLObject := TObject(data);
533  if (widget <> nil) and (LCLObject is TCustomEdit) then
534    { NumbersOnly }
535    if TCustomEdit(LCLObject).NumbersOnly then
536    begin
537      { get clipboard text and stop signal if pasted text is not a number }
538      FClipText := '';
539      FClip := gtk_clipboard_get(GDK_SELECTION_CLIPBOARD);
540      if (FClip <> nil) and gtk_clipboard_wait_is_text_available(FClip) then
541        FClipText := gtk_clipboard_wait_for_text(FClip);
542      if Assigned(FClip) and not IsNumber(FClipText) then
543        g_signal_stop_emission_by_name(Widget, 'paste-clipboard');
544    end;
545end;
546
547function gtkdaychanged(Widget: PGtkWidget; data: gPointer) : GBoolean; cdecl;
548var
549  MSG: TLMessage;
550begin
551  Result := CallBackDefaultReturn;
552
553  if LockOnChange(PgtkObject(Widget),0)>0 then exit;
554  EventTrace('day changed', data);
555  MSG.Msg := LM_DAYCHANGED;
556  DeliverPostMessage(Data, MSG);
557
558  Result := CallBackDefaultReturn;
559end;
560
561function gtktoggledCB( widget: PGtkWidget; data: gPointer): GBoolean; cdecl;
562var
563  Mess : TLMessage;
564
565  procedure ChangeCheckbox(AGrayed,AChecked: boolean);
566  begin
567    LockOnChange(PgtkObject(Widget),1);
568    gtk_toggle_button_set_Inconsistent(PGtkToggleButton(Widget), AGrayed);
569    gtk_toggle_button_set_active(PGtkToggleButton(Widget), AChecked);
570    LockOnChange(PgtkObject(Widget),-1);
571  end;
572
573begin
574  //DebugLn('gtktoggledCB ',DbgSName(TObject(Data)));
575  Result := CallBackDefaultReturn;
576  {$IFDEF EventTrace}
577  EventTrace('toggled', data);
578  {$ENDIF}
579  if LockOnChange(PgtkObject(Widget),0) > 0 then Exit;
580
581  if GtkWidgetIsA(Widget,gtk_toggle_button_get_type) then begin
582
583    if TObject(Data) is TCustomCheckbox then begin
584      if gtk_toggle_button_get_inconsistent(PGtkToggleButton(Widget)) then
585        ChangeCheckbox(false, true)
586      else
587      if TCustomCheckbox(Data).AllowGrayed and
588         gtk_toggle_button_get_active(PGtkToggleButton(Widget)) then
589        ChangeCheckbox(true, false);
590    end;
591
592  end;
593
594  Mess.Msg := LM_CHANGED;
595  Mess.Result := 0;
596  DeliverMessage(Data, Mess);
597  //DebugLn('gtktoggledCB END ',DbgSName(TObject(Data)));
598end;
599
600function gtkExposeEvent(Widget: PGtkWidget; Event : PGDKEventExpose;
601  Data: gPointer): GBoolean; cdecl;
602var
603  DesignOnlySignal: boolean;
604begin
605  Result := CallBackDefaultReturn;
606  {$IFDEF EventTrace}
607  EventTrace('ExposeAfter', data);
608  {$ENDIF}
609  //DebugLn(['gtkExposeEvent ',GetWidgetDebugReport(Widget),' Event^.Count=',Event^.Count]);
610  if (Event^.Count > 0) then exit;
611
612  if not (csDesigning in TComponent(Data).ComponentState) then begin
613    DesignOnlySignal:=GetDesignOnlySignalFlag(Widget,dstExposeAfter);
614    if DesignOnlySignal then exit;
615  end else begin
616    {$IFDEF VerboseDesignerDraw}
617    DebugLn('gtkExpose',
618      ' Widget=',DbgS(Widget),'=',GetWidgetClassName(Widget),
619      ' ',TComponent(Data).Name,
620      ' ',dbgs(Event^.area.x),',',dbgs(Event^.area.y),',',dbgs(Event^.area.width),',',dbgs(Event^.area.height),
621      '');
622    {$ENDIF}
623  end;
624
625  //DebugLn(['gtkExposeEvent ',GetWidgetDebugReport(Widget),' ',dbgGRect(@Event^.Area)]);
626
627  DeliverGtkPaintMessage(Data, Widget, @Event^.Area, False, False);
628end;
629
630function gtkExposeEventAfter(Widget: PGtkWidget; Event : PGDKEventExpose;
631  Data: gPointer): GBoolean; cdecl;
632var
633  DesignOnlySignal: boolean;
634  //children: PGList;
635begin
636  Result := CallBackDefaultReturn;
637  {$IFDEF EventTrace}
638  EventTrace('ExposeAfter', data);
639  {$ENDIF}
640  //DebugLn(['gtkExposeEventAfter ',GetWidgetDebugReport(Widget),' Event^.Count=',Event^.Count]);
641  if (Event^.Count > 0) then exit;
642
643  if not (csDesigning in TComponent(Data).ComponentState) then begin
644    DesignOnlySignal:=GetDesignOnlySignalFlag(Widget,dstExposeAfter);
645    if DesignOnlySignal then exit;
646  end else begin
647    {$IFDEF VerboseDesignerDraw}
648    DebugLn('gtkExposeAfter',
649      ' Widget=',DbgS(Widget),'=',GetWidgetClassName(Widget),
650      ' ',TComponent(Data).Name,
651      ' ',dbgs(Event^.area.x),',',dbgs(Event^.area.y),',',dbgs(Event^.area.width),',',dbgs(Event^.area.height),
652      '');
653    {$ENDIF}
654  end;
655
656  //DebugLn(['gtkExposeEventAfter ',GetWidgetDebugReport(Widget),' ',dbgGRect(@Event^.Area)]);
657
658  DeliverGtkPaintMessage(Data,Widget,@Event^.Area,false,true);
659end;
660
661procedure ClearTopLevelsFocus(Win: PGtkWidget);
662var
663  List, orgList: PGList;
664  Window: PGtkWindow;
665  event: PGdkEvent;
666  TopLevelWin: PGdkWindow;
667begin
668
669  if not GTK_IS_WINDOW(win) then
670    exit;
671
672  List := gdk_window_get_toplevels;
673  orgList:=List;
674  while List <> nil do
675  begin
676    TopLevelWin := PGdkWindow(List^.Data);
677    if (TopLevelWin<>nil) and (TopLevelWin<>Win^.Window) then
678    begin
679      gdk_window_get_user_data(TopLevelWin, Pgpointer(@Window));
680      if GTK_IS_WINDOW(Window)
681         and GTK_WIDGET_VISIBLE(Window)
682         and gtk_window_has_TopLevel_Focus(Window) then
683      begin
684        // fake focus-out event
685        {$IFDEF VerboseFocus}
686        DebugLn('NOTE: Window with stalled focus found!, faking focus-out event');
687        {$ENDIF}
688        event := gdk_event_new(GDK_FOCUS_CHANGE);
689        event^.focus_change.window := TopLevelWin;
690        event^.focus_change._type := GDK_FOCUS_CHANGE;
691        event^.focus_change._in:=0;
692        gtk_main_do_event(event);
693      end;
694    end;
695    list := g_list_next(list);
696  end;
697  if Assigned(orgList) then
698    g_list_free(orgList);
699end;
700
701function gtkfrmactivateAfter({%H-}widget: PGtkWidget; {%H-}Event : PgdkEventFocus;
702  data: gPointer) : GBoolean; cdecl;
703var
704  Mess: TLMActivate;
705  Info: PWidgetInfo;
706{$IFDEF VerboseFocus}
707  LCLObject: TObject;
708  CurFocusWidget: PGtkWidget;
709{$ENDIF}
710begin
711  {$IFDEF EventTrace}
712  EventTrace('activate after', data);
713  {$ENDIF}
714
715  ResetDefaultIMContext;
716
717  FillChar(Mess{%H-},SizeOf(Mess),#0);
718  {$IFDEF VerboseFocus}
719  LCLObject:=TObject(data);
720  DebugLnEnter(['gtkfrmActivateAfter INIT Widget=',DbgS(Widget),' Event^.theIn=',Event^._in,
721    ' LCLObject=',dbgsname(LCLObject)]);
722  CurFocusWidget:=PGtkWidget(GetFocus);
723  if CurFocusWidget<>nil then begin
724    LCLObject:=GetNearestLCLObject(CurFocusWidget);
725    DebugLn(' GetFocus=',DbgS(CurFocusWidget),' ParentLCLObject=',dbgsName(LCLObject));
726  end;
727  {$ENDIF}
728
729  Info := GetWidgetInfo(Widget);
730  try
731    if (Info <> nil) then
732      Include(Info^.Flags, wwiActivating);
733    {$IFDEF VerboseIDEDisplayState}
734    debugln(['gtkfrmactivateAfter ',DbgSName(TObject(Data))]);
735    {$ENDIF}
736    Mess.Msg := LM_ACTIVATE;
737    Mess.Active := WA_ACTIVE;
738    Mess.Minimized := False;
739    if GtkWidgetIsA(Widget, gtk_window_get_type) then
740      Mess.ActiveWindow := HWnd({%H-}PtrUInt(PGTKWindow(Widget)^.focus_widget))
741    else
742      Mess.ActiveWindow := 0;
743    Mess.Result := 0;
744    DeliverMessage(Data, Mess); // send message directly (not Post)
745  finally
746    if Info <> nil then
747      Exclude(Info^.Flags, wwiActivating);
748  end;
749
750  Result := CallBackDefaultReturn;
751  {$IFDEF VerboseFocus}
752  DebugLnExit('gtkfrmActivateAfter DONE');
753  {$ENDIF}
754end;
755
756function gtkfrmdeactivateAfter( {%H-}widget: PGtkWidget; {%H-}Event : PgdkEventFocus;
757  data: gPointer) : GBoolean; cdecl;
758var
759  Mess: TLMActivate;
760  Info: PWidgetInfo;
761{$IFDEF VerboseFocus}
762  LCLObject: TControl;
763{$ENDIF}
764begin
765  {$IFDEF EventTrace}
766  EventTrace('deactivate after', data);
767  {$ENDIF}
768  {$IFDEF VerboseFocus}
769  LCLObject := TControl(GetLCLObject(Widget));
770  DebugLnEnter(['gtkfrmDeactivate INIT Widget=',DbgS(Widget),' ',Event^._in,
771        ' GetFocus=',DbgS(Widget),' LCLObject=', dbgsName(LCLObject)]);
772  {$ENDIF}
773  ResetDefaultIMContext;
774
775  Info := GetWidgetInfo(Widget);
776  try
777    if (Info<>nil) then
778      Include(Info^.Flags, wwiDeactivating);
779    FillChar(Mess{%H-}, SizeOf(Mess), #0);
780    {$IFDEF VerboseIDEDisplayState}
781    debugln(['gtkfrmdeactivateAfter ',DbgSName(TObject(Data))]);
782    {$ENDIF}
783    Mess.Msg := LM_ACTIVATE;
784    Mess.Active := WA_INACTIVE;
785    Mess.Minimized := False;
786    Mess.ActiveWindow := 0;
787    Mess.Result := 0;
788    DeliverMessage(Data, Mess);
789  finally
790    if Info<>nil then
791      Exclude(Info^.Flags, wwiDeactivating);
792  end;
793
794  Result := CallBackDefaultReturn;
795  {$IFDEF VerboseFocus}
796  DebugLnExit('gtkfrmDeactivate DONE');
797  {$ENDIF}
798end;
799
800function GTKKeyPress(Widget: PGtkWidget; Event: PGdkEventKey; Data: gPointer) : GBoolean; cdecl;
801begin
802  Result := HandleGtkKeyUpDown(Widget,Event,Data,true,True,'key-press-event');
803end;
804
805function GTKKeyPressAfter(Widget: PGtkWidget; Event: pgdkeventkey; Data: gPointer): GBoolean; cdecl;
806begin
807  Result := HandleGtkKeyUpDown(Widget,Event,Data,false,True,'key-press-event');
808end;
809
810function GTKKeyRelease(Widget: PGtkWidget; Event: PGdkEventKey; Data: gPointer) : GBoolean; cdecl;
811begin
812  Result := HandleGtkKeyUpDown(Widget,Event,Data,true,False,'key-release-event');
813end;
814
815function GTKKeyReleaseAfter(Widget: PGtkWidget; Event: pgdkeventkey; Data: gPointer): GBoolean; cdecl;
816begin
817  Result := HandleGtkKeyUpDown(Widget,Event,Data,false,False,'key-release-event');
818end;
819
820
821var
822  NeedShiftUpdateAfterFocus: Boolean;
823
824procedure UpdateShiftState(const KeyStateList: TFPList; const ShiftState: TShiftState);
825
826  procedure UpdateList(const AVKeyCode: Integer; const APressed: Boolean);
827  begin
828    if AVKeyCode = 0 then Exit;
829    if APressed
830    then begin
831      if KeyStateList.IndexOf({%H-}Pointer(PtrUInt(AVKeyCode))) < 0
832      then KeyStateList.Add({%H-}Pointer(PtrUInt(AVKeyCode)));
833    end
834    else begin
835      KeyStateList.Remove({%H-}Pointer(PtrUInt(AVKeyCode)));
836    end;
837  end;
838
839const
840  STATE_MAP: array[0..3] of TShiftStateEnum = (
841    ssShift,
842    ssCtrl,
843    ssAlt,
844    ssSuper
845  );
846  VK_MAP: array[0..3] of array[0..2] of Byte = (
847    // (Main key, alt key 1, alt key 2) to check
848    (VK_SHIFT, VK_LSHIFT, VK_RSHIFT),
849    (VK_CONTROL, VK_LCONTROL, VK_RCONTROL),
850    (VK_MENU, VK_LMENU, VK_RMENU),
851    (VK_LWIN, VK_RWIN, 0)
852  );
853
854var
855  n: Integer;
856  InState: Boolean;
857begin
858  for n := 0 to High(STATE_MAP) do
859  begin
860    InState := STATE_MAP[n] in ShiftState;
861    UpdateList(VK_MAP[n][0], InState);
862    UpdateList(VK_MAP[n][1], InState);
863    UpdateList(VK_MAP[n][2], InState);
864  end;
865end;
866
867function GTKFocusCB(widget: PGtkWidget; {%H-}event: PGdkEventFocus; data: gPointer): GBoolean; cdecl;
868var
869  Mess : TLMessage;
870  LCLObject: TObject;
871  AForm: TCustomForm;
872{$IFDEF VerboseFocus}
873  CurFocusWidget: PGtkWidget;
874{$ENDIF}
875  Mask: TGdkModifierType;
876  AInfo: PWidgetInfo;
877begin
878  {$IFDEF EventTrace}
879  EventTrace('focus', data);
880  {$ENDIF}
881  //DebugLn('GTKFocusCB ',DbgSName(TObject(Data)),' ',GetWidgetDebugReport(Widget));
882
883  LCLObject:=TObject(data);
884
885  if (widget<>nil) and GTK_IS_WINDOW(widget) and (LCLObject is TCustomForm) then
886  begin
887    // it's a top level window about to be focused, if we are being focused
888    // because of ALT+TABing to this form, the origin form might be left with
889    // invalid focus information (ALT+TAB doesn't trigger focus-out event on those)
890    ClearTopLevelsFocus(Widget);
891  end;
892
893  NeedShiftUpdateAfterFocus := False;
894  gdk_window_get_pointer(nil, nil, nil, @Mask);
895  UpdateShiftState(GTK2WidgetSet.KeyStateList, GTKEventStateToShiftState(Word(Mask)));
896
897  {$IFDEF VerboseFocus}
898  DebugLnEnter(['GTKFocusCB INIT Widget=',DbgS(Widget),' Event^.theIn=',Event^._in,
899    ' LCLObject=',dbgsName(LCLObject)]);
900  CurFocusWidget:=PGtkWidget(GetFocus);
901  if CurFocusWidget<>nil then begin
902    LCLObject:=GetNearestLCLObject(CurFocusWidget); // NOTE: overrides argument data !!!
903    DebugLn('GetFocus=',DbgS(CurFocusWidget), ' ParentLCLFocus=',DbgsName(LCLObject));
904    {$IFDEF VerboseSizeMsg}
905    DebugLn(['GTKWindowStateEventCB ',DbgSName(TheForm),
906      ' GTK=',GtkWidth,'x',GtkHeight,
907      ' LCL=',TheForm.Width,'x',TheForm.Height,
908      ' SizeType=',SizeMsg.SizeType-Size_SourceIsInterface,'+Size_SourceIsInterface'
909      ]);
910    {$ENDIF}
911    LCLObject := TObject(Data); // restore original LCLObject
912  end;
913  {$ENDIF}
914
915  if LCLObject is TCustomForm then begin
916    // a form became active
917    // it does not mean: the control focus is switch to the form
918    AForm:=TCustomForm(LCLObject);
919    //debugln(['GTKFocusCBAfter ',DbgSName(AForm),' ',DbgSName(AForm.ActiveControl)]);
920    // the PGtkWindow(Data)^.focus_widget shows the last focus call for this
921    // window. If there is a sub window (e.g. docking), then the focus_widget
922    // of the parent window was not updated, so it can not be used.
923    // The gtk will use, if we let it, which will not follow the LCL focus logic.
924    // Follow the LCL logic:
925    if AForm.ActiveControl<>nil then begin
926      Data:=AForm.ActiveControl;
927      //debugln(['GTKFocusCBAfter ',DbgSName(LCLObject),' send=',event^.send_event,' window=',dbgs(event^.window),' in=',event^._in,' type=',event^._type,' Data=',dbgsname(TObject(Data))]);
928    end;
929  end;
930
931  // we do not show selection (gtk behaviour) when widget is unfocused,
932  // so revert back CursorPos.issues #18164,#21897,#23182
933  if GtkWidgetIsA(Widget, gtk_type_entry) then
934  begin
935    AInfo := GetWidgetInfo(Widget);
936    if AInfo <> nil then
937    begin
938      if (AInfo^.LCLObject is TCustomEdit)
939      and ((AInfo^.CursorPos > 0) or (AInfo^.SelLength > 0)) then
940      begin
941        // gtk_entry_set_position(PGtkEntry(Widget), AInfo^.CursorPos);
942        // gtk_editable_select_region(PGtkEditable(Widget), AInfo^.CursorPos, AInfo^.CursorPos);
943        // do not trigger signals, only update pos for lcl
944        PGtkEntry(Widget)^.current_pos := AInfo^.CursorPos;
945        PGtkEntry(Widget)^.selection_bound := AInfo^.CursorPos + AInfo^.SelLength;
946      end;
947    end;
948  end;
949
950  ResetDefaultIMContext;
951
952  //TODO: fill in old focus
953  FillChar(Mess{%H-}, SizeOf(Mess), 0);
954  Mess.msg := LM_SETFOCUS;
955  DeliverMessage(Data,  Mess);
956
957  Result := CallBackDefaultReturn;
958  {$IFDEF VerboseFocus}
959  DebugLnExit('GTKFocusCB DONE');
960  {$ENDIF}
961end;
962
963function GTKKillFocusCB({%H-}widget: PGtkWidget; {%H-}event:PGdkEventFocus;
964  data: gPointer) : GBoolean; cdecl;
965{$IFDEF VerboseFocus}
966var
967  LCLObject: TObject;
968  CurFocusWidget: PGtkWidget;
969{$ENDIF}
970begin
971  {$IFDEF EventTrace}
972  EventTrace('killfocusCB', data);
973  {$ENDIF}
974  //DebugLn('GTKKillFocusCB ',DbgSName(TObject(Data)),' ',GetWidgetDebugReport(Widget));
975  {$IFDEF VerboseFocus}
976  NeedShiftUpdateAfternFocus := True;   // <- JRA: this doesn't look like simply log !!!
977  LCLObject:=TObject(data);
978  DebugLn(['GTKillFocusCB Widget=',DbgS(Widget),' Event^.theIn=',Event^._in,
979    ' LCLObject=',dbgsName(LCLobject)]);
980  CurFocusWidget:=PGtkWidget(GetFocus);
981  if CurFocusWidget<>nil then begin
982    LCLObject:=GetNearestLCLObject(CurFocusWidget);
983    DebugLn('GTKillFocusCB GetFocus=',dbgs(CurFocusWidget),' ParentLCLObject=',dbgsName(LCLObject));
984  end;
985  {$ENDIF}
986  Result:=CallBackDefaultReturn;
987end;
988
989function GtkEntryDelayClearCursorPos(AGtkWidget: Pointer): GBoolean; cdecl;
990var
991  Info: PWidgetInfo;
992  p: Pgchar;
993  AStart,AEnd: gint;
994begin
995  Result := (AGtkWidget <> nil) and (GTK_IS_WIDGET(AGtkWidget));
996  if Result then
997  begin
998    g_idle_remove_by_data(AGtkWidget);
999    Info := GetWidgetInfo(AGtkWidget);
1000    if Info <> nil then
1001    begin
1002      gtk_editable_get_selection_bounds(PGtkEditable(AGtkWidget),@AStart, @AEnd);
1003      p := gtk_editable_get_chars(PGtkEditable(AGtkWidget), AStart, AEnd);
1004      if (AStart <> AEnd) then
1005        gtk_clipboard_set_text(gtk_clipboard_get(GDK_SELECTION_PRIMARY), p, -1);
1006      gtk_editable_select_region(PGtkEditable(AGtkWidget), 0, 0);
1007      g_free(p);
1008    end;
1009  end;
1010end;
1011
1012function GTKKillFocusCBAfter({%H-}widget: PGtkWidget; {%H-}event:PGdkEventFocus;
1013  data: gPointer) : GBoolean; cdecl;
1014var
1015  Mess : TLMessage;
1016  Info: PWidgetInfo;
1017  AStart,AEnd: gint;
1018  AForm: TCustomForm;
1019{$IFDEF VerboseFocus}
1020  LCLObject: TObject;
1021  CurFocusWidget: PGtkWidget;
1022{$ENDIF}
1023begin
1024  {$IFDEF EventTrace}
1025  EventTrace('killfocusCBAfter', data);
1026  {$ENDIF}
1027  //DebugLn('GTKKillFocusCBAfter ',DbgSName(TObject(Data)),' ',GetWidgetDebugReport(Widget));
1028  {$IFDEF VerboseFocus}
1029  NeedShiftUpdateAfternFocus := True;   // <- JRA: this doesn't look like simply log !!!
1030  LCLObject:=TObject(data);
1031  DebugLnEnter(['GTKillFocusCBAfter INIT Widget=',DbgS(Widget),' Event^.theIn=',Event^._in,
1032    ' LCLObject=',dbgsName(LCLObject)]);
1033  CurFocusWidget:=PGtkWidget(GetFocus);
1034  if CurFocusWidget<>nil then begin
1035    LCLObject:=GetNearestLCLObject(CurFocusWidget);
1036    DebugLn('GetFocus=',DbgS(CurFocusWidget),' ParentLCLFocus=', dbgsName(LCLObject));
1037  end;
1038  {$ENDIF}
1039
1040  ResetDefaultIMContext;
1041
1042  // do not send LM_KILLFOCUS message if widget is destroying itself
1043  if Assigned(Data) and
1044    not ((csDestroying in TComponent(Data).ComponentState) or
1045         (csDestroyingHandle in TControl(Data).ControlState)) then
1046  begin
1047    FillChar(Mess{%H-},SizeOf(Mess),0);
1048    Mess.msg := LM_KILLFOCUS;
1049    // do not release the capture widget here
1050
1051    //TODO: fill in new focus
1052    //DebugLn(Format('Trace:TODO: [gtkkillfocusCB] %s  finish', [TObject(Data).ClassName]));
1053
1054    DeliverMessage(Data,  Mess);
1055  end;
1056
1057  // do not show selection when widget is unfocused
1058  // issues #18164,#21897,#23182
1059  if GtkWidgetIsA(Widget, gtk_type_entry) and Assigned(Data) then
1060  begin
1061    if (csDestroying in TComponent(Data).ComponentState) or
1062      (csDestroyingHandle in TControl(Data).ControlState) then
1063    begin
1064      // DebugLn('NOTICE: Control is destroying itself, do not add new idle timer for ',dbgsName(TControl(Data)));
1065      exit;
1066    end;
1067    AForm := GetParentForm(TControl(Data));
1068    if Assigned(AForm) and ((csDestroying in AForm.ComponentState) or
1069      (csDestroyingHandle in AForm.ControlState) or
1070      ((fsModal in AForm.FormState) and (AForm.ModalResult <> mrNone)) ) then
1071    begin
1072      // DebugLn('NOTICE: Parent form is destroying, do not add new idle timer for ',dbgsName(TControl(Data)));
1073      exit;
1074    end;
1075
1076    g_idle_add(@GtkEntryDelayClearCursorPos, Widget);
1077    //save now CursorPos and SelStart in WidgetInfo
1078    if (Widget <> nil) then
1079    begin
1080      Info := GetWidgetInfo(Widget);
1081      if Info <> nil then
1082      begin
1083        if (Info^.LCLObject is TCustomEdit) then
1084        begin
1085          gtk_editable_get_selection_bounds(PGtkEditable(Widget),@AStart, @AEnd);
1086          Info^.CursorPos := Min(AStart, AEnd);
1087          Info^.SelLength := Abs(AEnd - AStart);
1088        end;
1089      end;
1090    end;
1091  end;
1092
1093  Result:=true;
1094  {$IFDEF VerboseFocus}
1095  DebugLnExit('GTKillFocusCBAfter DONE');
1096  {$ENDIF}
1097end;
1098
1099function GTKWindowStateEventCB(widget: PGtkWidget;
1100  state: PGdkEventWindowState; data: gpointer): gboolean; cdecl;
1101var
1102  TheForm: TCustomForm;
1103  SizeMsg: TLMSize;
1104  GtkWidth: LongInt;
1105  GtkHeight: LongInt;
1106  {$IFDEF HasX}
1107  NetAtom: TGdkAtom;
1108  AtomType: TGdkAtom;
1109  AIndex, ADesktop: pguint;
1110  AFormat: gint;
1111  ALength: gint;
1112  {$ENDIF}
1113begin
1114  Result := CallBackDefaultReturn;
1115
1116  // if iconified in changed then OnIconify...
1117
1118  if GTK_WIDGET_REALIZED(Widget) then
1119  begin
1120    if (GDK_WINDOW_STATE_WITHDRAWN and state^.changed_mask <> 0)
1121    or (GDK_WINDOW_STATE_WITHDRAWN and state^.new_window_state <> 0) then
1122    begin
1123      // visibility changed - this is another message block
1124      Exit;
1125    end;
1126    if TObject(Data) is TCustomForm then
1127    begin
1128      TheForm := TCustomForm(Data);
1129      //DebugLn(['GTKWindowStateEventCB ',DbgSName(TheForm),' new_window_state=',state^.new_window_state,' changed_mask=',state^.changed_mask]);
1130      if TheForm.Parent = nil then begin
1131        // toplevel window
1132        // send a WMSize Message (see TCustomForm.WMSize)
1133        // ToDo: this might be too early to use the Widget^.Allocation
1134        //    Either send this message later or find a better way to determine the size (including the client area)
1135        GtkWidth:=Widget^.Allocation.Width;
1136        if GtkWidth<0 then GtkWidth:=0;
1137        GtkHeight:=Widget^.Allocation.Height;
1138        if GtkHeight<0 then GtkHeight:=0;
1139        //debugln('GTKWindowStateEventCB ',DbgSName(TObject(Data)),' ',dbgs(state^.new_window_state),' ',WidgetFlagsToString(Widget));
1140        if ((GDK_WINDOW_STATE_ICONIFIED and state^.new_window_state)>0) then
1141        begin
1142          {$IFDEF HasX}
1143          NetAtom := gdk_atom_intern('_NET_WM_DESKTOP', True);
1144          if NetAtom > 0 then begin
1145            if gdk_property_get(Widget^.window, NetAtom, XA_CARDINAL,
1146              0, 4, 0, @AtomType, @AFormat, @ALength, @AIndex)
1147            then begin
1148              NetAtom := gdk_atom_intern('_NET_CURRENT_DESKTOP', True);
1149              if gdk_property_get(gdk_get_default_root_window, NetAtom, XA_CARDINAL,0, 4, 0, @AtomType, @AFormat, @ALength, @ADesktop)
1150              then if ADesktop^ <> AIndex^ then begin
1151                // form is not on active desktop => ignore
1152                g_free(ADesktop);
1153                g_free(AIndex);
1154                exit;
1155              end
1156              else begin
1157                g_free(ADesktop);
1158                g_free(AIndex);
1159              end;
1160            end;
1161          end;
1162          {$ENDIF}
1163          SizeMsg.SizeType := SIZE_MINIMIZED;
1164        end
1165        else if (GDK_WINDOW_STATE_MAXIMIZED and state^.new_window_state)>0 then
1166        begin
1167          // it can be both maximized + iconified and just loose iconified state
1168          if (state^.changed_mask and (GDK_WINDOW_STATE_MAXIMIZED or GDK_WINDOW_STATE_ICONIFIED)) = 0 then Exit;
1169          SizeMsg.SizeType := SIZE_MAXIMIZED;
1170        end
1171        else
1172          SizeMsg.SizeType := SIZE_RESTORED;
1173
1174        // don't bother the LCL if nothing changed
1175        case SizeMsg.SizeType of
1176          SIZE_RESTORED: if TheForm.WindowState=wsNormal then exit;
1177          SIZE_MINIMIZED: if TheForm.WindowState=wsMinimized then exit;
1178          SIZE_MAXIMIZED: if TheForm.WindowState=wsMaximized then exit;
1179          SIZE_FULLSCREEN: if TheForm.WindowState=wsFullScreen then exit;
1180        end;
1181
1182        with SizeMsg do
1183        begin
1184          Result := 0;
1185          Msg := LM_SIZE;
1186          SizeType := SizeType+Size_SourceIsInterface;
1187          Width := SmallInt(GtkWidth);
1188          Height := SmallInt(GtkHeight);
1189        end;
1190        {$IFDEF VerboseSizeMsg}
1191        DebugLn(['GTKWindowStateEventCB ',DbgSName(TheForm),
1192          ' GTK=',GtkWidth,'x',GtkHeight,
1193          ' LCL=',TheForm.Width,'x',TheForm.Height,
1194          ' SizeType=',SizeMsg.SizeType-Size_SourceIsInterface,'+Size_SourceIsInterface'
1195          ]);
1196        {$ENDIF}
1197        DeliverMessage(TheForm, SizeMsg);
1198        if (gtk_major_version = 2) and (gtk_minor_version <= 8) and
1199          (TheForm.WindowState = wsMaximized) then
1200            gtk_widget_queue_draw({%H-}PGtkWidget(TheForm.Handle));
1201
1202        if (TheForm = Application.MainForm)
1203        and (GDK_WINDOW_STATE_ICONIFIED and state^.changed_mask <> 0) then
1204        begin
1205          if GDK_WINDOW_STATE_ICONIFIED and state^.new_window_state <> 0 then
1206            Application.IntfAppMinimize
1207          else
1208            Application.IntfAppRestore;
1209        end;
1210      end;
1211    end;
1212  end;
1213end;
1214
1215
1216function gtkdestroyCB(widget: PGtkWidget; data: gPointer) : GBoolean; cdecl;
1217var
1218  Mess: TLMessage;
1219  Info: PWidgetInfo;
1220begin
1221  Result := CallBackDefaultReturn;
1222  //DebugLn(['gtkdestroyCB ',GetWidgetDebugReport(Widget)]);
1223
1224  Info:=GetWidgetInfo(Widget);
1225  if Info = nil then // this widget is already destroyed
1226    Exit;
1227
1228  if (Data = nil) or (Info^.LCLObject <> TObject(Data)) then // this LCLObject does not use this widget anymore
1229    Exit;
1230
1231  if (TObject(Data) is TWinControl) then
1232  begin
1233    if (not TWinControl(Data).HandleAllocated) then
1234    begin
1235      FreeWidgetInfo(Widget);
1236      Exit;
1237    end else
1238    if ({%H-}PGtkWidget(TWinControl(Data).Handle) <> Widget) then // the TWinControl does not use this widget anymore.
1239      Exit;
1240  end;
1241
1242  {$IFDEF EventTrace}
1243  EventTrace('destroyCB', data);
1244  {$ENDIF}
1245  //DebugLn('gtkdestroyCB Data="',DbgSName(TObject(Data)),'" LCLObject="',DbgSName(Info^.LCLObject),'" ',GetWidgetDebugReport(Widget));
1246  FillChar(Mess{%H-}, SizeOf(Mess), 0);
1247  Mess.msg := LM_DESTROY;
1248  DeliverMessage(Data, Mess);
1249
1250  // NOTE: if the destroy message is posted
1251  // we should post an info destroy message as well
1252
1253  FreeWidgetInfo(Widget);
1254end;
1255
1256procedure DestroyWindowFromPointCB(Widget: PGtkWidget; data: gPointer); cdecl;
1257begin
1258  if {%H-}PGtkWidget(LastWFPResult) <> Widget then Exit;
1259  LastWFPResult := 0;
1260  LastWFPMousePos := Point(High(Integer), High(Integer));
1261end;
1262
1263function gtkdeleteCB( {%H-}widget : PGtkWidget; {%H-}event : PGdkEvent;
1264  data : gPointer) : GBoolean; cdecl;
1265var Mess : TLMessage;
1266begin
1267  FillChar(Mess{%H-},SizeOf(Mess),0);
1268  Mess.Msg:= LM_CLOSEQUERY;
1269  { Message results : True - do nothing, False - destroy or hide window }
1270  Result:= DeliverMessage(Data, Mess) = 0;
1271end;
1272
1273function gtkresizeCB( {%H-}widget: PGtkWidget; data: gPointer) : GBoolean; cdecl;
1274//var
1275//   Mess : TLMessage;
1276begin
1277  Result := CallBackDefaultReturn;
1278  {$IFDEF EventTrace}
1279  EventTrace('resize', data);
1280  {$ENDIF}
1281//   Mess.msg := LM_RESIZE;
1282//   TControl(data).WindowProc(TLMessage(Mess));
1283  //DebugLn('Trace:TODO: [gtkresizeCB] fix (or remove) to new LM_SIZE');
1284//TObject(data).Dispatch(Mess);
1285end;
1286
1287function gtkMonthChanged({%H-}Widget: PGtkWidget; data: gPointer) : GBoolean; cdecl;
1288var
1289  Mess: TLMessage;
1290begin
1291  Result := CallBackDefaultReturn;
1292  {$IFDEF EventTrace}
1293  EventTrace('month changed', data);
1294  {$ENDIF}
1295  FillChar(Mess{%H-},SizeOf(Mess),0);
1296  Mess.Msg := LM_MONTHCHANGED;
1297  DeliverPostMessage(Data, Mess);
1298
1299  Result := CallBackDefaultReturn;
1300end;
1301
1302{-------------------------------------------------------------------------------
1303  procedure DeliverMouseMoveMessage(Widget:PGTKWidget; Event: PGDKEventMotion;
1304    AWinControl: TWinControl);
1305
1306  Translate a gdk mouse motion event into a LCL mouse move message and send it.
1307
1308  Mouse coordinate mapping:
1309
1310  Why mapping:
1311  An lcl control can consists of several gtk widgets, and any message to them is
1312  send to the lcl control. The gtk sends the coordinates relative to the
1313  emitting gdkwindow (not relative to the gtkwidget). And the area of a lcl
1314  control can belong to several gdkwindows. Therefore the mouse coordinates must
1315  be mapped.
1316
1317  What the lcl expects:
1318  For Delphi compatibility the mouse coordinates must be relative to the client
1319  area of the control.
1320  That means for example if the mouse is over the top-left pixel of the client
1321  widget (mostly a gtkfixed widget), then 0,0 is send.
1322  If the mouse is on the top-left pixel of the container widget then the
1323  coordinates can be negative, if there is frame around the client area.
1324-------------------------------------------------------------------------------}
1325procedure DeliverMouseMoveMessage(Widget: PGTKWidget; Event: PGDKEventMotion;
1326  AWinControl: TWinControl);
1327var
1328  Msg: TLMMouseMove;
1329  ShiftState: TShiftState;
1330  MappedXY: TPoint;
1331begin
1332  CheckTransparentWindow({%H-}TLCLIntfHandle(widget), AWinControl);
1333  if (widget=nil) or (AWinControl=nil) then
1334    Exit;
1335
1336  MappedXY := TranslateGdkPointToClientArea(Event^.Window,
1337                               Point(TruncToInt(Event^.X), TruncToInt(Event^.Y)),
1338                               {%H-}PGtkWidget(AWinControl.Handle));
1339  MappedXY := SubtractScoll({%H-}PGtkWidget(AWinControl.Handle), MappedXY);
1340
1341  ShiftState := GTKEventStateToShiftState(Event^.State);
1342  with Msg do
1343  begin
1344    Msg := LM_MouseMove;
1345
1346    XPos := MappedXY.X;
1347    YPos := MappedXY.Y;
1348
1349    Keys := ShiftStateToKeys(ShiftState);
1350
1351    Result := 0;
1352  end;
1353
1354  // send the message directly to the LCL
1355  // (Posting the message via queue
1356  //  has the risk of getting out of sync with the gtk)
1357  NotifyApplicationUserInput(AWinControl, Msg.Msg);
1358  //DebugLn(['DeliverMouseMoveMessage ',dbgsName(AWinControl)]);
1359  DeliverMessage(AWinControl, Msg);
1360
1361  // if dragmanager is started later then inform g_object issue #19914
1362  if GTK_IS_NOTEBOOK({%H-}PGtkWidget(AWinControl.Handle)) and
1363    DragManager.IsDragging and
1364    (g_object_get_data({%H-}PGObject(AWinControl.Handle),'lclnotebookdragging') = nil)
1365    then
1366      g_object_set_data({%H-}PGObject(AWinControl.Handle),
1367        'lclnotebookdragging', gpointer(PtrInt(1)));
1368end;
1369
1370procedure FixListViewRubberBand(AWidget: PGtkWidget);
1371var
1372  Info: PWidgetInfo;
1373  IconView: PGtkIconView;
1374  Priv: _PGtkIconViewPrivate;
1375begin
1376  Info := GetWidgetInfo(AWidget);
1377  IconView := PGtkIconView(Info^.CoreWidget);
1378  Priv := IconView^.priv;
1379
1380  if Priv^.doing_rubberband then
1381  begin
1382    Priv^.doing_rubberband := False;
1383    gtk_widget_queue_draw(AWidget);
1384  end;
1385end;
1386
1387{-------------------------------------------------------------------------------
1388  function ControlGetsMouseMoveBefore(AControl: TControl): boolean;
1389
1390  Returns true, if mouse move event should be sent before the widget itself
1391  reacts.
1392-------------------------------------------------------------------------------}
1393function ControlGetsMouseMoveBefore({%H-}AControl: TControl;
1394  const ABefore: Boolean; Event: PGDKEventMotion): boolean;
1395var
1396  ShiftState: TShiftState;
1397  Widget: PGtkWidget;
1398  MainView: PGtkWidget;
1399begin
1400  Result := True;
1401  // currently there are no controls, that need after events.
1402  if not ABefore then exit;
1403
1404  // gtk2 column resizing ... issue #21354
1405  if (Event <> nil) and not (csDesigning in AControl.ComponentState) and
1406    (AControl is TListView) and
1407    (TListView(AControl).ViewStyle = vsReport) and
1408    (TListView(AControl).ShowColumnHeaders) then
1409  begin
1410    ShiftState := GTKEventStateToShiftState(Event^.State);
1411    if ssLeft in ShiftState then
1412    begin
1413      Widget := {%H-}PGtkWidget(TWinControl(AControl).Handle);
1414      if GTK_IS_SCROLLED_WINDOW(Widget) then
1415      begin
1416        MainView := gtk_bin_get_child(PGtkBin(Widget));
1417        if GTK_IS_TREE_VIEW(MainView) then
1418        begin
1419          // here we are
1420          if gtk_tree_view_get_bin_window(PGtkTreeView(MainView)) <> Event^.window then
1421            Result := False;
1422          //TODO: queue column resize when x < 0
1423          // gtk_tree_view_column_queue_resize(tree_column: PGtkTreeViewColumn)
1424        end;
1425      end;
1426    end;
1427  end else
1428  if (Event <> nil) and not (csDesigning in AControl.ComponentState) and
1429    (AControl is TWinControl) and
1430    (TWinControl(AControl).FCompStyle = csListView) and
1431    (TListView(AControl).ViewStyle in [vsIcon, vsSmallIcon]) and
1432    TListView(AControl).MultiSelect then
1433  begin
1434    ShiftState := GTKEventStateToShiftState(Event^.State);
1435    // issue #22991 - this fixes rubberbanding
1436    if [ssShift, ssAlt, ssCtrl, ssLeft, ssRight, ssMiddle, ssDouble] * ShiftState = [] then
1437      FixListViewRubberBand({%H-}PGtkWidget(TWinControl(AControl).Handle));
1438  end;
1439end;
1440
1441procedure GTKGetDevicePointer(win: PGdkWindow; dev: PGdkDevice;
1442  x, y: pgdouble; mask: PGdkModifierType);
1443var
1444  axes: pgdouble;
1445  i: Integer;
1446begin
1447  axes := g_new(SizeOf(gdouble), dev^.num_axes);
1448  gdk_device_get_state(dev, win, axes, mask);
1449
1450  for i := 0 to dev^.num_axes - 1 do
1451    if (x^ <> 0) and (dev^.axes[i].use = GDK_AXIS_X) then
1452      x^ := axes[i]
1453    else if (y^ <> 0) and (dev^.axes[i].use = GDK_AXIS_Y) then
1454      y^ := axes[i];
1455
1456  g_free(axes);
1457end;
1458
1459
1460{-------------------------------------------------------------------------------
1461  GTKMotionNotify
1462  Params: widget: PGTKWidget; event: PGDKEventMotion; data: gPointer
1463  Returns: GBoolean
1464
1465  Called whenever the mouse is moved over a widget.
1466  The gtk event is translated into a lcl MouseMove message.
1467
1468-------------------------------------------------------------------------------}
1469function gtkMotionNotify(Widget:PGTKWidget; Event: PGDKEventMotion;
1470  Data: gPointer): GBoolean; cdecl;
1471const
1472  LastModifierKeys: TShiftState = [];
1473var
1474  DesignOnlySignal: boolean;
1475  ShiftState: TShiftState;
1476  ACtl: TWinControl;
1477begin
1478  Result := CallBackDefaultReturn;
1479
1480  if (Event^.is_hint <> 0) and (Event^._type = GDK_MOTION_NOTIFY) then
1481    GTKGetDevicePointer(Event^.window, Event^.device,
1482      @Event^.x, @Event^.y, @Event^.state);
1483
1484  {$IFDEF VerboseMouseBugfix}
1485  DesignOnlySignal:=GetDesignOnlySignalFlag(Widget,dstMouseMotion);
1486  DebugLn('[GTKMotionNotify] ',
1487    DbgSName(TControl(Data)),
1488    ' Widget=',DbgS(Widget),
1489    ' DSO=',dbgs(DesignOnlySignal),
1490    ' Event^.X=',dbgs(TruncToInt(Event^.X)),' Event^.Y=',dbgs(TruncToInt(Event^.Y))
1491    );
1492  {$ENDIF}
1493
1494  ShiftState := GTKEventStateToShiftState(Event^.State);
1495
1496  if (ShiftState*[ssShift, ssCtrl, ssAlt, ssSuper] <> LastModifierKeys) or NeedShiftUpdateAfterFocus
1497  then begin
1498    NeedShiftUpdateAfterFocus := False;
1499    LastModifierKeys := ShiftState*[ssShift, ssCtrl, ssAlt, ssSuper];
1500    //DebugLn(['Adjust KeyStateList in MouseMove',Integer(LastModifierKeys)]);
1501    UpdateShiftState(GTK2WidgetSet.KeyStateList, LastModifierKeys);
1502  end;
1503
1504  {$IFDEF VerboseMouseCapture}
1505  if (MouseCaptureWidget = Widget) and ([ssLeft,ssRight,ssMiddle]*ShiftState=[]) then
1506    DebugLn(['gtkMotionNotify gtk capture without mouse down: ',GetWidgetDebugReport(Widget)]);
1507  {$ENDIF}
1508
1509  if not (csDesigning in TComponent(Data).ComponentState) then
1510  begin
1511    DesignOnlySignal := GetDesignOnlySignalFlag(Widget, dstMouseMotion);
1512    if DesignOnlySignal then exit;
1513    if not ControlGetsMouseMoveBefore(TControl(Data), True, Event) then exit;
1514  end else
1515  begin
1516    // stop the signal, so that the widget does not auto react
1517    g_signal_stop_emission_by_name(PGTKObject(Widget), 'motion-notify-event');
1518    Result := CallBackDefaultReturn; // why not True if we want to stop it?
1519  end;
1520
1521  ACtl := TWinControl(Data);
1522  if not (csDesigning in ACtl.ComponentState) and
1523     not (csCaptureMouse in ACtl.ControlStyle) and
1524    ([ssLeft,ssRight,ssMiddle]*ShiftState <> []) and
1525    not (ACtl is TCustomForm) and not (ACtl is TScrollBar)
1526    and not DragManager.IsDragging then
1527  begin
1528    if (Event^.x < 0) or (Event^.y < 0) or
1529      (Event^.x > ACtl.Width) or (Event^.y > ACtl.Height) then
1530      Exit(True);
1531  end;
1532  DeliverMouseMoveMessage(Widget,Event, ACtl);
1533  if ACtl.FCompStyle = csWinControl then
1534    Result := True; // stop signal
1535end;
1536
1537{-------------------------------------------------------------------------------
1538  GTKMotionNotifyAfter
1539  Params: widget: PGTKWidget; event: PGDKEventMotion; data: gPointer
1540  Returns: GBoolean
1541
1542  Called whenever the mouse is moved over a widget as last handler.
1543-------------------------------------------------------------------------------}
1544function GTKMotionNotifyAfter(widget:PGTKWidget; event: PGDKEventMotion;
1545  data: gPointer): GBoolean; cdecl;
1546begin
1547  Result := true; // stop event propagation
1548
1549  if (Event^.is_hint <> 0) and (Event^._type = GDK_MOTION_NOTIFY) then
1550    GTKGetDevicePointer(Event^.window, Event^.device,
1551      @Event^.x, @Event^.y, @Event^.state);
1552
1553  {$IFDEF VerboseMouseBugfix}
1554  DebugLn('[GTKMotionNotifyAfter] ',
1555    DbgSName(TControl(Data)));
1556  {$ENDIF}
1557
1558  // stop the signal, so that it is not sent to the parent widgets
1559  g_signal_stop_emission_by_name(PGTKObject(Widget),'motion-notify-event');
1560
1561  if (csDesigning in TComponent(Data).ComponentState) then exit;
1562  if ControlGetsMouseMoveBefore(TControl(Data), True, Event) then exit;
1563
1564  DeliverMouseMoveMessage(Widget,Event, TWinControl(Data));
1565end;
1566
1567
1568// restore old column sizing after dblclick. issue #18381
1569function ReturnColumnSizing(AGtkWidget: Pointer): gboolean; cdecl;
1570var
1571  AIndex: PtrInt;
1572  ASizing: TGtkTreeViewColumnSizing;
1573  Column: PGtkTreeViewColumn;
1574  ColWidth: gint;
1575begin
1576  Result := AGtkWidget <> nil;
1577  if Result then
1578  begin
1579    if g_object_get_data(PGObject(AGtkWidget),'lcl-column-resized-dblclick') <> nil then
1580    begin
1581      AIndex := {%H-}PtrInt(g_object_get_data(PGObject(AGtkWidget),'lcl-column-resized-dblclick') - 1);
1582      ASizing := TGtkTreeViewColumnSizing({%H-}PtrUInt(g_object_get_data(PGObject(AGtkWidget),'lcl-column-resized-dblclick-oldsizing')) - 1);
1583      g_object_set_data(PGObject(AGtkWidget),'lcl-column-resized-dblclick', nil);
1584      g_object_set_data(PGObject(AGtkWidget),'lcl-column-resized-dblclick-oldsizing', nil);
1585      if (AIndex >= 0) then
1586      begin
1587        Column := gtk_tree_view_get_column(PGtkTreeView(AGtkWidget), AIndex);
1588        ColWidth := gtk_tree_view_column_get_width(Column);
1589        gtk_tree_view_column_set_sizing(Column, ASizing);
1590        gtk_tree_view_column_set_fixed_width(Column, ColWidth);
1591      end;
1592    end;
1593    g_idle_remove_by_data(AGtkWidget);
1594  end;
1595end;
1596
1597{resizes column to like autosize does when dblclicked separator. issue #18381}
1598function ResizeColumnOnDblClick({%H-}ACtl: TWinControl; ScrolledWin: PGtkWidget;
1599  TreeView: PGtkTreeView; const AMouseCoord: TPoint): Boolean;
1600var
1601  Adjustment: PGtkAdjustment;
1602  List: PGList;
1603  Column: PGtkTreeViewColumn;
1604  i, Accu: PtrInt;
1605  xoffset: Integer;
1606  Pt: TPoint;
1607  CurSizing: TGtkTreeViewColumnSizing;
1608  ColIndex: Integer;
1609  ColWidth: Integer;
1610begin
1611  Result := True;
1612  Pt := AMouseCoord;
1613  Accu := 0;
1614  ColIndex := -1;
1615  // think about horizontal scrollbar position too !
1616  Adjustment := gtk_scrolled_window_get_hadjustment(PGtkScrolledWindow(ScrolledWin));
1617  if Adjustment <> nil then
1618    xoffset := Round(gtk_adjustment_get_value(Adjustment))
1619  else
1620    xoffset := 0;
1621
1622  List := gtk_tree_view_get_columns(TreeView);
1623  try
1624    for i := 0 to g_list_length(List) - 1 do
1625    begin
1626      Column := g_list_nth_data(List, i);
1627      if Column = nil then
1628        continue;
1629      if gtk_tree_view_column_get_visible(Column) then
1630      begin
1631        ColWidth := gtk_tree_view_column_get_width(Column);
1632        if (Accu + ColWidth + 3 >= Pt.X + xoffset) then
1633        begin
1634          // DebugLn('NOTICE: GtkTreeView column resizing on dblclick ',i);
1635          CurSizing := gtk_tree_view_column_get_sizing(Column);
1636          if gtk_tree_view_column_get_resizable(Column) and
1637            (CurSizing <> GTK_TREE_VIEW_COLUMN_AUTOSIZE) then
1638          begin
1639            gtk_tree_view_column_set_sizing(Column, GTK_TREE_VIEW_COLUMN_AUTOSIZE);
1640            gtk_tree_view_column_set_resizable(Column, True);
1641
1642            ColIndex := i;
1643            // we are adding i + 1 since if i = 0 then ptr is null !
1644            g_object_set_data(PGObject(TreeView),'lcl-column-resized-dblclick', {%H-}GPointer(ColIndex + 1));
1645            Accu := Ord(CurSizing);
1646            // we are adding Accu + 1 since if Accu = 0 then ptr is null !
1647            g_object_set_data(PGObject(TreeView),'lcl-column-resized-dblclick-oldsizing', {%H-}GPointer(Accu + 1));
1648            Accu := g_idle_add(@ReturnColumnSizing, TreeView);
1649            break;
1650          end;
1651          break;
1652        end;
1653        Accu := Accu + ColWidth + 3 {section separator offset};
1654      end;
1655    end;
1656    Result := not (ColIndex >= 0);
1657  finally
1658    g_list_free(List);
1659  end;
1660end;
1661
1662{-------------------------------------------------------------------------------
1663  function ControlGetsMouseDownBefore(AControl: TControl): boolean;
1664
1665  Returns true, if mouse down event should be sent before the widget istelf
1666  reacts.
1667-------------------------------------------------------------------------------}
1668function ControlGetsMouseDownBefore(AControl: TControl;
1669  {%H-}AWidget: PGtkWidget; Event : PGdkEventButton): boolean;
1670var
1671  Widget: PGtkWidget;
1672  MainView: PGtkWidget;
1673  Pt: TPoint;
1674begin
1675  Result := True;
1676  if AControl = nil then exit;
1677
1678  if not (csDesigning in AControl.ComponentState) and
1679    (Event^.button = 1) and
1680    (gdk_event_get_type(Event) = GDK_2BUTTON_PRESS) and
1681    (AControl is TWinControl) and
1682    (TWinControl(AControl).FCompStyle = csListView) and
1683    (TListView(AControl).ViewStyle = vsReport) and
1684    (TListView(AControl).ShowColumnHeaders) then
1685  begin
1686    Widget := {%H-}PGtkWidget(TWinControl(AControl).Handle);
1687    if GTK_IS_SCROLLED_WINDOW(Widget) then
1688    begin
1689      MainView := gtk_bin_get_child(PGtkBin(Widget));
1690      if GTK_IS_TREE_VIEW(MainView) then
1691      begin
1692        if gtk_tree_view_get_bin_window(PGtkTreeView(MainView)) <> Event^.window then
1693        begin
1694          Pt.X := Round(Event^.x_root);
1695          Pt.Y := Round(Event^.y_root);
1696          ScreenToClient(TWinControl(AControl).Handle, Pt);
1697          Result := ResizeColumnOnDblClick(TWinControl(AControl), Widget,
1698            PGtkTreeView(MainView), Pt);
1699        end;
1700      end;
1701    end;
1702  end else
1703  if not (csDesigning in AControl.ComponentState) and
1704    (Event^.button = 1) and
1705    (gdk_event_get_type(Event) = GDK_BUTTON_PRESS) and
1706    (AControl is TWinControl) and
1707    (TWinControl(AControl).FCompStyle = csListView) and
1708    (TListView(AControl).ViewStyle in [vsIcon, vsSmallIcon]) and
1709    TListView(AControl).MultiSelect then
1710  begin
1711    // issue #22991 - this fixes crash after click on listview when modal form
1712    // is closed
1713    FixListViewRubberBand({%H-}PGtkWidget(TWinControl(AControl).Handle));
1714  end;
1715end;
1716
1717
1718{-------------------------------------------------------------------------------
1719We must stop delivery of events from scrollbars of GtkScrollable, otherwise
1720if we make an double click on scollbar button, and after that click into
1721our control client area we need 2 click to make it focused.
1722gtk_signal_connect_after() is used, otherwise our scrollbar won't react on
1723such event.
1724-------------------------------------------------------------------------------}
1725function gtk2ScrollBarMouseBtnPress(widget: PGtkWidget; event: pgdkEventButton;
1726  data: gPointer): GBoolean; cdecl;
1727begin
1728  Result := True;
1729end;
1730
1731{-------------------------------------------------------------------------------
1732We must stop delivery of events from scrollbars of GtkScrollable, otherwise
1733if we make an double click on scollbar button, and after that click into
1734our control client area we need 2 click to make it focused.
1735gtk_signal_connect_after() is used, otherwise our scrollbar won't react on
1736such event.
1737-------------------------------------------------------------------------------}
1738function gtk2ScrollBarMouseBtnRelease(widget: PGtkWidget; event: pgdkEventButton;
1739  data: gPointer): GBoolean; cdecl;
1740begin
1741  Result := True;
1742end;
1743
1744{-------------------------------------------------------------------------------
1745  gtkMouseBtnPress
1746  Params: widget: PGTKWidget; event: PGDKEventMotion; data: gPointer
1747  Returns: GBoolean
1748
1749  Called whenever the mouse is over a widget and a mouse button is pressed.
1750-------------------------------------------------------------------------------}
1751function gtkMouseBtnPress(widget: PGtkWidget; event: pgdkEventButton; data: gPointer): GBoolean; cdecl;
1752
1753  procedure CheckListSelection;
1754  var
1755    List: PGlist;
1756    ListWidget: PGtkList;
1757    R: TRect;
1758    Info: PWinWidgetInfo;
1759  begin
1760    // When in browse mode and a listbox is focused and nothing is selected,
1761    // the first item is focused.
1762    // Clicking with the mouse on this item won't select it.
1763    Info := GetWidgetInfo(Widget);
1764    if Info = nil then Exit;
1765    if Info^.CoreWidget = nil then Exit;
1766    if not GtkWidgetIsA(Info^.CoreWidget, gtk_list_get_type) then
1767      Exit;
1768    ListWidget := PGtkList(Info^.CoreWidget);
1769    // Check mode
1770    if selection_mode(ListWidget^) <> GTK_SELECTION_BROWSE then Exit;
1771
1772    // Check selection
1773    List := ListWidget^.selection;
1774    if (List <> nil) and (List^.data <> nil) then Exit;
1775
1776    // Check if there are children
1777    List := ListWidget^.children;
1778    if List = nil then Exit;
1779    if List^.Data = nil then Exit;
1780
1781    // we need only to check the first
1782    with PGtkWidget(List^.Data)^.allocation do
1783      R := Bounds(X, Y, Width, Height);
1784    if not PtInRect(R, Point(Trunc(event^.X), Trunc(event^.Y))) then Exit;
1785    // Select it
1786    gtk_list_item_select(PGtkListItem(List^.Data));
1787  end;
1788
1789  procedure FixTabControlFocusBehaviour;
1790  var
1791    Info: PWidgetInfo;
1792  begin
1793    {gtk_notebook have weird behaviour when clicked.
1794     if there's active control on page it'll loose it's
1795     focus and trigger OnExit (tab is taking focus).
1796     issue #20493}
1797    Info := GetWidgetInfo(Widget);
1798    if not gtk_widget_is_focus(Widget) then
1799      Include(Info^.Flags, wwiTabWidgetFocusCheck);
1800  end;
1801
1802var
1803  DesignOnlySignal: boolean;
1804  Msg: TLMContextMenu;
1805  x, y: gint;
1806  W: PGtkWidget;
1807  Info: PWidgetInfo;
1808  Old: TObject;
1809  Path: PGtkTreePath;
1810  Column: PGtkTreeViewColumn;
1811  {$IFDEF VerboseMouseBugfix}
1812  AWinControl: TWinControl;
1813  {$ENDIF}
1814begin
1815  Result := CallBackDefaultReturn;
1816
1817  {$IFDEF VerboseMouseBugfix}
1818  AWinControl := TWinControl(Data);
1819  DebugLn('');
1820  DesignOnlySignal:=GetDesignOnlySignalFlag(Widget,dstMousePress);
1821  DebugLn('[gtkMouseBtnPress] ',
1822    DbgSName(AWinControl),
1823    ' Widget=',DbgS(Widget),
1824    ' ControlWidget=',DbgS(AWinControl.Handle),
1825    ' DSO='+dbgs(DesignOnlySignal),
1826    ' '+dbgs(TruncToInt(Event^.X)),',',dbgs(TruncToInt(Event^.Y)),
1827    ' Type='+dbgs(gdk_event_get_type(Event)));
1828  {$ENDIF}
1829
1830  {$IFDEF EventTrace}
1831  EventTrace('Mouse button Press', data);
1832  {$ENDIF}
1833
1834  ResetDefaultIMContext;
1835
1836  //debugln('[gtkMouseBtnPress] calling DeliverMouseDownMessage Result=',dbgs(Result));
1837  {$IFDEF Gtk2CallMouseDownBeforeContext}
1838  if DeliverMouseDownMessage(Widget, Event, TWinControl(Data))<>0 then
1839  begin
1840    // Debugln(['[gtkMouseBtnPress] DeliverMouseDownMessage handled, stopping event']);
1841    g_signal_stop_emission_by_name(PGTKObject(Widget), 'button-press-event');
1842    exit(false);
1843  end;
1844  {$ENDIF}
1845
1846  if not (csDesigning in TComponent(Data).ComponentState) then
1847  begin
1848    // fix gtklist selection first
1849    CheckListSelection;
1850
1851    DesignOnlySignal := GetDesignOnlySignalFlag(Widget, dstMousePress);
1852    if DesignOnlySignal then exit;
1853    if not ControlGetsMouseDownBefore(TControl(Data), Widget, Event) then Exit;
1854
1855    if Event^.button = 1 then
1856    begin
1857      //CaptureMouseForWidget(CaptureWidget,mctGTKIntf);
1858      if (TControl(Data) is TCustomTabControl) and
1859        not (csDesigning in TControl(Data).ComponentState) then
1860          FixTabControlFocusBehaviour;
1861    end
1862    else
1863    // if LCL process LM_CONTEXTMENU then stop the event propagation
1864    if (Event^.button = 3) then
1865    begin
1866      W := Widget;
1867      gdk_display_get_pointer(gtk_widget_get_display(Widget), nil, @x, @y, nil);
1868      Old := nil;
1869      while W <> nil do
1870      begin
1871        Info := GetWidgetInfo(W);
1872        if (Info <> nil) and (Info^.LCLObject <> Old) then
1873        begin
1874          Old := Info^.LCLObject;
1875          FillChar(Msg{%H-}, SizeOf(Msg), #0);
1876          Msg.Msg := LM_CONTEXTMENU;
1877          Msg.hWnd := {%H-}HWND(W);
1878          Msg.XPos := x;
1879          Msg.YPos := y;
1880
1881          Result := DeliverMessage(Old, Msg) <> 0;
1882          if Result then break;
1883        end;
1884        // check if widget has a standard popup menu
1885        if (W = widget) and Assigned(GTK_WIDGET_GET_CLASS(W)^.popup_menu) then
1886          break;
1887        W := gtk_widget_get_parent(W);
1888      end;
1889
1890      {emit selection change when right mouse button pressed
1891       otherwise LCL is not updated since ChangeLock = 1 in case
1892       of pressing right mouse button and 'changed' signal never reach lcl.
1893       Issues #16972, #17888. }
1894      if Result and GTK_IS_TREE_VIEW(Widget) and (event^.button = 3) then
1895      begin
1896        Column := gtk_tree_view_get_column(GTK_TREE_VIEW(Widget), 0);
1897        Path:=nil;
1898        if gtk_tree_view_get_path_at_pos(GTK_TREE_VIEW(Widget), Round(Event^.x), Round(Event^.y),
1899          Path, Column, @x, @y) then
1900        begin
1901          gtk_tree_view_set_cursor(GTK_TREE_VIEW(Widget), Path, Column, False);
1902          gtk_widget_queue_draw(Widget);
1903        end;
1904        g_signal_stop_emission_by_name(PGTKObject(Widget), 'button-press-event');
1905      end;
1906
1907    end;
1908  end else begin
1909    if (event^.Button=1) and
1910       (TControl(Data) is TCustomTabControl) then
1911    begin
1912      // clicks on the tab control should be handled by the gtk (switching page)
1913    end
1914    else
1915    begin
1916      // stop the signal, so that the widget does not auto react
1917      //DebugLn(['gtkMouseBtnPress stop signal']);
1918      g_signal_stop_emission_by_name(PGTKObject(Widget), 'button-press-event');
1919    end;
1920  end;
1921  {$IFDEF Gtk2CallMouseDownBeforeContext}
1922  {$ELSE}
1923  //debugln('[gtkMouseBtnPress] calling DeliverMouseDownMessage Result=',dbgs(Result));
1924  DeliverMouseDownMessage(Widget, Event, TWinControl(Data));
1925  {$ENDIF}
1926  //debugln(['gtkMouseBtnPress END Control=',DbgSName(TObject(Data))]);
1927end;
1928
1929
1930{-------------------------------------------------------------------------------
1931  procedure DeliverMouseDownMessage(widget: PGtkWidget; event : pgdkEventButton;
1932    AWinControl: TWinControl);
1933
1934  Translate a gdk mouse press event into a LCL mouse down message and send it.
1935-------------------------------------------------------------------------------}
1936function DeliverMouseDownMessage(widget: PGtkWidget; event : pgdkEventButton;
1937  AWinControl: TWinControl): PtrInt;
1938const
1939  LastModifierKeys: TShiftState = [];
1940  WHEEL_DELTA : array[Boolean] of Integer = (-120, 120);
1941var
1942  MessI : TLMMouse;
1943  MessE : TLMMouseEvent;
1944  ShiftState: TShiftState;
1945  MappedXY: TPoint;
1946  EventXY: TPoint;
1947  AClip: gtk2.PGtkClipboard;
1948  AClipText: String;
1949
1950{off $DEFINE VerboseMouseBugfix}
1951
1952  function CheckMouseButtonDown(MouseButton, BtnKey: longint): boolean;
1953  begin
1954    Result := False;
1955
1956    case gdk_event_get_type(Event) of
1957      gdk_2button_press, gdk_3button_press:
1958      // the gtk itself has detected a double/triple click
1959      begin
1960        // they were already detected and sent to the LCL
1961        // -> skip this message
1962        exit;
1963      end;
1964    end;
1965
1966    if (LastMouse.Down) then
1967      if (gdk_event_get_type(Event) in [GDK_BUTTON_PRESS, gdk_2button_press, gdk_3button_press]) then
1968      begin
1969        // After a LastMouse.Down has to follow a LastMouse.Up. Issue #32199
1970        if LastMouse.WinControl <> AWinControl then
1971          Exit;
1972      end
1973      else
1974      begin
1975        {$IFDEF VerboseMouseBugfix}
1976        DebugLn('DeliverMouseDownMessage: NO CLICK: LastMouse.Down=',dbgs(LastMouse.Down),
1977                ' Event^.theType=',dbgs(gdk_event_get_type(Event)));
1978        {$ENDIF}
1979        Exit;
1980      end;
1981
1982    if (LastMouse.Down) and (gdk_event_get_type(Event) = GDK_BUTTON_PRESS) and
1983      (csDesigning in AWinControl.ComponentState) then
1984        exit;
1985
1986    MessI.Msg := CheckMouseButtonDownUp({%H-}TLCLIntfHandle(widget), AWinControl,
1987                                        LastMouse, EventXY, MouseButton, True);
1988    MessI.Keys := MessI.Keys or BtnKey;
1989    if BtnKey in [MK_XBUTTON1, MK_XBUTTON2] then
1990      MessI.Keys :=  MessI.Keys or BtnKey shl 11;
1991    case LastMouse.ClickCount of
1992      2: MessI.Keys := MessI.Keys or MK_DOUBLECLICK;
1993      3: MessI.Keys := MessI.Keys or MK_TRIPLECLICK;
1994      4: MessI.Keys := MessI.Keys or MK_QUADCLICK;
1995    end;
1996
1997    {$IFDEF VerboseMouseBugfix}
1998    DebugLn('  ClickCount=',dbgs(LastMouse.ClickCount));
1999    {$ENDIF}
2000
2001    //DebugLn('DeliverMouseDownMessage ',DbgSName(AWinControl),' Mapped=',dbgs(MappedXY.X),',',dbgs(MappedXY.Y),' Event=',dbgs(EventXY.X),',',dbgs(EventXY.Y),' ',dbgs(LastMouse.ClickCount));
2002    Result := True;
2003  end;
2004
2005begin
2006  Result := 0;
2007
2008  if GTK_IS_TREE_VIEW(widget)
2009  and (gtk_tree_view_get_bin_window(PGtkTreeView(widget)) <> Event^.window) then
2010    Exit;
2011
2012  CheckTransparentWindow({%H-}TLCLIntfHandle(widget), AWinControl);
2013  if (widget=nil) or (AWinControl=nil) then
2014    Exit;
2015
2016  EventXY := Point(TruncToInt(Event^.X), TruncToInt(Event^.Y));
2017  ShiftState := GTKEventStateToShiftState(Event^.State);
2018
2019  if ShiftState*[ssShift, ssCtrl, ssAlt, ssSuper] <> LastModifierKeys
2020  then begin
2021    LastModifierKeys := ShiftState*[ssShift, ssCtrl, ssAlt, ssSuper];
2022    //DebugLn(['Adjust KeyStateList in MouseBtnDown',Integer(LastModifierKeys)]);
2023    UpdateShiftState(GTK2WidgetSet.KeyStateList, LastModifierKeys);
2024  end;
2025
2026  MappedXY := TranslateGdkPointToClientArea(Event^.Window, EventXY,
2027                                            {%H-}PGtkWidget(AWinControl.Handle));
2028  MappedXY := SubtractScoll({%H-}PGtkWidget(AWinControl.Handle), MappedXY);
2029  //DebugLn('DeliverMouseDownMessage ',DbgSName(AWinControl),' Mapped=',dbgs(MappedXY.X),',',dbgs(MappedXY.Y),' Event=',dbgs(EventXY.X),',',dbgs(EventXY.Y));
2030
2031  if event^.Button in [4, 5] then
2032  begin
2033    // this is a mouse wheel event
2034    MessE.Msg := LM_MOUSEWHEEL;
2035    MessE.WheelDelta := WHEEL_DELTA[event^.Button = 4];
2036    MessE.X := MappedXY.X;
2037    MessE.Y := MappedXY.Y;
2038    MessE.State := ShiftState;
2039    MessE.UserData := AWinControl;
2040    MessE.Button := 0;
2041
2042    // send the message directly to the LCL
2043    NotifyApplicationUserInput(AWinControl, MessE.Msg);
2044    Result:=DeliverMessage(AWinControl, MessE);
2045  end
2046  else
2047  if event^.Button in [6, 7] then
2048  begin
2049    // this is a mouse wheel horizontal-scroll event
2050    MessE.Msg := LM_MOUSEHWHEEL;
2051    MessE.WheelDelta := WHEEL_DELTA[event^.Button = 7];
2052    MessE.X := MappedXY.X;
2053    MessE.Y := MappedXY.Y;
2054    MessE.State := ShiftState;
2055    MessE.UserData := AWinControl;
2056    MessE.Button := 0;
2057
2058    // send the message directly to the LCL
2059    NotifyApplicationUserInput(AWinControl, MessE.Msg);
2060    Result:=DeliverMessage(AWinControl, MessE);
2061  end
2062  else
2063  begin
2064    // a normal mouse button is pressed
2065    MessI.Keys := 0;
2066    case event^.Button of
2067      1: if not CheckMouseButtonDown(1, MK_LBUTTON) then Exit;
2068      2: if not CheckMouseButtonDown(3, MK_MBUTTON) then Exit;
2069      3: if not CheckMouseButtonDown(2, MK_RBUTTON) then Exit;
2070      8: if not CheckMouseButtonDown(4, MK_XBUTTON1) then Exit;
2071      9: if not CheckMouseButtonDown(5, MK_XBUTTON2) then Exit;
2072      else
2073        begin
2074          MessI.Msg := LM_NULL;
2075          exit;
2076        end;
2077    end; // case
2078
2079    MessI.XPos := MappedXY.X;
2080    MessI.YPos := MappedXY.Y;
2081
2082    MessI.Keys := MessI.Keys or ShiftStateToKeys(ShiftState);
2083
2084    MessI.Result:=0;
2085
2086    {Gtk2 should always send LM_SETFOCUS first, as qt and win32 does. issues #24308, #31900}
2087    if ((MessI.Msg = LM_LBUTTONDOWN) or (MessI.Msg = LM_RBUTTONDOWN) or
2088      (MessI.Msg = LM_MBUTTONDOWN) or (MessI.Msg = LM_LBUTTONDBLCLK) or
2089      (MessI.Msg = LM_XBUTTONDOWN)) and
2090      not AWinControl.Focused and AWinControl.CanFocus and
2091      not (csDesigning in AWinControl.ComponentState) then
2092    begin
2093      if (AWinControl is TCustomEdit) then
2094      begin
2095        AClipText := '';
2096        AClip := gtk_clipboard_get(GDK_SELECTION_PRIMARY);
2097        if gtk_clipboard_get_owner(AClip) = AClip then
2098          AClip := nil;
2099        if (AClip <> nil) and gtk_clipboard_wait_is_text_available(AClip) then
2100          AClipText := gtk_clipboard_wait_for_text(AClip);
2101        LCLIntf.SetFocus(AWinControl.Handle);
2102        if Assigned(AClip) then
2103          gtk_clipboard_set_text(AClip, PgChar(AClipText), length(AClipText));
2104      end else
2105      begin
2106        if (AWinControl is TCustomTabControl)
2107        or (AWinControl is TCustomPanel) then
2108          // do not grab focus. issue #32237, #32515
2109        else
2110          LCLIntf.SetFocus(AWinControl.Handle);
2111      end;
2112    end;
2113
2114    // send the message directly to the LCL
2115    NotifyApplicationUserInput(AWinControl, MessI.Msg);
2116    Result := DeliverMessage(AWinControl, MessI);
2117
2118    // issue #19914
2119    if (Result = 0) and (Event^.button = 1) and
2120      GTK_IS_NOTEBOOK({%H-}PGtkWidget(AWinControl.Handle)) and
2121      DragManager.IsDragging then
2122    begin
2123      g_object_set_data({%H-}PGObject(AWinControl.Handle),
2124        'lclnotebookdragging', gpointer(PtrInt(1)));
2125    end;
2126  end;
2127end;
2128
2129{-------------------------------------------------------------------------------
2130  gtkMouseBtnPressAfter
2131  Params: widget: PGTKWidget; event: PGDKEventMotion; data: gPointer
2132  Returns: GBoolean
2133
2134  Called whenever the mouse is over a widget and a mouse button is pressed.
2135  This is the last handler.
2136-------------------------------------------------------------------------------}
2137function gtkMouseBtnPressAfter(widget: PGtkWidget; event : pgdkEventButton;
2138  data: gPointer) : GBoolean; cdecl;
2139begin
2140  Result := True;
2141
2142  {$IFDEF VerboseMouseBugfix}
2143  debugln('[gtkMouseBtnPressAfter] ',
2144    DbgSName(TObject(Data)),
2145    ' Widget=',DbgS(Widget), ' ', GetWidgetClassName(Widget),
2146    ' ',dbgs(TruncToInt(Event^.X)),',',dbgs(TruncToInt(Event^.Y)));
2147  {$ENDIF}
2148
2149  ResetDefaultIMContext;
2150
2151  // stop the signal, so that it is not sent to the parent widgets
2152  g_signal_stop_emission_by_name(PGTKObject(Widget), 'button-press-event');
2153
2154  if (csDesigning in TComponent(Data).ComponentState) then exit;
2155  if ControlGetsMouseDownBefore(TControl(Data),Widget, Event) then exit;
2156
2157  //debugln('[gtkMouseBtnPressAfter] calling DeliverMouseDownMessage');
2158  DeliverMouseDownMessage(Widget, Event, TWinControl(Data));
2159end;
2160
2161{-------------------------------------------------------------------------------
2162  function ControlGetsMouseUpBefore(AControl: TControl): boolean;
2163
2164  Returns true, if mouse up event should be sent before the widget istelf
2165  reacts.
2166-------------------------------------------------------------------------------}
2167function ControlGetsMouseUpBefore({%H-}AControl: TControl): boolean;
2168begin
2169  {$NOTE ControlGetsMouseUpBefore always return true. See if still necessary}
2170  Result:=true;
2171end;
2172
2173{-------------------------------------------------------------------------------
2174  procedure DeliverMouseUpMessage(widget: PGtkWidget; event : pgdkEventButton;
2175    AWinControl: TWinControl);
2176
2177  Translate a gdk mouse release event into a LCL mouse up message and send it.
2178
2179  returns true, if message was handled by LCL
2180-------------------------------------------------------------------------------}
2181function DeliverMouseUpMessage(widget: PGtkWidget; event: pgdkEventButton;
2182  AWinControl: TWinControl): boolean;
2183var
2184  MessI : TLMMouse;
2185  ShiftState: TShiftState;
2186  MappedXY: TPoint;
2187  EventXY: TPoint;
2188
2189  function CheckMouseButtonUp(MouseButton: longint; BtnShiftState: TShiftStateEnum): boolean;
2190  begin
2191    MessI.Msg := CheckMouseButtonDownUp({%H-}TLCLIntfHandle(widget),
2192                           AWinControl, LastMouse, EventXY, MouseButton, False);
2193    Include(ShiftState, BtnShiftState);
2194    Result := True;
2195 end;
2196
2197begin
2198  Result := False;
2199  CheckTransparentWindow({%H-}TLCLIntfHandle(widget), AWinControl);
2200  if (widget=nil) or (AWinControl=nil) then
2201    Exit;
2202  EventXY := Point(TruncToInt(Event^.X), TruncToInt(Event^.Y));
2203  MappedXY := TranslateGdkPointToClientArea(Event^.Window,
2204                               EventXY,
2205                               {%H-}PGtkWidget(AWinControl.Handle));
2206  MappedXY := SubtractScoll({%H-}PGtkWidget(AWinControl.Handle), MappedXY);
2207  //DebugLn(['DeliverMouseUpMessage ',GetWidgetDebugReport(Widget),' ',dbgsName(AWinControl),' ',dbgs(MappedXY)]);
2208
2209  ShiftState := GTKEventStateToShiftState(Event^.State);
2210
2211  case event^.Button of
2212    1: if not CheckMouseButtonUp(1, ssLeft) then Exit;
2213    2: if not CheckMouseButtonUp(3, ssMiddle) then Exit;
2214    3: if not CheckMouseButtonUp(2, ssRight) then Exit;
2215    8: if not CheckMouseButtonUp(4, ssExtra1) then Exit;
2216    9: if not CheckMouseButtonUp(5, ssExtra2) then Exit;
2217  else
2218    begin
2219      MessI.Msg := LM_NULL;
2220      Exit;
2221    end;
2222  end; // case
2223
2224  MessI.XPos := MappedXY.X;
2225  MessI.YPos := MappedXY.Y;
2226
2227  // do not send button in shiftstate on mouse up.issue #20916
2228  case event^.Button of
2229    1: ShiftState := ShiftState - [ssLeft];
2230    2: ShiftState := ShiftState - [ssMiddle];
2231    3: ShiftState := ShiftState - [ssRight];
2232  end;
2233  MessI.Keys := ShiftStateToKeys(ShiftState);
2234  case LastMouse.ClickCount of
2235    2: MessI.Keys := MessI.Keys or MK_DOUBLECLICK;
2236    3: MessI.Keys := MessI.Keys or MK_TRIPLECLICK;
2237    4: MessI.Keys := MessI.Keys or MK_QUADCLICK;
2238  end;
2239
2240  if MessI.Msg <> LM_NULL then
2241  begin
2242    // send the message directly to the LCL
2243    // (Posting the message via queue
2244    //  has the risk of getting out of sync with the gtk)
2245    if event^.button in [8,9] then
2246      MessI.Keys := MessI.Keys or ((event^.button - 7) shl 16);
2247    MessI.Result := 0;
2248    NotifyApplicationUserInput(AWinControl, MessI.Msg);
2249    DeliverMessage(AWinControl, MessI);
2250    if not AWinControl.HandleAllocated then
2251      Result := True
2252    else if MessI.Result <> 0 then
2253    begin
2254      // issue #19914
2255      if GTK_IS_NOTEBOOK(Widget) then
2256      begin
2257        if g_object_get_data({%H-}PGObject(AWinControl.Handle),'lclnotebookdragging') <> nil then
2258        begin
2259          g_object_steal_data({%H-}PGObject(AWinControl.Handle),'lclnotebookdragging');
2260          exit;
2261        end;
2262      end;
2263      // handled by the LCL
2264      //DebugLn(['DeliverMouseUpMessage msg was handled by the LCL, Stopping signal ...']);
2265      g_signal_stop_emission_by_name(PGTKObject(Widget), 'button-release-event');
2266      Result := True;
2267    end;
2268  end;
2269end;
2270
2271{-------------------------------------------------------------------------------
2272  gtkMouseBtnRelease
2273  Params: widget: PGTKWidget; event: PGDKEventMotion; data: gPointer
2274  Returns: GBoolean
2275
2276  Called whenever the mouse is over a widget and a mouse button is released.
2277-------------------------------------------------------------------------------}
2278function gtkMouseBtnRelease(widget: PGtkWidget; event : pgdkEventButton;
2279  data: gPointer) : GBoolean; cdecl;
2280var
2281  DesignOnlySignal: boolean;
2282  AForm: TCustomForm;
2283begin
2284  Result := CallBackDefaultReturn;
2285  {$IFDEF VerboseMouseBugfix}
2286  DesignOnlySignal:=GetDesignOnlySignalFlag(Widget,dstMouseRelease);
2287  DebugLn(['[gtkMouseBtnRelease] A ',DbgSName(TObject(Data)),' ',
2288    ' Widget=',DbgS(Widget),
2289    ' Event.time=',event^.time,
2290    ' DSO=',DesignOnlySignal,
2291    ' ',TruncToInt(Event^.X),',',TruncToInt(Event^.Y),' Btn=',event^.Button]);
2292  {$ENDIF}
2293
2294  //DebugLn('EEE1 MouseRelease Widget=',DbgS(Widget),
2295  //' EventMask=',DbgS(gdk_window_get_events(Widget^.Window)),
2296  //' GDK_BUTTON_RELEASE_MASK=',DbgS(GDK_BUTTON_RELEASE_MASK));
2297
2298  ResetDefaultIMContext;
2299
2300  if not (csDesigning in TComponent(Data).ComponentState) then
2301  begin
2302    DesignOnlySignal := GetDesignOnlySignalFlag(Widget, dstMouseRelease);
2303
2304    if (TControl(Data) is TCustomListView) and
2305      (TListView(Data).ViewStyle in [vsIcon, vsSmallIcon]) and
2306      TListView(Data).MultiSelect then
2307    begin
2308      // fixed crash.See issue #22778
2309      FixListViewRubberBand(Widget);
2310    end;
2311
2312    if DesignOnlySignal or (not ControlGetsMouseUpBefore(TControl(Data))) then
2313    begin
2314      ReleaseMouseCapture;
2315      Exit;
2316    end;
2317  end else
2318  begin
2319    // stop the signal, so that the widget does not auto react
2320    if not (TControl(Data) is TCustomTabControl) then
2321    begin
2322      g_signal_stop_emission_by_name(PGTKObject(Widget), 'button-release-event');
2323      Result := not CallBackDefaultReturn;
2324    end;
2325  end;
2326  if DeliverMouseUpMessage(Widget, Event, TWinControl(Data)) then
2327  begin
2328    ReleaseMouseCapture;
2329    if not DragManager.IsDragging then
2330      Result := not CallBackDefaultReturn
2331    else
2332    begin
2333      // workaround for gtk2 bug where "clicked" isn't triggered
2334      // because of Result=TRUE and we started modal form from OnDropDown event.
2335      // see issue http://bugs.freepascal.org/view.php?id=14318 for details.
2336      if GTK_IS_BUTTON(Widget) then
2337      begin
2338        AForm := GetParentForm(TWinControl(Data));
2339        if (AForm <> nil) and (fsModal in AForm.FormState) then
2340          gtk_button_clicked(PGtkButton(Widget));
2341      end;
2342    end;
2343  end else
2344    ReleaseMouseCapture;
2345end;
2346
2347{-------------------------------------------------------------------------------
2348  gtkMouseBtnReleaseAfter
2349  Params: widget: PGTKWidget; event: PGDKEventMotion; data: gPointer
2350  Returns: GBoolean
2351
2352  Called whenever the mouse is over a widget and a mouse button is released.
2353  This is the last handler.
2354-------------------------------------------------------------------------------}
2355function gtkMouseBtnReleaseAfter(widget: PGtkWidget; event : pgdkEventButton;
2356  data: gPointer) : GBoolean; cdecl;
2357begin
2358  Result := True;
2359
2360  {$IFDEF VerboseMouseBugfix}
2361  DebugLn('[gtkMouseBtnReleaseAfter] ',DbgSName(TObject(Data)),' ',
2362    ' Widget=',DbgS(Widget),
2363    ' ',dbgs(TruncToInt(Event^.X)),',',dbgs(TruncToInt(Event^.Y)),' Btn=',dbgs(event^.Button));
2364  {$ENDIF}
2365
2366  // stop the signal, so that it is not sent to the parent widgets
2367  {$NOTE See if is necessary to stop emission. Return true is enough to avoid propagation}
2368  g_signal_stop_emission_by_name(PGTKObject(Widget),'button-release-event');
2369
2370  ResetDefaultIMContext;
2371
2372  if (csDesigning in TComponent(Data).ComponentState) then exit;
2373  if ControlGetsMouseUpBefore(TControl(Data)) then exit;
2374
2375  DeliverMouseUpMessage(Widget,Event,TWinControl(Data));
2376end;
2377
2378function gtkMouseWheelCB(widget: PGtkWidget; event: PGdkEventScroll;
2379  data: gPointer): GBoolean; cdecl;
2380var
2381  AWinControl: TWinControl;
2382  EventXY: TPoint;
2383  ShiftState: TShiftState;
2384  MappedXY: TPoint;
2385  MessE : TLMMouseEvent;
2386begin
2387  Result := False;
2388
2389  AWinControl:=TWinControl(Data);
2390  CheckTransparentWindow({%H-}TLCLIntfHandle(widget), AWinControl);
2391  if (widget=nil) or (AWinControl=nil) then
2392    Exit;
2393  EventXY:=Point(TruncToInt(Event^.X),TruncToInt(Event^.Y));
2394  ShiftState := GTKEventStateToShiftState(Event^.State);
2395  MappedXY:=TranslateGdkPointToClientArea(Event^.Window,EventXY,
2396                                          {%H-}PGtkWidget(AWinControl.Handle));
2397  MappedXY := SubtractScoll({%H-}PGtkWidget(AWinControl.Handle), MappedXY);
2398  //DebugLn('gtkMouseWheelCB ',DbgSName(AWinControl),' Mapped=',dbgs(MappedXY.X),',',dbgs(MappedXY.Y),' Event=',dbgs(EventXY.X),',',dbgs(EventXY.Y));
2399
2400  // this is a mouse wheel event
2401  FillChar(MessE{%H-},SizeOf(MessE),0);
2402  case event^.direction of
2403    GDK_SCROLL_UP: begin MessE.Msg := LM_MOUSEWHEEL; MessE.WheelDelta := 120; end;
2404    GDK_SCROLL_DOWN: begin MessE.Msg := LM_MOUSEWHEEL; MessE.WheelDelta := -120; end;
2405    GDK_SCROLL_LEFT: begin MessE.Msg := LM_MOUSEHWHEEL; MessE.WheelDelta := -120; end;
2406    GDK_SCROLL_RIGHT: begin MessE.Msg := LM_MOUSEHWHEEL; MessE.WheelDelta := 120; end;
2407  else
2408    exit;
2409  end;
2410  MessE.X := MappedXY.X;
2411  MessE.Y := MappedXY.Y;
2412  MessE.State := ShiftState;
2413  MessE.UserData := AWinControl;
2414  MessE.Button := 0;
2415
2416  // send the message directly to the LCL
2417  NotifyApplicationUserInput(AWinControl, MessE.Msg);
2418  if DeliverMessage(AWinControl, MessE) <> 0 then
2419    Result := True; // message handled by LCL, stop processing
2420end;
2421
2422
2423function gtkclickedCB(widget: PGtkWidget; data: gPointer) : GBoolean; cdecl;
2424var
2425  Mess: TLMessage;
2426begin
2427  Result := CallBackDefaultReturn;
2428  //DebugLn('[gtkclickedCB] ',TObject(Data).ClassName);
2429  EventTrace('clicked', data);
2430  if (LockOnChange(PgtkObject(Widget),0)>0) then exit;
2431  Mess.Msg := LM_CLICKED;
2432  DeliverMessage(Data, Mess);
2433end;
2434
2435function gtkEnterCB(widget: PGtkWidget; data: gPointer) : GBoolean; cdecl;
2436var
2437  Mess : TLMessage;
2438begin
2439  Result := CallBackDefaultReturn;
2440
2441  {$IFDEF EventTrace}
2442  EventTrace('enter', data);
2443  {$ENDIF}
2444
2445  if csDesigning in TControl(Data).ComponentState then begin
2446    // stop the signal, so that the widget does not auto react
2447    g_signal_stop_emission_by_name(PGTKObject(Widget),'enter');
2448  end;
2449
2450  Mess.msg := LM_MOUSEENTER;
2451  DeliverMessage(Data, Mess);
2452end;
2453
2454function gtkLeaveCB(widget: PGtkWidget; data: gPointer) : GBoolean; cdecl;
2455var
2456  Mess : TLMessage;
2457begin
2458  Result := CallBackDefaultReturn;
2459
2460  {$IFDEF EventTrace}
2461  EventTrace('leave', data);
2462  {$ENDIF}
2463
2464  if csDesigning in TControl(Data).ComponentState then begin
2465    // stop the signal, so that the widget does not auto react
2466    g_signal_stop_emission_by_name(PGTKObject(Widget),'leave');
2467  end;
2468
2469  Mess.msg := LM_MOUSELEAVE;
2470  DeliverMessage(Data, Mess);
2471end;
2472
2473function gtksize_allocateCB(widget: PGtkWidget; size: pGtkAllocation;
2474  data: gPointer) : GBoolean; cdecl;
2475{$IFDEF VerboseSizeMsg}
2476var
2477  w, h: Gint;
2478{$ENDIF}
2479
2480begin
2481  Result := CallBackDefaultReturn;
2482
2483  EventTrace('size-allocate', data);
2484
2485  //with Size^ do DebugLn(Format('Trace:[gtksize_allocateCB] %s --> X: %d, Y: %d, Width: %d, Height: %d', [TObject(data).ClassName, X, Y, Width, Height]));
2486
2487  if not (TObject(Data) is TControl) then begin
2488    // owner is not TControl -> ignore
2489    DebugLn('WARNING: gtksize_allocateCB: Data is not TControl. Data=',
2490            DbgS(Data),' ',GetWidgetClassName(Widget));
2491    if Data<>nil then
2492      DebugLn('  Data=',TObject(Data).ClassName);
2493    RaiseGDBException('');
2494    exit;
2495  end;
2496
2497  {$IFDEF VerboseSizeMsg}
2498  w:=0; h:=0;
2499  if Widget^.window<>nil then
2500    gdk_window_get_size(Widget^.window,@w,@h);
2501  DebugLn(['gtksize_allocateCB: ',
2502    DbgSName(TControl(Data)),
2503    ' widget=',GetWidgetDebugReport(Widget),
2504    ' fixwidget=',DbgS(GetFixedWidget(Widget)),
2505    ' NewSize=',Size^.Width,',',Size^.Height,
2506    ' GtkPos=',Widget^.allocation.x,',',Widget^.allocation.y,
2507               ',',Widget^.allocation.width,'x',Widget^.allocation.height,
2508    ' LCLPos=',TControl(Data).Left,',',TControl(Data).Top,
2509               ',',TControl(Data).Width,'x',TControl(Data).Height,
2510    ' gdkwindow=',w,'x',h]);
2511  {$ENDIF}
2512  {$IFDEF VerboseFormPositioning}
2513  if TControl(Data) is TCustomForm then
2514    DebugLn('VFP gtksize_allocateCB: ',TControl(Data).ClassName,' ',dbgs(Size^.X),',',dbgs(Size^.Y));
2515  {$ENDIF}
2516  SendSizeNotificationToLCL(Widget);
2517end;
2518
2519function gtksize_allocate_client({%H-}widget: PGtkWidget; {%H-}size: pGtkAllocation;
2520  data: gPointer): GBoolean; cdecl;
2521var
2522  MainWidget: PGtkWidget;
2523  ClientWidget: PGtkWidget;
2524begin
2525  Result := CallBackDefaultReturn;
2526
2527  if (TObject(Data) is TWinControl) then
2528  begin
2529    {$IFDEF VerboseSizeMsg}
2530    DebugLn('gtksize_allocate_client: ',
2531      TControl(Data).Name,':',TControl(Data).ClassName,
2532      ' widget=',DbgS(Widget),
2533      ' NewSize=',dbgs(Size^.Width),',',dbgs(Size^.Height),
2534      ' Allocation='+dbgs(widget^.Allocation.Width)+'x'+dbgs(Widget^.Allocation.Height),
2535      ' Requisiton='+dbgs(widget^.Requisition.Width)+'x'+dbgs(Widget^.Requisition.Height)
2536      );
2537    {$ENDIF}
2538    if not TWinControl(Data).HandleAllocated then begin
2539      exit;
2540    end;
2541    MainWidget:={%H-}PGtkWidget(TWinControl(Data).Handle);
2542    ClientWidget:=GetFixedWidget(MainWidget);
2543    if GTK_WIDGET_REALIZED(ClientWidget) then begin
2544      // the gtk resizes bottom to top, that means the
2545      // inner widget (client area) is resized before the outer widget
2546      // is resized. Because the LCL reads both sizes, keep this message back.
2547      SaveClientSizeNotification(ClientWidget);
2548    end;
2549  end else begin
2550    // owner is not TWinControl -> ignore
2551    DebugLn('WARNING: gtksize_allocate_client: Data is not TWinControl. Data=',
2552            DbgS(Data));
2553    exit;
2554  end;
2555end;
2556
2557function gtkconfigureevent( widget: PGtkWidget; event : PgdkEventConfigure;
2558  data: gPointer) : GBoolean; cdecl;
2559var
2560  Allocation : TGtkAllocation;
2561begin
2562
2563  { This signal is emitted for top level controls only, i.e. only controls
2564    that are not children. Thus, we register this event only for forms.
2565    This event is fired when the form is sized, moved or changes Z order.
2566  }
2567
2568  FillChar(Allocation{%H-},SizeOf(TGtkAllocation),0);
2569  with Allocation do begin
2570    X:= Event^.X;
2571    Y:= Event^.Y;
2572    Width:= Event^.Width;
2573    Height:= Event^.Height;
2574  end;
2575  Result:= gtksize_allocateCB( Widget, @Allocation, Data);
2576end;
2577
2578function gtkInsertText(widget: PGtkWidget; char : pChar;
2579  NewTextLength : Integer; Position : pgint; data: gPointer) : GBoolean; cdecl;
2580var
2581  Memo: TCustomMemo;
2582  CurrLength, CutLength: integer;
2583begin
2584  Result := CallBackDefaultReturn;
2585
2586  { GTK does not provide its own max. length for memos
2587    we have to do our own. }
2588
2589  if TObject(Data) is TCustomMemo then begin
2590    if (NewTextLength = 1) and (char^ = #13) and (LineEnding = #10) then
2591      char^ := #10;
2592    Memo:= TCustomMemo(Data);
2593    if Memo.MaxLength <= 0 then Exit;
2594
2595    CurrLength:= gtk_text_get_length(PGtkText(widget));
2596    if CurrLength + NewTextLength <= Memo.MaxLength then Exit;
2597
2598    CutLength:= CurrLength + NewTextLength - Memo.MaxLength;
2599
2600    if NewTextLength - CutLength > 0 then
2601      gtk_editable_insert_text(PGtkEditable(widget), char,
2602                               NewTextLength - CutLength, Position);
2603
2604    g_signal_stop_emission_by_name(PGtkObject(widget), 'insert_text');
2605  end;
2606  if TObject(Data) is TCustomEdit then
2607    if (NewTextLength = 1) and (char^ = #13) then
2608      g_signal_stop_emission_by_name(PGtkObject(widget), 'insert_text');
2609end;
2610
2611function gtkSetEditable( {%H-}widget: PGtkWidget; data: gPointer) : GBoolean; cdecl;
2612var
2613  Mess : TLMessage;
2614begin
2615  EventTrace('Set Editable', data);
2616  Mess.msg := LM_SETEDITABLE;
2617  Result:= DeliverMessage(Data, Mess) = 0;
2618end;
2619
2620function gtkMoveWord( {%H-}widget: PGtkWidget; data: gPointer) : GBoolean; cdecl;
2621var
2622   Mess : TLMessage;
2623begin
2624  EventTrace('Move Word', data);
2625  Mess.msg := LM_MOVEWORD;
2626  Result:= DeliverMessage(Data, Mess) = 0;
2627end;
2628
2629function gtkMovePage( {%H-}widget: PGtkWidget; data: gPointer) : GBoolean; cdecl;
2630var
2631  Mess : TLMessage;
2632begin
2633  EventTrace('Move Page', data);
2634  Mess.msg := LM_MOVEPAGE;
2635  Result:= DeliverMessage(Data, Mess) = 0;
2636end;
2637
2638function gtkMoveToRow( {%H-}widget: PGtkWidget; data: gPointer) : GBoolean; cdecl;
2639var
2640  Mess : TLMessage;
2641begin
2642  EventTrace('Move To Row!!', data);
2643  Mess.msg := LM_MOVETOROW;
2644  Result:= DeliverMessage(Data, Mess) = 0;
2645end;
2646
2647function gtkMoveToColumn( {%H-}widget: PGtkWidget; data: gPointer) : GBoolean; cdecl;
2648var
2649  Mess : TLMessage;
2650begin
2651  EventTrace('MoveToColumn', data);
2652  Mess.msg := LM_MOVETOCOLUMN;
2653  Result:= DeliverMessage(Data, Mess) = 0;
2654end;
2655
2656function gtkKillChar( {%H-}widget: PGtkWidget; data: gPointer) : GBoolean; cdecl;
2657var
2658  Mess : TLMessage;
2659begin
2660  EventTrace('Kill Char', data);
2661  Mess.msg := LM_KILLCHAR;
2662  Result:= DeliverMessage(Data, Mess) = 0;
2663end;
2664
2665function gtkKillWord( {%H-}widget: PGtkWidget; data: gPointer) : GBoolean; cdecl;
2666var
2667  Mess : TLMessage;
2668begin
2669  EventTrace('Kill Word', data);
2670  Mess.msg := LM_KILLWORD;
2671  Result:= DeliverMessage(Data, Mess) = 0;
2672end;
2673
2674function gtkKillLine( {%H-}widget: PGtkWidget; data: gPointer) : GBoolean; cdecl;
2675var
2676  Mess : TLMessage;
2677begin
2678  EventTrace('Kill Line', data);
2679  Mess.msg := LM_KILLLINE;
2680  Result:= DeliverMessage(Data, Mess) = 0;
2681end;
2682
2683function gtkCutToClip( widget: PGtkWidget; data: gPointer) : GBoolean; cdecl;
2684var
2685  Mess : TLMessage;
2686begin
2687  EventTrace('Cut to clip', data);
2688  Mess.msg := LM_CUT;
2689  Result:= DeliverMessage(Data, Mess) = 0;
2690end;
2691
2692function gtkCopyToClip( {%H-}widget: PGtkWidget; data: gPointer) : GBoolean; cdecl;
2693var
2694  Mess : TLMessage;
2695begin
2696  EventTrace('Copy to Clip', data);
2697  Mess.msg := LM_COPY;
2698  Result:= DeliverMessage(Data, Mess) = 0;
2699end;
2700
2701function gtkPasteFromClip( widget: PGtkWidget; data: gPointer) : GBoolean; cdecl;
2702var
2703  Mess : TLMessage;
2704begin
2705  EventTrace('Paste from clip', data);
2706  Mess.msg := LM_PASTE;
2707  Result:= DeliverMessage(Data, Mess) = 0;
2708end;
2709
2710function gtkValueChanged({%H-}widget: PGtkWidget; data: gPointer) : GBoolean; cdecl;
2711var
2712  Mess : TLMessage;
2713begin
2714  Result := CallBackDefaultReturn;
2715  EventTrace('Value changed', data);
2716  Mess.msg := LM_CHANGED;
2717  DeliverMessage(Data, Mess);
2718end;
2719
2720{------------------------------------------------------------------------------
2721  Method: gtkTimerCB
2722  Params:  Data - pointer TGtkITimerInfo structure
2723  Returns: 1    - 1 tells gtk to restart the timer
2724           0    - 0 will stop the gtk timer
2725
2726  Callback for gtk timer.
2727
2728  WARNING: There seems to be a bug in gtk-1.2.x which breaks
2729           gtk_timeout_remove so we have to dispose data here & return 0
2730           (s.a. KillTimer).
2731 ------------------------------------------------------------------------------}
2732function gtkTimerCB(Data: gPointer): gBoolean; cdecl;
2733var
2734  TimerInfo: PGtkITimerinfo;
2735begin
2736  EventTrace ('TimerCB', nil);
2737  Result := GdkFalse;  // assume: timer will stop
2738
2739  TimerInfo:=PGtkITimerinfo(Data);
2740
2741  if (FTimerData=nil) or (FTimerData.IndexOf(Data)<0) then begin
2742    {$IFDEF VerboseTimer}
2743    DebugLn('gtkTimerCB Timer was killed: TimerInfo=',DbgS(TimerInfo));
2744    {$ENDIF}
2745    // timer was killed
2746    Result:=GdkFalse; // stop timer
2747  end else begin
2748    {$IFDEF VerboseTimer}
2749    DebugLn('gtkTimerCB Timer Event: TimerInfo=',DbgS(TimerInfo));
2750    {$ENDIF}
2751    if TimerInfo^.TimerFunc <> nil
2752    then begin
2753      // Call users timer function
2754      //DebugLn(['gtkTimerCB ']);
2755      TimerInfo^.TimerFunc;
2756      Result:=GdkTrue; // timer will go on
2757    end
2758    else begin
2759      Result := GdkFalse; // stop timer
2760    end;
2761  end;
2762
2763  if (Result<>GdkFalse) and (FTimerData.IndexOf(Data)<0) then begin
2764    // timer was killed
2765    // -> stop timer
2766    Result:=GdkFalse;
2767  end;
2768
2769  if Result=GdkFalse then begin
2770    {$IFDEF VerboseTimer}
2771    DebugLn('gtkTimerCB Timer was STOPPED: TimerInfo=',DbgS(TimerInfo));
2772    {$ENDIF}
2773    // timer will be stopped
2774    // -> free timer data, if not already done
2775    if (FTimerData<>nil) and (FTimerData.IndexOf(Data)>=0) then begin
2776      FTimerData.Remove(Data);
2777      Dispose (TimerInfo);     // free memory with timer data
2778    end;
2779  end;
2780end;
2781
2782function gtkFocusInNotifyCB (widget : PGtkWidget; {%H-}event : PGdkEvent;
2783  data : gpointer) : GBoolean; cdecl;
2784var
2785  MessI : TLMEnter;
2786begin
2787  Result := CallBackDefaultReturn;
2788  //DebugLn('[gtkFocusInNotifyCB] ',TControl(data).Name,':',TObject(data).ClassName);
2789  {$IFDEF EventTrace}
2790  EventTrace ('FocusInNotify (alias Enter)', data);
2791  {$ENDIF}
2792
2793  if csDesigning in TControl(Data).ComponentState then begin
2794    // stop the signal, so that the widget does not auto react
2795    g_signal_stop_emission_by_name(PGTKObject(Widget),'focus-in-event');
2796  end;
2797
2798  MessI.msg := LM_Enter;
2799  DeliverMessage(Data, MessI);
2800end;
2801
2802function gtkFocusOutNotifyCB (widget : PGtkWidget; {%H-}event : PGdkEvent;
2803  data : gpointer) : GBoolean; cdecl;
2804var
2805  MessI : TLMExit;
2806begin
2807  Result := CallBackDefaultReturn;
2808  //DebugLn('[gtkFocusOutNotifyCB] ',TControl(data).Name,':',TObject(data).ClassName);
2809  {$IFDEF EventTrace}
2810  EventTrace ('FocusOutNotify (alias Exit)', data);
2811  {$ENDIF}
2812
2813  if csDesigning in TControl(Data).ComponentState then begin
2814    // stop the signal, so that the widget does not auto react
2815    g_signal_stop_emission_by_name(PGTKObject(Widget),'focus-out-event');
2816  end;
2817
2818  MessI.msg := LM_Exit;
2819  DeliverMessage(Data, MessI);
2820end;
2821
2822function get_gtk_scroll_type(range: PGTKRange): TGtkScrollType;
2823type
2824  TUnOpaqueTimer=record
2825    timeout_id: guint;
2826    ScrollType: TGTkScrollType;
2827  end;
2828  PUnOpaqueTimer=^TUnopaqueTimer;
2829begin
2830  if (gtk_major_version=2) and (gtk_minor_version<6) and
2831     (Range^.Timer<>nil) then
2832    { gtk2 pre gtk2.6 ONLY, tested gtk2.0.
2833      Later versions (gtk2.6+) have a change-value signal that includes scrolltype anyways }
2834
2835    Result := PUnOpaqueTimer(Range^.Timer)^.ScrollType
2836  else
2837    Result := GTK_SCROLL_NONE;
2838end;
2839
2840{$IFDEF VerboseGtkScrollbars}
2841procedure DebugScrollStyle(Scroll: LongInt);
2842begin
2843  DbgOut('TYPE=');
2844  case Scroll of
2845    GTK_SCROLL_NONE: DbgOut('GTK_SCROLL_NONE ');
2846    GTK_SCROLL_STEP_BACKWARD: DbgOut('GTK_SCROLL_STEP_BACKWARD ');
2847    GTK_SCROLL_STEP_FORWARD: DbgOut('GTK_SCROLL_STEP_FORWARD ');
2848    GTK_SCROLL_PAGE_BACKWARD: DbgOut('GTK_SCROLL_PAGE_BACKWARD ');
2849    GTK_SCROLL_PAGE_FORWARD: DbgOut('GTK_SCROLL_PAGE_FORWARD ');
2850    GTK_SCROLL_JUMP: DbgOut('GTK_SCROLL_JUMP ');
2851    GTK_SCROLL_STEP_UP: DbgOut('GTK_SCROLL_STEP_UP');
2852    GTK_SCROLL_STEP_DOWN: DbgOut('GTK_SCROLL_STEP_DOWN');
2853    GTK_SCROLL_PAGE_UP: DbgOut('GTK_SCROLL_PAGE_UP');
2854    GTK_SCROLL_PAGE_DOWN: DbgOut('GTK_SCROLL_PAGE_DOWN');
2855    GTK_SCROLL_STEP_LEFT: DbgOut('GTK_SCROLL_STEP_LEFT');
2856    GTK_SCROLL_STEP_RIGHT: DbgOut('GTK_SCROLL_STEP_RIGHT');
2857    GTK_SCROLL_PAGE_LEFT: DbgOut('GTK_SCROLL_PAGE_LEFT');
2858    GTK_SCROLL_PAGE_RIGHT: DbgOut('GTK_SCROLL_PAGE_RIGHT');
2859    GTK_SCROLL_START: DbgOut('GTK_SCROLL_START');
2860    GTK_SCROLL_END: DbgOut('GTK_SCROLL_END');
2861    else
2862      DbgOut(IntToStr(Scroll), '->?');
2863  end;
2864end;
2865{$ENDIF VerboseGtkScrollbars}
2866
2867function ScrollTypeToSbCode(IsVertSB: boolean; ScrollType: TGtkScrollType;
2868                            UpdatePolicy: TGtkUpdateType): Integer;
2869begin
2870  case ScrollType of
2871    GTK_SCROLL_STEP_BACKWARD:
2872      if IsVertSB then
2873        Result := SB_LINEUP
2874      else
2875        Result := SB_LINELEFT;
2876    GTK_SCROLL_STEP_FORWARD:
2877      if IsVertSB then
2878        Result := SB_LINEDOWN
2879      else
2880        Result := SB_LINERIGHT;
2881    GTK_SCROLL_PAGE_BACKWARD:
2882      if IsVertSB then
2883        Result := SB_PAGEUP
2884      else
2885        Result := SB_PAGELEFT;
2886    GTK_SCROLL_PAGE_FORWARD:
2887      if IsVertSB then
2888        Result := SB_PAGEDOWN
2889      else
2890        Result := SB_PAGERIGHT;
2891    GTK_SCROLL_STEP_UP:
2892      Result := SB_LINEUP;
2893    GTK_SCROLL_STEP_DOWN:
2894      Result := SB_LINEDOWN;
2895    GTK_SCROLL_PAGE_UP:
2896      Result := SB_PAGEUP;
2897    GTK_SCROLL_PAGE_DOWN:
2898      Result := SB_PAGEDOWN;
2899    GTK_SCROLL_STEP_LEFT:
2900      Result := SB_LINELEFT;
2901    GTK_SCROLL_STEP_RIGHT:
2902      Result := SB_LINERIGHT;
2903    GTK_SCROLL_PAGE_LEFT:
2904      Result := SB_PAGELEFT;
2905    GTK_SCROLL_PAGE_RIGHT:
2906      Result := SB_PAGERIGHT;
2907    GTK_SCROLL_START:
2908      if IsVertSB then
2909        Result := SB_TOP
2910      else
2911        Result := SB_LEFT;
2912    GTK_SCROLL_END:
2913      if IsVertSB then
2914        Result := SB_BOTTOM
2915      else
2916        Result := SB_RIGHT;
2917    else
2918      begin
2919        {$IFDEF VerboseGtkScrollbars}
2920        debugln('ScrollTypeToSbCode: Scroll_type=', IntToStr(ScrollType));
2921        {$Endif}
2922        if UpdatePolicy=GTK_UPDATE_CONTINUOUS then
2923          Result := SB_THUMBTRACK
2924        else
2925          Result := SB_THUMBPOSITION;
2926      end;
2927  end;
2928end;
2929
2930function GTKHScrollCB(Adjustment: PGTKAdjustment; data: GPointer): GBoolean; cdecl;
2931var
2932  Msg: TLMHScroll;
2933  Scroll: PGtkRange;
2934  ScrollType: TGtkScrollType;
2935begin
2936  Result := CallBackDefaultReturn;
2937  //DebugLn(Format('Trace:[GTKHScrollCB] Value: %d', [RoundToInt(Adjustment^.Value)]));
2938  Scroll := PgtkRange(g_object_get_data(PGObject(Adjustment), odnScrollBar));
2939  if Scroll<>nil then begin
2940    Msg.Msg := LM_HSCROLL;
2941    with Msg do begin
2942      Pos := Round(Adjustment^.Value);
2943      if Pos < High(SmallPos)
2944      then SmallPos := Pos
2945      else SmallPos := High(SmallPos);
2946      ScrollBar := HWND({%H-}PtrUInt(Scroll));
2947      ScrollType := get_gtk_scroll_type(Scroll);
2948      ScrollCode := ScrollTypeToSbCode(False, ScrollType,
2949                                       gtk_range_get_update_policy(Scroll));
2950    end;
2951    DeliverMessage(Data, Msg);
2952  end;
2953end;
2954
2955function GTKVScrollCB(Adjustment: PGTKAdjustment; data: GPointer): GBoolean; cdecl;
2956var
2957  Msg: TLMVScroll;
2958  Scroll: PGtkRange;
2959  ScrollType: TGtkScrollType;
2960begin
2961  //TODO: implement SB_THUMBPOSITION message after track is finished
2962
2963  Result := CallBackDefaultReturn;
2964  {$IFDEF SYNSCROLLDEBUG}
2965  DebugLn(Format('Trace:[GTKVScrollCB] Value: %d', [RoundToInt(Adjustment^.Value)]));
2966  {$ENDIF}
2967  Scroll := PgtkRange(g_object_get_data(PGObject(Adjustment), odnScrollBar));
2968  if Scroll<>nil then begin
2969    Msg.Msg := LM_VSCROLL;
2970    with Msg do begin
2971      Pos := Round(Adjustment^.Value);
2972      if Pos < High(SmallPos)
2973      then SmallPos := Pos
2974      else SmallPos := High(SmallPos);
2975      //DebugLn('GTKVScrollCB A Adjustment^.Value=',dbgs(Adjustment^.Value),' SmallPos=',dbgs(SmallPos));
2976      ScrollBar := HWND({%H-}PtrUInt(Scroll));
2977      ScrollType := get_gtk_scroll_type(Scroll);
2978      // GTK1 has a bug with wheel mouse. It sometimes gives the wrong direction.
2979      ScrollCode := ScrollTypeToSbCode(True, ScrollType,
2980                                       gtk_range_get_update_policy(Scroll));
2981      //DebugLn('GTKVScrollCB B Adjustment^.Value=',dbgs(Adjustment^.Value),' ScrollCode=',dbgs(ScrollCode),' ScrollType=',dbgs(ScrollType));
2982    end;
2983    DeliverMessage(Data, Msg);
2984  end;
2985end;
2986
2987function Gtk2RangeScrollCB(ARange: PGtkRange; AScrollType: TGtkScrollType;
2988                  AValue: gdouble; AWidgetInfo: PWidgetInfo): gboolean; cdecl;
2989var
2990  Msg: TLMVScroll;
2991  MaxValue: gdouble;
2992  Widget: PGTKWidget;
2993begin
2994  Result := CallBackDefaultReturn;
2995
2996  Widget:=PGTKWidget(ARange);
2997  {$IFDEF SYNSCROLLDEBUG}
2998  DebugLn(Format('Trace:[Gtk2RangeScrollCB] Value: %d', [RoundToInt(AValue)]));
2999  {$ENDIF}
3000  if G_OBJECT_TYPE(ARange) = gtk_hscrollbar_get_type then
3001    Msg.Msg := LM_HSCROLL
3002  else
3003    Msg.Msg := LM_VSCROLL;
3004
3005  if ARange^.adjustment^.page_size > 0 then
3006    MaxValue := ARange^.adjustment^.upper - ARange^.adjustment^.page_size
3007  else
3008    MaxValue := ARange^.adjustment^.upper;
3009
3010  if (AValue > MaxValue) then
3011    AValue := MaxValue
3012  else if (AValue < ARange^.adjustment^.lower) then
3013    AValue := ARange^.adjustment^.lower;
3014
3015  with Msg do
3016  begin
3017    Pos := Round(AValue);
3018    if Pos < High(SmallPos) then
3019      SmallPos := Pos
3020    else
3021      SmallPos := High(SmallPos);
3022
3023    ScrollBar := HWND({%H-}PtrUInt(ARange));
3024    ScrollCode := GtkScrollTypeToScrollCode(AScrollType);
3025  end;
3026  DeliverMessage(AWidgetInfo^.LCLObject, Msg);
3027
3028  if Msg.Scrollcode=SB_THUMBTRACK then
3029  begin
3030    if Widget^.state = 0 then
3031    begin
3032      Msg.ScrollCode := SB_THUMBPOSITION;
3033      DeliverMessage(AWidgetInfo^.LCLObject, Msg);
3034      Msg.ScrollCode:=SB_ENDSCROLL;
3035      DeliverMessage(AWidgetInfo^.LCLObject, Msg);
3036    end;
3037  end
3038  else Widget^.state := 1;
3039
3040  if (AWidgetInfo^.LCLObject is TScrollingWinControl) and
3041  ((Msg.ScrollCode=SB_LINEUP) or (Msg.ScrollCode=SB_LINEDOWN)) then
3042  Result:=True;
3043end;
3044
3045procedure Gtk2RangeValueChanged(ARange: PGTKRange; data: GPointer); cdecl;
3046var
3047  Msg: TLMVScroll;
3048  MaxValue: gdouble;
3049  Widget: PGTKWidget;
3050  AValue: gDouble;
3051begin
3052  // used only by TScrollingWinControl ! #issue #25479
3053  Widget := PGTKWidget(ARange);
3054  if G_OBJECT_TYPE(ARange) = gtk_hscrollbar_get_type then
3055    Msg.Msg := LM_HSCROLL
3056  else
3057    Msg.Msg := LM_VSCROLL;
3058
3059  AValue := gtk_range_get_value(ARange);
3060
3061  if ARange^.adjustment^.page_size > 0 then
3062    MaxValue := ARange^.adjustment^.upper - ARange^.adjustment^.page_size
3063  else
3064    MaxValue := ARange^.adjustment^.upper;
3065
3066  if (AValue > MaxValue) then
3067    AValue := MaxValue
3068  else if (AValue < ARange^.adjustment^.lower) then
3069    AValue := ARange^.adjustment^.lower;
3070
3071  with Msg do
3072  begin
3073    Pos := Round(AValue);
3074    if Pos < High(SmallPos) then
3075      SmallPos := Pos
3076    else
3077      SmallPos := High(SmallPos);
3078
3079    ScrollBar := HWND({%H-}PtrUInt(ARange));
3080    ScrollCode := SB_THUMBTRACK;
3081  end;
3082
3083  // do not send messages to LCL if we are already synced.
3084  if (Msg.Msg = LM_VSCROLL) and
3085    (TScrollingWinControl(PWidgetInfo(Data)^.LCLObject).VertScrollBar.Position = Msg.Pos) then
3086    exit
3087  else
3088  if (Msg.Msg = LM_HSCROLL) and
3089    (TScrollingWinControl(PWidgetInfo(Data)^.LCLObject).HorzScrollBar.Position = Msg.Pos) then
3090    exit;
3091
3092  DeliverMessage(PWidgetInfo(Data)^.LCLObject, Msg);
3093
3094  if Msg.Scrollcode=SB_THUMBTRACK then
3095  begin
3096    if Widget^.state = 0 then
3097    begin
3098      Msg.ScrollCode := SB_THUMBPOSITION;
3099      DeliverMessage(PWidgetInfo(Data)^.LCLObject, Msg);
3100      Msg.ScrollCode:=SB_ENDSCROLL;
3101      DeliverMessage(PWidgetInfo(Data)^.LCLObject, Msg);
3102    end;
3103  end
3104  else Widget^.state := 1;
3105end;
3106
3107function Gtk2RangeScrollPressCB(Widget: PGtkWidget;
3108  Event: PGdkEventButton; Data: gPointer): gboolean; cdecl;
3109begin
3110  Widget^.state := 2;
3111  Result := CallBackDefaultReturn;;
3112end;
3113
3114function Gtk2RangeScrollReleaseCB(Widget: PGtkWidget;
3115  Event: PGdkEventButton; Data: gPointer): gboolean; cdecl;
3116var
3117  Avalue: gdouble;
3118  WidgetInfo: PWidgetInfo;
3119begin
3120  AValue:=PGtkRange(Widget)^.adjustment^.value;
3121  WidgetInfo:=GetWidgetInfo(Widget);
3122  if not Assigned(WidgetInfo) then
3123    WidgetInfo:=GetWidgetInfo(Widget^.parent);
3124  if Assigned(WidgetInfo) and (Widget^.state = 1) then
3125    Gtk2RangeScrollCB(PGtkRange(Widget), 0, AValue, WidgetInfo);
3126  Widget^.state := 0;
3127  Result := CallBackDefaultReturn;
3128end;
3129
3130function Gtk2RangeUbuntuScrollCB(Adjustment: PGTKAdjustment; data: GPointer): GBoolean; cdecl;
3131var
3132  Msg: TLMVScroll;
3133  AWidgetInfo: PWidgetInfo;
3134  Scroll: PGtkRange;
3135  ScrollType: TGtkScrollType;
3136  LastPos: PtrInt;
3137begin
3138  Result := CallBackDefaultReturn;
3139  AWidgetInfo:=PWidgetInfo(Data);
3140
3141  //debugln(['Gtk2RangeUbuntuScrollCB ',DbgSName(AWidgetInfo^.LCLObject)]);
3142  Scroll := PgtkRange(g_object_get_data(PGObject(Adjustment), odnScrollBar));
3143  if Scroll<>nil then begin
3144    FillByte(Msg{%H-},SizeOf(Msg),0);
3145    if Scroll^.orientation=GTK_ORIENTATION_VERTICAL then
3146      Msg.Msg := LM_VSCROLL
3147    else
3148      Msg.Msg := LM_HSCROLL;
3149    with Msg do begin
3150      Pos := Round(Adjustment^.Value);
3151      if Pos < High(SmallPos)
3152      then SmallPos := Pos
3153      else SmallPos := High(SmallPos);
3154
3155      LastPos:={%H-}PtrInt(g_object_get_data(PGObject(Adjustment), odnScrollBarLastPos));
3156      if LastPos=Pos then begin
3157        //debugln(['Gtk2RangeUbuntuScrollCB duplicate message => skip']);
3158        exit;
3159      end;
3160      g_object_set_data(PGObject(Adjustment), odnScrollBarLastPos, {%H-}gpointer(Pos));
3161
3162      //DebugLn('Gtk2RangeUbuntuScrollCB A Adjustment^.Value=',dbgs(Adjustment^.Value),' SmallPos=',dbgs(SmallPos));
3163      ScrollBar := HWND({%H-}PtrUInt(Scroll));
3164      ScrollType := get_gtk_scroll_type(Scroll);
3165      ScrollCode := ScrollTypeToSbCode(True, ScrollType,
3166                                       gtk_range_get_update_policy(Scroll));
3167      //DebugLn('Gtk2RangeUbuntuScrollCB B Adjustment^.Value=',dbgs(Adjustment^.Value),' ScrollCode=',dbgs(ScrollCode),' ScrollType=',dbgs(ScrollType));
3168    end;
3169    DeliverMessage(AWidgetInfo^.LCLObject, Msg);
3170    Result:=true;
3171  end;
3172end;
3173
3174function Gtk2ScrolledWindowScrollCB(AScrollWindow: PGtkScrolledWindow; AEvent: PGdkEventScroll; AWidgetInfo: PWidgetInfo): gboolean; cdecl;
3175var
3176  Msg: TLMVScroll;
3177  AValue: Double;
3178  Range: PGtkRange;
3179begin
3180  {$IFDEF SYNSCROLLDEBUG}
3181  debugln(['Gtk2ScrolledWindowScrollCB ']);
3182  {$ENDIF}
3183  case AEvent^.direction of
3184    GDK_SCROLL_UP,
3185    GDK_SCROLL_DOWN: Msg.Msg := LM_VSCROLL;
3186    GDK_SCROLL_LEFT,
3187    GDK_SCROLL_RIGHT: Msg.Msg := LM_HSCROLL;
3188  end;
3189
3190  case Msg.Msg of
3191    LM_VSCROLL: Range := GTK_RANGE(AScrollWindow^.vscrollbar);
3192    LM_HSCROLL: Range := GTK_RANGE(AScrollWindow^.hscrollbar);
3193  end;
3194
3195  AValue :=  power(Range^.adjustment^.page_size, 2 / 3);
3196
3197  if (AEvent^.direction = GDK_SCROLL_UP) or
3198     (AEvent^.direction = GDK_SCROLL_LEFT)
3199  then
3200    AValue := -AValue;
3201
3202  AValue := gtk_range_get_value(Range) + AValue;
3203
3204  AValue := Max(AValue, Range^.adjustment^.lower);
3205  AValue := Min(AValue, Range^.adjustment^.upper - Range^.adjustment^.page_size);
3206
3207  with Msg do
3208  begin
3209    Pos := Round(AValue);
3210    if Pos < High(SmallPos) then
3211      SmallPos := Pos
3212    else
3213      SmallPos := High(SmallPos);
3214
3215    ScrollBar := HWND({%H-}PtrUInt(Range));
3216    ScrollCode := SB_THUMBPOSITION;
3217  end;
3218  Result := DeliverMessage(AWidgetInfo^.LCLObject, Msg) <> 0;
3219end;
3220
3221{------------------------------------------------------------------------------
3222  Function: GTKKeySnooper
3223  Params:  Widget: The widget for which this event is fired
3224           Event:  The keyevent data
3225           FuncData: the user parameter passed when the snooper was installed
3226  Returns: True if other snoopers shouldn't handled
3227
3228  Keeps track of which keys are pressed. The keycode is casted to a pointer and
3229  if it exists in the KeyStateList, it is pressed.
3230 ------------------------------------------------------------------------------}
3231function GTKKeySnooper(Widget: PGtkWidget; Event: PGdkEventKey;
3232  FuncData: gPointer): gInt; cdecl;
3233var
3234  KeyStateList: TFPList absolute FuncData;
3235
3236  procedure UpdateToggleList(const AVKeyCode: Integer);
3237  begin
3238    // Check for a toggle
3239    // If the remove was successfull, the key was on
3240    // else it was off so we should set the toggle flag
3241    if KeyStateList.Remove({%H-}Pointer(PtrUInt(AVKeyCode or KEYMAP_TOGGLE))) < 0
3242    then KeyStateList.Add({%H-}Pointer(PtrUInt(AVKeyCode or KEYMAP_TOGGLE)));
3243  end;
3244
3245  procedure UpdateList(const AVKeyCode: Integer; const APressed: Boolean);
3246  begin
3247    if AVKeyCode = 0 then Exit;
3248    if APressed
3249    then begin
3250      if KeyStateList.IndexOf({%H-}Pointer(PtrUInt(AVKeyCode))) < 0
3251      then KeyStateList.Add({%H-}Pointer(PtrUInt(AVKeyCode)));
3252    end
3253    else begin
3254      KeyStateList.Remove({%H-}Pointer(PtrUInt(AVKeyCode)));
3255    end;
3256  end;
3257
3258const
3259  STATE_MAP: array[0..3] of TShiftStateEnum = (
3260    ssShift,
3261    ssCtrl,
3262    ssAlt,
3263    ssSuper
3264  );
3265  VK_MAP: array[0..3] of array[0..2] of Byte = (
3266    // (Main key, alt key 1, alt key 2) to check
3267    (VK_SHIFT, VK_LSHIFT, VK_RSHIFT),
3268    (VK_CONTROL, VK_LCONTROL, VK_RCONTROL),
3269    (VK_MENU, VK_LMENU, VK_RMENU),
3270    (VK_LWIN, VK_RWIN, 0)
3271  );
3272var
3273  KeyCode: Word;
3274  KCInfo: TKeyCodeInfo;
3275  VKey: Byte;
3276  Pressed, InState: Boolean;
3277
3278  n: Integer;
3279  ShiftState: TShiftState;
3280
3281begin
3282  Result := 0;
3283
3284  // TODO: Remove when KeyStateList is obsolete
3285
3286  case gdk_event_get_type(Event) of
3287    GDK_KEY_PRESS: Pressed := True;
3288    GDK_KEY_RELEASE: Pressed := False;
3289  else
3290    // not interested
3291    Exit;
3292  end;
3293
3294  KeyCode := Event^.hardware_keycode;
3295  //DebugLn('GTKKeySnooper: KeyCode=%u -> %s', [KeyCode, Event^._String ]);
3296
3297  if KeyCode > High(MKeyCodeInfo)
3298  then begin
3299    if Pressed
3300    then DebugLn('[WARNING] Key pressed with keycode (%u) larger than expected: K=0x%x S="%s"', [
3301      KeyCode,
3302      Event^.KeyVal,
3303      Event^._String
3304    ]);
3305    Exit;
3306  end;
3307
3308  KCInfo := MKeyCodeInfo[KeyCode];
3309  if KCInfo.VKey1 = 0
3310  then begin
3311    if Pressed
3312    then DebugLn('[WARNING] Key pressed without VKey: K=0x%x S="%s"', [
3313      Event^.KeyVal,
3314      Event^._String
3315    ]);
3316    Exit;
3317  end;
3318
3319  if KeyStateList = nil then exit;
3320
3321  ShiftState := GTKEventStateToShiftState(Event^.State);
3322
3323  if (KCInfo.Flags and KCINFO_FLAG_SHIFT_XOR_NUM <> 0)
3324  and ((ssShift in ShiftState) xor (ssNum in ShiftState))
3325  then VKey := KCInfo.VKey2
3326  else VKey := KCInfo.VKey1;
3327
3328  UpdateList(VKey, Pressed);
3329  if Pressed then
3330    UpdateToggleList(VKey);
3331
3332  // Add special left and right codes
3333  case Event^.KeyVal of
3334    GDK_Key_Shift_L:   UpdateList(VK_LSHIFT,   Pressed);
3335    GDK_Key_Shift_R:   UpdateList(VK_RSHIFT,   Pressed);
3336    GDK_Key_Control_L: UpdateList(VK_LCONTROL, Pressed);
3337    GDK_Key_Control_R: UpdateList(VK_RCONTROL, Pressed);
3338    GDK_Key_Alt_L:     UpdateList(VK_LMENU,    Pressed);
3339    GDK_Key_Alt_R:     UpdateList(VK_RMENU,    Pressed);
3340  end;
3341
3342  // Recheck the list against the modifiers
3343  for n := 0 to High(STATE_MAP) do
3344  begin
3345    // Skip our current key, since the state is updated after the event
3346    if VKey = VK_MAP[n][0] then Continue;
3347    if VKey = VK_MAP[n][1] then Continue;
3348    if VKey = VK_MAP[n][2] then Continue;
3349
3350    InState := STATE_MAP[n] in ShiftState;
3351    UpdateList(VK_MAP[n][0], InState);
3352    UpdateList(VK_MAP[n][1], InState);
3353    UpdateList(VK_MAP[n][2], InState);
3354  end;
3355
3356  // if the VKey has multiple VK_codes then SHIFT distinguishes between them
3357  // In that case SHIFT is not pressed
3358  // On the next event the shift flag will be restored based on modifiers
3359  if Pressed and ((KCInfo.Flags and KCINFO_FLAG_SHIFT_XOR_NUM) <> 0)
3360  then begin
3361    UpdateList(VK_SHIFT,  False);
3362    UpdateList(VK_LSHIFT, False);
3363    UpdateList(VK_RSHIFT, False);
3364  end;
3365end;
3366
3367function gtkYearChanged({%H-}Widget: PGtkWidget; data: gPointer) : GBoolean; cdecl;
3368var
3369  MSG: TLMessage;
3370begin
3371  Result := CallBackDefaultReturn;
3372
3373  EventTrace('year changed', data);
3374  MSG.Msg := LM_YEARCHANGED;
3375  DeliverPostMessage(Data, MSG);
3376end;
3377
3378procedure GtkDragDataReceived(widget:PGtkWidget; context:PGdkDragContext;
3379  x:gint; y:gint; selection_data:PGtkSelectionData; info:guint; time:guint; Data: gPointer);cdecl;
3380var
3381  S: TStringList;
3382  I: Integer;
3383  FileName, DecodedFileName: String;
3384  Files: Array of String;
3385  Form: TControl;
3386  Result: Boolean;
3387  U: TURI;
3388begin
3389  //DebugLn('GtkDragDataReceived ' + PChar(selection_data^.data));
3390  Result := False;
3391
3392  if selection_data^.data <> nil then // data is list of uri
3393  try
3394    SetLength(Files{%H-}, 0);
3395    S := TStringList.Create;
3396    try
3397      S.Text := PChar(selection_data^.data);
3398
3399      for I := 0 to S.Count - 1 do
3400      begin
3401        FileName := S[I];
3402
3403        if FileName = '' then Continue;
3404        // uri = protocol://hostname/file name
3405        U := ParseURI(FileName);
3406        if (SameText(U.Host, 'localhost') or (U.Host = '')) and SameText(U.Protocol, 'file')
3407          and URIToFileName(FileName, DecodedFileName) then // convert uri of local files to file name
3408        begin
3409          FileName := DecodedFileName;
3410        end;
3411        // otherwise: protocol and hostname are preserved!
3412
3413        if FileName = '' then Continue;
3414        SetLength(Files, Length(Files) + 1);
3415        Files[High(Files)] := FileName;
3416        //DebugLn('GtkDragDataReceived ' + DbgS(I) + ': ' + PChar(FileName));
3417      end;
3418    finally
3419      S.Free;
3420    end;
3421
3422    if Length(Files) > 0 then
3423    begin
3424      Form := nil;
3425      if (TObject(Data) is TWinControl) then
3426        Form := TWinControl(Data).IntfGetDropFilesTarget;
3427
3428      if Form is TCustomForm then
3429        TCustomForm(Form).IntfDropFiles(Files)
3430      else
3431        if (Application <> nil) and (Application.MainForm <> nil) then
3432          Application.MainForm.IntfDropFiles(Files);
3433
3434      if Application <> nil then
3435        Application.IntfDropFiles(Files);
3436
3437      Result := True;
3438    end;
3439  except
3440    Application.HandleException(nil);
3441  end;
3442
3443  gtk_drag_finish(Context, Result, false, time);
3444end;
3445
3446{------------------------------------------------------------------------------
3447  ClipboardSelectionReceivedHandler
3448
3449  This handler is called whenever a clipboard owner sends data. Because the LCL
3450  caches all requests, this is typically data from another application.
3451  Copy the received selection data record and buffer to
3452  internal record and buffer (ClipboardSelectionData)
3453 ------------------------------------------------------------------------------}
3454procedure ClipboardSelectionReceivedHandler({%H-}TargetWidget: PGtkWidget;
3455  SelectionData: PGtkSelectionData; TimeID: guint32; {%H-}Data: Pointer); cdecl;
3456var TempBuf: Pointer;
3457  c: PClipboardEventData;
3458  i: integer;
3459begin
3460  // at any time there can be several requests
3461  // find the request with the correct TimeID
3462  i:=ClipboardSelectionData.Count-1;
3463  while (i>=0) do begin
3464    c:=PClipboardEventData(ClipboardSelectionData[i]);
3465    if c^.TimeID=TimeID then break;
3466    dec(i);
3467  end;
3468  {$IFDEF DEBUG_CLIPBOARD}
3469  DebugLn('[ClipboardSelectionReceivedHandler] A TimeID=',dbgs(TimeID),' RequestIndex=',dbgs(i),
3470    ' selection=',dbgs(SelectionData^.selection)+'='+GdkAtomToStr(SelectionData^.selection),
3471    ' target=',dbgs(SelectionData^.Target)+'='+GdkAtomToStr(SelectionData^.Target),
3472    ' theType=',dbgs(SelectionData^._type)+'='+GdkAtomToStr(SelectionData^._type),
3473    ' format=',dbgs(SelectionData^.format),
3474    ' len=',dbgs(SelectionData^.length)
3475    );
3476  {$ENDIF}
3477  if i<0 then exit;
3478  // free old data
3479  if (c^.Data.Data<>nil) then FreeMem(c^.Data.Data);
3480  // copy the information
3481  c^.Data:=SelectionData^;
3482  // copy the raw data to an internal buffer (the gtk buffer will be destroyed
3483  // right after this event)
3484  {$IFDEF DEBUG_CLIPBOARD}
3485  DebugLn('[ClipboardSelectionReceivedHandler] B DataLen=',dbgs(c^.Data.Length));
3486  {$ENDIF}
3487  if (c^.Data.Data<>nil)
3488  and (c^.Data.Length>0) then begin
3489    GetMem(TempBuf,c^.Data.Length);
3490    Move(c^.Data.Data^,TempBuf^,c^.Data.Length);
3491    c^.Data.Data:=TempBuf;
3492    {$IFDEF DEBUG_CLIPBOARD}
3493    DebugLn('[ClipboardSelectionReceivedHandler] C FirstCharacter=',dbgs(ord(PChar(c^.Data.Data)[0])));
3494    {$ENDIF}
3495  end else begin
3496    {if (SelectionData^.Target <> GDK_TARGET_STRING)
3497    and (SelectionData^.length<0) then begin
3498      if gtk_selection_convert (TargetWidget, SelectionData^.selection,
3499        GDK_TARGET_STRING, TimeID)<>GdkFalse
3500      then begin
3501        DebugLn('[ClipboardSelectionReceivedHandler] D TimeID=',dbgs(TimeID),' RequestIndex=',dbgs(i),
3502          ' selection=',dbgs(SelectionData^.selection)+'='+GdkAtomToStr(SelectionData^.selection),
3503          ' target=',dbgs(SelectionData^.Target)+'='+GdkAtomToStr(SelectionData^.Target),
3504          ' theType=',dbgs(SelectionData^.theType)+'='+GdkAtomToStr(SelectionData^.theType),
3505          ' format=',dbgs(SelectionData^.format),
3506          ' len=',dbgs(SelectionData^.length)
3507          );
3508      end;
3509    end;}
3510    c^.Data.Data:=nil;
3511  end;
3512end;
3513
3514// Helper procedures for ClipboardSelectionRequestHandler :
3515
3516procedure Transform2CompoundText(SelectionData: PGtkSelectionData; MemStream: TMemoryStream);
3517var
3518  Buffer: Pointer;
3519  BufLength: integer;
3520  P: PChar;
3521begin
3522  BufLength:=integer(MemStream.Size);
3523  P:=StrAlloc(BufLength);
3524  MemStream.Read(P^,BufLength);
3525  Buffer:=nil;
3526  BufLength:=0;
3527  gdk_string_to_compound_text(P,
3528    @SelectionData^._Type,
3529    @SelectionData^.Format,ppguchar(@Buffer),@BufLength);
3530  StrDispose(P);
3531  gtk_selection_data_set(SelectionData,SelectionData^.Target,
3532    SelectionData^.Format,Buffer,BufLength);
3533  gdk_free_compound_text(Buffer);
3534end;
3535
3536procedure SetData(SelectionData: PGtkSelectionData; MemStream: TMemoryStream);
3537var
3538  Buffer: Pointer;
3539  BufLength: integer;
3540begin
3541  BufLength:=integer(MemStream.Size);
3542  GetMem(Buffer,BufLength);
3543  Assert(Assigned(Buffer) and (BufLength>0), 'SetData: GTK2 clipboard Buffer=Nil or empty.');
3544  MemStream.Read(Buffer^,BufLength);
3545  gtk_selection_data_set(SelectionData,SelectionData^.Target,8,Buffer,BufLength);
3546  FreeMem(Buffer);
3547end;
3548
3549{------------------------------------------------------------------------------
3550  ClipboardSelectionRequestHandler
3551
3552  This signal is emitted if someone requests the clipboard data.
3553  Since the lcl clipboard caches all requests this will typically be another
3554  application.
3555 ------------------------------------------------------------------------------}
3556procedure ClipboardSelectionRequestHandler({%H-}TargetWidget: PGtkWidget;
3557  SelectionData: PGtkSelectionData; {%H-}Info: cardinal; {%H-}TimeID: cardinal;
3558  {%H-}Data: Pointer); cdecl;
3559var
3560  ClipboardType: TClipboardType;
3561  FormatID: cardinal;
3562  MemStream: TMemoryStream;
3563begin
3564  {$IFDEF DEBUG_CLIPBOARD}
3565  DebugLn('*** [ClipboardSelectionRequestHandler] START');
3566  {$ENDIF}
3567  if SelectionData^.Target=0 then exit;
3568  for ClipboardType:=Low(TClipboardType) to High(TClipboardType) do
3569  begin
3570    if SelectionData^.Selection<>ClipboardTypeAtoms[ClipboardType] then
3571      Continue;
3572    if ClipboardHandler[ClipboardType]=nil then
3573      break;
3574    // handler found for this type of clipboard
3575    // now create a stream and find a supported format
3576    {$IFDEF DEBUG_CLIPBOARD}
3577    DebugLn('[ClipboardSelectionRequestHandler] "',ClipboardTypeName[ClipboardType],'" Format=',GdkAtomToStr(SelectionData^.Target),' ID=',dbgs(SelectionData^.Target));
3578    {$ENDIF}
3579    MemStream:=TMemoryStream.Create;
3580    try
3581      // the gtk-interface provides automatically some formats, that the lcl
3582      // does not know. Wrapping them to lcl formats ...
3583      FormatID:=SelectionData^.Target;
3584      if ((FormatID=gdk_atom_intern('UTF8_STRING',GdkTrue))
3585        and (ClipboardExtraGtkFormats[ClipboardType][gfUTF8_STRING]))
3586      or ((FormatID=gdk_atom_intern('COMPOUND_TEXT',GdkTrue))
3587        and (ClipboardExtraGtkFormats[ClipboardType][gfCOMPOUND_TEXT]))
3588      or ((FormatID=gdk_atom_intern('STRING',GdkTrue))
3589        and (ClipboardExtraGtkFormats[ClipboardType][gfSTRING]))
3590      or ((FormatID=gdk_atom_intern('TEXT',GdkTrue))
3591        and (ClipboardExtraGtkFormats[ClipboardType][gfTEXT]))
3592      then
3593        FormatID:=gdk_atom_intern('text/plain',GdkTrue);
3594
3595      {$IFDEF DEBUG_CLIPBOARD}
3596      DebugLn('[ClipboardSelectionRequestHandler] FormatID=',dbgs(FormatID),'=',GdkAtomToStr(FormatID),' ',dbgs(ClipboardExtraGtkFormats[ClipboardType][gfCOMPOUND_TEXT]));
3597      {$ENDIF}
3598      // get the requested data by calling a handler for this clipboard type
3599      //  and build data for gtk
3600      ClipboardHandler[ClipboardType](FormatID,MemStream);
3601      if MemStream.Size=0 then
3602        break;
3603      MemStream.Position:=0;
3604      if (FormatID=gdk_atom_intern('text/plain',GdkTrue))
3605      and (SelectionData^.Target=gdk_atom_intern('COMPOUND_TEXT',GdkTrue)) then
3606        // if the format was wrapped, transform text/plain back to COMPOUND_TEXT
3607        Transform2CompoundText(SelectionData, MemStream)
3608      else
3609        SetData(SelectionData, MemStream);
3610    finally
3611      MemStream.Free;
3612    end;
3613    break;
3614  end; // for
3615end;
3616
3617{------------------------------------------------------------------------------
3618  ClipboardSelectionLostOwnershipHandler
3619
3620  This signal is emitted if another application gets the clipboard ownership.
3621 ------------------------------------------------------------------------------}
3622function ClipboardSelectionLostOwnershipHandler({%H-}TargetWidget: PGtkWidget;
3623  EventSelection: PGdkEventSelection;  {%H-}Data: Pointer): cardinal; cdecl;
3624var ClipboardType: TClipboardType;
3625begin
3626  //DebugLn('*** [ClipboardSelectionLostOwnershipHandler] ',DbgS(targetwidget));
3627  for ClipboardType:=Low(TClipboardType) to High(TClipboardType) do
3628    if EventSelection^.Selection=ClipboardTypeAtoms[ClipboardType] then begin
3629      {$IFDEF DEBUG_CLIPBOARD}
3630      DebugLn('*** [ClipboardSelectionLostOwnershipHandler] ',ClipboardTypeName[ClipboardType]);
3631      {$ENDIF}
3632      if (ClipboardWidget<>nil)
3633      and (gdk_selection_owner_get(ClipboardTypeAtoms[ClipboardType])
3634        <> GetControlWindow(ClipboardWidget))
3635      and Assigned(ClipboardHandler[ClipboardType]) then begin
3636        // handler found for this type of clipboard
3637        {$IFDEF DEBUG_CLIPBOARD}
3638        DebugLn('[ClipboardSelectionLostOwnershipHandler] ',ClipboardTypeName[ClipboardType]);
3639        {$ENDIF}
3640        ClipboardHandler[ClipboardType](0,nil);
3641        ClipboardHandler[ClipboardType]:=nil;
3642      end;
3643      break;
3644    end;
3645  Result:=1;
3646end;
3647
3648{-------------------------------------------------------------------------------
3649  procedure GTKStyleChanged(Widget: PGtkWidget; previous_style : PGTKStyle;
3650    Data: Pointer); cdecl;
3651
3652  Handler for style changes. For example the user changes the theme.
3653  But also called on every widget realize, so it should not release all styles
3654  everytime.
3655-------------------------------------------------------------------------------}
3656{$IFDEF EventTrace}
3657procedure GTKStyleChanged({%H-}Widget: PGtkWidget; {%H-}previous_style : PGTKStyle;
3658  {%H-}Data: Pointer); cdecl;
3659begin
3660  EventTrace('style-set', nil);
3661  //ReleaseAllStyles;
3662end;
3663
3664procedure GTKStyleChangedAfter({%H-}Widget: PGtkWidget; {%H-}previous_style : PGTKStyle;
3665  {%H-}Data: Pointer); cdecl;
3666begin
3667  EventTrace('style-set', nil);
3668
3669  { Note:
3670    This event is called for many widgets but not for all.
3671    It is called on creation and called when the theme changes.
3672    The resizing should occur when all styles were updated by the gtk.
3673    The gtk itself uses size messages via queue.
3674    Maybe the solution is to use g_idle_add for the top level form and resize.
3675  }
3676  //debugln('style-set after ',DbgSName(TWinControl(Data)));
3677  //LCLObject.InvalidateClientRectCache(False);
3678end;
3679{$ENDIF}
3680
3681
3682function gtkListBoxSelectionChangedAfter(widget: PGtkWidget; data: gPointer
3683  ): GBoolean; cdecl;
3684var
3685  Mess: TLMessage;
3686  GtkList: PGtkList;
3687begin
3688  Result := CallBackDefaultReturn;
3689  {$IFDEF EventTrace}
3690  EventTrace('gtkListSelectionChangedAfter', data);
3691  {$ENDIF}
3692  GtkList:=PGtkList(widget);
3693  if (GtkList^.selection = nil) or (LockOnChange(PGtkObject(widget),0) > 0) then
3694    Exit;
3695  FillChar(Mess{%H-},SizeOf(Mess),0);
3696  Mess.msg := LM_SelChange;
3697  if gtkListGetSelectionMode(GtkList)=GTK_SELECTION_SINGLE then
3698    gtk_list_set_selection_mode(GtkList,GTK_SELECTION_BROWSE);
3699  DeliverMessage(Data, Mess);
3700end;
3701
3702//DRAG CALLBACK FUNCTIONS
3703
3704function edit_drag_data_received({%H-}widget : pgtkWidget;
3705  Context : pGdkDragContext;
3706  {%H-}X, {%H-}Y : Integer;
3707  SelData : pGtkSelectionData;
3708  {%H-}info : Integer;
3709  time : Integer;
3710  data : pointer) : GBoolean; cdecl;
3711Var
3712  Texts : String;
3713Begin
3714  Result:=false;
3715  //DebugLn('Trace:***********Drag Data Received*******************');
3716  if Seldata^.Length > 0 then
3717  Begin
3718    Texts := StrPas(PChar(SelData^.data));
3719    //DebugLn('Trace:' + Texts);
3720    //DebugLn('Trace:0');
3721    TCustomEdit(Data).Caption := Texts;
3722    //DebugLn('Trace:1');
3723  end;
3724  gtk_drag_finish(Context,false,false,time);
3725end;
3726
3727function edit_source_drag_data_get({%H-}widget : pgtkWidget;
3728  {%H-}Context : pGdkDragContext;
3729  Selection_data : pGtkSelectionData;
3730  info : Integer;
3731  {%H-}time : Integer;
3732  data : pointer) : GBoolean; cdecl;
3733var
3734  strTemp : PChar;
3735  Texts : String;
3736Begin
3737  Result:=false;
3738  if (info = TARGET_ROOTWIN) then begin
3739    //DebugLn('Trace:I WAS DROPPED ON THE ROOTWIN')
3740  end
3741  else Begin
3742    //DebugLn('Trace:*********Setting Data************');
3743    Texts := TCustomEdit(data).Text;
3744    //DebugLn('Trace:0');
3745    strTemp := StrAlloc(length(Texts) + 1);
3746    try
3747      StrPCopy(strTemp, Texts);
3748      //DebugLn('Trace:1');
3749      gtk_selection_data_set(selection_data,selection_data^.target,
3750                    8,
3751                    PGUChar(StrTemp),
3752                    length(Texts)+1);
3753      //DebugLn('Trace:2');
3754    finally
3755      strDispose(strTemp);
3756    end;
3757    //DebugLn('Trace:3');
3758  end;
3759end;
3760
3761
3762function Edit_source_drag_data_delete ({%H-}Widget: pGtkWidget;
3763  {%H-}Context: pGdkDragContext; {%H-}Data: gpointer): gBoolean ; cdecl;
3764begin
3765  //DebugLn('Trace:***************');
3766  //DebugLn('Trace:DELETE THE DATA');
3767  Result:=false;
3768end;
3769
3770// combobox callbacks
3771function gtkComboBoxShowAfter({%H-}widget: PGtkWidget; data: gPointer): GBoolean; cdecl;
3772var
3773  Mess : TLMCommand;
3774  AComboBox: TCustomComboBox absolute data;
3775begin
3776  Result := True;
3777  EventTrace('ComboBoxShowAfter', data);
3778
3779  AComboBox.IntfGetItems;
3780
3781  FillChar(Mess{%H-},SizeOf(Mess),0);
3782  Mess.Msg := CN_Command;
3783  Mess.NotifyCode := CBN_DROPDOWN;
3784
3785  Result := DeliverMessage(Data, Mess) = 0;
3786end;
3787
3788function gtkComboBoxHideAfter({%H-}widget: PGtkWidget; data: gPointer): GBoolean; cdecl;
3789var
3790  Mess : TLMCommand;
3791begin
3792  Result := True;
3793  EventTrace('ComboBoxHideAfter', data);
3794  FillChar(Mess{%H-},SizeOf(Mess),0);
3795  Mess.Msg := CN_Command;
3796  Mess.NotifyCode := CBN_CLOSEUP;
3797
3798  Result := DeliverMessage(Data, Mess) = 0;
3799end;
3800
3801// notebook callbacks
3802procedure DrawNotebookPageIcon(Page: TCustomPage; Widget: PGtkWidget);
3803var
3804  NoteBook: TCustomTabControl;
3805  NoteBookWidget: PGtkWidget;
3806  PageWidget: PGtkWidget;
3807  TabWidget: PGtkWidget;
3808  ImageIndex: Integer;
3809begin
3810  NoteBook := Page.Parent as TCustomTabControl;
3811  ImageIndex := NoteBook.GetImageIndex(Page.PageIndex);
3812  if (NoteBook.Images = nil) or (ImageIndex < 0)
3813  or (Page.ImageIndex >= NoteBook.Images.Count)
3814  or (not NoteBook.HandleAllocated)
3815  or (not Page.HandleAllocated)
3816  then exit;
3817  NoteBookWidget := {%H-}PGtkWidget(NoteBook.Handle);
3818  PageWidget := {%H-}PGtkWidget(Page.Handle);
3819
3820  // get the tab container and the tab icon widget
3821  TabWidget := gtk_notebook_get_tab_label(PGtkNoteBook(NotebookWidget),
3822                                        PageWidget);
3823  if TabWidget = nil then exit;
3824  {$IFDEF VerboseGtkToDos}{$note reimplement}{$ENDIF}
3825  DrawImageListIconOnWidget(NoteBook.Images.ResolutionForPPI[NoteBook.ImagesWidth, NoteBook.Font.PixelsPerInch, NoteBook.GetCanvasScaleFactor],
3826    ImageIndex, Widget);
3827end;
3828
3829function PageIconWidgetExposeAfter(Widget: PGtkWidget; Event: PGDKEventExpose;
3830  Data: gPointer): GBoolean; cdecl;
3831var
3832  ThePage: TCustomPage absolute Data;
3833begin
3834  Result := false;
3835  //DebugLn('PageIconWidgetExposeAfter ',DbgS(Widget));
3836  EventTrace('PageIconWidgetExposeAfter', Data);
3837  if (Event^.Count > 0) then exit;
3838  DrawNotebookPageIcon(ThePage, Widget);
3839end;
3840
3841
3842