PageRenderTime 69ms CodeModel.GetById 27ms app.highlight 36ms RepoModel.GetById 1ms app.codeStats 0ms

/ide/miscoptions.pas

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