From a391c23b4c06e42394f3a9227bb09c30f806d988 Mon Sep 17 00:00:00 2001 From: maxim Date: Wed, 25 Feb 2015 23:02:07 +0000 Subject: [PATCH] Merged revision(s) 47959 #a57530c071, 47975 #778078e958, 47987 #e62738c753 from trunk: Speedup lhelp starting. New LHelp messages are added and the ide will try to rebuild lhelp if lhelp doesn't understand the new messages ........ Added check to try to save original lhelp when recompiling in case it fails. Fixed bug where ContentProvider.EndUpdate was called too soon. LHelp starts speedily now :) ........ Lazarus chm search to send to lhelp now doesn't search paths recursively ........ git-svn-id: branches/fixes_1_4@48003 - --- .../chmhelp/lhelp/basecontentprovider.pas | 21 ++++++ .../chmhelp/lhelp/chmcontentprovider.pas | 47 ++++++++++-- components/chmhelp/lhelp/lhelp.lpi | 4 +- components/chmhelp/lhelp/lhelp.lpr | 3 + components/chmhelp/lhelp/lhelp.res | Bin 5220 -> 855 bytes components/chmhelp/lhelp/lhelpcore.pas | 56 ++++++++++++++- .../chmhelp/packages/help/lhelpcontrol.pas | 21 +++++- .../chmhelp/packages/idehelp/lazchmhelp.pas | 68 ++++++++++++++++-- 8 files changed, 205 insertions(+), 15 deletions(-) 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..378da9313d 100644 --- a/components/chmhelp/lhelp/lhelp.lpi +++ b/components/chmhelp/lhelp/lhelp.lpi @@ -10,7 +10,6 @@ - @@ -82,10 +81,12 @@ + + @@ -108,6 +109,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/lhelp.res b/components/chmhelp/lhelp/lhelp.res index 50aee0e749002b6f32df877efa619d5ec84ba53b..e66ecf85feb5a99d4bc85c4973bd1bb2e918b668 100644 GIT binary patch delta 7 OcmaE&ah+{LI5PkaKLYds literal 5220 zcmc(j2~ZSQ8poSMK?OlX!6Pz`iq{HwCQ;C!8%xTwvSxR)sThZ$fl20a4h|#4s4pw|#TcX6C~DTY8{Ji7j3>s3$mw){`+q&tFe0U7D_c9(kN2kEd*A=N zUQd-A$8ickWCznnJ^^m>dLZ_=NNc{nty{vUB!P*E3K-CvBa~K?exg|&&+Am? zQ96y;-$tfok#QK_&b z8?h}>qaQm)87is9@Mg71W3(Xh$!wcKWi)CvY888+a9UKv^CmtdJk;rtF_!;qBiok&e_zkK2jP*%gQTv*nD1{7IvaF(jHp5RlHGA2rROx0noCv$8cO6Ie!` zoD-up8j;N8ljj@W0=EYto&G|Jw0Y#Z8f2|j;xsYMOHKeA2ZLSNziEdINoeuQG~ZFy_keE ztQ@oW1YWDqvcC~Zl{reEfVfObg;f)&W^ECnj8$pPyuGj}MQDqOHrB&Ko!tlzZ3zb2 z;h}O*Pv-n_MZy44cWyQp$whHk2uZ+{}c)~D!6U9VJ^~NJb(?icJJOW ztg-bM06Qgpa54rHhWsI1Zkb+x&JP~=dagQHos$OM2dfk^FN~*Ntty6Udw%1_F;%RcSXDnm|1<5Yw{A(=On;K`lOLepsYTzs{~Xhg|7a^UH8=nEfy3g@ zH8r#-eVydPcy0CxS(}Z)hQgCfKXmnJ$}26S8`afRS6A0UeSJMWiH3#-dK!(5jZ}X8 zYf9dbLDQ^RKccU<%RUT?-%{Q)U7+qC*l6sUv-HxsQi{zgqWF!4q{%5FZEhjyHW!g$ z3n(Ze)3zcqZwEUH$%-*yM=>StETW{H#k3gT7jG}2CEJQY38i36*;+)YTTAHeEya|Y z4_g@pG$JmyT-Jv#1%YcD$aA$oKIso>U`91PvqKzqh)PJ_RRH1`Oo0L3EB`%I*?V@;%7 zn6p&Y#~od%Tw6`t`vSSGZ=!x5UnHMBHu9=~KgUG!`&J}>*bIREK6gdxS4Y$zJOc(e zM)tjLtw@3Jr#JlbKQB^`QzCW$QlxI>0(tHds8fzW9v=ymSX%uM{TC+d_kS(#FT>Yd zA=h=-lif`HHeIAX2W@ukvm*7nY`4pFgMjh@^v@CbY$EDaN;L2~(Vzy5^>%-l9|1Sv z!@uDJav=Fo3Lmx$Gz@utJ@5Qo=)21Lm_Pfw)&Fev$b^5JA5!1Ei!|t{P4b_`9SB>J zHtZ{*)A3pDEhYL#~Ql&sB0 z==U4BvZ}W0M(7vVsPE=WH2iq8ly@oiJED~DAm|UgPt*x|k~Y(K_~5$(YfZ>cBXR&g z`XWz(x9oN6Q3d@y-V z`N+hIi@wNz=UjpOvoF!u!*%3~zW4iwNIlVaeyC}8*zO7q_aiuv1dw}950;@Gwa5!z z+nxfE*Fz%T8k|8N_V`XDpRepa7*r%s+|CO%$hSvZ{Sn69RlXkz%kGo+ zVZ0O2Ki)rz)P?08c3q+2!VcdBhro9Lez6xhd(PI~vCjkkbc4P(&U+m|?LQZ2N|``& zS06#=w*KbI^Wky%`~1^w56NSC8HCNVj9tSMQjToBx&E27Et_#8IZqvB@I}}`A zOa0C@kk>CZ#3b6|mJby{m-Sx3YBnT-(Pod=aJ&9*z7NVb;Pkz-EoLEOcb=gtO25?pLTt?Rw| z)1FmV*ZZX(jt-3776toK`JA`5ox@%yFbEjIaqs|$pj9gka~A&+aNg;8>mIhh5qu9; zfib`nbVQ%+8x7I`JKqFawb}ejAiskWFfRuzFOTkHIlB(>KqT-2Pt<4YpevXJvcOgF z5Iky|X?+TC_oY0rdzb;xcTRf+%zpueU^egt9ntTGeN#XVVE(t(-q{bPCD(z~g88xr z;P(M%7_0_0pbWeO{6Ncl-`SKr$2yC@3wR!U46cC3l-K0ZgnV6+YR6(951xAWoc+LlmIKx=6Tu4H_Y1i1;$u3pUfVI18gLgg zahCO6Z_uIG+xXz_IQt^Tce!Icu{yI|EoR27pQE zCkt0d$B_F6$c2rIcgnj4ep&FIOrsmz30jZ+)4>41?((nJmVIGo0m}oc#V{}vzxM|2 z4DQqyRL*UqDsC5kBM#9n^xG<|{{e&ofAC+$Eo(cEu*Ld;{VwzbN)QIvJ310XfU#f* XV6|rNZ|Oem;WE&|26&xzYId4 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 c8351a1a93..2903305196 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', False); 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; @@ -315,12 +318,33 @@ var WS: String; PCP: String; Tool: TIDEExternalToolOptions; + OrigFile: String; + TmpFile: String = ''; + ExistingFile: Boolean; begin Result := mrCancel; - if FileExistsUTF8(GetHelpExe) then + ExistingFile := FileExistsUTF8(GetHelpExe); + + if ExistingFile and not AForce then Exit(mrOK); + if ExistingFile then + begin + OrigFile:=StringReplace(GetHelpEXE, PathDelim+PathDelim, PathDelim, [rfReplaceAll]); + TmpFile:=ChangeFileExt(OrigFile, '.tmp'); + //debugln(['TChmHelpViewer.CheckBuildLHelp forced rebuilding of lhelp']); + if FileExistsUTF8(TmpFile) then + DeleteFileUTF8(TmpFile); + if not RenameFile(OrigFile, TmpFile) then + begin + debugln(['TChmHelpViewer.CheckBuildLHelp no permission to modify lhelp executable']); + // we don't have permission to move or rebuild lhelp so exit + // Exit with mrYes anyway since lhelp is still present, just an older version + Exit(mrYes); + end; + end; + if not GetLazBuildEXE(Lazbuild) then begin debugln(['TChmHelpViewer.CheckBuildLHelp failed because lazbuild not found']); @@ -353,7 +377,19 @@ begin Tool.Scanners.Add(SubToolFPC); Tool.Scanners.Add(SubToolMake); if RunExternalTool(Tool) then + begin Result:=mrOk; + if (TmpFile <> '') and FileExistsUTF8(TmpFile) then + DeleteFileUTF8(TmpFile); + end + else + begin + debugln(['TChmHelpViewer.CheckBuildLHelp failed building of lhelp. Trying to use old version']); + // compile failed + // try to copy back the old lhelp if it existed + if (TmpFile <> '') and FileExistsUTF8(TmpFile) and RenameFile(TmpFile, OrigFile) then + Result := mrOK; + end; finally Tool.Free; end; @@ -549,13 +585,37 @@ 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 succeed but the old lhelp will be restarted anyway and + // just return error codes for unknown messages. + if CheckBuildLHelp(True) = mrOK then + begin + // start it again + Debugln(['TChmHelpViewer.ShowNode restarting lhelp to use updated protocols']); + 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; + 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))); end; + fHelpConnection.BeginUpdate; Response := fHelpConnection.OpenURL(FileName, Url); + fHelpConnection.EndUpdate; + if not WasRunning then + fHelpConnection.EndUpdate; end else begin