lazchmhelp: added help for keywords

git-svn-id: trunk@30790 -

.gitattributes

@@ -378,6 +378,7 @@ components/chmhelp/packages/idehelp/Makefile.compiled svneol=native#text/plain
 components/chmhelp/packages/idehelp/Makefile.fpc svneol=native#text/plain
 components/chmhelp/packages/idehelp/chmhelppkg.lpk svneol=native#text/plain
 components/chmhelp/packages/idehelp/chmhelppkg.pas svneol=native#text/plain
+components/chmhelp/packages/idehelp/chmlangref.pas svneol=native#text/plain
 components/chmhelp/packages/idehelp/lazchmhelp.pas svneol=native#text/plain
 components/codetools/Makefile.compiled svneol=native#text/plain
 components/codetools/allcodetoolunits.pp svneol=native#text/pascal

components/chmhelp/packages/idehelp/chmhelppkg.lpk

@@ -3,21 +3,30 @@
   <Package Version="3">
     <Name Value="ChmHelpPkg"/>
     <CompilerOptions>
-      <Version Value="8"/>
+      <Version Value="10"/>
       <SearchPaths>
         <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
       </SearchPaths>
+      <Parsing>
+        <SyntaxOptions>
+          <UseAnsiStrings Value="False"/>
+        </SyntaxOptions>
+      </Parsing>
       <Other>
         <CompilerPath Value="$(CompPath)"/>
       </Other>
     </CompilerOptions>
     <Version Minor="1"/>
-    <Files Count="1">
+    <Files Count="2">
       <Item1>
         <Filename Value="lazchmhelp.pas"/>
         <HasRegisterProc Value="True"/>
         <UnitName Value="LazChmHelp"/>
       </Item1>
+      <Item2>
+        <Filename Value="chmlangref.pas"/>
+        <UnitName Value="ChmLangRef"/>
+      </Item2>
     </Files>
     <Type Value="DesignTime"/>
     <RequiredPkgs Count="5">

components/chmhelp/packages/idehelp/chmhelppkg.pas

@@ -7,7 +7,7 @@ unit ChmHelpPkg;
 interface
 
 uses
-  LazChmHelp, LazarusPackageIntf;
+  LazChmHelp, ChmLangRef, LazarusPackageIntf;
 
 implementation
 

components/chmhelp/packages/idehelp/chmlangref.pas

@@ -0,0 +1,147 @@
+unit ChmLangRef;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils,
+  Dialogs, FileUtil,
+  LazHelpIntf, HelpIntfs,
+  IDEHelpIntf, LazHelpHTML, MacroIntf;
+
+const
+  sFPCLangRef = 'FPC Language Reference';
+
+type
+
+  { TLangRefHelpDatabase }
+
+  TLangRefHelpDatabase = class(THelpDatabase)
+  private
+    FKeywordNodes: TList;
+    FKeyWordsList: TStringList;
+    procedure ClearKeywordNodes;
+  public
+    constructor Create(TheOwner: TComponent); override;
+    destructor Destroy; override;
+    procedure LoadKeywordList(Path: string);
+    function GetNodesForKeyword(const HelpKeyword: string;
+                        var ListOfNodes: THelpNodeQueryList; var ErrMsg: string
+                        ): TShowHelpResult; override;
+    function ShowHelp(Query: THelpQuery; BaseNode, NewNode: THelpNode;
+                      QueryItem: THelpQueryItem;
+                      var ErrMsg: string): TShowHelpResult; override;
+  end;
+
+procedure RegisterLangRefHelpDatabase;
+
+var
+  LangRefHelpDatabase: TLangRefHelpDatabase = nil;
+
+implementation
+
+procedure RegisterLangRefHelpDatabase;
+begin
+  if not Assigned(LangRefHelpDatabase) then
+    LangRefHelpDatabase := TLangRefHelpDatabase(HelpDatabases.CreateHelpDatabase(sFPCLangRef,
+                                               TLangRefHelpDatabase, true));
+end;
+
+{ TLangRefHelpDatabase }
+
+procedure TLangRefHelpDatabase.ClearKeywordNodes;
+var i: Integer;
+begin
+  for i := 0 to FKeywordNodes.Count - 1 do
+    TObject(FKeywordNodes[i]).Free;
+  FKeywordNodes.Clear;
+end;
+
+constructor TLangRefHelpDatabase.Create(TheOwner: TComponent);
+begin
+  inherited Create(TheOwner);
+  FKeywordNodes := TList.Create;
+  FKeyWordsList := TStringList.Create;
+  FKeyWordsList.CaseSensitive := False;
+end;
+
+destructor TLangRefHelpDatabase.Destroy;
+begin
+  ClearKeywordNodes;
+  FKeywordNodes.Free;
+  FKeyWordsList.Free;
+  inherited Destroy;
+end;
+
+procedure TLangRefHelpDatabase.LoadKeywordList(Path: string);
+begin
+  if Path = '' then
+  begin
+    Path := { TODO : FixSlash }('$(LazarusDir)/docs/html/');
+    IDEMacros.SubstituteMacros(Path);
+  end;
+  Path := AppendPathDelim(Path);
+
+  if FileExistsUTF8(Path + 'ref.kwd') then
+  begin
+    FKeyWordsList.LoadFromFile(Utf8ToSys(Path + 'ref.kwd'));
+  end else FKeyWordsList.Clear;
+end;
+
+function TLangRefHelpDatabase.GetNodesForKeyword(const HelpKeyword: string;
+  var ListOfNodes: THelpNodeQueryList; var ErrMsg: string): TShowHelpResult;
+var
+  KeyWord: String;
+  i, n: Integer;
+  KeywordNode: THelpNode;
+begin
+  Result := shrHelpNotFound;
+  if (csDesigning in ComponentState) then Exit;
+  if (FPCKeyWordHelpPrefix<>'')
+  and (LeftStr(HelpKeyword,length(FPCKeyWordHelpPrefix))=FPCKeyWordHelpPrefix) then
+  begin
+    // HelpKeyword starts with KeywordPrefix
+    KeyWord := Copy(HelpKeyword, Length(FPCKeyWordHelpPrefix) + 1, Length(HelpKeyword));
+    ClearKeywordNodes;
+    n := 0;
+    for i := 0 to FKeyWordsList.Count - 1 do
+      if SameText(FKeyWordsList.Names[i], KeyWord) then
+      begin
+        Inc(n);
+        KeywordNode := THelpNode.CreateURL(Self,KeyWord,'ref.chm://ref/' + FKeyWordsList.ValueFromIndex[i]);
+        KeywordNode.Title := Format('Pascal keyword "%s"', [KeyWord]);
+        if n > 1 then
+          KeywordNode.Title := KeywordNode.Title + ' (' + IntToStr(n) + ')';
+        FKeywordNodes.Add(KeywordNode);
+        CreateNodeQueryListAndAdd(KeywordNode,nil,ListOfNodes,true);
+        Result := shrSuccess;
+      end;
+    if Result <> shrSuccess then Exit;
+    { for => +forin, in => +forin }
+    if SameText(KeyWord, 'for') or SameText(KeyWord, 'in') then
+    begin
+      i := FKeyWordsList.IndexOfName('forin');
+      KeywordNode := THelpNode.CreateURL(Self,KeyWord,'ref.chm://ref/' + FKeyWordsList.ValueFromIndex[i]);
+      KeywordNode.Title := 'Pascal keyword "for..in"';
+      FKeywordNodes.Add(KeywordNode);
+      CreateNodeQueryListAndAdd(KeywordNode, nil, ListOfNodes, True);
+    end;
+  end;
+end;
+
+function TLangRefHelpDatabase.ShowHelp(Query: THelpQuery; BaseNode,
+  NewNode: THelpNode; QueryItem: THelpQueryItem; var ErrMsg: string
+  ): TShowHelpResult;
+var
+  Viewer: THelpViewer;
+begin
+  Result:=shrHelpNotFound;
+  if not (Query is THelpQueryKeyword) then exit;
+  Result := FindViewer('text/html', ErrMsg, Viewer);
+  if Result <> shrSuccess then Exit;
+  Result := Viewer.ShowNode(NewNode, ErrMsg);
+end;
+
+end.
+

components/chmhelp/packages/idehelp/lazchmhelp.pas

@@ -24,7 +24,7 @@ interface
 
 uses
   Classes, SysUtils, FileUtil, LazHelpIntf, HelpIntfs, LazConfigStorage,
-  PropEdits, LHelpControl, Controls;
+  PropEdits, LHelpControl, Controls, ChmLangRef;
   
 type
   
@@ -40,6 +40,7 @@ type
     function DBFindViewer(HelpDB: THelpDatabase; const MimeType: string;
       var ErrMsg: string; out Viewer: THelpViewer): TShowHelpResult;
     function GetHelpLabel: String;
+    procedure SetChmsFilePath(const AValue: String);
   protected
     function GetFileNameAndURL(RawUrl: String; out FileName: String; out URL: String): Boolean;
     procedure SetHelpEXE(AValue: String);
@@ -62,8 +63,7 @@ type
   published
     property HelpEXE: String read GetHelpEXE write SetHelpEXE;
     property HelpLabel: String read GetHelpLabel write SetHelpLabel;
-    property HelpFilesPath: String read fChmsFilePath write fChmsFilePath;
-
+    property HelpFilesPath: String read fChmsFilePath write SetChmsFilePath;
   end;
   
   procedure Register;
@@ -112,6 +112,14 @@ begin
   Result := fHelpLabel;
 end;
 
+procedure TChmHelpViewer.SetChmsFilePath(const AValue: String);
+begin
+  if fChmsFilePath = AValue then Exit;
+  fChmsFilePath := IncludeTrailingBackslash(AValue);
+  if Assigned(LangRefHelpDatabase) then
+    LangRefHelpDatabase.LoadKeywordList(fChmsFilePath);
+end;
+
 function TChmHelpViewer.GetHelpEXE: String;
 begin
   if fHelpExe <> '' then
@@ -125,7 +133,7 @@ end;
 function TChmHelpViewer.GetFileNameAndURL(RawUrl:String; out FileName: String; out URL: String
   ): Boolean;
 var
-fPos: Integer;
+  fPos: Integer;
 begin
   Result := False;
 
@@ -158,7 +166,6 @@ var
   LHelpProject: String;
   WS: String;
   LastWasEOL: Boolean;
-  EOLP: Integer;
   BufC: Char;
   Buffer: array[0..511] of char;
   BufP: Integer;
@@ -319,16 +326,16 @@ end;
 
 function TChmHelpViewer.SupportsMimeType(const AMimeType: string): boolean;
 begin
-  REsult := inherited;
+  Result := inherited;
 end;
 
 function TChmHelpViewer.ShowNode(Node: THelpNode; var ErrMsg: string
   ): TShowHelpResult;
 var
-FileName: String;
-Url: String;
-Res: TLHelpResponse;
-DocsDir: String;
+  FileName: String;
+  Url: String;
+  Res: TLHelpResponse;
+  DocsDir: String;
 begin
   if Pos('file://', Node.URL) = 1 then
   begin
@@ -350,6 +357,10 @@ begin
   begin
     DocsDir := FixSlash('$(LazarusDir)/docs/html/');
     IDEMacros.SubstituteMacros(DocsDir);
+  end
+  else
+    DocsDir := fChmsFilePath;
+
   if not FileExistsUTF8(DocsDir+FileName) then
   begin
     Result := shrDatabaseNotFound;
@@ -361,10 +372,6 @@ begin
     Exit;
   end;
 
-  end
-  else
-    DocsDir := fChmsFilePath;
-
   FileName := IncludeTrailingPathDelimiter(DocsDir)+FileName;
 
   fHelpConnection.StartHelpServer(HelpLabel, HelpExe);
@@ -419,12 +426,14 @@ var
 begin
   ChmHelp := TChmHelpViewer.Create(nil);
   HelpViewers.RegisterViewer(ChmHelp);
+  RegisterLangRefHelpDatabase;
+  LangRefHelpDatabase.OnFindViewer := @ChmHelp.DBFindViewer;
 end;
 
 initialization
   RegisterPropertyEditor(TypeInfo(AnsiString),
-    TCHmHelpViewer,'HelpEXE',TFileNamePropertyEditor);
+    TChmHelpViewer,'HelpEXE',TFileNamePropertyEditor);
   RegisterPropertyEditor(TypeInfo(AnsiString),
-    TCHmHelpViewer,'HelpFilesPath',TFileNamePropertyEditor);
+    TChmHelpViewer,'HelpFilesPath',TDirectoryPropertyEditor);
 end.