whtmlhlp.pas 41 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604
  1. {
  2. This file is part of the Free Pascal Integrated Development Environment
  3. Copyright (c) 1999-2000 by Berczi Gabor
  4. See the file COPYING.FPC, included in this distribution,
  5. for details about the copyright.
  6. This program is distributed in the hope that it will be useful,
  7. but WITHOUT ANY WARRANTY; without even the implied warranty of
  8. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  9. **********************************************************************}
  10. unit WHTMLHlp;
  11. interface
  12. uses Objects,WHTML,WAnsi,WHelp;
  13. const
  14. extHTML = '.htm';
  15. extHTMLIndex = '.htx';
  16. ListIndent = 2;
  17. DefIndent = 4;
  18. MaxTopicLinks = 4000; { maximum number of links on a single HTML page }
  19. type
  20. THTMLSection = (hsNone,hsHeading1,hsHeading2,hsHeading3,hsHeading4,hsHeading5,hsHeading6);
  21. PTopicLinkCollection = ^TTopicLinkCollection;
  22. TTopicLinkCollection = object(TStringCollection)
  23. procedure Insert(Item: Pointer); virtual;
  24. function At(Index: sw_Integer): PString;
  25. function AddItem(Item: string): integer;
  26. end;
  27. TParagraphAlign = (paLeft,paCenter,paRight);
  28. PTableElement = ^TTableElement;
  29. TTableElement = object(Tobject)
  30. TextBegin,TextEnd, TextLength, NumNL : sw_word;
  31. Alignment : TParagraphAlign;
  32. NextEl : PTableElement;
  33. constructor init(AAlignment : TParagraphAlign);
  34. end;
  35. PTableLine = ^TTableLine;
  36. TTableLine = object(Tobject)
  37. NumElements : sw_word;
  38. Nextline : PTableLine;
  39. FirstEl,LastEl : PTableElement;
  40. constructor Init;
  41. procedure AddElement(PTE : PTableElement);
  42. destructor Done; virtual;
  43. end;
  44. PHTMLTopicRenderer = ^THTMLTopicRenderer;
  45. PTable = ^TTable;
  46. TTable = object(Tobject)
  47. NumLines,NumCols : sw_word;
  48. GlobalOffset,
  49. GlobalTextBegin : sw_word;
  50. WithBorder : boolean;
  51. IsBar : boolean;
  52. FirstLine : PTableLine;
  53. LastLine : PTableLine;
  54. PreviousTable : PTable;
  55. Renderer : PHTMLTopicRenderer;
  56. constructor Init(Previous : PTable);
  57. procedure AddLine(PL : PTableLine);
  58. procedure AddElement(PTE : PTableElement);
  59. procedure TextInsert(Pos : sw_word;const S : string);
  60. procedure FormatTable;
  61. destructor Done; virtual;
  62. end;
  63. THTMLTopicRenderer = object(THTMLParser)
  64. function BuildTopic(P: PTopic; AURL: string; HTMLFile: PTextFile; ATopicLinks: PTopicLinkCollection): boolean;
  65. public
  66. function DocAddTextChar(C: char): boolean; virtual;
  67. procedure DocSoftBreak; virtual;
  68. procedure DocTYPE; virtual;
  69. procedure DocHTML(Entered: boolean); virtual;
  70. procedure DocHEAD(Entered: boolean); virtual;
  71. procedure DocMETA; virtual;
  72. procedure DocTITLE(Entered: boolean); virtual;
  73. procedure DocBODY(Entered: boolean); virtual;
  74. procedure DocAnchor(Entered: boolean); virtual;
  75. procedure DocUnknownTag; virtual;
  76. procedure DocHeading(Level: integer; Entered: boolean); virtual;
  77. procedure DocParagraph(Entered: boolean); virtual;
  78. procedure DocBreak; virtual;
  79. procedure DocImage; virtual;
  80. procedure DocProcessComment(Comment: string); virtual;
  81. procedure DocBold(Entered: boolean); virtual;
  82. procedure DocCite(Entered: boolean); virtual;
  83. procedure DocCode(Entered: boolean); virtual;
  84. procedure DocEmphasized(Entered: boolean); virtual;
  85. procedure DocItalic(Entered: boolean); virtual;
  86. procedure DocKbd(Entered: boolean); virtual;
  87. procedure DocPreformatted(Entered: boolean); virtual;
  88. procedure DocSample(Entered: boolean); virtual;
  89. procedure DocStrong(Entered: boolean); virtual;
  90. procedure DocTeleType(Entered: boolean); virtual;
  91. procedure DocVariable(Entered: boolean); virtual;
  92. procedure DocSpan(Entered: boolean); virtual;
  93. procedure DocList(Entered: boolean); virtual;
  94. procedure DocOrderedList(Entered: boolean); virtual;
  95. procedure DocListItem(Entered: boolean); virtual;
  96. procedure DocDefList(Entered: boolean); virtual;
  97. procedure DocDefTerm(Entered: boolean); virtual;
  98. procedure DocDefExp(Entered: boolean); virtual;
  99. procedure DocTable(Entered: boolean); virtual;
  100. procedure DocTableRow(Entered: boolean); virtual;
  101. procedure DocTableHeaderItem(Entered: boolean); virtual;
  102. procedure DocTableItem(Entered: boolean); virtual;
  103. procedure DocHorizontalRuler; virtual;
  104. public
  105. function GetSectionColor(Section: THTMLSection; var Color: byte): boolean; virtual;
  106. private
  107. URL: string;
  108. Topic: PTopic;
  109. TopicLinks: PTopicLinkCollection;
  110. TextPtr: sw_word;
  111. InTitle: boolean;
  112. InBody: boolean;
  113. InAnchor: boolean;
  114. InParagraph: boolean;
  115. InPreformatted: boolean;
  116. SuppressOutput: boolean;
  117. SuppressUntil : string;
  118. InDefExp: boolean;
  119. TopicTitle: string;
  120. Indent: integer;
  121. AnyCharsInLine,
  122. LastAnsiLoadFailed: boolean;
  123. CurHeadLevel: integer;
  124. PAlign: TParagraphAlign;
  125. LinkIndexes: array[0..MaxTopicLinks] of sw_integer;
  126. LinkPtr: sw_integer;
  127. LastTextChar: char;
  128. { Anchor: TAnchor;}
  129. { Table stuff }
  130. CurrentTable : PTable;
  131. procedure AddText(const S: string);
  132. procedure AddChar(C: char);
  133. procedure AddCharAt(C: char;AtPtr : sw_word);
  134. function AddTextAt(const S: string;AtPtr : sw_word) : sw_word;
  135. function ComputeTextLength(TStart,TEnd : sw_word) : sw_word;
  136. end;
  137. PCustomHTMLHelpFile = ^TCustomHTMLHelpFile;
  138. TCustomHTMLHelpFile = object(THelpFile)
  139. constructor Init(AID: word);
  140. destructor Done; virtual;
  141. public
  142. function GetTopicInfo(T: PTopic) : string; virtual;
  143. function SearchTopic(HelpCtx: THelpCtx): PTopic; virtual;
  144. function ReadTopic(T: PTopic): boolean; virtual;
  145. private
  146. Renderer: PHTMLTopicRenderer;
  147. DefaultFileName: string;
  148. CurFileName: string;
  149. TopicLinks: PTopicLinkCollection;
  150. end;
  151. PHTMLHelpFile = ^THTMLHelpFile;
  152. THTMLHelpFile = object(TCustomHTMLHelpFile)
  153. constructor Init(AFileName: string; AID: word; ATOCEntry: string);
  154. public
  155. function LoadIndex: boolean; virtual;
  156. private
  157. TOCEntry: string;
  158. end;
  159. PHTMLIndexHelpFile = ^THTMLIndexHelpFile;
  160. THTMLIndexHelpFile = object(TCustomHTMLHelpFile)
  161. constructor Init(AFileName: string; AID: word);
  162. function LoadIndex: boolean; virtual;
  163. private
  164. IndexFileName: string;
  165. end;
  166. PHTMLAnsiView = ^THTMLAnsiView;
  167. PHTMLAnsiConsole = ^THTMLAnsiConsole;
  168. THTMLAnsiConsole = Object(TAnsiViewConsole)
  169. MaxX,MaxY : integer;
  170. procedure GotoXY(X,Y: integer); virtual;
  171. end;
  172. THTMLAnsiView = Object(TAnsiView)
  173. private
  174. HTMLOwner : PHTMLTopicRenderer;
  175. HTMLConsole : PHTMLAnsiConsole;
  176. public
  177. constructor Init(AOwner: PHTMLTopicRenderer);
  178. procedure CopyToHTML;
  179. end;
  180. THTMLGetSectionColorProc = function(Section: THTMLSection; var Color: byte): boolean;
  181. function DefHTMLGetSectionColor(Section: THTMLSection; var Color: byte): boolean;
  182. const HTMLGetSectionColor : THTMLGetSectionColorProc = {$ifdef fpc}@{$endif}DefHTMLGetSectionColor;
  183. procedure RegisterHelpType;
  184. implementation
  185. uses
  186. Views,WConsts,WUtils,WViews,WHTMLScn;
  187. constructor TTableElement.init(AAlignment : TParagraphAlign);
  188. begin
  189. Alignment:=AAlignment;
  190. NextEl:=nil;
  191. TextBegin:=0;
  192. TextEnd:=0;
  193. end;
  194. { TTableLine methods }
  195. constructor TTableLine.Init;
  196. begin
  197. NumElements:=0;
  198. NextLine:=nil;
  199. Firstel:=nil;
  200. LastEl:=nil;
  201. end;
  202. procedure TTableLine.AddElement(PTE : PTableElement);
  203. begin
  204. if not assigned(FirstEl) then
  205. FirstEl:=PTE;
  206. if assigned(LastEl) then
  207. LastEl^.NextEl:=PTE;
  208. LastEl:=PTE;
  209. Inc(NumElements);
  210. end;
  211. destructor TTableLine.Done;
  212. begin
  213. LastEl:=FirstEl;
  214. while assigned(LastEl) do
  215. begin
  216. LastEl:=FirstEl^.NextEl;
  217. Dispose(FirstEl,Done);
  218. FirstEl:=LastEl;
  219. end;
  220. inherited Done;
  221. end;
  222. { TTable methods }
  223. constructor TTable.Init(Previous : PTable);
  224. begin
  225. PreviousTable:=Previous;
  226. NumLines:=0;
  227. NumCols:=0;
  228. GlobalOffset:=0;
  229. GlobalTextBegin:=0;
  230. FirstLine:=nil;
  231. LastLine:=nil;
  232. WithBorder:=false;
  233. IsBar:=false;
  234. end;
  235. procedure TTable.AddLine(PL : PTableLine);
  236. begin
  237. If not assigned(FirstLine) then
  238. FirstLine:=PL;
  239. if Assigned(LastLine) then
  240. LastLine^.NextLine:=PL;
  241. LastLine:=PL;
  242. Inc(NumLines);
  243. end;
  244. procedure TTable.AddElement(PTE : PTableElement);
  245. begin
  246. if assigned(LastLine) then
  247. begin
  248. LastLine^.AddElement(PTE);
  249. If LastLine^.NumElements>NumCols then
  250. NumCols:=LastLine^.NumElements;
  251. end;
  252. end;
  253. procedure TTable.TextInsert(Pos : sw_word;const S : string);
  254. var
  255. i : sw_word;
  256. begin
  257. if S='' then
  258. exit;
  259. i:=Renderer^.AddTextAt(S,Pos+GlobalOffset);
  260. GlobalOffset:=GlobalOffset+i;
  261. end;
  262. procedure TTable.FormatTable;
  263. const
  264. MaxCols = 200;
  265. type
  266. TLengthArray = Array [ 1 .. MaxCols] of sw_word;
  267. PLengthArray = ^TLengthArray;
  268. var
  269. ColLengthArray : PLengthArray;
  270. RowSizeArray : PLengthArray;
  271. CurLine : PTableLine;
  272. CurEl : PTableElement;
  273. Align : TParagraphAlign;
  274. TextBegin,TextEnd : sw_word;
  275. i,j,k,Length : sw_word;
  276. begin
  277. { do nothing for single cell tables }
  278. if (NumCols=1) and (NumLines=1) then
  279. exit;
  280. GetMem(ColLengthArray,Sizeof(sw_word)*NumCols);
  281. FillChar(ColLengthArray^,Sizeof(sw_word)*NumCols,#0);
  282. GetMem(RowSizeArray,Sizeof(sw_word)*NumLines);
  283. FillChar(RowSizeArray^,Sizeof(sw_word)*NumLines,#0);
  284. { Compute the largest cell }
  285. CurLine:=FirstLine;
  286. For i:=1 to NumLines do
  287. begin
  288. CurEl:=CurLine^.FirstEl;
  289. RowSizeArray^[i]:=1;
  290. For j:=1 to NumCols do
  291. begin
  292. if not assigned(CurEl) then
  293. break;
  294. Length:=CurEl^.TextLength;
  295. if assigned(CurEl^.NextEl) and
  296. (CurEl^.NextEl^.TextBegin>CurEl^.TextEnd) then
  297. Inc(Length,Renderer^.ComputeTextLength(
  298. CurEl^.NextEl^.TextBegin+GlobalOffset,
  299. CurEl^.TextBegin+GlobalOffset));
  300. if Length>ColLengthArray^[j] then
  301. ColLengthArray^[j]:=Length;
  302. { We need to handle multiline cells... }
  303. if CurEl^.NumNL>=RowSizeArray^[i] then
  304. RowSizeArray^[i]:=CurEl^.NumNL;
  305. { We don't handle multiline cells yet... }
  306. if CurEl^.NumNL>=1 then
  307. begin
  308. for k:=CurEl^.TextBegin+GlobalOffset to
  309. CurEl^.TextEnd+GlobalOffset do
  310. if Renderer^.Topic^.Text^[k]=ord(hscLineBreak) then
  311. Renderer^.Topic^.Text^[k]:=ord(' ');
  312. end;
  313. CurEl:=CurEl^.NextEl;
  314. end;
  315. CurLine:=CurLine^.NextLine;
  316. end;
  317. { Adjust to largest cell }
  318. CurLine:=FirstLine;
  319. TextBegin:=GlobalTextBegin;
  320. If (NumLines>0) and WithBorder then
  321. Begin
  322. TextInsert(TextBegin,#218);
  323. For j:=1 to NumCols do
  324. begin
  325. TextInsert(TextBegin,CharStr(#196,ColLengthArray^[j]));
  326. if j<NumCols then
  327. TextInsert(TextBegin,#194);
  328. end;
  329. TextInsert(TextBegin,#191);
  330. TextInsert(TextBegin,hscLineBreak);
  331. End;
  332. For i:=1 to NumLines do
  333. begin
  334. CurEl:=CurLine^.FirstEl;
  335. For j:=1 to NumCols do
  336. begin
  337. if not assigned(CurEl) then
  338. begin
  339. Length:=0;
  340. Align:=paLeft;
  341. end
  342. else
  343. begin
  344. TextBegin:=CurEl^.TextBegin;
  345. TextEnd:=CurEl^.TextEnd;
  346. {While (TextEnd>TextBegin) and
  347. (Renderer^.Topic^.Text^[TextEnd+GlobalOffset]=ord(hscLineBreak)) do
  348. dec(TextEnd); }
  349. Length:=CurEl^.TextLength;
  350. Align:=CurEl^.Alignment;
  351. end;
  352. if WithBorder then
  353. TextInsert(TextBegin,#179)
  354. else
  355. TextInsert(TextBegin,' ');
  356. if Length<ColLengthArray^[j] then
  357. begin
  358. case Align of
  359. paLeft:
  360. TextInsert(TextEnd,CharStr(' ',ColLengthArray^[j]-Length));
  361. paRight:
  362. TextInsert(TextBegin,CharStr(' ',ColLengthArray^[j]-Length));
  363. paCenter:
  364. begin
  365. TextInsert(TextBegin,CharStr(' ',(ColLengthArray^[j]-Length) div 2));
  366. TextInsert(TextEnd,CharStr(' ',(ColLengthArray^[j]-Length)- ((ColLengthArray^[j]-Length) div 2)));
  367. end;
  368. end;
  369. end;
  370. if Assigned(CurEl) then
  371. CurEl:=CurEl^.NextEl;
  372. end;
  373. if WithBorder then
  374. TextInsert(TextEnd,#179);
  375. //TextInsert(TextEnd,hscLineBreak);
  376. CurLine:=CurLine^.NextLine;
  377. end;
  378. If (NumLines>0) and WithBorder then
  379. Begin
  380. TextInsert(TextEnd,hscLineBreak);
  381. TextInsert(TextEnd,#192);
  382. For j:=1 to NumCols do
  383. begin
  384. TextInsert(TextEnd,CharStr(#196,ColLengthArray^[j]));
  385. if j<NumCols then
  386. TextInsert(TextEnd,#193);
  387. end;
  388. TextInsert(TextEnd,#217);
  389. TextInsert(TextEnd,hscLineBreak);
  390. End;
  391. FreeMem(ColLengthArray,Sizeof(sw_word)*NumCols);
  392. FreeMem(RowSizeArray,Sizeof(sw_word)*NumLines);
  393. end;
  394. destructor TTable.Done;
  395. begin
  396. LastLine:=FirstLine;
  397. while assigned(LastLine) do
  398. begin
  399. LastLine:=FirstLine^.NextLine;
  400. Dispose(FirstLine,Done);
  401. FirstLine:=LastLine;
  402. end;
  403. if Assigned(PreviousTable) then
  404. Inc(PreviousTable^.GlobalOffset,GlobalOffset);
  405. inherited Done;
  406. end;
  407. { THTMLAnsiConsole methods }
  408. procedure THTMLAnsiConsole.GotoXY(X,Y : integer);
  409. begin
  410. if X>MaxX then MaxX:=X-1;
  411. if Y>MaxY then MaxY:=Y-1;
  412. inherited GotoXY(X,Y);
  413. end;
  414. { THTMLAnsiView methods }
  415. constructor THTMLAnsiView.Init(AOwner : PHTMLTopicRenderer);
  416. var
  417. R : TRect;
  418. begin
  419. if not assigned(AOwner) then
  420. fail;
  421. R.Assign(0,0,80,25);
  422. inherited init(R,nil,nil);
  423. HTMLOwner:=AOwner;
  424. HTMLConsole:=New(PHTMLAnsiConsole,Init(@Self));
  425. HTMLConsole^.HighVideo;
  426. Dispose(Console,Done);
  427. Console:=HTMLConsole;
  428. HTMLConsole^.Size.X:=80;
  429. HTMLConsole^.Size.Y:=25;
  430. HTMLConsole^.ClrScr;
  431. HTMLConsole^.MaxX:=-1;
  432. HTMLConsole^.MaxY:=-1;
  433. HTMLConsole^.BoundChecks:=0;
  434. end;
  435. procedure THTMLAnsiView.CopyToHTML;
  436. var
  437. Attr,NewAttr : byte;
  438. c : char;
  439. X,Y,Pos : longint;
  440. begin
  441. Attr:=(Buffer^[1] shr 8);
  442. HTMLOwner^.AddChar(hscLineBreak);
  443. HTMLOwner^.AddText(hscTextAttr+chr(Attr));
  444. for Y:=0 to HTMLConsole^.MaxY-1 do
  445. begin
  446. for X:=0 to HTMLConsole^.MaxX-1 do
  447. begin
  448. Pos:=(Delta.Y*MaxViewWidth)+X+Y*MaxViewWidth;
  449. NewAttr:=(Buffer^[Pos] shr 8);
  450. if NewAttr <> Attr then
  451. begin
  452. Attr:=NewAttr;
  453. HTMLOwner^.AddText(hscTextAttr+chr(Attr));
  454. end;
  455. c:= chr(Buffer^[Pos] and $ff);
  456. if ord(c)>16 then
  457. HTMLOwner^.AddChar(c)
  458. else
  459. begin
  460. HTMLOwner^.AddChar(hscDirect);
  461. HTMLOwner^.AddChar(c);
  462. end;
  463. end;
  464. { Write start of next line in normal color, for correct alignment }
  465. HTMLOwner^.AddChar(hscNormText);
  466. { Force to set attr again at start of next line }
  467. Attr:=0;
  468. HTMLOwner^.AddChar(hscLineBreak);
  469. end;
  470. end;
  471. function DefHTMLGetSectionColor(Section: THTMLSection; var Color: byte): boolean;
  472. begin
  473. Color:=0;
  474. DefHTMLGetSectionColor:=false;
  475. end;
  476. function EncodeHTMLCtx(FileID: integer; LinkNo: word): longint;
  477. var Ctx: longint;
  478. begin
  479. Ctx:=(longint(FileID) shl 16)+LinkNo;
  480. EncodeHTMLCtx:=Ctx;
  481. end;
  482. procedure DecodeHTMLCtx(Ctx: longint; var FileID: word; var LinkNo: word);
  483. begin
  484. if (Ctx shr 16)=0 then
  485. begin
  486. FileID:=$ffff; LinkNo:=0;
  487. end
  488. else
  489. begin
  490. FileID:=Ctx shr 16; LinkNo:=Ctx and $ffff;
  491. end;
  492. end;
  493. function CharStr(C: char; Count: byte): string;
  494. var S: string;
  495. begin
  496. S[0]:=chr(Count);
  497. if Count>0 then FillChar(S[1],Count,C);
  498. CharStr:=S;
  499. end;
  500. procedure TTopicLinkCollection.Insert(Item: Pointer);
  501. begin
  502. AtInsert(Count,Item);
  503. end;
  504. function TTopicLinkCollection.At(Index: sw_Integer): PString;
  505. begin
  506. At:=inherited At(Index);
  507. end;
  508. function TTopicLinkCollection.AddItem(Item: string): integer;
  509. var Idx: sw_integer;
  510. begin
  511. if Item='' then Idx:=-1 else
  512. if Search(@Item,Idx)=false then
  513. begin
  514. AtInsert(Count,NewStr(Item));
  515. Idx:=Count-1;
  516. end;
  517. AddItem:=Idx;
  518. end;
  519. function THTMLTopicRenderer.DocAddTextChar(C: char): boolean;
  520. var Added: boolean;
  521. begin
  522. Added:=false;
  523. if InTitle then
  524. begin
  525. TopicTitle:=TopicTitle+C;
  526. Added:=true;
  527. end
  528. else
  529. if InBody then
  530. begin
  531. if (InPreFormatted) or (C<>#32) or (LastTextChar<>C) then
  532. if (C<>#32) or (AnyCharsInLine=true) or (InPreFormatted=true) then
  533. begin
  534. AddChar(C);
  535. LastTextChar:=C;
  536. Added:=true;
  537. end;
  538. end;
  539. DocAddTextChar:=Added;
  540. end;
  541. procedure THTMLTopicRenderer.DocSoftBreak;
  542. begin
  543. if InPreformatted then DocBreak else
  544. if AnyCharsInLine and not assigned(CurrentTable) then
  545. begin
  546. AddChar(' ');
  547. LastTextChar:=' ';
  548. end;
  549. end;
  550. procedure THTMLTopicRenderer.DocTYPE;
  551. begin
  552. end;
  553. procedure THTMLTopicRenderer.DocHTML(Entered: boolean);
  554. begin
  555. end;
  556. procedure THTMLTopicRenderer.DocHEAD(Entered: boolean);
  557. begin
  558. end;
  559. procedure THTMLTopicRenderer.DocMETA;
  560. begin
  561. end;
  562. procedure THTMLTopicRenderer.DocTITLE(Entered: boolean);
  563. begin
  564. if Entered then
  565. begin
  566. TopicTitle:='';
  567. end
  568. else
  569. begin
  570. { render topic title here }
  571. if TopicTitle<>'' then
  572. begin
  573. AddText(' '+TopicTitle+' Ü'); DocBreak;
  574. AddText(' '+CharStr('ß',length(TopicTitle)+3)); DocBreak;
  575. end;
  576. end;
  577. InTitle:=Entered;
  578. end;
  579. procedure THTMLTopicRenderer.DocBODY(Entered: boolean);
  580. begin
  581. InBody:=Entered;
  582. end;
  583. procedure THTMLTopicRenderer.DocAnchor(Entered: boolean);
  584. var HRef,Name: string;
  585. begin
  586. if Entered and InAnchor then DocAnchor(false);
  587. if Entered then
  588. begin
  589. if DocGetTagParam('HREF',HRef)=false then HRef:='';
  590. if DocGetTagParam('NAME',Name)=false then Name:='';
  591. if {(HRef='') and} (Name='') then
  592. if DocGetTagParam('ID',Name)=false then
  593. Name:='';
  594. if Name<>'' then
  595. begin
  596. Topic^.NamedMarks^.InsertStr(Name);
  597. {$ifdef DEBUG}
  598. DebugMessage('',' Adding Name "'+Name+'"',1,1);
  599. {$endif DEBUG}
  600. AddChar(hscNamedMark);
  601. end;
  602. if (HRef<>'')then
  603. begin
  604. if (LinkPtr<MaxTopicLinks){ and
  605. not DisableCrossIndexing} then
  606. begin
  607. InAnchor:=true;
  608. AddChar(hscLink);
  609. if pos('#',HRef)=1 then
  610. Href:=NameAndExtOf(GetFilename)+Href;
  611. HRef:=CompleteURL(URL,HRef);
  612. LinkIndexes[LinkPtr]:=TopicLinks^.AddItem(HRef);
  613. {$ifdef DEBUG}
  614. DebugMessage('',' Adding Link "'+HRef+'"',1,1);
  615. {$endif DEBUG}
  616. Inc(LinkPtr);
  617. end;
  618. end;
  619. end
  620. else
  621. begin
  622. if InAnchor=true then AddChar(hscLink);
  623. InAnchor:=false;
  624. end;
  625. end;
  626. procedure THTMLTopicRenderer.DocUnknownTag;
  627. begin
  628. {$ifdef DEBUG}
  629. DebugMessage('',' Unknown tag "'+TagName+'" params "'+
  630. TagParams+'"',1,1);
  631. {$endif DEBUG}
  632. end;
  633. procedure DecodeAlign(Align: string; var PAlign: TParagraphAlign);
  634. begin
  635. Align:=UpcaseStr(Align);
  636. if Align='LEFT' then PAlign:=paLeft else
  637. if Align='CENTER' then PAlign:=paCenter else
  638. if Align='RIGHT' then PAlign:=paRight;
  639. end;
  640. procedure THTMLTopicRenderer.DocHeading(Level: integer; Entered: boolean);
  641. var Align: string;
  642. C: byte;
  643. SC: THTMLSection;
  644. begin
  645. if Entered then
  646. begin
  647. DocBreak;
  648. CurHeadLevel:=Level;
  649. PAlign:=paLeft;
  650. if DocGetTagParam('ALIGN',Align) then
  651. DecodeAlign(Align,PAlign);
  652. SC:=hsNone;
  653. case Level of
  654. 1: SC:=hsHeading1;
  655. 2: SC:=hsHeading2;
  656. 3: SC:=hsHeading3;
  657. 4: SC:=hsHeading4;
  658. 5: SC:=hsHeading5;
  659. 6: SC:=hsHeading6;
  660. end;
  661. if GetSectionColor(SC,C) then
  662. AddText(hscTextAttr+chr(C));
  663. end
  664. else
  665. begin
  666. AddChar(hscNormText);
  667. CurHeadLevel:=0;
  668. DocBreak;
  669. end;
  670. end;
  671. procedure THTMLTopicRenderer.DocParagraph(Entered: boolean);
  672. var Align: string;
  673. begin
  674. if Entered and InParagraph then DocParagraph(false);
  675. if Entered then
  676. begin
  677. if AnyCharsInLine then DocBreak;
  678. if DocGetTagParam('ALIGN',Align) then
  679. DecodeAlign(Align,PAlign);
  680. end
  681. else
  682. begin
  683. { if AnyCharsInLine then }DocBreak;
  684. PAlign:=paLeft;
  685. end;
  686. InParagraph:=Entered;
  687. end;
  688. procedure THTMLTopicRenderer.DocBreak;
  689. begin
  690. if (CurHeadLevel=1) or (PAlign=paCenter) then
  691. AddChar(hscCenter);
  692. if (PAlign=paRight) then
  693. AddChar(hscRight);
  694. AddChar(hscLineBreak);
  695. if Indent>0 then
  696. AddText(CharStr(#255,Indent)+hscLineStart);
  697. AnyCharsInLine:=false;
  698. end;
  699. procedure THTMLTopicRenderer.DocProcessComment(Comment: string);
  700. var
  701. src,index : string;
  702. begin
  703. if pos('tex4ht:',Comment)=0 then
  704. exit;
  705. {$ifdef DEBUG}
  706. DebugMessage(GetFileName,'tex4ht comment "'
  707. +Comment+'"',Line,1);
  708. {$endif DEBUG}
  709. if SuppressOutput then
  710. begin
  711. if (pos(SuppressUntil,Comment)=0) then
  712. exit
  713. else
  714. begin
  715. {$ifdef DEBUG}
  716. DebugMessage(GetFileName,' Found '+SuppressUntil+'comment "'
  717. +Comment+'" SuppressOuput reset to false',Line,1);
  718. {$endif DEBUG}
  719. SuppressOutput:=false;
  720. SuppressUntil:='';
  721. end;
  722. end;
  723. if (pos('tex4ht:graphics ',Comment)>0) and
  724. LastAnsiLoadFailed then
  725. begin
  726. {$ifdef DEBUG}
  727. DebugMessage(GetFileName,' Using tex4ht comment "'
  728. +Comment+'"',Line,1);
  729. {$endif DEBUG}
  730. { Try again with this info }
  731. TagParams:=Comment;
  732. DocImage;
  733. end;
  734. if (pos('tex4ht:syntaxdiagram ',Comment)>0) then
  735. begin
  736. {$ifdef DEBUG}
  737. DebugMessage(GetFileName,' Using tex4ht:syntaxdiagram comment "'
  738. +Comment+'"',Line,1);
  739. {$endif DEBUG}
  740. { Try again with this info }
  741. TagParams:=Comment;
  742. DocImage;
  743. if not LastAnsiLoadFailed then
  744. begin
  745. SuppressOutput:=true;
  746. SuppressUntil:='tex4ht:endsyntaxdiagram ';
  747. end
  748. end;
  749. if (pos('tex4ht:mysyntdiag ',Comment)>0) then
  750. begin
  751. {$ifdef DEBUG}
  752. DebugMessage(GetFileName,' Using tex4ht:mysyntdiag comment "'
  753. +Comment+'"',Line,1);
  754. {$endif DEBUG}
  755. { Try again with this info }
  756. TagParams:=Comment;
  757. DocGetTagParam('SRC',src);
  758. DocGetTagParam('INDEX',index);
  759. TagParams:='src="../syntax/'+src+'-'+index+'.png"';
  760. DocImage;
  761. if not LastAnsiLoadFailed then
  762. begin
  763. SuppressOutput:=true;
  764. SuppressUntil:='tex4ht:endmysyntdiag ';
  765. end
  766. end;
  767. end;
  768. procedure THTMLTopicRenderer.DocImage;
  769. var Name,Src,Alt,SrcLine: string;
  770. f : text;
  771. attr : byte;
  772. PA : PHTMLAnsiView;
  773. StorePreformatted : boolean;
  774. begin
  775. if SuppressOutput then
  776. exit;
  777. {$ifdef DEBUG}
  778. if not DocGetTagParam('NAME',Name) then
  779. Name:='<No name>';
  780. DebugMessage(GetFileName,' Image "'+Name+'"',Line,1);
  781. {$endif DEBUG}
  782. if DocGetTagParam('SRC',src) then
  783. begin
  784. {$ifdef DEBUG}
  785. DebugMessage(GetFileName,' Image source tag "'+Src+'"',Line,1);
  786. {$endif DEBUG}
  787. if src<>'' then
  788. begin
  789. src:=CompleteURL(URL,src);
  790. { this should be a image file ending by .gif or .jpg...
  791. Try to see if a file with same name and extension .git
  792. exists PM }
  793. src:=DirAndNameOf(src)+'.ans';
  794. {$ifdef DEBUG}
  795. DebugMessage(GetFileName,' Trying "'+Src+'"',Line,1);
  796. {$endif DEBUG}
  797. if not ExistsFile(src) then
  798. begin
  799. DocGetTagParam('SRC',src);
  800. src:=DirAndNameOf(src)+'.ans';
  801. src:=CompleteURL(DirOf(URL)+'../',src);
  802. {$ifdef DEBUG}
  803. DebugMessage(GetFileName,' Trying "'+Src+'"',Line,1);
  804. {$endif DEBUG}
  805. end;
  806. if not ExistsFile(src) then
  807. begin
  808. LastAnsiLoadFailed:=true;
  809. {$ifdef DEBUG}
  810. DebugMessage(GetFileName,' "'+Src+'" not found',Line,1);
  811. {$endif DEBUG}
  812. end
  813. else
  814. begin
  815. PA:=New(PHTMLAnsiView,init(@self));
  816. PA^.LoadFile(src);
  817. LastAnsiLoadFailed:=false;
  818. if AnyCharsInLine then DocBreak;
  819. StorePreformatted:=InPreformatted;
  820. InPreformatted:=true;
  821. {AddText('Image from '+src+hscLineBreak); }
  822. AddChar(hscInImage);
  823. PA^.CopyToHTML;
  824. InPreformatted:=StorePreformatted;
  825. AddChar(hscInImage);
  826. AddChar(hscNormText);
  827. if AnyCharsInLine then DocBreak;
  828. Dispose(PA,Done);
  829. Exit;
  830. end;
  831. { also look for a raw text file without colors }
  832. src:=DirAndNameOf(src)+'.txt';
  833. if not ExistsFile(src) then
  834. begin
  835. LastAnsiLoadFailed:=true;
  836. {$ifdef DEBUG}
  837. DebugMessage(GetFileName,' "'+Src+'" not found',Line,1);
  838. {$endif DEBUG}
  839. end
  840. else
  841. begin
  842. Assign(f,src);
  843. Reset(f);
  844. DocPreformatted(true);
  845. while not eof(f) do
  846. begin
  847. Readln(f,SrcLine);
  848. AddText(SrcLine+hscLineBreak);
  849. end;
  850. Close(f);
  851. LastAnsiLoadFailed:=false;
  852. DocPreformatted(false);
  853. LastAnsiLoadFailed:=false;
  854. Exit;
  855. end;
  856. end;
  857. end;
  858. if DocGetTagParam('ALT',Alt)=false then
  859. begin
  860. DocGetTagParam('SRC',Alt);
  861. if Alt<>'' then
  862. Alt:='Can''t display '+Alt
  863. else
  864. Alt:='IMG';
  865. end;
  866. if Alt<>'' then
  867. begin
  868. StorePreformatted:=InPreformatted;
  869. InPreformatted:=true;
  870. DocGetTagParam('SRC',src);
  871. AddChar(hscInImage);
  872. AddText('[--'+Src+'--'+hscLineBreak);
  873. AddText(Alt+hscLineBreak+'--]');
  874. AddChar(hscInImage);
  875. AddChar(hscNormText);
  876. InPreformatted:=StorePreformatted;
  877. end;
  878. end;
  879. procedure THTMLTopicRenderer.DocBold(Entered: boolean);
  880. begin
  881. end;
  882. procedure THTMLTopicRenderer.DocCite(Entered: boolean);
  883. begin
  884. end;
  885. procedure THTMLTopicRenderer.DocCode(Entered: boolean);
  886. begin
  887. if AnyCharsInLine then DocBreak;
  888. AddText(hscCode);
  889. DocBreak;
  890. end;
  891. procedure THTMLTopicRenderer.DocEmphasized(Entered: boolean);
  892. begin
  893. end;
  894. procedure THTMLTopicRenderer.DocItalic(Entered: boolean);
  895. begin
  896. end;
  897. procedure THTMLTopicRenderer.DocKbd(Entered: boolean);
  898. begin
  899. end;
  900. procedure THTMLTopicRenderer.DocPreformatted(Entered: boolean);
  901. begin
  902. if AnyCharsInLine then DocBreak;
  903. AddText(hscCode);
  904. DocBreak;
  905. InPreformatted:=Entered;
  906. end;
  907. procedure THTMLTopicRenderer.DocSample(Entered: boolean);
  908. begin
  909. end;
  910. procedure THTMLTopicRenderer.DocStrong(Entered: boolean);
  911. begin
  912. end;
  913. procedure THTMLTopicRenderer.DocTeleType(Entered: boolean);
  914. begin
  915. end;
  916. procedure THTMLTopicRenderer.DocVariable(Entered: boolean);
  917. begin
  918. end;
  919. procedure THTMLTopicRenderer.DocSpan(Entered: boolean);
  920. begin
  921. end;
  922. procedure THTMLTopicRenderer.DocList(Entered: boolean);
  923. begin
  924. if Entered then
  925. begin
  926. Inc(Indent,ListIndent);
  927. DocBreak;
  928. end
  929. else
  930. begin
  931. Dec(Indent,ListIndent);
  932. if AnyCharsInLine then DocBreak;
  933. end;
  934. end;
  935. procedure THTMLTopicRenderer.DocOrderedList(Entered: boolean);
  936. begin
  937. DocList(Entered);
  938. end;
  939. procedure THTMLTopicRenderer.DocListItem(Entered: boolean);
  940. begin
  941. if not Entered then
  942. exit;
  943. if AnyCharsInLine then
  944. DocBreak;
  945. AddText('þ'+hscLineStart);
  946. end;
  947. procedure THTMLTopicRenderer.DocDefList(Entered: boolean);
  948. begin
  949. if Entered then
  950. begin
  951. { if LastChar<>hscLineBreak then DocBreak;}
  952. end
  953. else
  954. begin
  955. if AnyCharsInLine then DocBreak;
  956. InDefExp:=false;
  957. end;
  958. end;
  959. procedure THTMLTopicRenderer.DocDefTerm(Entered: boolean);
  960. begin
  961. if not Entered then
  962. exit;
  963. DocBreak;
  964. end;
  965. procedure THTMLTopicRenderer.DocDefExp(Entered: boolean);
  966. begin
  967. if not Entered then
  968. begin
  969. if InDefExp then
  970. Dec(Indent,DefIndent);
  971. InDefExp:=false;
  972. end
  973. else
  974. begin
  975. if not InDefExp then
  976. Inc(Indent,DefIndent);
  977. InDefExp:=true;
  978. DocBreak;
  979. end;
  980. end;
  981. procedure THTMLTopicRenderer.DocTable(Entered: boolean);
  982. var
  983. ATable : PTable;
  984. Param : String;
  985. begin
  986. if AnyCharsInLine then
  987. begin
  988. AddChar(hscLineBreak);
  989. AnyCharsInLine:=false;
  990. end;
  991. if Entered then
  992. begin
  993. DocBreak;
  994. New(ATable,Init(CurrentTable));
  995. CurrentTable:=ATable;
  996. CurrentTable^.Renderer:=@Self;
  997. if DocGetTagParam('BORDER',Param) then
  998. if Param<>'0' then
  999. CurrentTable^.WithBorder:=true;
  1000. if DocGetTagParam('CLASS',Param) then
  1001. if Param='bar' then
  1002. CurrentTable^.IsBar:=true;
  1003. end
  1004. else
  1005. begin
  1006. CurrentTable^.FormatTable;
  1007. ATable:=CurrentTable;
  1008. CurrentTable:=ATable^.PreviousTable;
  1009. Dispose(ATable,Done);
  1010. end;
  1011. end;
  1012. procedure THTMLTopicRenderer.DocTableRow(Entered: boolean);
  1013. var
  1014. ATableLine : PTableLine;
  1015. begin
  1016. if AnyCharsInLine or
  1017. (assigned(CurrentTable) and
  1018. assigned(CurrentTable^.FirstLine)) then
  1019. begin
  1020. AddChar(hscLineBreak);
  1021. AnyCharsInLine:=false;
  1022. end;
  1023. if Entered then
  1024. begin
  1025. New(ATableLine,Init);
  1026. if CurrentTable^.GlobalTextBegin=0 then
  1027. CurrentTable^.GlobalTextBegin:=TextPtr;
  1028. CurrentTable^.AddLine(ATableLine);
  1029. end;
  1030. end;
  1031. procedure THTMLTopicRenderer.DocTableItem(Entered: boolean);
  1032. var
  1033. Align : String;
  1034. i : sw_word;
  1035. NewEl : PTableElement;
  1036. PAlignEl : TParagraphAlign;
  1037. begin
  1038. if Entered then
  1039. begin
  1040. if assigned(CurrentTable^.LastLine) and Assigned(CurrentTable^.LastLine^.LastEl) and
  1041. (CurrentTable^.LastLine^.LastEl^.TextEnd=sw_word(-1)) then
  1042. begin
  1043. NewEl:=CurrentTable^.LastLine^.LastEl;
  1044. NewEl^.TextEnd:=TextPtr;
  1045. NewEl^.TextLength:=ComputeTextLength(
  1046. NewEl^.TextBegin+CurrentTable^.GlobalOffset,
  1047. TextPtr+CurrentTable^.GlobalOffset);
  1048. end;
  1049. PAlignEl:=paLeft;
  1050. if DocGetTagParam('ALIGN',Align) then
  1051. DecodeAlign(Align,PAlignEl);
  1052. New(NewEl,Init(PAlignEl));
  1053. CurrentTable^.AddElement(NewEl);
  1054. NewEl^.TextBegin:=TextPtr;
  1055. NewEl^.TextEnd:=sw_word(-1);
  1056. { AddText(' - ');}
  1057. end
  1058. else
  1059. begin
  1060. NewEl:=CurrentTable^.LastLine^.LastEl;
  1061. NewEl^.TextEnd:=TextPtr;
  1062. NewEl^.TextLength:=ComputeTextLength(
  1063. NewEl^.TextBegin+CurrentTable^.GlobalOffset,
  1064. TextPtr+CurrentTable^.GlobalOffset);
  1065. NewEl^.NumNL:=0;
  1066. for i:=NewEl^.TextBegin to TextPtr do
  1067. begin
  1068. if Topic^.Text^[i]=ord(hscLineBreak) then
  1069. inc(NewEl^.NumNL);
  1070. end;
  1071. end;
  1072. end;
  1073. procedure THTMLTopicRenderer.DocTableHeaderItem(Entered: boolean);
  1074. begin
  1075. { Treat as a normal item }
  1076. DocTableItem(Entered);
  1077. end;
  1078. procedure THTMLTopicRenderer.DocHorizontalRuler;
  1079. var OAlign: TParagraphAlign;
  1080. begin
  1081. OAlign:=PAlign;
  1082. if AnyCharsInLine then DocBreak;
  1083. PAlign:=paCenter;
  1084. DocAddText(' '+CharStr('Ä',60)+' ');
  1085. DocBreak;
  1086. PAlign:=OAlign;
  1087. end;
  1088. procedure THTMLTopicRenderer.AddChar(C: char);
  1089. begin
  1090. if (Topic=nil) or (TextPtr=MaxBytes) or SuppressOutput then Exit;
  1091. Topic^.Text^[TextPtr]:=ord(C);
  1092. Inc(TextPtr);
  1093. if (C>#15) and ((C<>' ') or (InPreFormatted=true)) then
  1094. AnyCharsInLine:=true;
  1095. end;
  1096. procedure THTMLTopicRenderer.AddCharAt(C: char;AtPtr : sw_word);
  1097. begin
  1098. if (Topic=nil) or (TextPtr=MaxBytes) or SuppressOutput then Exit;
  1099. if AtPtr>TextPtr then
  1100. AtPtr:=TextPtr
  1101. else
  1102. begin
  1103. Move(Topic^.Text^[AtPtr],Topic^.Text^[AtPtr+1],TextPtr-AtPtr);
  1104. end;
  1105. Topic^.Text^[AtPtr]:=ord(C);
  1106. Inc(TextPtr);
  1107. end;
  1108. procedure THTMLTopicRenderer.AddText(const S: string);
  1109. var I: sw_integer;
  1110. begin
  1111. for I:=1 to length(S) do
  1112. AddChar(S[I]);
  1113. end;
  1114. function THTMLTopicRenderer.ComputeTextLength(TStart,TEnd : sw_word) : sw_word;
  1115. var I,tot: sw_integer;
  1116. begin
  1117. tot:=0;
  1118. i:=TStart;
  1119. while i<= TEnd-1 do
  1120. begin
  1121. inc(tot);
  1122. case chr(Topic^.Text^[i]) of
  1123. hscLink,hscCode,
  1124. hscCenter,hscRight,
  1125. hscNamedMark,hscNormText :
  1126. Dec(tot);{ Do not increase tot }
  1127. hscDirect:
  1128. begin
  1129. Inc(i); { Skip next }
  1130. //Inc(tot);
  1131. end;
  1132. hscTextAttr,
  1133. hscTextColor:
  1134. begin
  1135. Inc(i);
  1136. Dec(tot);
  1137. end;
  1138. end;
  1139. inc(i);
  1140. end;
  1141. ComputeTextLength:=tot;
  1142. end;
  1143. function THTMLTopicRenderer.AddTextAt(const S: String;AtPtr : sw_word) : sw_word;
  1144. var
  1145. i,slen,len : sw_word;
  1146. begin
  1147. if (Topic=nil) or (TextPtr>=MaxBytes) or SuppressOutput then Exit;
  1148. slen:=length(s);
  1149. if TextPtr+slen>=MaxBytes then
  1150. slen:=MaxBytes-TextPtr;
  1151. if AtPtr>TextPtr then
  1152. AtPtr:=TextPtr
  1153. else
  1154. begin
  1155. len:=TextPtr-AtPtr;
  1156. Move(Topic^.Text^[AtPtr],Topic^.Text^[AtPtr+slen],len);
  1157. end;
  1158. for i:=1 to slen do
  1159. begin
  1160. Topic^.Text^[AtPtr]:=ord(S[i]);
  1161. Inc(TextPtr);
  1162. inc(AtPtr);
  1163. if (TextPtr=MaxBytes) then Exit;
  1164. end;
  1165. AddTextAt:=slen;
  1166. end;
  1167. function THTMLTopicRenderer.GetSectionColor(Section: THTMLSection; var Color: byte): boolean;
  1168. begin
  1169. GetSectionColor:=HTMLGetSectionColor(Section,Color);
  1170. end;
  1171. function THTMLTopicRenderer.BuildTopic(P: PTopic; AURL: string; HTMLFile: PTextFile;
  1172. ATopicLinks: PTopicLinkCollection): boolean;
  1173. var OK: boolean;
  1174. TP: pointer;
  1175. I: sw_integer;
  1176. begin
  1177. URL:=AURL;
  1178. Topic:=P; TopicLinks:=ATopicLinks;
  1179. OK:=Assigned(Topic) and Assigned(HTMLFile) and Assigned(TopicLinks);
  1180. if OK then
  1181. begin
  1182. if (Topic^.TextSize<>0) and Assigned(Topic^.Text) then
  1183. begin
  1184. FreeMem(Topic^.Text,Topic^.TextSize);
  1185. Topic^.TextSize:=0; Topic^.Text:=nil;
  1186. end;
  1187. Topic^.TextSize:=MaxHelpTopicSize;
  1188. GetMem(Topic^.Text,Topic^.TextSize);
  1189. TopicTitle:='';
  1190. InTitle:=false; InBody:={false}true; InAnchor:=false;
  1191. InParagraph:=false; InPreformatted:=false;
  1192. Indent:=0; CurHeadLevel:=0;
  1193. PAlign:=paLeft;
  1194. TextPtr:=0; LinkPtr:=0;
  1195. AnyCharsInLine:=false;
  1196. LastTextChar:=#0;
  1197. SuppressUntil:='';
  1198. SuppressOutput:=false;
  1199. OK:=Process(HTMLFile);
  1200. if OK then
  1201. begin
  1202. { --- topic links --- }
  1203. if (Topic^.Links<>nil) and (Topic^.LinkSize>0) then
  1204. begin
  1205. FreeMem(Topic^.Links,Topic^.LinkSize);
  1206. Topic^.Links:=nil; Topic^.LinkCount:=0;
  1207. end;
  1208. Topic^.LinkCount:=LinkPtr{TopicLinks^.Count}; { <- eeeeeek! }
  1209. GetMem(Topic^.Links,Topic^.LinkSize);
  1210. if Topic^.LinkCount>0 then { FP causes numeric RTE 215 without this }
  1211. for I:=0 to Min(Topic^.LinkCount-1,High(LinkIndexes)-1) do
  1212. begin
  1213. Topic^.Links^[I].FileID:=Topic^.FileID;
  1214. Topic^.Links^[I].Context:=EncodeHTMLCtx(Topic^.FileID,LinkIndexes[I]+1);
  1215. end;
  1216. { --- topic text --- }
  1217. GetMem(TP,TextPtr);
  1218. Move(Topic^.Text^,TP^,TextPtr);
  1219. FreeMem(Topic^.Text,Topic^.TextSize);
  1220. Topic^.Text:=TP; Topic^.TextSize:=TextPtr;
  1221. end
  1222. else
  1223. begin
  1224. DisposeTopic(Topic);
  1225. Topic:=nil;
  1226. end;
  1227. end;
  1228. BuildTopic:=OK;
  1229. end;
  1230. constructor TCustomHTMLHelpFile.Init(AID: word);
  1231. begin
  1232. inherited Init(AID);
  1233. New(Renderer, Init);
  1234. New(TopicLinks, Init(50,500));
  1235. end;
  1236. function TCustomHTMLHelpFile.SearchTopic(HelpCtx: THelpCtx): PTopic;
  1237. function MatchCtx(P: PTopic): boolean; {$ifndef FPC}far;{$endif}
  1238. begin
  1239. MatchCtx:=P^.HelpCtx=HelpCtx;
  1240. end;
  1241. var FileID,LinkNo: word;
  1242. P: PTopic;
  1243. FName: string;
  1244. begin
  1245. DecodeHTMLCtx(HelpCtx,FileID,LinkNo);
  1246. if (HelpCtx<>0) and (FileID<>ID) then P:=nil else
  1247. if (FileID=ID) and (LinkNo>TopicLinks^.Count) then P:=nil else
  1248. begin
  1249. P:=Topics^.FirstThat(@MatchCtx);
  1250. if P=nil then
  1251. begin
  1252. if LinkNo=0 then
  1253. FName:=DefaultFileName
  1254. else
  1255. FName:=TopicLinks^.At(LinkNo-1)^;
  1256. P:=NewTopic(ID,HelpCtx,0,FName,nil,0);
  1257. Topics^.Insert(P);
  1258. end;
  1259. end;
  1260. SearchTopic:=P;
  1261. end;
  1262. function TCustomHTMLHelpFile.GetTopicInfo(T: PTopic) : string;
  1263. var OK: boolean;
  1264. Name: string;
  1265. Link,Bookmark: string;
  1266. P: sw_integer;
  1267. begin
  1268. Bookmark:='';
  1269. OK:=T<>nil;
  1270. if OK then
  1271. begin
  1272. if T^.HelpCtx=0 then
  1273. begin
  1274. Name:=DefaultFileName;
  1275. P:=0;
  1276. end
  1277. else
  1278. begin
  1279. Link:=TopicLinks^.At((T^.HelpCtx and $ffff)-1)^;
  1280. Link:=FormatPath(Link);
  1281. {$ifdef DEBUG_WHTMLHLP}
  1282. DebugMessage(Link,' looking for',1,1);
  1283. {$endif DEBUG_WHTMLHLP}
  1284. P:=Pos('#',Link);
  1285. if P>0 then
  1286. begin
  1287. Bookmark:=copy(Link,P+1,length(Link));
  1288. Link:=copy(Link,1,P-1);
  1289. end;
  1290. { if CurFileName='' then Name:=Link else
  1291. Name:=CompletePath(CurFileName,Link);}
  1292. Name:=Link;
  1293. end;
  1294. end;
  1295. GetTopicInfo:=Name+'#'+BookMark;
  1296. end;
  1297. function TCustomHTMLHelpFile.ReadTopic(T: PTopic): boolean;
  1298. var OK: boolean;
  1299. HTMLFile: PMemoryTextFile;
  1300. Name: string;
  1301. Link,Bookmark: string;
  1302. P: sw_integer;
  1303. begin
  1304. Bookmark:='';
  1305. OK:=T<>nil;
  1306. if OK then
  1307. begin
  1308. if T^.HelpCtx=0 then
  1309. begin
  1310. Name:=DefaultFileName;
  1311. P:=0;
  1312. end
  1313. else
  1314. begin
  1315. Link:=TopicLinks^.At((T^.HelpCtx and $ffff)-1)^;
  1316. Link:=FormatPath(Link);
  1317. {$ifdef DEBUG}
  1318. DebugMessage(Link,' looking for',1,1);
  1319. {$endif DEBUG}
  1320. P:=Pos('#',Link);
  1321. if P>0 then
  1322. begin
  1323. Bookmark:=copy(Link,P+1,length(Link));
  1324. Link:=copy(Link,1,P-1);
  1325. end;
  1326. { if CurFileName='' then Name:=Link else
  1327. Name:=CompletePath(CurFileName,Link);}
  1328. Name:=Link;
  1329. end;
  1330. HTMLFile:=nil;
  1331. if Name<>'' then
  1332. HTMLFile:=New(PDOSTextFile, Init(Name));
  1333. if (HTMLFile=nil)and (CurFileName<>'') then
  1334. begin
  1335. Name:=CurFileName;
  1336. HTMLFile:=New(PDOSTextFile, Init(Name));
  1337. end;
  1338. if (HTMLFile=nil) then
  1339. begin
  1340. {$ifdef DEBUG}
  1341. DebugMessage(Link,' filename not known :(',1,1);
  1342. {$endif DEBUG}
  1343. end;
  1344. if (p>1) and (HTMLFile=nil) then
  1345. begin
  1346. {$ifdef DEBUG}
  1347. if p>0 then
  1348. DebugMessage(Name,Link+'#'+Bookmark+' not found',1,1)
  1349. else
  1350. DebugMessage(Name,Link+' not found',1,1);
  1351. {$endif DEBUG}
  1352. New(HTMLFile, Init);
  1353. HTMLFile^.AddLine('<HEAD><TITLE>'+msg_pagenotavailable+'</TITLE></HEAD>');
  1354. HTMLFile^.AddLine(
  1355. '<BODY>'+
  1356. FormatStrStr(msg_cantaccessurl,Name)+'<br><br>'+
  1357. '</BODY>');
  1358. end;
  1359. OK:=Renderer^.BuildTopic(T,Name,HTMLFile,TopicLinks);
  1360. if OK then
  1361. CurFileName:=Name
  1362. else
  1363. begin
  1364. {$ifdef DEBUG}
  1365. if p>0 then
  1366. DebugMessage(Name,Link+'#'+Bookmark+' not found',1,1)
  1367. else
  1368. DebugMessage(Name,Link+' not found',1,1);
  1369. {$endif DEBUG}
  1370. end;
  1371. if HTMLFile<>nil then Dispose(HTMLFile, Done);
  1372. if BookMark='' then
  1373. T^.StartNamedMark:=0
  1374. else
  1375. begin
  1376. P:=T^.GetNamedMarkIndex(BookMark);
  1377. {$ifdef DEBUG}
  1378. if p=-1 then
  1379. DebugMessage(Name,Link+'#'+Bookmark+' bookmark not found',1,1);
  1380. {$endif DEBUG}
  1381. T^.StartNamedMark:=P+1;
  1382. end;
  1383. end;
  1384. ReadTopic:=OK;
  1385. end;
  1386. destructor TCustomHTMLHelpFile.Done;
  1387. begin
  1388. inherited Done;
  1389. if Renderer<>nil then Dispose(Renderer, Done);
  1390. if TopicLinks<>nil then Dispose(TopicLinks, Done);
  1391. end;
  1392. constructor THTMLHelpFile.Init(AFileName: string; AID: word; ATOCEntry: string);
  1393. begin
  1394. if inherited Init(AID)=false then Fail;
  1395. DefaultFileName:=AFileName; TOCEntry:=ATOCEntry;
  1396. if DefaultFileName='' then
  1397. begin
  1398. Done;
  1399. Fail;
  1400. end;
  1401. end;
  1402. function THTMLHelpFile.LoadIndex: boolean;
  1403. begin
  1404. IndexEntries^.Insert(NewIndexEntry(TOCEntry,ID,0));
  1405. LoadIndex:=true;
  1406. end;
  1407. constructor THTMLIndexHelpFile.Init(AFileName: string; AID: word);
  1408. begin
  1409. inherited Init(AID);
  1410. IndexFileName:=AFileName;
  1411. end;
  1412. function THTMLIndexHelpFile.LoadIndex: boolean;
  1413. function FormatAlias(Alias: string): string;
  1414. begin
  1415. if Assigned(HelpFacility) then
  1416. if length(Alias)>HelpFacility^.IndexTabSize-4 then
  1417. Alias:=Trim(copy(Alias,1,HelpFacility^.IndexTabSize-4-2))+'..';
  1418. FormatAlias:=Alias;
  1419. end;
  1420. (*procedure AddDoc(P: PHTMLLinkScanDocument); {$ifndef FPC}far;{$endif}
  1421. var I: sw_integer;
  1422. TLI: THelpCtx;
  1423. begin
  1424. for I:=1 to P^.GetAliasCount do
  1425. begin
  1426. TLI:=TopicLinks^.AddItem(P^.GetName);
  1427. TLI:=EncodeHTMLCtx(ID,TLI+1);
  1428. IndexEntries^.Insert(NewIndexEntry(FormatAlias(P^.GetAlias(I-1)),ID,TLI));
  1429. end;
  1430. end;*)
  1431. var S: PBufStream;
  1432. LS: PHTMLLinkScanner;
  1433. OK: boolean;
  1434. TLI: THelpCtx;
  1435. I,J: sw_integer;
  1436. begin
  1437. New(S, Init(IndexFileName,stOpenRead,4096));
  1438. OK:=Assigned(S);
  1439. if OK then
  1440. begin
  1441. New(LS, LoadDocuments(S^));
  1442. OK:=Assigned(LS);
  1443. if OK then
  1444. begin
  1445. LS^.SetBaseDir(DirOf(IndexFileName));
  1446. for I:=0 to LS^.GetDocumentCount-1 do
  1447. begin
  1448. TLI:=TopicLinks^.AddItem(LS^.GetDocumentURL(I));
  1449. TLI:=EncodeHTMLCtx(ID,TLI+1);
  1450. for J:=0 to LS^.GetDocumentAliasCount(I)-1 do
  1451. IndexEntries^.Insert(NewIndexEntry(
  1452. FormatAlias(LS^.GetDocumentAlias(I,J)),ID,TLI));
  1453. end;
  1454. Dispose(LS, Done);
  1455. end;
  1456. Dispose(S, Done);
  1457. end;
  1458. LoadIndex:=OK;
  1459. end;
  1460. function CreateProcHTML(const FileName,Param: string;Index : longint): PHelpFile; {$ifndef FPC}far;{$endif}
  1461. var H: PHelpFile;
  1462. begin
  1463. H:=nil;
  1464. if CompareText(copy(ExtOf(FileName),1,length(extHTML)),extHTML)=0 then
  1465. H:=New(PHTMLHelpFile, Init(FileName,Index,Param));
  1466. CreateProcHTML:=H;
  1467. end;
  1468. function CreateProcHTMLIndex(const FileName,Param: string;Index : longint): PHelpFile; {$ifndef FPC}far;{$endif}
  1469. var H: PHelpFile;
  1470. begin
  1471. H:=nil;
  1472. if CompareText(ExtOf(FileName),extHTMLIndex)=0 then
  1473. H:=New(PHTMLIndexHelpFile, Init(FileName,Index));
  1474. CreateProcHTMLIndex:=H;
  1475. end;
  1476. procedure RegisterHelpType;
  1477. begin
  1478. RegisterHelpFileType({$ifdef FPC}@{$endif}CreateProcHTML);
  1479. RegisterHelpFileType({$ifdef FPC}@{$endif}CreateProcHTMLIndex);
  1480. end;
  1481. END.