1 {
2     This file is part of the Free Pascal Integrated Development Environment
3     Copyright (c) 1999-2000 by Berczi Gabor
4 
5     See the file COPYING.FPC, included in this distribution,
6     for details about the copyright.
7 
8     This program is distributed in the hope that it will be useful,
9     but WITHOUT ANY WARRANTY; without even the implied warranty of
10     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
11 
12  **********************************************************************}
13 unit WHTMLHlp;
14 
15 interface
16 
17 uses Objects,WHTML,WAnsi,WHelp,WChmHWrap;
18 
19 const
20      extHTML              = '.htm';
21      extHTMLIndex         = '.htx';
22      extCHM		  = '.chm';
23 
24      ListIndent = 2;
25      DefIndent  = 4;
26 
27      MaxTopicLinks = 24000; { maximum number of links on a single HTML page }
28 
29 type
30     THTMLSection = (hsNone,hsHeading1,hsHeading2,hsHeading3,hsHeading4,hsHeading5,hsHeading6);
31 
32     TParagraphAlign = (paLeft,paCenter,paRight);
33 
34     PTableElement = ^TTableElement;
35     TTableElement = object(Tobject)
36       TextBegin,TextEnd, TextLength, NumNL : sw_word;
37       Alignment : TParagraphAlign;
38       NextEl : PTableElement;
39       constructor init(AAlignment : TParagraphAlign);
40     end;
41 
42     PTableLine = ^TTableLine;
43     TTableLine = object(Tobject)
44       NumElements : sw_word;
45       Nextline : PTableLine;
46       FirstEl,LastEl : PTableElement;
47       constructor Init;
48       procedure AddElement(PTE : PTableElement);
49       destructor Done; virtual;
50     end;
51 
52     PHTMLTopicRenderer = ^THTMLTopicRenderer;
53     PTable = ^TTable;
54     TTable = object(Tobject)
55       NumLines,NumCols : sw_word;
56       GlobalOffset,
57       GlobalTextBegin : sw_word;
58       WithBorder : boolean;
59       IsBar : boolean;
60       FirstLine : PTableLine;
61       LastLine : PTableLine;
62       PreviousTable : PTable;
63       Renderer : PHTMLTopicRenderer;
64       constructor Init(Previous : PTable);
65       procedure AddLine(PL : PTableLine);
66       procedure AddElement(PTE : PTableElement);
67       procedure TextInsert(Pos : sw_word;const S : string);
68       procedure FormatTable;
69       destructor Done; virtual;
70     end;
71 
72     THTMLTopicRenderer = object(THTMLParser)
BuildTopicnull73       function  BuildTopic(P: PTopic; AURL: string; HTMLFile: PTextFile; ATopicLinks: PTopicLinkCollection): boolean;
74     public
DocAddTextCharnull75       function  DocAddTextChar(C: char): boolean; virtual;
76       procedure DocSoftBreak; virtual;
77       procedure DocTYPE; virtual;
78       procedure DocHTML(Entered: boolean); virtual;
79       procedure DocHEAD(Entered: boolean); virtual;
80       procedure DocMETA; virtual;
81       procedure DocTITLE(Entered: boolean); virtual;
82       procedure DocBODY(Entered: boolean); virtual;
83       procedure DocAnchor(Entered: boolean); virtual;
84       procedure DocUnknownTag; virtual;
85       procedure DocHeading(Level: integer; Entered: boolean); virtual;
86       procedure DocParagraph(Entered: boolean); virtual;
87       procedure DocBreak; virtual;
88       procedure DocImage; virtual;
89       procedure DocProcessComment(Comment: string); virtual;
90       procedure DocBold(Entered: boolean); virtual;
91       procedure DocCite(Entered: boolean); virtual;
92       procedure DocCode(Entered: boolean); virtual;
93       procedure DocEmphasized(Entered: boolean); virtual;
94       procedure DocItalic(Entered: boolean); virtual;
95       procedure DocKbd(Entered: boolean); virtual;
96       procedure DocPreformatted(Entered: boolean); virtual;
97       procedure DocSample(Entered: boolean); virtual;
98       procedure DocStrong(Entered: boolean); virtual;
99       procedure DocTeleType(Entered: boolean); virtual;
100       procedure DocVariable(Entered: boolean); virtual;
101       procedure DocSpan(Entered: boolean); virtual;
102       procedure DocList(Entered: boolean); virtual;
103       procedure DocOrderedList(Entered: boolean); virtual;
104       procedure DocListItem(Entered: boolean); virtual;
105       procedure DocDefList(Entered: boolean); virtual;
106       procedure DocDefTerm(Entered: boolean); virtual;
107       procedure DocDefExp(Entered: boolean); virtual;
108       procedure DocTable(Entered: boolean); virtual;
109       procedure DocTableRow(Entered: boolean); virtual;
110       procedure DocTableHeaderItem(Entered: boolean); virtual;
111       procedure DocTableItem(Entered: boolean); virtual;
112       procedure DocHorizontalRuler; virtual;
CanonicalizeURLnull113       function CanonicalizeURL(const Base,Relative:String):string; virtual;
114       procedure Resolve( href: ansistring; var AFileId,ALinkId : sw_integer); virtual;
115     public
GetSectionColornull116       function  GetSectionColor(Section: THTMLSection; var Color: byte): boolean; virtual;
117     private
118       URL: string;
119       Topic: PTopic;
120       TopicLinks: PTopicLinkCollection;
121       TextPtr: sw_word;
122       InTitle: boolean;
123       InBody: boolean;
124       InAnchor: boolean;
125       InParagraph: boolean;
126       InPreformatted: boolean;
127       SuppressOutput: boolean;
128       SuppressUntil : string;
129       InDefExp: boolean;
130       TopicTitle: string;
131       Indent: integer;
132       AnyCharsInLine,
133       LastAnsiLoadFailed: boolean;
134       CurHeadLevel: integer;
135       PAlign: TParagraphAlign;
136       LinkIndexes: array[0..MaxTopicLinks] of sw_integer;
137       FileIDLinkIndexes: array[0..MaxTopicLinks] of sw_integer;
138       LinkPtr: sw_integer;
139       LastTextChar: char;
140 {      Anchor: TAnchor;}
141       { Table stuff }
142       CurrentTable : PTable;
143       procedure AddText(const S: string);
144       procedure AddChar(C: char);
145       procedure AddCharAt(C: char;AtPtr : sw_word);
AddTextAtnull146       function AddTextAt(const S: string;AtPtr : sw_word) : sw_word;
ComputeTextLengthnull147       function ComputeTextLength(TStart,TEnd : sw_word) : sw_word;
148     end;
149 
150     PCHMTopicRenderer = ^TCHMTopicRenderer;
151     TCHMTopicRenderer = object(THTMLTopicRenderer)
CanonicalizeURLnull152       function CanonicalizeURL(const Base,Relative:String):string; virtual;
153       procedure Resolve( href: ansistring; var AFileId,ALinkId : sw_integer); virtual;
154       end;
155 
156     PCustomHTMLHelpFile = ^TCustomHTMLHelpFile;
157     TCustomHTMLHelpFile = object(THelpFile)
158       constructor Init(AID: word);
159       destructor  Done; virtual;
160     public
161       Renderer: PHTMLTopicRenderer;
GetTopicInfonull162       function    GetTopicInfo(T: PTopic) : string; virtual;
SearchTopicnull163       function    SearchTopic(HelpCtx: THelpCtx): PTopic; virtual;
ReadTopicnull164       function    ReadTopic(T: PTopic): boolean; virtual;
FormatLinknull165       function    FormatLink(const s:String):string; virtual;
166     private
167       DefaultFileName: string;
168       CurFileName: string;
169       TopicLinks: PTopicLinkCollection;
170     end;
171 
172     PHTMLHelpFile = ^THTMLHelpFile;
173     THTMLHelpFile = object(TCustomHTMLHelpFile)
174       constructor Init(AFileName: string; AID: word; ATOCEntry: string);
175     public
LoadIndexnull176       function    LoadIndex: boolean; virtual;
177     private
178       TOCEntry: string;
179     end;
180 
181     PCHMHelpFile = ^TCHMHelpFile;
182     TCHMHelpFile = object(TCustomHTMLHelpFile)
183       constructor Init(AFileName: string; AID: word);
184       destructor  Done; virtual;
185     public
LoadIndexnull186       function    LoadIndex: boolean; virtual;
ReadTopicnull187       function    ReadTopic(T: PTopic): boolean; virtual;
GetTopicInfonull188       function    GetTopicInfo(T: PTopic) : string; virtual;
SearchTopicnull189       function    SearchTopic(HelpCtx: THelpCtx): PTopic; virtual;
FormatLinknull190       function    FormatLink(const s:String):string; virtual;
191     private
192       Chmw: TCHMWrapper;
193     end;
194 
195     PHTMLIndexHelpFile = ^THTMLIndexHelpFile;
196     THTMLIndexHelpFile = object(TCustomHTMLHelpFile)
197       constructor Init(AFileName: string; AID: word);
LoadIndexnull198       function    LoadIndex: boolean; virtual;
199     private
200       IndexFileName: string;
201     end;
202 
203     PHTMLAnsiView    = ^THTMLAnsiView;
204     PHTMLAnsiConsole = ^THTMLAnsiConsole;
205 
206     THTMLAnsiConsole = Object(TAnsiViewConsole)
207       MaxX,MaxY : integer;
208       procedure   GotoXY(X,Y: integer); virtual;
209     end;
210 
211     THTMLAnsiView = Object(TAnsiView)
212     private
213       HTMLOwner : PHTMLTopicRenderer;
214       HTMLConsole : PHTMLAnsiConsole;
215     public
216       constructor Init(AOwner: PHTMLTopicRenderer);
217       procedure   CopyToHTML;
218     end;
219 
ectionnull220     THTMLGetSectionColorProc = function(Section: THTMLSection; var Color: byte): boolean;
221 
DefHTMLGetSectionColornull222 function DefHTMLGetSectionColor(Section: THTMLSection; var Color: byte): boolean;
223 
224 const HTMLGetSectionColor : THTMLGetSectionColorProc = {$ifdef fpc}@{$endif}DefHTMLGetSectionColor;
225 
226 procedure RegisterHelpType;
227 
228 implementation
229 
230 uses
231   Views,WConsts,WUtils,WViews,WHTMLScn;
232 
233 
234 
235 constructor TTableElement.init(AAlignment : TParagraphAlign);
236 begin
237   Alignment:=AAlignment;
238   NextEl:=nil;
239   TextBegin:=0;
240   TextEnd:=0;
241 end;
242 
243 
244 { TTableLine methods }
245 
246 constructor TTableLine.Init;
247 begin
248   NumElements:=0;
249   NextLine:=nil;
250   Firstel:=nil;
251   LastEl:=nil;
252 end;
253 
254 procedure TTableLine.AddElement(PTE : PTableElement);
255 begin
256   if not assigned(FirstEl) then
257     FirstEl:=PTE;
258   if assigned(LastEl) then
259     LastEl^.NextEl:=PTE;
260   LastEl:=PTE;
261   Inc(NumElements);
262 end;
263 
264 destructor TTableLine.Done;
265 begin
266   LastEl:=FirstEl;
267   while assigned(LastEl) do
268     begin
269       LastEl:=FirstEl^.NextEl;
270       Dispose(FirstEl,Done);
271       FirstEl:=LastEl;
272     end;
273   inherited Done;
274 end;
275 
276 { TTable methods }
277 constructor TTable.Init(Previous : PTable);
278 begin
279   PreviousTable:=Previous;
280   NumLines:=0;
281   NumCols:=0;
282   GlobalOffset:=0;
283   GlobalTextBegin:=0;
284   FirstLine:=nil;
285   LastLine:=nil;
286 
287   WithBorder:=false;
288   IsBar:=false;
289 end;
290 
291 procedure TTable.AddLine(PL : PTableLine);
292 begin
293   If not assigned(FirstLine) then
294     FirstLine:=PL;
295   if Assigned(LastLine) then
296     LastLine^.NextLine:=PL;
297   LastLine:=PL;
298   Inc(NumLines);
299 end;
300 
301 procedure TTable.AddElement(PTE : PTableElement);
302 begin
303   if assigned(LastLine) then
304     begin
305       LastLine^.AddElement(PTE);
306       If LastLine^.NumElements>NumCols then
307         NumCols:=LastLine^.NumElements;
308     end;
309 end;
310 
311 procedure TTable.TextInsert(Pos : sw_word;const S : string);
312 var
313   i : sw_word;
314 begin
315   if S='' then
316     exit;
317   i:=Renderer^.AddTextAt(S,Pos+GlobalOffset);
318   GlobalOffset:=GlobalOffset+i;
319 end;
320 
321 procedure TTable.FormatTable;
322 const
323   MaxCols = 200;
324 type
325   TLengthArray = Array [ 1 .. MaxCols] of sw_word;
326   PLengthArray = ^TLengthArray;
327 var
328   ColLengthArray : PLengthArray;
329   RowSizeArray : PLengthArray;
330   CurLine : PTableLine;
331   CurEl : PTableElement;
332   Align : TParagraphAlign;
333   TextBegin,TextEnd : sw_word;
334   i,j,k,Length : sw_word;
335 begin
336   { do nothing for single cell tables }
337   if (NumCols=1) and (NumLines=1) then
338     exit;
339   GetMem(ColLengthArray,Sizeof(sw_word)*NumCols);
340   FillChar(ColLengthArray^,Sizeof(sw_word)*NumCols,#0);
341   GetMem(RowSizeArray,Sizeof(sw_word)*NumLines);
342   FillChar(RowSizeArray^,Sizeof(sw_word)*NumLines,#0);
343   { Compute the largest cell }
344   CurLine:=FirstLine;
345   For i:=1 to NumLines do
346     begin
347       CurEl:=CurLine^.FirstEl;
348       RowSizeArray^[i]:=1;
349       For j:=1 to NumCols do
350         begin
351           if not assigned(CurEl) then
352             break;
353           Length:=CurEl^.TextLength;
354           if assigned(CurEl^.NextEl) and
355              (CurEl^.NextEl^.TextBegin>CurEl^.TextEnd) then
356             Inc(Length,Renderer^.ComputeTextLength(
357                CurEl^.NextEl^.TextBegin+GlobalOffset,
358                CurEl^.TextBegin+GlobalOffset));
359 
360           if Length>ColLengthArray^[j] then
361             ColLengthArray^[j]:=Length;
362           { We need to handle multiline cells... }
363           if CurEl^.NumNL>=RowSizeArray^[i] then
364             RowSizeArray^[i]:=CurEl^.NumNL;
365           { We don't handle multiline cells yet... }
366           if CurEl^.NumNL>=1 then
367             begin
368               for k:=CurEl^.TextBegin+GlobalOffset to
369                      CurEl^.TextEnd+GlobalOffset do
370                 if Renderer^.Topic^.Text^[k]=ord(hscLineBreak) then
371                   Renderer^.Topic^.Text^[k]:=ord(' ');
372             end;
373 
374           CurEl:=CurEl^.NextEl;
375         end;
376       CurLine:=CurLine^.NextLine;
377     end;
378   { Adjust to largest cell }
379   CurLine:=FirstLine;
380   TextBegin:=GlobalTextBegin;
381   If (NumLines>0) and WithBorder then
382     Begin
383       TextInsert(TextBegin,#218);
384       For j:=1 to NumCols do
385         begin
386           TextInsert(TextBegin,CharStr(#196,ColLengthArray^[j]));
387           if j<NumCols then
388             TextInsert(TextBegin,#194);
389         end;
390       TextInsert(TextBegin,#191);
391       TextInsert(TextBegin,hscLineBreak);
392     End;
393   For i:=1 to NumLines do
394     begin
395       CurEl:=CurLine^.FirstEl;
396       For j:=1 to NumCols do
397         begin
398           if not assigned(CurEl) then
399             begin
400               Length:=0;
401               Align:=paLeft;
402             end
403           else
404             begin
405               TextBegin:=CurEl^.TextBegin;
406               TextEnd:=CurEl^.TextEnd;
407               {While (TextEnd>TextBegin) and
408                     (Renderer^.Topic^.Text^[TextEnd+GlobalOffset]=ord(hscLineBreak)) do
409                 dec(TextEnd); }
410               Length:=CurEl^.TextLength;
411               Align:=CurEl^.Alignment;
412             end;
413           if WithBorder then
414             TextInsert(TextBegin,#179)
415           else
416             TextInsert(TextBegin,' ');
417           if Length<ColLengthArray^[j] then
418             begin
419               case Align of
420                 paLeft:
421                   TextInsert(TextEnd,CharStr(' ',ColLengthArray^[j]-Length));
422                 paRight:
423                   TextInsert(TextBegin,CharStr(' ',ColLengthArray^[j]-Length));
424                 paCenter:
425                   begin
426                     TextInsert(TextBegin,CharStr(' ',(ColLengthArray^[j]-Length) div 2));
427                     TextInsert(TextEnd,CharStr(' ',(ColLengthArray^[j]-Length)- ((ColLengthArray^[j]-Length) div 2)));
428                   end;
429                 end;
430             end;
431           if Assigned(CurEl) then
432             CurEl:=CurEl^.NextEl;
433         end;
434       if WithBorder then
435         TextInsert(TextEnd,#179);
436       //TextInsert(TextEnd,hscLineBreak);
437       CurLine:=CurLine^.NextLine;
438     end;
439   If (NumLines>0) and WithBorder then
440     Begin
441       TextInsert(TextEnd,hscLineBreak);
442       TextInsert(TextEnd,#192);
443       For j:=1 to NumCols do
444         begin
445           TextInsert(TextEnd,CharStr(#196,ColLengthArray^[j]));
446           if j<NumCols then
447             TextInsert(TextEnd,#193);
448         end;
449       TextInsert(TextEnd,#217);
450       TextInsert(TextEnd,hscLineBreak);
451     End;
452 
453   FreeMem(ColLengthArray,Sizeof(sw_word)*NumCols);
454   FreeMem(RowSizeArray,Sizeof(sw_word)*NumLines);
455 end;
456 
457 destructor TTable.Done;
458 begin
459   LastLine:=FirstLine;
460   while assigned(LastLine) do
461     begin
462       LastLine:=FirstLine^.NextLine;
463       Dispose(FirstLine,Done);
464       FirstLine:=LastLine;
465     end;
466   if Assigned(PreviousTable) then
467     Inc(PreviousTable^.GlobalOffset,GlobalOffset);
468   inherited Done;
469 end;
470 
471 
472 {    THTMLAnsiConsole methods      }
473 
474 procedure THTMLAnsiConsole.GotoXY(X,Y : integer);
475 begin
476   if X>MaxX then MaxX:=X-1;
477   if Y>MaxY then MaxY:=Y-1;
478   inherited GotoXY(X,Y);
479 end;
480 
481 {    THTMLAnsiView methods      }
482 
483 constructor THTMLAnsiView.Init(AOwner : PHTMLTopicRenderer);
484 var
485   R : TRect;
486 begin
487   if not assigned(AOwner) then
488     fail;
489   R.Assign(0,0,80,25);
490   inherited init(R,nil,nil);
491   HTMLOwner:=AOwner;
492   HTMLConsole:=New(PHTMLAnsiConsole,Init(@Self));
493   HTMLConsole^.HighVideo;
494   Dispose(Console,Done);
495   Console:=HTMLConsole;
496   HTMLConsole^.Size.X:=80;
497   HTMLConsole^.Size.Y:=25;
498   HTMLConsole^.ClrScr;
499   HTMLConsole^.MaxX:=-1;
500   HTMLConsole^.MaxY:=-1;
501   HTMLConsole^.BoundChecks:=0;
502 end;
503 
504 procedure THTMLAnsiView.CopyToHTML;
505 var
506   Attr,NewAttr : byte;
507   c : char;
508   X,Y,Pos : longint;
509 begin
510    Attr:=(Buffer^[1] shr 8);
511    HTMLOwner^.AddChar(hscLineBreak);
512    HTMLOwner^.AddText(hscTextAttr+chr(Attr));
513    for Y:=0 to HTMLConsole^.MaxY-1 do
514      begin
515        for X:=0 to HTMLConsole^.MaxX-1 do
516          begin
517            Pos:=(Delta.Y*MaxViewWidth)+X+Y*MaxViewWidth;
518            NewAttr:=(Buffer^[Pos] shr 8);
519            if NewAttr <> Attr then
520              begin
521                Attr:=NewAttr;
522                HTMLOwner^.AddText(hscTextAttr+chr(Attr));
523              end;
524            c:= chr(Buffer^[Pos] and $ff);
525            if ord(c)>16 then
526              HTMLOwner^.AddChar(c)
527            else
528              begin
529                HTMLOwner^.AddChar(hscDirect);
530                HTMLOwner^.AddChar(c);
531              end;
532          end;
533        { Write start of next line in normal color, for correct alignment }
534        HTMLOwner^.AddChar(hscNormText);
535        { Force to set attr again at start of next line }
536        Attr:=0;
537        HTMLOwner^.AddChar(hscLineBreak);
538      end;
539 end;
540 
DefHTMLGetSectionColornull541 function DefHTMLGetSectionColor(Section: THTMLSection; var Color: byte): boolean;
542 begin
543   Color:=0;
544   DefHTMLGetSectionColor:=false;
545 end;
546 
CharStrnull547 function CharStr(C: char; Count: byte): string;
548 var S: string;
549 begin
550   setlength(s,count);
551   if Count>0 then FillChar(S[1],Count,C);
552   CharStr:=S;
553 end;
554 
555 
THTMLTopicRenderer.DocAddTextCharnull556 function THTMLTopicRenderer.DocAddTextChar(C: char): boolean;
557 var Added: boolean;
558 begin
559   Added:=false;
560   if InTitle then
561     begin
562       TopicTitle:=TopicTitle+C;
563       Added:=true;
564     end
565   else
566   if InBody then
567     begin
568       if (InPreFormatted) or (C<>#32) or (LastTextChar<>C) then
569       if (C<>#32) or (AnyCharsInLine=true) or (InPreFormatted=true) then
570         begin
571           AddChar(C);
572           LastTextChar:=C;
573           Added:=true;
574         end;
575     end;
576   DocAddTextChar:=Added;
577 end;
578 
579 procedure THTMLTopicRenderer.DocSoftBreak;
580 begin
581   if InPreformatted then DocBreak else
582   if AnyCharsInLine and not assigned(CurrentTable) then
583     begin
584       AddChar(' ');
585       LastTextChar:=' ';
586     end;
587 end;
588 
589 procedure THTMLTopicRenderer.DocTYPE;
590 begin
591 end;
592 
593 procedure THTMLTopicRenderer.DocHTML(Entered: boolean);
594 begin
595 end;
596 
597 procedure THTMLTopicRenderer.DocHEAD(Entered: boolean);
598 begin
599 end;
600 
601 procedure THTMLTopicRenderer.DocMETA;
602 begin
603 end;
604 
605 procedure THTMLTopicRenderer.DocTITLE(Entered: boolean);
606 begin
607   if Entered then
608     begin
609       TopicTitle:='';
610     end
611   else
612     begin
613       { render topic title here }
614       if TopicTitle<>'' then
615         begin
616           AddText('  '+TopicTitle+' �'); DocBreak;
617           AddText(' '+CharStr('�',length(TopicTitle)+3)); DocBreak;
618         end;
619     end;
620   InTitle:=Entered;
621 end;
622 
623 procedure THTMLTopicRenderer.DocBODY(Entered: boolean);
624 begin
625   InBody:=Entered;
626 end;
627 
628 procedure THTMLTopicRenderer.DocAnchor(Entered: boolean);
629 var HRef,Name: string;
630     lfileid,llinkid : sw_integer;
631 begin
632   if Entered and InAnchor then DocAnchor(false);
633   if Entered then
634     begin
635       if DocGetTagParam('HREF',HRef)=false then HRef:='';
636       if DocGetTagParam('NAME',Name)=false then Name:='';
637       if {(HRef='') and} (Name='') then
638         if DocGetTagParam('ID',Name)=false then
639           Name:='';
640       if Name<>'' then
641         begin
642           Topic^.NamedMarks^.InsertStr(Name);
643 {$IFDEF WDEBUG}
644           DebugMessageS({$i %file%},' Adding Name "'+Name+'"',{$i %line%},'1',0,0);
645 {$endif WDEBUG}
646           AddChar(hscNamedMark);
647         end;
648       if (HRef<>'')then
649           begin
650             if (LinkPtr<MaxTopicLinks){ and
651                not DisableCrossIndexing}  then
652             begin
653               InAnchor:=true;
654               AddChar(hscLink);
655 {$IFDEF WDEBUG}
656               DebugMessageS({$i %file%},' Adding Link1 "'+HRef+'"'+' "'+url+'"',{$i %line%},'1',0,0);
657 {$ENDIF WDEBUG}
658 
659               if pos('#',HRef)=1 then
660                 Href:=NameAndExtOf(GetFilename)+Href;
661               HRef:=canonicalizeURL(URL,HRef);
662               Resolve(Href,lfileid,llinkid);
663               LinkIndexes[LinkPtr]:=llinkid;
664               FileIDLinkIndexes[LinkPtr]:=lfileid;
665 {$IFDEF WDEBUG}
666               DebugMessageS({$i %file%},' Adding Link2 "'+HRef+'"',{$i %line%},'1',0,0);
667 {$ENDIF WDEBUG}
668               Inc(LinkPtr);
669             end;
670           end;
671     end
672   else
673     begin
674       if InAnchor=true then AddChar(hscLink);
675       InAnchor:=false;
676     end;
677 end;
678 
679 procedure THTMLTopicRenderer.DocUnknownTag;
680 begin
681 {$IFDEF WDEBUG}
682   DebugMessageS({$i %file%},' Unknown tag "'+TagName+'" params "'+TagParams+'"'  ,{$i %line%},'1',0,0);
683 {$endif WDEBUG}
684 end;
685 
686 procedure DecodeAlign(Align: string; var PAlign: TParagraphAlign);
687 begin
688   Align:=UpcaseStr(Align);
689   if Align='LEFT' then PAlign:=paLeft else
690   if Align='CENTER' then PAlign:=paCenter else
691   if Align='RIGHT' then PAlign:=paRight;
692 end;
693 
694 procedure THTMLTopicRenderer.DocHeading(Level: integer; Entered: boolean);
695 var Align: string;
696     C: byte;
697     SC: THTMLSection;
698 begin
699   if Entered then
700     begin
701       DocBreak;
702       CurHeadLevel:=Level;
703       PAlign:=paLeft;
704       if DocGetTagParam('ALIGN',Align) then
705         DecodeAlign(Align,PAlign);
706       SC:=hsNone;
707       case Level of
708         1: SC:=hsHeading1;
709         2: SC:=hsHeading2;
710         3: SC:=hsHeading3;
711         4: SC:=hsHeading4;
712         5: SC:=hsHeading5;
713         6: SC:=hsHeading6;
714       end;
715       if GetSectionColor(SC,C) then
716         AddText(hscTextAttr+chr(C));
717     end
718   else
719     begin
720       AddChar(hscNormText);
721       CurHeadLevel:=0;
722       DocBreak;
723     end;
724 end;
725 
THTMLTopicRenderer.CanonicalizeURLnull726 Function  THTMLTopicRenderer.CanonicalizeURL(const Base,Relative:String):string;
727 // uses info from filesystem (curdir) -> overridden for CHM.
728 begin
729  CanonicalizeURL:=CompleteURL(Base,relative);
730 end;
731 
732 procedure THTMLTopicRenderer.Resolve( href: ansistring; var AFileId,ALinkId : sw_integer);
733 begin
734 {$IFDEF WDEBUG}
735               DebugMessageS({$i %file%},' htmlresolve "'+HRef+'"',{$i %line%},'1',0,0);
736 {$ENDIF WDEBUG}
737 
738   Afileid:=Topic^.FileId;
739   ALinkId:=TopicLinks^.AddItem(HRef);
740 end;
741 
742 procedure THTMLTopicRenderer.DocParagraph(Entered: boolean);
743 var Align: string;
744 begin
745   if Entered and InParagraph then DocParagraph(false);
746   if Entered then
747     begin
748       if AnyCharsInLine then DocBreak;
749       if DocGetTagParam('ALIGN',Align) then
750         DecodeAlign(Align,PAlign);
751     end
752   else
753     begin
754 {      if AnyCharsInLine then }DocBreak;
755       PAlign:=paLeft;
756     end;
757   InParagraph:=Entered;
758 end;
759 
760 procedure THTMLTopicRenderer.DocBreak;
761 begin
762   if (CurHeadLevel=1) or (PAlign=paCenter) then
763     AddChar(hscCenter);
764   if (PAlign=paRight) then
765     AddChar(hscRight);
766   AddChar(hscLineBreak);
767   if Indent>0 then
768   AddText(CharStr(#255,Indent)+hscLineStart);
769   AnyCharsInLine:=false;
770 end;
771 
772 procedure THTMLTopicRenderer.DocProcessComment(Comment: string);
773 var
774   src,index : string;
775 begin
776   if pos('tex4ht:',Comment)=0 then
777     exit;
778 {$IFDEF WDEBUG}
779   DebugMessage(GetFileName,'tex4ht comment "'
780         +Comment+'"',Line,1);
781 {$endif WDEBUG}
782   if SuppressOutput then
783     begin
784       if (pos(SuppressUntil,Comment)=0) then
785         exit
786       else
787         begin
788 {$IFDEF WDEBUG}
789           DebugMessage(GetFileName,' Found '+SuppressUntil+'comment "'
790             +Comment+'" SuppressOuput reset to false',Line,1);
791 {$endif WDEBUG}
792           SuppressOutput:=false;
793           SuppressUntil:='';
794         end;
795     end;
796   if (pos('tex4ht:graphics ',Comment)>0) and
797      LastAnsiLoadFailed then
798     begin
799 {$IFDEF WDEBUG}
800       DebugMessage(GetFileName,' Using tex4ht comment "'
801         +Comment+'"',Line,1);
802 {$endif WDEBUG}
803       { Try again with this info }
804       TagParams:=Comment;
805       DocImage;
806     end;
807   if (pos('tex4ht:syntaxdiagram ',Comment)>0) then
808     begin
809 {$IFDEF WDEBUG}
810       DebugMessage(GetFileName,' Using tex4ht:syntaxdiagram comment "'
811         +Comment+'"',Line,1);
812 {$endif WDEBUG}
813       { Try again with this info }
814       TagParams:=Comment;
815       DocImage;
816       if not LastAnsiLoadFailed then
817         begin
818           SuppressOutput:=true;
819           SuppressUntil:='tex4ht:endsyntaxdiagram ';
820         end
821     end;
822   if (pos('tex4ht:mysyntdiag ',Comment)>0) then
823     begin
824 {$IFDEF WDEBUG}
825       DebugMessage(GetFileName,' Using tex4ht:mysyntdiag comment "'
826         +Comment+'"',Line,1);
827 {$endif WDEBUG}
828       { Try again with this info }
829       TagParams:=Comment;
830       DocGetTagParam('SRC',src);
831       DocGetTagParam('INDEX',index);
832       TagParams:='src="../syntax/'+src+'-'+index+'.png"';
833       DocImage;
834       if not LastAnsiLoadFailed then
835         begin
836           SuppressOutput:=true;
837           SuppressUntil:='tex4ht:endmysyntdiag ';
838         end
839     end;
840 end;
841 
842 procedure THTMLTopicRenderer.DocImage;
843 var Name,Src,Alt,SrcLine: string;
844     f : text;
845     attr : byte;
846     PA : PHTMLAnsiView;
847     StorePreformatted : boolean;
848 begin
849   if SuppressOutput then
850     exit;
851 {$IFDEF WDEBUG}
852   if not DocGetTagParam('NAME',Name) then
853      Name:='<No name>';
854   DebugMessage(GetFileName,' Image "'+Name+'"',Line,1);
855 {$endif WDEBUG}
856   if DocGetTagParam('SRC',src) then
857     begin
858 {$IFDEF WDEBUG}
859       DebugMessage(GetFileName,' Image source tag "'+Src+'"',Line,1);
860 {$endif WDEBUG}
861       if src<>'' then
862         begin
863           src:=CompleteURL(URL,src);
864           { this should be a image file ending by .gif or .jpg...
865             Try to see if a file with same name and extension .git
866             exists PM }
867           src:=DirAndNameOf(src)+'.ans';
868 {$IFDEF WDEBUG}
869           DebugMessage(GetFileName,' Trying "'+Src+'"',Line,1);
870 {$endif WDEBUG}
871           if not ExistsFile(src) then
872             begin
873               DocGetTagParam('SRC',src);
874               src:=DirAndNameOf(src)+'.ans';
875               src:=CompleteURL(DirOf(URL)+'../',src);
876 {$IFDEF WDEBUG}
877               DebugMessage(GetFileName,' Trying "'+Src+'"',Line,1);
878 {$endif wDEBUG}
879             end;
880           if not ExistsFile(src) then
881             begin
882               LastAnsiLoadFailed:=true;
883 {$IFDEF WDEBUG}
884               DebugMessage(GetFileName,' "'+Src+'" not found',Line,1);
885 {$endif WDEBUG}
886             end
887           else
888             begin
889               PA:=New(PHTMLAnsiView,init(@self));
890               PA^.LoadFile(src);
891               LastAnsiLoadFailed:=false;
892               if AnyCharsInLine then DocBreak;
893               StorePreformatted:=InPreformatted;
894               InPreformatted:=true;
895               {AddText('Image from '+src+hscLineBreak); }
896               AddChar(hscInImage);
897               PA^.CopyToHTML;
898               InPreformatted:=StorePreformatted;
899               AddChar(hscInImage);
900               AddChar(hscNormText);
901               if AnyCharsInLine then DocBreak;
902               Dispose(PA,Done);
903               Exit;
904             end;
905           { also look for a raw text file without colors }
906           src:=DirAndNameOf(src)+'.txt';
907           if not ExistsFile(src) then
908             begin
909               LastAnsiLoadFailed:=true;
910 {$IFDEF WDEBUG}
911               DebugMessage(GetFileName,' "'+Src+'" not found',Line,1);
912 {$endif WDEBUG}
913             end
914           else
915             begin
916               Assign(f,src);
917               Reset(f);
918               DocPreformatted(true);
919               while not eof(f) do
920                 begin
921                   Readln(f,SrcLine);
922                   AddText(SrcLine+hscLineBreak);
923                 end;
924               Close(f);
925               LastAnsiLoadFailed:=false;
926               DocPreformatted(false);
927               LastAnsiLoadFailed:=false;
928               Exit;
929             end;
930         end;
931     end;
932   if DocGetTagParam('ALT',Alt)=false then
933     begin
934       DocGetTagParam('SRC',Alt);
935       if Alt<>'' then
936         Alt:='Can''t display '+Alt
937       else
938         Alt:='IMG';
939     end;
940   if Alt<>'' then
941     begin
942       StorePreformatted:=InPreformatted;
943       InPreformatted:=true;
944       DocGetTagParam('SRC',src);
945       AddChar(hscInImage);
946       AddText('[--'+Src+'--'+hscLineBreak);
947       AddText(Alt+hscLineBreak+'--]');
948       AddChar(hscInImage);
949       AddChar(hscNormText);
950       InPreformatted:=StorePreformatted;
951     end;
952 end;
953 
954 procedure THTMLTopicRenderer.DocBold(Entered: boolean);
955 begin
956 end;
957 
958 procedure THTMLTopicRenderer.DocCite(Entered: boolean);
959 begin
960 end;
961 
962 procedure THTMLTopicRenderer.DocCode(Entered: boolean);
963 begin
964   if AnyCharsInLine then DocBreak;
965   AddText(hscCode);
966   DocBreak;
967 end;
968 
969 procedure THTMLTopicRenderer.DocEmphasized(Entered: boolean);
970 begin
971 end;
972 
973 procedure THTMLTopicRenderer.DocItalic(Entered: boolean);
974 begin
975 end;
976 
977 procedure THTMLTopicRenderer.DocKbd(Entered: boolean);
978 begin
979 end;
980 
981 procedure THTMLTopicRenderer.DocPreformatted(Entered: boolean);
982 begin
983   if AnyCharsInLine then DocBreak;
984   AddText(hscCode);
985   DocBreak;
986   InPreformatted:=Entered;
987 end;
988 
989 procedure THTMLTopicRenderer.DocSample(Entered: boolean);
990 begin
991 end;
992 
993 procedure THTMLTopicRenderer.DocStrong(Entered: boolean);
994 begin
995 end;
996 
997 procedure THTMLTopicRenderer.DocTeleType(Entered: boolean);
998 begin
999 end;
1000 
1001 procedure THTMLTopicRenderer.DocVariable(Entered: boolean);
1002 begin
1003 end;
1004 
1005 procedure THTMLTopicRenderer.DocSpan(Entered: boolean);
1006 begin
1007 end;
1008 
1009 procedure THTMLTopicRenderer.DocList(Entered: boolean);
1010 begin
1011   if Entered then
1012     begin
1013       Inc(Indent,ListIndent);
1014       DocBreak;
1015     end
1016   else
1017     begin
1018       Dec(Indent,ListIndent);
1019       if AnyCharsInLine then DocBreak;
1020     end;
1021 end;
1022 
1023 procedure THTMLTopicRenderer.DocOrderedList(Entered: boolean);
1024 begin
1025   DocList(Entered);
1026 end;
1027 
1028 procedure THTMLTopicRenderer.DocListItem(Entered: boolean);
1029 begin
1030   if not Entered then
1031     exit;
1032   if AnyCharsInLine then
1033     DocBreak;
1034   AddText('�'+hscLineStart);
1035 end;
1036 
1037 procedure THTMLTopicRenderer.DocDefList(Entered: boolean);
1038 begin
1039   if Entered then
1040     begin
1041 {      if LastChar<>hscLineBreak then DocBreak;}
1042     end
1043   else
1044     begin
1045       if AnyCharsInLine then DocBreak;
1046       InDefExp:=false;
1047     end;
1048 end;
1049 
1050 procedure THTMLTopicRenderer.DocDefTerm(Entered: boolean);
1051 begin
1052   if not Entered then
1053     exit;
1054   DocBreak;
1055 end;
1056 
1057 procedure THTMLTopicRenderer.DocDefExp(Entered: boolean);
1058 begin
1059   if not Entered then
1060     begin
1061       if InDefExp then
1062         Dec(Indent,DefIndent);
1063       InDefExp:=false;
1064     end
1065   else
1066     begin
1067       if not InDefExp then
1068         Inc(Indent,DefIndent);
1069       InDefExp:=true;
1070       DocBreak;
1071     end;
1072 end;
1073 
1074 procedure THTMLTopicRenderer.DocTable(Entered: boolean);
1075 var
1076   ATable : PTable;
1077   Param : String;
1078 begin
1079   if AnyCharsInLine then
1080     begin
1081       AddChar(hscLineBreak);
1082       AnyCharsInLine:=false;
1083     end;
1084   if Entered then
1085     begin
1086       DocBreak;
1087       New(ATable,Init(CurrentTable));
1088       CurrentTable:=ATable;
1089       CurrentTable^.Renderer:=@Self;
1090       if DocGetTagParam('BORDER',Param) then
1091         if Param<>'0' then
1092           CurrentTable^.WithBorder:=true;
1093       if DocGetTagParam('CLASS',Param) then
1094         if Param='bar' then
1095           CurrentTable^.IsBar:=true;
1096     end
1097   else
1098     begin
1099       CurrentTable^.FormatTable;
1100       ATable:=CurrentTable;
1101       CurrentTable:=ATable^.PreviousTable;
1102       Dispose(ATable,Done);
1103     end;
1104 end;
1105 
1106 procedure THTMLTopicRenderer.DocTableRow(Entered: boolean);
1107 var
1108   ATableLine : PTableLine;
1109 begin
1110   if AnyCharsInLine or
1111      (assigned(CurrentTable) and
1112       assigned(CurrentTable^.FirstLine)) then
1113     begin
1114       AddChar(hscLineBreak);
1115       AnyCharsInLine:=false;
1116     end;
1117   if Entered then
1118     begin
1119       New(ATableLine,Init);
1120       if CurrentTable^.GlobalTextBegin=0 then
1121       CurrentTable^.GlobalTextBegin:=TextPtr;
1122       CurrentTable^.AddLine(ATableLine);
1123     end;
1124 end;
1125 
1126 procedure THTMLTopicRenderer.DocTableItem(Entered: boolean);
1127 var
1128   Align : String;
1129   i : sw_word;
1130   NewEl : PTableElement;
1131   PAlignEl : TParagraphAlign;
1132 begin
1133   if Entered then
1134     begin
1135       if assigned(CurrentTable^.LastLine) and Assigned(CurrentTable^.LastLine^.LastEl) and
1136          (CurrentTable^.LastLine^.LastEl^.TextEnd=sw_word(-1)) then
1137         begin
1138           NewEl:=CurrentTable^.LastLine^.LastEl;
1139           NewEl^.TextEnd:=TextPtr;
1140           NewEl^.TextLength:=ComputeTextLength(
1141             NewEl^.TextBegin+CurrentTable^.GlobalOffset,
1142             TextPtr+CurrentTable^.GlobalOffset);
1143         end;
1144       PAlignEl:=paLeft;
1145       if DocGetTagParam('ALIGN',Align) then
1146         DecodeAlign(Align,PAlignEl);
1147       New(NewEl,Init(PAlignEl));
1148       CurrentTable^.AddElement(NewEl);
1149       NewEl^.TextBegin:=TextPtr;
1150       NewEl^.TextEnd:=sw_word(-1);
1151       { AddText(' - ');}
1152     end
1153   else
1154     begin
1155       NewEl:=CurrentTable^.LastLine^.LastEl;
1156       NewEl^.TextEnd:=TextPtr;
1157       NewEl^.TextLength:=ComputeTextLength(
1158         NewEl^.TextBegin+CurrentTable^.GlobalOffset,
1159         TextPtr+CurrentTable^.GlobalOffset);
1160       NewEl^.NumNL:=0;
1161       for i:=NewEl^.TextBegin to TextPtr do
1162         begin
1163           if Topic^.Text^[i]=ord(hscLineBreak) then
1164             inc(NewEl^.NumNL);
1165         end;
1166     end;
1167 end;
1168 
1169 procedure THTMLTopicRenderer.DocTableHeaderItem(Entered: boolean);
1170 begin
1171   { Treat as a normal item }
1172   DocTableItem(Entered);
1173 end;
1174 
1175 
1176 procedure THTMLTopicRenderer.DocHorizontalRuler;
1177 var OAlign: TParagraphAlign;
1178 begin
1179   OAlign:=PAlign;
1180   if AnyCharsInLine then DocBreak;
1181   PAlign:=paCenter;
1182   DocAddText(' '+CharStr('�',60)+' ');
1183   DocBreak;
1184   PAlign:=OAlign;
1185 end;
1186 
1187 procedure THTMLTopicRenderer.AddChar(C: char);
1188 begin
1189   if (Topic=nil) or (TextPtr=MaxBytes) or SuppressOutput then Exit;
1190   Topic^.Text^[TextPtr]:=ord(C);
1191   Inc(TextPtr);
1192   if (C>#15) and ((C<>' ') or (InPreFormatted=true)) then
1193     AnyCharsInLine:=true;
1194 end;
1195 
1196 procedure THTMLTopicRenderer.AddCharAt(C: char;AtPtr : sw_word);
1197 begin
1198   if (Topic=nil) or (TextPtr=MaxBytes) or SuppressOutput then Exit;
1199   if AtPtr>TextPtr then
1200     AtPtr:=TextPtr
1201   else
1202     begin
1203       Move(Topic^.Text^[AtPtr],Topic^.Text^[AtPtr+1],TextPtr-AtPtr);
1204     end;
1205   Topic^.Text^[AtPtr]:=ord(C);
1206   Inc(TextPtr);
1207 end;
1208 
1209 procedure THTMLTopicRenderer.AddText(const S: string);
1210 var I: sw_integer;
1211 begin
1212   for I:=1 to length(S) do
1213     AddChar(S[I]);
1214 end;
1215 
THTMLTopicRenderer.ComputeTextLengthnull1216 function THTMLTopicRenderer.ComputeTextLength(TStart,TEnd : sw_word) : sw_word;
1217 var I,tot: sw_integer;
1218 begin
1219   tot:=0;
1220   i:=TStart;
1221   while i<= TEnd-1 do
1222     begin
1223       inc(tot);
1224       case chr(Topic^.Text^[i]) of
1225       hscLink,hscCode,
1226       hscCenter,hscRight,
1227       hscNamedMark,hscNormText :
1228         Dec(tot);{ Do not increase tot }
1229       hscDirect:
1230         begin
1231           Inc(i); { Skip next }
1232           //Inc(tot);
1233         end;
1234       hscTextAttr,
1235       hscTextColor:
1236         begin
1237           Inc(i);
1238           Dec(tot);
1239         end;
1240       end;
1241       inc(i);
1242     end;
1243   ComputeTextLength:=tot;
1244 
1245 end;
AddTextAtnull1246 function THTMLTopicRenderer.AddTextAt(const S: String;AtPtr : sw_word) : sw_word;
1247 var
1248   i,slen,len : sw_word;
1249 begin
1250   if (Topic=nil) or (TextPtr>=MaxBytes)  or SuppressOutput then Exit;
1251   slen:=length(s);
1252   if TextPtr+slen>=MaxBytes then
1253     slen:=MaxBytes-TextPtr;
1254   if AtPtr>TextPtr then
1255     AtPtr:=TextPtr
1256   else
1257     begin
1258       len:=TextPtr-AtPtr;
1259       Move(Topic^.Text^[AtPtr],Topic^.Text^[AtPtr+slen],len);
1260     end;
1261   for i:=1 to slen do
1262     begin
1263       Topic^.Text^[AtPtr]:=ord(S[i]);
1264       Inc(TextPtr);
1265       inc(AtPtr);
1266       if (TextPtr=MaxBytes) then Exit;
1267     end;
1268   AddTextAt:=slen;
1269 end;
1270 
THTMLTopicRenderer.GetSectionColornull1271 function THTMLTopicRenderer.GetSectionColor(Section: THTMLSection; var Color: byte): boolean;
1272 begin
1273   GetSectionColor:=HTMLGetSectionColor(Section,Color);
1274 end;
1275 
THTMLTopicRenderer.BuildTopicnull1276 function THTMLTopicRenderer.BuildTopic(P: PTopic; AURL: string; HTMLFile: PTextFile;
1277            ATopicLinks: PTopicLinkCollection): boolean;
1278 var OK: boolean;
1279     TP: pointer;
1280     I: sw_integer;
1281 begin
1282   URL:=AURL;
1283   Topic:=P; TopicLinks:=ATopicLinks;
1284   OK:=Assigned(Topic) and Assigned(HTMLFile) and Assigned(TopicLinks);
1285   if OK then
1286     begin
1287       if (Topic^.TextSize<>0) and Assigned(Topic^.Text) then
1288         begin
1289           FreeMem(Topic^.Text,Topic^.TextSize);
1290           Topic^.TextSize:=0; Topic^.Text:=nil;
1291         end;
1292       Topic^.TextSize:=MaxHelpTopicSize;
1293       GetMem(Topic^.Text,Topic^.TextSize);
1294 
1295       TopicTitle:='';
1296       InTitle:=false; InBody:={false}true; InAnchor:=false;
1297       InParagraph:=false; InPreformatted:=false;
1298       Indent:=0; CurHeadLevel:=0;
1299       PAlign:=paLeft;
1300       TextPtr:=0; LinkPtr:=0;
1301       AnyCharsInLine:=false;
1302       LastTextChar:=#0;
1303       SuppressUntil:='';
1304       SuppressOutput:=false;
1305       OK:=Process(HTMLFile);
1306 
1307       if OK then
1308         begin
1309           { --- topic links --- }
1310           if (Topic^.Links<>nil) and (Topic^.LinkSize>0) then
1311             begin
1312               FreeMem(Topic^.Links,Topic^.LinkSize);
1313               Topic^.Links:=nil; Topic^.LinkCount:=0;
1314             end;
1315           Topic^.LinkCount:=LinkPtr{TopicLinks^.Count}; { <- eeeeeek! }
1316           GetMem(Topic^.Links,Topic^.LinkSize);
1317           if Topic^.LinkCount>0 then { FP causes numeric RTE 215 without this }
1318           for I:=0 to Min(Topic^.LinkCount-1,High(LinkIndexes)-1) do
1319             begin
1320               {$IFDEF WDEBUG}
1321                 DebugMessageS({$i %file%},' Indexing links ('+inttostr(i)+')'+topiclinks^.at(linkindexes[i])^+' '+inttostr(i)+' '+inttostr(linkindexes[i]),{$i %line%},'1',0,0);
1322               {$endif WDEBUG}
1323               Topic^.Links^[I].FileID:=FileIDLinkIndexes[i];
1324               Topic^.Links^[I].Context:=EncodeHTMLCtx(FileIDLinkIndexes[i],LinkIndexes[I]+1);
1325             end;
1326          {$IFDEF WDEBUG}
1327           if Topic^.Linkcount>High(linkindexes) then
1328            DebugMessageS({$i %file%},' Maximum links exceeded ('+inttostr(Topic^.LinkCount)+') '+URL,{$i %line%},'1',0,0);
1329          {$endif WDEBUG}
1330 
1331 
1332           { --- topic text --- }
1333           GetMem(TP,TextPtr);
1334           Move(Topic^.Text^,TP^,TextPtr);
1335           FreeMem(Topic^.Text,Topic^.TextSize);
1336           Topic^.Text:=TP; Topic^.TextSize:=TextPtr;
1337         end
1338       else
1339         begin
1340           DisposeTopic(Topic);
1341           Topic:=nil;
1342         end;
1343     end;
1344   BuildTopic:=OK;
1345 end;
1346 
TCHMTopicRenderer.CanonicalizeURLnull1347 Function  TCHMTopicRenderer.CanonicalizeURL(const Base,Relative:String):string;
1348 begin
1349  if copy(relative,1,6)='http:/' then // external links don't need to be fixed since we can't load them.
1350    begin
1351      CanonicalizeUrl:=relative;
1352      exit;
1353    end;
1354  if copy(relative,1,7)<>'ms-its:' then
1355    CanonicalizeUrl:=combinepaths(relative,base)
1356   else
1357    CanonicalizeUrl:=relative;
1358 end;
1359 
1360 procedure TCHMTopicRenderer.Resolve( href: ansistring; var AFileId,ALinkId : sw_integer);
1361 var resolved:boolean;
1362 begin
1363 {$IFDEF WDEBUG}
1364   DebugMessageS({$i %file%},' chmresolve "'+HRef+'"',{$i %line%},'1',0,0);
1365 {$ENDIF WDEBUG}
1366   resolved:=false; AFileID:=0; ALinkID:=0;
1367   href:=stringreplace(href,'%20',' ');
1368   if copy(href,1,7)='ms-its:' then
1369     resolved:=CHMResolve(Href,AFileId,ALinkID);
1370   if not resolved then
1371     begin
1372     {$IFDEF WDEBUG}
1373        DebugMessageS({$i %file%},' chmresolve not resolved "'+HRef+'"',{$i %line%},'1',0,0);
1374     {$ENDIF WDEBUG}
1375 
1376       Afileid:=Topic^.FileId;
1377       ALinkId:=TopicLinks^.AddItem(HRef);
1378     end;
1379 end;
1380 
1381 
1382 constructor TCustomHTMLHelpFile.Init(AID: word);
1383 begin
1384   inherited Init(AID);
1385   New(Renderer, Init);
1386   New(TopicLinks, Init(50,500));
1387 end;
1388 
TCustomHTMLHelpFile.SearchTopicnull1389 function TCustomHTMLHelpFile.SearchTopic(HelpCtx: THelpCtx): PTopic;
MatchCtxnull1390 function MatchCtx(P: PTopic): boolean;
1391 begin
1392   MatchCtx:=P^.HelpCtx=HelpCtx;
1393 end;
1394 var FileID,LinkNo: word;
1395     P: PTopic;
1396     FName: string;
1397 begin
1398   DecodeHTMLCtx(HelpCtx,FileID,LinkNo);
1399   if (HelpCtx<>0) and (FileID<>ID) then P:=nil else
1400   if (FileID=ID) and (LinkNo>TopicLinks^.Count) then P:=nil else
1401     begin
1402       P:=Topics^.FirstThat(@MatchCtx);
1403       if P=nil then
1404         begin
1405           if LinkNo=0 then
1406             FName:=DefaultFileName
1407           else
1408             FName:=TopicLinks^.At(LinkNo-1)^;
1409           P:=NewTopic(ID,HelpCtx,0,FName,nil,0);
1410           Topics^.Insert(P);
1411         end;
1412     end;
1413   SearchTopic:=P;
1414 end;
1415 
TCustomHTMLHelpFile.FormatLinknull1416 function TCustomHTMLHelpFile.FormatLink(const s:String):string;
1417 begin
1418  formatlink:=formatpath(s);
1419 end;
1420 
TCustomHTMLHelpFile.GetTopicInfonull1421 function TCustomHTMLHelpFile.GetTopicInfo(T: PTopic) : string;
1422 var OK: boolean;
1423     Name: string;
1424     Link,Bookmark: string;
1425     P: sw_integer;
1426 begin
1427   Bookmark:='';
1428   OK:=T<>nil;
1429   if OK then
1430     begin
1431       if T^.HelpCtx=0 then
1432         begin
1433           Name:=DefaultFileName;
1434           P:=0;
1435         end
1436       else
1437         begin
1438           Link:=TopicLinks^.At((T^.HelpCtx and $ffff)-1)^;
1439 {$IFDEF WDEBUG}
1440           DebugMessageS({$i %file%},'(Topicinfo) Link before formatpath "'+link+'"',{$i %line%},'1',0,0);
1441 {$ENDIF WDEBUG}
1442 
1443           Link:=FormatLink(Link);
1444 {$IFDEF WDEBUG}
1445           DebugMessageS({$i %file%},'(Topicinfo) Link after formatpath "'+link+'"',{$i %line%},'1',0,0);
1446 {$ENDIF WDEBUG}
1447           P:=Pos('#',Link);
1448           if P>0 then
1449           begin
1450             Bookmark:=copy(Link,P+1,length(Link));
1451             Link:=copy(Link,1,P-1);
1452           end;
1453 {          if CurFileName='' then Name:=Link else
1454           Name:=CompletePath(CurFileName,Link);}
1455           Name:=Link;
1456         end;
1457     end;
1458   GetTopicInfo:=Name+'#'+BookMark;
1459 end;
1460 
TCustomHTMLHelpFile.ReadTopicnull1461 function TCustomHTMLHelpFile.ReadTopic(T: PTopic): boolean;
1462 var OK: boolean;
1463     HTMLFile: PMemoryTextFile;
1464     Name: string;
1465     Link,Bookmark: string;
1466     P: sw_integer;
1467 begin
1468   Bookmark:='';
1469   OK:=T<>nil;
1470   if OK then
1471     begin
1472       if T^.HelpCtx=0 then
1473         begin
1474           Name:=DefaultFileName;
1475           P:=0;
1476         end
1477       else
1478         begin
1479           Link:=TopicLinks^.At((T^.HelpCtx and $ffff)-1)^;
1480 {$IFDEF WDEBUG}
1481           DebugMessageS({$i %file%},'(ReadTopic) Link before formatpath "'+link+'"',{$i %line%},'1',0,0);
1482 {$ENDIF WDEBUG}
1483           Link:=FormatPath(Link);
1484 {$IFDEF WDEBUG}
1485           DebugMessageS({$i %file%},'(ReadTopic) Link before formatpath "'+link+'"',{$i %line%},'1',0,0);
1486 {$ENDIF WDEBUG}
1487           P:=Pos('#',Link);
1488           if P>0 then
1489           begin
1490             Bookmark:=copy(Link,P+1,length(Link));
1491             Link:=copy(Link,1,P-1);
1492           end;
1493 {          if CurFileName='' then Name:=Link else
1494           Name:=CompletePath(CurFileName,Link);}
1495           Name:=Link;
1496         end;
1497       HTMLFile:=nil;
1498       if Name<>'' then
1499         HTMLFile:=New(PDOSTextFile, Init(Name));
1500 
1501       if (HTMLFile=nil) and (CurFileName<>'') then
1502         begin
1503           Name:=CurFileName;
1504           HTMLFile:=New(PDOSTextFile, Init(Name));
1505         end;
1506       if (HTMLFile=nil) then
1507         begin
1508 {$IFDEF WDEBUG}
1509           DebugMessageS({$i %file%},'(ReadTopic) Filename not known:  "'+link+'"',{$i %line%},'1',0,0);
1510 {$ENDIF WDEBUG}
1511         end;
1512       if (p>1) and (HTMLFile=nil) then
1513         begin
1514 {$IFDEF WDEBUG}
1515           if p>0 then
1516             DebugMessage(Name,Link+'#'+Bookmark+' not found',1,1)
1517           else
1518             DebugMessage(Name,Link+' not found',1,1);
1519 {$endif WDEBUG}
1520           New(HTMLFile, Init);
1521           HTMLFile^.AddLine('<HEAD><TITLE>'+msg_pagenotavailable+'</TITLE></HEAD>');
1522           HTMLFile^.AddLine(
1523             '<BODY>'+
1524             FormatStrStr(msg_cantaccessurl,Name)+'<br><br>'+
1525             '</BODY>');
1526         end;
1527       OK:=Renderer^.BuildTopic(T,Name,HTMLFile,TopicLinks);
1528       if OK then
1529         CurFileName:=Name
1530       else
1531         begin
1532 {$IFDEF WDEBUG}
1533           if p>0 then
1534             DebugMessage(Name,Link+'#'+Bookmark+' not found',1,1)
1535           else
1536             DebugMessage(Name,Link+' not found',1,1);
1537 {$endif WDEBUG}
1538         end;
1539       if HTMLFile<>nil then Dispose(HTMLFile, Done);
1540       if BookMark='' then
1541         T^.StartNamedMark:=0
1542       else
1543         begin
1544           P:=T^.GetNamedMarkIndex(BookMark);
1545 {$IFDEF WDEBUG}
1546           if p=-1 then
1547             DebugMessage(Name,Link+'#'+Bookmark+' bookmark not found',1,1);
1548 {$endif WDEBUG}
1549           T^.StartNamedMark:=P+1;
1550         end;
1551     end;
1552   ReadTopic:=OK;
1553 end;
1554 
1555 destructor TCustomHTMLHelpFile.Done;
1556 begin
1557   inherited Done;
1558   if Renderer<>nil then Dispose(Renderer, Done);
1559   if TopicLinks<>nil then Dispose(TopicLinks, Done);
1560 end;
1561 
1562 constructor THTMLHelpFile.Init(AFileName: string; AID: word; ATOCEntry: string);
1563 begin
1564   if inherited Init(AID)=false then Fail;
1565   DefaultFileName:=AFileName; TOCEntry:=ATOCEntry;
1566   if DefaultFileName='' then
1567   begin
1568     Done;
1569     Fail;
1570   end;
1571 end;
1572 
LoadIndexnull1573 function THTMLHelpFile.LoadIndex: boolean;
1574 begin
1575   IndexEntries^.Insert(NewIndexEntry(TOCEntry,ID,0));
1576   LoadIndex:=true;
1577 end;
1578 
1579 constructor THTMLIndexHelpFile.Init(AFileName: string; AID: word);
1580 begin
1581   inherited Init(AID);
1582   IndexFileName:=AFileName;
1583 end;
1584 
LoadIndexnull1585 function THTMLIndexHelpFile.LoadIndex: boolean;
FormatAliasnull1586 function FormatAlias(Alias: string): string;
1587 begin
1588   if Assigned(HelpFacility) then
1589     if length(Alias)>HelpFacility^.IndexTabSize-4 then
1590       Alias:=Trim(copy(Alias,1,HelpFacility^.IndexTabSize-4-2))+'..';
1591   FormatAlias:=Alias;
1592 end;
1593 (*procedure AddDoc(P: PHTMLLinkScanDocument);
1594 var I: sw_integer;
1595     TLI: THelpCtx;
1596 begin
1597   for I:=1 to P^.GetAliasCount do
1598   begin
1599     TLI:=TopicLinks^.AddItem(P^.GetName);
1600     TLI:=EncodeHTMLCtx(ID,TLI+1);
1601     IndexEntries^.Insert(NewIndexEntry(FormatAlias(P^.GetAlias(I-1)),ID,TLI));
1602   end;
1603 end;*)
1604 var S: PBufStream;
1605     LS: PHTMLLinkScanner;
1606     OK: boolean;
1607     TLI: THelpCtx;
1608     I,J: sw_integer;
1609 begin
1610   New(S, Init(IndexFileName,stOpenRead,4096));
1611   OK:=Assigned(S);
1612   if OK then
1613   begin
1614     New(LS, LoadDocuments(S^));
1615     OK:=Assigned(LS);
1616     if OK then
1617     begin
1618       {LS^.SetBaseDir(DirOf(IndexFileName)); already set by LoadDocuments to real base dire stored into htx file. This allows storing toc file in current dir in case doc installation dir is read only.}
1619       for I:=0 to LS^.GetDocumentCount-1 do
1620         begin
1621           TLI:=TopicLinks^.AddItem(LS^.GetDocumentURL(I));
1622           TLI:=EncodeHTMLCtx(ID,TLI+1);
1623           for J:=0 to LS^.GetDocumentAliasCount(I)-1 do
1624             IndexEntries^.Insert(NewIndexEntry(
1625               FormatAlias(LS^.GetDocumentAlias(I,J)),ID,TLI));
1626         end;
1627       Dispose(LS, Done);
1628     end;
1629     Dispose(S, Done);
1630   end;
1631   LoadIndex:=OK;
1632 end;
1633 
1634 constructor TChmHelpFile.Init(AFileName: string; AID: word);
1635 begin
1636   if inherited Init(AID)=false then
1637     Fail;
1638   Dispose(renderer,done);
1639   renderer:=New(PCHMTopicRenderer, Init);
1640   DefaultFileName:=AFileName;
1641   if (DefaultFileName='') or not ExistsFile(DefaultFilename) then
1642   begin
1643     Done;
1644     Fail;
1645   end
1646   else
1647     chmw:=TCHMWrapper.Create(DefaultFileName,AID,TopicLinks);
1648 end;
1649 
LoadIndexnull1650 function    TChmHelpFile.LoadIndex: boolean;
1651 begin
1652   loadindex:=false;
1653   if assigned(chmw) then
1654     loadindex:=chmw.loadindex(id,TopicLinks,IndexEntries,helpfacility);
1655 end;
1656 
FormatLinknull1657 function TCHMHelpFile.FormatLink(const s:String):string;
1658 // do not reformat for chms, we assume them internally consistent.
1659 begin
1660  formatlink:=s;
1661 end;
1662 
TChmHelpFile.SearchTopicnull1663 function TChmHelpFile.SearchTopic(HelpCtx: THelpCtx): PTopic;
MatchCtxnull1664 function MatchCtx(P: PTopic): boolean;
1665 begin
1666   MatchCtx:=P^.HelpCtx=HelpCtx;
1667 end;
1668 var FileID,LinkNo: word;
1669     P: PTopic;
1670     FName: string;
1671 begin
1672   DecodeHTMLCtx(HelpCtx,FileID,LinkNo);
1673   if (HelpCtx<>0) and (FileID<>ID) then P:=nil else
1674   if (FileID=ID) and (LinkNo>TopicLinks^.Count) then P:=nil else
1675     begin
1676       P:=Topics^.FirstThat(@MatchCtx);
1677       if P=nil then
1678         begin
1679           if LinkNo=0 then
1680             FName:=DefaultFileName
1681           else
1682             FName:=TopicLinks^.At(LinkNo-1)^;
1683           P:=NewTopic(ID,HelpCtx,0,FName,nil,0);
1684           Topics^.Insert(P);
1685         end;
1686     end;
1687   SearchTopic:=P;
1688 end;
1689 
TChmHelpFile.GetTopicInfonull1690 function TChmHelpFile.GetTopicInfo(T: PTopic) : string;
1691 var OK: boolean;
1692     Name: string;
1693     Link,Bookmark: string;
1694     P: sw_integer;
1695 begin
1696   Bookmark:='';
1697   OK:=T<>nil;
1698   if OK then
1699     begin
1700       if T^.HelpCtx=0 then
1701         begin
1702           Name:=DefaultFileName;
1703           P:=0;
1704         end
1705       else
1706         begin
1707           Link:=TopicLinks^.At((T^.HelpCtx and $ffff)-1)^;
1708           Link:=FormatPath(Link);
1709 {$IFDEF WDEBUG}
1710           DebugMessageS({$i %file%},' Looking for  "'+Link+'"',{$i %line%},'1',0,0);
1711 {$endif WDEBUG}
1712           P:=Pos('#',Link);
1713           if P>0 then
1714           begin
1715             Bookmark:=copy(Link,P+1,length(Link));
1716             Link:=copy(Link,1,P-1);
1717           end;
1718 {          if CurFileName='' then Name:=Link else
1719           Name:=CompletePath(CurFileName,Link);}
1720           Name:=Link;
1721         end;
1722     end;
1723   GetTopicInfo:=Name+'#'+BookMark;
1724 end;
1725 
TChmHelpFile.ReadTopicnull1726 function TChmHelpFile.ReadTopic(T: PTopic): boolean;
1727 var OK: boolean;
1728     HTMLFile: PMemoryTextFile;
1729     Name: string;
1730     Link,Bookmark: string;
1731     P: sw_integer;
1732 begin
1733   Bookmark:='';
1734   OK:=T<>nil;
1735   if OK then
1736     begin
1737       if T^.HelpCtx=0 then
1738         begin
1739           Name:=DefaultFileName;
1740           P:=0;
1741         end
1742       else
1743         begin
1744           Link:=TopicLinks^.At((T^.HelpCtx and $ffff)-1)^;
1745 {$IFDEF WDEBUG}
1746           DebugMessageS({$i %file%},' Looking for  "'+Link+'"',{$i %line%},'1',0,0);
1747 {$endif WDEBUG}
1748           Link:=FormatLink(Link);
1749 {$IFDEF WDEBUG}
1750           DebugMessageS({$i %file%},' Looking for (after formatlink)  "'+Link+'"',{$i %line%},'1',0,0);
1751 {$endif WDEBUG}
1752           P:=Pos('#',Link);
1753           if P>0 then
1754           begin
1755             Bookmark:=copy(Link,P+1,length(Link));
1756             Link:=copy(Link,1,P-1);
1757             {$IFDEF WDEBUG}
1758               debugMessageS({$i %file%},' Removed label: "'+Link+'"',{$i %line%},'1',0,0);
1759             {$endif WDEBUG}
1760           end;
1761 {          if CurFileName='' then Name:=Link else
1762           Name:=CompletePath(CurFileName,Link);}
1763           Name:=Link;
1764         end;
1765       HTMLFile:=nil;
1766       if Name<>'' then
1767         HTMLFile:=chmw.gettopic(name);
1768 
1769       if (HTMLFile=nil) and (CurFileName<>'') then
1770         begin
1771           Name:=CurFileName;
1772           HTMLFile:=chmw.gettopic(name);
1773         end;
1774       if (HTMLFile=nil) then
1775         begin
1776 {$IFDEF WDEBUG}
1777           DebugMessage(Link,' filename not known :(',1,1);
1778 {$endif WDEBUG}
1779         end;
1780       if (p>1) and (HTMLFile=nil) then
1781         begin
1782 {$IFDEF WDEBUG}
1783           if p>0 then
1784             DebugMessage(Name,Link+'#'+Bookmark+' not found',1,1)
1785           else
1786             DebugMessage(Name,Link+' not found',1,1);
1787 {$endif WDEBUG}
1788           New(HTMLFile, Init);
1789           HTMLFile^.AddLine('<HEAD><TITLE>'+msg_pagenotavailable+'</TITLE></HEAD>');
1790           HTMLFile^.AddLine(
1791             '<BODY>'+
1792             FormatStrStr(msg_cantaccessurl,Name)+'<br><br>'+
1793             '</BODY>');
1794         end;
1795       OK:=Renderer^.BuildTopic(T,Name,HTMLFile,TopicLinks);
1796       if OK then
1797         CurFileName:=Name
1798       else
1799         begin
1800 {$IFDEF WDEBUG}
1801           if p>0 then
1802             DebugMessage(Name,Link+'#'+Bookmark+' not found',1,1)
1803           else
1804             DebugMessage(Name,Link+' not found',1,1);
1805 {$endif WDEBUG}
1806         end;
1807       if HTMLFile<>nil then Dispose(HTMLFile, Done);
1808       if BookMark='' then
1809         T^.StartNamedMark:=0
1810       else
1811         begin
1812           P:=T^.GetNamedMarkIndex(BookMark);
1813 {$IFDEF WDEBUG}
1814           if p=-1 then
1815             DebugMessage(Name,Link+'#'+Bookmark+' bookmark not found',1,1);
1816 {$endif WDEBUG}
1817           T^.StartNamedMark:=P+1;
1818         end;
1819     end;
1820   ReadTopic:=OK;
1821 end;
1822 
1823 destructor TChmHelpFile.done;
1824 
1825 begin
1826  if assigned(chmw) then
1827   chmw.free;
1828  inherited Done;
1829 end;
1830 
CreateProcHTMLnull1831 function CreateProcHTML(const FileName,Param: string;Index : longint): PHelpFile;
1832 var H: PHelpFile;
1833 begin
1834   H:=nil;
1835   if CompareText(copy(ExtOf(FileName),1,length(extHTML)),extHTML)=0 then
1836     H:=New(PHTMLHelpFile, Init(FileName,Index,Param));
1837   CreateProcHTML:=H;
1838 end;
1839 
CreateProcCHMnull1840 function CreateProcCHM(const FileName,Param: string;Index : longint): PHelpFile;
1841 var H: PHelpFile;
1842 begin
1843   H:=nil;
1844   if CompareText(copy(ExtOf(FileName),1,length(extCHM)),extCHM)=0 then
1845     H:=New(PCHMHelpFile, Init(FileName,Index));
1846   CreateProcCHM:=H;
1847 end;
1848 
CreateProcHTMLIndexnull1849 function CreateProcHTMLIndex(const FileName,Param: string;Index : longint): PHelpFile;
1850 var H: PHelpFile;
1851 begin
1852   H:=nil;
1853   if CompareText(ExtOf(FileName),extHTMLIndex)=0 then
1854     H:=New(PHTMLIndexHelpFile, Init(FileName,Index));
1855   CreateProcHTMLIndex:=H;
1856 end;
1857 
1858 procedure RegisterHelpType;
1859 begin
1860   RegisterHelpFileType({$ifdef FPC}@{$endif}CreateProcHTML);
1861   RegisterHelpFileType({$ifdef FPC}@{$endif}CreateProcHTMLIndex);
1862   RegisterHelpFileType({$ifdef FPC}@{$endif}CreateProcCHM);
1863 end;
1864 
1865 
1866 END.
1867