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

ChmHelp: Improve LHelp and related packages. Issue #24743, patch from Reinier Olislagers

Browse Source 
git-svn-id: trunk@42270 -
This commit is contained in:
juha 2013-08-03 08:04:18 +00:00
parent c93b75b24c
commit c80a38a73b
8 changed files with 269 additions and 94 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
components/chmhelp/lhelp/chmcontentprovider.pas
View File

@ -5,9 +5,6 @@ unit chmcontentprovider;
{$Note Compiling lhelp with search support}
{$DEFINE CHM_SEARCH}
//{$else}
//{$Note Compiling lhelp *without* search support since your fpc version is not new enough}
//{$endif}
{$if (fpc_version=2) and (fpc_release>4)}
{$Note Compiling lhelp *with* binary index and toc support}
{$DEFINE CHM_BINARY_INDEX_TOC}
@ -15,7 +12,7 @@ unit chmcontentprovider;
{off $DEFINE CHM_DEBUG_TIME}
{off $DEFINE CHM_SEARCH}
interface
@ -540,11 +537,9 @@ begin
fStatusBar.SimpleText:= '';
{$IFDEF CHM_DEBUG_TIME}
writeln('Eind: ',FormatDateTime('hh:nn:ss.zzz', Now));
writeln('End: ',FormatDateTime('hh:nn:ss.zzz', Now));
{$ENDIF}
{$IFDEF CHM_SEARCH}
i := 0;
while (HasSearchIndex = False) and (i < fChms.Count) do

2
components/chmhelp/lhelp/lhelp.lpi
View File

@ -1,4 +1,4 @@
<?xml version="1.0"?>
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="9"/>

26
components/chmhelp/lhelp/lhelp.lpr
View File

@ -1,5 +1,7 @@
{ Copyright (C) <2005> <Andrew Haines> lhelp.lpr
Lhelp CHM help viewer application
This source is free software; you can redistribute it and/or modify it under
the terms of the GNU General Public License as published by the Free
Software Foundation; either version 2 of the License, or (at your option)
@ -21,12 +23,8 @@ program lhelp;
uses
Interfaces, // this includes the LCL widgetset
SysUtils,
Classes,
Controls,
Dialogs,
Forms
{ add your units here }, SimpleIPC, TurboPowerIPro, chmpopup, lhelpcontrolpkg, lhelpcore;
SysUtils, Classes, Controls, Dialogs, Forms,
SimpleIPC, TurboPowerIPro, chmpopup, lhelpcontrolpkg, lhelpcore;
var
X: Integer;
@ -40,14 +38,15 @@ begin
if LowerCase(ParamStr(X)) = '--help' then
begin
S := TStringList.Create;
S.Add(' LHelp Options:');
S.Add(' LHelp options:');
S.Add('');
S.Add(' Usage: lhelp [[filename] [--context id] [--ipcname lhelp-myapp]]');
S.Add(' Usage: lhelp [[filename] [--context id] [--hide] [--ipcname lhelp-myapp]]');
S.Add('');
S.Add(' --help : Show this information');
S.Add(' --hide : Start hidden but accept communications via IPC');
S.Add(' --context : Show the help information related');
S.Add(' to this context');
S.Add(' --ipcname : The name of the ipc server to listen on for');
S.Add(' --ipcname : The name of the IPC server to listen on for');
S.Add(' programs who wish to control the viewer');
if TextRec(Output).Mode = fmClosed then
@ -60,15 +59,22 @@ begin
end;
Application.CreateForm(THelpForm, HelpForm);
Application.CreateForm(THelpPopupForm, HelpPopupForm);
try
Application.Run;
except
// try to remove stale names pipes so that a new instance can use them
// try to remove stale named pipes so that a new instance can use them
if IPCServer <> nil then
try
FreeAndNil(IPCServer);
except
end;
if IPCClient <> nil then
try
FreeAndNil(IPCClient);
except
end;
end;
end.

9
components/chmhelp/lhelp/lhelpcore.lfm
View File

@ -5,7 +5,7 @@ object HelpForm: THelpForm
Width = 758
ActiveControl = Panel1
Caption = 'LHelp'
ClientHeight = 515
ClientHeight = 516
ClientWidth = 758
Icon.Data = {
7E04000000000100010010100000010020006804000016000000280000001000
@ -52,7 +52,7 @@ object HelpForm: THelpForm
OnKeyUp = FormKeyUp
OnShow = FormShow
Position = poScreenCenter
LCLVersion = '0.9.31'
LCLVersion = '1.1'
Visible = True
object Panel1: TPanel
Left = 0
@ -105,7 +105,6 @@ object HelpForm: THelpForm
8B000000000000000000B07522006780280037221A005E392A00683B2C009129
1B000000000038AB3E000000000068BC74000000000000000000
}
NumGlyphs = 0
OnClick = ForwardToolBtnClick
end
object BackBttn: TSpeedButton
@ -150,7 +149,6 @@ object HelpForm: THelpForm
8B00000000000000000053575500535755005659580000000000000000000000
0000000000000000000000000000000000000000000000000000
}
NumGlyphs = 0
OnClick = BackToolBtnClick
end
object HomeBttn: TSpeedButton
@ -235,13 +233,12 @@ object HelpForm: THelpForm
EA00E4E7EA00E4E7EA00E4E7EA00E4E7EA00E4E7EA00E4E7EA00E4E7EA00E4E7
EA00E4E7EA00E4E7EA00E4E7EA00E4E7EA00E4E7EA00E4E7EA00
}
NumGlyphs = 0
OnClick = HomeToolBtnClick
end
end
object PageControl: TPageControl
Left = 0
Height = 483
Height = 484
Top = 32
Width = 758
Align = alClient

222
components/chmhelp/lhelp/lhelpcore.pas
View File

@ -1,4 +1,6 @@
{ Copyright (C) 2005 Andrew Haines
{ Copyright (C) 2005-2013 Andrew Haines, Lazarus contributors
Main form for lhelp. Includes processing/data communication.
This source is free software; you can redistribute it and/or modify it under
the terms of the GNU General Public License as published by the Free
@ -95,27 +97,46 @@ type
private
{ private declarations }
fServerName: String;
// Receives commands from IDE
fInputIPC: TSimpleIPCServer;
// Sends responses back to IDE
// only used if lhelp started with --ipcname to indicate
// IPC communication method should be used
fOutputIPC: TSimpleIPCClient;
fServerTimer: TTimer;
fContext: LongInt; // used once when we are started on the command line with --context
fConfig: TXMLConfig;
FHasShowed: Boolean;
fHide: boolean; //If yes, start with content hidden. Otherwise start normally
// Load preferences; separate preferences per coupled server/IDE
procedure LoadPreferences(AIPCName: String);
procedure SavePreferences({%H-}AIPCName: String);
// Saves preferences. Uses existing config loaded by LoadPreferences
procedure SavePreferences;
procedure AddRecentFile(AFileName: String);
procedure ContentTitleChange({%H-}sender: TObject);
procedure OpenRecentItemClick(Sender: TObject);
// Send response back to server (IDE)
// Used to acknowledge commands from the server
procedure SendResponse(Response: DWord);
// Wait for message from server (IDE) and process
procedure ServerMessage(Sender: TObject);
// Parse any given command line options
procedure ReadCommandLineOptions;
procedure StartServer(ServerName: String);
procedure StopServer;
function OpenURL(const AURL: String; AContext: THelpContext=-1): DWord;
// Start simple IPC server/client
// ServerName can be the variable passed to --ipcname
// It is used both for starting up the local server and to ID the remote server
procedure StartComms(ServerName: String);
// Stop simple IPC server/client
procedure StopComms;
// Open specified URL in viewer window
function OpenURL(const AURL: String; AContext: THelpContext=-1): DWord;
// Open specified URL - presumably used to queue URLs for delayed opening
procedure LateOpenURL(Url: PStringItem);
function ActivePage: TContentTab;
// Update UI visibility
procedure RefreshState;
procedure ShowError(AError: String);
// Set keyup handler for control (and any child controls)
procedure SetKeyUp(AControl: TControl);
public
{ public declarations }
@ -124,8 +145,12 @@ type
var
HelpForm: THelpForm;
IPCClient: TSimpleIPCClient;
IPCServer: TSimpleIPCServer;
const INVALID_FILE_TYPE = 1;
const
INVALID_FILE_TYPE = 1;
VERSION_STAMP = '2013-07-31'; //used in displaying about form etc
implementation
@ -160,14 +185,15 @@ begin
f.BorderStyle := bsDialog;
f.Position := poMainFormCenter;
f.Constraints.MinWidth := 150;
f.Constraints.MaxWidth := 250;
f.Constraints.MaxWidth := 350;
l := TLabel.Create(f);
l.Parent := f;;
l.Align := alTop;
l.BorderSpacing.Around := 6;
l.Caption := 'LHelp (CHM file viewer)' + LineEnding +
'Ver. 2009.06.08' + LineEnding +
'Copyright (C) Andrew Haines';
'Version ' + VERSION_STAMP + LineEnding +
'Copyright (C) Andrew Haines, ' + LineEnding +
'Lazarus contributors';
l.AutoSize := True;
l.WordWrap := True;
b := TButton.Create(f);
@ -236,7 +262,7 @@ begin
URLSAllowed := Trim(URLSALLowed);
fRes:='';
if InputQuery('Please Enter a URL', 'Supported URL type(s): (' +URLSAllowed+ ')', fRes) then
if InputQuery('Please enter a URL', 'Supported URL type(s): (' +URLSAllowed+ ')', fRes) then
begin
if OpenURL(fRes) = ord(srSuccess) then
AddRecentFile(fRes);
@ -249,17 +275,19 @@ begin
Visible:= False;
Application.ProcessMessages;
FileMenuCloseItemClick(Sender);
StopServer;
SavePreferences(fServerName);
StopComms;
SavePreferences;
end;
procedure THelpForm.FormCreate(Sender: TObject);
begin
fContext := -1;
fHide := false;
ReadCommandLineOptions;
LoadPreferences(fServerName);
// Only start IPC if server name passed in --ipcname
if fServerName <> '' then begin
StartServer(fServerName);
StartComms(fServerName);
end;
RefreshState;
SetKeyUp(Self);
@ -279,7 +307,6 @@ begin
if FHasShowed then
Exit;
FHasShowed := True;
end;
procedure THelpForm.ForwardToolBtnClick(Sender: TObject);
@ -319,11 +346,16 @@ procedure THelpForm.LoadPreferences(AIPCName: String);
var
PrefFile: String;
RecentCount: Integer;
ServerPart: String;
i: Integer;
begin
PrefFile := GetAppConfigDirUTF8(False);
ForceDirectoriesUTF8(PrefFile);
PrefFile:=Format('%slhelp-%s.conf',[IncludeTrailingPathDelimiter(PrefFile), AIPCName]);
// --ipcname passes a server ID that consists of a
// a server-dependent constant together with a process ID.
// Strip out the process ID to get fixed config file names for one server
ServerPart := Copy(AIPCName, 1, length(AIPCName)-5); //strip out PID
PrefFile:=Format('%slhelp-%s.conf',[IncludeTrailingPathDelimiter(PrefFile), ServerPart]);
fConfig := TXMLConfig.Create(Self);
fConfig.Filename:=PrefFile;
@ -333,6 +365,9 @@ begin
Width := fConfig.GetValue('Position/Width/Value', Width);
Height := fConfig.GetValue('Position/Height/Value', Height);
if fConfig.GetValue('Position/Maximized',false)=true then
Windowstate:=wsMaximized;
OpenDialog1.FileName := fConfig.GetValue('LastFileOpen/Value', OpenDialog1.FileName);
RecentCount:= fConfig.GetValue('Recent/ItemCount/Value', 0);
@ -341,7 +376,7 @@ begin
AddRecentFile(fConfig.GetValue('Recent/Item'+IntToStr(i)+'/Value',''));
end;
procedure THelpForm.SavePreferences(AIPCName: String);
procedure THelpForm.SavePreferences;
var
i: Integer;
begin
@ -351,6 +386,10 @@ begin
fConfig.SetValue('Position/Top/Value', Top);
fConfig.SetValue('Position/Width/Value', Width);
fConfig.SetValue('Position/Height/Value', Height);
end
else
begin
fConfig.SetValue('Position/Maximized', true);
end;
fConfig.SetValue('LastFileOpen/Value', OpenDialog1.FileName);
@ -412,31 +451,27 @@ procedure THelpForm.SendResponse(Response: DWord);
var
Stream: TMemoryStream;
begin
fOutputIPC := TSimpleIPCClient.Create(nil);
fOutputIPC.ServerID := fServerName+'client';
if fOutputIPC.ServerRunning {$IFDEF STALE_PIPE_WORKAROUND} and not IPCPipeIsStale(fOutputIPC){$ENDIF}
then
fOutputIPC.Active := True;
Stream := TMemoryStream.Create;
Stream.WriteDWord(Response);
try
Stream.WriteDWord(Response);
if fOutputIPC.Active then
fOutputIPC.SendMessage(mtUnknown, Stream);
if fOutputIPC.Active then
fOutputIPC.Active := False;
FreeAndNil(fOutputIPC);
if assigned(fOutputIPC) and fOutputIPC.Active then
fOutputIPC.SendMessage(mtUnknown, Stream);
finally
Stream.Free;
end;
end;
procedure THelpForm.ServerMessage(Sender: TObject);
var
UrlReq: TUrlRequest;
FileReq:TFileRequest;
FileReq: TFileRequest;
ConReq: TContextRequest;
MiscReq: TMiscRequest;
MustClose: boolean=false;
Stream: TStream;
Res: LongWord;
Url: String;
Url: String='';
begin
if fInputIPC.PeekMessage(5, True) then begin
Stream := fInputIPC.MsgData;
@ -470,13 +505,48 @@ begin
Url := 'file://'+FileReq.FileName;
Res := OpenURL(Url, ConReq.HelpContext);
end;
rtMisc : begin
Stream.Position := 0;
FillByte(MiscReq{%H-},SizeOf(MiscReq),0);
Stream.Read(MiscReq, SizeOf(MiscReq));
case MiscReq.RequestID of
mrClose:
begin
MustClose:=true;
Res:= ord(srSuccess);
end;
mrShow:
begin
fHide := false;
PageControl.Visible:=true;
Res := ord(srSuccess);
end;
mrVersion:
begin
//Protocol version encoded in the filename
// Verify what we support
if strtointdef(FileReq.FileName,0)=strtointdef(PROTOCOL_VERSION,0) then
Res := ord(srSuccess)
else
Res := ord(srError); //version not supported
end
else {Unknown}
Res := ord(srUnknown);
end;
end;
end;
if Res = Ord(srSuccess) then
if (URL<>'') and (Res = Ord(srSuccess)) then
AddRecentFile(Url);
SendResponse(Res);
Self.SendToBack;
Self.BringToFront;
Self.ShowOnTop;
if MustClose then
Application.Terminate;
if (MustClose=false) and (fHide=false) then
begin
Self.SendToBack;
Self.BringToFront;
Self.ShowOnTop;
end;
end;
end;
@ -499,7 +569,7 @@ begin
IsHandled[X] := True;
inc(X);
end;
end else if LowerCase(ParamStrUTF8(X)) = '--context' then begin
end else if LowerCase(ParamStrUTF8(X)) = '--context' then begin
IsHandled[X] := True;
inc(X);
if (X <= ParamCount) then
@ -507,11 +577,16 @@ begin
IsHandled[X] := True;
inc(X);
end;
end else if LowerCase(ParamStrUTF8(X)) = '--hide' then begin
IsHandled[X] := True;
inc(X);
fHide:=true;
end else begin
IsHandled[X]:=copy(ParamStrUTF8(X),1,1)='-'; // ignore other parameters
inc(X);
end;
end;
// Loop through a second time for the url
for X := 1 to ParamCount do
if not IsHandled[X] then begin
@ -535,9 +610,13 @@ begin
end;
end;
procedure THelpForm.StartServer(ServerName: String);
begin
procedure THelpForm.StartComms(ServerName: String);
// Starts IPC server and client for two-way communication with
// controlling program (e.g. Lazarus IDE).
// Only useful if IPC serverID is passed through the --ipcname
// command.
begin
fInputIPC := TSimpleIPCServer.Create(nil);
fInputIPC.ServerID := ServerName;
fInputIPC.Global := True;
@ -550,20 +629,38 @@ begin
fServerTimer.Enabled := True;
ServerMessage(nil);
fOutputIPC := TSimpleIPCClient.Create(nil);
fOutputIPC.ServerID := ServerName+'client';
try
if fOutputIPC.ServerRunning {$IFDEF STALE_PIPE_WORKAROUND} and not IPCPipeIsStale(fOutputIPC){$ENDIF}
then
fOutputIPC.Active := True;
except
fOutputIPC.Active := False;
end;
IPCClient := fOutputIPC;
end;
procedure THelpForm.StopServer;
procedure THelpForm.StopComms;
begin
if fInputIPC = nil then
exit;
if fInputIPC <> nil then
begin
if fInputIPC.Active then
fInputIPC.Active := False;
if fInputIPC.Active then
fInputIPC.Active := False;
FreeAndNil(fInputIPC);
IPCServer := nil;
FreeAndNil(fServerTimer);
end;
FreeAndNil(fInputIPC);
IPCServer := nil;
FreeAndNil(fServerTimer);
if fOutputIPC <> nil then
begin
if fOutputIPC.Active then
fOutputIPC.Active := False;
FreeAndNil(fOutputIPC);
IPCClient := nil;
end;
end;
function THelpForm.OpenURL(const AURL: String; AContext: THelpContext): DWord;
@ -598,7 +695,6 @@ begin
Exit;
end;
for I := 0 to PageControl.PageCount-1 do begin
if fRealContentProvider.ClassName = TContentTab(PageControl.Pages[I]).ContentProvider.ClassName then begin
fPage := TContentTab(PageControl.Pages[I]);
@ -615,7 +711,7 @@ begin
if fPage = nil then
begin
//no page was found already to handle this content so create one
//no existing page that can handle this content, so create one
fPage := TContentTab.Create(PageControl);
fPage.ContentProvider := fRealContentProvider.Create(fPage, ImageList1);
fPAge.ContentProvider.OnTitleChange:=@ContentTitleChange;
@ -634,7 +730,8 @@ begin
else
Result := Ord(srInvalidFile);
ShowOnTop;
if not fHide then
ShowOnTop;
end;
@ -659,7 +756,25 @@ procedure THelpForm.RefreshState;
var
en: Boolean;
begin
en := Assigned(ActivePage);
if fHide then
begin
en := false;
// Hide content page
// todo: even though this code perhaps will hide the content window,
// starting laz+pressing f1 will show content while loading all chms
if Assigned(ActivePage) then
with TChmContentProvider(ActivePage.ContentProvider) do
begin
ActivePage.Visible:=false;
Visible:=false;
//todo: are these necessary
TabsControl.Visible := false;
Splitter.Visible := false;
end;
end
else
en := Assigned(ActivePage);
BackBttn.Enabled := en;
ForwardBttn.Enabled := en;
HomeBttn.Enabled := en;
@ -685,7 +800,7 @@ begin
if (AControl = nil) or not (AControl.InheritsFrom(TWinControl)) then
Exit;
for i := 0 to WCont.ControlCount-1 do
SetKeyUp(WCont.Controls[i]);
SetKeyUp(WCont.Controls[i]);
WCont.OnKeyUp:=@FormKeyUp;
end;
@ -705,6 +820,7 @@ end;
finalization
if IPCServer <> nil then
FreeAndNil(IPCServer);
if IPCClient <> nil then
FreeAndNil(IPCClient);
end.

2
components/chmhelp/packages/help/lazhelpchm.pas
View File

@ -7,7 +7,7 @@
Author: Mattias Gaertner
Abstract:
Methods and types for simple CHM help using chm viewer "lhelp".
Methods and types for CHM help using chm viewer "lhelp".
}
unit LazHelpCHM;

53
components/chmhelp/packages/help/lhelpcontrol.pas
View File

@ -4,8 +4,7 @@ unit LHelpControl;
Starts, stops and controls external help viewer via IPC.
This is used to display context-sensitive help in Lazarus, and could be used in applications to do the same.
This unit serves as reference implementation and documentation of the protocol used to communicate with help viewers.
Also contains definitions used by both Lazarus IDE and help viewers.
Currently, the only help viewer that supports this protocol is the lhelp CHM help viewer.
}
@ -25,12 +24,16 @@ uses
{$ENDIF}
Classes, SysUtils, FileUtil, LazLogger, SimpleIPC, process, UTF8Process;
const
PROTOCOL_VERSION='1'; //IDE<>LHelp communication protocol version. Please update when breaking compatibility
type
TRequestType = (rtFile, rtUrl, rtContext);
TRequestType = (rtFile, rtUrl, rtContext, rtMisc {window handling etc});
TMiscRequests = (mrShow, mrVersion, mrClose);
TLHelpResponse = (srNoAnswer, srUnknown, srSuccess, srInvalidFile, srInvalidURL, srInvalidContext);
TLHelpResponse = (srError, srNoAnswer, srUnknown, srSuccess, srInvalidFile, srInvalidURL, srInvalidContext);
TFileRequest = record
// Opening files
RequestType: TRequestType;
FileName: array[0..512] of char;
end;
@ -42,6 +45,11 @@ type
FileRequest: TFileRequest;
HelpContext: THelpContext;
end;
TMiscRequest = record
// In this record, the FileName array may have a meaning specific to the request ID.
FileRequest: TFileRequest;
RequestID: TMiscRequests;
end;
TProcedureOfObject = procedure of object;
@ -52,22 +60,26 @@ type
FProcessWhileWaiting: TProcedureOfObject;
fServerOut: TSimpleIPCClient; // sends messages to lhelp
fServerIn: TSimpleIPCServer; // recieves messages from lhelp
// Wait for help viewer to respond in a reasonable timeframe and return the response
function WaitForMsgResponse: TLHelpResponse;
// Send a message to the help viewer
function SendMessage(Stream: TStream): TLHelpResponse;
public
constructor Create;
destructor Destroy; override;
// Checks whether the server is running using SimpleIPC
function ServerRunning: Boolean;
// Starts server
// Starts remote server (help viewer); if Hide specified, asks the help server to hide itself/run minimized while starting
// Server must support a switch --ipcname that accepts the NameForServer argument to identify it for SimpleIPC
function StartHelpServer(NameForServer: String; ServerEXE: String = ''): Boolean;
function StartHelpServer(NameForServer: String; ServerEXE: String = '';Hide: boolean=false): Boolean;
// Shows URL in the HelpFileName file by sending a TUrlRequest
function OpenURL(HelpFileName: String; Url: String): TLHelpResponse;
// Shows help for Context in the HelpFileName file by sending a TContextRequest request
function OpenContext(HelpFileName: String; Context: THelpContext): TLHelpResponse;
// Opens HelpFileName by sending a TContextRequest
function OpenFile(HelpFileName: String): TLHelpResponse;
// Requests to run command on viewer by sending a TMiscrequest
function RunMiscCommand(CommandID: TMiscRequests): TLHelpResponse;
property ProcessWhileWaiting: TProcedureOfObject read FProcessWhileWaiting write FProcessWhileWaiting;
end;
@ -169,7 +181,7 @@ begin
end;
function TLHelpConnection.StartHelpServer(NameForServer: String;
ServerEXE: String): Boolean;
ServerEXE: String; Hide: boolean=false): Boolean;
var
X: Integer;
Cmd: String;
@ -184,7 +196,8 @@ begin
fServerOut.Active := False;
fServerOut.ServerID := NameForServer;
if not ServerRunning then begin
Cmd:= ServerExe + ' --ipcname ' + NameForServer;
Cmd := ServerExe + ' --ipcname ' + NameForServer;
if Hide then Cmd := Cmd + ' --hide';
{$IFDEF darwin}
if DirectoryExistsUTF8(ServerEXE+'.app') then
ServerEXE+='.app';
@ -265,5 +278,29 @@ begin
end;
end;
function TLHelpConnection.RunMiscCommand(CommandID: TMiscRequests): TLHelpResponse;
var
MiscRequest : TMiscRequest;
Stream: TMemoryStream;
begin
Stream := TMemoryStream.Create;
try
MiscRequest.FileRequest.RequestType := rtMisc;
MiscRequest.FileRequest.FileName := ''+#0; //i
//CommandID is ord(TMiscRequests)
MiscRequest.RequestID:=CommandID;
case CommandID of
mrClose: ; //do nothing
mrShow: ; //do nothing
mrVersion:
MiscRequest.FileRequest.FileName := PROTOCOL_VERSION+#0;
end;
Stream.Write(MiscRequest, SizeOf(MiscRequest));
Result := SendMessage(Stream);
finally
Stream.Free;
end;
end;
end.

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

@ -1,4 +1,8 @@
{ Copyright (C) <2005> <Andrew Haines> lazchmhelp.pas
{ Copyright (C) <2005-2013> <Andrew Haines>, Lazarus contributors
lazchmhelp.pas
Lazarus IDE support for lhelp/chm help files. Can start and control lhelp application.
This source is free software; you can redistribute it and/or modify it under
the terms of the GNU General Public License as published by the Free
@ -41,7 +45,7 @@ type
TChmHelpViewer = class(THelpViewer)
private
fHelpExe: String;
fHelpLabel: String;
fHelpLabel: String; //ID used for SimpleIPC identification
fHelpConnection: TLHelpConnection;
fCHMSearchPath: String;
fHelpExeParams: String;
@ -77,6 +81,7 @@ type
function GetHelpFilesPath: String; // macros resolved, see property HelpFilesPath
published
property HelpEXE: String read fHelpEXE write SetHelpEXE; // with macros, see GetHelpEXE
// ID used for SimpleIPC communication with the help viewer
property HelpLabel: String read GetHelpLabel write SetHelpLabel;
property HelpFilesPath: String read fCHMSearchPath write SetChmsFilePath; // directories separated with semicolon, with macros, see GetHelpFilesPath
property HelpExeParams: String read fHelpExeParams write fHelpExeParams;
@ -115,8 +120,12 @@ end;
function TChmHelpViewer.GetHelpLabel: String;
begin
// fHelpLable is used for SimpleIPC server id;
// lhelp protocol specifies server-dependent constant string
// followed by string representation of last 5 digits of the processID
// padded with 00000 at the right
if Length(fHelpLabel) = 0 then
fHelpLabel := 'lazhelp';
fHelpLabel := 'lazhelp'+copy(inttostr(GetProcessID)+'00000',1,5);
Result := fHelpLabel;
end;
@ -418,6 +427,7 @@ end;
procedure TChmHelpViewer.ShowAllHelp(Sender: TObject);
var
Response: TLHelpResponse;
SearchPath: String; //; delimited list of directories
HelpExeFileName: String;
begin
@ -434,13 +444,27 @@ begin
end;
SearchPath := GetHelpFilesPath;
// Start up server if needed
// Start up help viewer if needed - and tell it to hide
if not(fHelpConnection.ServerRunning) then
begin
fHelpConnection.StartHelpServer(HelpLabel, HelpExeFileName);
fHelpConnection.StartHelpServer(HelpLabel, HelpExeFileName, true);
Response:=fHelpConnection.RunMiscCommand(mrVersion);
if Response<>srSuccess then
begin
debugln('Help viewer does not support our protocol version.');
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
begin
debugln('Help viewer failed to respond to mrShow command.');
end;
end;
end;
// Open all chm files after it has started
OpenAllCHMsInSearchPath(SearchPath);
end;
function TChmHelpViewer.ShowNode(Node: THelpNode; var ErrMsg: string
@ -569,7 +593,7 @@ procedure TChmHelpViewer.Load(Storage: TConfigStorage);
begin
HelpEXE:=Storage.GetValue('CHMHelp/Exe','');
HelpExeParams := Storage.GetValue('CHMHelp/ExeParams','');
HelpLabel:=Storage.GetValue('CHMHelp/Name','lazhelp');
HelpLabel:=Storage.GetValue('CHMHelp/Name','lazhelp')+inttostr(GetProcessID);
HelpFilesPath := Storage.GetValue('CHMHelp/FilesPath','');
end;