1 {
2 /***************************************************************************
3 helpmanager.pas
4 ---------------
5
6
7 ***************************************************************************/
8
9 ***************************************************************************
10 * *
11 * This source is free software; you can redistribute it and/or modify *
12 * it under the terms of the GNU General Public License as published by *
13 * the Free Software Foundation; either version 2 of the License, or *
14 * (at your option) any later version. *
15 * *
16 * This code is distributed in the hope that it will be useful, but *
17 * WITHOUT ANY WARRANTY; without even the implied warranty of *
18 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
19 * General Public License for more details. *
20 * *
21 * A copy of the GNU General Public License is available on the World *
22 * Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
23 * obtain it by writing to the Free Software Foundation, *
24 * Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA. *
25 * *
26 ***************************************************************************
27 }
28 unit IDEHelpManager;
29
30 {$mode objfpc}{$H+}
31
32 interface
33
34 uses
35 // RTL + FCL
36 Classes, SysUtils, Laz_AVL_Tree,
37 // LCL
38 LCLProc, LCLIntf, LCLType, FileProcs, Forms, Controls, ComCtrls, StdCtrls,
39 Dialogs, Graphics, Buttons, ButtonPanel, LazHelpHTML, HelpIntfs,
40 // LazUtils
41 LConvEncoding, LazFileUtils, HTML2TextRender,
42 // CodeTools
43 BasicCodeTools, CodeToolManager, CodeCache, CustomCodeTool, CodeTree,
44 PascalParserTool, FindDeclarationTool,
45 // IDEIntf
46 PropEdits, ObjectInspector, TextTools, IDEDialogs, LazHelpIntf, MacroIntf,
47 IDEWindowIntf, IDEMsgIntf, PackageIntf, LazIDEIntf, HelpFPDoc, IDEHelpIntf,
48 IDEExternToolIntf, IDEImagesIntf,
49 // IDE
50 LazarusIDEStrConsts, DialogProcs, ObjInspExt, EnvironmentOpts, AboutFrm,
51 Project, MainBar, IDEFPDocFileSearch, PackageDefs, PackageSystem, HelpOptions,
52 MainIntf, LazConf, HelpFPCMessages, CodeHelp, IDEWindowHelp, CodeBrowser;
53
54 type
55
56 { TSimpleFPCKeywordHelpDatabase }
57
58 TSimpleFPCKeywordHelpDatabase = class(THTMLHelpDatabase)
59 private
60 FKeywordPrefixNode: THelpNode;
61 public
GetNodesForKeywordnull62 function GetNodesForKeyword(const HelpKeyword: string;
63 var ListOfNodes: THelpNodeQueryList; var {%H-}ErrMsg: string
64 ): TShowHelpResult; override;
ShowHelpnull65 function ShowHelp(Query: THelpQuery; {%H-}BaseNode, {%H-}NewNode: THelpNode;
66 {%H-}QueryItem: THelpQueryItem;
67 var ErrMsg: string): TShowHelpResult; override;
68 end;
69
70 TLIHProviders = class;
71
72 { TLazIDEHTMLProvider }
73
74 TLazIDEHTMLProvider = class(TAbstractIDEHTMLProvider)
75 private
76 fWaitingForAsync: boolean;
77 FProviders: TLIHProviders;
78 procedure SetProviders(const AValue: TLIHProviders);
79 procedure OpenNextURL({%H-}Data: PtrInt); // called via Application.QueueAsyncCall
80 procedure OpenFPDoc(Path: string);
81 public
82 NextURL: string;
83 destructor Destroy; override;
URLHasStreamnull84 function URLHasStream(const URL: string): boolean; override;
85 procedure OpenURLAsync(const URL: string); override;
GetStreamnull86 function GetStream(const URL: string; Shared: Boolean): TStream; override;
87 procedure ReleaseStream(const URL: string); override;
88 property Providers: TLIHProviders read FProviders write SetProviders;
89 end;
90
91 { TLIHProviderStream }
92
93 TLIHProviderStream = class
94 private
95 FRefCount: integer;
96 public
97 Stream: TStream;
98 URL: string;
99 destructor Destroy; override;
100 procedure IncreaseRefCount;
101 procedure DecreaseRefCount;
102 property RefCount: integer read FRefCount;
103 end;
104
105 { TLIHProviders
106 manages all TLazIDEHTMLProvider }
107
108 TLIHProviders = class
109 private
110 FStreams: TAVLTree;// tree of TLIHProviderStream sorted for URL
111 public
112 constructor Create;
113 destructor Destroy; override;
FindStreamnull114 function FindStream(const URL: string; CreateIfNotExists: Boolean): TLIHProviderStream;
GetStreamnull115 function GetStream(const URL: string; Shared: boolean): TStream;
116 procedure ReleaseStream(const URL: string);
117 end;
118
119 { TSimpleHTMLControl }
120
121 TSimpleHTMLControl = class(TLabel,TIDEHTMLControlIntf)
122 private
123 FMaxLineCount: integer;
124 FProvider: TAbstractIDEHTMLProvider;
125 FURL: string;
126 procedure SetProvider(const AValue: TAbstractIDEHTMLProvider);
127 public
128 constructor Create(AOwner: TComponent); override;
GetURLnull129 function GetURL: string;
130 procedure SetURL(const AValue: string);
131 property Provider: TAbstractIDEHTMLProvider read FProvider write SetProvider;
132 procedure SetHTMLContent(Stream: TStream; const NewURL: string);
133 procedure GetPreferredControlSize(out AWidth, AHeight: integer);
134 property MaxLineCount: integer read FMaxLineCount write FMaxLineCount;
135 end;
136
137 { TScrollableHTMLControl }
138
139 TScrollableHTMLControl = class(TMemo,TIDEHTMLControlIntf)
140 private
141 FProvider: TAbstractIDEHTMLProvider;
142 FURL: string;
143 procedure SetProvider(const AValue: TAbstractIDEHTMLProvider);
144 public
145 constructor Create(AOwner: TComponent); override;
GetURLnull146 function GetURL: string;
147 procedure SetURL(const AValue: string);
148 property Provider: TAbstractIDEHTMLProvider read FProvider write SetProvider;
149 procedure SetHTMLContent(Stream: TStream; const NewURL: string);
150 procedure GetPreferredControlSize(out AWidth, AHeight: integer);
151 end;
152
153 { TIDEHelpDatabases }
154
155 TIDEHelpDatabases = class(THelpDatabases)
156 public
ShowHelpSelectornull157 function ShowHelpSelector({%H-}Query: THelpQuery; Nodes: THelpNodeQueryList;
158 var {%H-}ErrMsg: string;
159 var Selection: THelpNodeQuery
160 ): TShowHelpResult; override;
GetBaseDirectoryForBasePathObjectnull161 function GetBaseDirectoryForBasePathObject(BasePathObject: TObject): string; override;
ShowHelpForSourcePositionnull162 function ShowHelpForSourcePosition(Query: THelpQuerySourcePosition;
163 var ErrMsg: string): TShowHelpResult; override;
SubstituteMacrosnull164 function SubstituteMacros(var s: string): boolean; override;
165 end;
166
167
168 { TIDEHelpManager }
169
170 TIDEHelpManager = class(TBaseHelpManager)
171 // help menu of the IDE menu bar
172 procedure mnuHelpAboutLazarusClicked(Sender: TObject);
173 procedure mnuHelpOnlineHelpClicked(Sender: TObject);
174 procedure mnuHelpReportBugClicked(Sender: TObject);
175 // fpdoc
176 procedure mnuSearchInFPDocFilesClick(Sender: TObject);
177 // messages
178 procedure mnuEditMessageHelpClick(Sender: TObject);
179 private
180 FFCLHelpDB: THelpDatabase;
181 FFCLHelpDBPath: THelpBaseURLObject;
182 FHTMLProviders: TLIHProviders;
183 FLCLHelpDB: THelpDatabase;
184 FLCLHelpDBPath: THelpBaseURLObject;
185 FMainHelpDB: THelpDatabase;
186 FMainHelpDBPath: THelpBasePathObject;
187 FRTLHelpDB: THelpDatabase;
188 FRTLHelpDBPath: THelpBaseURLObject;
189 FLazUtilsHelpDB: THelpDatabase;
190 FLazUtilsHelpDBPath: THelpBaseURLObject;
191
192 procedure RegisterIDEHelpDatabases;
193 procedure RegisterDefaultIDEHelpViewers;
194 procedure FindDefaultBrowser(var DefaultBrowser, Params: string);
CollectKeywordsnull195 function CollectKeywords(CodeBuffer: TCodeBuffer; const CodePos: TPoint;
196 out Identifier: string): TShowHelpResult;
CollectDeclarationsnull197 function CollectDeclarations(CodeBuffer: TCodeBuffer; const CodePos: TPoint;
198 out Complete: boolean; var ErrMsg: string): TShowHelpResult;
199 public
200 constructor Create(TheOwner: TComponent); override;
201 destructor Destroy; override;
202
203 procedure ConnectMainBarEvents; override;
204 procedure LoadHelpOptions; override;
205 procedure SaveHelpOptions; override;
206
207 procedure ShowLazarusHelpStartPage;
208 procedure ShowIDEHelpForContext(HelpContext: THelpContext);
209 procedure ShowIDEHelpForKeyword(const Keyword: string); // an arbitrary keyword, not an FPC keyword
210
ShowHelpForSourcePositionnull211 function ShowHelpForSourcePosition(const Filename: string;
212 const CodePos: TPoint;
213 var ErrMsg: string): TShowHelpResult; override;
214 procedure ShowHelpForMessage; override;
215 procedure ShowHelpForObjectInspector(Sender: TObject); override;
216 procedure ShowHelpForIDEControl(Sender: TControl); override;
GetHintForSourcePositionnull217 function GetHintForSourcePosition(const ExpandedFilename: string;
218 const CodePos: TPoint; out BaseURL, HTMLHint: string;
219 Flags: TIDEHelpManagerCreateHintFlags = []): TShowHelpResult; override;
ConvertSourcePosToPascalHelpContextnull220 function ConvertSourcePosToPascalHelpContext(const CaretPos: TPoint;
221 const Filename: string): TPascalHelpContextList; override;
ConvertCodePosToPascalHelpContextnull222 function ConvertCodePosToPascalHelpContext(
223 ACodePos: PCodeXYPosition): TPascalHelpContextList;
GetFPDocFilenameForSourcenull224 function GetFPDocFilenameForSource(SrcFilename: string;
225 ResolveIncludeFiles: Boolean; out AnOwner: TObject): string; override;
226 public
227 property FCLHelpDB: THelpDatabase read FFCLHelpDB;
228 property FCLHelpDBPath: THelpBaseURLObject read FFCLHelpDBPath;
229 property MainHelpDB: THelpDatabase read FMainHelpDB;
230 property MainHelpDBPath: THelpBasePathObject read FMainHelpDBPath;
231 property LCLHelpDB: THelpDatabase read FLCLHelpDB;
232 property LCLHelpDBPath: THelpBaseURLObject read FLCLHelpDBPath;
233 property RTLHelpDB: THelpDatabase read FRTLHelpDB;
234 property RTLHelpDBPath: THelpBaseURLObject read FRTLHelpDBPath;
235 property LazUtilsHelpDB: THelpDatabase read FLazUtilsHelpDB;
236 property LazUtilsHelpDBPath: THelpBaseURLObject read FLazUtilsHelpDBPath;
237 end;
238
239 { TIDEHintWindowManager }
240
241 TIDEHintWindowManager = class(THintWindowManager)
242 public
HintIsComplexnull243 function HintIsComplex: boolean;
SenderIsHintControlnull244 function SenderIsHintControl(Sender: TObject): Boolean;
PtIsOnHintnull245 function PtIsOnHint(Pt: TPoint): boolean;
246 end;
247
248 { THelpSelectorDialog }
249
250 THelpSelectorDialog = class(TForm)
251 BtnPanel: TButtonPanel;
252 NodesGroupBox: TGroupBox;
253 NodesTreeView: TTreeView;
254 procedure HelpSelectorDialogClose(Sender: TObject; var {%H-}CloseAction: TCloseAction);
255 procedure NodesTreeViewDblClick(Sender: TObject);
256 procedure NodesTreeViewSelectionChanged(Sender: TObject);
257 private
258 FNodes: THelpNodeQueryList;
259 FImgIndexDB, FImgIndexNode: Integer;
260 procedure SetNodes(const AValue: THelpNodeQueryList);
261 procedure FillNodesTV;
262 procedure UpdateButtons;
263 public
264 constructor Create(TheOwner: TComponent); override;
265 property Nodes: THelpNodeQueryList read FNodes write SetNodes;
GetSelectedNodeQuerynull266 function GetSelectedNodeQuery: THelpNodeQuery;
267 end;
268
269 { Help Contexts for IDE help }
270 const
271 lihcStartPage = 'StartPage';
272 lihcRTLUnits = 'RTLUnits';
273 lihcFCLUnits = 'FCLUnits';
274 lihcLCLUnits = 'LCLUnits';
275 lihcLazUtilsUnits = 'LazUtilsUnits';
276
277
278 lihBaseUrl = 'http://lazarus-ccr.sourceforge.net/docs/';
279
280 lihRTLURL = lihBaseUrl+'rtl/';
281 lihFCLURL = lihBaseUrl+'fcl/';
282 lihLCLURL = lihBaseUrl+'lcl/';
283
284 lihLazUtilsURL = 'lazutils.chm://';
285 // not important see: ../components/chmhelp/packages/idehelp/lazchmhelp.pas
286
287 var
288 HelpBoss: TBaseHelpManager = nil;
289
290 implementation
291
292 {$R *.lfm}
293
294 // Default help control generator if no other is registered.
LazCreateIDEHTMLControlnull295 function LazCreateIDEHTMLControl(Owner: TComponent;
296 var Provider: TAbstractIDEHTMLProvider;
297 Flags: TIDEHTMLControlFlags): TControl;
298 begin
299 if ihcScrollable in Flags then
300 Result:=TScrollableHTMLControl.Create(Owner)
301 else
302 Result:=TSimpleHTMLControl.Create(Owner);
303 if Provider=nil then
304 Provider:=CreateIDEHTMLProvider(Result);
305 if ihcScrollable in Flags then
306 begin
307 Provider.ControlIntf:=TScrollableHTMLControl(Result);
308 TScrollableHTMLControl(Result).Provider:=Provider;
309 end
310 else
311 begin
312 Provider.ControlIntf:=TSimpleHTMLControl(Result);
313 TSimpleHTMLControl(Result).Provider:=Provider;
314 end;
315 end;
316
317 // Default provider generator if no other is registered.
LazCreateIDEHTMLProvidernull318 function LazCreateIDEHTMLProvider(Owner: TComponent): TAbstractIDEHTMLProvider;
319 begin
320 Result:=TLazIDEHTMLProvider.Create(Owner);
321 TLazIDEHTMLProvider(Result).Providers:=TIDEHelpManager(HelpBoss).FHTMLProviders;
322 end;
323
CompareLIHProviderStreamnull324 function CompareLIHProviderStream(Data1, Data2: Pointer): integer;
325 begin
326 Result:=CompareStr(TLIHProviderStream(Data1).URL,TLIHProviderStream(Data2).URL);
327 end;
328
CompareURLWithLIHProviderStreamnull329 function CompareURLWithLIHProviderStream(URL, Stream: Pointer): integer;
330 begin
331 Result:=CompareStr(AnsiString(URL),TLIHProviderStream(Stream).URL);
332 end;
333
334 { TSimpleFPCKeywordHelpDatabase }
335
GetNodesForKeywordnull336 function TSimpleFPCKeywordHelpDatabase.GetNodesForKeyword(
337 const HelpKeyword: string; var ListOfNodes: THelpNodeQueryList;
338 var ErrMsg: string): TShowHelpResult;
339 var
340 KeyWord: String;
341 begin
342 Result:=shrHelpNotFound;
343 if (csDesigning in ComponentState) then exit;
344 if (FPCKeyWordHelpPrefix<>'')
345 and (LeftStr(HelpKeyword,length(FPCKeyWordHelpPrefix))=FPCKeyWordHelpPrefix) then begin
346 // HelpKeyword starts with KeywordPrefix
347 KeyWord:=copy(HelpKeyword,length(FPCKeyWordHelpPrefix)+1,length(HelpKeyword));
348 // test: testfcpkeyword
349 if KeyWord='testfcpkeyword' then begin
350 // this help database knows this keyword
351 // => add a node, so that if there are several possibilities the IDE can
352 // show the user a dialog to choose
353 if FKeywordPrefixNode=nil then
354 FKeywordPrefixNode:=THelpNode.CreateURL(Self,'','');
355 FKeywordPrefixNode.Title:='Pascal keyword '+KeyWord;
356 CreateNodeQueryListAndAdd(FKeywordPrefixNode,nil,ListOfNodes,true);
357 Result:=shrSuccess;
358 end;
359 end;
360 end;
361
TSimpleFPCKeywordHelpDatabase.ShowHelpnull362 function TSimpleFPCKeywordHelpDatabase.ShowHelp(Query: THelpQuery; BaseNode,
363 NewNode: THelpNode; QueryItem: THelpQueryItem; var ErrMsg: string
364 ): TShowHelpResult;
365 var
366 KeywordQuery: THelpQueryKeyword;
367 KeyWord: String;
368 begin
369 Result:=shrHelpNotFound;
370 if not (Query is THelpQueryKeyword) then exit;
371 KeywordQuery:=THelpQueryKeyword(Query);
372 KeyWord:=copy(KeywordQuery.Keyword,length(FPCKeyWordHelpPrefix)+1,length(KeywordQuery.Keyword));
373 debugln(['TSimpleFPCKeywordHelpDatabase.ShowHelp Keyword=',Keyword]);
374 // ToDo: implement me
375 ErrMsg:='';
376 end;
377
378 { TSimpleHTMLControl }
379
380 procedure TSimpleHTMLControl.SetProvider(const AValue: TAbstractIDEHTMLProvider);
381 begin
382 if FProvider=AValue then exit;
383 FProvider:=AValue;
384 end;
385
386 constructor TSimpleHTMLControl.Create(AOwner: TComponent);
387 begin
388 inherited Create(AOwner);
389 MaxLineCount:=30;
390 WordWrap := True;
391 Layout := tlCenter;
392 Alignment := taLeftJustify;
393 Font.Color := clInfoText;
394 BorderSpacing.Around := 4;
395 ShowAccelChar := False; //don't underline after &
396 end;
397
GetURLnull398 function TSimpleHTMLControl.GetURL: string;
399 begin
400 Result:=FURL;
401 end;
402
403 procedure TSimpleHTMLControl.SetURL(const AValue: string);
404 var
405 Stream: TStream;
406 Renderer: THTML2TextRenderer;
407 NewURL: String;
408 begin
409 if Provider=nil then raise Exception.Create('TSimpleHTMLControl.SetURL missing Provider');
410 if FURL=AValue then exit;
411 NewURL:=Provider.MakeURLAbsolute(Provider.BaseURL,AValue);
412 if FURL=NewURL then exit;
413 FURL:=NewURL;
414 try
415 Stream:=Provider.GetStream(FURL,true);
416 Renderer:=THTML2TextRenderer.Create(Stream);
417 try
418 Caption:=Renderer.Render(MaxLineCount);
419 finally
420 Renderer.Free;
421 Provider.ReleaseStream(FURL);
422 end;
423 except
424 on E: Exception do begin
425 Caption:=E.Message;
426 end;
427 end;
428 end;
429
430 procedure TSimpleHTMLControl.SetHTMLContent(Stream: TStream; const NewURL: string);
431 var
432 Renderer: THTML2TextRenderer;
433 begin
434 FURL:=NewURL;
435 Renderer:=THTML2TextRenderer.Create(Stream);
436 try
437 Caption:=Renderer.Render(MaxLineCount);
438 finally
439 Renderer.Free;
440 end;
441 //debugln(['TSimpleHTMLControl.SetHTMLContent: ',Caption]);
442 end;
443
444 procedure TSimpleHTMLControl.GetPreferredControlSize(out AWidth, AHeight: integer);
445 var
446 DC: HDC;
447 R: TRect;
448 OldFont: HGDIOBJ;
449 Flags: Cardinal;
450 LabelText: String;
451 begin
452 AWidth:=0;
453 AHeight:=0;
454 DC := GetDC(Parent.Handle);
455 try
456 R := Rect(0, 0, 600, 200);
457 OldFont := SelectObject(DC, HGDIOBJ(Font.Reference.Handle));
458 Flags := DT_CALCRECT or DT_EXPANDTABS;
459 inc(Flags, DT_WordBreak);
460 LabelText := GetLabelText;
461 DrawText(DC, PChar(LabelText), Length(LabelText), R, Flags);
462 SelectObject(DC, OldFont);
463 AWidth := R.Right - R.Left + 8; // border
464 AHeight := R.Bottom - R.Top + 8; // border
465 finally
466 ReleaseDC(Parent.Handle, DC);
467 end;
468 //DebugLn(['TSimpleHTMLControl.GetPreferredControlSize Caption="',Caption,'" ',AWidth,'x',AHeight]);
469 end;
470
471 { TScrollableHTMLControl }
472
473 procedure TScrollableHTMLControl.SetProvider(const AValue: TAbstractIDEHTMLProvider);
474 begin
475 if FProvider=AValue then exit;
476 FProvider:=AValue;
477 end;
478
479 constructor TScrollableHTMLControl.Create(AOwner: TComponent);
480 begin
481 inherited Create(AOwner);
482 BorderSpacing.Around := 4;
483 BorderStyle := bsNone;
484 ReadOnly := True;
485 ScrollBars := ssAutoVertical;
486 end;
487
GetURLnull488 function TScrollableHTMLControl.GetURL: string;
489 begin
490 Result:=FURL;
491 end;
492
493 procedure TScrollableHTMLControl.SetURL(const AValue: string);
494 var
495 Stream: TStream;
496 Renderer: THTML2TextRenderer;
497 NewURL: String;
498 begin
499 if Provider=nil then raise Exception.Create('TScrollableHTMLControl.SetURL missing Provider');
500 if FURL=AValue then exit;
501 NewURL:=Provider.MakeURLAbsolute(Provider.BaseURL,AValue);
502 if FURL=NewURL then exit;
503 FURL:=NewURL;
504 try
505 Stream:=Provider.GetStream(FURL,true);
506 Renderer:=THTML2TextRenderer.Create(Stream);
507 try
508 Caption:=Renderer.Render;
509 finally
510 Renderer.Free;
511 Provider.ReleaseStream(FURL);
512 end;
513 except
514 on E: Exception do begin
515 Caption:=E.Message;
516 end;
517 end;
518 end;
519
520 procedure TScrollableHTMLControl.SetHTMLContent(Stream: TStream; const NewURL: string);
521 var
522 Renderer: THTML2TextRenderer;
523 begin
524 FURL:=NewURL;
525 Renderer:=THTML2TextRenderer.Create(Stream);
526 try
527 Caption:=Renderer.Render;
528 finally
529 Renderer.Free;
530 end;
531 //debugln(['TScrollableHTMLControl.SetHTMLContent: ',Caption]);
532 end;
533
534 procedure TScrollableHTMLControl.GetPreferredControlSize(out AWidth, AHeight: integer);
535 begin
536 AWidth:=0;
537 AHeight:=0;
538 GetPreferredSize(AWidth, AHeight);
539 end;
540
541 { TLazIDEHTMLProvider }
542
543 procedure TLazIDEHTMLProvider.SetProviders(const AValue: TLIHProviders);
544 begin
545 if FProviders=AValue then exit;
546 FProviders:=AValue;
547 end;
548
549 procedure TLazIDEHTMLProvider.OpenNextURL(Data: PtrInt);
550 var
551 URLScheme: string;
552 URLPath: string;
553 URLParams: string;
554 AFilename: String;
555 p: TPoint;
556 begin
557 fWaitingForAsync:=false;
558 SplitURL(NextURL,URLScheme,URLPath,URLParams);
559 debugln(['TLazIDEHTMLProvider.OpenNextURL "',URLScheme,'" :// "',URLPath,'" & "',URLParams,'"']);
560 if URLScheme='source' then begin
561 p:=Point(1,1);
562 if REMatches(URLPath,'(.*)\((.*),(.*)\)') then begin
563 AFilename:=REVar(1);
564 p.Y:=StrToIntDef(REVar(2),p.x);
565 p.X:=StrToIntDef(REVar(3),p.y);
566 end else begin
567 AFilename:=URLPath;
568 end;
569 AFilename:=GetForcedPathDelims(AFilename);
570 LazarusIDE.DoOpenFileAndJumpToPos(AFilename,p,-1,-1,-1,[]);
571 end else if (URLScheme='openpackage') and IsValidIdent(URLPath) then begin
572 PackageEditingInterface.DoOpenPackageWithName(URLPath,[],false);
573 end else if (URLScheme='fpdoc') and (URLParams<>'') then begin
574 OpenFPDoc(URLParams);
575 end;
576 end;
577
578 procedure TLazIDEHTMLProvider.OpenFPDoc(Path: string);
579 var
580 RestPath: string;
581
582 function ExtractSubPath: string;
583 var
584 p: SizeInt;
585 begin
586 p:=System.Pos('.',RestPath);
587 if p<1 then p:=length(RestPath)+1;
588 Result:=copy(RestPath,1,p-1);
589 RestPath:=copy(RestPath,p+1,length(RestPath));
590 end;
591
592 procedure InvalidPathError(Msg: string);
593 begin
594 debugln(['InvalidPathError Path="',Path,'" Msg="',Msg,'"']);
595 IDEMessageDialog('Unable to open fpdoc help',
596 'The fpdoc path "'+Path+'" is invalid.'+LineEnding+Msg,
597 mtError,[mbCancel]);
598 end;
599
600 var
601 PkgName: String;
602 Pkg: TLazPackage;
603 AnUnitName: String;
604 PkgFile: TPkgFile;
605 ContextList: TPascalHelpContextList;
606 ElementName: String;
607 Filename: String;
608 ErrMsg: string;
609 PascalHelpContextLists: TList;
610 i: Integer;
611 PkgList: TFPList;
612 SubPkg: TLazPackage;
613 begin
614 RestPath:=Path;
615 PkgName:=ExtractSubPath;
616 if (PkgName='') or (PkgName[1]<>'#') then begin
617 InvalidPathError('It does not start with a package name, for example #rtl.');
618 exit;
619 end;
620 PkgName:=copy(PkgName,2,length(PkgName));
621 if not IsValidIdent(PkgName) then begin
622 InvalidPathError('It does not start with a package name, for example #rtl.');
623 exit;
624 end;
625 if SysUtils.CompareText(PkgName,'rtl')=0 then PkgName:='fcl';
626 Pkg:=TLazPackage(PackageEditingInterface.FindPackageWithName(PkgName));
627 if Pkg=nil then begin
628 InvalidPathError('Package "'+PkgName+'" not found.');
629 exit;
630 end;
631 if Pkg.IsVirtual then begin
632 InvalidPathError('Package "'+PkgName+'" has no help.');
633 exit;
634 end;
635
636 AnUnitName:=ExtractSubPath;
637 if not IsValidIdent(AnUnitName) then begin
638 InvalidPathError('Unit name "'+AnUnitName+'" is invalid.');
639 exit;
640 end;
641
642 Filename:='';
643 PkgFile:=Pkg.FindUnit(AnUnitName);
644 if PkgFile=nil then begin
645 // search in all sub packages
646 PkgList:=nil;
647 try
648 PackageGraph.GetAllRequiredPackages(nil,Pkg.FirstRequiredDependency,
649 PkgList);
650 if PkgList<>nil then begin
651 for i:=0 to PkgList.Count-1 do begin
652 SubPkg:=TLazPackage(PkgList[i]);
653 PkgFile:=SubPkg.FindUnit(AnUnitName);
654 if PkgFile<>nil then begin
655 Pkg:=SubPkg;
656 break;
657 end;
658 end;
659 end;
660 finally
661 PkgList.Free;
662 end;
663 end;
664 if (PkgFile<>nil) and (PkgFile.FileType in PkgFileRealUnitTypes) then begin
665 // normal unit in lpk
666 Filename:=PkgFile.GetFullFilename;
667 end else if SysUtils.CompareText(PkgName,'fcl')=0 then begin
668 // search in FPC sources
669 Filename:=CodeToolBoss.DirectoryCachePool.FindUnitInUnitSet('',AnUnitName);
670 end;
671 if Filename='' then begin
672 InvalidPathError('Unit "'+AnUnitName+'" was not found in package '+Pkg.Name+'.');
673 exit;
674 end;
675
676 PascalHelpContextLists:=TList.Create;
677 try
678 // create a context list (and add it as sole element to the PascalHelpContextLists)
679 ContextList:=TPascalHelpContextList.Create;
680 PascalHelpContextLists.Add(ContextList);
681 ContextList.Add(pihcFilename,Filename);
682 ContextList.Add(pihcSourceName,AnUnitName);
683 repeat
684 ElementName:=ExtractSubPath;
685 if ElementName='' then break;
686 ContextList.Add(pihcType,ElementName);
687 until false;
688 ErrMsg:='TLazIDEHTMLProvider.OpenFPDoc ShowHelpForPascalContexts';
689 ShowHelpForPascalContexts(Filename,Point(1,1),PascalHelpContextLists,ErrMsg);
690 finally
691 if PascalHelpContextLists<>nil then begin
692 for i:=0 to PascalHelpContextLists.Count-1 do
693 TObject(PascalHelpContextLists[i]).Free;
694 PascalHelpContextLists.Free;
695 end;
696 end;
697 end;
698
699 destructor TLazIDEHTMLProvider.Destroy;
700 begin
701 if (Application<>nil) and fWaitingForAsync then
702 Application.RemoveAsyncCalls(Self);
703 inherited Destroy;
704 end;
705
URLHasStreamnull706 function TLazIDEHTMLProvider.URLHasStream(const URL: string): boolean;
707 var
708 URLScheme: string;
709 URLPath: string;
710 URLParams: string;
711 begin
712 Result:=false;
713 SplitURL(URL,URLScheme,URLPath,URLParams);
714 if (URLScheme='file') or (URLScheme='lazdoc') or (URLScheme='fpdoc') then
715 Result:=true;
716 end;
717
718 procedure TLazIDEHTMLProvider.OpenURLAsync(const URL: string);
719 begin
720 NextURL:=URL;
721 //debugln(['TLazIDEHTMLProvider.OpenURLAsync URL=',URL]);
722 if not fWaitingForAsync then begin
723 Application.QueueAsyncCall(@OpenNextURL,0);
724 fWaitingForAsync:=true;
725 end;
726 end;
727
GetStreamnull728 function TLazIDEHTMLProvider.GetStream(const URL: string; Shared: Boolean): TStream;
729 begin
730 Result:=FProviders.GetStream(URL,Shared);
731 end;
732
733 procedure TLazIDEHTMLProvider.ReleaseStream(const URL: string);
734 begin
735 FProviders.ReleaseStream(URL);
736 end;
737
738 { TLIHProviders }
739
740 constructor TLIHProviders.Create;
741 begin
742 FStreams:=TAVLTree.Create(@CompareLIHProviderStream);
743 end;
744
745 destructor TLIHProviders.Destroy;
746 begin
747 FStreams.FreeAndClear;
748 FreeAndNil(FStreams);
749 inherited Destroy;
750 end;
751
FindStreamnull752 function TLIHProviders.FindStream(const URL: string; CreateIfNotExists: Boolean
753 ): TLIHProviderStream;
754 var
755 Node: TAVLTreeNode;
756 begin
757 if URL='' then
758 exit(nil);
759 Node:=FStreams.FindKey(Pointer(URL),@CompareURLWithLIHProviderStream);
760 if Node<>nil then begin
761 Result:=TLIHProviderStream(Node.Data);
762 end else if CreateIfNotExists then begin
763 Result:=TLIHProviderStream.Create;
764 Result.URL:=URL;
765 FStreams.Add(Result);
766 end else
767 Result:=nil;
768 end;
769
GetStreamnull770 function TLIHProviders.GetStream(const URL: string; Shared: boolean): TStream;
771
772 procedure OpenFile(out Stream: TStream; const Filename: string;
773 UseCTCache: boolean);
774 var
775 fs: TFileStream;
776 ok: Boolean;
777 Buf: TCodeBuffer;
778 ms: TMemoryStream;
779 begin
780 if UseCTCache then begin
781 Buf:=CodeToolBoss.LoadFile(Filename,true,false);
782 if Buf=nil then
783 raise Exception.Create('TLIHProviders.GetStream: unable to open file '+Filename);
784 ms:=TMemoryStream.Create;
785 Buf.SaveToStream(ms);
786 ms.Position:=0;
787 Result:=ms;
788 end else begin
789 fs:=nil;
790 ok:=false;
791 try
792 DebugLn(['TLIHProviders.GetStream.OpenFile ',Filename]);
793 fs:=TFileStream.Create(Filename,fmOpenRead);
794 Stream:=fs;
795 ok:=true;
796 finally
797 if not ok then
798 fs.Free;
799 end;
800 end;
801 end;
802
803
804 {const
805 HTML =
806 '<HTML>'+#10
807 +'<BODY>'+#10
808 +'Test'+#10
809 +'</BODY>'+#10
810 +'</HTML>';}
811 var
812 Stream: TLIHProviderStream;
813 URLType: string;
814 URLPath: string;
815 URLParams: string;
816 begin
817 if URL='' then raise Exception.Create('TLIHProviders.GetStream no URL');
818 if Shared then begin
819 Stream:=FindStream(URL,true);
820 Stream.IncreaseRefCount;
821 Result:=Stream.Stream;
822 end else begin
823 Stream:=nil;
824 Result:=nil;
825 end;
826 try
827 if Result=nil then begin
828 SplitURL(URL,URLType,URLPath,URLParams);
829 {$ifdef VerboseLazDoc}
830 DebugLn(['TLIHProviders.GetStream URLType=',URLType,' URLPath=',URLPath,' URLParams=',URLParams]);
831 {$endif}
832 if URLType='lazdoc' then begin
833 if copy(URLPath,1,8)='lazarus/' then begin
834 URLPath:=copy(URLPath,9,length(URLPath));
835 if (URLPath='index.html')
836 or (URLPath='images/laztitle.jpg')
837 or (URLPath='images/cheetah1.png')
838 or (URLPath='lazdoc.css')
839 then begin
840 OpenFile(Result,
841 EnvironmentOptions.GetParsedLazarusDirectory
842 +GetForcedPathDelims('/docs/'+URLPath),
843 true);
844 end;
845 end;
846 end else if URLType='file' then begin
847 OpenFile(Result,GetForcedPathDelims(URLPath),true);
848 end;
849 {Result:=TMemoryStream.Create;
850 Stream.Stream:=Result;
851 Result.Write(HTML[1],length(HTML));
852 Result.Position:=0;}
853 if Result=nil then
854 raise Exception.Create('TLIHProviders.GetStream: URL not found "'+dbgstr(URL)+'"');
855 if Stream<>nil then
856 Stream.Stream:=Result;
857 end;
858 finally
859 if (Result=nil) and (Stream<>nil) then
860 ReleaseStream(URL);
861 end;
862 end;
863
864 procedure TLIHProviders.ReleaseStream(const URL: string);
865 var
866 Stream: TLIHProviderStream;
867 begin
868 Stream:=FindStream(URL,false);
869 if Stream=nil then
870 raise Exception.Create('TLIHProviders.ReleaseStream "'+URL+'"');
871 Stream.DecreaseRefCount;
872 if Stream.RefCount=0 then begin
873 FStreams.Remove(Stream);
874 Stream.Free;
875 end;
876 end;
877
878 { TLIHProviderStream }
879
880 destructor TLIHProviderStream.Destroy;
881 begin
882 FreeAndNil(Stream);
883 inherited Destroy;
884 end;
885
886 procedure TLIHProviderStream.IncreaseRefCount;
887 begin
888 inc(FRefCount);
889 end;
890
891 procedure TLIHProviderStream.DecreaseRefCount;
892 begin
893 if FRefCount<=0 then
894 raise Exception.Create('TLIHProviderStream.DecreaseRefCount');
895 dec(FRefCount);
896 end;
897
898 { THelpSelectorDialog }
899
900 procedure THelpSelectorDialog.HelpSelectorDialogClose(Sender: TObject;
901 var CloseAction: TCloseAction);
902 begin
903 IDEDialogLayoutList.SaveLayout(Self);
904 end;
905
906 procedure THelpSelectorDialog.NodesTreeViewDblClick(Sender: TObject);
907 begin
908 ModalResult := mrOK;
909 end;
910
911 procedure THelpSelectorDialog.NodesTreeViewSelectionChanged(Sender: TObject);
912 begin
913 UpdateButtons;
914 end;
915
916 procedure THelpSelectorDialog.SetNodes(const AValue: THelpNodeQueryList);
917 begin
918 if FNodes=AValue then exit;
919 FNodes:=AValue;
920 FillNodesTV;
921 end;
922
923 procedure THelpSelectorDialog.FillNodesTV;
924 var
925 i: Integer;
926 NodeQuery: THelpNodeQuery;
927 Node: THelpNode;
928 DB: THelpDatabase;
929 DBTVNode, TVNode: TTreeNode;
930 begin
931 NodesTreeView.BeginUpdate;
932 try
933 TVNode:=nil;
934 NodesTreeView.Items.Clear;
935 if (Nodes<>nil) then begin
936 for i:=0 to Nodes.Count-1 do begin
937 NodeQuery:=Nodes[i];
938 Node:=NodeQuery.Node;
939 DB:=Node.Owner;
940
941 DBTVNode:=NodesTreeView.Items.FindTopLvlNode(DB.ID);
942 if DBTVNode=nil then
943 begin
944 DBTVNode:=NodesTreeView.Items.AddChild(nil,DB.ID);
945 DBTVNode.ImageIndex:=FImgIndexDB;
946 DBTVNode.SelectedIndex:=FImgIndexDB;
947 end;
948
949 TVNode:=NodesTreeView.Items.AddChild(DBTVNode,NodeQuery.AsString);
950 TVNode.ImageIndex:=FImgIndexNode;
951 TVNode.SelectedIndex:=FImgIndexNode;
952 TVNode.Data:=NodeQuery;
953
954 DBTVNode.Expand(true);
955 end;
956 end;
957 NodesTreeView.Selected:=TVNode;
958 finally
959 NodesTreeView.EndUpdate;
960 end;
961 end;
962
963 procedure THelpSelectorDialog.UpdateButtons;
964 begin
965 BtnPanel.OKButton.Enabled:=GetSelectedNodeQuery<>nil;
966 end;
967
968 constructor THelpSelectorDialog.Create(TheOwner: TComponent);
969 begin
970 inherited Create(TheOwner);
971 IDEDialogLayoutList.ApplyLayout(Self,500,300);
972
973 Caption := lisHelpSelectorDialog;
974 NodesGroupBox.Caption:=lisSelectAHelpItem;
975 BtnPanel.OKButton.Caption:=lisMenuOk;
976
977 NodesTreeView.Images:=IDEImages.Images_16;
978 FImgIndexDB:=IDEImages.LoadImage('item_package');
979 FImgIndexNode:=IDEImages.LoadImage('btn_help');
980 end;
981
GetSelectedNodeQuerynull982 function THelpSelectorDialog.GetSelectedNodeQuery: THelpNodeQuery;
983 var
984 TVNode: TTreeNode;
985 begin
986 Result:=nil;
987 TVNode:=NodesTreeView.Selected;
988 if (TVNode=nil) or (TVNode.Data=nil) then exit;
989 Result:=TObject(TVNode.Data) as THelpNodeQuery;
990 end;
991
992 { TIDEHelpDatabases }
993
ShowHelpSelectornull994 function TIDEHelpDatabases.ShowHelpSelector(Query: THelpQuery;
995 Nodes: THelpNodeQueryList;
996 var ErrMsg: string;
997 var Selection: THelpNodeQuery
998 ): TShowHelpResult;
999 var
1000 Dialog: THelpSelectorDialog;
1001 begin
1002 Selection:=nil;
1003 Result:=shrNone;
1004 Dialog:=THelpSelectorDialog.Create(nil);
1005 try
1006 Dialog.Nodes:=Nodes;
1007 if Dialog.ShowModal=mrOk then begin
1008 Selection:=Dialog.GetSelectedNodeQuery;
1009 if Selection<>nil then
1010 Result:=shrSuccess;
1011 end else begin
1012 Result:=shrCancel;
1013 end;
1014 finally
1015 Dialog.Free;
1016 end;
1017 end;
1018
GetBaseDirectoryForBasePathObjectnull1019 function TIDEHelpDatabases.GetBaseDirectoryForBasePathObject(
1020 BasePathObject: TObject): string;
1021 var
1022 s: String;
1023 begin
1024 Result:='';
1025 DebugLn('TIDEHelpDatabases.GetBaseDirectoryForBasePathObject BasePathObject=',dbgsName(BasePathObject));
1026 if (BasePathObject is THelpBasePathObject) then
1027 Result:=THelpBasePathObject(BasePathObject).BasePath
1028 else if (BasePathObject=HelpBoss) or (BasePathObject=MainIDEInterface) then
1029 Result:=EnvironmentOptions.GetParsedLazarusDirectory
1030 else if BasePathObject is TProject then
1031 Result:=TProject(BasePathObject).Directory
1032 else if BasePathObject is TLazPackage then
1033 Result:=TLazPackage(BasePathObject).Directory;
1034 if Result<>'' then begin
1035 s:=Result;
1036 if not IDEMacros.SubstituteMacros(Result) then
1037 debugln(['TIDEHelpDatabases.GetBaseDirectoryForBasePathObject macros failed "',s,'"']);
1038 end;
1039 Result:=AppendPathDelim(Result);
1040 end;
1041
ShowHelpForSourcePositionnull1042 function TIDEHelpDatabases.ShowHelpForSourcePosition(
1043 Query: THelpQuerySourcePosition; var ErrMsg: string): TShowHelpResult;
1044 begin
1045 Result:=HelpBoss.ShowHelpForSourcePosition(Query.Filename,
1046 Query.SourcePosition,ErrMsg);
1047 end;
1048
SubstituteMacrosnull1049 function TIDEHelpDatabases.SubstituteMacros(var s: string): boolean;
1050 begin
1051 Result:=IDEMacros.SubstituteMacros(s);
1052 end;
1053
1054 { TIDEHelpManager }
1055
1056 procedure TIDEHelpManager.mnuSearchInFPDocFilesClick(Sender: TObject);
1057 begin
1058 ShowFPDocFileSearch;
1059 end;
1060
1061 procedure TIDEHelpManager.mnuEditMessageHelpClick(Sender: TObject);
1062 begin
1063
1064 end;
1065
1066 procedure TIDEHelpManager.mnuHelpAboutLazarusClicked(Sender: TObject);
1067 begin
1068 ShowAboutForm;
1069 end;
1070
1071 procedure TIDEHelpManager.mnuHelpOnlineHelpClicked(Sender: TObject);
1072 begin
1073 ShowLazarusHelpStartPage;
1074 end;
1075
1076 procedure TIDEHelpManager.mnuHelpReportBugClicked(Sender: TObject);
1077 begin
1078 OpenURL(lisReportingBugURL);
1079 end;
1080
1081 procedure TIDEHelpManager.RegisterIDEHelpDatabases;
1082
1083 procedure CreateMainIDEHelpDB;
1084 var
1085 StartNode: THelpNode;
1086 HTMLHelp: THTMLHelpDatabase;
1087 begin
1088 FMainHelpDB:=HelpDatabases.CreateHelpDatabase(lihcStartPage,
1089 THTMLHelpDatabase,true);
1090 HTMLHelp:=FMainHelpDB as THTMLHelpDatabase;
1091 FMainHelpDBPath:=THelpBasePathObject.Create('$(LazarusDir)/docs');
1092 HTMLHelp.BasePathObject:=FMainHelpDBPath;
1093
1094 // HTML nodes for the IDE
1095 StartNode:=THelpNode.CreateURLID(HTMLHelp,'Lazarus',
1096 'file://index.html',lihcStartPage);
1097 HTMLHelp.TOCNode:=THelpNode.Create(HTMLHelp,StartNode);// once as TOC
1098 HTMLHelp.RegisterItemWithNode(StartNode);// and once as normal page
1099 end;
1100
1101 procedure CreateRTLHelpDB;
1102 var
1103 HTMLHelp: TFPDocHTMLHelpDatabase;
1104 FPDocNode: THelpNode;
1105 DirItem: THelpDBISourceDirectory;
1106 begin
1107 FRTLHelpDB:=HelpDatabases.CreateHelpDatabase(lihcRTLUnits,
1108 TFPDocHTMLHelpDatabase,true);
1109 HTMLHelp:=FRTLHelpDB as TFPDocHTMLHelpDatabase;
1110 HTMLHelp.DefaultBaseURL:=lihRTLURL;
1111 FRTLHelpDBPath:=THelpBaseURLObject.Create;
1112 HTMLHelp.BasePathObject:=FRTLHelpDBPath;
1113
1114 // FPDoc nodes for units in the RTL
1115 FPDocNode:=THelpNode.CreateURL(HTMLHelp,
1116 'RTL - Free Pascal Run Time Library Units',
1117 'file://index.html');
1118 HTMLHelp.TOCNode:=THelpNode.Create(HTMLHelp,FPDocNode);// once as TOC
1119 DirItem:=THelpDBISourceDirectories.Create(FPDocNode,'$(FPCSrcDir)',
1120 'rtl;packages/rtl-console/src;packages/rtl-extra/src;packages/rtl-objpas/src;packages/rtl-unicode/src',
1121 '*.pp;*.pas',true);// and once as normal page
1122 HTMLHelp.RegisterItem(DirItem);
1123 end;
1124
1125 procedure CreateFCLHelpDB;
1126 var
1127 HTMLHelp: TFPDocHTMLHelpDatabase;
1128 FPDocNode: THelpNode;
1129 DirItem: THelpDBISourceDirectory;
1130 begin
1131 FFCLHelpDB:=HelpDatabases.CreateHelpDatabase(lihcFCLUnits,
1132 TFPDocHTMLHelpDatabase,true);
1133 HTMLHelp:=FFCLHelpDB as TFPDocHTMLHelpDatabase;
1134 HTMLHelp.DefaultBaseURL:=lihFCLURL;
1135 FFCLHelpDBPath:=THelpBaseURLObject.Create;
1136 HTMLHelp.BasePathObject:=FFCLHelpDBPath;
1137
1138 // FPDoc nodes for units in the FCL
1139 // create TOC
1140 HTMLHelp.TOCNode:=THelpNode.CreateURL(HTMLHelp,
1141 'FCL - Free Pascal Component Library Units',
1142 'file://index.html');
1143
1144 // FPC 2.0.x FCL source directory
1145 FPDocNode:=THelpNode.CreateURL(HTMLHelp,
1146 'FCL - Free Pascal Component Library Units (2.0.x)',
1147 'file://index.html');
1148 DirItem:=THelpDBISourceDirectory.Create(FPDocNode,
1149 '$(FPCSrcDir)/fcl/inc','*.pp;*.pas',false);
1150 HTMLHelp.RegisterItem(DirItem);
1151
1152 // FPC 2.2.x FCL source directory
1153 FPDocNode:=THelpNode.CreateURL(HTMLHelp,
1154 'FCL - Free Pascal Component Library Units',
1155 'file://index.html');
1156 DirItem:=THelpDBISourceDirectory.Create(FPDocNode,
1157 '$(FPCSrcDir)/packages/fcl-base/src','*.pp;*.pas',true);
1158 HTMLHelp.RegisterItem(DirItem);
1159
1160 // FPC 2.4.4+ FCL source directory
1161 FPDocNode:=THelpNode.CreateURL(HTMLHelp,
1162 'FCL - Free Pascal Component Library Units',
1163 'file://index.html');
1164 DirItem:=THelpDBISourceDirectories.Create(FPDocNode,'$(FPCSrcDir)/packages',
1165 'fcl-base/src;fcl-db/src;fcl-extra/src;fcl-process/src;fcl-web/src;paszlib/src',
1166 '*.pp;*.pas',true);
1167 HTMLHelp.RegisterItem(DirItem);
1168 end;
1169
1170 procedure CreateLCLHelpDB;
1171 var
1172 HTMLHelp: TFPDocHTMLHelpDatabase;
1173 FPDocNode: THelpNode;
1174 DirItem: THelpDBISourceDirectory;
1175 begin
1176 FLCLHelpDB:=HelpDatabases.CreateHelpDatabase(lihcLCLUnits,
1177 TFPDocHTMLHelpDatabase,true);
1178 HTMLHelp:=FLCLHelpDB as TFPDocHTMLHelpDatabase;
1179 HTMLHelp.DefaultBaseURL:=lihLCLURL;
1180 FLCLHelpDBPath:=THelpBaseURLObject.Create;
1181 HTMLHelp.BasePathObject:=FLCLHelpDBPath;
1182
1183 // FPDoc nodes for units in the LCL
1184 FPDocNode:=THelpNode.CreateURL(HTMLHelp,
1185 'LCL - Lazarus Component Library Units',
1186 'file://index.html');
1187 HTMLHelp.TOCNode:=THelpNode.Create(HTMLHelp,FPDocNode);// once as TOC
1188 DirItem:=THelpDBISourceDirectory.Create(FPDocNode,'$(LazarusDir)/lcl',
1189 '*.pp;*.pas',true);// and once as normal page
1190 HTMLHelp.RegisterItem(DirItem);
1191 end;
1192
1193 procedure CreateLazUtilsHelpDB;
1194 var
1195 HTMLHelp: TFPDocHTMLHelpDatabase;
1196 FPDocNode: THelpNode;
1197 DirItem: THelpDBISourceDirectory;
1198 begin
1199 FLazUtilsHelpDB:=HelpDatabases.CreateHelpDatabase(lihcLazUtilsUnits,
1200 TFPDocHTMLHelpDatabase,true);
1201 HTMLHelp:=FLazUtilsHelpDB as TFPDocHTMLHelpDatabase;
1202 HTMLHelp.DefaultBaseURL:=lihLazUtilsURL;
1203 FLazUtilsHelpDBPath:=THelpBaseURLObject.Create;
1204 HTMLHelp.BasePathObject:=FLazUtilsHelpDBPath;
1205
1206 // FPDoc nodes for units in the LazUtils
1207 FPDocNode:=THelpNode.CreateURL(HTMLHelp,
1208 'LazUtils - Lazarus Utilities Library Units',
1209 'file://index.html');
1210 HTMLHelp.TOCNode:=THelpNode.Create(HTMLHelp,FPDocNode);// once as TOC
1211 DirItem:=THelpDBISourceDirectory.Create(FPDocNode,
1212 '$(LazarusDir)/components/lazutils',
1213 '*.pp;*.pas',true);// and once as normal page
1214 HTMLHelp.RegisterItem(DirItem);
1215 end;
1216
1217 procedure CreateFPCKeywordsHelpDB;
1218 begin
1219 {$IFDEF EnableSimpleFPCKeyWordHelpDB}
1220 HelpDatabases.CreateHelpDatabase('SimpleDemoForFPCKeyWordHelpDB',
1221 TSimpleFPCKeywordHelpDatabase,true);
1222 {$ENDIF}
1223 end;
1224
1225 begin
1226 CreateMainIDEHelpDB;
1227 CreateRTLHelpDB;
1228 CreateFCLHelpDB;
1229 CreateLCLHelpDB;
1230 CreateFPCMessagesHelpDB;
1231 CreateFPCKeywordsHelpDB;
1232 CreateLazUtilsHelpDB;
1233 end;
1234
1235 procedure TIDEHelpManager.RegisterDefaultIDEHelpViewers;
1236 var
1237 HelpViewer: THTMLBrowserHelpViewer;
1238 begin
1239 HelpViewer:= THTMLBrowserHelpViewer.Create(nil);
1240 HelpViewer.OnFindDefaultBrowser := @FindDefaultBrowser;
1241 HelpViewers.RegisterViewer(HelpViewer);
1242 end;
1243
1244 procedure TIDEHelpManager.FindDefaultBrowser(var DefaultBrowser, Params: string);
1245 begin
1246 GetDefaultBrowser(DefaultBrowser, Params);
1247 end;
1248
CollectKeywordsnull1249 function TIDEHelpManager.CollectKeywords(CodeBuffer: TCodeBuffer;
1250 const CodePos: TPoint; out Identifier: string): TShowHelpResult;
1251 // Collect keywords and show help if possible
1252 var
1253 p: Integer;
1254 IdentStart, IdentEnd: integer;
1255 KeyWord: String;
1256 ErrorMsg: String;
1257 begin
1258 Result:=shrHelpNotFound;
1259 Identifier:='';
1260 p:=0;
1261 CodeBuffer.LineColToPosition(CodePos.Y,CodePos.X,p);
1262 if p<1 then exit;
1263 GetIdentStartEndAtPosition(CodeBuffer.Source,p,IdentStart,IdentEnd);
1264 if IdentEnd<=IdentStart then exit;
1265 Identifier:=copy(CodeBuffer.Source,IdentStart,IdentEnd-IdentStart);
1266 if (IdentStart > 1) and (CodeBuffer.Source[IdentStart - 1] in ['$','%']) then
1267 Dec(IdentStart);
1268 KeyWord:=copy(CodeBuffer.Source,IdentStart,IdentEnd-IdentStart);
1269 ErrorMsg:='';
1270 if KeyWord[1] = '$' then
1271 Result:=ShowHelpForDirective('',FPCDirectiveHelpPrefix+Keyword,ErrorMsg)
1272 else if KeyWord[1] = '%' then
1273 Result:=ShowHelpForDirective('',IDEDirectiveHelpPrefix+Keyword,ErrorMsg)
1274 else
1275 Result:=ShowHelpForKeyword('',FPCKeyWordHelpPrefix+Keyword,ErrorMsg);
1276 if Result=shrSuccess then
1277 exit;
1278 if Result in [shrNone,shrDatabaseNotFound,shrContextNotFound,shrHelpNotFound] then
1279 exit(shrHelpNotFound); // not an FPC keyword
1280 // viewer error
1281 HelpManager.ShowError(Result,ErrorMsg);
1282 Result:=shrCancel;
1283 end;
1284
CollectDeclarationsnull1285 function TIDEHelpManager.CollectDeclarations(CodeBuffer: TCodeBuffer;
1286 const CodePos: TPoint; out Complete: boolean; var ErrMsg: string
1287 ): TShowHelpResult;
1288 // Collect declarations and show help if possible
1289 var
1290 NewList: TPascalHelpContextList;
1291 PascalHelpContextLists: TList;
1292 ListOfPCodeXYPosition: TFPList;
1293 CurCodePos: PCodeXYPosition;
1294 i: Integer;
1295 Flags: TFindDeclarationListFlags;
1296 begin
1297 Complete:=false;
1298 Result:=shrHelpNotFound;
1299 ListOfPCodeXYPosition:=nil;
1300 PascalHelpContextLists:=nil;
1301 try
1302 // get all possible declarations of this identifier
1303 debugln(['CollectDeclarations ',CodeBuffer.Filename,' line=',CodePos.Y,' col=',CodePos.X]);
1304 Flags:=[fdlfWithoutEmptyProperties,fdlfWithoutForwards];
1305 if CombineSameIdentifiersInUnit then
1306 Include(Flags,fdlfOneOverloadPerUnit);
1307 if CodeToolBoss.FindDeclarationAndOverload(CodeBuffer,CodePos.X,CodePos.Y,
1308 ListOfPCodeXYPosition,Flags)
1309 then begin
1310 if ListOfPCodeXYPosition=nil then exit;
1311 debugln('TIDEHelpManager.ShowHelpForSourcePosition Success, number of declarations: ',dbgs(ListOfPCodeXYPosition.Count));
1312 // convert the source positions in Pascal help context list
1313 for i:=0 to ListOfPCodeXYPosition.Count-1 do begin
1314 CurCodePos:=PCodeXYPosition(ListOfPCodeXYPosition[i]);
1315 debugln('TIDEHelpManager.ShowHelpForSourcePosition Declaration at ',dbgs(CurCodePos));
1316 NewList:=ConvertCodePosToPascalHelpContext(CurCodePos);
1317 if NewList<>nil then begin
1318 if PascalHelpContextLists=nil then
1319 PascalHelpContextLists:=TList.Create;
1320 PascalHelpContextLists.Add(NewList);
1321 end;
1322 end;
1323 if PascalHelpContextLists=nil then exit;
1324
1325 // invoke help system
1326 Complete:=true;
1327 debugln(['TIDEHelpManager.ShowHelpForSourcePosition PascalHelpContextLists.Count=',PascalHelpContextLists.Count,' calling ShowHelpForPascalContexts...']);
1328 Result:=ShowHelpForPascalContexts(CodeBuffer.Filename,CodePos,PascalHelpContextLists,ErrMsg);
1329 end else if CodeToolBoss.ErrorCode<>nil then begin
1330 MainIDEInterface.DoJumpToCodeToolBossError;
1331 Complete:=True;
1332 end;
1333 finally
1334 FreeListOfPCodeXYPosition(ListOfPCodeXYPosition);
1335 if PascalHelpContextLists<>nil then begin
1336 for i:=0 to PascalHelpContextLists.Count-1 do
1337 TObject(PascalHelpContextLists[i]).Free;
1338 PascalHelpContextLists.Free;
1339 end;
1340 end;
1341 end;
1342
1343 constructor TIDEHelpManager.Create(TheOwner: TComponent);
1344 begin
1345 inherited Create(TheOwner);
1346 HelpBoss:=Self;
1347 LazarusHelp:=Self;
1348 HelpOpts:=THelpOptions.Create;
1349 HelpOpts.SetDefaultFilename;
1350 HelpDatabases:=TIDEHelpDatabases.Create;
1351 HelpIntfs.HelpManager:=HelpDatabases;
1352 HelpViewers:=THelpViewers.Create;
1353 RegisterIDEHelpDatabases;
1354 RegisterDefaultIDEHelpViewers;
1355 CombineSameIdentifiersInUnit:=true;
1356 ShowCodeBrowserOnUnknownIdentifier:=true;
1357
1358 CodeHelpBoss:=TCodeHelpManager.Create(Self);
1359
1360 // register property editors for URL handling
1361 RegisterPropertyEditor(TypeInfo(AnsiString),
1362 THTMLHelpDatabase,'BaseURL',TURLDirectoryPropertyEditor);
1363
1364 FHTMLProviders:=TLIHProviders.Create;
1365
1366 if CreateIDEHTMLControl=nil then
1367 CreateIDEHTMLControl:=@LazCreateIDEHTMLControl;
1368 if CreateIDEHTMLProvider=nil then
1369 CreateIDEHTMLProvider:=@LazCreateIDEHTMLProvider;
1370 end;
1371
1372 destructor TIDEHelpManager.Destroy;
1373 begin
1374 FreeThenNil(FHTMLProviders);
1375 FreeThenNil(CodeHelpBoss);
1376 FPCMessagesHelpDB:=nil;
1377 FreeLCLHelpSystem;
1378 FreeThenNil(HelpOpts);
1379 FreeThenNil(FMainHelpDBPath);
1380 FreeThenNil(FRTLHelpDBPath);
1381 FreeThenNil(FFCLHelpDBPath);
1382 FreeThenNil(FLCLHelpDBPath);
1383 FreeThenNil(FLazUtilsHelpDBPath);
1384 HelpBoss:=nil;
1385 LazarusHelp:=nil;
1386 inherited Destroy;
1387 end;
1388
1389 procedure TIDEHelpManager.ConnectMainBarEvents;
1390 begin
1391 {$IFDEF Darwin}
1392 // ToDo: Place the "About Lazarus" under MacOS Application menu. See issue #12294.
1393 MainIDEBar.itmHelpAboutLazarus.OnClick := @mnuHelpAboutLazarusClicked;
1394 {$ELSE}
1395 MainIDEBar.itmHelpAboutLazarus.OnClick := @mnuHelpAboutLazarusClicked;
1396 {$ENDIF}
1397 MainIDEBar.itmHelpOnlineHelp.OnClick := @mnuHelpOnlineHelpClicked;
1398 MainIDEBar.itmHelpReportingBug.OnClick := @mnuHelpReportBugClicked;
1399
1400 {$IFDEF EnableFPDocSearch}
1401 MainIDEBar.itmSearchInFPDocFiles.OnClick:=@mnuSearchInFPDocFilesClick;
1402 {$ENDIF}
1403 end;
1404
1405 procedure TIDEHelpManager.LoadHelpOptions;
1406 begin
1407 HelpOpts.Load;
1408 end;
1409
1410 procedure TIDEHelpManager.SaveHelpOptions;
1411 begin
1412 HelpOpts.Save;
1413 end;
1414
1415 procedure TIDEHelpManager.ShowLazarusHelpStartPage;
1416 begin
1417 ShowIDEHelpForKeyword(lihcStartPage);
1418 end;
1419
1420 procedure TIDEHelpManager.ShowIDEHelpForContext(HelpContext: THelpContext);
1421 begin
1422 ShowHelpOrErrorForContext(MainHelpDB.ID,HelpContext);
1423 end;
1424
1425 procedure TIDEHelpManager.ShowIDEHelpForKeyword(const Keyword: string);
1426 begin
1427 ShowHelpOrErrorForKeyword(MainHelpDB.ID,Keyword);
1428 end;
1429
ShowHelpForSourcePositionnull1430 function TIDEHelpManager.ShowHelpForSourcePosition(const Filename: string;
1431 const CodePos: TPoint; var ErrMsg: string): TShowHelpResult;
1432 var
1433 CodeBuffer: TCodeBuffer;
1434 Complete: boolean;
1435 Identifier: string;
1436 begin
1437 debugln('TIDEHelpManager.ShowHelpForSourcePosition A Filename=',Filename,' ',dbgs(CodePos));
1438 Result:=shrHelpNotFound;
1439 ErrMsg:='No help found for "'+Filename+'"'
1440 +' at ('+IntToStr(CodePos.Y)+','+IntToStr(CodePos.X)+')';
1441 // commit editor changes
1442 if not CodeToolBoss.GatherExternalChanges then exit;
1443 // get code buffer for Filename
1444 if mrOk<>LoadCodeBuffer(CodeBuffer,FileName,[lbfCheckIfText],false) then
1445 exit;
1446
1447 Result:=CollectDeclarations(CodeBuffer,CodePos,Complete,ErrMsg);
1448 if Complete then exit;
1449
1450 debugln(['TIDEHelpManager.ShowHelpForSourcePosition no declaration found, trying keywords and built-in functions...']);
1451 Result:=CollectKeywords(CodeBuffer,CodePos,Identifier);
1452 if Result in [shrCancel,shrSuccess] then exit;
1453 if IsValidIdent(Identifier) and ShowCodeBrowserOnUnknownIdentifier then
1454 begin
1455 debugln(['TIDEHelpManager.ShowHelpForSourcePosition "',Identifier,'" is not an FPC keyword, search via code browser...']);
1456 ShowCodeBrowser(Identifier);
1457 exit(shrSuccess);
1458 end;
1459 debugln(['TIDEHelpManager.ShowHelpForSourcePosition "',Identifier,'" is not an FPC keyword']);
1460 end;
1461
ConvertCodePosToPascalHelpContextnull1462 function TIDEHelpManager.ConvertCodePosToPascalHelpContext(
1463 ACodePos: PCodeXYPosition): TPascalHelpContextList;
1464
1465 procedure AddContext(Descriptor: TPascalHelpContextType;
1466 const Context: string);
1467 begin
1468 Result.Add(Descriptor,Context);
1469 //debugln(' AddContext Descriptor=',dbgs(ord(Descriptor)),' Context="',Context,'"');
1470 end;
1471
1472 procedure AddContextsBackwards(Tool: TCodeTool;
1473 Node: TCodeTreeNode);
1474 begin
1475 if Node=nil then exit;
1476 AddContextsBackwards(Tool,Node.Parent);
1477 case Node.Desc of
1478 ctnUnit, ctnPackage, ctnProgram, ctnLibrary:
1479 AddContext(pihcSourceName,Tool.GetSourceName);
1480 ctnVarDefinition:
1481 AddContext(pihcVariable,Tool.ExtractDefinitionName(Node));
1482 ctnTypeDefinition:
1483 AddContext(pihcType,Tool.ExtractDefinitionName(Node));
1484 ctnConstDefinition:
1485 AddContext(pihcConst,Tool.ExtractDefinitionName(Node));
1486 ctnProperty:
1487 AddContext(pihcProperty,Tool.ExtractPropName(Node,false));
1488 ctnProcedure:
1489 AddContext(pihcProcedure,Tool.ExtractProcName(Node,
1490 [phpWithoutClassName]));
1491 ctnProcedureHead:
1492 AddContext(pihcParameterList,Tool.ExtractProcHead(Node,
1493 [phpWithoutClassKeyword,phpWithoutClassName,phpWithoutName,
1494 phpWithoutSemicolon]));
1495 end;
1496 end;
1497
1498 var
1499 MainCodeBuffer: TCodeBuffer;
1500 Tool: TCustomCodeTool;
1501 CleanPos: integer;
1502 i: Integer;
1503 Node: TCodeTreeNode;
1504 IncludeChain: TFPList;
1505 ConversionResult: LongInt;
1506 begin
1507 Result:=nil;
1508 // find code buffer
1509 if ACodePos^.Code=nil then begin
1510 debugln('WARNING: ConvertCodePosToPascalHelpContext ACodePos.Code=nil');
1511 exit;
1512 end;
1513 Result:=TPascalHelpContextList.Create;
1514 // add filename and all filenames of the include chain
1515 IncludeChain:=nil;
1516 try
1517 CodeToolBoss.GetIncludeCodeChain(ACodePos^.Code,true,IncludeChain);
1518 if IncludeChain=nil then begin
1519 debugln('WARNING: ConvertCodePosToPascalHelpContext IncludeChain=nil');
1520 exit;
1521 end;
1522 for i:=0 to IncludeChain.Count-1 do
1523 AddContext(pihcFilename,TCodeBuffer(IncludeChain[i]).Filename);
1524 MainCodeBuffer:=TCodeBuffer(IncludeChain[0]);
1525 finally
1526 IncludeChain.Free;
1527 end;
1528 // find code tool
1529 Tool:=CodeToolBoss.FindCodeToolForSource(MainCodeBuffer);
1530 if not (Tool is TCodeTool) then begin
1531 debugln('WARNING: ConvertCodePosToPascalHelpContext not (Tool is TCodeTool) MainCodeBuffer=',MainCodeBuffer.Filename);
1532 exit;
1533 end;
1534 // convert cursor position to clean position
1535 ConversionResult:=Tool.CaretToCleanPos(ACodePos^,CleanPos);
1536 if ConversionResult<>0 then begin
1537 // position not in clean code, maybe a comment, maybe behind last line
1538 // => ignore
1539 exit;
1540 end;
1541 // find node
1542 Node:=Tool.FindDeepestNodeAtPos(CleanPos,false);
1543 if Node=nil then begin
1544 // position not in a scanned pascal node, maybe in between
1545 // => ignore
1546 exit;
1547 end;
1548 AddContextsBackwards(TCodeTool(Tool),Node);
1549 end;
1550
GetFPDocFilenameForSourcenull1551 function TIDEHelpManager.GetFPDocFilenameForSource(SrcFilename: string;
1552 ResolveIncludeFiles: Boolean; out AnOwner: TObject): string;
1553 var
1554 CacheWasUsed: boolean;
1555 begin
1556 Result:=CodeHelpBoss.GetFPDocFilenameForSource(SrcFilename,ResolveIncludeFiles,
1557 CacheWasUsed,AnOwner);
1558 end;
1559
1560 procedure TIDEHelpManager.ShowHelpForMessage;
1561 var
1562 Line: TMessageLine;
1563 Parts: TStringList;
1564 begin
1565 if IDEMessagesWindow=nil then exit;
1566 Line:=IDEMessagesWindow.GetSelectedLine;
1567 if Line=nil then exit;
1568 Parts:=TStringList.Create;
1569 Line.GetAttributes(Parts);
1570 ShowHelpOrErrorForMessageLine(Line.Msg,Parts);
1571 end;
1572
1573 procedure TIDEHelpManager.ShowHelpForObjectInspector(Sender: TObject);
1574 var
1575 AnInspector: TObjectInspectorDlg;
1576 Code: TCodeBuffer;
1577 Caret: TPoint;
1578 ErrMsg: string;
1579 NewTopLine: integer;
1580 begin
1581 //DebugLn('TIDEHelpManager.ShowHelpForObjectInspector ',dbgsName(Sender));
1582 if Sender=nil then Sender:=ObjectInspector1;
1583 if Sender is TObjectInspectorDlg then begin
1584 AnInspector:=TObjectInspectorDlg(Sender);
1585 if AnInspector.GetActivePropertyRow<>nil then begin
1586 if FindDeclarationOfOIProperty(AnInspector,nil,Code,Caret,NewTopLine) then
1587 begin
1588 if NewTopLine=0 then ;
1589 ErrMsg:='TIDEHelpManager.ShowHelpForObjectInspector ShowHelpForSourcePosition';
1590 ShowHelpForSourcePosition(Code.Filename,Caret,ErrMsg);
1591 end;
1592 end else begin
1593 DebugLn('TIDEHelpManager.ShowHelpForObjectInspector show default help for OI');
1594 ShowHelpForIDEControl(AnInspector);
1595 end;
1596 end;
1597 end;
1598
1599 procedure TIDEHelpManager.ShowHelpForIDEControl(Sender: TControl);
1600 begin
1601 LoadIDEWindowHelp;
1602 IDEWindowHelpNodes.InvokeHelp(Sender);
1603 end;
1604
GetHintForSourcePositionnull1605 function TIDEHelpManager.GetHintForSourcePosition(const ExpandedFilename: string;
1606 const CodePos: TPoint; out BaseURL, HTMLHint: string;
1607 Flags: TIDEHelpManagerCreateHintFlags): TShowHelpResult;
1608 var
1609 Code: TCodeBuffer;
1610 CacheWasUsed: boolean;
1611 HintFlags: TCodeHelpHintOptions;
1612 PropDetails: string;
1613 begin
1614 BaseURL:='';
1615 HTMLHint:='';
1616 Code:=CodeToolBoss.LoadFile(ExpandedFilename,true,false);
1617 if (Code=nil) or Code.LineColIsSpace(CodePos.Y,CodePos.X) then
1618 exit(shrHelpNotFound);
1619 HintFlags:=[chhoDeclarationHeader,chhoComments];
1620 if ihmchAddFocusHint in Flags then
1621 Include(HintFlags,chhoShowFocusHint);
1622 if CodeHelpBoss.GetHTMLHint(Code,CodePos.X,CodePos.Y,
1623 HintFlags,BaseURL,HTMLHint,PropDetails,CacheWasUsed)=chprSuccess
1624 then
1625 exit(shrSuccess);
1626 Result:=shrHelpNotFound;
1627 end;
1628
ConvertSourcePosToPascalHelpContextnull1629 function TIDEHelpManager.ConvertSourcePosToPascalHelpContext(
1630 const CaretPos: TPoint; const Filename: string): TPascalHelpContextList;
1631 var
1632 CodePos: TCodeXYPosition;
1633 Code: TCodeBuffer;
1634 ACodeTool: TCodeTool;
1635 begin
1636 Result:=nil;
1637 Code:=CodeToolBoss.FindFile(Filename);
1638 if Code=nil then exit;
1639 CodePos.Code:=Code;
1640 CodePos.X:=CaretPos.X;
1641 CodePos.Y:=CaretPos.Y;
1642 if not CodeToolBoss.Explore(Code,ACodeTool,false) then exit;
1643 if ACodeTool=nil then ;
1644 Result:=ConvertCodePosToPascalHelpContext(@CodePos);
1645 end;
1646
1647 { TIDEHintWindowManager }
1648
HintIsComplexnull1649 function TIDEHintWindowManager.HintIsComplex: boolean;
1650 begin
1651 Result := HintIsVisible and (CurHintWindow.ControlCount > 0)
1652 and not (CurHintWindow.Controls[0] is TSimpleHTMLControl);
1653 end;
1654
PtIsOnHintnull1655 function TIDEHintWindowManager.PtIsOnHint(Pt: TPoint): boolean;
1656 begin
1657 Result := PtInRect(CurHintWindow.BoundsRect, Pt);
1658 end;
1659
SenderIsHintControlnull1660 function TIDEHintWindowManager.SenderIsHintControl(Sender: TObject): Boolean;
1661 // ToDo: simplify. FHintWindow only has one child control.
1662
1663 function IsHintControl(Control: TWinControl): Boolean;
1664 var
1665 I: Integer;
1666 begin
1667 if not Control.Visible then
1668 Exit(False);
1669 Result := Control = Sender;
1670 if Result then
1671 Exit;
1672 for I := 0 to Control.ControlCount - 1 do
1673 begin
1674 Result := Control.Controls[I] = Sender;
1675 if Result then
1676 Exit;
1677 if (Control.Controls[I] is TWinControl) then
1678 begin
1679 Result := IsHintControl(TWinControl(Control.Controls[I]));
1680 if Result then
1681 Exit;
1682 end;
1683 end;
1684 end;
1685
1686 begin
1687 if Assigned(CurHintWindow) then
1688 Assert(CurHintWindow.ControlCount < 2,
1689 'SenderIsHintControl: ControlCount = ' + IntToStr(CurHintWindow.ControlCount));
1690 Result := Assigned(Sender) and Assigned(CurHintWindow) and IsHintControl(CurHintWindow);
1691 end;
1692
1693
1694 initialization
1695 RegisterPropertyEditor(TypeInfo(AnsiString),
1696 THTMLBrowserHelpViewer,'BrowserPath',TFileNamePropertyEditor);
1697
1698 end.
1699
1700
