1 unit FileConverter;
2
3 {(*}
4 (*------------------------------------------------------------------------------
5 Delphi Code formatter source code
6
7 The Original Code is Converter.pas, released January 2001.
8 The Initial Developer of the Original Code is Anthony Steele.
9 Portions created by Anthony Steele are Copyright (C) 1999-2008 Anthony Steele.
10 All Rights Reserved.
11 Contributor(s): Anthony Steele.
12
13 The contents of this file are subject to the Mozilla Public License Version 1.1
14 (the "License"). you may not use this file except in compliance with the License.
15 You may obtain a copy of the License at http://www.mozilla.org/NPL/
16
17 Software distributed under the License is distributed on an "AS IS" basis,
18 WITHOUT WARRANTY OF ANY KIND, either express or implied.
19 See the License for the specific language governing rights and limitations
20 under the License.
21
22 Alternatively, the contents of this file may be used under the terms of
23 the GNU General Public License Version 2 or later (the "GPL")
24 See http://www.gnu.org/licenses/gpl.html
25 ------------------------------------------------------------------------------*)
26 {*)}
27
28 {$I ..\Include\JcfGlobal.inc}
29
30 interface
31
32 uses
33 Classes, SysUtils,
34 Dialogs, Controls, Forms,
35 // local
36 Converter, ConvertTypes;
37
38 { AFS 7 July 04
39 rewrote this as a wrapper for the string->string converter
40 So basically it deals with file issues
41 and delegates the convertion to the wrapped TConverter
42 }
43
44
45 type
46
47 TFileConverter = class(TObject)
48 private
49 { the string-> string converter }
50 fcConverter: TConverter;
51
52 { state }
53 fOnStatusMessage: TStatusMessageProc;
54 peBackupMode: TBackupMode;
55 peSourceMode: TSourceMode;
56
57 { properties }
58 fsInput: string;
59 fsOriginalFileName: string;
60 fsOutFileName: string;
61 fbYesAll: boolean;
62 fbGuiMessages: Boolean;
63 fbAbort: boolean;
64 fiConvertCount: integer;
65
66 procedure SendStatusMessage(const psUnit, psMessage: string;
67 const peMessageType: TStatusMessageType;
68 const piY, piX: integer);
69
70 procedure GetFileNames(const psDir: string; psFiles: TStrings);
71 procedure GetDirNames(const psDir: string; psFiles: TStrings);
72
GetOnStatusMessagenull73 function GetOnStatusMessage: TStatusMessageProc;
74 procedure SetOnStatusMessage(const Value: TStatusMessageProc);
75 procedure FinalSummary;
76
PreProcessChecksnull77 function PreProcessChecks(const psInputFileName: string): boolean;
78
79 protected
OriginalFileNamenull80 function OriginalFileName: string;
81
82 procedure ProcessDirectory(const psDir: string);
83
84 public
85 constructor Create;
86 destructor Destroy; override;
87
88 procedure ProcessFile(const psInputFileName: string);
89
90 procedure Convert;
91 procedure Clear;
92
ConvertErrornull93 function ConvertError: Boolean;
TokenCountnull94 function TokenCount: integer;
95
96
97
98 property BackupMode: TBackupMode Read peBackupMode Write peBackupMode;
99 property SourceMode: TSourceMode Read peSourceMode Write peSourceMode;
100 property Input: string Read fsInput Write fsInput;
101
102 property YesAll: boolean read fbYesAll write fbYesAll;
103 property GuiMessages: Boolean read fbGuiMessages write fbGuiMessages;
104
105 property Abort: boolean read fbAbort write fbAbort;
106
107 // details of the last file converted
108 property OutFileName: string Read fsOutFileName;
109
110 property OnStatusMessage: TStatusMessageProc read GetOnStatusMessage write SetOnStatusMessage;
111 end;
112
113 implementation
114
115 uses
116 { local }
117 JcfStringUtils, JcfSystemUtils,
118 JcfMiscFunctions, JcfLog,
119 JcfRegistrySettings, JcfSettings, JcfUnicodeFiles;
120
121 constructor TFileConverter.Create;
122 begin
123 inherited;
124 fcConverter := TConverter.Create;
125 fcConverter.OnStatusMessage := SendStatusMessage;
126 end;
127
128 destructor TFileConverter.Destroy;
129 begin
130 FreeAndNil(fcConverter);
131 inherited;
132 end;
133
TFileConverter.PreProcessChecksnull134 function TFileConverter.PreProcessChecks(const psInputFileName: string): boolean;
135 var
136 lsTemp: string;
137 begin
138 Result := False;
139
140 if psInputFileName = '' then
141 begin
142 SendStatusMessage('', 'Select a file', mtInputError, -1, -1);
143 exit;
144 end;
145
146 if not FileExists(psInputFileName) then
147 begin
148 SendStatusMessage(psInputFileName,
149 'The file "' + psInputFileName + '" does not exist',
150 mtInputError, -1, -1);
151 exit;
152 end;
153
154 if FileGetSize(psInputFileName) < 1 then
155 begin
156 SendStatusMessage(psInputFileName, 'The file "' + psInputFileName + '" is empty',
157 mtInputError,
158 -1, -1);
159 exit;
160 end;
161
162 if (SourceMode <> fmSingleFile) then
163 begin
164 lsTemp := PathExtractFileNameNoExt(psInputFileName);
165
166 if GetRegSettings.FileIsExcluded(lsTemp) then
167 begin
168 Log.Write('Exluded file: ' + psInputFileName);
169 exit;
170 end;
171 end;
172
173 { all kinds of chaos ensues if you work with readonly files,
174 for e.g. you can rename them to .bak, but on the next run you will be unable to delete the old .bak files.
175 They are only safe when the source is read not written, ie "output to separate file" backup mode
176 }
177 if (BackupMode <> cmSeparateOutput) and (FileIsReadOnly(psInputFileName)) then
178 begin
179 Log.WriteError('File: ' + psInputFileName + ' cannot be processed as it is read only');
180 exit;
181 end;
182
183 result := True;
184 end;
185
186 procedure TFileConverter.ProcessFile(const psInputFileName: string);
187 var
188 lsMessage, lsOut: string;
189 wRes: word;
190 lbFileIsChanged: boolean;
191 lsOutType: string;
192 lsSourceCode: String;
193 leContentType: TFileContentType;
194 begin
195 // do checks
196 if not PreProcessChecks(psInputFileName) then
197 exit;
198
199 // notify owner
200 lsMessage := 'Formatting file ' + psInputFileName;
201
202 if GetRegSettings.LogLevel in [eLogFiles, eLogTokens] then
203 Log.Write(lsMessage);
204 SendStatusMessage(psInputFileName, lsMessage, mtProgress, -1, -1);
205
206 // convert in memory
207 fsOriginalFileName := psInputFileName;
208
209 ReadTextFile(psInputFileName, lsSourceCode, leContentType);
210
211 fcConverter.FileName := psInputFileName;
212 fcConverter.InputCode := lsSourceCode;
213 fcConverter.GuiMessages := GuiMessages;
214 fcConverter.Convert;
215
216 // was it converted ?
217 if ConvertError then
218 exit;
219
220 Inc(fiConvertCount);
221
222 {
223 check if the file has changed.
224 If not, do not write.
225 This is kinder to source control systems (CVS, SVN etc.)
226 that check the file timestamp
227 }
228 lbFileIsChanged := (fcConverter.InputCode <> fcConverter.OutputCode);
229
230 lsOut := GetRegSettings.GetOutputFileName(psInputFileName, peBackupMode);
231
232 // check if an output/backup file must be removed
233 if BackupMode <> cmInplace then
234 begin
235 if lsOut = '' then
236 begin
237 SendStatusMessage(psInputFileName, 'No output/backup file specified',
238 mtInputError, -1, -1);
239 exit;
240 end;
241
242 if lbFileIsChanged and FileExists(lsOut) then
243 begin
244 if YesAll then
245 wRes := mrYes
246 else
247 begin
248 if BackupMode = cmInPlaceWithBackup then
249 lsOutType := 'Backup'
250 else
251 lsOutType := 'Output';
252
253 wRes := MessageDlg(lsOutType + ' file ' + lsOut + ' exists already. Remove it?',
254 mtConfirmation, [mbYes, mbNo, mbAll, mbAbort], 0);
255 end;
256
257 if wRes = mrAll then
258 begin
259 YesAll := True;
260 wRes := mrYes;
261 end;
262
263 if wRes = mrYes then
264 begin
265 if not DeleteFile(lsOut) then
266 raise Exception.Create('TFileConverter.ProcessFile: ' +
267 'Failed to delete ' + lsOutType + ' file ' + lsOut);
268 end
269 else if wRes = mrNo then
270 begin
271 exit;
272 end
273 else if wRes = mrAbort then
274 begin
275 fbAbort := True;
276 exit;
277 end;
278 end;
279 end;
280
281 // now, depending on mode, write the output to new/old file
282 case BackupMode of
283 cmInPlace:
284 begin
285 fsOutFileName := psInputFileName;
286
287 if lbFileIsChanged then
288 begin
289 // delete the old one, write the new one
290 DeleteFile(psInputFileName);
291 WriteTextFile(psInputFileName, fcConverter.OutputCode, leContentType);
292 end;
293 end;
294
295 cmInPlaceWithBackup:
296 begin
297 fsOutFileName := psInputFileName;
298
299 if lbFileIsChanged then
300 begin
301
302 { rename the original file to the backup file name,
303 write processed code back to the original file }
304 if not RenameFile(psInputFileName, lsOut) then
305 begin
306 raise Exception.Create('TFileConverter.ProcessFile: ' +
307 ' could not rename source file ' + psInputFileName + ' to ' + lsOut);
308 end;
309
310 WriteTextFile(psInputFileName, fcConverter.OutputCode, leContentType);
311 end;
312 end;
313
314 cmSeparateOutput:
315 begin
316 fsOutFileName := lsOut;
317 { simple. Write to a new file
318 doesn't matter if it;s not changed }
319 WriteTextFile(lsOut, fcConverter.OutputCode, leContentType);
320
321 end;
322 else
323 Assert(False, 'Bad backup mode');
324 end;
325
326 end;
327
328 procedure TFileConverter.ProcessDirectory(const psDir: string);
329 var
330 lsMessage: string;
331 lsNames: TStringList;
332 lsDir: string;
333 liLoop: integer;
334 begin
335 if not DirectoryExists(psDir) then
336 begin
337 SendStatusMessage('', 'The directory ' + psDir + ' does not exist',
338 mtInputError, -1, -1);
339 exit;
340 end;
341
342 if GetRegSettings.DirIsExcluded(GetLastDir(psDir)) then
343 begin
344 Log.Write('Exluded dir: ' + psDir);
345 exit;
346 end;
347
348 lsDir := IncludeTrailingPathDelimiter(psDir);
349
350 lsMessage := 'Processing directory ' + lsDir;
351 //if Settings.Log.LogLevel in [eLogFiles, eLogTokens] then
352 Log.Write(lsMessage);
353 SendStatusMessage('', lsMessage, mtProgress, -1, -1);
354
355 lsNames := TStringList.Create;
356 try { finally free }
357 GetFileNames(lsDir, lsNames);
358
359 for liLoop := 0 to lsNames.Count - 1 do
360 begin
361 ProcessFile(lsDir + lsNames[liLoop]);
362 if fbAbort then
363 break;
364
365 {$IFNDEF COMMAND_LINE}
366 // refresh the GUI
367 Application.ProcessMessages;
368 {$ENDIF}
369 end;
370
371 { all subdirs }
372 if SourceMode = fmDirectoryRecursive then
373 begin
374 lsNames.Clear;
375 GetDirNames(lsDir, lsNames);
376
377 for liLoop := 0 to lsNames.Count - 1 do
378 begin
379 ProcessDirectory(lsDir + lsNames[liLoop]);
380 if fbAbort then
381 break;
382 end;
383 end;
384
385 finally
386 lsNames.Free;
387 end;
388 end;
389
390 procedure TFileConverter.GetFileNames(const psDir: string; psFiles: TStrings);
391 var
392 rSearch: TSearchRec;
393 lsName, lsExt, lsSearch: string;
394 bDone: boolean;
395 begin
396 Assert(psDir <> '');
397 Assert(psFiles <> nil);
398 lsSearch := psDir + AllFilesMask; { for all pas files in the dir }
399 FillChar(rSearch{%H-}, Sizeof(TSearchRec), 0);
400 bDone := (FindFirst(lsSearch, 0, rSearch) <> 0);
401 while not bDone do
402 begin
403 lsName := rSearch.Name;
404 Assert(lsName <> '');
405 if (rSearch.Attr and faDirectory > 0) then
406 continue;
407
408 lsExt := ExtractFileExt(lsName);
409 if FormattingSettings.Clarify.ExtensionIsFormatted(lsExt) then
410 psFiles.Add(lsName);
411
412 bDone := (FindNext(rSearch) <> 0);
413 Assert(bDone or (rSearch.Name <> lsName));
414 end;
415 FindClose(rSearch);
416 end;
417
418 procedure TFileConverter.GetDirNames(const psDir: string; psFiles: TStrings);
419 var
420 rSearch: TSearchRec;
421 lsSearch: string;
422 bDone: boolean;
423 begin
424 Assert(psDir <> '');
425 Assert(psFiles <> nil);
426 lsSearch := psDir + AllFilesMask;
427 FillChar(rSearch{%H-}, Sizeof(TSearchRec), 0);
428 bDone := (FindFirst(lsSearch, faDirectory, rSearch) <> 0);
429
430 while not bDone do
431 begin
432 if (rSearch.Attr and faDirectory > 0) and
433 (rSearch.Name <> '.') and (rSearch.Name <> '..') then
434 psFiles.Add(rSearch.Name);
435
436 bDone := (FindNext(rSearch) <> 0);
437 end;
438 FindClose(rSearch);
439 end;
440
441
442 procedure TFileConverter.Convert;
443 var
444 dwStart, dwElapsed: DWord;
445 begin
446 if GetRegSettings.LogTime then
447 dwStart := GetTickCount
448 else
449 dwStart := 0;
450
451 fbAbort := False;
452 fiConvertCount := 0;
453
454 { all processors must check thier inclusion settings
455 as this may have changed from the UI }
456
457 { process file(s) }
458 case SourceMode of
459 fmSingleFile:
460 ProcessFile(Input);
461 fmDirectory, fmDirectoryRecursive:
462 begin
463 ProcessDirectory(Input);
464 end
465 else
466 raise Exception.Create('TConverter.Convert: Bad file recurse type');
467 end;
468
469 if GetRegSettings.LogTime then
470 begin
471 dwElapsed := GetTickCount - dwStart;
472 Log.Write('Run took ' + FloatToStr(dwElapsed / 1000) + ' seconds')
473 end;
474
475 FinalSummary;
476 Log.CloseLog;
477
478 if GetRegSettings.ViewLogAfterRun then
479 GetRegSettings.ViewLog;
480 end;
481
OriginalFileNamenull482 function TFileConverter.OriginalFileName: string;
483 begin
484 Result := fsOriginalFileName;
485 end;
486
487
488 procedure TFileConverter.FinalSummary;
489 var
490 lsMessage: string;
491 begin
492 if fiConvertCount = 0 then
493 begin
494 if ConvertError then
495 lsMessage := 'Aborted due to error'
496 else
497 lsMessage := 'Nothing done';
498 end
499 else if fbAbort then
500 lsMessage := 'Aborted after ' + DescribeFileCount(fiConvertCount)
501 else if fiConvertCount > 1 then
502 lsMessage := 'Finished processing ' + DescribeFileCount(fiConvertCount)
503 else
504 lsMessage := '';
505
506 if lsMessage <> '' then
507 begin
508 SendStatusMessage('', lsMessage, mtProgress, -1, -1);
509
510 Log.EmptyLine;
511 Log.Write(lsMessage);
512 end;
513 end;
514
515 procedure TFileConverter.Clear;
516 begin
517 fcConverter.Clear;
518 end;
519
520
TFileConverter.ConvertErrornull521 function TFileConverter.ConvertError: Boolean;
522 begin
523 Result := fcConverter.ConvertError;
524 end;
525
526
TFileConverter.TokenCountnull527 function TFileConverter.TokenCount: integer;
528 begin
529 Result := fcConverter.TokenCount;
530 end;
531
TFileConverter.GetOnStatusMessagenull532 function TFileConverter.GetOnStatusMessage: TStatusMessageProc;
533 begin
534 Result := fOnStatusMessage;
535 end;
536
537 procedure TFileConverter.SetOnStatusMessage(const Value: TStatusMessageProc);
538 begin
539 fOnStatusMessage := Value;
540 end;
541
542 procedure TFileConverter.SendStatusMessage(const psUnit, psMessage: string;
543 const peMessageType: TStatusMessageType;
544 const piY, piX: integer);
545 var
546 lsUnit: string;
547 begin
548 if Assigned(fOnStatusMessage) then
549 begin
550 lsUnit := psUnit;
551 if lsUnit = '' then
552 lsUnit := OriginalFileName;
553
554 fOnStatusMessage(lsUnit, psMessage, peMessageType, piY, piX);
555 end;
556 end;
557
558 end.
559