diff --git a/components/chmhelp/lhelp/basecontentprovider.pas b/components/chmhelp/lhelp/basecontentprovider.pas
index 3928cda302..d068b59da8 100644
--- a/components/chmhelp/lhelp/basecontentprovider.pas
+++ b/components/chmhelp/lhelp/basecontentprovider.pas
@@ -18,10 +18,12 @@ type
fParent: TWinControl;
FTitle: String;
FConfig: TXMLConfig;
+ FUpdateCount: Integer;
protected
fImageList: TImageList;
function GetTitle: String; virtual;
procedure SetTitle(const AValue: String); virtual;
+ function IsUpdating: Boolean;
public
function CanGoBack: Boolean; virtual; abstract;
function CanGoForward: Boolean; virtual; abstract;
@@ -30,6 +32,8 @@ type
procedure GoHome; virtual; abstract;
procedure GoBack; virtual; abstract;
procedure GoForward; virtual; abstract;
+ procedure BeginUpdate; virtual;
+ procedure EndUpdate; virtual;
procedure LoadPreferences(ACfg: TXMLConfig); virtual;
procedure SavePreferences({%H-}ACfg: TXMLConfig); virtual;
class function GetProperContentProvider(const AURL: String): TBaseContentProviderClass; virtual; abstract;
@@ -98,6 +102,23 @@ begin
FOnTitleChange(Self);
end;
+function TBaseContentProvider.IsUpdating: Boolean;
+begin
+ Result := FUpdateCount <> 0;
+end;
+
+procedure TBaseContentProvider.BeginUpdate;
+begin
+ Inc(FUpdateCount);
+end;
+
+procedure TBaseContentProvider.EndUpdate;
+begin
+ Dec(FUpdateCount);
+ if FUpdateCount < 0 then
+ FUpdateCount:=0;
+end;
+
procedure TBaseContentProvider.LoadPreferences(ACfg: TXMLConfig);
begin
FConfig := ACfg;
diff --git a/components/chmhelp/lhelp/chmcontentprovider.pas b/components/chmhelp/lhelp/chmcontentprovider.pas
index 79b7956167..18a144be8b 100644
--- a/components/chmhelp/lhelp/chmcontentprovider.pas
+++ b/components/chmhelp/lhelp/chmcontentprovider.pas
@@ -33,6 +33,7 @@ type
TChmContentProvider = class(TFileContentProvider)
private
+ fUpdateURI: String;
fTabsControl: TPageControl;
fContentsTab: TTabSheet;
fContentsPanel: TPanel;
@@ -64,6 +65,8 @@ type
function MakeURI(AUrl: String; AChm: TChmReader): String;
+ procedure BeginUpdate; override;
+ procedure EndUpdate; override;
procedure AddHistory(URL: String);
procedure DoOpenChm(AFile: String; ACloseCurrent: Boolean = True);
procedure DoCloseChm;
@@ -247,6 +250,26 @@ begin
Result := ChmURI(AUrl, fChms.FileName[ChmIndex]);
end;
+procedure TChmContentProvider.BeginUpdate;
+begin
+ inherited BeginUpdate;
+ fContentsTree.BeginUpdate;
+ fIndexView.BeginUpdate;
+end;
+
+procedure TChmContentProvider.EndUpdate;
+begin
+ inherited EndUpdate;
+ fContentsTree.EndUpdate;
+ fIndexView.EndUpdate;
+ if not IsUpdating then
+ begin
+ if fUpdateURI <> '' then
+ DoLoadUri(fUpdateURI);
+ fUpdateURI:='';
+ end;
+end;
+
procedure TChmContentProvider.AddHistory(URL: String);
begin
if fHistoryIndex < fHistory.Count then
@@ -361,15 +384,25 @@ begin
Uri := NewUrl;
end;
- fIsUsingHistory := True;
- fHtml.OpenURL(Uri);
- TIpChmDataProvider(fHtml.DataProvider).CurrentPath := ExtractFileDir(URI)+'/';
+ if not IsUpdating then
+ begin
- AddHistory(Uri);
- EndTime := Now;
+ fIsUsingHistory := True;
+ fHtml.OpenURL(Uri);
+ TIpChmDataProvider(fHtml.DataProvider).CurrentPath := ExtractFileDir(URI)+'/';
- Time := INtToStr(DateTimeToTimeStamp(EndTime).Time - DateTimeToTimeStamp(StartTime).Time);
- fStatusBar.SimpleText :='Loaded: '+Uri+' in '+ Time+'ms';
+ AddHistory(Uri);
+ EndTime := Now;
+
+ Time := INtToStr(DateTimeToTimeStamp(EndTime).Time - DateTimeToTimeStamp(StartTime).Time);
+ fStatusBar.SimpleText :='Loaded: '+Uri+' in '+ Time+'ms';
+
+ end
+ else
+ begin
+ // We are updating. Save this to load at end of update. or if there is already a request overwrite it so only the last is loaded
+ fUpdateURI:= Uri;
+ end;
end;
diff --git a/components/chmhelp/lhelp/lhelp.lpi b/components/chmhelp/lhelp/lhelp.lpi
index 42bd5e14c1..8936c9f03b 100644
--- a/components/chmhelp/lhelp/lhelp.lpi
+++ b/components/chmhelp/lhelp/lhelp.lpi
@@ -82,10 +82,12 @@
+
+
@@ -108,6 +110,7 @@
+
diff --git a/components/chmhelp/lhelp/lhelp.lpr b/components/chmhelp/lhelp/lhelp.lpr
index 59f65ce593..2d6c6c5ef7 100644
--- a/components/chmhelp/lhelp/lhelp.lpr
+++ b/components/chmhelp/lhelp/lhelp.lpr
@@ -22,6 +22,9 @@ program lhelp;
{$mode objfpc}{$H+}
uses
+ {$IFDEF UNIX}
+ cthreads,
+ {$ENDIF}
Interfaces, // this includes the LCL widgetset
SysUtils, Classes, Controls, Dialogs, Forms,
SimpleIPC, TurboPowerIPro, chmpopup, lhelpcontrolpkg, lhelpcore;
diff --git a/components/chmhelp/lhelp/lhelpcore.pas b/components/chmhelp/lhelp/lhelpcore.pas
index 49dc0ffc94..f491f22cc3 100644
--- a/components/chmhelp/lhelp/lhelpcore.pas
+++ b/components/chmhelp/lhelp/lhelpcore.pas
@@ -109,6 +109,7 @@ type
fConfig: TXMLConfig;
fHasShowed: Boolean;
fHide: boolean; //If yes, start with content hidden. Otherwise start normally
+ fUpdateCount: Integer;
// Keep track of whether size/position preferences were loaded and applied to form
fLayoutApplied: boolean;
// Applies layout (size/position/fullscreen) preferences once in lhelp lifetime
@@ -145,6 +146,10 @@ type
procedure ShowError(AError: String);
// Set keyup handler for control (and any child controls)
procedure SetKeyUp(AControl: TControl);
+ // BeginUpdate tells each content provider to possibly stop some events
+ procedure BeginUpdate;
+ // EndUpdate tells each content provider to resume normal behavior
+ procedure EndUpdate;
public
{ public declarations }
end;
@@ -534,7 +539,7 @@ var
Res: LongWord;
Url: String='';
begin
- if fInputIPC.PeekMessage(5, True) then
+ while fInputIPC.PeekMessage(5, True) do
begin
Stream := fInputIPC.MsgData;
Stream.Position := 0;
@@ -604,6 +609,16 @@ begin
else
Res := ord(srError); //version not supported
debugln('got rtmisc/');
+ end;
+ mrBeginUpdate:
+ begin
+ BeginUpdate;
+ Res := ord(srSuccess);
+ end;
+ mrEndUpdate:
+ begin
+ EndUpdate;
+ Res := ord(srSuccess);
end
else {Unknown request}
Res := ord(srUnknown);
@@ -834,6 +849,9 @@ begin
fPage.ContentProvider.LoadPreferences(fConfig);
end;
+ if fUpdateCount > 0 then
+ fPage.ContentProvider.BeginUpdate;
+
if fPage.ContentProvider.LoadURL(AURL, AContext) then
begin
PageControl.ActivePage := fPage;
@@ -929,6 +947,42 @@ begin
WCont.OnKeyUp:=@FormKeyUp;
end;
+procedure THelpForm.BeginUpdate;
+var
+ Tab: TContentTab;
+ i: Integer;
+begin
+ Inc(fUpdateCount);
+ if fUpdateCount = 1 then
+ begin
+ for i := 0 to PageControl.PageCount-1 do
+ begin
+ Tab := TContentTab(PageControl.Pages[I]);
+ Tab.ContentProvider.BeginUpdate;
+ end;
+ end;
+
+end;
+
+procedure THelpForm.EndUpdate;
+var
+ Tab: TContentTab;
+ i: Integer;
+begin
+ Dec(fUpdateCount);
+ if fUpdateCount < 0 then
+ fUpdateCount:=0;
+
+ if fUpdateCount = 0 then
+ begin
+ for i := 0 to PageControl.PageCount-1 do
+ begin
+ Tab := TContentTab(PageControl.Pages[I]);
+ Tab.ContentProvider.EndUpdate;
+ end;
+ end;
+end;
+
{ TContentTab }
constructor TContentTab.Create(AOwner: TComponent);
diff --git a/components/chmhelp/packages/help/lhelpcontrol.pas b/components/chmhelp/packages/help/lhelpcontrol.pas
index e8e983c96d..a184f2c500 100644
--- a/components/chmhelp/packages/help/lhelpcontrol.pas
+++ b/components/chmhelp/packages/help/lhelpcontrol.pas
@@ -34,7 +34,7 @@ const
// Version 2.1: ipcname string constant part may only contain A..Z, a..z, _
type
TRequestType = (rtFile, rtUrl, rtContext, rtMisc {window handling etc});
- TMiscRequests = (mrShow, mrVersion, mrClose);
+ TMiscRequests = (mrShow, mrVersion, mrClose, mrBeginUpdate, mrEndUpdate);
TLHelpResponse = (srError, srNoAnswer, srUnknown, srSuccess, srInvalidFile, srInvalidURL, srInvalidContext);
@@ -85,6 +85,10 @@ type
function OpenContext(HelpFileName: String; Context: THelpContext): TLHelpResponse;
// Opens HelpFileName by sending a TContextRequest
function OpenFile(HelpFileName: String): TLHelpResponse;
+ // Send BeginUpdate through miscCommand
+ function BeginUpdate: TLHelpResponse;
+ // Send EndUpdate through miscCommand
+ function EndUpdate: TLHelpResponse;
// Requests to run command on viewer by sending a TMiscrequest
function RunMiscCommand(CommandID: TMiscRequests): TLHelpResponse;
// Calling code can set this to process e.g. GUI handling while waiting for help to show
@@ -240,7 +244,10 @@ begin
for X := 0 to 40 do
begin
// use fServerOut.ServerRunning here instead of Self.ServerRunning to avoid a race condition
- if not fServerOut.ServerRunning then Sleep(200);
+ if not fServerOut.ServerRunning then
+ Sleep(200)
+ else
+ break;
end;
end;
if fServerOut.ServerRunning then
@@ -333,6 +340,16 @@ begin
end;
end;
+function TLHelpConnection.BeginUpdate: TLHelpResponse;
+begin
+ Result := RunMiscCommand(mrBeginUpdate);
+end;
+
+function TLHelpConnection.EndUpdate: TLHelpResponse;
+begin
+ Result := RunMiscCommand(mrEndUpdate);
+end;
+
function TLHelpConnection.RunMiscCommand(CommandID: TMiscRequests): TLHelpResponse;
var
MiscRequest : TMiscRequest;
diff --git a/components/chmhelp/packages/idehelp/lazchmhelp.pas b/components/chmhelp/packages/idehelp/lazchmhelp.pas
index b893af57b4..71270302a4 100644
--- a/components/chmhelp/packages/idehelp/lazchmhelp.pas
+++ b/components/chmhelp/packages/idehelp/lazchmhelp.pas
@@ -66,7 +66,7 @@ type
// Sets label/ID used for simpleipc communications
procedure SetHelpLabel(AValue: String);
// Check for lhelp executable, if not present, build if possible
- function CheckBuildLHelp: Integer; // modal result
+ function CheckBuildLHelp(AForce: Boolean = False): Integer; // modal result
// Get full path of lazbuild executable
function GetLazBuildEXE(out ALazBuild: String): Boolean;
function PassTheBuck(Node: THelpNode; var ErrMsg: string): TShowHelpResult;
@@ -200,10 +200,11 @@ begin
for i := 0 to SearchPaths.Count-1 do
begin
// Note: FindAllFiles has a SearchPath parameter that is a *single* directory,
- SearchFiles := FindAllFiles(SearchPaths[i]);
+ SearchFiles := FindAllFiles(SearchPaths[i], '*.chm;*.CHM;*.Chm');
CHMFiles.AddStrings(SearchFiles);
SearchFiles.Free;
end;
+ fHelpConnection.BeginUpdate;
for i := 0 to CHMFiles.Count-1 do
begin
if UpperCase(ExtractFileExt(CHMFiles[i]))='.CHM' then
@@ -215,7 +216,9 @@ begin
//Application.ProcessMessages;
end;
end;
+
finally
+ fHelpConnection.EndUpdate;
CHMFiles.Free;
SearchPaths.Free;
end;
@@ -307,7 +310,7 @@ begin
end;
end;
-function TChmHelpViewer.CheckBuildLHelp: Integer;
+function TChmHelpViewer.CheckBuildLHelp(AForce: Boolean): Integer;
var
Lazbuild: String;
LHelpProject: String;
@@ -318,7 +321,7 @@ var
begin
Result := mrCancel;
- if FileExistsUTF8(GetHelpExe) then
+ if FileExistsUTF8(GetHelpExe) and not AForce then
Exit(mrOK);
if not GetLazBuildEXE(Lazbuild) then
@@ -549,13 +552,33 @@ begin
// This will allow cross-chm (LCL, FCL etc) searching and browsing in lhelp.
if not(WasRunning) then
begin
+ if fHelpConnection.BeginUpdate = srError then
+ begin
+ // existing lhelp doesn't understand mrBeginUpdate and needs to be rebuilt
+ //close lhelp
+ if fHelpConnection.RunMiscCommand(LHelpControl.mrClose) <> srError then
+ begin
+ // force rebuild of lhelp
+ // this may not succede but the old lhelp will be restarted anyway and
+ // just return error codes for unknown messages.
+ CheckBuildLHelp(True);
+ // start it again
+ fHelpConnection.StartHelpServer(HelpLabel, GetHelpExe, true);
+ // now run begin update
+ fHelpConnection.BeginUpdate; // it inc's a value so calling it more than once doesn't hurt
+ end;
+ end;
+
OpenAllCHMsInSearchPath(SearchPath);
// 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)));
+ fHelpConnection.EndUpdate;
end;
+ fHelpConnection.BeginUpdate;
Response := fHelpConnection.OpenURL(FileName, Url);
+ fHelpConnection.EndUpdate;
end
else
begin