paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-02 17:50:16 +02:00
Code Issues Packages Projects Releases Wiki Activity

* new bunch of Gabor's changes

Browse Source
This commit is contained in:
pierre 2000-06-26 07:29:22 +00:00
parent 1f902711f3
commit 0b75c6e4fd
7 changed files with 1296 additions and 119 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
ide/text/fixes.txt
View File

@ -1,3 +1,15 @@
Gabors's log to 26/6/2000 commits
========================= Already fixed ================================
[*] topics with the same name are now all shown on the Index page
========================== Other improvements ============================
[+] added support for "see also" entries of Norton Guide help topics
[+] coloring of NG help is now integrated with the common color managment
system of FV
[+] started implementing help support for Windows Help files
Gabors's log to 22/6/2000 commits
========================== Other improvements ============================

8
ide/text/fpconst.pas
View File

@ -51,7 +51,8 @@ const
HTMLExt = '.htm';
TemplateExt = '.pt';
NGExt = '.ng';
HelpFileExts = '*.tph;*.htm*;*'+HTMLIndexExt+';*'+NGExt;
WinHelpExt = '.hlp';
HelpFileExts = '*.tph;*.htm*;*'+HTMLIndexExt+';*'+NGExt+';*'+WinHelpExt;
EnterSign = #17#196#217;
@ -406,7 +407,10 @@ implementation
END.
{
$Log$
Revision 1.41 2000-06-22 09:07:11 pierre
Revision 1.42 2000-06-26 07:29:22 pierre
* new bunch of Gabor's changes
Revision 1.41 2000/06/22 09:07:11 pierre
* Gabor changes: see fixes.txt
Revision 1.40 2000/06/16 08:50:40 pierre

35
ide/text/fphelp.pas
View File

@ -66,7 +66,7 @@ const
implementation
uses Objects,Views,App,MsgBox,Commands,
WUtils,WHTMLHlp,
WUtils,WHTMLHlp,WNGHelp,
FPString,FPConst,FPVars,FPUtils;
const
@ -290,6 +290,14 @@ procedure InitHelpSystem;
{$IFDEF DEBUG}SetStatus(msg_LoadingHelpFile);{$ENDIF}
end;
procedure AddWinHelpFile(HelpFile: string);
begin
{$IFDEF DEBUG}SetStatus(msg_LoadingHelpFile+' ('+SmartPath(HelpFile)+')');{$ENDIF}
if HelpFacility^.AddWinHelpFile(HelpFile)=false then
ErrorBox(FormatStrStr(msg_failedtoloadhelpfile,HelpFile),nil);
{$IFDEF DEBUG}SetStatus(msg_LoadingHelpFile);{$ENDIF}
end;
procedure AddHTMLIndexFile(HelpFile: string);
begin
{$IFDEF DEBUG}SetStatus(msg_LoadingHelpFile+' ('+SmartPath(HelpFile)+')');{$ENDIF}
@ -317,6 +325,8 @@ begin
AddHTMLIndexFile(S) else
if UpcaseStr(ExtOf(S))=UpcaseStr(NGExt) then
AddNGFile(S) else
if UpcaseStr(ExtOf(S))=UpcaseStr(WinHelpExt) then
AddWinHelpFile(S) else
AddOAFile(S);
end;
PopStatus;
@ -461,9 +471,27 @@ begin
FPHTMLGetSectionColor:=OK;
end;
function FPNGGetAttrColor(Attr: char; var Color: byte): boolean;
var OK: boolean;
begin
OK:=false;
case Attr of
'A' : OK:=FPHTMLGetSectionColor(hsHeading1,Color);
'B' : OK:=FPHTMLGetSectionColor(hsHeading2,Color);
'b' : OK:=FPHTMLGetSectionColor(hsHeading5,Color);
'U' : OK:=FPHTMLGetSectionColor(hsHeading3,Color);
'N' : OK:=FPHTMLGetSectionColor(hsHeading4,Color);
{$ifdef DEBUGMSG}
else ErrorBox('Unknown attr encountered : "'+Attr+'"',nil);
{$endif}
end;
FPNGGetAttrColor:=OK;
end;
procedure InitHelpFiles;
begin
HTMLGetSectionColor:={$ifdef FPC}@{$endif}FPHTMLGetSectionColor;
NGGetAttrColor:={$ifdef FPC}@{$endif}FPNGGetAttrColor;
New(HelpFiles, Init(10,10));
end;
@ -490,7 +518,10 @@ end;
END.
{
$Log$
Revision 1.34 2000-06-22 09:07:12 pierre
Revision 1.35 2000-06-26 07:29:23 pierre
* new bunch of Gabor's changes
Revision 1.34 2000/06/22 09:07:12 pierre
* Gabor changes: see fixes.txt
Revision 1.33 2000/06/16 08:50:40 pierre

76
ide/text/whelp.pas
View File

@ -156,7 +156,7 @@ type
end;
PKeywordDescriptors = ^TKeywordDescriptors;
TKeywordDescriptors = array[0..10900] of TKeywordDescriptor;
TKeywordDescriptors = array[0..MaxBytes div sizeof(TKeywordDescriptor)-1] of TKeywordDescriptor;
PTopic = ^TTopic;
TTopic = object
@ -190,11 +190,17 @@ type
function Compare(Key1, Key2: Pointer): Sw_Integer; virtual;
end;
PUnsortedIndexEntryCollection = ^TUnsortedIndexEntryCollection;
TUnsortedIndexEntryCollection = object(TCollection)
function At(Index: Sw_Integer): PIndexEntry;
procedure FreeItem(Item: Pointer); virtual;
end;
PHelpFile = ^THelpFile;
THelpFile = object(TObject)
ID : word;
Topics : PTopicCollection;
IndexEntries : PIndexEntryCollection;
IndexEntries : PUnsortedIndexEntryCollection;
constructor Init(AID: word);
function LoadTopic(HelpCtx: THelpCtx): PTopic; virtual;
procedure AddTopic(HelpCtx: THelpCtx; Pos: longint; const Param: string);
@ -244,6 +250,7 @@ type
function AddOAHelpFile(const FileName: string): boolean;
function AddHTMLHelpFile(const FileName, TOCEntry: string): boolean;
function AddNGHelpFile(const FileName: string): boolean;
function AddWinHelpFile(const FileName: string): boolean;
function AddHTMLIndexHelpFile(const FileName: string): boolean;
function LoadTopic(SourceFileID: word; Context: THelpCtx): PTopic; virtual;
function TopicSearch(Keyword: string; var FileID: word; var Context: THelpCtx): boolean; virtual;
@ -279,7 +286,7 @@ uses
{$ifdef Linux}
linux,
{$endif Linux}
WConsts,WHTMLHlp,WNGHelp;
WConsts,WHTMLHlp,WNGHelp,WWinHelp;
Function GetDosTicks:longint; { returns ticks at 18.2 Hz, just like DOS }
@ -364,7 +371,7 @@ begin
end;
procedure RenderTopic(Lines: PUnsortedStringCollection; T: PTopic);
var Size,CurPtr,I: sw_word;
var Size,CurPtr,I,MSize: sw_word;
S: string;
begin
CurPtr:=0;
@ -379,8 +386,12 @@ begin
CurPtr:=0;
for I:=0 to Lines^.Count-1 do
begin
S:=GetStr(Lines^.At(I)); Size:=length(S);
Move(S[1],PByteArray(T^.Text)^[CurPtr],Size);
S:=GetStr(Lines^.At(I)); Size:=length(S); MSize:=Size;
if CurPtr+Size>=T^.TextSize then
MSize:=T^.TextSize-CurPtr;
Move(S[1],PByteArray(T^.Text)^[CurPtr],MSize);
if MSize<>Size then
Break;
Inc(CurPtr,Size);
PByteArray(T^.Text)^[CurPtr]:=ord(hscLineBreak);
Inc(CurPtr);
@ -392,7 +403,7 @@ procedure AddLinkToTopic(T: PTopic; AFileID: word; ACtx: THelpCtx);
var NewSize: word;
NewPtr: pointer;
begin
NewSize:=(T^.LinkCount+1)*sizeof(T^.Links^[0]);
NewSize:=longint(T^.LinkCount+1)*sizeof(T^.Links^[0]);
GetMem(NewPtr,NewSize);
if Assigned(T^.Links) then
begin
@ -488,6 +499,16 @@ begin
if Item<>nil then DisposeIndexEntry(Item);
end;
function TUnsortedIndexEntryCollection.At(Index: Sw_Integer): PIndexEntry;
begin
At:=inherited At(Index);
end;
procedure TUnsortedIndexEntryCollection.FreeItem(Item: Pointer);
begin
if Item<>nil then DisposeIndexEntry(Item);
end;
function TIndexEntryCollection.Compare(Key1, Key2: Pointer): Sw_Integer;
var K1: PIndexEntry absolute Key1;
K2: PIndexEntry absolute Key2;
@ -497,6 +518,8 @@ begin
S1:=UpcaseStr(K1^.Tag^); S2:=UpcaseStr(K2^.Tag^);
if S1<S2 then R:=-1 else
if S1>S2 then R:=1 else
if K1^.FileID<K2^.FileID then R:=-1 else
if K1^.FileID>K2^.FileID then R:= 1 else
R:=0;
Compare:=R;
end;
@ -1006,6 +1029,13 @@ begin
AddNGHelpFile:=AddFile(H);;
end;
function THelpFacility.AddWinHelpFile(const FileName: string): boolean;
var H: PHelpFile;
begin
H:=New(PWinHelpFile, Init(FileName, LastID+1));
AddWinHelpFile:=AddFile(H);;
end;
function THelpFacility.AddHTMLIndexHelpFile(const FileName: string): boolean;
var H: PHelpFile;
begin
@ -1112,12 +1142,32 @@ begin
LastFirstChar:=FirstChar;
NLFlag:=0;
end;
function FormatAlias(Alias: string): string;
var StartP,EndP: sw_integer;
begin
repeat
StartP:=Pos(' ',Alias);
if StartP>0 then
begin
EndP:=StartP;
while (EndP+1<=length(Alias)) and (Alias[EndP+1]=' ') do Inc(EndP);
Alias:=copy(Alias,1,StartP-1)+' | '+copy(Alias,EndP+1,High(Alias));
end;
until StartP=0;
if Assigned(HelpFacility) then
if length(Alias)>IndexTabSize-4 then
Alias:=Trim(copy(Alias,1,IndexTabSize-4-2))+'..';
FormatAlias:=Alias;
end;
procedure AddKeyword(KWS: string);
begin
Inc(KWCount); if KWCount=1 then NLFlag:=0;
if (KWCount=1) or
( (Upcase(KWS[1])<>LastFirstChar) and ( (LastFirstChar>#64) or (KWS[1]>#64) ) ) then
NewSection(Upcase(KWS[1]));
KWS:=FormatAlias(KWS);
if (NLFlag mod 2)=0
then Line:=' '+#2+KWS+#2
else begin
@ -1141,14 +1191,15 @@ begin
begin
AddLine(' '+msg_helpindex);
KWCount:=0; Line:='';
T^.LinkCount:=Keywords^.Count;
T^.LinkCount:=Min(Keywords^.Count,MaxBytes div sizeof(T^.Links^[0])-1);
GetMem(T^.Links,T^.LinkSize);
for I:=0 to Keywords^.Count-1 do
for I:=0 to T^.LinkCount-1 do
begin
KW:=Keywords^.At(I);
AddKeyword(KW^.Tag^);
T^.Links^[I].Context:=longint(KW^.HelpCtx); T^.Links^[I].FileID:=KW^.FileID;
T^.Links^[I].Context:=longint(KW^.HelpCtx);
T^.Links^[I].FileID:=KW^.FileID;
end;
FlushLine;
AddLine('');
@ -1185,7 +1236,10 @@ end;
END.
{
$Log$
Revision 1.24 2000-06-22 09:07:14 pierre
Revision 1.25 2000-06-26 07:29:23 pierre
* new bunch of Gabor's changes
Revision 1.24 2000/06/22 09:07:14 pierre
* Gabor changes: see fixes.txt
Revision 1.23 2000/06/16 08:50:44 pierre

294
ide/text/wnghelp.pas
View File

@ -75,6 +75,7 @@ type
{ array of TNGSeeAlsoRec }
end;
PNGSeeAlsoRec = ^TNGSeeAlsoRec;
TNGSeeAlsoRec = packed record
EntryCount : word;
Entries : record end;
@ -89,6 +90,12 @@ type
Container: PNGContainerRecord;
end;
PLinkRec = ^TLinkRec;
TLinkRec = record
Name : string;
FilePos : longint;
end;
PNGHelpFile = ^TNGHelpFile;
TNGHelpFile = object(THelpFile)
constructor Init(AFileName: string; AID: word);
@ -99,17 +106,30 @@ type
private
F: PStream;
Header: TNGFileHeader;
FirstRecordPos: longint;
IndexLoaded: boolean;
{ NextHelpCtx: longint;}
function ReadHeader: boolean;
function ReadContainer(EnumProc: pointer): boolean;
function ReadTopicRec(Lines: PUnsortedStringCollection): boolean;
function ReadTopicRec(LineEnumProc: pointer; LinkEnumProc: pointer): boolean;
function ReadRecord(var R: TRecord; ReadData: boolean): boolean;
end;
TNGGetAttrColorProc = function(Attr: char; var Color: byte): boolean;
function DefNGGetAttrColor(Attr: char; var Color: byte): boolean;
const NGGetAttrColor : TNGGetAttrColorProc = DefNGGetAttrColor;
implementation
uses CallSpec;
function DefNGGetAttrColor(Attr: char; var Color: byte): boolean;
begin
DefNGGetAttrColor:=false;
end;
function NGDecompressStr(const S: string): string;
var NS: string;
I: sw_integer;
@ -134,6 +154,7 @@ function TranslateStr(const S: string): string;
var NS: string;
I: sw_integer;
InHiLite: boolean;
Color: byte;
begin
NS:=''; InHiLite:=false;
I:=1;
@ -144,25 +165,14 @@ begin
Inc(I);
case S[I] of
'^' : NS:=NS+'^';
'B' : begin
'A'..'Z',
'a'..'z' :
begin
if InHiLite then
NS:=NS+hscNormText
else
NS:=NS+hscTextColor+chr(15);
InHiLite:=not InHiLite;
end;
'b' : begin
if InHiLite then
NS:=NS+hscNormText
else
NS:=NS+hscTextColor+chr(11);
InHiLite:=not InHiLite;
end;
'U' : begin
if InHiLite then
NS:=NS+hscNormText
else
NS:=NS+hscTextColor+chr(3);
if NGGetAttrColor(S[I],Color) then
NS:=NS+hscTextColor+chr(Color);
InHiLite:=not InHiLite;
end;
else
@ -190,40 +200,7 @@ begin
end;
constructor TNGHelpFile.Init(AFileName: string; AID: word);
function FormatAlias(Alias: string): string;
var StartP,EndP: sw_integer;
begin
repeat
StartP:=Pos(' ',Alias);
if StartP>0 then
begin
EndP:=StartP;
while (EndP+1<=length(Alias)) and (Alias[EndP+1]=' ') do Inc(EndP);
Alias:=copy(Alias,1,StartP-1)+' | '+copy(Alias,EndP+1,High(Alias));
end;
until StartP=0;
if Assigned(HelpFacility) then
if length(Alias)>HelpFacility^.IndexTabSize-4 then
Alias:=Trim(copy(Alias,1,HelpFacility^.IndexTabSize-4-2))+'..';
FormatAlias:=Alias;
end;
procedure AddToIndex(P: PContainerItemRec); {$ifndef FPC}far;{$endif}
var S: string;
begin
S:=Trim(P^.Name);
S:=TranslateStr(S);
S:=Trim(FormatAlias(S));
if (S<>'') and (P^.FilePos<>-1) then
begin
{ Inc(NextHelpCtx);}
AddIndexEntry(S,P^.FilePos);
AddTopic(P^.FilePos,P^.FilePos,'');
end;
end;
var OK: boolean;
FS: longint;
R: TRecord;
L: longint;
begin
if inherited Init(AID)=false then Fail;
F:=New(PBufStream, Init(AFileName, stOpenRead, HelpStreamBufSize));
@ -231,38 +208,10 @@ begin
if OK then OK:=(F^.Status=stOK);
if OK then
begin
FS:=F^.GetSize;
OK:=ReadHeader;
if OK then
FirstRecordPos:=F^.GetPos;
end;
while OK do
begin
L:=F^.GetPos;
if (L>=FS) then Break;
OK:=ReadRecord(R,false);
if (OK=false) then Break;
case R.SClass of
ng_rtContainer : begin F^.Seek(L); OK:=ReadContainer(@AddToIndex); end;
{ ng_rtTopic : begin F^.Seek(L); OK:=ReadTopicRec; end;}
else
begin
{$ifdef DEBUGMSG}
ClearFormatParams;
AddFormatParamInt(R.SClass);
AddFormatParamInt(L);
AddFormatParamInt(R.Size);
ErrorBox('Uknown help record tag %x encountered, '+
'offset %x, size %d',@FormatParams);
{$else}
{Skip};
{$endif}
end;
end;
if OK then
begin
Inc(L, sizeof(TNGRecordHeader)+R.Size); F^.Seek(L);
OK:=(F^.Status=stOK);
end;
end;
if OK=false then
begin
Done;
@ -279,22 +228,10 @@ begin
ReadHeader:=OK;
end;
function KillSpecChars(const S: string): string;
var I: sw_integer;
RS: string;
begin
RS:='';
for I:=1 to length(S) do
if S[I]>=#32 then
RS:=RS+S[I];
KillSpecChars:=RS;
end;
function TNGHelpFile.ReadContainer(EnumProc: pointer): boolean;
var OK: boolean;
R: TRecord;
I,L: longint;
CI: TNGContainerItem;
I: longint;
P: pointer;
CIR: TContainerItemRec;
begin
@ -322,23 +259,45 @@ begin
ReadContainer:=OK;
end;
function TNGHelpFile.ReadTopicRec(Lines: PUnsortedStringCollection): boolean;
function TNGHelpFile.ReadTopicRec(LineEnumProc, LinkEnumProc: pointer): boolean;
var OK: boolean;
R: TRecord;
I: sw_integer;
LineP: pointer;
S: string;
ParamS: string;
NextLinkOfsPtr,NextLinkNamePtr: pointer;
SeeAlso: PNGSeeAlsoRec;
LR: TLinkRec;
begin
OK:=ReadRecord(R, true);
if OK then
with TNGTopicRecord(R.Data^) do
begin
LineP:=@TopicLines;
if Assigned(LineEnumProc) then
for I:=1 to NumberOfLines do
begin
S:=StrPas(LineP);
Lines^.InsertStr(NGDecompressStr(S));
LineP:=pointer(longint(LineP)+length(S)+1);
ParamS:=NGDecompressStr(S);
CallPointerLocal(LineEnumProc,PreviousFramePointer,@ParamS);
Inc(longint(LineP),length(S)+1);
end;
if Assigned(LinkEnumProc) and (SeeAlsoOfs>0) then
begin
SeeAlso:=@PByteArray(R.Data)^[NGMinRecordSize-sizeof(TNGRecordHeader)+SeeAlsoOfs];
NextLinkOfsPtr:=@SeeAlso^.Entries;
NextLinkNamePtr:=@PByteArray(NextLinkOfsPtr)^[SeeAlso^.EntryCount*4];
for I:=1 to SeeAlso^.EntryCount do
begin
FillChar(LR,sizeof(LR),0);
S:=StrPas(NextLinkNamePtr);
LR.Name:=S;
Move(NextLinkOfsPtr^,LR.FilePos,4);
CallPointerLocal(LinkEnumProc,PreviousFramePointer,@LR);
Inc(longint(NextLinkNamePtr),length(S)+1);
Inc(longint(NextLinkOfsPtr),4);
end;
end;
end;
DisposeRecord(R);
@ -374,20 +333,142 @@ begin
end;
function TNGHelpFile.LoadIndex: boolean;
{function FormatAlias(Alias: string): string;
var StartP,EndP: sw_integer;
begin
LoadIndex:=false;
repeat
StartP:=Pos(' ',Alias);
if StartP>0 then
begin
EndP:=StartP;
while (EndP+1<=length(Alias)) and (Alias[EndP+1]=' ') do Inc(EndP);
Alias:=copy(Alias,1,StartP-1)+' | '+copy(Alias,EndP+1,High(Alias));
end;
until StartP=0;
if Assigned(HelpFacility) then
if length(Alias)>HelpFacility^.IndexTabSize-4 then
Alias:=Trim(copy(Alias,1,HelpFacility^.IndexTabSize-4-2))+'..';
FormatAlias:=Alias;
end;}
procedure AddToIndex(P: PContainerItemRec); {$ifndef FPC}far;{$endif}
var S: string;
begin
S:=Trim(P^.Name);
S:=TranslateStr(S);
S:=Trim({FormatAlias}(S));
if (S<>'') and (P^.FilePos<>-1) then
begin
{ Inc(NextHelpCtx);}
AddIndexEntry(S,P^.FilePos);
AddTopic(P^.FilePos,P^.FilePos,'');
end;
end;
var OK: boolean;
FS: longint;
R: TRecord;
L: longint;
begin
if IndexLoaded then OK:=true else
begin
FS:=F^.GetSize;
OK:=FirstRecordPos<>0;
while OK do
begin
L:=F^.GetPos;
if (L>=FS) then Break;
OK:=ReadRecord(R,false);
if (OK=false) then Break;
case R.SClass of
ng_rtContainer : begin F^.Seek(L); OK:=ReadContainer(@AddToIndex); end;
ng_rtTopic : ;
else
begin
{$ifdef DEBUGMSG}
ClearFormatParams;
AddFormatParamInt(R.SClass);
AddFormatParamInt(L);
AddFormatParamInt(R.Size);
ErrorBox('Uknown help record tag %x encountered, '+
'offset %x, size %d',@FormatParams);
{$else}
{Skip};
{$endif}
end;
end;
if OK then
begin
Inc(L, sizeof(TNGRecordHeader)+R.Size); F^.Seek(L);
OK:=(F^.Status=stOK);
end;
end;
IndexLoaded:=OK;
end;
LoadIndex:=OK;
end;
function TNGHelpFile.ReadTopic(T: PTopic): boolean;
function ExtractStr(var Buf; BufSize: word): string;
var S: string;
I,Size: integer;
StartP,EndP: sw_integer;
begin
S:='';
Size:=BufSize;
while (PByteArray(@Buf)^[Size-1]=0) and (Size>0) do
Dec(Size);
S:=MemToStr(Buf,Size);
S:=NGDecompressStr(S);
for I:=1 to length(S) do
if S[I]=#0 then S[I]:=#32;
{ kill long spaces }
repeat
StartP:=Pos(' ',S);
if StartP>0 then
begin
EndP:=StartP;
while (EndP+1<=length(S)) and (S[EndP+1]=' ') do Inc(EndP);
S:=copy(S,1,StartP-1)+hscLineBreak+copy(S,EndP+1,High(S));
end;
until StartP=0;
S:=Trim(S);
ExtractStr:=S;
end;
var Lines: PUnsortedStringCollection;
procedure AddLine(const S: string);
begin
Lines^.InsertStr(S);
end;
procedure AddToTopic(P: PContainerItemRec); {$ifndef FPC}far;{$endif}
begin
Lines^.InsertStr(hscLink+P^.Name+hscLink);
AddLine(hscLink+Trim(P^.Name)+hscLink);
AddLinkToTopic(T,ID,P^.FilePos);
end;
procedure AddTopicLine(P: PString); {$ifndef FPC}far;{$endif}
begin
AddLine(' '+GetStr(P));
end;
var LinkCount: sw_integer;
procedure AddLink(P: PLinkRec); {$ifndef FPC}far;{$endif}
begin
Inc(LinkCount);
if LinkCount=1 then
begin
AddLine('');
AddLine(' See also :');
end;
AddLine(' '+hscLink+Trim(P^.Name)+hscLink);
AddLinkToTopic(T,ID,P^.FilePos);
end;
var OK: boolean;
R: TRecord;
begin
LinkCount:=0;
New(Lines, Init(100,100));
F^.Seek(T^.FileOfs); OK:=F^.Status=stOK;
if OK then OK:=ReadRecord(R,false);
@ -395,17 +476,21 @@ begin
ng_rtContainer :
begin
F^.Seek(T^.FileOfs);
Lines^.InsertStr(' ');
AddLine('');
OK:=ReadContainer(@AddToTopic);
RenderTopic(Lines,T);
end;
ng_rtTopic :
begin
F^.Seek(T^.FileOfs);
Lines^.InsertStr(' ');
OK:=ReadTopicRec(Lines);
AddLine('');
OK:=ReadTopicRec(@AddTopicLine,@AddLink);
TranslateLines(Lines);
Lines^.InsertStr(' ');
AddLine('');
{ include copyright info }
{ AddLine(CharStr('Ä',80));
AddLine(ExtractStr(Header.GuideName,sizeof(Header.GuideName)));
AddLine(ExtractStr(Header.Credits,sizeof(Header.Credits)));}
RenderTopic(Lines,T);
end;
else OK:=false;
@ -423,7 +508,10 @@ end;
END.
{
$Log$
Revision 1.1 2000-06-22 09:07:15 pierre
Revision 1.2 2000-06-26 07:29:23 pierre
* new bunch of Gabor's changes
Revision 1.1 2000/06/22 09:07:15 pierre
* Gabor changes: see fixes.txt
}

67
ide/text/wutils.pas
View File

@ -66,12 +66,27 @@ type
S : PStream;
end;
PFastBufStream = ^TFastBufStream;
TFastBufStream = object(TBufStream)
procedure Seek(Pos: Longint); virtual;
private
BasePos: longint;
end;
PTextCollection = ^TTextCollection;
TTextCollection = object(TStringCollection)
function LookUp(const S: string; var Idx: sw_integer): string;
function Compare(Key1, Key2: Pointer): sw_Integer; virtual;
end;
PIntCollection = ^TIntCollection;
TIntCollection = object(TSortedCollection)
function Compare(Key1, Key2: Pointer): sw_Integer; virtual;
procedure FreeItem(Item: Pointer); virtual;
procedure Add(Item: longint);
function Contains(Item: longint): boolean;
end;
{$ifdef TPUNIXLF}
procedure readln(var t:text;var s:string);
{$endif}
@ -609,6 +624,33 @@ begin
S.WriteStr(Item);
end;
function TIntCollection.Contains(Item: longint): boolean;
var Index: sw_integer;
begin
Contains:=Search(pointer(Item),Index);
end;
procedure TIntCollection.Add(Item: longint);
begin
Insert(pointer(Item));
end;
function TIntCollection.Compare(Key1, Key2: Pointer): sw_Integer;
var K1: longint absolute Key1;
K2: longint absolute Key2;
R: integer;
begin
if K1<K2 then R:=-1 else
if K1>K2 then R:= 1 else
R:=0;
Compare:=R;
end;
procedure TIntCollection.FreeItem(Item: Pointer);
begin
{ do nothing here }
end;
constructor TNulStream.Init;
begin
inherited Init;
@ -684,6 +726,26 @@ begin
S^.Write(Buf,Count);
end;
procedure TFastBufStream.Seek(Pos: Longint);
function BufStartPos: longint;
begin
BufStartPos:=Position-BufPtr;
end;
var RelOfs: longint;
begin
RelOfs:=Pos-{BufStartPos}BasePos;
if (RelOfs<0) or (RelOfs>=BufEnd) or (BufEnd=0) then
begin
inherited Seek(Pos);
BasePos:=Pos;
end
else
begin
BufPtr:=RelOfs;
Position:=Pos;
end;
end;
function TTextCollection.Compare(Key1, Key2: Pointer): Sw_Integer;
var K1: PString absolute Key1;
K2: PString absolute Key2;
@ -972,7 +1034,10 @@ end;
END.
{
$Log$
Revision 1.25 2000-06-22 09:07:15 pierre
Revision 1.26 2000-06-26 07:29:23 pierre
* new bunch of Gabor's changes
Revision 1.25 2000/06/22 09:07:15 pierre
* Gabor changes: see fixes.txt
Revision 1.24 2000/06/16 21:16:41 pierre

923
ide/text/wwinhelp.pas Normal file
View File

@ -0,0 +1,923 @@
{
$Id$
This file is part of the Free Pascal Integrated Development Environment
Copyright (c) 2000 by Berczi Gabor
Help support for Windows Help (.HLP) files
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************}
{$R-}
unit WWinHelp;
interface
uses Objects,
WUtils,WHelp;
const
WinHelpMagicNo = $00035F3F;
WinHelpBTreeHeaderMagicNo = $293B;
WinHelpSystemHeaderMagicNo = $036c;
{ WinHelp Btree dataformat descriptors }
wh_bdf_Long = 'L';
wh_bdf_ASCIIZ = 'F';
wh_bdf_ASCIIZ2 = 'i';
wh_bdf_Short = '2';
wh_bdf_Long2 = '4';
wh_bdf_ASCIIZ3 = 'z';
{ WinHelp system record type }
wh_srt_Title = 1;
wh_srt_Copyright = 2;
wh_srt_Contents = 3;
wh_srt_Config = 4;
wh_srt_Icon = 5;
wh_srt_Window = 6;
wh_srt_Citation = 8;
wh_srt_LangID = 9;
wh_srt_Content = 10;
wh_srt_DefFont = 11;
wh_srt_FtIndex = 12;
wh_srt_Groups = 13;
wh_srt_KeyIndex = 14;
wh_srt_Language = 18;
wh_srt_DLLMaps = 19;
type
PInteger = ^integer;
TWinHelpHeader = packed record
MagicNo : longint;
DirectoryStart : longint;
NonDirectoryStart: longint;
EntireFileSize : longint;
end;
TWinHelpFileEntryHeader = packed record
ReservedSpace : longint;
UsedSpace : longint;
FileFlags : byte;
end;
TWinHelpRecordHeader = packed record
RecordType : word;
DataSize : word;
end;
TWinHelpBTreeHeader = packed record
Magic : word;
Flags : word; { 0x0002 always set, 0x0400 set if directory }
PageSize : word;
DataFormat : array[1..16] of char;
MustBeZero : word; { $0000 }
PageSplits : word;
RootPage : word;
MustBeNegOne : integer; { $ffff }
TotalPages : word;
NumLevels : word;
TotalEntries : word;
Pages : record end;
end;
TWinHelpBTreeIndexHeader = packed record
Unknown : longint;
NumEntries : word; { no of index-entries }
PrevPage : integer;
end;
{
TWinHelpBTreeIndexEntry = packed record
FileName : STRINGZ;
PageNumber : word;
end;
}
TWinHelpBTreeNodeHeader = packed record
Unknown : longint;
NumEntries : word; { no of index-entries }
PrevPage : integer;
NextPage : integer;
end;
TWinHelpSystemHeader = packed record
Magic : word;
Version : word;
Always1 : word;
GenDate : longint;
Flags : word;
end;
TWinHelpTopicBlockHeader = packed record
LastTopicLink : longint;
FirstTopicLink : longint;
LastTopicHeader : longint;
end;
TWinHelpTopicBlock = packed record
Header : TWinHelpTopicBlockHeader;
Data : record end;
end;
TTopicBlock = record
Header : TWinHelpTopicBlockHeader;
DataSize : longint;
DataPtr : pointer;
end;
PWinHelpFile = ^TWinHelpFile;
TWinHelpFile = object(THelpFile)
constructor Init(AFileName: string; AID: word);
destructor Done; virtual;
public
function LoadIndex: boolean; virtual;
function ReadTopic(T: PTopic): boolean; virtual;
private
F: PStream;
Header: TWinHelpHeader;
SysHeader: TWinHelpSystemHeader;
Title: string;
CNTFileName: string;
PhrasesStart: longint;
TTLBTreeStart: longint;
TopicFileStart: longint;
Phrases: PUnsortedStringCollection;
TreeDone: boolean;
IndexLoaded: boolean;
function ReadHeader: boolean;
function ReadInternalDirectory: boolean;
function ProcessLeafPage(PagesBase: longint; PageSize,PageNo,TotalPages: word;
ReadLeafEntryMethod: pointer; ScannedPages: PIntCollection): boolean;
function ProcessIndexPage(CurLevel,MaxLevel: integer; PagesBase: longint; PageSize: word; PageNo,
TotalPages: word; ReadIndexEntryMethod, ReadLeafEntryMethod: pointer;
ScannedPages: PIntCollection): boolean;
function ProcessTree(ReadIndexEntryMethod, ReadLeafEntryMethod: pointer; NoDuplicates: boolean): boolean;
function IDIRReadIndexEntry(SubPageNo: PInteger): boolean;
function IDIRReadLeafEntry(P: pointer): boolean;
function IDIRProcessFile(const FileName: string; FileOfs: longint): boolean;
function TTLBReadIndexEntry(SubPageNo: PInteger): boolean;
function TTLBReadLeafEntry(P: pointer): boolean;
function TTLBProcessTopicEntry(const TopicTitle: string; FileOfs: longint): boolean;
function ReadSystemFile: boolean;
function ReadPhraseFile: boolean;
function ReadTTLBTree: boolean;
function TopicBlockSize: word;
function LZ77Compressed: boolean;
procedure ExtractTopicOffset(TopicOffset: longint; var TopicBlockNo, TopicBlockOffset: word);
function ReadTopicBlock(BlockNo: word; var T: TTopicBlock; ReadData: boolean): boolean;
end;
implementation
uses Crt,CallSpec;
function ReadString(F: PStream): string;
var S: string;
C: char;
begin
S:='';
if Assigned(F) then
repeat
F^.Read(C,sizeof(C));
if (F^.Status=stOK) and (C<>#0) then
S:=S+C;
until (C=#0) or (F^.Status<>stOK);
ReadString:=S;
end;
constructor TWinHelpFile.Init(AFileName: string; AID: word);
var OK: boolean;
begin
if inherited Init(AID)=false then Fail;
New(Phrases, Init(1000,1000));
F:=New(PFastBufStream, Init(AFileName, stOpenRead, HelpStreamBufSize));
OK:=F<>nil;
if OK then OK:=(F^.Status=stOK);
if OK then
begin
OK:=ReadHeader;
end;
if OK=false then
begin
Done;
Fail;
end;
end;
function TWinHelpFile.ReadHeader: boolean;
var OK: boolean;
begin
F^.Read(Header,sizeof(Header));
OK:=(F^.Status=stOK);
OK:=OK and (Header.MagicNo=WinHelpMagicNo);
if OK then
begin
F^.Seek(Header.DirectoryStart);
OK:=(F^.Status=stOK);
end;
if OK then
OK:=ReadInternalDirectory;
ReadHeader:=OK;
end;
function TWinHelpFile.TopicBlockSize: word;
var Size: word;
begin
if (SysHeader.Version<=16) then
Size:=2048 else
if (SysHeader.Flags in[0,4]) then
Size:=4096
else
Size:=2048;
TopicBlockSize:=Size;
end;
function TWinHelpFile.LZ77Compressed: boolean;
begin
LZ77Compressed:=(SysHeader.Version>16) and (SysHeader.Flags<>0);
end;
function TWinHelpFile.ReadSystemFile: boolean;
var OK: boolean;
FH: TWinHelpFileEntryHeader;
RH: TWinHelpRecordHeader;
StartOfs,RecStartOfs: longint;
begin
F^.Read(FH,sizeof(FH));
OK:=(F^.Status=stOK);
StartOfs:=F^.GetPos;
F^.Read(SysHeader,sizeof(SysHeader));
OK:=OK and (F^.Status=stOK);
OK:=OK and (SysHeader.Magic=WinHelpSystemHeaderMagicNo);
if OK then
if SysHeader.Version>16 then
begin
repeat
F^.Read(RH,sizeof(RH));
OK:=(F^.Status=stOK);
RecStartOfs:=F^.GetPos;
if OK then
begin
case RH.RecordType of
wh_srt_Title : Title:=ReadString(F);
wh_srt_Content : CNTFileName:=ReadString(F);
end;
if F^.GetPos<>RecStartOfs+RH.DataSize then
F^.Seek(RecStartOfs+RH.DataSize);
OK:=(F^.Status=stOK);
end;
until (OK=false) or (F^.GetPos>=StartOfs+FH.UsedSpace);
end
else
Title:=ReadString(F);
OK:=OK and (F^.Status=stOK);
ReadSystemFile:=OK;
end;
function LZ77Decompress(SrcBufP: pointer; SrcSize: longint; DestBufP: pointer; DestSize: longint): longint;
var SrcBuf: PByteArray absolute SrcBufP;
DestBuf: PByteArray absolute DestBufP;
var SrcOfs: longint;
function GetByte: byte;
begin
GetByte:=PByteArray(SrcBuf)^[SrcOfs];
Inc(SrcOfs);
end;
var DestOfs: longint;
procedure PutByte(B: byte);
begin
PByteArray(DestBuf)^[DestOfs]:=B;
Inc(DestOfs);
end;
var B,Mask: byte;
Len,J: word;
I: integer;
const N = 4096; F=16;
begin
SrcOfs:=0; DestOfs:=0; I:=N-F;
while (SrcOfs<SrcSize) do
begin
B:=GetByte;
for Mask:=0 to 7 do
begin
if SrcOfs=SrcSize then Break;
if (B and (1 shl Mask))<>0 then
begin
J:=GetByte;
Len:=GetByte;
J:=J+(Len and $0f) shl 8;
Len:=(Len and $f0) shr 4+3;
while (Len>0) do
begin
PutByte(PByteArray(DestBuf)^[DestOfs-J-1]);
{Inc(J); }Inc(I);
Dec(Len);
end;
end
else
begin
PutByte(GetByte);
I:=(I+1) and (N-1);
end;
end;
end;
LZ77Decompress:=DestOfs;
end;
function TWinHelpFile.ReadPhraseFile: boolean;
var OK: boolean;
FH: TWinHelpFileEntryHeader;
NumPhrases: word;
DecompSize: longint;
W: word;
PhraseOfss: PWordArray;
PhraseOfssSize: word;
PhraseBuf: PByteArray;
TempBuf: pointer;
TempSize: longint;
I,PhraseBufSize,PhraseOfs,PhraseSize: longint;
S: string;
begin
F^.Read(FH,sizeof(FH));
OK:=(F^.Status=stOK);
F^.Read(NumPhrases,sizeof(NumPhrases));
F^.Read(W,sizeof(W));
OK:=(F^.Status=stOK) and (W=$0100);
if OK then
begin
PhraseOfssSize:=(NumPhrases+1)*sizeof(word);
GetMem(PhraseOfss,PhraseOfssSize);
F^.Read(W,sizeof(W));
if W=2*(NumPhrases+1) then
begin
{ uncompressed data }
PhraseOfss^[0]:=W;
F^.Read(PhraseOfss^[1],PhraseOfssSize-sizeof(word)*1);
DecompSize:=FH.UsedSpace-(PhraseOfssSize+2+2+2);
PhraseBufSize:=DecompSize;
GetMem(PhraseBuf,PhraseBufSize);
F^.Read(PhraseBuf^,DecompSize);
end
else
begin
DecompSize:=W;
F^.Read(W,sizeof(W));
DecompSize:=DecompSize+longint(W) shl 16;
Inc(DecompSize);
PhraseOfss^[0]:=DecompSize;
F^.Read(PhraseOfss^[1],PhraseOfssSize);
PhraseBufSize:=DecompSize+10;
GetMem(PhraseBuf,PhraseBufSize); FillChar(PhraseBuf^,DecompSize,0);
TempSize:=FH.UsedSpace-(PhraseOfssSize+2+2+2);
GetMem(TempBuf,TempSize);
F^.Read(TempBuf^,TempSize);
LZ77Decompress(TempBuf,TempSize,PhraseBuf,DecompSize);
FreeMem(TempBuf,TempSize);
end;
for I:=1 to NumPhrases do
begin
PhraseOfs:=PhraseOfss^[I]-PhraseOfss^[1];
if I=NumPhrases then
PhraseSize:=DecompSize-PhraseOfs
else
PhraseSize:=PhraseOfss^[I+1]-PhraseOfss^[I];
S:=MemToStr(PhraseBuf^[PhraseOfs],PhraseSize);
Phrases^.InsertStr(S);
end;
FreeMem(PhraseOfss,PhraseOfssSize);
FreeMem(PhraseBuf,PhraseBufSize);
end;
ReadPhraseFile:=OK;
end;
function TWinHelpFile.ProcessLeafPage(PagesBase: longint; PageSize,PageNo,TotalPages: word;
ReadLeafEntryMethod: pointer; ScannedPages: PIntCollection): boolean;
var OK: boolean;
BNH: TWinHelpBTreeNodeHeader;
Count: longint;
PageOfs: longint;
CurPage: longint;
begin
CurPage:=PageNo;
repeat
PageOfs:=PagesBase+longint(PageSize)*CurPage;
F^.Seek(PageOfs);
OK:=(F^.Status=stOK);
if OK then
begin
F^.Read(BNH,sizeof(BNH));
OK:=(F^.Status=stOK);
end;
if OK then
if (ScannedPages<>nil) and ScannedPages^.Contains(CurPage) then
Break
else
begin
if Assigned(ScannedPages) then ScannedPages^.Add(CurPage);
Count:=0;
repeat
TreeDone:=not (longint(CallPointerMethod(ReadLeafEntryMethod,@Self,nil))<>0);
Inc(Count);
until (OK=false) or (F^.Status<>stOK) or TreeDone or (Count>=BNH.NumEntries){ or
(F^.GetPos>=PageOfs+PageSize-BNH.NumEntries)};
end;
if (BNH.PrevPage<>-1) and (TreeDone=false) then
CurPage:=BNH.PrevPage;
until (OK=false) or TreeDone or (BNH.PrevPage=-1);
ProcessLeafPage:=OK;
end;
function TWinHelpFile.ProcessIndexPage(CurLevel,MaxLevel: integer; PagesBase: longint; PageSize: word; PageNo,
TotalPages: word; ReadIndexEntryMethod, ReadLeafEntryMethod: pointer; ScannedPages: PIntCollection): boolean;
var BIH: TWinHelpBTreeIndexHeader;
I: integer;
SubPageNo: integer;
OK: boolean;
OldPos: longint;
CurPage: longint;
begin
CurPage:=PageNo;
repeat
F^.Seek(PagesBase+longint(PageSize)*CurPage);
OK:=(F^.Status=stOK);
if OK then
begin
F^.Read(BIH,sizeof(BIH));
OK:=(F^.Status=stOK);
end;
if OK then
if (ScannedPages<>nil) and ScannedPages^.Contains(CurPage) then
Break
else
begin
if Assigned(ScannedPages) then ScannedPages^.Add(CurPage);
for I:=1 to BIH.NumEntries do
begin
SubPageNo:=-1;
OK:=(longint(CallPointerMethod(ReadIndexEntryMethod,@Self,@SubPageNo))<>0);
OK:=OK and (F^.Status=stOK);
if OK then
if CurLevel<MaxLevel-1 then
begin
if (0<=SubPageNo) then
if (ScannedPages=nil) or (ScannedPages^.Contains(SubPageNo)=false) then
begin
OldPos:=F^.GetPos;
OK:=ProcessIndexPage(CurLevel+1,MaxLevel,PagesBase,PageSize,SubPageNo,TotalPages,
ReadIndexEntryMethod,ReadLeafEntryMethod,ScannedPages);
if F^.GetPos<>OldPos then
F^.Seek(OldPos);
end
end
else
{ process leaf page }
if (0<=SubPageNo) then
if (ScannedPages=nil) or (ScannedPages^.Contains(SubPageNo)=false) then
begin
OldPos:=F^.GetPos;
OK:=ProcessLeafPage(PagesBase,PageSize,SubPageNo,TotalPages,ReadLeafEntryMethod,ScannedPages);
if F^.GetPos<>OldPos then
F^.Seek(OldPos);
end;
if TreeDone then
Break;
end;
end;
if (BIH.PrevPage>0) and (TreeDone=false) then
CurPage:=BIH.PrevPage
else
Break;
until (OK=false) or TreeDone;
ProcessIndexPage:=OK;
end;
function TWinHelpFile.ProcessTree(ReadIndexEntryMethod, ReadLeafEntryMethod: pointer; NoDuplicates: boolean): boolean;
var BTH: TWinHelpBTreeHeader;
OK: boolean;
PagesBase: longint;
ScannedPages: PIntCollection;
begin
ScannedPages:=nil;
TreeDone:=false;
F^.Read(BTH,sizeof(BTH));
OK:=(F^.Status=stOK);
PagesBase:=F^.GetPos;
if OK then
begin
OK:=(BTH.Magic=WinHelpBTreeHeaderMagicNo) and
(BTH.MustBeZero=0) and
(BTH.MustBeNegOne=-1);
end;
if OK then
begin
if NoDuplicates then
New(ScannedPages, Init(500,100));
if BTH.NumLevels>1 then
begin
OK:=ProcessIndexPage(1,BTH.NumLevels,PagesBase,BTH.PageSize,BTH.RootPage,BTH.TotalPages,
ReadIndexEntryMethod,ReadLeafEntryMethod,ScannedPages);
end
else
OK:=ProcessLeafPage(PagesBase,BTH.PageSize,BTH.RootPage,BTH.TotalPages,ReadLeafEntryMethod,ScannedPAges);
if Assigned(ScannedPages) then
Dispose(ScannedPages, Done);
end;
ProcessTree:=OK;
end;
(*function TWinHelpFile.IDIRProcessFile(const FileName: string; FileOfs: longint): boolean;
var OK: boolean;
begin
OK:=true;
if FileName='|SYSTEM' then
begin
F^.Seek(FileOfs); OK:=(F^.Status=stOK);
if OK then OK:=ReadSystemFile;
end else
if (FileName='|Phrases') then
begin
PhrasesStart:=FileOfs;
end else
;
IDIRProcessFile:=OK;
end;
function TWinHelpFile.IDIRProcessLeafPage(PagesBase: longint; PageSize,PageNo,TotalPages: word): boolean;
var OK: boolean;
BNH: TWinHelpBTreeNodeHeader;
FileOfs: longint;
Count: integer;
S: string;
CurOfs,PageOfs,OldPos: longint;
begin
PageOfs:=PagesBase+PageSize*PageNo;
F^.Seek(PageOfs);
OK:=(F^.Status=stOK);
repeat
if OK then
begin
F^.Read(BNH,sizeof(BNH));
OK:=(F^.Status=stOK);
end;
if OK then
begin
Count:=0;
repeat
S:=ReadString(F);
F^.Read(FileOfs,sizeof(FileOfs)); { longint }
OK:=OK and (F^.Status=stOK);
if OK then
begin
OldPos:=F^.GetPos;
OK:=IDIRProcessFile(S,FileOfs);
if F^.GetPos<>OldPos then
F^.Seek(OldPos);
end;
Inc(Count);
until (OK=false) or (Count=BNH.NumEntries){ or (F^.GetPos>=PageOfs+PageSize-BNH.NumEntries)};
end;
if BNH.PrevPage<>-1 then
begin
F^.Seek(PagesBase+PageSize*BNH.PrevPage);
OK:=(F^.Status=stOK);
end;
until (OK=false) or (BNH.PrevPage=-1);
IDIRProcessLeafPage:=OK;
end;
function TWinHelpFile.IDIRProcessIndexPage(CurLevel,MaxLevel: integer; PagesBase: longint; PageSize: word; PageNo,
TotalPages: word): boolean;
var BIH: TWinHelpBTreeIndexHeader;
I: integer;
SubPageNo: integer;
OK: boolean;
S: string;
OldPos: longint;
begin
F^.Seek(PagesBase+PageSize*PageNo);
OK:=(F^.Status=stOK);
repeat
if OK then
begin
F^.Read(BIH,sizeof(BIH));
OK:=(F^.Status=stOK);
end;
if OK then
for I:=1 to BIH.NumEntries do
begin
S:=ReadString(F);
F^.Read(SubPageNo,sizeof(SubPageNo)); { word }
OK:=OK and (F^.Status=stOK);
if OK then
if CurLevel<MaxLevel-1 then
begin
if (0<=SubPageNo) then
begin
OldPos:=F^.GetPos;
OK:=IDIRProcessIndexPage(CurLevel+1,MaxLevel,PagesBase,PageSize,SubPageNo,TotalPages);
if F^.GetPos<>OldPos then
F^.Seek(OldPos);
end
end
else
{ process leaf page }
if (0<=SubPageNo) then
OK:=IDIRProcessLeafPage(PagesBase,PageSize,SubPageNo,TotalPages);
end;
if (BIH.PrevPage>0) then
begin
F^.Seek(PagesBase+PageSize*BIH.PrevPage);
OK:=(F^.Status=stOK);
end
else
Break;
until (OK=false);
IDIRProcessIndexPage:=OK;
end;
function TWinHelpFile.ReadInternalDirectory: boolean;
var BTH: TWinHelpBTreeHeader;
OK: boolean;
PagesBase: longint;
begin
F^.Read(BTH,sizeof(BTH));
OK:=(F^.Status=stOK);
PagesBase:=F^.GetPos;
if OK then
begin
OK:=(BTH.Magic=WinHelpBTreeHeaderMagicNo) and
(BTH.MustBeZero=0) and
(BTH.MustBeNegOne=-1);
end;
if BTH.NumLevels>1 then
OK:=IDIRProcessIndexPage(1,BTH.NumLevels,PagesBase,BTH.PageSize,BTH.RootPage,BTH.TotalPages)
else
OK:=IDIRProcessLeafPage(PagesBase,BTH.PageSize,BTH.RootPage,BTH.TotalPages);
ReadInternalDirectory:=OK;
end;
*)
function TWinHelpFile.IDIRProcessFile(const FileName: string; FileOfs: longint): boolean;
var OK: boolean;
begin
OK:=true;
if FileName='|SYSTEM' then
begin
F^.Seek(FileOfs); OK:=(F^.Status=stOK);
if OK then OK:=ReadSystemFile;
end else
if (FileName='|Phrases') then
begin
PhrasesStart:=FileOfs;
end else
;
if (FileName='|TOPIC') then
begin
TopicFileStart:=FileOfs;
end else
;
if (FileName='|TTLBTREE') then
begin
TTLBTreeStart:=FileOfs;
end else
;
IDIRProcessFile:=OK;
end;
function TWinHelpFile.IDIRReadIndexEntry(SubPageNo: PInteger): boolean;
var {S: string;}
OK: boolean;
begin
{S:=}ReadString(F);
F^.Read(SubPageNo^,sizeof(SubPageNo^));
OK:=(F^.Status=stOK);
IDIRReadIndexEntry:=OK;
end;
function TWinHelpFile.IDIRReadLeafEntry(P: pointer): boolean;
var OK: boolean;
S: string;
FileOfs,OldPos: longint;
begin
S:=ReadString(F);
F^.Read(FileOfs,sizeof(FileOfs)); { longint }
OK:=(F^.Status=stOK);
if OK then
begin
OldPos:=F^.GetPos;
OK:=IDIRProcessFile(S,FileOfs);
if F^.GetPos<>OldPos then
F^.Seek(OldPos);
OK:=OK and (F^.Status=stOK);
end;
IDIRReadLeafEntry:=OK;
end;
function TWinHelpFile.ReadInternalDirectory: boolean;
var OK: boolean;
FH: TWinHelpFileEntryHeader;
begin
F^.Read(FH,sizeof(FH));
OK:=(F^.Status=stOK);
if OK then
OK:=ProcessTree(@TWinHelpFile.IDIRReadIndexEntry,@TWinHelpFile.IDIRReadLeafEntry,true);
ReadInternalDirectory:=OK;
end;
function TWinHelpFile.TTLBReadIndexEntry(SubPageNo: PInteger): boolean;
var TopicOffset: longint;
OK: boolean;
begin
F^.Read(TopicOffset,sizeof(TopicOffset));
F^.Read(SubPageNo^,sizeof(SubPageNo^));
OK:=(F^.Status=stOK);
TTLBReadIndexEntry:=OK;
end;
function TWinHelpFile.TTLBReadLeafEntry(P: pointer): boolean;
var OK: boolean;
S: string;
TopicOfs,OldPos: longint;
begin
F^.Read(TopicOfs,sizeof(TopicOfs)); { longint }
S:=ReadString(F);
OK:=(F^.Status=stOK);
if OK then
begin
OldPos:=F^.GetPos;
OK:=TTLBProcessTopicEntry(S,TopicOfs);
if F^.GetPos<>OldPos then
F^.Seek(OldPos);
OK:=OK and (F^.Status=stOK);
end;
TTLBReadLeafEntry:=OK;
end;
function TWinHelpFile.TTLBProcessTopicEntry(const TopicTitle: string; FileOfs: longint): boolean;
var OK: boolean;
const Count: longint = 0;
begin
Inc(Count);
if (Count mod 100)=1 then
begin
gotoxy(1,1); write(Count,' - ',IndexEntries^.Count,' - ',Topics^.Count);
end;
OK:=(IndexEntries^.Count<MaxCollectionSize-10);
if OK then
begin
if (TopicTitle<>'') and (FileOfs>=0) then
begin
AddIndexEntry(TopicTitle,FileOfs);
AddTopic(FileOfs,FileOfs,'');
end;
end;
TTLBProcessTopicEntry:=OK;
end;
function TWinHelpFile.ReadTTLBTree: boolean;
var OK: boolean;
FH: TWinHelpFileEntryHeader;
begin
F^.Read(FH,sizeof(FH));
OK:=(F^.Status=stOK);
if OK then
OK:=ProcessTree(@TWinHelpFile.TTLBReadIndexEntry,@TWinHelpFile.TTLBReadLeafEntry,true);
ReadTTLBTree:=OK;
end;
function TWinHelpFile.LoadIndex: boolean;
var OK: boolean;
begin
if IndexLoaded then OK:=true else
begin
if PhrasesStart<>0 then
begin
F^.Seek(PhrasesStart); OK:=(F^.Status=stOK);
if OK then OK:=ReadPhraseFile;
end;
if TTLBTreeStart<>0 then
begin
F^.Seek(TTLBTreeStart); OK:=(F^.Status=stOK);
if OK then OK:=ReadTTLBTree;
end;
IndexLoaded:=OK;
end;
LoadIndex:=OK;
end;
procedure TWinHelpFile.ExtractTopicOffset(TopicOffset: longint; var TopicBlockNo, TopicBlockOffset: word);
var {OfsBitCount: longint;
OfsMask: longint;}
BS: longint;
begin
if LZ77Compressed then
BS:=16384
else
BS:=TopicBlockSize;
{ for OfsBitCount:=0 to 31 do
if (1 shl OfsBitCount)=BS then
Break;
OfsMask:=(1 shl OfsBitCount)-1;
TopicBlockNo:=(TopicOffset and not OfsMask) shr OfsBitCount;
TopicBlockOffset:=(TopicOffset and OfsMask);}
TopicBlockNo:=TopicOffset div BS;
TopicBlockOffset:=TopicOffset mod BS;
end;
function TWinHelpFile.ReadTopicBlock(BlockNo: word; var T: TTopicBlock; ReadData: boolean): boolean;
var TempBuf: pointer;
BlockBuf: ^TWinHelpTopicBlock;
OK: boolean;
RS,DecompSize: longint;
const TempBufSize = 16384;
begin
FillChar(T,sizeof(T),0);
F^.Seek(TopicFileStart+sizeof(TWinHelpFileEntryHeader)+longint(BlockNo)*TopicBlockSize);
OK:=(F^.Status=stOK);
if OK then
if ReadData=false then
begin
F^.Read(T.Header,sizeof(T.Header));
OK:=(F^.Status=stOK);
end
else
begin
GetMem(BlockBuf, TopicBlockSize);
F^.Read(BlockBuf^,TopicBlockSize);
OK:=(F^.Status=stOK);
if OK then
begin
Move(BlockBuf^.Header,T.Header,sizeof(T.Header));
if LZ77Compressed then
begin
GetMem(TempBuf,TempBufSize);
DecompSize:=LZ77Decompress(@BlockBuf^.Data,TopicBlockSize-sizeof(BlockBuf^.Header),TempBuf,TempBufSize);
T.DataSize:=DecompSize;
GetMem(T.DataPtr,T.DataSize);
Move(TempBuf^,T.DataPtr^,T.DataSize);
FreeMem(TempBuf,TempBufSize);
end
else
begin
T.DataSize:=TopicBlockSize-sizeof(BlockBuf^.Header);
GetMem(T.DataPtr,T.DataSize);
Move(BlockBuf^.Data,T.DataPtr^,T.DataSize);
end;
end;
FreeMem(BlockBuf,TopicBlockSize);
end;
ReadTopicBlock:=OK;
end;
procedure FreeTopicBlock(T: TTopicBlock);
begin
if (T.DataSize>0) and (T.DataPtr<>nil) then
begin
FreeMem(T.DataPtr,T.DataSize);
T.DataPtr:=nil;
end;
end;
function TWinHelpFile.ReadTopic(T: PTopic): boolean;
var OK: boolean;
BlockNo,BlockOfs: word;
TB: TTopicBlock;
begin
OK:=(TopicFileStart<>0) and (T<>nil);
if OK then
begin
ExtractTopicOffset(T^.FileOfs,BlockNo,BlockOfs);
OK:=ReadTopicBlock(BlockNo,TB,true);
end;
if OK then
begin
FreeTopicBlock(TB);
end;
ReadTopic:=OK;
end;
destructor TWinHelpFile.Done;
begin
if Assigned(F) then Dispose(F, Done); F:=nil;
if Assigned(Phrases) then Dispose(Phrases, Done); Phrases:=nil;
inherited Done;
end;
END.
{
$Log$
Revision 1.1 2000-06-26 07:29:23 pierre
* new bunch of Gabor's changes
}