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