/ide/helpoptions.pas

http://github.com/graemeg/lazarus · Pascal · 248 lines · 184 code · 31 blank · 33 comment · 10 complexity · 5ca7a41203d0fbf2bc15e7c184a3e435 MD5 · raw file

  1. { /***************************************************************************
  2. helpoptions.pas - Lazarus IDE unit
  3. ------------------------------------
  4. ***************************************************************************/
  5. ***************************************************************************
  6. * *
  7. * This source is free software; you can redistribute it and/or modify *
  8. * it under the terms of the GNU General Public License as published by *
  9. * the Free Software Foundation; either version 2 of the License, or *
  10. * (at your option) any later version. *
  11. * *
  12. * This code is distributed in the hope that it will be useful, but *
  13. * WITHOUT ANY WARRANTY; without even the implied warranty of *
  14. * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
  15. * General Public License for more details. *
  16. * *
  17. * A copy of the GNU General Public License is available on the World *
  18. * Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
  19. * obtain it by writing to the Free Software Foundation, *
  20. * Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *
  21. * *
  22. ***************************************************************************
  23. Author: Mattias Gaertner
  24. Abstract:
  25. - THelpOptions
  26. }
  27. unit HelpOptions;
  28. {$mode objfpc}{$H+}
  29. interface
  30. uses
  31. Classes, SysUtils, LCLProc, LazFileUtils, Laz2_XMLCfg, LazFileCache,
  32. LazHelpIntf, IDEOptionsIntf, MacroIntf, LazConf,
  33. LazarusIDEStrConsts, IDEOptionDefs;
  34. type
  35. { THelpOptions }
  36. THelpOptions = class(TAbstractIDEHelpOptions)
  37. private
  38. FFilename: string;
  39. FFPCDocsHTMLDirectory: string;
  40. procedure SetFPCDocsHTMLDirectory(const AValue: string);
  41. procedure SetFilename(const AValue: string);
  42. public
  43. class function GetGroupCaption:string; override;
  44. class function GetInstance: TAbstractIDEOptions; override;
  45. procedure DoAfterWrite(Restore: boolean); override;
  46. public
  47. constructor Create;
  48. procedure Clear;
  49. procedure Load;
  50. procedure Save;
  51. procedure SetDefaultFilename;
  52. procedure Assign(Source: TPersistent); override;
  53. function IsEqual(HelpOpts: THelpOptions): boolean;
  54. function CreateCopy: THelpOptions;
  55. public
  56. property Filename: string read FFilename write SetFilename;
  57. function GetEffectiveFPCDocsHTMLDirectory: string;
  58. published
  59. property FPCDocsHTMLDirectory: string read FFPCDocsHTMLDirectory
  60. write SetFPCDocsHTMLDirectory;
  61. end;
  62. var
  63. HelpOpts: THelpOptions; // set by the IDE
  64. const
  65. HelpOptionsVersion = 1;
  66. DefaultHelpOptsFile = 'helpoptions.xml';
  67. implementation
  68. { THelpOptions }
  69. procedure THelpOptions.SetFilename(const AValue: string);
  70. begin
  71. if FFilename = AValue then Exit;
  72. FFilename := AValue;
  73. end;
  74. procedure THelpOptions.SetFPCDocsHTMLDirectory(const AValue: string);
  75. begin
  76. if FFPCDocsHTMLDirectory = AValue then Exit;
  77. FFPCDocsHTMLDirectory := AValue;
  78. end;
  79. constructor THelpOptions.Create;
  80. begin
  81. Clear;
  82. end;
  83. class function THelpOptions.GetGroupCaption: string;
  84. begin
  85. Result := lisHelp;
  86. end;
  87. class function THelpOptions.GetInstance: TAbstractIDEOptions;
  88. begin
  89. Result := HelpOpts;
  90. end;
  91. procedure THelpOptions.DoAfterWrite(Restore: boolean);
  92. begin
  93. if not Restore then
  94. Save;
  95. end;
  96. procedure THelpOptions.Clear;
  97. begin
  98. FFPCDocsHTMLDirectory := '';
  99. end;
  100. procedure THelpOptions.Load;
  101. var
  102. XMLConfig: TXMLConfig;
  103. FileVersion: integer;
  104. Storage: TXMLOptionsStorage;
  105. begin
  106. try
  107. XMLConfig := TXMLConfig.Create(FFileName);
  108. try
  109. FileVersion := XMLConfig.GetValue('HelpOptions/Version/Value',0);
  110. if (FileVersion <> 0) and (FileVersion < HelpOptionsVersion) then
  111. DebugLn('Note: Loading old Help options file', FFileName);
  112. FPCDocsHTMLDirectory:=
  113. XMLConfig.GetValue('HelpOptions/FPCDocs/HTML/Directory','');
  114. if HelpViewers <> nil then
  115. begin
  116. Storage := TXMLOptionsStorage.Create(XMLConfig, 'Viewers');
  117. try
  118. HelpViewers.Load(Storage);
  119. finally
  120. FreeAndNil(Storage);
  121. end;
  122. end;
  123. if HelpDatabases <> nil then
  124. begin
  125. Storage := TXMLOptionsStorage.Create(XMLConfig,'Databases');
  126. try
  127. HelpDatabases.Load(Storage);
  128. finally
  129. FreeAndNil(Storage);
  130. end;
  131. end;
  132. finally
  133. XMLConfig.Free;
  134. end;
  135. except
  136. on E: Exception do
  137. DebugLn('[THelpOptions.Load] error reading "',FFilename,'": ',E.Message);
  138. end;
  139. end;
  140. procedure THelpOptions.Save;
  141. var
  142. XMLConfig: TXMLConfig;
  143. Storage: TXMLOptionsStorage;
  144. begin
  145. try
  146. InvalidateFileStateCache;
  147. XMLConfig:=TXMLConfig.CreateClean(FFileName);
  148. try
  149. XMLConfig.SetValue('HelpOptions/Version/Value',HelpOptionsVersion);
  150. XMLConfig.SetDeleteValue('HelpOptions/FPCDocs/HTML/Directory',
  151. FPCDocsHTMLDirectory,'');
  152. if HelpViewers <> nil then
  153. begin
  154. Storage := TXMLOptionsStorage.Create(XMLConfig,'Viewers');
  155. try
  156. HelpViewers.Save(Storage);
  157. finally
  158. FreeAndNil(Storage);
  159. end;
  160. end;
  161. if HelpDatabases <> nil then
  162. begin
  163. Storage := TXMLOptionsStorage.Create(XMLConfig,'Databases');
  164. try
  165. HelpDatabases.Save(Storage);
  166. finally
  167. FreeAndNil(Storage);
  168. end;
  169. end;
  170. XMLConfig.Flush;
  171. finally
  172. XMLConfig.Free;
  173. end;
  174. except
  175. on E: Exception do
  176. DebugLn('[THelpOptions.Save] error writing "',FFilename,'": ',E.Message);
  177. end;
  178. end;
  179. procedure THelpOptions.SetDefaultFilename;
  180. var
  181. ConfFileName: string;
  182. begin
  183. ConfFileName := AppendPathDelim(GetPrimaryConfigPath)+DefaultHelpOptsFile;
  184. CopySecondaryConfigFile(DefaultHelpOptsFile);
  185. if (not FileExistsUTF8(ConfFileName)) then
  186. DebugLn('NOTE: help options config file not found - using defaults');
  187. FFilename := ConfFilename;
  188. end;
  189. procedure THelpOptions.Assign(Source: TPersistent);
  190. begin
  191. if Source is THelpOptions then
  192. FPCDocsHTMLDirectory := THelpOptions(Source).FPCDocsHTMLDirectory
  193. else
  194. inherited Assign(Source);
  195. end;
  196. function THelpOptions.IsEqual(HelpOpts: THelpOptions): boolean;
  197. begin
  198. Result := FPCDocsHTMLDirectory = HelpOpts.FPCDocsHTMLDirectory;
  199. end;
  200. function THelpOptions.CreateCopy: THelpOptions;
  201. begin
  202. Result := THelpOptions.Create;
  203. Result.Assign(Self);
  204. end;
  205. function THelpOptions.GetEffectiveFPCDocsHTMLDirectory: string;
  206. begin
  207. Result:=FPCDocsHTMLDirectory;
  208. IDEMacros.SubstituteMacros(Result);
  209. Result:=AppendURLPathDelim(Result);
  210. end;
  211. initialization
  212. RegisterIDEOptionsGroup(GroupHelp, THelpOptions);
  213. end.