1{%MainUnit gtk2wsextctrls.pp}
2{
3 gtk2trayicon.inc
4
5 *****************************************************************************
6  This file is part of the Lazarus Component Library (LCL)
7
8  See the file COPYING.modifiedLGPL.txt, included in this distribution,
9  for details about the license.
10 *****************************************************************************
11
12 Authors: Felipe Monteiro de Carvalho and Andrew Haines
13
14 Special thanks for: Danny Milosavljevic and the Lazarus Team
15
16 Gtk2 specific code.
17}
18
19{ TGtk2WSCustomTrayIcon }
20
21type
22  { TGtk2TrayIconHandle }
23
24  TGtk2TrayIconHandle = class
25  private
26    plug: PGtkWidget;
27    DrawingArea: PGtkWidget;
28    Tips: PGtkTooltips;
29    fEmbedded: Boolean;
30    fTrayIcon: TCustomTrayIcon;
31{$ifdef UseStatusIcon}
32    FStatusIcon: PGtkStatusIcon;
33{$endif}
34{$ifdef HasGdk2X}
35    fDisplay: PDisplay;
36    fWindow: TWindow;
37    fScreen: PScreen;
38    fScreenID: longint;
39    fTrayParent: TWindow;
40    function SendMessage(window: TWindow; msg: Integer; data1, data2, data3: Integer): Boolean;
41    procedure SetEmbedded;
42{$endif HasGdk2X}
43  public
44    constructor Create(const wsTrayIcon: TCustomTrayIcon);
45    destructor Destroy; override;
46    procedure Show;
47    function GetPosition: TPoint;
48    procedure Update(NewPixBuf: PGdkPixbuf; const NewHint: String);
49  end;
50
51const
52  SYSTEM_TRAY_REQUEST_DOCK   = 0;
53  //SYSTEM_TRAY_BEGIN_MESSAGE  = 1;
54  //SYSTEM_TRAY_CANCEL_MESSAGE = 2;
55
56{$ifdef HasGdk2X}
57var
58  XError: Integer;
59{*******************************************************************
60*  TempX11ErrorHandler ()
61*
62*  DESCRIPTION:    Temp ErrorHandler
63*
64*  PARAMETERS:     ?
65*
66*  RETURNS:        ?
67*
68*******************************************************************}
69function TempX11ErrorHandler({%H-}Display:PDisplay; ErrorEv:PXErrorEvent):longint;cdecl;
70begin
71  XError := ErrorEv^.error_code;
72  WriteLn('Error: ' + IntToStr(XError));
73  Result:=0;
74end;
75
76{*******************************************************************
77*  TGtk2TrayIconHandle.Send_Message ()
78*
79*  DESCRIPTION:    Sends a message to the X client
80*
81*  PARAMETERS:     None
82*
83*  RETURNS:        Nothing
84*
85*******************************************************************}
86function TGtk2TrayIconHandle.SendMessage(window: TWindow; msg: Integer; data1, data2, data3: Integer): Boolean;
87var
88  Ev: TXEvent;
89begin
90  FillChar(Ev{%H-}, SizeOf(TXEvent), 0);
91
92  ev.xclient._type := ClientMessage;
93  ev.xclient.window := window;
94  ev.xclient.message_type := XInternAtom (fDisplay, '_NET_SYSTEM_TRAY_OPCODE', False);
95  ev.xclient.format := 32;
96  ev.xclient.data.l[0] := CurrentTime;
97  ev.xclient.data.l[1] := msg;
98  ev.xclient.data.l[2] := data1;
99  ev.xclient.data.l[3] := data2;
100  ev.xclient.data.l[4] := data3;
101
102  XError := 0;
103  XSendEvent(fDisplay, fTrayParent, False, NoEventMask, @ev);
104  XSync(fDisplay, False);
105  Result := XError = 0;
106  XError := 0;
107end;
108
109{*******************************************************************
110*  TGtk2TrayIconHandle.SetEmbedded ()
111*
112*  DESCRIPTION:    Docks the GtkPlug into the system tray
113*
114*  PARAMETERS:     None
115*
116*  RETURNS:        Nothing
117*
118*******************************************************************}
119procedure TGtk2TrayIconHandle.SetEmbedded;
120var
121  old_error: TXErrorHandler;
122  buf: array [0..32] of char;
123  selection_atom : TAtom;
124begin
125  if fEmbedded then
126    Exit;
127  old_error := XSetErrorHandler(@TempX11ErrorHandler);
128
129  xsync(fdisplay,true);
130  buf :=  PChar('_NET_SYSTEM_TRAY_S' + IntToStr(fScreenID));
131  selection_atom := XInternAtom(fDisplay, buf, false);
132  XGrabServer(fDisplay);
133
134  fTrayParent := XGetSelectionOwner(fDisplay, selection_atom);
135  if fTrayParent <> None then
136  begin
137    XSelectInput(fDisplay, fTrayParent, StructureNotifyMask);
138  end;
139
140  XUngrabServer(fDisplay);
141  XFlush(fDisplay);
142  if fTrayParent <> None then
143    fEmbedded := SendMessage(fTrayParent, SYSTEM_TRAY_REQUEST_DOCK, fWindow, 0, 0);
144
145  XSetErrorHandler(old_error);
146end;
147{$endif HasGdk2X}
148
149{*******************************************************************
150*  realize_cb ()
151*
152*  DESCRIPTION:    Callback function for the realize signal
153*                  Sets the systray icon after the widget is realized
154*
155*  PARAMETERS:     None
156*
157*  RETURNS:        Nothing
158*
159*******************************************************************}
160procedure realize_cb({%H-}widget: PGtkWidget; user_data: gpointer); cdecl;
161var
162  wsTrayIcon: TCustomTrayIcon absolute user_data;
163begin
164  with TGtk2TrayIconHandle(wsTrayIcon.Handle) do
165  begin
166    {$ifdef HasGdk2X}
167    fDisplay := GDK_WINDOW_XDISPLAY(plug^.window);
168    fWindow := GDK_WINDOW_XWINDOW(plug^.window);
169
170{  Does not work
171
172    gdk_screen := gtk_widget_get_screen(plug);
173    fScreen := GDK_SCREEN_XSCREEN(gdk_screen); // get the real screen}
174
175    fScreen := XDefaultScreenOfDisplay(fDisplay);
176    fScreenID := XScreenNumberOfScreen(fScreen); // and it's number
177    SetEmbedded;
178    {$endif}
179  end;
180end;
181
182{*******************************************************************
183*  button_release_cb ()
184*
185*  DESCRIPTION:    Callback function for Mouse Click
186*
187*  PARAMETERS:     None
188*
189*  RETURNS:        Nothing
190*
191*******************************************************************}
192function button_release_cb({%H-}widget: PGtkWidget; event: PGdkEventButton;
193 user_data: gpointer): gboolean; cdecl;
194var
195  vwsTrayIcon: TCustomTrayIcon absolute user_data;
196begin
197  Result := False;
198
199  case event^.button of
200    1:
201    begin
202      if Assigned(vwsTrayIcon.OnClick) then vwsTrayIcon.OnClick(vwsTrayIcon);
203      if Assigned(vwsTrayIcon.OnMouseUp) then
204       vwsTrayIcon.OnMouseUp(vwsTrayIcon, mbLeft, [], Round(event^.X), Round(event^.Y));
205    end;
206
207    2: if Assigned(vwsTrayIcon.OnMouseUp) then
208        vwsTrayIcon.OnMouseUp(vwsTrayIcon, mbMiddle, [], Round(event^.X), Round(event^.Y));
209
210    3:
211    begin
212      if Assigned(vwsTrayIcon.OnMouseUp) then
213       vwsTrayIcon.OnMouseUp(vwsTrayIcon, mbRight, [], Round(event^.X), Round(event^.Y));
214      if Assigned(vwsTrayIcon.PopUpMenu) then
215       vwsTrayIcon.PopUpMenu.PopUp(Mouse.CursorPos.X, Mouse.CursorPos.Y);
216     end;
217  end;
218end;
219
220{*******************************************************************
221*  button_press_cb ()
222*
223*  DESCRIPTION:    Callback function for Mouse Click
224*
225*  PARAMETERS:     None
226*
227*  RETURNS:        Nothing
228*
229*******************************************************************}
230function button_press_cb({%H-}widget: PGtkWidget; event: PGdkEventButton;
231 user_data: gpointer): gboolean; cdecl;
232var
233  vwsTrayIcon: TCustomTrayIcon absolute user_data;
234begin
235  Result := False;
236
237  if (event^._type = GDK_2BUTTON_PRESS) and Assigned(vwsTrayIcon.OnDblClick) then
238   vwsTrayIcon.OnDblClick(vwsTrayIcon)
239  else
240  begin
241    case event^.button of
242      1: if Assigned(vwsTrayIcon.OnMouseDown) then
243          vwsTrayIcon.OnMouseDown(vwsTrayIcon, mbLeft, [], Round(event^.X), Round(event^.Y));
244
245      2: if Assigned(vwsTrayIcon.OnMouseDown) then
246          vwsTrayIcon.OnMouseDown(vwsTrayIcon, mbMiddle, [], Round(event^.X), Round(event^.Y));
247
248      3: if Assigned(vwsTrayIcon.OnMouseDown) then
249          vwsTrayIcon.OnMouseDown(vwsTrayIcon, mbRight, [], Round(event^.X), Round(event^.Y));
250    end;
251  end;
252end;
253
254{*******************************************************************
255*  popup_cb ()
256*
257*  DESCRIPTION:    Callback function for the popup menu
258*
259*  PARAMETERS:     None
260*
261*  RETURNS:        Nothing
262*
263*******************************************************************}
264function popup_cb({%H-}widget: PGtkWidget; user_data: gpointer): Boolean; cdecl;
265var
266  vwsTrayIcon: TCustomTrayIcon absolute user_data;
267begin
268  Result := True;
269
270  if Assigned(vwsTrayIcon.PopUpMenu) then
271    vwsTrayIcon.PopUpMenu.PopUp(Mouse.CursorPos.X, Mouse.CursorPos.Y);
272end;
273
274{*******************************************************************
275*  motion_cb ()
276*
277*  DESCRIPTION:    Callback function for the OnMouseMove event
278*
279*  PARAMETERS:     None
280*
281*  RETURNS:        Nothing
282*
283*******************************************************************}
284function motion_cb({%H-}widget: PGtkWidget; event: PGdkEventMotion; user_data: gpointer): Boolean; cdecl;
285var
286  vwsTrayIcon: TCustomTrayIcon absolute user_data;
287begin
288  Result := False;
289
290  if Assigned(vwsTrayIcon.OnMouseMove) then
291   vwsTrayIcon.OnMouseMove(vwsTrayIcon, [], Round(event^.X), Round(event^.Y));
292end;
293
294{$ifdef UseStatusIcon}
295procedure activate_cb_statusicon({%H-}status_icon: PGtkStatusIcon; user_data: gpointer); cdecl;
296var
297  vwsTrayIcon: TCustomTrayIcon absolute user_data;
298begin
299  if Assigned(vwsTrayIcon.OnMouseDown) then
300    with Mouse.CursorPos do
301      vwsTrayIcon.OnMouseDown(vwsTrayIcon, mbLeft, [], X, Y);
302end;
303
304procedure popup_cb_statusicon({%H-}status_icon: PGtkStatusIcon; {%H-}button: guint;
305                {%H-}activate_time: guint; user_data: gpointer); cdecl;
306var
307  vwsTrayIcon: TCustomTrayIcon absolute user_data;
308begin
309  if Assigned(vwsTrayIcon.PopUpMenu) then
310    vwsTrayIcon.PopUpMenu.PopUp(Mouse.CursorPos.X, Mouse.CursorPos.Y);
311end;
312
313function button_press_cb_statusicon({%H-}status_icon: PGtkStatusIcon;
314  event: PGdkEvent; user_data: gpointer): gboolean; cdecl;
315var
316  vwsTrayIcon: TCustomTrayIcon absolute user_data;
317begin
318  Result := False;
319
320  if (PGdkEventButton(event)^._type = GDK_2BUTTON_PRESS) and Assigned(vwsTrayIcon.OnDblClick) then
321   vwsTrayIcon.OnDblClick(vwsTrayIcon)
322  else
323  begin
324    case PGdkEventButton(event)^.button of
325      1: if Assigned(vwsTrayIcon.OnMouseDown) then
326          vwsTrayIcon.OnMouseDown(vwsTrayIcon, mbLeft, [], Round(PGdkEventButton(event)^.X), Round(PGdkEventButton(event)^.Y));
327
328      2: if Assigned(vwsTrayIcon.OnMouseDown) then
329          vwsTrayIcon.OnMouseDown(vwsTrayIcon, mbMiddle, [], Round(PGdkEventButton(event)^.X), Round(PGdkEventButton(event)^.Y));
330
331      3: if Assigned(vwsTrayIcon.OnMouseDown) then
332          vwsTrayIcon.OnMouseDown(vwsTrayIcon, mbRight, [], Round(PGdkEventButton(event)^.X), Round(PGdkEventButton(event)^.Y));
333    end;
334  end;
335end;
336
337function button_release_cb_statusicon({%H-}status_icon: PGtkStatusIcon;
338  event: PGdkEvent; user_data: gpointer): gboolean; cdecl;
339var
340  vwsTrayIcon: TCustomTrayIcon absolute user_data;
341begin
342  Result := False;
343  case PGdkEventButton(event)^.button of
344    1:
345    begin
346      if Assigned(vwsTrayIcon.OnClick) then vwsTrayIcon.OnClick(vwsTrayIcon);
347      if Assigned(vwsTrayIcon.OnMouseUp) then
348       vwsTrayIcon.OnMouseUp(vwsTrayIcon, mbLeft, [], Round(PGdkEventButton(event)^.X), Round(PGdkEventButton(event)^.Y));
349    end;
350
351    2: if Assigned(vwsTrayIcon.OnMouseUp) then
352        vwsTrayIcon.OnMouseUp(vwsTrayIcon, mbMiddle, [], Round(PGdkEventButton(event)^.X), Round(PGdkEventButton(event)^.Y));
353
354    3:
355    begin
356      if Assigned(vwsTrayIcon.OnMouseUp) then
357       vwsTrayIcon.OnMouseUp(vwsTrayIcon, mbRight, [], Round(PGdkEventButton(event)^.X), Round(PGdkEventButton(event)^.Y));
358      if Assigned(vwsTrayIcon.PopUpMenu) then
359       vwsTrayIcon.PopUpMenu.PopUp(Mouse.CursorPos.X, Mouse.CursorPos.Y);
360     end;
361  end;
362end;
363
364function query_tooltip_cb_statusicon({%H-}status_icon: PGtkStatusIcon;
365  x: guint; y: guint; {%H-}keyboard_mode: gboolean; {%H-}tooltip: gpointer{PGtkTooltip}; user_data: gpointer): gboolean; cdecl;
366var
367  vwsTrayIcon: TCustomTrayIcon absolute user_data;
368begin
369  Result := FALSE;
370
371  if Assigned(vwsTrayIcon.OnMouseMove) then
372   vwsTrayIcon.OnMouseMove(vwsTrayIcon, [], x, y);
373end;
374{$endif}
375
376constructor TGtk2TrayIconHandle.Create(const wsTrayIcon: TCustomTrayIcon);
377begin
378  fTrayIcon := wsTrayIcon;
379
380{$ifdef UseStatusIcon}
381  FStatusIcon := nil;
382  if Available_GtkStatusIcon_2_10 then
383  begin
384    FStatusIcon := gtk_status_icon_new();
385    gtk_status_icon_set_from_pixbuf(FStatusIcon, {%H-}PGdkPixbuf(FTrayIcon.Icon.Handle));
386    {$IF FPC_FULLVERSION>30300}
387    gtk_status_icon_set_tooltip_text(FStatusIcon, PChar(FTrayIcon.Hint));
388    {$ELSE}
389    gtk_status_icon_set_tooltip(FStatusIcon, PChar(FTrayIcon.Hint));
390    {$ENDIF}
391    g_object_set(PGObject(FStatusIcon), 'has-tooltip', gTRUE, nil);
392    fEmbedded := gtk_status_icon_is_embedded(FStatusIcon);
393
394    g_signal_connect(FStatusIcon, 'activate', TGCallback(@activate_cb_statusicon), fTrayIcon);
395    g_signal_connect(FStatusIcon, 'popup-menu', TGCallback(@popup_cb_statusicon), fTrayIcon);
396    g_signal_connect(FStatusIcon, 'button-press-event', TGCallback(@button_press_cb_statusicon), fTrayIcon);
397    g_signal_connect(FStatusIcon, 'button-release-event', TGCallback(@button_release_cb_statusicon), fTrayIcon);
398    g_signal_connect(FStatusIcon, 'query-tooltip', TGCallback(@query_tooltip_cb_statusicon), fTrayIcon);
399  end
400  else
401{$endif}
402  begin
403    //  Creates the GtkPlug
404    plug := gtk_plug_new(0);
405    Tips := gtk_tooltips_new;
406    g_object_ref(Tips);
407    gtk_object_sink(GTK_OBJECT(Tips));
408    gtk_tooltips_set_tip(GTK_TOOLTIPS(Tips), plug, PChar(wsTrayIcon.Hint), '');
409
410    //  Connects the signals
411    gtk_widget_add_events(plug, GDK_ALL_EVENTS_MASK);
412    g_signal_connect(plug, 'realize', TGCallback(@realize_cb), wsTrayIcon);
413    g_signal_connect(plug, 'popup-menu', TGCallback(@popup_cb), wsTrayIcon);
414    g_signal_connect(plug, 'motion-notify-event', TGCallback(@motion_cb), wsTrayIcon);
415    g_signal_connect(plug, 'button-press-event', TGCallback(@button_press_cb), wsTrayIcon);
416    g_signal_connect(plug, 'button-release-event', TGCallback(@button_release_cb), wsTrayIcon);
417
418    //  Draws the icon
419    with wsTrayIcon do
420    begin
421      DrawingArea := gtk_image_new_from_pixbuf({%H-}PGdkPixbuf(Icon.Handle));
422      gtk_container_add(GTK_CONTAINER(plug), DrawingArea);
423      gtk_widget_show(DrawingArea);
424    end;
425  end;
426end;
427
428destructor TGtk2TrayIconHandle.Destroy;
429begin
430{$ifdef UseStatusIcon}
431  if FStatusIcon <> nil then
432  begin
433    gtk_status_icon_set_visible(FStatusIcon, False);
434    g_object_unref(FStatusIcon);
435    FStatusIcon := nil;
436  end
437  else
438{$endif}
439  begin
440    gtk_widget_destroy(plug);
441    plug := nil;
442
443    g_object_unref(Tips);
444    Tips := nil;
445  end;
446end;
447
448procedure TGtk2TrayIconHandle.Show;
449begin
450{$ifdef UseStatusIcon}
451  if FStatusIcon <> nil then
452    gtk_status_icon_set_visible(FStatusIcon, True)
453  else
454{$endif}
455    gtk_widget_show(plug);
456end;
457
458function TGtk2TrayIconHandle.GetPosition: TPoint;
459var
460{$ifdef UseStatusIcon}
461  AScreen: PGdkScreen;
462  AArea: TGdkRectangle;
463  AOrientation: TGtkOrientation;
464{$endif}
465  WindowHandle: PGDKWindow;
466begin
467{$ifdef UseStatusIcon}
468  if FStatusIcon <> nil then
469  begin
470    gtk_status_icon_get_geometry(FStatusIcon, @AScreen, @AArea, @AOrientation);
471    Result.x := AArea.x;
472    Result.y := AArea.y;
473  end
474  else
475{$endif}
476  begin
477    if Assigned(plug) then
478    begin
479      WindowHandle := plug^.window;
480      if Assigned(WindowHandle) then
481        gdk_window_get_origin(WindowHandle, @Result.X, @Result.Y);
482    end;
483  end;
484end;
485
486procedure TGtk2TrayIconHandle.Update(NewPixBuf: PGdkPixbuf; const NewHint: String);
487begin
488{$ifdef UseStatusIcon}
489  if FStatusIcon <> nil then
490  begin
491    gtk_status_icon_set_from_pixbuf(FStatusIcon, NewPixBuf);
492    {$IF FPC_FULLVERSION>30300}
493    gtk_status_icon_set_tooltip_text(FStatusIcon, PChar(NewHint));
494    {$ELSE}
495    gtk_status_icon_set_tooltip(FStatusIcon, PChar(NewHint));
496    {$ENDIF}
497    g_object_set(PGObject(FStatusIcon), 'has-tooltip', gTRUE, nil);
498  end
499  else
500{$endif}
501  begin
502    // Updates the tooltips
503    if Assigned(Tips) then
504      gtk_tooltips_set_tip(GTK_TOOLTIPS(Tips), plug, PChar(NewHint), '');
505    // Updates the icon
506    if Assigned(DrawingArea) then
507      gtk_image_set_from_pixbuf(GTK_IMAGE(DrawingArea), NewPixbuf);
508  end;
509end;
510
511{*******************************************************************
512*  TGtk2WSCustomTrayIcon.Hide ()
513*
514*  DESCRIPTION:    Hides the main tray icon of the program
515*
516*  PARAMETERS:     None
517*
518*  RETURNS:        True if sucessfull, otherwise False
519*
520*******************************************************************}
521class function TGtk2WSCustomTrayIcon.Hide(const ATrayIcon: TCustomTrayIcon): Boolean;
522begin
523  Result := False;
524
525  { Free and nil the handle }
526  TGtk2TrayIconHandle(ATrayIcon.Handle).Free;
527  ATrayIcon.Handle := 0;
528
529  Result := True;
530end;
531
532{*******************************************************************
533*  TGtk2WSCustomTrayIcon.Show ()
534*
535*  DESCRIPTION:    Shows the main tray icon of the program
536*
537*  PARAMETERS:     None
538*
539*  RETURNS:        True if sucessfull, otherwise False
540*
541*******************************************************************}
542class function TGtk2WSCustomTrayIcon.Show(const ATrayIcon: TCustomTrayIcon): Boolean;
543var
544  TrayIconHandle: TGtk2TrayIconHandle;
545begin
546  Result := False;
547
548  TrayIconHandle := TGtk2TrayIconHandle.Create(ATrayIcon);
549  ATrayIcon.Handle := HWND(TrayIconHandle);
550  {*******************************************************************
551  *  Now shows the GtkPlug
552  *******************************************************************}
553  TrayIconHandle.Show;
554  {$ifdef UseStatusIcon}
555  Result := True;
556  {$else}
557  if TrayIconHandle.fEmbedded then
558    Result := True
559  else
560    Hide(ATrayIcon);
561  {$endif}
562end;
563
564{*******************************************************************
565*  TGtk2WSCustomTrayIcon.InternalUpdate ()
566*
567*  DESCRIPTION:    Makes modifications to the Icon while running
568*                  i.e. without hiding it and showing again
569*
570*  PARAMETERS:     None
571*
572*  RETURNS:        Nothing
573*
574*******************************************************************}
575class procedure TGtk2WSCustomTrayIcon.InternalUpdate(const ATrayIcon: TCustomTrayIcon);
576begin
577  if ATrayIcon.Handle <> 0 then
578    TGtk2TrayIconHandle(ATrayIcon.Handle).Update({%H-}PGdkPixbuf(ATrayIcon.Icon.Handle), ATrayIcon.Hint);
579end;
580
581{*******************************************************************
582*  TGtk2WSCustomTrayIcon.GetPosition ()
583*
584*  DESCRIPTION:    Returns the position of the tray icon on the display.
585*                  This function is utilized to show message boxes near
586*                  the icon
587*
588*  PARAMETERS:     None
589*
590*  RETURNS:        Nothing
591*
592*******************************************************************}
593class function TGtk2WSCustomTrayIcon.GetPosition(const ATrayIcon: TCustomTrayIcon): TPoint;
594begin
595  Result := Point(0, 0);
596  if ATrayIcon.Handle <> 0 then
597    Result := TGtk2TrayIconHandle(ATrayIcon.Handle).GetPosition;
598end;
599
600