whtml.pas 24 KB

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