/ide/helpoptions.pas

  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., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.        *
 23 *                                                                         *
 24 ***************************************************************************
 25
 26  Author: Mattias Gaertner
 27
 28  Abstract:
 29    - THelpOptions
 30}
 31unit HelpOptions;
 32
 33{$mode objfpc}{$H+}
 34
 35interface
 36
 37uses
 38  Classes, SysUtils, LCLProc, LazFileUtils, Laz2_XMLCfg, LazFileCache,
 39  LazHelpIntf, IDEOptionsIntf, MacroIntf, LazConf,
 40  LazarusIDEStrConsts, IDEOptionDefs;
 41
 42type
 43  { THelpOptions }
 44
 45  THelpOptions = class(TAbstractIDEHelpOptions)
 46  private
 47    FFilename: string;
 48    FFPCDocsHTMLDirectory: string;
 49    procedure SetFPCDocsHTMLDirectory(const AValue: string);
 50    procedure SetFilename(const AValue: string);
 51  public
 52    class function GetGroupCaption:string; override;
 53    class function GetInstance: TAbstractIDEOptions; override;
 54    procedure DoAfterWrite(Restore: boolean); override;
 55  public
 56    constructor Create;
 57    procedure Clear;
 58    procedure Load;
 59    procedure Save;
 60    procedure SetDefaultFilename;
 61    procedure Assign(Source: TPersistent); override;
 62    function IsEqual(HelpOpts: THelpOptions): boolean;
 63    function CreateCopy: THelpOptions;
 64  public
 65    property Filename: string read FFilename write SetFilename;
 66    function GetEffectiveFPCDocsHTMLDirectory: string;
 67  published
 68    property FPCDocsHTMLDirectory: string read FFPCDocsHTMLDirectory
 69                                          write SetFPCDocsHTMLDirectory;
 70  end;
 71  
 72var
 73  HelpOpts: THelpOptions; // set by the IDE
 74
 75const
 76  HelpOptionsVersion = 1;
 77  DefaultHelpOptsFile = 'helpoptions.xml';
 78
 79implementation
 80
 81{ THelpOptions }
 82
 83procedure THelpOptions.SetFilename(const AValue: string);
 84begin
 85  if FFilename = AValue then Exit;
 86  FFilename := AValue;
 87end;
 88
 89procedure THelpOptions.SetFPCDocsHTMLDirectory(const AValue: string);
 90begin
 91  if FFPCDocsHTMLDirectory = AValue then Exit;
 92  FFPCDocsHTMLDirectory := AValue;
 93end;
 94
 95constructor THelpOptions.Create;
 96begin
 97  Clear;
 98end;
 99
100class function THelpOptions.GetGroupCaption: string;
101begin
102  Result := lisHelp;
103end;
104
105class function THelpOptions.GetInstance: TAbstractIDEOptions;
106begin
107  Result := HelpOpts;
108end;
109
110procedure THelpOptions.DoAfterWrite(Restore: boolean);
111begin
112  if not Restore then
113    Save;
114end;
115
116procedure THelpOptions.Clear;
117begin
118  FFPCDocsHTMLDirectory := '';
119end;
120
121procedure THelpOptions.Load;
122var
123  XMLConfig: TXMLConfig;
124  FileVersion: integer;
125  Storage: TXMLOptionsStorage;
126begin
127  try
128    XMLConfig := TXMLConfig.Create(FFileName);
129    try
130      FileVersion := XMLConfig.GetValue('HelpOptions/Version/Value',0);
131      if (FileVersion <> 0) and (FileVersion < HelpOptionsVersion) then
132        DebugLn('Note: Loading old Help options file', FFileName);
133      FPCDocsHTMLDirectory:=
134                    XMLConfig.GetValue('HelpOptions/FPCDocs/HTML/Directory','');
135        
136      if HelpViewers <> nil then
137      begin
138        Storage := TXMLOptionsStorage.Create(XMLConfig, 'Viewers');
139        try
140          HelpViewers.Load(Storage);
141        finally
142          FreeAndNil(Storage);
143        end;
144      end;
145
146      if HelpDatabases <> nil then
147      begin
148        Storage := TXMLOptionsStorage.Create(XMLConfig,'Databases');
149        try
150          HelpDatabases.Load(Storage);
151        finally
152          FreeAndNil(Storage);
153        end;
154      end;
155
156    finally
157      XMLConfig.Free;
158    end;
159  except
160    on E: Exception do
161      DebugLn('[THelpOptions.Load]  error reading "',FFilename,'": ',E.Message);
162  end;
163end;
164
165procedure THelpOptions.Save;
166var
167  XMLConfig: TXMLConfig;
168  Storage: TXMLOptionsStorage;
169begin
170  try
171    InvalidateFileStateCache;
172    XMLConfig:=TXMLConfig.CreateClean(FFileName);
173    try
174      XMLConfig.SetValue('HelpOptions/Version/Value',HelpOptionsVersion);
175      XMLConfig.SetDeleteValue('HelpOptions/FPCDocs/HTML/Directory',
176                               FPCDocsHTMLDirectory,'');
177
178      if HelpViewers <> nil then
179      begin
180        Storage := TXMLOptionsStorage.Create(XMLConfig,'Viewers');
181        try
182          HelpViewers.Save(Storage);
183        finally
184          FreeAndNil(Storage);
185        end;
186      end;
187
188      if HelpDatabases <> nil then
189      begin
190        Storage := TXMLOptionsStorage.Create(XMLConfig,'Databases');
191        try
192          HelpDatabases.Save(Storage);
193        finally
194          FreeAndNil(Storage);
195        end;
196      end;
197
198      XMLConfig.Flush;
199    finally
200      XMLConfig.Free;
201    end;
202  except
203    on E: Exception do
204      DebugLn('[THelpOptions.Save]  error writing "',FFilename,'": ',E.Message);
205  end;
206end;
207
208procedure THelpOptions.SetDefaultFilename;
209var
210  ConfFileName: string;
211begin
212  ConfFileName := AppendPathDelim(GetPrimaryConfigPath)+DefaultHelpOptsFile;
213  CopySecondaryConfigFile(DefaultHelpOptsFile);
214  if (not FileExistsUTF8(ConfFileName)) then
215    DebugLn('NOTE: help options config file not found - using defaults');
216  FFilename := ConfFilename;
217end;
218
219procedure THelpOptions.Assign(Source: TPersistent);
220begin
221  if Source is THelpOptions then
222    FPCDocsHTMLDirectory := THelpOptions(Source).FPCDocsHTMLDirectory
223  else
224    inherited Assign(Source);
225end;
226
227function THelpOptions.IsEqual(HelpOpts: THelpOptions): boolean;
228begin
229  Result := FPCDocsHTMLDirectory = HelpOpts.FPCDocsHTMLDirectory;
230end;
231
232function THelpOptions.CreateCopy: THelpOptions;
233begin
234  Result := THelpOptions.Create;
235  Result.Assign(Self);
236end;
237
238function THelpOptions.GetEffectiveFPCDocsHTMLDirectory: string;
239begin
240  Result:=FPCDocsHTMLDirectory;
241  IDEMacros.SubstituteMacros(Result);
242  Result:=AppendURLPathDelim(Result);
243end;
244
245initialization
246  RegisterIDEOptionsGroup(GroupHelp, THelpOptions);
247end.
248