diff --git a/.gitattributes b/.gitattributes index 6f18aabd7a..4887681be9 100644 --- a/.gitattributes +++ b/.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 diff --git a/components/chmhelp/packages/idehelp/chmhelppkg.lpk b/components/chmhelp/packages/idehelp/chmhelppkg.lpk index 171b99e53e..0ed183185e 100644 --- a/components/chmhelp/packages/idehelp/chmhelppkg.lpk +++ b/components/chmhelp/packages/idehelp/chmhelppkg.lpk @@ -3,21 +3,30 @@ - + + + + + + - + + + + + diff --git a/components/chmhelp/packages/idehelp/chmhelppkg.pas b/components/chmhelp/packages/idehelp/chmhelppkg.pas index 41ef1145e1..ec6e1b2b65 100644 --- a/components/chmhelp/packages/idehelp/chmhelppkg.pas +++ b/components/chmhelp/packages/idehelp/chmhelppkg.pas @@ -7,7 +7,7 @@ unit ChmHelpPkg; interface uses - LazChmHelp, LazarusPackageIntf; + LazChmHelp, ChmLangRef, LazarusPackageIntf; implementation diff --git a/components/chmhelp/packages/idehelp/chmlangref.pas b/components/chmhelp/packages/idehelp/chmlangref.pas new file mode 100644 index 0000000000..5d945ea8a4 --- /dev/null +++ b/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. + diff --git a/components/chmhelp/packages/idehelp/lazchmhelp.pas b/components/chmhelp/packages/idehelp/lazchmhelp.pas index aa7e8aa8fd..ef33feac48 100644 --- a/components/chmhelp/packages/idehelp/lazchmhelp.pas +++ b/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,21 +357,21 @@ begin begin DocsDir := FixSlash('$(LazarusDir)/docs/html/'); IDEMacros.SubstituteMacros(DocsDir); - if not FileExistsUTF8(DocsDir+FileName) then - begin - Result := shrDatabaseNotFound; - ErrMsg := FileName +' not found. Please put the chm help files in '+ LineEnding - +DocsDir+ LineEnding - +' or set the path to lcl.chm rtl.chm fcl.chm with "HelpFilesPath" in ' - +' Environment Options -> Help -> Help Options ->'+LineEnding - +' under HelpViewers - CHMHelpViewer'; - Exit; - end; - end else DocsDir := fChmsFilePath; + if not FileExistsUTF8(DocsDir+FileName) then + begin + Result := shrDatabaseNotFound; + ErrMsg := FileName +' not found. Please put the chm help files in '+ LineEnding + +DocsDir+ LineEnding + +' or set the path to lcl.chm rtl.chm fcl.chm with "HelpFilesPath" in ' + +' Environment Options -> Help -> Help Options ->'+LineEnding + +' under HelpViewers - CHMHelpViewer'; + Exit; + end; + 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.