Speedup lhelp starting.

New LHelp messages are added and the ide will try to rebuild lhelp if lhelp doesn't understand the new messages

git-svn-id: trunk@47959 -

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;

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;
 
 

components/chmhelp/lhelp/lhelp.lpi

@@ -82,10 +82,12 @@
       <Unit1>
         <Filename Value="chmdataprovider.pas"/>
         <IsPartOfProject Value="True"/>
+        <UnitName Value="ChmDataProvider"/>
       </Unit1>
       <Unit2>
         <Filename Value="chmspecialparser.pas"/>
         <IsPartOfProject Value="True"/>
+        <UnitName Value="ChmSpecialParser"/>
       </Unit2>
       <Unit3>
         <Filename Value="chmpopup.pas"/>
@@ -108,6 +110,7 @@
       <Unit6>
         <Filename Value="basecontentprovider.pas"/>
         <IsPartOfProject Value="True"/>
+        <UnitName Value="BaseContentProvider"/>
       </Unit6>
       <Unit7>
         <Filename Value="chmcontentprovider.pas"/>

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;

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);

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;

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