mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-08 00:02:03 +02:00
* lhelp uses fpc code to parse toc sitemap
* lhelp - remove newline from please wait message * lhelp - made listview column size 400 since autosize is not working git-svn-id: trunk@21950 -
This commit is contained in:
andrew
parent
86798d3d1d
commit
c97887101c
@ -2,12 +2,12 @@ unit chmcontentprovider;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
{$if (fpc_version=2) and (fpc_release>2) ((fpc_version=2) and (fpc_release=2) and (fpc_patch>2))}
|
||||
//{$if (fpc_version=2) and (fpc_release>2) ((fpc_version=2) and (fpc_release=2) and (fpc_patch>2))}
|
||||
{$Note Compiling lhelp with search support}
|
||||
{$DEFINE CHM_SEARCH}
|
||||
{$else}
|
||||
{$Note Compiling lhelp *without* search support since your fpc version is not new enough}
|
||||
{$endif}
|
||||
//{$else}
|
||||
//{$Note Compiling lhelp *without* search support since your fpc version is not new enough}
|
||||
//{$endif}
|
||||
|
||||
{off $DEFINE CHM_DEBUG_TIME}
|
||||
{off $DEFINE CHM_SEARCH}
|
||||
@ -76,6 +76,7 @@ type
|
||||
{$IFDEF CHM_SEARCH}
|
||||
procedure SearchButtonClick(Sender: TObject);
|
||||
procedure SearchResultsDblClick(Sender: TObject);
|
||||
procedure SearchComboKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
|
||||
{$ENDIF}
|
||||
public
|
||||
function CanGoBack: Boolean; override;
|
||||
@ -95,7 +96,7 @@ type
|
||||
|
||||
implementation
|
||||
|
||||
uses ChmSpecialParser{$IFDEF CHM_SEARCH}, chmFIftiMain{$ENDIF};
|
||||
uses ChmSpecialParser{$IFDEF CHM_SEARCH}, chmFIftiMain{$ENDIF}, LCLType;
|
||||
|
||||
function GetURIFileName(AURI: String): String;
|
||||
var
|
||||
@ -296,7 +297,7 @@ begin
|
||||
end;
|
||||
fFillingToc := True;
|
||||
fContentsTree.Visible := False;
|
||||
fContentsPanel.Caption := 'Table of Contents Loading. ' + LineEnding +'Please Wait...';
|
||||
fContentsPanel.Caption := 'Table of Contents Loading. Please Wait...';
|
||||
Application.ProcessMessages;
|
||||
fChm := TChmReader(Data);
|
||||
{$IFDEF CHM_DEBUG_TIME}
|
||||
@ -402,8 +403,13 @@ begin
|
||||
ARootNode := ARootNode.Parent;
|
||||
|
||||
fChm := TChmReader(ARootNode.Data);
|
||||
if ATreeNode.Url <> '' then begin
|
||||
DoLoadUri(MakeURI(ATreeNode.Url, fChm));
|
||||
try
|
||||
fContentsTree.OnSelectionChanged := nil;
|
||||
if ATreeNode.Url <> '' then begin
|
||||
DoLoadUri(MakeURI(ATreeNode.Url, fChm));
|
||||
end;
|
||||
finally
|
||||
fContentsTree.OnSelectionChanged := @ContentsTreeSelectionChanged;
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -485,6 +491,8 @@ var
|
||||
TmpHolder: TNotifyEvent;
|
||||
i: integer;
|
||||
begin
|
||||
if fContentsTree.OnSelectionChanged = nil then
|
||||
Exit; // the change was a response to a click and should be ignored
|
||||
FileName := GetURIFileName(AUrl);
|
||||
URL := GetURIURL(AUrl);
|
||||
FoundNode := nil;
|
||||
@ -537,6 +545,15 @@ begin
|
||||
end;
|
||||
|
||||
{$IFDEF CHM_SEARCH}
|
||||
|
||||
procedure TChmContentProvider.SearchComboKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
|
||||
begin
|
||||
case key of
|
||||
VK_RETURN: SearchButtonClick(nil);
|
||||
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TChmContentProvider.SearchButtonClick ( Sender: TObject ) ;
|
||||
type
|
||||
TTopicEntry = record
|
||||
@ -820,6 +837,7 @@ begin
|
||||
Align := alClient;
|
||||
BevelOuter := bvNone;
|
||||
Caption := '';
|
||||
|
||||
Visible := True;
|
||||
end;
|
||||
fContentsTree := TTreeView.Create(fContentsPanel);
|
||||
@ -862,8 +880,14 @@ begin
|
||||
with fIndexView do begin
|
||||
Parent := fIndexTab;
|
||||
ShowColumnHeaders := False;
|
||||
Columns.Add.AutoSize := True;
|
||||
ViewStyle := vsReport;
|
||||
with Columns.Add do
|
||||
begin
|
||||
Width := 400; {$NOTE TListView.Column.AutoSize does not seem to work}
|
||||
AutoSize := True;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
Anchors := [akLeft, akTop, akRight, akBottom];
|
||||
BorderSpacing.Around := 6;
|
||||
AnchorSide[akLeft].Control := fIndexTab;
|
||||
@ -878,7 +902,7 @@ begin
|
||||
ReadOnly := True;
|
||||
end;
|
||||
|
||||
{$IFDEF CHM_SEARCH}
|
||||
// {$IFDEF CHM_SEARCH}
|
||||
fSearchTab := TTabSheet.Create(fTabsControl);
|
||||
with fSearchTab do begin
|
||||
Caption := 'Search';
|
||||
@ -903,6 +927,7 @@ begin
|
||||
AnchorSide[akRight].Side := asrBottom;
|
||||
AnchorSide[akTop].Control := fKeywordLabel;
|
||||
AnchorSide[akTop].Side := asrBottom;
|
||||
OnKeyDown := @SearchComboKeyDown;
|
||||
end;
|
||||
|
||||
fSearchBtn := TButton.Create(fSearchTab);
|
||||
@ -959,7 +984,7 @@ begin
|
||||
{$ENDIF}
|
||||
OnDblClick := @SearchResultsDblClick;
|
||||
end;
|
||||
{$ENDIF}
|
||||
// {$ENDIF}
|
||||
|
||||
fSplitter := TSplitter.Create(Parent);
|
||||
with fSplitter do begin
|
||||
|
||||
@ -25,7 +25,7 @@ unit ChmSpecialParser;
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, Forms, SysUtils, Controls, ComCtrls;
|
||||
Classes, Forms, SysUtils, Controls, ComCtrls, chmsitemap;
|
||||
|
||||
type
|
||||
|
||||
@ -55,18 +55,13 @@ type
|
||||
TContentsFiller = class(TObject)
|
||||
private
|
||||
fTreeView: TTreeView;
|
||||
fStream: TStream;
|
||||
fSitemap: TChmSiteMap;
|
||||
fChm: TObject;
|
||||
fText: TStringList;
|
||||
|
||||
fBranchCount: DWord;
|
||||
fStop: PBoolean;
|
||||
fULList: Array of Integer;
|
||||
procedure CustomCreateContentTreeItem(Sender: TCustomTreeView;
|
||||
var ATreeNode: TTreenode);
|
||||
function AddULTree(StartLine, EndLine: Integer; ParentNode: TTreeNode): Boolean;
|
||||
function GetULEnd(StartLine: Integer): Integer;
|
||||
function GetLIData(StartLine: Integer): TContentNode;
|
||||
procedure FillULIndices;
|
||||
procedure CustomCreateContentTreeItem(Sender: TCustomTreeView; var ATreeNode: TTreenode);
|
||||
procedure AddItem(AItem: TChmSiteMapItem; AParentNode: TTreeNode);
|
||||
public
|
||||
constructor Create(ATreeView: TTreeView; AStream: TStream; StopBoolean: PBoolean; AChm: TObject);
|
||||
procedure DoFill(ParentNode: TTreeNode);
|
||||
@ -118,122 +113,37 @@ begin
|
||||
ATreeNode := TContentTreeNode.Create(TTreeView(Sender).Items);
|
||||
end;
|
||||
|
||||
function TContentsFiller.AddULTree(StartLine, EndLine: Integer; ParentNode: TTreeNode): Boolean;
|
||||
procedure TContentsFiller.AddItem(AItem: TChmSiteMapItem; AParentNode: TTreeNode);
|
||||
var
|
||||
X: LongInt;
|
||||
TreeNode: TContentTreeNode = nil;
|
||||
NodeInfo: TContentNode;
|
||||
ULEnd: Integer;
|
||||
begin
|
||||
// NOTE: this doesn't truly parse the html'ish content here. So things like
|
||||
// entries spread on multiple lines won't work. Patches are welcome :)
|
||||
Result := True;
|
||||
Inc(fBranchCount);
|
||||
X := StartLine-1;
|
||||
if EndLine > fText.Count-1 then
|
||||
EndLine := fText.Count-1;
|
||||
while X < EndLine do begin
|
||||
Inc(X);
|
||||
if Pos('<LI>', UpperCase(fText.Strings[X])) > 0 then begin
|
||||
try
|
||||
NodeInfo := GetLIData(X);
|
||||
TreeNode := TContentTreeNode(fTreeView.Items.AddChild(ParentNode, NodeInfo.Name));
|
||||
if (ParentNode.ImageIndex < 0) or (ParentNode.ImageIndex > 2) then
|
||||
begin
|
||||
ParentNode.ImageIndex := 1;
|
||||
ParentNode.SelectedIndex := 1;
|
||||
end;
|
||||
TreeNode.Url := NodeInfo.Url;
|
||||
TreeNode.Data := fChm;
|
||||
TreeNode.ImageIndex := 3;
|
||||
TreeNode.SelectedIndex := 3;
|
||||
Inc(X, NodeInfo.LineCount);
|
||||
except
|
||||
// an exception can occur if we have closed the file while the toc is still being read
|
||||
Result := False;
|
||||
Exit;
|
||||
end;
|
||||
end;
|
||||
if (X <> StartLine) and (fULList[X-1] < fULList[X]) then begin
|
||||
ULEnd := GetULEnd(X);
|
||||
if not AddULTree(X, ULEnd, TreeNode) then exit(False);
|
||||
Inc(X, ULEnd-X);
|
||||
end;
|
||||
end;
|
||||
if fBranchCount mod 400 = 0 then begin
|
||||
Application.ProcessMessages;
|
||||
if fStop^ = True then Exit(False);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TContentsFiller.GetULEnd(StartLine: Integer): Integer;
|
||||
var
|
||||
X: LongInt;
|
||||
begin
|
||||
for X := StartLine+1 to fText.Count-1 do begin
|
||||
if fULList[X] < fULList[StartLine] then begin
|
||||
Result := X;
|
||||
Exit;
|
||||
end;
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
function TContentsFiller.GetLIData(StartLine: Integer): TContentNode;
|
||||
var
|
||||
X: Integer;
|
||||
fLength: Integer;
|
||||
fPos: Integer;
|
||||
Line: String;
|
||||
begin
|
||||
// Don't use fillchar to initialize the result.
|
||||
// The caller passes a pointer a record which may already contain strings and
|
||||
// those will not be freed when we clean it with FillChar
|
||||
Result.Name:='';
|
||||
Result.Url:='';
|
||||
Result.LineCount:= 0;
|
||||
for X := StartLine to fText.Count-1 do begin
|
||||
Line := fText.Strings[X];
|
||||
fPos := Pos('<param name="name" value="', LowerCase(Line));
|
||||
if fPos > 0 then begin
|
||||
fLength := Length('<param name="name" value="');
|
||||
Result.Name := Copy(Line, fPos+fLength, Length(Line)-(fLength+fPos));
|
||||
Result.Name := Copy(Result.Name, 1, Pos('"', Result.Name)-1);
|
||||
end
|
||||
else begin
|
||||
fPos := Pos('<param name="local" value="', LowerCase(Line));
|
||||
if fPos > 0 then begin
|
||||
fLength := Length('<param name="local" value="');
|
||||
Result.Url := Copy(Line, fPos+fLength, Length(Line)-(fLength+fPos));
|
||||
Result.Url := '/'+Copy(Result.Url, 1, Pos('"', Result.Url)-1);
|
||||
end
|
||||
else if Pos('</OBJECT>', UpperCase(Line)) > 0 then begin
|
||||
Result.LineCount := X-StartLine;
|
||||
Break;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
Result.Url := FixURL(Result.Url);
|
||||
end;
|
||||
|
||||
procedure TContentsFiller.FillULIndices;
|
||||
var
|
||||
ULDepth: Integer = 0;
|
||||
NewNode: TContentTreeNode;
|
||||
X: Integer;
|
||||
begin
|
||||
for X := 0 to fText.Count-1 do begin
|
||||
if Pos('<UL>', UpperCase(fText.Strings[X])) > 0 then Inc(ULDepth);
|
||||
if Pos('</UL>', UpperCase(fText.Strings[X])) > 0 then Dec(ULDepth);
|
||||
fULList[X] := ULDepth;
|
||||
if fStop^ then Exit;
|
||||
NewNode := TContentTreeNode(fTreeView.Items.AddChild(AParentNode, AItem.Text));
|
||||
NewNode.Url:='/'+AItem.Local;
|
||||
NewNode.Data:=fChm;
|
||||
NewNode.ImageIndex := 3;
|
||||
NewNode.SelectedIndex := 3;
|
||||
if (AParentNode.ImageIndex < 0) or (AParentNode.ImageIndex > 2) then
|
||||
begin
|
||||
AParentNode.ImageIndex := 1;
|
||||
AParentNode.SelectedIndex := 1;
|
||||
end;
|
||||
end;
|
||||
Inc(fBranchCount);
|
||||
|
||||
if fBranchCount mod 400 = 0 then
|
||||
Application.ProcessMessages;
|
||||
|
||||
for X := 0 to AItem.Children.Count-1 do
|
||||
AddItem(AItem.Children.Item[X], NewNode);
|
||||
end;
|
||||
|
||||
constructor TContentsFiller.Create(ATreeView: TTreeView; AStream: TStream; StopBoolean: PBoolean; AChm: TObject);
|
||||
begin
|
||||
inherited Create;
|
||||
fTreeView := ATreeView;
|
||||
fStream := AStream;
|
||||
fSitemap := TChmSiteMap.Create(stTOC);
|
||||
fSitemap.LoadFromStream(AStream);
|
||||
fStop := StopBoolean;
|
||||
fChm := AChm;
|
||||
end;
|
||||
@ -246,23 +156,18 @@ begin
|
||||
OrigEvent := fTreeView.OnCustomCreateItem;
|
||||
fTreeView.OnCustomCreateItem := @CustomCreateContentTreeItem;
|
||||
|
||||
fText := TStringList.Create;
|
||||
fStream.Position := 0;
|
||||
|
||||
fTreeView.BeginUpdate;
|
||||
fText.LoadFromStream(fStream);
|
||||
SetLength(fULList, fText.Count);
|
||||
FillULIndices;
|
||||
for X := 0 to fText.Count-1 do begin
|
||||
if Pos('<UL>', UpperCase(fText.Strings[X])) > 0 then begin
|
||||
if not AddULTree(X, GetULEnd(X), ParentNode) then begin
|
||||
//then we have either closed the file or are exiting the program
|
||||
fTreeView.Items.Clear;
|
||||
end;
|
||||
Break;
|
||||
end;
|
||||
end;
|
||||
|
||||
for X := 0 to fSitemap.Items.Count-1 do
|
||||
AddItem(fSitemap.Items.Item[X], ParentNode);
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
fTreeView.OnCustomCreateItem := OrigEvent;
|
||||
fText.Free;
|
||||
|
||||
fTreeView.EndUpdate;
|
||||
end;
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user