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+' Ü'); DocBreak;
AddText(' '+CharStr('ß',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('þ'+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('Ä',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.