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