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