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., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA. *
18 * *
19 ***************************************************************************
20
21 Author: Mattias Gaertner
22
23 Abstract:
24 Help for IDE windows (controls).
25 }
26 unit IDEWindowHelp;
27
28 {$mode objfpc}{$H+}
29
30 interface
31
32 uses
33 Classes, SysUtils,
34 // LCL
35 LCLProc, Controls, Dialogs, HelpIntfs,
36 // LazUtils
37 LazFileUtils, LazConfigStorage,
38 // IdeIntf
39 IDEDialogs,
40 // IDE
41 EnvironmentOpts, IDEOptionDefs, LazarusIDEStrConsts;
42
43 type
44
45 { TIWHelpNode }
46
47 TIWHelpNode = class
48 private
49 FIsRoot: boolean;
50 FItems: TFPList;// list of TIWHelpNode
51 FHasHelp: Boolean;
52 FName: string;
53 FParent: TIWHelpNode;
54 FPath: string;
GetChildsnull55 function GetChilds(Index: integer): TIWHelpNode;
GetCountnull56 function GetCount: integer;
57 procedure SetHasHelp(const AValue: Boolean);
58 procedure SetIsRoot(const AValue: boolean);
59 procedure SetName(const AValue: string);
60 procedure SetPath(const AValue: string);
61 procedure DoRemove(AChild: TIWHelpNode);
62 public
63 constructor Create;
64 destructor Destroy; override;
65 procedure Clear;
66 procedure Assign(Source: TIWHelpNode);
AddChildnull67 function AddChild(const ChildName: string = '';
68 const ChildPath: string = ''): TIWHelpNode;
69 procedure Load(Config: TConfigStorage; const CfgPath: string);
70 procedure Save(Config: TConfigStorage; const CfgPath: string);
FindByNamenull71 function FindByName(const ChildName: string): TIWHelpNode;
72 procedure DeleteLeavesWithoutHelp;
GetFullPathnull73 function GetFullPath: string;
74 public
75 property HasHelp: Boolean read FHasHelp write SetHasHelp;
76 property IsRoot: boolean read FIsRoot write SetIsRoot;// skip parent paths, except path of the top node
77 property Name: string read FName write SetName;
78 property Path: string read FPath write SetPath;
79 property Parent: TIWHelpNode read FParent;
80 property Count: integer read GetCount;
81 property Children[Index: integer]: TIWHelpNode read GetChilds; default;
82 end;
83
84 { TIWHelpTree }
85
86 TIWHelpTree = class
87 private
88 FRoot: TIWHelpNode;
89 public
90 constructor Create;
91 destructor Destroy; override;
92 procedure Clear;
93 procedure Assign(Source: TIWHelpTree);
94 procedure Load(Config: TConfigStorage; const Path: string);
95 procedure Save(Config: TConfigStorage; const Path: string);
ControlHasValidNamePathnull96 function ControlHasValidNamePath(AControl: TControl): Boolean;
FindNodeForControlnull97 function FindNodeForControl(AControl: TControl;
98 CreateIfNotExists: Boolean = false): TIWHelpNode;
99 procedure WriteDebugReport;
100 procedure DeleteLeavesWithoutHelp;
101 procedure InvokeHelp(AControl: TControl);
CreateURLnull102 function CreateURL(AControl: TControl): string;
103 public
104 property Root: TIWHelpNode read FRoot;
105 end;
106
107 const
108 IDEWindowHelpTreeFile = 'docs/IDEWindowHelpTree.xml';
109
110 var
111 IDEWindowHelpNodes: TIWHelpTree = nil;
112
GetIDEWindowHelpFilenamenull113 function GetIDEWindowHelpFilename: string;
114 procedure LoadIDEWindowHelp;
115 procedure SaveIDEWindowHelp;
116
117 implementation
118
GetIDEWindowHelpFilenamenull119 function GetIDEWindowHelpFilename: string;
120 begin
121 Result:=AppendPathDelim(EnvironmentOptions.GetParsedLazarusDirectory)
122 +GetForcedPathDelims(IDEWindowHelpTreeFile);
123 end;
124
125 procedure LoadIDEWindowHelp;
126 var
127 Filename: String;
128 Config: TXMLOptionsStorage;
129 begin
130 if IDEWindowHelpNodes=nil then
131 IDEWindowHelpNodes:=TIWHelpTree.Create;
132 Filename:=GetIDEWindowHelpFilename;
133 try
134 Config:=TXMLOptionsStorage.Create(Filename,true);
135 if Config=nil then exit;
136 try
137 IDEWindowHelpNodes.Load(Config,'');
138 finally
139 Config.Free;
140 end;
141 except
142 on E: Exception do begin
143 IDEMessageDialog('Read error','Error reading file '+Filename+LineEnding+E.Message,
144 mtError,[mbOk]);
145 end;
146 end;
147 end;
148
149 procedure SaveIDEWindowHelp;
150 var
151 Filename: String;
152 Config: TConfigStorage;
153 begin
154 if IDEWindowHelpNodes=nil then exit;
155 Filename:=GetIDEWindowHelpFilename;
156 try
157 Config:=TXMLOptionsStorage.Create(Filename,false);
158 if Config=nil then exit;
159 try
160 IDEWindowHelpNodes.Save(Config,'');
161 Config.WriteToDisk;
162 finally
163 Config.Free;
164 end;
165 except
166 on E: Exception do begin
167 IDEMessageDialog(lisCodeToolsDefsWriteError,
168 Format(lisErrorWritingFile, [Filename+LineEnding+E.Message]),
169 mtError,[mbOk]);
170 end;
171 end;
172 end;
173
174 { TIWHelpNode }
175
176 procedure TIWHelpNode.SetHasHelp(const AValue: Boolean);
177 begin
178 if FHasHelp=AValue then exit;
179 FHasHelp:=AValue;
180 end;
181
182 procedure TIWHelpNode.SetIsRoot(const AValue: boolean);
183 begin
184 if FIsRoot=AValue then exit;
185 FIsRoot:=AValue;
186 end;
187
188 procedure TIWHelpNode.SetName(const AValue: string);
189 begin
190 if FName=AValue then exit;
191 FName:=AValue;
192 end;
193
GetChildsnull194 function TIWHelpNode.GetChilds(Index: integer): TIWHelpNode;
195 begin
196 Result:=TIWHelpNode(FItems[Index]);
197 end;
198
GetCountnull199 function TIWHelpNode.GetCount: integer;
200 begin
201 if FItems<>nil then
202 Result:=FItems.Count
203 else
204 Result:=0;
205 end;
206
207 procedure TIWHelpNode.SetPath(const AValue: string);
208 begin
209 if FPath=AValue then exit;
210 FPath:=AValue;
211 end;
212
213 procedure TIWHelpNode.DoRemove(AChild: TIWHelpNode);
214 begin
215 FItems.Remove(AChild);
216 AChild.FParent:=nil;
217 end;
218
219 constructor TIWHelpNode.Create;
220 begin
221
222 end;
223
224 destructor TIWHelpNode.Destroy;
225 begin
226 Clear;
227 if FParent<>nil then
228 FParent.DoRemove(Self);
229 FreeAndNil(FItems);
230 inherited Destroy;
231 end;
232
233 procedure TIWHelpNode.Clear;
234 var
235 i: Integer;
236 CurChild: TIWHelpNode;
237 begin
238 if FItems<>nil then begin
239 for i:=FItems.Count-1 downto 0 do begin
240 CurChild:=Children[i];
241 CurChild.FParent:=nil;
242 CurChild.Free;
243 end;
244 FreeAndNil(FItems);
245 end;
246 end;
247
248 procedure TIWHelpNode.Assign(Source: TIWHelpNode);
249 var
250 i: Integer;
251 SrcNode: TIWHelpNode;
252 NewNode: TIWHelpNode;
253 begin
254 Clear;
255 Name:=Source.Name;
256 Path:=Source.Path;
257 HasHelp:=Source.HasHelp;
258 IsRoot:=Source.IsRoot;
259 for i:=0 to Source.Count-1 do begin
260 SrcNode:=Source[i];
261 NewNode:=AddChild;
262 NewNode.Assign(SrcNode);
263 end;
264 end;
265
AddChildnull266 function TIWHelpNode.AddChild(const ChildName: string;
267 const ChildPath: string): TIWHelpNode;
268 begin
269 Result:=TIWHelpNode.Create;
270 Result.FParent:=Self;
271 Result.Name:=ChildName;
272 Result.Path:=ChildPath;
273 if FItems=nil then
274 FItems:=TFPList.Create;
275 FItems.Add(Result);
276 end;
277
278 procedure TIWHelpNode.Load(Config: TConfigStorage; const CfgPath: string);
279 var
280 NewChildCount: LongInt;
281 i: Integer;
282 NewChild: TIWHelpNode;
283 NewName: String;
284 begin
285 Clear;
286 NewName:=Config.GetValue(CfgPath+'Name','');
287 if NewName='' then exit;
288 Name:=NewName;
289 Path:=Config.GetValue(CfgPath+'Path','');
290 HasHelp:=Config.GetValue(CfgPath+'HasHelp',false);
291 IsRoot:=Config.GetValue(CfgPath+'IsRoot',false);
292 NewChildCount:=Config.GetValue(CfgPath+'ChildCount',0);
293 for i:=0 to NewChildCount-1 do begin
294 NewChild:=AddChild('');
295 NewChild.Load(Config,CfgPath+'Node'+IntToStr(i+1)+'/');
296 end;
297 end;
298
299 procedure TIWHelpNode.Save(Config: TConfigStorage; const CfgPath: string);
300 var
301 i: Integer;
302 begin
303 Config.SetDeleteValue(CfgPath+'Name',Name,'');
304 Config.SetDeleteValue(CfgPath+'Path',Path,'');
305 Config.SetDeleteValue(CfgPath+'HasHelp',HasHelp,false);
306 Config.SetDeleteValue(CfgPath+'IsRoot',IsRoot,false);
307 Config.SetDeleteValue(CfgPath+'ChildCount',Count,0);
308 for i:=0 to Count-1 do
309 Children[i].Save(Config,CfgPath+'Node'+IntToStr(i+1)+'/');
310 end;
311
TIWHelpNode.FindByNamenull312 function TIWHelpNode.FindByName(const ChildName: string): TIWHelpNode;
313 var
314 i: Integer;
315 begin
316 for i := 0 to Count-1 do begin
317 Result:=Children[i];
318 if CompareText(Result.Name,ChildName)=0 then exit;
319 end;
320 Result:=nil;
321 end;
322
323 procedure TIWHelpNode.DeleteLeavesWithoutHelp;
324 var
325 CurChild: TIWHelpNode;
326 i: Integer;
327 begin
328 for i:=Count-1 downto 0 do begin
329 CurChild:=Children[i];
330 CurChild.DeleteLeavesWithoutHelp;
331 if (CurChild.Count=0) and (not CurChild.HasHelp) then
332 CurChild.Free;
333 end;
334 end;
335
GetFullPathnull336 function TIWHelpNode.GetFullPath: string;
337 var
338 Node: TIWHelpNode;
339 SkipTillRoot: Boolean;
340 begin
341 Result:='';
342 Node:=Self;
343 SkipTillRoot:=false;
344 while Node<>nil do begin
345 if (Node.Parent=nil) or (not SkipTillRoot) then
346 Result:=Node.Path+Result;
347 if Node.IsRoot then
348 SkipTillRoot:=true;
349 Node:=Node.Parent;
350 end;
351 end;
352
353 { TIWHelpTree }
354
355 constructor TIWHelpTree.Create;
356 begin
357 Clear;
358 end;
359
360 destructor TIWHelpTree.Destroy;
361 begin
362 Clear;
363 FreeAndNil(FRoot);
364 inherited Destroy;
365 end;
366
367 procedure TIWHelpTree.Clear;
368 begin
369 FreeAndNil(FRoot);
370 FRoot:=TIWHelpNode.Create;
371 Root.Name:='IDE windows and dialogs';
372 Root.Path:='IDE_Window:_';
373 end;
374
375 procedure TIWHelpTree.Assign(Source: TIWHelpTree);
376 begin
377 Clear;
378 Root.Assign(Source.Root);
379 end;
380
381 procedure TIWHelpTree.Load(Config: TConfigStorage; const Path: string);
382 begin
383 Clear;
384 FRoot.Load(Config,Path);
385 end;
386
387 procedure TIWHelpTree.Save(Config: TConfigStorage; const Path: string);
388 begin
389 FRoot.Save(Config,Path);
390 end;
391
TIWHelpTree.ControlHasValidNamePathnull392 function TIWHelpTree.ControlHasValidNamePath(AControl: TControl): Boolean;
393 begin
394 if (AControl=nil) then exit(false);
395 if AControl.Name='' then exit(false);
396 if AControl.Parent=nil then begin
397 Result:=true;
398 end else begin
399 Result:=ControlHasValidNamePath(AControl.Parent);
400 end;
401 end;
402
FindNodeForControlnull403 function TIWHelpTree.FindNodeForControl(AControl: TControl;
404 CreateIfNotExists: Boolean): TIWHelpNode;
405
Findnull406 function Find(TheControl: TControl): TIWHelpNode;
407 var
408 NextParent: TWinControl;
409 ParentHelpNode: TIWHelpNode;
410 CurName: String;
411 begin
412 Result:=nil;
413 //DebugLn('TIWHelpTree.FindNodeForControl.Find ',dbgsName(TheControl));
414 NextParent:=TheControl.Parent;
415 if NextParent=nil then begin
416 CurName:=TheControl.ClassName;
417 ParentHelpNode:=Root;
418 end else begin
419 CurName:=TheControl.Name;
420 if CurName='' then exit;
421 ParentHelpNode:=Find(NextParent);
422 if ParentHelpNode=nil then exit;
423 end;
424 Result:=ParentHelpNode.FindByName(CurName);
425 if (Result=nil) and CreateIfNotExists then begin
426 Result:=ParentHelpNode.AddChild(CurName,CurName);
427 //DebugLn('Find Create: ParentHelpNode=',ParentHelpNode.Name,' Result=',Result.Name);
428 end;
429 end;
430
431 begin
432 Result:=Find(AControl);
433 end;
434
435 procedure TIWHelpTree.WriteDebugReport;
436
437 procedure WriteNode(const Prefix: string; Node: TIWHelpNode);
438 var
439 i: Integer;
440 begin
441 if Node=nil then exit;
442 DebugLn(Prefix,'Name="',Node.Name,'" Path="',Node.Path,'" HashHelp=',dbgs(Node.HasHelp));
443 for i:=0 to Node.Count-1 do
444 WriteNode(Prefix+' ',Node[i]);
445 end;
446
447 begin
448 DebugLn('TIWHelpTree.WriteDebugReport =====================================');
449 WriteNode('',Root);
450 end;
451
452 procedure TIWHelpTree.DeleteLeavesWithoutHelp;
453 begin
454 Root.DeleteLeavesWithoutHelp;
455 end;
456
457 procedure TIWHelpTree.InvokeHelp(AControl: TControl);
458 var
459 URL: String;
460 begin
461 URL:=CreateURL(AControl);
462 if URL='' then exit;
463 ShowHelpOrError(URL,'Help for '+dbgsName(AControl),'text/html');
464 end;
465
TIWHelpTree.CreateURLnull466 function TIWHelpTree.CreateURL(AControl: TControl): string;
467 var
468 HelpNode: TIWHelpNode;
469
Findnull470 function Find(TheControl: TControl): TIWHelpNode;
471 var
472 NextParent: TWinControl;
473 ParentHelpNode: TIWHelpNode;
474 CurName: String;
475 begin
476 Result:=nil;
477 NextParent:=TheControl.Parent;
478 if NextParent=nil then begin
479 CurName:=TheControl.ClassName;
480 ParentHelpNode:=Root;
481 end else begin
482 CurName:=TheControl.Name;
483 ParentHelpNode:=Find(NextParent);
484 if ParentHelpNode=nil then exit;
485 end;
486 Result:=ParentHelpNode.FindByName(CurName);
487 if (Result<>nil) and Result.HasHelp then
488 HelpNode:=Result;
489 end;
490
491 begin
492 HelpNode:=nil;
493 // search a help for this control
494 Find(AControl);
495 if HelpNode=nil then begin
496 Result:='';
497 end else begin
498 Result:='http://wiki.lazarus.freepascal.org/'+HelpNode.GetFullPath;
499 end;
500 end;
501
502 finalization
503 FreeAndNil(IDEWindowHelpNodes);
504
505 end.
506
507