1 {
2  *****************************************************************************
3  *                               gtk3WSTrayIcon.pas                          *
4  *                               ------------------                          *
5  *                                                                           *
6  *                                                                           *
7  *****************************************************************************
8 
9  *****************************************************************************
10   This file is part of the Lazarus Component Library (LCL)
11 
12   See the file COPYING.modifiedLGPL.txt, included in this distribution,
13   for details about the license.
14  *****************************************************************************
15 
16 A unit that uses LibAppIndicator3-1 or libAyatana-AppIndicator3-1 to display a
17 TrayIcon in GTK3.   Based on a GTK2 version by Anthony Walter, now works with
18 many common Linux systems "out of the box" or with the addition of one of the
19 above mentioned libraries and possibly gnome-shell-extension-appindicator.
20 
21 See Wiki for details and Limitations (Menu only, one Icon only....)
22 Also refer to discussion in ../gtk2/UnityWSCtrls.pas
23 }
24 
25 
26 unit gtk3wstrayicon;
27 
28 interface
29 
30 {$mode delphi}
31 uses
32   GLib2, LazGtk3, LazGdkPixbuf2, gtk3widgets,
33   Classes, SysUtils, dynlibs,
34   Graphics, Controls, Forms, ExtCtrls, WSExtCtrls, LCLType, LazUTF8,
35   FileUtil;
36 
37 type
38   TGtk3WSTrayIcon = class(TWSCustomTrayIcon)
39   published
Hidenull40     class function Hide(const ATrayIcon: TCustomTrayIcon): Boolean; override;
Shownull41     class function Show(const ATrayIcon: TCustomTrayIcon): Boolean; override;
42     class procedure InternalUpdate(const ATrayIcon: TCustomTrayIcon); override;
GetPositionnull43     class function GetPosition(const {%H-}ATrayIcon: TCustomTrayIcon): TPoint; override;
44   end;
45 
46 { Gtk3AppIndicatorInit returns true if a LibAppIndicator3 library has been loaded }
Gtk3AppIndicatorInitnull47 function Gtk3AppIndicatorInit: Boolean;
48 
49 implementation
50 
51 {X$define DEBUGAPPIND}
52 
53 uses gtk3objects;     // TGtk3Image
54 
55 const
56   libappindicator_3 = 'libappindicator3.so.1';              // Unity or Canonical libappindicator3-1
57   LibAyatanaAppIndicator = 'libayatana-appindicator3.so.1'; // Ayatana - typically called libayatana-appindicator3-1
58   IconThemePath = '/tmp/appindicators/';                    // We must write our icon to a file.
59   IconType = 'png';
60 
61 type
62   TAppIndicatorCategory = (
63     APP_INDICATOR_CATEGORY_APPLICATION_STATUS,
64     APP_INDICATOR_CATEGORY_COMMUNICATIONS,
65     APP_INDICATOR_CATEGORY_SYSTEM_SERVICES,
66     APP_INDICATOR_CATEGORY_HARDWARE,
67     APP_INDICATOR_CATEGORY_OTHER
68   );
69 
70   TAppIndicatorStatus = (
71     APP_INDICATOR_STATUS_PASSIVE,
72     APP_INDICATOR_STATUS_ACTIVE,
73     APP_INDICATOR_STATUS_ATTENTION
74   );
75 
76   PAppIndicator = Pointer;
77 
78 var
79   { GlobalAppIndicator creation routines }
GTypenull80   app_indicator_get_type: function: GType; cdecl;
dnull81   app_indicator_new: function(id, icon_name: PGChar; category: TAppIndicatorCategory): PAppIndicator; cdecl;
dnull82   app_indicator_new_with_path: function(id, icon_name: PGChar; category: TAppIndicatorCategory; icon_theme_path: PGChar): PAppIndicator; cdecl;
83   { Set properties }
84   app_indicator_set_status: procedure(self: PAppIndicator; status: TAppIndicatorStatus); cdecl;
85   app_indicator_set_attention_icon: procedure(self: PAppIndicator; icon_name: PGChar); cdecl;
86   app_indicator_set_menu: procedure(self: PAppIndicator; menu: PGtkMenu); cdecl;
87   app_indicator_set_icon: procedure(self: PAppIndicator; icon_name: PGChar); cdecl;
88   app_indicator_set_label: procedure(self: PAppIndicator; _label, guide: PGChar); cdecl;
89   app_indicator_set_icon_theme_path: procedure(self: PAppIndicator; icon_theme_path: PGChar); cdecl;
90   app_indicator_set_ordering_index: procedure(self: PAppIndicator; ordering_index: guint32); cdecl;
91   { Get properties }
elfnull92   app_indicator_get_id: function(self: PAppIndicator): PGChar; cdecl;
elfnull93   app_indicator_get_category: function(self: PAppIndicator): TAppIndicatorCategory; cdecl;
elfnull94   app_indicator_get_status: function(self: PAppIndicator): TAppIndicatorStatus; cdecl;
elfnull95   app_indicator_get_icon: function(self: PAppIndicator): PGChar; cdecl;
elfnull96   app_indicator_get_icon_theme_path: function(self: PAppIndicator): PGChar; cdecl;
elfnull97   app_indicator_get_attention_icon: function(self: PAppIndicator): PGChar; cdecl;
elfnull98   app_indicator_get_menu: function(self: PAppIndicator): PGtkMenu; cdecl;
elfnull99   app_indicator_get_label: function(self: PAppIndicator): PGChar; cdecl;
elfnull100   app_indicator_get_label_guide: function(self: PAppIndicator): PGChar; cdecl;
elfnull101   app_indicator_get_ordering_index: function(self: PAppIndicator): guint32; cdecl;
102 
103 { TAppIndTrayIconHandle }
104 
105 type
106   TAppIndTrayIconHandle = class
107   private
108     FTrayIcon: TCustomTrayIcon;
109     FName: string;
110     FIconName: string;
111   public
112     constructor Create(TrayIcon: TCustomTrayIcon);
113     destructor Destroy; override;
114     procedure Update;
115   end;
116 
117 
118 var
119   GlobalAppIndicator: PAppIndicator;
120   GlobalIcon: Pointer;
121   GlobalIconPath: string;
122 
123 constructor TAppIndTrayIconHandle.Create(TrayIcon: TCustomTrayIcon);
124 var
125   NewIcon: Pointer;
126 begin
127   inherited Create;
128   FTrayIcon := TrayIcon;
129   FName := 'app-' + IntToHex(IntPtr(Application), SizeOf(IntPtr) * 2);
130   NewIcon := {%H-}Pointer(TGtk3Image(FTrayIcon.Icon.Handle).handle);
131   if NewIcon = nil then
132     NewIcon := {%H-}Pointer(Application.Icon.Handle);
133   if NewIcon <> GlobalIcon then
134   begin
135     GlobalIcon := NewIcon;
136     ForceDirectories(IconThemePath);
137     FIconName := FName + '-' + IntToHex({%H-}IntPtr(GlobalIcon), SizeOf(GlobalIcon) * 2);
138     if FileExists(GlobalIconPath) then
139       DeleteFile(GlobalIconPath);
140     GlobalIconPath := IconThemePath + FIconName + '.' + IconType;
141     gdk_pixbuf_save(GlobalIcon, PChar(GlobalIconPath), IconType, nil, [nil]);
142     if GlobalAppIndicator <> nil then
143         app_indicator_set_icon(GlobalAppIndicator, PChar(FIconName));
144   end
145   else
146     FIconName := FName + '-' + IntToHex({%H-}IntPtr(GlobalIcon), SizeOf(GlobalIcon) * 2);
147   { Only the first created AppIndicator is functional }
148   if GlobalAppIndicator = nil then
149     { It seems that icons can only come from files :( }
150     GlobalAppIndicator := app_indicator_new_with_path(PChar(FName), PChar(FIconName),
151       APP_INDICATOR_CATEGORY_APPLICATION_STATUS, IconThemePath);
152   Update;
153   {$ifdef DEBUGAPPIND}
154   case app_indicator_get_status(GlobalAppIndicator) of
155 	      APP_INDICATOR_STATUS_PASSIVE : writeln('AppInd statis is Passive');
156 	      APP_INDICATOR_STATUS_ACTIVE : writeln('AppInd status is Active');
157 	      APP_INDICATOR_STATUS_ATTENTION  : writeln('AppInd is Attention');
158   else writeln('AppInd status is unknown');
159   end;
160   {$endif}
161 end;
162 
163 destructor TAppIndTrayIconHandle.Destroy;
164 begin
165   { Hide the global AppIndicator }
166   app_indicator_set_status(GlobalAppIndicator, APP_INDICATOR_STATUS_PASSIVE);
167   inherited Destroy;
168 end;
169 
170 procedure TAppIndTrayIconHandle.Update;
171 var
172   NewIcon: Pointer;
173 begin
174   NewIcon := {%H-}Pointer(TGTK3Image(FTrayIcon.Icon.Handle).Handle);
175   if NewIcon = nil then
176     NewIcon := {%H-}Pointer(Application.Icon.Handle);
177   if NewIcon <> GlobalIcon then
178   begin
179     GlobalIcon := NewIcon;
180     FIconName := FName + '-' + IntToHex({%H-}IntPtr(GlobalIcon), SizeOf(GlobalIcon) * 2);
181     ForceDirectories(IconThemePath);
182     if FileExists(GlobalIconPath) then
183       DeleteFile(GlobalIconPath);
184     GlobalIconPath := IconThemePath + FIconName + '.' + IconType;
185     gdk_pixbuf_save(GlobalIcon, PChar(GlobalIconPath), IconType, nil, [nil]);
186     { Again it seems that icons can only come from files }
187     app_indicator_set_icon(GlobalAppIndicator, PChar(FIconName));
188   end;
189   { It seems to me you can only set the menu once for an AppIndicator }
190   if (app_indicator_get_menu(GlobalAppIndicator) = nil) and (FTrayIcon.PopUpMenu <> nil) then
191     //app_indicator_set_menu(GlobalAppIndicator, {%H-}PGtkMenu(FTrayIcon.PopUpMenu.Handle));
192     app_indicator_set_menu(GlobalAppIndicator, {%H-}PGtkMenu(TGTK3Menu(FTrayIcon.PopUpMenu.Handle).Widget));
193   app_indicator_set_status(GlobalAppIndicator, APP_INDICATOR_STATUS_ACTIVE);
194 end;
195 
196 { TAppIndWSCustomTrayIcon }
197 
TGtk3WSTrayIcon.Hidenull198 class function TGtk3WSTrayIcon.Hide(const ATrayIcon: TCustomTrayIcon): Boolean;
199 var
200   T: TAppIndTrayIconHandle;
201 begin
202   if ATrayIcon.Handle <> 0 then
203   begin
204     T := TAppIndTrayIconHandle(ATrayIcon.Handle);
205     ATrayIcon.Handle := 0;
206     T.Free;
207   end;
208   Result := True;
209 end;
210 
TGtk3WSTrayIcon.Shownull211 class function TGtk3WSTrayIcon.Show(const ATrayIcon: TCustomTrayIcon): Boolean;
212 var
213   T: TAppIndTrayIconHandle;
214 begin
215   if ATrayIcon.Handle = 0 then
216   begin
217     T := TAppIndTrayIconHandle.Create(ATrayIcon);
218     ATrayIcon.Handle := HWND(T);
219   end;
220   Result := True;
221 end;
222 
223 class procedure TGtk3WSTrayIcon.InternalUpdate(const ATrayIcon: TCustomTrayIcon);
224 var
225   T: TAppIndTrayIconHandle;
226 begin
227   if ATrayIcon.Handle <> 0 then
228   begin
229     T := TAppIndTrayIconHandle(ATrayIcon.Handle);
230     T.Update;
231   end;
232 end;
233 
TGtk3WSTrayIcon.GetPositionnull234 class function TGtk3WSTrayIcon.GetPosition(const ATrayIcon: TCustomTrayIcon): TPoint;
235 begin
236   Result := Point(0, 0);
237 end;
238 
239 { AppIndicatorInit }
240 
241 var
242   Loaded: Boolean;
243   Initialized: Boolean;
244 
Gtk3AppIndicatorInitnull245 function Gtk3AppIndicatorInit: Boolean;
246 var
247   Module: HModule;
248 
TryLoadnull249   function TryLoad(const ProcName: string; var Proc: Pointer): Boolean;
250   begin
251     Proc := GetProcAddress(Module, ProcName);
252     Result := Proc <> nil;
253   end;
254 
255 begin
256   Result := False;
257   if Loaded then
258     Exit(Initialized);
259   Loaded := True;
260   if Initialized then
261     Exit(True);
262   Module := LoadLibrary(libappindicator_3);
263   if Module = 0 then begin
264     Module := LoadLibrary(LibAyatanaAppIndicator);
265     if Module = 0 then begin                    // Sorry, no TrayIcon !
266       {$ifdef DEBUGAPPIND}
267       writeln('Failed to load an appindicator library');{$endif}
268       Exit;
269     end
270     {$ifdef DEBUGAPPIND} else writeln('Loaded ' + LibAyatanaAppIndicator){$endif};
271   end {$ifdef DEBUGAPPIND} else writeln('Loaded ' + libappindicator_3){$endif};
272   Result :=
273     TryLoad('app_indicator_get_type', @app_indicator_get_type) and
274     TryLoad('app_indicator_new', @app_indicator_new) and
275     TryLoad('app_indicator_new_with_path', @app_indicator_new_with_path) and
276     TryLoad('app_indicator_set_status', @app_indicator_set_status) and
277     TryLoad('app_indicator_set_attention_icon', @app_indicator_set_attention_icon) and
278     TryLoad('app_indicator_set_menu', @app_indicator_set_menu) and
279     TryLoad('app_indicator_set_icon', @app_indicator_set_icon) and
280     TryLoad('app_indicator_set_label', @app_indicator_set_label) and
281     TryLoad('app_indicator_set_icon_theme_path', @app_indicator_set_icon_theme_path) and
282     TryLoad('app_indicator_set_ordering_index', @app_indicator_set_ordering_index) and
283     TryLoad('app_indicator_get_id', @app_indicator_get_id) and
284     TryLoad('app_indicator_get_category', @app_indicator_get_category) and
285     TryLoad('app_indicator_get_status', @app_indicator_get_status) and
286     TryLoad('app_indicator_get_icon', @app_indicator_get_icon) and
287     TryLoad('app_indicator_get_icon_theme_path', @app_indicator_get_icon_theme_path) and
288     TryLoad('app_indicator_get_attention_icon', @app_indicator_get_attention_icon) and
289     TryLoad('app_indicator_get_menu', @app_indicator_get_menu) and
290     TryLoad('app_indicator_get_label', @app_indicator_get_label) and
291     TryLoad('app_indicator_get_label_guide', @app_indicator_get_label_guide) and
292     TryLoad('app_indicator_get_ordering_index', @app_indicator_get_ordering_index);
293   Initialized := Result;
294 end;
295 
296 initialization
297   GlobalAppIndicator := nil;
298   GlobalIconPath := '';
299 finalization
300   if FileExists(GlobalIconPath) then
301     DeleteFile(GlobalIconPath);
302   if GlobalAppIndicator <> nil then
303     g_object_unref(GlobalAppIndicator);
304 end.
305