whtml.pas 25 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722
  1. {
  2. This file is part of the Free Pascal Integrated Development Environment
  3. Copyright (c) 1998 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 WHTML;
  11. {$I globdir.inc}
  12. interface
  13. uses Objects;
  14. type
  15. PTextFile = ^TTextFile;
  16. TTextFile = object(TObject)
  17. function GetLine(Idx: sw_integer; var S: string): boolean; virtual;
  18. end;
  19. PMemoryTextFile = ^TMemoryTextFile;
  20. TMemoryTextFile = object(TTextFile)
  21. constructor Init;
  22. procedure AddLine(const S: string); virtual;
  23. function GetLine(Idx: sw_integer; var S: string): boolean; virtual;
  24. destructor Done; virtual;
  25. private
  26. Lines : PUnsortedStrCollection;
  27. end;
  28. PDOSTextFile = ^TDOSTextFile;
  29. TDOSTextFile = object(TMemoryTextFile)
  30. constructor Init(AFileName: string);
  31. end;
  32. PSGMLParser = ^TSGMLParser;
  33. TSGMLParser = object(TObject)
  34. constructor Init;
  35. function Process(HTMLFile: PTextFile): boolean; virtual;
  36. function ProcessLine(LineText: string): boolean; virtual;
  37. destructor Done; virtual;
  38. public
  39. Line,LinePos: sw_integer;
  40. procedure DocSoftBreak; virtual;
  41. function DocAddTextChar(C: char): boolean; virtual;
  42. procedure DocAddText(S: string); virtual;
  43. procedure DocProcessTag(Tag: string); virtual;
  44. procedure DocProcessComment(Comment: string); virtual;
  45. function DocDecodeNamedEntity(Name: string; var Entity: string): boolean; virtual;
  46. private
  47. CurTag: string;
  48. InTag,InComment,InString: boolean;
  49. end;
  50. PHTMLParser = ^THTMLParser;
  51. THTMLParser = object(TSGMLParser)
  52. procedure DocSoftBreak; virtual;
  53. function DocAddTextChar(C: char): boolean; virtual;
  54. procedure DocProcessTag(Tag: string); virtual;
  55. function DocGetTagParam(Name: string; var Value: string): boolean; virtual;
  56. procedure DocProcessComment(Comment: string); virtual;
  57. function DocDecodeNamedEntity(Name: string; var E: string): boolean; virtual;
  58. public
  59. TagName,TagParams: string;
  60. procedure DocUnknownTag; virtual;
  61. procedure DocTYPE; virtual;
  62. procedure DocHTML(Entered: boolean); virtual;
  63. procedure DocHEAD(Entered: boolean); virtual;
  64. procedure DocMETA; virtual;
  65. procedure DocTITLE(Entered: boolean); virtual;
  66. procedure DocBODY(Entered: boolean); virtual;
  67. procedure DocAnchor(Entered: boolean); virtual;
  68. procedure DocHeading(Level: integer; Entered: boolean); virtual;
  69. procedure DocParagraph(Entered: boolean); virtual;
  70. procedure DocBreak; virtual;
  71. procedure DocImage; virtual;
  72. procedure DocBold(Entered: boolean); virtual;
  73. procedure DocCite(Entered: boolean); virtual;
  74. procedure DocCode(Entered: boolean); virtual;
  75. procedure DocEmphasized(Entered: boolean); virtual;
  76. procedure DocItalic(Entered: boolean); virtual;
  77. procedure DocKbd(Entered: boolean); virtual;
  78. procedure DocPreformatted(Entered: boolean); virtual;
  79. procedure DocSample(Entered: boolean); virtual;
  80. procedure DocStrong(Entered: boolean); virtual;
  81. procedure DocTeleType(Entered: boolean); virtual;
  82. procedure DocVariable(Entered: boolean); virtual;
  83. procedure DocList(Entered: boolean); virtual;
  84. procedure DocOrderedList(Entered: boolean); virtual;
  85. procedure DocListItem; virtual;
  86. procedure DocDefList(Entered: boolean); virtual;
  87. procedure DocDefTerm; virtual;
  88. procedure DocDefExp; virtual;
  89. procedure DocTable(Entered: boolean); virtual;
  90. procedure DocTableRow(Entered: boolean); virtual;
  91. procedure DocTableHeaderItem(Entered: boolean); virtual;
  92. procedure DocTableItem(Entered: boolean); virtual;
  93. procedure DocHorizontalRuler; virtual;
  94. end;
  95. implementation
  96. uses WUtils;
  97. function TTextFile.GetLine(Idx: sw_integer; var S: string): boolean;
  98. begin
  99. Abstract;
  100. GetLine:=false;
  101. end;
  102. constructor TMemoryTextFile.Init;
  103. begin
  104. inherited Init;
  105. New(Lines, Init(500,500));
  106. end;
  107. procedure TMemoryTextFile.AddLine(const S: string);
  108. begin
  109. Lines^.Insert(NewStr(S));
  110. end;
  111. function TMemoryTextFile.GetLine(Idx: sw_integer; var S: string): boolean;
  112. var OK: boolean;
  113. PS: PString;
  114. begin
  115. OK:=(Lines<>nil) and (Idx<Lines^.Count);
  116. if OK then
  117. begin
  118. PS:=Lines^.At(Idx);
  119. if PS=nil then S:='' else S:=PS^;
  120. end;
  121. GetLine:=OK;
  122. end;
  123. destructor TMemoryTextFile.Done;
  124. begin
  125. inherited Done;
  126. if Lines<>nil then Dispose(Lines, Done); Lines:=nil;
  127. end;
  128. constructor TDOSTextFile.Init(AFileName: string);
  129. (*{$ifdef TPUNIXLF}
  130. procedure readln(var t:text;var s:string);
  131. var
  132. c : char;
  133. i : longint;
  134. begin
  135. c:=#0;
  136. i:=0;
  137. while (not eof(t)) and (c<>#10) and (i<255) do
  138. begin
  139. read(t,c);
  140. if (i<255) and (c<>#10) then
  141. begin
  142. inc(i);
  143. s[i]:=c;
  144. end;
  145. end;
  146. if (i>0) and (s[i]=#13) then
  147. dec(i);
  148. s[0]:=chr(i);
  149. end;
  150. {$endif}*)
  151. var f: text;
  152. S: string;
  153. begin
  154. inherited Init;
  155. if AFileName='' then Fail;
  156. {$I-}
  157. Assign(f,AFileName);
  158. Reset(f);
  159. if IOResult<>0 then Fail;
  160. New(Lines, Init(500,2000));
  161. while (Eof(f)=false) and (IOResult=0) do
  162. begin
  163. readln(f,S); { this is the one in WUTILS.PAS }
  164. AddLine(S);
  165. end;
  166. Close(f);
  167. {$I+}
  168. end;
  169. constructor TSGMLParser.Init;
  170. begin
  171. inherited Init;
  172. end;
  173. function TSGMLParser.Process(HTMLFile: PTextFile): boolean;
  174. var S: string;
  175. OK,LineOK: boolean;
  176. begin
  177. if HTMLFile=nil then Exit;
  178. InTag:=false; InComment:=false; InString:=false; CurTag:='';
  179. Line:=0; OK:=true;
  180. repeat
  181. LineOK:=HTMLFile^.GetLine(Line,S);
  182. if LineOK then
  183. begin
  184. OK:=ProcessLine(S);
  185. Inc(Line);
  186. end;
  187. until (LineOK=false) or (OK=false);
  188. Process:=OK;
  189. end;
  190. function TSGMLParser.ProcessLine(LineText: string): boolean;
  191. var OK: boolean;
  192. C: char;
  193. NewInString: boolean;
  194. OldInComment: boolean;
  195. WasThereAnyText: boolean;
  196. Pos2: integer;
  197. Name,Entity: string;
  198. LiteralCode: boolean;
  199. LiteralStart,LiteralEnd,P: integer;
  200. const TabSize : integer = 8;
  201. Tab = #9;
  202. begin
  203. WasThereAnyText:=false;
  204. OK:=true; LinePos:=1;
  205. LiteralStart:=0; LiteralEnd:=0;
  206. repeat
  207. P:=Pos(TAB,LineText);
  208. if P>0 then
  209. LineText:=copy(LineText,1,P-1)+CharStr(' ',TabSize)+copy(LineText,P+1,255);
  210. until P=0;
  211. while (LinePos<=length(LineText)) and OK do
  212. begin
  213. LiteralCode:=false;
  214. NewInString:=InString; OldInComment:=InComment;
  215. C:=LineText[LinePos];
  216. LiteralCode:=(LiteralStart<=LinePos) and (LinePos<=LiteralEnd);
  217. if (LiteralCode=false) and (C='&') then
  218. begin
  219. LiteralStart:=0; LiteralEnd:=0;
  220. Name:=''; Pos2:=LinePos+1;
  221. while (Pos2<=length(LineText)) and (LineText[Pos2]<>';') do
  222. begin
  223. Name:=Name+LineText[Pos2];
  224. Inc(Pos2);
  225. end;
  226. Inc(Pos2);
  227. if DocDecodeNamedEntity(Name,Entity) then
  228. begin
  229. LineText:=copy(LineText,1,LinePos-1)+Entity+copy(LineText,Pos2,255);
  230. LiteralStart:=LinePos; LiteralEnd:=LiteralStart+length(Entity)-1;
  231. C:=LineText[LinePos];
  232. end;
  233. end;
  234. LiteralCode:=(LiteralStart<=LinePos) and (LinePos<=LiteralEnd);
  235. if (LiteralCode=false) and (C='"') and (InTag=true) and (InString=false) then
  236. NewInString:=true;
  237. if (LiteralCode=false) and (C='<') and (InTag=false) then
  238. InTag:=true;
  239. if InTag then CurTag:=CurTag+C else
  240. WasThereAnyText:=DocAddTextChar(C);
  241. if (LiteralCode=false) and InTag and (InString=false) and (CurTag='<!--') then
  242. InComment:=true;
  243. { A comment can be longer than 255 chars
  244. move the test to LineText string,
  245. This is why the Previous, Next and Up Tags where not working ... PM
  246. if (LiteralCode=false) and InTag and InComment and (InString=false) and (length(CurTag)>=3) and
  247. (copy(CurTag,length(CurTag)-2,3)='-->') then
  248. InComment:=false; }
  249. if (LiteralCode=false) and InTag and InComment and (InString=false) and (LinePos>=3) and
  250. (copy(LineText,LinePos-2,3)='-->') then
  251. InComment:=false;
  252. if (LiteralCode=false) and (C='"') and (InTag=true) and (InString=true) then
  253. NewInString:=false;
  254. if (LiteralCode=false) and (C='>') and (InTag=true) then
  255. begin
  256. InTag:=false;
  257. if OldInComment then
  258. DocProcessComment(CurTag)
  259. else
  260. DocProcessTag(CurTag);
  261. CurTag:='';
  262. end;
  263. InString:=NewInString;
  264. Inc(LinePos);
  265. end;
  266. { whtml does not depend on whelp,
  267. so I can not use hscLineBreak here. PM }
  268. if InTag and InString then
  269. CurTag:=CurTag+#0
  270. else if WasThereAnyText then DocSoftBreak;
  271. ProcessLine:=true;
  272. end;
  273. procedure TSGMLParser.DocSoftBreak;
  274. begin
  275. Abstract;
  276. end;
  277. function TSGMLParser.DocAddTextChar(C: char): boolean;
  278. begin
  279. Abstract;
  280. DocAddTextChar:=false;
  281. end;
  282. procedure TSGMLParser.DocAddText(S: string);
  283. var I: sw_integer;
  284. begin
  285. for I:=1 to length(S) do
  286. DocAddTextChar(S[I]);
  287. end;
  288. function TSGMLParser.DocDecodeNamedEntity(Name: string; var Entity: string): boolean;
  289. begin
  290. DocDecodeNamedEntity:=false;
  291. end;
  292. procedure TSGMLParser.DocProcessTag(Tag: string);
  293. begin
  294. Abstract;
  295. end;
  296. procedure TSGMLParser.DocProcessComment(Comment: string);
  297. begin
  298. Abstract;
  299. end;
  300. destructor TSGMLParser.Done;
  301. begin
  302. inherited Done;
  303. end;
  304. procedure THTMLParser.DocSoftBreak;
  305. begin
  306. end;
  307. function THTMLParser.DocAddTextChar(C: char): boolean;
  308. begin
  309. { Abstract }
  310. DocAddTextChar:=false;
  311. end;
  312. function THTMLParser.DocDecodeNamedEntity(Name: string; var E: string): boolean;
  313. var Found: boolean;
  314. Code: integer;
  315. CC: integer;
  316. begin
  317. Found:=true; Code:=-1;
  318. Name:=LowCaseStr(Name);
  319. if copy(Name,1,1)='#' then
  320. begin
  321. Val(copy(Name,2,255),Code,CC);
  322. if CC<>0 then Code:=-1;
  323. end;
  324. if (Name='lt') then E:='<' else { less-than sign }
  325. if (Name='gt') then E:='>' else { greater-than sign }
  326. if (Name='amp') then E:='&' else { ampersand }
  327. if (Name='quot') then E:='"' else { double quote sign }
  328. if (Code=160) or (Name='nbsp') then E:=#255 else { no-break space }
  329. if (Code=161) or (Name='iexcl') then E:='­' else { inverted excalamation mark }
  330. if (Code=162) or (Name='cent') then E:='›' else { cent sign }
  331. if (Code=163) or (Name='pound') then E:='œ' else { pound sterling sign }
  332. if (Code=164) or (Name='curren') then E:='$' else { general currency sign }
  333. if (Code=165) or (Name='yen') then E:='�' else { yen sign }
  334. if (Code=166) or (Name='brvbar') then E:='|' else { broken vertical bar }
  335. (* if (Code=167) or (Name='sect') then E:=#255 else { section sign }*)
  336. (* if (Code=168) or (Name='uml') then E:=#255 else { umlaut (dieresis) }*)
  337. if (Code=169) or (Name='copy') then E:='(C)' else { copyright sign }
  338. (* if (Code=170) or (Name='ordf') then E:=#255 else { ordinal indicator, feminine }*)
  339. if (Code=171) or (Name='laquo') then E:='"' else { angle quotation mark -left }
  340. if (Code=172) or (Name='not') then E:='!' else { not sign }
  341. if (Code=173) or (Name='shy') then E:='-' else { soft hypen }
  342. if (Code=174) or (Name='reg') then E:='(R)' else { registered sign }
  343. (* if (Code=175) or (Name='macr') then E:='?' else { macron }*)
  344. if (Code=176) or (Name='deg') then E:='ø' else { degree sign }
  345. if (Code=177) or (Name='plusmn') then E:='ñ' else { plus-or-minus sign }
  346. if (Code=178) or (Name='sup2') then E:='ý' else { superscript 2 }
  347. if (Code=179) or (Name='sup3') then E:='^3' else { superscript 3 }
  348. if (Code=180) or (Name='acute') then E:='''' else { acute accent }
  349. if (Code=181) or (Name='micro') then E:='æ' else { micro sign }
  350. (* if (Code=182) or (Name='para') then E:='?' else { paragraph sign }*)
  351. if (Code=183) or (Name='middot') then E:='ù' else { middle dot }
  352. (* if (Code=184) or (Name='cedil') then E:='?' else { cedilla }*)
  353. if (Code=185) or (Name='sup1') then E:='^1' else { superscript 1 }
  354. (* if (Code=186) or (Name='ordm') then E:='?' else { ordinal indicator, masculine }*)
  355. if (Code=187) or (Name='raquo') then E:='"' else { angle quoatation mark -right }
  356. if (Code=188) or (Name='frac14') then E:='¬' else { fraction one-quarter }
  357. if (Code=189) or (Name='frac12') then E:='«' else { fraction one-half }
  358. if (Code=190) or (Name='frac34') then E:='3/4' else { fraction three-quarters }
  359. if (Code=191) or (Name='iquest') then E:='¨' else { inverted question mark }
  360. if (Code=192) or (Name='Agrave') then E:='A' else { capital A, grave accent }
  361. if (Code=193) or (Name='Aacute') then E:='A' else { capital A, acute accent }
  362. if (Code=194) or (Name='Acirc') then E:='A' else { capital A, circumflex accent }
  363. if (Code=195) or (Name='Atilde') then E:='A' else { capital A, tilde accent }
  364. if (Code=196) or (Name='Auml') then E:='Ž' else { capital A, dieresis or umlaut }
  365. if (Code=197) or (Name='Aring') then E:='�' else { capital A, ring }
  366. if (Code=198) or (Name='AElig') then E:='AE' else { capital AE diphthong }
  367. (* if (Code=199) or (Name='Ccedil') then E:='?' else { capital C, cedilla }*)
  368. if (Code=200) or (Name='Egrave') then E:='�' else { capital E, grave accent }
  369. if (Code=201) or (Name='Eacute') then E:='�' else { capital E, acute accent }
  370. if (Code=202) or (Name='Ecirc') then E:='E' else { capital E, circumflex accent }
  371. if (Code=203) or (Name='Euml') then E:='E' else { capital E, dieresis or umlaut }
  372. if (Code=204) or (Name='Igrave') then E:='I' else { capital I, grave accent }
  373. if (Code=205) or (Name='Iacute') then E:='I' else { capital I, acute accent }
  374. if (Code=206) or (Name='Icirc') then E:='I' else { capital I, circumflex accent }
  375. if (Code=207) or (Name='Iuml') then E:='I' else { capital I, dieresis or umlaut }
  376. (* if (Code=208) or (Name='ETH') then E:='?' else { capital Eth, Icelandic }*)
  377. if (Code=209) or (Name='Ntidle') then E:='¥' else { capital N, tilde }
  378. if (Code=210) or (Name='Ograve') then E:='O' else { capital O, grave accent }
  379. if (Code=211) or (Name='Oacute') then E:='O' else { capital O, acute accent }
  380. if (Code=212) or (Name='Ocirc') then E:='O' else { capital O, circumflex accent }
  381. if (Code=213) or (Name='Otilde') then E:='O' else { capital O, tilde }
  382. if (Code=214) or (Name='Ouml') then E:='™' else { capital O, dieresis or umlaut }
  383. if (Code=215) or (Name='times') then E:='*' else { multiply sign }
  384. if (Code=216) or (Name='Oslash') then E:='O' else { capital O, slash }
  385. if (Code=217) or (Name='Ugrave') then E:='U' else { capital U, grave accent }
  386. if (Code=218) or (Name='Uacute') then E:='U' else { capital U, acute accent }
  387. if (Code=219) or (Name='Ucirc') then E:='U' else { capital U, circumflex accent }
  388. if (Code=220) or (Name='Uuml') then E:='š' else { capital U, dieresis or umlaut }
  389. if (Code=221) or (Name='Yacute') then E:='Y' else { capital Y, acute accent }
  390. (* if (Code=222) or (Name='THORN') then E:='?' else { capital THORN, Icelandic }*)
  391. if (Code=223) or (Name='szlig') then E:='á' else { small sharp S, German }
  392. if (Code=224) or (Name='agrave') then E:='…' else { small a, grave accent }
  393. if (Code=225) or (Name='aacute') then E:=' ' else { small a, acute accent }
  394. if (Code=226) or (Name='acirc') then E:='ƒ' else { small a, circumflex accent }
  395. if (Code=227) or (Name='atilde') then E:='ƒ' else { small a, tilde }
  396. if (Code=228) or (Name='auml') then E:='„' else { small a, dieresis or umlaut }
  397. if (Code=229) or (Name='aring') then E:='†' else { small a, ring }
  398. if (Code=230) or (Name='aelig') then E:='ae' else { small ae, diphthong }
  399. (* if (Code=231) or (Name='ccedil') then E:='?' else { small c, cedilla }*)
  400. if (Code=232) or (Name='egrave') then E:='Š' else { small e, grave accent }
  401. if (Code=233) or (Name='eacute') then E:='‚' else { small e, acute accent }
  402. if (Code=234) or (Name='ecirc') then E:='ˆ' else { small e, circumflex accent }
  403. if (Code=235) or (Name='euml') then E:='‰' else { small e, dieresis or umlaut }
  404. if (Code=236) or (Name='igrave') then E:='�' else { small i, grave accent }
  405. if (Code=237) or (Name='iacute') then E:='¡' else { small i, acute accent }
  406. if (Code=238) or (Name='icirc') then E:='Œ' else { small i, circumflex accent }
  407. if (Code=239) or (Name='iuml') then E:='‹' else { small i, dieresis or umlaut }
  408. (* if (Code=240) or (Name='eth') then E:='?' else { small eth, Icelandic }*)
  409. if (Code=241) or (Name='ntilde') then E:='¤' else { small n, tilde }
  410. if (Code=242) or (Name='ograve') then E:='•' else { small o, grave accent }
  411. if (Code=243) or (Name='oacute') then E:='¢' else { small o, acute accent }
  412. if (Code=244) or (Name='ocirc') then E:='“' else { small o, circumflex accent }
  413. if (Code=245) or (Name='otilde') then E:='“' else { small o, tilde }
  414. if (Code=246) or (Name='ouml') then E:='”' else { small o, dieresis or umlaut }
  415. if (Code=247) or (Name='divide') then E:='/' else { divide sign }
  416. if (Code=248) or (Name='oslash') then E:='"' else { small o, slash }
  417. if (Code=249) or (Name='ugrave') then E:='—' else { small u, grave accent }
  418. if (Code=250) or (Name='uacute') then E:='£' else { small u, acute accent }
  419. if (Code=251) or (Name='ucirc') then E:='–' else { small u, circumflex accent }
  420. if (Code=252) or (Name='uuml') then E:='�' else { small u, dieresis or umlaut }
  421. if (Code=253) or (Name='yacute') then E:='y' else { small y, acute accent }
  422. (* if (Code=254) or (Name='thorn') then E:='?' else { small thorn, Icelandic }*)
  423. if (Code=255) or (Name='yuml') then E:='y' else { small y, dieresis or umlaut }
  424. if (Code=8217) then E:='''' else { acute accent as generated by TeXH }
  425. Found:=false;
  426. DocDecodeNamedEntity:=Found;
  427. end;
  428. procedure THTMLParser.DocProcessTag(Tag: string);
  429. var UTagName,ETagName: string[30];
  430. P: byte;
  431. NotEndTag: boolean;
  432. begin
  433. if copy(Tag,1,1)='<' then Delete(Tag,1,1);
  434. if copy(Tag,length(Tag),1)='>' then Delete(Tag,length(Tag),1);
  435. Tag:=Trim(Tag);
  436. P:=Pos(' ',Tag); if P=0 then P:=length(Tag)+1;
  437. TagName:=copy(Tag,1,P-1); TagParams:=copy(Tag,P+1,255);
  438. UTagName:=UpcaseStr(TagName);
  439. NotEndTag:=copy(TagName,1,1)<>'/';
  440. if NotEndTag then ETagName:=UTagName else ETagName:=copy(UTagName,2,255);
  441. if (UTagName='!DOCTYPE') then DocTYPE else
  442. { Section tags }
  443. if (ETagName='HTML') then DocHTML(NotEndTag) else
  444. if (ETagName='HEAD') then DocHEAD(NotEndTag) else
  445. if (ETagName='TITLE') then DocTITLE(NotEndTag) else
  446. if (ETagName='BODY') then DocBODY(NotEndTag) else
  447. { Anchor tags }
  448. if (ETagName='A') then DocAnchor(NotEndTag) else
  449. { Direct formatting directives }
  450. if (ETagName='H1') then DocHeading(1,NotEndTag) else
  451. if (ETagName='H2') then DocHeading(2,NotEndTag) else
  452. if (ETagName='H3') then DocHeading(3,NotEndTag) else
  453. if (ETagName='H4') then DocHeading(4,NotEndTag) else
  454. if (ETagName='H5') then DocHeading(5,NotEndTag) else
  455. if (ETagName='H6') then DocHeading(6,NotEndTag) else
  456. if (ETagName='P') then DocParagraph(NotEndTag) else
  457. if (ETagName='BR') then DocBreak else
  458. if (ETagName='B') then DocBold(NotEndTag) else
  459. if (ETagName='CITE') then DocCite(NotEndTag) else
  460. if (ETagName='CODE') then DocCode(NotEndTag) else
  461. if (ETagName='EM') then DocEmphasized(NotEndTag) else
  462. if (ETagName='I') then DocItalic(NotEndTag) else
  463. if (ETagName='KBD') then DocKbd(NotEndTag) else
  464. if (ETagName='PRE') then DocPreformatted(NotEndTag) else
  465. if (ETagName='SAMP') then DocSample(NotEndTag) else
  466. if (ETagName='STRONG') then DocStrong(NotEndTag) else
  467. if (ETagName='TT') then DocTeleType(NotEndTag) else
  468. if (ETagName='VAR') then DocVariable(NotEndTag) else
  469. { Unordered & ordered lists }
  470. if (ETagName='UL') then DocList(NotEndTag) else
  471. if (ETagName='OL') then DocOrderedList(NotEndTag) else
  472. if (UTagName='LI') then DocListItem else
  473. { Definition list }
  474. if (ETagName='DL') then DocDefList(NotEndTag) else
  475. if (UTagName='DT') then DocDefTerm else
  476. if (UTagName='DD') then DocDefExp else
  477. { Table }
  478. if (ETagName='TABLE') then DocTable(NotEndTag) else
  479. if (ETagName='TR') then DocTableRow(NotEndTag) else
  480. if (ETagName='TH') then DocTableHeaderItem(NotEndTag) else
  481. if (ETagName='TD') then DocTableItem(NotEndTag) else
  482. { Misc. tags }
  483. if (UTagName='META') then DocMETA else
  484. if (UTagName='IMG') then DocImage else
  485. if (UTagName='HR') then DocHorizontalRuler else
  486. DocUnknownTag;
  487. end;
  488. function THTMLParser.DocGetTagParam(Name: string; var Value: string): boolean;
  489. var Found: boolean;
  490. S: string;
  491. ParamName,ParamValue: string;
  492. InStr: boolean;
  493. I: sw_integer;
  494. begin
  495. Found:=false; Name:=UpcaseStr(Name);
  496. S:=TagParams;
  497. repeat
  498. InStr:=false;
  499. ParamName:=''; ParamValue:='';
  500. S:=Trim(S); I:=1;
  501. while (I<=length(S)) and (S[I]<>'=') do
  502. begin
  503. ParamName:=ParamName+S[I];
  504. Inc(I);
  505. end;
  506. ParamName:=Trim(ParamName);
  507. if S[I]='=' then
  508. begin
  509. Inc(I); InStr:=false;
  510. while (I<=length(S)) and (S[I]=' ') do
  511. Inc(I);
  512. if (I<=length(S)) and (S[I]='"') then
  513. begin
  514. InStr:=true;
  515. Inc(I);
  516. end;
  517. while (I<=length(S)) and ((InStr=true) or (S[I]<>' ')) do
  518. begin
  519. if S[I]='"' then
  520. begin
  521. InStr:=not InStr;
  522. if InStr=false then Break;
  523. end
  524. else
  525. ParamValue:=ParamValue+S[I];
  526. Inc(I);
  527. end;
  528. end;
  529. Found:=(Name=UpcaseStr(ParamName));
  530. if Found then Value:=ParamValue;
  531. Delete(S,1,I);
  532. until Found or (S='');
  533. DocGetTagParam:=Found;
  534. end;
  535. procedure THTMLParser.DocProcessComment(Comment: string);
  536. begin
  537. end;
  538. procedure THTMLParser.DocUnknownTag;
  539. begin
  540. end;
  541. procedure THTMLParser.DocTYPE;
  542. begin
  543. end;
  544. procedure THTMLParser.DocHTML(Entered: boolean);
  545. begin
  546. end;
  547. procedure THTMLParser.DocHEAD(Entered: boolean);
  548. begin
  549. end;
  550. procedure THTMLParser.DocMETA;
  551. begin
  552. end;
  553. procedure THTMLParser.DocTITLE(Entered: boolean);
  554. begin
  555. end;
  556. procedure THTMLParser.DocBODY(Entered: boolean);
  557. begin
  558. end;
  559. procedure THTMLParser.DocAnchor(Entered: boolean);
  560. begin
  561. end;
  562. procedure THTMLParser.DocHeading(Level: integer; Entered: boolean);
  563. begin
  564. end;
  565. procedure THTMLParser.DocParagraph(Entered: boolean);
  566. begin
  567. end;
  568. procedure THTMLParser.DocBreak;
  569. begin
  570. end;
  571. procedure THTMLParser.DocImage;
  572. begin
  573. end;
  574. procedure THTMLParser.DocBold(Entered: boolean);
  575. begin
  576. end;
  577. procedure THTMLParser.DocCite(Entered: boolean);
  578. begin
  579. end;
  580. procedure THTMLParser.DocCode(Entered: boolean);
  581. begin
  582. end;
  583. procedure THTMLParser.DocEmphasized(Entered: boolean);
  584. begin
  585. end;
  586. procedure THTMLParser.DocItalic(Entered: boolean);
  587. begin
  588. end;
  589. procedure THTMLParser.DocKbd(Entered: boolean);
  590. begin
  591. end;
  592. procedure THTMLParser.DocPreformatted(Entered: boolean);
  593. begin
  594. end;
  595. procedure THTMLParser.DocSample(Entered: boolean);
  596. begin
  597. end;
  598. procedure THTMLParser.DocStrong(Entered: boolean);
  599. begin
  600. end;
  601. procedure THTMLParser.DocTeleType(Entered: boolean);
  602. begin
  603. end;
  604. procedure THTMLParser.DocVariable(Entered: boolean);
  605. begin
  606. end;
  607. procedure THTMLParser.DocList(Entered: boolean);
  608. begin
  609. end;
  610. procedure THTMLParser.DocOrderedList(Entered: boolean);
  611. begin
  612. end;
  613. procedure THTMLParser.DocListItem;
  614. begin
  615. end;
  616. procedure THTMLParser.DocDefList(Entered: boolean);
  617. begin
  618. end;
  619. procedure THTMLParser.DocDefTerm;
  620. begin
  621. end;
  622. procedure THTMLParser.DocDefExp;
  623. begin
  624. end;
  625. procedure THTMLParser.DocTable(Entered: boolean);
  626. begin
  627. end;
  628. procedure THTMLParser.DocTableRow(Entered: boolean);
  629. begin
  630. end;
  631. procedure THTMLParser.DocTableHeaderItem(Entered: boolean);
  632. begin
  633. end;
  634. procedure THTMLParser.DocTableItem(Entered: boolean);
  635. begin
  636. end;
  637. procedure THTMLParser.DocHorizontalRuler;
  638. begin
  639. end;
  640. END.