/ide/miscoptions.pas
http://github.com/graemeg/lazarus · Pascal · 490 lines · 402 code · 55 blank · 33 comment · 26 complexity · 57b299d6a8233a1624482aa70b6357a0 MD5 · raw file
- {
- ***************************************************************************
- * *
- * This source is free software; you can redistribute it and/or modify *
- * it under the terms of the GNU General Public License as published by *
- * the Free Software Foundation; either version 2 of the License, or *
- * (at your option) any later version. *
- * *
- * This code is distributed in the hope that it will be useful, but *
- * WITHOUT ANY WARRANTY; without even the implied warranty of *
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
- * General Public License for more details. *
- * *
- * A copy of the GNU General Public License is available on the World *
- * Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
- * obtain it by writing to the Free Software Foundation, *
- * Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *
- * *
- ***************************************************************************
- Author: Mattias Gaertner
- Abstract:
- Miscellaneous options of the lazarus IDE.
- }
- unit MiscOptions;
- {$mode objfpc}{$H+}
- interface
- uses
- Classes, SysUtils, LCLProc, BuildProfileManager, CodeToolsStructs, TextTools,
- LazFileUtils, Laz2_XMLCfg, LazFileCache, LazConf, IDEProcs;
- type
- { TFindRenameIdentifierOptions }
- TFindRenameScope = (
- frCurrentUnit,
- frOwnerProjectPackage, // the project/package the current unit beongs to
- frProject,
- frAllOpenProjectsAndPackages
- );
- TFindRenameIdentifierOptions = class
- private
- FChangeStamp: integer;
- FExtraFiles: TStrings;
- FIdentifierFilename: string;
- FIdentifierPosition: TPoint;
- FRename: boolean;
- FRenameShowResult: boolean;
- FRenameTo: string;
- FScope: TFindRenameScope;
- FSearchInComments: boolean;
- fSavedStamp: integer;
- function GetModified: boolean;
- procedure SetExtraFiles(AValue: TStrings);
- procedure SetIdentifierFilename(AValue: string);
- procedure SetIdentifierPosition(AValue: TPoint);
- procedure SetModified(AValue: boolean);
- procedure SetRename(AValue: boolean);
- procedure SetRenameShowResult(AValue: boolean);
- procedure SetRenameTo(AValue: string);
- procedure SetScope(AValue: TFindRenameScope);
- procedure SetSearchInComments(AValue: boolean);
- public
- constructor Create;
- destructor Destroy; override;
- procedure LoadFromXMLConfig(XMLConfig: TXMLConfig; const Path: string);
- procedure SaveToXMLConfig(XMLConfig: TXMLConfig; const Path: string);
- property ChangeStamp: integer read FChangeStamp;
- procedure IncreaseChangeStamp; inline;
- property Modified: boolean read GetModified write SetModified;
- property IdentifierFilename: string read FIdentifierFilename write SetIdentifierFilename;
- property IdentifierPosition: TPoint read FIdentifierPosition write SetIdentifierPosition;
- property Rename: boolean read FRename write SetRename;
- property RenameTo: string read FRenameTo write SetRenameTo;
- property SearchInComments: boolean read FSearchInComments write SetSearchInComments;
- property RenameShowResult: boolean read FRenameShowResult write SetRenameShowResult;
- property Scope: TFindRenameScope read FScope write SetScope;
- property ExtraFiles: TStrings read FExtraFiles write SetExtraFiles;
- end;
-
-
- { TMiscellaneousOptions }
- TMiscellaneousOptions = class
- private
- fBuildLazProfiles: TBuildLazarusProfiles;
- FChangeStamp: integer;
- FExtractProcName: string;
- fFilename: string;
- FFindRenameIdentifierOptions: TFindRenameIdentifierOptions;
- FMakeResourceStringInsertPolicy: TResourcestringInsertPolicy;
- FShowCompOptFullFilenames: boolean;
- FSortSelDirection: TSortDirection;
- FSortSelDomain: TSortDomain;
- fSavedStamp: integer;
- function GetBuildLazOpts: TBuildLazarusProfile;
- function GetFilename: string;
- function GetModified: boolean;
- procedure SetExtractProcName(AValue: string);
- procedure SetMakeResourceStringInsertPolicy(
- AValue: TResourcestringInsertPolicy);
- procedure SetModified(AValue: boolean);
- procedure SetShowCompOptFullFilenames(AValue: boolean);
- procedure SetSortSelDirection(AValue: TSortDirection);
- public
- constructor Create;
- destructor Destroy; override;
- procedure Load;
- procedure Save;
- property Filename: string read GetFilename;
- property ChangeStamp: integer read FChangeStamp;
- procedure IncreaseChangeStamp; inline;
- property Modified: boolean read GetModified write SetModified;
- property BuildLazProfiles: TBuildLazarusProfiles read fBuildLazProfiles;
- property BuildLazOpts: TBuildLazarusProfile read GetBuildLazOpts;
- property ExtractProcName: string read FExtractProcName write SetExtractProcName;
- property SortSelDirection: TSortDirection read FSortSelDirection
- write SetSortSelDirection;
- property SortSelDomain: TSortDomain read FSortSelDomain write FSortSelDomain;
- property MakeResourceStringInsertPolicy: TResourcestringInsertPolicy
- read FMakeResourceStringInsertPolicy
- write SetMakeResourceStringInsertPolicy;
- property FindRenameIdentifierOptions: TFindRenameIdentifierOptions
- read FFindRenameIdentifierOptions;
- property ShowCompOptFullFilenames: boolean read FShowCompOptFullFilenames
- write SetShowCompOptFullFilenames;
- end;
- const
- SortDirectionNames: array[TSortDirection] of string = (
- 'Ascending', 'Descending');
- SortDomainNames: array[TSortDomain] of string = (
- 'Words', 'Lines', 'Paragraphs');
- ResourcestringInsertPolicyNames: array[TResourcestringInsertPolicy] of string
- = ('None', 'Append', 'Alphabetically', 'Context');
- FindRenameScopeNames: array[TFindRenameScope] of string = (
- 'CurrentUnit', 'Project', 'OwnerProjectPackage',
- 'AllOpenProjectsAndPackages'
- );
- var MiscellaneousOptions: TMiscellaneousOptions = nil;
- function SortDirectionNameToType(const s: string): TSortDirection;
- function SortDomainNameToType(const s: string): TSortDomain;
- function ResourcestringInsertPolicyNameToType(
- const s: string): TResourcestringInsertPolicy;
- function FindRenameScopeNameToScope(const s: string): TFindRenameScope;
- implementation
- const
- MiscOptsFilename = 'miscellaneousoptions.xml';
- MiscOptsVersion = 3;
- function SortDirectionNameToType(const s: string): TSortDirection;
- begin
- for Result:=Low(TSortDirection) to High(TSortDirection) do
- if CompareText(SortDirectionNames[Result],s)=0 then exit;
- Result:=sdAscending;
- end;
- function SortDomainNameToType(const s: string): TSortDomain;
- begin
- for Result:=Low(TSortDomain) to High(TSortDomain) do
- if CompareText(SortDomainNames[Result],s)=0 then exit;
- Result:=sdLines;
- end;
- function ResourcestringInsertPolicyNameToType(
- const s: string): TResourcestringInsertPolicy;
- begin
- for Result:=Low(TResourcestringInsertPolicy)
- to High(TResourcestringInsertPolicy) do
- if CompareText(ResourcestringInsertPolicyNames[Result],s)=0 then exit;
- Result:=rsipAppend;
- end;
- function FindRenameScopeNameToScope(const s: string): TFindRenameScope;
- begin
- for Result:=Low(TFindRenameScope) to High(TFindRenameScope) do
- if CompareText(FindRenameScopeNames[Result],s)=0 then exit;
- Result:=frAllOpenProjectsAndPackages;
- end;
- { TMiscellaneousOptions }
- // inline
- procedure TMiscellaneousOptions.IncreaseChangeStamp;
- begin
- LUIncreaseChangeStamp(fChangeStamp);
- end;
- constructor TMiscellaneousOptions.Create;
- begin
- inherited Create;
- fSavedStamp:=LUInvalidChangeStamp;
- fBuildLazProfiles:=TBuildLazarusProfiles.Create;
- FExtractProcName:='NewProc';
- fSortSelDirection:=sdAscending;
- fSortSelDomain:=sdLines;
- fMakeResourceStringInsertPolicy:=rsipAppend;
- FFindRenameIdentifierOptions:=TFindRenameIdentifierOptions.Create;
- end;
- destructor TMiscellaneousOptions.Destroy;
- begin
- fBuildLazProfiles.Free;
- FFindRenameIdentifierOptions.Free;
- inherited Destroy;
- end;
- function TMiscellaneousOptions.GetFilename: string;
- var
- ConfFileName: string;
- begin
- if fFilename='' then begin
- ConfFileName:=AppendPathDelim(GetPrimaryConfigPath)+MiscOptsFilename;
- CopySecondaryConfigFile(MiscOptsFilename);
- if (not FileExistsUTF8(ConfFileName)) then begin
- //DebugLn('Note: miscellaneous options file not found - using defaults');
- end;
- FFilename:=ConfFilename;
- end;
- Result:=fFilename;
- end;
- function TMiscellaneousOptions.GetModified: boolean;
- begin
- Result:=(ChangeStamp<>fSavedStamp) or FindRenameIdentifierOptions.Modified;
- end;
- procedure TMiscellaneousOptions.SetExtractProcName(AValue: string);
- begin
- if FExtractProcName=AValue then Exit;
- FExtractProcName:=AValue;
- IncreaseChangeStamp;
- end;
- procedure TMiscellaneousOptions.SetMakeResourceStringInsertPolicy(
- AValue: TResourcestringInsertPolicy);
- begin
- if FMakeResourceStringInsertPolicy=AValue then Exit;
- FMakeResourceStringInsertPolicy:=AValue;
- IncreaseChangeStamp;
- end;
- procedure TMiscellaneousOptions.SetModified(AValue: boolean);
- begin
- if AValue then
- IncreaseChangeStamp
- else begin
- fSavedStamp:=ChangeStamp;
- FindRenameIdentifierOptions.Modified:=false;
- end;
- end;
- procedure TMiscellaneousOptions.SetShowCompOptFullFilenames(AValue: boolean);
- begin
- if FShowCompOptFullFilenames=AValue then Exit;
- FShowCompOptFullFilenames:=AValue;
- IncreaseChangeStamp;
- end;
- procedure TMiscellaneousOptions.SetSortSelDirection(AValue: TSortDirection);
- begin
- if FSortSelDirection=AValue then Exit;
- FSortSelDirection:=AValue;
- IncreaseChangeStamp;
- end;
- function TMiscellaneousOptions.GetBuildLazOpts: TBuildLazarusProfile;
- begin
- Result:=BuildLazProfiles.Current;
- end;
- procedure TMiscellaneousOptions.Load;
- var XMLConfig: TXMLConfig;
- FileVersion: integer;
- Path: String;
- begin
- try
- XMLConfig:=TXMLConfig.Create(GetFilename);
- except
- DebugLn('ERROR: unable to open miscellaneous options "',GetFilename,'"');
- exit;
- end;
- try
- try
- Path:='MiscellaneousOptions/';
- FileVersion:=XMLConfig.GetValue(Path+'Version/Value',0);
- BuildLazProfiles.Load(XMLConfig,Path+'BuildLazarusOptions/',FileVersion);
- SortSelDirection:=SortDirectionNameToType(XMLConfig.GetValue(
- Path+'SortSelection/Direction',SortDirectionNames[sdAscending]));
- SortSelDomain:=SortDomainNameToType(XMLConfig.GetValue(
- Path+'SortSelection/Domain',SortDomainNames[sdLines]));
- MakeResourceStringInsertPolicy:=ResourcestringInsertPolicyNameToType(
- XMLConfig.GetValue(Path+'MakeResourcestringInsertPolicy/Value',
- ResourcestringInsertPolicyNames[rsipAppend]));
- ExtractProcName:=XMLConfig.GetValue(Path+'ExtractProcName/Value','NewProc');
- FindRenameIdentifierOptions.LoadFromXMLConfig(XMLConfig,
- Path+'FindRenameIdentifier/');
- ShowCompOptFullFilenames:=XMLConfig.GetValue(Path+'ShowCompOpts/Filenames/Full',false);
- finally
- XMLConfig.Free;
- end;
- except
- on E: Exception do begin
- DebugLn('ERROR: unable read miscellaneous options from "',GetFilename,'": ',E.Message);
- end;
- end;
- Modified:=false;
- end;
- procedure TMiscellaneousOptions.Save;
- var XMLConfig: TXMLConfig;
- Path: String;
- XMLFilename: String;
- begin
- if not Modified then exit;
- XMLFilename:=GetFilename;
- try
- XMLConfig:=TXMLConfig.CreateClean(XMLFilename);
- except
- on E: Exception do begin
- DebugLn('ERROR: unable to open miscellaneous options "',XMLFilename,'":',E.Message);
- exit;
- end;
- end;
- try
- try
- Path:='MiscellaneousOptions/';
- XMLConfig.SetValue(Path+'Version/Value',MiscOptsVersion);
- BuildLazProfiles.Save(XMLConfig,Path+'BuildLazarusOptions/');
- XMLConfig.SetDeleteValue(Path+'SortSelection/Direction',
- SortDirectionNames[SortSelDirection],
- SortDirectionNames[sdAscending]);
- XMLConfig.SetDeleteValue(Path+'SortSelection/Domain',
- SortDomainNames[SortSelDomain],SortDomainNames[sdLines]);
- XMLConfig.SetDeleteValue(Path+'MakeResourcestringInsertPolicy/Value',
- ResourcestringInsertPolicyNames[MakeResourceStringInsertPolicy],
- ResourcestringInsertPolicyNames[rsipAppend]);
- XMLConfig.SetDeleteValue(Path+'ExtractProcName/Value',ExtractProcName,
- 'NewProc');
- FindRenameIdentifierOptions.SaveToXMLConfig(XMLConfig,
- Path+'FindRenameIdentifier/');
- XMLConfig.SetDeleteValue(Path+'ShowCompOpts/Filenames/Full',ShowCompOptFullFilenames,false);
- XMLConfig.Flush;
- finally
- XMLConfig.Free;
- end;
- except
- on E: Exception do begin
- DebugLn('ERROR: unable read miscellaneous options from "',XMLFilename,'": ',E.Message);
- end;
- end;
- Modified:=false;
- end;
- { TFindRenameIdentifierOptions }
- // inline
- procedure TFindRenameIdentifierOptions.IncreaseChangeStamp;
- begin
- LUIncreaseChangeStamp(fChangeStamp);
- end;
- procedure TFindRenameIdentifierOptions.SetExtraFiles(AValue: TStrings);
- begin
- if (FExtraFiles=AValue) or FExtraFiles.Equals(AValue) then Exit;
- FExtraFiles.Assign(AValue);
- IncreaseChangeStamp;
- end;
- function TFindRenameIdentifierOptions.GetModified: boolean;
- begin
- Result:=fSavedStamp=ChangeStamp;
- end;
- procedure TFindRenameIdentifierOptions.SetIdentifierFilename(AValue: string);
- begin
- if FIdentifierFilename=AValue then Exit;
- FIdentifierFilename:=AValue;
- IncreaseChangeStamp;
- end;
- procedure TFindRenameIdentifierOptions.SetIdentifierPosition(AValue: TPoint);
- begin
- if ComparePoints(FIdentifierPosition,AValue)=0 then Exit;
- FIdentifierPosition:=AValue;
- IncreaseChangeStamp;
- end;
- procedure TFindRenameIdentifierOptions.SetModified(AValue: boolean);
- begin
- if AValue then
- IncreaseChangeStamp
- else
- fSavedStamp:=ChangeStamp;
- end;
- procedure TFindRenameIdentifierOptions.SetRename(AValue: boolean);
- begin
- if FRename=AValue then Exit;
- FRename:=AValue;
- IncreaseChangeStamp;
- end;
- procedure TFindRenameIdentifierOptions.SetRenameShowResult(AValue: boolean);
- begin
- if FRenameShowResult=AValue then Exit;
- FRenameShowResult:=AValue;
- IncreaseChangeStamp;
- end;
- procedure TFindRenameIdentifierOptions.SetRenameTo(AValue: string);
- begin
- if FRenameTo=AValue then Exit;
- FRenameTo:=AValue;
- IncreaseChangeStamp;
- end;
- procedure TFindRenameIdentifierOptions.SetScope(AValue: TFindRenameScope);
- begin
- if FScope=AValue then Exit;
- FScope:=AValue;
- IncreaseChangeStamp;
- end;
- procedure TFindRenameIdentifierOptions.SetSearchInComments(AValue: boolean);
- begin
- if FSearchInComments=AValue then Exit;
- FSearchInComments:=AValue;
- IncreaseChangeStamp;
- end;
- constructor TFindRenameIdentifierOptions.Create;
- begin
- inherited;
- fSavedStamp:=LUInvalidChangeStamp;
- fExtraFiles:=TStringList.Create;
- end;
- destructor TFindRenameIdentifierOptions.Destroy;
- begin
- FreeAndNil(FExtraFiles);
- inherited Destroy;
- end;
- procedure TFindRenameIdentifierOptions.LoadFromXMLConfig(XMLConfig: TXMLConfig;
- const Path: string);
- begin
- fIdentifierFilename:=XMLConfig.GetValue(Path+'Identifier/Filename','');
- LoadPoint(XMLConfig,Path+'Identifier/',fIdentifierPosition,Point(0,0));
- fRename:=XMLConfig.GetValue(Path+'Rename/Value',false);
- fRenameTo:=XMLConfig.GetValue(Path+'Rename/Identifier','');
- fSearchInComments:=XMLConfig.GetValue(Path+'SearchInComments/Value',true);
- fRenameShowResult:=XMLConfig.GetValue(Path+'RenameShowResult/Value',false);
- fScope:=FindRenameScopeNameToScope(XMLConfig.GetValue(Path+'Scope/Value',
- FindRenameScopeNames[frAllOpenProjectsAndPackages]));
- LoadStringList(XMLConfig,fExtraFiles,Path+'ExtraFiles/');
- Modified:=false;
- end;
- procedure TFindRenameIdentifierOptions.SaveToXMLConfig(XMLConfig: TXMLConfig;
- const Path: string);
- begin
- XMLConfig.SetDeleteValue(Path+'Identifier/Filename',IdentifierFilename,'');
- SavePoint(XMLConfig,Path+'Identifier/',IdentifierPosition,Point(0,0));
- XMLConfig.SetDeleteValue(Path+'Rename/Value',Rename,false);
- XMLConfig.SetDeleteValue(Path+'Rename/Identifier',RenameTo,'');
- XMLConfig.SetDeleteValue(Path+'SearchInComments/Value',SearchInComments,true);
- XMLConfig.SetDeleteValue(Path+'RenameShowResult/Value',RenameShowResult,false);
- XMLConfig.SetDeleteValue(Path+'Scope/Value',FindRenameScopeNames[Scope],
- FindRenameScopeNames[frAllOpenProjectsAndPackages]);
- SaveStringList(XMLConfig,ExtraFiles,Path+'ExtraFiles/');
- Modified:=false;
- end;
- end.