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: Mattias Gaertner
22
23 Abstract:
24 A dialog for cleaning directories.
25 }
26 unit CleanDirDlg;
27
28 {$mode objfpc}{$H+}
29
30 interface
31
32 uses
33 Classes, SysUtils, RegExpr,
34 // LCL
35 LCLProc, Forms, Controls, Graphics, Dialogs, StdCtrls, ButtonPanel,
36 // LazUtils
37 FileUtil, LazFileUtils, Laz2_XMLCfg, LazStringUtils,
38 // IdeIntf
39 IDEWindowIntf, IDEHelpIntf, IDEDialogs,
40 // IDE
41 IDEProcs, LazarusIDEStrConsts, LazConf, TransferMacros, InputHistory,
42 ShowDeletingFilesDlg, EnvironmentOpts;
43
44 type
45
46 { TCleanDirectoryDialog }
47
48 TCleanDirectoryDialog = class(TForm)
49 ButtonPanel: TButtonPanel;
50 DirBrowseButton: TButton;
51 KeepTextFilesCheckbox: TCheckBox;
52 SubDirsCheckbox: TCheckBox;
53 SimpleSyntaxKeepCheckbox: TCheckBox;
54 KeepCombobox: TComboBox;
55 KeepGroupbox: TGroupBox;
56 SimpleSyntaxRemoveCheckbox: TCheckBox;
57 RemoveCombobox: TComboBox;
58 DirCombobox: TComboBox;
59 DirGroupbox: TGroupBox;
60 RemoveGroupbox: TGroupBox;
61 procedure CleanDirectoryDialogCreate(Sender: TObject);
62 procedure FormDestroy(Sender: TObject);
63 procedure HelpButtonClick(Sender: TObject);
64 procedure DirBrowseButtonClick(Sender: TObject);
65 procedure OkButtonClick(Sender: TObject);
66 private
67 FMacros: TTransferMacroList;
68 procedure SetMacros(const AValue: TTransferMacroList);
69 public
70 procedure LoadSettings;
71 procedure SaveSettings;
GetConfigFilenamenull72 function GetConfigFilename: string;
SearchFilesToDeletenull73 function SearchFilesToDelete(var List: TStrings): boolean;
DeleteFilesnull74 function DeleteFiles(List: TStrings): boolean;
75 property Macros: TTransferMacroList read FMacros write SetMacros;
76 end;
77
ShowCleanDirectoryDialognull78 function ShowCleanDirectoryDialog(const DefaultDirectory: string;
79 Macros: TTransferMacroList): TModalResult;
80
81 implementation
82
83 {$R *.lfm}
84
85 const
86 CleanDirXMLFilename = 'cleandirectorydialog.xml';
87 CleanDirXMLVersion = 1;
88
ShowCleanDirectoryDialognull89 function ShowCleanDirectoryDialog(const DefaultDirectory: string;
90 Macros: TTransferMacroList): TModalResult;
91 var
92 CleanDirectoryDialog: TCleanDirectoryDialog;
93 begin
94 CleanDirectoryDialog:=TCleanDirectoryDialog.Create(nil);
95 CleanDirectoryDialog.Macros:=Macros;
96 CleanDirectoryDialog.LoadSettings;
97 AddToRecentList(DefaultDirectory,CleanDirectoryDialog.DirCombobox.Items,20,rltFile);
98 CleanDirectoryDialog.DirComboBox.ItemIndex:=0;
99 CleanDirectoryDialog.DirComboBox.Text:=DefaultDirectory;
100 Result:=CleanDirectoryDialog.ShowModal;
101 CleanDirectoryDialog.Free;
102 end;
103
104 { TCleanDirectoryDialog }
105
106 procedure TCleanDirectoryDialog.OkButtonClick(Sender: TObject);
107 var
108 List: TStrings;
109 begin
110 ModalResult:=mrNone;
111 SaveSettings;
112 List:=nil;
113 try
114 if not SearchFilesToDelete(List) then exit;
115 if not DeleteFiles(List) then exit;
116 finally
117 List.Free;
118 end;
119 ModalResult:=mrOk;
120 end;
121
122 procedure TCleanDirectoryDialog.SetMacros(const AValue: TTransferMacroList);
123 begin
124 if FMacros=AValue then exit;
125 FMacros:=AValue;
126 end;
127
128 procedure TCleanDirectoryDialog.CleanDirectoryDialogCreate(Sender: TObject);
129 begin
130 Caption:=lisClDirCleanDirectory;
131 DirGroupbox.Caption:=lisCodeToolsDefsInsertBehindDirectory;
132 SubDirsCheckbox.Caption:=lisClDirCleanSubDirectories;
133 RemoveGroupbox.Caption:=lisClDirRemoveFilesMatchingFilter;
134 SimpleSyntaxRemoveCheckbox.Caption:=lisClDirSimpleSyntaxEGInsteadOf;
135 KeepGroupbox.Caption:=lisClDirKeepFilesMatchingFilter;
136 SimpleSyntaxKeepCheckbox.Caption:=lisClDirSimpleSyntaxEGInsteadOf;
137 KeepTextFilesCheckbox.Caption:=lisClDirKeepAllTextFiles;
138
139 ButtonPanel.OKButton.Caption:=lisClDirClean;
140 ButtonPanel.HelpButton.Caption:=lisMenuHelp;
141 ButtonPanel.CancelButton.Caption:=lisCancel;
142
143 ButtonPanel.OKButton.OnClick := @OKButtonClick;
144 ButtonPanel.HelpButton.OnClick := @HelpButtonClick;
145
146 IDEDialogLayoutList.ApplyLayout(Self);
147 DirCombobox.DropDownCount:=EnvironmentOptions.DropDownCount;
148 RemoveCombobox.DropDownCount:=EnvironmentOptions.DropDownCount;
149 KeepCombobox.DropDownCount:=EnvironmentOptions.DropDownCount;
150 end;
151
152 procedure TCleanDirectoryDialog.FormDestroy(Sender: TObject);
153 begin
154 IDEDialogLayoutList.SaveLayout(Self);
155 end;
156
157 procedure TCleanDirectoryDialog.HelpButtonClick(Sender: TObject);
158 begin
159 LazarusHelp.ShowHelpForIDEControl(Self);
160 end;
161
162 procedure TCleanDirectoryDialog.DirBrowseButtonClick(Sender: TObject);
163 var
164 NewDirectory: String;
165 begin
166 NewDirectory:=InputHistories.SelectDirectory(lisMenuCleanDirectory, true,
167 ExtractFilePath(DirCombobox.Text),ExtractFilename(DirCombobox.Text));
168 if NewDirectory<>'' then
169 DirCombobox.Text:=NewDirectory;
170 end;
171
172 procedure TCleanDirectoryDialog.LoadSettings;
173 var
174 XMLConfig: TXMLConfig;
175
176 procedure LoadComboList(AComboBox: TComboBox; const Path: string;
177 ListType: TRecentListType);
178 var
179 List: TStringList;
180 begin
181 List:=TStringList.Create;
182 LoadRecentList(XMLConfig,List,Path,ListType);
183 AComboBox.Items.Assign(List);
184 if AComboBox.Items.Count > 0 then
185 AComboBox.ItemIndex := 0;
186 List.Free;
187 end;
188
189 procedure AddStandardComboItem(AComboBox: TComboBox; const Item: string);
190 begin
191 if AComboBox.Items.IndexOf(Item)>=0 then exit;
192 AComboBox.Items.Add(Item);
193 AComboBox.ItemIndex:=0;
194 end;
195
196 var
197 Filename: String;
198 Path: String;
199 begin
200 try
201 Filename:=GetConfigFilename;
202 XMLConfig:=TXMLConfig.Create(Filename);
203 except
204 DebugLn('ERROR: unable to open clean directory options "',Filename,'"');
205 exit;
206 end;
207 try
208 try
209 Path:='CleanDirectoryOptions/';
210 //FileVersion:=XMLConfig.GetValue(Path+'Version/Value',0);
211
212 SubDirsCheckbox.Checked:=XMLConfig.GetValue(
213 Path+'SubDirectories/Value',false);
214 LoadComboList(DirCombobox,Path+'Directories',rltFile);
215 LoadComboList(RemoveCombobox,Path+'RemoveFilters',rltFile);
216 SimpleSyntaxRemoveCheckbox.Checked:=XMLConfig.GetValue(
217 Path+'RemoveFilter/SimpleSyntax',true);
218 LoadComboList(KeepCombobox,Path+'KeepFilters',rltFile);
219 SimpleSyntaxKeepCheckbox.Checked:=XMLConfig.GetValue(
220 Path+'KeepFilter/SimpleSyntax',true);
221 KeepTextFilesCheckbox.Checked:=XMLConfig.GetValue(
222 Path+'KeepTextFiles/Value',true);
223
224 // set defaults
225 AddStandardComboItem(DirCombobox,'$(ProjPath)');
226 AddStandardComboItem(RemoveCombobox,'*.(bak|ppu|ppl|o|or|a|so|dll)');
227 AddStandardComboItem(RemoveCombobox,'*.bak|*~');
228 AddStandardComboItem(KeepCombobox,
229 '*.(pas|pp|lpr|lfm|lrs|lpi|lpk|inc|sh|xml)');
230
231 finally
232 XMLConfig.Free;
233 end;
234 except
235 on E: Exception do begin
236 DebugLn('ERROR: unable to read clean directory options from "',
237 Filename,'": ',E.Message);
238 end;
239 end;
240 end;
241
242 procedure TCleanDirectoryDialog.SaveSettings;
243 var
244 XMLConfig: TXMLConfig;
245 Filename: String;
246 Path: String;
247 begin
248 AddComboTextToRecentList(DirCombobox, 20,rltFile);
249 AddComboTextToRecentList(RemoveCombobox, 20,rltFile);
250 AddComboTextToRecentList(KeepCombobox, 20,rltFile);
251 try
252 InvalidateFileStateCache;
253 Filename:=GetConfigFilename;
254 XMLConfig:=TXMLConfig.CreateClean(Filename);
255 except
256 DebugLn('ERROR: unable to open clean directory options "',Filename,'"');
257 exit;
258 end;
259 try
260 try
261 Path:='CleanDirectoryOptions/';
262 XMLConfig.SetValue(Path+'Version/Value',CleanDirXMLVersion);
263
264 XMLConfig.SetDeleteValue(Path+'SubDirectories/Value',
265 SubDirsCheckbox.Checked,false);
266 SaveRecentList(XMLConfig,DirCombobox.Items,Path+'Directories');
267 SaveRecentList(XMLConfig,RemoveCombobox.Items,Path+'RemoveFilters');
268 XMLConfig.SetDeleteValue(Path+'RemoveFilter/SimpleSyntax',
269 SimpleSyntaxRemoveCheckbox.Checked,true);
270 SaveRecentList(XMLConfig,KeepCombobox.Items,Path+'KeepFilters');
271 XMLConfig.SetDeleteValue(Path+'KeepFilter/SimpleSyntax',
272 SimpleSyntaxKeepCheckbox.Checked,true);
273 XMLConfig.SetDeleteValue(Path+'KeepTextFiles/Value',
274 KeepTextFilesCheckbox.Checked,true);
275
276 XMLConfig.Flush;
277 finally
278 XMLConfig.Free;
279 end;
280 except
281 on E: Exception do begin
282 DebugLn('ERROR: unable to write clean directory options to "',
283 Filename,'": ',E.Message);
284 end;
285 end;
286 end;
287
GetConfigFilenamenull288 function TCleanDirectoryDialog.GetConfigFilename: string;
289 begin
290 Result:=AppendPathDelim(GetPrimaryConfigPath)+CleanDirXMLFilename;
291 end;
292
SearchFilesToDeletenull293 function TCleanDirectoryDialog.SearchFilesToDelete(var List: TStrings): boolean;
294 var
295 RemoveFilterRegExpr: TRegExpr;
296 KeepFilterRegExpr: TRegExpr;
297
FileMatchesnull298 function FileMatches(const Filename: string): boolean;
299 var
300 ShortFilename: String;
301 begin
302 Result:=false;
303 ShortFilename:=ExtractFilename(Filename);
304 if (RemoveFilterRegExpr=nil)
305 or not RemoveFilterRegExpr.Exec(ExtractFilename(ShortFilename)) then exit;
306 if (KeepFilterRegExpr<>nil)
307 and KeepFilterRegExpr.Exec(ExtractFilename(ShortFilename)) then exit;
308 if KeepTextFilesCheckbox.Checked and FileIsText(Filename) then exit;
309 Result:=true;
310 end;
311
SearchInDirectorynull312 function SearchInDirectory(const MainDirectory: string;
313 Lvl: integer): boolean;
314 var
315 FileInfo: TSearchRec;
316 FullFilename: String;
317 begin
318 Result:=false;
319 if (not DirPathExists(MainDirectory)) or (Lvl>20) then exit;
320 if FindFirstUTF8(MainDirectory+GetAllFilesMask,
321 faAnyFile,FileInfo)=0
322 then begin
323 repeat
324 // check if special file
325 if (FileInfo.Name='.') or (FileInfo.Name='..') or (FileInfo.Name='')
326 then continue;
327 FullFilename:=MainDirectory+FileInfo.Name;
328 if (FileInfo.Attr and faDirectory)>0 then begin
329 if SubDirsCheckbox.Checked then begin
330 // search recursively
331 if not SearchInDirectory(AppendPathDelim(FullFilename),Lvl+1) then
332 break;
333 end;
334 end else begin
335 if FileMatches(FullFilename) then
336 List.Add(FullFilename);
337 end;
338 until FindNextUTF8(FileInfo)<>0;
339 end;
340 FindCloseUTF8(FileInfo);
341 Result:=true;
342 end;
343
SetupFilternull344 function SetupFilter(var Filter: TRegExpr; SimpleSyntax: boolean;
345 const FilterAsText: string): boolean;
346 var
347 Expr: String;
348 s: String;
349 begin
350 Result:=false;
351 if FilterAsText='' then begin
352 Filter:=nil;
353 Result:=true;
354 exit;
355 end;
356 Filter:=TRegExpr.Create;
357 if SimpleSyntax then
358 Expr:=SimpleSyntaxToRegExpr(FilterAsText)
359 else
360 Expr:=FilterAsText;
361 try
362 Filter.Expression:=Expr;
363 // do a simple test
364 Filter.Exec('test.file');
365 Result:=true;
366 except
367 on E: Exception do begin
368 if SimpleSyntax then
369 s:=Format(lisTheFileMaskIsInvalid, [FilterAsText])
370 else
371 s:=Format(lisTheFileMaskIsNotAValidRegularExpression, [FilterAsText]);
372 IDEMessageDialog(lisInvalidMask, s, mtError, [mbCancel]);
373 end;
374 end;
375 end;
376
377 var
378 Directory: String;
379 begin
380 Result:=false;
381 RemoveFilterRegExpr:=nil;
382 KeepFilterRegExpr:=nil;
383 List:=nil;
384
385 try
386 // get directory
387 Directory:=DirCombobox.Text;
388 if (Macros<>nil) and (not Macros.SubstituteStr(Directory)) then exit;
389 Directory:=AppendPathDelim(Directory);
390
391 // setup filters
392 if not SetupFilter(RemoveFilterRegExpr,SimpleSyntaxRemoveCheckbox.Checked,
393 RemoveCombobox.Text) then exit;
394 if not SetupFilter(KeepFilterRegExpr,SimpleSyntaxKeepCheckbox.Checked,
395 KeepCombobox.Text) then exit;
396
397 // search files
398 List:=TStringList.Create;
399 if not SearchInDirectory(Directory,0) then exit;
400
401 Result:=true;
402 finally
403 RemoveFilterRegExpr.Free;
404 KeepFilterRegExpr.Free;
405 if not Result then
406 FreeAndNil(List);
407 end;
408 end;
409
TCleanDirectoryDialog.DeleteFilesnull410 function TCleanDirectoryDialog.DeleteFiles(List: TStrings): boolean;
411 var
412 i: Integer;
413 Filename: string;
414 MsgResult: TModalResult;
415 ShowDeletingFilesDialog: TShowDeletingFilesDialog;
416 begin
417 Result:=false;
418 if List.Count=0 then begin
419 Result:=true;
420 exit;
421 end;
422
423 // ask user for confirmation
424 ShowDeletingFilesDialog:=TShowDeletingFilesDialog.Create(Self);
425 try
426 ShowDeletingFilesDialog.FileList.Items.AddStrings(List);
427 for i := 0 to ShowDeletingFilesDialog.FileList.Count - 1 do
428 ShowDeletingFilesDialog.FileList.Checked[i] := True;
429
430 if ShowDeletingFilesDialog.ShowModal<>mrOk then exit;
431
432 // delete all checked files
433 for i:=0 to ShowDeletingFilesDialog.FileList.Count-1 do begin
434 if ShowDeletingFilesDialog.FileList.Checked[i] then
435 begin
436 Filename:=ShowDeletingFilesDialog.FileList.Items[i];
437 DebugLn('TCleanDirectoryDialog: Deleting file ',Filename);
438 if FileExistsUTF8(Filename) then begin
439 repeat
440 if DeleteFileUTF8(Filename) then begin
441 break;
442 end else begin
443 MsgResult:=MessageDlg(lisErrorDeletingFile,
444 Format(lisPkgMangUnableToDeleteFile, [Filename]),
445 mtError,[mbAbort,mbIgnore,mbRetry],0);
446 if (MsgResult=mrIgnore) then break;
447 if MsgResult=mrAbort then exit;
448 end;
449 until false;
450 end;
451 end;
452 end;
453
454 finally
455 ShowDeletingFilesDialog.Free;
456 end;
457
458 Result:=true;
459 end;
460
461 end.
462
463