diff --git a/fcl/xml/Makefile b/fcl/xml/Makefile index c3148699b3..8671f55264 100644 --- a/fcl/xml/Makefile +++ b/fcl/xml/Makefile @@ -1,5 +1,5 @@ # -# Don't edit, this file is generated by FPCMake Version 1.1 [2002/11/24] +# Don't edit, this file is generated by FPCMake Version 1.1 [2002/11/28] # default: all MAKEFILETARGETS=linux go32v2 win32 os2 freebsd beos netbsd amiga atari sunos qnx netware openbsd wdosx @@ -213,7 +213,7 @@ UNITSDIR:=$(wildcard $(FPCDIR)/units/$(OS_TARGET)) endif PACKAGESDIR:=$(wildcard $(FPCDIR) $(FPCDIR)/packages/base $(FPCDIR)/packages/extra) override PACKAGE_NAME=fcl -override TARGET_UNITS+=dom htmldoc xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite +override TARGET_UNITS+=dom htmldoc xmlcfg xmlread xmlstreaming xmlwrite xhtml htmldefs htmwrite override INSTALL_FPCPACKAGE=y override COMPILER_OPTIONS+=-S2 override COMPILER_TARGETDIR+=../$(OS_TARGET) diff --git a/fcl/xml/Makefile.fpc b/fcl/xml/Makefile.fpc index 355e014e4f..e3be362d06 100644 --- a/fcl/xml/Makefile.fpc +++ b/fcl/xml/Makefile.fpc @@ -6,7 +6,7 @@ main=fcl [target] -units=dom htmldoc xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite +units=dom htmldoc xmlcfg xmlread xmlstreaming xmlwrite xhtml htmldefs htmwrite [compiler] options=-S2 diff --git a/fcl/xml/htmldefs.pp b/fcl/xml/htmldefs.pp new file mode 100644 index 0000000000..538e62def0 --- /dev/null +++ b/fcl/xml/htmldefs.pp @@ -0,0 +1,358 @@ +{ + $Id$ + This file is part of the Free Component Library + + HTML definitions and utility functions + Copyright (c) 2000-2002 by + Areca Systems GmbH / Sebastian Guenther, sg@freepascal.org + + See the file COPYING.FPC, included in this distribution, + for details about the copyright. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + + **********************************************************************} + + +unit HTMLDefs; + +{$MODE objfpc} +{$H+} + +interface + +type + + THTMLElementFlags = set of ( + efSubelementContent, // may have subelements + efPCDATAContent, // may have PCDATA content + efPreserveWhitespace); // preserve all whitespace + + PHTMLElementProps = ^THTMLElementProps; + THTMLElementProps = record + Name: String; + Flags: THTMLElementFlags; + end; + + +const + + HTMLElProps: array[0..78] of THTMLElementProps = ( + (Name: 'a'; Flags: [efSubelementContent, efPCDATAContent]), + (Name: 'abbr'; Flags: [efSubelementContent, efPCDATAContent]), + (Name: 'acronym'; Flags: [efSubelementContent, efPCDATAContent]), + (Name: 'address'; Flags: [efSubelementContent, efPCDATAContent]), + (Name: 'applet'; Flags: [efSubelementContent, efPCDATAContent]), + (Name: 'b'; Flags: [efSubelementContent, efPCDATAContent]), + (Name: 'basefont'; Flags: []), + (Name: 'bdo'; Flags: [efSubelementContent, efPCDATAContent]), + (Name: 'big'; Flags: [efSubelementContent, efPCDATAContent]), + (Name: 'blockquote';Flags: [efSubelementContent]), + (Name: 'body'; Flags: [efSubelementContent]), + (Name: 'br'; Flags: []), + (Name: 'button'; Flags: [efSubelementContent, efPCDATAContent]), + (Name: 'caption'; Flags: [efSubelementContent, efPCDATAContent]), + (Name: 'center'; Flags: [efSubelementContent]), + (Name: 'cite'; Flags: [efSubelementContent, efPCDATAContent]), + (Name: 'code'; Flags: [efSubelementContent, efPCDATAContent]), + (Name: 'col'; Flags: []), + (Name: 'colgroup'; Flags: [efSubelementContent]), + (Name: 'del'; Flags: [efSubelementContent]), + (Name: 'dfn'; Flags: [efSubelementContent, efPCDATAContent]), + (Name: 'dir'; Flags: [efSubelementContent]), + (Name: 'div'; Flags: [efSubelementContent]), + (Name: 'dl'; Flags: [efSubelementContent]), + (Name: 'em'; Flags: [efSubelementContent, efPCDATAContent]), + (Name: 'fieldset'; Flags: [efSubelementContent, efPCDATAContent]), + (Name: 'font'; Flags: [efSubelementContent, efPCDATAContent]), + (Name: 'form'; Flags: [efSubelementContent]), + (Name: 'h1'; Flags: [efSubelementContent, efPCDATAContent]), + (Name: 'h2'; Flags: [efSubelementContent, efPCDATAContent]), + (Name: 'h3'; Flags: [efSubelementContent, efPCDATAContent]), + (Name: 'h4'; Flags: [efSubelementContent, efPCDATAContent]), + (Name: 'h5'; Flags: [efSubelementContent, efPCDATAContent]), + (Name: 'h6'; Flags: [efSubelementContent, efPCDATAContent]), + (Name: 'head'; Flags: [efSubelementContent]), + (Name: 'hr'; Flags: []), + (Name: 'html'; Flags: [efSubelementContent]), + (Name: 'i'; Flags: [efSubelementContent, efPCDATAContent]), + (Name: 'iframe'; Flags: [efSubelementContent]), + (Name: 'img'; Flags: []), + (Name: 'input'; Flags: []), + (Name: 'ins'; Flags: [efSubelementContent]), + (Name: 'isindex'; Flags: []), + (Name: 'kbd'; Flags: [efSubelementContent, efPCDATAContent]), + (Name: 'label'; Flags: [efSubelementContent, efPCDATAContent]), + (Name: 'link'; Flags: []), + (Name: 'map'; Flags: [efSubelementContent]), + (Name: 'menu'; Flags: [efSubelementContent]), + (Name: 'meta'; Flags: []), + (Name: 'noframes'; Flags: [efSubelementContent, efPCDATAContent]), + (Name: 'noscript'; Flags: [efSubelementContent, efPCDATAContent]), + (Name: 'object'; Flags: [efSubelementContent, efPCDATAContent]), + (Name: 'ol'; Flags: [efSubelementContent]), + (Name: 'p'; Flags: [efSubelementContent, efPCDATAContent]), + (Name: 'pre'; Flags: [efSubelementContent, efPCDATAContent, efPreserveWhitespace]), + (Name: 'q'; Flags: [efSubelementContent, efPCDATAContent]), + (Name: 's'; Flags: [efSubelementContent, efPCDATAContent]), + (Name: 'samp'; Flags: [efSubelementContent, efPCDATAContent]), + (Name: 'script'; Flags: [efPCDATAContent]), + (Name: 'select'; Flags: [efSubelementContent]), + (Name: 'small'; Flags: [efSubelementContent, efPCDATAContent]), + (Name: 'span'; Flags: [efSubelementContent, efPCDATAContent]), + (Name: 'strike'; Flags: [efSubelementContent, efPCDATAContent]), + (Name: 'strong'; Flags: [efSubelementContent, efPCDATAContent]), + (Name: 'style'; Flags: [efPCDATAContent]), + (Name: 'sub'; Flags: [efSubelementContent, efPCDATAContent]), + (Name: 'sup'; Flags: [efSubelementContent, efPCDATAContent]), + (Name: 'table'; Flags: [efSubelementContent]), + (Name: 'textarea'; Flags: [efPCDATAContent]), + (Name: 'tbody'; Flags: [efSubelementContent]), + (Name: 'td'; Flags: [efSubelementContent]), + (Name: 'tfoot'; Flags: [efSubelementContent]), + (Name: 'th'; Flags: [efSubelementContent]), + (Name: 'thead'; Flags: [efSubelementContent]), + (Name: 'tr'; Flags: [efSubelementContent]), + (Name: 'tt'; Flags: [efSubelementContent, efPCDATAContent]), + (Name: 'u'; Flags: [efSubelementContent, efPCDATAContent]), + (Name: 'ul'; Flags: [efSubelementContent]), + (Name: 'var'; Flags: [efSubelementContent, efPCDATAContent])); + + + // ISO8859-1 mapping: + HTMLEntities: array[#160..#255] of String = ( + // 160-191 + 'nbsp', 'iexcl', 'cent', 'pound', 'curren', 'yen', 'brvbar', 'sect', + 'uml', 'copy', 'ordf', 'laquo', 'not', 'shy', 'reg', 'macr', + 'deg', 'plusmn', 'sup2', 'sup3', 'acute', 'micro', 'para', 'middot', + 'cedil', 'sup1', 'ordm', 'raquo', 'frac14', 'frac12', 'frac34', 'iquest', + // 192-223 + 'Agrave', 'Aacute', 'Acirc', 'Atilde', 'Auml', 'Aring', 'AElig', 'Ccedil', + 'Egrave', 'Eacute', 'Ecirc', 'Euml', 'Igrave', 'Iacute', 'Icirc', 'Iuml', + 'ETH', 'Ntilde', 'Ograve', 'Oacute', 'Ocirc', 'Otilde', 'Ouml', 'times', + 'Oslash', 'Ugrave', 'Uacute', 'Ucirc', 'Uuml', 'Yacute', 'THORN', 'szlig', + // 224-255 + 'agrave', 'aacute', 'acirc', 'atilde', 'auml', 'aring', 'aelig', 'ccedil', + 'egrave', 'eacute', 'ecirc', 'euml', 'igrave', 'iacute', 'icirc', 'iuml', + 'eth', 'ntilde', 'ograve', 'oacute', 'ocirc', 'otilde', 'ouml', 'divide', + 'oslash', 'ugrave', 'uacute', 'ucirc', 'uuml', 'yacute', 'thorn', 'yuml'); + + + UnicodeHTMLEntities: array[0..141] of String = ( + 'Alpha', // #913 + 'Beta', // #914 + 'Gamma', // #915 + 'Delta', // #916 + 'Epsilon', // #917 + 'Zeta', // #918 + 'Eta', // #919 + 'Theta', // #920 + 'Iota', // #921 + 'Kappa', // #922 + 'Lambda', // #923 + 'Mu', // #924 + 'Nu', // #925 + 'Xi', // #926 + 'Omicron', // #927 + 'Pi', // #928 + 'Rho', // #929 + 'Sigma', // #931 + 'Tau', // #932 + 'Upsilon', // #933 + 'Phi', // #934 + 'Chi', // #935 + 'Psi', // #936 + 'Omega', // #937 + 'alpha', // #945 + 'beta', // #946 + 'gamma', // #947 + 'delta', // #948 + 'epsilon', // #949 + 'zeta', // #950 + 'eta', // #951 + 'theta', // #952 + 'iota', // #953 + 'kappa', // #954 + 'lambda', // #955 + 'mu', // #956 + 'nu', // #957 + 'xi', // #958 + 'omicron', // #959 + 'pi', // #960 + 'rho', // #961 + 'sigmaf', // #962 + 'sigma', // #963 + 'tau', // #964 + 'upsilon', // #965 + 'phi', // #966 + 'chi', // #967 + 'psi', // #968 + 'omega', // #969 + 'thetasym', // #977 + 'upsih', // #978 + 'piv', // #982 + 'ensp', // #8194 + 'emsp', // #8195 + 'thinsp', // #8201 + 'zwnj', // #8204 + 'zwj', // #8205 + 'lrm', // #8206 + 'rlm', // #8207 + 'ndash', // #8211 + 'mdash', // #8212 + 'lsquo', // #8216 + 'rsquo', // #8217 + 'sbquo', // #8218 + 'ldquo', // #8220 + 'rdquo', // #8221 + 'bdquo', // #8222 + 'dagger', // #8224 + 'Dagger', // #8225 + 'bull', // #8226 + 'hellip', // #8230 + 'permil', // #8240 + 'prime', // #8242 + 'lsaquo', // #8249 + 'rsaquo', // #8250 + 'oline', // #8254 + 'frasl', // #8260 + 'image', // #8465 + 'weierp', // #8472 + 'real', // #8476 + 'trade', // #8482 + 'alefsym', // #8501 + 'larr', // #8592 + 'uarr', // #8593 + 'rarr', // #8594 + 'darr', // #8595 + 'harr', // #8596 + 'crarr', // #8629 + 'lArr', // #8656 + 'uArr', // #8657 + 'rArr', // #8658 + 'dArr', // #8659 + 'hArr', // #8660 + 'forall', // #8704 + 'part', // #8706 + 'exist', // #8707 + 'empty', // #8709 + 'nabla', // #8711 + 'isin', // #8712 + 'notin', // #8713 + 'ni', // #8715 + 'prod', // #8719 + 'sum', // #8721 + 'minus', // #8722 + 'lowast', // #8727 + 'radic', // #8730 + 'prop', // #8733 + 'infin', // #8734 + 'ang', // #8736 + 'and', // #8743 + 'or', // #8744 + 'cap', // #8745 + 'cup', // #8746 + 'int', // #8747 + 'there4', // #8756 + 'sim', // #8764 + 'cong', // #8773 + 'asymp', // #8776 + 'ne', // #8800 + 'equiv', // #8801 + 'le', // #8804 + 'ge', // #8805 + 'sub', // #8834 + 'sup', // #8835 + 'nsub', // #8836 + 'sube', // #8838 + 'supe', // #8839 + 'oplus', // #8853 + 'otimes', // #8855 + 'perp', // #8869 + 'sdot', // #8901 + 'lceil', // #8968 + 'rceil', // #8969 + 'lfloor', // #8970 + 'rfloor', // #8971 + 'lang', // #9001 + 'rang', // #9002 + 'loz', // #9674 + 'spades', // #9824 + 'clubs', // #9827 + 'hearts', // #9829 + 'diams' // #9830 + ); + + + +function ResolveHTMLEntityReference(const Name: String; + var Entity: Char): Boolean; + + + +implementation + +uses SysUtils; + +function ResolveHTMLEntityReference(const Name: String; + var Entity: Char): Boolean; +var + Ent: Char; + i: Integer; +begin + if Name = 'quot' then + begin + Entity := '"'; + Result := True; + end else if Name = 'apos' then + begin + Entity := ''''; + Result := True; + end else if Name = 'amp' then + begin + Entity := '&'; + Result := True; + end else if Name = 'lt' then + begin + Entity := '<'; + Result := True; + end else if Name = 'gt' then + begin + Entity := '>'; + Result := True; + end else if (Length(Name) > 0) and (Name[1] = '#') then + begin + for i := 2 to Length(Name) do + if (Name[i] < '0') or (Name[i] > '9') then + break; + if i > 2 then + begin + Entity := Chr(StrToInt(Copy(Name, 2, i - 1))); + Result := True; + end else + Result := False; + end else + begin + for Ent := Low(HTMLEntities) to High(HTMLEntities) do + if HTMLEntities[Ent] = Name then + begin + Entity := Ent; + Result := True; + exit; + end; + Result := False; + end; +end; + +end. + + +{ + $Log$ + Revision 1.1 2002-11-29 18:04:25 sg + * Improved HTML writing, now uses the HTML definition unit + (moved from FPDoc into FCL) + +} diff --git a/fcl/xml/htmwrite.pp b/fcl/xml/htmwrite.pp index 1c7ff372fa..07058df240 100644 --- a/fcl/xml/htmwrite.pp +++ b/fcl/xml/htmwrite.pp @@ -3,7 +3,7 @@ This file is part of the Free Component Library HTML writing routines - Copyright (c) 2000 by + Copyright (c) 2000-2002 by Areca Systems GmbH / Sebastian Guenther, sg@freepascal.org See the file COPYING.FPC, included in this distribution, @@ -27,18 +27,18 @@ uses Classes, DOM; procedure WriteHTMLFile(doc: TXMLDocument; const AFileName: String); procedure WriteHTMLFile(doc: TXMLDocument; var AFile: Text); -procedure WriteHTMLFile(doc: TXMLDocument; var AStream: TStream); +procedure WriteHTMLFile(doc: TXMLDocument; AStream: TStream); procedure WriteHTML(Element: TDOMElement; const AFileName: String); procedure WriteHTML(Element: TDOMElement; var AFile: Text); -procedure WriteHTML(Element: TDOMElement; var AStream: TStream); +procedure WriteHTML(Element: TDOMElement; AStream: TStream); // =================================================================== implementation -uses SysUtils; +uses SysUtils, HTMLDefs; // ------------------------------------------------------------------- // Writers for the different node types @@ -181,9 +181,19 @@ procedure WriteElement(node: TDOMNode); var i: Integer; attr, child: TDOMNode; - SavedInsideTextNode: Boolean; s: String; + SavedInsideTextNode: Boolean; + ElFlags: THTMLElementFlags; begin + s := LowerCase(node.NodeName); + ElFlags := [efSubelementContent, efPCDATAContent]; // default flags + for i := Low(HTMLElProps) to High(HTMLElProps) do + if HTMLElProps[i].Name = s then + begin + ElFlags := HTMLElProps[i].Flags; + break; + end; + wrt('<' + node.NodeName); for i := 0 to node.Attributes.Length - 1 do begin @@ -195,31 +205,27 @@ begin ConvWrite(s, AttrSpecialChars, @AttrSpecialCharCallback); wrt('"'); end; + wrt('>'); + if (not InsideTextNode) and not (efPCDATAContent in ElFlags) then + wrtln(''); + Child := node.FirstChild; - if Child = nil then - if InsideTextNode then - wrt(' />') - else - wrtln(' />') - else + if Assigned(Child) then begin SavedInsideTextNode := InsideTextNode; - if InsideTextNode or IsTextNode(Child) then - wrt('>') - else - wrtln('>'); repeat - if IsTextNode(Child) then - InsideTextNode := True; + InsideTextNode := efPCDATAContent in ElFlags; WriteNode(Child); Child := Child.NextSibling; - until child = nil; + until not Assigned(child); InsideTextNode := SavedInsideTextNode; - s := ''; - if InsideTextNode then - wrt(s) - else - wrtln(s); + end; + + if ElFlags * [efSubelementContent, efPCDATAContent] <> [] then + begin + wrt(''); + if not InsideTextNode then + wrtln(''); end; end; @@ -332,7 +338,7 @@ begin RootWriter(doc); end; -procedure WriteHTMLFile(doc: TXMLDocument; var AStream: TStream); +procedure WriteHTMLFile(doc: TXMLDocument; AStream: TStream); begin Stream := AStream; wrt := @Stream_Write; @@ -360,7 +366,7 @@ begin WriteNode(Element); end; -procedure WriteHTML(Element: TDOMElement; var AStream: TStream); +procedure WriteHTML(Element: TDOMElement; AStream: TStream); begin stream := AStream; wrt := @Stream_Write; @@ -375,7 +381,11 @@ end. { $Log$ - Revision 1.4 2002-09-07 15:15:29 peter + Revision 1.5 2002-11-29 18:04:25 sg + * Improved HTML writing, now uses the HTML definition unit + (moved from FPDoc into FCL) + + Revision 1.4 2002/09/07 15:15:29 peter * old logs removed and tabs fixed }