1 {
2 ***************************************************************************
3 * *
4 * This source is free software; you can redistribute it and/or modify *
5 * it under the terms of the GNU General Public License as published by *
6 * the Free Software Foundation; either version 2 of the License, or *
7 * (at your option) any later version. *
8 * *
9 * This code is distributed in the hope that it will be useful, but *
10 * WITHOUT ANY WARRANTY; without even the implied warranty of *
11 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
12 * General Public License for more details. *
13 * *
14 * A copy of the GNU General Public License is available on the World *
15 * Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
16 * obtain it by writing to the Free Software Foundation, *
17 * Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA. *
18 * *
19 ***************************************************************************
20
21 Author: Ondrej Pokorny
22
23 Abstract:
24 Adds favorite projects list into the drop-down menu of "Open" toolbar button.
25 }
26 unit favorites_impl;
27
28 {$mode objfpc}{$H+}
29
30 interface
31
32 uses
33 Classes, SysUtils,
34 // LCL
35 Graphics, ComCtrls, Menus, ImgList,
36 // LazUtils
37 LazFileUtils, Laz2_XMLCfg,
38 // IdeIntf
39 ToolBarIntf, IDEImagesIntf, LazIDEIntf, ProjectIntf, IDEOptionsIntf,
40 IDECommands, IDEUtils,
41 // Favorites
42 favoritesstr;
43
44 type
45 TFavoritesHandler = class
46 private
47 FOldToolButtonClass: TIDEToolButtonClass;
48 FFavoriteProjects: TStringList;
49 FConfig: TXMLConfig;
50
51 procedure AddToRecentProjectFiles(Sender: TObject; AFileName: string;
52 var AAllow: Boolean);
53 public
54 constructor Create;
55 destructor Destroy; override;
56 public
57 procedure LoadFromConfig;
58 procedure SaveToConfig;
IsInFavoriteProjectsnull59 function IsInFavoriteProjects(const aFileName: string): Boolean;
60 procedure AddToFavoriteProjects(const aFileName: string);
61 procedure RemoveFromFavoriteProjects(const aFileName: string);
62 end;
63
64 TFileNameMenuItem = class(TMenuItem)
65 public
66 FileName: string;
67 end;
68
69 TOpenFileFavToolButton = class(TIDEToolButton)
70 private
71 FOrigButton: TIDEToolButton;
72 FOrigOnPopup: TNotifyEvent;
73 FIndex: TStringList;
74 FAddImageIndex, FRemoveImageIndex: Integer;
75
76 procedure RefreshMenu(Sender: TObject);
77 procedure mnuFavoriteFile(Sender: TObject);
78 procedure mnuAddRemoveActiveProject(Sender: TObject);
79 public
80 constructor Create(aOwner: TComponent); override;
81 destructor Destroy; override;
82 procedure DoOnAdded; override;
83 end;
84
85
86 procedure Register;
87
88 implementation
89
90 var
91 FavHandler: TFavoritesHandler = nil;
92
93 procedure Register;
94 begin
95 FavHandler := TFavoritesHandler.Create;
96 end;
97
98 { TOpenFileFavToolButton }
99
100 constructor TOpenFileFavToolButton.Create(aOwner: TComponent);
101 begin
102 inherited Create(aOwner);
103
104 FIndex := TStringList.Create;
105
106 if FavHandler.FOldToolButtonClass<>nil then
107 FOrigButton := FavHandler.FOldToolButtonClass.Create(Self)
108 else
109 FOrigButton := TIDEToolButton.Create(Self);
110 end;
111
112 destructor TOpenFileFavToolButton.Destroy;
113 begin
114 FIndex.Free;
115
116 inherited Destroy;
117 end;
118
119 procedure TOpenFileFavToolButton.DoOnAdded;
120 var
121 xGlyphs: TLCLGlyphs;
122 begin
123 inherited DoOnAdded;
124
125 FOrigButton.DoOnAdded;
126
127 if FOrigButton.DropdownMenu<>nil then
128 DropdownMenu := FOrigButton.DropdownMenu
129 else
130 DropdownMenu := TPopupMenu.Create(Self);
131
132 if DropdownMenu.Images=nil then
133 DropdownMenu.Images := LCLGlyphs;
134 xGlyphs := DropdownMenu.Images as TLCLGlyphs;
135
136 FAddImageIndex := xGlyphs.GetImageIndex('laz_add');
137 FRemoveImageIndex := xGlyphs.GetImageIndex('laz_delete');
138
139 FOrigOnPopup := DropdownMenu.OnPopup;
140 DropdownMenu.OnPopup := @RefreshMenu;
141 Style := tbsDropDown;
142 end;
143
144 procedure TOpenFileFavToolButton.mnuAddRemoveActiveProject(Sender: TObject);
145 var
146 xFileName: string;
147 begin
148 xFileName := (Sender as TFileNameMenuItem).FileName;
149 if FavHandler.IsInFavoriteProjects(xFileName) then
150 begin
151 FavHandler.RemoveFromFavoriteProjects(xFileName);
152 IDEEnvironmentOptions.AddToRecentProjectFiles(xFileName);
153 end else
154 begin
155 FavHandler.AddToFavoriteProjects(xFileName);
156 IDEEnvironmentOptions.RemoveFromRecentProjectFiles(xFileName);
157 end;
158 end;
159
160 procedure TOpenFileFavToolButton.mnuFavoriteFile(Sender: TObject);
161 begin
162 LazarusIDE.DoOpenProjectFile((Sender as TFileNameMenuItem).FileName,[ofAddToRecent]);
163 end;
164
165 procedure TOpenFileFavToolButton.RefreshMenu(Sender: TObject);
166 var
167 xM, xSep: TMenuItem;
168 xFavoriteFile, xExt: string;
169 xMI, xAddToFav: TFileNameMenuItem;
170 xProj: TLazProject;
171 xMIndex: Integer;
172 begin
173 if Assigned(FOrigOnPopup) then
174 FOrigOnPopup(Sender);
175
176 xM := DropdownMenu.Items;
177
178 xMIndex := 0;
179 for xFavoriteFile in FavHandler.FFavoriteProjects do
180 begin
181 xMI := TFileNameMenuItem.Create(Self);
182 xMI.FileName := xFavoriteFile;
183 xMI.Caption := xFavoriteFile;
184 xMI.OnClick := @mnuFavoriteFile;
185 xExt := ExtractFileExt(xFavoriteFile);
186 if SameFileName(xExt, '.lpi') or SameFileName(xExt, '.lpr') then
187 xMI.ImageIndex := LoadProjectIconIntoImages(xFavoriteFile, DropdownMenu.Images, FIndex);
188
189 xM.Insert(xMIndex, xMI);
190 Inc(xMIndex);
191 end;
192
193 xProj := LazarusIDE.ActiveProject;
194 if (xProj<>nil) and FileExists(xProj.ProjectInfoFile) then
195 begin
196 xAddToFav := TFileNameMenuItem.Create(Self);
197 xAddToFav.FileName := xProj.ProjectInfoFile;
198 if not FavHandler.IsInFavoriteProjects(xProj.ProjectInfoFile) then
199 begin
200 xAddToFav.Caption := Format(sAddToFavoritesS, [xProj.ProjectInfoFile]);
201 xAddToFav.ImageIndex := FAddImageIndex;
202 end else
203 begin
204 xAddToFav.Caption := Format(sRemoveFromFavoritesS, [xProj.ProjectInfoFile]);
205 xAddToFav.ImageIndex := FRemoveImageIndex;
206 end;
207 xAddToFav.OnClick := @mnuAddRemoveActiveProject;
208 xM.Insert(xMIndex, xAddToFav);
209 Inc(xMIndex);
210 end;
211
212 if xMIndex > 0 then
213 begin
214 xSep := TMenuItem.Create(Self);
215 xSep.Caption := '-';
216 xM.Insert(xMIndex, xSep);
217 Inc(xMIndex);
218 end;
219 end;
220
221 { TFavoritesHandler }
222
223 constructor TFavoritesHandler.Create;
224 var
225 I: Integer;
226 xToolButton: TIDEButtonCommand;
227 begin
228 IDEEnvironmentOptions.AddHandlerAddToRecentProjectFiles(@AddToRecentProjectFiles);
229 FFavoriteProjects := TStringList.Create;
230 FFavoriteProjects.Duplicates := dupIgnore;
231 FFavoriteProjects.CaseSensitive := False;
232 FFavoriteProjects.Sorted := True;
233 FConfig := TXMLConfig.Create(AppendPathDelim(LazarusIDE.GetPrimaryConfigPath)+'favorites.xml');
234 LoadFromConfig;
235
236 xToolButton := IDEToolButtonCategories.FindItemByCommand(ecOpen);
237 FOldToolButtonClass := xToolButton.ToolButtonClass;
238 xToolButton.ToolButtonClass := TOpenFileFavToolButton;
239
240 for I := 0 to FFavoriteProjects.Count-1 do
241 IDEEnvironmentOptions.RemoveFromRecentProjectFiles(FFavoriteProjects[I]);
242 end;
243
244 procedure TFavoritesHandler.AddToFavoriteProjects(const aFileName: string);
245 begin
246 FFavoriteProjects.Add(aFileName);
247 end;
248
249 procedure TFavoritesHandler.AddToRecentProjectFiles(Sender: TObject;
250 AFileName: string; var AAllow: Boolean);
251 begin
252 if IsInFavoriteProjects(AFileName) then
253 AAllow := False;
254 end;
255
256 destructor TFavoritesHandler.Destroy;
257 begin
258 SaveToConfig;
259 FFavoriteProjects.Free;
260 FConfig.Free;
261
262 inherited Destroy;
263 end;
264
TFavoritesHandler.IsInFavoriteProjectsnull265 function TFavoritesHandler.IsInFavoriteProjects(const aFileName: string
266 ): Boolean;
267 var
268 I: Integer;
269 begin
270 for I := 0 to FFavoriteProjects.Count-1 do
271 if SameFileName(aFileName, FFavoriteProjects[I]) then
272 Exit(True);
273 Result := False;
274 end;
275
276 procedure TFavoritesHandler.LoadFromConfig;
277 var
278 I: Integer;
279 xItem: string;
280 begin
281 I := 1;
282 while True do
283 begin
284 xItem := FConfig.GetValue('projects/item'+IntToStr(I), '');
285 if xItem = '' then
286 Break;
287 if FileExists(xItem) then
288 FFavoriteProjects.Add(xItem);
289 Inc(I);
290 end;
291 end;
292
293 procedure TFavoritesHandler.RemoveFromFavoriteProjects(const aFileName: string);
294 var
295 xIndex: Integer;
296 begin
297 xIndex := FFavoriteProjects.IndexOf(aFileName);
298 if xIndex >= 0 then
299 FFavoriteProjects.Delete(xIndex);
300 end;
301
302 procedure TFavoritesHandler.SaveToConfig;
303 var
304 I: Integer;
305 xItem: string;
306 begin
307 I := 1;
308 FConfig.DeletePath('projects');
309 for xItem in FFavoriteProjects do
310 begin
311 FConfig.SetValue('projects/item'+IntToStr(I), xItem);
312 Inc(I);
313 end;
314 end;
315
316 finalization
317 FreeAndNil(FavHandler);
318 end.
319
320