paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-12-04 21:57:10 +01:00
Code Issues Packages Projects Releases Wiki Activity

* made lhelp url loading more robust. now an absolute link is stored in history

Browse Source 
git-svn-id: trunk@17665 -
This commit is contained in:
andrew 2008-12-02 22:31:28 +00:00
parent 7ceed3d638
commit 707ab26207
3 changed files with 160 additions and 91 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

138
components/chmhelp/lhelp/chmcontentprovider.pas
View File

@ -35,7 +35,6 @@ type
fPopUp: TPopUpMenu;
fStatusBar: TStatusBar;
fContext: THelpContext;
fPendingChm: TChmReader;
protected
fIsUsingHistory: Boolean;
fChms: TChmFileList;
@ -44,11 +43,13 @@ type
fStopTimer: Boolean;
fFillingToc: Boolean;
function MakeURI(AUrl: String; AChm: TChmReader): String;
procedure AddHistory(URL: String);
procedure DoOpenChm(AFile: String);
procedure DoCloseChm;
procedure DoLoadContext(Context: THelpContext);
procedure DoLoadUrl(Url: String; AChm: TChmReader = nil);
procedure DoLoadUri(Uri: String; AChm: TChmReader = nil);
procedure DoError(Error: Integer);
procedure NewChmOpened(ChmFileList: TChmFileList; Index: Integer);
@ -81,14 +82,55 @@ implementation
uses ChmSpecialParser, chmFIftiMain;
function GetURIFileName(AURI: String): String;
var
FileStart,
FileEnd: Integer;
begin
FileStart := Pos(':', AURI)+1;
FileEnd := Pos('::', AURI);
Result := Copy(AURI, FileStart, FileEnd-FileStart);
end;
function GetURIURL(AURI: String): String;
var
URLStart: Integer;
begin
URLStart := Pos('::', AURI) + 2;
Result := Copy(AURI, URLStart, Length(AURI));
end;
function ChmURI(AUrl: String; AFileName: String): String;
var
FileNameNoPath: String;
begin
Result := AUrl;
if Pos('ms-its:', Result) > 0 then
Exit;
FileNameNoPath := ExtractFileName(AFileName);
Result := 'ms-its:'+FileNameNoPath+'::'+AUrl;
end;
{ TChmContentProvider }
function TChmContentProvider.MakeURI ( AUrl: String; AChm: TChmReader ) : String;
var
ChmIndex: Integer;
begin
ChmIndex := fChms.IndexOfObject(AChm);
Result := ChmURI(AUrl, fChms.FileName[ChmIndex]);
end;
procedure TChmContentProvider.AddHistory(URL: String);
begin
if fHistoryIndex < fHistory.Count then begin
while fHistory.Count-1 > fHistoryIndex do
fHistory.Delete(fHistory.Count-1);
end;
fHistory.Add(URL);
Inc(fHistoryIndex);
end;
@ -115,7 +157,7 @@ begin
Exit;
end;
if fChms = nil then Exit;
fChms.OnOpenNewFile := @NewChmOpened;
fHistoryIndex := -1;
fHistory.Clear;
@ -144,20 +186,31 @@ var
begin
if fChms = nil then exit;
Str := fChms.Chm[0].GetContextUrl(Context);
if Str <> '' then DoLoadUrl(Str);
if Str <> '' then DoLoadUri(Str, fChms.Chm[0]);
end;
procedure TChmContentProvider.DoLoadUrl(Url: String; AChm: TChmReader = nil);
procedure TChmContentProvider.DoLoadUri(Uri: String; AChm: TChmReader = nil);
var
ChmIndex: Integer;
NewUrl: String;
begin
if (fChms = nil) and (AChm = nil) then exit;
if fChms.ObjectExists(Url, AChm) = 0 then begin
fStatusBar.SimpleText := URL + ' not found!';
if fChms.ObjectExists(Uri, AChm) = 0 then begin
fStatusBar.SimpleText := URI + ' not found!';
Exit;
end;
if (Pos('ms-its', Uri) = 0) and (AChm <> nil) then
begin
ChmIndex := fChms.IndexOfObject(AChm);
NewUrl := ExtractFileName(fChms.FileName[ChmIndex]);
NewUrl := 'ms-its:'+NewUrl+'::/'+Uri;
Uri := NewUrl;
end;
fIsUsingHistory := True;
fHtml.OpenURL(Url);
TIpChmDataProvider(fHtml.DataProvider).CurrentPath := ExtractFileDir(URL)+'/';
AddHistory(Url);
fHtml.OpenURL(Uri);
TIpChmDataProvider(fHtml.DataProvider).CurrentPath := ExtractFileDir(URI)+'/';
AddHistory(Uri);
end;
@ -172,19 +225,20 @@ procedure TChmContentProvider.NewChmOpened(ChmFileList: TChmFileList;
begin
if Index = 0 then begin
fContentsTree.Items.Clear;
fPendingChm := ChmFileList.Chm[Index];
if fContext > -1 then begin
DoLoadContext(fContext);
fContext := -1;
end
else if ChmFileList.Chm[Index].DefaultPage <> '' then begin
DoLoadUrl(ChmFileList.Chm[Index].DefaultPage);
DoLoadUri(MakeURI(ChmFileList.Chm[Index].DefaultPage, ChmFileList.Chm[Index]));
end;
end;
if ChmFileList.Chm[Index].Title = '' then
ChmFileList.Chm[Index].Title := ExtractFileName(ChmFileList.FileName[Index]);
// Fill the table of contents. This actually works very well
fContentsTree.Visible := False;
// Fill the table of contents.
if Index <> 0 then
Application.QueueAsyncCall(@FillToc, PtrInt(ChmFileList.Chm[Index]));
end;
procedure TChmContentProvider.FillTOC(Data: PtrInt);
@ -199,6 +253,7 @@ begin
end;
fFillingToc := True;
fContentsTree.Visible := False;
Application.ProcessMessages;
fChm := TChmReader(Data);
{$IFDEF CHM_DEBUG_TIME}
writeln('Start: ',FormatDateTime('hh:nn:ss.zzz', Now));
@ -217,15 +272,18 @@ begin
end;
end;
Stream.Free;
// we fill the index here too
Stream := fchms.GetObject(fChm.IndexFile);
if Stream <> nil then begin
Stream.position := 0;
with TIndexFiller.Create(fIndexView, Stream) do begin;
DoFill;
Free;
// we fill the index here too but only for the main file
if fChms.IndexOfObject(fChm) < 1 then
begin
Stream := fchms.GetObject(fChm.IndexFile);
if Stream <> nil then begin
Stream.position := 0;
with TIndexFiller.Create(fIndexView, Stream) do begin;
DoFill;
Free;
end;
Stream.Free;
end;
Stream.Free;
end;
end;
if ParentNode.Index = 0 then ParentNode.Expanded := True;
@ -247,12 +305,6 @@ begin
if fIsUsingHistory = False then
AddHistory(TIpChmDataProvider(fHtml.DataProvider).CurrentPage)
else fIsUsingHistory := False;
if fPendingChm<>nil then
begin
AChm := fPendingChm;
fPendingChm := nil;
Application.QueueAsyncCall(@FillToc, PtrInt(AChm));
end;
end;
procedure TChmContentProvider.IpHtmlPanelHotChange(Sender: TObject);
@ -276,7 +328,7 @@ begin
begin
fChm := TChmReader(fContentsTree.Selected.Data);
if fChm.DefaultPage <> '' then
DoLoadUrl(fChm.DefaultPage, fChm);
DoLoadUri(MakeURI(fChm.DefaultPage, fChm));
Exit;
end;
ATreeNode := TContentTreeNode(fContentsTree.Selected);
@ -288,7 +340,7 @@ begin
fChm := TChmReader(ARootNode.Data);
if ATreeNode.Url <> '' then begin
DoLoadUrl(ATreeNode.Url, fChm);
DoLoadUri(MakeURI(ATreeNode.Url, fChm));
end;
end;
@ -304,7 +356,7 @@ begin
if not fIndexEdit.Focused then
fIndexEdit.Text := Trim(RealItem.Caption);
if RealItem.Url <> '' then begin
DoLoadUrl(RealItem.Url);
DoLoadUri(MakeURI(RealItem.Url, TChmReader(RealItem.Data)));
end;
end;
@ -505,7 +557,7 @@ begin
if (Item = nil) or (Item.Data = nil) then
Exit;
DoLoadUrl(Item.SubItems[2], TChmReader(Item.Data));
DoLoadUri(MakeURI(Item.SubItems[2], TChmReader(Item.Data)));
end;
@ -529,6 +581,7 @@ var
fFile: String;
fURL: String = '';
fPos: Integer;
FileIndex: Integer;
begin
Result := False;
fFile := Copy(AUrl,8, Length(AURL));
@ -538,36 +591,49 @@ begin
fFile := Copy(fFIle, 1, fPos-1);
end;
//writeln(fURL);
//if fChms = nil then
if fChms <> nil then
fChms.OnOpenNewFile := nil;
DoOpenChm(fFile);
FileIndex := fChms.IndexOf(fFile);
if fURL <> '' then
DoLoadUrl(fUrl)
DoLoadUri(MakeURI(fURL, fChms.Chm[FileIndex]))
else
GoHome;
Result := True;
Application.ProcessMessages;
Application.QueueAsyncCall(@FillToc, PtrInt(fChms.Chm[FileIndex]));
fChms.OnOpenNewFile := @NewChmOpened;
end;
procedure TChmContentProvider.GoHome;
begin
if (fChms <> nil) and (fChms.Chm[0].DefaultPage <> '') then begin
DoLoadUrl(fChms.Chm[0].DefaultPage);
DoLoadUri(MakeURI(fChms.Chm[0].DefaultPage, fChms.Chm[0]));
end;
end;
procedure TChmContentProvider.GoBack;
var
HistoryChm: TChmReader;
begin
if CanGoBack then begin
Dec(fHistoryIndex);
fIsUsingHistory:=True;
fHtml.OpenURL(fHistory.Strings[fHistoryIndex]);
HistoryChm := TChmReader(fHistory.Objects[fHistoryIndex]);
fHtml.OpenURL(fHistory.Strings[fHistoryIndex]);
end;
end;
procedure TChmContentProvider.GoForward;
var
HistoryChm: TChmReader;
begin
if CanGoForward then begin
Inc(fHistoryIndex);
fIsUsingHistory:=True;
HistoryChm := TChmReader(fHistory.Objects[fHistoryIndex]);
fChms.ObjectExists(fHistory.Strings[fHistoryIndex], HistoryChm); // this ensures that the correct chm will be found
fHtml.OpenURL(fHistory.Strings[fHistoryIndex]);
end;
end;

111
components/chmhelp/lhelp/chmdataprovider.pas
View File

@ -49,6 +49,7 @@ type
fCurrentPage: String;
fCurrentPath: String;
fOnHelpPopup: THelpPopupEvent;
function StripInPageLink(AURL: String): String;
protected
function DoGetHtmlStream(const URL: string;
PostData: TIpFormDataEntity) : TStream; override;
@ -76,10 +77,20 @@ implementation
{ TIpChmDataProvider }
function TIpChmDataProvider.StripInPageLink ( AURL: String ) : String;
var
i: LongInt;
begin
Result := AURL;
i := Pos('#', Result);
if i > 0 then
Result := Copy(Result, 1, i-1);
end;
function TIpChmDataProvider.DoGetHtmlStream(const URL: string;
PostData: TIpFormDataEntity): TStream;
begin
Result := fChm.GetObject(URL);
Result := fChm.GetObject(StripInPageLink(URL));
// If for some reason we were not able to get the page return something so that
// we don't cause an AV
if Result = nil then begin
@ -94,14 +105,10 @@ var
X: Integer;
begin
//DebugLn('RequestedUrl: ',URL);
Result := fChm.ObjectExists(Url) > 0;
Result := fChm.ObjectExists(StripInPageLink(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;
@ -149,8 +156,8 @@ var
begin
Result := True;
if Pos('Java', URL) =1 then Result := False;
if (fChm.ObjectExists(url)= 0)
and (fChm.ObjectExists(BuildUrl(fCurrentPath,Url)) = 0) then Result := False;
if (fChm.ObjectExists(StripInPageLink(url))= 0)
and (fChm.ObjectExists(StripInPageLink(BuildUrl(fCurrentPath,Url))) = 0) then Result := False;
//DebugLn('CanHandle ',Url,' = ', Result);
//if not Result then if fChm.ObjectExists(BuildURL('', URL)) > 0 Then result := true;
if Pos('javascript:helppopup(''', LowerCase(URL)) = 1 then begin
@ -166,66 +173,64 @@ var
tmp: String;
X: LongInt;
fOldUrl: String;
fNewURL: String;
ParentDirs: TStringList;
RemoveDirCount: Integer;
begin
Result := NewURL;
if Pos('ms-its:', OldURL) > 0 then begin
X := Pos('::', OldUrl);
fOldUrl := Copy(OldUrl, X+2, Length(OldUrl)-(X+2));
end
else fOldUrl := OldURL;
fOldUrl := OldURL;
fNewURL := NewURL;
if Length(NewURL) < 1 then Exit(NewURL);
if fChm.ObjectExists(NewURL) > 0 then begin
Result := NewUrl;
if Pos('ms-its:', NewURL) = 1 then
Exit;
end;
Result:=iputils.BuildURL(fOldurl,NewUrl);
if NewURL[1] <> '/' then
begin
if fChm.ObjectExists(Result) > 0 then Tmp := Result
else if fChm.ObjectExists('/'+Result) > 0 then begin
Tmp := '/'+Result;
end
else if fChm.ObjectExists(fCurrentPath+Result) > 0 then begin
Tmp := fCurrentPath+Result;
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;
ParentDirs := GetDirsParents(OldURL);
RemoveDirCount := 0;
repeat
X := Pos('../', fNewURL);
if X > 0 then
begin
Delete(fNewURL, X, 3);
Inc(RemoveDirCount);
end;
Result := Tmp;
end;
X := Pos('//', Result);
while X > 0 do begin
Delete(Result, X ,1);
until X = 0;
repeat
X := Pos('./', fNewURL);
if X > 0 then
Delete(fNewURL, X, 2);
until X = 0;
Result := '';
for X := 0 to ParentDirs.Count-RemoveDirCount-1 do
Result := Result + ParentDirs[X] + '/';
Result := Result+fNewURL;
repeat
X := Pos('//', Result);
end;
X := Pos('\', Result);
while X > 0 do begin
Result[X] := '/';
X := Pos('\', Result);
end;
if X > 0 then
Delete(Result, X, 1);
until X = 0;
ParentDirs.Free;
//WriteLn('res = ', Result);
end;
function TIpChmDataProvider.GetDirsParents(ADir: String): TStringList;
var
X: Integer;
Tmp: String;
LastName: String;
begin
Result := TStringList.Create;
//Result.Add(ADir);
for X := Length(ADir) downto 1 do begin
if ADir[X] = '/' then begin
Tmp := Copy(ADir, 1, X);
Result.Add(Tmp);
end;
end;
Result.Delimiter := '/';
Result.DelimitedText := ADir;
LastName := ExtractFileName(ADir);
if LastName <> '' then
Result.Delete(Result.Count-1);
if Result[Result.Count-1] = '' then
Result.Delete(Result.Count-1);
end;
function TIpChmDataProvider.DoGetStream(const URL: string): TStream;

2
components/chmhelp/lhelp/lhelpcore.lrs
View File

@ -1,5 +1,3 @@
{ This is an automatically generated lazarus resource file }
LazarusResources.Add('THelpForm','FORMDATA',[
'TPF0'#9'THelpForm'#8'HelpForm'#4'Left'#3#201#0#6'Height'#3#23#2#3'Top'#3#205
+#0#5'Width'#3#246#2#11'HelpContext'#2#0#13'ActiveControl'#7#6'Panel1'#5'Alig'