From 5d587ccb3ccd543da2e684302254bce4dc91c9f6 Mon Sep 17 00:00:00 2001 From: mattias Date: Thu, 21 Jun 2012 14:36:24 +0000 Subject: [PATCH] chmhelp: using search path to search for chm files git-svn-id: trunk@37715 - --- .../chmhelp/packages/idehelp/chmlangref.pas | 28 ++-- .../chmhelp/packages/idehelp/chmprog.pas | 48 ++++--- .../chmhelp/packages/idehelp/lazchmhelp.pas | 121 ++++++++---------- 3 files changed, 99 insertions(+), 98 deletions(-) diff --git a/components/chmhelp/packages/idehelp/chmlangref.pas b/components/chmhelp/packages/idehelp/chmlangref.pas index d3a767a4a7..6ef10d4fd7 100644 --- a/components/chmhelp/packages/idehelp/chmlangref.pas +++ b/components/chmhelp/packages/idehelp/chmlangref.pas @@ -6,7 +6,7 @@ interface uses Classes, SysUtils, - Dialogs, FileUtil, + Dialogs, FileUtil, LazFileUtils, LazHelpIntf, HelpIntfs, IDEHelpIntf, MacroIntf; @@ -19,10 +19,10 @@ type TLangRefHelpDatabase = class(THelpDatabase) private + FCHMSearchPath: string; FKeywordNodes: TList; FKeyWordsList: TStringList; FRTLIndex: TStringList; - FDocsDir: string; procedure ClearKeywordNodes; procedure LoadChmIndex(const Path, ChmFileName: string; IndexStrings: TStrings; const Filter: string = ''); @@ -36,6 +36,7 @@ type function ShowHelp(Query: THelpQuery; {%H-}BaseNode, NewNode: THelpNode; {%H-}QueryItem: THelpQueryItem; var ErrMsg: string): TShowHelpResult; override; + property CHMSearchPath: string read FCHMSearchPath write FCHMSearchPath; end; procedure RegisterLangRefHelpDatabase; @@ -97,20 +98,21 @@ var SM: TChmSiteMap; X, Y: Integer; s: string; + Filename: String; begin - FDocsDir := Path; - if FDocsDir = '' then + fCHMSearchPath := Path; + if fCHMSearchPath = '' then begin - FDocsDir := '$(LazarusDir)'; - IDEMacros.SubstituteMacros(FDocsDir); - FDocsDir := AppendPathDelim(FDocsDir) + 'docs' + PathDelim + 'html'; + fCHMSearchPath := '$(LazarusDir)/docs/html'; + IDEMacros.SubstituteMacros(fCHMSearchPath); + fCHMSearchPath := MinimizeSearchPath(SetDirSeparators(fCHMSearchPath)); end; - FDocsDir := AppendPathDelim(FDocsDir); + Filename:=SearchFileInPath(ChmFileName,'',fCHMSearchPath,';',[]); IndexStrings.Clear; - if FileExistsUTF8(FDocsDir + ChmFileName) then + if (Filename<>'') then begin - chm := TChmFileList.Create(Utf8ToSys(FDocsDir + ChmFileName)); + chm := TChmFileList.Create(Utf8ToSys(Filename)); try if chm.Count = 0 then Exit; fchm := chm.Chm[0]; @@ -153,7 +155,7 @@ begin if (FPCKeyWordHelpPrefix<>'') and (LeftStr(HelpKeyword,length(FPCKeyWordHelpPrefix))=FPCKeyWordHelpPrefix) then begin - if FKeyWordsList.Count = 0 then LoadKeywordList(FDocsDir); + if FKeyWordsList.Count = 0 then LoadKeywordList(fCHMSearchPath); if FKeyWordsList.Count = 0 then begin Result := shrDatabaseNotFound; @@ -161,7 +163,7 @@ begin + '%s' + LineEnding +'or set the path to it with "HelpFilesPath" in ' +' Environment Options -> Help -> Help Options ->' + LineEnding - +'under Viewers - CHM Help Viewer', [FDocsDir]); + +'under Viewers - CHM Help Viewer', [fCHMSearchPath]); Exit; end; // HelpKeyword starts with KeywordPrefix @@ -193,7 +195,7 @@ begin begin { it can be predefined procedure/function from RTL } if FRTLIndex.Count = 0 then - LoadChmIndex(FDocsDir, 'rtl.chm', FRTLIndex, 'system/'); + LoadChmIndex(FCHMSearchPath, 'rtl.chm', FRTLIndex, 'system/'); for i := 0 to FRTLIndex.Count - 1 do begin s := FRTLIndex.Names[i]; diff --git a/components/chmhelp/packages/idehelp/chmprog.pas b/components/chmhelp/packages/idehelp/chmprog.pas index 80c97146bf..6097c52876 100644 --- a/components/chmhelp/packages/idehelp/chmprog.pas +++ b/components/chmhelp/packages/idehelp/chmprog.pas @@ -6,7 +6,7 @@ interface uses Classes, SysUtils, - Dialogs, FileUtil, + Dialogs, FileUtil, LazFileUtils, LazHelpIntf, HelpIntfs, IDEHelpIntf, MacroIntf; @@ -19,7 +19,7 @@ type TFPCDirectivesHelpDatabase = class(THelpDatabase) private - FDocsDir: string; + FCHMSearchPath: string; FDirectiveNodes: TFPList; function SearchForDirective(ADirective: string; var ListOfNodes: THelpNodeQueryList): Boolean; @@ -33,7 +33,9 @@ type function ShowHelp(Query: THelpQuery; {%H-}BaseNode, NewNode: THelpNode; {%H-}QueryItem: THelpQueryItem; var ErrMsg: string): TShowHelpResult; override; - property DocsDir: string read FDocsDir write FDocsDir; + function GetCHMSearchPath: string; + property CHMSearchPath: string read FCHMSearchPath write FCHMSearchPath; + function FindCHMFile: string; end; procedure RegisterFPCDirectivesHelpDatabase; @@ -65,11 +67,15 @@ var TitleResults: TChmWLCTopicArray; i, k: Integer; DirectiveNode: THelpNode; + Filename: String; begin ADirective := UpperCase(ADirective); Result := False; - chm := TChmFileList.Create(Utf8ToSys(FDocsDir + 'prog.chm')); + Filename:=FindCHMFile; + if Filename='' then exit; + + chm := TChmFileList.Create(Utf8ToSys(Filename)); try if chm.Count = 0 then Exit; fchm := chm.Chm[0]; @@ -132,27 +138,22 @@ function TFPCDirectivesHelpDatabase.GetNodesForDirective( var ErrMsg: string): TShowHelpResult; var Directive: String; + Filename: String; begin Result := shrHelpNotFound; if (csDesigning in ComponentState) then Exit; if (FPCDirectiveHelpPrefix<>'') and (LeftStr(HelpDirective, Length(FPCDirectiveHelpPrefix)) = FPCDirectiveHelpPrefix) then begin - if FDocsDir = '' then - begin - FDocsDir := '$(LazarusDir)'; - IDEMacros.SubstituteMacros(FDocsDir); - FDocsDir := AppendPathDelim(FDocsDir) + 'docs' + PathDelim + 'html'; - end; - FDocsDir := AppendPathDelim(FDocsDir); - if not FileExistsUTF8(FDocsDir + 'prog.chm') then + Filename:=FindCHMFile; + if (Filename='') then begin Result := shrDatabaseNotFound; ErrMsg := Format('prog.chm not found. Please put prog.chm help file in '+ LineEnding - + '%s' + LineEnding - +'or set the path to it with "HelpFilesPath" in ' - +' Environment Options -> Help -> Help Options ->' + LineEnding - +'under Viewers - CHM Help Viewer', [FDocsDir]); + + '%s' + LineEnding + +'or set the path to it with "HelpFilesPath" in ' + +' Environment Options -> Help -> Help Options ->' + LineEnding + +'under Viewers - CHM Help Viewer', [FCHMSearchPath]); Exit; end; // HelpDirective starts with DirectivePrefix @@ -176,5 +177,20 @@ begin Result := Viewer.ShowNode(NewNode, ErrMsg); end; +function TFPCDirectivesHelpDatabase.GetCHMSearchPath: string; +begin + Result:=FCHMSearchPath; + if Result='' then begin + Result := '$(LazarusDir)/docs/html'; + IDEMacros.SubstituteMacros(Result); + Result:=MinimizeSearchPath(SetDirSeparators(Result)); + end; +end; + +function TFPCDirectivesHelpDatabase.FindCHMFile: string; +begin + Result:=SearchFileInPath('prog.chm','',GetCHMSearchPath,';',[]); +end; + end. diff --git a/components/chmhelp/packages/idehelp/lazchmhelp.pas b/components/chmhelp/packages/idehelp/lazchmhelp.pas index 0620ffe70f..a8bad6eeb7 100644 --- a/components/chmhelp/packages/idehelp/lazchmhelp.pas +++ b/components/chmhelp/packages/idehelp/lazchmhelp.pas @@ -57,9 +57,9 @@ unit LazChmHelp; interface uses - Classes, SysUtils, FileUtil, LazLogger, LazHelpIntf, HelpIntfs, - LazConfigStorage, PropEdits, LHelpControl, Controls, ChmLangRef, ChmLcl, - ChmProg; + Classes, SysUtils, FileUtil, LazLogger, LazFileUtils, LazHelpIntf, HelpIntfs, + LazConfigStorage, PropEdits, LHelpControl, Controls, UTF8Process, ChmLangRef, + ChmLcl, ChmProg; type @@ -70,7 +70,7 @@ type fHelpExe: String; fHelpLabel: String; fHelpConnection: TLHelpConnection; - fChmsFilePath: String; + fCHMSearchPath: String; fHelpExeParams: String; function DBFindViewer({%H-}HelpDB: THelpDatabase; {%H-}const MimeType: string; var {%H-}ErrMsg: string; out Viewer: THelpViewer): TShowHelpResult; @@ -96,10 +96,11 @@ type procedure Save(Storage: TConfigStorage); override; function GetLocalizedName: string; override; function GetHelpEXE: String; // macros resolved, see property HelpEXE + function GetHelpFilesPath: String; // macros resolved, see property HelpFilesPath published property HelpEXE: String read fHelpEXE write SetHelpEXE; // with macros, see GetHelpEXE property HelpLabel: String read GetHelpLabel write SetHelpLabel; - property HelpFilesPath: String read fChmsFilePath write SetChmsFilePath; + property HelpFilesPath: String read fCHMSearchPath write SetChmsFilePath; // directories separated with semicolon, with macros, see GetHelpFilesPath property HelpExeParams: String read fHelpExeParams write fHelpExeParams; end; @@ -109,30 +110,6 @@ implementation uses Process, MacroIntf, InterfaceBase, Forms, Dialogs, HelpFPDoc, IDEMsgIntf; -function FixSlash(AStr: String): String; -var - WrongSlash: String; - FP: Integer; -begin - Result := AStr; - case PathDelim of - '/': WrongSlash := '\'; - '\': WrongSlash := '/'; - end; - // fix wrong delim - repeat - FP := Pos(WrongSlash, Result); - if FP > 0 then - Result[FP] := PathDelim; - until FP = 0; - // fix double path delim - repeat - FP := Pos(PathDelim+PathDelim, Result); - if FP <> 0 then - Delete(Result, FP, 1); - until FP = 0; -end; - { TChmHelpViewer } function TChmHelpViewer.DBFindViewer(HelpDB: THelpDatabase; @@ -151,13 +128,16 @@ begin end; procedure TChmHelpViewer.SetChmsFilePath(const AValue: String); +var + p: String; begin - if fChmsFilePath = AValue then Exit; - fChmsFilePath := AppendPathDelim(AValue); + if fCHMSearchPath = AValue then Exit; + fCHMSearchPath := AppendPathDelim(AValue); + p:=GetHelpFilesPath; if Assigned(LangRefHelpDatabase) then - LangRefHelpDatabase.LoadKeywordList(fChmsFilePath); + LangRefHelpDatabase.LoadKeywordList(p); if Assigned(FPCDirectivesHelpDatabase) then - FPCDirectivesHelpDatabase.DocsDir := fChmsFilePath; + FPCDirectivesHelpDatabase.CHMSearchPath := p; end; procedure TChmHelpViewer.SetHelpEXE(AValue: String); @@ -175,6 +155,15 @@ begin Exit(''); end; +function TChmHelpViewer.GetHelpFilesPath: String; +begin + Result:=fCHMSearchPath; + if Result='' then + Result:='$(LazarusDir)/docs/html;$(LazarusDir)/docs/html/lcl'; + IDEMacros.SubstituteMacros(Result); + Result:=MinimizeSearchPath(SetDirSeparators(Result)); +end; + function TChmHelpViewer.GetFileNameAndURL(RawUrl:String; out FileName: String; out URL: String ): Boolean; var @@ -201,7 +190,7 @@ end; function TChmHelpViewer.CheckBuildLHelp: Integer; var - Proc: TProcess; + Proc: TProcessUTF8; Lazbuild: String; LHelpProject: String; WS: String; @@ -218,11 +207,10 @@ begin if not GetLazBuildEXE(Lazbuild) then Exit; - LHelpProject := FixSlash('$(LazarusDir)/components/chmhelp/lhelp/lhelp.lpi'); - - if not (IDEMacros.SubstituteMacros(LHelpProject) - and FileExistsUTF8(LHelpProject)) - then + LHelpProject := '$(LazarusDir)/components/chmhelp/lhelp/lhelp.lpi'; + if not IDEMacros.SubstituteMacros(LHelpProject) then exit; + LHelpProject:=TrimFilename(SetDirSeparators(LHelpProject)); + if not FileExistsUTF8(LHelpProject) then Exit; WS := '--ws='+LCLPlatformDirNames[WidgetSet.LCLPlatform]; @@ -231,14 +219,13 @@ begin //if Result <> mrYes then // Exit; - Proc := TProcess.Create(nil); + Proc := TProcessUTF8.Create(nil); {$if (fpc_version=2) and (fpc_release<5)} - Proc.CommandLine := Utf8ToSys(Lazbuild) + ' ' + WS - + ' ' + Utf8ToSys(LHelpProject); + Proc.CommandLine := Lazbuild + ' ' + WS + ' ' + LHelpProject; {$else} - Proc.Executable := Utf8ToSys(Lazbuild); + Proc.Executable := Lazbuild; Proc.Parameters.Add(WS); - Proc.Parameters.Add(Utf8ToSys(LHelpProject)); + Proc.Parameters.Add(LHelpProject); {$endif} Proc.Options := [poUsePipes, poStderrToOutPut]; Proc.Execute; @@ -250,8 +237,10 @@ begin IDEMessagesWindow.BeginBlock; IDEMessagesWindow.AddMsg('- Building lhelp -','',0); - LHelpProject := FixSlash('$(LazarusDir)/components/chmhelp/lhelp/'); + LHelpProject := '$(LazarusDir)/components/chmhelp/lhelp/'; IDEMacros.SubstituteMacros(LHelpProject); + LHelpProject:=TrimFilename(SetDirSeparators(LHelpProject)); + while Proc.Running do begin while Proc.Output.NumBytesAvailable > 0 do begin @@ -299,15 +288,12 @@ begin end; function TChmHelpViewer.GetLazBuildEXE(out ALazBuild: String): Boolean; -var - LazBuildMacro: String; begin - Result := False; - LazBuildMacro:= '$(LazarusDir)/$MakeExe(lazbuild)'; - Result := IDEMacros.SubstituteMacros(LazBuildMacro) - and FileExistsUTF8(LazBuildMacro); - if Result then - ALazBuild := FixSlash(LazBuildMacro); + Result := False; + ALazBuild:= '$(LazarusDir)/$MakeExe(lazbuild)'; + if not IDEMacros.SubstituteMacros(ALazBuild) then exit; + ALazBuild:=TrimFilename(SetDirSeparators(ALazBuild)); + Result:=FileExistsUTF8(ALazBuild); end; function TChmHelpViewer.PassTheBuck(Node: THelpNode; var ErrMsg: string @@ -382,8 +368,9 @@ var FileName: String; Url: String; Res: TLHelpResponse; - DocsDir: String; - Proc: TProcess; + SearchPath: String; + Proc: TProcessUTF8; + FoundFileName: String; begin if Pos('file://', Node.URL) = 1 then begin @@ -401,26 +388,22 @@ begin Exit(shrDatabaseNotFound); end; - if HelpFilesPath = '' then - begin - DocsDir := FixSlash('$(LazarusDir)/docs/html/'); - IDEMacros.SubstituteMacros(DocsDir); - end - else - DocsDir := fChmsFilePath; + SearchPath := GetHelpFilesPath; + FoundFileName:=SearchFileInPath(Filename,'',SearchPath,';',[]); + debugln(['TChmHelpViewer.ShowNode Filename="',Filename,'" SearchPath="',SearchPath,'" Found="',FoundFileName,'"']); - if not FileExistsUTF8(DocsDir+FileName) then + if FoundFileName='' then begin Result := shrDatabaseNotFound; ErrMsg := FileName +' not found. Please put the chm help files in '+ LineEnding - +DocsDir+ LineEnding + +SearchPath+ 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; + FileName := FoundFileName; if ExtractFileNameOnly(GetHelpExe) = 'lhelp' then begin fHelpConnection.StartHelpServer(HelpLabel, GetHelpExe); @@ -439,13 +422,13 @@ begin + 'and the second one will be replaced by URL'; Exit; end; - Proc := TProcess.Create(nil); + Proc := TProcessUTF8.Create(nil); try {$if (fpc_version=2) and (fpc_release<5)} - Proc.CommandLine := Utf8ToSys(GetHelpExe + ' ' + Format(fHelpExeParams, [FileName, Url])); + Proc.CommandLine := GetHelpExe + ' ' + Format(fHelpExeParams, [FileName, Url]); {$else} - Proc.Executable := Utf8ToSys(GetHelpExe); - Proc.Parameters.Add(Utf8ToSys(Format(fHelpExeParams, [FileName, Url]))); + Proc.Executable := GetHelpExe; + Proc.Parameters.Add(Format(fHelpExeParams, [FileName, Url])); {$endif} Proc.Execute; Res := srSuccess;