mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-10-21 21:21:39 +02:00
585 lines
14 KiB
ObjectPascal
585 lines
14 KiB
ObjectPascal
unit WHTMLHlp;
|
||
|
||
interface
|
||
|
||
uses Objects,WHTML,WHelp;
|
||
|
||
const
|
||
ListIndent = 2;
|
||
DefIndent = 4;
|
||
|
||
MaxTopicLinks = 100;
|
||
|
||
type
|
||
PTopicLinkCollection = ^TTopicLinkCollection;
|
||
TTopicLinkCollection = object(TStringCollection)
|
||
procedure Insert(Item: Pointer); virtual;
|
||
function At(Index: sw_Integer): PString;
|
||
function AddItem(Item: string): integer;
|
||
end;
|
||
|
||
TParagraphAlign = (paLeft,paCenter,paRight);
|
||
|
||
PHTMLTopicRenderer = ^THTMLTopicRenderer;
|
||
THTMLTopicRenderer = object(THTMLParser)
|
||
function BuildTopic(P: PTopic; HTMLFile: PTextFile; ATopicLinks: PTopicLinkCollection): boolean;
|
||
public
|
||
procedure DocAddTextChar(C: char); virtual;
|
||
procedure DocSoftBreak; virtual;
|
||
procedure DocTYPE; virtual;
|
||
procedure DocHTML(Entered: boolean); virtual;
|
||
procedure DocHEAD(Entered: boolean); virtual;
|
||
procedure DocMETA; virtual;
|
||
procedure DocTITLE(Entered: boolean); virtual;
|
||
procedure DocBODY(Entered: boolean); virtual;
|
||
procedure DocAnchor(Entered: boolean); virtual;
|
||
procedure DocHeading(Level: integer; Entered: boolean); virtual;
|
||
procedure DocParagraph(Entered: boolean); virtual;
|
||
procedure DocBreak; virtual;
|
||
procedure DocImage; virtual;
|
||
procedure DocBold(Entered: boolean); virtual;
|
||
procedure DocCite(Entered: boolean); virtual;
|
||
procedure DocCode(Entered: boolean); virtual;
|
||
procedure DocEmphasized(Entered: boolean); virtual;
|
||
procedure DocItalic(Entered: boolean); virtual;
|
||
procedure DocKbd(Entered: boolean); virtual;
|
||
procedure DocPreformatted(Entered: boolean); virtual;
|
||
procedure DocSample(Entered: boolean); virtual;
|
||
procedure DocStrong(Entered: boolean); virtual;
|
||
procedure DocTeleType(Entered: boolean); virtual;
|
||
procedure DocVariable(Entered: boolean); virtual;
|
||
procedure DocList(Entered: boolean); virtual;
|
||
procedure DocOrderedList(Entered: boolean); virtual;
|
||
procedure DocListItem; virtual;
|
||
procedure DocDefList(Entered: boolean); virtual;
|
||
procedure DocDefTerm; virtual;
|
||
procedure DocDefExp; virtual;
|
||
procedure DocHorizontalRuler; virtual;
|
||
private
|
||
Topic: PTopic;
|
||
TopicLinks: PTopicLinkCollection;
|
||
TextPtr: word;
|
||
InTitle: boolean;
|
||
InBody: boolean;
|
||
InAnchor: boolean;
|
||
InParagraph: boolean;
|
||
InPreformatted: boolean;
|
||
TopicTitle: string;
|
||
Indent: integer;
|
||
AnyCharsInLine: boolean;
|
||
CurHeadLevel: integer;
|
||
PAlign: TParagraphAlign;
|
||
LinkIndexes: array[0..MaxTopicLinks] of sw_integer;
|
||
LinkPtr: sw_integer;
|
||
{ Anchor: TAnchor;}
|
||
procedure AddText(S: string);
|
||
procedure AddChar(C: char);
|
||
end;
|
||
|
||
PHTMLHelpFile = ^THTMLHelpFile;
|
||
THTMLHelpFile = object(THelpFile)
|
||
constructor Init(AFileName: string; AID: word; ATOCEntry: string);
|
||
destructor Done; virtual;
|
||
public
|
||
function LoadIndex: boolean; virtual;
|
||
function SearchTopic(HelpCtx: THelpCtx): PTopic; virtual;
|
||
function ReadTopic(T: PTopic): boolean; virtual;
|
||
private
|
||
Renderer: PHTMLTopicRenderer;
|
||
FileName: string;
|
||
CurFileName: string;
|
||
TOCEntry: string;
|
||
TopicLinks: PTopicLinkCollection;
|
||
end;
|
||
|
||
implementation
|
||
|
||
uses Dos;
|
||
|
||
const
|
||
{$ifdef LINUX}
|
||
dirsep = '/';
|
||
{$else}
|
||
dirsep = '\';
|
||
{$endif}
|
||
|
||
function FormatPath(Path: string): string;
|
||
var P: sw_integer;
|
||
begin
|
||
repeat
|
||
if DirSep='/' then P:=Pos('\',Path)
|
||
else P:=Pos('/',Path);
|
||
if P>0 then Path[P]:=DirSep;
|
||
until P=0;
|
||
FormatPath:=Path;
|
||
end;
|
||
|
||
function UpcaseStr(S: string): string;
|
||
var I: integer;
|
||
begin
|
||
for I:=1 to length(S) do
|
||
S[I]:=Upcase(S[I]);
|
||
UpcaseStr:=S;
|
||
end;
|
||
|
||
function EncodeHTMLCtx(FileID: integer; LinkNo: word): longint;
|
||
var Ctx: longint;
|
||
begin
|
||
Ctx:=(longint(FileID) shl 16)+LinkNo;
|
||
EncodeHTMLCtx:=Ctx;
|
||
end;
|
||
|
||
procedure DecodeHTMLCtx(Ctx: longint; var FileID: word; var LinkNo: word);
|
||
begin
|
||
if (Ctx shr 16)=0 then
|
||
begin
|
||
FileID:=$ffff; LinkNo:=0;
|
||
end
|
||
else
|
||
begin
|
||
FileID:=Ctx shr 16; LinkNo:=Ctx and $ffff;
|
||
end;
|
||
end;
|
||
|
||
function CharStr(C: char; Count: byte): string;
|
||
var S: string;
|
||
begin
|
||
S[0]:=chr(Count);
|
||
if Count>0 then FillChar(S[1],Count,C);
|
||
CharStr:=S;
|
||
end;
|
||
|
||
procedure TTopicLinkCollection.Insert(Item: Pointer);
|
||
begin
|
||
AtInsert(Count,Item);
|
||
end;
|
||
|
||
function TTopicLinkCollection.At(Index: sw_Integer): PString;
|
||
begin
|
||
At:=inherited At(Index);
|
||
end;
|
||
|
||
function TTopicLinkCollection.AddItem(Item: string): integer;
|
||
var Idx: sw_integer;
|
||
begin
|
||
if Item='' then Idx:=-1 else
|
||
if Search(@Item,Idx)=false then
|
||
begin
|
||
AtInsert(Count,NewStr(Item));
|
||
Idx:=Count-1;
|
||
end;
|
||
AddItem:=Idx;
|
||
end;
|
||
|
||
procedure THTMLTopicRenderer.DocAddTextChar(C: char);
|
||
begin
|
||
if InTitle then TopicTitle:=TopicTitle+C else
|
||
if InBody then
|
||
begin
|
||
if (C<>#32) or (AnyCharsInLine=true) then AddChar(C);
|
||
end;
|
||
end;
|
||
|
||
procedure THTMLTopicRenderer.DocSoftBreak;
|
||
begin
|
||
if InPreformatted then DocBreak else
|
||
if AnyCharsInLine then AddChar(' ');
|
||
end;
|
||
|
||
procedure THTMLTopicRenderer.DocTYPE;
|
||
begin
|
||
end;
|
||
|
||
procedure THTMLTopicRenderer.DocHTML(Entered: boolean);
|
||
begin
|
||
end;
|
||
|
||
procedure THTMLTopicRenderer.DocHEAD(Entered: boolean);
|
||
begin
|
||
end;
|
||
|
||
procedure THTMLTopicRenderer.DocMETA;
|
||
begin
|
||
end;
|
||
|
||
procedure THTMLTopicRenderer.DocTITLE(Entered: boolean);
|
||
begin
|
||
if Entered then
|
||
begin
|
||
TopicTitle:='';
|
||
end
|
||
else
|
||
begin
|
||
{ render topic title here }
|
||
if TopicTitle<>'' then
|
||
begin
|
||
AddText(' '+TopicTitle+' <20>'); DocBreak;
|
||
AddText(' '+CharStr('<27>',length(TopicTitle)+3)); DocBreak;
|
||
end;
|
||
end;
|
||
InTitle:=Entered;
|
||
end;
|
||
|
||
procedure THTMLTopicRenderer.DocBODY(Entered: boolean);
|
||
begin
|
||
InBody:=Entered;
|
||
end;
|
||
|
||
procedure THTMLTopicRenderer.DocAnchor(Entered: boolean);
|
||
var HRef: string;
|
||
begin
|
||
if Entered and InAnchor then DocAnchor(false);
|
||
if Entered then
|
||
begin
|
||
if DocGetTagParam('HREF',HRef)=false then HRef:='';
|
||
if (HRef<>'') and (copy(HRef,1,1)<>'#') then
|
||
begin
|
||
InAnchor:=true;
|
||
AddChar(hscLink);
|
||
LinkIndexes[LinkPtr]:=TopicLinks^.AddItem(HRef);
|
||
Inc(LinkPtr);
|
||
end;
|
||
end
|
||
else
|
||
begin
|
||
if InAnchor=true then AddChar(hscLink);
|
||
InAnchor:=false;
|
||
end;
|
||
end;
|
||
|
||
procedure DecodeAlign(Align: string; var PAlign: TParagraphAlign);
|
||
begin
|
||
Align:=UpcaseStr(Align);
|
||
if Align='LEFT' then PAlign:=paLeft else
|
||
if Align='CENTER' then PAlign:=paCenter else
|
||
if Align='RIGHT' then PAlign:=paRight;
|
||
end;
|
||
|
||
procedure THTMLTopicRenderer.DocHeading(Level: integer; Entered: boolean);
|
||
var Align: string;
|
||
begin
|
||
if Entered then
|
||
begin
|
||
DocBreak;
|
||
CurHeadLevel:=Level;
|
||
PAlign:=paLeft;
|
||
if DocGetTagParam('ALIGN',Align) then
|
||
DecodeAlign(Align,PAlign);
|
||
end
|
||
else
|
||
begin
|
||
{ if LastChar<>hscLineBreak then AddText(hscLineBreak);}
|
||
CurHeadLevel:=0;
|
||
DocBreak;
|
||
end;
|
||
end;
|
||
|
||
procedure THTMLTopicRenderer.DocParagraph(Entered: boolean);
|
||
var Align: string;
|
||
begin
|
||
{ if Entered and InParagraph then}
|
||
if Entered and InParagraph then DocParagraph(false);
|
||
if Entered then
|
||
begin
|
||
if AnyCharsInLine then DocBreak;
|
||
if DocGetTagParam('ALIGN',Align) then
|
||
DecodeAlign(Align,PAlign);
|
||
end
|
||
else
|
||
begin
|
||
{ if AnyCharsInLine then }DocBreak;
|
||
PAlign:=paLeft;
|
||
end;
|
||
InParagraph:=Entered;
|
||
end;
|
||
|
||
procedure THTMLTopicRenderer.DocBreak;
|
||
begin
|
||
if (CurHeadLevel=1) or (PAlign=paCenter) then
|
||
AddChar(hscCenter);
|
||
if (PAlign=paRight) then
|
||
AddChar(hscRight);
|
||
AddChar(hscLineBreak);
|
||
if Indent>0 then
|
||
AddText(CharStr(#255,Indent)+hscLineStart);
|
||
AnyCharsInLine:=false;
|
||
end;
|
||
|
||
procedure THTMLTopicRenderer.DocImage;
|
||
var Alt: string;
|
||
begin
|
||
if DocGetTagParam('ALT',Alt)=false then Alt:='IMG';
|
||
if Alt<>'' then
|
||
begin
|
||
AddText('['+Alt+']');
|
||
end;
|
||
end;
|
||
|
||
procedure THTMLTopicRenderer.DocBold(Entered: boolean);
|
||
begin
|
||
end;
|
||
|
||
procedure THTMLTopicRenderer.DocCite(Entered: boolean);
|
||
begin
|
||
end;
|
||
|
||
procedure THTMLTopicRenderer.DocCode(Entered: boolean);
|
||
begin
|
||
end;
|
||
|
||
procedure THTMLTopicRenderer.DocEmphasized(Entered: boolean);
|
||
begin
|
||
end;
|
||
|
||
procedure THTMLTopicRenderer.DocItalic(Entered: boolean);
|
||
begin
|
||
end;
|
||
|
||
procedure THTMLTopicRenderer.DocKbd(Entered: boolean);
|
||
begin
|
||
end;
|
||
|
||
procedure THTMLTopicRenderer.DocPreformatted(Entered: boolean);
|
||
begin
|
||
if AnyCharsInLine then DocBreak;
|
||
DocBreak;
|
||
InPreformatted:=Entered;
|
||
end;
|
||
|
||
procedure THTMLTopicRenderer.DocSample(Entered: boolean);
|
||
begin
|
||
end;
|
||
|
||
procedure THTMLTopicRenderer.DocStrong(Entered: boolean);
|
||
begin
|
||
end;
|
||
|
||
procedure THTMLTopicRenderer.DocTeleType(Entered: boolean);
|
||
begin
|
||
end;
|
||
|
||
procedure THTMLTopicRenderer.DocVariable(Entered: boolean);
|
||
begin
|
||
end;
|
||
|
||
procedure THTMLTopicRenderer.DocList(Entered: boolean);
|
||
begin
|
||
if Entered then
|
||
begin
|
||
Inc(Indent,ListIndent);
|
||
DocBreak;
|
||
end
|
||
else
|
||
begin
|
||
Dec(Indent,ListIndent);
|
||
if AnyCharsInLine then DocBreak;
|
||
end;
|
||
end;
|
||
|
||
procedure THTMLTopicRenderer.DocOrderedList(Entered: boolean);
|
||
begin
|
||
DocList(Entered);
|
||
end;
|
||
|
||
procedure THTMLTopicRenderer.DocListItem;
|
||
begin
|
||
if AnyCharsInLine then
|
||
DocBreak;
|
||
AddText('<27>'+hscLineStart);
|
||
end;
|
||
|
||
procedure THTMLTopicRenderer.DocDefList(Entered: boolean);
|
||
begin
|
||
if Entered then
|
||
begin
|
||
{ if LastChar<>hscLineBreak then DocBreak;}
|
||
end
|
||
else
|
||
begin
|
||
if AnyCharsInLine then DocBreak;
|
||
end;
|
||
end;
|
||
|
||
procedure THTMLTopicRenderer.DocDefTerm;
|
||
begin
|
||
DocBreak;
|
||
end;
|
||
|
||
procedure THTMLTopicRenderer.DocDefExp;
|
||
begin
|
||
Inc(Indent,DefIndent);
|
||
DocBreak;
|
||
Dec(Indent,DefIndent);
|
||
end;
|
||
|
||
procedure THTMLTopicRenderer.DocHorizontalRuler;
|
||
var OAlign: TParagraphAlign;
|
||
begin
|
||
OAlign:=PAlign;
|
||
if AnyCharsInLine then DocBreak;
|
||
PAlign:=paCenter;
|
||
DocAddText(' '+CharStr('<27>',60)+' ');
|
||
DocBreak;
|
||
PAlign:=OAlign;
|
||
end;
|
||
|
||
procedure THTMLTopicRenderer.AddChar(C: char);
|
||
begin
|
||
if Topic=nil then Exit;
|
||
Topic^.Text^[TextPtr]:=ord(C);
|
||
Inc(TextPtr);
|
||
if (C>#15) and (C<>' ') then
|
||
AnyCharsInLine:=true;
|
||
end;
|
||
|
||
procedure THTMLTopicRenderer.AddText(S: string);
|
||
var I: sw_integer;
|
||
begin
|
||
for I:=1 to length(S) do
|
||
AddChar(S[I]);
|
||
end;
|
||
|
||
function THTMLTopicRenderer.BuildTopic(P: PTopic; HTMLFile: PTextFile; ATopicLinks: PTopicLinkCollection): boolean;
|
||
var OK: boolean;
|
||
TP: pointer;
|
||
I: sw_integer;
|
||
begin
|
||
Topic:=P; TopicLinks:=ATopicLinks;
|
||
OK:=Assigned(Topic) and Assigned(HTMLFile) and Assigned(TopicLinks);
|
||
if OK then
|
||
begin
|
||
if (Topic^.TextSize<>0) and Assigned(Topic^.Text) then
|
||
begin
|
||
FreeMem(Topic^.Text,Topic^.TextSize);
|
||
Topic^.TextSize:=0; Topic^.Text:=nil;
|
||
end;
|
||
Topic^.TextSize:=MaxHelpTopicSize;
|
||
GetMem(Topic^.Text,Topic^.TextSize);
|
||
|
||
TopicTitle:='';
|
||
InTitle:=false; InBody:=false; InAnchor:=false;
|
||
InParagraph:=false; InPreformatted:=false;
|
||
Indent:=0; CurHeadLevel:=0;
|
||
PAlign:=paLeft;
|
||
TextPtr:=0; LinkPtr:=0;
|
||
AnyCharsInLine:=false;
|
||
OK:=Process(HTMLFile);
|
||
|
||
if OK then
|
||
begin
|
||
{ --- topic links --- }
|
||
if (Topic^.Links<>nil) and (Topic^.LinkSize>0) then
|
||
begin
|
||
FreeMem(Topic^.Links,Topic^.LinkSize);
|
||
Topic^.Links:=nil; Topic^.LinkSize:=0; Topic^.LinkCount:=0;
|
||
end;
|
||
Topic^.LinkCount:=TopicLinks^.Count;
|
||
Topic^.LinkSize:=SizeOf(Topic^.Links^[0])*Topic^.LinkCount;
|
||
GetMem(Topic^.Links,Topic^.LinkSize);
|
||
for I:=0 to Topic^.LinkCount-1 do
|
||
begin
|
||
Topic^.Links^[I].FileID:=Topic^.FileID;
|
||
Topic^.Links^[I].Context:=EncodeHTMLCtx(Topic^.FileID,LinkIndexes[I]+1);
|
||
end;
|
||
{ --- topic text --- }
|
||
GetMem(TP,TextPtr);
|
||
Move(Topic^.Text^,TP^,TextPtr);
|
||
FreeMem(Topic^.Text,Topic^.TextSize);
|
||
Topic^.Text:=TP; Topic^.TextSize:=TextPtr;
|
||
end
|
||
else
|
||
begin
|
||
DisposeTopic(Topic);
|
||
Topic:=nil;
|
||
end;
|
||
end;
|
||
BuildTopic:=OK;
|
||
end;
|
||
|
||
constructor THTMLHelpFile.Init(AFileName: string; AID: word; ATOCEntry: string);
|
||
begin
|
||
inherited Init(AID);
|
||
FileName:=AFileName; TOCEntry:=ATOCEntry;
|
||
if FileName='' then Fail;
|
||
New(Renderer, Init);
|
||
New(TopicLinks, Init(50,500));
|
||
end;
|
||
|
||
function THTMLHelpFile.LoadIndex: boolean;
|
||
begin
|
||
IndexEntries^.Insert(NewIndexEntry(TOCEntry,ID,0));
|
||
LoadIndex:=true;
|
||
end;
|
||
|
||
function THTMLHelpFile.SearchTopic(HelpCtx: THelpCtx): PTopic;
|
||
function MatchCtx(P: PTopic): boolean; {$ifndef FPC}far;{$endif}
|
||
begin
|
||
MatchCtx:=P^.HelpCtx=HelpCtx;
|
||
end;
|
||
var FileID,LinkNo: word;
|
||
P: PTopic;
|
||
begin
|
||
DecodeHTMLCtx(HelpCtx,FileID,LinkNo);
|
||
if (HelpCtx<>0) and (FileID<>ID) then P:=nil else
|
||
if (FileID=ID) and (LinkNo>TopicLinks^.Count) then P:=nil else
|
||
begin
|
||
P:=Topics^.FirstThat(@MatchCtx);
|
||
if P=nil then
|
||
begin
|
||
P:=NewTopic(ID,HelpCtx,0);
|
||
Topics^.Insert(P);
|
||
end;
|
||
end;
|
||
SearchTopic:=P;
|
||
end;
|
||
|
||
function CompletePath(const Base: string; InComplete: string): string;
|
||
var Drv,BDrv: string[40]; D,BD: DirStr; N,BN: NameStr; E,BE: ExtStr;
|
||
P: sw_integer;
|
||
begin
|
||
FSplit(InComplete,D,N,E);
|
||
P:=Pos(':',D); if P=0 then Drv:='' else begin Drv:=copy(D,1,P); Delete(D,1,P); end;
|
||
FSplit(Base,BD,BN,BE);
|
||
P:=Pos(':',BD); if P=0 then BDrv:='' else begin BDrv:=copy(BD,1,P); Delete(BD,1,P); end;
|
||
if copy(D,1,1)<>'\' then
|
||
InComplete:=BD+D+N+E;
|
||
if Drv='' then
|
||
InComplete:=BDrv+InComplete;
|
||
InComplete:=FExpand(InComplete);
|
||
CompletePath:=InComplete;
|
||
end;
|
||
|
||
function THTMLHelpFile.ReadTopic(T: PTopic): boolean;
|
||
var OK: boolean;
|
||
HTMLFile: PDOSTextFile;
|
||
Name: string;
|
||
Link: string;
|
||
P: sw_integer;
|
||
begin
|
||
OK:=T<>nil;
|
||
if OK then
|
||
begin
|
||
if T^.HelpCtx=0 then Name:=FileName else
|
||
begin
|
||
Link:=TopicLinks^.At(T^.HelpCtx-1)^;
|
||
Link:=FormatPath(Link);
|
||
P:=Pos('#',Link); if P>0 then Delete(Link,P,255);
|
||
if CurFileName='' then Name:=Link else
|
||
Name:=CompletePath(CurFileName,Link);
|
||
end;
|
||
New(HTMLFile, Init(Name));
|
||
OK:=Renderer^.BuildTopic(T,HTMLFile,TopicLinks);
|
||
if OK then CurFileName:=Name;
|
||
if HTMLFile<>nil then Dispose(HTMLFile, Done);
|
||
end;
|
||
ReadTopic:=OK;
|
||
end;
|
||
|
||
destructor THTMLHelpFile.Done;
|
||
begin
|
||
inherited Done;
|
||
if Renderer<>nil then Dispose(Renderer, Done);
|
||
if TopicLinks<>nil then Dispose(TopicLinks, Done);
|
||
end;
|
||
|
||
END. |