9
Dialogs, FileUtil, LazFileUtils, LazLogger,
10
LazHelpIntf, HelpIntfs,
11
IDEHelpIntf, MacroIntf;
14
sFPCCompilerDirectives = 'FreePascal Compiler directives';
18
{ TFPCDirectivesHelpDatabase }
20
TFPCDirectivesHelpDatabase = class(THelpDatabase)
22
FCHMSearchPath: string;
23
FDirectiveNodes: TFPList;
24
function SearchForDirective(ADirective: string;
25
var ListOfNodes: THelpNodeQueryList): Boolean;
26
procedure ClearDirectiveNodes;
28
constructor Create(TheOwner: TComponent); override;
29
destructor Destroy; override;
30
function GetNodesForDirective(const HelpDirective: string;
31
var ListOfNodes: THelpNodeQueryList;
32
var ErrMsg: string): TShowHelpResult; override;
33
function ShowHelp(Query: THelpQuery; {%H-}BaseNode, NewNode: THelpNode;
34
{%H-}QueryItem: THelpQueryItem;
35
var ErrMsg: string): TShowHelpResult; override;
36
function GetCHMSearchPath: string;
37
property CHMSearchPath: string read FCHMSearchPath write FCHMSearchPath;
38
function FindCHMFile: string;
41
procedure RegisterFPCDirectivesHelpDatabase;
44
FPCDirectivesHelpDatabase: TFPCDirectivesHelpDatabase = nil;
48
uses chmreader, chmFiftiMain;
50
procedure RegisterFPCDirectivesHelpDatabase;
52
if not Assigned(FPCDirectivesHelpDatabase) then
53
FPCDirectivesHelpDatabase :=
54
TFPCDirectivesHelpDatabase(HelpDatabases.CreateHelpDatabase(
55
sFPCCompilerDirectives, TFPCDirectivesHelpDatabase, true));
58
{ TFPCDirectivesHelpDatabase }
60
function TFPCDirectivesHelpDatabase.SearchForDirective(ADirective: string;
61
var ListOfNodes: THelpNodeQueryList): Boolean;
65
DocTitle, URL: string;
67
SearchReader: TChmSearchReader;
68
TitleResults: TChmWLCTopicArray;
70
DirectiveNode: THelpNode;
73
ADirective := UpperCase(ADirective);
76
Filename:=FindCHMFile;
77
if Filename='' then exit;
79
chm := TChmFileList.Create(Utf8ToSys(Filename));
81
if chm.Count = 0 then Exit;
84
if fchm.SearchReader = nil then
86
ms := fchm.GetObject('/$FIftiMain');
87
if ms = nil then Exit;
88
SearchReader := TChmSearchReader.Create(ms, True); //frees the stream when done
89
fchm.SearchReader := SearchReader;
92
SearchReader := fchm.SearchReader;
93
SearchReader.LookupWord(Copy(ADirective, 2, MaxInt), TitleResults);
94
for k := 0 to High(TitleResults) do
96
URL := fchm.LookupTopicByID(TitleResults[k].TopicIndex, DocTitle);
97
i := Pos(ADirective, DocTitle);
98
if (i = 0) or (Length(DocTitle) >= i + Length(ADirective))
99
and (upCase(DocTitle[i + Length(ADirective)]) in ['A'..'Z','0'..'9']) then Continue;
100
if (Length(URL) > 0) and (URL[1] = '/') then
102
if URL = '' then Continue;
103
DirectiveNode := THelpNode.CreateURL(Self, ADirective, 'prog.chm://' + URL);
104
DirectiveNode.Title := 'FPC directives: ' + DocTitle;
105
CreateNodeQueryListAndAdd(DirectiveNode, nil, ListOfNodes, True);
106
FDirectiveNodes.Add(DirectiveNode);
116
procedure TFPCDirectivesHelpDatabase.ClearDirectiveNodes;
119
for i := 0 to FDirectiveNodes.Count - 1 do
120
TObject(FDirectiveNodes[i]).Free;
121
FDirectiveNodes.Clear;
124
constructor TFPCDirectivesHelpDatabase.Create(TheOwner: TComponent);
126
inherited Create(TheOwner);
127
FDirectiveNodes := TFPList.Create;
130
destructor TFPCDirectivesHelpDatabase.Destroy;
133
FDirectiveNodes.Free;
137
function TFPCDirectivesHelpDatabase.GetNodesForDirective(
138
const HelpDirective: string; var ListOfNodes: THelpNodeQueryList;
139
var ErrMsg: string): TShowHelpResult;
144
Result := shrHelpNotFound;
145
if (csDesigning in ComponentState) then Exit;
146
if (FPCDirectiveHelpPrefix<>'')
147
and (LeftStr(HelpDirective, Length(FPCDirectiveHelpPrefix)) = FPCDirectiveHelpPrefix) then
149
Filename:=FindCHMFile;
150
debugln(['TFPCDirectivesHelpDatabase.GetNodesForDirective ',Filename]);
151
if (Filename='') then
153
Result := shrDatabaseNotFound;
154
ErrMsg := Format('prog.chm not found. Please put prog.chm help file in '+ LineEnding
156
+'or set the path to it with "HelpFilesPath" in '
157
+' Environment Options -> Help -> Help Options ->' + LineEnding
158
+'under Viewers - CHM Help Viewer', [FCHMSearchPath]);
161
// HelpDirective starts with DirectivePrefix
162
Directive := Copy(HelpDirective, Length(FPCDirectiveHelpPrefix) + 1, Length(HelpDirective));
164
if SearchForDirective(Directive, ListOfNodes) then
165
Result := shrSuccess;
169
function TFPCDirectivesHelpDatabase.ShowHelp(Query: THelpQuery; BaseNode,
170
NewNode: THelpNode; QueryItem: THelpQueryItem; var ErrMsg: string
175
Result:=shrHelpNotFound;
176
if not (Query is THelpQueryDirective) then exit;
177
Result := FindViewer('text/html', ErrMsg, Viewer);
178
if Result <> shrSuccess then Exit;
179
Result := Viewer.ShowNode(NewNode, ErrMsg);
182
function TFPCDirectivesHelpDatabase.GetCHMSearchPath: string;
184
Result:=FCHMSearchPath;
185
if Result='' then begin
186
Result := '$(LazarusDir)/docs/html;$(LazarusDir)/docs/chm';
187
IDEMacros.SubstituteMacros(Result);
188
Result:=MinimizeSearchPath(SetDirSeparators(Result));
192
function TFPCDirectivesHelpDatabase.FindCHMFile: string;
194
Result:=SearchFileInPath('prog.chm','',GetCHMSearchPath,';',[]);