paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-05-15 10:42:46 +02:00
Code Issues Packages Projects Releases Wiki Activity

Revert r45857 #c2a0094609, "ChmHelp: close lhelp that laz started when laz is closed..." because Reinier requested it.

Browse Source 
git-svn-id: trunk@45864 -
This commit is contained in:
juha 2014-07-14 20:06:29 +00:00
parent 6ff6f62e77
commit cace204583
7 changed files with 73 additions and 124 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -5,7 +5,7 @@ unit chmcontentprovider;
{$Note Compiling lhelp with search support}
{$DEFINE CHM_SEARCH}
{$IF FPC_FULLVERSION>=20400}
{$if (fpc_version=2) and (fpc_release>4)}
{$Note Compiling lhelp *with* binary index and toc support}
{$DEFINE CHM_BINARY_INDEX_TOC}
{$endif}

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

@ -47,6 +47,12 @@
</Win32>
</Options>
</Linking>
<Other>
<CompilerMessages>
<UseMsgFile Value="True"/>
</CompilerMessages>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
</Item2>
</BuildModes>
@ -78,6 +84,7 @@
<Unit0>
<Filename Value="lhelp.lpr"/>
<IsPartOfProject Value="True"/>
<UnitName Value="lhelp"/>
</Unit0>
<Unit1>
<Filename Value="chmdataprovider.pas"/>
@ -87,12 +94,14 @@
<Unit2>
<Filename Value="chmspecialparser.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="ChmSpecialParser"/>
</Unit2>
<Unit3>
<Filename Value="chmpopup.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="HelpPopupForm"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="ChmPopup"/>
</Unit3>
<Unit4>
<Filename Value="lhelpcore.pas"/>
@ -105,10 +114,12 @@
<Unit5>
<Filename Value="lnethttpdataprovider.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="LNetHTTPDataProvider"/>
</Unit5>
<Unit6>
<Filename Value="basecontentprovider.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="BaseContentProvider"/>
</Unit6>
<Unit7>
<Filename Value="chmcontentprovider.pas"/>
@ -118,6 +129,7 @@
<Unit8>
<Filename Value="httpcontentprovider.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="HTTPContentProvider"/>
</Unit8>
</Units>
</ProjectOptions>
@ -147,5 +159,11 @@
</Win32>
</Options>
</Linking>
<Other>
<CompilerMessages>
<UseMsgFile Value="True"/>
</CompilerMessages>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
</CONFIG>

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

@ -1,4 +1,4 @@
{ Copyright (C) <2005-2014> <Andrew Haines>, Lazarus contributors lhelp.lpr
{ Copyright (C) <2005> <Andrew Haines> lhelp.lpr
Lhelp CHM help viewer application

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

@ -5,7 +5,7 @@ object HelpForm: THelpForm
Width = 758
ActiveControl = Panel1
Caption = 'LHelp'
ClientHeight = 516
ClientHeight = 510
ClientWidth = 758
Icon.Data = {
7E04000000000100010010100000010020006804000016000000280000001000
@ -238,7 +238,7 @@ object HelpForm: THelpForm
end
object PageControl: TPageControl
Left = 0
Height = 484
Height = 478
Top = 32
Width = 758
Align = alClient

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

@ -1,4 +1,4 @@
{ Copyright (C) 2005-2014 Andrew Haines, Lazarus contributors
{ Copyright (C) 2005-2013 Andrew Haines, Lazarus contributors
Main form for lhelp. Includes processing/data communication.
@ -150,7 +150,7 @@ var
const
INVALID_FILE_TYPE = 1;
VERSION_STAMP = '2013-07-31'; //used in displaying version in about form etc
VERSION_STAMP = '2013-07-31'; //used in displaying about form etc
implementation
@ -244,22 +244,20 @@ procedure THelpForm.FileMenuOpenURLItemClick(Sender: TObject);
var
fRes: String;
URLSAllowed: String;
Protocol: TStrings;
Protocall: TStrings;
i: Integer;
begin
Protocol := GetContentProviderList;
try
Protocall := GetContentProviderList;
URLSAllowed:='';
for i := 0 to Protocol.Count-1 do
for i := 0 to Protocall.Count-1 do
begin
if i < 1 then
URLSAllowed := URLSAllowed + Protocol[i]
URLSAllowed := URLSAllowed + Protocall[i]
else
URLSAllowed := URLSAllowed + ', ' +Protocol[i]
end;
finally
Protocol.Free;
URLSAllowed := URLSAllowed + ', ' +Protocall[i]
end;
Protocall.Free;
URLSAllowed := Trim(URLSALLowed);
@ -354,7 +352,7 @@ begin
PrefFile := GetAppConfigDirUTF8(False);
ForceDirectoriesUTF8(PrefFile);
// --ipcname passes a server ID that consists of a
// server-dependent constant together with a process ID.
// 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]);
@ -477,7 +475,6 @@ begin
Stream.Position := 0;
FillByte(FileReq{%H-},SizeOf(FileReq),0);
Stream.Read(FileReq, SizeOf(FileReq));
Res := Ord(srError); //fail by default
case FileReq.RequestType of
rtFile : begin
Url := 'file://'+FileReq.FileName;
@ -539,14 +536,8 @@ begin
AddRecentFile(Url);
SendResponse(Res);
if MustClose then
begin
// Wait some time for the response message to go out before shutting down
Application.ProcessMessages;
Sleep(10);
Application.Terminate;
end;
// We received mrShow:
if (MustClose=false) and (fHide=false) then
begin
Self.SendToBack;
@ -684,20 +675,20 @@ var
fPage: TContentTab = nil;
I: Integer;
begin
Result := Ord(srInvalidURL);
Result := Ord(srUnknown);
fURLPrefix := GetURLPrefix;
fContentProvider := GetContentProvider(fURLPrefix);
if fContentProvider = nil then begin
ShowError('Cannot handle this type of content. "' + fURLPrefix + '" for url:'+LineEnding+AURL);
Result := Ord(srInvalidURL);
Result := Ord(srInvalidFile);
Exit;
end;
fRealContentProvider := fContentProvider.GetProperContentProvider(AURL);
if fRealContentProvider = nil then begin
ShowError('Cannot handle this type of subcontent. "' + fURLPrefix + '" for url:'+LineEnding+AURL);
Result := Ord(srInvalidURL);
Result := Ord(srInvalidFile);
Exit;
end;
@ -726,6 +717,7 @@ begin
fPage.ContentProvider.LoadPreferences(fConfig);
end;
if fPage.ContentProvider.LoadURL(AURL, AContext) then
begin
PageControl.ActivePage := fPage;
@ -733,7 +725,7 @@ begin
Result := Ord(srSuccess);
end
else
Result := Ord(srInvalidURL);
Result := Ord(srInvalidFile);
if not fHide then
ShowOnTop;

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

@ -25,12 +25,7 @@ uses
Classes, SysUtils, FileUtil, LazLogger, SimpleIPC, process, UTF8Process;
const
PROTOCOL_VERSION='2'; //IDE<>LHelp communication protocol version. Please update when breaking compatibility
// Version 1: original version
// Version 2:
// - support for Proposed extensions in bug 24743:
// - openurl: if applicable return error instead of unknown
// - openurl: if applicable return invalid url instead of invalid file for openurl
PROTOCOL_VERSION='1'; //IDE<>LHelp communication protocol version. Please update when breaking compatibility
type
TRequestType = (rtFile, rtUrl, rtContext, rtMisc {window handling etc});
TMiscRequests = (mrShow, mrVersion, mrClose);
@ -118,9 +113,12 @@ end;
function TLHelpConnection.SendMessage(Stream: TStream): TLHelpResponse;
begin
Result := srNoAnswer;
//try
fServerOut.SendMessage(mtUnknown, Stream);
Result := WaitForMsgResponse;
//except
// on EIPCError do Result := srNoAnswer;
//end;
end;
constructor TLHelpConnection.Create;
@ -227,9 +225,6 @@ begin
if fServerOut.ServerRunning then begin
fServerOut.Active := True;
Result := True;
end
else begin
debugln('Could not get lhelp running with command '+Cmd);
end;
end;
@ -243,17 +238,8 @@ begin
UrlRequest.FileRequest.FileName := HelpFileName+#0;
UrlRequest.FileRequest.RequestType := rtURL;
UrlRequest.Url := Url+#0;
Result:=srNoAnswer;
try
Stream.Write(UrlRequest,SizeOf(UrlRequest));
Result := SendMessage(Stream);
except
// Catch stream read errors etc
on E: Exception do
begin
debugln('Help connection: error '+E.Message+' running UrlRequest command');
end;
end;
finally
Stream.Free;
end;
@ -266,22 +252,12 @@ var
Stream: TMemoryStream;
begin
Stream := TMemoryStream.Create;
Result := srNoAnswer;
try
ContextRequest.FileRequest.FileName := HelpFileName+#0;
ContextRequest.FileRequest.RequestType := rtContext;
ContextRequest.HelpContext := Context;
Result := srNoAnswer;
try
Stream.Write(ContextRequest, SizeOf(ContextRequest));
Result := SendMessage(Stream);
except
// Catch stream read errors etc
on E: Exception do
begin
debugln('Help connection: error '+E.Message+' running ContextRequest command');
end;
end;
finally
Stream.Free;
end;
@ -296,17 +272,8 @@ begin
try
FileRequest.RequestType := rtFile;
FileRequest.FileName := HelpFileName+#0;
Result := srNoAnswer;
try
Stream.Write(FileRequest, SizeOf(FileRequest));
Result := SendMessage(Stream);
except
// Catch stream read errors etc
on E: Exception do
begin
debugln('Help connection: error '+E.Message+' running FileRequest command');
end;
end;
finally
Stream.Free;
end;
@ -320,27 +287,17 @@ begin
Stream := TMemoryStream.Create;
try
MiscRequest.FileRequest.RequestType := rtMisc;
MiscRequest.FileRequest.FileName := ''+#0;
MiscRequest.FileRequest.FileName := ''+#0; //i
//CommandID is ord(TMiscRequests)
MiscRequest.RequestID:=CommandID;
case CommandID of
mrClose: ; //no arguments required
mrShow: ; //no arguments required
mrClose: ; //do nothing
mrShow: ; //do nothing
mrVersion:
MiscRequest.FileRequest.FileName := PROTOCOL_VERSION+#0;
end;
try
Stream.Write(MiscRequest, SizeOf(MiscRequest));
Result := SendMessage(Stream);
except
// Catch stream read errors etc
on E: Exception do
begin
// When closing, the viewer may not respond in time, which is expected.
if CommandID<>mrClose then
debugln('Help connection: error '+E.Message+' running MiscRequest command');
end;
end;
finally
Stream.Free;
end;

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

@ -1,4 +1,4 @@
{ Copyright (C) <2005-2014> <Andrew Haines>, Lazarus contributors
{ Copyright (C) <2005-2013> <Andrew Haines>, Lazarus contributors
lazchmhelp.pas
@ -437,16 +437,6 @@ end;
destructor TChmHelpViewer.Destroy;
begin
// Try to close lhelp if we had opened it before; ignore response
try
fHelpConnection.RunMiscCommand(LHelpControl.mrClose);
except
// ignore errors; let user close it himself
on E: Exception do begin
debugln('TChmHelpViewer.Destroy: exception '+E.Message+' when trying to send mrClose on viewer');
end;
end;
fHelpConnection.Free;
inherited Destroy;
end;
@ -491,7 +481,9 @@ begin
fHelpConnection.StartHelpServer(HelpLabel, HelpExeFileName, true);
Response:=fHelpConnection.RunMiscCommand(mrVersion);
if Response<>srSuccess then
debugln('Help viewer does not support our protocol version ('+PROTOCOL_VERSION +'). Response was: ord: '+inttostr(ord(Response)))
begin
debugln('Help viewer does not support our protocol version.');
end
else
begin
// Open all chm files after it has started, while still hidden
@ -499,7 +491,9 @@ begin
// Instruct viewer to show its GUI
Response:=fHelpConnection.RunMiscCommand(mrShow);
if Response<>srSuccess then
debugln('Help viewer gave error response to mrShow command. Response was: ord: '+inttostr(ord(Response)));
begin
debugln('Help viewer failed to respond to mrShow command.');
end;
end;
end;
end;
@ -606,19 +600,7 @@ begin
case Res of
srSuccess: Result := shrSuccess;
srNoAnswer: Result := shrSuccess;
srInvalidContext: begin
Result := shrNone;
ErrMsg := 'Invalid context showing '+URL;
end;
srInvalidFile: begin
Result := shrNone;
ErrMsg := 'Invalid file showing '+URL;
end;
srInvalidURL: begin
Result := shrNone;
ErrMsg := 'Invalid URL showing '+URL;
end;
else //srUnknown, srError
else
Result := shrNone;
ErrMsg := 'Unknown error showing '+URL;
end;