1 {(*}
2 (*------------------------------------------------------------------------------
3 Delphi Code formatter source code
4
5 The Original Code is Settings.pas, released April 2000.
6 The Initial Developer of the Original Code is Anthony Steele.
7 Portions created by Anthony Steele are Copyright (C) 1999-2008 Anthony Steele.
8 All Rights Reserved.
9 Contributor(s): Anthony Steele.
10
11 The contents of this file are subject to the Mozilla Public License Version 1.1
12 (the "License"). you may not use this file except in compliance with the License.
13 You may obtain a copy of the License at http://www.mozilla.org/NPL/
14
15 Software distributed under the License is distributed on an "AS IS" basis,
16 WITHOUT WARRANTY OF ANY KIND, either express or implied.
17 See the License for the specific language governing rights and limitations
18 under the License.
19
20 Alternatively, the contents of this file may be used under the terms of
21 the GNU General Public License Version 2 or later (the "GPL")
22 See http://www.gnu.org/licenses/gpl.html
23 ------------------------------------------------------------------------------*)
24 {*)}
25
26 unit JcfSettings;
27
28 { this is the settings on how to parse. As of 2.0 this is always from a file
29 The file name is stored in registry
30 This allows centralised settings on a shared dir }
31
32 {$I JcfGlobal.inc}
33
34 interface
35
36 uses
37 { local }
38 SetObfuscate, SetClarify,
39 SetIndent, SetSpaces, SetReturns,
40 SetComments, SetCaps, SetWordList,
41 SetAlign, SetReplace, SetUses, SetPreProcessor,
42 SettingsStream, SetTransform, SetAsm,
43 JcfVersionConsts, IDEOptionsIntf, IDEOptEditorIntf;
44
45 type
46
47 { TFormattingSettings }
48
49 TFormattingSettings = class(TAbstractIDEEnvironmentOptions)
50 private
51 fcObfuscate: TSetObfuscate;
52 fcClarify: TSetClarify;
53 fcSpaces: TSetSpaces;
54 fcIndent: TSetIndent;
55 fcReturns: TSetReturns;
56 fcComments: TSetComments;
57
58 fcCaps: TSetCaps;
59 fcSpecificWordCaps: TSetWordList;
60 fcIdentifierCaps: TSetWordList;
61 fcNotIdentifierCaps: TSetWordList;
62 fcUnitNameCaps: TSetWordList;
63
64 fcSetAsm: TSetAsm;
65
66 fcPreProcessor: TSetPreProcessor;
67 fcAlign: TSetAlign;
68 fcUses: TSetUses;
69
70 fcReplace: TSetReplace;
71
72 fcTransform: TSetTransform;
73
74 fbWriteOnExit: boolean;
75 fbHasRead: boolean;
76 fbDirty: boolean;
77
78 fsDescription: string;
79 fdtWriteDateTime: TDateTime;
80 fsWriteVersion: string;
81 fsConfirmFormat: Boolean;
82
83 procedure FromStream(const pcStream: TSettingsInput);
84 public
85 constructor Create(const pbReadRegFile: boolean);
86 destructor Destroy; override;
GetGroupCaptionnull87 class function GetGroupCaption: String; override;
GetInstancenull88 class function GetInstance: TAbstractIDEOptions; override;
89 procedure DoAfterWrite({%H-}Restore: boolean); override;
90
91 procedure Read;
92 procedure ReadFromFile(const psFileName: string; const pbMustExist: boolean);
93 procedure ReadDefaults;
94 procedure Write;
95
96 procedure MakeConsistent;
97
98 procedure ToStream(const pcStream: TSettingsOutput);
99
100 property Description: string Read fsDescription Write fsDescription;
101 property WriteDateTime: TDateTime Read fdtWriteDateTime Write fdtWriteDateTime;
102 property WriteVersion: string Read fsWriteVersion Write fsWriteVersion;
103
104 property Obfuscate: TSetObfuscate Read fcObfuscate;
105 property Clarify: TSetClarify Read fcClarify;
106 property Indent: TSetIndent Read fcIndent;
107 property Spaces: TSetSpaces Read fcSpaces;
108 property Returns: TSetReturns Read fcReturns;
109 property Comments: TSetComments Read fcComments;
110
111 property Caps: TSetCaps Read fcCaps;
112 property SpecificWordCaps: TSetWordList Read fcSpecificWordCaps;
113 property IdentifierCaps: TSetWordList Read fcIdentifierCaps;
114 property NotIdentifierCaps: TSetWordList Read fcNotIdentifierCaps;
115 property UnitNameCaps: TSetWordList Read fcUnitNameCaps;
116 property SetAsm: TSetAsm Read fcSetAsm;
117
118 property PreProcessor: TSetPreProcessor Read fcPreProcessor;
119
120 property Align: TSetAlign Read fcAlign;
121 property Replace: TSetReplace Read fcReplace;
122 property UsesClause: TSetUses Read fcUses;
123
124 property Transform: TSetTransform read fcTransform;
125
126 property WriteOnExit: boolean Read fbWriteOnExit Write fbWriteOnExit;
127 property Dirty: boolean Read fbDirty Write fbDirty;
128 property HasRead: boolean read fbHasRead write fbHasRead;
129 property ConfirmFormat: boolean read fsConfirmFormat write fsConfirmFormat;
130 end;
131
FormattingSettingsnull132 function FormattingSettings: TFormattingSettings;
133
134 // create from a settings file
FormatSettingsFromFilenull135 function FormatSettingsFromFile(const psFileName: string): TFormattingSettings;
136
137 var
138 JCFOptionsGroup: Integer;
139 const
140 JCFOptionFormatFile = 1;
141 JCFOptionObfuscate = 2;
142 JCFOptionClarify = 3;
143 JCFOptionSpaces = 4;
144 JCFOptionIndentation = 5;
145 JCFOptionBlankLines = 6;
146 JCFOptionAlign = 7;
147 JCFOptionLongLines = 8;
148 JCFOptionReturns = 9;
149 JCFOptionCaseBlocks = 10;
150 JCFOptionBlocks = 11;
151 JCFOptionCompilerDirectives = 12;
152 JCFOptionComments = 13;
153 JCFOptionWarnings = 14;
154 JCFOptionObjectPascal = 15;
155 JCFOptionAnyWord = 16;
156 JCFOptionIdentifiers = 17;
157 JCFOptionNotIdentifiers = 18;
158 JCFOptionUnitName = 19;
159 JCFOptionFindAndReplace = 20;
160 JCFOptionUses = 21;
161 JCFOptionBasic = 22;
162 JCFOptionTransform = 23;
163 JCFOptionAsm = 24;
164 JCFOptionPreProcessor = 25;
165
166 const
167 GUI_PAD = 3;
168
169 implementation
170
171 uses
172 { delphi }
173 {$IFNDEF FPC}Windows,{$ELSE}LazFileUtils, LazUTF8,{$ENDIF} SysUtils, Dialogs,
174 { local }
175 JcfStringUtils,
176 JcfSetBase,
177 JcfRegistrySettings,
178 jcfuiconsts;
179
180
181 constructor TFormattingSettings.Create(const pbReadRegFile: boolean);
182 begin
183 inherited Create();
184
185 fcObfuscate := TSetObfuscate.Create;
186 fcClarify := TSetClarify.Create;
187 fcIndent := TSetIndent.Create;
188 fcSpaces := TSetSpaces.Create;
189 fcReturns := TSetReturns.Create;
190
191 fcComments := TSetComments.Create;
192
193 fcCaps := TSetCaps.Create;
194 fcSpecificWordCaps := TSetWordList.Create('SpecificWordCaps');
195 fcIdentifierCaps := TSetWordList.Create('Identifiers');
196 fcNotIdentifierCaps := TSetWordList.Create('NotIdent');
197 fcUnitNameCaps := TSetWordList.Create('UnitNameCaps');
198
199 fcSetAsm := TSetAsm.Create();
200
201 fcPreProcessor := TSetPreProcessor.Create;
202
203 fcAlign := TSetAlign.Create;
204 fcReplace := TSetReplace.Create;
205 fcUses := TSetUses.Create;
206 fcTransform := TSetTransform.Create;
207
208 if pbReadRegFile then
209 begin
210 Read;
211 end;
212
213 fbWriteOnExit := True;
214 fbDirty := False;
215 end;
216
217 destructor TFormattingSettings.Destroy;
218 begin
219 if WriteOnExit then
220 Write;
221
222 FreeAndNil(fcObfuscate);
223 FreeAndNil(fcClarify);
224 FreeAndNil(fcIndent);
225 FreeAndNil(fcSpaces);
226 FreeAndNil(fcReturns);
227 FreeAndNil(fcComments);
228
229 FreeAndNil(fcCaps);
230 FreeAndNil(fcSpecificWordCaps);
231 FreeAndNil(fcIdentifierCaps);
232 FreeAndNil(fcNotIdentifierCaps);
233 FreeAndNil(fcUnitNameCaps);
234 FreeAndNil(fcSetAsm);
235
236 FreeAndNil(fcPreProcessor);
237
238 FreeAndNil(fcReplace);
239 FreeAndNil(fcAlign);
240 FreeAndNil(fcUses);
241 FreeAndNil(fcTransform);
242
243 inherited;
244 end;
245
TFormattingSettings.GetGroupCaptionnull246 class function TFormattingSettings.GetGroupCaption: String;
247 begin
248 Result := lisJCFFormatSettings;
249 end;
250
TFormattingSettings.GetInstancenull251 class function TFormattingSettings.GetInstance: TAbstractIDEOptions;
252 begin
253 Result := FormattingSettings;
254 end;
255
256 procedure TFormattingSettings.DoAfterWrite(Restore: boolean);
257 begin
258 { settings are now in need of saving }
259 Dirty := True;
260 { check consistency of settings }
261 MakeConsistent;
262 { save to file }
263 Write;
264 end;
265
266 const
267 CODEFORMAT_SETTINGS_SECTION = 'JediCodeFormatSettings';
268
269 REG_VERSION = 'WriteVersion';
270 REG_WRITE_DATETIME = 'WriteDateTime';
271 REG_DESCRIPTION = 'Description';
272 REG_CONFIRM_FORMAT = 'ConfirmFormat';
273
274 procedure TFormattingSettings.Read;
275 var
276 lcReg: TJCFRegistrySettings;
277 begin
278 // use the Settings File if it exists
279 lcReg := GetRegSettings;
280 ReadFromFile(lcReg.FormatConfigFileName, lcReg.FormatConfigNameSpecified);
281 end;
282
283 procedure TFormattingSettings.ReadFromFile(const psFileName: string; const pbMustExist: boolean);
284 var
285 lsText: string;
286 lcFile: TSettingsInputString;
287 begin
288 if {$ifdef FPC}FileExistsUTF8(psFileName){$else}FileExists(psFileName){$endif} then
289 begin
290 // debug ShowMessage('Reading settings from file ' + lsSettingsFileName);
291
292 // now we know the file exists - try get settings from it
293 {$ifdef FPC}
294 lsText := string(FileToString(UTF8ToSys(psFileName)));
295 {$else}
296 lsText := string(FileToString(psFileName));
297 {$endif}
298 lcFile := TSettingsInputString.Create(lsText);
299 try
300 FromStream(lcFile);
301 finally
302 lcFile.Free;
303 end;
304 end
305 else
306 begin
307 if pbMustExist then
308 begin
309 MessageDlg(Format(lisTheSettingsFileDoesNotExist, [psFileName, NativeLineBreak]),
310 mtError, [mbOK], 0);
311 end;
312 end;
313 end;
314
315
316 procedure TFormattingSettings.ReadDefaults;
317 var
318 lcSetDummy: TSettingsInputDummy;
319 begin
320 lcSetDummy := TSettingsInputDummy.Create;
321 try
322 FromStream(lcSetDummy);
323 finally
324 lcSetDummy.Free;
325 end;
326 end;
327
328 procedure TFormattingSettings.Write;
329 var
330 lcReg: TJCFRegistrySettings;
331 lcFile: TSettingsStreamOutput;
332 begin
333 if not Dirty then
334 exit;
335
336 { user may have specified no-write }
337 lcReg := GetRegSettings;
338 if lcReg.FormatFileWriteOption = eNeverWrite then
339 exit;
340
341 if lcReg.FormatConfigFileName = '' then
342 exit;
343
344 {$ifdef FPC}
345 if FileExistsUTF8(lcReg.FormatConfigFileName) and FileIsReadOnlyUTF8(lcReg.FormatConfigFileName) then
346 {$else}
347 if FileExists(lcReg.FormatConfigFileName) and FileIsReadOnly(lcReg.FormatConfigFileName) then
348 {$endif}
349 begin
350 { fail quietly? }
351 if lcReg.FormatFileWriteOption = eAlwaysWrite then
352 MessageDlg(Format(lisErrorWritingSettingsFileReadOnly, [lcReg.FormatConfigFileName]), mtError, [mbOK], 0);
353 exit;
354 end;
355
356 try
357 // use the Settings file name
358 {$ifdef FPC}
359 lcFile := TSettingsStreamOutput.Create(UTF8ToSys(GetRegSettings.FormatConfigFileName));
360 {$else}
361 lcFile := TSettingsStreamOutput.Create(GetRegSettings.FormatConfigFileName);
362 {$endif}
363 try
364 ToStream(lcFile);
365
366 // not dirty any more
367 fbDirty := False;
368 finally
369 lcFile.Free;
370 end;
371 except
372 on e: Exception do
373 begin
374 if lcReg.FormatFileWriteOption = eAlwaysWrite then
375 begin
376 MessageDlg(Format(lisErrorWritingSettingsException, [GetRegSettings.FormatConfigFileName, NativeLineBreak, E.Message]),
377 mtError, [mbOK], 0);
378 end;
379 end;
380 end;
381 end;
382
383
384 procedure TFormattingSettings.ToStream(const pcStream: TSettingsOutput);
385
386 procedure WriteToStream(const pcSet: TSetBase);
387 begin
388 Assert(pcSet <> nil);
389 pcStream.OpenSection(pcSet.Section);
390 pcSet.WriteToStream(pcStream);
391 pcStream.CloseSection(pcSet.Section);
392 end;
393
394 begin
395 Assert(pcStream <> nil);
396 pcStream.WriteXMLHeader;
397
398 pcStream.OpenSection(CODEFORMAT_SETTINGS_SECTION);
399
400 pcStream.Write(REG_VERSION, PROGRAM_VERSION);
401 pcStream.Write(REG_WRITE_DATETIME, Now);
402 pcStream.Write(REG_DESCRIPTION, Description);
403 pcStream.Write(REG_CONFIRM_FORMAT, fsConfirmFormat);
404
405 WriteToStream(fcObfuscate);
406 WriteToStream(fcClarify);
407 WriteToStream(fcIndent);
408 WriteToStream(fcSpaces);
409 WriteToStream(fcReturns);
410 WriteToStream(fcComments);
411
412 WriteToStream(fcCaps);
413 WriteToStream(fcSpecificWordCaps);
414 WriteToStream(fcIdentifierCaps);
415 WriteToStream(fcNotIdentifierCaps);
416 WriteToStream(fcUnitNameCaps);
417 WriteToStream(fcSetAsm);
418
419 WriteToStream(fcPreProcessor);
420 WriteToStream(fcAlign);
421 WriteToStream(fcReplace);
422 WriteToStream(fcUses);
423 WriteToStream(fcTransform);
424
425 pcStream.CloseSection(CODEFORMAT_SETTINGS_SECTION);
426 end;
427
428 procedure TFormattingSettings.FromStream(const pcStream: TSettingsInput);
429 var
430 lcAllSettings: TSettingsInput;
431
432 procedure ReadFromStream(const pcSet: TSetBase);
433 var
434 lcSection: TSettingsInput;
435 begin
436 Assert(pcSet <> nil);
437
438 lcSection := lcAllSettings.ExtractSection(pcSet.Section);
439 if lcSection <> nil then
440 begin
441 pcSet.ReadFromStream(lcSection);
442 lcSection.Free;
443 end
444 else
445 begin
446 lcSection := TSettingsInputDummy.Create;
447 try
448 pcSet.ReadFromStream(lcSection);
449 finally
450 lcSection.Free;
451 end;
452 //ShowMessage('Skipping section ' + pcSet.Section + ' as it was not found');
453 end;
454 end;
455
456 begin
457
458 { basic test - we are only interested in the
459 <JediCodeFormaTFormatSettings> ... </JediCodeFormaTFormatSettings> part of the file
460 If this start & end is not present, then is is the wrong file }
461 lcAllSettings := pcStream.ExtractSection(CODEFORMAT_SETTINGS_SECTION);
462 if lcAllSettings = nil then
463 begin
464 ShowMessage(lisNoSettingsFound);
465 exit;
466 end;
467
468 try
469 fsWriteVersion := pcStream.Read(REG_VERSION, '');
470 fsDescription := pcStream.Read(REG_DESCRIPTION, '');
471 fsConfirmFormat := pcStream.Read(REG_CONFIRM_FORMAT, True);
472 fdtWriteDateTime := pcStream.Read(REG_WRITE_DATETIME, 0.0);
473
474 ReadFromStream(fcObfuscate);
475 ReadFromStream(fcClarify);
476 ReadFromStream(fcIndent);
477 ReadFromStream(fcSpaces);
478 ReadFromStream(fcReturns);
479 ReadFromStream(fcComments);
480 ReadFromStream(fcCaps);
481 ReadFromStream(fcSpecificWordCaps);
482 ReadFromStream(fcIdentifierCaps);
483 ReadFromStream(fcNotIdentifierCaps);
484 ReadFromStream(fcUnitNameCaps);
485 ReadFromStream(fcSetAsm);
486
487 ReadFromStream(fcPreProcessor);
488
489 ReadFromStream(fcAlign);
490 ReadFromStream(fcReplace);
491 ReadFromStream(fcUses);
492 ReadFromStream(fcTransform);
493
494 fbHasRead := True;
495 finally
496 lcAllSettings.Free;
497 end;
498 end;
499
500
501 var
502 // a module var
503 mcFormattingSettings: TFormattingSettings = nil;
504
FormattingSettingsnull505 function FormattingSettings: TFormattingSettings;
506 begin
507 if mcFormattingSettings = nil then
508 mcFormattingSettings := TFormattingSettings.Create(true);
509
510 Result := mcFormattingSettings;
511 end;
512
FormatSettingsFromFilenull513 function FormatSettingsFromFile(const psFileName: string): TFormattingSettings;
514 begin
515 if mcFormattingSettings = nil then
516 mcFormattingSettings := TFormattingSettings.Create(false);
517
518 mcFormattingSettings.ReadFromFile(psFileName, true);
519 Result := mcFormattingSettings;
520 end;
521
522
523 procedure TFormattingSettings.MakeConsistent;
524 begin
525 { one consistency check so far
526 - if linebreaking is off, then "remove returns in expressions" must also be off }
527
528 if Returns.RebreakLines = rbOff then
529 Returns.RemoveExpressionReturns := False;
530 end;
531
532 initialization
533 JCFOptionsGroup := GetFreeIDEOptionsGroupIndex(GroupEditor);
534 RegisterIDEOptionsGroup(JCFOptionsGroup, TFormattingSettings);
535 finalization
536 FreeAndNil(mcFormattingSettings);
537 end.
538