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