+ New unit dtdmodel.pp containing DTD-related classes.

* TXMLNodeType, TNodeData and TAttrDataType moved to xmlutils.pp, so they can be shared between dom, xmlread and dtdmodel.
* TContentParticle class moved from xmlread.pp to dtdmodel.pp.
* dom.pp and xmlread.pp switched to DOM-independent representation of DTD element declarations and attribute defaults.

git-svn-id: trunk@16221 -

.gitattributes

@@ -2316,6 +2316,7 @@ packages/fcl-xml/fpmake.pp svneol=native#text/plain
 packages/fcl-xml/src/README.txt svneol=native#text/plain
 packages/fcl-xml/src/dom.pp svneol=native#text/plain
 packages/fcl-xml/src/dom_html.pp svneol=native#text/plain
+packages/fcl-xml/src/dtdmodel.pp svneol=native#text/plain
 packages/fcl-xml/src/htmldefs.pp svneol=native#text/plain
 packages/fcl-xml/src/htmlelements.pp svneol=native#text/plain
 packages/fcl-xml/src/htmlwriter.pp svneol=native#text/plain

packages/fcl-xml/Makefile

@@ -1,5 +1,5 @@
 #
-# Don't edit, this file is generated by FPCMake Version 2.0.0 [2010/09/29]
+# Don't edit, this file is generated by FPCMake Version 2.0.0 [2010/10/23]
 #
 default: all
 MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-haiku i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince i386-embedded i386-symbian i386-nativent i386-iphonesim m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos m68k-embedded powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macos powerpc-darwin powerpc-morphos powerpc-embedded sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd x86_64-solaris x86_64-darwin x86_64-win64 x86_64-embedded arm-linux arm-palmos arm-darwin arm-wince arm-gba arm-nds arm-embedded arm-symbian powerpc64-linux powerpc64-darwin powerpc64-embedded avr-embedded armeb-linux armeb-embedded mipsel-linux
@@ -267,190 +267,190 @@ PACKAGESDIR:=$(wildcard $(FPCDIR) $(FPCDIR)/packages $(FPCDIR)/packages/base $(F
 override PACKAGE_NAME=fcl-xml
 override PACKAGE_VERSION=2.5.1
 ifeq ($(FULL_TARGET),i386-linux)
-override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml  xmliconv
+override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml dtdmodel  xmliconv
 endif
 ifeq ($(FULL_TARGET),i386-go32v2)
-override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml
+override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml dtdmodel
 endif
 ifeq ($(FULL_TARGET),i386-win32)
-override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml  xmliconv_windows
+override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml dtdmodel  xmliconv_windows
 endif
 ifeq ($(FULL_TARGET),i386-os2)
-override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml
+override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml dtdmodel
 endif
 ifeq ($(FULL_TARGET),i386-freebsd)
-override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml  xmliconv
+override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml dtdmodel  xmliconv
 endif
 ifeq ($(FULL_TARGET),i386-beos)
-override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml
+override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml dtdmodel
 endif
 ifeq ($(FULL_TARGET),i386-haiku)
-override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml
+override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml dtdmodel
 endif
 ifeq ($(FULL_TARGET),i386-netbsd)
-override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml
+override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml dtdmodel
 endif
 ifeq ($(FULL_TARGET),i386-solaris)
-override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml
+override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml dtdmodel
 endif
 ifeq ($(FULL_TARGET),i386-qnx)
-override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml
+override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml dtdmodel
 endif
 ifeq ($(FULL_TARGET),i386-netware)
-override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml
+override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml dtdmodel
 endif
 ifeq ($(FULL_TARGET),i386-openbsd)
-override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml
+override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml dtdmodel
 endif
 ifeq ($(FULL_TARGET),i386-wdosx)
-override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml
+override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml dtdmodel
 endif
 ifeq ($(FULL_TARGET),i386-darwin)
-override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml  xmliconv
+override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml dtdmodel  xmliconv
 endif
 ifeq ($(FULL_TARGET),i386-emx)
-override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml
+override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml dtdmodel
 endif
 ifeq ($(FULL_TARGET),i386-watcom)
-override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml
+override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml dtdmodel
 endif
 ifeq ($(FULL_TARGET),i386-netwlibc)
-override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml
+override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml dtdmodel
 endif
 ifeq ($(FULL_TARGET),i386-wince)
-override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml
+override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml dtdmodel
 endif
 ifeq ($(FULL_TARGET),i386-embedded)
-override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml
+override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml dtdmodel
 endif
 ifeq ($(FULL_TARGET),i386-symbian)
-override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml
+override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml dtdmodel
 endif
 ifeq ($(FULL_TARGET),i386-nativent)
-override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml
+override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml dtdmodel
 endif
 ifeq ($(FULL_TARGET),i386-iphonesim)
-override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml  xmliconv
+override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml dtdmodel  xmliconv
 endif
 ifeq ($(FULL_TARGET),m68k-linux)
-override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml  xmliconv
+override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml dtdmodel  xmliconv
 endif
 ifeq ($(FULL_TARGET),m68k-freebsd)
-override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml  xmliconv
+override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml dtdmodel  xmliconv
 endif
 ifeq ($(FULL_TARGET),m68k-netbsd)
-override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml
+override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml dtdmodel
 endif
 ifeq ($(FULL_TARGET),m68k-amiga)
-override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml
+override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml dtdmodel
 endif
 ifeq ($(FULL_TARGET),m68k-atari)
-override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml
+override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml dtdmodel
 endif
 ifeq ($(FULL_TARGET),m68k-openbsd)
-override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml
+override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml dtdmodel
 endif
 ifeq ($(FULL_TARGET),m68k-palmos)
-override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml
+override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml dtdmodel
 endif
 ifeq ($(FULL_TARGET),m68k-embedded)
-override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml
+override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml dtdmodel
 endif
 ifeq ($(FULL_TARGET),powerpc-linux)
-override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml  xmliconv
+override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml dtdmodel  xmliconv
 endif
 ifeq ($(FULL_TARGET),powerpc-netbsd)
-override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml
+override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml dtdmodel
 endif
 ifeq ($(FULL_TARGET),powerpc-amiga)
-override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml
+override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml dtdmodel
 endif
 ifeq ($(FULL_TARGET),powerpc-macos)
-override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml
+override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml dtdmodel
 endif
 ifeq ($(FULL_TARGET),powerpc-darwin)
-override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml  xmliconv
+override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml dtdmodel  xmliconv
 endif
 ifeq ($(FULL_TARGET),powerpc-morphos)
-override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml
+override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml dtdmodel
 endif
 ifeq ($(FULL_TARGET),powerpc-embedded)
-override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml
+override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml dtdmodel
 endif
 ifeq ($(FULL_TARGET),sparc-linux)
-override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml  xmliconv
+override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml dtdmodel  xmliconv
 endif
 ifeq ($(FULL_TARGET),sparc-netbsd)
-override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml
+override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml dtdmodel
 endif
 ifeq ($(FULL_TARGET),sparc-solaris)
-override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml
+override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml dtdmodel
 endif
 ifeq ($(FULL_TARGET),sparc-embedded)
-override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml
+override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml dtdmodel
 endif
 ifeq ($(FULL_TARGET),x86_64-linux)
-override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml  xmliconv
+override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml dtdmodel  xmliconv
 endif
 ifeq ($(FULL_TARGET),x86_64-freebsd)
-override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml  xmliconv
+override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml dtdmodel  xmliconv
 endif
 ifeq ($(FULL_TARGET),x86_64-solaris)
-override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml
+override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml dtdmodel
 endif
 ifeq ($(FULL_TARGET),x86_64-darwin)
-override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml  xmliconv
+override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml dtdmodel  xmliconv
 endif
 ifeq ($(FULL_TARGET),x86_64-win64)
-override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml  xmliconv_windows
+override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml dtdmodel  xmliconv_windows
 endif
 ifeq ($(FULL_TARGET),x86_64-embedded)
-override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml
+override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml dtdmodel
 endif
 ifeq ($(FULL_TARGET),arm-linux)
-override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml  xmliconv
+override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml dtdmodel  xmliconv
 endif
 ifeq ($(FULL_TARGET),arm-palmos)
-override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml
+override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml dtdmodel
 endif
 ifeq ($(FULL_TARGET),arm-darwin)
-override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml  xmliconv
+override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml dtdmodel  xmliconv
 endif
 ifeq ($(FULL_TARGET),arm-wince)
-override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml
+override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml dtdmodel
 endif
 ifeq ($(FULL_TARGET),arm-gba)
-override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml
+override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml dtdmodel
 endif
 ifeq ($(FULL_TARGET),arm-nds)
-override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml
+override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml dtdmodel
 endif
 ifeq ($(FULL_TARGET),arm-embedded)
-override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml
+override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml dtdmodel
 endif
 ifeq ($(FULL_TARGET),arm-symbian)
-override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml
+override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml dtdmodel
 endif
 ifeq ($(FULL_TARGET),powerpc64-linux)
-override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml  xmliconv
+override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml dtdmodel  xmliconv
 endif
 ifeq ($(FULL_TARGET),powerpc64-darwin)
-override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml  xmliconv
+override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml dtdmodel  xmliconv
 endif
 ifeq ($(FULL_TARGET),powerpc64-embedded)
-override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml
+override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml dtdmodel
 endif
 ifeq ($(FULL_TARGET),avr-embedded)
-override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml
+override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml dtdmodel
 endif
 ifeq ($(FULL_TARGET),armeb-linux)
-override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml  xmliconv
+override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml dtdmodel  xmliconv
 endif
 ifeq ($(FULL_TARGET),armeb-embedded)
-override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml
+override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml dtdmodel
 endif
 ifeq ($(FULL_TARGET),mipsel-linux)
-override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml  xmliconv
+override TARGET_UNITS+=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml dtdmodel  xmliconv
 endif
 ifeq ($(FULL_TARGET),i386-linux)
 override TARGET_RSTS+=sax xpath htmlwriter xmlconf

packages/fcl-xml/Makefile.fpc

@@ -7,7 +7,7 @@ name=fcl-xml
 version=2.5.1
 
 [target]
-units=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml
+units=htmldefs sax xmlutils dom sax_html dom_html xmlcfg xmlread xmlstreaming xmlwrite xhtml htmwrite xpath htmlelements htmlwriter xmlconf sax_xml dtdmodel
 units_linux=xmliconv
 units_freebsd=xmliconv
 units_darwin=xmliconv

packages/fcl-xml/src/dom.pp

@@ -38,7 +38,7 @@ unit DOM;
 interface
 
 uses
-  SysUtils, Classes, xmlutils;
+  SysUtils, Classes, xmlutils, dtdmodel;
 
 // -------------------------------------------------------
 //   DOMException
@@ -484,7 +484,7 @@ type
       TDOMProcessingInstruction; virtual;
     function CreateAttribute(const name: DOMString): TDOMAttr;
     function CreateAttributeBuf(Buf: DOMPChar; Length: Integer): TDOMAttr;
-    function CreateAttributeDef(Buf: DOMPChar; Length: Integer): TDOMAttrDef;
+    function CreateAttributeDef(Buf: DOMPChar; Length: Integer): TDOMAttrDef; deprecated;
     function CreateEntityReference(const name: DOMString): TDOMEntityReference;
       virtual;
     function GetElementsByTagName(const tagname: DOMString): TDOMNodeList;
@@ -534,17 +534,7 @@ type
 //   Attr
 // -------------------------------------------------------
 
-  TAttrDataType = (
-    dtCdata,
-    dtId,
-    dtIdRef,
-    dtIdRefs,
-    dtEntity,
-    dtEntities,
-    dtNmToken,
-    dtNmTokens,
-    dtNotation
-  );
+  TAttrDataType = xmlutils.TAttrDataType;
 
   TDOMNode_NS = class(TDOMNode_WithChildren)
   protected
@@ -596,7 +586,7 @@ type
     function GetAttributes: TDOMNamedNodeMap; override;
     procedure AttachDefaultAttrs;
     function InternalLookupPrefix(const nsURI: DOMString; Original: TDOMElement): DOMString;
-    procedure RestoreDefaultAttr(AttrDef: TDOMAttr);
+    procedure RestoreDefaultAttr(AttrDef: TAttributeDef);
   public
     destructor Destroy; override;
     function  CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode; overload; override;
@@ -766,14 +756,9 @@ type
 
 // Attribute declaration - Attr descendant which carries rudimentary type info
 // must be severely improved while developing Level 3
+// NOT USED ANYMORE -- replaced by dtdmodel.TAttributeDef
 
-  TAttrDefault = (
-    adImplied,
-    adDefault,
-    adRequired,
-    adFixed
-  );
-
+  TAttrDefault = dtdmodel.TAttrDefault;
   TDOMAttrDef = class(TDOMAttr)
   protected
     FExternallyDeclared: Boolean;
@@ -787,7 +772,7 @@ type
     property Default: TAttrDefault read FDefault write FDefault;
     property ExternallyDeclared: Boolean read FExternallyDeclared write FExternallyDeclared;
     property Tag: Cardinal read FTag write FTag;
-  end;
+  end deprecated;
 
 // TNodePool - custom memory management for TDOMNode's
 // One pool manages objects of the same InstanceSize (may be of various classes)
@@ -819,7 +804,8 @@ const
   stduri_xml: DOMString = 'http://www.w3.org/XML/1998/namespace';
   stduri_xmlns: DOMString = 'http://www.w3.org/2000/xmlns/';
 
-
+// temporary until things are settled
+function LoadAttribute(doc: TDOMDocument; src: PNodeData): TDOMAttr;
 
 // =======================================================
 // =======================================================
@@ -833,7 +819,7 @@ type
     function FindNS(nsIndex: Integer; const aLocalName: DOMString;
       out Index: LongWord): Boolean;
     function InternalRemoveNS(const nsURI, aLocalName: DOMString): TDOMNode;
-    procedure RestoreDefault(const name: DOMString);
+    procedure RestoreDefault(aName: PHashItem);
   protected
     function Delete(index: LongWord): TDOMNode; override;
     function ValidateInsert(arg: TDOMNode): Integer; override;
@@ -1819,7 +1805,7 @@ begin
   begin
     Result.FParentNode := nil;
     if Assigned(TDOMAttr(Result).FNSI.QName) then
-      RestoreDefault(TDOMAttr(Result).FNSI.QName^.Key);
+      RestoreDefault(TDOMAttr(Result).FNSI.QName);
   end;
 end;
 
@@ -1835,19 +1821,19 @@ begin
   end;
 end;
 
-procedure TAttributeMap.RestoreDefault(const name: DOMString);
+procedure TAttributeMap.RestoreDefault(aName: PHashItem);
 var
-  eldef: TDOMElement;
-  attrdef: TDOMAttr;
+  eldef: TElementDecl;
+  attrdef: TAttributeDef;
 begin
   if not Assigned(TDOMElement(FOwner).FNSI.QName) then  // safeguard
     Exit;
-  eldef := TDOMElement(TDOMElement(FOwner).FNSI.QName^.Data);
+  eldef := TElementDecl(TDOMElement(FOwner).FNSI.QName^.Data);
   if Assigned(eldef) then
   begin
     // TODO: can be avoided by linking attributes directly to their defs
-    attrdef := eldef.GetAttributeNode(name);
-    if Assigned(attrdef) and (TDOMAttrDef(attrdef).FDefault in [adDefault, adFixed]) then
+    attrdef := eldef.GetAttrDef(aName);
+    if Assigned(attrdef) and (attrdef.Default in [adDefault, adFixed]) then
       TDOMElement(FOwner).RestoreDefaultAttr(attrdef);
   end;
 end;
@@ -2793,19 +2779,19 @@ end;
 
 procedure TDOMElement.AttachDefaultAttrs;
 var
-  eldef: TDOMElement;
-  attrdef: TDOMAttrDef;
+  eldef: TElementDecl;
+  attrdef: TAttributeDef;
   I: Integer;
 begin
   if not Assigned(FNSI.QName) then     // safeguard
     Exit;
-  eldef := TDOMElement(FNSI.QName^.Data);
-  if Assigned(eldef) and Assigned(eldef.FAttributes) then
+  eldef := TElementDecl(FNSI.QName^.Data);
+  if Assigned(eldef) and eldef.NeedsDefaultPass then
   begin
-    for I := 0 to eldef.FAttributes.Length-1 do
+    for I := 0 to eldef.AttrDefCount-1 do
     begin
-      attrdef := TDOMAttrDef(eldef.FAttributes[I]);
-      if attrdef.FDefault in [adDefault, adFixed] then
+      attrdef := eldef.AttrDefs[I];
+      if attrdef.Default in [adDefault, adFixed] then
         RestoreDefaultAttr(attrdef);
     end;
   end;
@@ -2841,7 +2827,33 @@ begin
   result := GetAncestorElement(Self).InternalLookupPrefix(nsURI, Original);
 end;
 
-procedure TDOMElement.RestoreDefaultAttr(AttrDef: TDOMAttr);
+// Copypasted from the same procedure in xmlread
+function LoadAttribute(doc: TDOMDocument; src: PNodeData): TDOMAttr;
+var
+  curr: PNodeData;
+begin
+  TDOMNode(result) := doc.Alloc(TDOMAttr);
+  result.Create(doc);
+  result.FNSI.QName := src^.FQName;
+  if not src^.FIsDefault then
+    Include(result.FFlags, nfSpecified);
+  if Assigned(src^.FNext) then
+  begin
+    curr := src^.FNext;
+    while Assigned(curr) do
+    begin
+      case curr^.FNodeType of
+        ntText: result.InternalAppend(doc.CreateTextNode(curr^.FValueStr));
+        ntEntityReference: result.InternalAppend(doc.CreateEntityReference(curr^.FValueStr));
+      end;
+      curr := curr^.FNext;
+    end;
+  end
+  else if src^.FValueStr <> '' then
+    result.InternalAppend(doc.CreateTextNode(src^.FValueStr));
+end;
+
+procedure TDOMElement.RestoreDefaultAttr(AttrDef: TAttributeDef);
 var
   Attr: TDOMAttr;
   ColonPos: Integer;
@@ -2849,7 +2861,8 @@ var
 begin
   if nfDestroying in FOwnerDocument.FFlags then
     Exit;
-  Attr := TDOMAttr(AttrDef.CloneNode(True));
+  Attr := LoadAttribute(FOwnerDocument, AttrDef.Data);
+
   AttrName := Attr.Name;
   ColonPos := Pos(WideChar(':'), AttrName);
   if Pos(DOMString('xmlns'), AttrName) = 1 then

packages/fcl-xml/src/dtdmodel.pp

@@ -0,0 +1,345 @@
+{
+    This file is part of the Free Component Library
+
+    Object model for DTD.
+    Copyright (c) 2010 by Sergei Gorelkin, [email protected]
+
+    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 dtdmodel;
+
+{$ifdef fpc}
+{$MODE objfpc}{$H+}
+{$endif}
+
+interface
+
+uses
+  Classes, SysUtils, xmlutils;
+
+type
+  TCPType = (ctName, ctChoice, ctSeq);
+  TCPQuant = (cqOnce, cqZeroOrOnce, cqZeroOrMore, cqOnceOrMore);
+
+  TContentParticle = class(TObject)
+  private
+    FParent: TContentParticle;
+    FChildren: TFPList;
+    FIndex: Integer;
+    FDef: TObject;
+    FCPType: TCPType;
+    FCPQuant: TCPQuant;
+    function GetChildCount: Integer;
+    function GetChild(Index: Integer): TContentParticle;
+  public
+    destructor Destroy; override;
+    function Add: TContentParticle;
+    function IsRequired: Boolean;
+    function FindFirst(aDef: TObject): TContentParticle;
+    function FindNext(aDef: TObject; ChildIdx: Integer): TContentParticle;
+    function MoreRequired(ChildIdx: Integer): Boolean;
+    property ChildCount: Integer read GetChildCount;
+    property Children[Index: Integer]: TContentParticle read GetChild;
+    property Def: TObject read FDef write FDef;
+    property CPType: TCPType read FCPType write FCPType;
+    property CPQuant: TCPQuant read FCPQuant write FCPQuant;
+  end;
+
+  TDTDObject = class(TObject)
+  private
+    FExternallyDeclared: Boolean;
+  public
+    property ExternallyDeclared: Boolean read FExternallyDeclared write FExternallyDeclared;
+  end;
+
+  TAttrDefault = (
+    adImplied,
+    adDefault,
+    adRequired,
+    adFixed
+  );
+
+  TAttributeDef = class(TDTDObject)
+  private
+    FData: PNodeData;
+    FDataType: TAttrDataType;
+    FDefault: TAttrDefault;
+    FTag: Cardinal;
+    FEnumeration: array of WideString;
+  public
+    constructor Create;
+    destructor Destroy; override;
+    function AddEnumToken(Buf: PWideChar; Len: Integer): Boolean;
+    function HasEnumToken(const aValue: WideString): Boolean;
+    property Data: PNodeData read FData;
+    property Default: TAttrDefault read FDefault write FDefault;
+    property DataType: TAttrDataType read FDataType write FDataType;
+    property Tag: Cardinal read FTag write FTag;
+  end;
+
+  TElementContentType = (
+    ctUndeclared,
+    ctAny,
+    ctEmpty,
+    ctMixed,
+    ctChildren
+  );
+
+  TElementDecl = class(TDTDObject)
+  private
+    FAttrDefs: TFPList;
+    FNeedsDefaultPass: Boolean;
+    function GetAttrDefCount: Integer;
+    function AttrDefByIndex(index: Integer): TAttributeDef;
+  public
+    ContentType: TElementContentType;
+    IDAttr: TAttributeDef;
+    NotationAttr: TAttributeDef;
+    RootCP: TContentParticle;
+    destructor Destroy; override;
+    function GetAttrDef(aName: PHashItem): TAttributeDef;
+    procedure AddAttrDef(aDef: TAttributeDef);
+    property AttrDefCount: Integer read GetAttrDefCount;
+    property AttrDefs[index: Integer]: TAttributeDef read AttrDefByIndex;
+    property NeedsDefaultPass: Boolean read FNeedsDefaultPass;
+  end;
+
+
+implementation
+
+{ TContentParticle }
+
+function TContentParticle.Add: TContentParticle;
+begin
+  if FChildren = nil then
+    FChildren := TFPList.Create;
+  Result := TContentParticle.Create;
+  Result.FParent := Self;
+  Result.FIndex := FChildren.Add(Result);
+end;
+
+destructor TContentParticle.Destroy;
+var
+  I: Integer;
+begin
+  if Assigned(FChildren) then
+    for I := FChildren.Count-1 downto 0 do
+      TObject(FChildren[I]).Free;
+  FChildren.Free;
+  inherited Destroy;
+end;
+
+function TContentParticle.GetChild(Index: Integer): TContentParticle;
+begin
+  Result := TContentParticle(FChildren[Index]);
+end;
+
+function TContentParticle.GetChildCount: Integer;
+begin
+  if Assigned(FChildren) then
+    Result := FChildren.Count
+  else
+    Result := 0;
+end;
+
+function TContentParticle.IsRequired: Boolean;
+var
+  I: Integer;
+begin
+  Result := (CPQuant = cqOnce) or (CPQuant = cqOnceOrMore);
+  // do not return True if all children are optional
+  if (CPType <> ctName) and Result then
+  begin
+    for I := 0 to ChildCount-1 do
+    begin
+      Result := Children[I].IsRequired;
+      if Result then Exit;
+    end;
+  end;
+end;
+
+function TContentParticle.MoreRequired(ChildIdx: Integer): Boolean;
+var
+  I: Integer;
+begin
+  Result := False;
+  if CPType = ctSeq then
+  begin
+    for I := ChildIdx + 1 to ChildCount-1 do
+    begin
+      Result := Children[I].IsRequired;
+      if Result then Exit;
+    end;
+  end;
+  if Assigned(FParent) then
+    Result := FParent.MoreRequired(FIndex);
+end;
+
+function TContentParticle.FindFirst(aDef: TObject): TContentParticle;
+var
+  I: Integer;
+begin
+  Result := nil;
+  case CPType of
+    ctSeq:
+      for I := 0 to ChildCount-1 do with Children[I] do
+      begin
+        Result := FindFirst(aDef);
+        if Assigned(Result) or IsRequired then
+          Exit;
+      end;
+    ctChoice:
+      for I := 0 to ChildCount-1 do with Children[I] do
+      begin
+        Result := FindFirst(aDef);
+        if Assigned(Result) then
+          Exit;
+      end;
+  else // ctName
+    if aDef = Self.Def then
+      Result := Self
+  end;
+end;
+
+function TContentParticle.FindNext(aDef: TObject;
+  ChildIdx: Integer): TContentParticle;
+var
+  I: Integer;
+begin
+  Result := nil;
+  if CPType = ctSeq then   // search sequence to its end
+  begin
+    for I := ChildIdx + 1 to ChildCount-1 do with Children[I] do
+    begin
+      Result := FindFirst(aDef);
+      if (Result <> nil) or IsRequired then
+        Exit;
+    end;
+  end;
+  if (CPQuant = cqZeroOrMore) or (CPQuant = cqOnceOrMore) then
+    Result := FindFirst(aDef);
+  if (Result = nil) and Assigned(FParent) then
+    Result := FParent.FindNext(aDef, FIndex);
+end;
+
+{ TElementDecl }
+
+function TElementDecl.GetAttrDefCount: Integer;
+begin
+  if Assigned(FAttrDefs) then
+    Result := FAttrDefs.Count
+  else
+    Result := 0;
+end;
+
+function TElementDecl.AttrDefByIndex(index: Integer): TAttributeDef;
+begin
+  if Assigned(FAttrDefs) then
+    Result := TAttributeDef(FAttrDefs[index])
+  else
+    Result := nil;
+end;
+
+destructor TElementDecl.Destroy;
+var
+  i: Integer;
+begin
+  RootCP.Free;
+  if Assigned(FAttrDefs) then
+  begin
+    for i := FAttrDefs.Count-1 downto 0 do
+      TObject(FAttrDefs.List^[i]).Free;
+    FAttrDefs.Free;
+  end;
+  inherited Destroy;
+end;
+
+function TElementDecl.GetAttrDef(aName: PHashItem): TAttributeDef;
+var
+  i: Integer;
+begin
+  if Assigned(FAttrDefs) then
+  begin
+    for i := 0 to FAttrDefs.Count-1 do
+    begin
+      Result := TAttributeDef(FAttrDefs.List^[i]);
+      if Result.FData^.FQName = aName then
+        Exit;
+    end;
+  end;
+  Result := nil;
+end;
+
+procedure TElementDecl.AddAttrDef(aDef: TAttributeDef);
+begin
+  if FAttrDefs = nil then
+    FAttrDefs := TFPList.Create;
+  FAttrDefs.Add(aDef);
+  if aDef.Default in [adRequired, adDefault, adFixed] then
+    FNeedsDefaultPass := True;
+end;
+
+{ TAttributeDef }
+
+constructor TAttributeDef.Create;
+begin
+  New(FData);
+  FillChar(FData^, sizeof(TNodeData), 0);
+  FData^.FIsDefault := True;
+end;
+
+destructor TAttributeDef.Destroy;
+var
+  curr, tmp: PNodeData;
+begin
+  curr := FData;
+  while Assigned(curr) do
+  begin
+    tmp := curr^.FNext;
+    Dispose(curr);
+    curr := tmp;
+  end;
+  inherited Destroy;
+end;
+
+function TAttributeDef.AddEnumToken(Buf: PWideChar; Len: Integer): Boolean;
+var
+  I, L: Integer;
+begin
+  // TODO: this implementaion is the slowest possible...
+  Result := False;
+  L := Length(FEnumeration);
+  for I := 0 to L-1 do
+  begin
+    if (Len = Length(FEnumeration[i])) and
+      CompareMem(Pointer(FEnumeration[i]), Buf, Len*sizeof(WideChar)) then
+        Exit;
+  end;
+  SetLength(FEnumeration, L+1);
+  SetString(FEnumeration[L], Buf, Len);
+  Result := True;
+end;
+
+function TAttributeDef.HasEnumToken(const aValue: WideString): Boolean;
+var
+  I: Integer;
+begin
+  Result := True;
+  if Length(FEnumeration) = 0 then
+    Exit;
+  for I := 0 to Length(FEnumeration)-1 do
+  begin
+    if FEnumeration[I] = aValue then
+      Exit;
+  end;
+  Result := False;
+end;
+
+end.

packages/fcl-xml/src/xmlread.pp

@@ -143,7 +143,7 @@ procedure RegisterDecoder(Proc: TGetDecoderProc);
 implementation
 
 uses
-  UriParser, xmlutils;
+  UriParser, xmlutils, dtdmodel;
 
 const
   PubidChars: TSetOfChar = [' ', #13, #10, 'a'..'z', 'A'..'Z', '0'..'9',
@@ -154,7 +154,7 @@ type
   TDOMNotationEx = class(TDOMNotation);
   TDOMDocumentTypeEx = class(TDOMDocumentType);
   TDOMTopNodeEx = class(TDOMNode_TopLevel);
-  TDOMElementDef = class;
+  TDOMElementDef = dtdmodel.TElementDecl;
 
   TDTDSubsetType = (dsNone, dsInternal, dsExternal);
 
@@ -164,17 +164,6 @@ type
     LinePos: Integer;
   end;
 
-  TXMLNodeType = (ntNone, ntElement, ntAttribute, ntText,
-    ntCDATA, ntEntityReference, ntEntity, ntProcessingInstruction,
-    ntComment, ntDocument, ntDocumentType, ntDocumentFragment,
-    ntNotation,
-    ntWhitespace,
-    ntSignificantWhitespace,
-    ntEndElement,
-    ntEndEntity,
-    ntXmlDeclaration
-  );
-
   TDOMEntityEx = class(TDOMEntity)
   protected
     FExternallyDeclared: Boolean;
@@ -271,45 +260,7 @@ type
     Loc: TLocation;
   end;
 
-  TCPType = (ctName, ctChoice, ctSeq);
-  TCPQuant = (cqOnce, cqZeroOrOnce, cqZeroOrMore, cqOnceOrMore);
-
-  TContentParticle = class(TObject)
-  private
-    FParent: TContentParticle;
-    FChildren: TFPList;
-    FIndex: Integer;
-    function GetChildCount: Integer;
-    function GetChild(Index: Integer): TContentParticle;
-  public
-    CPType: TCPType;
-    CPQuant: TCPQuant;
-    Def: TObject;
-    destructor Destroy; override;
-    function Add: TContentParticle;
-    function IsRequired: Boolean;
-    function FindFirst(aDef: TObject): TContentParticle;
-    function FindNext(aDef: TObject; ChildIdx: Integer): TContentParticle;
-    function MoreRequired(ChildIdx: Integer): Boolean;
-    property ChildCount: Integer read GetChildCount;
-    property Children[Index: Integer]: TContentParticle read GetChild;
-  end;
-
-  PNodeData = ^TNodeData;
-  TNodeData = object
-    // generic members
-    FNext: PNodeData;
-    FQName: PHashItem;
-    FPrefix: PHashItem;
-    FNsUri: PHashItem;
-    FNodeType: TXMLNodeType;
-    FDOMNode: TDOMNode_WithChildren;   // temporary
-
-    FValueStr: WideString;
-    FValueStart: PWideChar;
-    FValueLength: Integer;
-
-    // validation-specific members
+  TElementValidator = object
     FElementDef: TDOMElementDef;
     FCurCP: TContentParticle;
     FFailed: Boolean;
@@ -318,17 +269,11 @@ type
   end;
 
   TNodeDataDynArray = array of TNodeData;
+  TDOMNodeDynArray = array of TDOMNode_WithChildren;
+  TValidatorDynArray = array of TElementValidator;
 
   TXMLReadState = (rsProlog, rsDTD, rsAfterDTD, rsRoot, rsEpilog);
 
-  TElementContentType = (
-    ctUndeclared,
-    ctAny,
-    ctEmpty,
-    ctMixed,
-    ctChildren
-  );
-
   TCheckNameFlags = set of (cnOptional, cnToken);
 
   TXMLToken = (xtNone, xtEOF, xtText, xtWhitespace, xtElement, xtEndElement,
@@ -398,7 +343,7 @@ type
     procedure XML11_BuildTables;
     function ParseQuantity: TCPQuant;
     procedure StoreLocation(out Loc: TLocation);
-    function ValidateAttrSyntax(AttrDef: TDOMAttrDef; const aValue: WideString): Boolean;
+    function ValidateAttrSyntax(AttrDef: TAttributeDef; const aValue: WideString): Boolean;
     procedure ValidateAttrValue(Attr: TDOMAttr; const aValue: WideString);
     procedure AddForwardRef(aList: TFPList; Buf: PWideChar; Length: Integer);
     procedure ClearRefs(aList: TFPList);
@@ -418,6 +363,8 @@ type
     FCurrNode: PNodeData;
     FAttrCount: Integer;
     FNodeStack: TNodeDataDynArray;
+    FCursorStack: TDOMNodeDynArray;
+    FValidators: TValidatorDynArray;
     FAttrChunks: TFPList;
     FFreeAttrChunk: PNodeData;
     FAttrCleanupFlag: Boolean;
@@ -471,21 +418,21 @@ type
     procedure ParseElementDecl;
     procedure ParseNotationDecl;
     function ResolveEntity(const ASystemID, APublicID, ABaseURI: WideString; out Source: TXMLCharSource): Boolean;
-    procedure ProcessDefaultAttributes(Element: TDOMElement; Map: TDOMNamedNodeMap);
+    procedure ProcessDefaultAttributes(Element: TDOMElement; ElDef: TElementDecl);
     procedure ProcessNamespaceAtts(Element: TDOMElement);
     procedure AddBinding(Attr: TDOMAttr; PrefixPtr: PWideChar; PrefixLen: Integer);
 
-    procedure PushVC(aElement: TDOMElement; aElDef: TDOMElementDef);
+    procedure PushVC(aElDef: TDOMElementDef);
     procedure PopVC;
     procedure UpdateConstraints;
     procedure ValidateDTD;
     procedure ValidateRoot;
     procedure ValidationError(const Msg: string; const args: array of const; LineOffs: Integer = -1);
+    procedure ValidationErrorWithName(const Msg: string; LineOffs: Integer = -1);
     procedure DoAttrText(node: TDOMAttr; ch: PWideChar; Count: Integer);
     procedure DTDReloadHook;
     procedure ConvertSource(SrcIn: TXMLInputSource; out SrcOut: TXMLCharSource);
     // Some SAX-alike stuff (at a very early stage)
-    procedure LoadAttribute(src: PNodeData; dest: TDOMAttr);
     procedure DoText(ch: PWideChar; Count: Integer; Whitespace: Boolean=False);
     procedure DoComment(ch: PWideChar; Count: Integer);
     procedure DoCDSect(ch: PWideChar; Count: Integer);
@@ -500,18 +447,6 @@ type
     procedure ProcessDTD(ASource: TXMLCharSource);               // ([29])
   end;
 
-  // Attribute/Element declarations
-
-  TDOMElementDef = class(TDOMElement)
-  public
-    FExternallyDeclared: Boolean;
-    ContentType: TElementContentType;
-    IDAttr: TDOMAttrDef;
-    NotationAttr: TDOMAttrDef;
-    RootCP: TContentParticle;
-    destructor Destroy; override;
-  end;
-
 const
   NullLocation: TLocation = (Line: 0; LinePos: 0);
 
@@ -1124,6 +1059,14 @@ begin
     DoError(esError, Format(Msg, Args), LineOffs);
 end;
 
+procedure TXMLReader.ValidationErrorWithName(const Msg: string; LineOffs: Integer);
+var
+  ws: WideString;
+begin
+  SetString(ws, FName.Buffer, FName.Length);
+  ValidationError(Msg, [ws], LineOffs);
+end;
+
 procedure TXMLReader.DoError(Severity: TErrorSeverity; const descr: string; LineOffs: Integer);
 var
   Loc: TLocation;
@@ -1316,6 +1259,8 @@ begin
   // Set char rules to XML 1.0
   FNamePages := @NamePages;
   SetLength(FNodeStack, 16);
+  SetLength(FValidators, 16);
+  SetLength(FCursorStack, 16);
 end;
 
 constructor TXMLReader.Create(AParser: TDOMParser);
@@ -1378,7 +1323,7 @@ begin
   FState := rsProlog;
   FNesting := 0;
   FCurrNode := @FNodeStack[0];
-  FCurrNode^.FDOMNode := doc;
+  FCursorStack[0] := doc;
   Initialize(ASource);
   ParseContent;
 
@@ -1395,7 +1340,7 @@ begin
   FState := rsRoot;
   FNesting := 0;
   FCurrNode := @FNodeStack[0];
-  FCurrNode^.FDOMNode := AOwner as TDOMNode_WithChildren;
+  FCursorStack[0] := AOwner as TDOMNode_WithChildren;
   FXML11 := doc.InheritsFrom(TXMLDocument) and (TXMLDocument(doc).XMLVersion = '1.1');
   Initialize(ASource);
   FDocType := TDOMDocumentTypeEx(doc.DocType);
@@ -1990,7 +1935,7 @@ begin
     ValidationError('Processing instructions are not allowed within EMPTY elements', []);
 
   PINode := Doc.CreateProcessingInstruction(NameStr, ValueStr);
-  FNodeStack[FNesting].FDOMNode.InternalAppend(PINode);
+  FCursorStack[FNesting].InternalAppend(PINode);
 end;
 
 const
@@ -2218,8 +2163,7 @@ begin
   Result := TDOMElementDef(p^.Data);
   if Result = nil then
   begin
-    Result := TDOMElementDef.Create(doc);
-    Result.FNSI.QName := p;
+    Result := TDOMElementDef.Create;
     p^.Data := Result;
   end;
 end;
@@ -2281,7 +2225,7 @@ begin
   ExpectWhitespace;
   ElDef := FindOrCreateElDef;
   if ElDef.ContentType <> ctUndeclared then
-    ValidationError('Duplicate declaration of element ''%s''', [ElDef.TagName], FName.Length);
+    ValidationErrorWithName('Duplicate declaration of element ''%s''', FName.Length);
 
   ExtDecl := FSource.DTDSubsetType <> dsInternal;
 
@@ -2341,7 +2285,7 @@ begin
   // SAX: DeclHandler.ElementDecl(name, model);
   if FDTDProcessed and (ElDef.ContentType = ctUndeclared) then
   begin
-    ElDef.FExternallyDeclared := ExtDecl;
+    ElDef.ExternallyDeclared := ExtDecl;
     ElDef.ContentType := Typ;
     ElDef.RootCP := CP;
   end
@@ -2380,11 +2324,11 @@ const
 procedure TXMLReader.ParseAttlistDecl;         // [52]
 var
   ElDef: TDOMElementDef;
-  AttDef: TDOMAttrDef;
+  AttDef: TAttributeDef;
   dt: TAttrDataType;
   Found, DiscardIt: Boolean;
   Offsets: array [Boolean] of Integer;
-  attrData: PNodeData;
+  attrName: PHashItem;
 begin
   ExpectWhitespace;
   ElDef := FindOrCreateElDef;
@@ -2393,14 +2337,14 @@ begin
   begin
     CheckName;
     ExpectWhitespace;
-    AttDef := doc.CreateAttributeDef(FName.Buffer, FName.Length);
+    attrName := doc.Names.FindOrAdd(FName.Buffer, FName.Length);
+    AttDef := TAttributeDef.Create;
     try
+      AttDef.Data^.FQName := attrName;
       AttDef.ExternallyDeclared := FSource.DTDSubsetType <> dsInternal;
 // In case of duplicate declaration of the same attribute, we must discard it,
 // not modifying ElDef, and suppressing certain validation errors.
-      DiscardIt := (not FDTDProcessed) or Assigned(ElDef.GetAttributeNode(AttDef.Name));
-      if not DiscardIt then
-        ElDef.SetAttributeNode(AttDef);
+      DiscardIt := (not FDTDProcessed) or Assigned(ElDef.GetAttrDef(attrName));
 
       if CheckForChar('(') then     // [59]
       begin
@@ -2471,7 +2415,7 @@ begin
           if Found and (FSource.FBuf^ < 'A') then
             ExpectWhitespace
           else
-            FatalError('Illegal attribute type for ''%s''', [AttDef.Name], Offsets[Found]);
+            FatalError('Illegal attribute type for ''%s''', [attrName^.Key], Offsets[Found]);
         end;
       end;
       StoreLocation(FTokenStart);
@@ -2493,19 +2437,16 @@ begin
           ValidationError('An attribute of type ID cannot have a default value',[]);
 
 // See comments to valid-sa-094: PE expansion should be disabled in AttDef.
-        attrData := AllocAttributeData(nil);
-        ExpectAttValue(attrData, dt <> dtCDATA);
+        ExpectAttValue(AttDef.Data, dt <> dtCDATA);
 
-        LoadAttribute(attrData, AttDef);   // convert to DOM form
-        CleanupAttributeData;
-        FAttrCount := 0;
-
-        if not ValidateAttrSyntax(AttDef, AttDef.NodeValue) then
-          ValidationError('Default value for attribute ''%s'' has wrong syntax', [AttDef.Name]);
+        if not ValidateAttrSyntax(AttDef, AttDef.Data^.FValueStr) then
+          ValidationError('Default value for attribute ''%s'' has wrong syntax', [attrName^.Key]);
       end;
       // SAX: DeclHandler.AttributeDecl(...)
       if DiscardIt then
-        AttDef.Free;
+        AttDef.Free
+      else
+        ElDef.AddAttrDef(AttDef);
     except
       AttDef.Free;
       raise;
@@ -2782,26 +2723,6 @@ const
     ntWhitespace
   );
 
-procedure TXMLReader.LoadAttribute(src: PNodeData; dest: TDOMAttr);
-var
-  curr: PNodeData;
-begin
-  if Assigned(src^.FNext) then
-  begin
-    curr := src^.FNext;
-    while Assigned(curr) do
-    begin
-      case curr^.FNodeType of
-        ntText: dest.InternalAppend(doc.CreateTextNode(curr^.FValueStr));
-        ntEntityReference: dest.InternalAppend(doc.CreateEntityReference(curr^.FValueStr));
-      end;
-      curr := curr^.FNext;
-    end;
-  end
-  else if src^.FValueStr <> '' then
-    dest.InternalAppend(doc.CreateTextNode(src^.FValueStr));
-end;
-
 procedure TXMLReader.ParseContent;
 begin
   FNext := xtText;
@@ -2987,7 +2908,7 @@ begin
   FNext := xtText;
 
   case tok of
-    xtEntity:     AppendReference(FNodeStack[FNesting].FDOMNode, FCurrEntity);
+    xtEntity:     AppendReference(FCursorStack[FNesting], FCurrEntity);
     xtElement:    ParseStartTag;
     xtEndElement: ParseEndTag;
     xtPI:         ParsePI;
@@ -3031,11 +2952,9 @@ begin
 
   // we're about to process a new set of attributes
   Inc(FAttrTag);
-  // can point to a child text/comment/PI node, so restore it
-  FCurrNode := @FNodeStack[FNesting];
 
   NewElem := doc.CreateElementBuf(FName.Buffer, FName.Length);
-  FCurrNode^.FDOMNode.InternalAppend(NewElem);
+  FCursorStack[FNesting].InternalAppend(NewElem);
 
   // Remember the hash entry, we'll need it often
   ElName := NewElem.NSI.QName;
@@ -3046,12 +2965,14 @@ begin
     ValidationError('Using undeclared element ''%s''',[ElName^.Key], FName.Length);
 
   // Check if new element is allowed in current context
-  if FValidate and not FCurrNode^.IsElementAllowed(ElDef) then
+  if FValidate and not FValidators[FNesting].IsElementAllowed(ElDef) then
     ValidationError('Element ''%s'' is not allowed in this context',[ElName^.Key], FName.Length);
 
   IsEmpty := False;
   FAttrCount := 0;
-  PushVC(NewElem, ElDef);  // this increases FNesting
+  PushVC(ElDef);           // this increases FNesting
+  FCursorStack[FNesting] := NewElem;
+
   FCurrNode^.FQName := ElName;
   FCurrNode^.FNodeType := ntElement;
   if FNamespaces then
@@ -3078,8 +2999,8 @@ begin
   end;
   ExpectChar('>');
 
-  if Assigned(ElDef) and Assigned(ElDef.FAttributes) then
-    ProcessDefaultAttributes(NewElem, ElDef.FAttributes);
+  if Assigned(ElDef) and ElDef.NeedsDefaultPass then
+    ProcessDefaultAttributes(NewElem, ElDef);
 
   if FNamespaces then
     ProcessNamespaceAtts(NewElem);
@@ -3096,10 +3017,10 @@ end;
 
 procedure TXMLReader.DoEndElement;
 begin
-  if (FNesting > 0) and (FNodeStack[FNesting-1].FDOMNode = doc) then
+  if (FNesting = 1) and (FCursorStack[0] = doc) then
     FState := rsEpilog;
 
-  if FValidate and FCurrNode^.Incomplete then
+  if FValidate and FValidators[FNesting].Incomplete then
     ValidationError('Element ''%s'' is missing required sub-elements', [FNodeStack[FNesting].FQName^.Key], -1);
 end;
 
@@ -3132,16 +3053,16 @@ end;
 procedure TXMLReader.ParseAttribute(Elem: TDOMElement; ElDef: TDOMElementDef);
 var
   attr: TDOMAttr;
+  attrName: PHashItem;
   attrData: PNodeData;
-  AttDef: TDOMAttrDef;
+  AttDef: TAttributeDef;
   i: Integer;
   normalized: Boolean;
 
-{ still needs a temp to store AttDef.Value }
 procedure CheckValue;
 begin
   // TODO: what about normalization of AttDef.Value? (Currently it IS normalized)
-  if (AttDef.Default = adFixed) and (AttDef.Value <> attrData^.FValueStr) then
+  if (AttDef.Default = adFixed) and (AttDef.Data^.FValueStr <> attrData^.FValueStr) then
     ValidationError('Value of attribute ''%s'' does not match its #FIXED default',[attrData^.FQName^.Key], -1);
   if not ValidateAttrSyntax(AttDef, attrData^.FValueStr) then
     ValidationError('Attribute ''%s'' type mismatch', [attrData^.FQName^.Key], -1);
@@ -3150,15 +3071,15 @@ end;
 
 begin
   CheckName;
-  attr := doc.CreateAttributeBuf(FName.Buffer, FName.Length);
-  attrData := AllocAttributeData(attr.NSI.QName);
+  attrName := doc.Names.FindOrAdd(FName.Buffer, FName.Length);
+  attrData := AllocAttributeData(attrName);
 
   if Assigned(ElDef) then
   begin
-    AttDef := TDOMAttrDef(ElDef.GetAttributeNode(attrData^.FQName^.Key));
+    AttDef := ElDef.GetAttrDef(attrName);
     if AttDef = nil then
       ValidationError('Using undeclared attribute ''%s'' on element ''%s''',
-        [attrData^.FQName^.Key, FNodeStack[FNesting].FQName^.Key], FName.Length)
+        [attrName^.Key, FNodeStack[FNesting].FQName^.Key], FName.Length)
     else
       AttDef.Tag := FAttrTag;  // indicates that this one is specified
   end
@@ -3167,13 +3088,13 @@ begin
 
   // check for duplicates
   for i := 1 to FAttrCount-1 do
-    if FNodeStack[FNesting+i].FQName = attrData^.FQName then
+    if FNodeStack[FNesting+i].FQName = attrName then
       FatalError('Duplicate attribute', FName.Length);
 
   ExpectEq;
   normalized := ExpectAttValue(attrData, Assigned(AttDef) and (AttDef.DataType <> dtCDATA));
 
-  LoadAttribute(attrData, attr);
+  attr := LoadAttribute(doc, attrData);
 
   elem.Attributes.SetNamedItem(attr);
   if Assigned(AttDef) and ((AttDef.DataType <> dtCdata) or (AttDef.Default = adFixed)) then
@@ -3216,15 +3137,16 @@ begin
   ClearRefs(FIDRefs);
 end;
 
-procedure TXMLReader.ProcessDefaultAttributes(Element: TDOMElement; Map: TDOMNamedNodeMap);
+procedure TXMLReader.ProcessDefaultAttributes(Element: TDOMElement; ElDef: TElementDecl);
 var
   I: Integer;
-  AttDef: TDOMAttrDef;
+  AttDef: TAttributeDef;
   Attr: TDOMAttr;
+  attrData: PNodeData;
 begin
-  for I := 0 to Map.Length-1 do
+  for I := 0 to ElDef.AttrDefCount-1 do
   begin
-    AttDef := Map[I] as TDOMAttrDef;
+    AttDef := ElDef.AttrDefs[I];
 
     if AttDef.Tag <> FAttrTag then  // this one wasn't specified
     begin
@@ -3232,11 +3154,16 @@ begin
         adDefault, adFixed: begin
           if FStandalone and AttDef.ExternallyDeclared then
             StandaloneError;
-          Attr := TDOMAttr(AttDef.CloneNode(True));
+          attrData := AllocAttributeData(nil);
+          attrData^ := AttDef.Data^;
+
+          Attr := LoadAttribute(doc, AttDef.Data);
           Element.SetAttributeNode(Attr);
+
           ValidateAttrValue(Attr, Attr.Value);
         end;
-        adRequired:  ValidationError('Required attribute ''%s'' of element ''%s'' is missing',[AttDef.Name, Element.TagName], 0)
+        adRequired:
+          ValidationError('Required attribute ''%s'' of element ''%s'' is missing',[AttDef.Data^.FQName^.Key, Element.TagName], 0)
       end;
     end;
   end;
@@ -3385,7 +3312,7 @@ begin
   Result := True;
 end;
 
-function TXMLReader.ValidateAttrSyntax(AttrDef: TDOMAttrDef; const aValue: WideString): Boolean;
+function TXMLReader.ValidateAttrSyntax(AttrDef: TAttributeDef; const aValue: WideString): Boolean;
 begin
   case AttrDef.DataType of
     dtId, dtIdRef, dtEntity: Result := IsXmlName(aValue, FXML11) and
@@ -3492,7 +3419,7 @@ begin
 
   // Document builder part
   TextNode := Doc.CreateTextNodeBuf(ch, Count, Whitespace and (FCurrContentType = ctChildren));
-  FNodeStack[FNesting].FDOMNode.InternalAppend(TextNode);
+  FCursorStack[FNesting].InternalAppend(TextNode);
 end;
 
 procedure TXMLReader.DoComment(ch: PWideChar; Count: Integer);
@@ -3507,7 +3434,7 @@ begin
   if (not FIgnoreComments) and (FState <> rsDTD) then
   begin
     Node := Doc.CreateCommentBuf(ch, Count);
-    FNodeStack[FNesting].FDOMNode.InternalAppend(Node);
+    FCursorStack[FNesting].InternalAppend(Node);
   end;
 end;
 
@@ -3521,7 +3448,7 @@ begin
     ValidationError('CDATA sections are not allowed in element-only content',[]);
 
   SetString(s, ch, Count);
-  FNodeStack[FNesting].FDOMNode.InternalAppend(doc.CreateCDATASection(s));
+  FCursorStack[FNesting].InternalAppend(doc.CreateCDATASection(s));
 end;
 
 procedure TXMLReader.DoNotationDecl(const aName, aPubID, aSysID: WideString);
@@ -3561,17 +3488,26 @@ end;
 
 function TXMLReader.AllocAttributeValueChunk(APrev: PNodeData): PNodeData;
 begin
-  result := FFreeAttrChunk;
-  if Assigned(result) then
-  begin
-    FFreeAttrChunk := result^.FNext;
-    result^.FNext := nil;
-  end
-  else { no free chunks, create a new one }
+  { when parsing DTD, don't take ownership of allocated data }
+  if FState = rsDTD then
   begin
     New(result);
     FillChar(result^, sizeof(TNodeData), 0);
-    FAttrChunks.Add(result);
+  end
+  else
+  begin
+    result := FFreeAttrChunk;
+    if Assigned(result) then
+    begin
+      FFreeAttrChunk := result^.FNext;
+      result^.FNext := nil;
+    end
+    else { no free chunks, create a new one }
+    begin
+      New(result);
+      FillChar(result^, sizeof(TNodeData), 0);
+      FAttrChunks.Add(result);
+    end;
   end;
   APrev^.FNext := result;
 end;
@@ -3584,13 +3520,15 @@ begin
   for i := 1 to FAttrCount do
   begin
     chunk := FNodeStack[FNesting+i].FNext;
-    while Assigned(chunk) do
-    begin
-      tmp := chunk^.FNext;
-      chunk^.FNext := FFreeAttrChunk;
-      FFreeAttrChunk := chunk;
-      chunk := tmp;
-    end;
+    {don't unlink chunks of default attributes, they are owned by DTD}
+    if not FNodeStack[FNesting+i].FIsDefault then
+      while Assigned(chunk) do
+      begin
+        tmp := chunk^.FNext;
+        chunk^.FNext := FFreeAttrChunk;
+        FFreeAttrChunk := chunk;
+        chunk := tmp;
+      end;
     FNodeStack[FNesting+i].FNext := nil;
   end;
   FAttrCleanupFlag := False;
@@ -3606,15 +3544,21 @@ begin
   FCurrNode^.FValueLength := FValue.Length;
 end;
 
-procedure TXMLReader.PushVC(aElement: TDOMElement; aElDef: TDOMElementDef);
+procedure TXMLReader.PushVC(aElDef: TDOMElementDef);
 begin
   Inc(FNesting);
   FCurrNode := AllocNodeData(FNesting);
-  FCurrNode^.FDOMNode := aElement;
-  FCurrNode^.FElementDef := aElDef;
-  FCurrNode^.FCurCP := nil;
-  FCurrNode^.FFailed := False;
   FCurrNode^.FPrefix := nil;
+
+  if FNesting >= Length(FCursorStack) then
+  begin
+    SetLength(FCursorStack, FNesting * 2);
+    SetLength(FValidators, FNesting * 2);
+  end;
+
+  FValidators[FNesting].FElementDef := aElDef;
+  FValidators[FNesting].FCurCP := nil;
+  FValidators[FNesting].FFailed := False;
   UpdateConstraints;
 end;
 
@@ -3627,10 +3571,10 @@ end;
 
 procedure TXMLReader.UpdateConstraints;
 begin
-  if FValidate and Assigned(FCurrNode^.FElementDef) then
+  if FValidate and Assigned(FValidators[FNesting].FElementDef) then
   begin
-    FCurrContentType := FCurrNode^.FElementDef.ContentType;
-    FSaViolation := FStandalone and (FCurrNode^.FElementDef.FExternallyDeclared);
+    FCurrContentType := FValidators[FNesting].FElementDef.ContentType;
+    FSaViolation := FStandalone and (FValidators[FNesting].FElementDef.ExternallyDeclared);
   end
   else
   begin
@@ -3639,9 +3583,9 @@ begin
   end;
 end;
 
-{ TNodeData }
+{ TElementValidator }
 
-function TNodeData.IsElementAllowed(Def: TDOMElementDef): Boolean;
+function TElementValidator.IsElementAllowed(Def: TDOMElementDef): Boolean;
 var
   Next: TContentParticle;
 begin
@@ -3671,7 +3615,7 @@ begin
   end;
 end;
 
-function TNodeData.Incomplete: Boolean;
+function TElementValidator.Incomplete: Boolean;
 begin
   if Assigned(FElementDef) and (FElementDef.ContentType = ctChildren) and (not FFailed) then
   begin
@@ -3684,129 +3628,6 @@ begin
     Result := False;
 end;
 
-{ TContentParticle }
-
-function TContentParticle.Add: TContentParticle;
-begin
-  if FChildren = nil then
-    FChildren := TFPList.Create;
-  Result := TContentParticle.Create;
-  Result.FParent := Self;
-  Result.FIndex := FChildren.Add(Result);
-end;
-
-destructor TContentParticle.Destroy;
-var
-  I: Integer;
-begin
-  if Assigned(FChildren) then
-    for I := FChildren.Count-1 downto 0 do
-      TObject(FChildren[I]).Free;
-  FChildren.Free;
-  inherited Destroy;
-end;
-
-function TContentParticle.GetChild(Index: Integer): TContentParticle;
-begin
-  Result := TContentParticle(FChildren[Index]);
-end;
-
-function TContentParticle.GetChildCount: Integer;
-begin
-  if Assigned(FChildren) then
-    Result := FChildren.Count
-  else
-    Result := 0;
-end;
-
-function TContentParticle.IsRequired: Boolean;
-var
-  I: Integer;
-begin
-  Result := (CPQuant = cqOnce) or (CPQuant = cqOnceOrMore);
-  // do not return True if all children are optional
-  if (CPType <> ctName) and Result then
-  begin
-    for I := 0 to ChildCount-1 do
-    begin
-      Result := Children[I].IsRequired;
-      if Result then Exit;
-    end;
-  end;
-end;
-
-function TContentParticle.MoreRequired(ChildIdx: Integer): Boolean;
-var
-  I: Integer;
-begin
-  Result := False;
-  if CPType = ctSeq then
-  begin
-    for I := ChildIdx + 1 to ChildCount-1 do
-    begin
-      Result := Children[I].IsRequired;
-      if Result then Exit;
-    end;
-  end;
-  if Assigned(FParent) then
-    Result := FParent.MoreRequired(FIndex);
-end;
-
-function TContentParticle.FindFirst(aDef: TObject): TContentParticle;
-var
-  I: Integer;
-begin
-  Result := nil;
-  case CPType of
-    ctSeq:
-      for I := 0 to ChildCount-1 do with Children[I] do
-      begin
-        Result := FindFirst(aDef);
-        if Assigned(Result) or IsRequired then
-          Exit;
-      end;
-    ctChoice:
-      for I := 0 to ChildCount-1 do with Children[I] do
-      begin
-        Result := FindFirst(aDef);
-        if Assigned(Result) then
-          Exit;
-      end;
-  else // ctName
-    if aDef = Self.Def then
-      Result := Self
-  end;
-end;
-
-function TContentParticle.FindNext(aDef: TObject;
-  ChildIdx: Integer): TContentParticle;
-var
-  I: Integer;
-begin
-  Result := nil;
-  if CPType = ctSeq then   // search sequence to its end
-  begin
-    for I := ChildIdx + 1 to ChildCount-1 do with Children[I] do
-    begin
-      Result := FindFirst(aDef);
-      if (Result <> nil) or IsRequired then
-        Exit;
-    end;
-  end;
-  if (CPQuant = cqZeroOrMore) or (CPQuant = cqOnceOrMore) then
-    Result := FindFirst(aDef);
-  if (Result = nil) and Assigned(FParent) then
-    Result := FParent.FindNext(aDef, FIndex);
-end;
-
-{ TDOMElementDef }
-
-destructor TDOMElementDef.Destroy;
-begin
-  RootCP.Free;
-  inherited Destroy;
-end;
-
 { plain calls }
 
 procedure ReadXMLFile(out ADoc: TXMLDocument; var f: Text);

packages/fcl-xml/src/xmlutils.pp

@@ -42,7 +42,31 @@ type
 
 const
   xmlVersionStr: array[TXMLVersion] of WideString = ('', '1.0', '1.1');
-  
+
+type
+  TXMLNodeType = (ntNone, ntElement, ntAttribute, ntText,
+    ntCDATA, ntEntityReference, ntEntity, ntProcessingInstruction,
+    ntComment, ntDocument, ntDocumentType, ntDocumentFragment,
+    ntNotation,
+    ntWhitespace,
+    ntSignificantWhitespace,
+    ntEndElement,
+    ntEndEntity,
+    ntXmlDeclaration
+  );
+
+  TAttrDataType = (
+    dtCdata,
+    dtId,
+    dtIdRef,
+    dtIdRefs,
+    dtEntity,
+    dtEntities,
+    dtNmToken,
+    dtNmTokens,
+    dtNotation
+  );
+
 { a simple hash table with WideString keys }
 
 type
@@ -109,6 +133,24 @@ type
     destructor Destroy; override;
   end;
 
+{ generic node info record, shared between DOM and reader }
+
+  PNodeData = ^TNodeData;
+  TNodeData = record
+    FNext: PNodeData;
+    FQName: PHashItem;
+    FPrefix: PHashItem;
+    FNsUri: PHashItem;
+    FNodeType: TXMLNodeType;
+
+    FValueStr: WideString;
+    FValueStart: PWideChar;
+    FValueLength: Integer;
+    FIsDefault: Boolean;
+  end;
+
+{ TNSSupport provides tracking of prefix-uri pairs and namespace fixup for writer }
+
   TBinding = class
   public
     uri: WideString;