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