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 Miscellaneous options of the lazarus IDE.
25 }
26 unit MiscOptions;
27
28 {$mode objfpc}{$H+}
29
30 interface
31
32 uses
33 Classes, SysUtils, LCLProc, BuildProfileManager, CodeToolsStructs, TextTools,
34 LazFileUtils, Laz2_XMLCfg, LazFileCache, LazConf, IDEProcs;
35
36 type
37 { TFindRenameIdentifierOptions }
38
39 TFindRenameScope = (
40 frCurrentUnit,
41 frOwnerProjectPackage, // the project/package the current unit beongs to
42 frProject,
43 frAllOpenProjectsAndPackages
44 );
45
46 TFindRenameIdentifierOptions = class
47 private
48 FChangeStamp: integer;
49 FExtraFiles: TStrings;
50 FIdentifierFilename: string;
51 FIdentifierPosition: TPoint;
52 FRename: boolean;
53 FRenameShowResult: boolean;
54 FRenameTo: string;
55 FScope: TFindRenameScope;
56 FSearchInComments: boolean;
57 fSavedStamp: integer;
GetModifiednull58 function GetModified: boolean;
59 procedure SetExtraFiles(AValue: TStrings);
60 procedure SetIdentifierFilename(AValue: string);
61 procedure SetIdentifierPosition(AValue: TPoint);
62 procedure SetModified(AValue: boolean);
63 procedure SetRename(AValue: boolean);
64 procedure SetRenameShowResult(AValue: boolean);
65 procedure SetRenameTo(AValue: string);
66 procedure SetScope(AValue: TFindRenameScope);
67 procedure SetSearchInComments(AValue: boolean);
68 public
69 constructor Create;
70 destructor Destroy; override;
71 procedure LoadFromXMLConfig(XMLConfig: TXMLConfig; const Path: string);
72 procedure SaveToXMLConfig(XMLConfig: TXMLConfig; const Path: string);
73 property ChangeStamp: integer read FChangeStamp;
74 procedure IncreaseChangeStamp; inline;
75 property Modified: boolean read GetModified write SetModified;
76 property IdentifierFilename: string read FIdentifierFilename write SetIdentifierFilename;
77 property IdentifierPosition: TPoint read FIdentifierPosition write SetIdentifierPosition;
78 property Rename: boolean read FRename write SetRename;
79 property RenameTo: string read FRenameTo write SetRenameTo;
80 property SearchInComments: boolean read FSearchInComments write SetSearchInComments;
81 property RenameShowResult: boolean read FRenameShowResult write SetRenameShowResult;
82 property Scope: TFindRenameScope read FScope write SetScope;
83 property ExtraFiles: TStrings read FExtraFiles write SetExtraFiles;
84 end;
85
86
87 { TMiscellaneousOptions }
88
89 TMiscellaneousOptions = class
90 private
91 fBuildLazProfiles: TBuildLazarusProfiles;
92 FChangeStamp: integer;
93 FExtractProcName: string;
94 fFilename: string;
95 FFindRenameIdentifierOptions: TFindRenameIdentifierOptions;
96 FMakeResourceStringInsertPolicy: TResourcestringInsertPolicy;
97 FShowCompOptFullFilenames: boolean;
98 FShowCompOptMultiLine: boolean;
99 FSortSelDirection: TSortDirection;
100 FSortSelDomain: TSortDomain;
101 fSavedStamp: integer;
GetBuildLazOptsnull102 function GetBuildLazOpts: TBuildLazarusProfile;
GetFilenamenull103 function GetFilename: string;
GetModifiednull104 function GetModified: boolean;
105 procedure SetExtractProcName(AValue: string);
106 procedure SetMakeResourceStringInsertPolicy(
107 AValue: TResourcestringInsertPolicy);
108 procedure SetModified(AValue: boolean);
109 procedure SetShowCompOptFullFilenames(AValue: boolean);
110 procedure SetShowCompOptMultiLine(const AValue: boolean);
111 procedure SetSortSelDirection(AValue: TSortDirection);
112 public
113 constructor Create;
114 destructor Destroy; override;
115 procedure Load;
116 procedure Save;
117 property Filename: string read GetFilename;
118 property ChangeStamp: integer read FChangeStamp;
119 procedure IncreaseChangeStamp; inline;
120 property Modified: boolean read GetModified write SetModified;
121
122 property BuildLazProfiles: TBuildLazarusProfiles read fBuildLazProfiles;
123 property BuildLazOpts: TBuildLazarusProfile read GetBuildLazOpts;
124 property ExtractProcName: string read FExtractProcName write SetExtractProcName;
125 property SortSelDirection: TSortDirection read FSortSelDirection
126 write SetSortSelDirection;
127 property SortSelDomain: TSortDomain read FSortSelDomain write FSortSelDomain;
128 property MakeResourceStringInsertPolicy: TResourcestringInsertPolicy
129 read FMakeResourceStringInsertPolicy
130 write SetMakeResourceStringInsertPolicy;
131 property FindRenameIdentifierOptions: TFindRenameIdentifierOptions
132 read FFindRenameIdentifierOptions;
133 property ShowCompOptFullFilenames: boolean read FShowCompOptFullFilenames
134 write SetShowCompOptFullFilenames;
135 property ShowCompOptMultiLine: boolean read FShowCompOptMultiLine
136 write SetShowCompOptMultiLine;
137 end;
138
139 const
140 SortDirectionNames: array[TSortDirection] of string = (
141 'Ascending', 'Descending');
142 SortDomainNames: array[TSortDomain] of string = (
143 'Words', 'Lines', 'Paragraphs');
144 ResourcestringInsertPolicyNames: array[TResourcestringInsertPolicy] of string
145 = ('None', 'Append', 'Alphabetically', 'Context');
146 FindRenameScopeNames: array[TFindRenameScope] of string = (
147 'CurrentUnit', 'Project', 'OwnerProjectPackage',
148 'AllOpenProjectsAndPackages'
149 );
150
151 var MiscellaneousOptions: TMiscellaneousOptions = nil;
152
SortDirectionNameToTypenull153 function SortDirectionNameToType(const s: string): TSortDirection;
SortDomainNameToTypenull154 function SortDomainNameToType(const s: string): TSortDomain;
ResourcestringInsertPolicyNameToTypenull155 function ResourcestringInsertPolicyNameToType(
156 const s: string): TResourcestringInsertPolicy;
FindRenameScopeNameToScopenull157 function FindRenameScopeNameToScope(const s: string): TFindRenameScope;
158
159
160 implementation
161
162
163 const
164 MiscOptsFilename = 'miscellaneousoptions.xml';
165 MiscOptsVersion = 3;
166
SortDirectionNameToTypenull167 function SortDirectionNameToType(const s: string): TSortDirection;
168 begin
169 for Result:=Low(TSortDirection) to High(TSortDirection) do
170 if CompareText(SortDirectionNames[Result],s)=0 then exit;
171 Result:=sdAscending;
172 end;
173
SortDomainNameToTypenull174 function SortDomainNameToType(const s: string): TSortDomain;
175 begin
176 for Result:=Low(TSortDomain) to High(TSortDomain) do
177 if CompareText(SortDomainNames[Result],s)=0 then exit;
178 Result:=sdLines;
179 end;
180
ResourcestringInsertPolicyNameToTypenull181 function ResourcestringInsertPolicyNameToType(
182 const s: string): TResourcestringInsertPolicy;
183 begin
184 for Result:=Low(TResourcestringInsertPolicy)
185 to High(TResourcestringInsertPolicy) do
186 if CompareText(ResourcestringInsertPolicyNames[Result],s)=0 then exit;
187 Result:=rsipAppend;
188 end;
189
FindRenameScopeNameToScopenull190 function FindRenameScopeNameToScope(const s: string): TFindRenameScope;
191 begin
192 for Result:=Low(TFindRenameScope) to High(TFindRenameScope) do
193 if CompareText(FindRenameScopeNames[Result],s)=0 then exit;
194 Result:=frAllOpenProjectsAndPackages;
195 end;
196
197 { TMiscellaneousOptions }
198
199 // inline
200 procedure TMiscellaneousOptions.IncreaseChangeStamp;
201 begin
202 LUIncreaseChangeStamp(fChangeStamp);
203 end;
204
205 constructor TMiscellaneousOptions.Create;
206 begin
207 inherited Create;
208 fSavedStamp:=LUInvalidChangeStamp;
209 fBuildLazProfiles:=TBuildLazarusProfiles.Create;
210 FExtractProcName:='NewProc';
211 fSortSelDirection:=sdAscending;
212 fSortSelDomain:=sdLines;
213 fMakeResourceStringInsertPolicy:=rsipAppend;
214 FFindRenameIdentifierOptions:=TFindRenameIdentifierOptions.Create;
215 end;
216
217 destructor TMiscellaneousOptions.Destroy;
218 begin
219 fBuildLazProfiles.Free;
220 FFindRenameIdentifierOptions.Free;
221 inherited Destroy;
222 end;
223
GetFilenamenull224 function TMiscellaneousOptions.GetFilename: string;
225 var
226 ConfFileName: string;
227 begin
228 if fFilename='' then begin
229 ConfFileName:=AppendPathDelim(GetPrimaryConfigPath)+MiscOptsFilename;
230 CopySecondaryConfigFile(MiscOptsFilename);
231 if (not FileExistsUTF8(ConfFileName)) then begin
232 //DebugLn('Note: miscellaneous options file not found - using defaults');
233 end;
234 FFilename:=ConfFilename;
235 end;
236 Result:=fFilename;
237 end;
238
TMiscellaneousOptions.GetModifiednull239 function TMiscellaneousOptions.GetModified: boolean;
240 begin
241 Result:=(ChangeStamp<>fSavedStamp) or FindRenameIdentifierOptions.Modified;
242 end;
243
244 procedure TMiscellaneousOptions.SetExtractProcName(AValue: string);
245 begin
246 if FExtractProcName=AValue then Exit;
247 FExtractProcName:=AValue;
248 IncreaseChangeStamp;
249 end;
250
251 procedure TMiscellaneousOptions.SetMakeResourceStringInsertPolicy(
252 AValue: TResourcestringInsertPolicy);
253 begin
254 if FMakeResourceStringInsertPolicy=AValue then Exit;
255 FMakeResourceStringInsertPolicy:=AValue;
256 IncreaseChangeStamp;
257 end;
258
259 procedure TMiscellaneousOptions.SetModified(AValue: boolean);
260 begin
261 if AValue then
262 IncreaseChangeStamp
263 else begin
264 fSavedStamp:=ChangeStamp;
265 FindRenameIdentifierOptions.Modified:=false;
266 end;
267 end;
268
269 procedure TMiscellaneousOptions.SetShowCompOptFullFilenames(AValue: boolean);
270 begin
271 if FShowCompOptFullFilenames=AValue then Exit;
272 FShowCompOptFullFilenames:=AValue;
273 IncreaseChangeStamp;
274 end;
275
276 procedure TMiscellaneousOptions.SetShowCompOptMultiLine(const AValue: boolean);
277 begin
278 if FShowCompOptMultiLine=AValue then Exit;
279 FShowCompOptMultiLine:=AValue;
280 IncreaseChangeStamp;
281 end;
282
283 procedure TMiscellaneousOptions.SetSortSelDirection(AValue: TSortDirection);
284 begin
285 if FSortSelDirection=AValue then Exit;
286 FSortSelDirection:=AValue;
287 IncreaseChangeStamp;
288 end;
289
GetBuildLazOptsnull290 function TMiscellaneousOptions.GetBuildLazOpts: TBuildLazarusProfile;
291 begin
292 Result:=BuildLazProfiles.Current;
293 end;
294
295 procedure TMiscellaneousOptions.Load;
296 var XMLConfig: TXMLConfig;
297 FileVersion: integer;
298 Path: String;
299 begin
300 try
301 XMLConfig:=TXMLConfig.Create(GetFilename);
302 except
303 DebugLn('ERROR: unable to open miscellaneous options "',GetFilename,'"');
304 exit;
305 end;
306 try
307 try
308 Path:='MiscellaneousOptions/';
309 FileVersion:=XMLConfig.GetValue(Path+'Version/Value',0);
310 BuildLazProfiles.Load(XMLConfig,Path+'BuildLazarusOptions/',FileVersion);
311 SortSelDirection:=SortDirectionNameToType(XMLConfig.GetValue(
312 Path+'SortSelection/Direction',SortDirectionNames[sdAscending]));
313 SortSelDomain:=SortDomainNameToType(XMLConfig.GetValue(
314 Path+'SortSelection/Domain',SortDomainNames[sdLines]));
315 MakeResourceStringInsertPolicy:=ResourcestringInsertPolicyNameToType(
316 XMLConfig.GetValue(Path+'MakeResourcestringInsertPolicy/Value',
317 ResourcestringInsertPolicyNames[rsipAppend]));
318 ExtractProcName:=XMLConfig.GetValue(Path+'ExtractProcName/Value','NewProc');
319 FindRenameIdentifierOptions.LoadFromXMLConfig(XMLConfig,
320 Path+'FindRenameIdentifier/');
321 ShowCompOptFullFilenames:=XMLConfig.GetValue(Path+'ShowCompOpts/Filenames/Full',false);
322 ShowCompOptMultiLine:=XMLConfig.GetValue(Path+'ShowCompOpts/MultiLine',true);
323 finally
324 XMLConfig.Free;
325 end;
326 except
327 on E: Exception do begin
328 DebugLn('ERROR: unable read miscellaneous options from "',GetFilename,'": ',E.Message);
329 end;
330 end;
331 Modified:=false;
332 end;
333
334 procedure TMiscellaneousOptions.Save;
335 var XMLConfig: TXMLConfig;
336 Path: String;
337 XMLFilename: String;
338 begin
339 if not Modified then exit;
340 XMLFilename:=GetFilename;
341 try
342 XMLConfig:=TXMLConfig.CreateClean(XMLFilename);
343 except
344 on E: Exception do begin
345 DebugLn('ERROR: unable to open miscellaneous options "',XMLFilename,'":',E.Message);
346 exit;
347 end;
348 end;
349 try
350 try
351 Path:='MiscellaneousOptions/';
352 XMLConfig.SetValue(Path+'Version/Value',MiscOptsVersion);
353
354 BuildLazProfiles.Save(XMLConfig,Path+'BuildLazarusOptions/');
355 XMLConfig.SetDeleteValue(Path+'SortSelection/Direction',
356 SortDirectionNames[SortSelDirection],
357 SortDirectionNames[sdAscending]);
358 XMLConfig.SetDeleteValue(Path+'SortSelection/Domain',
359 SortDomainNames[SortSelDomain],SortDomainNames[sdLines]);
360 XMLConfig.SetDeleteValue(Path+'MakeResourcestringInsertPolicy/Value',
361 ResourcestringInsertPolicyNames[MakeResourceStringInsertPolicy],
362 ResourcestringInsertPolicyNames[rsipAppend]);
363 XMLConfig.SetDeleteValue(Path+'ExtractProcName/Value',ExtractProcName,
364 'NewProc');
365 FindRenameIdentifierOptions.SaveToXMLConfig(XMLConfig,
366 Path+'FindRenameIdentifier/');
367 XMLConfig.SetDeleteValue(Path+'ShowCompOpts/MultLine',ShowCompOptMultiLine,true);
368 XMLConfig.Flush;
369 finally
370 XMLConfig.Free;
371 end;
372 except
373 on E: Exception do begin
374 DebugLn('ERROR: unable read miscellaneous options from "',XMLFilename,'": ',E.Message);
375 end;
376 end;
377 Modified:=false;
378 end;
379
380 { TFindRenameIdentifierOptions }
381
382 // inline
383 procedure TFindRenameIdentifierOptions.IncreaseChangeStamp;
384 begin
385 LUIncreaseChangeStamp(fChangeStamp);
386 end;
387
388 procedure TFindRenameIdentifierOptions.SetExtraFiles(AValue: TStrings);
389 begin
390 if (FExtraFiles=AValue) or FExtraFiles.Equals(AValue) then Exit;
391 FExtraFiles.Assign(AValue);
392 IncreaseChangeStamp;
393 end;
394
TFindRenameIdentifierOptions.GetModifiednull395 function TFindRenameIdentifierOptions.GetModified: boolean;
396 begin
397 Result:=fSavedStamp=ChangeStamp;
398 end;
399
400 procedure TFindRenameIdentifierOptions.SetIdentifierFilename(AValue: string);
401 begin
402 if FIdentifierFilename=AValue then Exit;
403 FIdentifierFilename:=AValue;
404 IncreaseChangeStamp;
405 end;
406
407 procedure TFindRenameIdentifierOptions.SetIdentifierPosition(AValue: TPoint);
408 begin
409 if ComparePoints(FIdentifierPosition,AValue)=0 then Exit;
410 FIdentifierPosition:=AValue;
411 IncreaseChangeStamp;
412 end;
413
414 procedure TFindRenameIdentifierOptions.SetModified(AValue: boolean);
415 begin
416 if AValue then
417 IncreaseChangeStamp
418 else
419 fSavedStamp:=ChangeStamp;
420 end;
421
422 procedure TFindRenameIdentifierOptions.SetRename(AValue: boolean);
423 begin
424 if FRename=AValue then Exit;
425 FRename:=AValue;
426 IncreaseChangeStamp;
427 end;
428
429 procedure TFindRenameIdentifierOptions.SetRenameShowResult(AValue: boolean);
430 begin
431 if FRenameShowResult=AValue then Exit;
432 FRenameShowResult:=AValue;
433 IncreaseChangeStamp;
434 end;
435
436 procedure TFindRenameIdentifierOptions.SetRenameTo(AValue: string);
437 begin
438 if FRenameTo=AValue then Exit;
439 FRenameTo:=AValue;
440 IncreaseChangeStamp;
441 end;
442
443 procedure TFindRenameIdentifierOptions.SetScope(AValue: TFindRenameScope);
444 begin
445 if FScope=AValue then Exit;
446 FScope:=AValue;
447 IncreaseChangeStamp;
448 end;
449
450 procedure TFindRenameIdentifierOptions.SetSearchInComments(AValue: boolean);
451 begin
452 if FSearchInComments=AValue then Exit;
453 FSearchInComments:=AValue;
454 IncreaseChangeStamp;
455 end;
456
457 constructor TFindRenameIdentifierOptions.Create;
458 begin
459 inherited;
460 fSavedStamp:=LUInvalidChangeStamp;
461 fExtraFiles:=TStringList.Create;
462 end;
463
464 destructor TFindRenameIdentifierOptions.Destroy;
465 begin
466 FreeAndNil(FExtraFiles);
467 inherited Destroy;
468 end;
469
470 procedure TFindRenameIdentifierOptions.LoadFromXMLConfig(XMLConfig: TXMLConfig;
471 const Path: string);
472 begin
473 fIdentifierFilename:=XMLConfig.GetValue(Path+'Identifier/Filename','');
474 LoadPoint(XMLConfig,Path+'Identifier/',fIdentifierPosition,Point(0,0));
475 fRename:=XMLConfig.GetValue(Path+'Rename/Value',false);
476 fRenameTo:=XMLConfig.GetValue(Path+'Rename/Identifier','');
477 fSearchInComments:=XMLConfig.GetValue(Path+'SearchInComments/Value',true);
478 fRenameShowResult:=XMLConfig.GetValue(Path+'RenameShowResult/Value',false);
479 fScope:=FindRenameScopeNameToScope(XMLConfig.GetValue(Path+'Scope/Value',
480 FindRenameScopeNames[frAllOpenProjectsAndPackages]));
481 LoadStringList(XMLConfig,fExtraFiles,Path+'ExtraFiles/');
482 Modified:=false;
483 end;
484
485 procedure TFindRenameIdentifierOptions.SaveToXMLConfig(XMLConfig: TXMLConfig;
486 const Path: string);
487 begin
488 XMLConfig.SetDeleteValue(Path+'Identifier/Filename',IdentifierFilename,'');
489 SavePoint(XMLConfig,Path+'Identifier/',IdentifierPosition,Point(0,0));
490 XMLConfig.SetDeleteValue(Path+'Rename/Value',Rename,false);
491 XMLConfig.SetDeleteValue(Path+'Rename/Identifier',RenameTo,'');
492 XMLConfig.SetDeleteValue(Path+'SearchInComments/Value',SearchInComments,true);
493 XMLConfig.SetDeleteValue(Path+'RenameShowResult/Value',RenameShowResult,false);
494 XMLConfig.SetDeleteValue(Path+'Scope/Value',FindRenameScopeNames[Scope],
495 FindRenameScopeNames[frAllOpenProjectsAndPackages]);
496 SaveStringList(XMLConfig,ExtraFiles,Path+'ExtraFiles/');
497 Modified:=false;
498 end;
499
500 end.
501
502
503