mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-11-03 21:19:38 +01:00
chmhelp: using search path to search for chm files
git-svn-id: trunk@37715 -
This commit is contained in:
mattias
parent
f23c1e5ca7
commit
5d587ccb3c
@ -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];
|
||||
|
||||
@ -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.
|
||||
|
||||
|
||||
@ -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;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user