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

* Remove 64Kb limitation for FPC by Gabor

Browse Source
This commit is contained in:
pierre 2000-02-07 11:47:25 +00:00
parent e779ae43b4
commit 32004746f0
1 changed files with 37 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

55
ide/text/whelp.pas
View File

@ -133,14 +133,14 @@ type
TTopic = object TTopic = object
HelpCtx : THelpCtx; HelpCtx : THelpCtx;
FileOfs : longint; FileOfs : longint;
TextSize : word; TextSize : sw_word;
Text : PByteArray; Text : PByteArray;
LinkCount : word; LinkCount : sw_word;
Links : PKeywordDescriptors; Links : PKeywordDescriptors;
LastAccess : longint; LastAccess : longint;
FileID : word; FileID : word;
Param : PString; Param : PString;
function LinkSize: word; function LinkSize: sw_word;
end; end;
PTopicCollection = ^TTopicCollection; PTopicCollection = ^TTopicCollection;
@ -224,7 +224,7 @@ type
const TopicCacheSize : sw_integer = 10; const TopicCacheSize : sw_integer = 10;
HelpStreamBufSize : sw_integer = 4096; HelpStreamBufSize : sw_integer = 4096;
HelpFacility : PHelpFacility = nil; HelpFacility : PHelpFacility = nil;
MaxHelpTopicSize : sw_word = 65520; MaxHelpTopicSize : sw_word = MaxBytes;
function NewTopic(FileID: byte; HelpCtx: THelpCtx; Pos: longint; Param: string): PTopic; function NewTopic(FileID: byte; HelpCtx: THelpCtx; Pos: longint; Param: string): PTopic;
procedure DisposeTopic(P: PTopic); procedure DisposeTopic(P: PTopic);
@ -242,7 +242,7 @@ uses
{$ifdef Win32} {$ifdef Win32}
windows, windows,
{$endif Win32} {$endif Win32}
WUtils,WHTMLHlp; WUtils,WViews,WHTMLHlp;
Function GetDosTicks:longint; { returns ticks at 18.2 Hz, just like DOS } Function GetDosTicks:longint; { returns ticks at 18.2 Hz, just like DOS }
@ -332,7 +332,7 @@ begin
end; end;
end; end;
function TTopic.LinkSize: word; function TTopic.LinkSize: sw_word;
begin begin
LinkSize:=LinkCount*SizeOf(Links^[0]); LinkSize:=LinkCount*SizeOf(Links^[0]);
end; end;
@ -407,10 +407,11 @@ var T: PTopic;
begin begin
T:=SearchTopic(HelpCtx); T:=SearchTopic(HelpCtx);
if (T<>nil) then if (T<>nil) then
if T^.Text=nil then if T^.Text=nil then
begin begin
MaintainTopicCache; MaintainTopicCache;
if ReadTopic(T)=false then T:=nil; if ReadTopic(T)=false then
T:=nil;
if (T<>nil) and (T^.Text=nil) then T:=nil; if (T<>nil) and (T^.Text=nil) then T:=nil;
end; end;
if T<>nil then if T<>nil then
@ -562,8 +563,10 @@ var OK: boolean;
R: TRecord; R: TRecord;
I: longint; I: longint;
LastTag,S: string; LastTag,S: string;
CurPtr,HelpCtx: word; CurPtr: sw_word;
HelpCtx: THelpCtx;
LenCode,CopyCnt,AddLen: byte; LenCode,CopyCnt,AddLen: byte;
type pword = ^word;
begin begin
if IndexTableRead then OK:=true else if IndexTableRead then OK:=true else
begin begin
@ -579,7 +582,7 @@ begin
AddLen:=LenCode and $1f; CopyCnt:=LenCode shr 5; AddLen:=LenCode and $1f; CopyCnt:=LenCode shr 5;
S[0]:=chr(AddLen); Move(PByteArray(@Entries)^[CurPtr+1],S[1],AddLen); S[0]:=chr(AddLen); Move(PByteArray(@Entries)^[CurPtr+1],S[1],AddLen);
LastTag:=copy(LastTag,1,CopyCnt)+S; LastTag:=copy(LastTag,1,CopyCnt)+S;
Move(PByteArray(@Entries)^[CurPtr+1+AddLen],HelpCtx,2); HelpCtx:=PWord(@PByteArray(@Entries)^[CurPtr+1+AddLen])^;
IndexEntries^.Insert(NewIndexEntry(LastTag,ID,HelpCtx)); IndexEntries^.Insert(NewIndexEntry(LastTag,ID,HelpCtx));
Inc(CurPtr,1+AddLen+2); Inc(CurPtr,1+AddLen+2);
end; end;
@ -631,7 +634,7 @@ begin
end; end;
function TOAHelpFile.ReadTopic(T: PTopic): boolean; function TOAHelpFile.ReadTopic(T: PTopic): boolean;
var SrcPtr,DestPtr: word; var SrcPtr,DestPtr,TopicSize: sw_word;
NewR: TRecord; NewR: TRecord;
function ExtractTextRec(var R: TRecord): boolean; function ExtractTextRec(var R: TRecord): boolean;
function GetNextNibble: byte; function GetNextNibble: byte;
@ -644,7 +647,8 @@ begin
end; end;
procedure AddChar(C: char); procedure AddChar(C: char);
begin begin
PByteArray(NewR.Data)^[DestPtr]:=ord(C); if Assigned(NewR.Data) then
PByteArray(NewR.Data)^[DestPtr]:=ord(C);
Inc(DestPtr); Inc(DestPtr);
end; end;
var OK: boolean; var OK: boolean;
@ -677,8 +681,19 @@ begin
ctNone : ; ctNone : ;
ctNibble : ctNibble :
begin begin
NewR.SClass:=0;
NewR.Size:=0;
NewR.Data:=nil;
SrcPtr:=0; DestPtr:=0;
while SrcPtr<(R.Size*2) do
begin
C:=GetNextChar;
AddChar(C);
end;
TopicSize:=DestPtr;
NewR.SClass:=R.SClass; NewR.SClass:=R.SClass;
NewR.Size:=MaxHelpTopicSize; { R.Size*2 <- bug fixed, i didn't care of RLL codings } NewR.Size:=Min(MaxHelpTopicSize,TopicSize);
GetMem(NewR.Data, NewR.Size); GetMem(NewR.Data, NewR.Size);
SrcPtr:=0; DestPtr:=0; SrcPtr:=0; DestPtr:=0;
while SrcPtr<(R.Size*2) do while SrcPtr<(R.Size*2) do
@ -699,7 +714,7 @@ begin
end; end;
var OK: boolean; var OK: boolean;
TextR,KeyWR: TRecord; TextR,KeyWR: TRecord;
I: word; I: sw_word;
begin begin
OK:=T<>nil; OK:=T<>nil;
if OK and (T^.Text=nil) then if OK and (T^.Text=nil) then
@ -848,9 +863,10 @@ begin
Lines^.Insert(NewStr(S)); Lines^.Insert(NewStr(S));
end; end;
procedure RenderTopic; procedure RenderTopic;
var Size,CurPtr,I: word; var Size,CurPtr,I: sw_word;
S: string; S: string;
function CountSize(P: PString): boolean; {$ifndef FPC}far;{$endif} begin Inc(Size, length(P^)+1); CountSize:=Size>65200; end; function CountSize(P: PString): boolean; {$ifndef FPC}far;{$endif}
begin Inc(Size, length(P^)+1); CountSize:=Size>MaxHelpTopicSize-300; end;
begin begin
Size:=0; Lines^.FirstThat(@CountSize); Size:=0; Lines^.FirstThat(@CountSize);
T^.TextSize:=Size; GetMem(T^.Text,T^.TextSize); T^.TextSize:=Size; GetMem(T^.Text,T^.TextSize);
@ -917,7 +933,7 @@ begin
begin begin
KW:=Keywords^.At(I); KW:=Keywords^.At(I);
AddKeyword(KW^.Tag^); AddKeyword(KW^.Tag^);
T^.Links^[I].Context:=KW^.HelpCtx; T^.Links^[I].FileID:=KW^.FileID; T^.Links^[I].Context:=longint(KW^.HelpCtx); T^.Links^[I].FileID:=KW^.FileID;
end; end;
FlushLine; FlushLine;
AddLine(''); AddLine('');
@ -954,7 +970,10 @@ end;
END. END.
{ {
$Log$ $Log$
Revision 1.16 2000-01-03 14:59:03 marco Revision 1.17 2000-02-07 11:47:25 pierre
* Remove 64Kb limitation for FPC by Gabor
Revision 1.16 2000/01/03 14:59:03 marco
* Fixed Linux code that got time of day. Removed Timezone parameter * Fixed Linux code that got time of day. Removed Timezone parameter
Revision 1.15 1999/08/16 18:25:29 peter Revision 1.15 1999/08/16 18:25:29 peter