diff --git a/components/chmhelp/lhelp/chmcontentprovider.pas b/components/chmhelp/lhelp/chmcontentprovider.pas index 50f7e18ebb..70161a7aae 100644 --- a/components/chmhelp/lhelp/chmcontentprovider.pas +++ b/components/chmhelp/lhelp/chmcontentprovider.pas @@ -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} diff --git a/components/chmhelp/lhelp/lhelp.lpi b/components/chmhelp/lhelp/lhelp.lpi index 68a736f327..5e6325304b 100644 --- a/components/chmhelp/lhelp/lhelp.lpi +++ b/components/chmhelp/lhelp/lhelp.lpi @@ -47,6 +47,12 @@ + + + + + + @@ -78,6 +84,7 @@ + @@ -87,12 +94,14 @@ + + @@ -105,10 +114,12 @@ + + @@ -118,6 +129,7 @@ + @@ -147,5 +159,11 @@ + + + + + + diff --git a/components/chmhelp/lhelp/lhelp.lpr b/components/chmhelp/lhelp/lhelp.lpr index 930e185e17..9f45f1ff88 100644 --- a/components/chmhelp/lhelp/lhelp.lpr +++ b/components/chmhelp/lhelp/lhelp.lpr @@ -1,4 +1,4 @@ -{ Copyright (C) <2005-2014> , Lazarus contributors lhelp.lpr +{ Copyright (C) <2005> lhelp.lpr Lhelp CHM help viewer application diff --git a/components/chmhelp/lhelp/lhelpcore.lfm b/components/chmhelp/lhelp/lhelpcore.lfm index 20c760819f..a055117a58 100644 --- a/components/chmhelp/lhelp/lhelpcore.lfm +++ b/components/chmhelp/lhelp/lhelpcore.lfm @@ -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 diff --git a/components/chmhelp/lhelp/lhelpcore.pas b/components/chmhelp/lhelp/lhelpcore.pas index 3be7593e72..2749ef8b59 100644 --- a/components/chmhelp/lhelp/lhelpcore.pas +++ b/components/chmhelp/lhelp/lhelpcore.pas @@ -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. @@ -27,7 +27,7 @@ unit lhelpcore; {$IFDEF UNIX} {$if FPC_FULLVERSION <= 20700} - {$DEFINE STALE_PIPE_WORKAROUND} + {$DEFINE STALE_PIPE_WORKAROUND} {$ENDIF} {$ENDIF} @@ -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 - URLSAllowed:=''; - for i := 0 to Protocol.Count-1 do - begin - if i < 1 then - URLSAllowed := URLSAllowed + Protocol[i] - else - URLSAllowed := URLSAllowed + ', ' +Protocol[i] - end; - finally - Protocol.Free; + Protocall := GetContentProviderList; + + URLSAllowed:=''; + for i := 0 to Protocall.Count-1 do + begin + if i < 1 then + URLSAllowed := URLSAllowed + Protocall[i] + else + URLSAllowed := URLSAllowed + ', ' +Protocall[i] end; + Protocall.Free; URLSAllowed := Trim(URLSALLowed); @@ -333,7 +331,7 @@ end; procedure THelpForm.ViewMenuContentsClick(Sender: TObject); begin - // TabsControl property in TChmContentProvider + //TabsControl property in TChmContentProvider if Assigned(ActivePage) then with TChmContentProvider(ActivePage.ContentProvider) do begin @@ -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; @@ -523,7 +520,7 @@ begin end; mrVersion: begin - // Protocol version encoded in the filename + //Protocol version encoded in the filename // Verify what we support if strtointdef(FileReq.FileName,0)=strtointdef(PROTOCOL_VERSION,0) then Res := ord(srSuccess) @@ -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; diff --git a/components/chmhelp/packages/help/lhelpcontrol.pas b/components/chmhelp/packages/help/lhelpcontrol.pas index 1cc63bac61..6e23360cae 100644 --- a/components/chmhelp/packages/help/lhelpcontrol.pas +++ b/components/chmhelp/packages/help/lhelpcontrol.pas @@ -12,7 +12,7 @@ Currently, the only help viewer that supports this protocol is the lhelp CHM hel {$IFDEF UNIX} {$if FPC_FULLVERSION <= 20700} - {$DEFINE STALE_PIPE_WORKAROUND} + {$DEFINE STALE_PIPE_WORKAROUND} {$ENDIF} {$ENDIF} @@ -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; - fServerOut.SendMessage(mtUnknown, Stream); - Result := WaitForMsgResponse; + //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; + Stream.Write(UrlRequest,SizeOf(UrlRequest)); + Result := SendMessage(Stream); 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; + Stream.Write(ContextRequest, SizeOf(ContextRequest)); + Result := SendMessage(Stream); 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; + Stream.Write(FileRequest, SizeOf(FileRequest)); + Result := SendMessage(Stream); 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; + Stream.Write(MiscRequest, SizeOf(MiscRequest)); + Result := SendMessage(Stream); finally Stream.Free; end; diff --git a/components/chmhelp/packages/idehelp/lazchmhelp.pas b/components/chmhelp/packages/idehelp/lazchmhelp.pas index e6805ad304..f2685dee18 100644 --- a/components/chmhelp/packages/idehelp/lazchmhelp.pas +++ b/components/chmhelp/packages/idehelp/lazchmhelp.pas @@ -1,4 +1,4 @@ -{ Copyright (C) <2005-2014> , Lazarus contributors +{ Copyright (C) <2005-2013> , 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; @@ -540,7 +534,7 @@ begin begin Result := shrDatabaseNotFound; ErrMsg := FileName +' not found. Please put the chm help files in '+ LineEnding - +SearchPath + 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'; @@ -562,7 +556,7 @@ begin if Trim(fHelpExeParams) = '' then begin Result := shrViewerError; - ErrMsg := 'If you do not use "lhelp" as viewer you have to set up ' + ErrMsg := 'If you do not use "lhelp" as viewer you have to setup ' + 'HelpExeParams correctly in' + sLineBreak + 'Tools -> Options -> Help -> Help Options -> ' + 'under HelpViewers - CHM Help Viewer' + sLineBreak @@ -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;