1 {
2 *****************************************************************************
3 See the file COPYING.modifiedLGPL.txt, included in this distribution,
4 for details about the license.
5 *****************************************************************************
6
7 Author: Mattias Gaertner
8
9 Abstract:
10 Methods and types for CHM help using chm viewer "lhelp".
11 }
12 unit LazHelpCHM;
13
14 {$mode objfpc}{$H+}
15
16 {$IFDEF VerboseLCLHelp}
17 {$DEFINE VerboseChmHelp}
18 {$ENDIF}
19
20 interface
21
22 uses
23 Classes, SysUtils,
24 // LCL
25 LazHelpIntf, HelpIntfs, LResources, Dialogs, Forms,
26 // LazUtils
27 LazConfigStorage, LazLoggerBase, FileUtil, LazFileUtils,
28 // ChmHelp
29 LHelpControl;
30
31 const
32 CHMMimeType = 'application/chm';
33 CHMPathParam = 'path';
34
35 type
36 { TCHMHelpDatabase
37
38 KeywordPrefix: if set, then the database will handle all Keywords
39 beginning with this value. And when the path is created by replacing
40 the prefix with the BaseURL.
41 For example:
42 Create a chm. For example build and run chmmaker in lazarus/tools/chmmaker
43 to create the example.chm (lazarus/tools/chmmaker/example.chm).
44
45 Put a TCHMHelpDatabase on a form.
46 Set AutoRegister to true.
47 Set KeywordPrefix to 'example'
48 Set CHM file to '../../../tools/chmmaker/example.chm'
49
50 Put a TLHelpRemoteViewer on the form.
51 Set AutoRegister to true.
52 Set LHelpPath to the path of lhelp. E.g. '../../lhelp/lhelp'
53
54 Put a TEdit on a form.
55 Set HelpType to htKeyword
56 Set HelpKeyword to 'example/MainPage.html'
57
58 Run the program.
59 Focus the edit field and press F1. The page '/MainPage.html' will be shown.
60 Note: lhelp requires the leading slash.
61 }
62 TCHMHelpDatabase = class(THelpDatabase)
63 private
64 FFilename: string;
65 FHelpNode: THelpNode;
66 FKeywordPrefix: string;
67 procedure SetFilename(AValue: string);
68 procedure SetKeywordPrefix(AValue: string);
69 public
70 constructor Create(TheOwner: TComponent); override;
71 destructor Destroy; override;
ShowHelpnull72 function ShowHelp({%H-}Query: THelpQuery; {%H-}BaseNode, NewNode: THelpNode;
73 {%H-}QueryItem: THelpQueryItem;
74 var ErrMsg: string): TShowHelpResult; override;
ShowURLnull75 function ShowURL(const URL, Title: string;
76 var ErrMsg: string): TShowHelpResult; virtual;
GetNodesForKeywordnull77 function GetNodesForKeyword(const HelpKeyword: string;
78 var ListOfNodes: THelpNodeQueryList;
79 var ErrMsg: string): TShowHelpResult; override;
80 procedure Load(Storage: TConfigStorage); override;
81 procedure Save(Storage: TConfigStorage); override;
82 published
83 property AutoRegister;
84 property Filename: string read FFilename write SetFilename;
85 property KeywordPrefix: string read FKeywordPrefix write SetKeywordPrefix;
86 end;
87
88 type
89 TOnFindLHelp = procedure(var Path: string) of object;
90
91 { TLHelpConnector }
92
93 TLHelpConnector = class(THelpViewer)
94 private
95 FConnection: TLHelpConnection;
96 FLHelpPath: string;
97 FOnFindLHelp: TOnFindLHelp;
98 procedure SetLHelpPath(AValue: string);
99 public
100 constructor Create(TheOwner: TComponent); override;
101 destructor Destroy; override;
ShowNodenull102 function ShowNode(Node: THelpNode; var ErrMsg: string): TShowHelpResult; override;
103 procedure Assign(Source: TPersistent); override;
104 procedure Load(Storage: TConfigStorage); override;
105 procedure Save(Storage: TConfigStorage); override;
GetLocalizedNamenull106 function GetLocalizedName: string; override;
107 property OnFindLHelp: TOnFindLHelp read FOnFindLHelp write FOnFindLHelp;
108 property Connection: TLHelpConnection read FConnection;
109 published
110 property LHelpPath: string read FLHelpPath write SetLHelpPath;
111 property AutoRegister;
112 end;
113
114 procedure Register;
115
116 implementation
117
118 {$R lazhelpchm.res}
119
120 procedure Register;
121 begin
122 RegisterComponents('System',[TCHMHelpDatabase,TLHelpConnector]);
123 end;
124
125 { TLHelpConnector }
126
127 procedure TLHelpConnector.SetLHelpPath(AValue: string);
128 begin
129 if FLHelpPath=AValue then Exit;
130 FLHelpPath:=AValue;
131 end;
132
133 constructor TLHelpConnector.Create(TheOwner: TComponent);
134 begin
135 inherited Create(TheOwner);
136 AddSupportedMimeType(CHMMimeType);
137 end;
138
139 destructor TLHelpConnector.Destroy;
140 begin
141 FConnection.Free;
142 inherited;
143 end;
144
ShowNodenull145 function TLHelpConnector.ShowNode(Node: THelpNode; var ErrMsg: string
146 ): TShowHelpResult;
147 var
148 Path: String;
149 IPCFile: String;
150 URLScheme: string;
151 URLPath: string;
152 URLParams: string;
153 CHMFilename: String;
154 SubPath: String;
155 Response: TLHelpResponse;
156 s: String;
157 begin
158 {$IFDEF VerboseChmHelp}
159 debugln(['TLHelpConnector.ShowNode START URL="',Node.URL,'"']);
160 {$ENDIF}
161
162 Result:=shrViewerError;
163 ErrMsg:='';
164 if (not Node.URLValid) then
165 begin
166 ErrMsg:='TLHelpConnector.ShowNode Node.URLValid=false';
167 exit;
168 end;
169 if (Node.URL='') then
170 begin
171 ErrMsg:='TLHelpConnector.ShowNode Node.URL empty';
172 exit;
173 end;
174
175 SplitURL(Node.URL,URLScheme,URLPath,URLParams);
176 CHMFilename:=CleanAndExpandFilename(URLPath);
177 if not FileExistsUTF8(CHMFilename) then
178 begin
179 ErrMsg:='chm file "'+CHMFilename+'" not found';
180 exit;
181 end;
182 if DirPathExists(CHMFilename) then
183 begin
184 ErrMsg:='invalid chm file "'+CHMFilename+'"';
185 exit;
186 end;
187
188 SubPath:='';
189 if (URLParams<>'') and (URLParams[1]='?') then
190 Delete(URLParams,1,1);
191 if LeftStr(URLParams,length(CHMPathParam)+1)=CHMPathParam+'=' then
192 begin
193 SubPath:=URLParams;
194 Delete(SubPath,1,length(CHMPathParam)+1);
195 end;
196
197 if Connection=nil then
198 begin
199 // create a connection to lhelp:
200 FConnection := TLHelpConnection.Create;
201 Connection.ProcessWhileWaiting := @Application.ProcessMessages;
202 end;
203
204 if Connection.ServerRunning = false then
205 begin
206 // Use '_lhlpctl_' in case application developer uses SimpleIPC
207 // and also uses the exe name followed by the process ID.
208 // See help protocol specs defined in
209 // http://wiki.lazarus.freepascal.org/Help_protocol
210 // Use process id in order to avoid conflicts when multiple entries are running
211 IPCFile:=LowerCase(ExtractFileName(Application.ExeName))+
212 '_lhlpctl_'+
213 copy(inttostr(GetProcessID)+'00000',1,5);
214 {$IFDEF Unix}
215 if FileExistsUTF8('/tmp/'+IPCFile) then
216 DeleteFileUTF8('/tmp/'+IPCFile);
217 {$ENDIF}
218
219 // get lhelp path
220 Path:=LHelpPath;
221 if Assigned(OnFindLHelp) then
222 OnFindLHelp(Path);
223
224 // append exe extension
225 if ExtractFileExt(Path)='' then
226 Path:=Path+GetExeExt;
227
228 // search in Path
229 if (Path<>'') and (ExtractFilePath(Path)='') then
230 begin
231 s:=FindDefaultExecutablePath(Path);
232 if s<>'' then Path:=s;
233 end;
234
235 if not FileExistsUTF8(Path) then
236 begin
237 ErrMsg:='The chm viewer program lhelp was not found at "'+Path+'"';
238 exit;
239 end;
240
241 Connection.StartHelpServer(IPCFile,Path);
242 end;
243
244 {$IFDEF VerboseChmHelp}
245 debugln(['TLHelpConnector.ShowNode CHMFilename="',CHMFilename,'" SubPath="',SubPath,'"']);
246 {$ENDIF}
247 Response:=Connection.OpenURL(CHMFilename,SubPath);
248 case Response of
249 srSuccess: exit(shrSuccess);
250 srNoAnswer: ErrMsg:='lhelp does not respond';
251 srInvalidFile: ErrMsg:='lhelp can not open the file "'+CHMFilename+'"';
252 srInvalidURL,srInvalidContext: ErrMsg:='lhelp can not find the help entry "'+SubPath+'"';
253 else
254 ErrMsg:='Something is wrong with lhelp';
255 end;
256 debugln(['TLHelpConnector.ShowNode error: ',ErrMsg]);
257 end;
258
259 procedure TLHelpConnector.Assign(Source: TPersistent);
260 var
261 Src: TLHelpConnector;
262 begin
263 if Source is TLHelpConnector then
264 begin
265 Src:=TLHelpConnector(Source);
266 LHelpPath:=Src.LHelpPath;
267 end;
268 inherited Assign(Source);
269 end;
270
271 procedure TLHelpConnector.Load(Storage: TConfigStorage);
272 begin
273 inherited Load(Storage);
274 LHelpPath:=Storage.GetValue('LHelp/Path','');
275 end;
276
277 procedure TLHelpConnector.Save(Storage: TConfigStorage);
278 begin
279 inherited Save(Storage);
280 Storage.SetDeleteValue('LHelp/Path',LHelpPath,'');
281 end;
282
TLHelpConnector.GetLocalizedNamenull283 function TLHelpConnector.GetLocalizedName: string;
284 begin
285 Result:='LHelp Connector';
286 end;
287
288 { TCHMHelpDatabase }
289
290 procedure TCHMHelpDatabase.SetFilename(AValue: string);
291 begin
292 if FFilename=AValue then Exit;
293 FFilename:=AValue;
294 end;
295
296 procedure TCHMHelpDatabase.SetKeywordPrefix(AValue: string);
297 begin
298 if FKeywordPrefix=AValue then Exit;
299 FKeywordPrefix:=AValue;
300 end;
301
302 constructor TCHMHelpDatabase.Create(TheOwner: TComponent);
303 begin
304 inherited Create(TheOwner);
305 AddSupportedMimeType(CHMMimeType);
306 end;
307
308 destructor TCHMHelpDatabase.Destroy;
309 begin
310 FreeAndNil(FHelpNode);
311 inherited Destroy;
312 end;
313
TCHMHelpDatabase.ShowHelpnull314 function TCHMHelpDatabase.ShowHelp(Query: THelpQuery; BaseNode,
315 NewNode: THelpNode; QueryItem: THelpQueryItem; var ErrMsg: string
316 ): TShowHelpResult;
317 begin
318 ErrMsg:='';
319 Result:=shrContextNotFound;
320 if NewNode.URLValid then
321 begin
322 Result:=ShowURL(NewNode.URL,NewNode.Title,ErrMsg);
323 end
324 else
325 begin
326 Result:=shrContextNotFound;
327 ErrMsg:='TCHMHelpDatabase.ShowHelp Node.URLValid=false Node.URL="'+NewNode.URL+'"';
328 end;
329 end;
330
ShowURLnull331 function TCHMHelpDatabase.ShowURL(const URL, Title: string; var ErrMsg: string
332 ): TShowHelpResult;
333 var
334 Viewer: THelpViewer;
335 Node: THelpNode;
336 begin
337 //DebugLn('TCHMHelpDatabase.ShowURL A URL="',URL,'" Title="',Title,'"');
338
339 if not FileExistsUTF8(Filename) then
340 begin
341 ErrMsg:='chm help file "'+Filename+'" not found';
342 exit(shrDatabaseNotFound);
343 end;
344
345 // find HTML viewer
346 Result:=FindViewer(CHMMimeType,ErrMsg,Viewer);
347 if Result<>shrSuccess then exit;
348
349 // call viewer
350 Node:=nil;
351 try
352 Node:=THelpNode.CreateURL(Self,Title,URL);
353 Result:=Viewer.ShowNode(Node,ErrMsg);
354 finally
355 Node.Free;
356 end;
357 end;
358
TCHMHelpDatabase.GetNodesForKeywordnull359 function TCHMHelpDatabase.GetNodesForKeyword(const HelpKeyword: string;
360 var ListOfNodes: THelpNodeQueryList; var ErrMsg: string): TShowHelpResult;
361 var
362 Path: String;
363 begin
364 Result:=inherited GetNodesForKeyword(HelpKeyword, ListOfNodes, ErrMsg);
365 if Result<>shrSuccess then exit;
366
367 if not (csDesigning in ComponentState) and
368 (KeywordPrefix<>'') and
369 (LeftStr(HelpKeyword,length(KeywordPrefix))=KeywordPrefix) then
370 begin
371 // HelpKeyword starts with KeywordPrefix -> add default node
372 if FHelpNode=nil then
373 FHelpNode:=THelpNode.CreateURL(Self,'','');
374 Path:=copy(HelpKeyword,length(KeywordPrefix)+1,length(HelpKeyword));
375 FHelpNode.Title:='Show page '+Path+' of '+ExtractFileName(Filename);
376 FHelpNode.URL:='chmfile://'+FilenameToURLPath(Filename)+'?'+CHMPathParam+'='+Path;
377 CreateNodeQueryListAndAdd(FHelpNode,nil,ListOfNodes,true);
378 end;
379 end;
380
381 procedure TCHMHelpDatabase.Load(Storage: TConfigStorage);
382 begin
383 inherited Load(Storage);
384 KeywordPrefix:=Storage.GetValue('KeywordPrefix','');
385 Filename:=Storage.GetValue('Filename','');
386 end;
387
388 procedure TCHMHelpDatabase.Save(Storage: TConfigStorage);
389 begin
390 inherited Save(Storage);
391 Storage.SetDeleteValue('KeywordPrefix',KeywordPrefix,'');
392 Storage.SetDeleteValue('Filename',Filename, '');
393 end;
394
395 end.
396
397