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