paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-26 03:59:10 +02:00
Code Issues Packages Projects Releases Wiki Activity

IdeHelp: Fix Lazarus hanging when lHelp starts from Menu and F1 pressed. Issue #38276, patch from Andrey Sobol.

Browse Source 
git-svn-id: trunk@64306 -
This commit is contained in:
juha 2020-12-29 23:28:27 +00:00
parent 802ff9d061
commit 9cc893672d
2 changed files with 48 additions and 44 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

76
components/chmhelp/packages/idehelp/lazchmhelp.pas
View File

@ -114,8 +114,13 @@ type
procedure Register;
function ChmViewerInstance(): TChmHelpViewer;
implementation
var
ChmHelpViewer: TChmHelpViewer;
const
// Part of help name. Stored/retrieved in Lazarus options CHMHelp/Name.
// Do not localize.
@ -133,22 +138,28 @@ end;
procedure Register;
var
ChmHelp: TChmHelpViewer;
ChmViewer: TChmHelpViewer;
begin
ChmHelp := TChmHelpViewer.Create(nil);
HelpViewers.RegisterViewer(ChmHelp);
ChmViewer := ChmViewerInstance();
HelpViewers.RegisterViewer(ChmViewer);
RegisterLangRefHelpDatabase;
LangRefHelpDatabase.OnFindViewer := @ChmHelp.DBFindViewer;
LangRefHelpDatabase.OnFindViewer := @ChmViewer.DBFindViewer;
RegisterLclHelpDatabase;
LCLHelpDatabase.OnFindViewer := @ChmHelp.DBFindViewer;
LCLHelpDatabase.OnFindViewer := @ChmViewer.DBFindViewer;
RegisterFPCDirectivesHelpDatabase;
FPCDirectivesHelpDatabase.OnFindViewer := @ChmHelp.DBFindViewer;
FPCDirectivesHelpDatabase.OnFindViewer := @ChmViewer.DBFindViewer;
// disable showing CodeBrowser on unknown identifiers. LHelp has its own
// search function.
LazarusHelp.ShowCodeBrowserOnUnknownIdentifier:=false;
end;
function ChmViewerInstance ( ): TChmHelpViewer;
begin
if not Assigned (ChmHelpViewer) then
ChmHelpViewer:= TChmHelpViewer.Create(nil);
Result:= ChmHelpViewer;
end;
{ TChmHelpViewer }
@ -515,43 +526,42 @@ var
SearchPath: String; //; delimited list of directories
HelpExeFileName: String;
begin
// Make sure the lhelp help viewer exists; build it if doesn't and it is lhelp
HelpExeFileName:=GetHelpExe;
if (not FileExistsUTF8(HelpExeFileName)) and
((ExtractFileNameOnly(HelpExeFileName) = 'lhelp') and
(CheckBuildLHelp <> mrOK)) then
begin
IDEMessageDialog(HELP_MissingLhelp,
Format(HELP_UnableToFindTheLhelpViewerPleaseCompileTheLhelpPro,
[LineEnding, HelpExeFileName, LineEnding+LineEnding, LineEnding,
GetForcedPathDelims('components/chmhelp/lhelp/lhelp.lpi')]),
mtError,[mbCancel]);
Debugln(Format('ChmHelpViewer: '+HELP_UnableToFindTheLhelpViewerPleaseCompileTheLhelpPro,
[LineEnding, HelpExeFileName, LineEnding+LineEnding, LineEnding,
GetForcedPathDelims('components/chmhelp/lhelp/lhelp.lpi')]));
exit;
end;
SearchPath := GetHelpFilesPath;
// Start up help viewer if needed - and tell it to hide
if not(fHelpConnection.ServerRunning) then
begin
// Make sure the lhelp help viewer exists; build it if doesn't and it is lhelp
if (not FileExistsUTF8(HelpExeFileName)) and
((ExtractFileNameOnly(HelpExeFileName) = 'lhelp') and
(CheckBuildLHelp <> mrOK)) then
begin
IDEMessageDialog(HELP_MissingLhelp,
Format(HELP_UnableToFindTheLhelpViewerPleaseCompileTheLhelpPro,
[LineEnding, HelpExeFileName, LineEnding+LineEnding, LineEnding,
GetForcedPathDelims('components/chmhelp/lhelp/lhelp.lpi')]),
mtError,[mbCancel]);
Debugln(Format('ChmHelpViewer: '+HELP_UnableToFindTheLhelpViewerPleaseCompileTheLhelpPro,
[LineEnding, HelpExeFileName, LineEnding+LineEnding, LineEnding,
GetForcedPathDelims('components/chmhelp/lhelp/lhelp.lpi')]));
exit;
end;
// Start up help viewer if needed - and tell it to hide
fHelpConnection.StartHelpServer(HelpLabel, HelpExeFileName, true);
Response := fHelpConnection.RunMiscCommand(mrVersion);
if Response <> srSuccess then
begin
debugln('TChmHelpViewer: Help viewer does not support our protocol version ('+PROTOCOL_VERSION +'). Response was: ord: '+inttostr(ord(Response)))
end
else
begin
// Open all chm files after it has started, while still hidden
OpenAllCHMsInSearchPath(SearchPath);
// Instruct viewer to show its GUI
Response := fHelpConnection.RunMiscCommand(mrShow);
if Response <> srSuccess then
debugln('TChmHelpViewer: Help viewer gave error response to mrShow command. Response was: ord: '+inttostr(ord(Response)));
debugln('TChmHelpViewer: Help viewer does not support our protocol version ('+
PROTOCOL_VERSION +'). Response was: ord: '+inttostr(ord(Response)));
Exit;
end;
end;
// Open all chm files always
OpenAllCHMsInSearchPath(SearchPath);
// Instruct viewer to show its GUI
Response := fHelpConnection.RunMiscCommand(mrShow);
if Response <> srSuccess then
debugln('TChmHelpViewer: Help viewer gave error response to mrShow command. Response was: ord: '+inttostr(ord(Response)));
end;
function TChmHelpViewer.ShowNode(Node: THelpNode; var ErrMsg: string

16
components/chmhelp/packages/idehelp/lazchmhelpregister.pas
View File

@ -42,10 +42,7 @@ const
HELP_CURRENT_NAME = 'chpHelp';
HELP_CATEGORY_IDECMD_NAME = 'chpFormat';
var
IDECHMHelp: TChmHelpViewer;
// Register package
procedure Register;
var
Cat: TIDECommandCategory;
@ -53,10 +50,11 @@ var
Key: TIDEShortCut;
}
CmdHelpCommand: TIDECommand;
AChmViewer: TChmHelpViewer;
begin
// We can't put this in an initialization section because IDEChmHelp requires
// some IDE features, which are only available in "Register".
IDECHMHelp := TChmHelpViewer.Create(nil);
AChmViewer := ChmViewerInstance();
Cat := IDECommandList.CreateCategory(nil, HELP_CATEGORY_IDECMD_NAME,
HELP_CATEGORY_IDECMD, IDECmdScopeSrcEditOnly);
{
@ -66,13 +64,9 @@ begin
@IDECHMHelp.ShowAllHelp);
}
CmdHelpCommand := RegisterIDECommand(Cat, HELP_CURRENT_NAME, HELP_CURRENT_IDECMD,
@IDECHMHelp.ShowAllHelp);
@AChmViewer.ShowAllHelp);
RegisterIDEMenuCommand(mnuHelp, HELP_CURRENT_NAME, HELP_CURRENT_MENU,
@IDECHMHelp.ShowAllHelp, nil, CmdHelpCommand);
@AChmViewer.ShowAllHelp, nil, CmdHelpCommand);
end;
finalization
FreeAndNil(IDECHMHelp);
end.