much improved history support

git-svn-id: trunk@8375 -

components/chmhelp/lhelp/chmdataprovider.pas

@@ -46,6 +46,7 @@ type
   TIpChmDataProvider = class(TIpAbstractHtmlDataProvider)
   private
     fChm: TChmFileList;
+    fCurrentPage: String;
     fCurrentPath: String;
     fOnHelpPopup: THelpPopupEvent;
   protected
@@ -65,7 +66,9 @@ type
     destructor Destroy; override;
     property Chm: TChmFileList read fChm write fChm;
     property OnHelpPopup: THelpPopupEvent read fOnHelpPopup write fOnHelpPopup;
+    property CurrentPAge: String read fCurrentPage;
     property CurrentPath: String read fCurrentPath write fCurrentPath;
+
   end;
 
 implementation
@@ -88,14 +91,20 @@ end;
 
 function TIpChmDataProvider.DoCheckURL(const URL: string;
   var ContentType: string): Boolean;
-
+var
+X: Integer;
 begin
   //DebugLn('RequestedUrl: ',URL);
   Result := fChm.ObjectExists(Url) > 0;
   if Result then begin
     ContentType := 'text/html';
     fCurrentPath := ExtractFilePath(Url);
+    if Pos('ms-its:', fCurrentPath) > 0 then begin
+      X := Pos('::', fCurrentPath);
+      fCurrentPath := Copy(fCurrentPath, X+2, Length(fCurrentPAth)-(X+1));
+    end;
     Result := True;
+    fCurrentPage := URL;
   end;
 end;
 
@@ -191,12 +200,22 @@ var
 tmp: String;
 X: LongInt;
 RelURL: String = '';
+fOldUrl: String;
 begin
+
+   if Pos('ms-its:', OldURL) > 0 then begin
+    X := Pos('::', OldUrl);
+    fOldUrl := Copy(OldUrl, X+2, Length(OldUrl)-(X+2));
+  end
+  else fOldUrl := OldURL;
+
+  if Length(NewURL) < 1 then Exit(NewURL);
   if fChm.ObjectExists(NewURL) > 0 then begin
     Result := NewUrl;
     Exit;
   end;
-  Result:=iputils.BuildURL(Oldurl,NewUrl);
+  Result:=iputils.BuildURL(fOldurl,NewUrl);
+
   if NewURL[1] <> '/' then
   begin
     if fChm.ObjectExists(Result) > 0 then Tmp := Result
@@ -208,6 +227,9 @@ begin
     end
     else if fChm.ObjectExists(fCurrentPath+NewUrl) > 0 then begin
       Tmp := fCurrentPath+NewURL;
+    end
+    else if fChm.ObjectExists('/'+fCurrentPath+NewUrl) > 0 then begin
+      Tmp := '/'+fCurrentPath+NewURL;
     end;
     Result := Tmp;
   end;
@@ -216,6 +238,7 @@ begin
     Delete(Result, X ,1);
     X := Pos('//', Result);
   end;
+
 end;
 
 function TIpChmDataProvider.GetDirsParents(ADir: String): TStringList;

components/chmhelp/lhelp/unit1.pas

@@ -104,11 +104,11 @@ type
     procedure FillTOCTimer(Sender: TObject);
   private
     { private declarations }
+    fIsUsingHistory: Boolean;
     fStopTimer: Boolean;
     fFillingToc: Boolean;
     fChms: TChmFileList;
     fHistory: TStringList;
-    fHotUrl: String;
     fHistoryIndex: Integer;
     fServerName: String;
     fServer: TSimpleIPCServer;
@@ -148,6 +148,7 @@ procedure THelpForm.BackToolBtnClick(Sender: TObject);
 begin
   if fHistoryIndex > 0 then begin
     Dec(fHistoryIndex);
+    fIsUsingHistory:=True;
     IpHtmlPanel1.OpenURL(fHistory.Strings[fHistoryIndex]);
   end;
 end;
@@ -214,7 +215,6 @@ end;
 procedure THelpForm.FormCreate(Sender: TObject);
 begin
   fContext := -1;
-  //Chm := TCHMFile.Create;
   fHistory := TStringList.Create;
   IpHtmlPanel1.DataProvider := TIpChmDataProvider.Create(fChms);
   ReadCommandLineOptions;
@@ -227,6 +227,7 @@ procedure THelpForm.ForwardToolBtnClick(Sender: TObject);
 begin
   if fHistoryIndex < fHistory.Count-1 then begin
     Inc(fHistoryIndex);
+    fIsUsingHistory:=True;
     IpHtmlPanel1.OpenURL(fHistory.Strings[fHistoryIndex]);
   end;
 end;
@@ -258,17 +259,19 @@ end;
 procedure THelpForm.IpHtmlPanel1DocumentOpen(Sender: TObject);
 begin
  // StatusBar1.Panels.Items[1] := IpHtmlPanel1.DataProvider.;
+ if fIsUsingHistory = False then
+   AddHistory(TIpChmDataProvider(IpHtmlPanel1.DataProvider).CurrentPage)
+ else fIsUsingHistory := False;
 end;
 
 procedure THelpForm.IpHtmlPanel1HotChange(Sender: TObject);
 begin
   StatusBar1.Panels.Items[0].Text := IpHtmlPanel1.HotURL;
-  fHotUrl := IpHtmlPanel1.HotURL;
 end;
 
 procedure THelpForm.IpHtmlPanel1HotClick(Sender: TObject);
 begin
-  AddHistory(fHotUrl);
+
 end;
 
 procedure THelpForm.PopupCopyClick(Sender: TObject);
@@ -450,6 +453,7 @@ procedure THelpForm.DoLoadUrl(Url: String; AChm: TChmReader = nil);
 begin
   if (fChms = nil) and (AChm = nil) then exit;
   if fChms.ObjectExists(Url, AChm) = 0 then Exit;
+  fIsUsingHistory := True;
   IpHtmlPanel1.OpenURL(Url);
   TIpChmDataProvider(IpHtmlPanel1.DataProvider).CurrentPath := ExtractFileDir(URL)+'/';
   AddHistory(Url);

components/chmhelp/packages/chm/chmreader.pas

@@ -445,7 +445,7 @@ begin
   fFreeStreamOnDestroy := FreeStreamOnDestroy;
   ReadHeader;
   if not IsValidFile then Exit;
-  FillDirectoryEntries(1000); // the default size of the array
+  FillDirectoryEntries(4096); // the default size of the array
   fContextList := TContextList.Create;
   ReadCommonData;
 end;
@@ -566,7 +566,7 @@ begin
        LookupPMGLchunk(EntriesBuffer, X, PMGLChunk);
        while EntriesBuffer.Position < ChunkStart + fDirectoryHeader.ChunkSize - PMGLChunk.UnusedSpace do begin
           if fDirectoryEntriesCount >= DirEntrySize-1 then begin
-            Inc(DirEntrySize, 1000);
+            Inc(DirEntrySize, 1024);
             SetLength(fDirectoryEntries, DirEntrySize);
           end;
           if ReadPMGLchunkEntryFromStream(EntriesBuffer, fDirectoryEntries[fDirectoryEntriesCount])